diff --git a/.gitignore b/.gitignore
index 0e401127..1c2d92dd 100644
--- a/.gitignore
+++ b/.gitignore
@@ -4,9 +4,13 @@
/build/*
/*.exe
/*.obj
-/*.o
+/*.[cho]
/*.lib
/*.map
+/*.sym
+/*.asm
+/*.mod
+/Errors.txt
/olang
/src/test/**/*.exe
/src/test/**/*.c
@@ -14,10 +18,16 @@
/src/test/**/*.o
/src/test/**/*.obj
/src/test/**/*.sym
-/src/test/**/*.stackdump
+**/*.stackdump
+/src/test/confidence/**/input
/src/test/confidence/**/result
+/src/test/confidence/**/result-*
/src/test/confidence/**/*.asm
/src/test/confidence/**/*.s
+/src/test/confidence/**/*.map
+/bootstrap/*/SYSTEM.[ch]
+/bootstrap/*/Errors.Txt
+/bootstrap/*/WindowsWrapper.h
/.DS_store
**/.DS_store
**/*.dSYM
diff --git a/ReadMe.md b/ReadMe.md
index be623b82..b5dbdb74 100644
--- a/ReadMe.md
+++ b/ReadMe.md
@@ -11,35 +11,39 @@ 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.
-###### Contents
+### Contents
-> [Installation](#installation)
-> [A 'Hello' application](#a-hello-application)
-> [Licensing](#licensing)
-> [Platform support and porting](#platform-support-and-porting)
-> [Language support and libraries](#language-support-and-libraries)
-> [History](#history)
-> [Roadmap](#roadmap)
-> [Contributors](#contributors)
-> [Origin of the name "Ѵishap Oberon"](#origin-of-the-name-Ѵishap-oberon)
-> [References](#references)
+ [**Installation**](#installation)
+ [**A 'Hello' application**](#a-hello-application)
+ [**Licensing**](#licensing)
+ [**Platform support and porting**](#platform-support-and-porting)
+ [**Language support and libraries**](#language-support-and-libraries)
+ [**History**](#history)
+ [**Roadmap**](#roadmap)
+ [**Contributors**](#contributors)
+ [**Origin of the name "Ѵishap Oberon"**](#origin-of-the-name-Ѵishap-oberon)
+ [**References**](#references)
## Installation
-###### Prerequisites
+While pre-built packages are not provided, it is easy to install the Oberon compiler and libraries
+with the following simple steps.
-| Platform | Packages |
-| --------- | ------------ |
-| Debian/Ubuntu/Mint ... | `apt-get install git` |
-| Fedora/RHEL/CentOS ... | `yum install git gcc glibc-static` |
-| FreeBSD/OpenBSD/NetBSD | `pkg install git` |
-| Cygwin | use setup-x86[_x64] to add packages git, make and gcc-core |
-| Darwin | type 'git' at the command line and accept the prompt to install it. |
+#### 1. Install prerequisites
-More details, including for MingW and MS C, in [Installation](/doc/Installation.md).
+| Platform | Packages |
+| --------- | ------------ |
+| Debian/Ubuntu/Mint ... | `apt-get install git` |
+| Fedora/RHEL/CentOS ... | `yum install git gcc glibc-static` (`dnf` instead of `yum` on recent Fedoras) |
+| FreeBSD/OpenBSD/NetBSD | `pkg install git` |
+| OpenSUSE | `zypper install gcc git-core make glibc-devel-static` |
+| Cygwin | use setup-x86[_x64] to add packages git, make, diffutils and gcc-core |
+| Darwin | type 'git' at the command line and accept the prompt to install it. |
-###### Build and install
+More details, including for MingW and MS C, in [**Installation**](/doc/Installation.md).
+
+#### 2. Build and install the compiler and libraries
1. `git clone https://github.com/vishaps/voc`
2. `cd voc`
@@ -47,7 +51,7 @@ More details, including for MingW and MS C, in [Installation](/doc/Installation.
Since 'make full' will install the compiler and libraries, it needs root (unix) or administrator (windows) privileges.
-###### PATH environment variable
+#### 3. Set your PATH environment variable
Set your path to the installed compiler binary location as reported
by make full, e.g.
@@ -59,11 +63,12 @@ by make full, e.g.
| Windows | See [Installation](/doc/Installation.md) |
| Termux | `export PATH="/data/data/com.termux/files/opt/voc/bin:$PATH"` |
-Also see [Installation](/doc/Installation.md).
+Also see [**Installation**](/doc/Installation.md).
+
## A 'Hello' application
-Anything appended to Oberon.Log is automatically displayed on the console, so the
+Anything appended to Oberon.Log is automatically written to stdout, so the
following conventional Oberon program will display 'Hello.':
```Modula-2
@@ -77,13 +82,13 @@ BEGIN
END hello.
```
-Alternatively the Console may be accessed directly as follows:
+Alternatively the Oakwood module Out can be used to write directly to stdout:
```Modula-2
MODULE hello;
- IMPORT Console;
+ IMPORT Out;
BEGIN
- Console.String("Hello."); Console.Ln;
+ Out.String("Hello."); Out.Ln;
END hello.
```
@@ -97,12 +102,12 @@ executable binary.
Execute as usual on Linux ('./hello') or Windows ('hello').
-Also see [Compiling](/doc/Compiling.md).
+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 environment.
+under the FreeBSD License. Unlike Ofront, Vishap Oberon does not include the Oberon v4 GUI environment.
The Ulm Oberon Library and the Ooc libraries are distributed under GPL. Proprietry code
using these libraries may not be statically linked.
@@ -121,69 +126,68 @@ It compiles under gcc, clang and Microsoft Visual C.
Installation supports GNU/Linux, MAC OSX, BSD and Windows (native and cygwin).
A C program (src/tools/make/configure.c) detects the details of the C compiler
-and operating system on which it is running. In most cases it will automatically
-determine all that is needed for the port to a new platform. and 'make full'
-will just work.
+and operating system on which it is running.
-In some cases manual work will be required:
+The following systems are recognised:
- - If configure.c cannot recognise the operating system on which it is running
- a few lines will need to be added to detect and set the make variables
- correctly.
- - If porting to a system that does not provide a Unix style API, it will be
- necessary to implement a new variant of Platform.Mod providing the same
- interface as Platformunix.Mod and Platform Windows.Mod.
+ - Linux, including Ubuntu and Centos derivatives.
+ - The BSDs, including OpenBSD and FreeBSD.
+ - Cygwin under Windows, MingW under Cygwin, Bash on Ubuntu on Windows.
+
+Additionally a Windows .cmd is provided for building with Microsoft C.
+
+For details, including how to add support for unrecognised systems, see
+[**Porting**](/doc/Porting.md).
-For details, see [Porting](/doc/Porting.md).
## Language support and libraries
-Vishap Oberon supports the Oberon 2 programming language, including type-bound procedures.
+Vishap Oberon supports the Oberon 2 programming language, including type-bound procedures. SYSTEM.Mod includes additional functionality and some changes for 64 bit support.
-It also supports some features of Oberon-07.
+#### Integer and set type sizes:
-Vishap Oberon comes with libraries easing the porting of code from the major
-Oberon systems:
+| Type | -O2 option (default) | -OC option |
+| --- | --- | --- |
+| SHORTINT | 8 bit | 16 bit |
+| INTEGER | 16 bit | 32 bit |
+| LONGINT | 32 bit | 64 bit |
+| SET | 32 bit | 64 bit |
+
+#### Libraries
+
+Included libraries ease porting of code from the major Oberon systems:
- Oberon V4 and S3 compatible library set.
-
- - ooc (optimizing oberon-2 compiler) library port.
-
+ - Ooc (optimizing oberon-2 compiler) library port.
- Ulm’s Oberon system library port.
+ - Oakwood standard libraries.
+ - Some other freely redistributable libraries.
-Some other freely redistributable libraries are available as a part of voc distribution.
+Oakwood libraries are supported for both -O2 and -OC options, whereas the ULM, OOC and ETH system 3 libraries are only available on -O2 (default) compilations.
-See also [Features](/doc/Features.md).
-## History
+Vishap Oberon also supports some features of Oberon-07.
-See [History](/doc/History.md).
-## Roadmap
+See also [**Features**](/doc/Features.md).
-See [Roadmap](/doc/Roadmap.md).
## Contributors
-Originally developed as a cross platform implementation of the
-Oberon system by Joseph Templ.
+Joseph Templ developed ofront as a tool to translate Oberon-2 programs into semantically equivalent
+C programs. It was Copyrighted in 1995, and transferred to the Free BSD license in 2012.
-Updated for 64 bit support, refactored as a standalone compiler and brought
-to new platforms by Norayr Chilingarian.
+From Joseph's github repository:
-Build process simplified for more platform support and bugs fixed by David
-C W Brown.
+> Design and implementation of ofront is due to Josef Templ ... ofront has been based in part on Regis Crelier's PhD thesis and Stefan Gehring's diploma thesis, both at ETH Zurich, Institute for Computer Systems.
+
+Norayr Chilingarian forked ofront in 2013, porting extensive libraries from [ULM Oberon](http://www.mathematik.uni-ulm.de/oberon/), [OO2C](https://github.com/Spirit-of-Oberon/oo2c) and ETH Oberon System 3, and adding support for more platforms including 64 bit systems.
+
+David Brown has worked on adding support for more platforms incuding windows using MSC, cygwin or mingw since January 2016. More recently he has generalised basic type support within the compiler to allow e.g. 64 bit LONGINT on 32 bit systems, and 32 bit LONGINT on 64 bit systems.
## Origin of the name "Ѵishap Oberon"
-###### Ѵishap
-
-Vishaps are dragons inhabiting the Armenian Highlands.
-We decided to name the project “Vishap” because ties between compilers and dragons have ancient traditions.
-
-Also, Vishaps are known in tales, fiction. [This page](http://blog.fogus.me/2015/04/27/six-works-of-computer-science-fiction/) refers to some technologies as “computer science fiction”. Among them to Oberon. This brings another meaning, Oberon is like aliens, ghosts. And Vishaps.
-
-###### Oberon - System and Programming Language
+#### Oberon
Oberon is a programming language, an operating system and a graphical
user interface. Originally designed and implemented by by Niklaus Wirth and
@@ -202,6 +206,13 @@ of Einstein and Antoine de Saint-Exupéry:
> when there is no longer anything to take away. (Antoine de Saint-Exupéry,
> translated by Lewis Galantière.)
+#### Ѵishap
+
+Vishaps are dragons inhabiting the Armenian Highlands.
+We decided to name the project “Vishap” because ties between compilers and dragons have ancient traditions.
+
+Also, Vishaps are known in tales, fiction. [This page](http://blog.fogus.me/2015/04/27/six-works-of-computer-science-fiction/) refers to some technologies as “computer science fiction”. Among them to Oberon. This brings another meaning, Oberon is like aliens, ghosts. And Vishaps.
+
## References
###### Oberon
@@ -224,4 +235,6 @@ of Einstein and Antoine de Saint-Exupéry:
###### Links
- [Niklaus Wirth's personal page at ETH Zurich](https://www.inf.ethz.ch/personal/wirth/)
- [ETH Zurich's Wirth publications page](http://www.ethoberon.ethz.ch/WirthPubl/)
+ - [Joseph Templ's ofront on github](https://hithub.com/jtempl/ofront)
+ - [Software Templ OG](http://www.software-templ.com)
- [Oberon: Steps beyond Pascal and Modula](http://fruttenboel.verhoeven272.nl/Oberon/)
diff --git a/bootstrap/unix-88/SYSTEM.c b/bootstrap/SYSTEM.c
similarity index 66%
rename from bootstrap/unix-88/SYSTEM.c
rename to bootstrap/SYSTEM.c
index 33511a70..a1b2cb14 100644
--- a/bootstrap/unix-88/SYSTEM.c
+++ b/bootstrap/SYSTEM.c
@@ -18,13 +18,48 @@
#include
-LONGINT SYSTEM_XCHK(LONGINT i, LONGINT ub) {return __X(i, ub);}
-LONGINT SYSTEM_RCHK(LONGINT i, LONGINT ub) {return __R(i, ub);}
-LONGINT SYSTEM_ASH (LONGINT i, LONGINT n) {return __ASH(i, n);}
-LONGINT SYSTEM_ABS (LONGINT i) {return __ABS(i);}
-double SYSTEM_ABSD(double i) {return __ABS(i);}
+// Procedure verions of SYSTEM.H versions used when a multiply accessed
+// parameter has side effects.
-void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0)
+
+
+
+INT64 SYSTEM_DIV(INT64 x, INT64 y)
+{
+ if (x == 0) return 0;
+ if (x >= 0)
+ if (y >= 0) {return x/y;}
+ else {return -((x-y-1)/(-y));}
+ else
+ if (y >= 0) {return -((y-x-1)/y);}
+ else {return (-x)/(-y);}
+}
+
+INT64 SYSTEM_MOD(INT64 x, INT64 y)
+{
+ if (x == 0) return 0;
+ if (x >= 0)
+ if (y >= 0) {return x % y;}
+ else {return (y+1) + ((x-1) % (-y));}
+ else
+ if (y >= 0) {return (y-1) - ((-x-1) % y);}
+ else {return -((-x) % (-y));}
+}
+
+INT64 SYSTEM_ENTIER(double x)
+{
+ INT64 y;
+ if (x >= 0)
+ return (INT64)x;
+ else {
+ y = (INT64)x;
+ if (y <= x) return y; else return y - 1;
+ }
+}
+
+
+
+void SYSTEM_INHERIT(ADDRESS *t, ADDRESS *t0)
{
t -= __TPROC0OFF;
t0 -= __TPROC0OFF;
@@ -32,68 +67,44 @@ void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0)
}
-void SYSTEM_ENUMP(void *adr, LONGINT n, void (*P)())
+void SYSTEM_ENUMP(void *adr, ADDRESS n, void (*P)())
{
while (n > 0) {
- P((LONGINT)(SYSTEM_ADDRESS)(*((void**)(adr))));
+ P((ADDRESS)(*((void**)(adr))));
adr = ((void**)adr) + 1;
n--;
}
}
-void SYSTEM_ENUMR(void *adr, LONGINT *typ, LONGINT size, LONGINT n, void (*P)())
+void SYSTEM_ENUMR(void *adr, ADDRESS *typ, ADDRESS size, ADDRESS n, void (*P)())
{
- LONGINT *t, off;
+ ADDRESS *t, off;
typ++;
while (n > 0) {
t = typ;
off = *t;
- while (off >= 0) {P(*(LONGINT*)((char*)adr+off)); t++; off = *t;}
+ while (off >= 0) {P(*(ADDRESS*)((char*)adr+off)); t++; off = *t;}
adr = ((char*)adr) + size;
n--;
}
}
-LONGINT SYSTEM_DIV(U_LONGINT x, U_LONGINT y)
-{ if ((LONGINT) x >= 0) return (x / y);
- else return -((y - 1 - x) / y);
-}
-
-LONGINT SYSTEM_MOD(U_LONGINT x, U_LONGINT y)
-{ U_LONGINT m;
- if ((LONGINT) x >= 0) return (x % y);
- else { m = (-x) % y;
- if (m != 0) return (y - m); else return 0;
- }
-}
-
-LONGINT SYSTEM_ENTIER(double x)
-{
- LONGINT y;
- if (x >= 0)
- return (LONGINT)x;
- else {
- y = (LONGINT)x;
- if (y <= x) return y; else return y - 1;
- }
-}
-
extern void Heap_Lock();
extern void Heap_Unlock();
-SYSTEM_PTR SYSTEM_NEWARR(LONGINT *typ, LONGINT elemsz, int elemalgn, int nofdim, int nofdyn, ...)
+SYSTEM_PTR SYSTEM_NEWARR(ADDRESS *typ, ADDRESS elemsz, int elemalgn, int nofdim, int nofdyn, ...)
{
- LONGINT nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off;
+ ADDRESS nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off;
va_list ap;
va_start(ap, nofdyn);
nofelems = 1;
while (nofdim > 0) {
- nofelems = nofelems * va_arg(ap, LONGINT); nofdim--;
+ nofelems = nofelems * va_arg(ap, ADDRESS); nofdim--;
if (nofelems <= 0) __HALT(-20);
}
va_end(ap);
- dataoff = nofdyn * sizeof(LONGINT);
- if (elemalgn > sizeof(LONGINT)) {
+ dataoff = nofdyn * sizeof(ADDRESS);
+ if (elemalgn > sizeof(ADDRESS)) {
n = dataoff % elemalgn;
if (n != 0) dataoff += elemalgn - n;
}
@@ -103,37 +114,37 @@ SYSTEM_PTR SYSTEM_NEWARR(LONGINT *typ, LONGINT elemsz, int elemalgn, int nofdim,
/* element typ does not contain pointers */
x = Heap_NEWBLK(size);
}
- else if (typ == (LONGINT*)POINTER__typ) {
+ else if (typ == (ADDRESS*)POINTER__typ) {
/* element type is a pointer */
- x = Heap_NEWBLK(size + nofelems * sizeof(LONGINT));
- p = (LONGINT*)(SYSTEM_ADDRESS)x[-1];
+ x = Heap_NEWBLK(size + nofelems * sizeof(ADDRESS));
+ p = (ADDRESS*)(ADDRESS)x[-1];
p[-nofelems] = *p; /* build new type desc in situ: 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */
p -= nofelems - 1; n = 1; /* n =1 for skipping the size field */
- while (n <= nofelems) {*p = n*sizeof(LONGINT); p++; n++;}
- *p = - (nofelems + 1) * sizeof(LONGINT); /* sentinel */
- x[-1] -= nofelems * sizeof(LONGINT);
+ while (n <= nofelems) {*p = n*sizeof(ADDRESS); p++; n++;}
+ *p = - (nofelems + 1) * sizeof(ADDRESS); /* sentinel */
+ x[-1] -= nofelems * sizeof(ADDRESS);
}
else {
/* element type is a record that contains pointers */
ptab = typ + 1; nofptrs = 0;
while (ptab[nofptrs] >= 0) {nofptrs++;} /* number of pointers per element */
nptr = nofelems * nofptrs; /* total number of pointers */
- x = Heap_NEWBLK(size + nptr * sizeof(LONGINT));
- p = (LONGINT*)(SYSTEM_ADDRESS)x[- 1];
+ x = Heap_NEWBLK(size + nptr * sizeof(ADDRESS));
+ p = (ADDRESS*)(ADDRESS)x[- 1];
p[-nptr] = *p; /* build new type desc in situ; 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */
p -= nptr - 1; n = 0; off = dataoff;
while (n < nofelems) {i = 0;
while (i < nofptrs) {*p = off + ptab[i]; p++; i++;}
off += elemsz; n++;
}
- *p = - (nptr + 1) * sizeof(LONGINT); /* sentinel */
- x[-1] -= nptr * sizeof(LONGINT);
+ *p = - (nptr + 1) * sizeof(ADDRESS); /* sentinel */
+ x[-1] -= nptr * sizeof(ADDRESS);
}
if (nofdyn != 0) {
/* setup len vector for index checks */
va_start(ap, nofdyn);
p = x;
- while (nofdyn > 0) {*p = va_arg(ap, LONGINT); p++, nofdyn--;}
+ while (nofdyn > 0) {*p = va_arg(ap, ADDRESS); p++, nofdyn--;}
va_end(ap);
}
Heap_Unlock();
@@ -143,7 +154,7 @@ SYSTEM_PTR SYSTEM_NEWARR(LONGINT *typ, LONGINT elemsz, int elemalgn, int nofdim,
-typedef void (*SystemSignalHandler)(INTEGER); // = Platform_SignalHandler
+typedef void (*SystemSignalHandler)(INT32); // = Platform_SignalHandler
#ifndef _WIN32
@@ -155,7 +166,7 @@ typedef void (*SystemSignalHandler)(INTEGER); // = Platform_SignalHandler
// (Ignore other signals)
}
- void SystemSetHandler(int s, SYSTEM_ADDRESS h) {
+ void SystemSetHandler(int s, ADDRESS h) {
if (s >= 2 && s <= 4) {
int needtosetsystemhandler = handler[s-2] == 0;
handler[s-2] = (SystemSignalHandler)h;
@@ -194,12 +205,12 @@ typedef void (*SystemSignalHandler)(INTEGER); // = Platform_SignalHandler
}
}
- void SystemSetInterruptHandler(SYSTEM_ADDRESS h) {
+ void SystemSetInterruptHandler(ADDRESS h) {
EnsureConsoleCtrlHandler();
SystemInterruptHandler = (SystemSignalHandler)h;
}
- void SystemSetQuitHandler(SYSTEM_ADDRESS h) {
+ void SystemSetQuitHandler(ADDRESS h) {
EnsureConsoleCtrlHandler();
SystemQuitHandler = (SystemSignalHandler)h;
}
diff --git a/bootstrap/SYSTEM.h b/bootstrap/SYSTEM.h
new file mode 100644
index 00000000..43baa836
--- /dev/null
+++ b/bootstrap/SYSTEM.h
@@ -0,0 +1,326 @@
+#ifndef SYSTEM__h
+#define SYSTEM__h
+
+
+// 64 bit system detection
+
+#if (__SIZEOF_POINTER__ == 8) || defined (_LP64) || defined(__LP64__) || defined(_WIN64)
+ #define o__64
+#endif
+
+
+// Declare memcpy in a way compatible with C compilers intrinsic
+// built in implementations.
+
+#if defined (o__64)
+ #if defined(_WIN64)
+ typedef unsigned long long size_t;
+ #else
+ typedef unsigned long size_t;
+ #endif
+#else
+ typedef unsigned int size_t;
+#endif
+
+#define _SIZE_T_DECLARED // For FreeBSD
+#define _SIZE_T_DEFINED_ // For OpenBSD
+
+void *memcpy(void *dest, const void *source, size_t size);
+#if defined _MSC_VER
+#define alloca _alloca
+#endif
+void *alloca(size_t size);
+
+
+// Declare fixed size versions of basic intger types
+
+#if defined (o__64) && !defined(_WIN64)
+ // LP64
+ typedef long INT64;
+ typedef unsigned long UINT64;
+#else
+ // ILP32 or LLP64
+ typedef long long INT64;
+ typedef unsigned long long UINT64;
+#endif
+
+typedef int INT32;
+typedef unsigned int UINT32;
+
+typedef short int INT16;
+typedef unsigned short int UINT16;
+
+typedef signed char INT8;
+typedef unsigned char UINT8;
+
+
+// The compiler uses 'import' and 'export' which translate to 'extern' and
+// nothing respectively.
+
+#define import extern
+#define export
+
+
+
+// Known constants
+
+#define NIL ((void*)0)
+#define __MAXEXT 16
+#define POINTER__typ ((ADDRESS*)(1)) // not NIL and not a valid type
+
+
+// Oberon types
+
+typedef INT8 BOOLEAN;
+typedef INT8 SYSTEM_BYTE;
+typedef UINT8 CHAR;
+typedef float REAL;
+typedef double LONGREAL;
+typedef void* SYSTEM_PTR;
+
+
+
+// 'ADDRESS' is a synonym for an integer of pointer size
+
+#if defined (o__64)
+ #define ADDRESS INT64
+#else
+ #define ADDRESS INT32
+#endif
+
+
+
+// ----------------------------------------------------------------------
+// ----------------------------------------------------------------------
+
+
+
+// OS Memory allocation interfaces are in PlatformXXX.Mod
+
+extern ADDRESS Platform_OSAllocate (ADDRESS size);
+extern void Platform_OSFree (ADDRESS addr);
+
+
+// Assertions and Halts
+
+extern void Modules_Halt(INT32 x);
+extern void Modules_AssertFail(INT32 x);
+
+#define __HALT(x) Modules_Halt((INT32)(x))
+#define __ASSERT(cond, x) if (!(cond)) Modules_AssertFail((INT32)(x))
+
+
+// Index checking
+
+static inline INT64 __XF(UINT64 i, UINT64 ub) {if (i >= ub) {__HALT(-2);} return i;}
+#define __X(i, ub) (((i)<(ub))?i:(__HALT(-2),0))
+
+
+// Range checking, and checked SHORT and CHR functions
+
+static inline INT64 __RF(UINT64 i, UINT64 ub) {if (i >= ub) {__HALT(-8);} return i;}
+#define __R(i, ub) (((i)<(ub))?i:(__HALT(-8),0))
+#define __SHORT(x, ub) ((int)((UINT64)(x)+(ub)<(ub)+(ub)?(x):(__HALT(-8),0)))
+#define __SHORTF(x, ub) ((int)(__RF((x)+(ub),(ub)+(ub))-(ub)))
+#define __CHR(x) ((CHAR)__R(x, 256))
+#define __CHRF(x) ((CHAR)__RF(x, 256))
+
+
+
+// Signal handling in SYSTEM.c
+
+#ifndef _WIN32
+ extern void SystemSetHandler(int s, ADDRESS h);
+#else
+ extern void SystemSetInterruptHandler(ADDRESS h);
+ extern void SystemSetQuitHandler (ADDRESS h);
+#endif
+
+
+
+// String comparison
+
+static inline int __str_cmp(CHAR *x, CHAR *y){
+ INT64 i = 0;
+ CHAR ch1, ch2;
+ do {ch1 = x[i]; ch2 = y[i]; i++;
+ if (!ch1) return -(int)ch2;
+ } while (ch1==ch2);
+ return (int)ch1 - (int)ch2;
+}
+#define __STRCMP(a,b) __str_cmp((CHAR*)(a), (CHAR*)(b))
+
+
+
+// Inline string, record and array copy
+
+#define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d; LONGINT _i=0,_t=n-1; \
+ while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;}
+#define __DUPARR(v, t) v=(void*)memcpy(v##__copy,v,sizeof(t))
+#define __DUP(x, l, t) x=(void*)memcpy(alloca(l*sizeof(t)),x,l*sizeof(t))
+#define __DEL(x)
+
+
+/* SYSTEM ops */
+
+#define __VAL(t, x) (*(t*)&(x))
+
+#define __GET(a, x, t) x=*(t*)(ADDRESS)(a)
+#define __PUT(a, x, t) *(t*)(ADDRESS)(a)=x
+
+#define __LSHL(x, n, s) ((INT##s)((UINT##s)(x)<<(n)))
+#define __LSHR(x, n, s) ((INT##s)((UINT##s)(x)>>(n)))
+#define __LSH(x, n, s) ((n)>=0? __LSHL(x, n, s): __LSHR(x, -(n), s))
+
+#define __ROTL(x, n, s) ((INT##s)((UINT##s)(x)<<(n)|(UINT##s)(x)>>(s-(n))))
+#define __ROTR(x, n, s) ((INT##s)((UINT##s)(x)>>(n)|(UINT##s)(x)<<(s-(n))))
+#define __ROT(x, n, s) ((n)>=0? __ROTL(x, n, s): __ROTR(x, -(n), s))
+
+#define __ASHL(x, n) ((INT64)(x)<<(n))
+#define __ASHR(x, n) ((INT64)(x)>>(n))
+#define __ASH(x, n) ((n)>=0?__ASHL(x,n):__ASHR(x,-(n)))
+static inline INT64 SYSTEM_ASH(INT64 x, INT64 n) {return __ASH(x,n);}
+#define __ASHF(x, n) SYSTEM_ASH((INT64)(x), (INT64)(n))
+
+#define __MOVE(s, d, n) memcpy((char*)(ADDRESS)(d),(char*)(ADDRESS)(s),n)
+
+
+extern INT64 SYSTEM_DIV(INT64 x, INT64 y);
+#define __DIVF(x, y) SYSTEM_DIV(x, y)
+#define __DIV(x, y) (((x)>0 && (y)>0) ? (x)/(y) : __DIVF(x, y))
+
+
+extern INT64 SYSTEM_MOD(INT64 x, INT64 y);
+#define __MODF(x, y) SYSTEM_MOD(x, y)
+#define __MOD(x, y) (((x)>0 && (y)>0) ? (x)%(y) : __MODF(x, y))
+
+
+extern INT64 SYSTEM_ENTIER (double x);
+#define __ENTIER(x) SYSTEM_ENTIER(x)
+
+
+#define __ABS(x) (((x)<0)?-(x):(x))
+
+static inline INT32 SYSTEM_ABS64(INT64 i) {return i >= 0 ? i : -i;}
+static inline INT64 SYSTEM_ABS32(INT32 i) {return i >= 0 ? i : -i;}
+#define __ABSF(x) ((sizeof(x) <= 4) ? SYSTEM_ABS32(x) : SYSTEM_ABS64(x))
+
+static inline double SYSTEM_ABSD(double i) {return i >= 0.0 ? i : -i;}
+#define __ABSFD(x) SYSTEM_ABSD(x)
+
+#define __CAP(ch) ((CHAR)((ch)&0x5f))
+#define __ODD(x) ((x)&1)
+
+#define __IN(x, s, size) (((unsigned int)(x))>(x))&1))
+// todo tested versions of SETOF and SETRNG: check that x, l and h fit size
+#define __SETOF(x, size) ((UINT##size)1<<(x))
+#define __SETRNG(l, h, size) ((~(UINT##size)0<<(l))&~(UINT##size)0>>(size-1-(h)))
+
+#define __MASK(x, m) ((x)&~(m))
+#define __BIT(x, n) (*(UINT64*)(x)>>(n)&1)
+
+
+
+// Runtime checks
+
+#define __RETCHK __retchk: __HALT(-3); return 0;
+#define __CASECHK __HALT(-4)
+#define __WITHCHK __HALT(-7)
+
+
+#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(ADDRESS)typ##__typ)
+#define __TYPEOF(p) (*(((ADDRESS**)(p))-1))
+#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level)
+
+
+#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p)))
+#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r))))
+#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p)))
+#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p)
+#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p)
+
+
+
+// Module entry/registration/exit
+
+extern void Heap_REGCMD();
+extern SYSTEM_PTR Heap_REGMOD();
+extern void Heap_REGTYP();
+extern void Heap_INCREF();
+
+#define __DEFMOD static void *m; if (m!=0) {return m;}
+#define __REGCMD(name, cmd) Heap_REGCMD(m, (CHAR*)name, cmd)
+#define __REGMOD(name, enum) if (m==0) {m = Heap_REGMOD((CHAR*)name,enum);}
+#define __ENDMOD return m
+#define __MODULE_IMPORT(name) Heap_INCREF(name##__init())
+
+
+
+// Main module initialisation, registration and finalisation
+
+extern void Platform_Init(INT32 argc, ADDRESS argv);
+extern void Heap_FINALL();
+
+#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
+
+
+// Memory allocation
+
+extern SYSTEM_PTR Heap_NEWBLK (ADDRESS size);
+extern SYSTEM_PTR Heap_NEWREC (ADDRESS tag);
+extern SYSTEM_PTR SYSTEM_NEWARR(ADDRESS*, ADDRESS, int, int, int, ...);
+
+#define __SYSNEW(p, len) p = Heap_NEWBLK((ADDRESS)(len))
+#define __NEW(p, t) p = Heap_NEWREC((ADDRESS)t##__typ)
+#define __NEWARR SYSTEM_NEWARR
+
+
+
+/* Type handling */
+
+extern void SYSTEM_INHERIT(ADDRESS *t, ADDRESS *t0);
+extern void SYSTEM_ENUMP (void *adr, ADDRESS n, void (*P)());
+extern void SYSTEM_ENUMR (void *adr, ADDRESS *typ, ADDRESS size, ADDRESS n, void (*P)());
+
+
+#define __TDESC(t, m, n) \
+ static struct t##__desc { \
+ ADDRESS tproc[m]; /* Proc for each ptr field */ \
+ ADDRESS tag; \
+ ADDRESS next; /* Module table type list points here */ \
+ ADDRESS level; \
+ ADDRESS module; \
+ char name[24]; \
+ ADDRESS basep[__MAXEXT]; /* List of bases this extends */ \
+ ADDRESS reserved; \
+ ADDRESS blksz; /* xxx_typ points here */ \
+ ADDRESS ptr[n+1]; /* Offsets of ptrs up to -ve sentinel */ \
+ } t##__desc
+
+#define __BASEOFF (__MAXEXT+1) // blksz as index to base.
+#define __TPROC0OFF (__BASEOFF+24/sizeof(ADDRESS)+5) // blksz as index to tproc IFF m=1.
+#define __EOM 1
+#define __TDFLDS(name, size) {__EOM}, 1, 0, 0, 0, name, {0}, 0, size
+#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (ADDRESS)(n), P)
+#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (ADDRESS)(size), (ADDRESS)(n), P)
+
+#define __INITYP(t, t0, level) \
+ t##__typ = (ADDRESS*)&t##__desc.blksz; \
+ memcpy(t##__desc.basep, t0##__typ - __BASEOFF, level*sizeof(ADDRESS)); \
+ t##__desc.basep[level] = (ADDRESS)t##__typ; \
+ t##__desc.module = (ADDRESS)m; \
+ if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \
+ t##__desc.blksz = (t##__desc.blksz+5*sizeof(ADDRESS)-1)/(4*sizeof(ADDRESS))*(4*sizeof(ADDRESS)); \
+ Heap_REGTYP(m, (ADDRESS)&t##__desc.next); \
+ SYSTEM_INHERIT(t##__typ, t0##__typ)
+
+// Oberon-2 type bound procedures support
+#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(ADDRESS)proc
+#define __SEND(typ, num, funtyp, parlist) ((funtyp)((ADDRESS)*(typ-(__TPROC0OFF+num))))parlist
+
+
+
+
+#endif
diff --git a/bootstrap/unix-44/WindowsWrapper.h b/bootstrap/WindowsWrapper.h
similarity index 100%
rename from bootstrap/unix-44/WindowsWrapper.h
rename to bootstrap/WindowsWrapper.h
diff --git a/bootstrap/unix-44/Compiler.c b/bootstrap/unix-44/Compiler.c
new file mode 100644
index 00000000..dc4bb660
--- /dev/null
+++ b/bootstrap/unix-44/Compiler.c
@@ -0,0 +1,184 @@
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspamS */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
+#include "SYSTEM.h"
+#include "Configuration.h"
+#include "Heap.h"
+#include "OPB.h"
+#include "OPC.h"
+#include "OPM.h"
+#include "OPP.h"
+#include "OPT.h"
+#include "OPV.h"
+#include "Platform.h"
+#include "Strings.h"
+#include "VT100.h"
+#include "extTools.h"
+
+
+static CHAR Compiler_mname[256];
+
+
+export void Compiler_Module (BOOLEAN *done);
+static void Compiler_PropagateElementaryTypeSizes (void);
+export void Compiler_Translate (void);
+static void Compiler_Trap (INT32 sig);
+
+
+void Compiler_Module (BOOLEAN *done)
+{
+ BOOLEAN ext, new;
+ OPT_Node p = NIL;
+ OPP_Module(&p, OPM_Options);
+ if (OPM_noerr) {
+ OPV_Init();
+ OPT_InitRecno();
+ OPV_AdrAndSize(OPT_topScope);
+ OPT_Export(&ext, &new);
+ if (OPM_noerr) {
+ OPM_OpenFiles((void*)OPT_SelfName, 256);
+ OPC_Init();
+ OPV_Module(p);
+ if (OPM_noerr) {
+ if ((__IN(10, OPM_Options, 32) && __STRCMP(OPM_modName, "SYSTEM") != 0)) {
+ OPM_DeleteNewSym();
+ OPM_LogVT100((CHAR*)"32m", 4);
+ OPM_LogWStr((CHAR*)" Main program.", 16);
+ OPM_LogVT100((CHAR*)"0m", 3);
+ } else {
+ if (new) {
+ OPM_LogVT100((CHAR*)"32m", 4);
+ OPM_LogWStr((CHAR*)" New symbol file.", 19);
+ OPM_LogVT100((CHAR*)"0m", 3);
+ OPM_RegisterNewSym();
+ } else if (ext) {
+ OPM_LogWStr((CHAR*)" Extended symbol file.", 24);
+ OPM_RegisterNewSym();
+ }
+ }
+ } else {
+ OPM_DeleteNewSym();
+ }
+ }
+ }
+ OPM_CloseFiles();
+ OPT_Close();
+ OPM_LogWLn();
+ *done = OPM_noerr;
+}
+
+static void Compiler_PropagateElementaryTypeSizes (void)
+{
+ OPT_Struct adrinttyp = NIL;
+ OPT_sysptrtyp->size = OPM_AddressSize;
+ OPT_sysptrtyp->idfp = OPT_sysptrtyp->form;
+ OPM_FPrint(&OPT_sysptrtyp->idfp, OPT_sysptrtyp->size);
+ OPT_adrtyp->size = OPM_AddressSize;
+ OPT_adrtyp->idfp = OPT_adrtyp->form;
+ OPM_FPrint(&OPT_adrtyp->idfp, OPT_adrtyp->size);
+ adrinttyp = OPT_IntType(OPM_AddressSize);
+ OPT_adrtyp->strobj = adrinttyp->strobj;
+ OPT_sinttyp = OPT_IntType(OPM_ShortintSize);
+ OPT_inttyp = OPT_IntType(OPM_IntegerSize);
+ OPT_linttyp = OPT_IntType(OPM_LongintSize);
+ OPT_sintobj->typ = OPT_sinttyp;
+ OPT_intobj->typ = OPT_inttyp;
+ OPT_lintobj->typ = OPT_linttyp;
+ switch (OPM_LongintSize) {
+ case 4:
+ OPT_settyp = OPT_set32typ;
+ break;
+ default:
+ OPT_settyp = OPT_set64typ;
+ break;
+ }
+ OPT_setobj->typ = OPT_settyp;
+ if (__STRCMP(OPM_Model, "C") == 0) {
+ OPT_cpbytetyp->strobj->name[4] = 0x00;
+ } else {
+ OPT_cpbytetyp->strobj->name[4] = '@';
+ }
+}
+
+void Compiler_Translate (void)
+{
+ BOOLEAN done;
+ CHAR modulesobj[2048];
+ modulesobj[0] = 0x00;
+ if (OPM_OpenPar()) {
+ for (;;) {
+ OPM_Init(&done, (void*)Compiler_mname, 256);
+ if (!done) {
+ return;
+ }
+ OPM_InitOptions();
+ Compiler_PropagateElementaryTypeSizes();
+ Heap_GC(0);
+ Compiler_Module(&done);
+ if (!done) {
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Module compilation failed.", 27);
+ OPM_LogWLn();
+ Platform_Exit(1);
+ }
+ if (!__IN(13, OPM_Options, 32)) {
+ if (__IN(14, OPM_Options, 32)) {
+ extTools_Assemble(OPM_modName, 32);
+ } else {
+ if (!__IN(10, OPM_Options, 32)) {
+ extTools_Assemble(OPM_modName, 32);
+ Strings_Append((CHAR*)" ", 2, (void*)modulesobj, 2048);
+ Strings_Append(OPM_modName, 32, (void*)modulesobj, 2048);
+ Strings_Append((CHAR*)".o", 3, (void*)modulesobj, 2048);
+ } else {
+ extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), modulesobj, 2048);
+ }
+ }
+ }
+ }
+ }
+}
+
+static void Compiler_Trap (INT32 sig)
+{
+ Heap_FINALL();
+ if (sig == 3) {
+ Platform_Exit(0);
+ } else {
+ if (sig == 4) {
+ OPM_LogWStr((CHAR*)" --- Oberon compiler internal error", 36);
+ OPM_LogWLn();
+ }
+ Platform_Exit(2);
+ }
+}
+
+
+export int main(int argc, char **argv)
+{
+ __INIT(argc, argv);
+ __MODULE_IMPORT(Configuration);
+ __MODULE_IMPORT(Heap);
+ __MODULE_IMPORT(OPB);
+ __MODULE_IMPORT(OPC);
+ __MODULE_IMPORT(OPM);
+ __MODULE_IMPORT(OPP);
+ __MODULE_IMPORT(OPT);
+ __MODULE_IMPORT(OPV);
+ __MODULE_IMPORT(Platform);
+ __MODULE_IMPORT(Strings);
+ __MODULE_IMPORT(VT100);
+ __MODULE_IMPORT(extTools);
+ __REGMAIN("Compiler", 0);
+ __REGCMD("Translate", Compiler_Translate);
+/* BEGIN */
+ Platform_SetInterruptHandler(Compiler_Trap);
+ Platform_SetQuitHandler(Compiler_Trap);
+ Platform_SetBadInstructionHandler(Compiler_Trap);
+ Compiler_Translate();
+ __FINI;
+}
diff --git a/bootstrap/unix-44/Configuration.c b/bootstrap/unix-44/Configuration.c
index 821dff97..2d0061df 100644
--- a/bootstrap/unix-44/Configuration.c
+++ b/bootstrap/unix-44/Configuration.c
@@ -1,8 +1,14 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
-export CHAR Configuration_versionLong[41];
+export CHAR Configuration_versionLong[75];
@@ -13,6 +19,6 @@ export void *Configuration__init(void)
__DEFMOD;
__REGMOD("Configuration", 0);
/* BEGIN */
- __MOVE("1.95 [2016/08/23] for gcc LP64 on cygwin", Configuration_versionLong, 41);
+ __MOVE("1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75);
__ENDMOD;
}
diff --git a/bootstrap/unix-44/Configuration.h b/bootstrap/unix-44/Configuration.h
index ec5e865a..b28e0caa 100644
--- a/bootstrap/unix-44/Configuration.h
+++ b/bootstrap/unix-44/Configuration.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Configuration__h
#define Configuration__h
@@ -6,10 +6,10 @@
#include "SYSTEM.h"
-import CHAR Configuration_versionLong[41];
+import CHAR Configuration_versionLong[75];
import void *Configuration__init(void);
-#endif
+#endif // Configuration
diff --git a/bootstrap/unix-44/Console.c b/bootstrap/unix-44/Console.c
deleted file mode 100644
index f9161937..00000000
--- a/bootstrap/unix-44/Console.c
+++ /dev/null
@@ -1,150 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#include "SYSTEM.h"
-#include "Platform.h"
-
-
-static CHAR Console_line[128];
-static INTEGER Console_pos;
-
-
-export void Console_Bool (BOOLEAN b);
-export void Console_Char (CHAR ch);
-export void Console_Flush (void);
-export void Console_Hex (LONGINT i);
-export void Console_Int (LONGINT i, LONGINT n);
-export void Console_Ln (void);
-export void Console_Read (CHAR *ch);
-export void Console_ReadLine (CHAR *line, LONGINT line__len);
-export void Console_String (CHAR *s, LONGINT s__len);
-
-
-void Console_Flush (void)
-{
- INTEGER error;
- error = Platform_Write(((LONGINT)(1)), (LONGINT)(SYSTEM_ADDRESS)Console_line, Console_pos);
- Console_pos = 0;
-}
-
-void Console_Char (CHAR ch)
-{
- if (Console_pos == 128) {
- Console_Flush();
- }
- Console_line[__X(Console_pos, ((LONGINT)(128)))] = ch;
- Console_pos += 1;
- if (ch == 0x0a) {
- Console_Flush();
- }
-}
-
-void Console_String (CHAR *s, LONGINT s__len)
-{
- INTEGER i;
- __DUP(s, s__len, CHAR);
- i = 0;
- while (s[__X(i, s__len)] != 0x00) {
- Console_Char(s[__X(i, s__len)]);
- i += 1;
- }
- __DEL(s);
-}
-
-void Console_Int (LONGINT i, LONGINT n)
-{
- CHAR s[32];
- LONGINT i1, k;
- if (i == __LSHL(1, 31, LONGINT)) {
- __MOVE("8463847412", s, 11);
- k = 10;
- } else {
- i1 = __ABS(i);
- s[0] = (CHAR)(__MOD(i1, 10) + 48);
- i1 = __DIV(i1, 10);
- k = 1;
- while (i1 > 0) {
- s[__X(k, ((LONGINT)(32)))] = (CHAR)(__MOD(i1, 10) + 48);
- i1 = __DIV(i1, 10);
- k += 1;
- }
- }
- if (i < 0) {
- s[__X(k, ((LONGINT)(32)))] = '-';
- k += 1;
- }
- while (n > k) {
- Console_Char(' ');
- n -= 1;
- }
- while (k > 0) {
- k -= 1;
- Console_Char(s[__X(k, ((LONGINT)(32)))]);
- }
-}
-
-void Console_Ln (void)
-{
- Console_Char(0x0a);
-}
-
-void Console_Bool (BOOLEAN b)
-{
- if (b) {
- Console_String((CHAR*)"TRUE", (LONGINT)5);
- } else {
- Console_String((CHAR*)"FALSE", (LONGINT)6);
- }
-}
-
-void Console_Hex (LONGINT i)
-{
- LONGINT k, n;
- k = -28;
- while (k <= 0) {
- n = __MASK(__ASH(i, k), -16);
- if (n <= 9) {
- Console_Char((CHAR)(48 + n));
- } else {
- Console_Char((CHAR)(55 + n));
- }
- k += 4;
- }
-}
-
-void Console_Read (CHAR *ch)
-{
- LONGINT n;
- INTEGER error;
- Console_Flush();
- error = Platform_ReadBuf(((LONGINT)(0)), (void*)&*ch, ((LONGINT)(1)), &n);
- if (n != 1) {
- *ch = 0x00;
- }
-}
-
-void Console_ReadLine (CHAR *line, LONGINT line__len)
-{
- LONGINT i;
- CHAR ch;
- Console_Flush();
- i = 0;
- Console_Read(&ch);
- while ((((i < line__len - 1 && ch != 0x0a)) && ch != 0x00)) {
- line[__X(i, line__len)] = ch;
- i += 1;
- Console_Read(&ch);
- }
- line[__X(i, line__len)] = 0x00;
-}
-
-
-export void *Console__init(void)
-{
- __DEFMOD;
- __MODULE_IMPORT(Platform);
- __REGMOD("Console", 0);
- __REGCMD("Flush", Console_Flush);
- __REGCMD("Ln", Console_Ln);
-/* BEGIN */
- Console_pos = 0;
- __ENDMOD;
-}
diff --git a/bootstrap/unix-44/Console.h b/bootstrap/unix-44/Console.h
deleted file mode 100644
index 5fdd4e4d..00000000
--- a/bootstrap/unix-44/Console.h
+++ /dev/null
@@ -1,23 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-
-#ifndef Console__h
-#define Console__h
-
-#include "SYSTEM.h"
-
-
-
-
-import void Console_Bool (BOOLEAN b);
-import void Console_Char (CHAR ch);
-import void Console_Flush (void);
-import void Console_Hex (LONGINT i);
-import void Console_Int (LONGINT i, LONGINT n);
-import void Console_Ln (void);
-import void Console_Read (CHAR *ch);
-import void Console_ReadLine (CHAR *line, LONGINT line__len);
-import void Console_String (CHAR *s, LONGINT s__len);
-import void *Console__init(void);
-
-
-#endif
diff --git a/bootstrap/unix-44/Files.c b/bootstrap/unix-44/Files.c
index 5a1dd875..548774b0 100644
--- a/bootstrap/unix-44/Files.c
+++ b/bootstrap/unix-44/Files.c
@@ -1,8 +1,13 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
-#include "Configuration.h"
-#include "Console.h"
#include "Heap.h"
+#include "Out.h"
#include "Platform.h"
#include "Strings.h"
@@ -13,7 +18,7 @@ typedef
struct Files_BufDesc {
Files_File f;
BOOLEAN chg;
- LONGINT org, size;
+ INT32 org, size;
SYSTEM_BYTE data[4096];
} Files_BufDesc;
@@ -28,114 +33,114 @@ typedef
Files_FileName workName, registerName;
BOOLEAN tempFile;
Platform_FileIdentity identity;
- LONGINT fd, len, pos;
+ INT32 fd, len, pos;
Files_Buffer bufs[4];
- INTEGER swapper, state;
+ INT16 swapper, state;
Files_File next;
} Files_FileDesc;
typedef
struct Files_Rider {
- LONGINT res;
+ INT32 res;
BOOLEAN eof;
Files_Buffer buf;
- LONGINT org, offset;
+ INT32 org, offset;
} Files_Rider;
static Files_File Files_files;
-static INTEGER Files_tempno;
+static INT16 Files_tempno;
static CHAR Files_HOME[1024];
static struct {
LONGINT len[1];
CHAR data[1];
} *Files_SearchPath;
-export LONGINT *Files_FileDesc__typ;
-export LONGINT *Files_BufDesc__typ;
-export LONGINT *Files_Rider__typ;
+export ADDRESS *Files_FileDesc__typ;
+export ADDRESS *Files_BufDesc__typ;
+export ADDRESS *Files_Rider__typ;
-export Files_File Files_Base (Files_Rider *r, LONGINT *r__typ);
+export Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
static Files_File Files_CacheEntry (Platform_FileIdentity identity);
-export void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *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, LONGINT name__len, INTEGER *res);
-static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INTEGER 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, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len);
static void Files_Flush (Files_Buffer buf);
-export void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d);
+export void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
export void Files_GetName (Files_File f, CHAR *name, LONGINT name__len);
static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len);
static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len);
-export LONGINT Files_Length (Files_File f);
+export INT32 Files_Length (Files_File f);
static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len);
export Files_File Files_New (CHAR *name, LONGINT name__len);
export Files_File Files_Old (CHAR *name, LONGINT name__len);
-export LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ);
+export INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ);
export void Files_Purge (Files_File f);
-export void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x);
-export void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x);
-export void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len);
-export void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n);
-export void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x);
-export void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x);
-export void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x);
-export void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
-export void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x);
-export void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x);
-export void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x);
-export void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
+export void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
+export void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x);
+export void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+export void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x);
+export void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x);
+export void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
+export void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+export void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
+export void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
+export void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
+export void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
export void Files_Register (Files_File f);
-export void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res);
-static void Files_ScanPath (INTEGER *pos, CHAR *dir, LONGINT dir__len);
-export void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos);
+export void Files_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, LONGINT path__len);
-export void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x);
-export void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x);
-export void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n);
-export void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x);
-export void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x);
-export void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x);
-export void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x);
-export void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x);
-export void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x);
-export void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
+export void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
+export void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
+export void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+export void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
+export void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
+export void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
+export void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
+export void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
+export void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
+export void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
#define Files_IdxTrap() __HALT(-1)
+#define Files_ToAdr(x) (ADDRESS)x
-static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INTEGER errcode)
+static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
{
__DUP(s, s__len, CHAR);
- Console_Ln();
- Console_String((CHAR*)"-- ", (LONGINT)4);
- Console_String(s, s__len);
- Console_String((CHAR*)": ", (LONGINT)3);
+ Out_Ln();
+ Out_String((CHAR*)"-- ", 4);
+ Out_String(s, s__len);
+ Out_String((CHAR*)": ", 3);
if (f != NIL) {
if (f->registerName[0] != 0x00) {
- Console_String(f->registerName, ((LONGINT)(101)));
+ Out_String(f->registerName, 101);
} else {
- Console_String(f->workName, ((LONGINT)(101)));
+ Out_String(f->workName, 101);
}
if (f->fd != 0) {
- Console_String((CHAR*)"f.fd = ", (LONGINT)8);
- Console_Int(f->fd, ((LONGINT)(1)));
+ Out_String((CHAR*)"f.fd = ", 8);
+ Out_Int(f->fd, 1);
}
}
if (errcode != 0) {
- Console_String((CHAR*)" errcode = ", (LONGINT)12);
- Console_Int(errcode, ((LONGINT)(1)));
+ Out_String((CHAR*)" errcode = ", 12);
+ Out_Int(errcode, 1);
}
- Console_Ln();
+ Out_Ln();
__HALT(99);
__DEL(s);
}
static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len)
{
- INTEGER i, j;
+ INT16 i, j;
__DUP(dir, dir__len, CHAR);
__DUP(name, name__len, CHAR);
i = 0;
@@ -160,7 +165,7 @@ static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT
static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len)
{
- LONGINT n, i, j;
+ INT32 n, i, j;
__DUP(finalName, finalName__len, CHAR);
Files_tempno += 1;
n = Files_tempno;
@@ -192,7 +197,7 @@ static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *na
name[i + 5] = '.';
i += 6;
while (n > 0) {
- name[i] = (CHAR)(__MOD(n, 10) + 48);
+ name[i] = (CHAR)((int)__MOD(n, 10) + 48);
n = __DIV(n, 10);
i += 1;
}
@@ -200,7 +205,7 @@ static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *na
i += 1;
n = Platform_PID;
while (n > 0) {
- name[i] = (CHAR)(__MOD(n, 10) + 48);
+ name[i] = (CHAR)((int)__MOD(n, 10) + 48);
n = __DIV(n, 10);
i += 1;
}
@@ -212,19 +217,19 @@ static void Files_Create (Files_File f)
{
Platform_FileIdentity identity;
BOOLEAN done;
- INTEGER error;
+ INT16 error;
CHAR err[32];
if (f->fd == -1) {
if (f->state == 1) {
- Files_GetTempName(f->registerName, ((LONGINT)(101)), (void*)f->workName, ((LONGINT)(101)));
+ Files_GetTempName(f->registerName, 101, (void*)f->workName, 101);
f->tempFile = 1;
} else if (f->state == 2) {
- __COPY(f->registerName, f->workName, ((LONGINT)(101)));
+ __COPY(f->registerName, f->workName, 101);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
- error = Platform_Unlink((void*)f->workName, ((LONGINT)(101)));
- error = Platform_New((void*)f->workName, ((LONGINT)(101)), &f->fd);
+ 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;
@@ -242,14 +247,14 @@ static void Files_Create (Files_File f)
} else {
__MOVE("file not created", err, 17);
}
- Files_Err(err, ((LONGINT)(32)), f, error);
+ Files_Err(err, 32, f, error);
}
}
}
static void Files_Flush (Files_Buffer buf)
{
- INTEGER error;
+ INT16 error;
Files_File f = NIL;
if (buf->chg) {
f = buf->f;
@@ -257,15 +262,15 @@ static void Files_Flush (Files_Buffer buf)
if (buf->org != f->pos) {
error = Platform_Seek(f->fd, buf->org, Platform_SeekSet);
}
- error = Platform_Write(f->fd, (LONGINT)(SYSTEM_ADDRESS)buf->data, buf->size);
+ error = Platform_Write(f->fd, (ADDRESS)buf->data, buf->size);
if (error != 0) {
- Files_Err((CHAR*)"error writing file", (LONGINT)19, f, error);
+ Files_Err((CHAR*)"error writing file", 19, f, error);
}
f->pos = buf->org + buf->size;
buf->chg = 0;
error = Platform_Identify(f->fd, &f->identity, Platform_FileIdentity__typ);
if (error != 0) {
- Files_Err((CHAR*)"error identifying file", (LONGINT)23, f, error);
+ Files_Err((CHAR*)"error identifying file", 23, f, error);
}
}
}
@@ -273,7 +278,7 @@ static void Files_Flush (Files_Buffer buf)
static void Files_CloseOSFile (Files_File f)
{
Files_File prev = NIL;
- INTEGER error;
+ INT16 error;
if (Files_files == f) {
Files_files = f->next;
} else {
@@ -293,8 +298,8 @@ static void Files_CloseOSFile (Files_File f)
void Files_Close (Files_File f)
{
- LONGINT i;
- INTEGER error;
+ INT32 i;
+ INT16 error;
if (f->state != 1 || f->registerName[0] != 0x00) {
Files_Create(f);
i = 0;
@@ -302,42 +307,34 @@ void Files_Close (Files_File f)
Files_Flush(f->bufs[i]);
i += 1;
}
- error = Platform_Sync(f->fd);
- if (error != 0) {
- Files_Err((CHAR*)"error writing file", (LONGINT)19, f, error);
- }
Files_CloseOSFile(f);
}
}
-LONGINT Files_Length (Files_File f)
+INT32 Files_Length (Files_File f)
{
- LONGINT _o_result;
- _o_result = f->len;
- return _o_result;
+ return f->len;
}
Files_File Files_New (CHAR *name, LONGINT name__len)
{
- Files_File _o_result;
Files_File f = NIL;
__DUP(name, name__len, CHAR);
__NEW(f, Files_FileDesc);
f->workName[0] = 0x00;
- __COPY(name, f->registerName, ((LONGINT)(101)));
+ __COPY(name, f->registerName, 101);
f->fd = -1;
f->state = 1;
f->len = 0;
f->pos = 0;
f->swapper = -1;
- _o_result = f;
__DEL(name);
- return _o_result;
+ return f;
}
-static void Files_ScanPath (INTEGER *pos, CHAR *dir, LONGINT dir__len)
+static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len)
{
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
if (Files_SearchPath == NIL) {
@@ -380,8 +377,7 @@ static void Files_ScanPath (INTEGER *pos, CHAR *dir, LONGINT dir__len)
static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len)
{
- BOOLEAN _o_result;
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
ch = name[0];
@@ -389,15 +385,13 @@ static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len)
i += 1;
ch = name[i];
}
- _o_result = ch == '/';
- return _o_result;
+ return ch == '/';
}
static Files_File Files_CacheEntry (Platform_FileIdentity identity)
{
- Files_File _o_result;
Files_File f = NIL;
- INTEGER i, error;
+ INT16 i, error;
f = Files_files;
while (f != NIL) {
if (Platform_SameFile(identity, f->identity)) {
@@ -414,60 +408,56 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
f->identity = identity;
error = Platform_Size(f->fd, &f->len);
}
- _o_result = f;
- return _o_result;
+ return f;
}
f = f->next;
}
- _o_result = NIL;
- return _o_result;
+ return NIL;
}
Files_File Files_Old (CHAR *name, LONGINT name__len)
{
- Files_File _o_result;
Files_File f = NIL;
- LONGINT fd;
- INTEGER pos;
+ INT32 fd;
+ INT16 pos;
BOOLEAN done;
CHAR dir[256], path[256];
- INTEGER error;
+ INT16 error;
Platform_FileIdentity identity;
__DUP(name, name__len, CHAR);
if (name[0] != 0x00) {
if (Files_HasDir((void*)name, name__len)) {
dir[0] = 0x00;
- __COPY(name, path, ((LONGINT)(256)));
+ __COPY(name, path, 256);
} else {
pos = 0;
- Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256)));
- Files_MakeFileName(dir, ((LONGINT)(256)), name, name__len, (void*)path, ((LONGINT)(256)));
- Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256)));
+ Files_ScanPath(&pos, (void*)dir, 256);
+ Files_MakeFileName(dir, 256, name, name__len, (void*)path, 256);
+ Files_ScanPath(&pos, (void*)dir, 256);
}
for (;;) {
- error = Platform_OldRW((void*)path, ((LONGINT)(256)), &fd);
+ error = Platform_OldRW((void*)path, 256, &fd);
done = error == 0;
if ((!done && Platform_TooManyFiles(error))) {
- Files_Err((CHAR*)"too many files open", (LONGINT)20, f, error);
+ Files_Err((CHAR*)"too many files open", 20, f, error);
}
if ((!done && Platform_Inaccessible(error))) {
- error = Platform_OldRO((void*)path, ((LONGINT)(256)), &fd);
+ error = Platform_OldRO((void*)path, 256, &fd);
done = error == 0;
}
if ((!done && !Platform_Absent(error))) {
- Console_String((CHAR*)"Warning: Files.Old ", (LONGINT)20);
- Console_String(name, name__len);
- Console_String((CHAR*)" error = ", (LONGINT)10);
- Console_Int(error, ((LONGINT)(0)));
- Console_Ln();
+ Out_String((CHAR*)"Warning: Files.Old ", 20);
+ Out_String(name, name__len);
+ Out_String((CHAR*)" error = ", 10);
+ Out_Int(error, 0);
+ Out_Ln();
}
if (done) {
error = Platform_Identify(fd, &identity, Platform_FileIdentity__typ);
f = Files_CacheEntry(identity);
if (f != NIL) {
- _o_result = f;
__DEL(name);
- return _o_result;
+ return f;
} else {
__NEW(f, Files_FileDesc);
Heap_RegisterFinalizer((void*)f, Files_Finalize);
@@ -476,39 +466,36 @@ Files_File Files_Old (CHAR *name, LONGINT name__len)
f->pos = 0;
f->swapper = -1;
error = Platform_Size(fd, &f->len);
- __COPY(name, f->workName, ((LONGINT)(101)));
+ __COPY(name, f->workName, 101);
f->registerName[0] = 0x00;
f->tempFile = 0;
f->identity = identity;
f->next = Files_files;
Files_files = f;
Heap_FileCount += 1;
- _o_result = f;
__DEL(name);
- return _o_result;
+ return f;
}
} else if (dir[0] == 0x00) {
- _o_result = NIL;
__DEL(name);
- return _o_result;
+ return NIL;
} else {
- Files_MakeFileName(dir, ((LONGINT)(256)), name, name__len, (void*)path, ((LONGINT)(256)));
- Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256)));
+ Files_MakeFileName(dir, 256, name, name__len, (void*)path, 256);
+ Files_ScanPath(&pos, (void*)dir, 256);
}
}
} else {
- _o_result = NIL;
__DEL(name);
- return _o_result;
+ return NIL;
}
__RETCHK;
}
void Files_Purge (Files_File f)
{
- INTEGER i;
+ INT16 i;
Platform_FileIdentity identity;
- INTEGER error;
+ INT16 error;
i = 0;
while (i < 4) {
if (f->bufs[i] != NIL) {
@@ -518,8 +505,8 @@ void Files_Purge (Files_File f)
i += 1;
}
if (f->fd != -1) {
- error = Platform_Truncate(f->fd, ((LONGINT)(0)));
- error = Platform_Seek(f->fd, ((LONGINT)(0)), Platform_SeekSet);
+ error = Platform_Truncate(f->fd, 0);
+ error = Platform_Seek(f->fd, 0, Platform_SeekSet);
}
f->pos = 0;
f->len = 0;
@@ -528,27 +515,26 @@ void Files_Purge (Files_File f)
Platform_SetMTime(&f->identity, Platform_FileIdentity__typ, identity);
}
-void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d)
+void Files_GetDate (Files_File f, INT32 *t, INT32 *d)
{
Platform_FileIdentity identity;
- INTEGER error;
+ INT16 error;
Files_Create(f);
error = Platform_Identify(f->fd, &identity, Platform_FileIdentity__typ);
Platform_MTimeAsClock(identity, &*t, &*d);
}
-LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ)
+INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ)
{
- LONGINT _o_result;
- _o_result = (*r).org + (*r).offset;
- return _o_result;
+ __ASSERT((*r).offset <= 4096, 0);
+ return (*r).org + (*r).offset;
}
-void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos)
+void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos)
{
- LONGINT org, offset, i, n;
+ INT32 org, offset, i, n;
Files_Buffer buf = NIL;
- INTEGER error;
+ INT16 error;
if (f != NIL) {
if (pos > f->len) {
pos = f->len;
@@ -584,9 +570,9 @@ void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos)
if (f->pos != org) {
error = Platform_Seek(f->fd, org, Platform_SeekSet);
}
- error = Platform_ReadBuf(f->fd, (void*)buf->data, ((LONGINT)(4096)), &n);
+ error = Platform_ReadBuf(f->fd, (void*)buf->data, 4096, &n);
if (error != 0) {
- Files_Err((CHAR*)"read from file not done", (LONGINT)24, f, error);
+ Files_Err((CHAR*)"read from file not done", 24, f, error);
}
f->pos = org + n;
buf->size = n;
@@ -599,6 +585,7 @@ void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos)
org = 0;
offset = 0;
}
+ __ASSERT(offset <= 4096, 0);
(*r).buf = buf;
(*r).org = org;
(*r).offset = offset;
@@ -606,9 +593,9 @@ void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos)
(*r).res = 0;
}
-void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x)
+void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
{
- LONGINT offset;
+ INT32 offset;
Files_Buffer buf = NIL;
buf = (*r).buf;
offset = (*r).offset;
@@ -617,6 +604,7 @@ void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x)
buf = (*r).buf;
offset = (*r).offset;
}
+ __ASSERT(offset <= buf->size, 0);
if (offset < buf->size) {
*x = buf->data[offset];
(*r).offset = offset + 1;
@@ -630,9 +618,9 @@ void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x)
}
}
-void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n)
+void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
{
- LONGINT xpos, min, restInBuf, offset;
+ INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
if (n > x__len) {
Files_IdxTrap();
@@ -656,39 +644,35 @@ void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x
} else {
min = n;
}
- __MOVE((LONGINT)(SYSTEM_ADDRESS)buf->data + offset, (LONGINT)(SYSTEM_ADDRESS)x + xpos, min);
+ __MOVE((ADDRESS)buf->data + Files_ToAdr(offset), (ADDRESS)x + Files_ToAdr(xpos), min);
offset += min;
(*r).offset = offset;
xpos += min;
n -= min;
+ __ASSERT(offset <= 4096, 0);
}
(*r).res = 0;
(*r).eof = 0;
}
-void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len)
+Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ)
{
- Files_ReadBytes(&*r, r__typ, (void*)x, x__len * ((LONGINT)(1)), ((LONGINT)(1)));
+ return (*r).buf->f;
}
-Files_File Files_Base (Files_Rider *r, LONGINT *r__typ)
-{
- Files_File _o_result;
- _o_result = (*r).buf->f;
- return _o_result;
-}
-
-void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x)
+void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
{
Files_Buffer buf = NIL;
- LONGINT offset;
+ INT32 offset;
buf = (*r).buf;
offset = (*r).offset;
+ __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;
}
+ __ASSERT(offset < 4096, 0);
buf->data[offset] = x;
buf->chg = 1;
if (offset == buf->size) {
@@ -699,9 +683,9 @@ void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x)
(*r).res = 0;
}
-void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n)
+void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
{
- LONGINT xpos, min, restInBuf, offset;
+ INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
if (n > x__len) {
Files_IdxTrap();
@@ -710,20 +694,23 @@ void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT
buf = (*r).buf;
offset = (*r).offset;
while (n > 0) {
+ __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;
}
+ __ASSERT(offset <= 4096, 0);
restInBuf = 4096 - offset;
if (n > restInBuf) {
min = restInBuf;
} else {
min = n;
}
- __MOVE((LONGINT)(SYSTEM_ADDRESS)x + xpos, (LONGINT)(SYSTEM_ADDRESS)buf->data + offset, min);
+ __MOVE((ADDRESS)x + Files_ToAdr(xpos), (ADDRESS)buf->data + Files_ToAdr(offset), min);
offset += min;
(*r).offset = offset;
+ __ASSERT(offset <= 4096, 0);
if (offset > buf->size) {
buf->f->len += offset - buf->size;
buf->size = offset;
@@ -735,17 +722,17 @@ void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT
(*r).res = 0;
}
-void Files_Delete (CHAR *name, LONGINT name__len, INTEGER *res)
+void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res)
{
__DUP(name, name__len, CHAR);
*res = Platform_Unlink((void*)name, name__len);
__DEL(name);
}
-void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res)
+void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res)
{
- LONGINT fdold, fdnew, n;
- INTEGER error, ignore;
+ INT32 fdold, fdnew, n;
+ INT16 error, ignore;
Platform_FileIdentity oldidentity, newidentity;
CHAR buf[4096];
__DUP(old, old__len, CHAR);
@@ -759,28 +746,34 @@ void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT
error = Platform_Rename((void*)old, old__len, (void*)new, new__len);
if (!Platform_DifferentFilesystems(error)) {
*res = error;
+ __DEL(old);
+ __DEL(new);
return;
} else {
error = Platform_OldRO((void*)old, old__len, &fdold);
if (error != 0) {
*res = 2;
+ __DEL(old);
+ __DEL(new);
return;
}
error = Platform_New((void*)new, new__len, &fdnew);
if (error != 0) {
error = Platform_Close(fdold);
*res = 3;
+ __DEL(old);
+ __DEL(new);
return;
}
- error = Platform_Read(fdold, (LONGINT)(SYSTEM_ADDRESS)buf, ((LONGINT)(4096)), &n);
+ error = Platform_Read(fdold, (ADDRESS)buf, 4096, &n);
while (n > 0) {
- error = Platform_Write(fdnew, (LONGINT)(SYSTEM_ADDRESS)buf, n);
+ error = Platform_Write(fdnew, (ADDRESS)buf, n);
if (error != 0) {
ignore = Platform_Close(fdold);
ignore = Platform_Close(fdnew);
- Files_Err((CHAR*)"cannot move file", (LONGINT)17, NIL, error);
+ Files_Err((CHAR*)"cannot move file", 17, NIL, error);
}
- error = Platform_Read(fdold, (LONGINT)(SYSTEM_ADDRESS)buf, ((LONGINT)(4096)), &n);
+ error = Platform_Read(fdold, (ADDRESS)buf, 4096, &n);
}
ignore = Platform_Close(fdold);
ignore = Platform_Close(fdnew);
@@ -788,7 +781,7 @@ void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT
error = Platform_Unlink((void*)old, old__len);
*res = 0;
} else {
- Files_Err((CHAR*)"cannot move file", (LONGINT)17, NIL, error);
+ Files_Err((CHAR*)"cannot move file", 17, NIL, error);
}
}
} else {
@@ -800,7 +793,7 @@ void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT
void Files_Register (Files_File f)
{
- INTEGER idx, errcode;
+ INT16 idx, errcode;
Files_File f1 = NIL;
CHAR file[104];
if ((f->state == 1 && f->registerName[0] != 0x00)) {
@@ -808,18 +801,18 @@ void Files_Register (Files_File f)
}
Files_Close(f);
if (f->registerName[0] != 0x00) {
- Files_Rename(f->workName, ((LONGINT)(101)), f->registerName, ((LONGINT)(101)), &errcode);
+ Files_Rename(f->workName, 101, f->registerName, 101, &errcode);
if (errcode != 0) {
- __COPY(f->registerName, file, ((LONGINT)(104)));
+ __COPY(f->registerName, file, 104);
__HALT(99);
}
- __COPY(f->registerName, f->workName, ((LONGINT)(101)));
+ __COPY(f->registerName, f->workName, 101);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
}
-void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res)
+void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res)
{
__DUP(path, path__len, CHAR);
*res = Platform_Chdir((void*)path, path__len);
@@ -828,7 +821,7 @@ void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res)
static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len)
{
- LONGINT i, j;
+ INT32 i, j;
if (!Platform_LittleEndian) {
i = src__len;
j = 0;
@@ -838,55 +831,55 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *de
j += 1;
}
} else {
- __MOVE((LONGINT)(SYSTEM_ADDRESS)src, (LONGINT)(SYSTEM_ADDRESS)dest, src__len);
+ __MOVE((ADDRESS)src, (ADDRESS)dest, src__len);
}
}
-void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x)
+void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x)
{
Files_Read(&*R, R__typ, (CHAR*)(void*)&*x);
}
-void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x)
+void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x)
{
CHAR b[2];
- Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(2)), ((LONGINT)(2)));
- *x = (int)b[0] + __ASHL((int)b[1], 8);
+ Files_ReadBytes(&*R, R__typ, (void*)b, 2, 2);
+ *x = (INT16)b[0] + __ASHL((INT16)b[1], 8);
}
-void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x)
+void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x)
{
CHAR b[4];
- Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
- *x = ((int)((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((int)b[2], 16)) + __ASHL((int)b[3], 24);
+ Files_ReadBytes(&*R, R__typ, (void*)b, 4, 4);
+ *x = (((INT16)b[0] + __ASHL((INT16)b[1], 8)) + __ASHL(b[2], 16)) + __ASHL(b[3], 24);
}
-void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x)
+void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x)
{
CHAR b[4];
- LONGINT l;
- Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
- l = ((int)((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((int)b[2], 16)) + __ASHL((int)b[3], 24);
- *x = (SET)l;
+ INT32 l;
+ Files_ReadBytes(&*R, R__typ, (void*)b, 4, 4);
+ l = (((INT16)b[0] + __ASHL((INT16)b[1], 8)) + __ASHL(b[2], 16)) + __ASHL(b[3], 24);
+ *x = (UINT32)l;
}
-void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x)
+void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x)
{
CHAR b[4];
- Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
- Files_FlipBytes((void*)b, ((LONGINT)(4)), (void*)&*x, ((LONGINT)(4)));
+ Files_ReadBytes(&*R, R__typ, (void*)b, 4, 4);
+ Files_FlipBytes((void*)b, 4, (void*)&*x, 4);
}
-void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x)
+void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x)
{
CHAR b[8];
- Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(8)), ((LONGINT)(8)));
- Files_FlipBytes((void*)b, ((LONGINT)(8)), (void*)&*x, ((LONGINT)(8)));
+ Files_ReadBytes(&*R, R__typ, (void*)b, 8, 8);
+ Files_FlipBytes((void*)b, 8, (void*)&*x, 8);
}
-void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len)
+void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
{
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
do {
@@ -896,101 +889,100 @@ void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len)
} while (!(ch == 0x00));
}
-void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len)
+void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
{
- INTEGER i;
- CHAR ch;
- BOOLEAN b;
+ INT16 i;
i = 0;
- b = 0;
do {
- Files_Read(&*R, R__typ, (void*)&ch);
- if ((ch == 0x00 || ch == 0x0a) || ch == 0x0d) {
- b = 1;
- } else {
- x[i] = ch;
- i += 1;
- }
- } while (!b);
-}
-
-void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x)
-{
- SHORTINT s;
- CHAR ch;
- LONGINT n;
- s = 0;
- n = 0;
- Files_Read(&*R, R__typ, (void*)&ch);
- while ((int)ch >= 128) {
- n += __ASH((int)((int)ch - 128), s);
- s += 7;
- Files_Read(&*R, R__typ, (void*)&ch);
+ Files_Read(&*R, R__typ, (void*)&x[i]);
+ i += 1;
+ } while (!(x[i - 1] == 0x00 || x[i - 1] == 0x0a));
+ if (x[i - 1] == 0x0a) {
+ i -= 1;
}
- n += __ASH((int)(__MASK((int)ch, -64) - __ASHL(__ASHR((int)ch, 6), 6)), s);
- *x = n;
+ if ((i > 0 && x[i - 1] == 0x0d)) {
+ i -= 1;
+ }
+ x[i] = 0x00;
}
-void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x)
+void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len)
+{
+ INT8 s, b;
+ INT64 q;
+ s = 0;
+ q = 0;
+ Files_Read(&*R, R__typ, (void*)&b);
+ while (b < 0) {
+ q += (INT64)__ASH(((INT16)b + 128), s);
+ s += 7;
+ Files_Read(&*R, R__typ, (void*)&b);
+ }
+ q += (INT64)__ASH((__MASK(b, -64) - __ASHL(__ASHR(b, 6), 6)), s);
+ __ASSERT(x__len <= 8, 0);
+ __MOVE((ADDRESS)&q, (ADDRESS)x, x__len);
+}
+
+void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x)
{
Files_Write(&*R, R__typ, __VAL(CHAR, x));
}
-void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x)
+void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x)
{
CHAR b[2];
b[0] = (CHAR)x;
b[1] = (CHAR)__ASHR(x, 8);
- Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(2)), ((LONGINT)(2)));
+ Files_WriteBytes(&*R, R__typ, (void*)b, 2, 2);
}
-void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x)
+void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x)
{
CHAR b[4];
b[0] = (CHAR)x;
b[1] = (CHAR)__ASHR(x, 8);
b[2] = (CHAR)__ASHR(x, 16);
b[3] = (CHAR)__ASHR(x, 24);
- Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
+ Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
}
-void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x)
+void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x)
{
CHAR b[4];
- LONGINT i;
- i = (LONGINT)x;
+ INT32 i;
+ i = (INT32)x;
b[0] = (CHAR)i;
b[1] = (CHAR)__ASHR(i, 8);
b[2] = (CHAR)__ASHR(i, 16);
b[3] = (CHAR)__ASHR(i, 24);
- Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
+ Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
}
-void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x)
+void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x)
{
CHAR b[4];
- Files_FlipBytes((void*)&x, ((LONGINT)(4)), (void*)b, ((LONGINT)(4)));
- Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
+ Files_FlipBytes((void*)&x, 4, (void*)b, 4);
+ Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
}
-void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x)
+void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x)
{
CHAR b[8];
- Files_FlipBytes((void*)&x, ((LONGINT)(8)), (void*)b, ((LONGINT)(8)));
- Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(8)), ((LONGINT)(8)));
+ Files_FlipBytes((void*)&x, 8, (void*)b, 8);
+ Files_WriteBytes(&*R, R__typ, (void*)b, 8, 8);
}
-void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len)
+void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
{
- INTEGER i;
+ INT16 i;
i = 0;
while (x[i] != 0x00) {
i += 1;
}
- Files_WriteBytes(&*R, R__typ, (void*)x, x__len * ((LONGINT)(1)), i + 1);
+ Files_WriteBytes(&*R, R__typ, (void*)x, x__len * 1, i + 1);
}
-void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x)
+void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x)
{
while (x < -64 || x > 63) {
Files_Write(&*R, R__typ, (CHAR)(__MASK(x, -128) + 128));
@@ -1007,12 +999,12 @@ void Files_GetName (Files_File f, CHAR *name, LONGINT name__len)
static void Files_Finalize (SYSTEM_PTR o)
{
Files_File f = NIL;
- LONGINT res;
- f = (Files_File)(SYSTEM_ADDRESS)o;
+ INT32 res;
+ f = (Files_File)(ADDRESS)o;
if (f->fd >= 0) {
Files_CloseOSFile(f);
if (f->tempFile) {
- res = Platform_Unlink((void*)f->workName, ((LONGINT)(101)));
+ res = Platform_Unlink((void*)f->workName, 101);
}
}
}
@@ -1021,7 +1013,7 @@ void Files_SetSearchPath (CHAR *path, LONGINT path__len)
{
__DUP(path, path__len, CHAR);
if (Strings_Length(path, path__len) != 0) {
- Files_SearchPath = __NEWARR(NIL, ((LONGINT)(1)), 1, 1, 1, (LONGINT)(Strings_Length(path, path__len) + 1));
+ Files_SearchPath = __NEWARR(NIL, 1, 1, 1, 1, ((ADDRESS)((Strings_Length(path, path__len) + 1))));
__COPY(path, Files_SearchPath->data, Files_SearchPath->len[0]);
} else {
Files_SearchPath = NIL;
@@ -1042,9 +1034,8 @@ __TDESC(Files_Rider, 1, 1) = {__TDFLDS("Rider", 20), {8, -8}};
export void *Files__init(void)
{
__DEFMOD;
- __MODULE_IMPORT(Configuration);
- __MODULE_IMPORT(Console);
__MODULE_IMPORT(Heap);
+ __MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
__REGMOD("Files", EnumPtrs);
@@ -1055,6 +1046,6 @@ export void *Files__init(void)
Files_tempno = -1;
Heap_FileCount = 0;
Files_HOME[0] = 0x00;
- Platform_GetEnv((CHAR*)"HOME", (LONGINT)5, (void*)Files_HOME, ((LONGINT)(1024)));
+ Platform_GetEnv((CHAR*)"HOME", 5, (void*)Files_HOME, 1024);
__ENDMOD;
}
diff --git a/bootstrap/unix-44/Files.h b/bootstrap/unix-44/Files.h
index a4a4ea8c..79164af5 100644
--- a/bootstrap/unix-44/Files.h
+++ b/bootstrap/unix-44/Files.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
#ifndef Files__h
#define Files__h
@@ -11,60 +11,59 @@ typedef
typedef
struct Files_FileDesc {
char _prvt0[216];
- LONGINT fd;
+ INT32 fd;
char _prvt1[32];
} Files_FileDesc;
typedef
struct Files_Rider {
- LONGINT res;
+ INT32 res;
BOOLEAN eof;
char _prvt0[15];
} Files_Rider;
-import LONGINT *Files_FileDesc__typ;
-import LONGINT *Files_Rider__typ;
+import ADDRESS *Files_FileDesc__typ;
+import ADDRESS *Files_Rider__typ;
-import Files_File Files_Base (Files_Rider *r, LONGINT *r__typ);
-import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res);
+import Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
+import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res);
import void Files_Close (Files_File f);
-import void Files_Delete (CHAR *name, LONGINT name__len, INTEGER *res);
-import void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d);
+import void Files_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, LONGINT name__len);
-import LONGINT Files_Length (Files_File f);
+import INT32 Files_Length (Files_File f);
import Files_File Files_New (CHAR *name, LONGINT name__len);
import Files_File Files_Old (CHAR *name, LONGINT name__len);
-import LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ);
+import INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ);
import void Files_Purge (Files_File f);
-import void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x);
-import void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x);
-import void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len);
-import void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n);
-import void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x);
-import void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x);
-import void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x);
-import void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
-import void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x);
-import void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x);
-import void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x);
-import void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
+import void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
+import void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x);
+import void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+import void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x);
+import void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x);
+import void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
+import void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+import void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
+import void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
+import void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
+import void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
import void Files_Register (Files_File f);
-import void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res);
-import void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos);
+import void Files_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, LONGINT path__len);
-import void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x);
-import void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x);
-import void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n);
-import void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x);
-import void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x);
-import void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x);
-import void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x);
-import void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x);
-import void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x);
-import void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
+import void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
+import void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
+import void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+import void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
+import void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
+import void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
+import void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
+import void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
+import void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
+import void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
import void *Files__init(void);
-#endif
+#endif // Files
diff --git a/bootstrap/unix-44/Heap.c b/bootstrap/unix-44/Heap.c
index 30ec687a..72677604 100644
--- a/bootstrap/unix-44/Heap.c
+++ b/bootstrap/unix-44/Heap.c
@@ -1,4 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tskSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tsSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
struct Heap__1 {
@@ -34,7 +40,7 @@ typedef
typedef
struct Heap_FinDesc {
Heap_FinNode next;
- LONGINT obj;
+ INT32 obj;
BOOLEAN marked;
Heap_Finalizer finalize;
} Heap_FinDesc;
@@ -49,62 +55,61 @@ typedef
struct Heap_ModuleDesc {
Heap_Module next;
Heap_ModuleName name;
- LONGINT refcnt;
+ INT32 refcnt;
Heap_Cmd cmds;
- LONGINT types;
+ INT32 types;
Heap_EnumProc enumPtrs;
- LONGINT reserved1, reserved2;
+ INT32 reserved1, reserved2;
} Heap_ModuleDesc;
export SYSTEM_PTR Heap_modules;
-static LONGINT Heap_freeList[10];
-static LONGINT Heap_bigBlocks;
-export LONGINT Heap_allocated;
+static INT32 Heap_freeList[10];
+static INT32 Heap_bigBlocks;
+export INT32 Heap_allocated;
static BOOLEAN Heap_firstTry;
-static LONGINT Heap_heap, Heap_heapend;
-export LONGINT Heap_heapsize;
+static INT32 Heap_heap, Heap_heapend;
+export INT32 Heap_heapsize;
static Heap_FinNode Heap_fin;
-static INTEGER Heap_lockdepth;
+static INT16 Heap_lockdepth;
static BOOLEAN Heap_interrupted;
-export INTEGER Heap_FileCount;
+export INT16 Heap_FileCount;
-export LONGINT *Heap_ModuleDesc__typ;
-export LONGINT *Heap_CmdDesc__typ;
-export LONGINT *Heap_FinDesc__typ;
-export LONGINT *Heap__1__typ;
+export ADDRESS *Heap_ModuleDesc__typ;
+export ADDRESS *Heap_CmdDesc__typ;
+export ADDRESS *Heap_FinDesc__typ;
+export ADDRESS *Heap__1__typ;
static void Heap_CheckFin (void);
-static void Heap_ExtendHeap (LONGINT blksz);
+static void Heap_ExtendHeap (INT32 blksz);
export void Heap_FINALL (void);
static void Heap_Finalize (void);
export void Heap_GC (BOOLEAN markStack);
-static void Heap_HeapSort (LONGINT n, LONGINT *a, LONGINT a__len);
+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 (LONGINT q);
-static void Heap_MarkCandidates (LONGINT n, LONGINT *cand, LONGINT cand__len);
+static void Heap_Mark (INT32 q);
+static void Heap_MarkCandidates (INT32 n, INT32 *cand, LONGINT cand__len);
static void Heap_MarkP (SYSTEM_PTR p);
-static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len);
-export SYSTEM_PTR Heap_NEWBLK (LONGINT size);
-export SYSTEM_PTR Heap_NEWREC (LONGINT tag);
-static LONGINT Heap_NewChunk (LONGINT blksz);
+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);
export void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd);
export SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs);
-export void Heap_REGTYP (Heap_Module m, LONGINT typ);
+export void Heap_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 (LONGINT l, LONGINT r, LONGINT *a, LONGINT 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 LONGINT Platform_MainStackFrame;
-extern LONGINT Platform_OSAllocate(LONGINT size);
-#define Heap_FetchAddress(pointer) (LONGINT)(SYSTEM_ADDRESS)(*((void**)((SYSTEM_ADDRESS)pointer)))
+extern ADDRESS Platform_MainStackFrame;
+extern ADDRESS Platform_OSAllocate(ADDRESS size);
#define Heap_HeapModuleInit() Heap__init()
+#define Heap_ModulesHalt(code) Modules_Halt(code)
#define Heap_OSAllocate(size) Platform_OSAllocate(size)
-#define Heap_PlatformHalt(code) Platform_Halt(code)
#define Heap_PlatformMainStackFrame() Platform_MainStackFrame
void Heap_Lock (void)
@@ -116,13 +121,12 @@ void Heap_Unlock (void)
{
Heap_lockdepth -= 1;
if ((Heap_interrupted && Heap_lockdepth == 0)) {
- Heap_PlatformHalt(((LONGINT)(-9)));
+ Heap_ModulesHalt(-9);
}
}
SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs)
{
- SYSTEM_PTR _o_result;
Heap_Module m;
if (__STRCMP(name, "Heap") == 0) {
__SYSNEW(m, 48);
@@ -131,13 +135,12 @@ SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs)
}
m->types = 0;
m->cmds = NIL;
- __COPY(name, m->name, ((LONGINT)(20)));
+ __COPY(name, m->name, 20);
m->refcnt = 0;
m->enumPtrs = enumPtrs;
- m->next = (Heap_Module)(SYSTEM_ADDRESS)Heap_modules;
+ m->next = (Heap_Module)(ADDRESS)Heap_modules;
Heap_modules = (SYSTEM_PTR)m;
- _o_result = (void*)m;
- return _o_result;
+ return (void*)m;
}
void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd)
@@ -148,15 +151,15 @@ void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd)
} else {
__NEW(c, Heap_CmdDesc);
}
- __COPY(name, c->name, ((LONGINT)(24)));
+ __COPY(name, c->name, 24);
c->cmd = cmd;
c->next = m->cmds;
m->cmds = c;
}
-void Heap_REGTYP (Heap_Module m, LONGINT typ)
+void Heap_REGTYP (Heap_Module m, INT32 typ)
{
- __PUT(typ, m->types, LONGINT);
+ __PUT(typ, m->types, INT32);
m->types = typ;
}
@@ -165,27 +168,25 @@ void Heap_INCREF (Heap_Module m)
m->refcnt += 1;
}
-static LONGINT Heap_NewChunk (LONGINT blksz)
+static INT32 Heap_NewChunk (INT32 blksz)
{
- LONGINT _o_result;
- LONGINT chnk;
+ INT32 chnk;
chnk = Heap_OSAllocate(blksz + 12);
if (chnk != 0) {
- __PUT(chnk + 4, chnk + (12 + blksz), LONGINT);
- __PUT(chnk + 12, chnk + 16, LONGINT);
- __PUT(chnk + 16, blksz, LONGINT);
- __PUT(chnk + 20, -4, LONGINT);
- __PUT(chnk + 24, Heap_bigBlocks, LONGINT);
+ __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;
}
- _o_result = chnk;
- return _o_result;
+ return chnk;
}
-static void Heap_ExtendHeap (LONGINT blksz)
+static void Heap_ExtendHeap (INT32 blksz)
{
- LONGINT size, chnk, j, next;
+ INT32 size, chnk, j, next;
if (blksz > 160000) {
size = blksz;
} else {
@@ -194,31 +195,30 @@ static void Heap_ExtendHeap (LONGINT blksz)
chnk = Heap_NewChunk(size);
if (chnk != 0) {
if (chnk < Heap_heap) {
- __PUT(chnk, Heap_heap, LONGINT);
+ __PUT(chnk, Heap_heap, INT32);
Heap_heap = chnk;
} else {
j = Heap_heap;
- next = Heap_FetchAddress(j);
+ __GET(j, next, INT32);
while ((next != 0 && chnk > next)) {
j = next;
- next = Heap_FetchAddress(j);
+ __GET(j, next, INT32);
}
- __PUT(chnk, next, LONGINT);
- __PUT(j, chnk, LONGINT);
+ __PUT(chnk, next, INT32);
+ __PUT(j, chnk, INT32);
}
if (next == 0) {
- Heap_heapend = Heap_FetchAddress(chnk + 4);
+ __GET(chnk + 4, Heap_heapend, INT32);
}
}
}
-SYSTEM_PTR Heap_NEWREC (LONGINT tag)
+SYSTEM_PTR Heap_NEWREC (INT32 tag)
{
- SYSTEM_PTR _o_result;
- LONGINT i, i0, di, blksz, restsize, t, adr, end, next, prev;
+ INT32 i, i0, di, blksz, restsize, t, adr, end, next, prev;
SYSTEM_PTR new;
Heap_Lock();
- blksz = Heap_FetchAddress(tag);
+ __GET(tag, blksz, INT32);
i0 = __ASHR(blksz, 4);
i = i0;
if (i < 9) {
@@ -229,17 +229,17 @@ SYSTEM_PTR Heap_NEWREC (LONGINT tag)
}
}
if (i < 9) {
- next = Heap_FetchAddress(adr + 12);
+ __GET(adr + 12, next, INT32);
Heap_freeList[i] = next;
if (i != i0) {
di = i - i0;
restsize = __ASHL(di, 4);
end = adr + restsize;
- __PUT(end + 4, blksz, LONGINT);
- __PUT(end + 8, -4, LONGINT);
- __PUT(end, end + 4, LONGINT);
- __PUT(adr + 4, restsize, LONGINT);
- __PUT(adr + 12, Heap_freeList[di], LONGINT);
+ __PUT(end + 4, blksz, INT32);
+ __PUT(end + 8, -4, INT32);
+ __PUT(end, end + 4, INT32);
+ __PUT(adr + 4, restsize, INT32);
+ __PUT(adr + 12, Heap_freeList[di], INT32);
Heap_freeList[di] = adr;
adr += restsize;
}
@@ -262,39 +262,37 @@ SYSTEM_PTR Heap_NEWREC (LONGINT tag)
new = Heap_NEWREC(tag);
}
Heap_Unlock();
- _o_result = new;
- return _o_result;
+ return new;
} else {
Heap_Unlock();
- _o_result = NIL;
- return _o_result;
+ return NIL;
}
}
- t = Heap_FetchAddress(adr + 4);
+ __GET(adr + 4, t, INT32);
if (t >= blksz) {
break;
}
prev = adr;
- adr = Heap_FetchAddress(adr + 12);
+ __GET(adr + 12, adr, INT32);
}
restsize = t - blksz;
end = adr + restsize;
- __PUT(end + 4, blksz, LONGINT);
- __PUT(end + 8, -4, LONGINT);
- __PUT(end, end + 4, LONGINT);
+ __PUT(end + 4, blksz, INT32);
+ __PUT(end + 8, -4, INT32);
+ __PUT(end, end + 4, INT32);
if (restsize > 144) {
- __PUT(adr + 4, restsize, LONGINT);
+ __PUT(adr + 4, restsize, INT32);
} else {
- next = Heap_FetchAddress(adr + 12);
+ __GET(adr + 12, next, INT32);
if (prev == 0) {
Heap_bigBlocks = next;
} else {
- __PUT(prev + 12, next, LONGINT);
+ __PUT(prev + 12, next, INT32);
}
if (restsize > 0) {
di = __ASHR(restsize, 4);
- __PUT(adr + 4, restsize, LONGINT);
- __PUT(adr + 12, Heap_freeList[di], LONGINT);
+ __PUT(adr + 4, restsize, INT32);
+ __PUT(adr + 12, Heap_freeList[di], INT32);
Heap_freeList[di] = adr;
}
}
@@ -303,73 +301,70 @@ SYSTEM_PTR Heap_NEWREC (LONGINT tag)
i = adr + 16;
end = adr + blksz;
while (i < end) {
- __PUT(i, 0, LONGINT);
- __PUT(i + 4, 0, LONGINT);
- __PUT(i + 8, 0, LONGINT);
- __PUT(i + 12, 0, LONGINT);
+ __PUT(i, 0, INT32);
+ __PUT(i + 4, 0, INT32);
+ __PUT(i + 8, 0, INT32);
+ __PUT(i + 12, 0, INT32);
i += 16;
}
- __PUT(adr + 12, 0, LONGINT);
- __PUT(adr, tag, LONGINT);
- __PUT(adr + 4, 0, LONGINT);
- __PUT(adr + 8, 0, LONGINT);
+ __PUT(adr + 12, 0, INT32);
+ __PUT(adr, tag, INT32);
+ __PUT(adr + 4, 0, INT32);
+ __PUT(adr + 8, 0, INT32);
Heap_allocated += blksz;
Heap_Unlock();
- _o_result = (SYSTEM_PTR)(SYSTEM_ADDRESS)(adr + 4);
- return _o_result;
+ return (SYSTEM_PTR)(ADDRESS)(adr + 4);
}
-SYSTEM_PTR Heap_NEWBLK (LONGINT size)
+SYSTEM_PTR Heap_NEWBLK (INT32 size)
{
- SYSTEM_PTR _o_result;
- LONGINT blksz, tag;
+ INT32 blksz, tag;
SYSTEM_PTR new;
Heap_Lock();
blksz = __ASHL(__ASHR(size + 31, 4), 4);
- new = Heap_NEWREC((LONGINT)(SYSTEM_ADDRESS)&blksz);
- tag = ((LONGINT)(SYSTEM_ADDRESS)new + blksz) - 12;
- __PUT(tag - 4, 0, LONGINT);
- __PUT(tag, blksz, LONGINT);
- __PUT(tag + 4, -4, LONGINT);
- __PUT((LONGINT)(SYSTEM_ADDRESS)new - 4, tag, LONGINT);
+ new = Heap_NEWREC((ADDRESS)&blksz);
+ tag = ((INT32)(ADDRESS)new + blksz) - 12;
+ __PUT(tag - 4, 0, INT32);
+ __PUT(tag, blksz, INT32);
+ __PUT(tag + 4, -4, INT32);
+ __PUT((INT32)(ADDRESS)new - 4, tag, INT32);
Heap_Unlock();
- _o_result = new;
- return _o_result;
+ return new;
}
-static void Heap_Mark (LONGINT q)
+static void Heap_Mark (INT32 q)
{
- LONGINT p, tag, fld, n, offset, tagbits;
+ INT32 p, tag, offset, fld, n, tagbits;
if (q != 0) {
- tagbits = Heap_FetchAddress(q - 4);
+ __GET(q - 4, tagbits, INT32);
if (!__ODD(tagbits)) {
- __PUT(q - 4, tagbits + 1, LONGINT);
+ __PUT(q - 4, tagbits + 1, INT32);
p = 0;
tag = tagbits + 4;
for (;;) {
- __GET(tag, offset, LONGINT);
+ __GET(tag, offset, INT32);
if (offset < 0) {
- __PUT(q - 4, (tag + offset) + 1, LONGINT);
+ __PUT(q - 4, (tag + offset) + 1, INT32);
if (p == 0) {
break;
}
n = q;
q = p;
- tag = Heap_FetchAddress(q - 4);
+ __GET(q - 4, tag, INT32);
tag -= 1;
- __GET(tag, offset, LONGINT);
+ __GET(tag, offset, INT32);
fld = q + offset;
- p = Heap_FetchAddress(fld);
- __PUT(fld, (SYSTEM_PTR)(SYSTEM_ADDRESS)n, SYSTEM_PTR);
+ __GET(fld, p, INT32);
+ __PUT(fld, (SYSTEM_PTR)(ADDRESS)n, SYSTEM_PTR);
} else {
fld = q + offset;
- n = Heap_FetchAddress(fld);
+ __GET(fld, n, INT32);
if (n != 0) {
- tagbits = Heap_FetchAddress(n - 4);
+ __GET(n - 4, tagbits, INT32);
if (!__ODD(tagbits)) {
- __PUT(n - 4, tagbits + 1, LONGINT);
- __PUT(q - 4, tag + 1, LONGINT);
- __PUT(fld, (SYSTEM_PTR)(SYSTEM_ADDRESS)p, SYSTEM_PTR);
+ __PUT(n - 4, tagbits + 1, INT32);
+ __PUT(q - 4, tag + 1, INT32);
+ __PUT(fld, (SYSTEM_PTR)(ADDRESS)p, SYSTEM_PTR);
p = q;
q = n;
tag = tagbits;
@@ -384,12 +379,12 @@ static void Heap_Mark (LONGINT q)
static void Heap_MarkP (SYSTEM_PTR p)
{
- Heap_Mark((LONGINT)(SYSTEM_ADDRESS)p);
+ Heap_Mark((INT32)(ADDRESS)p);
}
static void Heap_Scan (void)
{
- LONGINT chnk, adr, end, start, tag, i, size, freesize;
+ INT32 chnk, adr, end, start, tag, i, size, freesize;
Heap_bigBlocks = 0;
i = 1;
while (i < 9) {
@@ -401,58 +396,58 @@ static void Heap_Scan (void)
chnk = Heap_heap;
while (chnk != 0) {
adr = chnk + 12;
- end = Heap_FetchAddress(chnk + 4);
+ __GET(chnk + 4, end, INT32);
while (adr < end) {
- tag = Heap_FetchAddress(adr);
+ __GET(adr, tag, INT32);
if (__ODD(tag)) {
if (freesize > 0) {
start = adr - freesize;
- __PUT(start, start + 4, LONGINT);
- __PUT(start + 4, freesize, LONGINT);
- __PUT(start + 8, -4, LONGINT);
+ __PUT(start, start + 4, INT32);
+ __PUT(start + 4, freesize, INT32);
+ __PUT(start + 8, -4, INT32);
i = __ASHR(freesize, 4);
freesize = 0;
if (i < 9) {
- __PUT(start + 12, Heap_freeList[i], LONGINT);
+ __PUT(start + 12, Heap_freeList[i], INT32);
Heap_freeList[i] = start;
} else {
- __PUT(start + 12, Heap_bigBlocks, LONGINT);
+ __PUT(start + 12, Heap_bigBlocks, INT32);
Heap_bigBlocks = start;
}
}
tag -= 1;
- __PUT(adr, tag, LONGINT);
- size = Heap_FetchAddress(tag);
+ __PUT(adr, tag, INT32);
+ __GET(tag, size, INT32);
Heap_allocated += size;
adr += size;
} else {
- size = Heap_FetchAddress(tag);
+ __GET(tag, size, INT32);
freesize += size;
adr += size;
}
}
if (freesize > 0) {
start = adr - freesize;
- __PUT(start, start + 4, LONGINT);
- __PUT(start + 4, freesize, LONGINT);
- __PUT(start + 8, -4, LONGINT);
+ __PUT(start, start + 4, INT32);
+ __PUT(start + 4, freesize, INT32);
+ __PUT(start + 8, -4, INT32);
i = __ASHR(freesize, 4);
freesize = 0;
if (i < 9) {
- __PUT(start + 12, Heap_freeList[i], LONGINT);
+ __PUT(start + 12, Heap_freeList[i], INT32);
Heap_freeList[i] = start;
} else {
- __PUT(start + 12, Heap_bigBlocks, LONGINT);
+ __PUT(start + 12, Heap_bigBlocks, INT32);
Heap_bigBlocks = start;
}
}
- chnk = Heap_FetchAddress(chnk);
+ __GET(chnk, chnk, INT32);
}
}
-static void Heap_Sift (LONGINT l, LONGINT r, LONGINT *a, LONGINT a__len)
+static void Heap_Sift (INT32 l, INT32 r, INT32 *a, LONGINT a__len)
{
- LONGINT i, j, x;
+ INT32 i, j, x;
j = l;
x = a[j];
for (;;) {
@@ -469,9 +464,9 @@ static void Heap_Sift (LONGINT l, LONGINT r, LONGINT *a, LONGINT a__len)
a[i] = x;
}
-static void Heap_HeapSort (LONGINT n, LONGINT *a, LONGINT a__len)
+static void Heap_HeapSort (INT32 n, INT32 *a, LONGINT a__len)
{
- LONGINT l, r, x;
+ INT32 l, r, x;
l = __ASHR(n, 1);
r = n - 1;
while (l > 0) {
@@ -487,25 +482,25 @@ static void Heap_HeapSort (LONGINT n, LONGINT *a, LONGINT a__len)
}
}
-static void Heap_MarkCandidates (LONGINT n, LONGINT *cand, LONGINT cand__len)
+static void Heap_MarkCandidates (INT32 n, INT32 *cand, LONGINT cand__len)
{
- LONGINT chnk, adr, tag, next, lim, lim1, i, ptr, size;
+ INT32 chnk, adr, tag, next, lim, lim1, i, ptr, size;
chnk = Heap_heap;
i = 0;
lim = cand[n - 1];
while ((chnk != 0 && chnk < lim)) {
adr = chnk + 12;
- lim1 = Heap_FetchAddress(chnk + 4);
+ __GET(chnk + 4, lim1, INT32);
if (lim < lim1) {
lim1 = lim;
}
while (adr < lim1) {
- tag = Heap_FetchAddress(adr);
+ __GET(adr, tag, INT32);
if (__ODD(tag)) {
- size = Heap_FetchAddress(tag - 1);
+ __GET(tag - 1, size, INT32);
adr += size;
} else {
- size = Heap_FetchAddress(tag);
+ __GET(tag, size, INT32);
ptr = adr + 4;
while (cand[i] < ptr) {
i += 1;
@@ -520,17 +515,17 @@ static void Heap_MarkCandidates (LONGINT n, LONGINT *cand, LONGINT cand__len)
adr = next;
}
}
- chnk = Heap_FetchAddress(chnk);
+ __GET(chnk, chnk, INT32);
}
}
static void Heap_CheckFin (void)
{
Heap_FinNode n;
- LONGINT tag;
+ INT32 tag;
n = Heap_fin;
while (n != NIL) {
- tag = Heap_FetchAddress(n->obj - 4);
+ __GET(n->obj - 4, tag, INT32);
if (!__ODD(tag)) {
n->marked = 0;
Heap_Mark(n->obj);
@@ -553,7 +548,7 @@ static void Heap_Finalize (void)
} else {
prev->next = n->next;
}
- (*n->finalize)((SYSTEM_PTR)(SYSTEM_ADDRESS)n->obj);
+ (*n->finalize)((SYSTEM_PTR)(ADDRESS)n->obj);
if (prev == NIL) {
n = Heap_fin;
} else {
@@ -572,14 +567,14 @@ void Heap_FINALL (void)
while (Heap_fin != NIL) {
n = Heap_fin;
Heap_fin = Heap_fin->next;
- (*n->finalize)((SYSTEM_PTR)(SYSTEM_ADDRESS)n->obj);
+ (*n->finalize)((SYSTEM_PTR)(ADDRESS)n->obj);
}
}
-static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len)
+static void Heap_MarkStack (INT32 n, INT32 *cand, LONGINT cand__len)
{
SYSTEM_PTR frame;
- LONGINT inc, nofcand, sp, p, stack0;
+ INT32 inc, nofcand, sp, p, stack0;
struct Heap__1 align;
if (n > 0) {
Heap_MarkStack(n - 1, cand, cand__len);
@@ -589,14 +584,14 @@ static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len)
}
if (n == 0) {
nofcand = 0;
- sp = (LONGINT)(SYSTEM_ADDRESS)&frame;
+ sp = (ADDRESS)&frame;
stack0 = Heap_PlatformMainStackFrame();
- inc = (LONGINT)(SYSTEM_ADDRESS)&align.p - (LONGINT)(SYSTEM_ADDRESS)&align;
+ inc = (ADDRESS)&align.p - (ADDRESS)&align;
if (sp > stack0) {
inc = -inc;
}
while (sp != stack0) {
- __GET(sp, p, LONGINT);
+ __GET(sp, p, INT32);
if ((p > Heap_heap && p < Heap_heapend)) {
if (nofcand == cand__len) {
Heap_HeapSort(nofcand, (void*)cand, cand__len);
@@ -618,11 +613,11 @@ static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len)
void Heap_GC (BOOLEAN markStack)
{
Heap_Module m;
- LONGINT i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23;
- LONGINT cand[10000];
+ INT32 i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23;
+ INT32 cand[10000];
if (Heap_lockdepth == 0 || (Heap_lockdepth == 1 && !markStack)) {
Heap_Lock();
- m = (Heap_Module)(SYSTEM_ADDRESS)Heap_modules;
+ m = (Heap_Module)(ADDRESS)Heap_modules;
while (m != NIL) {
if (m->enumPtrs != NIL) {
(*m->enumPtrs)(Heap_MarkP);
@@ -680,7 +675,7 @@ void Heap_GC (BOOLEAN markStack)
i22 += 23;
i23 += 24;
if ((i0 == -99 && i15 == 24)) {
- Heap_MarkStack(((LONGINT)(32)), (void*)cand, ((LONGINT)(10000)));
+ Heap_MarkStack(32, (void*)cand, 10000);
break;
}
}
@@ -699,7 +694,7 @@ void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
{
Heap_FinNode f;
__NEW(f, Heap_FinDesc);
- f->obj = (LONGINT)(SYSTEM_ADDRESS)obj;
+ f->obj = (INT32)(ADDRESS)obj;
f->finalize = finalize;
f->marked = 1;
f->next = Heap_fin;
@@ -709,8 +704,8 @@ void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
void Heap_InitHeap (void)
{
Heap_heap = Heap_NewChunk(128000);
- Heap_heapend = Heap_FetchAddress(Heap_heap + 4);
- __PUT(Heap_heap, 0, LONGINT);
+ __GET(Heap_heap + 4, Heap_heapend, INT32);
+ __PUT(Heap_heap, 0, INT32);
Heap_allocated = 0;
Heap_firstTry = 1;
Heap_freeList[9] = 1;
diff --git a/bootstrap/unix-44/Heap.h b/bootstrap/unix-44/Heap.h
index a2cab30c..0aa0a18b 100644
--- a/bootstrap/unix-44/Heap.h
+++ b/bootstrap/unix-44/Heap.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tskSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tsSF */
#ifndef Heap__h
#define Heap__h
@@ -22,7 +22,7 @@ typedef
typedef
struct Heap_ModuleDesc {
- LONGINT _prvt0;
+ INT32 _prvt0;
char _prvt1[44];
} Heap_ModuleDesc;
@@ -31,24 +31,24 @@ typedef
import SYSTEM_PTR Heap_modules;
-import LONGINT Heap_allocated, Heap_heapsize;
-import INTEGER Heap_FileCount;
+import INT32 Heap_allocated, Heap_heapsize;
+import INT16 Heap_FileCount;
-import LONGINT *Heap_ModuleDesc__typ;
+import ADDRESS *Heap_ModuleDesc__typ;
import void Heap_FINALL (void);
import void Heap_GC (BOOLEAN markStack);
import void Heap_INCREF (Heap_Module m);
import void Heap_InitHeap (void);
import void Heap_Lock (void);
-import SYSTEM_PTR Heap_NEWBLK (LONGINT size);
-import SYSTEM_PTR Heap_NEWREC (LONGINT tag);
+import SYSTEM_PTR Heap_NEWBLK (INT32 size);
+import SYSTEM_PTR Heap_NEWREC (INT32 tag);
import void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd);
import SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs);
-import void Heap_REGTYP (Heap_Module m, LONGINT typ);
+import void Heap_REGTYP (Heap_Module m, INT32 typ);
import void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize);
import void Heap_Unlock (void);
import void *Heap__init(void);
-#endif
+#endif // Heap
diff --git a/bootstrap/unix-44/Modules.c b/bootstrap/unix-44/Modules.c
index 330b7506..a5e72ba3 100644
--- a/bootstrap/unix-44/Modules.c
+++ b/bootstrap/unix-44/Modules.c
@@ -1,7 +1,13 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
-#include "Console.h"
#include "Heap.h"
+#include "Platform.h"
typedef
struct Modules_CmdDesc *Modules_Cmd;
@@ -26,32 +32,38 @@ typedef
struct Modules_ModuleDesc {
Modules_Module next;
Modules_ModuleName name;
- LONGINT refcnt;
+ INT32 refcnt;
Modules_Cmd cmds;
- LONGINT types;
- void (*enumPtrs)(void(*)(LONGINT));
- LONGINT reserved1, reserved2;
+ INT32 types;
+ void (*enumPtrs)(void(*)(INT32));
+ INT32 reserved1, reserved2;
} Modules_ModuleDesc;
-export INTEGER Modules_res;
+export INT16 Modules_res;
export CHAR Modules_resMsg[256];
export Modules_ModuleName Modules_imported, Modules_importing;
-export LONGINT *Modules_ModuleDesc__typ;
-export LONGINT *Modules_CmdDesc__typ;
+export ADDRESS *Modules_ModuleDesc__typ;
+export ADDRESS *Modules_CmdDesc__typ;
static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len);
+export void Modules_AssertFail (INT32 code);
+static void Modules_DisplayHaltCode (INT32 code);
export void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
+export void Modules_Halt (INT32 code);
export Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
export Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
+static void Modules_errch (CHAR c);
+static void Modules_errint (INT32 l);
+static void Modules_errstring (CHAR *s, LONGINT s__len);
#define Modules_modules() (Modules_Module)Heap_modules
#define Modules_setmodules(m) Heap_modules = m
static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len)
{
- INTEGER i, j;
+ INT16 i, j;
__DUP(b, b__len, CHAR);
i = 0;
while (a[__X(i, a__len)] != 0x00) {
@@ -69,7 +81,6 @@ static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len)
Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
{
- Modules_Module _o_result;
Modules_Module m = NIL;
CHAR bodyname[64];
Modules_Command body;
@@ -83,19 +94,17 @@ Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
Modules_resMsg[0] = 0x00;
} else {
Modules_res = 1;
- __COPY(name, Modules_importing, ((LONGINT)(20)));
+ __COPY(name, Modules_importing, 20);
__MOVE(" module \"", Modules_resMsg, 10);
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), name, name__len);
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)"\" not found", (LONGINT)12);
+ Modules_Append((void*)Modules_resMsg, 256, name, name__len);
+ Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
}
- _o_result = m;
__DEL(name);
- return _o_result;
+ return m;
}
Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len)
{
- Modules_Command _o_result;
Modules_Cmd c = NIL;
__DUP(name, name__len, CHAR);
c = mod->cmds;
@@ -105,20 +114,18 @@ Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT nam
if (c != NIL) {
Modules_res = 0;
Modules_resMsg[0] = 0x00;
- _o_result = c->cmd;
__DEL(name);
- return _o_result;
+ return c->cmd;
} else {
Modules_res = 2;
__MOVE(" command \"", Modules_resMsg, 11);
- __COPY(name, Modules_importing, ((LONGINT)(20)));
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), mod->name, ((LONGINT)(20)));
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)".", (LONGINT)2);
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), name, name__len);
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)"\" not found", (LONGINT)12);
- _o_result = NIL;
+ __COPY(name, Modules_importing, 20);
+ Modules_Append((void*)Modules_resMsg, 256, mod->name, 20);
+ Modules_Append((void*)Modules_resMsg, 256, (CHAR*)".", 2);
+ Modules_Append((void*)Modules_resMsg, 256, name, name__len);
+ Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
__DEL(name);
- return _o_result;
+ return NIL;
}
__RETCHK;
}
@@ -155,14 +162,124 @@ void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all)
__DEL(name);
}
+static void Modules_errch (CHAR c)
+{
+ INT16 e;
+ e = Platform_Write(1, (ADDRESS)&c, 1);
+}
+
+static void Modules_errstring (CHAR *s, LONGINT s__len)
+{
+ INT32 i;
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
+ Modules_errch(s[__X(i, s__len)]);
+ i += 1;
+ }
+ __DEL(s);
+}
+
+static void Modules_errint (INT32 l)
+{
+ if (l < 0) {
+ Modules_errch('-');
+ l = -l;
+ }
+ if (l >= 10) {
+ Modules_errint(__DIV(l, 10));
+ }
+ Modules_errch((CHAR)((int)__MOD(l, 10) + 48));
+}
+
+static void Modules_DisplayHaltCode (INT32 code)
+{
+ switch (code) {
+ case -1:
+ Modules_errstring((CHAR*)"Assertion failure.", 19);
+ break;
+ case -2:
+ Modules_errstring((CHAR*)"Index out of range.", 20);
+ break;
+ case -3:
+ Modules_errstring((CHAR*)"Reached end of function without reaching RETURN.", 49);
+ break;
+ case -4:
+ Modules_errstring((CHAR*)"CASE statement: no matching label and no ELSE.", 47);
+ break;
+ case -5:
+ Modules_errstring((CHAR*)"Type guard failed.", 19);
+ break;
+ case -6:
+ Modules_errstring((CHAR*)"Implicit type guard in record assignment failed.", 49);
+ break;
+ case -7:
+ Modules_errstring((CHAR*)"Invalid case in WITH statement.", 32);
+ break;
+ case -8:
+ Modules_errstring((CHAR*)"Value out of range.", 20);
+ break;
+ case -9:
+ Modules_errstring((CHAR*)"Heap interrupted while locked, but lockdepth = 0 at unlock.", 60);
+ break;
+ case -10:
+ Modules_errstring((CHAR*)"NIL access.", 12);
+ break;
+ case -11:
+ Modules_errstring((CHAR*)"Alignment error.", 17);
+ break;
+ case -12:
+ Modules_errstring((CHAR*)"Divide by zero.", 16);
+ break;
+ case -13:
+ Modules_errstring((CHAR*)"Arithmetic overflow/underflow.", 31);
+ break;
+ case -14:
+ Modules_errstring((CHAR*)"Invalid function argument.", 27);
+ break;
+ case -15:
+ Modules_errstring((CHAR*)"Internal error, e.g. Type descriptor size mismatch.", 52);
+ break;
+ case -20:
+ Modules_errstring((CHAR*)"Too many, or negative number of, elements in dynamic array.", 60);
+ break;
+ default:
+ break;
+ }
+}
+
+void Modules_Halt (INT32 code)
+{
+ Modules_errstring((CHAR*)"Terminated by Halt(", 20);
+ Modules_errint(code);
+ Modules_errstring((CHAR*)"). ", 4);
+ if (code < 0) {
+ Modules_DisplayHaltCode(code);
+ }
+ Modules_errstring(Platform_NL, 3);
+ Platform_Exit(code);
+}
+
+void Modules_AssertFail (INT32 code)
+{
+ Modules_errstring((CHAR*)"Assertion failure.", 19);
+ if (code != 0) {
+ Modules_errstring((CHAR*)" ASSERT code ", 14);
+ Modules_errint(code);
+ Modules_errstring((CHAR*)".", 2);
+ }
+ Modules_errstring(Platform_NL, 3);
+ 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)
{
__DEFMOD;
- __MODULE_IMPORT(Console);
__MODULE_IMPORT(Heap);
+ __MODULE_IMPORT(Platform);
__REGMOD("Modules", 0);
__INITYP(Modules_ModuleDesc, Modules_ModuleDesc, 0);
__INITYP(Modules_CmdDesc, Modules_CmdDesc, 0);
diff --git a/bootstrap/unix-44/Modules.h b/bootstrap/unix-44/Modules.h
index ac8ac89e..8bb89fe5 100644
--- a/bootstrap/unix-44/Modules.h
+++ b/bootstrap/unix-44/Modules.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Modules__h
#define Modules__h
@@ -28,27 +28,27 @@ typedef
struct Modules_ModuleDesc {
Modules_Module next;
Modules_ModuleName name;
- LONGINT refcnt;
+ INT32 refcnt;
Modules_Cmd cmds;
- LONGINT types;
- void (*enumPtrs)(void(*)(LONGINT));
+ INT32 types;
+ void (*enumPtrs)(void(*)(INT32));
char _prvt0[8];
} Modules_ModuleDesc;
-import INTEGER Modules_res;
+import INT16 Modules_res;
import CHAR Modules_resMsg[256];
import Modules_ModuleName Modules_imported, Modules_importing;
-import LONGINT *Modules_ModuleDesc__typ;
-import LONGINT *Modules_CmdDesc__typ;
+import ADDRESS *Modules_ModuleDesc__typ;
+import ADDRESS *Modules_CmdDesc__typ;
+import void Modules_AssertFail (INT32 code);
import void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
+import void Modules_Halt (INT32 code);
import Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
import Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
import void *Modules__init(void);
-#define Modules_modules() (Modules_Module)Heap_modules
-#define Modules_setmodules(m) Heap_modules = m
-#endif
+#endif // Modules
diff --git a/bootstrap/unix-44/OPB.c b/bootstrap/unix-44/OPB.c
index 0f614e6a..3ef8e2f9 100644
--- a/bootstrap/unix-44/OPB.c
+++ b/bootstrap/unix-44/OPB.c
@@ -1,18 +1,23 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "OPM.h"
#include "OPS.h"
#include "OPT.h"
-export void (*OPB_typSize)(OPT_Struct);
-static INTEGER OPB_exp;
-static LONGINT OPB_maxExp;
+static INT16 OPB_exp;
+static INT64 OPB_maxExp;
export void OPB_Assign (OPT_Node *x, OPT_Node y);
-static void OPB_BindNodes (SHORTINT class, OPT_Struct typ, OPT_Node *x, OPT_Node y);
-static LONGINT OPB_BoolToInt (BOOLEAN b);
+static void OPB_BindNodes (INT8 class, OPT_Struct typ, OPT_Node *x, OPT_Node y);
+static INT16 OPB_BoolToInt (BOOLEAN b);
export void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp);
static void OPB_CharToString (OPT_Node n);
static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode);
@@ -20,10 +25,10 @@ static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo);
export void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames);
static void OPB_CheckProc (OPT_Struct x, OPT_Object y);
static void OPB_CheckPtr (OPT_Node x, OPT_Node y);
-static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x);
+static void OPB_CheckRealType (INT16 f, INT16 nr, OPT_Const x);
static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp);
-static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y);
-export void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y);
+static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y);
+export void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y);
static void OPB_Convert (OPT_Node *x, OPT_Struct typ);
export void OPB_DeRef (OPT_Node *x);
static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar);
@@ -33,19 +38,17 @@ export void OPB_Field (OPT_Node *x, OPT_Object y);
export void OPB_In (OPT_Node *x, OPT_Node y);
export void OPB_Index (OPT_Node *x, OPT_Node y);
export void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ);
-static BOOLEAN OPB_IntToBool (LONGINT i);
-static OPT_Struct OPB_IntType (LONGINT size);
+static BOOLEAN OPB_IntToBool (INT64 i);
export void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y);
-static LONGINT OPB_LongerSize (LONGINT i);
-export void OPB_MOp (SHORTINT op, OPT_Node *x);
+export void OPB_MOp (INT8 op, OPT_Node *x);
export OPT_Node OPB_NewBoolConst (BOOLEAN boolval);
-export OPT_Node OPB_NewIntConst (LONGINT intval);
+export OPT_Node OPB_NewIntConst (INT64 intval);
export OPT_Node OPB_NewLeaf (OPT_Object obj);
export OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ);
-export OPT_Node OPB_NewString (OPS_String str, LONGINT len);
+export OPT_Node OPB_NewString (OPS_String str, INT64 len);
export OPT_Node OPB_Nil (void);
static BOOLEAN OPB_NotVar (OPT_Node x);
-export void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y);
+export void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y);
export void OPB_OptIf (OPT_Node *x);
export void OPB_Param (OPT_Node ap, OPT_Object fp);
export void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar);
@@ -53,26 +56,24 @@ export void OPB_Return (OPT_Node *x, OPT_Object proc);
export void OPB_SetElem (OPT_Node *x);
static void OPB_SetIntType (OPT_Node node);
export void OPB_SetRange (OPT_Node *x, OPT_Node y);
-static LONGINT OPB_ShorterSize (LONGINT i);
-static INTEGER OPB_SignedByteSize (LONGINT n);
-export void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno);
-export void OPB_StPar0 (OPT_Node *par0, INTEGER fctno);
-export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno);
-export void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n);
-export void OPB_StaticLink (SHORTINT dlev);
+static void OPB_SetSetType (OPT_Node node);
+export void OPB_StFct (OPT_Node *par0, INT8 fctno, INT16 parno);
+export void OPB_StPar0 (OPT_Node *par0, INT16 fctno);
+export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno);
+export void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n);
+export void OPB_StaticLink (INT8 dlev);
export void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard);
-static void OPB_err (INTEGER n);
-static LONGINT OPB_log (LONGINT x);
+static void OPB_err (INT16 n);
+static INT64 OPB_log (INT64 x);
-static void OPB_err (INTEGER n)
+static void OPB_err (INT16 n)
{
OPM_err(n);
}
OPT_Node OPB_NewLeaf (OPT_Object obj)
{
- OPT_Node _o_result;
OPT_Node node = NIL;
switch (obj->mode) {
case 1:
@@ -100,11 +101,10 @@ OPT_Node OPB_NewLeaf (OPT_Object obj)
}
node->obj = obj;
node->typ = obj->typ;
- _o_result = node;
- return _o_result;
+ return node;
}
-void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y)
+void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y)
{
OPT_Node node = NIL;
node = OPT_NewNode(class);
@@ -127,42 +127,29 @@ void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y)
*last = y;
}
-static LONGINT OPB_BoolToInt (BOOLEAN b)
+static INT16 OPB_BoolToInt (BOOLEAN b)
{
- LONGINT _o_result;
if (b) {
- _o_result = 1;
- return _o_result;
+ return 1;
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-static BOOLEAN OPB_IntToBool (LONGINT i)
+static BOOLEAN OPB_IntToBool (INT64 i)
{
- BOOLEAN _o_result;
- if (i == 0) {
- _o_result = 0;
- return _o_result;
- } else {
- _o_result = 1;
- return _o_result;
- }
- __RETCHK;
+ return i != 0;
}
OPT_Node OPB_NewBoolConst (BOOLEAN boolval)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->typ = OPT_booltyp;
x->conval = OPT_NewConst();
x->conval->intval = OPB_BoolToInt(boolval);
- _o_result = x;
- return _o_result;
+ return x;
}
void OPB_OptIf (OPT_Node *x)
@@ -202,130 +189,72 @@ void OPB_OptIf (OPT_Node *x)
OPT_Node OPB_Nil (void)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->typ = OPT_niltyp;
x->conval = OPT_NewConst();
x->conval->intval = 0;
- _o_result = x;
- return _o_result;
+ return x;
}
OPT_Node OPB_EmptySet (void)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->typ = OPT_settyp;
x->conval = OPT_NewConst();
x->conval->setval = 0x0;
- _o_result = x;
- return _o_result;
-}
-
-static INTEGER OPB_SignedByteSize (LONGINT n)
-{
- INTEGER _o_result;
- INTEGER b;
- if (n < 0) {
- n = -(n + 1);
- }
- b = 1;
- while ((b < 8 && __ASH(n, -(__ASHL(b, 3) - 1)) != 0)) {
- b += 1;
- }
- _o_result = b;
- return _o_result;
-}
-
-static LONGINT OPB_ShorterSize (LONGINT i)
-{
- LONGINT _o_result;
- if (i >= (int)OPM_LIntSize) {
- _o_result = OPM_IntSize;
- return _o_result;
- } else {
- _o_result = OPM_SIntSize;
- return _o_result;
- }
- __RETCHK;
-}
-
-static LONGINT OPB_LongerSize (LONGINT i)
-{
- LONGINT _o_result;
- if (i <= (int)OPM_SIntSize) {
- _o_result = OPM_IntSize;
- return _o_result;
- } else {
- _o_result = OPM_LIntSize;
- return _o_result;
- }
- __RETCHK;
-}
-
-static OPT_Struct OPB_IntType (LONGINT size)
-{
- OPT_Struct _o_result;
- OPT_Struct result = NIL;
- if (size <= OPT_sinttyp->size) {
- result = OPT_sinttyp;
- } else if (size <= OPT_inttyp->size) {
- result = OPT_inttyp;
- } else {
- result = OPT_linttyp;
- }
- if (size > OPT_linttyp->size) {
- OPB_err(203);
- }
- _o_result = result;
- return _o_result;
+ return x;
}
static void OPB_SetIntType (OPT_Node node)
{
- node->typ = OPB_IntType(OPB_SignedByteSize(node->conval->intval));
+ node->typ = OPT_IntType(OPT_IntSize(node->conval->intval));
}
-OPT_Node OPB_NewIntConst (LONGINT intval)
+static void OPB_SetSetType (OPT_Node node)
+{
+ INT32 i32;
+ __GET((ADDRESS)&node->conval->setval + 4, i32, INT32);
+ if (i32 == 0) {
+ node->typ = OPT_set32typ;
+ } else {
+ node->typ = OPT_set64typ;
+ }
+}
+
+OPT_Node OPB_NewIntConst (INT64 intval)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->conval = OPT_NewConst();
x->conval->intval = intval;
OPB_SetIntType(x);
- _o_result = x;
- return _o_result;
+ return x;
}
OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->conval = OPT_NewConst();
x->conval->realval = realval;
x->typ = typ;
x->conval->intval = -1;
- _o_result = x;
- return _o_result;
+ return x;
}
-OPT_Node OPB_NewString (OPS_String str, LONGINT len)
+OPT_Node OPB_NewString (OPS_String str, INT64 len)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->conval = OPT_NewConst();
x->typ = OPT_stringtyp;
x->conval->intval = -1;
- x->conval->intval2 = len;
+ x->conval->intval2 = OPM_Longint(len);
x->conval->ext = OPT_NewExt();
- __COPY(str, *x->conval->ext, ((LONGINT)(256)));
- _o_result = x;
- return _o_result;
+ __COPY(str, *x->conval->ext, 256);
+ return x;
}
static void OPB_CharToString (OPT_Node n)
@@ -345,7 +274,7 @@ static void OPB_CharToString (OPT_Node n)
n->obj = NIL;
}
-static void OPB_BindNodes (SHORTINT class, OPT_Struct typ, OPT_Node *x, OPT_Node y)
+static void OPB_BindNodes (INT8 class, OPT_Struct typ, OPT_Node *x, OPT_Node y)
{
OPT_Node node = NIL;
node = OPT_NewNode(class);
@@ -357,9 +286,7 @@ static void OPB_BindNodes (SHORTINT class, OPT_Struct typ, OPT_Node *x, OPT_Node
static BOOLEAN OPB_NotVar (OPT_Node x)
{
- BOOLEAN _o_result;
- _o_result = (x->class >= 7 && ((x->class != 11 || x->subcl != 29) || x->left->class >= 7));
- return _o_result;
+ return (x->class >= 7 && ((x->class != 11 || x->subcl != 29) || x->left->class >= 7));
}
void OPB_DeRef (OPT_Node *x)
@@ -369,7 +296,7 @@ void OPB_DeRef (OPT_Node *x)
typ = (*x)->typ;
if ((*x)->class >= 7) {
OPB_err(78);
- } else if (typ->form == 13) {
+ } else if (typ->form == 11) {
if (typ == OPT_sysptrtyp) {
OPB_err(57);
}
@@ -387,18 +314,18 @@ void OPB_DeRef (OPT_Node *x)
void OPB_Index (OPT_Node *x, OPT_Node y)
{
- INTEGER f;
+ INT16 f;
OPT_Struct typ = NIL;
f = y->typ->form;
if ((*x)->class >= 7) {
OPB_err(79);
- } else if (!__IN(f, 0x70) || __IN(y->class, 0x0300)) {
+ } else if (f != 4 || __IN(y->class, 0x0300, 32)) {
OPB_err(80);
y->typ = OPT_inttyp;
}
if ((*x)->typ->comp == 2) {
typ = (*x)->typ->BaseTyp;
- if ((y->class == 7 && (y->conval->intval < 0 || y->conval->intval >= (*x)->typ->n))) {
+ if ((y->class == 7 && (y->conval->intval < 0 || y->conval->intval >= (INT64)(*x)->typ->n))) {
OPB_err(81);
}
} else if ((*x)->typ->comp == 3) {
@@ -419,7 +346,7 @@ void OPB_Field (OPT_Node *x, OPT_Object y)
if ((*x)->class >= 7) {
OPB_err(77);
}
- if ((y != NIL && __IN(y->mode, 0x2010))) {
+ if ((y != NIL && __IN(y->mode, 0x2010, 32))) {
OPB_BindNodes(2, y->typ, &*x, NIL);
(*x)->obj = y;
(*x)->readonly = (*x)->left->readonly || (y->vis == 2 && y->mnolev < 0);
@@ -429,16 +356,16 @@ void OPB_Field (OPT_Node *x, OPT_Object y)
}
}
-static struct TypTest__61 {
+static struct TypTest__58 {
OPT_Node *x;
OPT_Object *obj;
BOOLEAN *guard;
- struct TypTest__61 *lnk;
-} *TypTest__61_s;
+ struct TypTest__58 *lnk;
+} *TypTest__58_s;
-static void GTT__62 (OPT_Struct t0, OPT_Struct t1);
+static void GTT__59 (OPT_Struct t0, OPT_Struct t1);
-static void GTT__62 (OPT_Struct t0, OPT_Struct t1)
+static void GTT__59 (OPT_Struct t0, OPT_Struct t1)
{
OPT_Node node = NIL;
OPT_Struct t = NIL;
@@ -451,54 +378,54 @@ static void GTT__62 (OPT_Struct t0, OPT_Struct t1)
t1 = t1->BaseTyp;
}
if (t1 == t0 || t0->form == 0) {
- if (*TypTest__61_s->guard) {
- OPB_BindNodes(5, NIL, &*TypTest__61_s->x, NIL);
- (*TypTest__61_s->x)->readonly = (*TypTest__61_s->x)->left->readonly;
+ if (*TypTest__58_s->guard) {
+ OPB_BindNodes(5, NIL, &*TypTest__58_s->x, NIL);
+ (*TypTest__58_s->x)->readonly = (*TypTest__58_s->x)->left->readonly;
} else {
node = OPT_NewNode(11);
node->subcl = 16;
- node->left = *TypTest__61_s->x;
- node->obj = *TypTest__61_s->obj;
- *TypTest__61_s->x = node;
+ node->left = *TypTest__58_s->x;
+ node->obj = *TypTest__58_s->obj;
+ *TypTest__58_s->x = node;
}
} else {
OPB_err(85);
}
} else if (t0 != t1) {
OPB_err(85);
- } else if (!*TypTest__61_s->guard) {
- if ((*TypTest__61_s->x)->class == 5) {
+ } else if (!*TypTest__58_s->guard) {
+ if ((*TypTest__58_s->x)->class == 5) {
node = OPT_NewNode(11);
node->subcl = 16;
- node->left = *TypTest__61_s->x;
- node->obj = *TypTest__61_s->obj;
- *TypTest__61_s->x = node;
+ node->left = *TypTest__58_s->x;
+ node->obj = *TypTest__58_s->obj;
+ *TypTest__58_s->x = node;
} else {
- *TypTest__61_s->x = OPB_NewBoolConst(1);
+ *TypTest__58_s->x = OPB_NewBoolConst(1);
}
}
}
void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
{
- struct TypTest__61 _s;
+ struct TypTest__58 _s;
_s.x = x;
_s.obj = &obj;
_s.guard = &guard;
- _s.lnk = TypTest__61_s;
- TypTest__61_s = &_s;
+ _s.lnk = TypTest__58_s;
+ TypTest__58_s = &_s;
if (OPB_NotVar(*x)) {
OPB_err(112);
- } else if ((*x)->typ->form == 13) {
+ } else if ((*x)->typ->form == 11) {
if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) {
OPB_err(85);
- } else if (obj->typ->form == 13) {
- GTT__62((*x)->typ->BaseTyp, obj->typ->BaseTyp);
+ } else if (obj->typ->form == 11) {
+ GTT__59((*x)->typ->BaseTyp, obj->typ->BaseTyp);
} else {
OPB_err(86);
}
} else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) {
- GTT__62((*x)->typ, obj->typ);
+ GTT__59((*x)->typ, obj->typ);
} else {
OPB_err(87);
}
@@ -507,23 +434,23 @@ void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
} else {
(*x)->typ = OPT_booltyp;
}
- TypTest__61_s = _s.lnk;
+ TypTest__58_s = _s.lnk;
}
void OPB_In (OPT_Node *x, OPT_Node y)
{
- INTEGER f;
- LONGINT k;
+ INT16 f;
+ INT64 k;
f = (*x)->typ->form;
if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) {
OPB_err(126);
- } else if ((__IN(f, 0x70) && y->typ->form == 9)) {
+ } else if ((f == 4 && y->typ->form == 7)) {
if ((*x)->class == 7) {
k = (*x)->conval->intval;
- if (k < 0 || k > (int)OPM_MaxSet) {
+ if (k < 0 || k >= (INT64)__ASHL(y->typ->size, 3)) {
OPB_err(202);
} else if (y->class == 7) {
- (*x)->conval->intval = OPB_BoolToInt(__IN(k, y->conval->setval));
+ (*x)->conval->intval = OPB_BoolToInt(__IN(k, y->conval->setval, 64));
(*x)->obj = NIL;
} else {
OPB_BindNodes(12, OPT_booltyp, &*x, y);
@@ -539,9 +466,8 @@ void OPB_In (OPT_Node *x, OPT_Node y)
(*x)->typ = OPT_booltyp;
}
-static LONGINT OPB_log (LONGINT x)
+static INT64 OPB_log (INT64 x)
{
- LONGINT _o_result;
OPB_exp = 0;
if (x > 0) {
while (!__ODD(x)) {
@@ -549,14 +475,13 @@ static LONGINT OPB_log (LONGINT x)
OPB_exp += 1;
}
}
- _o_result = x;
- return _o_result;
+ return x;
}
-static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x)
+static void OPB_CheckRealType (INT16 f, INT16 nr, OPT_Const x)
{
LONGREAL min, max, r;
- if (f == 7) {
+ if (f == 5) {
min = OPM_MinReal;
max = OPM_MaxReal;
} else {
@@ -567,38 +492,36 @@ static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x)
if (r > max || r < min) {
OPB_err(nr);
x->realval = (LONGREAL)1;
- } else if (f == 7) {
+ } else if (f == 5) {
x->realval = x->realval;
}
x->intval = -1;
}
-static struct MOp__30 {
- struct MOp__30 *lnk;
-} *MOp__30_s;
+static struct MOp__28 {
+ struct MOp__28 *lnk;
+} *MOp__28_s;
-static OPT_Node NewOp__31 (SHORTINT op, OPT_Struct typ, OPT_Node z);
+static OPT_Node NewOp__29 (INT8 op, OPT_Struct typ, OPT_Node z);
-static OPT_Node NewOp__31 (SHORTINT op, OPT_Struct typ, OPT_Node z)
+static OPT_Node NewOp__29 (INT8 op, OPT_Struct typ, OPT_Node z)
{
- OPT_Node _o_result;
OPT_Node node = NIL;
node = OPT_NewNode(11);
node->subcl = op;
node->typ = typ;
node->left = z;
- _o_result = node;
- return _o_result;
+ return node;
}
-void OPB_MOp (SHORTINT op, OPT_Node *x)
+void OPB_MOp (INT8 op, OPT_Node *x)
{
- INTEGER f;
+ INT16 f;
OPT_Struct typ = NIL;
OPT_Node z = NIL;
- struct MOp__30 _s;
- _s.lnk = MOp__30_s;
- MOp__30_s = &_s;
+ struct MOp__28 _s;
+ _s.lnk = MOp__28_s;
+ MOp__28_s = &_s;
z = *x;
if (z->class == 8 || z->class == 9) {
OPB_err(126);
@@ -612,45 +535,49 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval));
z->obj = NIL;
} else {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
}
} else {
OPB_err(98);
}
break;
case 6:
- if (!__IN(f, 0x01f0)) {
+ if (!__IN(f, 0x70, 32)) {
OPB_err(96);
}
break;
case 7:
- if (__IN(f, 0x03f0)) {
+ if (__IN(f, 0xf0, 32)) {
if (z->class == 7) {
- if (__IN(f, 0x70)) {
- if (z->conval->intval == (-2147483647-1)) {
+ if (f == 4) {
+ if (z->conval->intval == (-9223372036854775807-1)) {
OPB_err(203);
} else {
z->conval->intval = -z->conval->intval;
OPB_SetIntType(z);
}
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
z->conval->realval = -z->conval->realval;
} else {
- z->conval->setval = ~z->conval->setval;
+ if (z->typ->size == 8) {
+ z->conval->setval = ~z->conval->setval;
+ } else {
+ z->conval->setval = z->conval->setval ^ 0xffffffff;
+ }
}
z->obj = NIL;
} else {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
}
} else {
OPB_err(97);
}
break;
case 21:
- if (__IN(f, 0x01f0)) {
+ if (__IN(f, 0x70, 32)) {
if (z->class == 7) {
- if (__IN(f, 0x70)) {
- if (z->conval->intval == (-2147483647-1)) {
+ if (f == 4) {
+ if (z->conval->intval == (-9223372036854775807-1)) {
OPB_err(203);
} else {
z->conval->intval = __ABS(z->conval->intval);
@@ -661,7 +588,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
}
z->obj = NIL;
} else {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
}
} else {
OPB_err(111);
@@ -670,10 +597,10 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
case 22:
if (f == 3) {
if (z->class == 7) {
- z->conval->intval = (int)__CAP((CHAR)z->conval->intval);
+ z->conval->intval = (INT16)__CAP((CHAR)z->conval->intval);
z->obj = NIL;
} else {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
}
} else {
OPB_err(111);
@@ -681,12 +608,12 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
}
break;
case 23:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (z->class == 7) {
z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval));
z->obj = NIL;
} else {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
}
} else {
OPB_err(111);
@@ -696,19 +623,19 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
case 24:
if ((((z->class == 7 && f == 3)) && z->conval->intval >= 32)) {
OPB_CharToString(z);
- f = 10;
+ f = 8;
}
- if (z->class < 7 || f == 10) {
- z = NewOp__31(op, typ, z);
+ if (z->class < 7 || f == 8) {
+ z = NewOp__29(op, typ, z);
} else {
OPB_err(127);
}
- z->typ = OPT_linttyp;
+ z->typ = OPT_adrtyp;
break;
case 25:
- if ((__IN(f, 0x70) && z->class == 7)) {
+ if ((f == 4 && z->class == 7)) {
if ((0 <= z->conval->intval && z->conval->intval <= -1)) {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
} else {
OPB_err(219);
}
@@ -718,22 +645,22 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->typ = OPT_booltyp;
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.MOp, op = ", (LONGINT)33);
- OPM_LogWNum(op, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.MOp, op = ", 33);
+ OPM_LogWNum(op, 0);
OPM_LogWLn();
break;
}
}
*x = z;
- MOp__30_s = _s.lnk;
+ MOp__28_s = _s.lnk;
}
static void OPB_CheckPtr (OPT_Node x, OPT_Node y)
{
- INTEGER g;
+ INT16 g;
OPT_Struct p = NIL, q = NIL, t = NIL;
g = y->typ->form;
- if (g == 13) {
+ if (g == 11) {
p = x->typ->BaseTyp;
q = y->typ->BaseTyp;
if ((p->comp == 4 && q->comp == 4)) {
@@ -751,7 +678,7 @@ static void OPB_CheckPtr (OPT_Node x, OPT_Node y)
} else {
OPB_err(100);
}
- } else if (g != 11) {
+ } else if (g != 9) {
OPB_err(100);
}
}
@@ -768,7 +695,7 @@ void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames)
at = at->BaseTyp;
}
if (ft != at) {
- if ((ft->form == 14 && at->form == 14)) {
+ if ((ft->form == 12 && at->form == 12)) {
if (ft->BaseTyp == at->BaseTyp) {
OPB_CheckParameters(ft->link, at->link, 0);
} else {
@@ -794,7 +721,7 @@ void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames)
static void OPB_CheckProc (OPT_Struct x, OPT_Object y)
{
- if (__IN(y->mode, 0x04c0)) {
+ if (__IN(y->mode, 0x04c0, 32)) {
if (y->mode == 6) {
if (y->mnolev == 0) {
y->mode = 7;
@@ -814,22 +741,21 @@ static void OPB_CheckProc (OPT_Struct x, OPT_Object y)
static struct ConstOp__13 {
OPT_Node *x;
- INTEGER *f;
+ INT16 *f;
OPT_Const *xval, *yval;
struct ConstOp__13 *lnk;
} *ConstOp__13_s;
-static INTEGER ConstCmp__14 (void);
+static INT16 ConstCmp__14 (void);
-static INTEGER ConstCmp__14 (void)
+static INT16 ConstCmp__14 (void)
{
- INTEGER _o_result;
- INTEGER res;
+ INT16 res;
switch (*ConstOp__13_s->f) {
case 0:
res = 9;
break;
- case 1: case 3: case 4: case 5: case 6:
+ case 1: case 3: case 4:
if ((*ConstOp__13_s->xval)->intval < (*ConstOp__13_s->yval)->intval) {
res = 11;
} else if ((*ConstOp__13_s->xval)->intval > (*ConstOp__13_s->yval)->intval) {
@@ -838,7 +764,7 @@ static INTEGER ConstCmp__14 (void)
res = 9;
}
break;
- case 7: case 8:
+ case 5: case 6:
if ((*ConstOp__13_s->xval)->realval < (*ConstOp__13_s->yval)->realval) {
res = 11;
} else if ((*ConstOp__13_s->xval)->realval > (*ConstOp__13_s->yval)->realval) {
@@ -854,14 +780,14 @@ static INTEGER ConstCmp__14 (void)
res = 9;
}
break;
- case 9:
+ case 7:
if ((*ConstOp__13_s->xval)->setval != (*ConstOp__13_s->yval)->setval) {
res = 10;
} else {
res = 9;
}
break;
- case 10:
+ case 8:
if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) < 0) {
res = 11;
} else if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) > 0) {
@@ -870,7 +796,7 @@ static INTEGER ConstCmp__14 (void)
res = 9;
}
break;
- case 11: case 13: case 14:
+ case 9: case 11: case 12:
if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) {
res = 10;
} else {
@@ -878,21 +804,20 @@ static INTEGER ConstCmp__14 (void)
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstCmp, f = ", (LONGINT)37);
- OPM_LogWNum(*ConstOp__13_s->f, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstCmp, f = ", 37);
+ OPM_LogWNum(*ConstOp__13_s->f, 0);
OPM_LogWLn();
break;
}
(*ConstOp__13_s->x)->typ = OPT_booltyp;
- _o_result = res;
- return _o_result;
+ return res;
}
-static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
+static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
{
- INTEGER f, g;
+ INT16 f, g;
OPT_Const xval = NIL, yval = NIL;
- LONGINT xv, yv;
+ INT64 xv, yv;
BOOLEAN temp;
struct ConstOp__13 _s;
_s.x = &x;
@@ -908,7 +833,7 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
if (f != g) {
switch (f) {
case 3:
- if (g == 10) {
+ if (g == 8) {
OPB_CharToString(x);
} else {
OPB_err(100);
@@ -916,17 +841,17 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
- case 4: case 5: case 6:
- if (__IN(g, 0x70)) {
+ case 4:
+ if (g == 4) {
if (x->typ->size <= y->typ->size) {
x->typ = y->typ;
} else {
- x->typ = OPB_IntType(x->typ->size);
+ x->typ = OPT_IntType(x->typ->size);
}
- } else if (g == 7) {
+ } else if (g == 5) {
x->typ = OPT_realtyp;
xval->realval = xval->intval;
- } else if (g == 8) {
+ } else if (g == 6) {
x->typ = OPT_lrltyp;
xval->realval = xval->intval;
} else {
@@ -935,11 +860,11 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
- case 7:
- if (__IN(g, 0x70)) {
+ case 5:
+ if (g == 4) {
y->typ = x->typ;
yval->realval = yval->intval;
- } else if (g == 8) {
+ } else if (g == 6) {
x->typ = OPT_lrltyp;
} else {
OPB_err(100);
@@ -947,11 +872,11 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
- case 8:
- if (__IN(g, 0x70)) {
+ case 6:
+ if (g == 4) {
y->typ = x->typ;
yval->realval = yval->intval;
- } else if (g == 7) {
+ } else if (g == 5) {
y->typ = OPT_lrltyp;
} else {
OPB_err(100);
@@ -959,26 +884,26 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
- case 10:
+ case 8:
if (g == 3) {
OPB_CharToString(y);
- g = 10;
+ g = 8;
} else {
OPB_err(100);
y->typ = x->typ;
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
- case 11:
- if (!__IN(g, 0x6000)) {
+ case 9:
+ if (!__IN(g, 0x1800, 32)) {
OPB_err(100);
}
break;
- case 13:
+ case 11:
OPB_CheckPtr(x, y);
break;
- case 14:
- if (g != 11) {
+ case 12:
+ if (g != 9) {
OPB_err(100);
}
break;
@@ -992,16 +917,16 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
}
switch (op) {
case 1:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
xv = xval->intval;
yv = yval->intval;
- if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(2147483647, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-2147483647-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-2147483647-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-2147483647-1))) && yv != (-2147483647-1))) && -xv <= __DIV(2147483647, -yv))) {
+ if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807-1))) && yv != (-9223372036854775807-1))) && -xv <= __DIV(9223372036854775807, -yv))) {
xval->intval = xv * yv;
OPB_SetIntType(x);
} else {
OPB_err(204);
}
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
temp = __ABS(yval->realval) <= (LONGREAL)1;
if (temp || __ABS(xval->realval) <= 1.79769296342094e+308 / (LONGREAL)__ABS(yval->realval)) {
xval->realval = xval->realval * yval->realval;
@@ -1009,23 +934,24 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
} else {
OPB_err(204);
}
- } else if (f == 9) {
+ } else if (f == 7) {
xval->setval = (xval->setval & yval->setval);
+ OPB_SetSetType(x);
} else if (f != 0) {
OPB_err(101);
}
break;
case 2:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (yval->intval != 0) {
xval->realval = xval->intval / (REAL)yval->intval;
- OPB_CheckRealType(7, 205, xval);
+ OPB_CheckRealType(5, 205, xval);
} else {
OPB_err(205);
xval->realval = (LONGREAL)1;
}
x->typ = OPT_realtyp;
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
temp = __ABS(yval->realval) >= (LONGREAL)1;
if (temp || __ABS(xval->realval) <= 1.79769296342094e+308 * __ABS(yval->realval)) {
xval->realval = xval->realval / yval->realval;
@@ -1033,14 +959,15 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
} else {
OPB_err(205);
}
- } else if (f == 9) {
+ } else if (f == 7) {
xval->setval = xval->setval ^ yval->setval;
+ OPB_SetSetType(x);
} else if (f != 0) {
OPB_err(102);
}
break;
case 3:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (yval->intval != 0) {
xval->intval = __DIV(xval->intval, yval->intval);
OPB_SetIntType(x);
@@ -1052,7 +979,7 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
}
break;
case 4:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (yval->intval != 0) {
xval->intval = __MOD(xval->intval, yval->intval);
OPB_SetIntType(x);
@@ -1071,15 +998,15 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
}
break;
case 6:
- if (__IN(f, 0x70)) {
- temp = (yval->intval >= 0 && xval->intval <= 2147483647 - yval->intval);
- if (temp || (yval->intval < 0 && xval->intval >= (-2147483647-1) - yval->intval)) {
+ if (f == 4) {
+ temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807 - yval->intval);
+ if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807-1) - yval->intval)) {
xval->intval += yval->intval;
OPB_SetIntType(x);
} else {
OPB_err(206);
}
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
temp = (yval->realval >= (LONGREAL)0 && xval->realval <= 1.79769296342094e+308 - yval->realval);
if (temp || (yval->realval < (LONGREAL)0 && xval->realval >= -1.79769296342094e+308 - yval->realval)) {
xval->realval = xval->realval + yval->realval;
@@ -1087,21 +1014,22 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
} else {
OPB_err(206);
}
- } else if (f == 9) {
+ } else if (f == 7) {
xval->setval = xval->setval | yval->setval;
+ OPB_SetSetType(x);
} else if (f != 0) {
OPB_err(105);
}
break;
case 7:
- if (__IN(f, 0x70)) {
- if ((yval->intval >= 0 && xval->intval >= (-2147483647-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 2147483647 + yval->intval)) {
+ if (f == 4) {
+ if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807 + yval->intval)) {
xval->intval -= yval->intval;
OPB_SetIntType(x);
} else {
OPB_err(207);
}
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
temp = (yval->realval >= (LONGREAL)0 && xval->realval >= -1.79769296342094e+308 + yval->realval);
if (temp || (yval->realval < (LONGREAL)0 && xval->realval <= 1.79769296342094e+308 + yval->realval)) {
xval->realval = xval->realval - yval->realval;
@@ -1109,8 +1037,9 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
} else {
OPB_err(207);
}
- } else if (f == 9) {
+ } else if (f == 7) {
xval->setval = (xval->setval & ~yval->setval);
+ OPB_SetSetType(x);
} else if (f != 0) {
OPB_err(106);
}
@@ -1129,36 +1058,36 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
xval->intval = OPB_BoolToInt(ConstCmp__14() != 9);
break;
case 11:
- if (__IN(f, 0x2a04)) {
+ if (__IN(f, 0x0a84, 32)) {
OPB_err(108);
} else {
xval->intval = OPB_BoolToInt(ConstCmp__14() == 11);
}
break;
case 12:
- if (__IN(f, 0x2a04)) {
+ if (__IN(f, 0x0a84, 32)) {
OPB_err(108);
} else {
xval->intval = OPB_BoolToInt(ConstCmp__14() != 13);
}
break;
case 13:
- if (__IN(f, 0x2a04)) {
+ if (__IN(f, 0x0a84, 32)) {
OPB_err(108);
} else {
xval->intval = OPB_BoolToInt(ConstCmp__14() == 13);
}
break;
case 14:
- if (__IN(f, 0x2a04)) {
+ if (__IN(f, 0x0a84, 32)) {
OPB_err(108);
} else {
xval->intval = OPB_BoolToInt(ConstCmp__14() != 11);
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstOp, op = ", (LONGINT)37);
- OPM_LogWNum(op, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstOp, op = ", 37);
+ OPM_LogWNum(op, 0);
OPM_LogWLn();
break;
}
@@ -1168,22 +1097,28 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
{
OPT_Node node = NIL;
- INTEGER f, g;
- LONGINT k;
+ INT16 f, g;
+ INT64 k;
LONGREAL r;
f = (*x)->typ->form;
g = typ->form;
if ((*x)->class == 7) {
- if (__IN(f, 0x70)) {
- if (__IN(g, 0x70)) {
- if (f > g) {
+ if ((((f == 7 && g == 7)) && (*x)->typ->size > typ->size)) {
+ OPB_SetSetType(*x);
+ if ((*x)->typ->size > typ->size) {
+ OPB_err(203);
+ (*x)->conval->setval = 0x0;
+ }
+ } else if (f == 4) {
+ if (g == 4) {
+ if ((*x)->typ->size > typ->size) {
OPB_SetIntType(*x);
- if ((int)(*x)->typ->form > g) {
+ if ((*x)->typ->size > typ->size) {
OPB_err(203);
(*x)->conval->intval = 1;
}
}
- } else if (__IN(g, 0x0180)) {
+ } else if (__IN(g, 0x60, 32)) {
(*x)->conval->realval = (*x)->conval->intval;
(*x)->conval->intval = -1;
} else {
@@ -1192,21 +1127,21 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
OPB_err(220);
}
}
- } else if (__IN(f, 0x0180)) {
- if (__IN(g, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
+ if (__IN(g, 0x60, 32)) {
OPB_CheckRealType(g, 203, (*x)->conval);
} else {
r = (*x)->conval->realval;
- if (r < -2.14748364800000e+009 || r > 2.14748364700000e+009) {
+ if (r < -9.22337203685478e+018 || r > 9.22337203685478e+018) {
OPB_err(203);
r = (LONGREAL)1;
}
- (*x)->conval->intval = (int)__ENTIER(r);
+ (*x)->conval->intval = (INT32)__ENTIER(r);
OPB_SetIntType(*x);
}
}
(*x)->obj = NIL;
- } else if (((((*x)->class == 11 && (*x)->subcl == 20)) && ((int)(*x)->left->typ->form < f || f > g))) {
+ } else if (((((*x)->class == 11 && (*x)->subcl == 20)) && ((INT16)(*x)->left->typ->form < f || f > g))) {
if ((*x)->left->typ == typ) {
*x = (*x)->left;
}
@@ -1219,15 +1154,15 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
(*x)->typ = typ;
}
-static struct Op__40 {
- INTEGER *f, *g;
- struct Op__40 *lnk;
-} *Op__40_s;
+static struct Op__38 {
+ INT16 *f, *g;
+ struct Op__38 *lnk;
+} *Op__38_s;
-static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y);
-static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y);
+static void NewOp__39 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y);
+static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y);
-static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
+static void NewOp__39 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
{
OPT_Node node = NIL;
node = OPT_NewNode(12);
@@ -1238,50 +1173,48 @@ static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
*x = node;
}
-static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y)
+static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y)
{
- BOOLEAN _o_result;
BOOLEAN ok, xCharArr, yCharArr;
- xCharArr = (__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp->form == 3) || *Op__40_s->f == 10;
- yCharArr = (__IN((*y)->typ->comp, 0x0c) && (*y)->typ->BaseTyp->form == 3) || *Op__40_s->g == 10;
- if ((((xCharArr && *Op__40_s->g == 3)) && (*y)->class == 7)) {
+ xCharArr = (__IN((*x)->typ->comp, 0x0c, 32) && (*x)->typ->BaseTyp->form == 3) || *Op__38_s->f == 8;
+ yCharArr = (__IN((*y)->typ->comp, 0x0c, 32) && (*y)->typ->BaseTyp->form == 3) || *Op__38_s->g == 8;
+ if ((((xCharArr && *Op__38_s->g == 3)) && (*y)->class == 7)) {
OPB_CharToString(*y);
- *Op__40_s->g = 10;
+ *Op__38_s->g = 8;
yCharArr = 1;
}
- if ((((yCharArr && *Op__40_s->f == 3)) && (*x)->class == 7)) {
+ if ((((yCharArr && *Op__38_s->f == 3)) && (*x)->class == 7)) {
OPB_CharToString(*x);
- *Op__40_s->f = 10;
+ *Op__38_s->f = 8;
xCharArr = 1;
}
ok = (xCharArr && yCharArr);
if (ok) {
- if ((*Op__40_s->f == 10 && (*x)->conval->intval2 == 1)) {
+ if ((*Op__38_s->f == 8 && (*x)->conval->intval2 == 1)) {
(*x)->typ = OPT_chartyp;
(*x)->conval->intval = 0;
- OPB_Index(&*y, OPB_NewIntConst(((LONGINT)(0))));
- } else if ((*Op__40_s->g == 10 && (*y)->conval->intval2 == 1)) {
+ OPB_Index(&*y, OPB_NewIntConst(0));
+ } else if ((*Op__38_s->g == 8 && (*y)->conval->intval2 == 1)) {
(*y)->typ = OPT_chartyp;
(*y)->conval->intval = 0;
- OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0))));
+ OPB_Index(&*x, OPB_NewIntConst(0));
}
}
- _o_result = ok;
- return _o_result;
+ return ok;
}
-void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
+void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
{
- INTEGER f, g;
+ INT16 f, g;
OPT_Node t = NIL, z = NIL;
OPT_Struct typ = NIL;
BOOLEAN do_;
- LONGINT val;
- struct Op__40 _s;
+ INT64 val;
+ struct Op__38 _s;
_s.f = &f;
_s.g = &g;
- _s.lnk = Op__40_s;
- Op__40_s = &_s;
+ _s.lnk = Op__38_s;
+ Op__38_s = &_s;
z = *x;
if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) {
OPB_err(126);
@@ -1299,49 +1232,58 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(100);
}
break;
- case 4: case 5: case 6:
- if ((__IN(g, 0x70) && y->typ->size < z->typ->size)) {
+ case 4:
+ if ((g == 4 && y->typ->size < z->typ->size)) {
OPB_Convert(&y, z->typ);
- } else if (__IN(g, 0x01f0)) {
+ } else if (__IN(g, 0x70, 32)) {
OPB_Convert(&z, y->typ);
} else {
OPB_err(100);
}
break;
case 7:
- if (__IN(g, 0x70)) {
+ if ((g == 7 && y->typ->size < z->typ->size)) {
OPB_Convert(&y, z->typ);
- } else if (__IN(g, 0x0180)) {
+ } else if (g == 7) {
OPB_Convert(&z, y->typ);
} else {
OPB_err(100);
}
break;
- case 8:
- if (__IN(g, 0x01f0)) {
+ case 5:
+ if (g == 4) {
OPB_Convert(&y, z->typ);
- } else if (__IN(g, 0x0180)) {
+ } else if (__IN(g, 0x60, 32)) {
+ OPB_Convert(&z, y->typ);
+ } else {
+ OPB_err(100);
+ }
+ break;
+ case 6:
+ if (__IN(g, 0x70, 32)) {
+ OPB_Convert(&y, z->typ);
+ } else if (__IN(g, 0x60, 32)) {
OPB_Convert(&y, z->typ);
} else {
OPB_err(100);
}
break;
- case 11:
- if (!__IN(g, 0x6000)) {
+ case 9:
+ if (!__IN(g, 0x1800, 32)) {
OPB_err(100);
}
break;
- case 13:
+ case 11:
OPB_CheckPtr(z, y);
break;
- case 14:
- if (g != 11) {
+ case 12:
+ if (g != 9) {
OPB_err(100);
}
break;
- case 10:
+ case 8:
break;
- case 15:
+ case 13:
if (z->typ->comp == 4) {
OPB_err(100);
}
@@ -1357,7 +1299,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
switch (op) {
case 1:
do_ = 1;
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (z->class == 7) {
val = z->conval->intval;
if (val == 1) {
@@ -1388,35 +1330,35 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
y->obj = NIL;
}
}
- } else if (!__IN(f, 0x0381)) {
+ } else if (!__IN(f, 0xe1, 32)) {
OPB_err(105);
typ = OPT_undftyp;
}
if (do_) {
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
}
break;
case 2:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if ((y->class == 7 && y->conval->intval == 0)) {
OPB_err(205);
}
OPB_Convert(&z, OPT_realtyp);
OPB_Convert(&y, OPT_realtyp);
typ = OPT_realtyp;
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
if ((y->class == 7 && y->conval->realval == (LONGREAL)0)) {
OPB_err(205);
}
- } else if ((f != 9 && f != 0)) {
+ } else if ((f != 7 && f != 0)) {
OPB_err(102);
typ = OPT_undftyp;
}
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
break;
case 3:
do_ = 1;
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (y->class == 7) {
val = y->conval->intval;
if (val == 0) {
@@ -1435,11 +1377,11 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp;
}
if (do_) {
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
}
break;
case 4:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (y->class == 7) {
if (y->conval->intval == 0) {
OPB_err(205);
@@ -1453,7 +1395,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(104);
typ = OPT_undftyp;
}
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
break;
case 5:
if (f == 2) {
@@ -1463,7 +1405,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
} else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) {
} else {
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
}
} else if (f != 0) {
OPB_err(94);
@@ -1471,12 +1413,12 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
break;
case 6:
- if (!__IN(f, 0x03f1)) {
+ if (!__IN(f, 0xf1, 32)) {
OPB_err(105);
typ = OPT_undftyp;
}
do_ = 1;
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if ((z->class == 7 && z->conval->intval == 0)) {
do_ = 0;
z = y;
@@ -1486,16 +1428,16 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
}
if (do_) {
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
}
break;
case 7:
- if (!__IN(f, 0x03f1)) {
+ if (!__IN(f, 0xf1, 32)) {
OPB_err(106);
typ = OPT_undftyp;
}
- if ((!__IN(f, 0x70) || y->class != 7) || y->conval->intval != 0) {
- NewOp__41(op, typ, &z, y);
+ if ((f != 4 || y->class != 7) || y->conval->intval != 0) {
+ NewOp__39(op, typ, &z, y);
}
break;
case 8:
@@ -1506,7 +1448,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
} else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) {
} else {
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
}
} else if (f != 0) {
OPB_err(95);
@@ -1514,61 +1456,62 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
break;
case 9: case 10:
- if (__IN(f, 0x6bff) || strings__43(&z, &y)) {
+ if (__IN(f, 0x1aff, 32) || strings__41(&z, &y)) {
typ = OPT_booltyp;
} else {
OPB_err(107);
typ = OPT_undftyp;
}
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
break;
case 11: case 12: case 13: case 14:
- if (__IN(f, 0x01f9) || strings__43(&z, &y)) {
+ if (__IN(f, 0x79, 32) || strings__41(&z, &y)) {
typ = OPT_booltyp;
} else {
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"ELSE in Op()", (LONGINT)13);
+ OPM_LogWStr((CHAR*)"ELSE in Op()", 13);
OPM_LogWLn();
OPB_err(108);
typ = OPT_undftyp;
}
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", (LONGINT)32);
- OPM_LogWNum(op, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", 32);
+ OPM_LogWNum(op, 0);
OPM_LogWLn();
break;
}
}
*x = z;
- Op__40_s = _s.lnk;
+ Op__38_s = _s.lnk;
}
void OPB_SetRange (OPT_Node *x, OPT_Node y)
{
- LONGINT k, l;
+ INT64 k, l;
if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) {
OPB_err(126);
- } else if ((__IN((*x)->typ->form, 0x70) && __IN(y->typ->form, 0x70))) {
+ } else if (((*x)->typ->form == 4 && y->typ->form == 4)) {
if ((*x)->class == 7) {
k = (*x)->conval->intval;
- if (0 > k || k > (int)OPM_MaxSet) {
+ if (0 > k || k > 63) {
OPB_err(202);
}
}
if (y->class == 7) {
l = y->conval->intval;
- if (0 > l || l > (int)OPM_MaxSet) {
+ if (0 > l || l > 63) {
OPB_err(202);
}
}
if (((*x)->class == 7 && y->class == 7)) {
if (k <= l) {
- (*x)->conval->setval = __SETRNG(k, l);
+ (*x)->conval->setval = __SETRNG(k, l, 32);
+ OPB_SetSetType(*x);
} else {
OPB_err(201);
- (*x)->conval->setval = __SETRNG(l, k);
+ (*x)->conval->setval = __SETRNG(l, k, 32);
}
(*x)->obj = NIL;
} else {
@@ -1582,86 +1525,69 @@ void OPB_SetRange (OPT_Node *x, OPT_Node y)
void OPB_SetElem (OPT_Node *x)
{
- LONGINT k;
+ INT64 k;
if ((*x)->class == 8 || (*x)->class == 9) {
OPB_err(126);
- } else if (!__IN((*x)->typ->form, 0x70)) {
+ } else if ((*x)->typ->form != 4) {
OPB_err(93);
} else if ((*x)->class == 7) {
k = (*x)->conval->intval;
- if ((0 <= k && k <= (int)OPM_MaxSet)) {
- (*x)->conval->setval = __SETOF(k);
+ if ((0 <= k && k <= 63)) {
+ (*x)->conval->setval = 0x0;
+ (*x)->conval->setval |= __SETOF(k,64);
} else {
OPB_err(202);
}
+ OPB_SetSetType(*x);
(*x)->obj = NIL;
} else {
OPB_Convert(&*x, OPT_settyp);
+ (*x)->typ = OPT_settyp;
}
- (*x)->typ = OPT_settyp;
}
static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
{
OPT_Struct y = NIL;
- INTEGER f, g;
+ INT16 f, g;
OPT_Struct p = NIL, q = NIL;
- if (OPM_Verbose) {
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"PROCEDURE CheckAssign", (LONGINT)22);
- OPM_LogWLn();
- }
y = ynode->typ;
f = x->form;
g = y->form;
- if (OPM_Verbose) {
- OPM_LogWStr((CHAR*)"y.form = ", (LONGINT)10);
- OPM_LogWNum(y->form, ((LONGINT)(0)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"f = ", (LONGINT)5);
- OPM_LogWNum(f, ((LONGINT)(0)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"g = ", (LONGINT)5);
- OPM_LogWNum(g, ((LONGINT)(0)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"ynode.typ.syze = ", (LONGINT)18);
- OPM_LogWNum(ynode->typ->size, ((LONGINT)(0)));
- OPM_LogWLn();
- }
- if (ynode->class == 8 || (ynode->class == 9 && f != 14)) {
+ if (ynode->class == 8 || (ynode->class == 9 && f != 12)) {
OPB_err(126);
}
switch (f) {
- case 0: case 10:
+ case 0: case 8:
break;
case 1:
- if (!((__IN(g, 0x7a) && y->size == 1))) {
+ if (!((__IN(g, 0x1a, 32) && y->size == 1))) {
OPB_err(113);
}
break;
- case 2: case 3: case 9:
+ case 2: case 3:
if (g != f) {
OPB_err(113);
}
break;
- case 4: case 5: case 6:
- if (!__IN(g, 0x70) || x->size < y->size) {
+ case 4: case 7:
+ if (g != f || x->size < y->size) {
OPB_err(113);
}
break;
- case 7:
- if (!__IN(g, 0xf0)) {
+ case 5:
+ if (!__IN(g, 0x30, 32)) {
OPB_err(113);
}
break;
- case 8:
- if (!__IN(g, 0x01f0)) {
+ case 6:
+ if (!__IN(g, 0x70, 32)) {
OPB_err(113);
}
break;
- case 13:
- if ((x == y || g == 11) || (x == OPT_sysptrtyp && g == 13)) {
- } else if (g == 13) {
+ case 11:
+ if ((x == y || g == 9) || (x == OPT_sysptrtyp && g == 11)) {
+ } else if (g == 11) {
p = x->BaseTyp;
q = y->BaseTyp;
if ((p->comp == 4 && q->comp == 4)) {
@@ -1678,32 +1604,32 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
OPB_err(113);
}
break;
- case 14:
+ case 12:
if (ynode->class == 9) {
OPB_CheckProc(x, ynode->obj);
- } else if (x == y || g == 11) {
+ } else if (x == y || g == 9) {
} else {
OPB_err(113);
}
break;
- case 12: case 11:
+ case 10: case 9:
OPB_err(113);
break;
- case 15:
+ case 13:
x->pvused = 1;
if (x->comp == 2) {
if ((ynode->class == 7 && g == 3)) {
OPB_CharToString(ynode);
y = ynode->typ;
- g = 10;
+ g = 8;
}
if (x == y) {
} else if (x->BaseTyp == OPT_chartyp) {
- if (g == 10) {
+ if (g == 8) {
if (ynode->conval->intval2 > x->n) {
OPB_err(114);
}
- } else if ((__IN(y->comp, 0x0c) && y->BaseTyp == OPT_chartyp)) {
+ } else if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
} else {
OPB_err(113);
}
@@ -1711,7 +1637,7 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
OPB_err(113);
}
} else if ((x->comp == 3 && x->BaseTyp == OPT_chartyp)) {
- if ((__IN(y->comp, 0x0c) && y->BaseTyp == OPT_chartyp)) {
+ if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
} else {
OPB_err(113);
}
@@ -1733,12 +1659,12 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.CheckAssign, f = ", (LONGINT)40);
- OPM_LogWNum(f, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.CheckAssign, f = ", 40);
+ OPM_LogWNum(f, 0);
OPM_LogWLn();
break;
}
- if ((((((ynode->class == 7 && g < f)) && __IN(g, 0xf0))) && __IN(f, 0x01e0))) {
+ if ((((((ynode->class == 7 && g < f)) && __IN(g, 0x30, 32))) && __IN(f, 0x70, 32))) {
OPB_Convert(&ynode, x);
}
}
@@ -1747,16 +1673,16 @@ static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo)
{
}
-void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
+void OPB_StPar0 (OPT_Node *par0, INT16 fctno)
{
- INTEGER f;
+ INT16 f;
OPT_Struct typ = NIL;
OPT_Node x = NIL;
x = *par0;
f = x->typ->form;
switch (fctno) {
case 0:
- if ((__IN(f, 0x70) && x->class == 7)) {
+ if ((f == 4 && x->class == 7)) {
if ((0 <= x->conval->intval && x->conval->intval <= 255)) {
OPB_BindNodes(28, OPT_notyp, &x, x);
} else {
@@ -1771,12 +1697,12 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
typ = OPT_notyp;
if (OPB_NotVar(x)) {
OPB_err(112);
- } else if (f == 13) {
+ } else if (f == 11) {
if (x->readonly) {
OPB_err(76);
}
f = x->typ->BaseTyp->comp;
- if (__IN(f, 0x1c)) {
+ if (__IN(f, 0x1c, 32)) {
if (f == 3) {
typ = x->typ->BaseTyp;
}
@@ -1809,7 +1735,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 5:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
OPB_Convert(&x, OPT_linttyp);
} else {
OPB_err(111);
@@ -1826,20 +1752,20 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
x = OPB_NewBoolConst(0);
break;
case 3:
- x = OPB_NewIntConst(((LONGINT)(0)));
+ x = OPB_NewIntConst(0);
x->typ = OPT_chartyp;
break;
- case 4: case 5: case 6:
+ case 4:
x = OPB_NewIntConst(OPM_SignedMinimum(x->typ->size));
break;
- case 9:
- x = OPB_NewIntConst(((LONGINT)(0)));
+ case 7:
+ x = OPB_NewIntConst(0);
x->typ = OPT_inttyp;
break;
- case 7:
+ case 5:
x = OPB_NewRealConst(OPM_MinReal, OPT_realtyp);
break;
- case 8:
+ case 6:
x = OPB_NewRealConst(OPM_MinLReal, OPT_lrltyp);
break;
default:
@@ -1857,20 +1783,20 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
x = OPB_NewBoolConst(1);
break;
case 3:
- x = OPB_NewIntConst(((LONGINT)(255)));
+ x = OPB_NewIntConst(255);
x->typ = OPT_chartyp;
break;
- case 4: case 5: case 6:
+ case 4:
x = OPB_NewIntConst(OPM_SignedMaximum(x->typ->size));
break;
- case 9:
- x = OPB_NewIntConst(OPM_MaxSet);
+ case 7:
+ x = OPB_NewIntConst(__ASHL(x->typ->size, 3) - 1);
x->typ = OPT_inttyp;
break;
- case 7:
+ case 5:
x = OPB_NewRealConst(OPM_MaxReal, OPT_realtyp);
break;
- case 8:
+ case 6:
x = OPB_NewRealConst(OPM_MaxLReal, OPT_lrltyp);
break;
default:
@@ -1884,7 +1810,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 9:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x71)) {
+ } else if (__IN(f, 0x11, 32)) {
OPB_Convert(&x, OPT_chartyp);
} else {
OPB_err(111);
@@ -1894,9 +1820,14 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 10:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if ((__IN(f, 0x70) && x->typ->size > (int)OPM_SIntSize)) {
- OPB_Convert(&x, OPB_IntType(OPB_ShorterSize(x->typ->size)));
- } else if (f == 8) {
+ } else if (f == 4) {
+ typ = OPT_ShorterOrLongerType(x->typ, -1);
+ if (typ == NIL) {
+ OPB_err(111);
+ } else {
+ OPB_Convert(&x, typ);
+ }
+ } else if (f == 6) {
OPB_Convert(&x, OPT_realtyp);
} else {
OPB_err(111);
@@ -1905,9 +1836,14 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 11:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if ((__IN(f, 0x70) && x->typ->size < (int)OPM_LIntSize)) {
- OPB_Convert(&x, OPB_IntType(OPB_LongerSize(x->typ->size)));
- } else if (f == 7) {
+ } else if (f == 4) {
+ typ = OPT_ShorterOrLongerType(x->typ, 1);
+ if (typ == NIL) {
+ OPB_err(111);
+ } else {
+ OPB_Convert(&x, typ);
+ }
+ } else if (f == 5) {
OPB_Convert(&x, OPT_lrltyp);
} else if (f == 3) {
OPB_Convert(&x, OPT_linttyp);
@@ -1918,7 +1854,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 13: case 14:
if (OPB_NotVar(x)) {
OPB_err(112);
- } else if (!__IN(f, 0x70)) {
+ } else if (f != 4) {
OPB_err(111);
} else if (x->readonly) {
OPB_err(76);
@@ -1927,7 +1863,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 15: case 16:
if (OPB_NotVar(x)) {
OPB_err(112);
- } else if (x->typ != OPT_settyp) {
+ } else if (x->typ->form != 7) {
OPB_err(111);
x->typ = OPT_settyp;
} else if (x->readonly) {
@@ -1935,26 +1871,26 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
}
break;
case 17:
- if (!__IN(x->typ->comp, 0x0c)) {
+ if (!__IN(x->typ->comp, 0x0c, 32)) {
OPB_err(131);
}
break;
case 18:
if ((x->class == 7 && f == 3)) {
OPB_CharToString(x);
- f = 10;
+ f = 8;
}
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (((!__IN(x->typ->comp, 0x0c) || x->typ->BaseTyp->form != 3) && f != 10)) {
+ } else if (((!__IN(x->typ->comp, 0x0c, 32) || x->typ->BaseTyp->form != 3) && f != 8)) {
OPB_err(111);
}
break;
case 19:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
- if (x->typ->size != (int)OPM_LIntSize) {
+ } else if (f == 4) {
+ if (x->typ->size < OPT_linttyp->size) {
OPB_Convert(&x, OPT_linttyp);
}
} else {
@@ -1969,14 +1905,14 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 12:
if (x->class != 8) {
OPB_err(110);
- x = OPB_NewIntConst(((LONGINT)(1)));
- } else if (__IN(f, 0x63fe) || __IN(x->typ->comp, 0x14)) {
- (*OPB_typSize)(x->typ);
+ x = OPB_NewIntConst(1);
+ } else if (__IN(f, 0x18fe, 32) || __IN(x->typ->comp, 0x14, 32)) {
+ OPT_TypSize(x->typ);
x->typ->pvused = 1;
x = OPB_NewIntConst(x->typ->size);
} else {
OPB_err(111);
- x = OPB_NewIntConst(((LONGINT)(1)));
+ x = OPB_NewIntConst(1);
}
break;
case 21:
@@ -1985,22 +1921,22 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 22: case 23:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (!__IN(f, 0x027a)) {
+ } else if (!__IN(f, 0x9a, 32)) {
OPB_err(111);
}
break;
case 24: case 25: case 28: case 31:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if ((((x->class == 7 && __IN(f, 0x70))) && x->typ->size < OPT_linttyp->size)) {
- OPB_Convert(&x, OPT_linttyp);
- } else if (!((__IN(x->typ->form, 0x2070) && x->typ->size == (int)OPM_PointerSize))) {
+ } else if ((((x->class == 7 && f == 4)) && x->typ->size < OPT_adrtyp->size)) {
+ OPB_Convert(&x, OPT_adrtyp);
+ } else if (!((__IN(x->typ->form, 0x0810, 32) && x->typ->size == OPM_AddressSize))) {
OPB_err(111);
- x->typ = OPT_linttyp;
+ x->typ = OPT_adrtyp;
}
break;
case 26: case 27:
- if ((__IN(f, 0x70) && x->class == 7)) {
+ if ((f == 4 && x->class == 7)) {
if (x->conval->intval < 0 || x->conval->intval > -1) {
OPB_err(220);
}
@@ -2011,14 +1947,14 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 29:
if (x->class != 8) {
OPB_err(110);
- } else if (__IN(f, 0x1401) || x->typ->comp == 3) {
+ } else if (__IN(f, 0x0501, 32) || x->typ->comp == 3) {
OPB_err(111);
}
break;
case 30:
if (OPB_NotVar(x)) {
OPB_err(112);
- } else if (f == 13) {
+ } else if (f == 11) {
} else {
OPB_err(111);
}
@@ -2035,40 +1971,38 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.StPar0, fctno = ", (LONGINT)39);
- OPM_LogWNum(fctno, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.StPar0, fctno = ", 39);
+ OPM_LogWNum(fctno, 0);
OPM_LogWLn();
break;
}
*par0 = x;
}
-static struct StPar1__56 {
- struct StPar1__56 *lnk;
-} *StPar1__56_s;
+static struct StPar1__53 {
+ struct StPar1__53 *lnk;
+} *StPar1__53_s;
-static OPT_Node NewOp__57 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right);
+static OPT_Node NewOp__54 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right);
-static OPT_Node NewOp__57 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right)
+static OPT_Node NewOp__54 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right)
{
- OPT_Node _o_result;
OPT_Node node = NIL;
node = OPT_NewNode(class);
node->subcl = subcl;
node->left = left;
node->right = right;
- _o_result = node;
- return _o_result;
+ return node;
}
-void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
+void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
{
- INTEGER f, L;
+ INT16 f, L;
OPT_Struct typ = NIL;
OPT_Node p = NIL, t = NIL;
- struct StPar1__56 _s;
- _s.lnk = StPar1__56_s;
- StPar1__56_s = &_s;
+ struct StPar1__53 _s;
+ _s.lnk = StPar1__53_s;
+ StPar1__53_s = &_s;
p = *par0;
f = x->typ->form;
switch (fctno) {
@@ -2078,40 +2012,40 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
p->typ = OPT_notyp;
} else {
if (x->typ != p->typ) {
- if ((x->class == 7 && __IN(f, 0x70))) {
+ if ((f == 4 && (x->class == 7 || (p->typ->form == 4 && x->typ->size <= p->typ->size)))) {
OPB_Convert(&x, p->typ);
} else {
OPB_err(111);
}
}
- p = NewOp__57(19, fctno, p, x);
+ p = NewOp__54(19, fctno, p, x);
p->typ = OPT_notyp;
}
break;
case 15: case 16:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
- if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval > (int)OPM_MaxSet))) {
+ } else if (f == 4) {
+ if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval >= (INT64)__ASHL(p->typ->size, 3)))) {
OPB_err(202);
}
- p = NewOp__57(19, fctno, p, x);
+ p = NewOp__54(19, fctno, p, x);
} else {
OPB_err(111);
}
p->typ = OPT_notyp;
break;
case 17:
- if (!__IN(f, 0x70) || x->class != 7) {
+ if (!(f == 4) || x->class != 7) {
OPB_err(69);
} else if (x->typ->size == 1) {
- L = (int)x->conval->intval;
+ L = OPM_Integer(x->conval->intval);
typ = p->typ;
- while ((L > 0 && __IN(typ->comp, 0x0c))) {
+ while ((L > 0 && __IN(typ->comp, 0x0c, 32))) {
typ = typ->BaseTyp;
L -= 1;
}
- if (L != 0 || !__IN(typ->comp, 0x0c)) {
+ if (L != 0 || !__IN(typ->comp, 0x0c, 32)) {
OPB_err(132);
} else {
x->obj = NIL;
@@ -2120,7 +2054,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
p = p->left;
x->conval->intval += 1;
}
- p = NewOp__57(12, 19, p, x);
+ p = NewOp__54(12, 19, p, x);
p->typ = OPT_linttyp;
} else {
p = x;
@@ -2135,14 +2069,14 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 18:
if (OPB_NotVar(x)) {
OPB_err(112);
- } else if ((__IN(x->typ->comp, 0x0c) && x->typ->BaseTyp->form == 3)) {
+ } else if ((__IN(x->typ->comp, 0x0c, 32) && x->typ->BaseTyp->form == 3)) {
if (x->readonly) {
OPB_err(76);
}
t = x;
x = p;
p = t;
- p = NewOp__57(19, 18, p, x);
+ p = NewOp__54(19, 18, p, x);
} else {
OPB_err(111);
}
@@ -2151,14 +2085,14 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 19:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
+ } else if (f == 4) {
if ((p->class == 7 && x->class == 7)) {
if (-OPB_maxExp > x->conval->intval || x->conval->intval > OPB_maxExp) {
OPB_err(208);
p->conval->intval = 1;
} else if (x->conval->intval >= 0) {
- if (__ABS(p->conval->intval) <= __DIV(2147483647, __ASH(1, x->conval->intval))) {
- p->conval->intval = p->conval->intval * __ASH(1, x->conval->intval);
+ 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);
p->conval->intval = 1;
@@ -2168,8 +2102,8 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
}
p->obj = NIL;
} else {
- p = NewOp__57(12, 17, p, x);
- p->typ = OPT_linttyp;
+ p = NewOp__54(12, 17, p, x);
+ p->typ = p->left->typ;
}
} else {
OPB_err(111);
@@ -2179,7 +2113,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if (p->typ->comp == 3) {
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) {
OPB_err(63);
}
@@ -2195,13 +2129,13 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 22: case 23:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (!__IN(f, 0x70)) {
+ } else if (f != 4) {
OPB_err(111);
} else {
if (fctno == 22) {
- p = NewOp__57(12, 27, p, x);
+ p = NewOp__54(12, 27, p, x);
} else {
- p = NewOp__57(12, 28, p, x);
+ p = NewOp__54(12, 28, p, x);
}
p->typ = p->left->typ;
}
@@ -2209,7 +2143,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 24: case 25: case 26: case 27:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x63ff)) {
+ } else if (__IN(f, 0x18ff, 32)) {
if (fctno == 24 || fctno == 26) {
if (OPB_NotVar(x)) {
OPB_err(112);
@@ -2218,7 +2152,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
x = p;
p = t;
}
- p = NewOp__57(19, fctno, p, x);
+ p = NewOp__54(19, fctno, p, x);
} else {
OPB_err(111);
}
@@ -2227,32 +2161,38 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 28:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
- p = NewOp__57(12, 26, p, x);
+ } else if (f == 4) {
+ p = NewOp__54(12, 26, p, x);
} else {
OPB_err(111);
}
p->typ = OPT_booltyp;
break;
case 29:
- if (((x->class == 8 || x->class == 9) || __IN(f, 0x1401)) || x->typ->comp == 3) {
+ if (((x->class == 8 || x->class == 9) || __IN(f, 0x0501, 32)) || x->typ->comp == 3) {
OPB_err(126);
}
- if (x->typ->size < p->typ->size) {
+ OPT_TypSize(x->typ);
+ OPT_TypSize(p->typ);
+ if ((x->class != 7 && x->typ->size < p->typ->size)) {
OPB_err(-308);
}
- t = OPT_NewNode(11);
- t->subcl = 29;
- t->left = x;
- x = t;
- x->typ = p->typ;
+ if ((((x->class == 7 && x->typ->form == 4)) && p->typ->form == 4)) {
+ OPB_Convert(&x, p->typ);
+ } else {
+ t = OPT_NewNode(11);
+ t->subcl = 29;
+ t->left = x;
+ x = t;
+ x->typ = p->typ;
+ }
p = x;
break;
case 30:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
- p = NewOp__57(19, 30, p, x);
+ } else if (f == 4) {
+ p = NewOp__54(19, 30, p, x);
} else {
OPB_err(111);
}
@@ -2261,16 +2201,16 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 31:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if ((((x->class == 7 && __IN(f, 0x70))) && x->typ->size < OPT_linttyp->size)) {
- OPB_Convert(&x, OPT_linttyp);
- } else if (!((__IN(x->typ->form, 0x2070) && x->typ->size == (int)OPM_PointerSize))) {
+ } else if ((((x->class == 7 && f == 4)) && x->typ->size < OPT_adrtyp->size)) {
+ OPB_Convert(&x, OPT_adrtyp);
+ } else if (!((__IN(x->typ->form, 0x0810, 32) && x->typ->size == OPM_AddressSize))) {
OPB_err(111);
- x->typ = OPT_linttyp;
+ x->typ = OPT_adrtyp;
}
p->link = x;
break;
case 32:
- if ((__IN(f, 0x70) && x->class == 7)) {
+ if ((f == 4 && x->class == 7)) {
if ((0 <= x->conval->intval && x->conval->intval <= 255)) {
OPB_BindNodes(28, OPT_notyp, &x, x);
x->conval = OPT_NewConst();
@@ -2298,13 +2238,13 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
break;
}
*par0 = p;
- StPar1__56_s = _s.lnk;
+ StPar1__53_s = _s.lnk;
}
-void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
+void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n)
{
OPT_Node node = NIL;
- INTEGER f;
+ INT16 f;
OPT_Node p = NIL;
p = *par0;
f = x->typ->form;
@@ -2313,7 +2253,7 @@ void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
OPB_err(126);
} else if (p->typ->comp != 3) {
OPB_err(64);
- } else if (__IN(f, 0x70)) {
+ } else if (f == 4) {
if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) {
OPB_err(63);
}
@@ -2329,7 +2269,7 @@ void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
} else if ((fctno == 31 && n == 2)) {
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
+ } else if (f == 4) {
node = OPT_NewNode(19);
node->subcl = 31;
node->right = p;
@@ -2346,9 +2286,9 @@ void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
*par0 = p;
}
-void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno)
+void OPB_StFct (OPT_Node *par0, INT8 fctno, INT16 parno)
{
- INTEGER dim;
+ INT16 dim;
OPT_Node x = NIL, p = NIL;
p = *par0;
if (fctno <= 19) {
@@ -2363,7 +2303,7 @@ void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno)
}
} else {
if (((fctno == 13 || fctno == 14) && parno == 1)) {
- OPB_BindNodes(19, OPT_notyp, &p, OPB_NewIntConst(((LONGINT)(1))));
+ OPB_BindNodes(19, OPT_notyp, &p, OPB_NewIntConst(1));
p->subcl = fctno;
p->right->typ = p->left->typ;
} else if ((fctno == 17 && parno == 1)) {
@@ -2385,7 +2325,7 @@ void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno)
} else if (fctno == 32) {
if (parno == 1) {
x = NIL;
- OPB_BindNodes(28, OPT_notyp, &x, OPB_NewIntConst(((LONGINT)(0))));
+ OPB_BindNodes(28, OPT_notyp, &x, OPB_NewIntConst(0));
x->conval = OPT_NewConst();
x->conval->intval = OPM_errpos;
OPB_Construct(15, &p, x);
@@ -2412,21 +2352,21 @@ void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno)
static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar)
{
- INTEGER f;
+ INT16 f;
f = atyp->comp;
ftyp = ftyp->BaseTyp;
atyp = atyp->BaseTyp;
if ((fvarpar && ftyp == OPT_bytetyp)) {
- if (!__IN(f, 0x0c) || !((__IN(atyp->form, 0x7e) && atyp->size == 1))) {
- if (__IN(18, OPM_opt)) {
+ if (!__IN(f, 0x0c, 32) || !((__IN(atyp->form, 0x1e, 32) && atyp->size == 1))) {
+ if (__IN(18, OPM_Options, 32)) {
OPB_err(-301);
}
}
- } else if (__IN(f, 0x0c)) {
+ } else if (__IN(f, 0x0c, 32)) {
if (ftyp->comp == 3) {
OPB_DynArrParCheck(ftyp, atyp, fvarpar);
} else if (ftyp != atyp) {
- if ((((!fvarpar && ftyp->form == 13)) && atyp->form == 13)) {
+ if ((((!fvarpar && ftyp->form == 11)) && atyp->form == 11)) {
ftyp = ftyp->BaseTyp;
atyp = atyp->BaseTyp;
if ((ftyp->comp == 4 && atyp->comp == 4)) {
@@ -2450,7 +2390,7 @@ static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpa
static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp)
{
- if (fp->typ->form == 13) {
+ if (fp->typ->form == 11) {
if ((*x)->class == 3) {
*x = (*x)->left;
} else {
@@ -2461,13 +2401,13 @@ static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp)
void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar)
{
- if (((*x)->obj != NIL && __IN((*x)->obj->mode, 0x22c0))) {
+ if (((*x)->obj != NIL && __IN((*x)->obj->mode, 0x22c0, 32))) {
*fpar = (*x)->obj->link;
if ((*x)->obj->mode == 13) {
OPB_CheckReceiver(&(*x)->left, *fpar);
*fpar = (*fpar)->link;
}
- } else if (((((*x)->class != 8 && (*x)->typ != NIL)) && (*x)->typ->form == 14)) {
+ } else if (((((*x)->class != 8 && (*x)->typ != NIL)) && (*x)->typ->form == 12)) {
*fpar = (*x)->typ->link;
} else {
OPB_err(121);
@@ -2499,17 +2439,17 @@ void OPB_Param (OPT_Node ap, OPT_Object fp)
if (q == NIL) {
OPB_err(111);
}
- } else if ((fp->typ == OPT_sysptrtyp && ap->typ->form == 13)) {
- } else if ((ap->typ != fp->typ && !((fp->typ->form == 1 && ((__IN(ap->typ->form, 0x7e) && ap->typ->size == 1)))))) {
+ } else if ((fp->typ == OPT_sysptrtyp && ap->typ->form == 11)) {
+ } else if ((ap->typ != fp->typ && !((((fp->typ->form == 1 && __IN(ap->typ->form, 0x1e, 32))) && ap->typ->size == 1)))) {
OPB_err(123);
- } else if ((fp->typ->form == 13 && ap->class == 5)) {
+ } else if ((fp->typ->form == 11 && ap->class == 5)) {
OPB_err(123);
}
} else if (fp->typ->comp == 3) {
if ((ap->class == 7 && ap->typ->form == 3)) {
OPB_CharToString(ap);
}
- if ((ap->typ->form == 10 && fp->typ->BaseTyp->form == 3)) {
+ if ((ap->typ->form == 8 && fp->typ->BaseTyp->form == 3)) {
} else if (ap->class >= 7) {
OPB_err(59);
} else {
@@ -2521,13 +2461,13 @@ void OPB_Param (OPT_Node ap, OPT_Object fp)
}
}
-void OPB_StaticLink (SHORTINT dlev)
+void OPB_StaticLink (INT8 dlev)
{
OPT_Object scope = NIL;
scope = OPT_topScope;
while (dlev > 0) {
dlev -= 1;
- scope->link->conval->setval |= __SETOF(3);
+ scope->link->conval->setval |= __SETOF(3,64);
scope = scope->left;
}
}
@@ -2536,7 +2476,7 @@ void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp)
{
OPT_Struct typ = NIL;
OPT_Node p = NIL;
- SHORTINT lev;
+ INT8 lev;
if ((*x)->class == 9) {
typ = (*x)->typ;
lev = (*x)->obj->mnolev;
@@ -2596,7 +2536,7 @@ void OPB_Return (OPT_Node *x, OPT_Object proc)
void OPB_Assign (OPT_Node *x, OPT_Node y)
{
OPT_Node z = NIL;
- SHORTINT subcl;
+ INT8 subcl;
if ((*x)->class >= 7) {
OPB_err(56);
}
@@ -2617,12 +2557,12 @@ void OPB_Assign (OPT_Node *x, OPT_Node y)
OPB_BindNodes(6, (*x)->typ, &z, NIL);
*x = z;
}
- } else if (((((((*x)->typ->comp == 2 && (*x)->typ->BaseTyp == OPT_chartyp)) && y->typ->form == 10)) && y->conval->intval2 == 1)) {
+ } else if (((((((*x)->typ->comp == 2 && (*x)->typ->BaseTyp == OPT_chartyp)) && y->typ->form == 8)) && y->conval->intval2 == 1)) {
y->typ = OPT_chartyp;
y->conval->intval = 0;
- OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0))));
+ OPB_Index(&*x, OPB_NewIntConst(0));
}
- if ((((((__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp == OPT_chartyp)) && __IN(y->typ->comp, 0x0c))) && y->typ->BaseTyp == OPT_chartyp)) {
+ 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;
@@ -2655,7 +2595,7 @@ export void *OPB__init(void)
__MODULE_IMPORT(OPT);
__REGMOD("OPB", 0);
/* BEGIN */
- OPB_maxExp = OPB_log(1073741824);
+ OPB_maxExp = OPB_log(4611686018427387904);
OPB_maxExp = OPB_exp;
__ENDMOD;
}
diff --git a/bootstrap/unix-44/OPB.h b/bootstrap/unix-44/OPB.h
index d1c88266..0be714e8 100644
--- a/bootstrap/unix-44/OPB.h
+++ b/bootstrap/unix-44/OPB.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPB__h
#define OPB__h
@@ -8,13 +8,12 @@
#include "OPT.h"
-import void (*OPB_typSize)(OPT_Struct);
import void OPB_Assign (OPT_Node *x, OPT_Node y);
import void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp);
import void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames);
-import void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y);
+import void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y);
import void OPB_DeRef (OPT_Node *x);
import OPT_Node OPB_EmptySet (void);
import void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc);
@@ -23,27 +22,27 @@ import void OPB_In (OPT_Node *x, OPT_Node y);
import void OPB_Index (OPT_Node *x, OPT_Node y);
import void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ);
import void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y);
-import void OPB_MOp (SHORTINT op, OPT_Node *x);
+import void OPB_MOp (INT8 op, OPT_Node *x);
import OPT_Node OPB_NewBoolConst (BOOLEAN boolval);
-import OPT_Node OPB_NewIntConst (LONGINT intval);
+import OPT_Node OPB_NewIntConst (INT64 intval);
import OPT_Node OPB_NewLeaf (OPT_Object obj);
import OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ);
-import OPT_Node OPB_NewString (OPS_String str, LONGINT len);
+import OPT_Node OPB_NewString (OPS_String str, INT64 len);
import OPT_Node OPB_Nil (void);
-import void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y);
+import void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y);
import void OPB_OptIf (OPT_Node *x);
import void OPB_Param (OPT_Node ap, OPT_Object fp);
import void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar);
import void OPB_Return (OPT_Node *x, OPT_Object proc);
import void OPB_SetElem (OPT_Node *x);
import void OPB_SetRange (OPT_Node *x, OPT_Node y);
-import void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno);
-import void OPB_StPar0 (OPT_Node *par0, INTEGER fctno);
-import void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno);
-import void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n);
-import void OPB_StaticLink (SHORTINT dlev);
+import void OPB_StFct (OPT_Node *par0, INT8 fctno, INT16 parno);
+import void OPB_StPar0 (OPT_Node *par0, INT16 fctno);
+import void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno);
+import void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n);
+import void OPB_StaticLink (INT8 dlev);
import void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard);
import void *OPB__init(void);
-#endif
+#endif // OPB
diff --git a/bootstrap/unix-44/OPC.c b/bootstrap/unix-44/OPC.c
index 3abccc9a..ef4b429f 100644
--- a/bootstrap/unix-44/OPC.c
+++ b/bootstrap/unix-44/OPC.c
@@ -1,31 +1,34 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "Configuration.h"
#include "OPM.h"
#include "OPT.h"
-static INTEGER OPC_indentLevel;
-static BOOLEAN OPC_ptrinit, OPC_mainprog, OPC_ansi;
-static SHORTINT OPC_hashtab[105];
-static CHAR OPC_keytab[36][9];
+static INT16 OPC_indentLevel;
+static INT8 OPC_hashtab[105];
+static CHAR OPC_keytab[50][9];
static BOOLEAN OPC_GlbPtrs;
static CHAR OPC_BodyNameExt[13];
-export void OPC_Align (LONGINT *adr, LONGINT base);
export void OPC_Andent (OPT_Struct typ);
static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames);
-export LONGINT OPC_BaseAlignment (OPT_Struct typ);
export OPT_Object OPC_BaseTProc (OPT_Object obj);
export void OPC_BegBlk (void);
export void OPC_BegStat (void);
-static void OPC_CProcDefs (OPT_Object obj, INTEGER vis);
-export void OPC_Case (LONGINT caseVal, INTEGER form);
-static void OPC_CharacterLiteral (LONGINT c);
-export void OPC_Cmp (INTEGER rel);
+static void OPC_CProcDefs (OPT_Object obj, INT16 vis);
+export void OPC_Case (INT64 caseVal, INT16 form);
+static void OPC_CharacterLiteral (INT64 c);
+export void OPC_Cmp (INT16 rel);
export void OPC_CompleteIdent (OPT_Object obj);
-export void OPC_Constant (OPT_Const con, INTEGER form);
+export void OPC_Constant (OPT_Const con, INT16 form);
static void OPC_DeclareBase (OPT_Object dcl);
static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef);
static void OPC_DeclareParams (OPT_Object par, BOOLEAN macro);
@@ -42,44 +45,45 @@ export void OPC_EnterBody (void);
export void OPC_EnterProc (OPT_Object proc);
export void OPC_ExitBody (void);
export void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet);
-static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *n, LONGINT *curAlign);
-static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LONGINT *curAlign);
+static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, INT32 *off, INT32 *n, INT32 *curAlign);
+static void OPC_FillGap (INT32 gap, INT32 off, INT32 align, INT32 *n, INT32 *curAlign);
export void OPC_GenBdy (OPT_Node n);
-static void OPC_GenDynTypes (OPT_Node n, INTEGER vis);
+static void OPC_GenDynTypes (OPT_Node n, INT16 vis);
export void OPC_GenEnumPtrs (OPT_Object var);
export void OPC_GenHdr (OPT_Node n);
export void OPC_GenHdrIncludes (void);
static void OPC_GenHeaderMsg (void);
-export void OPC_Halt (LONGINT n);
+export void OPC_Halt (INT32 n);
export void OPC_Ident (OPT_Object obj);
-static void OPC_IdentList (OPT_Object obj, INTEGER vis);
+static void OPC_IdentList (OPT_Object obj, INT16 vis);
static void OPC_Include (CHAR *name, LONGINT name__len);
-static void OPC_IncludeImports (OPT_Object obj, INTEGER vis);
+static void OPC_IncludeImports (OPT_Object obj, INT16 vis);
export void OPC_Increment (BOOLEAN decrement);
-export void OPC_Indent (INTEGER count);
+export void OPC_Indent (INT16 count);
export void OPC_Init (void);
static void OPC_InitImports (OPT_Object obj);
static void OPC_InitKeywords (void);
export void OPC_InitTDesc (OPT_Struct typ);
static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj);
-export void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim);
+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 INTEGER OPC_Length (CHAR *s, LONGINT s__len);
-export LONGINT OPC_NofPtrs (OPT_Struct typ);
-static INTEGER OPC_PerfectHash (CHAR *s, LONGINT s__len);
+static 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, LONGINT s__len);
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len);
static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define);
-static void OPC_ProcPredefs (OPT_Object obj, SHORTINT vis);
+static void OPC_ProcPredefs (OPT_Object obj, INT8 vis);
static void OPC_PutBase (OPT_Struct typ);
-static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt);
+static void OPC_PutPtrOffsets (OPT_Struct typ, INT32 adr, INT32 *cnt);
static void OPC_RegCmds (OPT_Object obj);
export void OPC_SetInclude (BOOLEAN exclude);
-export LONGINT OPC_SizeAlignment (LONGINT size);
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause);
-static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x);
-static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT 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, INTEGER vis);
+export void OPC_TypeDefs (OPT_Object obj, INT16 vis);
export void OPC_TypeOf (OPT_Object ap);
static BOOLEAN OPC_Undefined (OPT_Object obj);
@@ -87,24 +91,17 @@ static BOOLEAN OPC_Undefined (OPT_Object obj);
void OPC_Init (void)
{
OPC_indentLevel = 0;
- OPC_ptrinit = __IN(5, OPM_opt);
- OPC_mainprog = OPM_mainProg || OPM_mainLinkStat;
- OPC_ansi = __IN(6, OPM_opt);
- if (OPC_ansi) {
- __MOVE("__init(void)", OPC_BodyNameExt, 13);
- } else {
- __MOVE("__init()", OPC_BodyNameExt, 9);
- }
+ __MOVE("__init(void)", OPC_BodyNameExt, 13);
}
-void OPC_Indent (INTEGER count)
+void OPC_Indent (INT16 count)
{
OPC_indentLevel += count;
}
void OPC_BegStat (void)
{
- INTEGER i;
+ INT16 i;
i = OPC_indentLevel;
while (i > 0) {
OPM_Write(0x09);
@@ -140,10 +137,10 @@ void OPC_EndBlk0 (void)
OPM_Write('}');
}
-static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x)
+static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x)
{
CHAR ch;
- INTEGER i;
+ INT16 i;
__DUP(s, s__len, CHAR);
ch = s[0];
i = 0;
@@ -159,79 +156,86 @@ static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x)
__DEL(s);
}
-static INTEGER OPC_Length (CHAR *s, LONGINT s__len)
+static INT16 OPC_Length (CHAR *s, LONGINT s__len)
{
- INTEGER _o_result;
- INTEGER i;
+ INT16 i;
i = 0;
while (s[__X(i, s__len)] != 0x00) {
i += 1;
}
- _o_result = i;
- return _o_result;
+ return i;
}
-static INTEGER OPC_PerfectHash (CHAR *s, LONGINT s__len)
+static INT16 OPC_PerfectHash (CHAR *s, LONGINT s__len)
{
- INTEGER _o_result;
- INTEGER i, h;
+ INT16 i, h;
i = 0;
h = 0;
while ((s[__X(i, s__len)] != 0x00 && i < 5)) {
- h = 3 * h + (int)s[__X(i, s__len)];
+ h = 3 * h + (INT16)s[__X(i, s__len)];
i += 1;
}
- _o_result = (int)__MOD(h, 105);
- return _o_result;
+ return (int)__MOD(h, 105);
}
void OPC_Ident (OPT_Object obj)
{
- INTEGER mode, level, h;
+ INT16 mode, level, h;
mode = obj->mode;
level = obj->mnolev;
- if ((__IN(mode, 0x62) && level > 0) || __IN(mode, 0x14)) {
- OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256)));
- h = OPC_PerfectHash((void*)obj->name, ((LONGINT)(256)));
- if (OPC_hashtab[__X(h, ((LONGINT)(105)))] >= 0) {
- if (__STRCMP(OPC_keytab[__X(OPC_hashtab[__X(h, ((LONGINT)(105)))], ((LONGINT)(36)))], obj->name) == 0) {
+ if ((__IN(mode, 0x62, 32) && level > 0) || __IN(mode, 0x14, 32)) {
+ OPM_WriteStringVar((void*)obj->name, 256);
+ h = OPC_PerfectHash((void*)obj->name, 256);
+ if (OPC_hashtab[__X(h, 105)] >= 0) {
+ if (__STRCMP(OPC_keytab[__X(OPC_hashtab[__X(h, 105)], 50)], obj->name) == 0) {
OPM_Write('_');
}
}
+ } else if ((mode == 5 && __IN(obj->typ->form, 0x90, 32))) {
+ if (obj->typ == OPT_adrtyp) {
+ OPM_WriteString((CHAR*)"ADDRESS", 8);
+ } else {
+ if (obj->typ->form == 4) {
+ OPM_WriteString((CHAR*)"INT", 4);
+ } else {
+ OPM_WriteString((CHAR*)"UINT", 5);
+ }
+ OPM_WriteInt(__ASHL(obj->typ->size, 3));
+ }
} else {
if (mode != 5 || obj->linkadr != 2) {
if (mode == 13) {
OPC_Ident(obj->link->typ->strobj);
} else if (level < 0) {
- OPM_WriteStringVar((void*)OPT_GlbMod[__X(-level, ((LONGINT)(64)))]->name, ((LONGINT)(256)));
+ OPM_WriteStringVar((void*)OPT_GlbMod[__X(-level, 64)]->name, 256);
if (OPM_currFile == 0) {
- OPT_GlbMod[__X(-level, ((LONGINT)(64)))]->vis = 1;
+ OPT_GlbMod[__X(-level, 64)]->vis = 1;
}
} else {
- OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32)));
+ OPM_WriteStringVar((void*)OPM_modName, 32);
}
OPM_Write('_');
} else if (obj == OPT_sysptrtyp->strobj || obj == OPT_bytetyp->strobj) {
- OPM_WriteString((CHAR*)"SYSTEM_", (LONGINT)8);
+ OPM_WriteString((CHAR*)"SYSTEM_", 8);
}
- OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256)));
+ OPM_WriteStringVar((void*)obj->name, 256);
}
}
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause)
{
- INTEGER pointers;
+ INT16 pointers;
*openClause = 0;
if (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->comp != 4)) {
- if (__IN(typ->comp, 0x0c)) {
+ if (__IN(typ->comp, 0x0c, 32)) {
OPC_Stars(typ->BaseTyp, &*openClause);
*openClause = typ->comp == 2;
- } else if (typ->form == 14) {
+ } else if (typ->form == 12) {
OPM_Write('(');
OPM_Write('*');
} else {
pointers = 0;
- while (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->form == 13)) {
+ while (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->form == 11)) {
pointers += 1;
typ = typ->BaseTyp;
}
@@ -256,7 +260,7 @@ static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef)
{
OPT_Struct typ = NIL;
BOOLEAN varPar, openClause;
- INTEGER form, comp;
+ INT16 form, comp;
typ = dcl->typ;
varPar = ((dcl->mode == 2 && typ->comp != 2) || typ->comp == 3) || scopeDef;
OPC_Stars(typ, &openClause);
@@ -276,22 +280,18 @@ static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef)
for (;;) {
form = typ->form;
comp = typ->comp;
- if (((typ->strobj != NIL && typ->strobj->name[0] != 0x00) || form == 12) || comp == 4) {
+ if (((typ->strobj != NIL && typ->strobj->name[0] != 0x00) || form == 10) || comp == 4) {
break;
- } else if ((form == 13 && typ->BaseTyp->comp != 3)) {
+ } else if ((form == 11 && typ->BaseTyp->comp != 3)) {
openClause = 1;
- } else if (form == 14 || __IN(comp, 0x0c)) {
+ } else if (form == 12 || __IN(comp, 0x0c, 32)) {
if (openClause) {
OPM_Write(')');
openClause = 0;
}
- if (form == 14) {
- if (OPC_ansi) {
- OPM_Write(')');
- OPC_AnsiParamList(typ->link, 0);
- } else {
- OPM_WriteString((CHAR*)")()", (LONGINT)4);
- }
+ if (form == 12) {
+ OPM_Write(')');
+ OPC_AnsiParamList(typ->link, 0);
break;
} else if (comp == 2) {
OPM_Write('[');
@@ -308,8 +308,8 @@ static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef)
void OPC_Andent (OPT_Struct typ)
{
if (typ->strobj == NIL || typ->align >= 65536) {
- OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32)));
- OPC_Str1((CHAR*)"__#", (LONGINT)4, __ASHR(typ->align, 16));
+ OPM_WriteStringVar((void*)OPM_modName, 32);
+ OPC_Str1((CHAR*)"__#", 4, __ASHR(typ->align, 16));
} else {
OPC_Ident(typ->strobj);
}
@@ -317,36 +317,34 @@ void OPC_Andent (OPT_Struct typ)
static BOOLEAN OPC_Undefined (OPT_Object obj)
{
- BOOLEAN _o_result;
- _o_result = obj->name[0] == 0x00 || (((obj->mnolev >= 0 && obj->linkadr != (int)(3 + OPM_currFile))) && obj->linkadr != 2);
- return _o_result;
+ return obj->name[0] == 0x00 || (((obj->mnolev >= 0 && obj->linkadr != (3 + OPM_currFile))) && obj->linkadr != 2);
}
static void OPC_DeclareBase (OPT_Object dcl)
{
OPT_Struct typ = NIL, prev = NIL;
OPT_Object obj = NIL;
- INTEGER nofdims;
- LONGINT off, n, dummy;
+ INT16 nofdims;
+ INT32 off, n, dummy;
typ = dcl->typ;
prev = typ;
- while ((((((((typ->strobj == NIL || typ->comp == 3) || OPC_Undefined(typ->strobj)) && typ->comp != 4)) && typ->form != 12)) && !((typ->form == 13 && typ->BaseTyp->comp == 3)))) {
+ while ((((((((typ->strobj == NIL || typ->comp == 3) || OPC_Undefined(typ->strobj)) && typ->comp != 4)) && typ->form != 10)) && !((typ->form == 11 && typ->BaseTyp->comp == 3)))) {
prev = typ;
typ = typ->BaseTyp;
}
obj = typ->strobj;
- if (typ->form == 12) {
- OPM_WriteString((CHAR*)"void", (LONGINT)5);
+ if (typ->form == 10) {
+ OPM_WriteString((CHAR*)"void", 5);
} else if ((obj != NIL && !OPC_Undefined(obj))) {
OPC_Ident(obj);
} else if (typ->comp == 4) {
- OPM_WriteString((CHAR*)"struct ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"struct ", 8);
OPC_Andent(typ);
- if ((prev->form != 13 && (obj != NIL || dcl->name[0] == 0x00))) {
+ if ((prev->form != 11 && (obj != NIL || dcl->name[0] == 0x00))) {
if ((typ->BaseTyp != NIL && typ->BaseTyp->strobj->vis != 0)) {
- OPM_WriteString((CHAR*)" { /* ", (LONGINT)7);
+ OPM_WriteString((CHAR*)" { /* ", 7);
OPC_Ident(typ->BaseTyp->strobj);
- OPM_WriteString((CHAR*)" */", (LONGINT)4);
+ OPM_WriteString((CHAR*)" */", 4);
OPM_WriteLn();
OPC_Indent(1);
} else {
@@ -356,22 +354,22 @@ static void OPC_DeclareBase (OPT_Object dcl)
OPC_FieldList(typ, 1, &off, &n, &dummy);
OPC_EndBlk0();
}
- } else if ((typ->form == 13 && typ->BaseTyp->comp == 3)) {
+ } else if ((typ->form == 11 && typ->BaseTyp->comp == 3)) {
typ = typ->BaseTyp->BaseTyp;
nofdims = 1;
while (typ->comp == 3) {
nofdims += 1;
typ = typ->BaseTyp;
}
- OPM_WriteString((CHAR*)"struct ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"struct ", 8);
OPC_BegBlk();
OPC_BegStat();
- OPC_Str1((CHAR*)"LONGINT len[#]", (LONGINT)15, nofdims);
+ OPC_Str1((CHAR*)"LONGINT len[#]", 15, nofdims);
OPC_EndStat();
OPC_BegStat();
__NEW(obj, OPT_ObjDesc);
__NEW(obj->typ, OPT_StrDesc);
- obj->typ->form = 15;
+ obj->typ->form = 13;
obj->typ->comp = 2;
obj->typ->n = 1;
obj->typ->BaseTyp = typ;
@@ -386,15 +384,13 @@ static void OPC_DeclareBase (OPT_Object dcl)
}
}
-LONGINT OPC_NofPtrs (OPT_Struct typ)
+INT32 OPC_NofPtrs (OPT_Struct typ)
{
- LONGINT _o_result;
OPT_Object fld = NIL;
OPT_Struct btyp = NIL;
- LONGINT n;
- if ((typ->form == 13 && typ->sysflag == 0)) {
- _o_result = 1;
- return _o_result;
+ INT32 n;
+ if ((typ->form == 11 && typ->sysflag == 0)) {
+ return 1;
} else if ((typ->comp == 4 && __MASK(typ->sysflag, -256) == 0)) {
btyp = typ->BaseTyp;
if (btyp != NIL) {
@@ -411,8 +407,7 @@ LONGINT OPC_NofPtrs (OPT_Struct typ)
}
fld = fld->link;
}
- _o_result = n;
- return _o_result;
+ return n;
} else if (typ->comp == 2) {
btyp = typ->BaseTyp;
n = typ->n;
@@ -420,23 +415,21 @@ LONGINT OPC_NofPtrs (OPT_Struct typ)
n = btyp->n * n;
btyp = btyp->BaseTyp;
}
- _o_result = OPC_NofPtrs(btyp) * n;
- return _o_result;
+ return OPC_NofPtrs(btyp) * n;
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt)
+static void OPC_PutPtrOffsets (OPT_Struct typ, INT32 adr, INT32 *cnt)
{
OPT_Object fld = NIL;
OPT_Struct btyp = NIL;
- LONGINT n, i;
- if ((typ->form == 13 && typ->sysflag == 0)) {
+ INT32 n, i;
+ if ((typ->form == 11 && typ->sysflag == 0)) {
OPM_WriteInt(adr);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
*cnt += 1;
if (__MASK(*cnt, -16) == 0) {
OPM_WriteLn();
@@ -453,7 +446,7 @@ static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt)
OPC_PutPtrOffsets(fld->typ, adr + fld->adr, &*cnt);
} else {
OPM_WriteInt(adr + fld->adr);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
*cnt += 1;
if (__MASK(*cnt, -16) == 0) {
OPM_WriteLn();
@@ -485,11 +478,11 @@ static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj)
OPC_InitTProcs(typ, obj->left);
if (obj->mode == 13) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"__INITBP(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__INITBP(", 10);
OPC_Ident(typ);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Ident(obj);
- OPC_Str1((CHAR*)", #)", (LONGINT)5, __ASHR(obj->adr, 16));
+ OPC_Str1((CHAR*)", #)", 5, __ASHR(obj->adr, 16));
OPC_EndStat();
}
OPC_InitTProcs(typ, obj->right);
@@ -501,30 +494,30 @@ static void OPC_PutBase (OPT_Struct typ)
if (typ != NIL) {
OPC_PutBase(typ->BaseTyp);
OPC_Ident(typ->strobj);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)"__typ", 6);
+ OPM_WriteString((CHAR*)", ", 3);
}
}
static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamName)
{
OPT_Struct typ = NIL;
- INTEGER dim;
+ INT16 dim;
if (showParamName) {
OPC_Ident(par);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
}
dim = 1;
typ = par->typ->BaseTyp;
while (typ->comp == 3) {
if (ansiDefine) {
- OPM_WriteString((CHAR*)", LONGINT ", (LONGINT)11);
+ OPM_WriteString((CHAR*)", LONGINT ", 11);
} else {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
}
if (showParamName) {
OPC_Ident(par);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
OPM_WriteInt(dim);
}
typ = typ->BaseTyp;
@@ -537,24 +530,24 @@ static void OPC_DeclareParams (OPT_Object par, BOOLEAN macro)
OPM_Write('(');
while (par != NIL) {
if (macro) {
- OPM_WriteStringVar((void*)par->name, ((LONGINT)(256)));
+ OPM_WriteStringVar((void*)par->name, 256);
} else {
- if ((par->mode == 1 && par->typ->form == 7)) {
+ if ((par->mode == 1 && par->typ->form == 5)) {
OPM_Write('_');
}
OPC_Ident(par);
}
if (par->typ->comp == 3) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_LenList(par, 0, 1);
} else if ((par->mode == 2 && par->typ->comp == 4)) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPM_WriteStringVar((void*)par->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPM_WriteStringVar((void*)par->name, 256);
+ OPM_WriteString((CHAR*)"__typ", 6);
}
par = par->link;
if (par != NIL) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
}
}
OPM_Write(')');
@@ -566,12 +559,10 @@ static void OPC_DefineTProcTypes (OPT_Object obj)
if (obj->typ != OPT_notyp) {
OPC_DefineType(obj->typ);
}
- if (OPC_ansi) {
- par = obj->link;
- while (par != NIL) {
- OPC_DefineType(par->typ);
- par = par->link;
- }
+ par = obj->link;
+ while (par != NIL) {
+ OPC_DefineType(par->typ);
+ par = par->link;
}
}
@@ -586,7 +577,7 @@ static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty)
if (OPM_currFile == 0) {
if (obj->vis == 1) {
OPC_DefineTProcTypes(obj);
- OPM_WriteString((CHAR*)"import ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"import ", 8);
*empty = 0;
OPC_ProcHeader(obj, 0);
}
@@ -594,9 +585,9 @@ static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty)
*empty = 0;
OPC_DefineTProcTypes(obj);
if (obj->vis == 0) {
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"static ", 8);
} else {
- OPM_WriteString((CHAR*)"export ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"export ", 8);
}
OPC_ProcHeader(obj, 0);
}
@@ -607,11 +598,10 @@ static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty)
OPT_Object OPC_BaseTProc (OPT_Object obj)
{
- OPT_Object _o_result;
OPT_Struct typ = NIL, base = NIL;
- LONGINT mno;
+ INT32 mno;
typ = obj->link->typ;
- if (typ->form == 13) {
+ if (typ->form == 11) {
typ = typ->BaseTyp;
}
base = typ->BaseTyp;
@@ -621,8 +611,7 @@ OPT_Object OPC_BaseTProc (OPT_Object obj)
base = typ->BaseTyp;
}
OPT_FindField(obj->name, typ, &obj);
- _o_result = obj;
- return _o_result;
+ return obj;
}
static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty)
@@ -630,31 +619,27 @@ static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty)
if (obj != NIL) {
OPC_DefineTProcMacros(obj->left, &*empty);
if ((((obj->mode == 13 && obj == OPC_BaseTProc(obj))) && (OPM_currFile != 0 || obj->vis == 1))) {
- OPM_WriteString((CHAR*)"#define __", (LONGINT)11);
+ OPM_WriteString((CHAR*)"#define __", 11);
OPC_Ident(obj);
OPC_DeclareParams(obj->link, 1);
- OPM_WriteString((CHAR*)" __SEND(", (LONGINT)9);
- if (obj->link->typ->form == 13) {
- OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10);
+ 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", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
}
- OPC_Str1((CHAR*)", #, ", (LONGINT)6, __ASHR(obj->adr, 16));
+ OPC_Str1((CHAR*)", #, ", 6, __ASHR(obj->adr, 16));
if (obj->typ == OPT_notyp) {
- OPM_WriteString((CHAR*)"void", (LONGINT)5);
+ OPM_WriteString((CHAR*)"void", 5);
} else {
OPC_Ident(obj->typ->strobj);
}
- OPM_WriteString((CHAR*)"(*)", (LONGINT)4);
- if (OPC_ansi) {
- OPC_AnsiParamList(obj->link, 0);
- } else {
- OPM_WriteString((CHAR*)"()", (LONGINT)3);
- }
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)"(*)", 4);
+ OPC_AnsiParamList(obj->link, 0);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_DeclareParams(obj->link, 1);
OPM_Write(')');
OPM_WriteLn();
@@ -672,7 +657,7 @@ static void OPC_DefineType (OPT_Struct str)
if (obj == NIL || OPC_Undefined(obj)) {
if (obj != NIL) {
if (obj->linkadr == 1) {
- if (str->form != 13) {
+ if (str->form != 11) {
OPM_Mark(244, str->txtpos);
obj->linkadr = 2;
}
@@ -691,13 +676,13 @@ static void OPC_DefineType (OPT_Struct str)
}
field = field->link;
}
- } else if (str->form == 13) {
+ } else if (str->form == 11) {
if (str->BaseTyp->comp != 4) {
OPC_DefineType(str->BaseTyp);
}
- } else if (__IN(str->comp, 0x0c)) {
+ } else if (__IN(str->comp, 0x0c, 32)) {
OPC_DefineType(str->BaseTyp);
- } else if (str->form == 14) {
+ } else if (str->form == 12) {
if (str->BaseTyp != OPT_notyp) {
OPC_DefineType(str->BaseTyp);
}
@@ -709,7 +694,7 @@ static void OPC_DefineType (OPT_Struct str)
}
}
if ((obj != NIL && OPC_Undefined(obj))) {
- OPM_WriteString((CHAR*)"typedef", (LONGINT)8);
+ OPM_WriteString((CHAR*)"typedef", 8);
OPM_WriteLn();
OPM_Write(0x09);
OPC_Indent(1);
@@ -737,40 +722,36 @@ static void OPC_DefineType (OPT_Struct str)
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len)
{
- BOOLEAN _o_result;
- INTEGER i;
- BOOLEAN r;
+ INT16 i;
__DUP(y, y__len, CHAR);
i = 0;
- while ((*x)[__X(i + 1, ((LONGINT)(256)))] == y[__X(i, y__len)]) {
+ while ((*x)[__X(i + 1, 256)] == y[__X(i, y__len)]) {
i += 1;
}
- r = y[__X(i, y__len)] == 0x00;
- _o_result = r;
__DEL(y);
- return _o_result;
+ return y[__X(i, y__len)] == 0x00;
}
-static void OPC_CProcDefs (OPT_Object obj, INTEGER vis)
+static void OPC_CProcDefs (OPT_Object obj, INT16 vis)
{
- INTEGER i;
+ INT16 i;
OPT_ConstExt ext = NIL;
- INTEGER _for__9;
+ INT16 _for__7;
if (obj != NIL) {
OPC_CProcDefs(obj->left, vis);
- if ((((obj->mode == 9 && (int)obj->vis >= vis)) && obj->adr == 1)) {
+ if ((((obj->mode == 9 && (INT16)obj->vis >= vis)) && obj->adr == 1)) {
ext = obj->conval->ext;
i = 1;
- if (((*ext)[1] != '#' && !(OPC_Prefixed(ext, (CHAR*)"extern ", (LONGINT)8) || OPC_Prefixed(ext, (CHAR*)"import ", (LONGINT)8)))) {
- OPM_WriteString((CHAR*)"#define ", (LONGINT)9);
+ if (((*ext)[1] != '#' && !(OPC_Prefixed(ext, (CHAR*)"extern ", 8) || OPC_Prefixed(ext, (CHAR*)"import ", 8)))) {
+ OPM_WriteString((CHAR*)"#define ", 9);
OPC_Ident(obj);
OPC_DeclareParams(obj->link, 1);
OPM_Write(0x09);
}
- _for__9 = (int)(*obj->conval->ext)[0];
+ _for__7 = (INT16)(*obj->conval->ext)[0];
i = i;
- while (i <= _for__9) {
- OPM_Write((*obj->conval->ext)[__X(i, ((LONGINT)(256)))]);
+ while (i <= _for__7) {
+ OPM_Write((*obj->conval->ext)[__X(i, 256)]);
i += 1;
}
OPM_WriteLn();
@@ -779,7 +760,7 @@ static void OPC_CProcDefs (OPT_Object obj, INTEGER vis)
}
}
-void OPC_TypeDefs (OPT_Object obj, INTEGER vis)
+void OPC_TypeDefs (OPT_Object obj, INT16 vis)
{
if (obj != NIL) {
OPC_TypeDefs(obj->left, vis);
@@ -811,130 +792,85 @@ static void OPC_DefAnonRecs (OPT_Node n)
void OPC_TDescDecl (OPT_Struct typ)
{
- LONGINT nofptrs;
+ INT32 nofptrs;
OPT_Object o = NIL;
OPC_BegStat();
- OPM_WriteString((CHAR*)"__TDESC(", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__TDESC(", 9);
OPC_Andent(typ);
- OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1);
- OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ));
+ OPC_Str1((CHAR*)", #", 4, typ->n + 1);
+ OPC_Str1((CHAR*)", #) = {__TDFLDS(", 18, OPC_NofPtrs(typ));
OPM_Write('"');
if (typ->strobj != NIL) {
- OPM_WriteStringVar((void*)typ->strobj->name, ((LONGINT)(256)));
+ OPM_WriteStringVar((void*)typ->strobj->name, 256);
}
OPM_Write('"');
- OPC_Str1((CHAR*)", #), {", (LONGINT)8, typ->size);
+ OPC_Str1((CHAR*)", #), {", 8, typ->size);
nofptrs = 0;
- OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs);
- OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (int)OPM_LIntSize));
+ OPC_PutPtrOffsets(typ, 0, &nofptrs);
+ OPC_Str1((CHAR*)"#}}", 4, -((nofptrs + 1) * OPM_AddressSize));
OPC_EndStat();
}
void OPC_InitTDesc (OPT_Struct typ)
{
OPC_BegStat();
- OPM_WriteString((CHAR*)"__INITYP(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__INITYP(", 10);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
if (typ->BaseTyp != NIL) {
OPC_Andent(typ->BaseTyp);
} else {
OPC_Andent(typ);
}
- OPC_Str1((CHAR*)", #)", (LONGINT)5, typ->extlev);
+ OPC_Str1((CHAR*)", #)", 5, typ->extlev);
OPC_EndStat();
if (typ->strobj != NIL) {
OPC_InitTProcs(typ->strobj, typ->link);
}
}
-void OPC_Align (LONGINT *adr, LONGINT base)
+static void OPC_FillGap (INT32 gap, INT32 off, INT32 align, INT32 *n, INT32 *curAlign)
{
- switch (base) {
- case 2:
- *adr += __MASK(*adr, -2);
- break;
- case 4:
- *adr += __MASK(-*adr, -4);
- break;
- case 8:
- *adr += __MASK(-*adr, -8);
- break;
- case 16:
- *adr += __MASK(-*adr, -16);
- break;
- default:
- break;
- }
-}
-
-LONGINT OPC_SizeAlignment (LONGINT size)
-{
- LONGINT _o_result;
- LONGINT alignment;
- if (size < (int)OPM_Alignment) {
- alignment = 1;
- while (alignment < size) {
- alignment = __ASHL(alignment, 1);
- }
- } else {
- alignment = OPM_Alignment;
- }
- _o_result = alignment;
- return _o_result;
-}
-
-LONGINT OPC_BaseAlignment (OPT_Struct typ)
-{
- LONGINT _o_result;
- LONGINT alignment;
- if (typ->form == 15) {
- if (typ->comp == 4) {
- alignment = __MASK(typ->align, -65536);
- } else {
- alignment = OPC_BaseAlignment(typ->BaseTyp);
- }
- } else {
- alignment = OPC_SizeAlignment(typ->size);
- }
- _o_result = alignment;
- return _o_result;
-}
-
-static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LONGINT *curAlign)
-{
- LONGINT adr;
+ INT32 adr;
adr = off;
- OPC_Align(&adr, align);
+ OPT_Align(&adr, align);
if ((*curAlign < align && gap - (adr - off) >= align)) {
gap -= (adr - off) + align;
OPC_BegStat();
- if (align == (int)OPM_IntSize) {
- OPM_WriteString((CHAR*)"INTEGER", (LONGINT)8);
- } else if (align == (int)OPM_LIntSize) {
- OPM_WriteString((CHAR*)"LONGINT", (LONGINT)8);
- } else if (align == (int)OPM_LRealSize) {
- OPM_WriteString((CHAR*)"LONGREAL", (LONGINT)9);
+ switch (align) {
+ case 2:
+ OPM_WriteString((CHAR*)"INT16", 6);
+ break;
+ case 4:
+ OPM_WriteString((CHAR*)"INT32", 6);
+ break;
+ case 8:
+ OPM_WriteString((CHAR*)"INT64", 6);
+ break;
+ default:
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Unexpected enclosing alignment in FillGap.", 43);
+ break;
}
- OPC_Str1((CHAR*)" _prvt#", (LONGINT)8, *n);
+ OPC_Str1((CHAR*)" _prvt#", 8, *n);
*n += 1;
OPC_EndStat();
*curAlign = align;
}
if (gap > 0) {
OPC_BegStat();
- OPC_Str1((CHAR*)"char _prvt#", (LONGINT)12, *n);
+ OPC_Str1((CHAR*)"char _prvt#", 12, *n);
*n += 1;
- OPC_Str1((CHAR*)"[#]", (LONGINT)4, gap);
+ OPC_Str1((CHAR*)"[#]", 4, gap);
OPC_EndStat();
}
}
-static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *n, LONGINT *curAlign)
+static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, INT32 *off, INT32 *n, INT32 *curAlign)
{
OPT_Object fld = NIL;
OPT_Struct base = NIL;
- LONGINT gap, adr, align, fldAlign;
+ INT32 gap, adr, align, fldAlign;
fld = typ->link;
align = __MASK(typ->align, -65536);
if (typ->BaseTyp != NIL) {
@@ -952,8 +888,8 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
}
} else {
adr = *off;
- fldAlign = OPC_BaseAlignment(fld->typ);
- OPC_Align(&adr, fldAlign);
+ fldAlign = OPT_BaseAlignment(fld->typ);
+ OPT_Align(&adr, fldAlign);
gap = fld->adr - adr;
if (fldAlign > *curAlign) {
*curAlign = fldAlign;
@@ -969,7 +905,7 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
base = fld->typ;
fld = fld->link;
while ((((((((fld != NIL && fld->mode == 4)) && fld->typ == base)) && fld->adr == *off)) && ((OPM_currFile == 1 || fld->vis != 0) || fld->typ->strobj == NIL))) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_DeclareObj(fld, 0);
*off = fld->adr + fld->typ->size;
fld = fld->link;
@@ -978,7 +914,7 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
}
}
if (last) {
- adr = typ->size - (int)__ASHR(typ->sysflag, 8);
+ adr = typ->size - __ASHR(typ->sysflag, 8);
if (adr == 0) {
gap = 1;
} else {
@@ -990,16 +926,16 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
}
}
-static void OPC_IdentList (OPT_Object obj, INTEGER vis)
+static void OPC_IdentList (OPT_Object obj, INT16 vis)
{
OPT_Struct base = NIL;
BOOLEAN first;
- INTEGER lastvis;
+ INT16 lastvis;
base = NIL;
first = 1;
while ((obj != NIL && obj->mode != 13)) {
- if ((__IN(vis, 0x05) || (vis == 1 && obj->vis != 0)) || (vis == 3 && !obj->leaf)) {
- if (obj->typ != base || (int)obj->vis != lastvis) {
+ if ((__IN(vis, 0x05, 32) || (vis == 1 && obj->vis != 0)) || (vis == 3 && !obj->leaf)) {
+ if (obj->typ != base || (INT16)obj->vis != lastvis) {
if (!first) {
OPC_EndStat();
}
@@ -1008,16 +944,16 @@ static void OPC_IdentList (OPT_Object obj, INTEGER vis)
lastvis = obj->vis;
OPC_BegStat();
if ((vis == 1 && obj->vis != 0)) {
- OPM_WriteString((CHAR*)"import ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"import ", 8);
} else if ((obj->mnolev == 0 && vis == 0)) {
if (obj->vis == 0) {
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"static ", 8);
} else {
- OPM_WriteString((CHAR*)"export ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"export ", 8);
}
}
- if ((((vis == 2 && obj->mode == 1)) && base->form == 7)) {
- OPM_WriteString((CHAR*)"double", (LONGINT)7);
+ if ((((vis == 2 && obj->mode == 1)) && base->form == 5)) {
+ OPM_WriteString((CHAR*)"double", 7);
} else {
OPC_DeclareBase(obj);
}
@@ -1025,7 +961,7 @@ static void OPC_IdentList (OPT_Object obj, INTEGER vis)
OPM_Write(',');
}
OPM_Write(' ');
- if ((((vis == 2 && obj->mode == 1)) && base->form == 7)) {
+ if ((((vis == 2 && obj->mode == 1)) && base->form == 5)) {
OPM_Write('_');
}
OPC_DeclareObj(obj, vis == 3);
@@ -1033,17 +969,17 @@ static void OPC_IdentList (OPT_Object obj, INTEGER vis)
OPC_EndStat();
OPC_BegStat();
base = OPT_linttyp;
- OPM_WriteString((CHAR*)"LONGINT ", (LONGINT)9);
+ OPM_WriteString((CHAR*)"LONGINT ", 9);
OPC_LenList(obj, 0, 1);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPC_EndStat();
OPC_BegStat();
- OPM_WriteString((CHAR*)"LONGINT *", (LONGINT)10);
+ OPM_WriteString((CHAR*)"ADDRESS *", 10);
OPC_Ident(obj);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
base = NIL;
- } else if ((((((OPC_ptrinit && vis == 0)) && obj->mnolev > 0)) && obj->typ->form == 13)) {
- OPM_WriteString((CHAR*)" = NIL", (LONGINT)7);
+ } else if ((((((__IN(5, OPM_Options, 32) && vis == 0)) && obj->mnolev > 0)) && obj->typ->form == 11)) {
+ OPM_WriteString((CHAR*)" = NIL", 7);
}
}
obj = obj->link;
@@ -1058,7 +994,7 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
CHAR name[32];
OPM_Write('(');
if (obj == NIL || obj->mode == 13) {
- OPM_WriteString((CHAR*)"void", (LONGINT)5);
+ OPM_WriteString((CHAR*)"void", 5);
} else {
for (;;) {
OPC_DeclareBase(obj);
@@ -1066,25 +1002,25 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
OPM_Write(' ');
OPC_DeclareObj(obj, 0);
} else {
- __COPY(obj->name, name, ((LONGINT)(32)));
+ __COPY(obj->name, name, 32);
obj->name[0] = 0x00;
OPC_DeclareObj(obj, 0);
- __COPY(name, obj->name, ((LONGINT)(256)));
+ __COPY(name, obj->name, 256);
}
if (obj->typ->comp == 3) {
- OPM_WriteString((CHAR*)", LONGINT ", (LONGINT)11);
+ OPM_WriteString((CHAR*)", LONGINT ", 11);
OPC_LenList(obj, 1, showParamNames);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
- OPM_WriteString((CHAR*)", LONGINT *", (LONGINT)12);
+ OPM_WriteString((CHAR*)", ADDRESS *", 12);
if (showParamNames) {
OPC_Ident(obj);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
}
}
if (obj->link == NIL || obj->link->mode == 13) {
break;
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
obj = obj->link;
}
}
@@ -1094,42 +1030,31 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define)
{
if (proc->typ == OPT_notyp) {
- OPM_WriteString((CHAR*)"void", (LONGINT)5);
+ OPM_WriteString((CHAR*)"void", 5);
} else {
OPC_Ident(proc->typ->strobj);
}
OPM_Write(' ');
OPC_Ident(proc);
OPM_Write(' ');
- if (OPC_ansi) {
- OPC_AnsiParamList(proc->link, 1);
- if (!define) {
- OPM_Write(';');
- }
- OPM_WriteLn();
- } else if (define) {
- OPC_DeclareParams(proc->link, 0);
- OPM_WriteLn();
- OPC_Indent(1);
- OPC_IdentList(proc->link, 2);
- OPC_Indent(-1);
- } else {
- OPM_WriteString((CHAR*)"();", (LONGINT)4);
- OPM_WriteLn();
+ OPC_AnsiParamList(proc->link, 1);
+ if (!define) {
+ OPM_Write(';');
}
+ OPM_WriteLn();
}
-static void OPC_ProcPredefs (OPT_Object obj, SHORTINT vis)
+static void OPC_ProcPredefs (OPT_Object obj, INT8 vis)
{
if (obj != NIL) {
OPC_ProcPredefs(obj->left, vis);
- if ((((__IN(obj->mode, 0xc0) && obj->vis >= vis)) && (obj->history != 4 || obj->mode == 6))) {
+ if ((((__IN(obj->mode, 0xc0, 32) && obj->vis >= vis)) && (obj->history != 4 || obj->mode == 6))) {
if (vis == 1) {
- OPM_WriteString((CHAR*)"import ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"import ", 8);
} else if (obj->vis == 0) {
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"static ", 8);
} else {
- OPM_WriteString((CHAR*)"export ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"export ", 8);
}
OPC_ProcHeader(obj, 0);
}
@@ -1140,27 +1065,27 @@ static void OPC_ProcPredefs (OPT_Object obj, SHORTINT vis)
static void OPC_Include (CHAR *name, LONGINT name__len)
{
__DUP(name, name__len, CHAR);
- OPM_WriteString((CHAR*)"#include ", (LONGINT)10);
+ OPM_WriteString((CHAR*)"#include ", 10);
OPM_Write('"');
OPM_WriteStringVar((void*)name, name__len);
- OPM_WriteString((CHAR*)".h", (LONGINT)3);
+ OPM_WriteString((CHAR*)".h", 3);
OPM_Write('"');
OPM_WriteLn();
__DEL(name);
}
-static void OPC_IncludeImports (OPT_Object obj, INTEGER vis)
+static void OPC_IncludeImports (OPT_Object obj, INT16 vis)
{
if (obj != NIL) {
OPC_IncludeImports(obj->left, vis);
- if ((((obj->mode == 11 && obj->mnolev != 0)) && (int)OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->vis >= vis)) {
- OPC_Include(OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, ((LONGINT)(256)));
+ if ((((obj->mode == 11 && obj->mnolev != 0)) && (INT16)OPT_GlbMod[__X(-obj->mnolev, 64)]->vis >= vis)) {
+ OPC_Include(OPT_GlbMod[__X(-obj->mnolev, 64)]->name, 256);
}
OPC_IncludeImports(obj->right, vis);
}
}
-static void OPC_GenDynTypes (OPT_Node n, INTEGER vis)
+static void OPC_GenDynTypes (OPT_Node n, INT16 vis)
{
OPT_Struct typ = NIL;
while ((n != NIL && n->class == 14)) {
@@ -1168,15 +1093,15 @@ static void OPC_GenDynTypes (OPT_Node n, INTEGER vis)
if (vis == 0 || typ->ref < 255) {
OPC_BegStat();
if (vis == 1) {
- OPM_WriteString((CHAR*)"import ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"import ", 8);
} else if ((typ->strobj != NIL && typ->strobj->mnolev > 0)) {
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"static ", 8);
} else {
- OPM_WriteString((CHAR*)"export ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"export ", 8);
}
- OPM_WriteString((CHAR*)"LONGINT *", (LONGINT)10);
+ OPM_WriteString((CHAR*)"ADDRESS *", 10);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
OPC_EndStat();
}
n = n->link;
@@ -1194,29 +1119,30 @@ void OPC_GenHdr (OPT_Node n)
OPC_GenDynTypes(n, 1);
OPM_WriteLn();
OPC_ProcPredefs(OPT_topScope->right, 1);
- OPM_WriteString((CHAR*)"import ", (LONGINT)8);
- OPM_WriteString((CHAR*)"void *", (LONGINT)7);
- OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32)));
- OPM_WriteString(OPC_BodyNameExt, ((LONGINT)(13)));
+ OPM_WriteString((CHAR*)"import ", 8);
+ OPM_WriteString((CHAR*)"void *", 7);
+ OPM_WriteStringVar((void*)OPM_modName, 32);
+ OPM_WriteString(OPC_BodyNameExt, 13);
OPC_EndStat();
OPM_WriteLn();
OPC_CProcDefs(OPT_topScope->right, 1);
OPM_WriteLn();
- OPM_WriteString((CHAR*)"#endif", (LONGINT)7);
+ OPM_WriteString((CHAR*)"#endif // ", 11);
+ OPM_WriteStringVar((void*)OPM_modName, 32);
OPM_WriteLn();
}
static void OPC_GenHeaderMsg (void)
{
- INTEGER i;
- OPM_WriteString((CHAR*)"/* ", (LONGINT)4);
- OPM_WriteString((CHAR*)"voc", (LONGINT)4);
+ INT16 i;
+ OPM_WriteString((CHAR*)"/* ", 4);
+ OPM_WriteString((CHAR*)"voc", 4);
OPM_Write(' ');
- OPM_WriteString(Configuration_versionLong, ((LONGINT)(41)));
+ OPM_WriteString(Configuration_versionLong, 75);
OPM_Write(' ');
i = 0;
while (i <= 31) {
- if (__IN(i, OPM_glbopt)) {
+ if (__IN(i, OPM_Options, 32)) {
switch (i) {
case 0:
OPM_Write('x');
@@ -1233,9 +1159,6 @@ static void OPC_GenHeaderMsg (void)
case 5:
OPM_Write('p');
break;
- case 6:
- OPM_Write('k');
- break;
case 7:
OPM_Write('a');
break;
@@ -1264,14 +1187,14 @@ static void OPC_GenHeaderMsg (void)
OPM_Write('v');
break;
default:
- OPM_LogWStr((CHAR*)"( more options defined in OPM than checked in OPC.GenHeaderMsg, if you are a compiler developer, add them to OPC.GenHeaderMsg", (LONGINT)126);
+ OPM_LogWStr((CHAR*)"( more options defined in OPM than checked in OPC.GenHeaderMsg, if you are a compiler developer, add them to OPC.GenHeaderMsg", 126);
OPM_LogWLn();
break;
}
}
i += 1;
}
- OPM_WriteString((CHAR*)" */", (LONGINT)4);
+ OPM_WriteString((CHAR*)" */", 4);
OPM_WriteLn();
}
@@ -1280,20 +1203,16 @@ void OPC_GenHdrIncludes (void)
OPM_currFile = 2;
OPC_GenHeaderMsg();
OPM_WriteLn();
- OPM_WriteString((CHAR*)"#ifndef ", (LONGINT)9);
- OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32)));
- OPM_WriteString((CHAR*)"__h", (LONGINT)4);
+ OPM_WriteString((CHAR*)"#ifndef ", 9);
+ OPM_WriteStringVar((void*)OPM_modName, 32);
+ OPM_WriteString((CHAR*)"__h", 4);
OPM_WriteLn();
- OPM_WriteString((CHAR*)"#define ", (LONGINT)9);
- OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32)));
- OPM_WriteString((CHAR*)"__h", (LONGINT)4);
+ OPM_WriteString((CHAR*)"#define ", 9);
+ OPM_WriteStringVar((void*)OPM_modName, 32);
+ OPM_WriteString((CHAR*)"__h", 4);
OPM_WriteLn();
OPM_WriteLn();
- if (OPM_LIntSize == 8) {
- OPM_WriteString((CHAR*)"#define LARGE", (LONGINT)14);
- OPM_WriteLn();
- }
- OPC_Include((CHAR*)"SYSTEM", (LONGINT)7);
+ OPC_Include((CHAR*)"SYSTEM", 7);
OPC_IncludeImports(OPT_topScope->right, 1);
OPM_WriteLn();
}
@@ -1302,11 +1221,21 @@ void OPC_GenBdy (OPT_Node n)
{
OPM_currFile = 1;
OPC_GenHeaderMsg();
- if (OPM_LIntSize == 8) {
- OPM_WriteString((CHAR*)"#define LARGE", (LONGINT)14);
- OPM_WriteLn();
- }
- OPC_Include((CHAR*)"SYSTEM", (LONGINT)7);
+ OPM_WriteLn();
+ OPM_WriteString((CHAR*)"#define SHORTINT INT", 21);
+ OPM_WriteInt(__ASHL(OPT_sinttyp->size, 3));
+ OPM_WriteLn();
+ OPM_WriteString((CHAR*)"#define INTEGER INT", 21);
+ OPM_WriteInt(__ASHL(OPT_inttyp->size, 3));
+ OPM_WriteLn();
+ OPM_WriteString((CHAR*)"#define LONGINT INT", 21);
+ OPM_WriteInt(__ASHL(OPT_linttyp->size, 3));
+ OPM_WriteLn();
+ OPM_WriteString((CHAR*)"#define SET UINT", 22);
+ OPM_WriteInt(__ASHL(OPT_settyp->size, 3));
+ OPM_WriteLn();
+ OPM_WriteLn();
+ OPC_Include((CHAR*)"SYSTEM", 7);
OPC_IncludeImports(OPT_topScope->right, 0);
OPM_WriteLn();
OPC_DefAnonRecs(n);
@@ -1329,9 +1258,9 @@ static void OPC_RegCmds (OPT_Object obj)
if ((obj->mode == 7 && obj->history != 4)) {
if ((((obj->vis != 0 && obj->link == NIL)) && obj->typ == OPT_notyp)) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"__REGCMD(\"", (LONGINT)11);
- OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"\", ", (LONGINT)4);
+ OPM_WriteString((CHAR*)"__REGCMD(\"", 11);
+ OPM_WriteStringVar((void*)obj->name, 256);
+ OPM_WriteString((CHAR*)"\", ", 4);
OPC_Ident(obj);
OPM_Write(')');
OPC_EndStat();
@@ -1347,8 +1276,8 @@ static void OPC_InitImports (OPT_Object obj)
OPC_InitImports(obj->left);
if ((obj->mode == 11 && obj->mnolev != 0)) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"__MODULE_IMPORT(", (LONGINT)17);
- OPM_WriteStringVar((void*)OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, ((LONGINT)(256)));
+ OPM_WriteString((CHAR*)"__MODULE_IMPORT(", 17);
+ OPM_WriteStringVar((void*)OPT_GlbMod[__X(-obj->mnolev, 64)]->name, 256);
OPM_Write(')');
OPC_EndStat();
}
@@ -1359,38 +1288,30 @@ static void OPC_InitImports (OPT_Object obj)
void OPC_GenEnumPtrs (OPT_Object var)
{
OPT_Struct typ = NIL;
- LONGINT n;
+ INT32 n;
OPC_GlbPtrs = 0;
while (var != NIL) {
typ = var->typ;
if (OPC_NofPtrs(typ) > 0) {
if (!OPC_GlbPtrs) {
OPC_GlbPtrs = 1;
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
- if (OPC_ansi) {
- OPM_WriteString((CHAR*)"void EnumPtrs(void (*P)(void*))", (LONGINT)32);
- } else {
- OPM_WriteString((CHAR*)"void EnumPtrs(P)", (LONGINT)17);
- OPM_WriteLn();
- OPM_Write(0x09);
- OPM_WriteString((CHAR*)"void (*P)();", (LONGINT)13);
- }
+ OPM_WriteString((CHAR*)"static void EnumPtrs(void (*P)(void*))", 39);
OPM_WriteLn();
OPC_BegBlk();
}
OPC_BegStat();
- if (typ->form == 13) {
- OPM_WriteString((CHAR*)"P(", (LONGINT)3);
+ if (typ->form == 11) {
+ OPM_WriteString((CHAR*)"P(", 3);
OPC_Ident(var);
OPM_Write(')');
} else if (typ->comp == 4) {
- OPM_WriteString((CHAR*)"__ENUMR(&", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__ENUMR(&", 10);
OPC_Ident(var);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
- OPC_Str1((CHAR*)", #", (LONGINT)4, typ->size);
- OPM_WriteString((CHAR*)", 1, P)", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__typ", 6);
+ OPC_Str1((CHAR*)", #", 4, typ->size);
+ OPM_WriteString((CHAR*)", 1, P)", 8);
} else if (typ->comp == 2) {
n = typ->n;
typ = typ->BaseTyp;
@@ -1398,18 +1319,18 @@ void OPC_GenEnumPtrs (OPT_Object var)
n = n * typ->n;
typ = typ->BaseTyp;
}
- if (typ->form == 13) {
- OPM_WriteString((CHAR*)"__ENUMP(", (LONGINT)9);
+ if (typ->form == 11) {
+ OPM_WriteString((CHAR*)"__ENUMP(", 9);
OPC_Ident(var);
- OPC_Str1((CHAR*)", #, P)", (LONGINT)8, n);
+ OPC_Str1((CHAR*)", #, P)", 8, n);
} else if (typ->comp == 4) {
- OPM_WriteString((CHAR*)"__ENUMR(", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__ENUMR(", 9);
OPC_Ident(var);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
- OPC_Str1((CHAR*)", #", (LONGINT)4, typ->size);
- OPC_Str1((CHAR*)", #, P)", (LONGINT)8, n);
+ OPM_WriteString((CHAR*)"__typ", 6);
+ OPC_Str1((CHAR*)", #", 4, typ->size);
+ OPC_Str1((CHAR*)", #, P)", 8, n);
}
}
OPC_EndStat();
@@ -1425,49 +1346,41 @@ void OPC_GenEnumPtrs (OPT_Object var)
void OPC_EnterBody (void)
{
OPM_WriteLn();
- OPM_WriteString((CHAR*)"export ", (LONGINT)8);
- if (OPC_mainprog) {
- if (OPC_ansi) {
- OPM_WriteString((CHAR*)"int main(int argc, char **argv)", (LONGINT)32);
- OPM_WriteLn();
- } else {
- OPM_WriteString((CHAR*)"main(argc, argv)", (LONGINT)17);
- OPM_WriteLn();
- OPM_Write(0x09);
- OPM_WriteString((CHAR*)"int argc; char **argv;", (LONGINT)23);
- OPM_WriteLn();
- }
+ OPM_WriteString((CHAR*)"export ", 8);
+ if (__IN(10, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"int main(int argc, char **argv)", 32);
+ OPM_WriteLn();
} else {
- OPM_WriteString((CHAR*)"void *", (LONGINT)7);
- OPM_WriteString(OPM_modName, ((LONGINT)(32)));
- OPM_WriteString(OPC_BodyNameExt, ((LONGINT)(13)));
+ OPM_WriteString((CHAR*)"void *", 7);
+ OPM_WriteString(OPM_modName, 32);
+ OPM_WriteString(OPC_BodyNameExt, 13);
OPM_WriteLn();
}
OPC_BegBlk();
OPC_BegStat();
- if (OPC_mainprog) {
- OPM_WriteString((CHAR*)"__INIT(argc, argv)", (LONGINT)19);
+ if (__IN(10, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__INIT(argc, argv)", 19);
} else {
- OPM_WriteString((CHAR*)"__DEFMOD", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__DEFMOD", 9);
}
OPC_EndStat();
- if ((OPC_mainprog && 0)) {
+ if ((__IN(10, OPM_Options, 32) && 0)) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"/*don`t do it!*/ printf(\"DEMO VERSION: DO NOT USE THIS PROGRAM FOR ANY COMMERCIAL PURPOSE\\n\")", (LONGINT)94);
+ OPM_WriteString((CHAR*)"/*don`t do it!*/ printf(\"DEMO VERSION: DO NOT USE THIS PROGRAM FOR ANY COMMERCIAL PURPOSE\\n\")", 94);
OPC_EndStat();
}
OPC_InitImports(OPT_topScope->right);
OPC_BegStat();
- if (OPC_mainprog) {
- OPM_WriteString((CHAR*)"__REGMAIN(\"", (LONGINT)12);
+ if (__IN(10, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__REGMAIN(\"", 12);
} else {
- OPM_WriteString((CHAR*)"__REGMOD(\"", (LONGINT)11);
+ OPM_WriteString((CHAR*)"__REGMOD(\"", 11);
}
- OPM_WriteString(OPM_modName, ((LONGINT)(32)));
+ OPM_WriteString(OPM_modName, 32);
if (OPC_GlbPtrs) {
- OPM_WriteString((CHAR*)"\", EnumPtrs)", (LONGINT)13);
+ OPM_WriteString((CHAR*)"\", EnumPtrs)", 13);
} else {
- OPM_WriteString((CHAR*)"\", 0)", (LONGINT)6);
+ OPM_WriteString((CHAR*)"\", 0)", 6);
}
OPC_EndStat();
if (__STRCMP(OPM_modName, "SYSTEM") != 0) {
@@ -1478,10 +1391,10 @@ void OPC_EnterBody (void)
void OPC_ExitBody (void)
{
OPC_BegStat();
- if (OPC_mainprog) {
- OPM_WriteString((CHAR*)"__FINI;", (LONGINT)8);
+ if (__IN(10, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__FINI;", 8);
} else {
- OPM_WriteString((CHAR*)"__ENDMOD;", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__ENDMOD;", 10);
}
OPM_WriteLn();
OPC_EndBlk();
@@ -1491,55 +1404,60 @@ void OPC_DefineInter (OPT_Object proc)
{
OPT_Object scope = NIL;
scope = proc->scope;
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
- OPM_WriteString((CHAR*)"struct ", (LONGINT)8);
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
+ OPM_WriteString((CHAR*)"static ", 8);
+ OPM_WriteString((CHAR*)"struct ", 8);
+ OPM_WriteStringVar((void*)scope->name, 256);
OPM_Write(' ');
OPC_BegBlk();
OPC_IdentList(proc->link, 3);
OPC_IdentList(scope->scope, 3);
OPC_BegStat();
- OPM_WriteString((CHAR*)"struct ", (LONGINT)8);
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
+ OPM_WriteString((CHAR*)"struct ", 8);
+ OPM_WriteStringVar((void*)scope->name, 256);
OPM_Write(' ');
OPM_Write('*');
- OPM_WriteString((CHAR*)"lnk", (LONGINT)4);
+ OPM_WriteString((CHAR*)"lnk", 4);
OPC_EndStat();
OPC_EndBlk0();
OPM_Write(' ');
OPM_Write('*');
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteStringVar((void*)scope->name, 256);
+ OPM_WriteString((CHAR*)"_s", 3);
OPC_EndStat();
OPM_WriteLn();
OPC_ProcPredefs(scope->right, 0);
OPM_WriteLn();
}
+BOOLEAN OPC_NeedsRetval (OPT_Object proc)
+{
+ return (proc->typ != OPT_notyp && !proc->scope->leaf);
+}
+
void OPC_EnterProc (OPT_Object proc)
{
OPT_Object var = NIL, scope = NIL;
OPT_Struct typ = NIL;
- INTEGER dim;
+ INT16 dim;
if (proc->vis != 1) {
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"static ", 8);
}
OPC_ProcHeader(proc, 1);
OPC_BegBlk();
- if (proc->typ != OPT_notyp) {
- OPC_BegStat();
- OPC_Ident(proc->typ->strobj);
- OPM_WriteString((CHAR*)" _o_result;", (LONGINT)12);
- OPM_WriteLn();
- }
scope = proc->scope;
OPC_IdentList(scope->scope, 0);
if (!scope->leaf) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"struct ", (LONGINT)8);
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
+ OPM_WriteString((CHAR*)"struct ", 8);
+ OPM_WriteStringVar((void*)scope->name, 256);
OPM_Write(' ');
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"_s", 3);
+ OPC_EndStat();
+ }
+ if (OPC_NeedsRetval(proc)) {
+ OPC_BegStat();
+ OPC_Ident(proc->typ->strobj);
+ OPM_WriteString((CHAR*)" __retval", 10);
OPC_EndStat();
}
var = proc->link;
@@ -1553,56 +1471,41 @@ void OPC_EnterProc (OPT_Object proc)
}
OPM_Write(' ');
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__copy", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__copy", 7);
OPC_EndStat();
}
var = var->link;
}
- if (!OPC_ansi) {
- var = proc->link;
- while (var != NIL) {
- if ((var->typ->form == 7 && var->mode == 1)) {
- OPC_BegStat();
- OPC_Ident(var->typ->strobj);
- OPM_Write(' ');
- OPC_Ident(var);
- OPM_WriteString((CHAR*)" = _", (LONGINT)5);
- OPC_Ident(var);
- OPC_EndStat();
- }
- var = var->link;
- }
- }
var = proc->link;
while (var != NIL) {
- if ((((__IN(var->typ->comp, 0x0c) && var->mode == 1)) && var->typ->sysflag == 0)) {
+ if ((((__IN(var->typ->comp, 0x0c, 32) && var->mode == 1)) && var->typ->sysflag == 0)) {
OPC_BegStat();
if (var->typ->comp == 2) {
- OPM_WriteString((CHAR*)"__DUPARR(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__DUPARR(", 10);
OPC_Ident(var);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
if (var->typ->strobj == NIL) {
OPM_Mark(200, var->typ->txtpos);
} else {
OPC_Ident(var->typ->strobj);
}
} else {
- OPM_WriteString((CHAR*)"__DUP(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__DUP(", 7);
OPC_Ident(var);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
typ = var->typ->BaseTyp;
dim = 1;
while (typ->comp == 3) {
- OPM_WriteString((CHAR*)" * ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" * ", 4);
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
OPM_WriteInt(dim);
typ = typ->BaseTyp;
dim += 1;
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
if (typ->strobj == NIL) {
OPM_Mark(200, typ->txtpos);
} else {
@@ -1619,12 +1522,12 @@ void OPC_EnterProc (OPT_Object proc)
while (var != NIL) {
if (!var->leaf) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
OPC_Ident(var);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
- if (__IN(var->typ->comp, 0x0c)) {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
+ OPM_WriteString((CHAR*)" = ", 4);
+ if (__IN(var->typ->comp, 0x0c, 32)) {
+ OPM_WriteString((CHAR*)"(void*)", 8);
} else if (var->mode != 2) {
OPM_Write('&');
}
@@ -1633,31 +1536,31 @@ void OPC_EnterProc (OPT_Object proc)
typ = var->typ;
dim = 0;
do {
- OPM_WriteString((CHAR*)"; ", (LONGINT)3);
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"; ", 3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
if (dim != 0) {
OPM_WriteInt(dim);
}
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" = ", 4);
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
if (dim != 0) {
OPM_WriteInt(dim);
}
typ = typ->BaseTyp;
} while (!(typ->comp != 3));
} else if ((var->mode == 2 && var->typ->comp == 4)) {
- OPM_WriteString((CHAR*)"; ", (LONGINT)3);
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"; ", 3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteString((CHAR*)"__typ", 6);
+ OPM_WriteString((CHAR*)" = ", 4);
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
}
OPC_EndStat();
}
@@ -1667,14 +1570,14 @@ void OPC_EnterProc (OPT_Object proc)
while (var != NIL) {
if (!var->leaf) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
OPC_Ident(var);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" = ", 4);
if (var->typ->comp != 2) {
OPM_Write('&');
} else {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
+ OPM_WriteString((CHAR*)"(void*)", 8);
}
OPC_Ident(var);
OPC_EndStat();
@@ -1682,19 +1585,19 @@ void OPC_EnterProc (OPT_Object proc)
var = var->link;
}
OPC_BegStat();
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
- OPM_WriteString((CHAR*)"lnk", (LONGINT)4);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"lnk", 4);
+ OPM_WriteString((CHAR*)" = ", 4);
+ OPM_WriteStringVar((void*)scope->name, 256);
+ OPM_WriteString((CHAR*)"_s", 3);
OPC_EndStat();
OPC_BegStat();
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteStringVar((void*)scope->name, 256);
+ OPM_WriteString((CHAR*)"_s", 3);
+ OPM_WriteString((CHAR*)" = ", 4);
OPM_Write('&');
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPC_EndStat();
}
}
@@ -1706,7 +1609,7 @@ void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet)
indent = eoBlock;
if ((implicitRet && proc->typ != OPT_notyp)) {
OPM_Write(0x09);
- OPM_WriteString((CHAR*)"__RETCHK;", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__RETCHK;", 10);
OPM_WriteLn();
} else if (!eoBlock || implicitRet) {
if (!proc->scope->leaf) {
@@ -1715,12 +1618,12 @@ void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet)
} else {
indent = 1;
}
- OPM_WriteStringVar((void*)proc->scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteStringVar((void*)proc->scope->name, 256);
+ OPM_WriteString((CHAR*)"_s", 3);
+ OPM_WriteString((CHAR*)" = ", 4);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
- OPM_WriteString((CHAR*)"lnk", (LONGINT)4);
+ OPM_WriteString((CHAR*)"lnk", 4);
OPC_EndStat();
}
var = proc->link;
@@ -1731,7 +1634,7 @@ void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet)
} else {
indent = 1;
}
- OPM_WriteString((CHAR*)"__DEL(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__DEL(", 7);
OPC_Ident(var);
OPM_Write(')');
OPC_EndStat();
@@ -1749,14 +1652,14 @@ void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet)
void OPC_CompleteIdent (OPT_Object obj)
{
- INTEGER comp, level;
+ INT16 comp, level;
level = obj->mnolev;
if (obj->adr == 1) {
if (obj->typ->comp == 4) {
OPC_Ident(obj);
- OPM_WriteString((CHAR*)"__", (LONGINT)3);
+ OPM_WriteString((CHAR*)"__", 3);
} else {
- OPM_WriteString((CHAR*)"((", (LONGINT)3);
+ OPM_WriteString((CHAR*)"((", 3);
OPC_Ident(obj->typ->strobj);
OPM_Write(')');
OPC_Ident(obj);
@@ -1767,9 +1670,9 @@ void OPC_CompleteIdent (OPT_Object obj)
if ((obj->mode != 2 && comp != 3)) {
OPM_Write('*');
}
- OPM_WriteStringVar((void*)obj->scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
- OPM_WriteString((CHAR*)"->", (LONGINT)3);
+ OPM_WriteStringVar((void*)obj->scope->name, 256);
+ OPM_WriteString((CHAR*)"_s", 3);
+ OPM_WriteString((CHAR*)"->", 3);
OPC_Ident(obj);
} else {
OPC_Ident(obj);
@@ -1778,58 +1681,58 @@ void OPC_CompleteIdent (OPT_Object obj)
void OPC_TypeOf (OPT_Object ap)
{
- INTEGER i;
+ INT16 i;
__ASSERT(ap->typ->comp == 4, 0);
if (ap->mode == 2) {
- if ((int)ap->mnolev != OPM_level) {
- OPM_WriteStringVar((void*)ap->scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s->", (LONGINT)5);
+ if ((INT16)ap->mnolev != OPM_level) {
+ OPM_WriteStringVar((void*)ap->scope->name, 256);
+ OPM_WriteString((CHAR*)"_s->", 5);
OPC_Ident(ap);
} else {
OPC_Ident(ap);
}
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
} else if (ap->typ->strobj != NIL) {
OPC_Ident(ap->typ->strobj);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
} else {
OPC_Andent(ap->typ);
}
}
-void OPC_Cmp (INTEGER rel)
+void OPC_Cmp (INT16 rel)
{
switch (rel) {
case 9:
- OPM_WriteString((CHAR*)" == ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" == ", 5);
break;
case 10:
- OPM_WriteString((CHAR*)" != ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" != ", 5);
break;
case 11:
- OPM_WriteString((CHAR*)" < ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" < ", 4);
break;
case 12:
- OPM_WriteString((CHAR*)" <= ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" <= ", 5);
break;
case 13:
- OPM_WriteString((CHAR*)" > ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" > ", 4);
break;
case 14:
- OPM_WriteString((CHAR*)" >= ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" >= ", 5);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPC.Cmp, rel = ", (LONGINT)34);
- OPM_LogWNum(rel, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPC.Cmp, rel = ", 34);
+ OPM_LogWNum(rel, 0);
OPM_LogWLn();
break;
}
}
-static void OPC_CharacterLiteral (LONGINT c)
+static void OPC_CharacterLiteral (INT64 c)
{
if (c < 32 || c > 126) {
- OPM_WriteString((CHAR*)"0x", (LONGINT)3);
+ OPM_WriteString((CHAR*)"0x", 3);
OPM_WriteHex(c);
} else {
OPM_Write('\'');
@@ -1841,15 +1744,15 @@ static void OPC_CharacterLiteral (LONGINT c)
}
}
-static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l)
+static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l)
{
- LONGINT i;
- INTEGER c;
+ INT32 i;
+ INT16 c;
__DUP(s, s__len, CHAR);
OPM_Write('"');
i = 0;
while (i < l) {
- c = (int)s[__X(i, s__len)];
+ c = (INT16)s[__X(i, s__len)];
if (c < 32 || c > 126) {
OPM_Write('\\');
OPM_Write((CHAR)(48 + __ASHR(c, 6)));
@@ -1869,54 +1772,67 @@ static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l)
__DEL(s);
}
-void OPC_Case (LONGINT caseVal, INTEGER form)
+void OPC_Case (INT64 caseVal, INT16 form)
{
CHAR ch;
- OPM_WriteString((CHAR*)"case ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"case ", 6);
switch (form) {
case 3:
OPC_CharacterLiteral(caseVal);
break;
- case 4: case 5: case 6:
+ case 4:
OPM_WriteInt(caseVal);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPC.Case, form = ", (LONGINT)36);
- OPM_LogWNum(form, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPC.Case, form = ", 36);
+ OPM_LogWNum(form, 0);
OPM_LogWLn();
break;
}
- OPM_WriteString((CHAR*)": ", (LONGINT)3);
+ OPM_WriteString((CHAR*)": ", 3);
}
void OPC_SetInclude (BOOLEAN exclude)
{
if (exclude) {
- OPM_WriteString((CHAR*)" &= ~", (LONGINT)6);
+ OPM_WriteString((CHAR*)" &= ~", 6);
} else {
- OPM_WriteString((CHAR*)" |= ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" |= ", 5);
}
}
void OPC_Increment (BOOLEAN decrement)
{
if (decrement) {
- OPM_WriteString((CHAR*)" -= ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" -= ", 5);
} else {
- OPM_WriteString((CHAR*)" += ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" += ", 5);
}
}
-void OPC_Halt (LONGINT n)
+void OPC_Halt (INT32 n)
{
- OPC_Str1((CHAR*)"__HALT(#)", (LONGINT)10, n);
+ OPC_Str1((CHAR*)"__HALT(#)", 10, n);
}
-void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim)
+void OPC_IntLiteral (INT64 n, INT32 size)
+{
+ if ((((size > 4 && n <= 2147483647)) && n > (-2147483647-1))) {
+ OPM_WriteString((CHAR*)"((INT", 6);
+ OPM_WriteInt(__ASHL(size, 3));
+ OPM_WriteString((CHAR*)")(", 3);
+ OPM_WriteInt(n);
+ OPM_WriteString((CHAR*)"))", 3);
+ } else {
+ OPM_WriteInt(n);
+ }
+}
+
+void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim)
{
if (array->comp == 3) {
OPC_CompleteIdent(obj);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
if (dim != 0) {
OPM_WriteInt(dim);
}
@@ -1925,17 +1841,15 @@ void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim)
array = array->BaseTyp;
dim -= 1;
}
- OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12);
OPM_WriteInt(array->n);
- OPM_WriteString((CHAR*)"))", (LONGINT)3);
}
}
-void OPC_Constant (OPT_Const con, INTEGER form)
+void OPC_Constant (OPT_Const con, INT16 form)
{
- INTEGER i;
- SET s;
- LONGINT hex;
+ INT16 i;
+ UINT64 s;
+ INT64 hex;
BOOLEAN skipLeading;
switch (form) {
case 1:
@@ -1947,26 +1861,26 @@ void OPC_Constant (OPT_Const con, INTEGER form)
case 3:
OPC_CharacterLiteral(con->intval);
break;
- case 4: case 5: case 6:
+ case 4:
OPM_WriteInt(con->intval);
break;
- case 7:
+ case 5:
OPM_WriteReal(con->realval, 'f');
break;
- case 8:
+ case 6:
OPM_WriteReal(con->realval, 0x00);
break;
- case 9:
- OPM_WriteString((CHAR*)"0x", (LONGINT)3);
+ case 7:
+ OPM_WriteString((CHAR*)"0x", 3);
skipLeading = 1;
s = con->setval;
- i = 32;
+ i = 64;
do {
hex = 0;
do {
i -= 1;
hex = __ASHL(hex, 1);
- if (__IN(i, s)) {
+ if (__IN(i, s, 64)) {
hex += 1;
}
} while (!(__MASK(i, -8) == 0));
@@ -1979,88 +1893,98 @@ void OPC_Constant (OPT_Const con, INTEGER form)
OPM_Write('0');
}
break;
- case 10:
- OPC_StringLiteral(*con->ext, ((LONGINT)(256)), con->intval2 - 1);
+ case 8:
+ OPC_StringLiteral(*con->ext, 256, con->intval2 - 1);
break;
- case 11:
- OPM_WriteString((CHAR*)"NIL", (LONGINT)4);
+ case 9:
+ OPM_WriteString((CHAR*)"NIL", 4);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPC.Constant, form = ", (LONGINT)40);
- OPM_LogWNum(form, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPC.Constant, form = ", 40);
+ OPM_LogWNum(form, 0);
OPM_LogWLn();
break;
}
}
-static struct InitKeywords__48 {
- SHORTINT *n;
- struct InitKeywords__48 *lnk;
-} *InitKeywords__48_s;
+static struct InitKeywords__46 {
+ INT8 *n;
+ struct InitKeywords__46 *lnk;
+} *InitKeywords__46_s;
-static void Enter__49 (CHAR *s, LONGINT s__len);
+static void Enter__47 (CHAR *s, LONGINT s__len);
-static void Enter__49 (CHAR *s, LONGINT s__len)
+static void Enter__47 (CHAR *s, LONGINT s__len)
{
- INTEGER h;
+ INT16 h;
__DUP(s, s__len, CHAR);
h = OPC_PerfectHash((void*)s, s__len);
- OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__48_s->n;
- __COPY(s, OPC_keytab[__X(*InitKeywords__48_s->n, ((LONGINT)(36)))], ((LONGINT)(9)));
- *InitKeywords__48_s->n += 1;
+ OPC_hashtab[__X(h, 105)] = *InitKeywords__46_s->n;
+ __COPY(s, OPC_keytab[__X(*InitKeywords__46_s->n, 50)], 9);
+ *InitKeywords__46_s->n += 1;
__DEL(s);
}
static void OPC_InitKeywords (void)
{
- SHORTINT n, i;
- struct InitKeywords__48 _s;
+ INT8 n, i;
+ struct InitKeywords__46 _s;
_s.n = &n;
- _s.lnk = InitKeywords__48_s;
- InitKeywords__48_s = &_s;
+ _s.lnk = InitKeywords__46_s;
+ InitKeywords__46_s = &_s;
n = 0;
i = 0;
while (i <= 104) {
- OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1;
+ OPC_hashtab[__X(i, 105)] = -1;
i += 1;
}
- Enter__49((CHAR*)"asm", (LONGINT)4);
- Enter__49((CHAR*)"auto", (LONGINT)5);
- Enter__49((CHAR*)"break", (LONGINT)6);
- Enter__49((CHAR*)"case", (LONGINT)5);
- Enter__49((CHAR*)"char", (LONGINT)5);
- Enter__49((CHAR*)"const", (LONGINT)6);
- Enter__49((CHAR*)"continue", (LONGINT)9);
- Enter__49((CHAR*)"default", (LONGINT)8);
- Enter__49((CHAR*)"do", (LONGINT)3);
- Enter__49((CHAR*)"double", (LONGINT)7);
- Enter__49((CHAR*)"else", (LONGINT)5);
- Enter__49((CHAR*)"enum", (LONGINT)5);
- Enter__49((CHAR*)"extern", (LONGINT)7);
- Enter__49((CHAR*)"export", (LONGINT)7);
- Enter__49((CHAR*)"float", (LONGINT)6);
- Enter__49((CHAR*)"for", (LONGINT)4);
- Enter__49((CHAR*)"fortran", (LONGINT)8);
- Enter__49((CHAR*)"goto", (LONGINT)5);
- Enter__49((CHAR*)"if", (LONGINT)3);
- Enter__49((CHAR*)"import", (LONGINT)7);
- Enter__49((CHAR*)"int", (LONGINT)4);
- Enter__49((CHAR*)"long", (LONGINT)5);
- Enter__49((CHAR*)"register", (LONGINT)9);
- Enter__49((CHAR*)"return", (LONGINT)7);
- Enter__49((CHAR*)"short", (LONGINT)6);
- Enter__49((CHAR*)"signed", (LONGINT)7);
- Enter__49((CHAR*)"sizeof", (LONGINT)7);
- Enter__49((CHAR*)"static", (LONGINT)7);
- Enter__49((CHAR*)"struct", (LONGINT)7);
- Enter__49((CHAR*)"switch", (LONGINT)7);
- Enter__49((CHAR*)"typedef", (LONGINT)8);
- Enter__49((CHAR*)"union", (LONGINT)6);
- Enter__49((CHAR*)"unsigned", (LONGINT)9);
- Enter__49((CHAR*)"void", (LONGINT)5);
- Enter__49((CHAR*)"volatile", (LONGINT)9);
- Enter__49((CHAR*)"while", (LONGINT)6);
- InitKeywords__48_s = _s.lnk;
+ Enter__47((CHAR*)"ADDRESS", 8);
+ Enter__47((CHAR*)"INT16", 6);
+ Enter__47((CHAR*)"INT32", 6);
+ Enter__47((CHAR*)"INT64", 6);
+ Enter__47((CHAR*)"INT8", 5);
+ Enter__47((CHAR*)"UINT16", 7);
+ Enter__47((CHAR*)"UINT32", 7);
+ Enter__47((CHAR*)"UINT64", 7);
+ Enter__47((CHAR*)"UINT8", 6);
+ Enter__47((CHAR*)"asm", 4);
+ Enter__47((CHAR*)"auto", 5);
+ Enter__47((CHAR*)"break", 6);
+ Enter__47((CHAR*)"case", 5);
+ Enter__47((CHAR*)"char", 5);
+ Enter__47((CHAR*)"const", 6);
+ Enter__47((CHAR*)"continue", 9);
+ Enter__47((CHAR*)"default", 8);
+ Enter__47((CHAR*)"do", 3);
+ Enter__47((CHAR*)"double", 7);
+ Enter__47((CHAR*)"else", 5);
+ Enter__47((CHAR*)"enum", 5);
+ Enter__47((CHAR*)"extern", 7);
+ Enter__47((CHAR*)"export", 7);
+ Enter__47((CHAR*)"float", 6);
+ Enter__47((CHAR*)"for", 4);
+ Enter__47((CHAR*)"fortran", 8);
+ Enter__47((CHAR*)"goto", 5);
+ Enter__47((CHAR*)"if", 3);
+ Enter__47((CHAR*)"import", 7);
+ Enter__47((CHAR*)"int", 4);
+ Enter__47((CHAR*)"long", 5);
+ Enter__47((CHAR*)"register", 9);
+ Enter__47((CHAR*)"return", 7);
+ Enter__47((CHAR*)"short", 6);
+ Enter__47((CHAR*)"signed", 7);
+ Enter__47((CHAR*)"sizeof", 7);
+ Enter__47((CHAR*)"size_t", 7);
+ Enter__47((CHAR*)"static", 7);
+ Enter__47((CHAR*)"struct", 7);
+ Enter__47((CHAR*)"switch", 7);
+ Enter__47((CHAR*)"typedef", 8);
+ Enter__47((CHAR*)"union", 6);
+ Enter__47((CHAR*)"unsigned", 9);
+ Enter__47((CHAR*)"void", 5);
+ Enter__47((CHAR*)"volatile", 9);
+ Enter__47((CHAR*)"while", 6);
+ InitKeywords__46_s = _s.lnk;
}
diff --git a/bootstrap/unix-44/OPC.h b/bootstrap/unix-44/OPC.h
index b7d34a07..842e7dec 100644
--- a/bootstrap/unix-44/OPC.h
+++ b/bootstrap/unix-44/OPC.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPC__h
#define OPC__h
@@ -9,16 +9,14 @@
-import void OPC_Align (LONGINT *adr, LONGINT base);
import void OPC_Andent (OPT_Struct typ);
-import LONGINT OPC_BaseAlignment (OPT_Struct typ);
import OPT_Object OPC_BaseTProc (OPT_Object obj);
import void OPC_BegBlk (void);
import void OPC_BegStat (void);
-import void OPC_Case (LONGINT caseVal, INTEGER form);
-import void OPC_Cmp (INTEGER rel);
+import void OPC_Case (INT64 caseVal, INT16 form);
+import void OPC_Cmp (INT16 rel);
import void OPC_CompleteIdent (OPT_Object obj);
-import void OPC_Constant (OPT_Const con, INTEGER form);
+import void OPC_Constant (OPT_Const con, INT16 form);
import void OPC_DefineInter (OPT_Object proc);
import void OPC_EndBlk (void);
import void OPC_EndBlk0 (void);
@@ -31,20 +29,21 @@ import void OPC_GenBdy (OPT_Node n);
import void OPC_GenEnumPtrs (OPT_Object var);
import void OPC_GenHdr (OPT_Node n);
import void OPC_GenHdrIncludes (void);
-import void OPC_Halt (LONGINT n);
+import void OPC_Halt (INT32 n);
import void OPC_Ident (OPT_Object obj);
import void OPC_Increment (BOOLEAN decrement);
-import void OPC_Indent (INTEGER count);
+import void OPC_Indent (INT16 count);
import void OPC_Init (void);
import void OPC_InitTDesc (OPT_Struct typ);
-import void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim);
-import LONGINT OPC_NofPtrs (OPT_Struct typ);
+import void OPC_IntLiteral (INT64 n, INT32 size);
+import void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim);
+import BOOLEAN OPC_NeedsRetval (OPT_Object proc);
+import INT32 OPC_NofPtrs (OPT_Struct typ);
import void OPC_SetInclude (BOOLEAN exclude);
-import LONGINT OPC_SizeAlignment (LONGINT size);
import void OPC_TDescDecl (OPT_Struct typ);
-import void OPC_TypeDefs (OPT_Object obj, INTEGER vis);
+import void OPC_TypeDefs (OPT_Object obj, INT16 vis);
import void OPC_TypeOf (OPT_Object ap);
import void *OPC__init(void);
-#endif
+#endif // OPC
diff --git a/bootstrap/unix-44/OPM.c b/bootstrap/unix-44/OPM.c
index bf683e41..e76d763e 100644
--- a/bootstrap/unix-44/OPM.c
+++ b/bootstrap/unix-44/OPM.c
@@ -1,305 +1,474 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "Configuration.h"
-#include "Console.h"
#include "Files.h"
+#include "Out.h"
#include "Platform.h"
#include "Strings.h"
#include "Texts.h"
-#include "errors.h"
-#include "vt100.h"
+#include "VT100.h"
typedef
CHAR OPM_FileName[32];
static CHAR OPM_SourceFileName[256];
-export INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_MaxSet;
-export LONGINT OPM_MaxIndex;
+static CHAR OPM_GlobalModel[10];
+export CHAR OPM_Model[10];
+static INT16 OPM_GlobalAddressSize;
+export INT16 OPM_AddressSize;
+static INT16 OPM_GlobalAlignment;
+export INT16 OPM_Alignment;
+export UINT32 OPM_GlobalOptions, OPM_Options;
+export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize;
+export INT64 OPM_MaxIndex;
export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
export BOOLEAN OPM_noerr;
-export LONGINT OPM_curpos, OPM_errpos, OPM_breakpc;
-export INTEGER OPM_currFile, OPM_level, OPM_pc, OPM_entno;
+export INT32 OPM_curpos, OPM_errpos, OPM_breakpc;
+export INT16 OPM_currFile, OPM_level, OPM_pc, OPM_entno;
export CHAR OPM_modName[32];
export CHAR OPM_objname[64];
-export SET OPM_opt, OPM_glbopt;
-static LONGINT OPM_ErrorLineStartPos, OPM_ErrorLineLimitPos, OPM_ErrorLineNumber, OPM_lasterrpos;
+static INT32 OPM_ErrorLineStartPos, OPM_ErrorLineLimitPos, OPM_ErrorLineNumber, OPM_lasterrpos;
static Texts_Reader OPM_inR;
-static Texts_Text OPM_Log;
-static Texts_Writer OPM_W;
+static Texts_Text OPM_Log, OPM_Errors;
static Files_Rider OPM_oldSF, OPM_newSF;
static Files_Rider OPM_R[3];
static Files_File OPM_oldSFile, OPM_newSFile, OPM_HFile, OPM_BFile, OPM_HIFile;
-static INTEGER OPM_S;
-export BOOLEAN OPM_dontAsm, OPM_dontLink, OPM_mainProg, OPM_mainLinkStat, OPM_notColorOutput, OPM_forceNewSym, OPM_Verbose;
-static CHAR OPM_OBERON[1024];
-static CHAR OPM_MODULES[1024];
+static INT16 OPM_S;
+export CHAR OPM_ResourceDir[1024];
-static void OPM_Append (Files_Rider *R, LONGINT *R__typ, Files_File F);
+static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F);
export void OPM_CloseFiles (void);
export void OPM_CloseOldSym (void);
export void OPM_DeleteNewSym (void);
-export void OPM_FPrint (LONGINT *fp, LONGINT val);
-export void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr);
-export void OPM_FPrintReal (LONGINT *fp, REAL real);
-export void OPM_FPrintSet (LONGINT *fp, SET set);
-static void OPM_FindLine (Files_File f, Files_Rider *r, LONGINT *r__typ, LONGINT pos);
+export void OPM_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_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos);
+static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len);
export void OPM_Get (CHAR *ch);
-static void OPM_GetProperties (void);
-static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align);
export void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
export void OPM_InitOptions (void);
-static void OPM_LogErrMsg (INTEGER n);
+export INT16 OPM_Integer (INT64 n);
+static void OPM_LogErrMsg (INT16 n);
+export void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
export void OPM_LogW (CHAR ch);
export void OPM_LogWLn (void);
-export void OPM_LogWNum (LONGINT i, LONGINT len);
+export void OPM_LogWNum (INT64 i, INT64 len);
export void OPM_LogWStr (CHAR *s, LONGINT s__len);
+export INT32 OPM_Longint (INT64 n);
static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len);
-export void OPM_Mark (INTEGER n, LONGINT pos);
+export void OPM_Mark (INT16 n, INT32 pos);
export void OPM_NewSym (CHAR *modName, LONGINT modName__len);
export void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
export void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
export BOOLEAN OPM_OpenPar (void);
export void OPM_RegisterNewSym (void);
-static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt);
-static void OPM_ShowLine (LONGINT pos);
-export LONGINT OPM_SignedMaximum (LONGINT bytecount);
-export LONGINT OPM_SignedMinimum (LONGINT bytecount);
+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_SymRCh (CHAR *ch);
-export LONGINT OPM_SymRInt (void);
+export INT32 OPM_SymRInt (void);
+export INT64 OPM_SymRInt64 (void);
export void OPM_SymRLReal (LONGREAL *lr);
export void OPM_SymRReal (REAL *r);
-export void OPM_SymRSet (SET *s);
+export void OPM_SymRSet (UINT64 *s);
export void OPM_SymWCh (CHAR ch);
-export void OPM_SymWInt (LONGINT i);
+export void OPM_SymWInt (INT64 i);
export void OPM_SymWLReal (LONGREAL lr);
export void OPM_SymWReal (REAL r);
-export void OPM_SymWSet (SET s);
+export void OPM_SymWSet (UINT64 s);
static void OPM_VerboseListSizes (void);
export void OPM_Write (CHAR ch);
-export void OPM_WriteHex (LONGINT i);
-export void OPM_WriteInt (LONGINT i);
+export void OPM_WriteHex (INT64 i);
+export void OPM_WriteInt (INT64 i);
export void OPM_WriteLn (void);
export void OPM_WriteReal (LONGREAL r, CHAR suffx);
export void OPM_WriteString (CHAR *s, LONGINT s__len);
export void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
export BOOLEAN OPM_eofSF (void);
-export void OPM_err (INTEGER n);
-static LONGINT OPM_minusop (LONGINT i);
-static LONGINT OPM_power0 (LONGINT i, LONGINT j);
+export void OPM_err (INT16 n);
+#define OPM_GetAlignment(a) struct {char c; long long l;} _s; *a = (char*)&_s.l - (char*)&_s
void OPM_LogW (CHAR ch)
{
- Console_Char(ch);
+ Out_Char(ch);
}
void OPM_LogWStr (CHAR *s, LONGINT s__len)
{
__DUP(s, s__len, CHAR);
- Console_String(s, s__len);
+ Out_String(s, s__len);
__DEL(s);
}
-void OPM_LogWNum (LONGINT i, LONGINT len)
+void OPM_LogWNum (INT64 i, INT64 len)
{
- Console_Int(i, len);
+ Out_Int(i, len);
}
void OPM_LogWLn (void)
{
- Console_Ln();
+ Out_Ln();
}
-static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt)
+void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len)
{
- INTEGER i;
+ __DUP(vt100code, vt100code__len, CHAR);
+ if ((Out_IsConsole && !__IN(16, OPM_Options, 32))) {
+ VT100_SetAttr(vt100code, vt100code__len);
+ }
+ __DEL(vt100code);
+}
+
+INT64 OPM_SignedMaximum (INT32 bytecount)
+{
+ INT64 result;
+ result = 1;
+ result = __LSH(result, __ASHL(bytecount, 3) - 1, 64);
+ return result - 1;
+}
+
+INT64 OPM_SignedMinimum (INT32 bytecount)
+{
+ return -OPM_SignedMaximum(bytecount) - 1;
+}
+
+INT32 OPM_Longint (INT64 n)
+{
+ return __VAL(INT32, n);
+}
+
+INT16 OPM_Integer (INT64 n)
+{
+ return __VAL(INT16, n);
+}
+
+static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
+{
+ INT16 i;
+ __DUP(s, s__len, CHAR);
i = 1;
while (s[__X(i, s__len)] != 0x00) {
switch (s[__X(i, s__len)]) {
- case 'a':
- *opt = *opt ^ 0x80;
- break;
- case 'c':
- *opt = *opt ^ 0x4000;
- break;
- case 'e':
- *opt = *opt ^ 0x0200;
- break;
- case 'f':
- *opt = *opt ^ 0x010000;
- break;
- case 'k':
- *opt = *opt ^ 0x40;
- break;
- case 'm':
- *opt = *opt ^ 0x0400;
- break;
case 'p':
- *opt = *opt ^ 0x20;
+ OPM_Options = OPM_Options ^ 0x20;
+ break;
+ case 'a':
+ OPM_Options = OPM_Options ^ 0x80;
break;
case 'r':
- *opt = *opt ^ 0x04;
- break;
- case 's':
- *opt = *opt ^ 0x10;
+ OPM_Options = OPM_Options ^ 0x04;
break;
case 't':
- *opt = *opt ^ 0x08;
+ OPM_Options = OPM_Options ^ 0x08;
break;
case 'x':
- *opt = *opt ^ 0x01;
+ OPM_Options = OPM_Options ^ 0x01;
+ break;
+ case 'e':
+ OPM_Options = OPM_Options ^ 0x0200;
+ break;
+ case 's':
+ OPM_Options = OPM_Options ^ 0x10;
+ break;
+ case 'F':
+ OPM_Options = OPM_Options ^ 0x020000;
+ break;
+ case 'm':
+ OPM_Options = OPM_Options ^ 0x0400;
+ break;
+ case 'M':
+ OPM_Options = OPM_Options ^ 0x8000;
+ break;
+ case 'S':
+ OPM_Options = OPM_Options ^ 0x2000;
+ break;
+ case 'c':
+ OPM_Options = OPM_Options ^ 0x4000;
+ break;
+ case 'f':
+ OPM_Options = OPM_Options ^ 0x010000;
+ break;
+ case 'V':
+ OPM_Options = OPM_Options ^ 0x040000;
+ break;
+ case 'O':
+ if (i + 1 >= Strings_Length(s, s__len)) {
+ OPM_LogWStr((CHAR*)"-O option requires following size model character.", 51);
+ OPM_LogWLn();
+ } else {
+ OPM_Model[0] = s[__X(i + 1, s__len)];
+ OPM_Model[1] = 0x00;
+ if ((((OPM_Model[0] != '2' && OPM_Model[0] != 'C')) && OPM_Model[0] != 'V')) {
+ OPM_LogWStr((CHAR*)"Unrecognised size model character following -O.", 48);
+ OPM_LogWLn();
+ }
+ i += 1;
+ }
+ break;
+ case 'A':
+ if (i + 2 >= Strings_Length(s, s__len)) {
+ OPM_LogWStr((CHAR*)"-M option requires two following digits.", 41);
+ OPM_LogWLn();
+ } else {
+ OPM_AddressSize = (INT16)s[__X(i + 1, s__len)] - 48;
+ OPM_Alignment = (INT16)s[__X(i + 2, s__len)] - 48;
+ i += 2;
+ }
break;
case 'B':
if (s[__X(i + 1, s__len)] != 0x00) {
i += 1;
- OPM_IntSize = (int)s[__X(i, s__len)] - 48;
+ OPM_IntegerSize = (INT16)s[__X(i, s__len)] - 48;
}
if (s[__X(i + 1, s__len)] != 0x00) {
i += 1;
- OPM_PointerSize = (int)s[__X(i, s__len)] - 48;
+ OPM_AddressSize = (INT16)s[__X(i, s__len)] - 48;
}
if (s[__X(i + 1, s__len)] != 0x00) {
i += 1;
- OPM_Alignment = (int)s[__X(i, s__len)] - 48;
+ OPM_Alignment = (INT16)s[__X(i, s__len)] - 48;
}
- __ASSERT(OPM_IntSize == 2 || OPM_IntSize == 4, 0);
- __ASSERT(OPM_PointerSize == 4 || OPM_PointerSize == 8, 0);
+ __ASSERT(OPM_IntegerSize == 2 || OPM_IntegerSize == 4, 0);
+ __ASSERT(OPM_AddressSize == 4 || OPM_AddressSize == 8, 0);
__ASSERT(OPM_Alignment == 4 || OPM_Alignment == 8, 0);
- Files_SetSearchPath((CHAR*)"", (LONGINT)1);
- break;
- case 'F':
- *opt = *opt ^ 0x020000;
- break;
- case 'M':
- *opt = *opt ^ 0x8000;
- break;
- case 'S':
- *opt = *opt ^ 0x2000;
- break;
- case 'V':
- *opt = *opt ^ 0x040000;
+ if (OPM_IntegerSize == 2) {
+ OPM_LongintSize = 4;
+ } else {
+ OPM_LongintSize = 8;
+ }
+ Files_SetSearchPath((CHAR*)"", 1);
break;
default:
- OPM_LogWStr((CHAR*)" warning: option ", (LONGINT)19);
+ OPM_LogWStr((CHAR*)" warning: option ", 19);
OPM_LogW('-');
OPM_LogW(s[__X(i, s__len)]);
- OPM_LogWStr((CHAR*)" ignored", (LONGINT)9);
+ OPM_LogWStr((CHAR*)" ignored", 9);
OPM_LogWLn();
break;
}
i += 1;
}
+ __DEL(s);
}
BOOLEAN OPM_OpenPar (void)
{
- BOOLEAN _o_result;
CHAR s[256];
if (Platform_ArgCount == 1) {
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Vishap Oberon-2 compiler v", (LONGINT)27);
- OPM_LogWStr(Configuration_versionLong, ((LONGINT)(41)));
+ OPM_LogWStr((CHAR*)"Oberon-2 compiler v", 20);
+ OPM_LogWStr(Configuration_versionLong, 75);
OPM_LogW('.');
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Based on Ofront by Software Templ OEG, continued by Norayr Chilingarian and others.", (LONGINT)84);
+ 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_LogWLn();
- OPM_LogWStr((CHAR*)"Usage:", (LONGINT)7);
+ OPM_LogWStr((CHAR*)"Usage:", 7);
OPM_LogWLn();
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" ", (LONGINT)3);
- OPM_LogWStr((CHAR*)"voc", (LONGINT)4);
- OPM_LogWStr((CHAR*)" options {files {options}}.", (LONGINT)28);
+ OPM_LogWStr((CHAR*)" ", 3);
+ OPM_LogWStr((CHAR*)"voc", 4);
+ OPM_LogWStr((CHAR*)" options {files {options}}.", 28);
OPM_LogWLn();
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Where options = [\"-\" {option} ].", (LONGINT)33);
+ OPM_LogWStr((CHAR*)"Options:", 9);
OPM_LogWLn();
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" m - generate code for main module", (LONGINT)36);
+ OPM_LogWStr((CHAR*)" Run time safety", 18);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" M - generate code for main module and link object statically", (LONGINT)63);
+ OPM_LogWStr((CHAR*)" -p Initialise pointers to NIL. On by default.", 52);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" s - generate new symbol file", (LONGINT)31);
+ OPM_LogWStr((CHAR*)" -a Halt on assertion failures. On by default.", 52);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" e - allow extending the module interface", (LONGINT)43);
+ OPM_LogWStr((CHAR*)" -r Halt on range check failures.", 39);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" r - check value ranges", (LONGINT)25);
+ OPM_LogWStr((CHAR*)" -t Halt on type guard failure. On by default.", 52);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" a - don't check ASSERTs at runtime, use this option in tested production code", (LONGINT)80);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" t - don't check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" S - don't call external assembler/compiler, only generate C code", (LONGINT)67);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" c - don't call linker", (LONGINT)24);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" f - don't use color output", (LONGINT)29);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" V - verbose output", (LONGINT)21);
+ OPM_LogWStr((CHAR*)" -x Halt on index out of range. On by default.", 52);
OPM_LogWLn();
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Initial options specify defaults for all files.", (LONGINT)48);
+ OPM_LogWStr((CHAR*)" Symbol file management", 25);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Options following a filename are specific to that file.", (LONGINT)56);
+ OPM_LogWStr((CHAR*)" -e Allow extension of old symbol file.", 45);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Repeating an option toggles its value.", (LONGINT)39);
+ OPM_LogWStr((CHAR*)" -s Allow generation of new symbol file.", 46);
OPM_LogWLn();
- _o_result = 0;
- return _o_result;
+ OPM_LogWStr((CHAR*)" -F Force generation of new symbol file.", 46);
+ OPM_LogWLn();
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" C compiler and linker control", 32);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -m This module is main. Link dynamically.", 48);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -M This module is main. Link statically.", 47);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -S Don't call C compiler", 31);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -c Don't link.", 21);
+ OPM_LogWLn();
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" Miscellaneous", 16);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -f Disable VT100 control characters in status output.", 60);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -V Display compiler debugging messages.", 46);
+ OPM_LogWLn();
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" Size model for elementary types (default O2)", 47);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
+ OPM_LogWLn();
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" Target machine address size and alignment (default is that of the running compiler binary)", 93);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -A44 32 bit addresses, 32 bit alignment (e.g. Unix/linux 32 bit on x86).", 79);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -A48 32 bit addresses, 64 bit alignment (e.g. Windows 32 bit on x86, linux 32 bit on arm).", 97);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -A88 64 bit addresses, 64 bit alignment (e.g. 64 bit platforms).", 71);
+ OPM_LogWLn();
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"All options are off by default, except where noted above.", 58);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Initial options specify defaults for all files.", 48);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Options following a filename are specific to that file.", 56);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Repeating an option toggles its value.", 39);
+ OPM_LogWLn();
+ return 0;
} else {
+ OPM_AddressSize = 4;
+ OPM_GetAlignment(&OPM_Alignment);
+ __MOVE("2", OPM_Model, 2);
+ OPM_Options = 0xa9;
OPM_S = 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256)));
- OPM_glbopt = 0xe9;
+ Platform_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
- OPM_ScanOptions((void*)s, ((LONGINT)(256)), &OPM_glbopt);
+ OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256)));
+ Platform_GetArg(OPM_S, (void*)s, 256);
}
- _o_result = 1;
- return _o_result;
+ OPM_GlobalAddressSize = OPM_AddressSize;
+ OPM_GlobalAlignment = OPM_Alignment;
+ __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];
- OPM_opt = OPM_glbopt;
+ CHAR searchpath[1024], modules[1024];
+ CHAR MODULES[1024];
+ OPM_Options = OPM_GlobalOptions;
+ __COPY(OPM_GlobalModel, OPM_Model, 10);
+ OPM_Alignment = OPM_GlobalAlignment;
+ OPM_AddressSize = OPM_GlobalAddressSize;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256)));
+ Platform_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
- OPM_ScanOptions((void*)s, ((LONGINT)(256)), &OPM_opt);
+ OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256)));
+ Platform_GetArg(OPM_S, (void*)s, 256);
}
- OPM_dontAsm = __IN(13, OPM_opt);
- OPM_dontLink = __IN(14, OPM_opt);
- OPM_mainProg = __IN(10, OPM_opt);
- OPM_mainLinkStat = __IN(15, OPM_opt);
- OPM_notColorOutput = __IN(16, OPM_opt);
- OPM_forceNewSym = __IN(17, OPM_opt);
- OPM_Verbose = __IN(18, OPM_opt);
- if (OPM_mainLinkStat) {
- OPM_glbopt |= __SETOF(10);
+ if (__IN(15, OPM_Options, 32)) {
+ OPM_Options |= __SETOF(10,32);
}
- OPM_GetProperties();
+ OPM_MaxIndex = OPM_SignedMaximum(OPM_AddressSize);
+ switch (OPM_Model[0]) {
+ case '2':
+ OPM_ShortintSize = 1;
+ OPM_IntegerSize = 2;
+ OPM_LongintSize = 4;
+ break;
+ case 'C':
+ OPM_ShortintSize = 2;
+ OPM_IntegerSize = 4;
+ OPM_LongintSize = 8;
+ break;
+ case 'V':
+ OPM_ShortintSize = 1;
+ OPM_IntegerSize = 4;
+ OPM_LongintSize = 8;
+ break;
+ default:
+ OPM_ShortintSize = 1;
+ OPM_IntegerSize = 2;
+ OPM_LongintSize = 4;
+ break;
+ }
+ 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);
+ Platform_GetEnv((CHAR*)"OBERON", 7, (void*)searchpath, 1024);
+ Strings_Append((CHAR*)";.;", 4, (void*)searchpath, 1024);
+ Strings_Append(modules, 1024, (void*)searchpath, 1024);
+ Strings_Append((CHAR*)";", 2, (void*)searchpath, 1024);
+ Strings_Append(OPM_ResourceDir, 1024, (void*)searchpath, 1024);
+ Strings_Append((CHAR*)"/sym;", 6, (void*)searchpath, 1024);
+ Files_SetSearchPath(searchpath, 1024);
}
void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
{
Texts_Text T = NIL;
- LONGINT beg, end, time;
+ INT32 beg, end, time;
CHAR s[256];
*done = 0;
OPM_curpos = 0;
@@ -307,19 +476,19 @@ void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
return;
}
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256)));
+ Platform_GetArg(OPM_S, (void*)s, 256);
__NEW(T, Texts_TextDesc);
- Texts_Open(T, s, ((LONGINT)(256)));
- OPM_LogWStr(s, ((LONGINT)(256)));
- OPM_LogWStr((CHAR*)" ", (LONGINT)3);
+ Texts_Open(T, s, 256);
+ OPM_LogWStr(s, 256);
+ OPM_LogWStr((CHAR*)" ", 3);
__COPY(s, mname, mname__len);
- __COPY(s, OPM_SourceFileName, ((LONGINT)(256)));
+ __COPY(s, OPM_SourceFileName, 256);
if (T->len == 0) {
- OPM_LogWStr(s, ((LONGINT)(256)));
- OPM_LogWStr((CHAR*)" not found.", (LONGINT)12);
+ OPM_LogWStr(s, 256);
+ OPM_LogWStr((CHAR*)" not found.", 12);
OPM_LogWLn();
} else {
- Texts_OpenReader(&OPM_inR, Texts_Reader__typ, T, ((LONGINT)(0)));
+ Texts_OpenReader(&OPM_inR, Texts_Reader__typ, T, 0);
*done = 1;
}
OPM_S += 1;
@@ -347,7 +516,7 @@ void OPM_Get (CHAR *ch)
static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len)
{
- INTEGER i, j;
+ INT16 i, j;
CHAR ch;
__DUP(ext, ext__len, CHAR);
i = 0;
@@ -369,51 +538,56 @@ static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGIN
__DEL(ext);
}
-static void OPM_LogErrMsg (INTEGER n)
+static void OPM_LogErrMsg (INT16 n)
{
+ INT16 l;
Texts_Scanner S;
- Texts_Text T = NIL;
- CHAR ch;
- INTEGER i;
- CHAR buf[1024];
+ CHAR c;
if (n >= 0) {
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"31m", (LONGINT)4);
- }
- OPM_LogWStr((CHAR*)" err ", (LONGINT)7);
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"0m", (LONGINT)3);
- }
+ OPM_LogVT100((CHAR*)"31m", 4);
+ OPM_LogWStr((CHAR*)" err ", 7);
+ OPM_LogVT100((CHAR*)"0m", 3);
} else {
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"35m", (LONGINT)4);
- }
- OPM_LogWStr((CHAR*)" warning ", (LONGINT)11);
+ OPM_LogVT100((CHAR*)"35m", 4);
+ OPM_LogWStr((CHAR*)" warning ", 11);
n = -n;
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"0m", (LONGINT)3);
+ OPM_LogVT100((CHAR*)"0m", 3);
+ }
+ OPM_LogWNum(n, 1);
+ OPM_LogWStr((CHAR*)" ", 3);
+ if (OPM_Errors == NIL) {
+ __NEW(OPM_Errors, Texts_TextDesc);
+ Texts_Open(OPM_Errors, (CHAR*)"Errors.Txt", 11);
+ }
+ Texts_OpenScanner(&S, Texts_Scanner__typ, OPM_Errors, 0);
+ do {
+ l = S.line;
+ Texts_Scan(&S, Texts_Scanner__typ);
+ } while (!((((l != S.line && S.class == 3)) && S.i == n) || S.eot));
+ if (!S.eot) {
+ Texts_Read((void*)&S, Texts_Scanner__typ, &c);
+ while ((!S.eot && c >= ' ')) {
+ Out_Char(c);
+ Texts_Read((void*)&S, Texts_Scanner__typ, &c);
}
}
- OPM_LogWNum(n, ((LONGINT)(1)));
- OPM_LogWStr((CHAR*)" ", (LONGINT)3);
- OPM_LogWStr(errors_errors[__X(n, ((LONGINT)(350)))], ((LONGINT)(128)));
}
-static void OPM_FindLine (Files_File f, Files_Rider *r, LONGINT *r__typ, LONGINT pos)
+static void OPM_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos)
{
CHAR ch, cheol;
- if (pos < OPM_ErrorLineStartPos) {
+ if (pos < (INT64)OPM_ErrorLineStartPos) {
OPM_ErrorLineStartPos = 0;
OPM_ErrorLineLimitPos = 0;
OPM_ErrorLineNumber = 0;
}
- if (pos < OPM_ErrorLineLimitPos) {
+ if (pos < (INT64)OPM_ErrorLineLimitPos) {
Files_Set(&*r, r__typ, f, OPM_ErrorLineStartPos);
return;
}
Files_Set(&*r, r__typ, f, OPM_ErrorLineLimitPos);
Files_Read(&*r, r__typ, (void*)&ch);
- while ((OPM_ErrorLineLimitPos < pos && !(*r).eof)) {
+ while (((INT64)OPM_ErrorLineLimitPos < pos && !(*r).eof)) {
OPM_ErrorLineStartPos = OPM_ErrorLineLimitPos;
OPM_ErrorLineNumber += 1;
while ((((ch != 0x00 && ch != 0x0d)) && ch != 0x0a)) {
@@ -431,49 +605,45 @@ static void OPM_FindLine (Files_File f, Files_Rider *r, LONGINT *r__typ, LONGINT
Files_Set(&*r, r__typ, f, OPM_ErrorLineStartPos);
}
-static void OPM_ShowLine (LONGINT pos)
+static void OPM_ShowLine (INT64 pos)
{
Files_File f = NIL;
Files_Rider r;
CHAR line[1023];
- INTEGER i;
+ INT16 i;
CHAR ch;
- f = Files_Old(OPM_SourceFileName, ((LONGINT)(256)));
+ f = Files_Old(OPM_SourceFileName, 256);
OPM_FindLine(f, &r, Files_Rider__typ, pos);
i = 0;
Files_Read(&r, Files_Rider__typ, (void*)&ch);
while ((((((ch != 0x00 && ch != 0x0d)) && ch != 0x0a)) && i < 1022)) {
- line[__X(i, ((LONGINT)(1023)))] = ch;
+ line[__X(i, 1023)] = ch;
i += 1;
Files_Read(&r, Files_Rider__typ, (void*)&ch);
}
- line[__X(i, ((LONGINT)(1023)))] = 0x00;
+ line[__X(i, 1023)] = 0x00;
OPM_LogWLn();
OPM_LogWLn();
- OPM_LogWNum(OPM_ErrorLineNumber, ((LONGINT)(4)));
- OPM_LogWStr((CHAR*)": ", (LONGINT)3);
- OPM_LogWStr(line, ((LONGINT)(1023)));
+ OPM_LogWNum(OPM_ErrorLineNumber, 4);
+ OPM_LogWStr((CHAR*)": ", 3);
+ OPM_LogWStr(line, 1023);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" ", (LONGINT)7);
- if (pos >= OPM_ErrorLineLimitPos) {
+ OPM_LogWStr((CHAR*)" ", 7);
+ if (pos >= (INT64)OPM_ErrorLineLimitPos) {
pos = OPM_ErrorLineLimitPos - 1;
}
- i = (int)(pos - OPM_ErrorLineStartPos);
+ i = (INT16)OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos);
while (i > 0) {
OPM_LogW(' ');
i -= 1;
}
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"32m", (LONGINT)4);
- }
+ OPM_LogVT100((CHAR*)"32m", 4);
OPM_LogW('^');
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"0m", (LONGINT)3);
- }
+ OPM_LogVT100((CHAR*)"0m", 3);
Files_Close(f);
}
-void OPM_Mark (INTEGER n, LONGINT pos)
+void OPM_Mark (INT16 n, INT32 pos)
{
if (pos == -1) {
pos = 0;
@@ -484,30 +654,30 @@ void OPM_Mark (INTEGER n, LONGINT pos)
OPM_lasterrpos = pos;
OPM_ShowLine(pos);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" ", (LONGINT)3);
+ OPM_LogWStr((CHAR*)" ", 3);
if (n < 249) {
- OPM_LogWStr((CHAR*)" pos", (LONGINT)6);
- OPM_LogWNum(pos, ((LONGINT)(6)));
+ OPM_LogWStr((CHAR*)" pos", 6);
+ OPM_LogWNum(pos, 6);
OPM_LogErrMsg(n);
} else if (n == 255) {
- OPM_LogWStr((CHAR*)"pos", (LONGINT)4);
- OPM_LogWNum(pos, ((LONGINT)(6)));
- OPM_LogWStr((CHAR*)" pc ", (LONGINT)6);
- OPM_LogWNum(OPM_breakpc, ((LONGINT)(1)));
+ OPM_LogWStr((CHAR*)"pos", 4);
+ OPM_LogWNum(pos, 6);
+ OPM_LogWStr((CHAR*)" pc ", 6);
+ OPM_LogWNum(OPM_breakpc, 1);
} else if (n == 254) {
- OPM_LogWStr((CHAR*)"pc not found", (LONGINT)13);
+ OPM_LogWStr((CHAR*)"pc not found", 13);
} else {
- OPM_LogWStr(OPM_objname, ((LONGINT)(64)));
+ OPM_LogWStr(OPM_objname, 64);
if (n == 253) {
- OPM_LogWStr((CHAR*)" is new, compile with option e", (LONGINT)31);
+ OPM_LogWStr((CHAR*)" is new, compile with option e", 31);
} else if (n == 252) {
- OPM_LogWStr((CHAR*)" is redefined, compile with option s", (LONGINT)37);
+ OPM_LogWStr((CHAR*)" is redefined, compile with option s", 37);
} else if (n == 251) {
- OPM_LogWStr((CHAR*)" is redefined (private part only), compile with option s", (LONGINT)57);
+ OPM_LogWStr((CHAR*)" is redefined (private part only), compile with option s", 57);
} else if (n == 250) {
- OPM_LogWStr((CHAR*)" is no longer visible, compile with option s", (LONGINT)45);
+ OPM_LogWStr((CHAR*)" is no longer visible, compile with option s", 45);
} else if (n == 249) {
- OPM_LogWStr((CHAR*)" is not consistently imported, recompile imports", (LONGINT)49);
+ OPM_LogWStr((CHAR*)" is not consistently imported, recompile imports", 49);
}
}
}
@@ -515,8 +685,8 @@ void OPM_Mark (INTEGER n, LONGINT pos)
if (pos >= 0) {
OPM_ShowLine(pos);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" pos", (LONGINT)6);
- OPM_LogWNum(pos, ((LONGINT)(6)));
+ OPM_LogWStr((CHAR*)" pos", 6);
+ OPM_LogWNum(pos, 6);
}
OPM_LogErrMsg(n);
if (pos < 0) {
@@ -525,162 +695,42 @@ void OPM_Mark (INTEGER n, LONGINT pos)
}
}
-void OPM_err (INTEGER n)
+void OPM_err (INT16 n)
{
OPM_Mark(n, OPM_errpos);
}
-void OPM_FPrint (LONGINT *fp, LONGINT val)
+static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len)
{
- *fp = __ROTL((LONGINT)((SET)*fp ^ (SET)val), 1, LONGINT);
-}
-
-void OPM_FPrintSet (LONGINT *fp, SET set)
-{
- OPM_FPrint(&*fp, (LONGINT)set);
-}
-
-void OPM_FPrintReal (LONGINT *fp, REAL real)
-{
- INTEGER i;
- LONGINT l;
- __GET((LONGINT)(SYSTEM_ADDRESS)&real, l, LONGINT);
- OPM_FPrint(&*fp, l);
-}
-
-void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr)
-{
- LONGINT l, h;
- __GET((LONGINT)(SYSTEM_ADDRESS)&lr, l, LONGINT);
- __GET((LONGINT)(SYSTEM_ADDRESS)&lr + 4, h, LONGINT);
- OPM_FPrint(&*fp, l);
- OPM_FPrint(&*fp, h);
-}
-
-static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align)
-{
- __DUP(name, name__len, CHAR);
- if (((*S).class == 1 && __STRCMP((*S).s, name) == 0)) {
- Texts_Scan(&*S, S__typ);
- if ((*S).class == 3) {
- *size = (int)(*S).i;
- Texts_Scan(&*S, S__typ);
- } else {
- OPM_Mark(-157, ((LONGINT)(-1)));
- }
- if ((*S).class == 3) {
- *align = (int)(*S).i;
- Texts_Scan(&*S, S__typ);
- } else {
- OPM_Mark(-157, ((LONGINT)(-1)));
- }
- } else {
- OPM_Mark(-157, ((LONGINT)(-1)));
+ INT16 i;
+ INT32 l;
+ __ASSERT(__MASK(bytes__len, -4) == 0, 0);
+ i = 0;
+ while (i < bytes__len) {
+ __GET((ADDRESS)&bytes[__X(i, bytes__len)], l, INT32);
+ *fp = __ROTL((INT32)((UINT32)*fp ^ (UINT32)l), 1, 32);
+ i += 4;
}
- __DEL(name);
}
-static LONGINT OPM_minusop (LONGINT i)
+void OPM_FPrint (INT32 *fp, INT64 val)
{
- LONGINT _o_result;
- _o_result = -i;
- return _o_result;
+ OPM_FingerprintBytes(&*fp, (void*)&val, 8);
}
-static LONGINT OPM_power0 (LONGINT i, LONGINT j)
+void OPM_FPrintSet (INT32 *fp, UINT64 val)
{
- LONGINT _o_result;
- LONGINT k, p;
- k = 1;
- p = i;
- do {
- p = p * i;
- k += 1;
- } while (!(k == j));
- _o_result = p;
- return _o_result;
+ OPM_FingerprintBytes(&*fp, (void*)&val, 8);
}
-static void OPM_VerboseListSizes (void)
+void OPM_FPrintReal (INT32 *fp, REAL val)
{
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Type Size Alignement", (LONGINT)29);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"CHAR ", (LONGINT)14);
- OPM_LogWNum(OPM_CharSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"BOOLEAN ", (LONGINT)14);
- OPM_LogWNum(OPM_BoolSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"SHORTINT ", (LONGINT)14);
- OPM_LogWNum(OPM_SIntSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"INTEGER ", (LONGINT)14);
- OPM_LogWNum(OPM_IntSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"LONGINT ", (LONGINT)14);
- OPM_LogWNum(OPM_LIntSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"SET ", (LONGINT)14);
- OPM_LogWNum(OPM_SetSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"REAL ", (LONGINT)14);
- OPM_LogWNum(OPM_RealSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"LONGREAL ", (LONGINT)14);
- OPM_LogWNum(OPM_LRealSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"PTR ", (LONGINT)14);
- OPM_LogWNum(OPM_PointerSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"PROC ", (LONGINT)14);
- OPM_LogWNum(OPM_ProcSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"RECORD ", (LONGINT)14);
- OPM_LogWNum(OPM_RecSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWLn();
+ OPM_FingerprintBytes(&*fp, (void*)&val, 4);
}
-LONGINT OPM_SignedMaximum (LONGINT bytecount)
+void OPM_FPrintLReal (INT32 *fp, LONGREAL val)
{
- LONGINT _o_result;
- LONGINT result;
- result = 1;
- result = __LSH(result, __ASHL(bytecount, 3) - 1, LONGINT);
- _o_result = result - 1;
- return _o_result;
-}
-
-LONGINT OPM_SignedMinimum (LONGINT bytecount)
-{
- LONGINT _o_result;
- _o_result = -OPM_SignedMaximum(bytecount) - 1;
- return _o_result;
-}
-
-static void OPM_GetProperties (void)
-{
- OPM_ProcSize = OPM_PointerSize;
- OPM_LIntSize = __ASHL(OPM_IntSize, 1);
- OPM_SetSize = OPM_LIntSize;
- if (OPM_RealSize == 4) {
- OPM_MaxReal = 3.40282346000000e+038;
- } else if (OPM_RealSize == 8) {
- OPM_MaxReal = 1.79769296342094e+308;
- }
- if (OPM_LRealSize == 4) {
- OPM_MaxLReal = 3.40282346000000e+038;
- } else if (OPM_LRealSize == 8) {
- OPM_MaxLReal = 1.79769296342094e+308;
- }
- OPM_MinReal = -OPM_MaxReal;
- OPM_MinLReal = -OPM_MaxLReal;
- OPM_MaxSet = __ASHL(OPM_SetSize, 3) - 1;
- OPM_MaxIndex = OPM_SignedMaximum(OPM_PointerSize);
- if (OPM_Verbose) {
- OPM_VerboseListSizes();
- }
+ OPM_FingerprintBytes(&*fp, (void*)&val, 8);
}
void OPM_SymRCh (CHAR *ch)
@@ -688,18 +738,23 @@ void OPM_SymRCh (CHAR *ch)
Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&*ch);
}
-LONGINT OPM_SymRInt (void)
+INT32 OPM_SymRInt (void)
{
- LONGINT _o_result;
- LONGINT k;
- Files_ReadNum(&OPM_oldSF, Files_Rider__typ, &k);
- _o_result = k;
- return _o_result;
+ INT32 k;
+ Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (void*)&k, 4);
+ return k;
}
-void OPM_SymRSet (SET *s)
+INT64 OPM_SymRInt64 (void)
{
- Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (LONGINT*)&*s);
+ INT64 k;
+ Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (void*)&k, 8);
+ return k;
+}
+
+void OPM_SymRSet (UINT64 *s)
+{
+ Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (void*)&*s, 8);
}
void OPM_SymRReal (REAL *r)
@@ -714,19 +769,21 @@ void OPM_SymRLReal (LONGREAL *lr)
void OPM_CloseOldSym (void)
{
+ Files_Close(Files_Base(&OPM_oldSF, Files_Rider__typ));
}
void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done)
{
- CHAR ch;
+ CHAR tag, ver;
OPM_FileName fileName;
- OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5);
- OPM_oldSFile = Files_Old(fileName, ((LONGINT)(32)));
+ OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
+ OPM_oldSFile = Files_Old(fileName, 32);
*done = OPM_oldSFile != NIL;
if (*done) {
- Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, ((LONGINT)(0)));
- Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ch);
- if (ch != 0xf7) {
+ Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, 0);
+ Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&tag);
+ Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ver);
+ if (tag != 0xf7 || ver != 0x82) {
OPM_err(-306);
OPM_CloseOldSym();
*done = 0;
@@ -736,9 +793,7 @@ void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done)
BOOLEAN OPM_eofSF (void)
{
- BOOLEAN _o_result;
- _o_result = OPM_oldSF.eof;
- return _o_result;
+ return OPM_oldSF.eof;
}
void OPM_SymWCh (CHAR ch)
@@ -746,14 +801,14 @@ void OPM_SymWCh (CHAR ch)
Files_Write(&OPM_newSF, Files_Rider__typ, ch);
}
-void OPM_SymWInt (LONGINT i)
+void OPM_SymWInt (INT64 i)
{
Files_WriteNum(&OPM_newSF, Files_Rider__typ, i);
}
-void OPM_SymWSet (SET s)
+void OPM_SymWSet (UINT64 s)
{
- Files_WriteNum(&OPM_newSF, Files_Rider__typ, (LONGINT)s);
+ Files_WriteNum(&OPM_newSF, Files_Rider__typ, (INT64)s);
}
void OPM_SymWReal (REAL r)
@@ -768,7 +823,7 @@ void OPM_SymWLReal (LONGREAL lr)
void OPM_RegisterNewSym (void)
{
- if (__STRCMP(OPM_modName, "SYSTEM") != 0 || __IN(10, OPM_opt)) {
+ if (__STRCMP(OPM_modName, "SYSTEM") != 0 || __IN(10, OPM_Options, 32)) {
Files_Register(OPM_newSFile);
}
}
@@ -780,11 +835,12 @@ void OPM_DeleteNewSym (void)
void OPM_NewSym (CHAR *modName, LONGINT modName__len)
{
OPM_FileName fileName;
- OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5);
- OPM_newSFile = Files_New(fileName, ((LONGINT)(32)));
+ OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
+ OPM_newSFile = Files_New(fileName, 32);
if (OPM_newSFile != NIL) {
- Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, ((LONGINT)(0)));
+ Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, 0);
Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7);
+ Files_Write(&OPM_newSF, Files_Rider__typ, 0x82);
} else {
OPM_err(153);
}
@@ -792,74 +848,74 @@ void OPM_NewSym (CHAR *modName, LONGINT modName__len)
void OPM_Write (CHAR ch)
{
- Files_Write(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, ch);
+ Files_Write(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, ch);
}
void OPM_WriteString (CHAR *s, LONGINT s__len)
{
- INTEGER i;
+ INT16 i;
i = 0;
while (s[__X(i, s__len)] != 0x00) {
i += 1;
}
- Files_WriteBytes(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, (void*)s, s__len * ((LONGINT)(1)), i);
+ Files_WriteBytes(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, (void*)s, s__len * 1, i);
}
void OPM_WriteStringVar (CHAR *s, LONGINT s__len)
{
- INTEGER i;
+ INT16 i;
i = 0;
while (s[__X(i, s__len)] != 0x00) {
i += 1;
}
- Files_WriteBytes(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, (void*)s, s__len * ((LONGINT)(1)), i);
+ Files_WriteBytes(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, (void*)s, s__len * 1, i);
}
-void OPM_WriteHex (LONGINT i)
+void OPM_WriteHex (INT64 i)
{
CHAR s[3];
- INTEGER digit;
- digit = __ASHR((int)i, 4);
+ INT32 digit;
+ digit = __ASHR((INT32)i, 4);
if (digit < 10) {
s[0] = (CHAR)(48 + digit);
} else {
s[0] = (CHAR)(87 + digit);
}
- digit = __MASK((int)i, -16);
+ digit = __MASK((INT32)i, -16);
if (digit < 10) {
s[1] = (CHAR)(48 + digit);
} else {
s[1] = (CHAR)(87 + digit);
}
s[2] = 0x00;
- OPM_WriteString(s, ((LONGINT)(3)));
+ OPM_WriteString(s, 3);
}
-void OPM_WriteInt (LONGINT i)
+void OPM_WriteInt (INT64 i)
{
- CHAR s[20];
- LONGINT i1, k;
- if (i == OPM_SignedMinimum(OPM_IntSize) || i == OPM_SignedMinimum(OPM_LIntSize)) {
+ CHAR s[24];
+ INT64 i1, k;
+ if ((i == OPM_SignedMinimum(2) || i == OPM_SignedMinimum(4)) || i == OPM_SignedMinimum(8)) {
OPM_Write('(');
OPM_WriteInt(i + 1);
- OPM_WriteString((CHAR*)"-1)", (LONGINT)4);
+ OPM_WriteString((CHAR*)"-1)", 4);
} else {
i1 = __ABS(i);
s[0] = (CHAR)(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k = 1;
while (i1 > 0) {
- s[__X(k, ((LONGINT)(20)))] = (CHAR)(__MOD(i1, 10) + 48);
+ s[__X(k, 24)] = (CHAR)(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k += 1;
}
if (i < 0) {
- s[__X(k, ((LONGINT)(20)))] = '-';
+ s[__X(k, 24)] = '-';
k += 1;
}
while (k > 0) {
k -= 1;
- OPM_Write(s[__X(k, ((LONGINT)(20)))]);
+ OPM_Write(s[__X(k, 24)]);
}
}
}
@@ -871,14 +927,14 @@ void OPM_WriteReal (LONGREAL r, CHAR suffx)
Texts_Reader R;
CHAR s[32];
CHAR ch;
- INTEGER i;
- if ((((r < OPM_SignedMaximum(OPM_LIntSize) && r > OPM_SignedMinimum(OPM_LIntSize))) && r == ((int)__ENTIER(r)))) {
+ INT16 i;
+ if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == ((INT32)__ENTIER(r)))) {
if (suffx == 'f') {
- OPM_WriteString((CHAR*)"(REAL)", (LONGINT)7);
+ OPM_WriteString((CHAR*)"(REAL)", 7);
} else {
- OPM_WriteString((CHAR*)"(LONGREAL)", (LONGINT)11);
+ OPM_WriteString((CHAR*)"(LONGREAL)", 11);
}
- OPM_WriteInt((int)__ENTIER(r));
+ OPM_WriteInt((INT32)__ENTIER(r));
} else {
Texts_OpenWriter(&W, Texts_Writer__typ);
if (suffx == 'f') {
@@ -887,45 +943,45 @@ void OPM_WriteReal (LONGREAL r, CHAR suffx)
Texts_WriteLongReal(&W, Texts_Writer__typ, r, 23);
}
__NEW(T, Texts_TextDesc);
- Texts_Open(T, (CHAR*)"", (LONGINT)1);
+ Texts_Open(T, (CHAR*)"", 1);
Texts_Append(T, W.buf);
- Texts_OpenReader(&R, Texts_Reader__typ, T, ((LONGINT)(0)));
+ Texts_OpenReader(&R, Texts_Reader__typ, T, 0);
i = 0;
Texts_Read(&R, Texts_Reader__typ, &ch);
while (ch != 0x00) {
- s[__X(i, ((LONGINT)(32)))] = ch;
+ s[__X(i, 32)] = ch;
i += 1;
Texts_Read(&R, Texts_Reader__typ, &ch);
}
- s[__X(i, ((LONGINT)(32)))] = 0x00;
+ s[__X(i, 32)] = 0x00;
i = 0;
ch = s[0];
while ((ch != 'D' && ch != 0x00)) {
i += 1;
- ch = s[__X(i, ((LONGINT)(32)))];
+ ch = s[__X(i, 32)];
}
if (ch == 'D') {
- s[__X(i, ((LONGINT)(32)))] = 'e';
+ s[__X(i, 32)] = 'e';
}
- OPM_WriteString(s, ((LONGINT)(32)));
+ OPM_WriteString(s, 32);
}
}
void OPM_WriteLn (void)
{
- Files_Write(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, 0x0a);
+ Files_Write(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, 0x0a);
}
-static void OPM_Append (Files_Rider *R, LONGINT *R__typ, Files_File F)
+static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F)
{
Files_Rider R1;
CHAR buffer[4096];
if (F != NIL) {
- Files_Set(&R1, Files_Rider__typ, F, ((LONGINT)(0)));
- Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, ((LONGINT)(4096)), ((LONGINT)(4096)));
+ Files_Set(&R1, Files_Rider__typ, F, 0);
+ Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, 4096, 4096);
while (4096 - R1.res > 0) {
- Files_WriteBytes(&*R, R__typ, (void*)buffer, ((LONGINT)(4096)), 4096 - R1.res);
- Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, ((LONGINT)(4096)), ((LONGINT)(4096)));
+ Files_WriteBytes(&*R, R__typ, (void*)buffer, 4096, 4096 - R1.res);
+ Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, 4096, 4096);
}
}
}
@@ -933,24 +989,24 @@ static void OPM_Append (Files_Rider *R, LONGINT *R__typ, Files_File F)
void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
{
CHAR FName[32];
- __COPY(moduleName, OPM_modName, ((LONGINT)(32)));
- OPM_HFile = Files_New((CHAR*)"", (LONGINT)1);
+ __COPY(moduleName, OPM_modName, 32);
+ OPM_HFile = Files_New((CHAR*)"", 1);
if (OPM_HFile != NIL) {
- Files_Set(&OPM_R[0], Files_Rider__typ, OPM_HFile, ((LONGINT)(0)));
+ Files_Set(&OPM_R[0], Files_Rider__typ, OPM_HFile, 0);
} else {
OPM_err(153);
}
- OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, ((LONGINT)(32)), (CHAR*)".c", (LONGINT)3);
- OPM_BFile = Files_New(FName, ((LONGINT)(32)));
+ OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, 32, (CHAR*)".c", 3);
+ OPM_BFile = Files_New(FName, 32);
if (OPM_BFile != NIL) {
- Files_Set(&OPM_R[1], Files_Rider__typ, OPM_BFile, ((LONGINT)(0)));
+ Files_Set(&OPM_R[1], Files_Rider__typ, OPM_BFile, 0);
} else {
OPM_err(153);
}
- OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, ((LONGINT)(32)), (CHAR*)".h", (LONGINT)3);
- OPM_HIFile = Files_New(FName, ((LONGINT)(32)));
+ OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, 32, (CHAR*)".h", 3);
+ OPM_HIFile = Files_New(FName, 32);
if (OPM_HIFile != NIL) {
- Files_Set(&OPM_R[2], Files_Rider__typ, OPM_HIFile, ((LONGINT)(0)));
+ Files_Set(&OPM_R[2], Files_Rider__typ, OPM_HIFile, 0);
} else {
OPM_err(153);
}
@@ -959,26 +1015,26 @@ void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
void OPM_CloseFiles (void)
{
CHAR FName[32];
- INTEGER res;
+ INT16 res;
if (OPM_noerr) {
- OPM_LogWStr((CHAR*)" ", (LONGINT)3);
- OPM_LogWNum(Files_Pos(&OPM_R[1], Files_Rider__typ), ((LONGINT)(0)));
- OPM_LogWStr((CHAR*)" chars.", (LONGINT)8);
+ OPM_LogWStr((CHAR*)" ", 3);
+ OPM_LogWNum(Files_Pos(&OPM_R[1], Files_Rider__typ), 0);
+ OPM_LogWStr((CHAR*)" chars.", 8);
}
if (OPM_noerr) {
if (__STRCMP(OPM_modName, "SYSTEM") == 0) {
- if (!__IN(10, OPM_opt)) {
+ if (!__IN(10, OPM_Options, 32)) {
Files_Register(OPM_BFile);
}
- } else if (!__IN(10, OPM_opt)) {
+ } else if (!__IN(10, OPM_Options, 32)) {
OPM_Append(&OPM_R[2], Files_Rider__typ, OPM_HFile);
Files_Register(OPM_HIFile);
Files_Register(OPM_BFile);
} else {
- OPM_MakeFileName((void*)OPM_modName, ((LONGINT)(32)), (void*)FName, ((LONGINT)(32)), (CHAR*)".h", (LONGINT)3);
- Files_Delete(FName, ((LONGINT)(32)), &res);
- OPM_MakeFileName((void*)OPM_modName, ((LONGINT)(32)), (void*)FName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5);
- Files_Delete(FName, ((LONGINT)(32)), &res);
+ OPM_MakeFileName((void*)OPM_modName, 32, (void*)FName, 32, (CHAR*)".h", 3);
+ Files_Delete(FName, 32, &res);
+ OPM_MakeFileName((void*)OPM_modName, 32, (void*)FName, 32, (CHAR*)".sym", 5);
+ Files_Delete(FName, 32, &res);
Files_Register(OPM_BFile);
}
}
@@ -987,18 +1043,18 @@ void OPM_CloseFiles (void)
OPM_HIFile = NIL;
OPM_newSFile = NIL;
OPM_oldSFile = NIL;
- Files_Set(&OPM_R[0], Files_Rider__typ, NIL, ((LONGINT)(0)));
- Files_Set(&OPM_R[1], Files_Rider__typ, NIL, ((LONGINT)(0)));
- Files_Set(&OPM_R[2], Files_Rider__typ, NIL, ((LONGINT)(0)));
- Files_Set(&OPM_newSF, Files_Rider__typ, NIL, ((LONGINT)(0)));
- Files_Set(&OPM_oldSF, Files_Rider__typ, NIL, ((LONGINT)(0)));
+ Files_Set(&OPM_R[0], Files_Rider__typ, NIL, 0);
+ Files_Set(&OPM_R[1], Files_Rider__typ, NIL, 0);
+ Files_Set(&OPM_R[2], Files_Rider__typ, NIL, 0);
+ Files_Set(&OPM_newSF, Files_Rider__typ, NIL, 0);
+ Files_Set(&OPM_oldSF, Files_Rider__typ, NIL, 0);
}
static void EnumPtrs(void (*P)(void*))
{
__ENUMR(&OPM_inR, Texts_Reader__typ, 48, 1, P);
P(OPM_Log);
- __ENUMR(&OPM_W, Texts_Writer__typ, 36, 1, P);
+ P(OPM_Errors);
__ENUMR(&OPM_oldSF, Files_Rider__typ, 20, 1, P);
__ENUMR(&OPM_newSF, Files_Rider__typ, 20, 1, P);
__ENUMR(OPM_R, Files_Rider__typ, 20, 3, P);
@@ -1014,13 +1070,12 @@ export void *OPM__init(void)
{
__DEFMOD;
__MODULE_IMPORT(Configuration);
- __MODULE_IMPORT(Console);
__MODULE_IMPORT(Files);
+ __MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
__MODULE_IMPORT(Texts);
- __MODULE_IMPORT(errors);
- __MODULE_IMPORT(vt100);
+ __MODULE_IMPORT(VT100);
__REGMOD("OPM", EnumPtrs);
__REGCMD("CloseFiles", OPM_CloseFiles);
__REGCMD("CloseOldSym", OPM_CloseOldSym);
@@ -1030,26 +1085,9 @@ export void *OPM__init(void)
__REGCMD("RegisterNewSym", OPM_RegisterNewSym);
__REGCMD("WriteLn", OPM_WriteLn);
/* BEGIN */
- Texts_OpenWriter(&OPM_W, Texts_Writer__typ);
- OPM_MODULES[0] = 0x00;
- Platform_GetEnv((CHAR*)"MODULES", (LONGINT)8, (void*)OPM_MODULES, ((LONGINT)(1024)));
- __MOVE(".", OPM_OBERON, 2);
- Platform_GetEnv((CHAR*)"OBERON", (LONGINT)7, (void*)OPM_OBERON, ((LONGINT)(1024)));
- Strings_Append((CHAR*)";.;", (LONGINT)4, (void*)OPM_OBERON, ((LONGINT)(1024)));
- Strings_Append(OPM_MODULES, ((LONGINT)(1024)), (void*)OPM_OBERON, ((LONGINT)(1024)));
- Strings_Append((CHAR*)";", (LONGINT)2, (void*)OPM_OBERON, ((LONGINT)(1024)));
- Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)OPM_OBERON, ((LONGINT)(1024)));
- Strings_Append((CHAR*)"/sym;", (LONGINT)6, (void*)OPM_OBERON, ((LONGINT)(1024)));
- Files_SetSearchPath(OPM_OBERON, ((LONGINT)(1024)));
- OPM_CharSize = 1;
- OPM_BoolSize = 1;
- OPM_SIntSize = 1;
- OPM_RecSize = 1;
- OPM_ByteSize = 1;
- OPM_RealSize = 4;
- OPM_LRealSize = 8;
- OPM_PointerSize = 8;
- OPM_Alignment = 8;
- OPM_IntSize = 4;
+ OPM_MaxReal = 3.40282346000000e+038;
+ OPM_MaxLReal = 1.79769296342094e+308;
+ OPM_MinReal = -OPM_MaxReal;
+ OPM_MinLReal = -OPM_MaxLReal;
__ENDMOD;
}
diff --git a/bootstrap/unix-44/OPM.h b/bootstrap/unix-44/OPM.h
index ed914bff..2d272feb 100644
--- a/bootstrap/unix-44/OPM.h
+++ b/bootstrap/unix-44/OPM.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPM__h
#define OPM__h
@@ -6,60 +6,66 @@
#include "SYSTEM.h"
-import INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_MaxSet;
-import LONGINT OPM_MaxIndex;
+import CHAR OPM_Model[10];
+import INT16 OPM_AddressSize, OPM_Alignment;
+import UINT32 OPM_GlobalOptions, OPM_Options;
+import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize;
+import INT64 OPM_MaxIndex;
import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
import BOOLEAN OPM_noerr;
-import LONGINT OPM_curpos, OPM_errpos, OPM_breakpc;
-import INTEGER OPM_currFile, OPM_level, OPM_pc, OPM_entno;
+import 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 SET OPM_opt, OPM_glbopt;
-import BOOLEAN OPM_dontAsm, OPM_dontLink, OPM_mainProg, OPM_mainLinkStat, OPM_notColorOutput, OPM_forceNewSym, OPM_Verbose;
+import CHAR OPM_ResourceDir[1024];
import void OPM_CloseFiles (void);
import void OPM_CloseOldSym (void);
import void OPM_DeleteNewSym (void);
-import void OPM_FPrint (LONGINT *fp, LONGINT val);
-import void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr);
-import void OPM_FPrintReal (LONGINT *fp, REAL real);
-import void OPM_FPrintSet (LONGINT *fp, SET set);
+import void OPM_FPrint (INT32 *fp, INT64 val);
+import void OPM_FPrintLReal (INT32 *fp, LONGREAL val);
+import void OPM_FPrintReal (INT32 *fp, REAL val);
+import void OPM_FPrintSet (INT32 *fp, UINT64 val);
import void OPM_Get (CHAR *ch);
import void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
import void OPM_InitOptions (void);
+import INT16 OPM_Integer (INT64 n);
+import void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
import void OPM_LogW (CHAR ch);
import void OPM_LogWLn (void);
-import void OPM_LogWNum (LONGINT i, LONGINT len);
+import void OPM_LogWNum (INT64 i, INT64 len);
import void OPM_LogWStr (CHAR *s, LONGINT s__len);
-import void OPM_Mark (INTEGER n, LONGINT pos);
+import INT32 OPM_Longint (INT64 n);
+import void OPM_Mark (INT16 n, INT32 pos);
import void OPM_NewSym (CHAR *modName, LONGINT modName__len);
import void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
import void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
import BOOLEAN OPM_OpenPar (void);
import void OPM_RegisterNewSym (void);
-import LONGINT OPM_SignedMaximum (LONGINT bytecount);
-import LONGINT OPM_SignedMinimum (LONGINT bytecount);
+import INT64 OPM_SignedMaximum (INT32 bytecount);
+import INT64 OPM_SignedMinimum (INT32 bytecount);
import void OPM_SymRCh (CHAR *ch);
-import LONGINT OPM_SymRInt (void);
+import INT32 OPM_SymRInt (void);
+import INT64 OPM_SymRInt64 (void);
import void OPM_SymRLReal (LONGREAL *lr);
import void OPM_SymRReal (REAL *r);
-import void OPM_SymRSet (SET *s);
+import void OPM_SymRSet (UINT64 *s);
import void OPM_SymWCh (CHAR ch);
-import void OPM_SymWInt (LONGINT i);
+import void OPM_SymWInt (INT64 i);
import void OPM_SymWLReal (LONGREAL lr);
import void OPM_SymWReal (REAL r);
-import void OPM_SymWSet (SET s);
+import void OPM_SymWSet (UINT64 s);
import void OPM_Write (CHAR ch);
-import void OPM_WriteHex (LONGINT i);
-import void OPM_WriteInt (LONGINT i);
+import void OPM_WriteHex (INT64 i);
+import void OPM_WriteInt (INT64 i);
import void OPM_WriteLn (void);
import void OPM_WriteReal (LONGREAL r, CHAR suffx);
import void OPM_WriteString (CHAR *s, LONGINT s__len);
import void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
import BOOLEAN OPM_eofSF (void);
-import void OPM_err (INTEGER n);
+import void OPM_err (INT16 n);
import void *OPM__init(void);
-#endif
+#endif // OPM
diff --git a/bootstrap/unix-44/OPP.c b/bootstrap/unix-44/OPP.c
index 01d2144d..3f360d00 100644
--- a/bootstrap/unix-44/OPP.c
+++ b/bootstrap/unix-44/OPP.c
@@ -1,4 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "OPB.h"
#include "OPM.h"
@@ -6,38 +12,38 @@
#include "OPT.h"
struct OPP__1 {
- LONGINT low, high;
+ INT32 low, high;
};
typedef
struct OPP__1 OPP_CaseTable[128];
-static SHORTINT OPP_sym, OPP_level;
-static INTEGER OPP_LoopLevel;
+static INT8 OPP_sym, OPP_level;
+static INT16 OPP_LoopLevel;
static OPT_Node OPP_TDinit, OPP_lastTDinit;
-static INTEGER OPP_nofFwdPtr;
+static INT16 OPP_nofFwdPtr;
static OPT_Struct OPP_FwdPtr[64];
-export LONGINT *OPP__1__typ;
+export ADDRESS *OPP__1__typ;
static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar);
static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned);
static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq);
-static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab);
-static void OPP_CheckMark (SHORTINT *vis);
-static void OPP_CheckSym (INTEGER s);
-static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_);
+static void OPP_CaseLabelList (OPT_Node *lab, OPT_Struct LabelTyp, INT16 *n, OPP_CaseTable tab);
+static void OPP_CheckMark (INT8 *vis);
+static void OPP_CheckSym (INT16 s);
+static void OPP_CheckSysFlag (INT16 *sysflag, INT16 default_);
static void OPP_ConstExpression (OPT_Node *x);
static void OPP_Element (OPT_Node *x);
static void OPP_Expression (OPT_Node *x);
static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b);
static void OPP_Factor (OPT_Node *x);
static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp);
-export void OPP_Module (OPT_Node *prog, SET opt);
+export void OPP_Module (OPT_Node *prog, UINT32 opt);
static void OPP_PointerType (OPT_Struct *typ);
static void OPP_ProcedureDeclaration (OPT_Node *x);
-static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec);
+static void OPP_Receiver (INT8 *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec);
static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned);
static void OPP_Sets (OPT_Node *x);
static void OPP_SimpleExpression (OPT_Node *x);
@@ -46,19 +52,19 @@ static void OPP_StatSeq (OPT_Node *stat);
static void OPP_Term (OPT_Node *x);
static void OPP_Type (OPT_Struct *typ, OPT_Struct *banned);
static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned);
-static void OPP_err (INTEGER n);
+static void OPP_err (INT16 n);
static void OPP_qualident (OPT_Object *id);
static void OPP_selector (OPT_Node *x);
-static void OPP_err (INTEGER n)
+static void OPP_err (INT16 n)
{
OPM_err(n);
}
-static void OPP_CheckSym (INTEGER s)
+static void OPP_CheckSym (INT16 s)
{
- if ((int)OPP_sym == s) {
+ if ((INT16)OPP_sym == s) {
OPS_Get(&OPP_sym);
} else {
OPM_err(s);
@@ -68,7 +74,7 @@ static void OPP_CheckSym (INTEGER s)
static void OPP_qualident (OPT_Object *id)
{
OPT_Object obj = NIL;
- SHORTINT lev;
+ INT8 lev;
OPT_Find(&obj);
OPS_Get(&OPP_sym);
if ((((OPP_sym == 18 && obj != NIL)) && obj->mode == 11)) {
@@ -89,7 +95,7 @@ static void OPP_qualident (OPT_Object *id)
obj->adr = 0;
} else {
lev = obj->mnolev;
- if ((__IN(obj->mode, 0x06) && lev != OPP_level)) {
+ if ((__IN(obj->mode, 0x06, 32) && lev != OPP_level)) {
obj->leaf = 0;
if (lev > 0) {
OPB_StaticLink(OPP_level - lev);
@@ -104,11 +110,11 @@ static void OPP_ConstExpression (OPT_Node *x)
OPP_Expression(&*x);
if ((*x)->class != 7) {
OPP_err(50);
- *x = OPB_NewIntConst(((LONGINT)(1)));
+ *x = OPB_NewIntConst(1);
}
}
-static void OPP_CheckMark (SHORTINT *vis)
+static void OPP_CheckMark (INT8 *vis)
{
OPS_Get(&OPP_sym);
if (OPP_sym == 1 || OPP_sym == 7) {
@@ -126,17 +132,17 @@ static void OPP_CheckMark (SHORTINT *vis)
}
}
-static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_)
+static void OPP_CheckSysFlag (INT16 *sysflag, INT16 default_)
{
OPT_Node x = NIL;
- LONGINT sf;
+ INT64 sf;
if (OPP_sym == 31) {
OPS_Get(&OPP_sym);
if (!OPT_SYSimported) {
OPP_err(135);
}
OPP_ConstExpression(&x);
- if (__IN(x->typ->form, 0x70)) {
+ if (x->typ->form == 4) {
sf = x->conval->intval;
if (sf < 0 || sf > 1) {
OPP_err(220);
@@ -146,7 +152,7 @@ static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_)
OPP_err(51);
sf = 0;
}
- *sysflag = (int)sf;
+ *sysflag = OPM_Integer(sf);
OPP_CheckSym(23);
} else {
*sysflag = default_;
@@ -157,8 +163,8 @@ static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned)
{
OPT_Object fld = NIL, first = NIL, last = NIL, base = NIL;
OPT_Struct ftyp = NIL;
- INTEGER sysflag;
- *typ = OPT_NewStr(15, 4);
+ INT16 sysflag;
+ *typ = OPT_NewStr(13, 4);
(*typ)->BaseTyp = NIL;
OPP_CheckSysFlag(&sysflag, -1);
if (OPP_sym == 30) {
@@ -249,11 +255,11 @@ static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned)
static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned)
{
OPT_Node x = NIL;
- LONGINT n;
- INTEGER sysflag;
+ INT64 n;
+ INT16 sysflag;
OPP_CheckSysFlag(&sysflag, 0);
if (OPP_sym == 25) {
- *typ = OPT_NewStr(15, 3);
+ *typ = OPT_NewStr(13, 3);
(*typ)->mno = 0;
(*typ)->sysflag = sysflag;
OPS_Get(&OPP_sym);
@@ -265,10 +271,10 @@ static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned)
(*typ)->n = 0;
}
} else {
- *typ = OPT_NewStr(15, 2);
+ *typ = OPT_NewStr(13, 2);
(*typ)->sysflag = sysflag;
OPP_ConstExpression(&x);
- if (__IN(x->typ->form, 0x70)) {
+ if (x->typ->form == 4) {
n = x->conval->intval;
if (n <= 0 || n > OPM_MaxIndex) {
OPP_err(63);
@@ -278,7 +284,7 @@ static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned)
OPP_err(51);
n = 1;
}
- (*typ)->n = n;
+ (*typ)->n = OPM_Longint(n);
if (OPP_sym == 25) {
OPS_Get(&OPP_sym);
OPP_Type(&(*typ)->BaseTyp, &*banned);
@@ -301,26 +307,26 @@ static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned)
static void OPP_PointerType (OPT_Struct *typ)
{
OPT_Object id = NIL;
- *typ = OPT_NewStr(13, 1);
+ *typ = OPT_NewStr(11, 1);
OPP_CheckSysFlag(&(*typ)->sysflag, 0);
OPP_CheckSym(28);
if (OPP_sym == 38) {
OPT_Find(&id);
if (id == NIL) {
if (OPP_nofFwdPtr < 64) {
- OPP_FwdPtr[__X(OPP_nofFwdPtr, ((LONGINT)(64)))] = *typ;
+ OPP_FwdPtr[__X(OPP_nofFwdPtr, 64)] = *typ;
OPP_nofFwdPtr += 1;
} else {
OPP_err(224);
}
(*typ)->link = OPT_NewObj();
- __COPY(OPS_name, (*typ)->link->name, ((LONGINT)(256)));
+ __COPY(OPS_name, (*typ)->link->name, 256);
(*typ)->BaseTyp = OPT_undftyp;
OPS_Get(&OPP_sym);
} else {
OPP_qualident(&id);
if (id->mode == 5) {
- if (__IN(id->typ->comp, 0x1c)) {
+ if (__IN(id->typ->comp, 0x1c, 32)) {
(*typ)->BaseTyp = id->typ;
} else {
(*typ)->BaseTyp = OPT_undftyp;
@@ -333,7 +339,7 @@ static void OPP_PointerType (OPT_Struct *typ)
}
} else {
OPP_Type(&(*typ)->BaseTyp, &OPT_notyp);
- if (!__IN((*typ)->BaseTyp->comp, 0x1c)) {
+ if (!__IN((*typ)->BaseTyp->comp, 0x1c, 32)) {
(*typ)->BaseTyp = OPT_undftyp;
OPP_err(57);
}
@@ -342,7 +348,7 @@ static void OPP_PointerType (OPT_Struct *typ)
static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp)
{
- SHORTINT mode;
+ INT8 mode;
OPT_Object par = NIL, first = NIL, last = NIL, res = NIL;
OPT_Struct typ = NIL;
first = NIL;
@@ -386,6 +392,9 @@ static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp)
}
OPP_CheckSym(20);
OPP_Type(&typ, &OPT_notyp);
+ if (((typ->comp == 2 || typ->comp == 4) && typ->strobj == NIL)) {
+ OPP_err(-309);
+ }
if (mode == 1) {
typ->pvused = 1;
}
@@ -409,7 +418,7 @@ static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp)
if (OPP_sym == 38) {
OPP_qualident(&res);
if (res->mode == 5) {
- if (res->typ->form < 15) {
+ if (res->typ->form < 13) {
*resTyp = res->typ;
} else {
OPP_err(54);
@@ -459,7 +468,7 @@ static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned)
OPP_PointerType(&*typ);
} else if (OPP_sym == 61) {
OPS_Get(&OPP_sym);
- *typ = OPT_NewStr(14, 1);
+ *typ = OPT_NewStr(12, 1);
OPP_CheckSysFlag(&(*typ)->sysflag, 0);
if (OPP_sym == 30) {
OPS_Get(&OPP_sym);
@@ -488,7 +497,7 @@ static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned)
static void OPP_Type (OPT_Struct *typ, OPT_Struct *banned)
{
OPP_TypeDecl(&*typ, &*banned);
- if (((((*typ)->form == 13 && (*typ)->BaseTyp == OPT_undftyp)) && (*typ)->strobj == NIL)) {
+ if (((((*typ)->form == 11 && (*typ)->BaseTyp == OPT_undftyp)) && (*typ)->strobj == NIL)) {
OPP_err(0);
}
}
@@ -503,7 +512,7 @@ static void OPP_selector (OPT_Node *x)
if (OPP_sym == 31) {
OPS_Get(&OPP_sym);
for (;;) {
- if (((*x)->typ != NIL && (*x)->typ->form == 13)) {
+ if (((*x)->typ != NIL && (*x)->typ->form == 11)) {
OPB_DeRef(&*x);
}
OPP_Expression(&y);
@@ -518,10 +527,10 @@ static void OPP_selector (OPT_Node *x)
} else if (OPP_sym == 18) {
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
- __COPY(OPS_name, name, ((LONGINT)(256)));
+ __COPY(OPS_name, name, 256);
OPS_Get(&OPP_sym);
if ((*x)->typ != NIL) {
- if ((*x)->typ->form == 13) {
+ if ((*x)->typ->form == 11) {
OPB_DeRef(&*x);
}
if ((*x)->typ->comp == 4) {
@@ -543,7 +552,7 @@ static void OPP_selector (OPT_Node *x)
OPP_err(75);
}
typ = y->obj->typ;
- if (typ->form == 13) {
+ if (typ->form == 11) {
typ = typ->BaseTyp;
}
OPT_FindField((*x)->obj->name, typ->BaseTyp, &proc);
@@ -572,7 +581,7 @@ static void OPP_selector (OPT_Node *x)
} else if (OPP_sym == 17) {
OPS_Get(&OPP_sym);
OPB_DeRef(&*x);
- } else if ((((((OPP_sym == 30 && (*x)->class < 7)) && (*x)->typ->form != 14)) && ((*x)->obj == NIL || (*x)->obj->mode != 13))) {
+ } else if ((((((OPP_sym == 30 && (*x)->class < 7)) && (*x)->typ->form != 12)) && ((*x)->obj == NIL || (*x)->obj->mode != 13))) {
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
OPP_qualident(&obj);
@@ -623,9 +632,9 @@ static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar)
static void OPP_StandProcCall (OPT_Node *x)
{
OPT_Node y = NIL;
- SHORTINT m;
- INTEGER n;
- m = (int)(*x)->obj->adr;
+ INT8 m;
+ INT16 n;
+ m = (INT8)((INT16)(*x)->obj->adr);
n = 0;
if (OPP_sym == 30) {
OPS_Get(&OPP_sym);
@@ -742,8 +751,8 @@ static void OPP_Factor (OPT_Node *x)
*x = OPB_NewRealConst(OPS_lrlval, OPT_lrltyp);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPP.Factor, OPS.numtyp = ", (LONGINT)44);
- OPM_LogWNum(OPS_numtyp, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPP.Factor, OPS.numtyp = ", 44);
+ OPM_LogWNum(OPS_numtyp, 0);
OPM_LogWLn();
break;
}
@@ -776,7 +785,7 @@ static void OPP_Factor (OPT_Node *x)
*x = NIL;
}
if (*x == NIL) {
- *x = OPB_NewIntConst(((LONGINT)(1)));
+ *x = OPB_NewIntConst(1);
(*x)->typ = OPT_undftyp;
}
}
@@ -784,7 +793,7 @@ static void OPP_Factor (OPT_Node *x)
static void OPP_Term (OPT_Node *x)
{
OPT_Node y = NIL;
- SHORTINT mulop;
+ INT8 mulop;
OPP_Factor(&*x);
while ((1 <= OPP_sym && OPP_sym <= 5)) {
mulop = OPP_sym;
@@ -797,7 +806,7 @@ static void OPP_Term (OPT_Node *x)
static void OPP_SimpleExpression (OPT_Node *x)
{
OPT_Node y = NIL;
- SHORTINT addop;
+ INT8 addop;
if (OPP_sym == 7) {
OPS_Get(&OPP_sym);
OPP_Term(&*x);
@@ -821,7 +830,7 @@ static void OPP_Expression (OPT_Node *x)
{
OPT_Node y = NIL;
OPT_Object obj = NIL;
- SHORTINT relation;
+ INT8 relation;
OPP_SimpleExpression(&*x);
if ((9 <= OPP_sym && OPP_sym <= 14)) {
relation = OPP_sym;
@@ -847,7 +856,7 @@ static void OPP_Expression (OPT_Node *x)
}
}
-static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec)
+static void OPP_Receiver (INT8 *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec)
{
OPT_Object obj = NIL;
*typ = OPT_undftyp;
@@ -858,7 +867,7 @@ static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_St
} else {
*mode = 1;
}
- __COPY(OPS_name, name, ((LONGINT)(256)));
+ __COPY(OPS_name, name, 256);
OPP_CheckSym(38);
OPP_CheckSym(20);
if (OPP_sym == 38) {
@@ -871,10 +880,10 @@ static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_St
} else {
*typ = obj->typ;
*rec = *typ;
- if ((*rec)->form == 13) {
+ if ((*rec)->form == 11) {
*rec = (*rec)->BaseTyp;
}
- if (!((((*mode == 1 && (*typ)->form == 13)) && (*rec)->comp == 4) || (*mode == 2 && (*typ)->comp == 4))) {
+ if (!((((*mode == 1 && (*typ)->form == 11)) && (*rec)->comp == 4) || (*mode == 2 && (*typ)->comp == 4))) {
OPP_err(70);
*rec = NIL;
}
@@ -888,15 +897,14 @@ static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_St
}
OPP_CheckSym(22);
if (*rec == NIL) {
- *rec = OPT_NewStr(15, 4);
+ *rec = OPT_NewStr(13, 4);
(*rec)->BaseTyp = NIL;
}
}
static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b)
{
- BOOLEAN _o_result;
- if ((b->form == 13 && x->form == 13)) {
+ if ((b->form == 11 && x->form == 11)) {
b = b->BaseTyp;
x = x->BaseTyp;
}
@@ -905,15 +913,14 @@ static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b)
x = x->BaseTyp;
} while (!(x == NIL || x == b));
}
- _o_result = x == b;
- return _o_result;
+ return x == b;
}
static struct ProcedureDeclaration__16 {
OPT_Node *x;
OPT_Object *proc, *fwd;
OPS_Name *name;
- SHORTINT *mode, *vis;
+ INT8 *mode, *vis;
BOOLEAN *forward;
struct ProcedureDeclaration__16 *lnk;
} *ProcedureDeclaration__16_s;
@@ -926,14 +933,14 @@ static void TProcDecl__23 (void);
static void GetCode__19 (void)
{
OPT_ConstExt ext = NIL;
- INTEGER n;
- LONGINT c;
+ INT16 n;
+ INT64 c;
ext = OPT_NewExt();
(*ProcedureDeclaration__16_s->proc)->conval->ext = ext;
n = 0;
if (OPP_sym == 37) {
- while (OPS_str[__X(n, ((LONGINT)(256)))] != 0x00) {
- (*ext)[__X(n + 1, ((LONGINT)(256)))] = OPS_str[__X(n, ((LONGINT)(256)))];
+ while (OPS_str[__X(n, 256)] != 0x00) {
+ (*ext)[__X(n + 1, 256)] = OPS_str[__X(n, 256)];
n += 1;
}
(*ext)[0] = (CHAR)n;
@@ -949,7 +956,7 @@ static void GetCode__19 (void)
n = 1;
}
OPS_Get(&OPP_sym);
- (*ext)[__X(n, ((LONGINT)(256)))] = (CHAR)c;
+ (*ext)[__X(n, 256)] = (CHAR)c;
}
if (OPP_sym == 19) {
OPS_Get(&OPP_sym);
@@ -961,7 +968,7 @@ static void GetCode__19 (void)
}
}
}
- (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1);
+ (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1,64);
}
static void GetParams__21 (void)
@@ -991,9 +998,9 @@ static void GetParams__21 (void)
static void Body__17 (void)
{
OPT_Node procdec = NIL, statseq = NIL;
- LONGINT c;
+ INT32 c;
c = OPM_errpos;
- (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1);
+ (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1,64);
OPP_CheckSym(39);
OPP_Block(&procdec, &statseq);
OPB_Enter(&procdec, statseq, *ProcedureDeclaration__16_s->proc);
@@ -1014,7 +1021,7 @@ static void TProcDecl__23 (void)
{
OPT_Object baseProc = NIL;
OPT_Struct objTyp = NIL, recTyp = NIL;
- SHORTINT objMode;
+ INT8 objMode;
OPS_Name objName;
OPS_Get(&OPP_sym);
*ProcedureDeclaration__16_s->mode = 13;
@@ -1023,7 +1030,7 @@ static void TProcDecl__23 (void)
}
OPP_Receiver(&objMode, objName, &objTyp, &recTyp);
if (OPP_sym == 38) {
- __COPY(OPS_name, *ProcedureDeclaration__16_s->name, ((LONGINT)(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);
@@ -1036,7 +1043,7 @@ static void TProcDecl__23 (void)
if ((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mnolev != OPP_level)) {
*ProcedureDeclaration__16_s->fwd = NIL;
}
- if ((((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mode == 13)) && !__IN(1, (*ProcedureDeclaration__16_s->fwd)->conval->setval))) {
+ if ((((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mode == 13)) && !__IN(1, (*ProcedureDeclaration__16_s->fwd)->conval->setval, 64))) {
*ProcedureDeclaration__16_s->proc = OPT_NewObj();
(*ProcedureDeclaration__16_s->proc)->leaf = 1;
if ((*ProcedureDeclaration__16_s->fwd)->vis != *ProcedureDeclaration__16_s->vis) {
@@ -1070,7 +1077,7 @@ static void TProcDecl__23 (void)
if ((((((baseProc->vis == 1 && (*ProcedureDeclaration__16_s->proc)->vis == 0)) && recTyp->strobj != NIL)) && recTyp->strobj->vis == 1)) {
OPP_err(109);
}
- (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(2);
+ (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(2,64);
}
if (!*ProcedureDeclaration__16_s->forward) {
Body__17();
@@ -1086,7 +1093,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
{
OPT_Object proc = NIL, fwd = NIL;
OPS_Name name;
- SHORTINT mode, vis;
+ INT8 mode, vis;
BOOLEAN forward;
struct ProcedureDeclaration__16 _s;
_s.x = x;
@@ -1113,7 +1120,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
} else {
OPP_err(38);
}
- if ((__IN(mode, 0x0600) && !OPT_SYSimported)) {
+ if ((__IN(mode, 0x0600, 32) && !OPT_SYSimported)) {
OPP_err(135);
}
OPS_Get(&OPP_sym);
@@ -1122,7 +1129,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
TProcDecl__23();
} else if (OPP_sym == 38) {
OPT_Find(&fwd);
- __COPY(OPS_name, name, ((LONGINT)(256)));
+ __COPY(OPS_name, name, 256);
OPP_CheckMark(&vis);
if ((vis != 0 && mode == 6)) {
mode = 7;
@@ -1130,7 +1137,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
if ((fwd != NIL && (fwd->mnolev != OPP_level || fwd->mode == 8))) {
fwd = NIL;
}
- if ((((fwd != NIL && __IN(fwd->mode, 0xc0))) && !__IN(1, fwd->conval->setval))) {
+ if ((((fwd != NIL && __IN(fwd->mode, 0xc0, 32))) && !__IN(1, fwd->conval->setval, 64))) {
proc = OPT_NewObj();
proc->leaf = 1;
if (fwd->vis != vis) {
@@ -1163,34 +1170,34 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
ProcedureDeclaration__16_s = _s.lnk;
}
-static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab)
+static void OPP_CaseLabelList (OPT_Node *lab, OPT_Struct LabelTyp, INT16 *n, OPP_CaseTable tab)
{
OPT_Node x = NIL, y = NIL, lastlab = NIL;
- INTEGER i, f;
- LONGINT xval, yval;
+ INT16 i, f;
+ INT32 xval, yval;
*lab = NIL;
lastlab = NIL;
for (;;) {
OPP_ConstExpression(&x);
f = x->typ->form;
- if (__IN(f, 0x78)) {
- xval = x->conval->intval;
+ if (__IN(f, 0x18, 32)) {
+ xval = OPM_Longint(x->conval->intval);
} else {
OPP_err(61);
xval = 1;
}
- if (__IN(f, 0x70)) {
- if (LabelForm < f) {
+ if (f == 4) {
+ if (!(LabelTyp->form == 4) || LabelTyp->size < x->typ->size) {
OPP_err(60);
}
- } else if (LabelForm != f) {
+ } else if ((INT16)LabelTyp->form != f) {
OPP_err(60);
}
if (OPP_sym == 21) {
OPS_Get(&OPP_sym);
OPP_ConstExpression(&y);
- yval = y->conval->intval;
- if (((int)y->typ->form != f && !((__IN(f, 0x70) && __IN(y->typ->form, 0x70))))) {
+ yval = OPM_Longint(y->conval->intval);
+ if (((INT16)y->typ->form != f && !((f == 4 && y->typ->form == 4)))) {
OPP_err(60);
}
if (yval < xval) {
@@ -1207,17 +1214,17 @@ static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP
if (i == 0) {
break;
}
- if (tab[__X(i - 1, ((LONGINT)(128)))].low <= yval) {
- if (tab[__X(i - 1, ((LONGINT)(128)))].high >= xval) {
+ if (tab[__X(i - 1, 128)].low <= yval) {
+ if (tab[__X(i - 1, 128)].high >= xval) {
OPP_err(62);
}
break;
}
- tab[__X(i, ((LONGINT)(128)))] = tab[__X(i - 1, ((LONGINT)(128)))];
+ tab[__X(i, 128)] = tab[__X(i - 1, 128)];
i -= 1;
}
- tab[__X(i, ((LONGINT)(128)))].low = xval;
- tab[__X(i, ((LONGINT)(128)))].high = yval;
+ tab[__X(i, 128)].low = xval;
+ tab[__X(i, 128)].high = yval;
*n += 1;
} else {
OPP_err(213);
@@ -1234,7 +1241,7 @@ static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP
}
static struct StatSeq__30 {
- LONGINT *pos;
+ INT32 *pos;
struct StatSeq__30 *lnk;
} *StatSeq__30_s;
@@ -1244,8 +1251,8 @@ static void SetPos__35 (OPT_Node x);
static void CasePart__31 (OPT_Node *x)
{
- INTEGER n;
- LONGINT low, high;
+ INT16 n;
+ INT32 low, high;
BOOLEAN e;
OPP_CaseTable tab;
OPT_Node cases = NIL, lab = NIL, y = NIL, lastcase = NIL;
@@ -1253,7 +1260,7 @@ static void CasePart__31 (OPT_Node *x)
*StatSeq__30_s->pos = OPM_errpos;
if ((*x)->class == 8 || (*x)->class == 9) {
OPP_err(126);
- } else if (!__IN((*x)->typ->form, 0x78)) {
+ } else if (!__IN((*x)->typ->form, 0x18, 32)) {
OPP_err(125);
}
OPP_CheckSym(25);
@@ -1262,7 +1269,7 @@ static void CasePart__31 (OPT_Node *x)
n = 0;
for (;;) {
if (OPP_sym < 40) {
- OPP_CaseLabelList(&lab, (*x)->typ->form, &n, tab);
+ OPP_CaseLabelList(&lab, (*x)->typ, &n, tab);
OPP_CheckSym(20);
OPP_StatSeq(&y);
OPB_Construct(17, &lab, y);
@@ -1276,7 +1283,7 @@ static void CasePart__31 (OPT_Node *x)
}
if (n > 0) {
low = tab[0].low;
- high = tab[__X(n - 1, ((LONGINT)(128)))].high;
+ high = tab[__X(n - 1, 128)].high;
if (high - low > 512) {
OPP_err(209);
}
@@ -1328,7 +1335,7 @@ static void OPP_StatSeq (OPT_Node *stat)
OPT_Struct idtyp = NIL;
BOOLEAN e;
OPT_Node s = NIL, x = NIL, y = NIL, z = NIL, apar = NIL, last = NIL, lastif = NIL;
- LONGINT pos;
+ INT32 pos;
OPS_Name name;
struct StatSeq__30 _s;
_s.pos = &pos;
@@ -1439,7 +1446,7 @@ static void OPP_StatSeq (OPT_Node *stat)
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
OPP_qualident(&id);
- if (!__IN(id->typ->form, 0x70)) {
+ if (!(id->typ->form == 4)) {
OPP_err(68);
}
OPP_CheckSym(34);
@@ -1471,7 +1478,7 @@ static void OPP_StatSeq (OPT_Node *stat)
SetPos__35(z);
OPB_Link(&*stat, &last, z);
y = OPB_NewLeaf(t);
- } else if (y->typ->form < 4 || y->typ->form > x->left->typ->form) {
+ } else if (!(y->typ->form == 4) || y->typ->size > x->left->typ->size) {
OPP_err(113);
}
OPB_Link(&*stat, &last, x);
@@ -1479,7 +1486,7 @@ static void OPP_StatSeq (OPT_Node *stat)
OPS_Get(&OPP_sym);
OPP_ConstExpression(&z);
} else {
- z = OPB_NewIntConst(((LONGINT)(1)));
+ z = OPB_NewIntConst(1);
}
pos = OPM_errpos;
x = OPB_NewLeaf(id);
@@ -1526,7 +1533,7 @@ static void OPP_StatSeq (OPT_Node *stat)
if (OPP_sym == 38) {
OPP_qualident(&id);
y = OPB_NewLeaf(id);
- if ((((id != NIL && id->typ->form == 13)) && (id->mode == 2 || !id->leaf))) {
+ if ((((id != NIL && id->typ->form == 11)) && (id->mode == 2 || !id->leaf))) {
OPP_err(245);
}
OPP_CheckSym(20);
@@ -1621,7 +1628,7 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
OPT_Struct typ = NIL;
OPT_Object obj = NIL, first = NIL, last = NIL;
OPT_Node x = NIL, lastdec = NIL;
- INTEGER i;
+ INT16 i;
first = NIL;
last = NIL;
OPP_nofFwdPtr = 0;
@@ -1642,7 +1649,7 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
OPP_ConstExpression(&x);
} else {
OPP_err(9);
- x = OPB_NewIntConst(((LONGINT)(1)));
+ x = OPB_NewIntConst(1);
}
obj->mode = 3;
obj->typ = x->typ;
@@ -1670,10 +1677,10 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
if (obj->typ->strobj == NIL) {
obj->typ->strobj = obj;
}
- if (__IN(obj->typ->comp, 0x1c)) {
+ if (__IN(obj->typ->comp, 0x1c, 32)) {
i = 0;
while (i < OPP_nofFwdPtr) {
- typ = OPP_FwdPtr[__X(i, ((LONGINT)(64)))];
+ typ = OPP_FwdPtr[__X(i, 64)];
i += 1;
if (__STRCMP(typ->link->name, obj->name) == 0) {
typ->BaseTyp = obj->typ;
@@ -1735,10 +1742,10 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
}
i = 0;
while (i < OPP_nofFwdPtr) {
- if (OPP_FwdPtr[__X(i, ((LONGINT)(64)))]->link->name[0] != 0x00) {
+ if (OPP_FwdPtr[__X(i, 64)]->link->name[0] != 0x00) {
OPP_err(128);
}
- OPP_FwdPtr[__X(i, ((LONGINT)(64)))] = NIL;
+ OPP_FwdPtr[__X(i, 64)] = NIL;
i += 1;
}
OPT_topScope->adr = OPM_errpos;
@@ -1770,11 +1777,11 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
OPP_CheckSym(41);
}
-void OPP_Module (OPT_Node *prog, SET opt)
+void OPP_Module (OPT_Node *prog, UINT32 opt)
{
OPS_Name impName, aliasName;
OPT_Node procdec = NIL, statseq = NIL;
- LONGINT c;
+ INT32 c;
BOOLEAN done;
OPS_Init();
OPP_LoopLevel = 0;
@@ -1784,28 +1791,28 @@ void OPP_Module (OPT_Node *prog, SET opt)
OPS_Get(&OPP_sym);
} else {
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Unexpected symbol found when MODULE expected:", (LONGINT)46);
+ OPM_LogWStr((CHAR*)"Unexpected symbol found when MODULE expected:", 46);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" sym: ", (LONGINT)15);
- OPM_LogWNum(OPP_sym, ((LONGINT)(1)));
+ OPM_LogWStr((CHAR*)" sym: ", 15);
+ OPM_LogWNum(OPP_sym, 1);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.name: ", (LONGINT)15);
- OPM_LogWStr(OPS_name, ((LONGINT)(256)));
+ OPM_LogWStr((CHAR*)" OPS.name: ", 15);
+ OPM_LogWStr(OPS_name, 256);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.str: ", (LONGINT)15);
- OPM_LogWStr(OPS_str, ((LONGINT)(256)));
+ OPM_LogWStr((CHAR*)" OPS.str: ", 15);
+ OPM_LogWStr(OPS_str, 256);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.numtyp: ", (LONGINT)15);
- OPM_LogWNum(OPS_numtyp, ((LONGINT)(1)));
+ OPM_LogWStr((CHAR*)" OPS.numtyp: ", 15);
+ OPM_LogWNum(OPS_numtyp, 1);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.intval: ", (LONGINT)15);
- OPM_LogWNum(OPS_intval, ((LONGINT)(1)));
+ OPM_LogWStr((CHAR*)" OPS.intval: ", 15);
+ OPM_LogWNum(OPS_intval, 1);
OPM_LogWLn();
OPP_err(16);
}
if (OPP_sym == 38) {
- OPM_LogWStr((CHAR*)"compiling ", (LONGINT)11);
- OPM_LogWStr(OPS_name, ((LONGINT)(256)));
+ OPM_LogWStr((CHAR*)"compiling ", 11);
+ OPM_LogWStr(OPS_name, 256);
OPM_LogW('.');
OPT_Init(OPS_name, opt);
OPS_Get(&OPP_sym);
@@ -1814,13 +1821,13 @@ void OPP_Module (OPT_Node *prog, SET opt)
OPS_Get(&OPP_sym);
for (;;) {
if (OPP_sym == 38) {
- __COPY(OPS_name, aliasName, ((LONGINT)(256)));
- __COPY(aliasName, impName, ((LONGINT)(256)));
+ __COPY(OPS_name, aliasName, 256);
+ __COPY(aliasName, impName, 256);
OPS_Get(&OPP_sym);
if (OPP_sym == 34) {
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
- __COPY(OPS_name, impName, ((LONGINT)(256)));
+ __COPY(OPS_name, impName, 256);
OPS_Get(&OPP_sym);
} else {
OPP_err(38);
diff --git a/bootstrap/unix-44/OPP.h b/bootstrap/unix-44/OPP.h
index bf56b7d7..5a71eb39 100644
--- a/bootstrap/unix-44/OPP.h
+++ b/bootstrap/unix-44/OPP.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPP__h
#define OPP__h
@@ -9,8 +9,8 @@
-import void OPP_Module (OPT_Node *prog, SET opt);
+import void OPP_Module (OPT_Node *prog, UINT32 opt);
import void *OPP__init(void);
-#endif
+#endif // OPP
diff --git a/bootstrap/unix-44/OPS.c b/bootstrap/unix-44/OPS.c
index cacf9256..6ee700e5 100644
--- a/bootstrap/unix-44/OPS.c
+++ b/bootstrap/unix-44/OPS.c
@@ -1,4 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "OPM.h"
@@ -11,29 +17,29 @@ typedef
export OPS_Name OPS_name;
export OPS_String OPS_str;
-export INTEGER OPS_numtyp;
-export LONGINT OPS_intval;
+export INT16 OPS_numtyp;
+export INT64 OPS_intval;
export REAL OPS_realval;
export LONGREAL OPS_lrlval;
static CHAR OPS_ch;
-export void OPS_Get (SHORTINT *sym);
-static void OPS_Identifier (SHORTINT *sym);
+export void OPS_Get (INT8 *sym);
+static void OPS_Identifier (INT8 *sym);
export void OPS_Init (void);
static void OPS_Number (void);
-static void OPS_Str (SHORTINT *sym);
-static void OPS_err (INTEGER n);
+static void OPS_Str (INT8 *sym);
+static void OPS_err (INT16 n);
-static void OPS_err (INTEGER n)
+static void OPS_err (INT16 n)
{
OPM_err(n);
}
-static void OPS_Str (SHORTINT *sym)
+static void OPS_Str (INT8 *sym)
{
- INTEGER i;
+ INT16 i;
CHAR och;
i = 0;
och = OPS_ch;
@@ -59,15 +65,15 @@ static void OPS_Str (SHORTINT *sym)
if (OPS_intval == 2) {
*sym = 35;
OPS_numtyp = 1;
- OPS_intval = (int)OPS_str[0];
+ OPS_intval = (INT16)OPS_str[0];
} else {
*sym = 37;
}
}
-static void OPS_Identifier (SHORTINT *sym)
+static void OPS_Identifier (INT8 *sym)
{
- INTEGER i;
+ INT16 i;
i = 0;
do {
OPS_name[i] = OPS_ch;
@@ -86,12 +92,11 @@ static struct Number__6 {
struct Number__6 *lnk;
} *Number__6_s;
-static INTEGER Ord__7 (CHAR ch, BOOLEAN hex);
-static LONGREAL Ten__9 (INTEGER e);
+static INT16 Ord__7 (CHAR ch, BOOLEAN hex);
+static LONGREAL Ten__9 (INT16 e);
-static LONGREAL Ten__9 (INTEGER e)
+static LONGREAL Ten__9 (INT16 e)
{
- LONGREAL _o_result;
LONGREAL x, p;
x = (LONGREAL)1;
p = (LONGREAL)10;
@@ -104,30 +109,25 @@ static LONGREAL Ten__9 (INTEGER e)
p = p * p;
}
}
- _o_result = x;
- return _o_result;
+ return x;
}
-static INTEGER Ord__7 (CHAR ch, BOOLEAN hex)
+static INT16 Ord__7 (CHAR ch, BOOLEAN hex)
{
- INTEGER _o_result;
if (ch <= '9') {
- _o_result = (int)ch - 48;
- return _o_result;
+ return (INT16)ch - 48;
} else if (hex) {
- _o_result = ((int)ch - 65) + 10;
- return _o_result;
+ return ((INT16)ch - 65) + 10;
} else {
OPS_err(2);
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
static void OPS_Number (void)
{
- INTEGER i, m, n, d, e, maxHdig;
+ INT16 i, m, n, d, e;
CHAR dig[24];
LONGREAL f;
CHAR expCh;
@@ -173,7 +173,7 @@ static void OPS_Number (void)
OPS_numtyp = 1;
if (n <= 2) {
while (i < n) {
- OPS_intval = __ASHL(OPS_intval, 4) + (int)Ord__7(dig[i], 1);
+ OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1);
i += 1;
}
} else {
@@ -182,13 +182,12 @@ static void OPS_Number (void)
} else if (OPS_ch == 'H') {
OPM_Get(&OPS_ch);
OPS_numtyp = 2;
- maxHdig = 8;
- if (n <= maxHdig) {
- if ((n == maxHdig && dig[0] > '7')) {
+ if (n <= 16) {
+ if ((n == 16 && dig[0] > '7')) {
OPS_intval = -1;
}
while (i < n) {
- OPS_intval = __ASHL(OPS_intval, 4) + (int)Ord__7(dig[i], 1);
+ OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1);
i += 1;
}
} else {
@@ -199,8 +198,8 @@ static void OPS_Number (void)
while (i < n) {
d = Ord__7(dig[i], 0);
i += 1;
- if (OPS_intval <= __DIV(2147483647 - (int)d, 10)) {
- OPS_intval = OPS_intval * 10 + (int)d;
+ if (OPS_intval <= __DIV(9223372036854775807 - (INT64)d, 10)) {
+ OPS_intval = OPS_intval * 10 + (INT64)d;
} else {
OPS_err(203);
}
@@ -309,9 +308,9 @@ static void Comment__2 (void)
}
}
-void OPS_Get (SHORTINT *sym)
+void OPS_Get (INT8 *sym)
{
- SHORTINT s;
+ INT8 s;
struct Get__1 _s;
_s.lnk = Get__1_s;
Get__1_s = &_s;
@@ -319,6 +318,7 @@ void OPS_Get (SHORTINT *sym)
while (OPS_ch <= ' ') {
if (OPS_ch == 0x00) {
*sym = 64;
+ Get__1_s = _s.lnk;
return;
} else {
OPM_Get(&OPS_ch);
diff --git a/bootstrap/unix-44/OPS.h b/bootstrap/unix-44/OPS.h
index e901bcfc..1f7a3e58 100644
--- a/bootstrap/unix-44/OPS.h
+++ b/bootstrap/unix-44/OPS.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
#ifndef OPS__h
#define OPS__h
@@ -14,15 +14,15 @@ typedef
import OPS_Name OPS_name;
import OPS_String OPS_str;
-import INTEGER OPS_numtyp;
-import LONGINT OPS_intval;
+import INT16 OPS_numtyp;
+import INT64 OPS_intval;
import REAL OPS_realval;
import LONGREAL OPS_lrlval;
-import void OPS_Get (SHORTINT *sym);
+import void OPS_Get (INT8 *sym);
import void OPS_Init (void);
import void *OPS__init(void);
-#endif
+#endif // OPS
diff --git a/bootstrap/unix-44/OPT.c b/bootstrap/unix-44/OPT.c
index b32d0ebd..fb007184 100644
--- a/bootstrap/unix-44/OPT.c
+++ b/bootstrap/unix-44/OPT.c
@@ -1,4 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "OPM.h"
#include "OPS.h"
@@ -12,17 +18,18 @@ typedef
typedef
struct OPT_ConstDesc {
OPT_ConstExt ext;
- LONGINT intval, intval2;
- SET setval;
+ INT64 intval;
+ INT32 intval2;
+ UINT64 setval;
LONGREAL realval;
} OPT_ConstDesc;
typedef
struct OPT_ExpCtxt {
- LONGINT reffp;
- INTEGER ref;
- SHORTINT nofm;
- SHORTINT locmno[64];
+ INT32 reffp;
+ INT16 ref;
+ INT8 nofm;
+ INT8 locmno[64];
} OPT_ExpCtxt;
typedef
@@ -33,13 +40,13 @@ typedef
typedef
struct OPT_ImpCtxt {
- LONGINT nextTag, reffp;
- INTEGER nofr, minr, nofm;
+ INT32 nextTag, reffp;
+ INT16 nofr, minr, nofm;
BOOLEAN self;
OPT_Struct ref[255];
OPT_Object old[255];
- LONGINT pvfp[255];
- SHORTINT glbmno[64];
+ INT32 pvfp[255];
+ INT8 glbmno[64];
} OPT_ImpCtxt;
typedef
@@ -48,7 +55,7 @@ typedef
typedef
struct OPT_NodeDesc {
OPT_Node left, right, link;
- SHORTINT class, subcl;
+ INT8 class, subcl;
BOOLEAN readonly;
OPT_Struct typ;
OPT_Object obj;
@@ -60,120 +67,319 @@ typedef
OPT_Object left, right, link, scope;
OPS_Name name;
BOOLEAN leaf;
- SHORTINT mode, mnolev, vis, history;
+ INT8 mode, mnolev, vis, history;
BOOLEAN used, fpdone;
- LONGINT fprint;
+ INT32 fprint;
OPT_Struct typ;
OPT_Const conval;
- LONGINT adr, linkadr;
- INTEGER x;
+ INT32 adr, linkadr;
+ INT16 x;
} OPT_ObjDesc;
typedef
struct OPT_StrDesc {
- SHORTINT form, comp, mno, extlev;
- INTEGER ref, sysflag;
- LONGINT n, size, align, txtpos;
+ INT8 form, comp, mno, extlev;
+ INT16 ref, sysflag;
+ INT32 n, size, align, txtpos;
BOOLEAN allocated, pbused, pvused, fpdone, idfpdone;
- LONGINT idfp, pbfp, pvfp;
+ INT32 idfp, pbfp, pvfp;
OPT_Struct BaseTyp;
OPT_Object link, strobj;
} OPT_StrDesc;
-export void (*OPT_typSize)(OPT_Struct);
export OPT_Object OPT_topScope;
-export OPT_Struct OPT_undftyp, OPT_bytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_realtyp, OPT_lrltyp, OPT_settyp, OPT_stringtyp, OPT_niltyp, OPT_notyp, OPT_sysptrtyp;
-export SHORTINT OPT_nofGmod;
+export OPT_Struct OPT_undftyp, OPT_niltyp, OPT_notyp, OPT_bytetyp, OPT_cpbytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_hinttyp, OPT_int8typ, OPT_int16typ, OPT_int32typ, OPT_int64typ, OPT_settyp, OPT_set32typ, OPT_set64typ, OPT_realtyp, OPT_lrltyp, OPT_stringtyp, OPT_adrtyp, OPT_sysptrtyp;
+export OPT_Object OPT_sintobj, OPT_intobj, OPT_lintobj, OPT_setobj;
+export INT8 OPT_nofGmod;
export OPT_Object OPT_GlbMod[64];
export OPS_Name OPT_SelfName;
export BOOLEAN OPT_SYSimported;
static OPT_Object OPT_universe, OPT_syslink;
static OPT_ImpCtxt OPT_impCtxt;
static OPT_ExpCtxt OPT_expCtxt;
-static LONGINT OPT_nofhdfld;
+static INT32 OPT_nofhdfld;
static BOOLEAN OPT_newsf, OPT_findpc, OPT_extsf, OPT_sfpresent, OPT_symExtended, OPT_symNew;
+static INT32 OPT_recno;
-export LONGINT *OPT_ConstDesc__typ;
-export LONGINT *OPT_ObjDesc__typ;
-export LONGINT *OPT_StrDesc__typ;
-export LONGINT *OPT_NodeDesc__typ;
-export LONGINT *OPT_ImpCtxt__typ;
-export LONGINT *OPT_ExpCtxt__typ;
+export ADDRESS *OPT_ConstDesc__typ;
+export ADDRESS *OPT_ObjDesc__typ;
+export ADDRESS *OPT_StrDesc__typ;
+export ADDRESS *OPT_NodeDesc__typ;
+export ADDRESS *OPT_ImpCtxt__typ;
+export ADDRESS *OPT_ExpCtxt__typ;
+export void OPT_Align (INT32 *adr, INT32 base);
+export INT32 OPT_BaseAlignment (OPT_Struct typ);
export void OPT_Close (void);
export void OPT_CloseScope (void);
static void OPT_DebugStruct (OPT_Struct btyp);
-static void OPT_EnterBoolConst (OPS_Name name, LONGINT value);
-static void OPT_EnterProc (OPS_Name name, INTEGER num);
-static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct *res);
+static void OPT_EnterBoolConst (OPS_Name name, INT32 value);
+static void OPT_EnterProc (OPS_Name name, INT16 num);
+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, INTEGER errcode);
-static void OPT_FPrintName (LONGINT *fp, CHAR *name, LONGINT name__len);
+export void OPT_FPrintErr (OPT_Object obj, INT16 errcode);
+static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len);
export void OPT_FPrintObj (OPT_Object obj);
-static void OPT_FPrintSign (LONGINT *fp, OPT_Struct result, OPT_Object par);
+static void OPT_FPrintSign (INT32 *fp, OPT_Struct result, OPT_Object par);
export void OPT_FPrintStr (OPT_Struct typ);
export void OPT_Find (OPT_Object *res);
export void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res);
export void OPT_FindImport (OPT_Object mod, OPT_Object *res);
export void OPT_IdFPrint (OPT_Struct typ);
export void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done);
-static void OPT_InConstant (LONGINT f, OPT_Const conval);
+static void OPT_InConstant (INT32 f, OPT_Const conval);
static OPT_Object OPT_InFld (void);
-static void OPT_InMod (SHORTINT *mno);
+static void OPT_InMod (INT8 *mno);
static void OPT_InName (CHAR *name, LONGINT name__len);
-static OPT_Object OPT_InObj (SHORTINT mno);
-static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par);
+static 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);
-static OPT_Object OPT_InTProc (SHORTINT mno);
-export void OPT_Init (OPS_Name name, SET opt);
-static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form);
+static OPT_Object OPT_InTProc (INT8 mno);
+static OPT_Struct OPT_InTyp (INT32 tag);
+export void OPT_Init (OPS_Name name, UINT32 opt);
+export void OPT_InitRecno (void);
+static void OPT_InitStruct (OPT_Struct *typ, INT8 form);
export void OPT_Insert (OPS_Name name, OPT_Object *obj);
export void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old);
+export INT16 OPT_IntSize (INT64 n);
+export OPT_Struct OPT_IntType (INT32 size);
export OPT_Const OPT_NewConst (void);
export OPT_ConstExt OPT_NewExt (void);
-export OPT_Node OPT_NewNode (SHORTINT class);
+export OPT_Node OPT_NewNode (INT8 class);
export OPT_Object OPT_NewObj (void);
-export OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp);
-export void OPT_OpenScope (SHORTINT level, OPT_Object owner);
+export OPT_Struct OPT_NewStr (INT8 form, INT8 comp);
+export void OPT_OpenScope (INT8 level, OPT_Object owner);
static void OPT_OutConstant (OPT_Object obj);
-static void OPT_OutFlds (OPT_Object fld, LONGINT adr, BOOLEAN visible);
-static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr);
-static void OPT_OutMod (INTEGER mno);
+static void OPT_OutFlds (OPT_Object fld, INT32 adr, BOOLEAN visible);
+static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr);
+static void OPT_OutMod (INT16 mno);
static void OPT_OutName (CHAR *name, LONGINT name__len);
static void OPT_OutObj (OPT_Object obj);
static void OPT_OutSign (OPT_Struct result, OPT_Object par);
static void OPT_OutStr (OPT_Struct typ);
static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj);
-static void OPT_err (INTEGER n);
+export OPT_Struct OPT_SetType (INT32 size);
+export OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir);
+export INT32 OPT_SizeAlignment (INT32 size);
+export void OPT_TypSize (OPT_Struct typ);
+static void OPT_err (INT16 n);
-static void OPT_err (INTEGER n)
+void OPT_InitRecno (void)
+{
+ OPT_recno = 0;
+}
+
+static void OPT_err (INT16 n)
{
OPM_err(n);
}
+INT16 OPT_IntSize (INT64 n)
+{
+ INT16 bytes;
+ if (n < 0) {
+ n = -(n + 1);
+ }
+ bytes = 1;
+ while ((bytes < 8 && __ASH(n, -(__ASHL(bytes, 3) - 1)) != 0)) {
+ bytes += 1;
+ }
+ return bytes;
+}
+
+OPT_Struct OPT_IntType (INT32 size)
+{
+ if (size <= OPT_int8typ->size) {
+ return OPT_int8typ;
+ }
+ if (size <= OPT_int16typ->size) {
+ return OPT_int16typ;
+ }
+ if (size <= OPT_int32typ->size) {
+ return OPT_int32typ;
+ }
+ return OPT_int64typ;
+}
+
+OPT_Struct OPT_SetType (INT32 size)
+{
+ if (size == OPT_set32typ->size) {
+ return OPT_set32typ;
+ }
+ return OPT_set64typ;
+}
+
+OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir)
+{
+ INT16 i;
+ __ASSERT(x->form == 4, 0);
+ __ASSERT(x->BaseTyp == OPT_undftyp, 0);
+ __ASSERT(dir == 1 || dir == -1, 0);
+ if (dir > 0) {
+ if (x->size < OPT_sinttyp->size) {
+ return OPT_sinttyp;
+ }
+ if (x->size < OPT_inttyp->size) {
+ return OPT_inttyp;
+ }
+ if (x->size < OPT_linttyp->size) {
+ return OPT_linttyp;
+ }
+ return OPT_int64typ;
+ } else {
+ if (x->size > OPT_linttyp->size) {
+ return OPT_linttyp;
+ }
+ if (x->size > OPT_inttyp->size) {
+ return OPT_inttyp;
+ }
+ if (x->size > OPT_sinttyp->size) {
+ return OPT_sinttyp;
+ }
+ return OPT_int8typ;
+ }
+ __RETCHK;
+}
+
+void OPT_Align (INT32 *adr, INT32 base)
+{
+ switch (base) {
+ case 2:
+ *adr += __MASK(*adr, -2);
+ break;
+ case 4:
+ *adr += __MASK(-*adr, -4);
+ break;
+ case 8:
+ *adr += __MASK(-*adr, -8);
+ break;
+ case 16:
+ *adr += __MASK(-*adr, -16);
+ break;
+ default:
+ break;
+ }
+}
+
+INT32 OPT_SizeAlignment (INT32 size)
+{
+ INT32 alignment;
+ if (size < OPM_Alignment) {
+ alignment = 1;
+ while (alignment < size) {
+ alignment = __ASHL(alignment, 1);
+ }
+ } else {
+ alignment = OPM_Alignment;
+ }
+ return alignment;
+}
+
+INT32 OPT_BaseAlignment (OPT_Struct typ)
+{
+ INT32 alignment;
+ if (typ->form == 13) {
+ if (typ->comp == 4) {
+ alignment = __MASK(typ->align, -65536);
+ } else {
+ alignment = OPT_BaseAlignment(typ->BaseTyp);
+ }
+ } else {
+ alignment = OPT_SizeAlignment(typ->size);
+ }
+ return alignment;
+}
+
+void OPT_TypSize (OPT_Struct typ)
+{
+ INT16 f, c;
+ INT32 offset, size, base, fbase, off0;
+ OPT_Object fld = NIL;
+ OPT_Struct btyp = NIL;
+ if (typ == OPT_undftyp) {
+ OPM_err(58);
+ } else if (typ->size == -1) {
+ f = typ->form;
+ c = typ->comp;
+ if (c == 4) {
+ btyp = typ->BaseTyp;
+ if (btyp == NIL) {
+ offset = 0;
+ base = 1;
+ } else {
+ OPT_TypSize(btyp);
+ offset = btyp->size - __ASHR(btyp->sysflag, 8);
+ base = btyp->align;
+ }
+ fld = typ->link;
+ while ((fld != NIL && fld->mode == 4)) {
+ btyp = fld->typ;
+ OPT_TypSize(btyp);
+ size = btyp->size;
+ fbase = OPT_BaseAlignment(btyp);
+ OPT_Align(&offset, fbase);
+ fld->adr = offset;
+ offset += size;
+ if (fbase > base) {
+ base = fbase;
+ }
+ fld = fld->link;
+ }
+ off0 = offset;
+ if (offset == 0) {
+ offset = 1;
+ }
+ OPT_Align(&offset, base);
+ if ((typ->strobj == NIL && __MASK(typ->align, -65536) == 0)) {
+ OPT_recno += 1;
+ base += __ASHL(OPT_recno, 16);
+ }
+ typ->size = offset;
+ typ->align = base;
+ 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;
+ } else if (f == 11) {
+ typ->size = OPM_AddressSize;
+ if (typ->BaseTyp == OPT_undftyp) {
+ OPM_Mark(128, typ->n);
+ } else {
+ OPT_TypSize(typ->BaseTyp);
+ }
+ } else if (f == 12) {
+ typ->size = OPM_AddressSize;
+ } else if (c == 3) {
+ btyp = typ->BaseTyp;
+ OPT_TypSize(btyp);
+ if (btyp->comp == 3) {
+ typ->size = btyp->size + 4;
+ } else {
+ typ->size = 8;
+ }
+ }
+ }
+}
+
OPT_Const OPT_NewConst (void)
{
- OPT_Const _o_result;
OPT_Const const_ = NIL;
__NEW(const_, OPT_ConstDesc);
- _o_result = const_;
- return _o_result;
+ return const_;
}
OPT_Object OPT_NewObj (void)
{
- OPT_Object _o_result;
OPT_Object obj = NIL;
__NEW(obj, OPT_ObjDesc);
- _o_result = obj;
- return _o_result;
+ return obj;
}
-OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp)
+OPT_Struct OPT_NewStr (INT8 form, INT8 comp)
{
- OPT_Struct _o_result;
OPT_Struct typ = NIL;
__NEW(typ, OPT_StrDesc);
typ->form = form;
@@ -184,30 +390,25 @@ OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp)
}
typ->size = -1;
typ->BaseTyp = OPT_undftyp;
- _o_result = typ;
- return _o_result;
+ return typ;
}
-OPT_Node OPT_NewNode (SHORTINT class)
+OPT_Node OPT_NewNode (INT8 class)
{
- OPT_Node _o_result;
OPT_Node node = NIL;
__NEW(node, OPT_NodeDesc);
node->class = class;
- _o_result = node;
- return _o_result;
+ return node;
}
OPT_ConstExt OPT_NewExt (void)
{
- OPT_ConstExt _o_result;
OPT_ConstExt ext = NIL;
- ext = __NEWARR(NIL, ((LONGINT)(1)), 1, 1, 0, (LONGINT)256);
- _o_result = ext;
- return _o_result;
+ ext = __NEWARR(NIL, 1, 1, 1, 0, 256);
+ return ext;
}
-void OPT_OpenScope (SHORTINT level, OPT_Object owner)
+void OPT_OpenScope (INT8 level, OPT_Object owner)
{
OPT_Object head = NIL;
head = OPT_NewObj();
@@ -228,34 +429,34 @@ void OPT_CloseScope (void)
OPT_topScope = OPT_topScope->left;
}
-void OPT_Init (OPS_Name name, SET opt)
+void OPT_Init (OPS_Name name, UINT32 opt)
{
OPT_topScope = OPT_universe;
OPT_OpenScope(0, NIL);
OPT_SYSimported = 0;
- __COPY(name, OPT_SelfName, ((LONGINT)(256)));
- __COPY(name, OPT_topScope->name, ((LONGINT)(256)));
+ __COPY(name, OPT_SelfName, 256);
+ __COPY(name, OPT_topScope->name, 256);
OPT_GlbMod[0] = OPT_topScope;
OPT_nofGmod = 1;
- OPT_newsf = __IN(4, opt);
- OPT_findpc = __IN(8, opt);
- OPT_extsf = OPT_newsf || __IN(9, opt);
+ OPT_newsf = __IN(4, opt, 32);
+ OPT_findpc = __IN(8, opt, 32);
+ OPT_extsf = OPT_newsf || __IN(9, opt, 32);
OPT_sfpresent = 1;
}
void OPT_Close (void)
{
- INTEGER i;
+ INT16 i;
OPT_CloseScope();
i = 0;
while (i < 64) {
- OPT_GlbMod[__X(i, ((LONGINT)(64)))] = NIL;
+ OPT_GlbMod[__X(i, 64)] = NIL;
i += 1;
}
- i = 16;
+ i = 14;
while (i < 255) {
- OPT_impCtxt.ref[__X(i, ((LONGINT)(255)))] = NIL;
- OPT_impCtxt.old[__X(i, ((LONGINT)(255)))] = NIL;
+ OPT_impCtxt.ref[__X(i, 255)] = NIL;
+ OPT_impCtxt.old[__X(i, 255)] = NIL;
i += 1;
}
}
@@ -337,7 +538,7 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
{
OPT_Object ob0 = NIL, ob1 = NIL;
BOOLEAN left;
- SHORTINT mnolev;
+ INT8 mnolev;
ob0 = OPT_topScope;
ob1 = ob0->right;
left = 0;
@@ -366,7 +567,7 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
}
ob1->left = NIL;
ob1->right = NIL;
- __COPY(name, ob1->name, ((LONGINT)(256)));
+ __COPY(name, ob1->name, 256);
mnolev = OPT_topScope->mnolev;
ob1->mnolev = mnolev;
break;
@@ -375,14 +576,14 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
*obj = ob1;
}
-static void OPT_FPrintName (LONGINT *fp, CHAR *name, LONGINT name__len)
+static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len)
{
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
do {
ch = name[__X(i, name__len)];
- OPM_FPrint(&*fp, (int)ch);
+ OPM_FPrint(&*fp, (INT16)ch);
i += 1;
} while (!(ch == 0x00));
}
@@ -391,36 +592,36 @@ static void OPT_DebugStruct (OPT_Struct btyp)
{
OPM_LogWLn();
if (btyp == NIL) {
- OPM_LogWStr((CHAR*)"btyp is nil", (LONGINT)12);
+ OPM_LogWStr((CHAR*)"btyp is nil", 12);
OPM_LogWLn();
}
- OPM_LogWStr((CHAR*)"btyp^.strobji^.name = ", (LONGINT)23);
- OPM_LogWStr(btyp->strobj->name, ((LONGINT)(256)));
+ OPM_LogWStr((CHAR*)"btyp^.strobji^.name = ", 23);
+ OPM_LogWStr(btyp->strobj->name, 256);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.form = ", (LONGINT)14);
- OPM_LogWNum(btyp->form, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.form = ", 14);
+ OPM_LogWNum(btyp->form, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.comp = ", (LONGINT)14);
- OPM_LogWNum(btyp->comp, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.comp = ", 14);
+ OPM_LogWNum(btyp->comp, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.mno = ", (LONGINT)13);
- OPM_LogWNum(btyp->mno, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.mno = ", 13);
+ OPM_LogWNum(btyp->mno, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.extlev = ", (LONGINT)16);
- OPM_LogWNum(btyp->extlev, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.extlev = ", 16);
+ OPM_LogWNum(btyp->extlev, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.size = ", (LONGINT)14);
- OPM_LogWNum(btyp->size, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.size = ", 14);
+ OPM_LogWNum(btyp->size, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.align = ", (LONGINT)15);
- OPM_LogWNum(btyp->align, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.align = ", 15);
+ OPM_LogWNum(btyp->align, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.txtpos = ", (LONGINT)16);
- OPM_LogWNum(btyp->txtpos, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.txtpos = ", 16);
+ OPM_LogWNum(btyp->txtpos, 0);
OPM_LogWLn();
}
-static void OPT_FPrintSign (LONGINT *fp, OPT_Struct result, OPT_Object par)
+static void OPT_FPrintSign (INT32 *fp, OPT_Struct result, OPT_Object par)
{
OPT_IdFPrint(result);
OPM_FPrint(&*fp, result->idfp);
@@ -436,50 +637,53 @@ void OPT_IdFPrint (OPT_Struct typ)
{
OPT_Struct btyp = NIL;
OPT_Object strobj = NIL;
- LONGINT idfp;
- INTEGER f, c;
+ INT32 idfp;
+ INT16 f, c;
if (!typ->idfpdone) {
typ->idfpdone = 1;
idfp = 0;
f = typ->form;
- c = typ->comp;
OPM_FPrint(&idfp, f);
+ if (__IN(f, 0x90, 32)) {
+ OPM_FPrint(&idfp, typ->size);
+ }
+ c = typ->comp;
OPM_FPrint(&idfp, c);
btyp = typ->BaseTyp;
strobj = typ->strobj;
if ((strobj != NIL && strobj->name[0] != 0x00)) {
- OPT_FPrintName(&idfp, (void*)OPT_GlbMod[__X(typ->mno, ((LONGINT)(64)))]->name, ((LONGINT)(256)));
- OPT_FPrintName(&idfp, (void*)strobj->name, ((LONGINT)(256)));
+ OPT_FPrintName(&idfp, (void*)OPT_GlbMod[__X(typ->mno, 64)]->name, 256);
+ OPT_FPrintName(&idfp, (void*)strobj->name, 256);
}
- if ((f == 13 || (c == 4 && btyp != NIL)) || c == 3) {
+ if ((f == 11 || (c == 4 && btyp != NIL)) || c == 3) {
OPT_IdFPrint(btyp);
OPM_FPrint(&idfp, btyp->idfp);
} else if (c == 2) {
OPT_IdFPrint(btyp);
OPM_FPrint(&idfp, btyp->idfp);
OPM_FPrint(&idfp, typ->n);
- } else if (f == 14) {
+ } else if (f == 12) {
OPT_FPrintSign(&idfp, btyp, typ->link);
}
typ->idfp = idfp;
}
}
-static struct FPrintStr__12 {
- LONGINT *pbfp, *pvfp;
- struct FPrintStr__12 *lnk;
-} *FPrintStr__12_s;
+static struct FPrintStr__15 {
+ INT32 *pbfp, *pvfp;
+ struct FPrintStr__15 *lnk;
+} *FPrintStr__15_s;
-static void FPrintFlds__13 (OPT_Object fld, LONGINT adr, BOOLEAN visible);
-static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr);
-static void FPrintTProcs__17 (OPT_Object obj);
+static void FPrintFlds__16 (OPT_Object fld, INT32 adr, BOOLEAN visible);
+static void FPrintHdFld__18 (OPT_Struct typ, OPT_Object fld, INT32 adr);
+static void FPrintTProcs__20 (OPT_Object obj);
-static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr)
+static void FPrintHdFld__18 (OPT_Struct typ, OPT_Object fld, INT32 adr)
{
- LONGINT i, j, n;
+ INT32 i, j, n;
OPT_Struct btyp = NIL;
if (typ->comp == 4) {
- FPrintFlds__13(typ->link, adr, 0);
+ FPrintFlds__16(typ->link, adr, 0);
} else if (typ->comp == 2) {
btyp = typ->BaseTyp;
n = typ->n;
@@ -487,69 +691,69 @@ static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr)
n = btyp->n * n;
btyp = btyp->BaseTyp;
}
- if (btyp->form == 13 || btyp->comp == 4) {
+ if (btyp->form == 11 || btyp->comp == 4) {
j = OPT_nofhdfld;
- FPrintHdFld__15(btyp, fld, adr);
+ FPrintHdFld__18(btyp, fld, adr);
if (j != OPT_nofhdfld) {
i = 1;
while ((i < n && OPT_nofhdfld <= 2048)) {
adr += btyp->size;
- FPrintHdFld__15(btyp, fld, adr);
+ FPrintHdFld__18(btyp, fld, adr);
i += 1;
}
}
}
- } else if (typ->form == 13 || __STRCMP(fld->name, "@ptr") == 0) {
- OPM_FPrint(&*FPrintStr__12_s->pvfp, ((LONGINT)(13)));
- OPM_FPrint(&*FPrintStr__12_s->pvfp, adr);
+ } else if (typ->form == 11 || __STRCMP(fld->name, "@ptr") == 0) {
+ OPM_FPrint(&*FPrintStr__15_s->pvfp, 11);
+ OPM_FPrint(&*FPrintStr__15_s->pvfp, adr);
OPT_nofhdfld += 1;
}
}
-static void FPrintFlds__13 (OPT_Object fld, LONGINT adr, BOOLEAN visible)
+static void FPrintFlds__16 (OPT_Object fld, INT32 adr, BOOLEAN visible)
{
while ((fld != NIL && fld->mode == 4)) {
if ((fld->vis != 0 && visible)) {
- OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->vis);
- OPT_FPrintName(&*FPrintStr__12_s->pbfp, (void*)fld->name, ((LONGINT)(256)));
- OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->adr);
+ OPM_FPrint(&*FPrintStr__15_s->pbfp, fld->vis);
+ OPT_FPrintName(&*FPrintStr__15_s->pbfp, (void*)fld->name, 256);
+ OPM_FPrint(&*FPrintStr__15_s->pbfp, fld->adr);
OPT_FPrintStr(fld->typ);
- OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->typ->pbfp);
- OPM_FPrint(&*FPrintStr__12_s->pvfp, fld->typ->pvfp);
+ OPM_FPrint(&*FPrintStr__15_s->pbfp, fld->typ->pbfp);
+ OPM_FPrint(&*FPrintStr__15_s->pvfp, fld->typ->pvfp);
} else {
- FPrintHdFld__15(fld->typ, fld, fld->adr + adr);
+ FPrintHdFld__18(fld->typ, fld, fld->adr + adr);
}
fld = fld->link;
}
}
-static void FPrintTProcs__17 (OPT_Object obj)
+static void FPrintTProcs__20 (OPT_Object obj)
{
if (obj != NIL) {
- FPrintTProcs__17(obj->left);
+ FPrintTProcs__20(obj->left);
if (obj->mode == 13) {
if (obj->vis != 0) {
- OPM_FPrint(&*FPrintStr__12_s->pbfp, ((LONGINT)(13)));
- OPM_FPrint(&*FPrintStr__12_s->pbfp, __ASHR(obj->adr, 16));
- OPT_FPrintSign(&*FPrintStr__12_s->pbfp, obj->typ, obj->link);
- OPT_FPrintName(&*FPrintStr__12_s->pbfp, (void*)obj->name, ((LONGINT)(256)));
+ OPM_FPrint(&*FPrintStr__15_s->pbfp, 13);
+ OPM_FPrint(&*FPrintStr__15_s->pbfp, __ASHR(obj->adr, 16));
+ OPT_FPrintSign(&*FPrintStr__15_s->pbfp, obj->typ, obj->link);
+ OPT_FPrintName(&*FPrintStr__15_s->pbfp, (void*)obj->name, 256);
}
}
- FPrintTProcs__17(obj->right);
+ FPrintTProcs__20(obj->right);
}
}
void OPT_FPrintStr (OPT_Struct typ)
{
- INTEGER f, c;
+ INT16 f, c;
OPT_Struct btyp = NIL;
OPT_Object strobj = NIL, bstrobj = NIL;
- LONGINT pbfp, pvfp;
- struct FPrintStr__12 _s;
+ INT32 pbfp, pvfp;
+ struct FPrintStr__15 _s;
_s.pbfp = &pbfp;
_s.pvfp = &pvfp;
- _s.lnk = FPrintStr__12_s;
- FPrintStr__12_s = &_s;
+ _s.lnk = FPrintStr__15_s;
+ FPrintStr__15_s = &_s;
if (!typ->fpdone) {
OPT_IdFPrint(typ);
pbfp = typ->idfp;
@@ -563,7 +767,7 @@ void OPT_FPrintStr (OPT_Struct typ)
f = typ->form;
c = typ->comp;
btyp = typ->BaseTyp;
- if (f == 13) {
+ if (f == 11) {
strobj = typ->strobj;
bstrobj = btyp->strobj;
if (((strobj == NIL || strobj->name[0] == 0x00) || bstrobj == NIL) || bstrobj->name[0] == 0x00) {
@@ -571,8 +775,8 @@ void OPT_FPrintStr (OPT_Struct typ)
OPM_FPrint(&pbfp, btyp->pbfp);
pvfp = pbfp;
}
- } else if (f == 14) {
- } else if (__IN(c, 0x0c)) {
+ } else if (f == 12) {
+ } else if (__IN(c, 0x0c, 32)) {
OPT_FPrintStr(btyp);
OPM_FPrint(&pbfp, btyp->pvfp);
pvfp = pbfp;
@@ -586,11 +790,11 @@ void OPT_FPrintStr (OPT_Struct typ)
OPM_FPrint(&pvfp, typ->align);
OPM_FPrint(&pvfp, typ->n);
OPT_nofhdfld = 0;
- FPrintFlds__13(typ->link, ((LONGINT)(0)), 1);
+ FPrintFlds__16(typ->link, 0, 1);
if (OPT_nofhdfld > 2048) {
OPM_Mark(225, typ->txtpos);
}
- FPrintTProcs__17(typ->link);
+ FPrintTProcs__20(typ->link);
OPM_FPrint(&pvfp, pbfp);
strobj = typ->strobj;
if (strobj == NIL || strobj->name[0] == 0x00) {
@@ -600,13 +804,13 @@ void OPT_FPrintStr (OPT_Struct typ)
typ->pbfp = pbfp;
typ->pvfp = pvfp;
}
- FPrintStr__12_s = _s.lnk;
+ FPrintStr__15_s = _s.lnk;
}
void OPT_FPrintObj (OPT_Object obj)
{
- LONGINT fprint;
- INTEGER f, m;
+ INT32 fprint;
+ INT16 f, m;
REAL rval;
OPT_ConstExt ext = NIL;
if (!obj->fpdone) {
@@ -617,23 +821,23 @@ void OPT_FPrintObj (OPT_Object obj)
f = obj->typ->form;
OPM_FPrint(&fprint, f);
switch (f) {
- case 2: case 3: case 4: case 5: case 6:
+ case 2: case 3: case 4:
OPM_FPrint(&fprint, obj->conval->intval);
break;
- case 9:
+ case 7:
OPM_FPrintSet(&fprint, obj->conval->setval);
break;
- case 7:
+ case 5:
rval = obj->conval->realval;
OPM_FPrintReal(&fprint, rval);
break;
- case 8:
+ case 6:
OPM_FPrintLReal(&fprint, obj->conval->realval);
break;
- case 10:
- OPT_FPrintName(&fprint, (void*)*obj->conval->ext, ((LONGINT)(256)));
+ case 8:
+ OPT_FPrintName(&fprint, (void*)*obj->conval->ext, 256);
break;
- case 11:
+ case 9:
break;
default:
OPT_err(127);
@@ -643,16 +847,16 @@ void OPT_FPrintObj (OPT_Object obj)
OPM_FPrint(&fprint, obj->vis);
OPT_FPrintStr(obj->typ);
OPM_FPrint(&fprint, obj->typ->pbfp);
- } else if (__IN(obj->mode, 0x0480)) {
+ } else if (__IN(obj->mode, 0x0480, 32)) {
OPT_FPrintSign(&fprint, obj->typ, obj->link);
} else if (obj->mode == 9) {
OPT_FPrintSign(&fprint, obj->typ, obj->link);
ext = obj->conval->ext;
- m = (int)(*ext)[0];
+ m = (INT16)(*ext)[0];
f = 1;
OPM_FPrint(&fprint, m);
while (f <= m) {
- OPM_FPrint(&fprint, (int)(*ext)[__X(f, ((LONGINT)(256)))]);
+ OPM_FPrint(&fprint, (INT16)(*ext)[__X(f, 256)]);
f += 1;
}
} else if (obj->mode == 5) {
@@ -663,27 +867,27 @@ void OPT_FPrintObj (OPT_Object obj)
}
}
-void OPT_FPrintErr (OPT_Object obj, INTEGER errcode)
+void OPT_FPrintErr (OPT_Object obj, INT16 errcode)
{
- INTEGER i, j;
+ INT16 i, j;
CHAR ch;
if (obj->mnolev != 0) {
- __COPY(OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, OPM_objname, ((LONGINT)(64)));
+ __COPY(OPT_GlbMod[__X(-obj->mnolev, 64)]->name, OPM_objname, 64);
i = 0;
- while (OPM_objname[__X(i, ((LONGINT)(64)))] != 0x00) {
+ while (OPM_objname[__X(i, 64)] != 0x00) {
i += 1;
}
- OPM_objname[__X(i, ((LONGINT)(64)))] = '.';
+ OPM_objname[__X(i, 64)] = '.';
j = 0;
i += 1;
do {
- ch = obj->name[__X(j, ((LONGINT)(256)))];
- OPM_objname[__X(i, ((LONGINT)(64)))] = ch;
+ ch = obj->name[__X(j, 256)];
+ OPM_objname[__X(i, 64)] = ch;
j += 1;
i += 1;
} while (!(ch == 0x00));
} else {
- __COPY(obj->name, OPM_objname, ((LONGINT)(64)));
+ __COPY(obj->name, OPM_objname, 64);
}
if (errcode == 249) {
if (OPM_noerr) {
@@ -755,7 +959,7 @@ void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old)
static void OPT_InName (CHAR *name, LONGINT name__len)
{
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
do {
@@ -765,23 +969,23 @@ static void OPT_InName (CHAR *name, LONGINT name__len)
} while (!(ch == 0x00));
}
-static void OPT_InMod (SHORTINT *mno)
+static void OPT_InMod (INT8 *mno)
{
OPT_Object head = NIL;
OPS_Name name;
- LONGINT mn;
- SHORTINT i;
+ INT32 mn;
+ INT8 i;
mn = OPM_SymRInt();
if (mn == 0) {
*mno = OPT_impCtxt.glbmno[0];
} else {
if (mn == 16) {
- OPT_InName((void*)name, ((LONGINT)(256)));
+ OPT_InName((void*)name, 256);
if ((__STRCMP(name, OPT_SelfName) == 0 && !OPT_impCtxt.self)) {
OPT_err(154);
}
i = 0;
- while ((i < OPT_nofGmod && __STRCMP(name, OPT_GlbMod[__X(i, ((LONGINT)(64)))]->name) != 0)) {
+ while ((i < OPT_nofGmod && __STRCMP(name, OPT_GlbMod[__X(i, 64)]->name) != 0)) {
i += 1;
}
if (i < OPT_nofGmod) {
@@ -789,77 +993,77 @@ static void OPT_InMod (SHORTINT *mno)
} else {
head = OPT_NewObj();
head->mode = 12;
- __COPY(name, head->name, ((LONGINT)(256)));
+ __COPY(name, head->name, 256);
*mno = OPT_nofGmod;
head->mnolev = -*mno;
if (OPT_nofGmod < 64) {
- OPT_GlbMod[__X(*mno, ((LONGINT)(64)))] = head;
+ OPT_GlbMod[__X(*mno, 64)] = head;
OPT_nofGmod += 1;
} else {
OPT_err(227);
}
}
- OPT_impCtxt.glbmno[__X(OPT_impCtxt.nofm, ((LONGINT)(64)))] = *mno;
+ OPT_impCtxt.glbmno[__X(OPT_impCtxt.nofm, 64)] = *mno;
OPT_impCtxt.nofm += 1;
} else {
- *mno = OPT_impCtxt.glbmno[__X(-mn, ((LONGINT)(64)))];
+ *mno = OPT_impCtxt.glbmno[__X(-mn, 64)];
}
}
}
-static void OPT_InConstant (LONGINT f, OPT_Const conval)
+static void OPT_InConstant (INT32 f, OPT_Const conval)
{
CHAR ch;
- INTEGER i;
+ INT16 i;
OPT_ConstExt ext = NIL;
REAL rval;
switch (f) {
case 1: case 3: case 2:
OPM_SymRCh(&ch);
- conval->intval = (int)ch;
+ conval->intval = (INT16)ch;
break;
- case 4: case 5: case 6:
+ case 4:
conval->intval = OPM_SymRInt();
break;
- case 9:
+ case 7:
OPM_SymRSet(&conval->setval);
break;
- case 7:
+ case 5:
OPM_SymRReal(&rval);
conval->realval = rval;
conval->intval = -1;
break;
- case 8:
+ case 6:
OPM_SymRLReal(&conval->realval);
conval->intval = -1;
break;
- case 10:
+ case 8:
ext = OPT_NewExt();
conval->ext = ext;
i = 0;
do {
OPM_SymRCh(&ch);
- (*ext)[__X(i, ((LONGINT)(256)))] = ch;
+ (*ext)[__X(i, 256)] = ch;
i += 1;
} while (!(ch == 0x00));
conval->intval2 = i;
conval->intval = -1;
break;
- case 11:
+ case 9:
conval->intval = 0;
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in InConstant(), f = ", (LONGINT)37);
- OPM_LogWNum(f, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in InConstant(), f = ", 37);
+ OPM_LogWNum(f, 0);
OPM_LogWLn();
break;
}
}
-static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par)
+static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par)
{
OPT_Object last = NIL, new = NIL;
- LONGINT tag;
+ INT32 tag;
OPT_InStruct(&*res);
tag = OPM_SymRInt();
last = NIL;
@@ -878,7 +1082,7 @@ static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par)
}
OPT_InStruct(&new->typ);
new->adr = OPM_SymRInt();
- OPT_InName((void*)new->name, ((LONGINT)(256)));
+ OPT_InName((void*)new->name, 256);
last = new;
tag = OPM_SymRInt();
}
@@ -886,8 +1090,7 @@ static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par)
static OPT_Object OPT_InFld (void)
{
- OPT_Object _o_result;
- LONGINT tag;
+ INT32 tag;
OPT_Object obj = NIL;
tag = OPT_impCtxt.nextTag;
obj = OPT_NewObj();
@@ -899,7 +1102,7 @@ static OPT_Object OPT_InFld (void)
obj->vis = 1;
}
OPT_InStruct(&obj->typ);
- OPT_InName((void*)obj->name, ((LONGINT)(256)));
+ OPT_InName((void*)obj->name, 256);
obj->adr = OPM_SymRInt();
} else {
obj->mode = 4;
@@ -912,14 +1115,12 @@ static OPT_Object OPT_InFld (void)
obj->vis = 0;
obj->adr = OPM_SymRInt();
}
- _o_result = obj;
- return _o_result;
+ return obj;
}
-static OPT_Object OPT_InTProc (SHORTINT mno)
+static OPT_Object OPT_InTProc (INT8 mno)
{
- OPT_Object _o_result;
- LONGINT tag;
+ INT32 tag;
OPT_Object obj = NIL;
tag = OPT_impCtxt.nextTag;
obj = OPT_NewObj();
@@ -930,7 +1131,7 @@ static OPT_Object OPT_InTProc (SHORTINT mno)
obj->conval->intval = -1;
OPT_InSign(mno, &obj->typ, &obj->link);
obj->vis = 1;
- OPT_InName((void*)obj->name, ((LONGINT)(256)));
+ OPT_InName((void*)obj->name, 256);
obj->adr = __ASHL(OPM_SymRInt(), 16);
} else {
obj->mode = 13;
@@ -940,21 +1141,32 @@ static OPT_Object OPT_InTProc (SHORTINT mno)
obj->vis = 0;
obj->adr = __ASHL(OPM_SymRInt(), 16);
}
- _o_result = obj;
- return _o_result;
+ return obj;
+}
+
+static OPT_Struct OPT_InTyp (INT32 tag)
+{
+ if (tag == 4) {
+ return OPT_IntType(OPM_SymRInt());
+ } else if (tag == 7) {
+ return OPT_SetType(OPM_SymRInt());
+ } else {
+ return OPT_impCtxt.ref[__X(tag, 255)];
+ }
+ __RETCHK;
}
static void OPT_InStruct (OPT_Struct *typ)
{
- SHORTINT mno;
- INTEGER ref;
- LONGINT tag;
+ INT8 mno;
+ INT16 ref;
+ INT32 tag;
OPS_Name name;
OPT_Struct t = NIL;
OPT_Object obj = NIL, last = NIL, fld = NIL, old = NIL, dummy = NIL;
tag = OPM_SymRInt();
if (tag != 34) {
- *typ = OPT_impCtxt.ref[__X(-tag, ((LONGINT)(255)))];
+ *typ = OPT_InTyp(-tag);
} else {
ref = OPT_impCtxt.nofr;
OPT_impCtxt.nofr += 1;
@@ -962,23 +1174,23 @@ static void OPT_InStruct (OPT_Struct *typ)
OPT_impCtxt.minr = ref;
}
OPT_InMod(&mno);
- OPT_InName((void*)name, ((LONGINT)(256)));
+ OPT_InName((void*)name, 256);
obj = OPT_NewObj();
if (name[0] == 0x00) {
if (OPT_impCtxt.self) {
old = NIL;
} else {
__MOVE("@", obj->name, 2);
- OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old);
+ OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
obj->name[0] = 0x00;
}
*typ = OPT_NewStr(0, 1);
} else {
- __COPY(name, obj->name, ((LONGINT)(256)));
- OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old);
+ __COPY(name, obj->name, 256);
+ OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
if (old != NIL) {
OPT_FPrintObj(old);
- OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] = old->typ->pvfp;
+ OPT_impCtxt.pvfp[__X(ref, 255)] = old->typ->pvfp;
if (OPT_impCtxt.self) {
*typ = OPT_NewStr(0, 1);
} else {
@@ -992,8 +1204,8 @@ static void OPT_InStruct (OPT_Struct *typ)
*typ = OPT_NewStr(0, 1);
}
}
- OPT_impCtxt.ref[__X(ref, ((LONGINT)(255)))] = *typ;
- OPT_impCtxt.old[__X(ref, ((LONGINT)(255)))] = old;
+ OPT_impCtxt.ref[__X(ref, 255)] = *typ;
+ OPT_impCtxt.old[__X(ref, 255)] = old;
(*typ)->ref = ref + 255;
(*typ)->mno = mno;
(*typ)->allocated = 1;
@@ -1004,25 +1216,25 @@ static void OPT_InStruct (OPT_Struct *typ)
obj->vis = 0;
tag = OPM_SymRInt();
if (tag == 35) {
- (*typ)->sysflag = (int)OPM_SymRInt();
+ (*typ)->sysflag = (INT16)OPM_SymRInt();
tag = OPM_SymRInt();
}
switch (tag) {
case 36:
- (*typ)->form = 13;
- (*typ)->size = OPM_PointerSize;
+ (*typ)->form = 11;
+ (*typ)->size = OPM_AddressSize;
(*typ)->n = 0;
OPT_InStruct(&(*typ)->BaseTyp);
break;
case 37:
- (*typ)->form = 15;
+ (*typ)->form = 13;
(*typ)->comp = 2;
OPT_InStruct(&(*typ)->BaseTyp);
(*typ)->n = OPM_SymRInt();
- (*OPT_typSize)(*typ);
+ OPT_TypSize(*typ);
break;
case 38:
- (*typ)->form = 15;
+ (*typ)->form = 13;
(*typ)->comp = 3;
OPT_InStruct(&(*typ)->BaseTyp);
if ((*typ)->BaseTyp->comp == 3) {
@@ -1030,10 +1242,10 @@ static void OPT_InStruct (OPT_Struct *typ)
} else {
(*typ)->n = 0;
}
- (*OPT_typSize)(*typ);
+ OPT_TypSize(*typ);
break;
case 39:
- (*typ)->form = 15;
+ (*typ)->form = 13;
(*typ)->comp = 4;
OPT_InStruct(&(*typ)->BaseTyp);
if ((*typ)->BaseTyp == OPT_notyp) {
@@ -1067,25 +1279,25 @@ static void OPT_InStruct (OPT_Struct *typ)
}
break;
case 40:
- (*typ)->form = 14;
- (*typ)->size = OPM_ProcSize;
+ (*typ)->form = 12;
+ (*typ)->size = OPM_AddressSize;
OPT_InSign(mno, &(*typ)->BaseTyp, &(*typ)->link);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at InStruct, tag = ", (LONGINT)35);
- OPM_LogWNum(tag, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at InStruct, tag = ", 35);
+ OPM_LogWNum(tag, 0);
OPM_LogWLn();
break;
}
if (ref == OPT_impCtxt.minr) {
while (ref < OPT_impCtxt.nofr) {
- t = OPT_impCtxt.ref[__X(ref, ((LONGINT)(255)))];
+ t = OPT_InTyp(ref);
OPT_FPrintStr(t);
obj = t->strobj;
if (obj->name[0] != 0x00) {
OPT_FPrintObj(obj);
}
- old = OPT_impCtxt.old[__X(ref, ((LONGINT)(255)))];
+ old = OPT_impCtxt.old[__X(ref, 255)];
if (old != NIL) {
t->strobj = old;
if (OPT_impCtxt.self) {
@@ -1093,13 +1305,13 @@ static void OPT_InStruct (OPT_Struct *typ)
if (old->history != 5) {
if (old->fprint != obj->fprint) {
old->history = 2;
- } else if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) {
+ } else if (OPT_impCtxt.pvfp[__X(ref, 255)] != t->pvfp) {
old->history = 3;
}
}
} else if (old->fprint != obj->fprint) {
old->history = 2;
- } else if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) {
+ } else if (OPT_impCtxt.pvfp[__X(ref, 255)] != t->pvfp) {
old->history = 3;
} else if (old->vis == 0) {
old->history = 1;
@@ -1107,7 +1319,7 @@ static void OPT_InStruct (OPT_Struct *typ)
old->history = 0;
}
} else {
- if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) {
+ if (OPT_impCtxt.pvfp[__X(ref, 255)] != t->pvfp) {
old->history = 5;
}
if (old->fprint != obj->fprint) {
@@ -1126,14 +1338,13 @@ static void OPT_InStruct (OPT_Struct *typ)
}
}
-static OPT_Object OPT_InObj (SHORTINT mno)
+static OPT_Object OPT_InObj (INT8 mno)
{
- OPT_Object _o_result;
- INTEGER i, s;
+ INT16 i, s;
CHAR ch;
OPT_Object obj = NIL, old = NIL;
OPT_Struct typ = NIL;
- LONGINT tag;
+ INT32 tag;
OPT_ConstExt ext = NIL;
tag = OPT_impCtxt.nextTag;
if (tag == 19) {
@@ -1146,11 +1357,11 @@ static OPT_Object OPT_InObj (SHORTINT mno)
obj = OPT_NewObj();
obj->mnolev = -mno;
obj->vis = 1;
- if (tag <= 13) {
+ if (tag <= 11) {
obj->mode = 3;
- obj->typ = OPT_impCtxt.ref[__X(tag, ((LONGINT)(255)))];
obj->conval = OPT_NewConst();
OPT_InConstant(tag, obj->conval);
+ obj->typ = OPT_InTyp(tag);
} else if (tag >= 31) {
obj->conval = OPT_NewConst();
obj->conval->intval = -1;
@@ -1166,17 +1377,17 @@ static OPT_Object OPT_InObj (SHORTINT mno)
obj->mode = 9;
ext = OPT_NewExt();
obj->conval->ext = ext;
- s = (int)OPM_SymRInt();
+ s = (INT16)OPM_SymRInt();
(*ext)[0] = (CHAR)s;
i = 1;
while (i <= s) {
- OPM_SymRCh(&(*ext)[__X(i, ((LONGINT)(256)))]);
+ OPM_SymRCh(&(*ext)[__X(i, 256)]);
i += 1;
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", (LONGINT)32);
- OPM_LogWNum(tag, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", 32);
+ OPM_LogWNum(tag, 0);
OPM_LogWLn();
break;
}
@@ -1190,14 +1401,14 @@ static OPT_Object OPT_InObj (SHORTINT mno)
}
OPT_InStruct(&obj->typ);
}
- OPT_InName((void*)obj->name, ((LONGINT)(256)));
+ OPT_InName((void*)obj->name, 256);
}
OPT_FPrintObj(obj);
if ((obj->mode == 1 && (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00))) {
OPM_FPrint(&OPT_impCtxt.reffp, obj->typ->ref - 255);
}
if (tag != 19) {
- OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old);
+ OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
if (OPT_impCtxt.self) {
if (old != NIL) {
if (old->vis == 0) {
@@ -1225,14 +1436,13 @@ static OPT_Object OPT_InObj (SHORTINT mno)
}
}
}
- _o_result = obj;
- return _o_result;
+ return obj;
}
void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
{
OPT_Object obj = NIL;
- SHORTINT mno;
+ INT8 mno;
OPS_Name aliasName__copy;
__DUPARR(aliasName, OPS_Name);
if (__STRCMP(name, "SYSTEM") == 0) {
@@ -1243,12 +1453,12 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
obj->scope = OPT_syslink;
obj->typ = OPT_notyp;
} else {
- OPT_impCtxt.nofr = 16;
+ OPT_impCtxt.nofr = 14;
OPT_impCtxt.minr = 255;
OPT_impCtxt.nofm = 0;
OPT_impCtxt.self = __STRCMP(aliasName, "@self") == 0;
OPT_impCtxt.reffp = 0;
- OPM_OldSym((void*)name, ((LONGINT)(256)), &*done);
+ OPM_OldSym((void*)name, 256, &*done);
if (*done) {
OPT_InMod(&mno);
OPT_impCtxt.nextTag = OPM_SymRInt();
@@ -1258,8 +1468,8 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
}
OPT_Insert(aliasName, &obj);
obj->mode = 11;
- obj->scope = OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right;
- OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->link = obj;
+ obj->scope = OPT_GlbMod[__X(mno, 64)]->right;
+ OPT_GlbMod[__X(mno, 64)]->link = obj;
obj->mnolev = -mno;
obj->typ = OPT_notyp;
OPM_CloseOldSym();
@@ -1275,7 +1485,7 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
static void OPT_OutName (CHAR *name, LONGINT name__len)
{
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
do {
@@ -1285,21 +1495,21 @@ static void OPT_OutName (CHAR *name, LONGINT name__len)
} while (!(ch == 0x00));
}
-static void OPT_OutMod (INTEGER mno)
+static void OPT_OutMod (INT16 mno)
{
- if (OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))] < 0) {
- OPM_SymWInt(((LONGINT)(16)));
- OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))] = OPT_expCtxt.nofm;
+ if (OPT_expCtxt.locmno[__X(mno, 64)] < 0) {
+ OPM_SymWInt(16);
+ OPT_expCtxt.locmno[__X(mno, 64)] = OPT_expCtxt.nofm;
OPT_expCtxt.nofm += 1;
- OPT_OutName((void*)OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->name, ((LONGINT)(256)));
+ OPT_OutName((void*)OPT_GlbMod[__X(mno, 64)]->name, 256);
} else {
- OPM_SymWInt(-OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))]);
+ OPM_SymWInt(-OPT_expCtxt.locmno[__X(mno, 64)]);
}
}
-static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr)
+static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr)
{
- LONGINT i, j, n;
+ INT32 i, j, n;
OPT_Struct btyp = NIL;
if (typ->comp == 4) {
OPT_OutFlds(typ->link, adr, 0);
@@ -1310,7 +1520,7 @@ static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr)
n = btyp->n * n;
btyp = btyp->BaseTyp;
}
- if (btyp->form == 13 || btyp->comp == 4) {
+ if (btyp->form == 11 || btyp->comp == 4) {
j = OPT_nofhdfld;
OPT_OutHdFld(btyp, fld, adr);
if (j != OPT_nofhdfld) {
@@ -1322,24 +1532,24 @@ static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr)
}
}
}
- } else if (typ->form == 13 || __STRCMP(fld->name, "@ptr") == 0) {
- OPM_SymWInt(((LONGINT)(27)));
+ } else if (typ->form == 11 || __STRCMP(fld->name, "@ptr") == 0) {
+ OPM_SymWInt(27);
OPM_SymWInt(adr);
OPT_nofhdfld += 1;
}
}
-static void OPT_OutFlds (OPT_Object fld, LONGINT adr, BOOLEAN visible)
+static void OPT_OutFlds (OPT_Object fld, INT32 adr, BOOLEAN visible)
{
while ((fld != NIL && fld->mode == 4)) {
if ((fld->vis != 0 && visible)) {
if (fld->vis == 2) {
- OPM_SymWInt(((LONGINT)(26)));
+ OPM_SymWInt(26);
} else {
- OPM_SymWInt(((LONGINT)(25)));
+ OPM_SymWInt(25);
}
OPT_OutStr(fld->typ);
- OPT_OutName((void*)fld->name, ((LONGINT)(256)));
+ OPT_OutName((void*)fld->name, 256);
OPM_SymWInt(fld->adr);
} else {
OPT_OutHdFld(fld->typ, fld, fld->adr + adr);
@@ -1353,16 +1563,16 @@ static void OPT_OutSign (OPT_Struct result, OPT_Object par)
OPT_OutStr(result);
while (par != NIL) {
if (par->mode == 1) {
- OPM_SymWInt(((LONGINT)(23)));
+ OPM_SymWInt(23);
} else {
- OPM_SymWInt(((LONGINT)(24)));
+ OPM_SymWInt(24);
}
OPT_OutStr(par->typ);
OPM_SymWInt(par->adr);
- OPT_OutName((void*)par->name, ((LONGINT)(256)));
+ OPT_OutName((void*)par->name, 256);
par = par->link;
}
- OPM_SymWInt(((LONGINT)(18)));
+ OPM_SymWInt(18);
}
static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj)
@@ -1375,12 +1585,12 @@ static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj)
}
if (obj->vis != 0) {
if (obj->vis != 0) {
- OPM_SymWInt(((LONGINT)(29)));
+ OPM_SymWInt(29);
OPT_OutSign(obj->typ, obj->link);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
OPM_SymWInt(__ASHR(obj->adr, 16));
} else {
- OPM_SymWInt(((LONGINT)(30)));
+ OPM_SymWInt(30);
OPM_SymWInt(__ASHR(obj->adr, 16));
}
}
@@ -1394,8 +1604,11 @@ static void OPT_OutStr (OPT_Struct typ)
OPT_Object strobj = NIL;
if (typ->ref < OPT_expCtxt.ref) {
OPM_SymWInt(-typ->ref);
+ if (__IN(typ->ref, 0x90, 32)) {
+ OPM_SymWInt(typ->size);
+ }
} else {
- OPM_SymWInt(((LONGINT)(34)));
+ OPM_SymWInt(34);
typ->ref = OPT_expCtxt.ref;
OPT_expCtxt.ref += 1;
if (OPT_expCtxt.ref >= 255) {
@@ -1404,7 +1617,7 @@ static void OPT_OutStr (OPT_Struct typ)
OPT_OutMod(typ->mno);
strobj = typ->strobj;
if ((strobj != NIL && strobj->name[0] != 0x00)) {
- OPT_OutName((void*)strobj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)strobj->name, 256);
switch (strobj->history) {
case 2:
OPT_FPrintErr(strobj, 252);
@@ -1422,31 +1635,31 @@ static void OPT_OutStr (OPT_Struct typ)
OPM_SymWCh(0x00);
}
if (typ->sysflag != 0) {
- OPM_SymWInt(((LONGINT)(35)));
+ OPM_SymWInt(35);
OPM_SymWInt(typ->sysflag);
}
switch (typ->form) {
- case 13:
- OPM_SymWInt(((LONGINT)(36)));
+ case 11:
+ OPM_SymWInt(36);
OPT_OutStr(typ->BaseTyp);
break;
- case 14:
- OPM_SymWInt(((LONGINT)(40)));
+ case 12:
+ OPM_SymWInt(40);
OPT_OutSign(typ->BaseTyp, typ->link);
break;
- case 15:
+ case 13:
switch (typ->comp) {
case 2:
- OPM_SymWInt(((LONGINT)(37)));
+ OPM_SymWInt(37);
OPT_OutStr(typ->BaseTyp);
OPM_SymWInt(typ->n);
break;
case 3:
- OPM_SymWInt(((LONGINT)(38)));
+ OPM_SymWInt(38);
OPT_OutStr(typ->BaseTyp);
break;
case 4:
- OPM_SymWInt(((LONGINT)(39)));
+ OPM_SymWInt(39);
if (typ->BaseTyp == NIL) {
OPT_OutStr(OPT_notyp);
} else {
@@ -1456,23 +1669,23 @@ static void OPT_OutStr (OPT_Struct typ)
OPM_SymWInt(typ->align);
OPM_SymWInt(typ->n);
OPT_nofhdfld = 0;
- OPT_OutFlds(typ->link, ((LONGINT)(0)), 1);
+ OPT_OutFlds(typ->link, 0, 1);
if (OPT_nofhdfld > 2048) {
OPM_Mark(223, typ->txtpos);
}
OPT_OutTProcs(typ, typ->link);
- OPM_SymWInt(((LONGINT)(18)));
+ OPM_SymWInt(18);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.comp = ", (LONGINT)39);
- OPM_LogWNum(typ->comp, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.comp = ", 39);
+ OPM_LogWNum(typ->comp, 0);
OPM_LogWLn();
break;
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.form = ", (LONGINT)39);
- OPM_LogWNum(typ->form, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.form = ", 39);
+ OPM_LogWNum(typ->form, 0);
OPM_LogWLn();
break;
}
@@ -1481,7 +1694,7 @@ static void OPT_OutStr (OPT_Struct typ)
static void OPT_OutConstant (OPT_Object obj)
{
- INTEGER f;
+ INT16 f;
REAL rval;
f = obj->typ->form;
OPM_SymWInt(f);
@@ -1489,23 +1702,25 @@ static void OPT_OutConstant (OPT_Object obj)
case 2: case 3:
OPM_SymWCh((CHAR)obj->conval->intval);
break;
- case 4: case 5: case 6:
+ case 4:
OPM_SymWInt(obj->conval->intval);
- break;
- case 9:
- OPM_SymWSet(obj->conval->setval);
+ OPM_SymWInt(obj->typ->size);
break;
case 7:
+ OPM_SymWSet(obj->conval->setval);
+ OPM_SymWInt(obj->typ->size);
+ break;
+ case 5:
rval = obj->conval->realval;
OPM_SymWReal(rval);
break;
- case 8:
+ case 6:
OPM_SymWLReal(obj->conval->realval);
break;
- case 10:
- OPT_OutName((void*)*obj->conval->ext, ((LONGINT)(256)));
+ case 8:
+ OPT_OutName((void*)*obj->conval->ext, 256);
break;
- case 11:
+ case 9:
break;
default:
OPT_err(127);
@@ -1515,11 +1730,11 @@ static void OPT_OutConstant (OPT_Object obj)
static void OPT_OutObj (OPT_Object obj)
{
- INTEGER i, j;
+ INT16 i, j;
OPT_ConstExt ext = NIL;
if (obj != NIL) {
OPT_OutObj(obj->left);
- if (__IN(obj->mode, 0x06ea)) {
+ if (__IN(obj->mode, 0x06ea, 32)) {
if (obj->history == 4) {
OPT_FPrintErr(obj, 250);
} else if (obj->vis != 0) {
@@ -1536,64 +1751,64 @@ static void OPT_OutObj (OPT_Object obj)
OPT_FPrintErr(obj, 251);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj^.history = ", (LONGINT)42);
- OPM_LogWNum(obj->history, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj^.history = ", 42);
+ OPM_LogWNum(obj->history, 0);
OPM_LogWLn();
break;
}
switch (obj->mode) {
case 3:
OPT_OutConstant(obj);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
break;
case 5:
if (obj->typ->strobj == obj) {
- OPM_SymWInt(((LONGINT)(19)));
+ OPM_SymWInt(19);
OPT_OutStr(obj->typ);
} else {
- OPM_SymWInt(((LONGINT)(20)));
+ OPM_SymWInt(20);
OPT_OutStr(obj->typ);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
}
break;
case 1:
if (obj->vis == 2) {
- OPM_SymWInt(((LONGINT)(22)));
+ OPM_SymWInt(22);
} else {
- OPM_SymWInt(((LONGINT)(21)));
+ OPM_SymWInt(21);
}
OPT_OutStr(obj->typ);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
if (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00) {
OPM_FPrint(&OPT_expCtxt.reffp, obj->typ->ref);
}
break;
case 7:
- OPM_SymWInt(((LONGINT)(31)));
+ OPM_SymWInt(31);
OPT_OutSign(obj->typ, obj->link);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
break;
case 10:
- OPM_SymWInt(((LONGINT)(32)));
+ OPM_SymWInt(32);
OPT_OutSign(obj->typ, obj->link);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
break;
case 9:
- OPM_SymWInt(((LONGINT)(33)));
+ OPM_SymWInt(33);
OPT_OutSign(obj->typ, obj->link);
ext = obj->conval->ext;
- j = (int)(*ext)[0];
+ j = (INT16)(*ext)[0];
i = 1;
OPM_SymWInt(j);
while (i <= j) {
- OPM_SymWCh((*ext)[__X(i, ((LONGINT)(256)))]);
+ OPM_SymWCh((*ext)[__X(i, 256)]);
i += 1;
}
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj.mode = ", (LONGINT)38);
- OPM_LogWNum(obj->mode, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj.mode = ", 38);
+ OPM_LogWNum(obj->mode, 0);
OPM_LogWLn();
break;
}
@@ -1605,8 +1820,8 @@ static void OPT_OutObj (OPT_Object obj)
void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
{
- INTEGER i;
- SHORTINT nofmod;
+ INT16 i;
+ INT8 nofmod;
BOOLEAN done;
OPT_symExtended = 0;
OPT_symNew = 0;
@@ -1614,25 +1829,22 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
OPT_Import((CHAR*)"@self", OPT_SelfName, &done);
OPT_nofGmod = nofmod;
if (OPM_noerr) {
- OPM_NewSym((void*)OPT_SelfName, ((LONGINT)(256)));
+ OPM_NewSym((void*)OPT_SelfName, 256);
if (OPM_noerr) {
- OPM_SymWInt(((LONGINT)(16)));
- OPT_OutName((void*)OPT_SelfName, ((LONGINT)(256)));
+ OPM_SymWInt(16);
+ OPT_OutName((void*)OPT_SelfName, 256);
OPT_expCtxt.reffp = 0;
- OPT_expCtxt.ref = 16;
+ OPT_expCtxt.ref = 14;
OPT_expCtxt.nofm = 1;
OPT_expCtxt.locmno[0] = 0;
i = 1;
while (i < 64) {
- OPT_expCtxt.locmno[__X(i, ((LONGINT)(64)))] = -1;
+ OPT_expCtxt.locmno[__X(i, 64)] = -1;
i += 1;
}
OPT_OutObj(OPT_topScope->right);
*ext = (OPT_sfpresent && OPT_symExtended);
- *new = !OPT_sfpresent || OPT_symNew;
- if (OPM_forceNewSym) {
- *new = 1;
- }
+ *new = (!OPT_sfpresent || OPT_symNew) || __IN(17, OPM_Options, 32);
if ((((OPM_noerr && OPT_sfpresent)) && OPT_impCtxt.reffp != OPT_expCtxt.reffp)) {
*new = 1;
if (!OPT_extsf) {
@@ -1648,11 +1860,11 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
}
}
-static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form)
+static void OPT_InitStruct (OPT_Struct *typ, INT8 form)
{
*typ = OPT_NewStr(form, 1);
(*typ)->ref = form;
- (*typ)->size = OPM_ByteSize;
+ (*typ)->size = 1;
(*typ)->allocated = 1;
(*typ)->strobj = OPT_NewObj();
(*typ)->pbfp = form;
@@ -1662,7 +1874,7 @@ static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form)
(*typ)->idfpdone = 1;
}
-static void OPT_EnterBoolConst (OPS_Name name, LONGINT value)
+static void OPT_EnterBoolConst (OPS_Name name, INT32 value)
{
OPT_Object obj = NIL;
OPS_Name name__copy;
@@ -1674,7 +1886,7 @@ static void OPT_EnterBoolConst (OPS_Name name, LONGINT value)
obj->conval->intval = value;
}
-static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct *res)
+static void OPT_EnterTyp (OPS_Name name, INT8 form, INT16 size, OPT_Struct *res)
{
OPT_Object obj = NIL;
OPT_Struct typ = NIL;
@@ -1694,10 +1906,25 @@ static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct
typ->fpdone = 1;
typ->idfp = form;
typ->idfpdone = 1;
+ if (__IN(form, 0x90, 32)) {
+ OPM_FPrint(&typ->idfp, typ->size);
+ }
*res = typ;
}
-static void OPT_EnterProc (OPS_Name name, INTEGER num)
+static void OPT_EnterTypeAlias (OPS_Name name, OPT_Object *res)
+{
+ OPT_Object obj = NIL;
+ OPS_Name name__copy;
+ __DUPARR(name, OPS_Name);
+ OPT_Insert(name, &obj);
+ obj->mode = 5;
+ obj->typ = NIL;
+ obj->vis = 1;
+ *res = obj;
+}
+
+static void OPT_EnterProc (OPS_Name name, INT16 num)
{
OPT_Object obj = NIL;
OPS_Name name__copy;
@@ -1712,26 +1939,39 @@ static void EnumPtrs(void (*P)(void*))
{
P(OPT_topScope);
P(OPT_undftyp);
+ P(OPT_niltyp);
+ P(OPT_notyp);
P(OPT_bytetyp);
+ P(OPT_cpbytetyp);
P(OPT_booltyp);
P(OPT_chartyp);
P(OPT_sinttyp);
P(OPT_inttyp);
P(OPT_linttyp);
+ P(OPT_hinttyp);
+ P(OPT_int8typ);
+ P(OPT_int16typ);
+ P(OPT_int32typ);
+ P(OPT_int64typ);
+ P(OPT_settyp);
+ P(OPT_set32typ);
+ P(OPT_set64typ);
P(OPT_realtyp);
P(OPT_lrltyp);
- P(OPT_settyp);
P(OPT_stringtyp);
- P(OPT_niltyp);
- P(OPT_notyp);
+ P(OPT_adrtyp);
P(OPT_sysptrtyp);
+ P(OPT_sintobj);
+ P(OPT_intobj);
+ P(OPT_lintobj);
+ P(OPT_setobj);
__ENUMP(OPT_GlbMod, 64, P);
P(OPT_universe);
P(OPT_syslink);
__ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 3140, 1, P);
}
-__TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 24), {0, -8}};
+__TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 32), {0, -8}};
__TDESC(OPT_ObjDesc, 1, 6) = {__TDFLDS("ObjDesc", 304), {0, 4, 8, 12, 284, 288, -28}};
__TDESC(OPT_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}};
@@ -1777,6 +2017,7 @@ export void *OPT__init(void)
__REGMOD("OPT", EnumPtrs);
__REGCMD("Close", OPT_Close);
__REGCMD("CloseScope", OPT_CloseScope);
+ __REGCMD("InitRecno", OPT_InitRecno);
__INITYP(OPT_ConstDesc, OPT_ConstDesc, 0);
__INITYP(OPT_ObjDesc, OPT_ObjDesc, 0);
__INITYP(OPT_StrDesc, OPT_StrDesc, 0);
@@ -1788,12 +2029,19 @@ export void *OPT__init(void)
OPT_OpenScope(0, NIL);
OPM_errpos = 0;
OPT_InitStruct(&OPT_undftyp, 0);
- OPT_InitStruct(&OPT_notyp, 12);
- OPT_InitStruct(&OPT_stringtyp, 10);
- OPT_InitStruct(&OPT_niltyp, 11);
OPT_undftyp->BaseTyp = OPT_undftyp;
- OPT_EnterTyp((CHAR*)"BYTE", 1, OPM_ByteSize, &OPT_bytetyp);
- OPT_EnterTyp((CHAR*)"PTR", 13, OPM_PointerSize, &OPT_sysptrtyp);
+ OPT_InitStruct(&OPT_notyp, 10);
+ OPT_InitStruct(&OPT_stringtyp, 8);
+ OPT_InitStruct(&OPT_niltyp, 9);
+ OPT_EnterTyp((CHAR*)"BYTE", 1, 1, &OPT_bytetyp);
+ OPT_EnterTyp((CHAR*)"PTR", 11, -1, &OPT_sysptrtyp);
+ OPT_EnterTyp((CHAR*)"ADDRESS", 4, -1, &OPT_adrtyp);
+ OPT_EnterTyp((CHAR*)"INT8", 4, 1, &OPT_int8typ);
+ OPT_EnterTyp((CHAR*)"INT16", 4, 2, &OPT_int16typ);
+ OPT_EnterTyp((CHAR*)"INT32", 4, 4, &OPT_int32typ);
+ OPT_EnterTyp((CHAR*)"INT64", 4, 8, &OPT_int64typ);
+ OPT_EnterTyp((CHAR*)"SET32", 7, 4, &OPT_set32typ);
+ OPT_EnterTyp((CHAR*)"SET64", 7, 8, &OPT_set64typ);
OPT_EnterProc((CHAR*)"ADR", 20);
OPT_EnterProc((CHAR*)"CC", 21);
OPT_EnterProc((CHAR*)"LSH", 22);
@@ -1809,16 +2057,18 @@ export void *OPT__init(void)
OPT_syslink = OPT_topScope->right;
OPT_universe = OPT_topScope;
OPT_topScope->right = NIL;
- OPT_EnterTyp((CHAR*)"BOOLEAN", 2, OPM_BoolSize, &OPT_booltyp);
- OPT_EnterTyp((CHAR*)"CHAR", 3, OPM_CharSize, &OPT_chartyp);
- OPT_EnterTyp((CHAR*)"SET", 9, OPM_SetSize, &OPT_settyp);
- OPT_EnterTyp((CHAR*)"REAL", 7, OPM_RealSize, &OPT_realtyp);
- OPT_EnterTyp((CHAR*)"INTEGER", 5, OPM_IntSize, &OPT_inttyp);
- OPT_EnterTyp((CHAR*)"LONGINT", 6, OPM_LIntSize, &OPT_linttyp);
- OPT_EnterTyp((CHAR*)"LONGREAL", 8, OPM_LRealSize, &OPT_lrltyp);
- OPT_EnterTyp((CHAR*)"SHORTINT", 4, OPM_SIntSize, &OPT_sinttyp);
- OPT_EnterBoolConst((CHAR*)"FALSE", ((LONGINT)(0)));
- OPT_EnterBoolConst((CHAR*)"TRUE", ((LONGINT)(1)));
+ OPT_EnterTyp((CHAR*)"BOOLEAN", 2, 1, &OPT_booltyp);
+ OPT_EnterTyp((CHAR*)"CHAR", 3, 1, &OPT_chartyp);
+ OPT_EnterTyp((CHAR*)"REAL", 5, 4, &OPT_realtyp);
+ OPT_EnterTyp((CHAR*)"LONGREAL", 6, 8, &OPT_lrltyp);
+ OPT_EnterTyp((CHAR*)"HUGEINT", 4, 8, &OPT_hinttyp);
+ OPT_EnterTyp((CHAR*)"BYTE@", 4, 1, &OPT_cpbytetyp);
+ OPT_EnterTypeAlias((CHAR*)"SHORTINT", &OPT_sintobj);
+ OPT_EnterTypeAlias((CHAR*)"INTEGER", &OPT_intobj);
+ OPT_EnterTypeAlias((CHAR*)"LONGINT", &OPT_lintobj);
+ OPT_EnterTypeAlias((CHAR*)"SET", &OPT_setobj);
+ OPT_EnterBoolConst((CHAR*)"FALSE", 0);
+ OPT_EnterBoolConst((CHAR*)"TRUE", 1);
OPT_EnterProc((CHAR*)"HALT", 0);
OPT_EnterProc((CHAR*)"NEW", 1);
OPT_EnterProc((CHAR*)"ABS", 2);
@@ -1844,15 +2094,13 @@ export void *OPT__init(void)
OPT_impCtxt.ref[1] = OPT_bytetyp;
OPT_impCtxt.ref[2] = OPT_booltyp;
OPT_impCtxt.ref[3] = OPT_chartyp;
- OPT_impCtxt.ref[4] = OPT_sinttyp;
- OPT_impCtxt.ref[5] = OPT_inttyp;
- OPT_impCtxt.ref[6] = OPT_linttyp;
- OPT_impCtxt.ref[7] = OPT_realtyp;
- OPT_impCtxt.ref[8] = OPT_lrltyp;
- OPT_impCtxt.ref[9] = OPT_settyp;
- OPT_impCtxt.ref[10] = OPT_stringtyp;
- OPT_impCtxt.ref[11] = OPT_niltyp;
- OPT_impCtxt.ref[12] = OPT_notyp;
- OPT_impCtxt.ref[13] = OPT_sysptrtyp;
+ OPT_impCtxt.ref[4] = OPT_int32typ;
+ OPT_impCtxt.ref[5] = OPT_realtyp;
+ OPT_impCtxt.ref[6] = OPT_lrltyp;
+ OPT_impCtxt.ref[7] = OPT_settyp;
+ OPT_impCtxt.ref[8] = OPT_stringtyp;
+ OPT_impCtxt.ref[9] = OPT_niltyp;
+ OPT_impCtxt.ref[10] = OPT_notyp;
+ OPT_impCtxt.ref[11] = OPT_sysptrtyp;
__ENDMOD;
}
diff --git a/bootstrap/unix-44/OPT.h b/bootstrap/unix-44/OPT.h
index 41b3e7ec..90fcacf5 100644
--- a/bootstrap/unix-44/OPT.h
+++ b/bootstrap/unix-44/OPT.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPT__h
#define OPT__h
@@ -15,8 +15,9 @@ typedef
typedef
struct OPT_ConstDesc {
OPT_ConstExt ext;
- LONGINT intval, intval2;
- SET setval;
+ INT64 intval;
+ INT32 intval2;
+ UINT64 setval;
LONGREAL realval;
} OPT_ConstDesc;
@@ -32,7 +33,7 @@ typedef
typedef
struct OPT_NodeDesc {
OPT_Node left, right, link;
- SHORTINT class, subcl;
+ INT8 class, subcl;
BOOLEAN readonly;
OPT_Struct typ;
OPT_Object obj;
@@ -44,44 +45,48 @@ typedef
OPT_Object left, right, link, scope;
OPS_Name name;
BOOLEAN leaf;
- SHORTINT mode, mnolev, vis, history;
+ INT8 mode, mnolev, vis, history;
BOOLEAN used, fpdone;
- LONGINT fprint;
+ INT32 fprint;
OPT_Struct typ;
OPT_Const conval;
- LONGINT adr, linkadr;
- INTEGER x;
+ INT32 adr, linkadr;
+ INT16 x;
} OPT_ObjDesc;
typedef
struct OPT_StrDesc {
- SHORTINT form, comp, mno, extlev;
- INTEGER ref, sysflag;
- LONGINT n, size, align, txtpos;
+ INT8 form, comp, mno, extlev;
+ INT16 ref, sysflag;
+ INT32 n, size, align, txtpos;
BOOLEAN allocated, pbused, pvused;
- char _prvt0[16];
+ char _prvt0[4];
+ INT32 idfp;
+ char _prvt1[8];
OPT_Struct BaseTyp;
OPT_Object link, strobj;
} OPT_StrDesc;
-import void (*OPT_typSize)(OPT_Struct);
import OPT_Object OPT_topScope;
-import OPT_Struct OPT_undftyp, OPT_bytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_realtyp, OPT_lrltyp, OPT_settyp, OPT_stringtyp, OPT_niltyp, OPT_notyp, OPT_sysptrtyp;
-import SHORTINT OPT_nofGmod;
+import OPT_Struct OPT_undftyp, OPT_niltyp, OPT_notyp, OPT_bytetyp, OPT_cpbytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_hinttyp, OPT_int8typ, OPT_int16typ, OPT_int32typ, OPT_int64typ, OPT_settyp, OPT_set32typ, OPT_set64typ, OPT_realtyp, OPT_lrltyp, OPT_stringtyp, OPT_adrtyp, OPT_sysptrtyp;
+import OPT_Object OPT_sintobj, OPT_intobj, OPT_lintobj, OPT_setobj;
+import INT8 OPT_nofGmod;
import OPT_Object OPT_GlbMod[64];
import OPS_Name OPT_SelfName;
import BOOLEAN OPT_SYSimported;
-import LONGINT *OPT_ConstDesc__typ;
-import LONGINT *OPT_ObjDesc__typ;
-import LONGINT *OPT_StrDesc__typ;
-import LONGINT *OPT_NodeDesc__typ;
+import ADDRESS *OPT_ConstDesc__typ;
+import ADDRESS *OPT_ObjDesc__typ;
+import ADDRESS *OPT_StrDesc__typ;
+import ADDRESS *OPT_NodeDesc__typ;
+import void OPT_Align (INT32 *adr, INT32 base);
+import INT32 OPT_BaseAlignment (OPT_Struct typ);
import void OPT_Close (void);
import void OPT_CloseScope (void);
import void OPT_Export (BOOLEAN *ext, BOOLEAN *new);
-import void OPT_FPrintErr (OPT_Object obj, INTEGER errcode);
+import void OPT_FPrintErr (OPT_Object obj, INT16 errcode);
import void OPT_FPrintObj (OPT_Object obj);
import void OPT_FPrintStr (OPT_Struct typ);
import void OPT_Find (OPT_Object *res);
@@ -89,16 +94,23 @@ import void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res);
import void OPT_FindImport (OPT_Object mod, OPT_Object *res);
import void OPT_IdFPrint (OPT_Struct typ);
import void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done);
-import void OPT_Init (OPS_Name name, SET opt);
+import void OPT_Init (OPS_Name name, UINT32 opt);
+import void OPT_InitRecno (void);
import void OPT_Insert (OPS_Name name, OPT_Object *obj);
import void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old);
+import INT16 OPT_IntSize (INT64 n);
+import OPT_Struct OPT_IntType (INT32 size);
import OPT_Const OPT_NewConst (void);
import OPT_ConstExt OPT_NewExt (void);
-import OPT_Node OPT_NewNode (SHORTINT class);
+import OPT_Node OPT_NewNode (INT8 class);
import OPT_Object OPT_NewObj (void);
-import OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp);
-import void OPT_OpenScope (SHORTINT level, OPT_Object owner);
+import OPT_Struct OPT_NewStr (INT8 form, INT8 comp);
+import void OPT_OpenScope (INT8 level, OPT_Object owner);
+import OPT_Struct OPT_SetType (INT32 size);
+import OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir);
+import INT32 OPT_SizeAlignment (INT32 size);
+import void OPT_TypSize (OPT_Struct typ);
import void *OPT__init(void);
-#endif
+#endif // OPT
diff --git a/bootstrap/unix-44/OPV.c b/bootstrap/unix-44/OPV.c
index cf646f5e..5c21cb97 100644
--- a/bootstrap/unix-44/OPV.c
+++ b/bootstrap/unix-44/OPV.c
@@ -1,4 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "OPC.h"
#include "OPM.h"
@@ -7,167 +13,66 @@
typedef
struct OPV_ExitInfo {
- INTEGER level, label;
+ INT16 level, label;
} OPV_ExitInfo;
-static BOOLEAN OPV_assert, OPV_inxchk, OPV_mainprog, OPV_ansi;
-static INTEGER OPV_stamp;
-static LONGINT OPV_recno;
+static INT16 OPV_stamp;
static OPV_ExitInfo OPV_exit;
-static INTEGER OPV_nofExitLabels;
-static BOOLEAN OPV_naturalAlignment;
+static INT16 OPV_nofExitLabels;
-export LONGINT *OPV_ExitInfo__typ;
+export ADDRESS *OPV_ExitInfo__typ;
static void OPV_ActualPar (OPT_Node n, OPT_Object fp);
export void OPV_AdrAndSize (OPT_Object topScope);
static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc);
-static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INTEGER prec);
+static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec);
static void OPV_DefineTDescs (OPT_Node n);
-static void OPV_Entier (OPT_Node n, INTEGER prec);
+static void OPV_Entier (OPT_Node n, INT16 prec);
static void OPV_GetTProcNum (OPT_Object obj);
static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc);
static BOOLEAN OPV_ImplicitReturn (OPT_Node n);
-static void OPV_Index (OPT_Node n, OPT_Node d, INTEGER prec, INTEGER dim);
+static void OPV_Index (OPT_Node n, OPT_Node d, INT16 prec, INT16 dim);
export void OPV_Init (void);
static void OPV_InitTDescs (OPT_Node n);
-static void OPV_Len (OPT_Node n, LONGINT dim);
+static void OPV_Len (OPT_Node n, INT64 dim);
export void OPV_Module (OPT_Node prog);
-static LONGINT OPV_NaturalAlignment (LONGINT size, LONGINT max);
static void OPV_NewArr (OPT_Node d, OPT_Node x);
-static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, INTEGER comp);
+static void OPV_ParIntLiteral (INT64 n, INT32 size);
+static INT16 OPV_Precedence (INT16 class, INT16 subclass, INT16 form, INT16 comp);
static BOOLEAN OPV_SideEffects (OPT_Node n);
-static void OPV_SizeCast (LONGINT size);
+static void OPV_SizeCast (OPT_Node n, INT32 to);
static void OPV_Stamp (OPS_Name s);
static OPT_Object OPV_SuperProc (OPT_Node n);
static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported);
static void OPV_TraverseRecord (OPT_Struct typ);
-export void OPV_TypSize (OPT_Struct typ);
static void OPV_TypeOf (OPT_Node n);
-static void OPV_design (OPT_Node n, INTEGER prec);
-static void OPV_expr (OPT_Node n, INTEGER prec);
+static void OPV_design (OPT_Node n, INT16 prec);
+static void OPV_expr (OPT_Node n, INT16 prec);
static void OPV_stat (OPT_Node n, OPT_Object outerProc);
-static LONGINT OPV_NaturalAlignment (LONGINT size, LONGINT max)
-{
- LONGINT _o_result;
- LONGINT i;
- if (size >= max) {
- _o_result = max;
- return _o_result;
- } else {
- i = 1;
- while (i < size) {
- i += i;
- }
- _o_result = i;
- return _o_result;
- }
- __RETCHK;
-}
-
-void OPV_TypSize (OPT_Struct typ)
-{
- INTEGER f, c;
- LONGINT offset, size, base, fbase, off0;
- OPT_Object fld = NIL;
- OPT_Struct btyp = NIL;
- if (typ == OPT_undftyp) {
- OPM_err(58);
- } else if (typ->size == -1) {
- f = typ->form;
- c = typ->comp;
- if (c == 4) {
- btyp = typ->BaseTyp;
- if (btyp == NIL) {
- offset = 0;
- base = OPC_SizeAlignment(OPM_RecSize);
- } else {
- OPV_TypSize(btyp);
- offset = btyp->size - (int)__ASHR(btyp->sysflag, 8);
- base = btyp->align;
- }
- fld = typ->link;
- while ((fld != NIL && fld->mode == 4)) {
- btyp = fld->typ;
- OPV_TypSize(btyp);
- size = btyp->size;
- fbase = OPC_BaseAlignment(btyp);
- OPC_Align(&offset, fbase);
- fld->adr = offset;
- offset += size;
- if (fbase > base) {
- base = fbase;
- }
- fld = fld->link;
- }
- off0 = offset;
- if (offset == 0) {
- offset = 1;
- }
- if (OPM_RecSize == 0) {
- base = OPV_NaturalAlignment(offset, OPC_SizeAlignment(OPM_RecSize));
- }
- OPC_Align(&offset, base);
- if ((typ->strobj == NIL && __MASK(typ->align, -65536) == 0)) {
- OPV_recno += 1;
- base += __ASHL(OPV_recno, 16);
- }
- typ->size = offset;
- typ->align = base;
- typ->sysflag = __MASK(typ->sysflag, -256) + (int)__ASHL(offset - off0, 8);
- } else if (c == 2) {
- OPV_TypSize(typ->BaseTyp);
- typ->size = typ->n * typ->BaseTyp->size;
- } else if (f == 13) {
- typ->size = OPM_PointerSize;
- if (typ->BaseTyp == OPT_undftyp) {
- OPM_Mark(128, typ->n);
- } else {
- OPV_TypSize(typ->BaseTyp);
- }
- } else if (f == 14) {
- typ->size = OPM_ProcSize;
- } else if (c == 3) {
- btyp = typ->BaseTyp;
- OPV_TypSize(btyp);
- if (btyp->comp == 3) {
- typ->size = btyp->size + 4;
- } else {
- typ->size = 8;
- }
- }
- }
-}
-
void OPV_Init (void)
{
OPV_stamp = 0;
- OPV_recno = 0;
OPV_nofExitLabels = 0;
- OPV_assert = __IN(7, OPM_opt);
- OPV_inxchk = __IN(0, OPM_opt);
- OPV_mainprog = __IN(10, OPM_opt);
- OPV_ansi = __IN(6, OPM_opt);
}
static void OPV_GetTProcNum (OPT_Object obj)
{
- LONGINT oldPos;
+ INT32 oldPos;
OPT_Struct typ = NIL;
OPT_Object redef = NIL;
oldPos = OPM_errpos;
OPM_errpos = obj->scope->adr;
typ = obj->link->typ;
- if (typ->form == 13) {
+ if (typ->form == 11) {
typ = typ->BaseTyp;
}
OPT_FindField(obj->name, typ->BaseTyp, &redef);
if (redef != NIL) {
obj->adr = __ASHL(__ASHR(redef->adr, 16), 16);
- if (!__IN(2, obj->conval->setval)) {
+ if (!__IN(2, obj->conval->setval, 64)) {
OPM_err(119);
}
} else {
@@ -191,37 +96,37 @@ static void OPV_TraverseRecord (OPT_Struct typ)
static void OPV_Stamp (OPS_Name s)
{
- INTEGER i, j, k;
+ INT16 i, j, k;
CHAR n[10];
OPV_stamp += 1;
i = 0;
j = OPV_stamp;
- while (s[__X(i, ((LONGINT)(256)))] != 0x00) {
+ while (s[__X(i, 256)] != 0x00) {
i += 1;
}
if (i > 25) {
i = 25;
}
- s[__X(i, ((LONGINT)(256)))] = '_';
- s[__X(i + 1, ((LONGINT)(256)))] = '_';
+ s[__X(i, 256)] = '_';
+ s[__X(i + 1, 256)] = '_';
i += 2;
k = 0;
do {
- n[__X(k, ((LONGINT)(10)))] = (CHAR)((int)__MOD(j, 10) + 48);
+ n[__X(k, 10)] = (CHAR)((int)__MOD(j, 10) + 48);
j = __DIV(j, 10);
k += 1;
} while (!(j == 0));
do {
k -= 1;
- s[__X(i, ((LONGINT)(256)))] = n[__X(k, ((LONGINT)(10)))];
+ s[__X(i, 256)] = n[__X(k, 10)];
i += 1;
} while (!(k == 0));
- s[__X(i, ((LONGINT)(256)))] = 0x00;
+ s[__X(i, 256)] = 0x00;
}
static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported)
{
- INTEGER mode;
+ INT16 mode;
OPT_Object scope = NIL;
OPT_Struct typ = NIL;
if (obj != NIL) {
@@ -234,8 +139,8 @@ static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exporte
mode = obj->mode;
if ((mode == 5 && (obj->vis != 0) == exported)) {
typ = obj->typ;
- OPV_TypSize(obj->typ);
- if (typ->form == 13) {
+ OPT_TypSize(obj->typ);
+ if (typ->form == 11) {
typ = typ->BaseTyp;
}
if (typ->comp == 4) {
@@ -244,21 +149,21 @@ static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exporte
} else if (mode == 13) {
OPV_GetTProcNum(obj);
} else if (mode == 1) {
- OPV_TypSize(obj->typ);
+ OPT_TypSize(obj->typ);
}
if (!exported) {
- if ((__IN(mode, 0x60) && obj->mnolev > 0)) {
+ if ((__IN(mode, 0x60, 32) && obj->mnolev > 0)) {
OPV_Stamp(obj->name);
}
- if (__IN(mode, 0x26)) {
+ if (__IN(mode, 0x26, 32)) {
obj->scope = outerScope;
- } else if (__IN(mode, 0x26c0)) {
+ } else if (__IN(mode, 0x26c0, 32)) {
if (obj->conval->setval == 0x0) {
OPM_err(129);
}
scope = obj->scope;
scope->leaf = 1;
- __COPY(obj->name, scope->name, ((LONGINT)(256)));
+ __COPY(obj->name, scope->name, 256);
OPV_Stamp(scope->name);
if (mode == 9) {
obj->adr = 1;
@@ -275,66 +180,66 @@ static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exporte
void OPV_AdrAndSize (OPT_Object topScope)
{
+ __ASSERT(OPT_sinttyp != NIL, 0);
+ __ASSERT(OPT_inttyp != NIL, 0);
+ __ASSERT(OPT_linttyp != NIL, 0);
OPM_errpos = topScope->adr;
topScope->leaf = 1;
OPV_Traverse(topScope->right, topScope, 1);
OPV_Traverse(topScope->right, topScope, 0);
OPT_chartyp->strobj->linkadr = 2;
+ OPT_cpbytetyp->strobj->linkadr = 2;
OPT_settyp->strobj->linkadr = 2;
OPT_realtyp->strobj->linkadr = 2;
- OPT_inttyp->strobj->linkadr = 2;
- OPT_linttyp->strobj->linkadr = 2;
+ OPT_adrtyp->strobj->linkadr = 2;
+ OPT_int8typ->strobj->linkadr = 2;
+ OPT_int16typ->strobj->linkadr = 2;
+ OPT_int32typ->strobj->linkadr = 2;
+ OPT_int64typ->strobj->linkadr = 2;
+ OPT_set32typ->strobj->linkadr = 2;
+ OPT_set64typ->strobj->linkadr = 2;
+ OPT_hinttyp->strobj->linkadr = 2;
OPT_lrltyp->strobj->linkadr = 2;
- OPT_sinttyp->strobj->linkadr = 2;
OPT_booltyp->strobj->linkadr = 2;
OPT_bytetyp->strobj->linkadr = 2;
OPT_sysptrtyp->strobj->linkadr = 2;
}
-static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, INTEGER comp)
+static INT16 OPV_Precedence (INT16 class, INT16 subclass, INT16 form, INT16 comp)
{
- INTEGER _o_result;
switch (class) {
case 7: case 0: case 2: case 4: case 9:
case 13:
- _o_result = 10;
- return _o_result;
+ return 10;
break;
case 5:
- if (__IN(3, OPM_opt)) {
- _o_result = 10;
- return _o_result;
+ if (__IN(3, OPM_Options, 32)) {
+ return 10;
} else {
- _o_result = 9;
- return _o_result;
+ return 9;
}
break;
case 1:
- if (__IN(comp, 0x0c)) {
- _o_result = 10;
- return _o_result;
+ if (__IN(comp, 0x0c, 32)) {
+ return 10;
} else {
- _o_result = 9;
- return _o_result;
+ return 9;
}
break;
case 3:
- _o_result = 9;
- return _o_result;
+ return 9;
break;
case 11:
switch (subclass) {
case 33: case 7: case 24: case 29: case 20:
- _o_result = 9;
- return _o_result;
+ return 9;
break;
case 16: case 21: case 22: case 23: case 25:
- _o_result = 10;
- return _o_result;
+ return 10;
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence OPT.Nmop, subclass = ", (LONGINT)55);
- OPM_LogWNum(subclass, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence OPT.Nmop, subclass = ", 55);
+ OPM_LogWNum(subclass, 0);
OPM_LogWLn();
break;
}
@@ -342,91 +247,75 @@ static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, IN
case 12:
switch (subclass) {
case 1:
- if (form == 9) {
- _o_result = 4;
- return _o_result;
+ if (form == 7) {
+ return 4;
} else {
- _o_result = 8;
- return _o_result;
+ return 8;
}
break;
case 2:
- if (form == 9) {
- _o_result = 3;
- return _o_result;
+ if (form == 7) {
+ return 3;
} else {
- _o_result = 8;
- return _o_result;
+ return 8;
}
break;
case 3: case 4:
- _o_result = 10;
- return _o_result;
+ return 10;
break;
case 6:
- if (form == 9) {
- _o_result = 2;
- return _o_result;
+ if (form == 7) {
+ return 2;
} else {
- _o_result = 7;
- return _o_result;
+ return 7;
}
break;
case 7:
- if (form == 9) {
- _o_result = 4;
- return _o_result;
+ if (form == 7) {
+ return 4;
} else {
- _o_result = 7;
- return _o_result;
+ return 7;
}
break;
case 11: case 12: case 13: case 14:
- _o_result = 6;
- return _o_result;
+ return 6;
break;
case 9: case 10:
- _o_result = 5;
- return _o_result;
+ return 5;
break;
case 5:
- _o_result = 1;
- return _o_result;
+ return 1;
break;
case 8:
- _o_result = 0;
- return _o_result;
+ return 0;
break;
case 19: case 15: case 17: case 18: case 26:
case 27: case 28:
- _o_result = 10;
- return _o_result;
+ return 10;
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence OPT.Ndop, subclass = ", (LONGINT)55);
- OPM_LogWNum(subclass, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence OPT.Ndop, subclass = ", 55);
+ OPM_LogWNum(subclass, 0);
OPM_LogWLn();
break;
}
break;
case 10:
- _o_result = 10;
- return _o_result;
+ return 10;
break;
case 8: case 6:
- _o_result = 12;
- return _o_result;
+ return 12;
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence, class = ", (LONGINT)43);
- OPM_LogWNum(class, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence, class = ", 43);
+ OPM_LogWNum(class, 0);
OPM_LogWLn();
break;
}
__RETCHK;
}
-static void OPV_Len (OPT_Node n, LONGINT dim)
+static void OPV_Len (OPT_Node n, INT64 dim)
{
while ((n->class == 4 && n->typ->comp == 3)) {
dim += 1;
@@ -434,7 +323,7 @@ static void OPV_Len (OPT_Node n, LONGINT dim)
}
if ((n->class == 3 && n->typ->comp == 3)) {
OPV_design(n->left, 10);
- OPM_WriteString((CHAR*)"->len[", (LONGINT)7);
+ OPM_WriteString((CHAR*)"->len[", 7);
OPM_WriteInt(dim);
OPM_Write(']');
} else {
@@ -444,21 +333,18 @@ static void OPV_Len (OPT_Node n, LONGINT dim)
static BOOLEAN OPV_SideEffects (OPT_Node n)
{
- BOOLEAN _o_result;
if (n != NIL) {
- _o_result = (n->class == 13 || OPV_SideEffects(n->left)) || OPV_SideEffects(n->right);
- return _o_result;
+ return (n->class == 13 || OPV_SideEffects(n->left)) || OPV_SideEffects(n->right);
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-static void OPV_Entier (OPT_Node n, INTEGER prec)
+static void OPV_Entier (OPT_Node n, INT16 prec)
{
- if (__IN(n->typ->form, 0x0180)) {
- OPM_WriteString((CHAR*)"__ENTIER(", (LONGINT)10);
+ if (__IN(n->typ->form, 0x60, 32)) {
+ OPM_WriteString((CHAR*)"__ENTIER(", 10);
OPV_expr(n, -1);
OPM_Write(')');
} else {
@@ -466,44 +352,49 @@ static void OPV_Entier (OPT_Node n, INTEGER prec)
}
}
-static void OPV_SizeCast (LONGINT size)
+static void OPV_SizeCast (OPT_Node n, INT32 to)
{
- if (size <= 4) {
- OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
+ if ((to < n->typ->size && __IN(2, OPM_Options, 32))) {
+ OPM_WriteString((CHAR*)"__SHORT", 8);
+ if (OPV_SideEffects(n)) {
+ OPM_Write('F');
+ }
+ OPM_Write('(');
+ OPV_Entier(n, -1);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPM_WriteInt(OPM_SignedMaximum(to) + 1);
+ OPM_Write(')');
} else {
- OPM_WriteString((CHAR*)"(SYSTEM_INT64)", (LONGINT)15);
+ if ((n->typ->size != to && (n->typ->size > 4 || to != 4))) {
+ OPM_WriteString((CHAR*)"(INT", 5);
+ OPM_WriteInt(__ASHL(to, 3));
+ OPM_WriteString((CHAR*)")", 2);
+ }
}
}
-static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INTEGER prec)
+static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec)
{
- INTEGER from, to;
+ INT16 from, to;
from = n->typ->form;
to = newtype->form;
- if (to == 9) {
- OPM_WriteString((CHAR*)"__SETOF(", (LONGINT)9);
- OPV_Entier(n, -1);
- OPM_Write(')');
- } else if (__IN(to, 0x70)) {
- if ((newtype->size < n->typ->size && __IN(2, OPM_opt))) {
- OPM_WriteString((CHAR*)"__SHORT", (LONGINT)8);
- if (OPV_SideEffects(n)) {
- OPM_Write('F');
- }
- OPM_Write('(');
- OPV_Entier(n, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPM_WriteInt(OPM_SignedMaximum(newtype->size) + 1);
- OPM_Write(')');
- } else {
- if (newtype->size != n->typ->size) {
- OPV_SizeCast(newtype->size);
- }
+ 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);
+ OPM_WriteString((CHAR*)",", 2);
+ OPM_WriteInt(__ASHL(newtype->size, 3));
+ OPM_Write(')');
}
+ } else if (to == 4) {
+ OPV_SizeCast(n, newtype->size);
+ OPV_Entier(n, 9);
} else if (to == 3) {
- if (__IN(2, OPM_opt)) {
- OPM_WriteString((CHAR*)"__CHR", (LONGINT)6);
+ if (__IN(2, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__CHR", 6);
if (OPV_SideEffects(n)) {
OPM_Write('F');
}
@@ -511,7 +402,7 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INTEGER prec)
OPV_Entier(n, -1);
OPM_Write(')');
} else {
- OPM_WriteString((CHAR*)"(CHAR)", (LONGINT)7);
+ OPM_WriteString((CHAR*)"(CHAR)", 7);
OPV_Entier(n, 9);
}
} else {
@@ -521,15 +412,15 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INTEGER prec)
static void OPV_TypeOf (OPT_Node n)
{
- if (n->typ->form == 13) {
- OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10);
+ if (n->typ->form == 11) {
+ OPM_WriteString((CHAR*)"__TYPEOF(", 10);
OPV_expr(n, -1);
OPM_Write(')');
- } else if (__IN(n->class, 0x15)) {
+ } else if (__IN(n->class, 0x15, 32)) {
OPC_Andent(n->typ);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
} else if (n->class == 3) {
- OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__TYPEOF(", 10);
OPV_expr(n->left, -1);
OPM_Write(')');
} else if (n->class == 5) {
@@ -541,35 +432,35 @@ static void OPV_TypeOf (OPT_Node n)
}
}
-static void OPV_Index (OPT_Node n, OPT_Node d, INTEGER prec, INTEGER dim)
+static void OPV_Index (OPT_Node n, OPT_Node d, INT16 prec, INT16 dim)
{
- if (!OPV_inxchk || (n->right->class == 7 && (n->right->conval->intval == 0 || n->left->typ->comp != 3))) {
+ if (!__IN(0, OPM_Options, 32) || (n->right->class == 7 && (n->right->conval->intval == 0 || n->left->typ->comp != 3))) {
OPV_expr(n->right, prec);
} else {
if (OPV_SideEffects(n->right)) {
- OPM_WriteString((CHAR*)"__XF(", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__XF(", 6);
} else {
- OPM_WriteString((CHAR*)"__X(", (LONGINT)5);
+ OPM_WriteString((CHAR*)"__X(", 5);
}
OPV_expr(n->right, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_Len(d, dim);
OPM_Write(')');
}
}
-static void OPV_design (OPT_Node n, INTEGER prec)
+static void OPV_design (OPT_Node n, INT16 prec)
{
OPT_Object obj = NIL;
OPT_Struct typ = NIL;
- INTEGER class, designPrec, comp;
+ INT16 class, designPrec, comp;
OPT_Node d = NIL, x = NIL;
- INTEGER dims, i, _for__27;
+ INT16 dims, i, _for__26;
comp = n->typ->comp;
obj = n->obj;
class = n->class;
designPrec = OPV_Precedence(class, n->subcl, n->typ->form, comp);
- if ((((((class == 0 && obj->mnolev > 0)) && (int)obj->mnolev != OPM_level)) && prec == 10)) {
+ if ((((((class == 0 && obj->mnolev > 0)) && (INT16)obj->mnolev != OPM_level)) && prec == 10)) {
designPrec = 9;
}
if (prec > designPrec) {
@@ -586,7 +477,7 @@ static void OPV_design (OPT_Node n, INTEGER prec)
OPC_CompleteIdent(n->obj);
break;
case 1:
- if (!__IN(comp, 0x0c)) {
+ if (!__IN(comp, 0x0c, 32)) {
OPM_Write('*');
}
OPC_CompleteIdent(n->obj);
@@ -594,7 +485,7 @@ static void OPV_design (OPT_Node n, INTEGER prec)
case 2:
if (n->left->class == 3) {
OPV_design(n->left->left, designPrec);
- OPM_WriteString((CHAR*)"->", (LONGINT)3);
+ OPM_WriteString((CHAR*)"->", 3);
} else {
OPV_design(n->left, designPrec);
OPM_Write('.');
@@ -604,7 +495,7 @@ static void OPV_design (OPT_Node n, INTEGER prec)
case 3:
if (n->typ->comp == 3) {
OPV_design(n->left, 10);
- OPM_WriteString((CHAR*)"->data", (LONGINT)7);
+ OPM_WriteString((CHAR*)"->data", 7);
} else {
OPM_Write('*');
OPV_design(n->left, designPrec);
@@ -631,25 +522,25 @@ static void OPV_design (OPT_Node n, INTEGER prec)
while (x != d) {
if (x->left != d) {
OPV_Index(x, d, 7, i);
- OPM_WriteString((CHAR*)" + ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" + ", 4);
OPV_Len(d, i);
- OPM_WriteString((CHAR*)" * (", (LONGINT)5);
+ OPM_WriteString((CHAR*)" * (", 5);
i -= 1;
} else {
OPV_Index(x, d, -1, i);
}
x = x->left;
}
- _for__27 = dims;
+ _for__26 = dims;
i = 1;
- while (i <= _for__27) {
+ while (i <= _for__26) {
OPM_Write(')');
i += 1;
}
if (n->typ->comp == 3) {
OPM_Write(')');
- while ((int)i < __ASHR(d->typ->size - 4, 2)) {
- OPM_WriteString((CHAR*)" * ", (LONGINT)4);
+ while (i < __ASHR(d->typ->size - 4, 2)) {
+ OPM_WriteString((CHAR*)" * ", 4);
OPV_Len(d, i);
i += 1;
}
@@ -665,35 +556,35 @@ static void OPV_design (OPT_Node n, INTEGER prec)
case 5:
typ = n->typ;
obj = n->left->obj;
- if (__IN(3, OPM_opt)) {
+ if (__IN(3, OPM_Options, 32)) {
if (typ->comp == 4) {
- OPM_WriteString((CHAR*)"__GUARDR(", (LONGINT)10);
- if ((int)obj->mnolev != OPM_level) {
- OPM_WriteStringVar((void*)obj->scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"__curr->", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__GUARDR(", 10);
+ if ((INT16)obj->mnolev != OPM_level) {
+ OPM_WriteStringVar((void*)obj->scope->name, 256);
+ OPM_WriteString((CHAR*)"__curr->", 9);
OPC_Ident(obj);
} else {
OPC_Ident(obj);
}
} else {
if (typ->BaseTyp->strobj == NIL) {
- OPM_WriteString((CHAR*)"__GUARDA(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__GUARDA(", 10);
} else {
- OPM_WriteString((CHAR*)"__GUARDP(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__GUARDP(", 10);
}
OPV_expr(n->left, -1);
typ = typ->BaseTyp;
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(typ->extlev);
OPM_Write(')');
} else {
if (typ->comp == 4) {
- OPM_WriteString((CHAR*)"*(", (LONGINT)3);
+ OPM_WriteString((CHAR*)"*(", 3);
OPC_Ident(typ->strobj);
- OPM_WriteString((CHAR*)"*)", (LONGINT)3);
+ OPM_WriteString((CHAR*)"*)", 3);
OPC_CompleteIdent(obj);
} else {
OPM_Write('(');
@@ -704,17 +595,17 @@ static void OPV_design (OPT_Node n, INTEGER prec)
}
break;
case 6:
- if (__IN(3, OPM_opt)) {
+ if (__IN(3, OPM_Options, 32)) {
if (n->left->class == 1) {
- OPM_WriteString((CHAR*)"__GUARDEQR(", (LONGINT)12);
+ OPM_WriteString((CHAR*)"__GUARDEQR(", 12);
OPC_CompleteIdent(n->left->obj);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_TypeOf(n->left);
} else {
- OPM_WriteString((CHAR*)"__GUARDEQP(", (LONGINT)12);
+ OPM_WriteString((CHAR*)"__GUARDEQP(", 12);
OPV_expr(n->left->left, -1);
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Ident(n->left->typ->strobj);
OPM_Write(')');
} else {
@@ -727,8 +618,8 @@ static void OPV_design (OPT_Node n, INTEGER prec)
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.design, class = ", (LONGINT)39);
- OPM_LogWNum(class, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.design, class = ", 39);
+ OPM_LogWNum(class, 0);
OPM_LogWLn();
break;
}
@@ -737,10 +628,15 @@ static void OPV_design (OPT_Node n, INTEGER prec)
}
}
+static void OPV_ParIntLiteral (INT64 n, INT32 size)
+{
+ OPM_WriteInt(n);
+}
+
static void OPV_ActualPar (OPT_Node n, OPT_Object fp)
{
OPT_Struct typ = NIL, aptyp = NIL;
- INTEGER comp, form, mode, prec, dim;
+ INT16 comp, form, mode, prec, dim;
OPM_Write('(');
while (n != NIL) {
typ = fp->typ;
@@ -751,81 +647,68 @@ static void OPV_ActualPar (OPT_Node n, OPT_Object fp)
if ((((mode == 2 && n->class == 11)) && n->subcl == 29)) {
OPM_Write('(');
OPC_Ident(n->typ->strobj);
- OPM_WriteString((CHAR*)"*)", (LONGINT)3);
+ OPM_WriteString((CHAR*)"*)", 3);
prec = 10;
}
- if (!__IN(n->typ->comp, 0x0c)) {
+ if (!__IN(n->typ->comp, 0x0c, 32)) {
if (mode == 2) {
- if ((OPV_ansi && typ != n->typ)) {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
+ if (typ != n->typ) {
+ OPM_WriteString((CHAR*)"(void*)", 8);
}
OPM_Write('&');
prec = 9;
- } else if (OPV_ansi) {
- if ((__IN(comp, 0x0c) && n->class == 7)) {
- OPM_WriteString((CHAR*)"(CHAR*)", (LONGINT)8);
- } else if ((((form == 13 && typ != n->typ)) && n->typ != OPT_niltyp)) {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
- }
} else {
- if ((__IN(form, 0x0180) && __IN(n->typ->form, 0x70))) {
- OPM_WriteString((CHAR*)"(double)", (LONGINT)9);
- prec = 9;
- } else if ((form == 6 && n->typ->form < 6)) {
- OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10);
- prec = 9;
+ if ((__IN(comp, 0x0c, 32) && n->class == 7)) {
+ OPM_WriteString((CHAR*)"(CHAR*)", 8);
+ } else if ((((form == 11 && typ != n->typ)) && n->typ != OPT_niltyp)) {
+ OPM_WriteString((CHAR*)"(void*)", 8);
}
}
- } else if (OPV_ansi) {
+ } else {
if ((((mode == 2 && typ != n->typ)) && prec == -1)) {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
+ OPM_WriteString((CHAR*)"(void*)", 8);
}
}
if ((((mode == 2 && n->class == 11)) && n->subcl == 29)) {
OPV_expr(n->left, prec);
- } else if ((((((form == 6 && n->class == 7)) && n->conval->intval <= OPM_SignedMaximum(OPM_IntSize))) && n->conval->intval >= OPM_SignedMinimum(OPM_IntSize))) {
- OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12);
- OPV_expr(n, prec);
- OPM_WriteString((CHAR*)"))", (LONGINT)3);
+ } else if ((form == 4 && n->class == 7)) {
+ OPV_ParIntLiteral(n->conval->intval, n->typ->size);
} else {
OPV_expr(n, prec);
}
if ((comp == 4 && mode == 2)) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_TypeOf(n);
} else if (comp == 3) {
if (n->class == 7) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10);
- OPM_WriteInt(n->conval->intval2);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPV_ParIntLiteral(n->conval->intval2, OPM_AddressSize);
} else {
aptyp = n->typ;
dim = 0;
while ((typ->comp == 3 && typ->BaseTyp->form != 1)) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_Len(n, dim);
typ = typ->BaseTyp;
aptyp = aptyp->BaseTyp;
dim += 1;
}
if ((typ->comp == 3 && typ->BaseTyp->form == 1)) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
while (aptyp->comp == 3) {
OPV_Len(n, dim);
- OPM_WriteString((CHAR*)" * ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" * ", 4);
dim += 1;
aptyp = aptyp->BaseTyp;
}
- OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12);
- OPM_WriteInt(aptyp->size);
- OPM_WriteString((CHAR*)"))", (LONGINT)3);
+ OPV_ParIntLiteral(aptyp->size, OPM_AddressSize);
}
}
}
n = n->link;
fp = fp->link;
if (n != NIL) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
}
}
OPM_Write(')');
@@ -833,21 +716,19 @@ static void OPV_ActualPar (OPT_Node n, OPT_Object fp)
static OPT_Object OPV_SuperProc (OPT_Node n)
{
- OPT_Object _o_result;
OPT_Object obj = NIL;
OPT_Struct typ = NIL;
typ = n->right->typ;
- if (typ->form == 13) {
+ if (typ->form == 11) {
typ = typ->BaseTyp;
}
OPT_FindField(n->left->obj->name, typ->BaseTyp, &obj);
- _o_result = obj;
- return _o_result;
+ return obj;
}
-static void OPV_expr (OPT_Node n, INTEGER prec)
+static void OPV_expr (OPT_Node n, INT16 prec)
{
- INTEGER class, subclass, form, exprPrec;
+ INT16 class, subclass, form, exprPrec;
OPT_Struct typ = NIL;
OPT_Node l = NIL, r = NIL;
OPT_Object proc = NIL;
@@ -857,7 +738,7 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
l = n->left;
r = n->right;
exprPrec = OPV_Precedence(class, subclass, form, n->typ->comp);
- if ((exprPrec <= prec && __IN(class, 0x3ce0))) {
+ if ((exprPrec <= prec && __IN(class, 0x3ce0, 32))) {
OPM_Write('(');
}
switch (class) {
@@ -865,10 +746,12 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPC_Constant(n->conval, form);
break;
case 10:
- OPM_WriteString((CHAR*)"__SETRNG(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__SETRNG(", 10);
OPV_expr(l, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(r, -1);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPM_WriteInt(__ASHL(n->typ->size, 3));
OPM_Write(')');
break;
case 11:
@@ -878,7 +761,7 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPV_expr(l, exprPrec);
break;
case 7:
- if (form == 9) {
+ if (form == 7) {
OPM_Write('~');
} else {
OPM_Write('-');
@@ -888,16 +771,16 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
case 16:
typ = n->obj->typ;
if (l->typ->comp == 4) {
- OPM_WriteString((CHAR*)"__IS(", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__IS(", 6);
OPC_TypeOf(l->obj);
} else {
- OPM_WriteString((CHAR*)"__ISP(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__ISP(", 7);
OPV_expr(l, -1);
typ = typ->BaseTyp;
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(typ->extlev);
OPM_Write(')');
break;
@@ -906,54 +789,54 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
break;
case 21:
if (OPV_SideEffects(l)) {
- if (l->typ->form < 7) {
- if (l->typ->form < 6) {
- OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
+ if (l->typ->form < 5) {
+ if (l->typ->size <= 4) {
+ OPM_WriteString((CHAR*)"(int)", 6);
}
- OPM_WriteString((CHAR*)"__ABSF(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ABSF(", 8);
} else {
- OPM_WriteString((CHAR*)"__ABSFD(", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__ABSFD(", 9);
}
} else {
- OPM_WriteString((CHAR*)"__ABS(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__ABS(", 7);
}
OPV_expr(l, -1);
OPM_Write(')');
break;
case 22:
- OPM_WriteString((CHAR*)"__CAP(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__CAP(", 7);
OPV_expr(l, -1);
OPM_Write(')');
break;
case 23:
- OPM_WriteString((CHAR*)"__ODD(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__ODD(", 7);
OPV_expr(l, -1);
OPM_Write(')');
break;
case 24:
- OPM_WriteString((CHAR*)"(LONGINT)(SYSTEM_ADDRESS)", (LONGINT)26);
+ OPM_WriteString((CHAR*)"(ADDRESS)", 10);
if (l->class == 1) {
OPC_CompleteIdent(l->obj);
} else {
- if ((l->typ->form != 10 && !__IN(l->typ->comp, 0x0c))) {
+ if ((l->typ->form != 8 && !__IN(l->typ->comp, 0x0c, 32))) {
OPM_Write('&');
}
OPV_expr(l, exprPrec);
}
break;
case 29:
- if (!__IN(l->class, 0x17) || (((__IN(n->typ->form, 0x6240) && __IN(l->typ->form, 0x6240))) && n->typ->size == l->typ->size)) {
+ if (!__IN(l->class, 0x17, 32) || (((__IN(n->typ->form, 0x1890, 32) && __IN(l->typ->form, 0x1890, 32))) && n->typ->size == l->typ->size)) {
OPM_Write('(');
OPC_Ident(n->typ->strobj);
OPM_Write(')');
- if (__IN(n->typ->form, 0x6000) || __IN(l->typ->form, 0x6000)) {
- OPM_WriteString((CHAR*)"(SYSTEM_ADDRESS)", (LONGINT)17);
+ if (__IN(n->typ->form, 0x1800, 32) || __IN(l->typ->form, 0x1800, 32)) {
+ OPM_WriteString((CHAR*)"(ADDRESS)", 10);
}
OPV_expr(l, exprPrec);
} else {
- OPM_WriteString((CHAR*)"__VAL(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__VAL(", 7);
OPC_Ident(n->typ->strobj);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(l, -1);
OPM_Write(')');
}
@@ -972,94 +855,98 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
case 28: case 3: case 4:
switch (subclass) {
case 15:
- OPM_WriteString((CHAR*)"__IN(", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__IN(", 6);
break;
case 17:
if (r->class == 7) {
if (r->conval->intval >= 0) {
- OPM_WriteString((CHAR*)"__ASHL(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ASHL(", 8);
} else {
- OPM_WriteString((CHAR*)"__ASHR(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ASHR(", 8);
}
} else if (OPV_SideEffects(r)) {
- OPM_WriteString((CHAR*)"__ASHF(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ASHF(", 8);
} else {
- OPM_WriteString((CHAR*)"__ASH(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__ASH(", 7);
}
break;
case 18:
- OPM_WriteString((CHAR*)"__MASK(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__MASK(", 8);
break;
case 26:
- OPM_WriteString((CHAR*)"__BIT(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__BIT(", 7);
break;
case 27:
if (r->class == 7) {
if (r->conval->intval >= 0) {
- OPM_WriteString((CHAR*)"__LSHL(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__LSHL(", 8);
} else {
- OPM_WriteString((CHAR*)"__LSHR(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__LSHR(", 8);
}
} else {
- OPM_WriteString((CHAR*)"__LSH(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__LSH(", 7);
}
break;
case 28:
if (r->class == 7) {
if (r->conval->intval >= 0) {
- OPM_WriteString((CHAR*)"__ROTL(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ROTL(", 8);
} else {
- OPM_WriteString((CHAR*)"__ROTR(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ROTR(", 8);
}
} else {
- OPM_WriteString((CHAR*)"__ROT(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__ROT(", 7);
}
break;
case 3:
if (OPV_SideEffects(n)) {
- if (form < 6) {
- OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
+ if (n->typ->size <= 4) {
+ OPM_WriteString((CHAR*)"(int)", 6);
}
- OPM_WriteString((CHAR*)"__DIVF(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__DIVF(", 8);
} else {
- OPM_WriteString((CHAR*)"__DIV(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__DIV(", 7);
}
break;
case 4:
- if (form < 6) {
- OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
+ if (n->typ->size <= 4) {
+ OPM_WriteString((CHAR*)"(int)", 6);
}
if (OPV_SideEffects(n)) {
- OPM_WriteString((CHAR*)"__MODF(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__MODF(", 8);
} else {
- OPM_WriteString((CHAR*)"__MOD(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__MOD(", 7);
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", (LONGINT)40);
- OPM_LogWNum(subclass, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", 40);
+ OPM_LogWNum(subclass, 0);
OPM_LogWLn();
break;
}
OPV_expr(l, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- if ((((__IN(subclass, 0x18020000) && r->class == 7)) && r->conval->intval < 0)) {
+ OPM_WriteString((CHAR*)", ", 3);
+ if ((((__IN(subclass, 0x18020000, 32) && r->class == 7)) && r->conval->intval < 0)) {
OPM_WriteInt(-r->conval->intval);
} else {
OPV_expr(r, -1);
}
- if (__IN(subclass, 0x18000000)) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPC_Ident(l->typ->strobj);
+ if (__IN(subclass, 0x18008000, 32)) {
+ OPM_WriteString((CHAR*)", ", 3);
+ if (subclass == 15) {
+ OPM_WriteInt(__ASHL(r->typ->size, 3));
+ } else {
+ OPM_WriteInt(__ASHL(l->typ->size, 3));
+ }
}
OPM_Write(')');
break;
case 9: case 10: case 11: case 12: case 13:
case 14:
- if (__IN(l->typ->form, 0x8400)) {
- OPM_WriteString((CHAR*)"__STRCMP(", (LONGINT)10);
+ if (__IN(l->typ->form, 0x2100, 32)) {
+ OPM_WriteString((CHAR*)"__STRCMP(", 10);
OPV_expr(l, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(r, -1);
OPM_Write(')');
OPC_Cmp(subclass);
@@ -1068,31 +955,31 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPV_expr(l, exprPrec);
OPC_Cmp(subclass);
typ = l->typ;
- if ((((((typ->form == 13 && r->typ->form != 11)) && r->typ != typ)) && r->typ != OPT_sysptrtyp)) {
- OPM_WriteString((CHAR*)"(void *) ", (LONGINT)10);
+ if ((((((typ->form == 11 && r->typ->form != 9)) && r->typ != typ)) && r->typ != OPT_sysptrtyp)) {
+ OPM_WriteString((CHAR*)"(void *) ", 10);
}
OPV_expr(r, exprPrec);
}
break;
default:
- if (subclass == 5 || (form == 9 && (subclass == 1 || subclass == 7))) {
+ if (subclass == 5 || (form == 7 && (subclass == 1 || subclass == 7))) {
OPM_Write('(');
}
OPV_expr(l, exprPrec);
switch (subclass) {
case 1:
- if (form == 9) {
- OPM_WriteString((CHAR*)" & ", (LONGINT)4);
+ if (form == 7) {
+ OPM_WriteString((CHAR*)" & ", 4);
} else {
- OPM_WriteString((CHAR*)" * ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" * ", 4);
}
break;
case 2:
- if (form == 9) {
- OPM_WriteString((CHAR*)" ^ ", (LONGINT)4);
+ if (form == 7) {
+ OPM_WriteString((CHAR*)" ^ ", 4);
} else {
- OPM_WriteString((CHAR*)" / ", (LONGINT)4);
- if (r->obj == NIL || __IN(r->obj->typ->form, 0x70)) {
+ OPM_WriteString((CHAR*)" / ", 4);
+ if (r->obj == NIL || r->obj->typ->form == 4) {
OPM_Write('(');
OPC_Ident(n->typ->strobj);
OPM_Write(')');
@@ -1100,33 +987,33 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
}
break;
case 5:
- OPM_WriteString((CHAR*)" && ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" && ", 5);
break;
case 6:
- if (form == 9) {
- OPM_WriteString((CHAR*)" | ", (LONGINT)4);
+ if (form == 7) {
+ OPM_WriteString((CHAR*)" | ", 4);
} else {
- OPM_WriteString((CHAR*)" + ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" + ", 4);
}
break;
case 7:
- if (form == 9) {
- OPM_WriteString((CHAR*)" & ~", (LONGINT)5);
+ if (form == 7) {
+ OPM_WriteString((CHAR*)" & ~", 5);
} else {
- OPM_WriteString((CHAR*)" - ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" - ", 4);
}
break;
case 8:
- OPM_WriteString((CHAR*)" || ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" || ", 5);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", (LONGINT)40);
- OPM_LogWNum(subclass, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", 40);
+ OPM_LogWNum(subclass, 0);
OPM_LogWLn();
break;
}
OPV_expr(r, exprPrec);
- if (subclass == 5 || (form == 9 && (subclass == 1 || subclass == 7))) {
+ if (subclass == 5 || (form == 7 && (subclass == 1 || subclass == 7))) {
OPM_Write(')');
}
break;
@@ -1137,7 +1024,7 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
if (l->subcl == 1) {
proc = OPV_SuperProc(n);
} else {
- OPM_WriteString((CHAR*)"__", (LONGINT)3);
+ OPM_WriteString((CHAR*)"__", 3);
proc = OPC_BaseTProc(l->obj);
}
OPC_Ident(proc);
@@ -1153,7 +1040,7 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPV_design(n, prec);
break;
}
- if ((exprPrec <= prec && __IN(class, 0x3ca0))) {
+ if ((exprPrec <= prec && __IN(class, 0x3ca0, 32))) {
OPM_Write(')');
}
}
@@ -1163,10 +1050,10 @@ static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc)
OPT_Node if_ = NIL;
OPT_Object obj = NIL;
OPT_Struct typ = NIL;
- LONGINT adr;
+ INT32 adr;
if_ = n->left;
while (if_ != NIL) {
- OPM_WriteString((CHAR*)"if ", (LONGINT)4);
+ OPM_WriteString((CHAR*)"if ", 4);
OPV_expr(if_->left, 12);
OPM_Write(' ');
OPC_BegBlk();
@@ -1177,9 +1064,9 @@ static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc)
if (typ->comp == 4) {
OPC_BegStat();
OPC_Ident(if_->left->obj);
- OPM_WriteString((CHAR*)" *", (LONGINT)3);
- OPM_WriteString(obj->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"__ = (void*)", (LONGINT)13);
+ OPM_WriteString((CHAR*)" *", 3);
+ OPM_WriteString(obj->name, 256);
+ OPM_WriteString((CHAR*)"__ = (void*)", 13);
obj->adr = 0;
OPC_CompleteIdent(obj);
OPC_EndStat();
@@ -1195,13 +1082,13 @@ static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc)
if_ = if_->link;
if ((if_ != NIL || n->right != NIL) || withtrap) {
OPC_EndBlk0();
- OPM_WriteString((CHAR*)" else ", (LONGINT)7);
+ OPM_WriteString((CHAR*)" else ", 7);
} else {
OPC_EndBlk();
}
}
if (withtrap) {
- OPM_WriteString((CHAR*)"__WITHCHK", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__WITHCHK", 10);
OPC_EndStat();
} else if (n->right != NIL) {
OPC_BegBlk();
@@ -1213,9 +1100,9 @@ static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc)
static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc)
{
OPT_Node switchCase = NIL, label = NIL;
- LONGINT low, high;
- INTEGER form, i;
- OPM_WriteString((CHAR*)"switch ", (LONGINT)8);
+ INT64 low, high;
+ INT16 form, i;
+ OPM_WriteString((CHAR*)"switch ", 8);
OPV_expr(n->left, 12);
OPM_Write(' ');
OPC_BegBlk();
@@ -1247,22 +1134,22 @@ static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc)
OPC_Indent(1);
OPV_stat(switchCase->right, outerProc);
OPC_BegStat();
- OPM_WriteString((CHAR*)"break", (LONGINT)6);
+ OPM_WriteString((CHAR*)"break", 6);
OPC_EndStat();
OPC_Indent(-1);
switchCase = switchCase->link;
}
OPC_BegStat();
- OPM_WriteString((CHAR*)"default: ", (LONGINT)10);
+ OPM_WriteString((CHAR*)"default: ", 10);
if (n->right->conval->setval != 0x0) {
OPC_Indent(1);
OPM_WriteLn();
OPV_stat(n->right->right, outerProc);
OPC_BegStat();
- OPM_WriteString((CHAR*)"break", (LONGINT)6);
+ OPM_WriteString((CHAR*)"break", 6);
OPC_Indent(-1);
} else {
- OPM_WriteString((CHAR*)"__CASECHK", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__CASECHK", 10);
}
OPC_EndStat();
OPC_EndBlk();
@@ -1270,18 +1157,16 @@ static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc)
static BOOLEAN OPV_ImplicitReturn (OPT_Node n)
{
- BOOLEAN _o_result;
while ((n != NIL && n->class != 26)) {
n = n->link;
}
- _o_result = n == NIL;
- return _o_result;
+ return n == NIL;
}
static void OPV_NewArr (OPT_Node d, OPT_Node x)
{
OPT_Struct typ = NIL, base = NIL;
- INTEGER nofdim, nofdyn;
+ INT16 nofdim, nofdyn;
typ = d->typ->BaseTyp;
base = typ;
nofdim = 0;
@@ -1292,44 +1177,40 @@ static void OPV_NewArr (OPT_Node d, OPT_Node x)
base = base->BaseTyp;
}
OPV_design(d, -1);
- OPM_WriteString((CHAR*)" = __NEWARR(", (LONGINT)13);
+ OPM_WriteString((CHAR*)" = __NEWARR(", 13);
while (base->comp == 2) {
nofdim += 1;
base = base->BaseTyp;
}
if ((base->comp == 4 && OPC_NofPtrs(base) != 0)) {
OPC_Ident(base->strobj);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
- } else if (base->form == 13) {
- OPM_WriteString((CHAR*)"POINTER__typ", (LONGINT)13);
+ OPM_WriteString((CHAR*)"__typ", 6);
+ } else if (base->form == 11) {
+ OPM_WriteString((CHAR*)"POINTER__typ", 13);
} else {
- OPM_WriteString((CHAR*)"NIL", (LONGINT)4);
+ OPM_WriteString((CHAR*)"NIL", 4);
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12);
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(base->size);
- OPM_WriteString((CHAR*)"))", (LONGINT)3);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPM_WriteInt(OPC_BaseAlignment(base));
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPM_WriteInt(OPT_BaseAlignment(base));
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(nofdim);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(nofdyn);
while (typ != base) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
if (typ->comp == 3) {
if (x->class == 7) {
- OPM_WriteString((CHAR*)"(LONGINT)(", (LONGINT)11);
- OPV_expr(x, -1);
- OPM_WriteString((CHAR*)")", (LONGINT)2);
+ OPC_IntLiteral(x->conval->intval, OPM_AddressSize);
} else {
- OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10);
+ OPM_WriteString((CHAR*)"((ADDRESS)(", 12);
OPV_expr(x, 10);
+ OPM_WriteString((CHAR*)"))", 3);
}
x = x->link;
} else {
- OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10);
- OPM_WriteInt(typ->n);
+ OPC_IntLiteral(typ->n, OPM_AddressSize);
}
typ = typ->BaseTyp;
}
@@ -1358,7 +1239,7 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPV_ExitInfo saved;
OPT_Node l = NIL, r = NIL;
while ((n != NIL && OPM_noerr)) {
- OPM_errpos = n->conval->intval;
+ OPM_errpos = OPM_Longint(n->conval->intval);
if (n->class != 14) {
OPC_BegStat();
}
@@ -1372,7 +1253,7 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPV_DefineTDescs(n->right);
OPC_EnterBody();
OPV_InitTDescs(n->right);
- OPM_WriteString((CHAR*)"/* BEGIN */", (LONGINT)12);
+ OPM_WriteString((CHAR*)"/* BEGIN */", 12);
OPM_WriteLn();
OPV_stat(n->right, outerProc);
OPC_ExitBody();
@@ -1398,11 +1279,11 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
l = n->left;
r = n->right;
if (l->typ->comp == 2) {
- OPM_WriteString((CHAR*)"__MOVE(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__MOVE(", 8);
OPV_expr(r, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(l, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
if (r->typ == OPT_stringtyp) {
OPM_WriteInt(r->conval->intval2);
} else {
@@ -1410,30 +1291,30 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
}
OPM_Write(')');
} else {
- if ((((((l->typ->form == 13 && l->obj != NIL)) && l->obj->adr == 1)) && l->obj->mode == 1)) {
+ if ((((((l->typ->form == 11 && l->obj != NIL)) && l->obj->adr == 1)) && l->obj->mode == 1)) {
l->obj->adr = 0;
OPV_design(l, -1);
l->obj->adr = 1;
- if (r->typ->form != 11) {
- OPM_WriteString((CHAR*)" = (void*)", (LONGINT)11);
+ if (r->typ->form != 9) {
+ OPM_WriteString((CHAR*)" = (void*)", 11);
} else {
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" = ", 4);
}
} else {
OPV_design(l, -1);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" = ", 4);
}
if (l->typ == r->typ) {
OPV_expr(r, -1);
- } else if ((((l->typ->form == 13 && r->typ->form != 11)) && l->typ->strobj != NIL)) {
+ } else if ((((l->typ->form == 11 && r->typ->form != 9)) && l->typ->strobj != NIL)) {
OPM_Write('(');
OPC_Ident(l->typ->strobj);
OPM_Write(')');
OPV_expr(r, -1);
} else if (l->typ->comp == 4) {
- OPM_WriteString((CHAR*)"*(", (LONGINT)3);
+ OPM_WriteString((CHAR*)"*(", 3);
OPC_Andent(l->typ);
- OPM_WriteString((CHAR*)"*)&", (LONGINT)4);
+ OPM_WriteString((CHAR*)"*)&", 4);
OPV_expr(r, 9);
} else {
OPV_expr(r, -1);
@@ -1442,12 +1323,12 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
break;
case 1:
if (n->left->typ->BaseTyp->comp == 4) {
- OPM_WriteString((CHAR*)"__NEW(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__NEW(", 7);
OPV_design(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Andent(n->left->typ->BaseTyp);
- OPM_WriteString((CHAR*)")", (LONGINT)2);
- } else if (__IN(n->left->typ->BaseTyp->comp, 0x0c)) {
+ OPM_WriteString((CHAR*)")", 2);
+ } else if (__IN(n->left->typ->BaseTyp->comp, 0x0c, 32)) {
OPV_NewArr(n->left, n->right);
}
break;
@@ -1459,43 +1340,45 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
case 15: case 16:
OPV_expr(n->left, -1);
OPC_SetInclude(n->subcl == 16);
- OPM_WriteString((CHAR*)"__SETOF(", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__SETOF(", 9);
OPV_expr(n->right, -1);
+ OPM_WriteString((CHAR*)",", 2);
+ OPM_WriteInt(__ASHL(n->left->typ->size, 3));
OPM_Write(')');
break;
case 18:
- OPM_WriteString((CHAR*)"__COPY(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__COPY(", 8);
OPV_expr(n->right, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPV_Len(n->left, ((LONGINT)(0)));
+ OPM_WriteString((CHAR*)", ", 3);
+ OPV_Len(n->left, 0);
OPM_Write(')');
break;
case 31:
- OPM_WriteString((CHAR*)"__MOVE(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__MOVE(", 8);
OPV_expr(n->right, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->right->link, -1);
OPM_Write(')');
break;
case 24:
- OPM_WriteString((CHAR*)"__GET(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__GET(", 7);
OPV_expr(n->right, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Ident(n->left->typ->strobj);
OPM_Write(')');
break;
case 25:
- OPM_WriteString((CHAR*)"__PUT(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__PUT(", 7);
OPV_expr(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->right, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Ident(n->right->typ->strobj);
OPM_Write(')');
break;
@@ -1503,15 +1386,15 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPM_err(200);
break;
case 30:
- OPM_WriteString((CHAR*)"__SYSNEW(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__SYSNEW(", 10);
OPV_design(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->right, -1);
OPM_Write(')');
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.subcl = ", (LONGINT)40);
- OPM_LogWNum(n->subcl, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.subcl = ", 40);
+ OPM_LogWNum(n->subcl, 0);
OPM_LogWLn();
break;
}
@@ -1521,7 +1404,7 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
if (n->left->subcl == 1) {
proc = OPV_SuperProc(n);
} else {
- OPM_WriteString((CHAR*)"__", (LONGINT)3);
+ OPM_WriteString((CHAR*)"__", 3);
proc = OPC_BaseTProc(n->left->obj);
}
OPC_Ident(proc);
@@ -1536,10 +1419,10 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
case 20:
if (n->subcl != 32) {
OPV_IfStat(n, 0, outerProc);
- } else if (OPV_assert) {
- OPM_WriteString((CHAR*)"__ASSERT(", (LONGINT)10);
+ } else if (__IN(7, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__ASSERT(", 10);
OPV_expr(n->left->left->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(n->left->right->right->conval->intval);
OPM_Write(')');
OPC_EndStat();
@@ -1552,7 +1435,7 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
break;
case 22:
OPV_exit.level += 1;
- OPM_WriteString((CHAR*)"while ", (LONGINT)7);
+ OPM_WriteString((CHAR*)"while ", 7);
OPV_expr(n->left, 12);
OPM_Write(' ');
OPC_BegBlk();
@@ -1562,11 +1445,11 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
break;
case 23:
OPV_exit.level += 1;
- OPM_WriteString((CHAR*)"do ", (LONGINT)4);
+ OPM_WriteString((CHAR*)"do ", 4);
OPC_BegBlk();
OPV_stat(n->left, outerProc);
OPC_EndBlk0();
- OPM_WriteString((CHAR*)" while (!", (LONGINT)10);
+ OPM_WriteString((CHAR*)" while (!", 10);
OPV_expr(n->right, 9);
OPM_Write(')');
OPV_exit.level -= 1;
@@ -1575,13 +1458,13 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
saved = OPV_exit;
OPV_exit.level = 0;
OPV_exit.label = -1;
- OPM_WriteString((CHAR*)"for (;;) ", (LONGINT)10);
+ OPM_WriteString((CHAR*)"for (;;) ", 10);
OPC_BegBlk();
OPV_stat(n->left, outerProc);
OPC_EndBlk();
if (OPV_exit.label != -1) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"exit__", (LONGINT)7);
+ OPM_WriteString((CHAR*)"exit__", 7);
OPM_WriteInt(OPV_exit.label);
OPM_Write(':');
OPC_EndStat();
@@ -1590,39 +1473,48 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
break;
case 25:
if (OPV_exit.level == 0) {
- OPM_WriteString((CHAR*)"break", (LONGINT)6);
+ OPM_WriteString((CHAR*)"break", 6);
} else {
if (OPV_exit.label == -1) {
OPV_exit.label = OPV_nofExitLabels;
OPV_nofExitLabels += 1;
}
- OPM_WriteString((CHAR*)"goto exit__", (LONGINT)12);
+ OPM_WriteString((CHAR*)"goto exit__", 12);
OPM_WriteInt(OPV_exit.label);
}
break;
case 26:
if (OPM_level == 0) {
- if (OPV_mainprog) {
- OPM_WriteString((CHAR*)"__FINI", (LONGINT)7);
+ if (__IN(10, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__FINI", 7);
} else {
- OPM_WriteString((CHAR*)"__ENDMOD", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__ENDMOD", 9);
}
+ } else if (OPC_NeedsRetval(outerProc)) {
+ OPM_WriteString((CHAR*)"__retval = ", 12);
+ if ((n->left->typ->form == 11 && n->obj->typ != n->left->typ)) {
+ OPM_WriteString((CHAR*)"(void*)", 8);
+ OPV_expr(n->left, 10);
+ } else {
+ OPV_expr(n->left, -1);
+ }
+ OPC_EndStat();
+ OPC_BegStat();
+ OPC_ExitProc(outerProc, 0, 0);
+ OPC_EndStat();
+ OPC_BegStat();
+ OPM_WriteString((CHAR*)"return __retval", 16);
} else {
+ OPC_ExitProc(outerProc, 0, 0);
+ OPM_WriteString((CHAR*)"return", 7);
if (n->left != NIL) {
- OPM_WriteString((CHAR*)"_o_result = ", (LONGINT)13);
- if ((n->left->typ->form == 13 && n->obj->typ != n->left->typ)) {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
+ OPM_Write(' ');
+ if ((n->left->typ->form == 11 && n->obj->typ != n->left->typ)) {
+ OPM_WriteString((CHAR*)"(void*)", 8);
OPV_expr(n->left, 10);
} else {
OPV_expr(n->left, -1);
}
- OPM_WriteString((CHAR*)";", (LONGINT)2);
- OPM_WriteLn();
- OPC_BegStat();
- OPC_ExitProc(outerProc, 0, 0);
- OPM_WriteString((CHAR*)"return _o_result", (LONGINT)17);
- } else {
- OPM_WriteString((CHAR*)"return", (LONGINT)7);
}
}
break;
@@ -1630,15 +1522,15 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPV_IfStat(n, n->subcl == 0, outerProc);
break;
case 28:
- OPC_Halt(n->right->conval->intval);
+ OPC_Halt(OPM_Longint(n->right->conval->intval));
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.class = ", (LONGINT)40);
- OPM_LogWNum(n->class, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.class = ", 40);
+ OPM_LogWNum(n->class, 0);
OPM_LogWLn();
break;
}
- if (!__IN(n->class, 0x09744000)) {
+ if (!__IN(n->class, 0x09744000, 32)) {
OPC_EndStat();
}
n = n->link;
@@ -1647,7 +1539,7 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
void OPV_Module (OPT_Node prog)
{
- if (!OPV_mainprog) {
+ if (!__IN(10, OPM_Options, 32)) {
OPC_GenHdr(prog->right);
OPC_GenHdrIncludes();
}
diff --git a/bootstrap/unix-44/OPV.h b/bootstrap/unix-44/OPV.h
index 04828b2f..c4a61586 100644
--- a/bootstrap/unix-44/OPV.h
+++ b/bootstrap/unix-44/OPV.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPV__h
#define OPV__h
@@ -12,8 +12,7 @@
import void OPV_AdrAndSize (OPT_Object topScope);
import void OPV_Init (void);
import void OPV_Module (OPT_Node prog);
-import void OPV_TypSize (OPT_Struct typ);
import void *OPV__init(void);
-#endif
+#endif // OPV
diff --git a/bootstrap/unix-44/Out.c b/bootstrap/unix-44/Out.c
new file mode 100644
index 00000000..39f383cf
--- /dev/null
+++ b/bootstrap/unix-44/Out.c
@@ -0,0 +1,318 @@
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
+#include "SYSTEM.h"
+#include "Platform.h"
+
+
+export BOOLEAN Out_IsConsole;
+static CHAR Out_buf[128];
+static INT16 Out_in;
+
+
+export void Out_Char (CHAR ch);
+export void Out_Flush (void);
+export void Out_Int (INT64 x, INT64 n);
+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, LONGINT str__len);
+export LONGREAL Out_Ten (INT16 e);
+static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i);
+static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i);
+
+#define Out_Entier64(x) (INT64)(x)
+
+void Out_Flush (void)
+{
+ INT16 error;
+ if (Out_in > 0) {
+ error = Platform_Write(1, (ADDRESS)Out_buf, Out_in);
+ }
+ Out_in = 0;
+}
+
+void Out_Open (void)
+{
+}
+
+void Out_Char (CHAR ch)
+{
+ if (Out_in >= 128) {
+ Out_Flush();
+ }
+ Out_buf[__X(Out_in, 128)] = ch;
+ Out_in += 1;
+ if (ch == 0x0a) {
+ Out_Flush();
+ }
+}
+
+static INT32 Out_Length (CHAR *s, LONGINT s__len)
+{
+ INT32 l;
+ l = 0;
+ while ((l < s__len && s[__X(l, s__len)] != 0x00)) {
+ l += 1;
+ }
+ return l;
+}
+
+void Out_String (CHAR *str, LONGINT str__len)
+{
+ INT32 l;
+ INT16 error;
+ __DUP(str, str__len, CHAR);
+ l = Out_Length((void*)str, str__len);
+ if (Out_in + l > 128) {
+ Out_Flush();
+ }
+ if (l > 128) {
+ error = Platform_Write(1, (ADDRESS)str, l);
+ } else {
+ __MOVE((ADDRESS)str, (ADDRESS)&Out_buf[__X(Out_in, 128)], l);
+ Out_in += (INT16)l;
+ }
+ __DEL(str);
+}
+
+void Out_Int (INT64 x, INT64 n)
+{
+ CHAR s[22];
+ INT16 i;
+ BOOLEAN negative;
+ negative = x < 0;
+ if (x == (-9223372036854775807-1)) {
+ __MOVE("8085774586302733229", s, 20);
+ i = 19;
+ } else {
+ if (x < 0) {
+ x = -x;
+ }
+ s[0] = (CHAR)(48 + __MOD(x, 10));
+ x = __DIV(x, 10);
+ i = 1;
+ while (x != 0) {
+ s[__X(i, 22)] = (CHAR)(48 + __MOD(x, 10));
+ x = __DIV(x, 10);
+ i += 1;
+ }
+ }
+ if (negative) {
+ s[__X(i, 22)] = '-';
+ i += 1;
+ }
+ while (n > (INT64)i) {
+ Out_Char(' ');
+ n -= 1;
+ }
+ while (i > 0) {
+ i -= 1;
+ Out_Char(s[__X(i, 22)]);
+ }
+}
+
+void Out_Ln (void)
+{
+ Out_String(Platform_NL, 3);
+ Out_Flush();
+}
+
+static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i)
+{
+ *i -= 1;
+ s[__X(*i, s__len)] = (CHAR)(__MOD(n, 10) + 48);
+}
+
+static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i)
+{
+ INT16 j;
+ INT32 l;
+ __DUP(t, t__len, CHAR);
+ l = Out_Length((void*)t, t__len);
+ if (l > *i) {
+ l = *i;
+ }
+ *i -= (INT16)l;
+ j = 0;
+ while (j < l) {
+ s[__X(*i + j, s__len)] = t[__X(j, t__len)];
+ j += 1;
+ }
+ __DEL(t);
+}
+
+LONGREAL Out_Ten (INT16 e)
+{
+ LONGREAL r, power;
+ r = (LONGREAL)1;
+ power = (LONGREAL)10;
+ while (e > 0) {
+ if (__ODD(e)) {
+ r = r * power;
+ }
+ power = power * power;
+ e = __ASHR(e, 1);
+ }
+ return r;
+}
+
+static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_)
+{
+ INT16 e;
+ INT64 f;
+ CHAR s[30];
+ INT16 i, el;
+ LONGREAL x0;
+ BOOLEAN nn, en;
+ INT64 m;
+ INT16 d, dr;
+ e = (INT16)__MASK(__ASHR((__VAL(INT64, x)), 52), -2048);
+ f = __MASK((__VAL(INT64, x)), -4503599627370496);
+ nn = (__VAL(INT64, x) < 0 && !((e == 2047 && f != 0)));
+ if (nn) {
+ n -= 1;
+ }
+ i = 30;
+ if (e == 2047) {
+ if (f == 0) {
+ Out_prepend((CHAR*)"Infinity", 9, (void*)s, 30, &i);
+ } else {
+ Out_prepend((CHAR*)"NaN", 4, (void*)s, 30, &i);
+ }
+ } else {
+ if (long_) {
+ el = 3;
+ dr = n - 6;
+ if (dr > 17) {
+ dr = 17;
+ }
+ d = dr;
+ if (d < 15) {
+ d = 15;
+ }
+ } else {
+ el = 2;
+ dr = n - 5;
+ if (dr > 9) {
+ dr = 9;
+ }
+ d = dr;
+ if (d < 6) {
+ d = 6;
+ }
+ }
+ if (e == 0) {
+ while (el > 0) {
+ i -= 1;
+ s[__X(i, 30)] = '0';
+ el -= 1;
+ }
+ i -= 1;
+ s[__X(i, 30)] = '+';
+ m = 0;
+ } else {
+ if (nn) {
+ x = -x;
+ }
+ e = (INT16)__ASHR((e - 1023) * 77, 8);
+ if (e >= 0) {
+ x = x / (LONGREAL)Out_Ten(e);
+ } else {
+ x = Out_Ten(-e) * x;
+ }
+ if (x >= (LONGREAL)10) {
+ x = 1.00000000000000e-001 * x;
+ e += 1;
+ }
+ en = e < 0;
+ if (en) {
+ e = -e;
+ }
+ while (el > 0) {
+ Out_digit(e, (void*)s, 30, &i);
+ e = __DIV(e, 10);
+ el -= 1;
+ }
+ i -= 1;
+ if (en) {
+ s[__X(i, 30)] = '-';
+ } else {
+ s[__X(i, 30)] = '+';
+ }
+ x0 = Out_Ten(d - 1);
+ x = x0 * x;
+ x = x + 5.00000000000000e-001;
+ if (x >= (LONGREAL)10 * x0) {
+ x = 1.00000000000000e-001 * x;
+ e += 1;
+ }
+ m = Out_Entier64(x);
+ }
+ i -= 1;
+ if (long_) {
+ s[__X(i, 30)] = 'D';
+ } else {
+ s[__X(i, 30)] = 'E';
+ }
+ if (dr < 2) {
+ dr = 2;
+ }
+ while ((d > dr && __MOD(m, 10) == 0)) {
+ m = __DIV(m, 10);
+ d -= 1;
+ }
+ while (d > 1) {
+ Out_digit(m, (void*)s, 30, &i);
+ m = __DIV(m, 10);
+ d -= 1;
+ }
+ i -= 1;
+ s[__X(i, 30)] = '.';
+ Out_digit(m, (void*)s, 30, &i);
+ }
+ n -= 30 - i;
+ while (n > 0) {
+ Out_Char(' ');
+ n -= 1;
+ }
+ if (nn) {
+ Out_Char('-');
+ }
+ while (i < 30) {
+ Out_Char(s[__X(i, 30)]);
+ i += 1;
+ }
+}
+
+void Out_Real (REAL x, INT16 n)
+{
+ Out_RealP(x, n, 0);
+}
+
+void Out_LongReal (LONGREAL x, INT16 n)
+{
+ Out_RealP(x, n, 1);
+}
+
+
+export void *Out__init(void)
+{
+ __DEFMOD;
+ __MODULE_IMPORT(Platform);
+ __REGMOD("Out", 0);
+ __REGCMD("Flush", Out_Flush);
+ __REGCMD("Ln", Out_Ln);
+ __REGCMD("Open", Out_Open);
+/* BEGIN */
+ Out_IsConsole = Platform_IsConsole(1);
+ Out_in = 0;
+ __ENDMOD;
+}
diff --git a/bootstrap/unix-44/Out.h b/bootstrap/unix-44/Out.h
new file mode 100644
index 00000000..0e66420d
--- /dev/null
+++ b/bootstrap/unix-44/Out.h
@@ -0,0 +1,24 @@
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#ifndef Out__h
+#define Out__h
+
+#include "SYSTEM.h"
+
+
+import BOOLEAN Out_IsConsole;
+
+
+import void Out_Char (CHAR ch);
+import void Out_Flush (void);
+import void Out_Int (INT64 x, INT64 n);
+import void Out_Ln (void);
+import void Out_LongReal (LONGREAL x, INT16 n);
+import void Out_Open (void);
+import void Out_Real (REAL x, INT16 n);
+import void Out_String (CHAR *str, LONGINT str__len);
+import LONGREAL Out_Ten (INT16 e);
+import void *Out__init(void);
+
+
+#endif // Out
diff --git a/bootstrap/unix-44/Platform.c b/bootstrap/unix-44/Platform.c
index 74c43788..72c15bf8 100644
--- a/bootstrap/unix-44/Platform.c
+++ b/bootstrap/unix-44/Platform.c
@@ -1,4 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
typedef
@@ -8,90 +14,84 @@ typedef
Platform_ArgPtr (*Platform_ArgVec)[1024];
typedef
- LONGINT (*Platform_ArgVecPtr)[1];
+ INT32 (*Platform_ArgVecPtr)[1];
typedef
CHAR (*Platform_EnvPtr)[1024];
typedef
struct Platform_FileIdentity {
- LONGINT volume, index, mtime;
+ INT32 volume, index, mtime;
} Platform_FileIdentity;
typedef
- void (*Platform_HaltProcedure)(LONGINT);
+ void (*Platform_HaltProcedure)(INT32);
typedef
- void (*Platform_SignalHandler)(INTEGER);
+ void (*Platform_SignalHandler)(INT32);
export BOOLEAN Platform_LittleEndian;
-export LONGINT Platform_MainStackFrame, Platform_HaltCode;
-export INTEGER Platform_PID;
+export INT32 Platform_MainStackFrame;
+export INT16 Platform_PID;
export CHAR Platform_CWD[256];
-export INTEGER Platform_ArgCount;
-export LONGINT Platform_ArgVector;
+export INT16 Platform_ArgCount;
+export INT32 Platform_ArgVector;
static Platform_HaltProcedure Platform_HaltHandler;
-static LONGINT Platform_TimeStart;
-export INTEGER Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
-export CHAR Platform_nl[3];
+static INT32 Platform_TimeStart;
+export INT16 Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
+export CHAR Platform_NL[3];
-export LONGINT *Platform_FileIdentity__typ;
+export ADDRESS *Platform_FileIdentity__typ;
-export BOOLEAN Platform_Absent (INTEGER e);
-export INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len);
-export void Platform_AssertFail (LONGINT code);
-export INTEGER Platform_Chdir (CHAR *n, LONGINT n__len);
-export INTEGER Platform_Close (LONGINT h);
-export BOOLEAN Platform_ConnectionFailed (INTEGER e);
-export void Platform_Delay (LONGINT ms);
-export BOOLEAN Platform_DifferentFilesystems (INTEGER e);
-static void Platform_DisplayHaltCode (LONGINT code);
-export INTEGER Platform_Error (void);
-export void Platform_Exit (INTEGER code);
-export void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len);
-export void Platform_GetClock (LONGINT *t, LONGINT *d);
+export BOOLEAN Platform_Absent (INT16 e);
+export INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
+export INT16 Platform_Chdir (CHAR *n, LONGINT n__len);
+export INT16 Platform_Close (INT32 h);
+export BOOLEAN Platform_ConnectionFailed (INT16 e);
+export void Platform_Delay (INT32 ms);
+export BOOLEAN Platform_DifferentFilesystems (INT16 e);
+export INT16 Platform_Error (void);
+export void Platform_Exit (INT32 code);
+export void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len);
+export void Platform_GetClock (INT32 *t, INT32 *d);
export void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
-export void Platform_GetIntArg (INTEGER n, LONGINT *val);
-export void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec);
-export void Platform_Halt (LONGINT code);
-export INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ);
-export INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ);
-export BOOLEAN Platform_Inaccessible (INTEGER e);
-export void Platform_Init (INTEGER argc, LONGINT argvadr);
-export void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d);
-export INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h);
-export BOOLEAN Platform_NoSuchDirectory (INTEGER e);
-export LONGINT Platform_OSAllocate (LONGINT size);
-export void Platform_OSFree (LONGINT address);
-export INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h);
-export INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h);
-export INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n);
-export INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n);
-export INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
+export 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, 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_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, 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, 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 INTEGER Platform_Seek (LONGINT h, LONGINT offset, INTEGER whence);
+export INT16 Platform_Seek (INT32 h, INT32 offset, INT16 whence);
export void Platform_SetBadInstructionHandler (Platform_SignalHandler handler);
-export void Platform_SetHalt (Platform_HaltProcedure p);
export void Platform_SetInterruptHandler (Platform_SignalHandler handler);
-export void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source);
+export void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__typ, Platform_FileIdentity source);
export void Platform_SetQuitHandler (Platform_SignalHandler handler);
-export INTEGER Platform_Size (LONGINT h, LONGINT *l);
-export INTEGER Platform_Sync (LONGINT h);
-export INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len);
+export INT16 Platform_Size (INT32 h, INT32 *l);
+export INT16 Platform_Sync (INT32 h);
+export INT16 Platform_System (CHAR *cmd, LONGINT cmd__len);
static void Platform_TestLittleEndian (void);
-export LONGINT Platform_Time (void);
-export BOOLEAN Platform_TimedOut (INTEGER e);
-export BOOLEAN Platform_TooManyFiles (INTEGER e);
-export INTEGER Platform_Truncate (LONGINT h, LONGINT l);
-export INTEGER Platform_Unlink (CHAR *n, LONGINT n__len);
-export INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l);
-static void Platform_YMDHMStoClock (LONGINT ye, LONGINT mo, LONGINT da, LONGINT ho, LONGINT mi, LONGINT se, LONGINT *t, LONGINT *d);
-static void Platform_errch (CHAR c);
-static void Platform_errint (LONGINT l);
-static void Platform_errln (void);
-static void Platform_errposint (LONGINT l);
+export INT32 Platform_Time (void);
+export BOOLEAN Platform_TimedOut (INT16 e);
+export BOOLEAN Platform_TooManyFiles (INT16 e);
+export INT16 Platform_Truncate (INT32 h, INT32 l);
+export INT16 Platform_Unlink (CHAR *n, LONGINT n__len);
+export INT16 Platform_Write (INT32 h, INT32 p, INT32 l);
+static void Platform_YMDHMStoClock (INT32 ye, INT32 mo, INT32 da, INT32 ho, INT32 mi, INT32 se, INT32 *t, INT32 *d);
export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
#include
@@ -109,6 +109,7 @@ export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT
#define Platform_ECONNABORTED() ECONNABORTED
#define Platform_ECONNREFUSED() ECONNREFUSED
#define Platform_EHOSTUNREACH() EHOSTUNREACH
+#define Platform_EINTR() EINTR
#define Platform_EMFILE() EMFILE
#define Platform_ENETUNREACH() ENETUNREACH
#define Platform_ENFILE() ENFILE
@@ -118,14 +119,12 @@ export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT
#define Platform_EXDEV() EXDEV
extern void Heap_InitHeap();
#define Platform_HeapInitHeap() Heap_InitHeap()
-#define Platform_allocate(size) (LONGINT)(SYSTEM_ADDRESS)((void*)malloc((size_t)size))
+#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)
#define Platform_err() errno
-#define Platform_errc(c) write(1, &c, 1)
-#define Platform_errstring(s, s__len) write(1, s, s__len-1)
-#define Platform_exit(code) exit(code)
-#define Platform_free(address) free((void*)(SYSTEM_ADDRESS)address)
+#define Platform_exit(code) exit((int)code)
+#define Platform_free(address) free((void*)address)
#define Platform_fstat(fd) fstat(fd, &s)
#define Platform_fsync(fd) fsync(fd)
#define Platform_ftruncate(fd, l) ftruncate(fd, l)
@@ -133,23 +132,24 @@ extern void Heap_InitHeap();
#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)
#define Platform_lseek(fd, o, w) lseek(fd, o, w)
#define Platform_nanosleep(s, ns) struct timespec req, rem; req.tv_sec = s; req.tv_nsec = ns; nanosleep(&req, &rem)
#define Platform_opennew(n, n__len) open((char*)n, O_CREAT | O_TRUNC | O_RDWR, 0664)
#define Platform_openro(n, n__len) open((char*)n, O_RDONLY)
#define Platform_openrw(n, n__len) open((char*)n, O_RDWR)
-#define Platform_readfile(fd, p, l) read(fd, (void*)(SYSTEM_ADDRESS)(p), l)
+#define Platform_readfile(fd, p, l) (LONGINT)read(fd, (void*)(ADDRESS)(p), l)
#define Platform_rename(o, o__len, n, n__len) rename((char*)o, (char*)n)
#define Platform_sectotm(s) struct tm *time = localtime((time_t*)&s)
#define Platform_seekcur() SEEK_CUR
#define Platform_seekend() SEEK_END
#define Platform_seekset() SEEK_SET
-#define Platform_sethandler(s, h) SystemSetHandler(s, (SYSTEM_ADDRESS)h)
+#define Platform_sethandler(s, h) SystemSetHandler(s, (ADDRESS)h)
#define Platform_stat(n, n__len) stat((char*)n, &s)
#define Platform_statdev() (LONGINT)s.st_dev
#define Platform_statino() (LONGINT)s.st_ino
#define Platform_statmtime() (LONGINT)s.st_mtime
-#define Platform_statsize() (LONGINT)s.st_size
+#define Platform_statsize() (ADDRESS)s.st_size
#define Platform_structstats() struct stat s
#define Platform_system(str, str__len) system((char*)str)
#define Platform_tmhour() (LONGINT)time->tm_hour
@@ -161,92 +161,78 @@ extern void Heap_InitHeap();
#define Platform_tvsec() tv.tv_sec
#define Platform_tvusec() tv.tv_usec
#define Platform_unlink(n, n__len) unlink((char*)n)
-#define Platform_writefile(fd, p, l) write(fd, (void*)(SYSTEM_ADDRESS)(p), l)
+#define Platform_writefile(fd, p, l) write(fd, (void*)(ADDRESS)(p), l)
-BOOLEAN Platform_TooManyFiles (INTEGER e)
+BOOLEAN Platform_TooManyFiles (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = e == Platform_EMFILE() || e == Platform_ENFILE();
- return _o_result;
+ return e == Platform_EMFILE() || e == Platform_ENFILE();
}
-BOOLEAN Platform_NoSuchDirectory (INTEGER e)
+BOOLEAN Platform_NoSuchDirectory (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = e == Platform_ENOENT();
- return _o_result;
+ return e == Platform_ENOENT();
}
-BOOLEAN Platform_DifferentFilesystems (INTEGER e)
+BOOLEAN Platform_DifferentFilesystems (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = e == Platform_EXDEV();
- return _o_result;
+ return e == Platform_EXDEV();
}
-BOOLEAN Platform_Inaccessible (INTEGER e)
+BOOLEAN Platform_Inaccessible (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = (e == Platform_EACCES() || e == Platform_EROFS()) || e == Platform_EAGAIN();
- return _o_result;
+ return (e == Platform_EACCES() || e == Platform_EROFS()) || e == Platform_EAGAIN();
}
-BOOLEAN Platform_Absent (INTEGER e)
+BOOLEAN Platform_Absent (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = e == Platform_ENOENT();
- return _o_result;
+ return e == Platform_ENOENT();
}
-BOOLEAN Platform_TimedOut (INTEGER e)
+BOOLEAN Platform_TimedOut (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = e == Platform_ETIMEDOUT();
- return _o_result;
+ return e == Platform_ETIMEDOUT();
}
-BOOLEAN Platform_ConnectionFailed (INTEGER e)
+BOOLEAN Platform_ConnectionFailed (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = ((e == Platform_ECONNREFUSED() || e == Platform_ECONNABORTED()) || e == Platform_ENETUNREACH()) || e == Platform_EHOSTUNREACH();
- return _o_result;
+ return ((e == Platform_ECONNREFUSED() || e == Platform_ECONNABORTED()) || e == Platform_ENETUNREACH()) || e == Platform_EHOSTUNREACH();
}
-LONGINT Platform_OSAllocate (LONGINT size)
+BOOLEAN Platform_Interrupted (INT16 e)
{
- LONGINT _o_result;
- _o_result = Platform_allocate(size);
- return _o_result;
+ return e == Platform_EINTR();
}
-void Platform_OSFree (LONGINT address)
+INT32 Platform_OSAllocate (INT32 size)
+{
+ return Platform_allocate(size);
+}
+
+void Platform_OSFree (INT32 address)
{
Platform_free(address);
}
-void Platform_Init (INTEGER argc, LONGINT argvadr)
+void Platform_Init (INT32 argc, INT32 argvadr)
{
Platform_ArgVecPtr av = NIL;
Platform_MainStackFrame = argvadr;
- Platform_ArgCount = argc;
- av = (Platform_ArgVecPtr)(SYSTEM_ADDRESS)argvadr;
+ Platform_ArgCount = __VAL(INT16, argc);
+ av = (Platform_ArgVecPtr)(ADDRESS)argvadr;
Platform_ArgVector = (*av)[0];
- Platform_HaltCode = -128;
Platform_HeapInitHeap();
}
BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
{
- BOOLEAN _o_result;
Platform_EnvPtr p = NIL;
__DUP(var, var__len, CHAR);
p = Platform_getenv(var, var__len);
if (p != NIL) {
__COPY(*p, val, val__len);
}
- _o_result = p != NIL;
__DEL(var);
- return _o_result;
+ return p != NIL;
}
void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
@@ -258,31 +244,31 @@ void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
__DEL(var);
}
-void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len)
+void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len)
{
Platform_ArgVec av = NIL;
if (n < Platform_ArgCount) {
- av = (Platform_ArgVec)(SYSTEM_ADDRESS)Platform_ArgVector;
- __COPY(*(*av)[__X(n, ((LONGINT)(1024)))], val, val__len);
+ av = (Platform_ArgVec)(ADDRESS)Platform_ArgVector;
+ __COPY(*(*av)[__X(n, 1024)], val, val__len);
}
}
-void Platform_GetIntArg (INTEGER n, LONGINT *val)
+void Platform_GetIntArg (INT16 n, INT32 *val)
{
CHAR s[64];
- LONGINT k, d, i;
+ INT32 k, d, i;
s[0] = 0x00;
- Platform_GetArg(n, (void*)s, ((LONGINT)(64)));
+ Platform_GetArg(n, (void*)s, 64);
i = 0;
if (s[0] == '-') {
i = 1;
}
k = 0;
- d = (int)s[__X(i, ((LONGINT)(64)))] - 48;
+ d = (INT16)s[__X(i, 64)] - 48;
while ((d >= 0 && d <= 9)) {
k = k * 10 + d;
i += 1;
- d = (int)s[__X(i, ((LONGINT)(64)))] - 48;
+ d = (INT16)s[__X(i, 64)] - 48;
}
if (s[0] == '-') {
k = -k;
@@ -293,21 +279,19 @@ void Platform_GetIntArg (INTEGER n, LONGINT *val)
}
}
-INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len)
+INT16 Platform_ArgPos (CHAR *s, LONGINT s__len)
{
- INTEGER _o_result;
- INTEGER i;
+ INT16 i;
CHAR arg[256];
__DUP(s, s__len, CHAR);
i = 0;
- Platform_GetArg(i, (void*)arg, ((LONGINT)(256)));
+ Platform_GetArg(i, (void*)arg, 256);
while ((i < Platform_ArgCount && __STRCMP(s, arg) != 0)) {
i += 1;
- Platform_GetArg(i, (void*)arg, ((LONGINT)(256)));
+ Platform_GetArg(i, (void*)arg, 256);
}
- _o_result = i;
__DEL(s);
- return _o_result;
+ return i;
}
void Platform_SetInterruptHandler (Platform_SignalHandler handler)
@@ -325,447 +309,273 @@ void Platform_SetBadInstructionHandler (Platform_SignalHandler handler)
Platform_sethandler(4, handler);
}
-static void Platform_YMDHMStoClock (LONGINT ye, LONGINT mo, LONGINT da, LONGINT ho, LONGINT mi, LONGINT se, LONGINT *t, LONGINT *d)
+static void Platform_YMDHMStoClock (INT32 ye, INT32 mo, INT32 da, INT32 ho, INT32 mi, INT32 se, INT32 *t, INT32 *d)
{
- *d = (__ASHL(__MOD(ye, 100), 9) + __ASHL(mo + 1, 5)) + da;
+ *d = (__ASHL((int)__MOD(ye, 100), 9) + __ASHL(mo + 1, 5)) + da;
*t = (__ASHL(ho, 12) + __ASHL(mi, 6)) + se;
}
-void Platform_GetClock (LONGINT *t, LONGINT *d)
+void Platform_GetClock (INT32 *t, INT32 *d)
{
Platform_gettimeval();
Platform_sectotm(Platform_tvsec());
Platform_YMDHMStoClock(Platform_tmyear(), Platform_tmmon(), Platform_tmmday(), Platform_tmhour(), Platform_tmmin(), Platform_tmsec(), &*t, &*d);
}
-void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec)
+void Platform_GetTimeOfDay (INT32 *sec, INT32 *usec)
{
Platform_gettimeval();
*sec = Platform_tvsec();
*usec = Platform_tvusec();
}
-LONGINT Platform_Time (void)
+INT32 Platform_Time (void)
{
- LONGINT _o_result;
- LONGINT ms;
+ INT32 ms;
Platform_gettimeval();
- ms = __DIVF(Platform_tvusec(), 1000) + Platform_tvsec() * 1000;
- _o_result = __MOD(ms - Platform_TimeStart, 2147483647);
- return _o_result;
+ ms = (int)__DIVF(Platform_tvusec(), 1000) + Platform_tvsec() * 1000;
+ return (int)__MOD(ms - Platform_TimeStart, 2147483647);
}
-void Platform_Delay (LONGINT ms)
+void Platform_Delay (INT32 ms)
{
- LONGINT s, ns;
+ INT32 s, ns;
s = __DIV(ms, 1000);
- ns = __MOD(ms, 1000) * 1000000;
+ ns = (int)__MOD(ms, 1000) * 1000000;
Platform_nanosleep(s, ns);
}
-INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len)
+INT16 Platform_System (CHAR *cmd, LONGINT cmd__len)
{
- INTEGER _o_result;
__DUP(cmd, cmd__len, CHAR);
- _o_result = Platform_system(cmd, cmd__len);
__DEL(cmd);
- return _o_result;
+ return Platform_system(cmd, cmd__len);
}
-INTEGER Platform_Error (void)
+INT16 Platform_Error (void)
{
- INTEGER _o_result;
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
}
-INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h)
+INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h)
{
- INTEGER _o_result;
- INTEGER fd;
+ INT16 fd;
fd = Platform_openro(n, n__len);
if (fd < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
*h = fd;
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h)
+INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h)
{
- INTEGER _o_result;
- INTEGER fd;
+ INT16 fd;
fd = Platform_openrw(n, n__len);
if (fd < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
*h = fd;
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h)
+INT16 Platform_New (CHAR *n, LONGINT n__len, INT32 *h)
{
- INTEGER _o_result;
- INTEGER fd;
+ INT16 fd;
fd = Platform_opennew(n, n__len);
if (fd < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
*h = fd;
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Close (LONGINT h)
+INT16 Platform_Close (INT32 h)
{
- INTEGER _o_result;
if (Platform_closefile(h) < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ)
+BOOLEAN Platform_IsConsole (INT32 h)
+{
+ return Platform_isatty(h) != 0;
+}
+
+INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *identity__typ)
{
- INTEGER _o_result;
Platform_structstats();
if (Platform_fstat(h) < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
}
(*identity).volume = Platform_statdev();
(*identity).index = Platform_statino();
(*identity).mtime = Platform_statmtime();
- _o_result = 0;
- return _o_result;
+ return 0;
}
-INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ)
+INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
{
- INTEGER _o_result;
__DUP(n, n__len, CHAR);
Platform_structstats();
if (Platform_stat(n, n__len) < 0) {
- _o_result = Platform_err();
__DEL(n);
- return _o_result;
+ return Platform_err();
}
(*identity).volume = Platform_statdev();
(*identity).index = Platform_statino();
(*identity).mtime = Platform_statmtime();
- _o_result = 0;
__DEL(n);
- return _o_result;
+ return 0;
}
BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2)
{
- BOOLEAN _o_result;
- _o_result = (i1.index == i2.index && i1.volume == i2.volume);
- return _o_result;
+ return (i1.index == i2.index && i1.volume == i2.volume);
}
BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2)
{
- BOOLEAN _o_result;
- _o_result = i1.mtime == i2.mtime;
- return _o_result;
+ return i1.mtime == i2.mtime;
}
-void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source)
+void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__typ, Platform_FileIdentity source)
{
(*target).mtime = source.mtime;
}
-void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d)
+void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d)
{
Platform_sectotm(i.mtime);
Platform_YMDHMStoClock(Platform_tmyear(), Platform_tmmon(), Platform_tmmday(), Platform_tmhour(), Platform_tmmin(), Platform_tmsec(), &*t, &*d);
}
-INTEGER Platform_Size (LONGINT h, LONGINT *l)
+INT16 Platform_Size (INT32 h, INT32 *l)
{
- INTEGER _o_result;
Platform_structstats();
if (Platform_fstat(h) < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
}
*l = Platform_statsize();
- _o_result = 0;
- return _o_result;
+ return 0;
}
-INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n)
+INT16 Platform_Read (INT32 h, INT32 p, INT32 l, INT32 *n)
{
- INTEGER _o_result;
*n = Platform_readfile(h, p, l);
if (*n < 0) {
*n = 0;
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n)
+INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n)
{
- INTEGER _o_result;
- *n = Platform_readfile(h, (LONGINT)(SYSTEM_ADDRESS)b, b__len);
+ *n = Platform_readfile(h, (ADDRESS)b, b__len);
if (*n < 0) {
*n = 0;
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l)
+INT16 Platform_Write (INT32 h, INT32 p, INT32 l)
{
- INTEGER _o_result;
- LONGINT written;
+ INT32 written;
written = Platform_writefile(h, p, l);
if (written < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Sync (LONGINT h)
+INT16 Platform_Sync (INT32 h)
{
- INTEGER _o_result;
if (Platform_fsync(h) < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Seek (LONGINT h, LONGINT offset, INTEGER whence)
+INT16 Platform_Seek (INT32 h, INT32 offset, INT16 whence)
{
- INTEGER _o_result;
if (Platform_lseek(h, offset, whence) < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Truncate (LONGINT h, LONGINT l)
+INT16 Platform_Truncate (INT32 h, INT32 l)
{
- INTEGER _o_result;
if (Platform_ftruncate(h, l) < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Unlink (CHAR *n, LONGINT n__len)
+INT16 Platform_Unlink (CHAR *n, LONGINT n__len)
{
- INTEGER _o_result;
if (Platform_unlink(n, n__len) < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Chdir (CHAR *n, LONGINT n__len)
+INT16 Platform_Chdir (CHAR *n, LONGINT n__len)
{
- INTEGER _o_result;
- INTEGER r;
- r = Platform_chdir(n, n__len);
- Platform_getcwd((void*)Platform_CWD, ((LONGINT)(256)));
- if (r < 0) {
- _o_result = Platform_err();
- return _o_result;
+ INT16 r;
+ if ((Platform_chdir(n, n__len) >= 0 && Platform_getcwd((void*)Platform_CWD, 256) != NIL)) {
+ return 0;
} else {
- _o_result = 0;
- return _o_result;
+ return Platform_err();
}
__RETCHK;
}
-INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len)
+INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len)
{
- INTEGER _o_result;
if (Platform_rename(o, o__len, n, n__len) < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-void Platform_Exit (INTEGER code)
+void Platform_Exit (INT32 code)
{
Platform_exit(code);
}
-static void Platform_errch (CHAR c)
-{
- Platform_errc(c);
-}
-
-static void Platform_errln (void)
-{
- Platform_errch(0x0d);
- Platform_errch(0x0a);
-}
-
-static void Platform_errposint (LONGINT l)
-{
- if (l > 10) {
- Platform_errposint(__DIV(l, 10));
- }
- Platform_errch((CHAR)(48 + __MOD(l, 10)));
-}
-
-static void Platform_errint (LONGINT l)
-{
- if (l < 0) {
- Platform_errch('-');
- l = -l;
- }
- Platform_errposint(l);
-}
-
-static void Platform_DisplayHaltCode (LONGINT code)
-{
- switch (code) {
- case -1:
- Platform_errstring((CHAR*)"Assertion failure.", (LONGINT)19);
- break;
- case -2:
- Platform_errstring((CHAR*)"Index out of range.", (LONGINT)20);
- break;
- case -3:
- Platform_errstring((CHAR*)"Reached end of function without reaching RETURN.", (LONGINT)49);
- break;
- case -4:
- Platform_errstring((CHAR*)"CASE statement: no matching label and no ELSE.", (LONGINT)47);
- break;
- case -5:
- Platform_errstring((CHAR*)"Type guard failed.", (LONGINT)19);
- break;
- case -6:
- Platform_errstring((CHAR*)"Implicit type guard in record assignment failed.", (LONGINT)49);
- break;
- case -7:
- Platform_errstring((CHAR*)"Invalid case in WITH statement.", (LONGINT)32);
- break;
- case -8:
- Platform_errstring((CHAR*)"Value out of range.", (LONGINT)20);
- break;
- case -9:
- Platform_errstring((CHAR*)"Heap interrupted while locked, but lockdepth = 0 at unlock.", (LONGINT)60);
- break;
- case -10:
- Platform_errstring((CHAR*)"NIL access.", (LONGINT)12);
- break;
- case -11:
- Platform_errstring((CHAR*)"Alignment error.", (LONGINT)17);
- break;
- case -12:
- Platform_errstring((CHAR*)"Divide by zero.", (LONGINT)16);
- break;
- case -13:
- Platform_errstring((CHAR*)"Arithmetic overflow/underflow.", (LONGINT)31);
- break;
- case -14:
- Platform_errstring((CHAR*)"Invalid function argument.", (LONGINT)27);
- break;
- case -15:
- Platform_errstring((CHAR*)"Internal error, e.g. Type descriptor size mismatch.", (LONGINT)52);
- break;
- case -20:
- Platform_errstring((CHAR*)"Too many, or negative number of, elements in dynamic array.", (LONGINT)60);
- break;
- default:
- break;
- }
-}
-
-void Platform_Halt (LONGINT code)
-{
- INTEGER e;
- Platform_HaltCode = code;
- if (Platform_HaltHandler != NIL) {
- (*Platform_HaltHandler)(code);
- }
- Platform_errstring((CHAR*)"Terminated by Halt(", (LONGINT)20);
- Platform_errint(code);
- Platform_errstring((CHAR*)"). ", (LONGINT)4);
- if (code < 0) {
- Platform_DisplayHaltCode(code);
- }
- Platform_errln();
- Platform_exit(__VAL(INTEGER, code));
-}
-
-void Platform_AssertFail (LONGINT code)
-{
- INTEGER e;
- Platform_errstring((CHAR*)"Assertion failure.", (LONGINT)19);
- if (code != 0) {
- Platform_errstring((CHAR*)" ASSERT code ", (LONGINT)14);
- Platform_errint(code);
- Platform_errstring((CHAR*)".", (LONGINT)2);
- }
- Platform_errln();
- Platform_exit(__VAL(INTEGER, code));
-}
-
-void Platform_SetHalt (Platform_HaltProcedure p)
-{
- Platform_HaltHandler = p;
-}
-
static void Platform_TestLittleEndian (void)
{
- INTEGER i;
+ INT16 i;
i = 1;
- __GET((LONGINT)(SYSTEM_ADDRESS)&i, Platform_LittleEndian, BOOLEAN);
+ __GET((ADDRESS)&i, Platform_LittleEndian, BOOLEAN);
}
__TDESC(Platform_FileIdentity, 1, 0) = {__TDFLDS("FileIdentity", 12), {-4}};
@@ -777,17 +587,17 @@ export void *Platform__init(void)
__INITYP(Platform_FileIdentity, Platform_FileIdentity, 0);
/* BEGIN */
Platform_TestLittleEndian();
- Platform_HaltCode = -128;
Platform_HaltHandler = NIL;
Platform_TimeStart = 0;
Platform_TimeStart = Platform_Time();
- Platform_CWD[0] = 0x00;
- Platform_getcwd((void*)Platform_CWD, ((LONGINT)(256)));
Platform_PID = Platform_getpid();
+ if (Platform_getcwd((void*)Platform_CWD, 256) == NIL) {
+ Platform_CWD[0] = 0x00;
+ }
Platform_SeekSet = Platform_seekset();
Platform_SeekCur = Platform_seekcur();
Platform_SeekEnd = Platform_seekend();
- Platform_nl[0] = 0x0a;
- Platform_nl[1] = 0x00;
+ Platform_NL[0] = 0x0a;
+ Platform_NL[1] = 0x00;
__ENDMOD;
}
diff --git a/bootstrap/unix-44/Platform.h b/bootstrap/unix-44/Platform.h
index dd5ce434..b04f552d 100644
--- a/bootstrap/unix-44/Platform.h
+++ b/bootstrap/unix-44/Platform.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Platform__h
#define Platform__h
@@ -7,76 +7,73 @@
typedef
struct Platform_FileIdentity {
- LONGINT volume, index, mtime;
+ INT32 _prvt0;
+ char _prvt1[8];
} Platform_FileIdentity;
typedef
- void (*Platform_HaltProcedure)(LONGINT);
-
-typedef
- void (*Platform_SignalHandler)(INTEGER);
+ void (*Platform_SignalHandler)(INT32);
import BOOLEAN Platform_LittleEndian;
-import LONGINT Platform_MainStackFrame, Platform_HaltCode;
-import INTEGER Platform_PID;
+import INT32 Platform_MainStackFrame;
+import INT16 Platform_PID;
import CHAR Platform_CWD[256];
-import INTEGER Platform_ArgCount;
-import LONGINT Platform_ArgVector;
-import INTEGER Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
-import CHAR Platform_nl[3];
+import INT16 Platform_ArgCount;
+import INT32 Platform_ArgVector;
+import INT16 Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
+import CHAR Platform_NL[3];
-import LONGINT *Platform_FileIdentity__typ;
+import ADDRESS *Platform_FileIdentity__typ;
-import BOOLEAN Platform_Absent (INTEGER e);
-import INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len);
-import void Platform_AssertFail (LONGINT code);
-import INTEGER Platform_Chdir (CHAR *n, LONGINT n__len);
-import INTEGER Platform_Close (LONGINT h);
-import BOOLEAN Platform_ConnectionFailed (INTEGER e);
-import void Platform_Delay (LONGINT ms);
-import BOOLEAN Platform_DifferentFilesystems (INTEGER e);
-import INTEGER Platform_Error (void);
-import void Platform_Exit (INTEGER code);
-import void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len);
-import void Platform_GetClock (LONGINT *t, LONGINT *d);
+import BOOLEAN Platform_Absent (INT16 e);
+import INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
+import INT16 Platform_Chdir (CHAR *n, LONGINT n__len);
+import INT16 Platform_Close (INT32 h);
+import BOOLEAN Platform_ConnectionFailed (INT16 e);
+import void Platform_Delay (INT32 ms);
+import BOOLEAN Platform_DifferentFilesystems (INT16 e);
+import INT16 Platform_Error (void);
+import void Platform_Exit (INT32 code);
+import void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len);
+import void Platform_GetClock (INT32 *t, INT32 *d);
import void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
-import void Platform_GetIntArg (INTEGER n, LONGINT *val);
-import void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec);
-import void Platform_Halt (LONGINT code);
-import INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ);
-import INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ);
-import BOOLEAN Platform_Inaccessible (INTEGER e);
-import void Platform_Init (INTEGER argc, LONGINT argvadr);
-import void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d);
-import INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h);
-import BOOLEAN Platform_NoSuchDirectory (INTEGER e);
-import LONGINT Platform_OSAllocate (LONGINT size);
-import void Platform_OSFree (LONGINT address);
-import INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h);
-import INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h);
-import INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n);
-import INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n);
-import INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
+import 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, 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_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, 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, 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 INTEGER Platform_Seek (LONGINT h, LONGINT offset, INTEGER whence);
+import INT16 Platform_Seek (INT32 h, INT32 offset, INT16 whence);
import void Platform_SetBadInstructionHandler (Platform_SignalHandler handler);
-import void Platform_SetHalt (Platform_HaltProcedure p);
import void Platform_SetInterruptHandler (Platform_SignalHandler handler);
-import void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source);
+import void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__typ, Platform_FileIdentity source);
import void Platform_SetQuitHandler (Platform_SignalHandler handler);
-import INTEGER Platform_Size (LONGINT h, LONGINT *l);
-import INTEGER Platform_Sync (LONGINT h);
-import INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len);
-import LONGINT Platform_Time (void);
-import BOOLEAN Platform_TimedOut (INTEGER e);
-import BOOLEAN Platform_TooManyFiles (INTEGER e);
-import INTEGER Platform_Truncate (LONGINT h, LONGINT l);
-import INTEGER Platform_Unlink (CHAR *n, LONGINT n__len);
-import INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l);
+import INT16 Platform_Size (INT32 h, INT32 *l);
+import INT16 Platform_Sync (INT32 h);
+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, LONGINT n__len);
+import INT16 Platform_Write (INT32 h, INT32 p, INT32 l);
import BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
import void *Platform__init(void);
-#endif
+#endif // Platform
diff --git a/bootstrap/unix-44/Reals.c b/bootstrap/unix-44/Reals.c
index 2323e34d..cd4c3c61 100644
--- a/bootstrap/unix-44/Reals.c
+++ b/bootstrap/unix-44/Reals.c
@@ -1,25 +1,30 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len);
-export void Reals_Convert (REAL x, INTEGER n, CHAR *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, INTEGER n, CHAR *d, LONGINT d__len);
-export INTEGER Reals_Expo (REAL x);
-export INTEGER Reals_ExpoL (LONGREAL x);
-export void Reals_SetExpo (REAL *x, INTEGER ex);
-export REAL Reals_Ten (INTEGER e);
-export LONGREAL Reals_TenL (INTEGER e);
-static CHAR Reals_ToHex (INTEGER i);
+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);
+export REAL Reals_Ten (INT16 e);
+export LONGREAL Reals_TenL (INT16 e);
+static CHAR Reals_ToHex (INT16 i);
-REAL Reals_Ten (INTEGER e)
+REAL Reals_Ten (INT16 e)
{
- REAL _o_result;
LONGREAL r, power;
r = (LONGREAL)1;
power = (LONGREAL)10;
@@ -30,13 +35,11 @@ REAL Reals_Ten (INTEGER e)
power = power * power;
e = __ASHR(e, 1);
}
- _o_result = r;
- return _o_result;
+ return r;
}
-LONGREAL Reals_TenL (INTEGER e)
+LONGREAL Reals_TenL (INT16 e)
{
- LONGREAL _o_result;
LONGREAL r, power;
r = (LONGREAL)1;
power = (LONGREAL)10;
@@ -46,110 +49,102 @@ LONGREAL Reals_TenL (INTEGER e)
}
e = __ASHR(e, 1);
if (e <= 0) {
- _o_result = r;
- return _o_result;
+ return r;
}
power = power * power;
}
__RETCHK;
}
-INTEGER Reals_Expo (REAL x)
+INT16 Reals_Expo (REAL x)
{
- INTEGER _o_result;
- INTEGER i;
- __GET((LONGINT)(SYSTEM_ADDRESS)&x + 2, i, INTEGER);
- _o_result = __MASK(__ASHR(i, 7), -256);
- return _o_result;
+ INT16 i;
+ __GET((ADDRESS)&x + 2, i, INT16);
+ return __MASK(__ASHR(i, 7), -256);
}
-void Reals_SetExpo (REAL *x, INTEGER ex)
+void Reals_SetExpo (REAL *x, INT16 ex)
{
CHAR c;
- __GET((LONGINT)(SYSTEM_ADDRESS)x + 3, c, CHAR);
- __PUT((LONGINT)(SYSTEM_ADDRESS)x + 3, (CHAR)(__ASHL(__ASHR((int)c, 7), 7) + __MASK(__ASHR(ex, 1), -128)), CHAR);
- __GET((LONGINT)(SYSTEM_ADDRESS)x + 2, c, CHAR);
- __PUT((LONGINT)(SYSTEM_ADDRESS)x + 2, (CHAR)(__MASK((int)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR);
+ __GET((ADDRESS)x + 3, c, 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, (CHAR)(__MASK((INT16)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR);
}
-INTEGER Reals_ExpoL (LONGREAL x)
+INT16 Reals_ExpoL (LONGREAL x)
{
- INTEGER _o_result;
- INTEGER i;
- __GET((LONGINT)(SYSTEM_ADDRESS)&x + 6, i, INTEGER);
- _o_result = __MASK(__ASHR(i, 4), -2048);
- return _o_result;
+ INT16 i;
+ __GET((ADDRESS)&x + 6, i, INT16);
+ return __MASK(__ASHR(i, 4), -2048);
}
-void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len)
+void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len)
{
- LONGINT i, j, k;
+ INT32 i, j, k;
if (x < (LONGREAL)0) {
x = -x;
}
k = 0;
if (n > 9) {
- i = (int)__ENTIER(x / (LONGREAL)(LONGREAL)1000000000);
- j = (int)__ENTIER(x - i * (LONGREAL)1000000000);
+ 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)] = (CHAR)(__MOD(j, 10) + 48);
+ d[__X(k, d__len)] = (CHAR)((int)__MOD(j, 10) + 48);
j = __DIV(j, 10);
k += 1;
}
} else {
- i = (int)__ENTIER(x);
+ i = (INT32)__ENTIER(x);
}
- while (k < (int)n) {
- d[__X(k, d__len)] = (CHAR)(__MOD(i, 10) + 48);
+ while (k < n) {
+ d[__X(k, d__len)] = (CHAR)((int)__MOD(i, 10) + 48);
i = __DIV(i, 10);
k += 1;
}
}
-void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len)
+void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len)
{
Reals_ConvertL(x, n, (void*)d, d__len);
}
-static CHAR Reals_ToHex (INTEGER i)
+static CHAR Reals_ToHex (INT16 i)
{
- CHAR _o_result;
if (i < 10) {
- _o_result = (CHAR)(i + 48);
- return _o_result;
+ return (CHAR)(i + 48);
} else {
- _o_result = (CHAR)(i + 55);
- return _o_result;
+ return (CHAR)(i + 55);
}
__RETCHK;
}
static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len)
{
- INTEGER i;
- LONGINT l;
+ INT16 i;
+ INT32 l;
CHAR by;
i = 0;
l = b__len;
- while ((int)i < l) {
+ while (i < l) {
by = __VAL(CHAR, b[__X(i, b__len)]);
- d[__X(__ASHL(i, 1), d__len)] = Reals_ToHex(__ASHR((int)by, 4));
- d[__X(__ASHL(i, 1) + 1, d__len)] = Reals_ToHex(__MASK((int)by, -16));
+ d[__X(__ASHL(i, 1), d__len)] = Reals_ToHex(__ASHR((INT16)by, 4));
+ d[__X(__ASHL(i, 1) + 1, d__len)] = Reals_ToHex(__MASK((INT16)by, -16));
i += 1;
}
}
void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len)
{
- Reals_BytesToHex((void*)&y, ((LONGINT)(4)), (void*)d, d__len * ((LONGINT)(1)));
+ Reals_BytesToHex((void*)&y, 4, (void*)d, d__len * 1);
}
void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len)
{
- Reals_BytesToHex((void*)&x, ((LONGINT)(8)), (void*)d, d__len * ((LONGINT)(1)));
+ Reals_BytesToHex((void*)&x, 8, (void*)d, d__len * 1);
}
diff --git a/bootstrap/unix-44/Reals.h b/bootstrap/unix-44/Reals.h
index 7e6b534c..f0c84ab1 100644
--- a/bootstrap/unix-44/Reals.h
+++ b/bootstrap/unix-44/Reals.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Reals__h
#define Reals__h
@@ -8,16 +8,16 @@
-import void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT 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, INTEGER n, CHAR *d, LONGINT d__len);
-import INTEGER Reals_Expo (REAL x);
-import INTEGER Reals_ExpoL (LONGREAL x);
-import void Reals_SetExpo (REAL *x, INTEGER ex);
-import REAL Reals_Ten (INTEGER e);
-import LONGREAL Reals_TenL (INTEGER e);
+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);
+import REAL Reals_Ten (INT16 e);
+import LONGREAL Reals_TenL (INT16 e);
import void *Reals__init(void);
-#endif
+#endif // Reals
diff --git a/bootstrap/unix-44/SYSTEM.c b/bootstrap/unix-44/SYSTEM.c
deleted file mode 100644
index 33511a70..00000000
--- a/bootstrap/unix-44/SYSTEM.c
+++ /dev/null
@@ -1,207 +0,0 @@
-/*
-* The body prefix file of the voc(jet backend) runtime system, Version 1.0
-*
-* Copyright (c) Software Templ, 1994, 1995
-*
-* Module SYSTEM is subject to change any time without prior notification.
-* Software Templ disclaims all warranties with regard to module SYSTEM,
-* in particular shall Software Templ not be liable for any damage resulting
-* from inappropriate use or modification of module SYSTEM.
-*
-* Version 1.1 jt, 24.11.95 fixes for correct pointer arithmetic on Cray computers
-* jt 31.1.2007 ANSI prototypes for malloc and exit in order to avoid cc warnings
-*
-*/
-
-#include "SYSTEM.h"
-#include "stdarg.h"
-#include
-
-
-LONGINT SYSTEM_XCHK(LONGINT i, LONGINT ub) {return __X(i, ub);}
-LONGINT SYSTEM_RCHK(LONGINT i, LONGINT ub) {return __R(i, ub);}
-LONGINT SYSTEM_ASH (LONGINT i, LONGINT n) {return __ASH(i, n);}
-LONGINT SYSTEM_ABS (LONGINT i) {return __ABS(i);}
-double SYSTEM_ABSD(double i) {return __ABS(i);}
-
-void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0)
-{
- t -= __TPROC0OFF;
- t0 -= __TPROC0OFF;
- while (*t0 != __EOM) {*t = *t0; t--; t0--;}
-}
-
-
-void SYSTEM_ENUMP(void *adr, LONGINT n, void (*P)())
-{
- while (n > 0) {
- P((LONGINT)(SYSTEM_ADDRESS)(*((void**)(adr))));
- adr = ((void**)adr) + 1;
- n--;
- }
-}
-
-void SYSTEM_ENUMR(void *adr, LONGINT *typ, LONGINT size, LONGINT n, void (*P)())
-{
- LONGINT *t, off;
- typ++;
- while (n > 0) {
- t = typ;
- off = *t;
- while (off >= 0) {P(*(LONGINT*)((char*)adr+off)); t++; off = *t;}
- adr = ((char*)adr) + size;
- n--;
- }
-}
-
-LONGINT SYSTEM_DIV(U_LONGINT x, U_LONGINT y)
-{ if ((LONGINT) x >= 0) return (x / y);
- else return -((y - 1 - x) / y);
-}
-
-LONGINT SYSTEM_MOD(U_LONGINT x, U_LONGINT y)
-{ U_LONGINT m;
- if ((LONGINT) x >= 0) return (x % y);
- else { m = (-x) % y;
- if (m != 0) return (y - m); else return 0;
- }
-}
-
-LONGINT SYSTEM_ENTIER(double x)
-{
- LONGINT y;
- if (x >= 0)
- return (LONGINT)x;
- else {
- y = (LONGINT)x;
- if (y <= x) return y; else return y - 1;
- }
-}
-
-extern void Heap_Lock();
-extern void Heap_Unlock();
-
-SYSTEM_PTR SYSTEM_NEWARR(LONGINT *typ, LONGINT elemsz, int elemalgn, int nofdim, int nofdyn, ...)
-{
- LONGINT nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off;
- va_list ap;
- va_start(ap, nofdyn);
- nofelems = 1;
- while (nofdim > 0) {
- nofelems = nofelems * va_arg(ap, LONGINT); nofdim--;
- if (nofelems <= 0) __HALT(-20);
- }
- va_end(ap);
- dataoff = nofdyn * sizeof(LONGINT);
- if (elemalgn > sizeof(LONGINT)) {
- n = dataoff % elemalgn;
- if (n != 0) dataoff += elemalgn - n;
- }
- size = dataoff + nofelems * elemsz;
- Heap_Lock();
- if (typ == NIL) {
- /* element typ does not contain pointers */
- x = Heap_NEWBLK(size);
- }
- else if (typ == (LONGINT*)POINTER__typ) {
- /* element type is a pointer */
- x = Heap_NEWBLK(size + nofelems * sizeof(LONGINT));
- p = (LONGINT*)(SYSTEM_ADDRESS)x[-1];
- p[-nofelems] = *p; /* build new type desc in situ: 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */
- p -= nofelems - 1; n = 1; /* n =1 for skipping the size field */
- while (n <= nofelems) {*p = n*sizeof(LONGINT); p++; n++;}
- *p = - (nofelems + 1) * sizeof(LONGINT); /* sentinel */
- x[-1] -= nofelems * sizeof(LONGINT);
- }
- else {
- /* element type is a record that contains pointers */
- ptab = typ + 1; nofptrs = 0;
- while (ptab[nofptrs] >= 0) {nofptrs++;} /* number of pointers per element */
- nptr = nofelems * nofptrs; /* total number of pointers */
- x = Heap_NEWBLK(size + nptr * sizeof(LONGINT));
- p = (LONGINT*)(SYSTEM_ADDRESS)x[- 1];
- p[-nptr] = *p; /* build new type desc in situ; 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */
- p -= nptr - 1; n = 0; off = dataoff;
- while (n < nofelems) {i = 0;
- while (i < nofptrs) {*p = off + ptab[i]; p++; i++;}
- off += elemsz; n++;
- }
- *p = - (nptr + 1) * sizeof(LONGINT); /* sentinel */
- x[-1] -= nptr * sizeof(LONGINT);
- }
- if (nofdyn != 0) {
- /* setup len vector for index checks */
- va_start(ap, nofdyn);
- p = x;
- while (nofdyn > 0) {*p = va_arg(ap, LONGINT); p++, nofdyn--;}
- va_end(ap);
- }
- Heap_Unlock();
- return x;
-}
-
-
-
-
-typedef void (*SystemSignalHandler)(INTEGER); // = Platform_SignalHandler
-
-#ifndef _WIN32
-
- SystemSignalHandler handler[3] = {0};
-
- // Provide signal handling for Unix based systems
- void signalHandler(int s) {
- if (s >= 2 && s <= 4) handler[s-2](s);
- // (Ignore other signals)
- }
-
- void SystemSetHandler(int s, SYSTEM_ADDRESS h) {
- if (s >= 2 && s <= 4) {
- int needtosetsystemhandler = handler[s-2] == 0;
- handler[s-2] = (SystemSignalHandler)h;
- if (needtosetsystemhandler) {signal(s, signalHandler);}
- }
- }
-
-#else
-
- // Provides Windows callback handlers for signal-like scenarios
- #include "WindowsWrapper.h"
-
- SystemSignalHandler SystemInterruptHandler = 0;
- SystemSignalHandler SystemQuitHandler = 0;
- BOOL ConsoleCtrlHandlerSet = FALSE;
-
- BOOL WINAPI SystemConsoleCtrlHandler(DWORD ctrlType) {
- if ((ctrlType == CTRL_C_EVENT) || (ctrlType == CTRL_BREAK_EVENT)) {
- if (SystemInterruptHandler) {
- SystemInterruptHandler(2); // SIGINT
- return TRUE;
- }
- } else { // Close, logoff or shutdown
- if (SystemQuitHandler) {
- SystemQuitHandler(3); // SIGQUIT
- return TRUE;
- }
- }
- return FALSE;
- }
-
- void EnsureConsoleCtrlHandler() {
- if (!ConsoleCtrlHandlerSet) {
- SetConsoleCtrlHandler(SystemConsoleCtrlHandler, TRUE);
- ConsoleCtrlHandlerSet = TRUE;
- }
- }
-
- void SystemSetInterruptHandler(SYSTEM_ADDRESS h) {
- EnsureConsoleCtrlHandler();
- SystemInterruptHandler = (SystemSignalHandler)h;
- }
-
- void SystemSetQuitHandler(SYSTEM_ADDRESS h) {
- EnsureConsoleCtrlHandler();
- SystemQuitHandler = (SystemSignalHandler)h;
- }
-
-#endif
diff --git a/bootstrap/unix-44/SYSTEM.h b/bootstrap/unix-44/SYSTEM.h
deleted file mode 100644
index 6377745e..00000000
--- a/bootstrap/unix-44/SYSTEM.h
+++ /dev/null
@@ -1,295 +0,0 @@
-#ifndef SYSTEM__h
-#define SYSTEM__h
-
-#if defined(_WIN64)
- typedef long long SYSTEM_INT64;
- typedef unsigned long long SYSTEM_CARD64;
-#else
- typedef long SYSTEM_INT64;
- typedef unsigned long SYSTEM_CARD64;
-#endif
-
-typedef int SYSTEM_INT32;
-typedef unsigned int SYSTEM_CARD32;
-typedef short int SYSTEM_INT16;
-typedef unsigned short int SYSTEM_CARD16;
-typedef signed char SYSTEM_INT8;
-typedef unsigned char SYSTEM_CARD8;
-
-#if (__SIZEOF_POINTER__ == 8) || defined(_WIN64) || defined(__LP64__)
- #if defined(_WIN64)
- typedef unsigned long long size_t;
- #else
- typedef unsigned long size_t;
- #endif
-#else
- typedef unsigned int size_t;
-#endif
-
-#define SYSTEM_ADDRESS size_t
-#define _SIZE_T_DECLARED // For FreeBSD
-#define _SIZE_T_DEFINED_ // For OpenBSD
-
-void *memcpy(void *dest, const void *source, SYSTEM_ADDRESS size);
-
-
-
-// The compiler uses 'import' and 'export' which translate to 'extern' and
-// nothing respectively.
-
-#define import extern
-#define export
-
-
-
-// Known constants
-
-#define NIL ((void*)0)
-#define __MAXEXT 16
-#define POINTER__typ ((LONGINT*)(1)) // not NIL and not a valid type
-
-
-// Oberon types
-
-typedef char BOOLEAN;
-typedef unsigned char SYSTEM_BYTE;
-typedef unsigned char CHAR;
-typedef signed char SHORTINT;
-typedef float REAL;
-typedef double LONGREAL;
-typedef void* SYSTEM_PTR;
-
-// Unsigned variants are for use by shift and rotate macros.
-
-typedef unsigned char U_SYSTEM_BYTE;
-typedef unsigned char U_CHAR;
-typedef unsigned char U_SHORTINT;
-
-// For 32 bit builds, the size of LONGINT depends on a make option:
-
-#if (__SIZEOF_POINTER__ == 8) || defined(LARGE) || defined(_WIN64)
- typedef int INTEGER; // INTEGER is 32 bit.
- typedef long long LONGINT; // LONGINT is 64 bit. (long long is always 64 bits, while long can be 32 bits e.g. under MSC/MingW)
- typedef unsigned int U_INTEGER;
- typedef unsigned long long U_LONGINT;
-#else
- typedef short int INTEGER; // INTEGER is 16 bit.
- typedef long LONGINT; // LONGINT is 32 bit.
- typedef unsigned short int U_INTEGER;
- typedef unsigned long U_LONGINT;
-#endif
-
-typedef U_LONGINT SET;
-typedef U_LONGINT U_SET;
-
-
-// OS Memory allocation interfaces are in PlatformXXX.Mod
-
-extern LONGINT Platform_OSAllocate (LONGINT size);
-extern void Platform_OSFree (LONGINT addr);
-
-
-// Run time system routines in SYSTEM.c
-
-extern LONGINT SYSTEM_XCHK (LONGINT i, LONGINT ub);
-extern LONGINT SYSTEM_RCHK (LONGINT i, LONGINT ub);
-extern LONGINT SYSTEM_ASH (LONGINT i, LONGINT n);
-extern LONGINT SYSTEM_ABS (LONGINT i);
-extern double SYSTEM_ABSD (double i);
-extern void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0);
-extern void SYSTEM_ENUMP (void *adr, LONGINT n, void (*P)());
-extern void SYSTEM_ENUMR (void *adr, LONGINT *typ, LONGINT size, LONGINT n, void (*P)());
-extern LONGINT SYSTEM_DIV (U_LONGINT x, U_LONGINT y);
-extern LONGINT SYSTEM_MOD (U_LONGINT x, U_LONGINT y);
-extern LONGINT SYSTEM_ENTIER (double x);
-
-
-// Signal handling in SYSTEM.c
-
-#ifndef _WIN32
- extern void SystemSetHandler(int s, SYSTEM_ADDRESS h);
-#else
- extern void SystemSetInterruptHandler(SYSTEM_ADDRESS h);
- extern void SystemSetQuitHandler (SYSTEM_ADDRESS h);
-#endif
-
-
-
-// String comparison
-
-static int __str_cmp(CHAR *x, CHAR *y){
- LONGINT i = 0;
- CHAR ch1, ch2;
- do {ch1 = x[i]; ch2 = y[i]; i++;
- if (!ch1) return -(int)ch2;
- } while (ch1==ch2);
- return (int)ch1 - (int)ch2;
-}
-#define __STRCMP(a,b) __str_cmp((CHAR*)(a), (CHAR*)(b))
-
-
-
-// Inline string, record and array copy
-
-#define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d; LONGINT _i=0,_t=n-1; \
- while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;}
-#define __DUP(x, l, t) x=(void*)memcpy((void*)(SYSTEM_ADDRESS)Platform_OSAllocate(l*sizeof(t)),x,l*sizeof(t))
-#define __DUPARR(v, t) v=(void*)memcpy(v##__copy,v,sizeof(t))
-#define __DEL(x) Platform_OSFree((LONGINT)(SYSTEM_ADDRESS)x)
-
-
-
-
-/* SYSTEM ops */
-
-#define __VAL(t, x) (*(t*)&(x))
-
-
-#define __GET(a, x, t) x= *(t*)(SYSTEM_ADDRESS)(a)
-#define __PUT(a, x, t) *(t*)(SYSTEM_ADDRESS)(a)=x
-
-#define __LSHL(x, n, t) ((t)((U_##t)(x)<<(n)))
-#define __LSHR(x, n, t) ((t)((U_##t)(x)>>(n)))
-#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t))
-
-#define __ASHL(x, n) ((LONGINT)(x)<<(n))
-#define __ASHR(x, n) ((LONGINT)(x)>>(n))
-#define __ASH(x, n) ((n)>=0?__ASHL(x,n):__ASHR(x,-(n)))
-
-#define __ROTL(x, n, t) ((t)((U_##t)(x)<<(n)|(U_##t)(x)>>(8*sizeof(t)-(n))))
-#define __ROTR(x, n, t) ((t)((U_##t)(x)>>(n)|(U_##t)(x)<<(8*sizeof(t)-(n))))
-#define __ROT(x, n, t) ((n)>=0? __ROTL(x, n, t): __ROTR(x, -(n), t))
-
-#define __BIT(x, n) (*(U_LONGINT*)(x)>>(n)&1)
-#define __MOVE(s, d, n) memcpy((char*)(SYSTEM_ADDRESS)(d),(char*)(SYSTEM_ADDRESS)(s),n)
-#define __ASHF(x, n) SYSTEM_ASH((LONGINT)(x), (LONGINT)(n))
-#define __SHORT(x, y) ((int)((U_LONGINT)(x)+(y)<(y)+(y)?(x):(__HALT(-8),0)))
-#define __SHORTF(x, y) ((int)(__RF((x)+(y),(y)+(y))-(y)))
-#define __CHR(x) ((CHAR)__R(x, 256))
-#define __CHRF(x) ((CHAR)__RF(x, 256))
-#define __DIV(x, y) ((x)>=0?(x)/(y):-(((y)-1-(x))/(y)))
-#define __DIVF(x, y) SYSTEM_DIV((LONGINT)(x),(LONGINT)(y))
-#define __MOD(x, y) ((x)>=0?(x)%(y):__MODF(x,y))
-#define __MODF(x, y) SYSTEM_MOD((LONGINT)(x),(LONGINT)(y))
-#define __ENTIER(x) SYSTEM_ENTIER(x)
-#define __ABS(x) (((x)<0)?-(x):(x))
-#define __ABSF(x) SYSTEM_ABS((LONGINT)(x))
-#define __ABSFD(x) SYSTEM_ABSD((double)(x))
-#define __CAP(ch) ((CHAR)((ch)&0x5f))
-#define __ODD(x) ((x)&1)
-#define __IN(x, s) (((s)>>(x))&1)
-#define __SETOF(x) ((SET)1<<(x))
-#define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h)))
-#define __MASK(x, m) ((x)&~(m))
-
-
-
-// Runtime checks
-
-#define __X(i, ub) (((U_LONGINT)(i)<(U_LONGINT)(ub))?i:(__HALT(-2),0))
-#define __XF(i, ub) SYSTEM_XCHK((LONGINT)(i), (LONGINT)(ub))
-#define __R(i, ub) (((U_LONGINT)(i)<(U_LONGINT)(ub))?i:(__HALT(-8),0))
-#define __RF(i, ub) SYSTEM_RCHK((LONGINT)(i),(LONGINT)(ub))
-#define __RETCHK __retchk: __HALT(-3); return 0;
-#define __CASECHK __HALT(-4)
-#define __WITHCHK __HALT(-7)
-
-#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p)))
-#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r))))
-#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p)))
-#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p)
-#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p)
-
-
-
-// Module entry/registration/exit
-
-extern void Heap_REGCMD();
-extern SYSTEM_PTR Heap_REGMOD();
-extern void Heap_REGTYP();
-extern void Heap_INCREF();
-
-#define __DEFMOD static void *m; if (m!=0) {return m;}
-#define __REGCMD(name, cmd) Heap_REGCMD(m, (CHAR*)name, cmd)
-#define __REGMOD(name, enum) if (m==0) {m = Heap_REGMOD((CHAR*)name,enum);}
-#define __ENDMOD return m
-#define __MODULE_IMPORT(name) Heap_INCREF(name##__init())
-
-
-
-// Main module initialisation, registration and finalisation
-
-extern void Platform_Init(INTEGER argc, LONGINT argv);
-extern void Heap_FINALL();
-
-#define __INIT(argc, argv) static void *m; Platform_Init((INTEGER)argc, (LONGINT)(SYSTEM_ADDRESS)&argv);
-#define __REGMAIN(name, enum) m = Heap_REGMOD((CHAR*)name,enum)
-#define __FINI Heap_FINALL(); return 0
-
-
-// Assertions and Halts
-
-extern void Platform_Halt(LONGINT x);
-extern void Platform_AssertFail(LONGINT x);
-
-#define __HALT(x) Platform_Halt(x)
-#define __ASSERT(cond, x) if (!(cond)) Platform_AssertFail((LONGINT)(x))
-
-
-// Memory allocation
-
-extern SYSTEM_PTR Heap_NEWBLK (LONGINT size);
-extern SYSTEM_PTR Heap_NEWREC (LONGINT tag);
-extern SYSTEM_PTR SYSTEM_NEWARR(LONGINT*, LONGINT, int, int, int, ...);
-
-#define __SYSNEW(p, len) p = Heap_NEWBLK((LONGINT)(len))
-#define __NEW(p, t) p = Heap_NEWREC((LONGINT)(SYSTEM_ADDRESS)t##__typ)
-#define __NEWARR SYSTEM_NEWARR
-
-
-
-/* Type handling */
-
-#define __TDESC(t, m, n) \
- static struct t##__desc { \
- LONGINT tproc[m]; /* Proc for each ptr field */ \
- LONGINT tag; \
- LONGINT next; /* Module table type list points here */ \
- LONGINT level; \
- LONGINT module; \
- char name[24]; \
- LONGINT basep[__MAXEXT]; /* List of bases this extends */ \
- LONGINT reserved; \
- LONGINT blksz; /* xxx_typ points here */ \
- LONGINT ptr[n+1]; /* Offsets of ptrs up to -ve sentinel */ \
- } t##__desc
-
-#define __BASEOFF (__MAXEXT+1) // blksz as index to base.
-#define __TPROC0OFF (__BASEOFF+24/sizeof(LONGINT)+5) // blksz as index to tproc IFF m=1.
-#define __EOM 1
-#define __TDFLDS(name, size) {__EOM}, 1, 0, 0, 0, name, {0}, 0, size
-#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (LONGINT)(n), P)
-#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (LONGINT)(size), (LONGINT)(n), P)
-
-#define __INITYP(t, t0, level) \
- t##__typ = (LONGINT*)&t##__desc.blksz; \
- memcpy(t##__desc.basep, t0##__typ - __BASEOFF, level*sizeof(LONGINT)); \
- t##__desc.basep[level] = (LONGINT)(SYSTEM_ADDRESS)t##__typ; \
- t##__desc.module = (LONGINT)(SYSTEM_ADDRESS)m; \
- if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \
- t##__desc.blksz = (t##__desc.blksz+5*sizeof(LONGINT)-1)/(4*sizeof(LONGINT))*(4*sizeof(LONGINT)); \
- Heap_REGTYP(m, (LONGINT)(SYSTEM_ADDRESS)&t##__desc.next); \
- SYSTEM_INHERIT(t##__typ, t0##__typ)
-
-#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(LONGINT)(SYSTEM_ADDRESS)typ##__typ)
-#define __TYPEOF(p) ((LONGINT*)(SYSTEM_ADDRESS)(*(((LONGINT*)(p))-1)))
-#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level)
-
-// Oberon-2 type bound procedures support
-#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(LONGINT)(SYSTEM_ADDRESS)proc
-#define __SEND(typ, num, funtyp, parlist) ((funtyp)((SYSTEM_ADDRESS)*(typ-(__TPROC0OFF+num))))parlist
-
-
-
-
-#endif
diff --git a/bootstrap/unix-44/Strings.c b/bootstrap/unix-44/Strings.c
index 115456ea..b5707327 100644
--- a/bootstrap/unix-44/Strings.c
+++ b/bootstrap/unix-44/Strings.c
@@ -1,4 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
@@ -6,49 +12,53 @@
export void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len);
export void Strings_Cap (CHAR *s, LONGINT s__len);
-export void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n);
-export void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len);
-export void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len);
-export INTEGER Strings_Length (CHAR *s, LONGINT s__len);
+export 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 INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos);
-export void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len);
+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);
-INTEGER Strings_Length (CHAR *s, LONGINT s__len)
+INT16 Strings_Length (CHAR *s, LONGINT s__len)
{
- INTEGER _o_result;
- INTEGER i;
+ INT32 i;
__DUP(s, s__len, CHAR);
i = 0;
- while (((int)i < s__len && s[__X(i, s__len)] != 0x00)) {
+ while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
i += 1;
}
- _o_result = i;
- __DEL(s);
- return _o_result;
+ if (i <= 32767) {
+ __DEL(s);
+ return (INT16)i;
+ } else {
+ __DEL(s);
+ return 32767;
+ }
+ __RETCHK;
}
void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len)
{
- INTEGER n1, n2, i;
+ INT16 n1, n2, i;
__DUP(extra, extra__len, CHAR);
n1 = Strings_Length(dest, dest__len);
n2 = Strings_Length(extra, extra__len);
i = 0;
- while ((i < n2 && (int)(i + n1) < dest__len)) {
+ while ((i < n2 && (i + n1) < dest__len)) {
dest[__X(i + n1, dest__len)] = extra[__X(i, extra__len)];
i += 1;
}
- if ((int)(i + n1) < dest__len) {
+ if ((i + n1) < dest__len) {
dest[__X(i + n1, dest__len)] = 0x00;
}
__DEL(extra);
}
-void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len)
+void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len)
{
- INTEGER n1, n2, i;
+ INT16 n1, n2, i;
__DUP(source, source__len, CHAR);
n1 = Strings_Length(dest, dest__len);
n2 = Strings_Length(source, source__len);
@@ -57,12 +67,13 @@ void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest,
}
if (pos > n1) {
Strings_Append(dest, dest__len, (void*)source, source__len);
+ __DEL(source);
return;
}
- if ((int)(pos + n2) < dest__len) {
+ if ((pos + n2) < dest__len) {
i = n1;
while (i >= pos) {
- if ((int)(i + n2) < dest__len) {
+ if ((i + n2) < dest__len) {
dest[__X(i + n2, dest__len)] = dest[__X(i, dest__len)];
}
i -= 1;
@@ -76,9 +87,9 @@ void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest,
__DEL(source);
}
-void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n)
+void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n)
{
- INTEGER len, i;
+ INT16 len, i;
len = Strings_Length(s, s__len);
if (pos < 0) {
pos = 0;
@@ -91,7 +102,7 @@ void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n)
s[__X(i - n, s__len)] = s[__X(i, s__len)];
i += 1;
}
- if ((int)(i - n) < s__len) {
+ if ((i - n) < s__len) {
s[__X(i - n, s__len)] = 0x00;
}
} else {
@@ -99,7 +110,7 @@ void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n)
}
}
-void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT 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));
@@ -107,21 +118,22 @@ void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest
__DEL(source);
}
-void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len)
+void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len)
{
- INTEGER len, destLen, i;
+ INT16 len, destLen, i;
__DUP(source, source__len, CHAR);
len = Strings_Length(source, source__len);
- destLen = (int)dest__len - 1;
+ destLen = (INT16)dest__len - 1;
if (pos < 0) {
pos = 0;
}
if (pos >= len) {
dest[0] = 0x00;
+ __DEL(source);
return;
}
i = 0;
- while (((((int)(pos + i) <= source__len && source[__X(pos + i, source__len)] != 0x00)) && i < n)) {
+ while (((((pos + i) <= source__len && source[__X(pos + i, source__len)] != 0x00)) && i < n)) {
if (i < destLen) {
dest[__X(i, dest__len)] = source[__X(pos + i, source__len)];
}
@@ -131,19 +143,17 @@ void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n,
__DEL(source);
}
-INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos)
+INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos)
{
- INTEGER _o_result;
- INTEGER n1, n2, i, j;
+ INT16 n1, n2, i, j;
__DUP(pattern, pattern__len, CHAR);
__DUP(s, s__len, CHAR);
n1 = Strings_Length(s, s__len);
n2 = Strings_Length(pattern, pattern__len);
if (n2 == 0) {
- _o_result = 0;
__DEL(pattern);
__DEL(s);
- return _o_result;
+ return 0;
}
i = pos;
while (i <= n1 - n2) {
@@ -153,23 +163,21 @@ INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__le
j += 1;
}
if (j == n2) {
- _o_result = i;
__DEL(pattern);
__DEL(s);
- return _o_result;
+ return i;
}
}
i += 1;
}
- _o_result = -1;
__DEL(pattern);
__DEL(s);
- return _o_result;
+ return -1;
}
void Strings_Cap (CHAR *s, LONGINT s__len)
{
- INTEGER i;
+ INT16 i;
i = 0;
while (s[__X(i, s__len)] != 0x00) {
if (('a' <= s[__X(i, s__len)] && s[__X(i, s__len)] <= 'z')) {
@@ -183,54 +191,49 @@ static struct Match__7 {
struct Match__7 *lnk;
} *Match__7_s;
-static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INTEGER n, INTEGER m);
+static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INT16 n, INT16 m);
-static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INTEGER n, INTEGER m)
+static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INT16 n, INT16 m)
{
- BOOLEAN _o_result;
while ((((n >= 0 && m >= 0)) && mask[__X(m, mask__len)] != '*')) {
if (name[__X(n, name__len)] != mask[__X(m, mask__len)]) {
- _o_result = 0;
- return _o_result;
+ return 0;
}
n -= 1;
m -= 1;
}
if (m < 0) {
- _o_result = n < 0;
- return _o_result;
+ return n < 0;
}
while ((m >= 0 && mask[__X(m, mask__len)] == '*')) {
m -= 1;
}
if (m < 0) {
- _o_result = 1;
- return _o_result;
+ return 1;
}
while (n >= 0) {
if (M__8(name, name__len, mask, mask__len, n, m)) {
- _o_result = 1;
- return _o_result;
+ return 1;
}
n -= 1;
}
- _o_result = 0;
- return _o_result;
+ return 0;
}
BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len)
{
- BOOLEAN _o_result;
struct Match__7 _s;
+ BOOLEAN __retval;
__DUP(string, string__len, CHAR);
__DUP(pattern, pattern__len, CHAR);
_s.lnk = Match__7_s;
Match__7_s = &_s;
- _o_result = M__8((void*)string, string__len, (void*)pattern, pattern__len, Strings_Length(string, string__len) - 1, Strings_Length(pattern, pattern__len) - 1);
+ __retval = M__8((void*)string, string__len, (void*)pattern, pattern__len, Strings_Length(string, string__len) - 1, Strings_Length(pattern, pattern__len) - 1);
Match__7_s = _s.lnk;
__DEL(string);
__DEL(pattern);
- return _o_result;
+ ;
+ return __retval;
}
diff --git a/bootstrap/unix-44/Strings.h b/bootstrap/unix-44/Strings.h
index 96dbb01d..c987af8d 100644
--- a/bootstrap/unix-44/Strings.h
+++ b/bootstrap/unix-44/Strings.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Strings__h
#define Strings__h
@@ -10,14 +10,14 @@
import void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len);
import void Strings_Cap (CHAR *s, LONGINT s__len);
-import void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n);
-import void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len);
-import void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len);
-import INTEGER Strings_Length (CHAR *s, LONGINT s__len);
+import 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 INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos);
-import void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len);
+import 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);
-#endif
+#endif // Strings
diff --git a/bootstrap/unix-44/Texts.c b/bootstrap/unix-44/Texts.c
index 9ab3b430..0ac5c5f2 100644
--- a/bootstrap/unix-44/Texts.c
+++ b/bootstrap/unix-44/Texts.c
@@ -1,4 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "Files.h"
#include "Modules.h"
@@ -13,9 +19,9 @@ typedef
typedef
struct Texts_RunDesc {
Texts_Run prev, next;
- LONGINT len;
+ INT32 len;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
BOOLEAN ascii;
} Texts_RunDesc;
@@ -28,7 +34,7 @@ typedef
} Texts_ElemMsg;
typedef
- void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, LONGINT *);
+ void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, ADDRESS *);
typedef
struct Texts_TextDesc *Texts_Text;
@@ -36,26 +42,26 @@ typedef
typedef
struct Texts_ElemDesc {
Texts_Run prev, next;
- LONGINT len;
+ INT32 len;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
BOOLEAN ascii;
- LONGINT W, H;
+ INT32 W, H;
Texts_Handler handle;
Texts_Text base;
} Texts_ElemDesc;
struct Texts__1 { /* Texts_ElemDesc */
Texts_Run prev, next;
- LONGINT len;
+ INT32 len;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
BOOLEAN ascii;
- LONGINT W, H;
+ INT32 W, H;
Texts_Handler handle;
Texts_Text base;
Files_File file;
- LONGINT org, span;
+ INT32 org, span;
CHAR mod[32], proc[32];
};
@@ -64,7 +70,7 @@ typedef
typedef
struct Texts_BufDesc {
- LONGINT len;
+ INT32 len;
Texts_Run head;
} Texts_BufDesc;
@@ -78,8 +84,8 @@ typedef
typedef
struct Texts_FileMsg { /* Texts_ElemMsg */
- INTEGER id;
- LONGINT pos;
+ INT16 id;
+ INT32 pos;
Files_Rider r;
} Texts_FileMsg;
@@ -94,7 +100,7 @@ typedef
} Texts_IdentifyMsg;
typedef
- void (*Texts_Notifier)(Texts_Text, INTEGER, LONGINT, LONGINT);
+ void (*Texts_Notifier)(Texts_Text, INT16, INT32, INT32);
typedef
struct Texts_PieceDesc *Texts_Piece;
@@ -102,57 +108,57 @@ typedef
typedef
struct Texts_PieceDesc {
Texts_Run prev, next;
- LONGINT len;
+ INT32 len;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
BOOLEAN ascii;
Files_File file;
- LONGINT org;
+ INT32 org;
} Texts_PieceDesc;
typedef
struct Texts_Reader {
BOOLEAN eot;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
Texts_Elem elem;
Files_Rider rider;
Texts_Run run;
- LONGINT org, off;
+ INT32 org, off;
} Texts_Reader;
typedef
struct Texts_Scanner { /* Texts_Reader */
BOOLEAN eot;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
Texts_Elem elem;
Files_Rider rider;
Texts_Run run;
- LONGINT org, off;
+ INT32 org, off;
CHAR nextCh;
- INTEGER line, class;
- LONGINT i;
+ INT16 line, class;
+ INT32 i;
REAL x;
LONGREAL y;
CHAR c;
- SHORTINT len;
+ INT8 len;
CHAR s[64];
} Texts_Scanner;
typedef
struct Texts_TextDesc {
- LONGINT len;
+ INT32 len;
Texts_Notifier notify;
Texts_Run head, cache;
- LONGINT corg;
+ INT32 corg;
} Texts_TextDesc;
typedef
struct Texts_Writer {
Texts_Buffer buf;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
Files_Rider rider;
Files_File file;
} Texts_Writer;
@@ -162,84 +168,82 @@ export Texts_Elem Texts_new;
static Texts_Buffer Texts_del;
static Texts_FontsFont Texts_FontsDefault;
-export LONGINT *Texts_FontDesc__typ;
-export LONGINT *Texts_RunDesc__typ;
-export LONGINT *Texts_PieceDesc__typ;
-export LONGINT *Texts_ElemMsg__typ;
-export LONGINT *Texts_ElemDesc__typ;
-export LONGINT *Texts_FileMsg__typ;
-export LONGINT *Texts_CopyMsg__typ;
-export LONGINT *Texts_IdentifyMsg__typ;
-export LONGINT *Texts_BufDesc__typ;
-export LONGINT *Texts_TextDesc__typ;
-export LONGINT *Texts_Reader__typ;
-export LONGINT *Texts_Scanner__typ;
-export LONGINT *Texts_Writer__typ;
-export LONGINT *Texts__1__typ;
+export ADDRESS *Texts_FontDesc__typ;
+export ADDRESS *Texts_RunDesc__typ;
+export ADDRESS *Texts_PieceDesc__typ;
+export ADDRESS *Texts_ElemMsg__typ;
+export ADDRESS *Texts_ElemDesc__typ;
+export ADDRESS *Texts_FileMsg__typ;
+export ADDRESS *Texts_CopyMsg__typ;
+export ADDRESS *Texts_IdentifyMsg__typ;
+export ADDRESS *Texts_BufDesc__typ;
+export ADDRESS *Texts_TextDesc__typ;
+export ADDRESS *Texts_Reader__typ;
+export ADDRESS *Texts_Scanner__typ;
+export ADDRESS *Texts_Writer__typ;
+export ADDRESS *Texts__1__typ;
export void Texts_Append (Texts_Text T, Texts_Buffer B);
-export void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff);
+export void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff);
static Texts_Elem Texts_CloneElem (Texts_Elem e);
static Texts_Piece Texts_ClonePiece (Texts_Piece p);
export void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
export void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
export void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
-export void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end);
+export void Texts_Delete (Texts_Text T, INT32 beg, INT32 end);
export Texts_Text Texts_ElemBase (Texts_Elem E);
-export LONGINT Texts_ElemPos (Texts_Elem E);
-static void Texts_Find (Texts_Text T, LONGINT *pos, Texts_Run *u, LONGINT *org, LONGINT *off);
+export INT32 Texts_ElemPos (Texts_Elem E);
+static void Texts_Find (Texts_Text T, INT32 *pos, Texts_Run *u, INT32 *org, INT32 *off);
static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len);
-static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, LONGINT *msg__typ);
-export void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B);
-export void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T);
-static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T);
+static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, ADDRESS *msg__typ);
+export void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B);
+export void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
+static void Texts_Load0 (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
static void Texts_Merge (Texts_Text T, Texts_Run u, Texts_Run *v);
export void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
export void Texts_OpenBuf (Texts_Buffer B);
-export void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos);
-export void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos);
-export void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ);
-export LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ);
-export void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch);
-export void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ);
-export void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ);
+export void Texts_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);
+export void Texts_OpenWriter (Texts_Writer *W, ADDRESS *W__typ);
+export INT32 Texts_Pos (Texts_Reader *R, ADDRESS *R__typ);
+export void Texts_Read (Texts_Reader *R, ADDRESS *R__typ, CHAR *ch);
+export void Texts_ReadElem (Texts_Reader *R, ADDRESS *R__typ);
+export void Texts_ReadPrevElem (Texts_Reader *R, ADDRESS *R__typ);
export void Texts_Recall (Texts_Buffer *B);
-export void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B);
-export void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ);
-export void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col);
-export void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt);
-export void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff);
+export void Texts_Save (Texts_Text T, INT32 beg, INT32 end, Texts_Buffer B);
+export void Texts_Scan (Texts_Scanner *S, ADDRESS *S__typ);
+export void Texts_SetColor (Texts_Writer *W, ADDRESS *W__typ, INT8 col);
+export void Texts_SetFont (Texts_Writer *W, ADDRESS *W__typ, Texts_FontsFont fnt);
+export void Texts_SetOffset (Texts_Writer *W, ADDRESS *W__typ, INT8 voff);
static void Texts_Splice (Texts_Run un, Texts_Run v, Texts_Run w, Texts_Text base);
-static void Texts_Split (LONGINT off, Texts_Run *u, Texts_Run *un);
-export void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T);
-export void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch);
-export void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d);
-export void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e);
-export void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x);
-export void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n);
-export void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ);
-export void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n);
-export void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x);
-export void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n);
-export void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k);
-export void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x);
-export void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len);
+static void Texts_Split (INT32 off, Texts_Run *u, Texts_Run *un);
+export void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
+export void Texts_Write (Texts_Writer *W, ADDRESS *W__typ, CHAR ch);
+export void Texts_WriteDate (Texts_Writer *W, ADDRESS *W__typ, INT32 t, INT32 d);
+export void Texts_WriteElem (Texts_Writer *W, ADDRESS *W__typ, Texts_Elem e);
+export void Texts_WriteHex (Texts_Writer *W, ADDRESS *W__typ, INT32 x);
+export void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n);
+export void Texts_WriteLn (Texts_Writer *W, ADDRESS *W__typ);
+export void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n);
+export void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x);
+export void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n);
+export void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k);
+export void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x);
+export void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len)
{
- Texts_FontsFont _o_result;
Texts_FontsFont F = NIL;
__NEW(F, Texts_FontDesc);
- __COPY(name, F->name, ((LONGINT)(32)));
- _o_result = F;
- return _o_result;
+ __COPY(name, F->name, 32);
+ return F;
}
-static void Texts_Find (Texts_Text T, LONGINT *pos, Texts_Run *u, LONGINT *org, LONGINT *off)
+static void Texts_Find (Texts_Text T, INT32 *pos, Texts_Run *u, INT32 *org, INT32 *off)
{
Texts_Run v = NIL;
- LONGINT m;
+ INT32 m;
if (*pos >= T->len) {
*pos = T->len;
*u = T->head;
@@ -269,7 +273,7 @@ static void Texts_Find (Texts_Text T, LONGINT *pos, Texts_Run *u, LONGINT *org,
}
}
-static void Texts_Split (LONGINT off, Texts_Run *u, Texts_Run *un)
+static void Texts_Split (INT32 off, Texts_Run *u, Texts_Run *un)
{
Texts_Piece p = NIL, U = NIL;
if (off == 0) {
@@ -332,22 +336,18 @@ static void Texts_Splice (Texts_Run un, Texts_Run v, Texts_Run w, Texts_Text bas
static Texts_Piece Texts_ClonePiece (Texts_Piece p)
{
- Texts_Piece _o_result;
Texts_Piece q = NIL;
__NEW(q, Texts_PieceDesc);
__GUARDEQP(q, Texts_PieceDesc) = *p;
- _o_result = q;
- return _o_result;
+ return q;
}
static Texts_Elem Texts_CloneElem (Texts_Elem e)
{
- Texts_Elem _o_result;
Texts_CopyMsg msg;
msg.e = NIL;
(*e->handle)(e, (void*)&msg, Texts_CopyMsg__typ);
- _o_result = msg.e;
- return _o_result;
+ return msg.e;
}
void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE)
@@ -363,31 +363,27 @@ void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE)
Texts_Text Texts_ElemBase (Texts_Elem E)
{
- Texts_Text _o_result;
- _o_result = E->base;
- return _o_result;
+ return E->base;
}
-LONGINT Texts_ElemPos (Texts_Elem E)
+INT32 Texts_ElemPos (Texts_Elem E)
{
- LONGINT _o_result;
Texts_Run u = NIL;
- LONGINT pos;
+ INT32 pos;
u = E->base->head->next;
pos = 0;
while (u != (void *) E) {
pos = pos + u->len;
u = u->next;
}
- _o_result = pos;
- return _o_result;
+ return pos;
}
-static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, LONGINT *msg__typ)
+static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, ADDRESS *msg__typ)
{
Texts_Alien e = NIL;
Files_Rider r;
- LONGINT i;
+ INT32 i;
CHAR ch;
if (__ISP(E, Texts__1, 2)) {
if (__IS(msg__typ, Texts_CopyMsg, 1)) {
@@ -398,15 +394,15 @@ static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, LONGINT *msg__t
e->file = ((Texts_Alien)E)->file;
e->org = ((Texts_Alien)E)->org;
e->span = ((Texts_Alien)E)->span;
- __COPY(((Texts_Alien)E)->mod, e->mod, ((LONGINT)(32)));
- __COPY(((Texts_Alien)E)->proc, e->proc, ((LONGINT)(32)));
+ __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, ((LONGINT)(32)));
- __COPY(((Texts_Alien)E)->proc, (*msg__).proc, ((LONGINT)(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)) {
@@ -463,10 +459,10 @@ void Texts_Recall (Texts_Buffer *B)
Texts_del = NIL;
}
-void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B)
+void Texts_Save (Texts_Text T, INT32 beg, INT32 end, Texts_Buffer B)
{
Texts_Run u = NIL, v = NIL, w = NIL, wn = NIL;
- LONGINT uo, ud, vo, vd;
+ INT32 uo, ud, vo, vd;
Texts_Find(T, &beg, &u, &uo, &ud);
Texts_Find(T, &end, &v, &vo, &vd);
w = B->head->prev;
@@ -497,11 +493,11 @@ void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B)
B->len += end - beg;
}
-void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B)
+void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B)
{
Texts_Run u = NIL, un = NIL, v = NIL;
Texts_Piece p = NIL, q = NIL;
- LONGINT uo, ud, len;
+ INT32 uo, ud, len;
Texts_Find(T, &pos, &u, &uo, &ud);
Texts_Split(ud, &u, &un);
len = B->len;
@@ -520,7 +516,7 @@ void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B)
void Texts_Append (Texts_Text T, Texts_Buffer B)
{
Texts_Run v = NIL;
- LONGINT pos, len;
+ INT32 pos, len;
pos = T->len;
len = B->len;
v = B->head->next;
@@ -535,10 +531,10 @@ void Texts_Append (Texts_Text T, Texts_Buffer B)
}
}
-void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end)
+void Texts_Delete (Texts_Text T, INT32 beg, INT32 end)
{
Texts_Run c = NIL, u = NIL, un = NIL, v = NIL, vn = NIL;
- LONGINT co, uo, ud, vo, vd;
+ INT32 co, uo, ud, vo, vd;
Texts_Find(T, &beg, &u, &uo, &ud);
Texts_Split(ud, &u, &un);
c = T->cache;
@@ -560,10 +556,10 @@ void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end)
}
}
-void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff)
+void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff)
{
Texts_Run c = NIL, u = NIL, un = NIL, v = NIL, vn = NIL;
- LONGINT co, uo, ud, vo, vd;
+ INT32 co, uo, ud, vo, vd;
Texts_Find(T, &beg, &u, &uo, &ud);
Texts_Split(ud, &u, &un);
c = T->cache;
@@ -573,13 +569,13 @@ void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_F
T->cache = c;
T->corg = co;
while (un != vn) {
- if ((__IN(0, sel) && fnt != NIL)) {
+ if ((__IN(0, sel, 32) && fnt != NIL)) {
un->fnt = fnt;
}
- if (__IN(1, sel)) {
+ if (__IN(1, sel, 32)) {
un->col = col;
}
- if (__IN(2, sel)) {
+ if (__IN(2, sel, 32)) {
un->voff = voff;
}
Texts_Merge(T, u, &un);
@@ -599,7 +595,7 @@ void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_F
}
}
-void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos)
+void Texts_OpenReader (Texts_Reader *R, ADDRESS *R__typ, Texts_Text T, INT32 pos)
{
Texts_Run u = NIL;
if (pos >= T->len) {
@@ -613,10 +609,10 @@ void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT p
}
}
-void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch)
+void Texts_Read (Texts_Reader *R, ADDRESS *R__typ, CHAR *ch)
{
Texts_Run u = NIL;
- LONGINT pos;
+ INT32 pos;
CHAR nextch;
u = (*R).run;
(*R).fnt = u->fnt;
@@ -658,7 +654,7 @@ void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch)
}
}
-void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ)
+void Texts_ReadElem (Texts_Reader *R, ADDRESS *R__typ)
{
Texts_Run u = NIL, un = NIL;
u = (*R).run;
@@ -686,7 +682,7 @@ void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ)
}
}
-void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ)
+void Texts_ReadPrevElem (Texts_Reader *R, ADDRESS *R__typ)
{
Texts_Run u = NIL;
u = (*R).run->prev;
@@ -708,14 +704,12 @@ void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ)
}
}
-LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ)
+INT32 Texts_Pos (Texts_Reader *R, ADDRESS *R__typ)
{
- LONGINT _o_result;
- _o_result = (*R).org + (*R).off;
- return _o_result;
+ return (*R).org + (*R).off;
}
-void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos)
+void Texts_OpenScanner (Texts_Scanner *S, ADDRESS *S__typ, Texts_Text T, INT32 pos)
{
Texts_OpenReader((void*)&*S, S__typ, T, pos);
(*S).line = 0;
@@ -724,10 +718,10 @@ void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT
static struct Scan__31 {
Texts_Scanner *S;
- LONGINT *S__typ;
+ ADDRESS *S__typ;
CHAR *ch;
BOOLEAN *negE;
- INTEGER *e;
+ INT16 *e;
struct Scan__31 *lnk;
} *Scan__31_s;
@@ -746,18 +740,18 @@ static void ReadScaleFactor__32 (void)
}
}
while (('0' <= *Scan__31_s->ch && *Scan__31_s->ch <= '9')) {
- *Scan__31_s->e = (*Scan__31_s->e * 10 + (int)*Scan__31_s->ch) - 48;
+ *Scan__31_s->e = (*Scan__31_s->e * 10 + (INT16)*Scan__31_s->ch) - 48;
Texts_Read((void*)&*Scan__31_s->S, Scan__31_s->S__typ, &*Scan__31_s->ch);
}
}
-void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
+void Texts_Scan (Texts_Scanner *S, ADDRESS *S__typ)
{
CHAR ch, term;
BOOLEAN neg, negE, hex;
- SHORTINT i, j, h;
- INTEGER e;
- LONGINT k;
+ INT8 i, j, h;
+ INT16 e;
+ INT32 k;
REAL x, f;
LONGREAL y, g;
CHAR d[32];
@@ -780,21 +774,21 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
}
if ((('A' <= __CAP(ch) && __CAP(ch) <= 'Z') || ch == '/') || ch == '.') {
do {
- (*S).s[__X(i, ((LONGINT)(64)))] = ch;
+ (*S).s[__X(i, 64)] = ch;
i += 1;
Texts_Read((void*)&*S, S__typ, &ch);
} while (!((((__CAP(ch) > 'Z' && ch != '_') || ('A' > __CAP(ch) && ch > '9')) || ((('0' > ch && ch != '.')) && ch != '/')) || i == 63));
- (*S).s[__X(i, ((LONGINT)(64)))] = 0x00;
+ (*S).s[__X(i, 64)] = 0x00;
(*S).len = i;
(*S).class = 1;
} else if (ch == '"') {
Texts_Read((void*)&*S, S__typ, &ch);
while ((((ch != '"' && ch >= ' ')) && i != 63)) {
- (*S).s[__X(i, ((LONGINT)(64)))] = ch;
+ (*S).s[__X(i, 64)] = ch;
i += 1;
Texts_Read((void*)&*S, S__typ, &ch);
}
- (*S).s[__X(i, ((LONGINT)(64)))] = 0x00;
+ (*S).s[__X(i, 64)] = 0x00;
(*S).len = i + 1;
Texts_Read((void*)&*S, S__typ, &ch);
(*S).class = 2;
@@ -809,7 +803,7 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
hex = 0;
j = 0;
for (;;) {
- d[__X(i, ((LONGINT)(32)))] = ch;
+ d[__X(i, 32)] = ch;
i += 1;
Texts_Read((void*)&*S, S__typ, &ch);
if (ch < '0') {
@@ -818,10 +812,10 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
if ('9' < ch) {
if (('A' <= ch && ch <= 'F')) {
hex = 1;
- ch = (CHAR)((int)ch - 7);
+ ch = (CHAR)((INT16)ch - 7);
} else if (('a' <= ch && ch <= 'f')) {
hex = 1;
- ch = (CHAR)((int)ch - 39);
+ ch = (CHAR)((INT16)ch - 39);
} else {
break;
}
@@ -833,13 +827,13 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
if (i - j > 8) {
j = i - 8;
}
- k = (int)d[__X(j, ((LONGINT)(32)))] - 48;
+ k = (INT16)d[__X(j, 32)] - 48;
j += 1;
if ((i - j == 7 && k >= 8)) {
k -= 16;
}
while (j < i) {
- k = __ASHL(k, 4) + (int)((int)d[__X(j, ((LONGINT)(32)))] - 48);
+ k = __ASHL(k, 4) + ((INT16)d[__X(j, 32)] - 48);
j += 1;
}
if (neg) {
@@ -851,7 +845,7 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
Texts_Read((void*)&*S, S__typ, &ch);
h = i;
while (('0' <= ch && ch <= '9')) {
- d[__X(i, ((LONGINT)(32)))] = ch;
+ d[__X(i, 32)] = ch;
i += 1;
Texts_Read((void*)&*S, S__typ, &ch);
}
@@ -860,12 +854,12 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
y = (LONGREAL)0;
g = (LONGREAL)1;
do {
- y = y * (LONGREAL)10 + ((int)d[__X(j, ((LONGINT)(32)))] - 48);
+ y = y * (LONGREAL)10 + ((INT16)d[__X(j, 32)] - 48);
j += 1;
} while (!(j == h));
while (j < i) {
g = g / (LONGREAL)(LONGREAL)10;
- y = ((int)d[__X(j, ((LONGINT)(32)))] - 48) * g + y;
+ y = ((INT16)d[__X(j, 32)] - 48) * g + y;
j += 1;
}
ReadScaleFactor__32();
@@ -892,12 +886,12 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
x = (REAL)0;
f = (REAL)1;
do {
- x = x * (REAL)10 + ((int)d[__X(j, ((LONGINT)(32)))] - 48);
+ x = x * (REAL)10 + ((INT16)d[__X(j, 32)] - 48);
j += 1;
} while (!(j == h));
while (j < i) {
f = f / (REAL)(REAL)10;
- x = ((int)d[__X(j, ((LONGINT)(32)))] - 48) * f + x;
+ x = ((INT16)d[__X(j, 32)] - 48) * f + x;
j += 1;
}
if (ch == 'E') {
@@ -929,7 +923,7 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
(*S).class = 3;
k = 0;
do {
- k = k * 10 + (int)((int)d[__X(j, ((LONGINT)(32)))] - 48);
+ k = k * 10 + ((INT16)d[__X(j, 32)] - 48);
j += 1;
} while (!(j == i));
if (neg) {
@@ -957,33 +951,33 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
Scan__31_s = _s.lnk;
}
-void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ)
+void Texts_OpenWriter (Texts_Writer *W, ADDRESS *W__typ)
{
__NEW((*W).buf, Texts_BufDesc);
Texts_OpenBuf((*W).buf);
(*W).fnt = Texts_FontsDefault;
(*W).col = 15;
(*W).voff = 0;
- (*W).file = Files_New((CHAR*)"", (LONGINT)1);
- Files_Set(&(*W).rider, Files_Rider__typ, (*W).file, ((LONGINT)(0)));
+ (*W).file = Files_New((CHAR*)"", 1);
+ Files_Set(&(*W).rider, Files_Rider__typ, (*W).file, 0);
}
-void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt)
+void Texts_SetFont (Texts_Writer *W, ADDRESS *W__typ, Texts_FontsFont fnt)
{
(*W).fnt = fnt;
}
-void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col)
+void Texts_SetColor (Texts_Writer *W, ADDRESS *W__typ, INT8 col)
{
(*W).col = col;
}
-void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff)
+void Texts_SetOffset (Texts_Writer *W, ADDRESS *W__typ, INT8 voff)
{
(*W).voff = voff;
}
-void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch)
+void Texts_Write (Texts_Writer *W, ADDRESS *W__typ, CHAR ch)
{
Texts_Run u = NIL, un = NIL;
Texts_Piece p = NIL;
@@ -1009,7 +1003,7 @@ void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch)
}
}
-void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e)
+void Texts_WriteElem (Texts_Writer *W, ADDRESS *W__typ, Texts_Elem e)
{
Texts_Run u = NIL, un = NIL;
if (e->base != NIL) {
@@ -1028,14 +1022,14 @@ void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e)
un->prev = (Texts_Run)e;
}
-void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ)
+void Texts_WriteLn (Texts_Writer *W, ADDRESS *W__typ)
{
Texts_Write(&*W, W__typ, 0x0d);
}
-void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len)
+void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len)
{
- INTEGER i;
+ INT16 i;
__DUP(s, s__len, CHAR);
i = 0;
while (s[__X(i, s__len)] >= ' ') {
@@ -1045,15 +1039,15 @@ void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__le
__DEL(s);
}
-void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n)
+void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n)
{
- INTEGER i;
- LONGINT x0;
- CHAR a[22];
+ INT16 i;
+ INT64 x0;
+ CHAR a[24];
i = 0;
if (x < 0) {
- if (x == (-2147483647-1)) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" -2147483648", (LONGINT)13);
+ if (x == (-9223372036854775807-1)) {
+ Texts_WriteString(&*W, W__typ, (CHAR*)" -9223372036854775808", 22);
return;
} else {
n -= 1;
@@ -1063,11 +1057,11 @@ void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n)
x0 = x;
}
do {
- a[__X(i, ((LONGINT)(22)))] = (CHAR)(__MOD(x0, 10) + 48);
+ a[__X(i, 24)] = (CHAR)(__MOD(x0, 10) + 48);
x0 = __DIV(x0, 10);
i += 1;
} while (!(x0 == 0));
- while (n > (int)i) {
+ while (n > (INT64)i) {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
}
@@ -1076,47 +1070,47 @@ void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n)
}
do {
i -= 1;
- Texts_Write(&*W, W__typ, a[__X(i, ((LONGINT)(22)))]);
+ Texts_Write(&*W, W__typ, a[__X(i, 24)]);
} while (!(i == 0));
}
-void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x)
+void Texts_WriteHex (Texts_Writer *W, ADDRESS *W__typ, INT32 x)
{
- INTEGER i;
- LONGINT y;
+ INT16 i;
+ INT32 y;
CHAR a[20];
i = 0;
Texts_Write(&*W, W__typ, ' ');
do {
y = __MASK(x, -16);
if (y < 10) {
- a[__X(i, ((LONGINT)(20)))] = (CHAR)(y + 48);
+ a[__X(i, 20)] = (CHAR)(y + 48);
} else {
- a[__X(i, ((LONGINT)(20)))] = (CHAR)(y + 55);
+ a[__X(i, 20)] = (CHAR)(y + 55);
}
x = __ASHR(x, 4);
i += 1;
} while (!(i == 8));
do {
i -= 1;
- Texts_Write(&*W, W__typ, a[__X(i, ((LONGINT)(20)))]);
+ Texts_Write(&*W, W__typ, a[__X(i, 20)]);
} while (!(i == 0));
}
-void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n)
+void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n)
{
- INTEGER e;
+ INT16 e;
REAL x0;
CHAR d[9];
e = Reals_Expo(x);
if (e == 0) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" 0", (LONGINT)4);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" 0", 4);
do {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
} while (!(n <= 3));
} else if (e == 255) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", 5);
while (n > 4) {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
@@ -1153,13 +1147,13 @@ void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n)
x = x * 1.0000000e-001;
e += 1;
}
- Reals_Convert(x, n, (void*)d, ((LONGINT)(9)));
+ Reals_Convert(x, n, (void*)d, 9);
n -= 1;
- Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(9)))]);
+ Texts_Write(&*W, W__typ, d[__X(n, 9)]);
Texts_Write(&*W, W__typ, '.');
do {
n -= 1;
- Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(9)))]);
+ Texts_Write(&*W, W__typ, d[__X(n, 9)]);
} while (!(n == 0));
Texts_Write(&*W, W__typ, 'E');
if (e < 0) {
@@ -1175,16 +1169,16 @@ void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n)
static struct WriteRealFix__53 {
Texts_Writer *W;
- LONGINT *W__typ;
- INTEGER *i;
+ ADDRESS *W__typ;
+ INT16 *i;
CHAR (*d)[9];
struct WriteRealFix__53 *lnk;
} *WriteRealFix__53_s;
-static void dig__54 (INTEGER n);
-static void seq__56 (CHAR ch, INTEGER n);
+static void dig__54 (INT16 n);
+static void seq__56 (CHAR ch, INT16 n);
-static void seq__56 (CHAR ch, INTEGER n)
+static void seq__56 (CHAR ch, INT16 n)
{
while (n > 0) {
Texts_Write(&*WriteRealFix__53_s->W, WriteRealFix__53_s->W__typ, ch);
@@ -1192,18 +1186,18 @@ static void seq__56 (CHAR ch, INTEGER n)
}
}
-static void dig__54 (INTEGER n)
+static void dig__54 (INT16 n)
{
while (n > 0) {
*WriteRealFix__53_s->i -= 1;
- Texts_Write(&*WriteRealFix__53_s->W, WriteRealFix__53_s->W__typ, (*WriteRealFix__53_s->d)[__X(*WriteRealFix__53_s->i, ((LONGINT)(9)))]);
+ Texts_Write(&*WriteRealFix__53_s->W, WriteRealFix__53_s->W__typ, (*WriteRealFix__53_s->d)[__X(*WriteRealFix__53_s->i, 9)]);
n -= 1;
}
}
-void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k)
+void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k)
{
- INTEGER e, i;
+ INT16 e, i;
CHAR sign;
REAL x0;
CHAR d[9];
@@ -1222,7 +1216,7 @@ void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, IN
Texts_Write(&*W, W__typ, '0');
seq__56(' ', k + 1);
} else if (e == 255) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", 5);
seq__56(' ', n - 4);
} else {
e = __ASHR((e - 127) * 77, 8);
@@ -1254,7 +1248,7 @@ void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, IN
}
e += 1;
i = k + e;
- Reals_Convert(x, i, (void*)d, ((LONGINT)(9)));
+ Reals_Convert(x, i, (void*)d, 9);
if (e > 0) {
seq__56(' ', ((n - e) - k) - 2);
Texts_Write(&*W, W__typ, sign);
@@ -1273,32 +1267,32 @@ void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, IN
WriteRealFix__53_s = _s.lnk;
}
-void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x)
+void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x)
{
- INTEGER i;
+ INT16 i;
CHAR d[8];
- Reals_ConvertH(x, (void*)d, ((LONGINT)(8)));
+ Reals_ConvertH(x, (void*)d, 8);
i = 0;
do {
- Texts_Write(&*W, W__typ, d[__X(i, ((LONGINT)(8)))]);
+ Texts_Write(&*W, W__typ, d[__X(i, 8)]);
i += 1;
} while (!(i == 8));
}
-void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n)
+void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n)
{
- INTEGER e;
+ INT16 e;
LONGREAL x0;
CHAR d[16];
e = Reals_ExpoL(x);
if (e == 0) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" 0", (LONGINT)4);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" 0", 4);
do {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
} while (!(n <= 3));
} else if (e == 2047) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", 5);
while (n > 4) {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
@@ -1319,7 +1313,7 @@ void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER
} else {
Texts_Write(&*W, W__typ, ' ');
}
- e = (int)__ASHR((int)(e - 1023) * 77, 8);
+ e = (INT16)__ASHR((e - 1023) * 77, 8);
if (e >= 0) {
x = x / (LONGREAL)Reals_TenL(e);
} else {
@@ -1335,13 +1329,13 @@ void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER
x = 1.00000000000000e-001 * x;
e += 1;
}
- Reals_ConvertL(x, n, (void*)d, ((LONGINT)(16)));
+ Reals_ConvertL(x, n, (void*)d, 16);
n -= 1;
- Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(16)))]);
+ Texts_Write(&*W, W__typ, d[__X(n, 16)]);
Texts_Write(&*W, W__typ, '.');
do {
n -= 1;
- Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(16)))]);
+ Texts_Write(&*W, W__typ, d[__X(n, 16)]);
} while (!(n == 0));
Texts_Write(&*W, W__typ, 'D');
if (e < 0) {
@@ -1357,34 +1351,34 @@ void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER
}
}
-void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x)
+void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x)
{
- INTEGER i;
+ INT16 i;
CHAR d[16];
- Reals_ConvertHL(x, (void*)d, ((LONGINT)(16)));
+ Reals_ConvertHL(x, (void*)d, 16);
i = 0;
do {
- Texts_Write(&*W, W__typ, d[__X(i, ((LONGINT)(16)))]);
+ Texts_Write(&*W, W__typ, d[__X(i, 16)]);
i += 1;
} while (!(i == 16));
}
static struct WriteDate__43 {
Texts_Writer *W;
- LONGINT *W__typ;
+ ADDRESS *W__typ;
struct WriteDate__43 *lnk;
} *WriteDate__43_s;
-static void WritePair__44 (CHAR ch, LONGINT x);
+static void WritePair__44 (CHAR ch, INT32 x);
-static void WritePair__44 (CHAR ch, LONGINT x)
+static void WritePair__44 (CHAR ch, INT32 x)
{
Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, ch);
Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, (CHAR)(__DIV(x, 10) + 48));
- Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, (CHAR)(__MOD(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, LONGINT *W__typ, LONGINT t, LONGINT d)
+void Texts_WriteDate (Texts_Writer *W, ADDRESS *W__typ, INT32 t, INT32 d)
{
struct WriteDate__43 _s;
_s.W = W; _s.W__typ = W__typ;
@@ -1401,35 +1395,35 @@ void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d)
static struct Load0__16 {
Texts_Text *T;
- SHORTINT *ecnt;
+ INT8 *ecnt;
Files_File *f;
Texts_FileMsg *msg;
CHAR (*mods)[64][32], (*procs)[64][32];
struct Load0__16 *lnk;
} *Load0__16_s;
-static void LoadElem__17 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, LONGINT span, Texts_Elem *e);
+static void LoadElem__17 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, INT32 span, Texts_Elem *e);
-static void LoadElem__17 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, LONGINT span, Texts_Elem *e)
+static void LoadElem__17 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, INT32 span, Texts_Elem *e)
{
Modules_Module M = NIL;
Modules_Command Cmd;
Texts_Alien a = NIL;
- LONGINT org, ew, eh;
- SHORTINT eno;
+ INT32 org, ew, eh;
+ INT8 eno;
Texts_new = NIL;
Files_ReadLInt(&*r, r__typ, &ew);
Files_ReadLInt(&*r, r__typ, &eh);
Files_Read(&*r, r__typ, (void*)&eno);
if (eno > *Load0__16_s->ecnt) {
*Load0__16_s->ecnt = eno;
- Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32)));
- Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32)));
+ Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->mods)[__X(eno, 64)], 32);
+ Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->procs)[__X(eno, 64)], 32);
}
org = Files_Pos(&*r, r__typ);
- M = Modules_ThisMod((*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32)));
+ M = Modules_ThisMod((*Load0__16_s->mods)[__X(eno, 64)], 32);
if (M != NIL) {
- Cmd = Modules_ThisCommand(M, (*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32)));
+ Cmd = Modules_ThisCommand(M, (*Load0__16_s->procs)[__X(eno, 64)], 32);
if (Cmd != NIL) {
(*Cmd)();
}
@@ -1455,19 +1449,19 @@ static void LoadElem__17 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, LONGINT
a->file = *Load0__16_s->f;
a->org = org;
a->span = span;
- __COPY((*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], a->mod, ((LONGINT)(32)));
- __COPY((*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], a->proc, ((LONGINT)(32)));
+ __COPY((*Load0__16_s->mods)[__X(eno, 64)], a->mod, 32);
+ __COPY((*Load0__16_s->procs)[__X(eno, 64)], a->proc, 32);
*e = (Texts_Elem)a;
}
}
-static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
+static void Texts_Load0 (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
{
Texts_Run u = NIL, un = NIL;
Texts_Piece p = NIL;
Texts_Elem e = NIL;
- LONGINT org, pos, hlen, plen;
- SHORTINT ecnt, fno, fcnt, col, voff;
+ INT32 org, pos, hlen, plen;
+ INT8 ecnt, fcnt, fno, col, voff;
Files_File f = NIL;
Texts_FileMsg msg;
CHAR mods[64][32], procs[64][32];
@@ -1500,8 +1494,8 @@ static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
while (fno != 0) {
if (fno > fcnt) {
fcnt = fno;
- Files_ReadString(&msg.r, Files_Rider__typ, (void*)name, ((LONGINT)(32)));
- fnts[__X(fno, ((LONGINT)(32)))] = Texts_FontsThis((void*)name, ((LONGINT)(32)));
+ Files_ReadString(&msg.r, Files_Rider__typ, (void*)name, 32);
+ fnts[__X(fno, 32)] = Texts_FontsThis((void*)name, 32);
}
Files_Read(&msg.r, Files_Rider__typ, (void*)&col);
Files_Read(&msg.r, Files_Rider__typ, (void*)&voff);
@@ -1535,9 +1529,9 @@ static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
Load0__16_s = _s.lnk;
}
-void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
+void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
{
- INTEGER tag;
+ INT16 tag;
Files_ReadInt(&*r, r__typ, &tag);
if (tag != -4095) {
Files_Set(&*r, r__typ, Files_Base(&*r, r__typ), Files_Pos(&*r, r__typ) - 2);
@@ -1552,13 +1546,13 @@ void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len)
Texts_Run u = NIL;
Texts_Piece p = NIL;
CHAR tag, version;
- LONGINT hlen;
+ INT32 hlen;
__DUP(name, name__len, CHAR);
f = Files_Old(name, name__len);
if (f == NIL) {
- f = Files_New((CHAR*)"", (LONGINT)1);
+ f = Files_New((CHAR*)"", 1);
}
- Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(0)));
+ Files_Set(&r, Files_Rider__typ, f, 0);
Files_Read(&r, Files_Rider__typ, (void*)&tag);
Files_Read(&r, Files_Rider__typ, (void*)&version);
if (tag == 0xf0 || (tag == 0x01 && version == 0xf0)) {
@@ -1570,7 +1564,7 @@ void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len)
u->col = 15;
__NEW(p, Texts_PieceDesc);
if ((tag == 0xf7 && version == 0x07)) {
- Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(28)));
+ Files_Set(&r, Files_Rider__typ, f, 28);
Files_ReadLInt(&r, Files_Rider__typ, &hlen);
Files_Set(&r, Files_Rider__typ, f, 22 + hlen);
Files_ReadLInt(&r, Files_Rider__typ, &T->len);
@@ -1602,35 +1596,35 @@ void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len)
}
static struct Store__39 {
- SHORTINT *ecnt;
+ INT8 *ecnt;
Texts_FileMsg *msg;
Texts_IdentifyMsg *iden;
CHAR (*mods)[64][32], (*procs)[64][32];
struct Store__39 *lnk;
} *Store__39_s;
-static void StoreElem__40 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, Texts_Elem e);
+static void StoreElem__40 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, Texts_Elem e);
-static void StoreElem__40 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, Texts_Elem e)
+static void StoreElem__40 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, Texts_Elem e)
{
Files_Rider r1;
- LONGINT org, span;
- SHORTINT eno;
- __COPY((*Store__39_s->iden).mod, (*Store__39_s->mods)[__X(*Store__39_s->ecnt, ((LONGINT)(64)))], ((LONGINT)(32)));
- __COPY((*Store__39_s->iden).proc, (*Store__39_s->procs)[__X(*Store__39_s->ecnt, ((LONGINT)(64)))], ((LONGINT)(32)));
+ INT32 org, span;
+ INT8 eno;
+ __COPY((*Store__39_s->iden).mod, (*Store__39_s->mods)[__X(*Store__39_s->ecnt, 64)], 32);
+ __COPY((*Store__39_s->iden).proc, (*Store__39_s->procs)[__X(*Store__39_s->ecnt, 64)], 32);
eno = 1;
- while (__STRCMP((*Store__39_s->mods)[__X(eno, ((LONGINT)(64)))], (*Store__39_s->iden).mod) != 0 || __STRCMP((*Store__39_s->procs)[__X(eno, ((LONGINT)(64)))], (*Store__39_s->iden).proc) != 0) {
+ while (__STRCMP((*Store__39_s->mods)[__X(eno, 64)], (*Store__39_s->iden).mod) != 0 || __STRCMP((*Store__39_s->procs)[__X(eno, 64)], (*Store__39_s->iden).proc) != 0) {
eno += 1;
}
Files_Set(&r1, Files_Rider__typ, Files_Base(&*r, r__typ), Files_Pos(&*r, r__typ));
- Files_WriteLInt(&*r, r__typ, ((LONGINT)(0)));
- Files_WriteLInt(&*r, r__typ, ((LONGINT)(0)));
- Files_WriteLInt(&*r, r__typ, ((LONGINT)(0)));
+ Files_WriteLInt(&*r, r__typ, 0);
+ Files_WriteLInt(&*r, r__typ, 0);
+ Files_WriteLInt(&*r, r__typ, 0);
Files_Write(&*r, r__typ, eno);
if (eno == *Store__39_s->ecnt) {
*Store__39_s->ecnt += 1;
- Files_WriteString(&*r, r__typ, (*Store__39_s->iden).mod, ((LONGINT)(32)));
- Files_WriteString(&*r, r__typ, (*Store__39_s->iden).proc, ((LONGINT)(32)));
+ Files_WriteString(&*r, r__typ, (*Store__39_s->iden).mod, 32);
+ Files_WriteString(&*r, r__typ, (*Store__39_s->iden).proc, 32);
}
(*Store__39_s->msg).pos = pos;
org = Files_Pos(&*r, r__typ);
@@ -1641,14 +1635,15 @@ static void StoreElem__40 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, Texts_E
Files_WriteLInt(&r1, Files_Rider__typ, e->H);
}
-void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
+void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
{
Files_Rider r1;
Texts_Run u = NIL, un = NIL;
Texts_Elem e = NIL;
- LONGINT org, pos, delta, hlen, rlen;
- SHORTINT ecnt, fno, fcnt;
+ INT32 org, pos, delta, hlen, rlen;
+ INT8 ecnt, fcnt;
CHAR ch;
+ INT8 fno;
Texts_FileMsg msg;
Texts_IdentifyMsg iden;
CHAR mods[64][32], procs[64][32];
@@ -1665,7 +1660,7 @@ void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
org = Files_Pos(&*r, r__typ);
msg.id = 1;
msg.r = *r;
- Files_WriteLInt(&msg.r, Files_Rider__typ, ((LONGINT)(0)));
+ Files_WriteLInt(&msg.r, Files_Rider__typ, 0);
u = T->head->next;
pos = 0;
delta = 0;
@@ -1679,15 +1674,15 @@ void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
iden.mod[0] = 0x01;
}
if (iden.mod[0] != 0x00) {
- fnts[__X(fcnt, ((LONGINT)(32)))] = u->fnt;
+ fnts[__X(fcnt, 32)] = u->fnt;
fno = 1;
- while (__STRCMP(fnts[__X(fno, ((LONGINT)(32)))]->name, u->fnt->name) != 0) {
+ while (__STRCMP(fnts[__X(fno, 32)]->name, u->fnt->name) != 0) {
fno += 1;
}
Files_Write(&msg.r, Files_Rider__typ, fno);
if (fno == fcnt) {
fcnt += 1;
- Files_WriteString(&msg.r, Files_Rider__typ, u->fnt->name, ((LONGINT)(32)));
+ Files_WriteString(&msg.r, Files_Rider__typ, u->fnt->name, 32);
}
Files_Write(&msg.r, Files_Rider__typ, u->col);
Files_Write(&msg.r, Files_Rider__typ, u->voff);
@@ -1736,12 +1731,12 @@ void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
delta = ((Texts_Piece)u)->len;
while (delta > 1024) {
- Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), ((LONGINT)(1024)));
- Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), ((LONGINT)(1024)));
+ Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, 1024, 1024);
+ Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, 1024, 1024);
delta -= 1024;
}
- Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), delta);
- Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), delta);
+ Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, 1024, delta);
+ Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, 1024, delta);
}
} else __WITHCHK;
} else {
@@ -1755,7 +1750,7 @@ void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
}
__GUARDEQR(r, r__typ, Files_Rider) = msg.r;
if (T->notify != NIL) {
- (*T->notify)(T, 3, ((LONGINT)(0)), ((LONGINT)(0)));
+ (*T->notify)(T, 3, 0, 0);
}
Store__39_s = _s.lnk;
}
@@ -1764,11 +1759,11 @@ void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len)
{
Files_File f = NIL;
Files_Rider r;
- INTEGER i, res;
+ INT16 i, res;
CHAR bak[64];
__DUP(name, name__len, CHAR);
f = Files_New(name, name__len);
- Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(0)));
+ Files_Set(&r, Files_Rider__typ, f, 0);
Files_Write(&r, Files_Rider__typ, 0xf0);
Files_Write(&r, Files_Rider__typ, 0x01);
Texts_Store(&r, Files_Rider__typ, T);
@@ -1776,13 +1771,13 @@ void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len)
while (name[__X(i, name__len)] != 0x00) {
i += 1;
}
- __COPY(name, bak, ((LONGINT)(64)));
- bak[__X(i, ((LONGINT)(64)))] = '.';
- bak[__X(i + 1, ((LONGINT)(64)))] = 'B';
- bak[__X(i + 2, ((LONGINT)(64)))] = 'a';
- bak[__X(i + 3, ((LONGINT)(64)))] = 'k';
- bak[__X(i + 4, ((LONGINT)(64)))] = 0x00;
- Files_Rename(name, name__len, bak, ((LONGINT)(64)), &res);
+ __COPY(name, bak, 64);
+ bak[__X(i, 64)] = '.';
+ bak[__X(i + 1, 64)] = 'B';
+ bak[__X(i + 2, 64)] = 'a';
+ bak[__X(i + 3, 64)] = 'k';
+ bak[__X(i + 4, 64)] = 0x00;
+ Files_Rename(name, name__len, bak, 64, &res);
Files_Register(f);
__DEL(name);
}
diff --git a/bootstrap/unix-44/Texts.h b/bootstrap/unix-44/Texts.h
index 777a6c22..0d5201cb 100644
--- a/bootstrap/unix-44/Texts.h
+++ b/bootstrap/unix-44/Texts.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Texts__h
#define Texts__h
@@ -8,7 +8,7 @@
typedef
struct Texts_BufDesc {
- LONGINT len;
+ INT32 len;
char _prvt0[4];
} Texts_BufDesc;
@@ -30,25 +30,25 @@ typedef
typedef
struct Texts_RunDesc {
- LONGINT _prvt0;
+ INT32 _prvt0;
char _prvt1[15];
} Texts_RunDesc;
typedef
- void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, LONGINT *);
+ void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, ADDRESS *);
typedef
struct Texts_ElemDesc {
char _prvt0[20];
- LONGINT W, H;
+ INT32 W, H;
Texts_Handler handle;
char _prvt1[4];
} Texts_ElemDesc;
typedef
struct Texts_FileMsg { /* Texts_ElemMsg */
- INTEGER id;
- LONGINT pos;
+ INT16 id;
+ INT32 pos;
Files_Rider r;
} Texts_FileMsg;
@@ -69,13 +69,13 @@ typedef
struct Texts_TextDesc *Texts_Text;
typedef
- void (*Texts_Notifier)(Texts_Text, INTEGER, LONGINT, LONGINT);
+ void (*Texts_Notifier)(Texts_Text, INT16, INT32, INT32);
typedef
struct Texts_Reader {
BOOLEAN eot;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
Texts_Elem elem;
char _prvt0[32];
} Texts_Reader;
@@ -84,22 +84,22 @@ typedef
struct Texts_Scanner { /* Texts_Reader */
BOOLEAN eot;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
Texts_Elem elem;
char _prvt0[32];
CHAR nextCh;
- INTEGER line, class;
- LONGINT i;
+ INT16 line, class;
+ INT32 i;
REAL x;
LONGREAL y;
CHAR c;
- SHORTINT len;
+ INT8 len;
CHAR s[64];
} Texts_Scanner;
typedef
struct Texts_TextDesc {
- LONGINT len;
+ INT32 len;
Texts_Notifier notify;
char _prvt0[12];
} Texts_TextDesc;
@@ -108,65 +108,65 @@ typedef
struct Texts_Writer {
Texts_Buffer buf;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
char _prvt0[26];
} Texts_Writer;
import Texts_Elem Texts_new;
-import LONGINT *Texts_FontDesc__typ;
-import LONGINT *Texts_RunDesc__typ;
-import LONGINT *Texts_ElemMsg__typ;
-import LONGINT *Texts_ElemDesc__typ;
-import LONGINT *Texts_FileMsg__typ;
-import LONGINT *Texts_CopyMsg__typ;
-import LONGINT *Texts_IdentifyMsg__typ;
-import LONGINT *Texts_BufDesc__typ;
-import LONGINT *Texts_TextDesc__typ;
-import LONGINT *Texts_Reader__typ;
-import LONGINT *Texts_Scanner__typ;
-import LONGINT *Texts_Writer__typ;
+import ADDRESS *Texts_FontDesc__typ;
+import ADDRESS *Texts_RunDesc__typ;
+import ADDRESS *Texts_ElemMsg__typ;
+import ADDRESS *Texts_ElemDesc__typ;
+import ADDRESS *Texts_FileMsg__typ;
+import ADDRESS *Texts_CopyMsg__typ;
+import ADDRESS *Texts_IdentifyMsg__typ;
+import ADDRESS *Texts_BufDesc__typ;
+import ADDRESS *Texts_TextDesc__typ;
+import ADDRESS *Texts_Reader__typ;
+import ADDRESS *Texts_Scanner__typ;
+import ADDRESS *Texts_Writer__typ;
import void Texts_Append (Texts_Text T, Texts_Buffer B);
-import void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff);
+import void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff);
import void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
import void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
import void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
-import void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end);
+import void Texts_Delete (Texts_Text T, INT32 beg, INT32 end);
import Texts_Text Texts_ElemBase (Texts_Elem E);
-import LONGINT Texts_ElemPos (Texts_Elem E);
-import void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B);
-import void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T);
+import INT32 Texts_ElemPos (Texts_Elem E);
+import void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B);
+import void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
import void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
import void Texts_OpenBuf (Texts_Buffer B);
-import void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos);
-import void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos);
-import void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ);
-import LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ);
-import void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch);
-import void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ);
-import void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ);
+import void Texts_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);
+import void Texts_OpenWriter (Texts_Writer *W, ADDRESS *W__typ);
+import INT32 Texts_Pos (Texts_Reader *R, ADDRESS *R__typ);
+import void Texts_Read (Texts_Reader *R, ADDRESS *R__typ, CHAR *ch);
+import void Texts_ReadElem (Texts_Reader *R, ADDRESS *R__typ);
+import void Texts_ReadPrevElem (Texts_Reader *R, ADDRESS *R__typ);
import void Texts_Recall (Texts_Buffer *B);
-import void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B);
-import void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ);
-import void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col);
-import void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt);
-import void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff);
-import void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T);
-import void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch);
-import void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d);
-import void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e);
-import void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x);
-import void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n);
-import void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ);
-import void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n);
-import void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x);
-import void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n);
-import void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k);
-import void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x);
-import void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len);
+import void Texts_Save (Texts_Text T, INT32 beg, INT32 end, Texts_Buffer B);
+import void Texts_Scan (Texts_Scanner *S, ADDRESS *S__typ);
+import void Texts_SetColor (Texts_Writer *W, ADDRESS *W__typ, INT8 col);
+import void Texts_SetFont (Texts_Writer *W, ADDRESS *W__typ, Texts_FontsFont fnt);
+import void Texts_SetOffset (Texts_Writer *W, ADDRESS *W__typ, INT8 voff);
+import void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
+import void Texts_Write (Texts_Writer *W, ADDRESS *W__typ, CHAR ch);
+import void Texts_WriteDate (Texts_Writer *W, ADDRESS *W__typ, INT32 t, INT32 d);
+import void Texts_WriteElem (Texts_Writer *W, ADDRESS *W__typ, Texts_Elem e);
+import void Texts_WriteHex (Texts_Writer *W, ADDRESS *W__typ, INT32 x);
+import void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n);
+import void Texts_WriteLn (Texts_Writer *W, ADDRESS *W__typ);
+import void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n);
+import void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x);
+import void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n);
+import void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k);
+import void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x);
+import void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
import void *Texts__init(void);
-#endif
+#endif // Texts
diff --git a/bootstrap/unix-44/VT100.c b/bootstrap/unix-44/VT100.c
new file mode 100644
index 00000000..f69fd90e
--- /dev/null
+++ b/bootstrap/unix-44/VT100.c
@@ -0,0 +1,264 @@
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
+#include "SYSTEM.h"
+#include "Out.h"
+#include "Strings.h"
+
+
+export CHAR VT100_CSI[5];
+static CHAR VT100_tmpstr[32];
+
+
+export void VT100_CHA (INT16 n);
+export void VT100_CNL (INT16 n);
+export void VT100_CPL (INT16 n);
+export void VT100_CUB (INT16 n);
+export void VT100_CUD (INT16 n);
+export void VT100_CUF (INT16 n);
+export void VT100_CUP (INT16 n, INT16 m);
+export void VT100_CUU (INT16 n);
+export void VT100_DECTCEMh (void);
+export void VT100_DECTCEMl (void);
+export void VT100_DSR (INT16 n);
+export void VT100_ED (INT16 n);
+export void VT100_EL (INT16 n);
+static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len);
+static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len);
+static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len);
+static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len);
+export void VT100_HVP (INT16 n, INT16 m);
+export void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len);
+export void VT100_RCP (void);
+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, LONGINT attr__len);
+
+
+static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end)
+{
+ CHAR h;
+ while (start < end) {
+ h = str[__X(start, str__len)];
+ str[__X(start, str__len)] = str[__X(end, str__len)];
+ str[__X(end, str__len)] = h;
+ start += 1;
+ end -= 1;
+ }
+}
+
+void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len)
+{
+ CHAR b[21];
+ INT16 s, e;
+ INT8 maxLength;
+ maxLength = 11;
+ if (int_ == (-2147483647-1)) {
+ __MOVE("-2147483648", b, 12);
+ e = 11;
+ } else {
+ if (int_ < 0) {
+ b[0] = '-';
+ int_ = -int_;
+ s = 1;
+ } else {
+ s = 0;
+ }
+ e = s;
+ do {
+ b[__X(e, 21)] = (CHAR)((int)__MOD(int_, 10) + 48);
+ int_ = __DIV(int_, 10);
+ e += 1;
+ } while (!(int_ == 0));
+ b[__X(e, 21)] = 0x00;
+ VT100_Reverse0((void*)b, 21, s, e - 1);
+ }
+ __COPY(b, str, str__len);
+}
+
+static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len)
+{
+ CHAR cmd[9];
+ __DUP(letter, letter__len, CHAR);
+ __COPY(VT100_CSI, cmd, 9);
+ Strings_Append(letter, letter__len, (void*)cmd, 9);
+ Out_String(cmd, 9);
+ __DEL(letter);
+}
+
+static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len)
+{
+ CHAR nstr[2];
+ CHAR cmd[7];
+ __DUP(letter, letter__len, CHAR);
+ VT100_IntToStr(n, (void*)nstr, 2);
+ __COPY(VT100_CSI, cmd, 7);
+ Strings_Append(nstr, 2, (void*)cmd, 7);
+ Strings_Append(letter, letter__len, (void*)cmd, 7);
+ Out_String(cmd, 7);
+ __DEL(letter);
+}
+
+static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len)
+{
+ CHAR nstr[2];
+ CHAR cmd[7];
+ __DUP(letter, letter__len, CHAR);
+ VT100_IntToStr(n, (void*)nstr, 2);
+ __COPY(VT100_CSI, cmd, 7);
+ Strings_Append(letter, letter__len, (void*)cmd, 7);
+ Strings_Append(nstr, 2, (void*)cmd, 7);
+ Out_String(cmd, 7);
+ __DEL(letter);
+}
+
+static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len)
+{
+ CHAR nstr[5], mstr[5];
+ CHAR cmd[12];
+ __DUP(letter, letter__len, CHAR);
+ VT100_IntToStr(n, (void*)nstr, 5);
+ VT100_IntToStr(m, (void*)mstr, 5);
+ __COPY(VT100_CSI, cmd, 12);
+ Strings_Append(nstr, 5, (void*)cmd, 12);
+ Strings_Append((CHAR*)";", 2, (void*)cmd, 12);
+ Strings_Append(mstr, 5, (void*)cmd, 12);
+ Strings_Append(letter, letter__len, (void*)cmd, 12);
+ Out_String(cmd, 12);
+ __DEL(letter);
+}
+
+void VT100_CUU (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"A", 2);
+}
+
+void VT100_CUD (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"B", 2);
+}
+
+void VT100_CUF (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"C", 2);
+}
+
+void VT100_CUB (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"D", 2);
+}
+
+void VT100_CNL (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"E", 2);
+}
+
+void VT100_CPL (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"F", 2);
+}
+
+void VT100_CHA (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"G", 2);
+}
+
+void VT100_CUP (INT16 n, INT16 m)
+{
+ VT100_EscSeq2(n, m, (CHAR*)"H", 2);
+}
+
+void VT100_ED (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"J", 2);
+}
+
+void VT100_EL (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"K", 2);
+}
+
+void VT100_SU (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"S", 2);
+}
+
+void VT100_SD (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"T", 2);
+}
+
+void VT100_HVP (INT16 n, INT16 m)
+{
+ VT100_EscSeq2(n, m, (CHAR*)"f", 2);
+}
+
+void VT100_SGR (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"m", 2);
+}
+
+void VT100_SGR2 (INT16 n, INT16 m)
+{
+ VT100_EscSeq2(n, m, (CHAR*)"m", 2);
+}
+
+void VT100_DSR (INT16 n)
+{
+ VT100_EscSeq(6, (CHAR*)"n", 2);
+}
+
+void VT100_SCP (void)
+{
+ VT100_EscSeq0((CHAR*)"s", 2);
+}
+
+void VT100_RCP (void)
+{
+ VT100_EscSeq0((CHAR*)"u", 2);
+}
+
+void VT100_DECTCEMl (void)
+{
+ VT100_EscSeq0((CHAR*)"\?25l", 5);
+}
+
+void VT100_DECTCEMh (void)
+{
+ VT100_EscSeq0((CHAR*)"\?25h", 5);
+}
+
+void VT100_SetAttr (CHAR *attr, LONGINT attr__len)
+{
+ CHAR tmpstr[16];
+ __DUP(attr, attr__len, CHAR);
+ __COPY(VT100_CSI, tmpstr, 16);
+ Strings_Append(attr, attr__len, (void*)tmpstr, 16);
+ Out_String(tmpstr, 16);
+ __DEL(attr);
+}
+
+
+export void *VT100__init(void)
+{
+ __DEFMOD;
+ __MODULE_IMPORT(Out);
+ __MODULE_IMPORT(Strings);
+ __REGMOD("VT100", 0);
+ __REGCMD("DECTCEMh", VT100_DECTCEMh);
+ __REGCMD("DECTCEMl", VT100_DECTCEMl);
+ __REGCMD("RCP", VT100_RCP);
+ __REGCMD("SCP", VT100_SCP);
+/* BEGIN */
+ __COPY("\033", VT100_CSI, 5);
+ Strings_Append((CHAR*)"[", 2, (void*)VT100_CSI, 5);
+ __ENDMOD;
+}
diff --git a/bootstrap/unix-44/VT100.h b/bootstrap/unix-44/VT100.h
new file mode 100644
index 00000000..d99406ec
--- /dev/null
+++ b/bootstrap/unix-44/VT100.h
@@ -0,0 +1,37 @@
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#ifndef VT100__h
+#define VT100__h
+
+#include "SYSTEM.h"
+
+
+import CHAR VT100_CSI[5];
+
+
+import void VT100_CHA (INT16 n);
+import void VT100_CNL (INT16 n);
+import void VT100_CPL (INT16 n);
+import void VT100_CUB (INT16 n);
+import void VT100_CUD (INT16 n);
+import void VT100_CUF (INT16 n);
+import void VT100_CUP (INT16 n, INT16 m);
+import void VT100_CUU (INT16 n);
+import void VT100_DECTCEMh (void);
+import void VT100_DECTCEMl (void);
+import void VT100_DSR (INT16 n);
+import void VT100_ED (INT16 n);
+import void VT100_EL (INT16 n);
+import void VT100_HVP (INT16 n, INT16 m);
+import void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len);
+import void VT100_RCP (void);
+import void VT100_SCP (void);
+import void VT100_SD (INT16 n);
+import void VT100_SGR (INT16 n);
+import void VT100_SGR2 (INT16 n, INT16 m);
+import void VT100_SU (INT16 n);
+import void VT100_SetAttr (CHAR *attr, LONGINT attr__len);
+import void *VT100__init(void);
+
+
+#endif // VT100
diff --git a/bootstrap/unix-44/Vishap.c b/bootstrap/unix-44/Vishap.c
deleted file mode 100644
index 4c9e3b45..00000000
--- a/bootstrap/unix-44/Vishap.c
+++ /dev/null
@@ -1,168 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkamSf */
-#include "SYSTEM.h"
-#include "Configuration.h"
-#include "Heap.h"
-#include "OPB.h"
-#include "OPC.h"
-#include "OPM.h"
-#include "OPP.h"
-#include "OPT.h"
-#include "OPV.h"
-#include "Platform.h"
-#include "Strings.h"
-#include "extTools.h"
-#include "vt100.h"
-
-
-static CHAR Vishap_mname[256];
-
-
-export void Vishap_Module (BOOLEAN *done);
-static void Vishap_PropagateElementaryTypeSizes (void);
-export void Vishap_Translate (void);
-static void Vishap_Trap (INTEGER sig);
-
-
-void Vishap_Module (BOOLEAN *done)
-{
- BOOLEAN ext, new;
- OPT_Node p = NIL;
- OPP_Module(&p, OPM_opt);
- if (OPM_noerr) {
- OPV_Init();
- OPV_AdrAndSize(OPT_topScope);
- OPT_Export(&ext, &new);
- if (OPM_noerr) {
- OPM_OpenFiles((void*)OPT_SelfName, ((LONGINT)(256)));
- OPC_Init();
- OPV_Module(p);
- if (OPM_noerr) {
- if (((OPM_mainProg || OPM_mainLinkStat) && __STRCMP(OPM_modName, "SYSTEM") != 0)) {
- OPM_DeleteNewSym();
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"32m", (LONGINT)4);
- }
- OPM_LogWStr((CHAR*)" Main program.", (LONGINT)16);
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"0m", (LONGINT)3);
- }
- } else {
- if (new) {
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"32m", (LONGINT)4);
- }
- OPM_LogWStr((CHAR*)" New symbol file.", (LONGINT)19);
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"0m", (LONGINT)3);
- }
- OPM_RegisterNewSym();
- } else if (ext) {
- OPM_LogWStr((CHAR*)" Extended symbol file.", (LONGINT)24);
- OPM_RegisterNewSym();
- }
- }
- } else {
- OPM_DeleteNewSym();
- }
- }
- }
- OPM_CloseFiles();
- OPT_Close();
- OPM_LogWLn();
- *done = OPM_noerr;
-}
-
-static void Vishap_PropagateElementaryTypeSizes (void)
-{
- OPT_bytetyp->size = OPM_ByteSize;
- OPT_sysptrtyp->size = OPM_PointerSize;
- OPT_chartyp->size = OPM_CharSize;
- OPT_settyp->size = OPM_SetSize;
- OPT_realtyp->size = OPM_RealSize;
- OPT_inttyp->size = OPM_IntSize;
- OPT_linttyp->size = OPM_LIntSize;
- OPT_lrltyp->size = OPM_LRealSize;
- OPT_sinttyp->size = OPM_SIntSize;
- OPT_booltyp->size = OPM_BoolSize;
-}
-
-void Vishap_Translate (void)
-{
- BOOLEAN done;
- CHAR modulesobj[2048];
- modulesobj[0] = 0x00;
- if (OPM_OpenPar()) {
- for (;;) {
- OPM_Init(&done, (void*)Vishap_mname, ((LONGINT)(256)));
- if (!done) {
- return;
- }
- OPM_InitOptions();
- Vishap_PropagateElementaryTypeSizes();
- Heap_GC(0);
- Vishap_Module(&done);
- if (!done) {
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Module compilation failed.", (LONGINT)27);
- OPM_LogWLn();
- Platform_Exit(1);
- }
- if (!OPM_dontAsm) {
- if (OPM_dontLink) {
- extTools_Assemble(OPM_modName, ((LONGINT)(32)));
- } else {
- if (!(OPM_mainProg || OPM_mainLinkStat)) {
- extTools_Assemble(OPM_modName, ((LONGINT)(32)));
- Strings_Append((CHAR*)" ", (LONGINT)2, (void*)modulesobj, ((LONGINT)(2048)));
- Strings_Append(OPM_modName, ((LONGINT)(32)), (void*)modulesobj, ((LONGINT)(2048)));
- Strings_Append((CHAR*)".o", (LONGINT)3, (void*)modulesobj, ((LONGINT)(2048)));
- } else {
- extTools_LinkMain((void*)OPM_modName, ((LONGINT)(32)), OPM_mainLinkStat, modulesobj, ((LONGINT)(2048)));
- }
- }
- }
- }
- }
-}
-
-static void Vishap_Trap (INTEGER sig)
-{
- Heap_FINALL();
- if (sig == 3) {
- Platform_Exit(0);
- } else {
- if ((sig == 4 && Platform_HaltCode == -15)) {
- OPM_LogWStr((CHAR*)" --- Vishap Oberon: internal error", (LONGINT)35);
- OPM_LogWLn();
- }
- Platform_Exit(2);
- }
-}
-
-
-export int main(int argc, char **argv)
-{
- __INIT(argc, argv);
- __MODULE_IMPORT(Configuration);
- __MODULE_IMPORT(Heap);
- __MODULE_IMPORT(OPB);
- __MODULE_IMPORT(OPC);
- __MODULE_IMPORT(OPM);
- __MODULE_IMPORT(OPP);
- __MODULE_IMPORT(OPT);
- __MODULE_IMPORT(OPV);
- __MODULE_IMPORT(Platform);
- __MODULE_IMPORT(Strings);
- __MODULE_IMPORT(extTools);
- __MODULE_IMPORT(vt100);
- __REGMAIN("Vishap", 0);
- __REGCMD("Translate", Vishap_Translate);
-/* BEGIN */
- Platform_SetInterruptHandler(Vishap_Trap);
- Platform_SetQuitHandler(Vishap_Trap);
- Platform_SetBadInstructionHandler(Vishap_Trap);
- OPB_typSize = OPV_TypSize;
- OPT_typSize = OPV_TypSize;
- Vishap_Translate();
- __FINI;
-}
diff --git a/bootstrap/unix-44/errors.c b/bootstrap/unix-44/errors.c
deleted file mode 100644
index 68e433df..00000000
--- a/bootstrap/unix-44/errors.c
+++ /dev/null
@@ -1,199 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#include "SYSTEM.h"
-
-typedef
- CHAR errors_string[128];
-
-
-export errors_string errors_errors[350];
-
-
-
-
-
-export void *errors__init(void)
-{
- __DEFMOD;
- __REGMOD("errors", 0);
-/* BEGIN */
- __MOVE("undeclared identifier", errors_errors[0], 22);
- __MOVE("multiply defined identifier", errors_errors[1], 28);
- __MOVE("illegal character in number", errors_errors[2], 28);
- __MOVE("illegal character in string", errors_errors[3], 28);
- __MOVE("identifier does not match procedure name", errors_errors[4], 41);
- __MOVE("comment not closed", errors_errors[5], 19);
- errors_errors[6][0] = 0x00;
- errors_errors[7][0] = 0x00;
- errors_errors[8][0] = 0x00;
- __MOVE("'=' expected", errors_errors[9], 13);
- errors_errors[10][0] = 0x00;
- errors_errors[11][0] = 0x00;
- __MOVE("type definition starts with incorrect symbol", errors_errors[12], 45);
- __MOVE("factor starts with incorrect symbol", errors_errors[13], 36);
- __MOVE("statement starts with incorrect symbol", errors_errors[14], 39);
- __MOVE("declaration followed by incorrect symbol", errors_errors[15], 41);
- __MOVE("MODULE expected", errors_errors[16], 16);
- errors_errors[17][0] = 0x00;
- __MOVE("'.' missing", errors_errors[18], 12);
- __MOVE("',' missing", errors_errors[19], 12);
- __MOVE("':' missing", errors_errors[20], 12);
- errors_errors[21][0] = 0x00;
- __MOVE("')' missing", errors_errors[22], 12);
- __MOVE("']' missing", errors_errors[23], 12);
- __MOVE("'}' missing", errors_errors[24], 12);
- __MOVE("OF missing", errors_errors[25], 11);
- __MOVE("THEN missing", errors_errors[26], 13);
- __MOVE("DO missing", errors_errors[27], 11);
- __MOVE("TO missing", errors_errors[28], 11);
- errors_errors[29][0] = 0x00;
- __MOVE("'(' missing", errors_errors[30], 12);
- errors_errors[31][0] = 0x00;
- errors_errors[32][0] = 0x00;
- errors_errors[33][0] = 0x00;
- __MOVE("':=' missing", errors_errors[34], 13);
- __MOVE("',' or OF expected", errors_errors[35], 19);
- errors_errors[36][0] = 0x00;
- errors_errors[37][0] = 0x00;
- __MOVE("identifier expected", errors_errors[38], 20);
- __MOVE("';' missing", errors_errors[39], 12);
- errors_errors[40][0] = 0x00;
- __MOVE("END missing", errors_errors[41], 12);
- errors_errors[42][0] = 0x00;
- errors_errors[43][0] = 0x00;
- __MOVE("UNTIL missing", errors_errors[44], 14);
- errors_errors[45][0] = 0x00;
- __MOVE("EXIT not within loop statement", errors_errors[46], 31);
- __MOVE("illegally marked identifier", errors_errors[47], 28);
- errors_errors[48][0] = 0x00;
- errors_errors[49][0] = 0x00;
- __MOVE("expression should be constant", errors_errors[50], 30);
- __MOVE("constant not an integer", errors_errors[51], 24);
- __MOVE("identifier does not denote a type", errors_errors[52], 34);
- __MOVE("identifier does not denote a record type", errors_errors[53], 41);
- __MOVE("result type of procedure is not a basic type", errors_errors[54], 45);
- __MOVE("procedure call of a function", errors_errors[55], 29);
- __MOVE("assignment to non-variable", errors_errors[56], 27);
- __MOVE("pointer not bound to record or array type", errors_errors[57], 42);
- __MOVE("recursive type definition", errors_errors[58], 26);
- __MOVE("illegal open array parameter", errors_errors[59], 29);
- __MOVE("wrong type of case label", errors_errors[60], 25);
- __MOVE("inadmissible type of case label", errors_errors[61], 32);
- __MOVE("case label defined more than once", errors_errors[62], 34);
- __MOVE("illegal value of constant", errors_errors[63], 26);
- __MOVE("more actual than formal parameters", errors_errors[64], 35);
- __MOVE("fewer actual than formal parameters", errors_errors[65], 36);
- __MOVE("element types of actual array and formal open array differ", errors_errors[66], 59);
- __MOVE("actual parameter corresponding to open array is not an array", errors_errors[67], 61);
- __MOVE("control variable must be integer", errors_errors[68], 33);
- __MOVE("parameter must be an integer constant", errors_errors[69], 38);
- __MOVE("pointer or VAR record required as formal receiver", errors_errors[70], 50);
- __MOVE("pointer expected as actual receiver", errors_errors[71], 36);
- __MOVE("procedure must be bound to a record of the same scope", errors_errors[72], 54);
- __MOVE("procedure must have level 0", errors_errors[73], 28);
- __MOVE("procedure unknown in base type", errors_errors[74], 31);
- __MOVE("invalid call of base procedure", errors_errors[75], 31);
- __MOVE("this variable (field) is read only", errors_errors[76], 35);
- __MOVE("object is not a record", errors_errors[77], 23);
- __MOVE("dereferenced object is not a variable", errors_errors[78], 38);
- __MOVE("indexed object is not a variable", errors_errors[79], 33);
- __MOVE("index expression is not an integer", errors_errors[80], 35);
- __MOVE("index out of specified bounds", errors_errors[81], 30);
- __MOVE("indexed variable is not an array", errors_errors[82], 33);
- __MOVE("undefined record field", errors_errors[83], 23);
- __MOVE("dereferenced variable is not a pointer", errors_errors[84], 39);
- __MOVE("guard or test type is not an extension of variable type", errors_errors[85], 56);
- __MOVE("guard or testtype is not a pointer", errors_errors[86], 35);
- __MOVE("guarded or tested variable is neither a pointer nor a VAR-parameter record", errors_errors[87], 75);
- __MOVE("open array not allowed as variable, record field or array element", errors_errors[88], 66);
- errors_errors[89][0] = 0x00;
- errors_errors[90][0] = 0x00;
- errors_errors[91][0] = 0x00;
- __MOVE("operand of IN not an integer, or not a set", errors_errors[92], 43);
- __MOVE("set element type is not an integer", errors_errors[93], 35);
- __MOVE("operand of & is not of type BOOLEAN", errors_errors[94], 36);
- __MOVE("operand of OR is not of type BOOLEAN", errors_errors[95], 37);
- __MOVE("operand not applicable to (unary) +", errors_errors[96], 36);
- __MOVE("operand not applicable to (unary) -", errors_errors[97], 36);
- __MOVE("operand of ~ is not of type BOOLEAN", errors_errors[98], 36);
- __MOVE("ASSERT fault", errors_errors[99], 13);
- __MOVE("incompatible operands of dyadic operator", errors_errors[100], 41);
- __MOVE("operand type inapplicable to *", errors_errors[101], 31);
- __MOVE("operand type inapplicable to /", errors_errors[102], 31);
- __MOVE("operand type inapplicable to DIV", errors_errors[103], 33);
- __MOVE("operand type inapplicable to MOD", errors_errors[104], 33);
- __MOVE("operand type inapplicable to +", errors_errors[105], 31);
- __MOVE("operand type inapplicable to -", errors_errors[106], 31);
- __MOVE("operand type inapplicable to = or #", errors_errors[107], 36);
- __MOVE("operand type inapplicable to relation", errors_errors[108], 38);
- __MOVE("overriding method must be exported", errors_errors[109], 35);
- __MOVE("operand is not a type", errors_errors[110], 22);
- __MOVE("operand inapplicable to (this) function", errors_errors[111], 40);
- __MOVE("operand is not a variable", errors_errors[112], 26);
- __MOVE("incompatible assignment", errors_errors[113], 24);
- __MOVE("string too long to be assigned", errors_errors[114], 31);
- __MOVE("parameter doesn't match", errors_errors[115], 24);
- __MOVE("number of parameters doesn't match", errors_errors[116], 35);
- __MOVE("result type doesn't match", errors_errors[117], 26);
- __MOVE("export mark doesn't match with forward declaration", errors_errors[118], 51);
- __MOVE("redefinition textually precedes procedure bound to base type", errors_errors[119], 61);
- __MOVE("type of expression following IF, WHILE, UNTIL or ASSERT is not BOOLEAN", errors_errors[120], 71);
- __MOVE("called object is not a procedure (or is an interrupt procedure)", errors_errors[121], 64);
- __MOVE("actual VAR-parameter is not a variable", errors_errors[122], 39);
- __MOVE("type of actual parameter is not identical with that of formal VAR-parameter", errors_errors[123], 76);
- __MOVE("type of result expression differs from that of procedure", errors_errors[124], 57);
- __MOVE("type of case expression is neither INTEGER nor CHAR", errors_errors[125], 52);
- __MOVE("this expression cannot be a type or a procedure", errors_errors[126], 48);
- __MOVE("illegal use of object", errors_errors[127], 22);
- __MOVE("unsatisfied forward reference", errors_errors[128], 30);
- __MOVE("unsatisfied forward procedure", errors_errors[129], 30);
- __MOVE("WITH clause does not specify a variable", errors_errors[130], 40);
- __MOVE("LEN not applied to array", errors_errors[131], 25);
- __MOVE("dimension in LEN too large or negative", errors_errors[132], 39);
- __MOVE("SYSTEM not imported", errors_errors[135], 20);
- __MOVE("key inconsistency of imported module", errors_errors[150], 37);
- __MOVE("incorrect symbol file", errors_errors[151], 22);
- __MOVE("symbol file of imported module not found", errors_errors[152], 41);
- __MOVE("object or symbol file not opened (disk full\?)", errors_errors[153], 46);
- __MOVE("recursive import not allowed", errors_errors[154], 29);
- __MOVE("generation of new symbol file not allowed", errors_errors[155], 42);
- __MOVE("parameter file not found", errors_errors[156], 25);
- __MOVE("syntax error in parameter file", errors_errors[157], 31);
- __MOVE("not yet implemented", errors_errors[200], 20);
- __MOVE("lower bound of set range greater than higher bound", errors_errors[201], 51);
- __MOVE("set element greater than MAX(SET) or less than 0", errors_errors[202], 49);
- __MOVE("number too large", errors_errors[203], 17);
- __MOVE("product too large", errors_errors[204], 18);
- __MOVE("division by zero", errors_errors[205], 17);
- __MOVE("sum too large", errors_errors[206], 14);
- __MOVE("difference too large", errors_errors[207], 21);
- __MOVE("overflow in arithmetic shift", errors_errors[208], 29);
- __MOVE("case range too large", errors_errors[209], 21);
- __MOVE("too many cases in case statement", errors_errors[213], 33);
- __MOVE("illegal value of parameter (0 <= p < 256)", errors_errors[218], 42);
- __MOVE("machine registers cannot be accessed", errors_errors[219], 37);
- __MOVE("illegal value of parameter", errors_errors[220], 27);
- __MOVE("too many pointers in a record", errors_errors[221], 30);
- __MOVE("too many global pointers", errors_errors[222], 25);
- __MOVE("too many record types", errors_errors[223], 22);
- __MOVE("too many pointer types", errors_errors[224], 23);
- __MOVE("address of pointer variable too large (move forward in text)", errors_errors[225], 61);
- __MOVE("too many exported procedures", errors_errors[226], 29);
- __MOVE("too many imported modules", errors_errors[227], 26);
- __MOVE("too many exported structures", errors_errors[228], 29);
- __MOVE("too many nested records for import", errors_errors[229], 35);
- __MOVE("too many constants (strings) in module", errors_errors[230], 39);
- __MOVE("too many link table entries (external procedures)", errors_errors[231], 50);
- __MOVE("too many commands in module", errors_errors[232], 28);
- __MOVE("record extension hierarchy too high", errors_errors[233], 36);
- __MOVE("export of recursive type not allowed", errors_errors[234], 37);
- __MOVE("identifier too long", errors_errors[240], 20);
- __MOVE("string too long", errors_errors[241], 16);
- __MOVE("address overflow", errors_errors[242], 17);
- __MOVE("cyclic type definition not allowed", errors_errors[244], 35);
- __MOVE("guarded pointer variable may be manipulated by non-local operations; use auxiliary pointer variable", errors_errors[245], 100);
- __MOVE("implicit type cast", errors_errors[301], 19);
- __MOVE("inappropriate symbol file ignored", errors_errors[306], 34);
- __MOVE("no ELSE symbol after CASE statement sequence may lead to trap", errors_errors[307], 62);
- __MOVE("SYSTEM.VAL result includes memory past end of source variable", errors_errors[308], 62);
- __ENDMOD;
-}
diff --git a/bootstrap/unix-44/errors.h b/bootstrap/unix-44/errors.h
deleted file mode 100644
index 41d399ad..00000000
--- a/bootstrap/unix-44/errors.h
+++ /dev/null
@@ -1,18 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-
-#ifndef errors__h
-#define errors__h
-
-#include "SYSTEM.h"
-
-typedef
- CHAR errors_string[128];
-
-
-import errors_string errors_errors[350];
-
-
-import void *errors__init(void);
-
-
-#endif
diff --git a/bootstrap/unix-44/extTools.c b/bootstrap/unix-44/extTools.c
index 4efd107a..37630d23 100644
--- a/bootstrap/unix-44/extTools.c
+++ b/bootstrap/unix-44/extTools.c
@@ -1,29 +1,37 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "Configuration.h"
-#include "Console.h"
+#include "Modules.h"
#include "OPM.h"
+#include "Out.h"
#include "Platform.h"
#include "Strings.h"
-static CHAR extTools_compilationOptions[1023], extTools_CFLAGS[1023];
+static CHAR extTools_CFLAGS[1023];
export void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len);
+static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT s__len);
export void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len);
static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len);
static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len)
{
- INTEGER r, status, exitcode;
+ INT16 r, status, exitcode;
__DUP(title, title__len, CHAR);
__DUP(cmd, cmd__len, CHAR);
- if (OPM_Verbose) {
- Console_String(title, title__len);
- Console_String(cmd, cmd__len);
- Console_Ln();
+ if (__IN(18, OPM_Options, 32)) {
+ Out_String(title, title__len);
+ Out_String(cmd, cmd__len);
+ Out_Ln();
}
r = Platform_System(cmd, cmd__len);
status = __MASK(r, -128);
@@ -32,39 +40,49 @@ static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGIN
exitcode = exitcode - 256;
}
if (r != 0) {
- Console_String(title, title__len);
- Console_String(cmd, cmd__len);
- Console_Ln();
- Console_String((CHAR*)"-- failed: status ", (LONGINT)19);
- Console_Int(status, ((LONGINT)(1)));
- Console_String((CHAR*)", exitcode ", (LONGINT)12);
- Console_Int(exitcode, ((LONGINT)(1)));
- Console_String((CHAR*)".", (LONGINT)2);
- Console_Ln();
+ Out_String(title, title__len);
+ Out_String(cmd, cmd__len);
+ Out_Ln();
+ Out_String((CHAR*)"-- failed: status ", 19);
+ Out_Int(status, 1);
+ Out_String((CHAR*)", exitcode ", 12);
+ Out_Int(exitcode, 1);
+ Out_String((CHAR*)".", 2);
+ Out_Ln();
if ((status == 0 && exitcode == 127)) {
- Console_String((CHAR*)"Is the C compiler in the current command path\?", (LONGINT)47);
- Console_Ln();
+ Out_String((CHAR*)"Is the C compiler in the current command path\?", 47);
+ Out_Ln();
}
if (status != 0) {
- Platform_Halt(status);
+ Modules_Halt(status);
} else {
- Platform_Halt(exitcode);
+ Modules_Halt(exitcode);
}
}
__DEL(title);
__DEL(cmd);
}
+static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT 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);
+ 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);
+}
+
void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len)
{
CHAR cmd[1023];
__DUP(moduleName, moduleName__len, CHAR);
- __MOVE("gcc -g", cmd, 7);
- Strings_Append(extTools_compilationOptions, ((LONGINT)(1023)), (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)"-c ", (LONGINT)4, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)".c", (LONGINT)3, (void*)cmd, ((LONGINT)(1023)));
- extTools_execute((CHAR*)"Assemble: ", (LONGINT)11, cmd, ((LONGINT)(1023)));
+ 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);
}
@@ -72,22 +90,23 @@ void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN stati
{
CHAR cmd[1023];
__DUP(additionalopts, additionalopts__len, CHAR);
- __MOVE("gcc -g", cmd, 7);
- Strings_Append((CHAR*)" ", (LONGINT)2, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append(extTools_compilationOptions, ((LONGINT)(1023)), (void*)cmd, ((LONGINT)(1023)));
- Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)".c ", (LONGINT)4, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append(additionalopts, additionalopts__len, (void*)cmd, ((LONGINT)(1023)));
+ 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", (LONGINT)8, (void*)cmd, ((LONGINT)(1023)));
+ Strings_Append((CHAR*)"-static", 8, (void*)cmd, 1023);
}
- Strings_Append((CHAR*)" -o ", (LONGINT)5, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)" -L\"", (LONGINT)5, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)"/lib\"", (LONGINT)6, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)" -l voc", (LONGINT)8, (void*)cmd, ((LONGINT)(1023)));
- extTools_execute((CHAR*)"Assemble and link: ", (LONGINT)20, cmd, ((LONGINT)(1023)));
+ 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);
}
@@ -96,17 +115,12 @@ export void *extTools__init(void)
{
__DEFMOD;
__MODULE_IMPORT(Configuration);
- __MODULE_IMPORT(Console);
+ __MODULE_IMPORT(Modules);
__MODULE_IMPORT(OPM);
+ __MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
__REGMOD("extTools", 0);
/* BEGIN */
- Strings_Append((CHAR*)" -I \"", (LONGINT)6, (void*)extTools_compilationOptions, ((LONGINT)(1023)));
- Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)extTools_compilationOptions, ((LONGINT)(1023)));
- Strings_Append((CHAR*)"/include\" ", (LONGINT)11, (void*)extTools_compilationOptions, ((LONGINT)(1023)));
- Platform_GetEnv((CHAR*)"CFLAGS", (LONGINT)7, (void*)extTools_CFLAGS, ((LONGINT)(1023)));
- Strings_Append(extTools_CFLAGS, ((LONGINT)(1023)), (void*)extTools_compilationOptions, ((LONGINT)(1023)));
- Strings_Append((CHAR*)" ", (LONGINT)2, (void*)extTools_compilationOptions, ((LONGINT)(1023)));
__ENDMOD;
}
diff --git a/bootstrap/unix-44/extTools.h b/bootstrap/unix-44/extTools.h
index fc4f0da1..63e5df15 100644
--- a/bootstrap/unix-44/extTools.h
+++ b/bootstrap/unix-44/extTools.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef extTools__h
#define extTools__h
@@ -13,4 +13,4 @@ import void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEA
import void *extTools__init(void);
-#endif
+#endif // extTools
diff --git a/bootstrap/unix-44/vt100.c b/bootstrap/unix-44/vt100.c
deleted file mode 100644
index d77b0b84..00000000
--- a/bootstrap/unix-44/vt100.c
+++ /dev/null
@@ -1,258 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#include "SYSTEM.h"
-#include "Console.h"
-#include "Strings.h"
-
-
-export CHAR vt100_CSI[5];
-static CHAR vt100_tmpstr[32];
-
-
-export void vt100_CHA (INTEGER n);
-export void vt100_CNL (INTEGER n);
-export void vt100_CPL (INTEGER n);
-export void vt100_CUB (INTEGER n);
-export void vt100_CUD (INTEGER n);
-export void vt100_CUF (INTEGER n);
-export void vt100_CUP (INTEGER n, INTEGER m);
-export void vt100_CUU (INTEGER n);
-export void vt100_DECTCEMh (void);
-export void vt100_DECTCEMl (void);
-export void vt100_DSR (INTEGER n);
-export void vt100_ED (INTEGER n);
-export void vt100_EL (INTEGER n);
-static void vt100_EscSeq (INTEGER n, CHAR *letter, LONGINT letter__len);
-static void vt100_EscSeq0 (CHAR *letter, LONGINT letter__len);
-static void vt100_EscSeq2 (INTEGER n, INTEGER m, CHAR *letter, LONGINT letter__len);
-static void vt100_EscSeqSwapped (INTEGER n, CHAR *letter, LONGINT letter__len);
-export void vt100_HVP (INTEGER n, INTEGER m);
-export void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len);
-export void vt100_RCP (void);
-static void vt100_Reverse0 (CHAR *str, LONGINT str__len, INTEGER start, INTEGER end);
-export void vt100_SCP (void);
-export void vt100_SD (INTEGER n);
-export void vt100_SGR (INTEGER n);
-export void vt100_SGR2 (INTEGER n, INTEGER m);
-export void vt100_SU (INTEGER n);
-export void vt100_SetAttr (CHAR *attr, LONGINT attr__len);
-
-
-static void vt100_Reverse0 (CHAR *str, LONGINT str__len, INTEGER start, INTEGER end)
-{
- CHAR h;
- while (start < end) {
- h = str[__X(start, str__len)];
- str[__X(start, str__len)] = str[__X(end, str__len)];
- str[__X(end, str__len)] = h;
- start += 1;
- end -= 1;
- }
-}
-
-void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len)
-{
- CHAR b[21];
- INTEGER s, e;
- SHORTINT maxLength;
- maxLength = 11;
- if (int_ == (-2147483647-1)) {
- __MOVE("-2147483648", b, 12);
- e = 11;
- } else {
- if (int_ < 0) {
- b[0] = '-';
- int_ = -int_;
- s = 1;
- } else {
- s = 0;
- }
- e = s;
- do {
- b[__X(e, ((LONGINT)(21)))] = (CHAR)(__MOD(int_, 10) + 48);
- int_ = __DIV(int_, 10);
- e += 1;
- } while (!(int_ == 0));
- b[__X(e, ((LONGINT)(21)))] = 0x00;
- vt100_Reverse0((void*)b, ((LONGINT)(21)), s, e - 1);
- }
- __COPY(b, str, str__len);
-}
-
-static void vt100_EscSeq0 (CHAR *letter, LONGINT letter__len)
-{
- CHAR cmd[9];
- __DUP(letter, letter__len, CHAR);
- __COPY(vt100_CSI, cmd, ((LONGINT)(9)));
- Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(9)));
- Console_String(cmd, ((LONGINT)(9)));
- __DEL(letter);
-}
-
-static void vt100_EscSeq (INTEGER n, CHAR *letter, LONGINT letter__len)
-{
- CHAR nstr[2];
- CHAR cmd[7];
- __DUP(letter, letter__len, CHAR);
- vt100_IntToStr(n, (void*)nstr, ((LONGINT)(2)));
- __COPY(vt100_CSI, cmd, ((LONGINT)(7)));
- Strings_Append(nstr, ((LONGINT)(2)), (void*)cmd, ((LONGINT)(7)));
- Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(7)));
- Console_String(cmd, ((LONGINT)(7)));
- __DEL(letter);
-}
-
-static void vt100_EscSeqSwapped (INTEGER n, CHAR *letter, LONGINT letter__len)
-{
- CHAR nstr[2];
- CHAR cmd[7];
- __DUP(letter, letter__len, CHAR);
- vt100_IntToStr(n, (void*)nstr, ((LONGINT)(2)));
- __COPY(vt100_CSI, cmd, ((LONGINT)(7)));
- Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(7)));
- Strings_Append(nstr, ((LONGINT)(2)), (void*)cmd, ((LONGINT)(7)));
- Console_String(cmd, ((LONGINT)(7)));
- __DEL(letter);
-}
-
-static void vt100_EscSeq2 (INTEGER n, INTEGER m, CHAR *letter, LONGINT letter__len)
-{
- CHAR nstr[5], mstr[5];
- CHAR cmd[12];
- __DUP(letter, letter__len, CHAR);
- vt100_IntToStr(n, (void*)nstr, ((LONGINT)(5)));
- vt100_IntToStr(m, (void*)mstr, ((LONGINT)(5)));
- __COPY(vt100_CSI, cmd, ((LONGINT)(12)));
- Strings_Append(nstr, ((LONGINT)(5)), (void*)cmd, ((LONGINT)(12)));
- Strings_Append((CHAR*)";", (LONGINT)2, (void*)cmd, ((LONGINT)(12)));
- Strings_Append(mstr, ((LONGINT)(5)), (void*)cmd, ((LONGINT)(12)));
- Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(12)));
- Console_String(cmd, ((LONGINT)(12)));
- __DEL(letter);
-}
-
-void vt100_CUU (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"A", (LONGINT)2);
-}
-
-void vt100_CUD (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"B", (LONGINT)2);
-}
-
-void vt100_CUF (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"C", (LONGINT)2);
-}
-
-void vt100_CUB (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"D", (LONGINT)2);
-}
-
-void vt100_CNL (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"E", (LONGINT)2);
-}
-
-void vt100_CPL (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"F", (LONGINT)2);
-}
-
-void vt100_CHA (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"G", (LONGINT)2);
-}
-
-void vt100_CUP (INTEGER n, INTEGER m)
-{
- vt100_EscSeq2(n, m, (CHAR*)"H", (LONGINT)2);
-}
-
-void vt100_ED (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"J", (LONGINT)2);
-}
-
-void vt100_EL (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"K", (LONGINT)2);
-}
-
-void vt100_SU (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"S", (LONGINT)2);
-}
-
-void vt100_SD (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"T", (LONGINT)2);
-}
-
-void vt100_HVP (INTEGER n, INTEGER m)
-{
- vt100_EscSeq2(n, m, (CHAR*)"f", (LONGINT)2);
-}
-
-void vt100_SGR (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"m", (LONGINT)2);
-}
-
-void vt100_SGR2 (INTEGER n, INTEGER m)
-{
- vt100_EscSeq2(n, m, (CHAR*)"m", (LONGINT)2);
-}
-
-void vt100_DSR (INTEGER n)
-{
- vt100_EscSeq(6, (CHAR*)"n", (LONGINT)2);
-}
-
-void vt100_SCP (void)
-{
- vt100_EscSeq0((CHAR*)"s", (LONGINT)2);
-}
-
-void vt100_RCP (void)
-{
- vt100_EscSeq0((CHAR*)"u", (LONGINT)2);
-}
-
-void vt100_DECTCEMl (void)
-{
- vt100_EscSeq0((CHAR*)"\?25l", (LONGINT)5);
-}
-
-void vt100_DECTCEMh (void)
-{
- vt100_EscSeq0((CHAR*)"\?25h", (LONGINT)5);
-}
-
-void vt100_SetAttr (CHAR *attr, LONGINT attr__len)
-{
- CHAR tmpstr[16];
- __DUP(attr, attr__len, CHAR);
- __COPY(vt100_CSI, tmpstr, ((LONGINT)(16)));
- Strings_Append(attr, attr__len, (void*)tmpstr, ((LONGINT)(16)));
- Console_String(tmpstr, ((LONGINT)(16)));
- __DEL(attr);
-}
-
-
-export void *vt100__init(void)
-{
- __DEFMOD;
- __MODULE_IMPORT(Console);
- __MODULE_IMPORT(Strings);
- __REGMOD("vt100", 0);
- __REGCMD("DECTCEMh", vt100_DECTCEMh);
- __REGCMD("DECTCEMl", vt100_DECTCEMl);
- __REGCMD("RCP", vt100_RCP);
- __REGCMD("SCP", vt100_SCP);
-/* BEGIN */
- __COPY("\033", vt100_CSI, ((LONGINT)(5)));
- Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5)));
- __ENDMOD;
-}
diff --git a/bootstrap/unix-44/vt100.h b/bootstrap/unix-44/vt100.h
deleted file mode 100644
index 4af04d6e..00000000
--- a/bootstrap/unix-44/vt100.h
+++ /dev/null
@@ -1,37 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-
-#ifndef vt100__h
-#define vt100__h
-
-#include "SYSTEM.h"
-
-
-import CHAR vt100_CSI[5];
-
-
-import void vt100_CHA (INTEGER n);
-import void vt100_CNL (INTEGER n);
-import void vt100_CPL (INTEGER n);
-import void vt100_CUB (INTEGER n);
-import void vt100_CUD (INTEGER n);
-import void vt100_CUF (INTEGER n);
-import void vt100_CUP (INTEGER n, INTEGER m);
-import void vt100_CUU (INTEGER n);
-import void vt100_DECTCEMh (void);
-import void vt100_DECTCEMl (void);
-import void vt100_DSR (INTEGER n);
-import void vt100_ED (INTEGER n);
-import void vt100_EL (INTEGER n);
-import void vt100_HVP (INTEGER n, INTEGER m);
-import void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len);
-import void vt100_RCP (void);
-import void vt100_SCP (void);
-import void vt100_SD (INTEGER n);
-import void vt100_SGR (INTEGER n);
-import void vt100_SGR2 (INTEGER n, INTEGER m);
-import void vt100_SU (INTEGER n);
-import void vt100_SetAttr (CHAR *attr, LONGINT attr__len);
-import void *vt100__init(void);
-
-
-#endif
diff --git a/bootstrap/unix-48/Compiler.c b/bootstrap/unix-48/Compiler.c
new file mode 100644
index 00000000..dc4bb660
--- /dev/null
+++ b/bootstrap/unix-48/Compiler.c
@@ -0,0 +1,184 @@
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspamS */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
+#include "SYSTEM.h"
+#include "Configuration.h"
+#include "Heap.h"
+#include "OPB.h"
+#include "OPC.h"
+#include "OPM.h"
+#include "OPP.h"
+#include "OPT.h"
+#include "OPV.h"
+#include "Platform.h"
+#include "Strings.h"
+#include "VT100.h"
+#include "extTools.h"
+
+
+static CHAR Compiler_mname[256];
+
+
+export void Compiler_Module (BOOLEAN *done);
+static void Compiler_PropagateElementaryTypeSizes (void);
+export void Compiler_Translate (void);
+static void Compiler_Trap (INT32 sig);
+
+
+void Compiler_Module (BOOLEAN *done)
+{
+ BOOLEAN ext, new;
+ OPT_Node p = NIL;
+ OPP_Module(&p, OPM_Options);
+ if (OPM_noerr) {
+ OPV_Init();
+ OPT_InitRecno();
+ OPV_AdrAndSize(OPT_topScope);
+ OPT_Export(&ext, &new);
+ if (OPM_noerr) {
+ OPM_OpenFiles((void*)OPT_SelfName, 256);
+ OPC_Init();
+ OPV_Module(p);
+ if (OPM_noerr) {
+ if ((__IN(10, OPM_Options, 32) && __STRCMP(OPM_modName, "SYSTEM") != 0)) {
+ OPM_DeleteNewSym();
+ OPM_LogVT100((CHAR*)"32m", 4);
+ OPM_LogWStr((CHAR*)" Main program.", 16);
+ OPM_LogVT100((CHAR*)"0m", 3);
+ } else {
+ if (new) {
+ OPM_LogVT100((CHAR*)"32m", 4);
+ OPM_LogWStr((CHAR*)" New symbol file.", 19);
+ OPM_LogVT100((CHAR*)"0m", 3);
+ OPM_RegisterNewSym();
+ } else if (ext) {
+ OPM_LogWStr((CHAR*)" Extended symbol file.", 24);
+ OPM_RegisterNewSym();
+ }
+ }
+ } else {
+ OPM_DeleteNewSym();
+ }
+ }
+ }
+ OPM_CloseFiles();
+ OPT_Close();
+ OPM_LogWLn();
+ *done = OPM_noerr;
+}
+
+static void Compiler_PropagateElementaryTypeSizes (void)
+{
+ OPT_Struct adrinttyp = NIL;
+ OPT_sysptrtyp->size = OPM_AddressSize;
+ OPT_sysptrtyp->idfp = OPT_sysptrtyp->form;
+ OPM_FPrint(&OPT_sysptrtyp->idfp, OPT_sysptrtyp->size);
+ OPT_adrtyp->size = OPM_AddressSize;
+ OPT_adrtyp->idfp = OPT_adrtyp->form;
+ OPM_FPrint(&OPT_adrtyp->idfp, OPT_adrtyp->size);
+ adrinttyp = OPT_IntType(OPM_AddressSize);
+ OPT_adrtyp->strobj = adrinttyp->strobj;
+ OPT_sinttyp = OPT_IntType(OPM_ShortintSize);
+ OPT_inttyp = OPT_IntType(OPM_IntegerSize);
+ OPT_linttyp = OPT_IntType(OPM_LongintSize);
+ OPT_sintobj->typ = OPT_sinttyp;
+ OPT_intobj->typ = OPT_inttyp;
+ OPT_lintobj->typ = OPT_linttyp;
+ switch (OPM_LongintSize) {
+ case 4:
+ OPT_settyp = OPT_set32typ;
+ break;
+ default:
+ OPT_settyp = OPT_set64typ;
+ break;
+ }
+ OPT_setobj->typ = OPT_settyp;
+ if (__STRCMP(OPM_Model, "C") == 0) {
+ OPT_cpbytetyp->strobj->name[4] = 0x00;
+ } else {
+ OPT_cpbytetyp->strobj->name[4] = '@';
+ }
+}
+
+void Compiler_Translate (void)
+{
+ BOOLEAN done;
+ CHAR modulesobj[2048];
+ modulesobj[0] = 0x00;
+ if (OPM_OpenPar()) {
+ for (;;) {
+ OPM_Init(&done, (void*)Compiler_mname, 256);
+ if (!done) {
+ return;
+ }
+ OPM_InitOptions();
+ Compiler_PropagateElementaryTypeSizes();
+ Heap_GC(0);
+ Compiler_Module(&done);
+ if (!done) {
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Module compilation failed.", 27);
+ OPM_LogWLn();
+ Platform_Exit(1);
+ }
+ if (!__IN(13, OPM_Options, 32)) {
+ if (__IN(14, OPM_Options, 32)) {
+ extTools_Assemble(OPM_modName, 32);
+ } else {
+ if (!__IN(10, OPM_Options, 32)) {
+ extTools_Assemble(OPM_modName, 32);
+ Strings_Append((CHAR*)" ", 2, (void*)modulesobj, 2048);
+ Strings_Append(OPM_modName, 32, (void*)modulesobj, 2048);
+ Strings_Append((CHAR*)".o", 3, (void*)modulesobj, 2048);
+ } else {
+ extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), modulesobj, 2048);
+ }
+ }
+ }
+ }
+ }
+}
+
+static void Compiler_Trap (INT32 sig)
+{
+ Heap_FINALL();
+ if (sig == 3) {
+ Platform_Exit(0);
+ } else {
+ if (sig == 4) {
+ OPM_LogWStr((CHAR*)" --- Oberon compiler internal error", 36);
+ OPM_LogWLn();
+ }
+ Platform_Exit(2);
+ }
+}
+
+
+export int main(int argc, char **argv)
+{
+ __INIT(argc, argv);
+ __MODULE_IMPORT(Configuration);
+ __MODULE_IMPORT(Heap);
+ __MODULE_IMPORT(OPB);
+ __MODULE_IMPORT(OPC);
+ __MODULE_IMPORT(OPM);
+ __MODULE_IMPORT(OPP);
+ __MODULE_IMPORT(OPT);
+ __MODULE_IMPORT(OPV);
+ __MODULE_IMPORT(Platform);
+ __MODULE_IMPORT(Strings);
+ __MODULE_IMPORT(VT100);
+ __MODULE_IMPORT(extTools);
+ __REGMAIN("Compiler", 0);
+ __REGCMD("Translate", Compiler_Translate);
+/* BEGIN */
+ Platform_SetInterruptHandler(Compiler_Trap);
+ Platform_SetQuitHandler(Compiler_Trap);
+ Platform_SetBadInstructionHandler(Compiler_Trap);
+ Compiler_Translate();
+ __FINI;
+}
diff --git a/bootstrap/unix-48/Configuration.c b/bootstrap/unix-48/Configuration.c
index 821dff97..2d0061df 100644
--- a/bootstrap/unix-48/Configuration.c
+++ b/bootstrap/unix-48/Configuration.c
@@ -1,8 +1,14 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
-export CHAR Configuration_versionLong[41];
+export CHAR Configuration_versionLong[75];
@@ -13,6 +19,6 @@ export void *Configuration__init(void)
__DEFMOD;
__REGMOD("Configuration", 0);
/* BEGIN */
- __MOVE("1.95 [2016/08/23] for gcc LP64 on cygwin", Configuration_versionLong, 41);
+ __MOVE("1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75);
__ENDMOD;
}
diff --git a/bootstrap/unix-48/Configuration.h b/bootstrap/unix-48/Configuration.h
index ec5e865a..b28e0caa 100644
--- a/bootstrap/unix-48/Configuration.h
+++ b/bootstrap/unix-48/Configuration.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Configuration__h
#define Configuration__h
@@ -6,10 +6,10 @@
#include "SYSTEM.h"
-import CHAR Configuration_versionLong[41];
+import CHAR Configuration_versionLong[75];
import void *Configuration__init(void);
-#endif
+#endif // Configuration
diff --git a/bootstrap/unix-48/Console.c b/bootstrap/unix-48/Console.c
deleted file mode 100644
index f9161937..00000000
--- a/bootstrap/unix-48/Console.c
+++ /dev/null
@@ -1,150 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#include "SYSTEM.h"
-#include "Platform.h"
-
-
-static CHAR Console_line[128];
-static INTEGER Console_pos;
-
-
-export void Console_Bool (BOOLEAN b);
-export void Console_Char (CHAR ch);
-export void Console_Flush (void);
-export void Console_Hex (LONGINT i);
-export void Console_Int (LONGINT i, LONGINT n);
-export void Console_Ln (void);
-export void Console_Read (CHAR *ch);
-export void Console_ReadLine (CHAR *line, LONGINT line__len);
-export void Console_String (CHAR *s, LONGINT s__len);
-
-
-void Console_Flush (void)
-{
- INTEGER error;
- error = Platform_Write(((LONGINT)(1)), (LONGINT)(SYSTEM_ADDRESS)Console_line, Console_pos);
- Console_pos = 0;
-}
-
-void Console_Char (CHAR ch)
-{
- if (Console_pos == 128) {
- Console_Flush();
- }
- Console_line[__X(Console_pos, ((LONGINT)(128)))] = ch;
- Console_pos += 1;
- if (ch == 0x0a) {
- Console_Flush();
- }
-}
-
-void Console_String (CHAR *s, LONGINT s__len)
-{
- INTEGER i;
- __DUP(s, s__len, CHAR);
- i = 0;
- while (s[__X(i, s__len)] != 0x00) {
- Console_Char(s[__X(i, s__len)]);
- i += 1;
- }
- __DEL(s);
-}
-
-void Console_Int (LONGINT i, LONGINT n)
-{
- CHAR s[32];
- LONGINT i1, k;
- if (i == __LSHL(1, 31, LONGINT)) {
- __MOVE("8463847412", s, 11);
- k = 10;
- } else {
- i1 = __ABS(i);
- s[0] = (CHAR)(__MOD(i1, 10) + 48);
- i1 = __DIV(i1, 10);
- k = 1;
- while (i1 > 0) {
- s[__X(k, ((LONGINT)(32)))] = (CHAR)(__MOD(i1, 10) + 48);
- i1 = __DIV(i1, 10);
- k += 1;
- }
- }
- if (i < 0) {
- s[__X(k, ((LONGINT)(32)))] = '-';
- k += 1;
- }
- while (n > k) {
- Console_Char(' ');
- n -= 1;
- }
- while (k > 0) {
- k -= 1;
- Console_Char(s[__X(k, ((LONGINT)(32)))]);
- }
-}
-
-void Console_Ln (void)
-{
- Console_Char(0x0a);
-}
-
-void Console_Bool (BOOLEAN b)
-{
- if (b) {
- Console_String((CHAR*)"TRUE", (LONGINT)5);
- } else {
- Console_String((CHAR*)"FALSE", (LONGINT)6);
- }
-}
-
-void Console_Hex (LONGINT i)
-{
- LONGINT k, n;
- k = -28;
- while (k <= 0) {
- n = __MASK(__ASH(i, k), -16);
- if (n <= 9) {
- Console_Char((CHAR)(48 + n));
- } else {
- Console_Char((CHAR)(55 + n));
- }
- k += 4;
- }
-}
-
-void Console_Read (CHAR *ch)
-{
- LONGINT n;
- INTEGER error;
- Console_Flush();
- error = Platform_ReadBuf(((LONGINT)(0)), (void*)&*ch, ((LONGINT)(1)), &n);
- if (n != 1) {
- *ch = 0x00;
- }
-}
-
-void Console_ReadLine (CHAR *line, LONGINT line__len)
-{
- LONGINT i;
- CHAR ch;
- Console_Flush();
- i = 0;
- Console_Read(&ch);
- while ((((i < line__len - 1 && ch != 0x0a)) && ch != 0x00)) {
- line[__X(i, line__len)] = ch;
- i += 1;
- Console_Read(&ch);
- }
- line[__X(i, line__len)] = 0x00;
-}
-
-
-export void *Console__init(void)
-{
- __DEFMOD;
- __MODULE_IMPORT(Platform);
- __REGMOD("Console", 0);
- __REGCMD("Flush", Console_Flush);
- __REGCMD("Ln", Console_Ln);
-/* BEGIN */
- Console_pos = 0;
- __ENDMOD;
-}
diff --git a/bootstrap/unix-48/Console.h b/bootstrap/unix-48/Console.h
deleted file mode 100644
index 5fdd4e4d..00000000
--- a/bootstrap/unix-48/Console.h
+++ /dev/null
@@ -1,23 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-
-#ifndef Console__h
-#define Console__h
-
-#include "SYSTEM.h"
-
-
-
-
-import void Console_Bool (BOOLEAN b);
-import void Console_Char (CHAR ch);
-import void Console_Flush (void);
-import void Console_Hex (LONGINT i);
-import void Console_Int (LONGINT i, LONGINT n);
-import void Console_Ln (void);
-import void Console_Read (CHAR *ch);
-import void Console_ReadLine (CHAR *line, LONGINT line__len);
-import void Console_String (CHAR *s, LONGINT s__len);
-import void *Console__init(void);
-
-
-#endif
diff --git a/bootstrap/unix-48/Files.c b/bootstrap/unix-48/Files.c
index 5a1dd875..548774b0 100644
--- a/bootstrap/unix-48/Files.c
+++ b/bootstrap/unix-48/Files.c
@@ -1,8 +1,13 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
-#include "Configuration.h"
-#include "Console.h"
#include "Heap.h"
+#include "Out.h"
#include "Platform.h"
#include "Strings.h"
@@ -13,7 +18,7 @@ typedef
struct Files_BufDesc {
Files_File f;
BOOLEAN chg;
- LONGINT org, size;
+ INT32 org, size;
SYSTEM_BYTE data[4096];
} Files_BufDesc;
@@ -28,114 +33,114 @@ typedef
Files_FileName workName, registerName;
BOOLEAN tempFile;
Platform_FileIdentity identity;
- LONGINT fd, len, pos;
+ INT32 fd, len, pos;
Files_Buffer bufs[4];
- INTEGER swapper, state;
+ INT16 swapper, state;
Files_File next;
} Files_FileDesc;
typedef
struct Files_Rider {
- LONGINT res;
+ INT32 res;
BOOLEAN eof;
Files_Buffer buf;
- LONGINT org, offset;
+ INT32 org, offset;
} Files_Rider;
static Files_File Files_files;
-static INTEGER Files_tempno;
+static INT16 Files_tempno;
static CHAR Files_HOME[1024];
static struct {
LONGINT len[1];
CHAR data[1];
} *Files_SearchPath;
-export LONGINT *Files_FileDesc__typ;
-export LONGINT *Files_BufDesc__typ;
-export LONGINT *Files_Rider__typ;
+export ADDRESS *Files_FileDesc__typ;
+export ADDRESS *Files_BufDesc__typ;
+export ADDRESS *Files_Rider__typ;
-export Files_File Files_Base (Files_Rider *r, LONGINT *r__typ);
+export Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
static Files_File Files_CacheEntry (Platform_FileIdentity identity);
-export void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *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, LONGINT name__len, INTEGER *res);
-static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INTEGER 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, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len);
static void Files_Flush (Files_Buffer buf);
-export void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d);
+export void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
export void Files_GetName (Files_File f, CHAR *name, LONGINT name__len);
static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len);
static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len);
-export LONGINT Files_Length (Files_File f);
+export INT32 Files_Length (Files_File f);
static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len);
export Files_File Files_New (CHAR *name, LONGINT name__len);
export Files_File Files_Old (CHAR *name, LONGINT name__len);
-export LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ);
+export INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ);
export void Files_Purge (Files_File f);
-export void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x);
-export void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x);
-export void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len);
-export void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n);
-export void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x);
-export void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x);
-export void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x);
-export void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
-export void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x);
-export void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x);
-export void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x);
-export void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
+export void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
+export void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x);
+export void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+export void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x);
+export void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x);
+export void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
+export void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+export void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
+export void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
+export void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
+export void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
export void Files_Register (Files_File f);
-export void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res);
-static void Files_ScanPath (INTEGER *pos, CHAR *dir, LONGINT dir__len);
-export void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos);
+export void Files_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, LONGINT path__len);
-export void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x);
-export void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x);
-export void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n);
-export void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x);
-export void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x);
-export void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x);
-export void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x);
-export void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x);
-export void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x);
-export void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
+export void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
+export void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
+export void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+export void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
+export void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
+export void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
+export void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
+export void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
+export void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
+export void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
#define Files_IdxTrap() __HALT(-1)
+#define Files_ToAdr(x) (ADDRESS)x
-static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INTEGER errcode)
+static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
{
__DUP(s, s__len, CHAR);
- Console_Ln();
- Console_String((CHAR*)"-- ", (LONGINT)4);
- Console_String(s, s__len);
- Console_String((CHAR*)": ", (LONGINT)3);
+ Out_Ln();
+ Out_String((CHAR*)"-- ", 4);
+ Out_String(s, s__len);
+ Out_String((CHAR*)": ", 3);
if (f != NIL) {
if (f->registerName[0] != 0x00) {
- Console_String(f->registerName, ((LONGINT)(101)));
+ Out_String(f->registerName, 101);
} else {
- Console_String(f->workName, ((LONGINT)(101)));
+ Out_String(f->workName, 101);
}
if (f->fd != 0) {
- Console_String((CHAR*)"f.fd = ", (LONGINT)8);
- Console_Int(f->fd, ((LONGINT)(1)));
+ Out_String((CHAR*)"f.fd = ", 8);
+ Out_Int(f->fd, 1);
}
}
if (errcode != 0) {
- Console_String((CHAR*)" errcode = ", (LONGINT)12);
- Console_Int(errcode, ((LONGINT)(1)));
+ Out_String((CHAR*)" errcode = ", 12);
+ Out_Int(errcode, 1);
}
- Console_Ln();
+ Out_Ln();
__HALT(99);
__DEL(s);
}
static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len)
{
- INTEGER i, j;
+ INT16 i, j;
__DUP(dir, dir__len, CHAR);
__DUP(name, name__len, CHAR);
i = 0;
@@ -160,7 +165,7 @@ static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT
static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len)
{
- LONGINT n, i, j;
+ INT32 n, i, j;
__DUP(finalName, finalName__len, CHAR);
Files_tempno += 1;
n = Files_tempno;
@@ -192,7 +197,7 @@ static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *na
name[i + 5] = '.';
i += 6;
while (n > 0) {
- name[i] = (CHAR)(__MOD(n, 10) + 48);
+ name[i] = (CHAR)((int)__MOD(n, 10) + 48);
n = __DIV(n, 10);
i += 1;
}
@@ -200,7 +205,7 @@ static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *na
i += 1;
n = Platform_PID;
while (n > 0) {
- name[i] = (CHAR)(__MOD(n, 10) + 48);
+ name[i] = (CHAR)((int)__MOD(n, 10) + 48);
n = __DIV(n, 10);
i += 1;
}
@@ -212,19 +217,19 @@ static void Files_Create (Files_File f)
{
Platform_FileIdentity identity;
BOOLEAN done;
- INTEGER error;
+ INT16 error;
CHAR err[32];
if (f->fd == -1) {
if (f->state == 1) {
- Files_GetTempName(f->registerName, ((LONGINT)(101)), (void*)f->workName, ((LONGINT)(101)));
+ Files_GetTempName(f->registerName, 101, (void*)f->workName, 101);
f->tempFile = 1;
} else if (f->state == 2) {
- __COPY(f->registerName, f->workName, ((LONGINT)(101)));
+ __COPY(f->registerName, f->workName, 101);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
- error = Platform_Unlink((void*)f->workName, ((LONGINT)(101)));
- error = Platform_New((void*)f->workName, ((LONGINT)(101)), &f->fd);
+ 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;
@@ -242,14 +247,14 @@ static void Files_Create (Files_File f)
} else {
__MOVE("file not created", err, 17);
}
- Files_Err(err, ((LONGINT)(32)), f, error);
+ Files_Err(err, 32, f, error);
}
}
}
static void Files_Flush (Files_Buffer buf)
{
- INTEGER error;
+ INT16 error;
Files_File f = NIL;
if (buf->chg) {
f = buf->f;
@@ -257,15 +262,15 @@ static void Files_Flush (Files_Buffer buf)
if (buf->org != f->pos) {
error = Platform_Seek(f->fd, buf->org, Platform_SeekSet);
}
- error = Platform_Write(f->fd, (LONGINT)(SYSTEM_ADDRESS)buf->data, buf->size);
+ error = Platform_Write(f->fd, (ADDRESS)buf->data, buf->size);
if (error != 0) {
- Files_Err((CHAR*)"error writing file", (LONGINT)19, f, error);
+ Files_Err((CHAR*)"error writing file", 19, f, error);
}
f->pos = buf->org + buf->size;
buf->chg = 0;
error = Platform_Identify(f->fd, &f->identity, Platform_FileIdentity__typ);
if (error != 0) {
- Files_Err((CHAR*)"error identifying file", (LONGINT)23, f, error);
+ Files_Err((CHAR*)"error identifying file", 23, f, error);
}
}
}
@@ -273,7 +278,7 @@ static void Files_Flush (Files_Buffer buf)
static void Files_CloseOSFile (Files_File f)
{
Files_File prev = NIL;
- INTEGER error;
+ INT16 error;
if (Files_files == f) {
Files_files = f->next;
} else {
@@ -293,8 +298,8 @@ static void Files_CloseOSFile (Files_File f)
void Files_Close (Files_File f)
{
- LONGINT i;
- INTEGER error;
+ INT32 i;
+ INT16 error;
if (f->state != 1 || f->registerName[0] != 0x00) {
Files_Create(f);
i = 0;
@@ -302,42 +307,34 @@ void Files_Close (Files_File f)
Files_Flush(f->bufs[i]);
i += 1;
}
- error = Platform_Sync(f->fd);
- if (error != 0) {
- Files_Err((CHAR*)"error writing file", (LONGINT)19, f, error);
- }
Files_CloseOSFile(f);
}
}
-LONGINT Files_Length (Files_File f)
+INT32 Files_Length (Files_File f)
{
- LONGINT _o_result;
- _o_result = f->len;
- return _o_result;
+ return f->len;
}
Files_File Files_New (CHAR *name, LONGINT name__len)
{
- Files_File _o_result;
Files_File f = NIL;
__DUP(name, name__len, CHAR);
__NEW(f, Files_FileDesc);
f->workName[0] = 0x00;
- __COPY(name, f->registerName, ((LONGINT)(101)));
+ __COPY(name, f->registerName, 101);
f->fd = -1;
f->state = 1;
f->len = 0;
f->pos = 0;
f->swapper = -1;
- _o_result = f;
__DEL(name);
- return _o_result;
+ return f;
}
-static void Files_ScanPath (INTEGER *pos, CHAR *dir, LONGINT dir__len)
+static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len)
{
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
if (Files_SearchPath == NIL) {
@@ -380,8 +377,7 @@ static void Files_ScanPath (INTEGER *pos, CHAR *dir, LONGINT dir__len)
static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len)
{
- BOOLEAN _o_result;
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
ch = name[0];
@@ -389,15 +385,13 @@ static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len)
i += 1;
ch = name[i];
}
- _o_result = ch == '/';
- return _o_result;
+ return ch == '/';
}
static Files_File Files_CacheEntry (Platform_FileIdentity identity)
{
- Files_File _o_result;
Files_File f = NIL;
- INTEGER i, error;
+ INT16 i, error;
f = Files_files;
while (f != NIL) {
if (Platform_SameFile(identity, f->identity)) {
@@ -414,60 +408,56 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
f->identity = identity;
error = Platform_Size(f->fd, &f->len);
}
- _o_result = f;
- return _o_result;
+ return f;
}
f = f->next;
}
- _o_result = NIL;
- return _o_result;
+ return NIL;
}
Files_File Files_Old (CHAR *name, LONGINT name__len)
{
- Files_File _o_result;
Files_File f = NIL;
- LONGINT fd;
- INTEGER pos;
+ INT32 fd;
+ INT16 pos;
BOOLEAN done;
CHAR dir[256], path[256];
- INTEGER error;
+ INT16 error;
Platform_FileIdentity identity;
__DUP(name, name__len, CHAR);
if (name[0] != 0x00) {
if (Files_HasDir((void*)name, name__len)) {
dir[0] = 0x00;
- __COPY(name, path, ((LONGINT)(256)));
+ __COPY(name, path, 256);
} else {
pos = 0;
- Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256)));
- Files_MakeFileName(dir, ((LONGINT)(256)), name, name__len, (void*)path, ((LONGINT)(256)));
- Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256)));
+ Files_ScanPath(&pos, (void*)dir, 256);
+ Files_MakeFileName(dir, 256, name, name__len, (void*)path, 256);
+ Files_ScanPath(&pos, (void*)dir, 256);
}
for (;;) {
- error = Platform_OldRW((void*)path, ((LONGINT)(256)), &fd);
+ error = Platform_OldRW((void*)path, 256, &fd);
done = error == 0;
if ((!done && Platform_TooManyFiles(error))) {
- Files_Err((CHAR*)"too many files open", (LONGINT)20, f, error);
+ Files_Err((CHAR*)"too many files open", 20, f, error);
}
if ((!done && Platform_Inaccessible(error))) {
- error = Platform_OldRO((void*)path, ((LONGINT)(256)), &fd);
+ error = Platform_OldRO((void*)path, 256, &fd);
done = error == 0;
}
if ((!done && !Platform_Absent(error))) {
- Console_String((CHAR*)"Warning: Files.Old ", (LONGINT)20);
- Console_String(name, name__len);
- Console_String((CHAR*)" error = ", (LONGINT)10);
- Console_Int(error, ((LONGINT)(0)));
- Console_Ln();
+ Out_String((CHAR*)"Warning: Files.Old ", 20);
+ Out_String(name, name__len);
+ Out_String((CHAR*)" error = ", 10);
+ Out_Int(error, 0);
+ Out_Ln();
}
if (done) {
error = Platform_Identify(fd, &identity, Platform_FileIdentity__typ);
f = Files_CacheEntry(identity);
if (f != NIL) {
- _o_result = f;
__DEL(name);
- return _o_result;
+ return f;
} else {
__NEW(f, Files_FileDesc);
Heap_RegisterFinalizer((void*)f, Files_Finalize);
@@ -476,39 +466,36 @@ Files_File Files_Old (CHAR *name, LONGINT name__len)
f->pos = 0;
f->swapper = -1;
error = Platform_Size(fd, &f->len);
- __COPY(name, f->workName, ((LONGINT)(101)));
+ __COPY(name, f->workName, 101);
f->registerName[0] = 0x00;
f->tempFile = 0;
f->identity = identity;
f->next = Files_files;
Files_files = f;
Heap_FileCount += 1;
- _o_result = f;
__DEL(name);
- return _o_result;
+ return f;
}
} else if (dir[0] == 0x00) {
- _o_result = NIL;
__DEL(name);
- return _o_result;
+ return NIL;
} else {
- Files_MakeFileName(dir, ((LONGINT)(256)), name, name__len, (void*)path, ((LONGINT)(256)));
- Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256)));
+ Files_MakeFileName(dir, 256, name, name__len, (void*)path, 256);
+ Files_ScanPath(&pos, (void*)dir, 256);
}
}
} else {
- _o_result = NIL;
__DEL(name);
- return _o_result;
+ return NIL;
}
__RETCHK;
}
void Files_Purge (Files_File f)
{
- INTEGER i;
+ INT16 i;
Platform_FileIdentity identity;
- INTEGER error;
+ INT16 error;
i = 0;
while (i < 4) {
if (f->bufs[i] != NIL) {
@@ -518,8 +505,8 @@ void Files_Purge (Files_File f)
i += 1;
}
if (f->fd != -1) {
- error = Platform_Truncate(f->fd, ((LONGINT)(0)));
- error = Platform_Seek(f->fd, ((LONGINT)(0)), Platform_SeekSet);
+ error = Platform_Truncate(f->fd, 0);
+ error = Platform_Seek(f->fd, 0, Platform_SeekSet);
}
f->pos = 0;
f->len = 0;
@@ -528,27 +515,26 @@ void Files_Purge (Files_File f)
Platform_SetMTime(&f->identity, Platform_FileIdentity__typ, identity);
}
-void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d)
+void Files_GetDate (Files_File f, INT32 *t, INT32 *d)
{
Platform_FileIdentity identity;
- INTEGER error;
+ INT16 error;
Files_Create(f);
error = Platform_Identify(f->fd, &identity, Platform_FileIdentity__typ);
Platform_MTimeAsClock(identity, &*t, &*d);
}
-LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ)
+INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ)
{
- LONGINT _o_result;
- _o_result = (*r).org + (*r).offset;
- return _o_result;
+ __ASSERT((*r).offset <= 4096, 0);
+ return (*r).org + (*r).offset;
}
-void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos)
+void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos)
{
- LONGINT org, offset, i, n;
+ INT32 org, offset, i, n;
Files_Buffer buf = NIL;
- INTEGER error;
+ INT16 error;
if (f != NIL) {
if (pos > f->len) {
pos = f->len;
@@ -584,9 +570,9 @@ void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos)
if (f->pos != org) {
error = Platform_Seek(f->fd, org, Platform_SeekSet);
}
- error = Platform_ReadBuf(f->fd, (void*)buf->data, ((LONGINT)(4096)), &n);
+ error = Platform_ReadBuf(f->fd, (void*)buf->data, 4096, &n);
if (error != 0) {
- Files_Err((CHAR*)"read from file not done", (LONGINT)24, f, error);
+ Files_Err((CHAR*)"read from file not done", 24, f, error);
}
f->pos = org + n;
buf->size = n;
@@ -599,6 +585,7 @@ void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos)
org = 0;
offset = 0;
}
+ __ASSERT(offset <= 4096, 0);
(*r).buf = buf;
(*r).org = org;
(*r).offset = offset;
@@ -606,9 +593,9 @@ void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos)
(*r).res = 0;
}
-void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x)
+void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
{
- LONGINT offset;
+ INT32 offset;
Files_Buffer buf = NIL;
buf = (*r).buf;
offset = (*r).offset;
@@ -617,6 +604,7 @@ void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x)
buf = (*r).buf;
offset = (*r).offset;
}
+ __ASSERT(offset <= buf->size, 0);
if (offset < buf->size) {
*x = buf->data[offset];
(*r).offset = offset + 1;
@@ -630,9 +618,9 @@ void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x)
}
}
-void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n)
+void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
{
- LONGINT xpos, min, restInBuf, offset;
+ INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
if (n > x__len) {
Files_IdxTrap();
@@ -656,39 +644,35 @@ void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x
} else {
min = n;
}
- __MOVE((LONGINT)(SYSTEM_ADDRESS)buf->data + offset, (LONGINT)(SYSTEM_ADDRESS)x + xpos, min);
+ __MOVE((ADDRESS)buf->data + Files_ToAdr(offset), (ADDRESS)x + Files_ToAdr(xpos), min);
offset += min;
(*r).offset = offset;
xpos += min;
n -= min;
+ __ASSERT(offset <= 4096, 0);
}
(*r).res = 0;
(*r).eof = 0;
}
-void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len)
+Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ)
{
- Files_ReadBytes(&*r, r__typ, (void*)x, x__len * ((LONGINT)(1)), ((LONGINT)(1)));
+ return (*r).buf->f;
}
-Files_File Files_Base (Files_Rider *r, LONGINT *r__typ)
-{
- Files_File _o_result;
- _o_result = (*r).buf->f;
- return _o_result;
-}
-
-void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x)
+void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
{
Files_Buffer buf = NIL;
- LONGINT offset;
+ INT32 offset;
buf = (*r).buf;
offset = (*r).offset;
+ __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;
}
+ __ASSERT(offset < 4096, 0);
buf->data[offset] = x;
buf->chg = 1;
if (offset == buf->size) {
@@ -699,9 +683,9 @@ void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x)
(*r).res = 0;
}
-void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n)
+void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
{
- LONGINT xpos, min, restInBuf, offset;
+ INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
if (n > x__len) {
Files_IdxTrap();
@@ -710,20 +694,23 @@ void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT
buf = (*r).buf;
offset = (*r).offset;
while (n > 0) {
+ __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;
}
+ __ASSERT(offset <= 4096, 0);
restInBuf = 4096 - offset;
if (n > restInBuf) {
min = restInBuf;
} else {
min = n;
}
- __MOVE((LONGINT)(SYSTEM_ADDRESS)x + xpos, (LONGINT)(SYSTEM_ADDRESS)buf->data + offset, min);
+ __MOVE((ADDRESS)x + Files_ToAdr(xpos), (ADDRESS)buf->data + Files_ToAdr(offset), min);
offset += min;
(*r).offset = offset;
+ __ASSERT(offset <= 4096, 0);
if (offset > buf->size) {
buf->f->len += offset - buf->size;
buf->size = offset;
@@ -735,17 +722,17 @@ void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT
(*r).res = 0;
}
-void Files_Delete (CHAR *name, LONGINT name__len, INTEGER *res)
+void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res)
{
__DUP(name, name__len, CHAR);
*res = Platform_Unlink((void*)name, name__len);
__DEL(name);
}
-void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res)
+void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res)
{
- LONGINT fdold, fdnew, n;
- INTEGER error, ignore;
+ INT32 fdold, fdnew, n;
+ INT16 error, ignore;
Platform_FileIdentity oldidentity, newidentity;
CHAR buf[4096];
__DUP(old, old__len, CHAR);
@@ -759,28 +746,34 @@ void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT
error = Platform_Rename((void*)old, old__len, (void*)new, new__len);
if (!Platform_DifferentFilesystems(error)) {
*res = error;
+ __DEL(old);
+ __DEL(new);
return;
} else {
error = Platform_OldRO((void*)old, old__len, &fdold);
if (error != 0) {
*res = 2;
+ __DEL(old);
+ __DEL(new);
return;
}
error = Platform_New((void*)new, new__len, &fdnew);
if (error != 0) {
error = Platform_Close(fdold);
*res = 3;
+ __DEL(old);
+ __DEL(new);
return;
}
- error = Platform_Read(fdold, (LONGINT)(SYSTEM_ADDRESS)buf, ((LONGINT)(4096)), &n);
+ error = Platform_Read(fdold, (ADDRESS)buf, 4096, &n);
while (n > 0) {
- error = Platform_Write(fdnew, (LONGINT)(SYSTEM_ADDRESS)buf, n);
+ error = Platform_Write(fdnew, (ADDRESS)buf, n);
if (error != 0) {
ignore = Platform_Close(fdold);
ignore = Platform_Close(fdnew);
- Files_Err((CHAR*)"cannot move file", (LONGINT)17, NIL, error);
+ Files_Err((CHAR*)"cannot move file", 17, NIL, error);
}
- error = Platform_Read(fdold, (LONGINT)(SYSTEM_ADDRESS)buf, ((LONGINT)(4096)), &n);
+ error = Platform_Read(fdold, (ADDRESS)buf, 4096, &n);
}
ignore = Platform_Close(fdold);
ignore = Platform_Close(fdnew);
@@ -788,7 +781,7 @@ void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT
error = Platform_Unlink((void*)old, old__len);
*res = 0;
} else {
- Files_Err((CHAR*)"cannot move file", (LONGINT)17, NIL, error);
+ Files_Err((CHAR*)"cannot move file", 17, NIL, error);
}
}
} else {
@@ -800,7 +793,7 @@ void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT
void Files_Register (Files_File f)
{
- INTEGER idx, errcode;
+ INT16 idx, errcode;
Files_File f1 = NIL;
CHAR file[104];
if ((f->state == 1 && f->registerName[0] != 0x00)) {
@@ -808,18 +801,18 @@ void Files_Register (Files_File f)
}
Files_Close(f);
if (f->registerName[0] != 0x00) {
- Files_Rename(f->workName, ((LONGINT)(101)), f->registerName, ((LONGINT)(101)), &errcode);
+ Files_Rename(f->workName, 101, f->registerName, 101, &errcode);
if (errcode != 0) {
- __COPY(f->registerName, file, ((LONGINT)(104)));
+ __COPY(f->registerName, file, 104);
__HALT(99);
}
- __COPY(f->registerName, f->workName, ((LONGINT)(101)));
+ __COPY(f->registerName, f->workName, 101);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
}
-void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res)
+void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res)
{
__DUP(path, path__len, CHAR);
*res = Platform_Chdir((void*)path, path__len);
@@ -828,7 +821,7 @@ void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res)
static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len)
{
- LONGINT i, j;
+ INT32 i, j;
if (!Platform_LittleEndian) {
i = src__len;
j = 0;
@@ -838,55 +831,55 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *de
j += 1;
}
} else {
- __MOVE((LONGINT)(SYSTEM_ADDRESS)src, (LONGINT)(SYSTEM_ADDRESS)dest, src__len);
+ __MOVE((ADDRESS)src, (ADDRESS)dest, src__len);
}
}
-void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x)
+void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x)
{
Files_Read(&*R, R__typ, (CHAR*)(void*)&*x);
}
-void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x)
+void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x)
{
CHAR b[2];
- Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(2)), ((LONGINT)(2)));
- *x = (int)b[0] + __ASHL((int)b[1], 8);
+ Files_ReadBytes(&*R, R__typ, (void*)b, 2, 2);
+ *x = (INT16)b[0] + __ASHL((INT16)b[1], 8);
}
-void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x)
+void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x)
{
CHAR b[4];
- Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
- *x = ((int)((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((int)b[2], 16)) + __ASHL((int)b[3], 24);
+ Files_ReadBytes(&*R, R__typ, (void*)b, 4, 4);
+ *x = (((INT16)b[0] + __ASHL((INT16)b[1], 8)) + __ASHL(b[2], 16)) + __ASHL(b[3], 24);
}
-void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x)
+void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x)
{
CHAR b[4];
- LONGINT l;
- Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
- l = ((int)((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((int)b[2], 16)) + __ASHL((int)b[3], 24);
- *x = (SET)l;
+ INT32 l;
+ Files_ReadBytes(&*R, R__typ, (void*)b, 4, 4);
+ l = (((INT16)b[0] + __ASHL((INT16)b[1], 8)) + __ASHL(b[2], 16)) + __ASHL(b[3], 24);
+ *x = (UINT32)l;
}
-void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x)
+void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x)
{
CHAR b[4];
- Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
- Files_FlipBytes((void*)b, ((LONGINT)(4)), (void*)&*x, ((LONGINT)(4)));
+ Files_ReadBytes(&*R, R__typ, (void*)b, 4, 4);
+ Files_FlipBytes((void*)b, 4, (void*)&*x, 4);
}
-void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x)
+void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x)
{
CHAR b[8];
- Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(8)), ((LONGINT)(8)));
- Files_FlipBytes((void*)b, ((LONGINT)(8)), (void*)&*x, ((LONGINT)(8)));
+ Files_ReadBytes(&*R, R__typ, (void*)b, 8, 8);
+ Files_FlipBytes((void*)b, 8, (void*)&*x, 8);
}
-void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len)
+void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
{
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
do {
@@ -896,101 +889,100 @@ void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len)
} while (!(ch == 0x00));
}
-void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len)
+void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
{
- INTEGER i;
- CHAR ch;
- BOOLEAN b;
+ INT16 i;
i = 0;
- b = 0;
do {
- Files_Read(&*R, R__typ, (void*)&ch);
- if ((ch == 0x00 || ch == 0x0a) || ch == 0x0d) {
- b = 1;
- } else {
- x[i] = ch;
- i += 1;
- }
- } while (!b);
-}
-
-void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x)
-{
- SHORTINT s;
- CHAR ch;
- LONGINT n;
- s = 0;
- n = 0;
- Files_Read(&*R, R__typ, (void*)&ch);
- while ((int)ch >= 128) {
- n += __ASH((int)((int)ch - 128), s);
- s += 7;
- Files_Read(&*R, R__typ, (void*)&ch);
+ Files_Read(&*R, R__typ, (void*)&x[i]);
+ i += 1;
+ } while (!(x[i - 1] == 0x00 || x[i - 1] == 0x0a));
+ if (x[i - 1] == 0x0a) {
+ i -= 1;
}
- n += __ASH((int)(__MASK((int)ch, -64) - __ASHL(__ASHR((int)ch, 6), 6)), s);
- *x = n;
+ if ((i > 0 && x[i - 1] == 0x0d)) {
+ i -= 1;
+ }
+ x[i] = 0x00;
}
-void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x)
+void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len)
+{
+ INT8 s, b;
+ INT64 q;
+ s = 0;
+ q = 0;
+ Files_Read(&*R, R__typ, (void*)&b);
+ while (b < 0) {
+ q += (INT64)__ASH(((INT16)b + 128), s);
+ s += 7;
+ Files_Read(&*R, R__typ, (void*)&b);
+ }
+ q += (INT64)__ASH((__MASK(b, -64) - __ASHL(__ASHR(b, 6), 6)), s);
+ __ASSERT(x__len <= 8, 0);
+ __MOVE((ADDRESS)&q, (ADDRESS)x, x__len);
+}
+
+void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x)
{
Files_Write(&*R, R__typ, __VAL(CHAR, x));
}
-void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x)
+void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x)
{
CHAR b[2];
b[0] = (CHAR)x;
b[1] = (CHAR)__ASHR(x, 8);
- Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(2)), ((LONGINT)(2)));
+ Files_WriteBytes(&*R, R__typ, (void*)b, 2, 2);
}
-void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x)
+void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x)
{
CHAR b[4];
b[0] = (CHAR)x;
b[1] = (CHAR)__ASHR(x, 8);
b[2] = (CHAR)__ASHR(x, 16);
b[3] = (CHAR)__ASHR(x, 24);
- Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
+ Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
}
-void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x)
+void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x)
{
CHAR b[4];
- LONGINT i;
- i = (LONGINT)x;
+ INT32 i;
+ i = (INT32)x;
b[0] = (CHAR)i;
b[1] = (CHAR)__ASHR(i, 8);
b[2] = (CHAR)__ASHR(i, 16);
b[3] = (CHAR)__ASHR(i, 24);
- Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
+ Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
}
-void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x)
+void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x)
{
CHAR b[4];
- Files_FlipBytes((void*)&x, ((LONGINT)(4)), (void*)b, ((LONGINT)(4)));
- Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
+ Files_FlipBytes((void*)&x, 4, (void*)b, 4);
+ Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
}
-void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x)
+void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x)
{
CHAR b[8];
- Files_FlipBytes((void*)&x, ((LONGINT)(8)), (void*)b, ((LONGINT)(8)));
- Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(8)), ((LONGINT)(8)));
+ Files_FlipBytes((void*)&x, 8, (void*)b, 8);
+ Files_WriteBytes(&*R, R__typ, (void*)b, 8, 8);
}
-void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len)
+void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
{
- INTEGER i;
+ INT16 i;
i = 0;
while (x[i] != 0x00) {
i += 1;
}
- Files_WriteBytes(&*R, R__typ, (void*)x, x__len * ((LONGINT)(1)), i + 1);
+ Files_WriteBytes(&*R, R__typ, (void*)x, x__len * 1, i + 1);
}
-void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x)
+void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x)
{
while (x < -64 || x > 63) {
Files_Write(&*R, R__typ, (CHAR)(__MASK(x, -128) + 128));
@@ -1007,12 +999,12 @@ void Files_GetName (Files_File f, CHAR *name, LONGINT name__len)
static void Files_Finalize (SYSTEM_PTR o)
{
Files_File f = NIL;
- LONGINT res;
- f = (Files_File)(SYSTEM_ADDRESS)o;
+ INT32 res;
+ f = (Files_File)(ADDRESS)o;
if (f->fd >= 0) {
Files_CloseOSFile(f);
if (f->tempFile) {
- res = Platform_Unlink((void*)f->workName, ((LONGINT)(101)));
+ res = Platform_Unlink((void*)f->workName, 101);
}
}
}
@@ -1021,7 +1013,7 @@ void Files_SetSearchPath (CHAR *path, LONGINT path__len)
{
__DUP(path, path__len, CHAR);
if (Strings_Length(path, path__len) != 0) {
- Files_SearchPath = __NEWARR(NIL, ((LONGINT)(1)), 1, 1, 1, (LONGINT)(Strings_Length(path, path__len) + 1));
+ Files_SearchPath = __NEWARR(NIL, 1, 1, 1, 1, ((ADDRESS)((Strings_Length(path, path__len) + 1))));
__COPY(path, Files_SearchPath->data, Files_SearchPath->len[0]);
} else {
Files_SearchPath = NIL;
@@ -1042,9 +1034,8 @@ __TDESC(Files_Rider, 1, 1) = {__TDFLDS("Rider", 20), {8, -8}};
export void *Files__init(void)
{
__DEFMOD;
- __MODULE_IMPORT(Configuration);
- __MODULE_IMPORT(Console);
__MODULE_IMPORT(Heap);
+ __MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
__REGMOD("Files", EnumPtrs);
@@ -1055,6 +1046,6 @@ export void *Files__init(void)
Files_tempno = -1;
Heap_FileCount = 0;
Files_HOME[0] = 0x00;
- Platform_GetEnv((CHAR*)"HOME", (LONGINT)5, (void*)Files_HOME, ((LONGINT)(1024)));
+ Platform_GetEnv((CHAR*)"HOME", 5, (void*)Files_HOME, 1024);
__ENDMOD;
}
diff --git a/bootstrap/unix-48/Files.h b/bootstrap/unix-48/Files.h
index a4a4ea8c..79164af5 100644
--- a/bootstrap/unix-48/Files.h
+++ b/bootstrap/unix-48/Files.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
#ifndef Files__h
#define Files__h
@@ -11,60 +11,59 @@ typedef
typedef
struct Files_FileDesc {
char _prvt0[216];
- LONGINT fd;
+ INT32 fd;
char _prvt1[32];
} Files_FileDesc;
typedef
struct Files_Rider {
- LONGINT res;
+ INT32 res;
BOOLEAN eof;
char _prvt0[15];
} Files_Rider;
-import LONGINT *Files_FileDesc__typ;
-import LONGINT *Files_Rider__typ;
+import ADDRESS *Files_FileDesc__typ;
+import ADDRESS *Files_Rider__typ;
-import Files_File Files_Base (Files_Rider *r, LONGINT *r__typ);
-import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res);
+import Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
+import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res);
import void Files_Close (Files_File f);
-import void Files_Delete (CHAR *name, LONGINT name__len, INTEGER *res);
-import void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d);
+import void Files_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, LONGINT name__len);
-import LONGINT Files_Length (Files_File f);
+import INT32 Files_Length (Files_File f);
import Files_File Files_New (CHAR *name, LONGINT name__len);
import Files_File Files_Old (CHAR *name, LONGINT name__len);
-import LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ);
+import INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ);
import void Files_Purge (Files_File f);
-import void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x);
-import void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x);
-import void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len);
-import void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n);
-import void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x);
-import void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x);
-import void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x);
-import void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
-import void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x);
-import void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x);
-import void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x);
-import void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
+import void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
+import void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x);
+import void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+import void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x);
+import void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x);
+import void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
+import void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+import void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
+import void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
+import void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
+import void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
import void Files_Register (Files_File f);
-import void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res);
-import void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos);
+import void Files_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, LONGINT path__len);
-import void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x);
-import void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x);
-import void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n);
-import void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x);
-import void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x);
-import void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x);
-import void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x);
-import void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x);
-import void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x);
-import void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
+import void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
+import void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
+import void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+import void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
+import void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
+import void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
+import void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
+import void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
+import void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
+import void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
import void *Files__init(void);
-#endif
+#endif // Files
diff --git a/bootstrap/unix-48/Heap.c b/bootstrap/unix-48/Heap.c
index 30ec687a..72677604 100644
--- a/bootstrap/unix-48/Heap.c
+++ b/bootstrap/unix-48/Heap.c
@@ -1,4 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tskSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tsSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
struct Heap__1 {
@@ -34,7 +40,7 @@ typedef
typedef
struct Heap_FinDesc {
Heap_FinNode next;
- LONGINT obj;
+ INT32 obj;
BOOLEAN marked;
Heap_Finalizer finalize;
} Heap_FinDesc;
@@ -49,62 +55,61 @@ typedef
struct Heap_ModuleDesc {
Heap_Module next;
Heap_ModuleName name;
- LONGINT refcnt;
+ INT32 refcnt;
Heap_Cmd cmds;
- LONGINT types;
+ INT32 types;
Heap_EnumProc enumPtrs;
- LONGINT reserved1, reserved2;
+ INT32 reserved1, reserved2;
} Heap_ModuleDesc;
export SYSTEM_PTR Heap_modules;
-static LONGINT Heap_freeList[10];
-static LONGINT Heap_bigBlocks;
-export LONGINT Heap_allocated;
+static INT32 Heap_freeList[10];
+static INT32 Heap_bigBlocks;
+export INT32 Heap_allocated;
static BOOLEAN Heap_firstTry;
-static LONGINT Heap_heap, Heap_heapend;
-export LONGINT Heap_heapsize;
+static INT32 Heap_heap, Heap_heapend;
+export INT32 Heap_heapsize;
static Heap_FinNode Heap_fin;
-static INTEGER Heap_lockdepth;
+static INT16 Heap_lockdepth;
static BOOLEAN Heap_interrupted;
-export INTEGER Heap_FileCount;
+export INT16 Heap_FileCount;
-export LONGINT *Heap_ModuleDesc__typ;
-export LONGINT *Heap_CmdDesc__typ;
-export LONGINT *Heap_FinDesc__typ;
-export LONGINT *Heap__1__typ;
+export ADDRESS *Heap_ModuleDesc__typ;
+export ADDRESS *Heap_CmdDesc__typ;
+export ADDRESS *Heap_FinDesc__typ;
+export ADDRESS *Heap__1__typ;
static void Heap_CheckFin (void);
-static void Heap_ExtendHeap (LONGINT blksz);
+static void Heap_ExtendHeap (INT32 blksz);
export void Heap_FINALL (void);
static void Heap_Finalize (void);
export void Heap_GC (BOOLEAN markStack);
-static void Heap_HeapSort (LONGINT n, LONGINT *a, LONGINT a__len);
+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 (LONGINT q);
-static void Heap_MarkCandidates (LONGINT n, LONGINT *cand, LONGINT cand__len);
+static void Heap_Mark (INT32 q);
+static void Heap_MarkCandidates (INT32 n, INT32 *cand, LONGINT cand__len);
static void Heap_MarkP (SYSTEM_PTR p);
-static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len);
-export SYSTEM_PTR Heap_NEWBLK (LONGINT size);
-export SYSTEM_PTR Heap_NEWREC (LONGINT tag);
-static LONGINT Heap_NewChunk (LONGINT blksz);
+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);
export void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd);
export SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs);
-export void Heap_REGTYP (Heap_Module m, LONGINT typ);
+export void Heap_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 (LONGINT l, LONGINT r, LONGINT *a, LONGINT 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 LONGINT Platform_MainStackFrame;
-extern LONGINT Platform_OSAllocate(LONGINT size);
-#define Heap_FetchAddress(pointer) (LONGINT)(SYSTEM_ADDRESS)(*((void**)((SYSTEM_ADDRESS)pointer)))
+extern ADDRESS Platform_MainStackFrame;
+extern ADDRESS Platform_OSAllocate(ADDRESS size);
#define Heap_HeapModuleInit() Heap__init()
+#define Heap_ModulesHalt(code) Modules_Halt(code)
#define Heap_OSAllocate(size) Platform_OSAllocate(size)
-#define Heap_PlatformHalt(code) Platform_Halt(code)
#define Heap_PlatformMainStackFrame() Platform_MainStackFrame
void Heap_Lock (void)
@@ -116,13 +121,12 @@ void Heap_Unlock (void)
{
Heap_lockdepth -= 1;
if ((Heap_interrupted && Heap_lockdepth == 0)) {
- Heap_PlatformHalt(((LONGINT)(-9)));
+ Heap_ModulesHalt(-9);
}
}
SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs)
{
- SYSTEM_PTR _o_result;
Heap_Module m;
if (__STRCMP(name, "Heap") == 0) {
__SYSNEW(m, 48);
@@ -131,13 +135,12 @@ SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs)
}
m->types = 0;
m->cmds = NIL;
- __COPY(name, m->name, ((LONGINT)(20)));
+ __COPY(name, m->name, 20);
m->refcnt = 0;
m->enumPtrs = enumPtrs;
- m->next = (Heap_Module)(SYSTEM_ADDRESS)Heap_modules;
+ m->next = (Heap_Module)(ADDRESS)Heap_modules;
Heap_modules = (SYSTEM_PTR)m;
- _o_result = (void*)m;
- return _o_result;
+ return (void*)m;
}
void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd)
@@ -148,15 +151,15 @@ void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd)
} else {
__NEW(c, Heap_CmdDesc);
}
- __COPY(name, c->name, ((LONGINT)(24)));
+ __COPY(name, c->name, 24);
c->cmd = cmd;
c->next = m->cmds;
m->cmds = c;
}
-void Heap_REGTYP (Heap_Module m, LONGINT typ)
+void Heap_REGTYP (Heap_Module m, INT32 typ)
{
- __PUT(typ, m->types, LONGINT);
+ __PUT(typ, m->types, INT32);
m->types = typ;
}
@@ -165,27 +168,25 @@ void Heap_INCREF (Heap_Module m)
m->refcnt += 1;
}
-static LONGINT Heap_NewChunk (LONGINT blksz)
+static INT32 Heap_NewChunk (INT32 blksz)
{
- LONGINT _o_result;
- LONGINT chnk;
+ INT32 chnk;
chnk = Heap_OSAllocate(blksz + 12);
if (chnk != 0) {
- __PUT(chnk + 4, chnk + (12 + blksz), LONGINT);
- __PUT(chnk + 12, chnk + 16, LONGINT);
- __PUT(chnk + 16, blksz, LONGINT);
- __PUT(chnk + 20, -4, LONGINT);
- __PUT(chnk + 24, Heap_bigBlocks, LONGINT);
+ __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;
}
- _o_result = chnk;
- return _o_result;
+ return chnk;
}
-static void Heap_ExtendHeap (LONGINT blksz)
+static void Heap_ExtendHeap (INT32 blksz)
{
- LONGINT size, chnk, j, next;
+ INT32 size, chnk, j, next;
if (blksz > 160000) {
size = blksz;
} else {
@@ -194,31 +195,30 @@ static void Heap_ExtendHeap (LONGINT blksz)
chnk = Heap_NewChunk(size);
if (chnk != 0) {
if (chnk < Heap_heap) {
- __PUT(chnk, Heap_heap, LONGINT);
+ __PUT(chnk, Heap_heap, INT32);
Heap_heap = chnk;
} else {
j = Heap_heap;
- next = Heap_FetchAddress(j);
+ __GET(j, next, INT32);
while ((next != 0 && chnk > next)) {
j = next;
- next = Heap_FetchAddress(j);
+ __GET(j, next, INT32);
}
- __PUT(chnk, next, LONGINT);
- __PUT(j, chnk, LONGINT);
+ __PUT(chnk, next, INT32);
+ __PUT(j, chnk, INT32);
}
if (next == 0) {
- Heap_heapend = Heap_FetchAddress(chnk + 4);
+ __GET(chnk + 4, Heap_heapend, INT32);
}
}
}
-SYSTEM_PTR Heap_NEWREC (LONGINT tag)
+SYSTEM_PTR Heap_NEWREC (INT32 tag)
{
- SYSTEM_PTR _o_result;
- LONGINT i, i0, di, blksz, restsize, t, adr, end, next, prev;
+ INT32 i, i0, di, blksz, restsize, t, adr, end, next, prev;
SYSTEM_PTR new;
Heap_Lock();
- blksz = Heap_FetchAddress(tag);
+ __GET(tag, blksz, INT32);
i0 = __ASHR(blksz, 4);
i = i0;
if (i < 9) {
@@ -229,17 +229,17 @@ SYSTEM_PTR Heap_NEWREC (LONGINT tag)
}
}
if (i < 9) {
- next = Heap_FetchAddress(adr + 12);
+ __GET(adr + 12, next, INT32);
Heap_freeList[i] = next;
if (i != i0) {
di = i - i0;
restsize = __ASHL(di, 4);
end = adr + restsize;
- __PUT(end + 4, blksz, LONGINT);
- __PUT(end + 8, -4, LONGINT);
- __PUT(end, end + 4, LONGINT);
- __PUT(adr + 4, restsize, LONGINT);
- __PUT(adr + 12, Heap_freeList[di], LONGINT);
+ __PUT(end + 4, blksz, INT32);
+ __PUT(end + 8, -4, INT32);
+ __PUT(end, end + 4, INT32);
+ __PUT(adr + 4, restsize, INT32);
+ __PUT(adr + 12, Heap_freeList[di], INT32);
Heap_freeList[di] = adr;
adr += restsize;
}
@@ -262,39 +262,37 @@ SYSTEM_PTR Heap_NEWREC (LONGINT tag)
new = Heap_NEWREC(tag);
}
Heap_Unlock();
- _o_result = new;
- return _o_result;
+ return new;
} else {
Heap_Unlock();
- _o_result = NIL;
- return _o_result;
+ return NIL;
}
}
- t = Heap_FetchAddress(adr + 4);
+ __GET(adr + 4, t, INT32);
if (t >= blksz) {
break;
}
prev = adr;
- adr = Heap_FetchAddress(adr + 12);
+ __GET(adr + 12, adr, INT32);
}
restsize = t - blksz;
end = adr + restsize;
- __PUT(end + 4, blksz, LONGINT);
- __PUT(end + 8, -4, LONGINT);
- __PUT(end, end + 4, LONGINT);
+ __PUT(end + 4, blksz, INT32);
+ __PUT(end + 8, -4, INT32);
+ __PUT(end, end + 4, INT32);
if (restsize > 144) {
- __PUT(adr + 4, restsize, LONGINT);
+ __PUT(adr + 4, restsize, INT32);
} else {
- next = Heap_FetchAddress(adr + 12);
+ __GET(adr + 12, next, INT32);
if (prev == 0) {
Heap_bigBlocks = next;
} else {
- __PUT(prev + 12, next, LONGINT);
+ __PUT(prev + 12, next, INT32);
}
if (restsize > 0) {
di = __ASHR(restsize, 4);
- __PUT(adr + 4, restsize, LONGINT);
- __PUT(adr + 12, Heap_freeList[di], LONGINT);
+ __PUT(adr + 4, restsize, INT32);
+ __PUT(adr + 12, Heap_freeList[di], INT32);
Heap_freeList[di] = adr;
}
}
@@ -303,73 +301,70 @@ SYSTEM_PTR Heap_NEWREC (LONGINT tag)
i = adr + 16;
end = adr + blksz;
while (i < end) {
- __PUT(i, 0, LONGINT);
- __PUT(i + 4, 0, LONGINT);
- __PUT(i + 8, 0, LONGINT);
- __PUT(i + 12, 0, LONGINT);
+ __PUT(i, 0, INT32);
+ __PUT(i + 4, 0, INT32);
+ __PUT(i + 8, 0, INT32);
+ __PUT(i + 12, 0, INT32);
i += 16;
}
- __PUT(adr + 12, 0, LONGINT);
- __PUT(adr, tag, LONGINT);
- __PUT(adr + 4, 0, LONGINT);
- __PUT(adr + 8, 0, LONGINT);
+ __PUT(adr + 12, 0, INT32);
+ __PUT(adr, tag, INT32);
+ __PUT(adr + 4, 0, INT32);
+ __PUT(adr + 8, 0, INT32);
Heap_allocated += blksz;
Heap_Unlock();
- _o_result = (SYSTEM_PTR)(SYSTEM_ADDRESS)(adr + 4);
- return _o_result;
+ return (SYSTEM_PTR)(ADDRESS)(adr + 4);
}
-SYSTEM_PTR Heap_NEWBLK (LONGINT size)
+SYSTEM_PTR Heap_NEWBLK (INT32 size)
{
- SYSTEM_PTR _o_result;
- LONGINT blksz, tag;
+ INT32 blksz, tag;
SYSTEM_PTR new;
Heap_Lock();
blksz = __ASHL(__ASHR(size + 31, 4), 4);
- new = Heap_NEWREC((LONGINT)(SYSTEM_ADDRESS)&blksz);
- tag = ((LONGINT)(SYSTEM_ADDRESS)new + blksz) - 12;
- __PUT(tag - 4, 0, LONGINT);
- __PUT(tag, blksz, LONGINT);
- __PUT(tag + 4, -4, LONGINT);
- __PUT((LONGINT)(SYSTEM_ADDRESS)new - 4, tag, LONGINT);
+ new = Heap_NEWREC((ADDRESS)&blksz);
+ tag = ((INT32)(ADDRESS)new + blksz) - 12;
+ __PUT(tag - 4, 0, INT32);
+ __PUT(tag, blksz, INT32);
+ __PUT(tag + 4, -4, INT32);
+ __PUT((INT32)(ADDRESS)new - 4, tag, INT32);
Heap_Unlock();
- _o_result = new;
- return _o_result;
+ return new;
}
-static void Heap_Mark (LONGINT q)
+static void Heap_Mark (INT32 q)
{
- LONGINT p, tag, fld, n, offset, tagbits;
+ INT32 p, tag, offset, fld, n, tagbits;
if (q != 0) {
- tagbits = Heap_FetchAddress(q - 4);
+ __GET(q - 4, tagbits, INT32);
if (!__ODD(tagbits)) {
- __PUT(q - 4, tagbits + 1, LONGINT);
+ __PUT(q - 4, tagbits + 1, INT32);
p = 0;
tag = tagbits + 4;
for (;;) {
- __GET(tag, offset, LONGINT);
+ __GET(tag, offset, INT32);
if (offset < 0) {
- __PUT(q - 4, (tag + offset) + 1, LONGINT);
+ __PUT(q - 4, (tag + offset) + 1, INT32);
if (p == 0) {
break;
}
n = q;
q = p;
- tag = Heap_FetchAddress(q - 4);
+ __GET(q - 4, tag, INT32);
tag -= 1;
- __GET(tag, offset, LONGINT);
+ __GET(tag, offset, INT32);
fld = q + offset;
- p = Heap_FetchAddress(fld);
- __PUT(fld, (SYSTEM_PTR)(SYSTEM_ADDRESS)n, SYSTEM_PTR);
+ __GET(fld, p, INT32);
+ __PUT(fld, (SYSTEM_PTR)(ADDRESS)n, SYSTEM_PTR);
} else {
fld = q + offset;
- n = Heap_FetchAddress(fld);
+ __GET(fld, n, INT32);
if (n != 0) {
- tagbits = Heap_FetchAddress(n - 4);
+ __GET(n - 4, tagbits, INT32);
if (!__ODD(tagbits)) {
- __PUT(n - 4, tagbits + 1, LONGINT);
- __PUT(q - 4, tag + 1, LONGINT);
- __PUT(fld, (SYSTEM_PTR)(SYSTEM_ADDRESS)p, SYSTEM_PTR);
+ __PUT(n - 4, tagbits + 1, INT32);
+ __PUT(q - 4, tag + 1, INT32);
+ __PUT(fld, (SYSTEM_PTR)(ADDRESS)p, SYSTEM_PTR);
p = q;
q = n;
tag = tagbits;
@@ -384,12 +379,12 @@ static void Heap_Mark (LONGINT q)
static void Heap_MarkP (SYSTEM_PTR p)
{
- Heap_Mark((LONGINT)(SYSTEM_ADDRESS)p);
+ Heap_Mark((INT32)(ADDRESS)p);
}
static void Heap_Scan (void)
{
- LONGINT chnk, adr, end, start, tag, i, size, freesize;
+ INT32 chnk, adr, end, start, tag, i, size, freesize;
Heap_bigBlocks = 0;
i = 1;
while (i < 9) {
@@ -401,58 +396,58 @@ static void Heap_Scan (void)
chnk = Heap_heap;
while (chnk != 0) {
adr = chnk + 12;
- end = Heap_FetchAddress(chnk + 4);
+ __GET(chnk + 4, end, INT32);
while (adr < end) {
- tag = Heap_FetchAddress(adr);
+ __GET(adr, tag, INT32);
if (__ODD(tag)) {
if (freesize > 0) {
start = adr - freesize;
- __PUT(start, start + 4, LONGINT);
- __PUT(start + 4, freesize, LONGINT);
- __PUT(start + 8, -4, LONGINT);
+ __PUT(start, start + 4, INT32);
+ __PUT(start + 4, freesize, INT32);
+ __PUT(start + 8, -4, INT32);
i = __ASHR(freesize, 4);
freesize = 0;
if (i < 9) {
- __PUT(start + 12, Heap_freeList[i], LONGINT);
+ __PUT(start + 12, Heap_freeList[i], INT32);
Heap_freeList[i] = start;
} else {
- __PUT(start + 12, Heap_bigBlocks, LONGINT);
+ __PUT(start + 12, Heap_bigBlocks, INT32);
Heap_bigBlocks = start;
}
}
tag -= 1;
- __PUT(adr, tag, LONGINT);
- size = Heap_FetchAddress(tag);
+ __PUT(adr, tag, INT32);
+ __GET(tag, size, INT32);
Heap_allocated += size;
adr += size;
} else {
- size = Heap_FetchAddress(tag);
+ __GET(tag, size, INT32);
freesize += size;
adr += size;
}
}
if (freesize > 0) {
start = adr - freesize;
- __PUT(start, start + 4, LONGINT);
- __PUT(start + 4, freesize, LONGINT);
- __PUT(start + 8, -4, LONGINT);
+ __PUT(start, start + 4, INT32);
+ __PUT(start + 4, freesize, INT32);
+ __PUT(start + 8, -4, INT32);
i = __ASHR(freesize, 4);
freesize = 0;
if (i < 9) {
- __PUT(start + 12, Heap_freeList[i], LONGINT);
+ __PUT(start + 12, Heap_freeList[i], INT32);
Heap_freeList[i] = start;
} else {
- __PUT(start + 12, Heap_bigBlocks, LONGINT);
+ __PUT(start + 12, Heap_bigBlocks, INT32);
Heap_bigBlocks = start;
}
}
- chnk = Heap_FetchAddress(chnk);
+ __GET(chnk, chnk, INT32);
}
}
-static void Heap_Sift (LONGINT l, LONGINT r, LONGINT *a, LONGINT a__len)
+static void Heap_Sift (INT32 l, INT32 r, INT32 *a, LONGINT a__len)
{
- LONGINT i, j, x;
+ INT32 i, j, x;
j = l;
x = a[j];
for (;;) {
@@ -469,9 +464,9 @@ static void Heap_Sift (LONGINT l, LONGINT r, LONGINT *a, LONGINT a__len)
a[i] = x;
}
-static void Heap_HeapSort (LONGINT n, LONGINT *a, LONGINT a__len)
+static void Heap_HeapSort (INT32 n, INT32 *a, LONGINT a__len)
{
- LONGINT l, r, x;
+ INT32 l, r, x;
l = __ASHR(n, 1);
r = n - 1;
while (l > 0) {
@@ -487,25 +482,25 @@ static void Heap_HeapSort (LONGINT n, LONGINT *a, LONGINT a__len)
}
}
-static void Heap_MarkCandidates (LONGINT n, LONGINT *cand, LONGINT cand__len)
+static void Heap_MarkCandidates (INT32 n, INT32 *cand, LONGINT cand__len)
{
- LONGINT chnk, adr, tag, next, lim, lim1, i, ptr, size;
+ INT32 chnk, adr, tag, next, lim, lim1, i, ptr, size;
chnk = Heap_heap;
i = 0;
lim = cand[n - 1];
while ((chnk != 0 && chnk < lim)) {
adr = chnk + 12;
- lim1 = Heap_FetchAddress(chnk + 4);
+ __GET(chnk + 4, lim1, INT32);
if (lim < lim1) {
lim1 = lim;
}
while (adr < lim1) {
- tag = Heap_FetchAddress(adr);
+ __GET(adr, tag, INT32);
if (__ODD(tag)) {
- size = Heap_FetchAddress(tag - 1);
+ __GET(tag - 1, size, INT32);
adr += size;
} else {
- size = Heap_FetchAddress(tag);
+ __GET(tag, size, INT32);
ptr = adr + 4;
while (cand[i] < ptr) {
i += 1;
@@ -520,17 +515,17 @@ static void Heap_MarkCandidates (LONGINT n, LONGINT *cand, LONGINT cand__len)
adr = next;
}
}
- chnk = Heap_FetchAddress(chnk);
+ __GET(chnk, chnk, INT32);
}
}
static void Heap_CheckFin (void)
{
Heap_FinNode n;
- LONGINT tag;
+ INT32 tag;
n = Heap_fin;
while (n != NIL) {
- tag = Heap_FetchAddress(n->obj - 4);
+ __GET(n->obj - 4, tag, INT32);
if (!__ODD(tag)) {
n->marked = 0;
Heap_Mark(n->obj);
@@ -553,7 +548,7 @@ static void Heap_Finalize (void)
} else {
prev->next = n->next;
}
- (*n->finalize)((SYSTEM_PTR)(SYSTEM_ADDRESS)n->obj);
+ (*n->finalize)((SYSTEM_PTR)(ADDRESS)n->obj);
if (prev == NIL) {
n = Heap_fin;
} else {
@@ -572,14 +567,14 @@ void Heap_FINALL (void)
while (Heap_fin != NIL) {
n = Heap_fin;
Heap_fin = Heap_fin->next;
- (*n->finalize)((SYSTEM_PTR)(SYSTEM_ADDRESS)n->obj);
+ (*n->finalize)((SYSTEM_PTR)(ADDRESS)n->obj);
}
}
-static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len)
+static void Heap_MarkStack (INT32 n, INT32 *cand, LONGINT cand__len)
{
SYSTEM_PTR frame;
- LONGINT inc, nofcand, sp, p, stack0;
+ INT32 inc, nofcand, sp, p, stack0;
struct Heap__1 align;
if (n > 0) {
Heap_MarkStack(n - 1, cand, cand__len);
@@ -589,14 +584,14 @@ static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len)
}
if (n == 0) {
nofcand = 0;
- sp = (LONGINT)(SYSTEM_ADDRESS)&frame;
+ sp = (ADDRESS)&frame;
stack0 = Heap_PlatformMainStackFrame();
- inc = (LONGINT)(SYSTEM_ADDRESS)&align.p - (LONGINT)(SYSTEM_ADDRESS)&align;
+ inc = (ADDRESS)&align.p - (ADDRESS)&align;
if (sp > stack0) {
inc = -inc;
}
while (sp != stack0) {
- __GET(sp, p, LONGINT);
+ __GET(sp, p, INT32);
if ((p > Heap_heap && p < Heap_heapend)) {
if (nofcand == cand__len) {
Heap_HeapSort(nofcand, (void*)cand, cand__len);
@@ -618,11 +613,11 @@ static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len)
void Heap_GC (BOOLEAN markStack)
{
Heap_Module m;
- LONGINT i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23;
- LONGINT cand[10000];
+ INT32 i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23;
+ INT32 cand[10000];
if (Heap_lockdepth == 0 || (Heap_lockdepth == 1 && !markStack)) {
Heap_Lock();
- m = (Heap_Module)(SYSTEM_ADDRESS)Heap_modules;
+ m = (Heap_Module)(ADDRESS)Heap_modules;
while (m != NIL) {
if (m->enumPtrs != NIL) {
(*m->enumPtrs)(Heap_MarkP);
@@ -680,7 +675,7 @@ void Heap_GC (BOOLEAN markStack)
i22 += 23;
i23 += 24;
if ((i0 == -99 && i15 == 24)) {
- Heap_MarkStack(((LONGINT)(32)), (void*)cand, ((LONGINT)(10000)));
+ Heap_MarkStack(32, (void*)cand, 10000);
break;
}
}
@@ -699,7 +694,7 @@ void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
{
Heap_FinNode f;
__NEW(f, Heap_FinDesc);
- f->obj = (LONGINT)(SYSTEM_ADDRESS)obj;
+ f->obj = (INT32)(ADDRESS)obj;
f->finalize = finalize;
f->marked = 1;
f->next = Heap_fin;
@@ -709,8 +704,8 @@ void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
void Heap_InitHeap (void)
{
Heap_heap = Heap_NewChunk(128000);
- Heap_heapend = Heap_FetchAddress(Heap_heap + 4);
- __PUT(Heap_heap, 0, LONGINT);
+ __GET(Heap_heap + 4, Heap_heapend, INT32);
+ __PUT(Heap_heap, 0, INT32);
Heap_allocated = 0;
Heap_firstTry = 1;
Heap_freeList[9] = 1;
diff --git a/bootstrap/unix-48/Heap.h b/bootstrap/unix-48/Heap.h
index a2cab30c..0aa0a18b 100644
--- a/bootstrap/unix-48/Heap.h
+++ b/bootstrap/unix-48/Heap.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tskSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tsSF */
#ifndef Heap__h
#define Heap__h
@@ -22,7 +22,7 @@ typedef
typedef
struct Heap_ModuleDesc {
- LONGINT _prvt0;
+ INT32 _prvt0;
char _prvt1[44];
} Heap_ModuleDesc;
@@ -31,24 +31,24 @@ typedef
import SYSTEM_PTR Heap_modules;
-import LONGINT Heap_allocated, Heap_heapsize;
-import INTEGER Heap_FileCount;
+import INT32 Heap_allocated, Heap_heapsize;
+import INT16 Heap_FileCount;
-import LONGINT *Heap_ModuleDesc__typ;
+import ADDRESS *Heap_ModuleDesc__typ;
import void Heap_FINALL (void);
import void Heap_GC (BOOLEAN markStack);
import void Heap_INCREF (Heap_Module m);
import void Heap_InitHeap (void);
import void Heap_Lock (void);
-import SYSTEM_PTR Heap_NEWBLK (LONGINT size);
-import SYSTEM_PTR Heap_NEWREC (LONGINT tag);
+import SYSTEM_PTR Heap_NEWBLK (INT32 size);
+import SYSTEM_PTR Heap_NEWREC (INT32 tag);
import void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd);
import SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs);
-import void Heap_REGTYP (Heap_Module m, LONGINT typ);
+import void Heap_REGTYP (Heap_Module m, INT32 typ);
import void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize);
import void Heap_Unlock (void);
import void *Heap__init(void);
-#endif
+#endif // Heap
diff --git a/bootstrap/unix-48/Modules.c b/bootstrap/unix-48/Modules.c
index 330b7506..a5e72ba3 100644
--- a/bootstrap/unix-48/Modules.c
+++ b/bootstrap/unix-48/Modules.c
@@ -1,7 +1,13 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
-#include "Console.h"
#include "Heap.h"
+#include "Platform.h"
typedef
struct Modules_CmdDesc *Modules_Cmd;
@@ -26,32 +32,38 @@ typedef
struct Modules_ModuleDesc {
Modules_Module next;
Modules_ModuleName name;
- LONGINT refcnt;
+ INT32 refcnt;
Modules_Cmd cmds;
- LONGINT types;
- void (*enumPtrs)(void(*)(LONGINT));
- LONGINT reserved1, reserved2;
+ INT32 types;
+ void (*enumPtrs)(void(*)(INT32));
+ INT32 reserved1, reserved2;
} Modules_ModuleDesc;
-export INTEGER Modules_res;
+export INT16 Modules_res;
export CHAR Modules_resMsg[256];
export Modules_ModuleName Modules_imported, Modules_importing;
-export LONGINT *Modules_ModuleDesc__typ;
-export LONGINT *Modules_CmdDesc__typ;
+export ADDRESS *Modules_ModuleDesc__typ;
+export ADDRESS *Modules_CmdDesc__typ;
static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len);
+export void Modules_AssertFail (INT32 code);
+static void Modules_DisplayHaltCode (INT32 code);
export void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
+export void Modules_Halt (INT32 code);
export Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
export Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
+static void Modules_errch (CHAR c);
+static void Modules_errint (INT32 l);
+static void Modules_errstring (CHAR *s, LONGINT s__len);
#define Modules_modules() (Modules_Module)Heap_modules
#define Modules_setmodules(m) Heap_modules = m
static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len)
{
- INTEGER i, j;
+ INT16 i, j;
__DUP(b, b__len, CHAR);
i = 0;
while (a[__X(i, a__len)] != 0x00) {
@@ -69,7 +81,6 @@ static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len)
Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
{
- Modules_Module _o_result;
Modules_Module m = NIL;
CHAR bodyname[64];
Modules_Command body;
@@ -83,19 +94,17 @@ Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
Modules_resMsg[0] = 0x00;
} else {
Modules_res = 1;
- __COPY(name, Modules_importing, ((LONGINT)(20)));
+ __COPY(name, Modules_importing, 20);
__MOVE(" module \"", Modules_resMsg, 10);
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), name, name__len);
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)"\" not found", (LONGINT)12);
+ Modules_Append((void*)Modules_resMsg, 256, name, name__len);
+ Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
}
- _o_result = m;
__DEL(name);
- return _o_result;
+ return m;
}
Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len)
{
- Modules_Command _o_result;
Modules_Cmd c = NIL;
__DUP(name, name__len, CHAR);
c = mod->cmds;
@@ -105,20 +114,18 @@ Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT nam
if (c != NIL) {
Modules_res = 0;
Modules_resMsg[0] = 0x00;
- _o_result = c->cmd;
__DEL(name);
- return _o_result;
+ return c->cmd;
} else {
Modules_res = 2;
__MOVE(" command \"", Modules_resMsg, 11);
- __COPY(name, Modules_importing, ((LONGINT)(20)));
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), mod->name, ((LONGINT)(20)));
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)".", (LONGINT)2);
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), name, name__len);
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)"\" not found", (LONGINT)12);
- _o_result = NIL;
+ __COPY(name, Modules_importing, 20);
+ Modules_Append((void*)Modules_resMsg, 256, mod->name, 20);
+ Modules_Append((void*)Modules_resMsg, 256, (CHAR*)".", 2);
+ Modules_Append((void*)Modules_resMsg, 256, name, name__len);
+ Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
__DEL(name);
- return _o_result;
+ return NIL;
}
__RETCHK;
}
@@ -155,14 +162,124 @@ void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all)
__DEL(name);
}
+static void Modules_errch (CHAR c)
+{
+ INT16 e;
+ e = Platform_Write(1, (ADDRESS)&c, 1);
+}
+
+static void Modules_errstring (CHAR *s, LONGINT s__len)
+{
+ INT32 i;
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
+ Modules_errch(s[__X(i, s__len)]);
+ i += 1;
+ }
+ __DEL(s);
+}
+
+static void Modules_errint (INT32 l)
+{
+ if (l < 0) {
+ Modules_errch('-');
+ l = -l;
+ }
+ if (l >= 10) {
+ Modules_errint(__DIV(l, 10));
+ }
+ Modules_errch((CHAR)((int)__MOD(l, 10) + 48));
+}
+
+static void Modules_DisplayHaltCode (INT32 code)
+{
+ switch (code) {
+ case -1:
+ Modules_errstring((CHAR*)"Assertion failure.", 19);
+ break;
+ case -2:
+ Modules_errstring((CHAR*)"Index out of range.", 20);
+ break;
+ case -3:
+ Modules_errstring((CHAR*)"Reached end of function without reaching RETURN.", 49);
+ break;
+ case -4:
+ Modules_errstring((CHAR*)"CASE statement: no matching label and no ELSE.", 47);
+ break;
+ case -5:
+ Modules_errstring((CHAR*)"Type guard failed.", 19);
+ break;
+ case -6:
+ Modules_errstring((CHAR*)"Implicit type guard in record assignment failed.", 49);
+ break;
+ case -7:
+ Modules_errstring((CHAR*)"Invalid case in WITH statement.", 32);
+ break;
+ case -8:
+ Modules_errstring((CHAR*)"Value out of range.", 20);
+ break;
+ case -9:
+ Modules_errstring((CHAR*)"Heap interrupted while locked, but lockdepth = 0 at unlock.", 60);
+ break;
+ case -10:
+ Modules_errstring((CHAR*)"NIL access.", 12);
+ break;
+ case -11:
+ Modules_errstring((CHAR*)"Alignment error.", 17);
+ break;
+ case -12:
+ Modules_errstring((CHAR*)"Divide by zero.", 16);
+ break;
+ case -13:
+ Modules_errstring((CHAR*)"Arithmetic overflow/underflow.", 31);
+ break;
+ case -14:
+ Modules_errstring((CHAR*)"Invalid function argument.", 27);
+ break;
+ case -15:
+ Modules_errstring((CHAR*)"Internal error, e.g. Type descriptor size mismatch.", 52);
+ break;
+ case -20:
+ Modules_errstring((CHAR*)"Too many, or negative number of, elements in dynamic array.", 60);
+ break;
+ default:
+ break;
+ }
+}
+
+void Modules_Halt (INT32 code)
+{
+ Modules_errstring((CHAR*)"Terminated by Halt(", 20);
+ Modules_errint(code);
+ Modules_errstring((CHAR*)"). ", 4);
+ if (code < 0) {
+ Modules_DisplayHaltCode(code);
+ }
+ Modules_errstring(Platform_NL, 3);
+ Platform_Exit(code);
+}
+
+void Modules_AssertFail (INT32 code)
+{
+ Modules_errstring((CHAR*)"Assertion failure.", 19);
+ if (code != 0) {
+ Modules_errstring((CHAR*)" ASSERT code ", 14);
+ Modules_errint(code);
+ Modules_errstring((CHAR*)".", 2);
+ }
+ Modules_errstring(Platform_NL, 3);
+ 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)
{
__DEFMOD;
- __MODULE_IMPORT(Console);
__MODULE_IMPORT(Heap);
+ __MODULE_IMPORT(Platform);
__REGMOD("Modules", 0);
__INITYP(Modules_ModuleDesc, Modules_ModuleDesc, 0);
__INITYP(Modules_CmdDesc, Modules_CmdDesc, 0);
diff --git a/bootstrap/unix-48/Modules.h b/bootstrap/unix-48/Modules.h
index ac8ac89e..8bb89fe5 100644
--- a/bootstrap/unix-48/Modules.h
+++ b/bootstrap/unix-48/Modules.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Modules__h
#define Modules__h
@@ -28,27 +28,27 @@ typedef
struct Modules_ModuleDesc {
Modules_Module next;
Modules_ModuleName name;
- LONGINT refcnt;
+ INT32 refcnt;
Modules_Cmd cmds;
- LONGINT types;
- void (*enumPtrs)(void(*)(LONGINT));
+ INT32 types;
+ void (*enumPtrs)(void(*)(INT32));
char _prvt0[8];
} Modules_ModuleDesc;
-import INTEGER Modules_res;
+import INT16 Modules_res;
import CHAR Modules_resMsg[256];
import Modules_ModuleName Modules_imported, Modules_importing;
-import LONGINT *Modules_ModuleDesc__typ;
-import LONGINT *Modules_CmdDesc__typ;
+import ADDRESS *Modules_ModuleDesc__typ;
+import ADDRESS *Modules_CmdDesc__typ;
+import void Modules_AssertFail (INT32 code);
import void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
+import void Modules_Halt (INT32 code);
import Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
import Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
import void *Modules__init(void);
-#define Modules_modules() (Modules_Module)Heap_modules
-#define Modules_setmodules(m) Heap_modules = m
-#endif
+#endif // Modules
diff --git a/bootstrap/unix-48/OPB.c b/bootstrap/unix-48/OPB.c
index 0f614e6a..3ef8e2f9 100644
--- a/bootstrap/unix-48/OPB.c
+++ b/bootstrap/unix-48/OPB.c
@@ -1,18 +1,23 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "OPM.h"
#include "OPS.h"
#include "OPT.h"
-export void (*OPB_typSize)(OPT_Struct);
-static INTEGER OPB_exp;
-static LONGINT OPB_maxExp;
+static INT16 OPB_exp;
+static INT64 OPB_maxExp;
export void OPB_Assign (OPT_Node *x, OPT_Node y);
-static void OPB_BindNodes (SHORTINT class, OPT_Struct typ, OPT_Node *x, OPT_Node y);
-static LONGINT OPB_BoolToInt (BOOLEAN b);
+static void OPB_BindNodes (INT8 class, OPT_Struct typ, OPT_Node *x, OPT_Node y);
+static INT16 OPB_BoolToInt (BOOLEAN b);
export void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp);
static void OPB_CharToString (OPT_Node n);
static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode);
@@ -20,10 +25,10 @@ static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo);
export void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames);
static void OPB_CheckProc (OPT_Struct x, OPT_Object y);
static void OPB_CheckPtr (OPT_Node x, OPT_Node y);
-static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x);
+static void OPB_CheckRealType (INT16 f, INT16 nr, OPT_Const x);
static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp);
-static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y);
-export void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y);
+static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y);
+export void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y);
static void OPB_Convert (OPT_Node *x, OPT_Struct typ);
export void OPB_DeRef (OPT_Node *x);
static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar);
@@ -33,19 +38,17 @@ export void OPB_Field (OPT_Node *x, OPT_Object y);
export void OPB_In (OPT_Node *x, OPT_Node y);
export void OPB_Index (OPT_Node *x, OPT_Node y);
export void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ);
-static BOOLEAN OPB_IntToBool (LONGINT i);
-static OPT_Struct OPB_IntType (LONGINT size);
+static BOOLEAN OPB_IntToBool (INT64 i);
export void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y);
-static LONGINT OPB_LongerSize (LONGINT i);
-export void OPB_MOp (SHORTINT op, OPT_Node *x);
+export void OPB_MOp (INT8 op, OPT_Node *x);
export OPT_Node OPB_NewBoolConst (BOOLEAN boolval);
-export OPT_Node OPB_NewIntConst (LONGINT intval);
+export OPT_Node OPB_NewIntConst (INT64 intval);
export OPT_Node OPB_NewLeaf (OPT_Object obj);
export OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ);
-export OPT_Node OPB_NewString (OPS_String str, LONGINT len);
+export OPT_Node OPB_NewString (OPS_String str, INT64 len);
export OPT_Node OPB_Nil (void);
static BOOLEAN OPB_NotVar (OPT_Node x);
-export void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y);
+export void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y);
export void OPB_OptIf (OPT_Node *x);
export void OPB_Param (OPT_Node ap, OPT_Object fp);
export void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar);
@@ -53,26 +56,24 @@ export void OPB_Return (OPT_Node *x, OPT_Object proc);
export void OPB_SetElem (OPT_Node *x);
static void OPB_SetIntType (OPT_Node node);
export void OPB_SetRange (OPT_Node *x, OPT_Node y);
-static LONGINT OPB_ShorterSize (LONGINT i);
-static INTEGER OPB_SignedByteSize (LONGINT n);
-export void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno);
-export void OPB_StPar0 (OPT_Node *par0, INTEGER fctno);
-export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno);
-export void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n);
-export void OPB_StaticLink (SHORTINT dlev);
+static void OPB_SetSetType (OPT_Node node);
+export void OPB_StFct (OPT_Node *par0, INT8 fctno, INT16 parno);
+export void OPB_StPar0 (OPT_Node *par0, INT16 fctno);
+export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno);
+export void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n);
+export void OPB_StaticLink (INT8 dlev);
export void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard);
-static void OPB_err (INTEGER n);
-static LONGINT OPB_log (LONGINT x);
+static void OPB_err (INT16 n);
+static INT64 OPB_log (INT64 x);
-static void OPB_err (INTEGER n)
+static void OPB_err (INT16 n)
{
OPM_err(n);
}
OPT_Node OPB_NewLeaf (OPT_Object obj)
{
- OPT_Node _o_result;
OPT_Node node = NIL;
switch (obj->mode) {
case 1:
@@ -100,11 +101,10 @@ OPT_Node OPB_NewLeaf (OPT_Object obj)
}
node->obj = obj;
node->typ = obj->typ;
- _o_result = node;
- return _o_result;
+ return node;
}
-void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y)
+void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y)
{
OPT_Node node = NIL;
node = OPT_NewNode(class);
@@ -127,42 +127,29 @@ void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y)
*last = y;
}
-static LONGINT OPB_BoolToInt (BOOLEAN b)
+static INT16 OPB_BoolToInt (BOOLEAN b)
{
- LONGINT _o_result;
if (b) {
- _o_result = 1;
- return _o_result;
+ return 1;
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-static BOOLEAN OPB_IntToBool (LONGINT i)
+static BOOLEAN OPB_IntToBool (INT64 i)
{
- BOOLEAN _o_result;
- if (i == 0) {
- _o_result = 0;
- return _o_result;
- } else {
- _o_result = 1;
- return _o_result;
- }
- __RETCHK;
+ return i != 0;
}
OPT_Node OPB_NewBoolConst (BOOLEAN boolval)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->typ = OPT_booltyp;
x->conval = OPT_NewConst();
x->conval->intval = OPB_BoolToInt(boolval);
- _o_result = x;
- return _o_result;
+ return x;
}
void OPB_OptIf (OPT_Node *x)
@@ -202,130 +189,72 @@ void OPB_OptIf (OPT_Node *x)
OPT_Node OPB_Nil (void)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->typ = OPT_niltyp;
x->conval = OPT_NewConst();
x->conval->intval = 0;
- _o_result = x;
- return _o_result;
+ return x;
}
OPT_Node OPB_EmptySet (void)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->typ = OPT_settyp;
x->conval = OPT_NewConst();
x->conval->setval = 0x0;
- _o_result = x;
- return _o_result;
-}
-
-static INTEGER OPB_SignedByteSize (LONGINT n)
-{
- INTEGER _o_result;
- INTEGER b;
- if (n < 0) {
- n = -(n + 1);
- }
- b = 1;
- while ((b < 8 && __ASH(n, -(__ASHL(b, 3) - 1)) != 0)) {
- b += 1;
- }
- _o_result = b;
- return _o_result;
-}
-
-static LONGINT OPB_ShorterSize (LONGINT i)
-{
- LONGINT _o_result;
- if (i >= (int)OPM_LIntSize) {
- _o_result = OPM_IntSize;
- return _o_result;
- } else {
- _o_result = OPM_SIntSize;
- return _o_result;
- }
- __RETCHK;
-}
-
-static LONGINT OPB_LongerSize (LONGINT i)
-{
- LONGINT _o_result;
- if (i <= (int)OPM_SIntSize) {
- _o_result = OPM_IntSize;
- return _o_result;
- } else {
- _o_result = OPM_LIntSize;
- return _o_result;
- }
- __RETCHK;
-}
-
-static OPT_Struct OPB_IntType (LONGINT size)
-{
- OPT_Struct _o_result;
- OPT_Struct result = NIL;
- if (size <= OPT_sinttyp->size) {
- result = OPT_sinttyp;
- } else if (size <= OPT_inttyp->size) {
- result = OPT_inttyp;
- } else {
- result = OPT_linttyp;
- }
- if (size > OPT_linttyp->size) {
- OPB_err(203);
- }
- _o_result = result;
- return _o_result;
+ return x;
}
static void OPB_SetIntType (OPT_Node node)
{
- node->typ = OPB_IntType(OPB_SignedByteSize(node->conval->intval));
+ node->typ = OPT_IntType(OPT_IntSize(node->conval->intval));
}
-OPT_Node OPB_NewIntConst (LONGINT intval)
+static void OPB_SetSetType (OPT_Node node)
+{
+ INT32 i32;
+ __GET((ADDRESS)&node->conval->setval + 4, i32, INT32);
+ if (i32 == 0) {
+ node->typ = OPT_set32typ;
+ } else {
+ node->typ = OPT_set64typ;
+ }
+}
+
+OPT_Node OPB_NewIntConst (INT64 intval)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->conval = OPT_NewConst();
x->conval->intval = intval;
OPB_SetIntType(x);
- _o_result = x;
- return _o_result;
+ return x;
}
OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->conval = OPT_NewConst();
x->conval->realval = realval;
x->typ = typ;
x->conval->intval = -1;
- _o_result = x;
- return _o_result;
+ return x;
}
-OPT_Node OPB_NewString (OPS_String str, LONGINT len)
+OPT_Node OPB_NewString (OPS_String str, INT64 len)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->conval = OPT_NewConst();
x->typ = OPT_stringtyp;
x->conval->intval = -1;
- x->conval->intval2 = len;
+ x->conval->intval2 = OPM_Longint(len);
x->conval->ext = OPT_NewExt();
- __COPY(str, *x->conval->ext, ((LONGINT)(256)));
- _o_result = x;
- return _o_result;
+ __COPY(str, *x->conval->ext, 256);
+ return x;
}
static void OPB_CharToString (OPT_Node n)
@@ -345,7 +274,7 @@ static void OPB_CharToString (OPT_Node n)
n->obj = NIL;
}
-static void OPB_BindNodes (SHORTINT class, OPT_Struct typ, OPT_Node *x, OPT_Node y)
+static void OPB_BindNodes (INT8 class, OPT_Struct typ, OPT_Node *x, OPT_Node y)
{
OPT_Node node = NIL;
node = OPT_NewNode(class);
@@ -357,9 +286,7 @@ static void OPB_BindNodes (SHORTINT class, OPT_Struct typ, OPT_Node *x, OPT_Node
static BOOLEAN OPB_NotVar (OPT_Node x)
{
- BOOLEAN _o_result;
- _o_result = (x->class >= 7 && ((x->class != 11 || x->subcl != 29) || x->left->class >= 7));
- return _o_result;
+ return (x->class >= 7 && ((x->class != 11 || x->subcl != 29) || x->left->class >= 7));
}
void OPB_DeRef (OPT_Node *x)
@@ -369,7 +296,7 @@ void OPB_DeRef (OPT_Node *x)
typ = (*x)->typ;
if ((*x)->class >= 7) {
OPB_err(78);
- } else if (typ->form == 13) {
+ } else if (typ->form == 11) {
if (typ == OPT_sysptrtyp) {
OPB_err(57);
}
@@ -387,18 +314,18 @@ void OPB_DeRef (OPT_Node *x)
void OPB_Index (OPT_Node *x, OPT_Node y)
{
- INTEGER f;
+ INT16 f;
OPT_Struct typ = NIL;
f = y->typ->form;
if ((*x)->class >= 7) {
OPB_err(79);
- } else if (!__IN(f, 0x70) || __IN(y->class, 0x0300)) {
+ } else if (f != 4 || __IN(y->class, 0x0300, 32)) {
OPB_err(80);
y->typ = OPT_inttyp;
}
if ((*x)->typ->comp == 2) {
typ = (*x)->typ->BaseTyp;
- if ((y->class == 7 && (y->conval->intval < 0 || y->conval->intval >= (*x)->typ->n))) {
+ if ((y->class == 7 && (y->conval->intval < 0 || y->conval->intval >= (INT64)(*x)->typ->n))) {
OPB_err(81);
}
} else if ((*x)->typ->comp == 3) {
@@ -419,7 +346,7 @@ void OPB_Field (OPT_Node *x, OPT_Object y)
if ((*x)->class >= 7) {
OPB_err(77);
}
- if ((y != NIL && __IN(y->mode, 0x2010))) {
+ if ((y != NIL && __IN(y->mode, 0x2010, 32))) {
OPB_BindNodes(2, y->typ, &*x, NIL);
(*x)->obj = y;
(*x)->readonly = (*x)->left->readonly || (y->vis == 2 && y->mnolev < 0);
@@ -429,16 +356,16 @@ void OPB_Field (OPT_Node *x, OPT_Object y)
}
}
-static struct TypTest__61 {
+static struct TypTest__58 {
OPT_Node *x;
OPT_Object *obj;
BOOLEAN *guard;
- struct TypTest__61 *lnk;
-} *TypTest__61_s;
+ struct TypTest__58 *lnk;
+} *TypTest__58_s;
-static void GTT__62 (OPT_Struct t0, OPT_Struct t1);
+static void GTT__59 (OPT_Struct t0, OPT_Struct t1);
-static void GTT__62 (OPT_Struct t0, OPT_Struct t1)
+static void GTT__59 (OPT_Struct t0, OPT_Struct t1)
{
OPT_Node node = NIL;
OPT_Struct t = NIL;
@@ -451,54 +378,54 @@ static void GTT__62 (OPT_Struct t0, OPT_Struct t1)
t1 = t1->BaseTyp;
}
if (t1 == t0 || t0->form == 0) {
- if (*TypTest__61_s->guard) {
- OPB_BindNodes(5, NIL, &*TypTest__61_s->x, NIL);
- (*TypTest__61_s->x)->readonly = (*TypTest__61_s->x)->left->readonly;
+ if (*TypTest__58_s->guard) {
+ OPB_BindNodes(5, NIL, &*TypTest__58_s->x, NIL);
+ (*TypTest__58_s->x)->readonly = (*TypTest__58_s->x)->left->readonly;
} else {
node = OPT_NewNode(11);
node->subcl = 16;
- node->left = *TypTest__61_s->x;
- node->obj = *TypTest__61_s->obj;
- *TypTest__61_s->x = node;
+ node->left = *TypTest__58_s->x;
+ node->obj = *TypTest__58_s->obj;
+ *TypTest__58_s->x = node;
}
} else {
OPB_err(85);
}
} else if (t0 != t1) {
OPB_err(85);
- } else if (!*TypTest__61_s->guard) {
- if ((*TypTest__61_s->x)->class == 5) {
+ } else if (!*TypTest__58_s->guard) {
+ if ((*TypTest__58_s->x)->class == 5) {
node = OPT_NewNode(11);
node->subcl = 16;
- node->left = *TypTest__61_s->x;
- node->obj = *TypTest__61_s->obj;
- *TypTest__61_s->x = node;
+ node->left = *TypTest__58_s->x;
+ node->obj = *TypTest__58_s->obj;
+ *TypTest__58_s->x = node;
} else {
- *TypTest__61_s->x = OPB_NewBoolConst(1);
+ *TypTest__58_s->x = OPB_NewBoolConst(1);
}
}
}
void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
{
- struct TypTest__61 _s;
+ struct TypTest__58 _s;
_s.x = x;
_s.obj = &obj;
_s.guard = &guard;
- _s.lnk = TypTest__61_s;
- TypTest__61_s = &_s;
+ _s.lnk = TypTest__58_s;
+ TypTest__58_s = &_s;
if (OPB_NotVar(*x)) {
OPB_err(112);
- } else if ((*x)->typ->form == 13) {
+ } else if ((*x)->typ->form == 11) {
if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) {
OPB_err(85);
- } else if (obj->typ->form == 13) {
- GTT__62((*x)->typ->BaseTyp, obj->typ->BaseTyp);
+ } else if (obj->typ->form == 11) {
+ GTT__59((*x)->typ->BaseTyp, obj->typ->BaseTyp);
} else {
OPB_err(86);
}
} else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) {
- GTT__62((*x)->typ, obj->typ);
+ GTT__59((*x)->typ, obj->typ);
} else {
OPB_err(87);
}
@@ -507,23 +434,23 @@ void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
} else {
(*x)->typ = OPT_booltyp;
}
- TypTest__61_s = _s.lnk;
+ TypTest__58_s = _s.lnk;
}
void OPB_In (OPT_Node *x, OPT_Node y)
{
- INTEGER f;
- LONGINT k;
+ INT16 f;
+ INT64 k;
f = (*x)->typ->form;
if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) {
OPB_err(126);
- } else if ((__IN(f, 0x70) && y->typ->form == 9)) {
+ } else if ((f == 4 && y->typ->form == 7)) {
if ((*x)->class == 7) {
k = (*x)->conval->intval;
- if (k < 0 || k > (int)OPM_MaxSet) {
+ if (k < 0 || k >= (INT64)__ASHL(y->typ->size, 3)) {
OPB_err(202);
} else if (y->class == 7) {
- (*x)->conval->intval = OPB_BoolToInt(__IN(k, y->conval->setval));
+ (*x)->conval->intval = OPB_BoolToInt(__IN(k, y->conval->setval, 64));
(*x)->obj = NIL;
} else {
OPB_BindNodes(12, OPT_booltyp, &*x, y);
@@ -539,9 +466,8 @@ void OPB_In (OPT_Node *x, OPT_Node y)
(*x)->typ = OPT_booltyp;
}
-static LONGINT OPB_log (LONGINT x)
+static INT64 OPB_log (INT64 x)
{
- LONGINT _o_result;
OPB_exp = 0;
if (x > 0) {
while (!__ODD(x)) {
@@ -549,14 +475,13 @@ static LONGINT OPB_log (LONGINT x)
OPB_exp += 1;
}
}
- _o_result = x;
- return _o_result;
+ return x;
}
-static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x)
+static void OPB_CheckRealType (INT16 f, INT16 nr, OPT_Const x)
{
LONGREAL min, max, r;
- if (f == 7) {
+ if (f == 5) {
min = OPM_MinReal;
max = OPM_MaxReal;
} else {
@@ -567,38 +492,36 @@ static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x)
if (r > max || r < min) {
OPB_err(nr);
x->realval = (LONGREAL)1;
- } else if (f == 7) {
+ } else if (f == 5) {
x->realval = x->realval;
}
x->intval = -1;
}
-static struct MOp__30 {
- struct MOp__30 *lnk;
-} *MOp__30_s;
+static struct MOp__28 {
+ struct MOp__28 *lnk;
+} *MOp__28_s;
-static OPT_Node NewOp__31 (SHORTINT op, OPT_Struct typ, OPT_Node z);
+static OPT_Node NewOp__29 (INT8 op, OPT_Struct typ, OPT_Node z);
-static OPT_Node NewOp__31 (SHORTINT op, OPT_Struct typ, OPT_Node z)
+static OPT_Node NewOp__29 (INT8 op, OPT_Struct typ, OPT_Node z)
{
- OPT_Node _o_result;
OPT_Node node = NIL;
node = OPT_NewNode(11);
node->subcl = op;
node->typ = typ;
node->left = z;
- _o_result = node;
- return _o_result;
+ return node;
}
-void OPB_MOp (SHORTINT op, OPT_Node *x)
+void OPB_MOp (INT8 op, OPT_Node *x)
{
- INTEGER f;
+ INT16 f;
OPT_Struct typ = NIL;
OPT_Node z = NIL;
- struct MOp__30 _s;
- _s.lnk = MOp__30_s;
- MOp__30_s = &_s;
+ struct MOp__28 _s;
+ _s.lnk = MOp__28_s;
+ MOp__28_s = &_s;
z = *x;
if (z->class == 8 || z->class == 9) {
OPB_err(126);
@@ -612,45 +535,49 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval));
z->obj = NIL;
} else {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
}
} else {
OPB_err(98);
}
break;
case 6:
- if (!__IN(f, 0x01f0)) {
+ if (!__IN(f, 0x70, 32)) {
OPB_err(96);
}
break;
case 7:
- if (__IN(f, 0x03f0)) {
+ if (__IN(f, 0xf0, 32)) {
if (z->class == 7) {
- if (__IN(f, 0x70)) {
- if (z->conval->intval == (-2147483647-1)) {
+ if (f == 4) {
+ if (z->conval->intval == (-9223372036854775807-1)) {
OPB_err(203);
} else {
z->conval->intval = -z->conval->intval;
OPB_SetIntType(z);
}
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
z->conval->realval = -z->conval->realval;
} else {
- z->conval->setval = ~z->conval->setval;
+ if (z->typ->size == 8) {
+ z->conval->setval = ~z->conval->setval;
+ } else {
+ z->conval->setval = z->conval->setval ^ 0xffffffff;
+ }
}
z->obj = NIL;
} else {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
}
} else {
OPB_err(97);
}
break;
case 21:
- if (__IN(f, 0x01f0)) {
+ if (__IN(f, 0x70, 32)) {
if (z->class == 7) {
- if (__IN(f, 0x70)) {
- if (z->conval->intval == (-2147483647-1)) {
+ if (f == 4) {
+ if (z->conval->intval == (-9223372036854775807-1)) {
OPB_err(203);
} else {
z->conval->intval = __ABS(z->conval->intval);
@@ -661,7 +588,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
}
z->obj = NIL;
} else {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
}
} else {
OPB_err(111);
@@ -670,10 +597,10 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
case 22:
if (f == 3) {
if (z->class == 7) {
- z->conval->intval = (int)__CAP((CHAR)z->conval->intval);
+ z->conval->intval = (INT16)__CAP((CHAR)z->conval->intval);
z->obj = NIL;
} else {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
}
} else {
OPB_err(111);
@@ -681,12 +608,12 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
}
break;
case 23:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (z->class == 7) {
z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval));
z->obj = NIL;
} else {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
}
} else {
OPB_err(111);
@@ -696,19 +623,19 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
case 24:
if ((((z->class == 7 && f == 3)) && z->conval->intval >= 32)) {
OPB_CharToString(z);
- f = 10;
+ f = 8;
}
- if (z->class < 7 || f == 10) {
- z = NewOp__31(op, typ, z);
+ if (z->class < 7 || f == 8) {
+ z = NewOp__29(op, typ, z);
} else {
OPB_err(127);
}
- z->typ = OPT_linttyp;
+ z->typ = OPT_adrtyp;
break;
case 25:
- if ((__IN(f, 0x70) && z->class == 7)) {
+ if ((f == 4 && z->class == 7)) {
if ((0 <= z->conval->intval && z->conval->intval <= -1)) {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
} else {
OPB_err(219);
}
@@ -718,22 +645,22 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->typ = OPT_booltyp;
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.MOp, op = ", (LONGINT)33);
- OPM_LogWNum(op, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.MOp, op = ", 33);
+ OPM_LogWNum(op, 0);
OPM_LogWLn();
break;
}
}
*x = z;
- MOp__30_s = _s.lnk;
+ MOp__28_s = _s.lnk;
}
static void OPB_CheckPtr (OPT_Node x, OPT_Node y)
{
- INTEGER g;
+ INT16 g;
OPT_Struct p = NIL, q = NIL, t = NIL;
g = y->typ->form;
- if (g == 13) {
+ if (g == 11) {
p = x->typ->BaseTyp;
q = y->typ->BaseTyp;
if ((p->comp == 4 && q->comp == 4)) {
@@ -751,7 +678,7 @@ static void OPB_CheckPtr (OPT_Node x, OPT_Node y)
} else {
OPB_err(100);
}
- } else if (g != 11) {
+ } else if (g != 9) {
OPB_err(100);
}
}
@@ -768,7 +695,7 @@ void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames)
at = at->BaseTyp;
}
if (ft != at) {
- if ((ft->form == 14 && at->form == 14)) {
+ if ((ft->form == 12 && at->form == 12)) {
if (ft->BaseTyp == at->BaseTyp) {
OPB_CheckParameters(ft->link, at->link, 0);
} else {
@@ -794,7 +721,7 @@ void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames)
static void OPB_CheckProc (OPT_Struct x, OPT_Object y)
{
- if (__IN(y->mode, 0x04c0)) {
+ if (__IN(y->mode, 0x04c0, 32)) {
if (y->mode == 6) {
if (y->mnolev == 0) {
y->mode = 7;
@@ -814,22 +741,21 @@ static void OPB_CheckProc (OPT_Struct x, OPT_Object y)
static struct ConstOp__13 {
OPT_Node *x;
- INTEGER *f;
+ INT16 *f;
OPT_Const *xval, *yval;
struct ConstOp__13 *lnk;
} *ConstOp__13_s;
-static INTEGER ConstCmp__14 (void);
+static INT16 ConstCmp__14 (void);
-static INTEGER ConstCmp__14 (void)
+static INT16 ConstCmp__14 (void)
{
- INTEGER _o_result;
- INTEGER res;
+ INT16 res;
switch (*ConstOp__13_s->f) {
case 0:
res = 9;
break;
- case 1: case 3: case 4: case 5: case 6:
+ case 1: case 3: case 4:
if ((*ConstOp__13_s->xval)->intval < (*ConstOp__13_s->yval)->intval) {
res = 11;
} else if ((*ConstOp__13_s->xval)->intval > (*ConstOp__13_s->yval)->intval) {
@@ -838,7 +764,7 @@ static INTEGER ConstCmp__14 (void)
res = 9;
}
break;
- case 7: case 8:
+ case 5: case 6:
if ((*ConstOp__13_s->xval)->realval < (*ConstOp__13_s->yval)->realval) {
res = 11;
} else if ((*ConstOp__13_s->xval)->realval > (*ConstOp__13_s->yval)->realval) {
@@ -854,14 +780,14 @@ static INTEGER ConstCmp__14 (void)
res = 9;
}
break;
- case 9:
+ case 7:
if ((*ConstOp__13_s->xval)->setval != (*ConstOp__13_s->yval)->setval) {
res = 10;
} else {
res = 9;
}
break;
- case 10:
+ case 8:
if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) < 0) {
res = 11;
} else if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) > 0) {
@@ -870,7 +796,7 @@ static INTEGER ConstCmp__14 (void)
res = 9;
}
break;
- case 11: case 13: case 14:
+ case 9: case 11: case 12:
if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) {
res = 10;
} else {
@@ -878,21 +804,20 @@ static INTEGER ConstCmp__14 (void)
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstCmp, f = ", (LONGINT)37);
- OPM_LogWNum(*ConstOp__13_s->f, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstCmp, f = ", 37);
+ OPM_LogWNum(*ConstOp__13_s->f, 0);
OPM_LogWLn();
break;
}
(*ConstOp__13_s->x)->typ = OPT_booltyp;
- _o_result = res;
- return _o_result;
+ return res;
}
-static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
+static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
{
- INTEGER f, g;
+ INT16 f, g;
OPT_Const xval = NIL, yval = NIL;
- LONGINT xv, yv;
+ INT64 xv, yv;
BOOLEAN temp;
struct ConstOp__13 _s;
_s.x = &x;
@@ -908,7 +833,7 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
if (f != g) {
switch (f) {
case 3:
- if (g == 10) {
+ if (g == 8) {
OPB_CharToString(x);
} else {
OPB_err(100);
@@ -916,17 +841,17 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
- case 4: case 5: case 6:
- if (__IN(g, 0x70)) {
+ case 4:
+ if (g == 4) {
if (x->typ->size <= y->typ->size) {
x->typ = y->typ;
} else {
- x->typ = OPB_IntType(x->typ->size);
+ x->typ = OPT_IntType(x->typ->size);
}
- } else if (g == 7) {
+ } else if (g == 5) {
x->typ = OPT_realtyp;
xval->realval = xval->intval;
- } else if (g == 8) {
+ } else if (g == 6) {
x->typ = OPT_lrltyp;
xval->realval = xval->intval;
} else {
@@ -935,11 +860,11 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
- case 7:
- if (__IN(g, 0x70)) {
+ case 5:
+ if (g == 4) {
y->typ = x->typ;
yval->realval = yval->intval;
- } else if (g == 8) {
+ } else if (g == 6) {
x->typ = OPT_lrltyp;
} else {
OPB_err(100);
@@ -947,11 +872,11 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
- case 8:
- if (__IN(g, 0x70)) {
+ case 6:
+ if (g == 4) {
y->typ = x->typ;
yval->realval = yval->intval;
- } else if (g == 7) {
+ } else if (g == 5) {
y->typ = OPT_lrltyp;
} else {
OPB_err(100);
@@ -959,26 +884,26 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
- case 10:
+ case 8:
if (g == 3) {
OPB_CharToString(y);
- g = 10;
+ g = 8;
} else {
OPB_err(100);
y->typ = x->typ;
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
- case 11:
- if (!__IN(g, 0x6000)) {
+ case 9:
+ if (!__IN(g, 0x1800, 32)) {
OPB_err(100);
}
break;
- case 13:
+ case 11:
OPB_CheckPtr(x, y);
break;
- case 14:
- if (g != 11) {
+ case 12:
+ if (g != 9) {
OPB_err(100);
}
break;
@@ -992,16 +917,16 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
}
switch (op) {
case 1:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
xv = xval->intval;
yv = yval->intval;
- if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(2147483647, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-2147483647-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-2147483647-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-2147483647-1))) && yv != (-2147483647-1))) && -xv <= __DIV(2147483647, -yv))) {
+ if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807-1))) && yv != (-9223372036854775807-1))) && -xv <= __DIV(9223372036854775807, -yv))) {
xval->intval = xv * yv;
OPB_SetIntType(x);
} else {
OPB_err(204);
}
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
temp = __ABS(yval->realval) <= (LONGREAL)1;
if (temp || __ABS(xval->realval) <= 1.79769296342094e+308 / (LONGREAL)__ABS(yval->realval)) {
xval->realval = xval->realval * yval->realval;
@@ -1009,23 +934,24 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
} else {
OPB_err(204);
}
- } else if (f == 9) {
+ } else if (f == 7) {
xval->setval = (xval->setval & yval->setval);
+ OPB_SetSetType(x);
} else if (f != 0) {
OPB_err(101);
}
break;
case 2:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (yval->intval != 0) {
xval->realval = xval->intval / (REAL)yval->intval;
- OPB_CheckRealType(7, 205, xval);
+ OPB_CheckRealType(5, 205, xval);
} else {
OPB_err(205);
xval->realval = (LONGREAL)1;
}
x->typ = OPT_realtyp;
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
temp = __ABS(yval->realval) >= (LONGREAL)1;
if (temp || __ABS(xval->realval) <= 1.79769296342094e+308 * __ABS(yval->realval)) {
xval->realval = xval->realval / yval->realval;
@@ -1033,14 +959,15 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
} else {
OPB_err(205);
}
- } else if (f == 9) {
+ } else if (f == 7) {
xval->setval = xval->setval ^ yval->setval;
+ OPB_SetSetType(x);
} else if (f != 0) {
OPB_err(102);
}
break;
case 3:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (yval->intval != 0) {
xval->intval = __DIV(xval->intval, yval->intval);
OPB_SetIntType(x);
@@ -1052,7 +979,7 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
}
break;
case 4:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (yval->intval != 0) {
xval->intval = __MOD(xval->intval, yval->intval);
OPB_SetIntType(x);
@@ -1071,15 +998,15 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
}
break;
case 6:
- if (__IN(f, 0x70)) {
- temp = (yval->intval >= 0 && xval->intval <= 2147483647 - yval->intval);
- if (temp || (yval->intval < 0 && xval->intval >= (-2147483647-1) - yval->intval)) {
+ if (f == 4) {
+ temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807 - yval->intval);
+ if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807-1) - yval->intval)) {
xval->intval += yval->intval;
OPB_SetIntType(x);
} else {
OPB_err(206);
}
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
temp = (yval->realval >= (LONGREAL)0 && xval->realval <= 1.79769296342094e+308 - yval->realval);
if (temp || (yval->realval < (LONGREAL)0 && xval->realval >= -1.79769296342094e+308 - yval->realval)) {
xval->realval = xval->realval + yval->realval;
@@ -1087,21 +1014,22 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
} else {
OPB_err(206);
}
- } else if (f == 9) {
+ } else if (f == 7) {
xval->setval = xval->setval | yval->setval;
+ OPB_SetSetType(x);
} else if (f != 0) {
OPB_err(105);
}
break;
case 7:
- if (__IN(f, 0x70)) {
- if ((yval->intval >= 0 && xval->intval >= (-2147483647-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 2147483647 + yval->intval)) {
+ if (f == 4) {
+ if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807 + yval->intval)) {
xval->intval -= yval->intval;
OPB_SetIntType(x);
} else {
OPB_err(207);
}
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
temp = (yval->realval >= (LONGREAL)0 && xval->realval >= -1.79769296342094e+308 + yval->realval);
if (temp || (yval->realval < (LONGREAL)0 && xval->realval <= 1.79769296342094e+308 + yval->realval)) {
xval->realval = xval->realval - yval->realval;
@@ -1109,8 +1037,9 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
} else {
OPB_err(207);
}
- } else if (f == 9) {
+ } else if (f == 7) {
xval->setval = (xval->setval & ~yval->setval);
+ OPB_SetSetType(x);
} else if (f != 0) {
OPB_err(106);
}
@@ -1129,36 +1058,36 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
xval->intval = OPB_BoolToInt(ConstCmp__14() != 9);
break;
case 11:
- if (__IN(f, 0x2a04)) {
+ if (__IN(f, 0x0a84, 32)) {
OPB_err(108);
} else {
xval->intval = OPB_BoolToInt(ConstCmp__14() == 11);
}
break;
case 12:
- if (__IN(f, 0x2a04)) {
+ if (__IN(f, 0x0a84, 32)) {
OPB_err(108);
} else {
xval->intval = OPB_BoolToInt(ConstCmp__14() != 13);
}
break;
case 13:
- if (__IN(f, 0x2a04)) {
+ if (__IN(f, 0x0a84, 32)) {
OPB_err(108);
} else {
xval->intval = OPB_BoolToInt(ConstCmp__14() == 13);
}
break;
case 14:
- if (__IN(f, 0x2a04)) {
+ if (__IN(f, 0x0a84, 32)) {
OPB_err(108);
} else {
xval->intval = OPB_BoolToInt(ConstCmp__14() != 11);
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstOp, op = ", (LONGINT)37);
- OPM_LogWNum(op, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstOp, op = ", 37);
+ OPM_LogWNum(op, 0);
OPM_LogWLn();
break;
}
@@ -1168,22 +1097,28 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
{
OPT_Node node = NIL;
- INTEGER f, g;
- LONGINT k;
+ INT16 f, g;
+ INT64 k;
LONGREAL r;
f = (*x)->typ->form;
g = typ->form;
if ((*x)->class == 7) {
- if (__IN(f, 0x70)) {
- if (__IN(g, 0x70)) {
- if (f > g) {
+ if ((((f == 7 && g == 7)) && (*x)->typ->size > typ->size)) {
+ OPB_SetSetType(*x);
+ if ((*x)->typ->size > typ->size) {
+ OPB_err(203);
+ (*x)->conval->setval = 0x0;
+ }
+ } else if (f == 4) {
+ if (g == 4) {
+ if ((*x)->typ->size > typ->size) {
OPB_SetIntType(*x);
- if ((int)(*x)->typ->form > g) {
+ if ((*x)->typ->size > typ->size) {
OPB_err(203);
(*x)->conval->intval = 1;
}
}
- } else if (__IN(g, 0x0180)) {
+ } else if (__IN(g, 0x60, 32)) {
(*x)->conval->realval = (*x)->conval->intval;
(*x)->conval->intval = -1;
} else {
@@ -1192,21 +1127,21 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
OPB_err(220);
}
}
- } else if (__IN(f, 0x0180)) {
- if (__IN(g, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
+ if (__IN(g, 0x60, 32)) {
OPB_CheckRealType(g, 203, (*x)->conval);
} else {
r = (*x)->conval->realval;
- if (r < -2.14748364800000e+009 || r > 2.14748364700000e+009) {
+ if (r < -9.22337203685478e+018 || r > 9.22337203685478e+018) {
OPB_err(203);
r = (LONGREAL)1;
}
- (*x)->conval->intval = (int)__ENTIER(r);
+ (*x)->conval->intval = (INT32)__ENTIER(r);
OPB_SetIntType(*x);
}
}
(*x)->obj = NIL;
- } else if (((((*x)->class == 11 && (*x)->subcl == 20)) && ((int)(*x)->left->typ->form < f || f > g))) {
+ } else if (((((*x)->class == 11 && (*x)->subcl == 20)) && ((INT16)(*x)->left->typ->form < f || f > g))) {
if ((*x)->left->typ == typ) {
*x = (*x)->left;
}
@@ -1219,15 +1154,15 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
(*x)->typ = typ;
}
-static struct Op__40 {
- INTEGER *f, *g;
- struct Op__40 *lnk;
-} *Op__40_s;
+static struct Op__38 {
+ INT16 *f, *g;
+ struct Op__38 *lnk;
+} *Op__38_s;
-static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y);
-static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y);
+static void NewOp__39 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y);
+static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y);
-static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
+static void NewOp__39 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
{
OPT_Node node = NIL;
node = OPT_NewNode(12);
@@ -1238,50 +1173,48 @@ static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
*x = node;
}
-static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y)
+static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y)
{
- BOOLEAN _o_result;
BOOLEAN ok, xCharArr, yCharArr;
- xCharArr = (__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp->form == 3) || *Op__40_s->f == 10;
- yCharArr = (__IN((*y)->typ->comp, 0x0c) && (*y)->typ->BaseTyp->form == 3) || *Op__40_s->g == 10;
- if ((((xCharArr && *Op__40_s->g == 3)) && (*y)->class == 7)) {
+ xCharArr = (__IN((*x)->typ->comp, 0x0c, 32) && (*x)->typ->BaseTyp->form == 3) || *Op__38_s->f == 8;
+ yCharArr = (__IN((*y)->typ->comp, 0x0c, 32) && (*y)->typ->BaseTyp->form == 3) || *Op__38_s->g == 8;
+ if ((((xCharArr && *Op__38_s->g == 3)) && (*y)->class == 7)) {
OPB_CharToString(*y);
- *Op__40_s->g = 10;
+ *Op__38_s->g = 8;
yCharArr = 1;
}
- if ((((yCharArr && *Op__40_s->f == 3)) && (*x)->class == 7)) {
+ if ((((yCharArr && *Op__38_s->f == 3)) && (*x)->class == 7)) {
OPB_CharToString(*x);
- *Op__40_s->f = 10;
+ *Op__38_s->f = 8;
xCharArr = 1;
}
ok = (xCharArr && yCharArr);
if (ok) {
- if ((*Op__40_s->f == 10 && (*x)->conval->intval2 == 1)) {
+ if ((*Op__38_s->f == 8 && (*x)->conval->intval2 == 1)) {
(*x)->typ = OPT_chartyp;
(*x)->conval->intval = 0;
- OPB_Index(&*y, OPB_NewIntConst(((LONGINT)(0))));
- } else if ((*Op__40_s->g == 10 && (*y)->conval->intval2 == 1)) {
+ OPB_Index(&*y, OPB_NewIntConst(0));
+ } else if ((*Op__38_s->g == 8 && (*y)->conval->intval2 == 1)) {
(*y)->typ = OPT_chartyp;
(*y)->conval->intval = 0;
- OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0))));
+ OPB_Index(&*x, OPB_NewIntConst(0));
}
}
- _o_result = ok;
- return _o_result;
+ return ok;
}
-void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
+void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
{
- INTEGER f, g;
+ INT16 f, g;
OPT_Node t = NIL, z = NIL;
OPT_Struct typ = NIL;
BOOLEAN do_;
- LONGINT val;
- struct Op__40 _s;
+ INT64 val;
+ struct Op__38 _s;
_s.f = &f;
_s.g = &g;
- _s.lnk = Op__40_s;
- Op__40_s = &_s;
+ _s.lnk = Op__38_s;
+ Op__38_s = &_s;
z = *x;
if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) {
OPB_err(126);
@@ -1299,49 +1232,58 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(100);
}
break;
- case 4: case 5: case 6:
- if ((__IN(g, 0x70) && y->typ->size < z->typ->size)) {
+ case 4:
+ if ((g == 4 && y->typ->size < z->typ->size)) {
OPB_Convert(&y, z->typ);
- } else if (__IN(g, 0x01f0)) {
+ } else if (__IN(g, 0x70, 32)) {
OPB_Convert(&z, y->typ);
} else {
OPB_err(100);
}
break;
case 7:
- if (__IN(g, 0x70)) {
+ if ((g == 7 && y->typ->size < z->typ->size)) {
OPB_Convert(&y, z->typ);
- } else if (__IN(g, 0x0180)) {
+ } else if (g == 7) {
OPB_Convert(&z, y->typ);
} else {
OPB_err(100);
}
break;
- case 8:
- if (__IN(g, 0x01f0)) {
+ case 5:
+ if (g == 4) {
OPB_Convert(&y, z->typ);
- } else if (__IN(g, 0x0180)) {
+ } else if (__IN(g, 0x60, 32)) {
+ OPB_Convert(&z, y->typ);
+ } else {
+ OPB_err(100);
+ }
+ break;
+ case 6:
+ if (__IN(g, 0x70, 32)) {
+ OPB_Convert(&y, z->typ);
+ } else if (__IN(g, 0x60, 32)) {
OPB_Convert(&y, z->typ);
} else {
OPB_err(100);
}
break;
- case 11:
- if (!__IN(g, 0x6000)) {
+ case 9:
+ if (!__IN(g, 0x1800, 32)) {
OPB_err(100);
}
break;
- case 13:
+ case 11:
OPB_CheckPtr(z, y);
break;
- case 14:
- if (g != 11) {
+ case 12:
+ if (g != 9) {
OPB_err(100);
}
break;
- case 10:
+ case 8:
break;
- case 15:
+ case 13:
if (z->typ->comp == 4) {
OPB_err(100);
}
@@ -1357,7 +1299,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
switch (op) {
case 1:
do_ = 1;
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (z->class == 7) {
val = z->conval->intval;
if (val == 1) {
@@ -1388,35 +1330,35 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
y->obj = NIL;
}
}
- } else if (!__IN(f, 0x0381)) {
+ } else if (!__IN(f, 0xe1, 32)) {
OPB_err(105);
typ = OPT_undftyp;
}
if (do_) {
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
}
break;
case 2:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if ((y->class == 7 && y->conval->intval == 0)) {
OPB_err(205);
}
OPB_Convert(&z, OPT_realtyp);
OPB_Convert(&y, OPT_realtyp);
typ = OPT_realtyp;
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
if ((y->class == 7 && y->conval->realval == (LONGREAL)0)) {
OPB_err(205);
}
- } else if ((f != 9 && f != 0)) {
+ } else if ((f != 7 && f != 0)) {
OPB_err(102);
typ = OPT_undftyp;
}
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
break;
case 3:
do_ = 1;
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (y->class == 7) {
val = y->conval->intval;
if (val == 0) {
@@ -1435,11 +1377,11 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp;
}
if (do_) {
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
}
break;
case 4:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (y->class == 7) {
if (y->conval->intval == 0) {
OPB_err(205);
@@ -1453,7 +1395,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(104);
typ = OPT_undftyp;
}
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
break;
case 5:
if (f == 2) {
@@ -1463,7 +1405,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
} else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) {
} else {
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
}
} else if (f != 0) {
OPB_err(94);
@@ -1471,12 +1413,12 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
break;
case 6:
- if (!__IN(f, 0x03f1)) {
+ if (!__IN(f, 0xf1, 32)) {
OPB_err(105);
typ = OPT_undftyp;
}
do_ = 1;
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if ((z->class == 7 && z->conval->intval == 0)) {
do_ = 0;
z = y;
@@ -1486,16 +1428,16 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
}
if (do_) {
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
}
break;
case 7:
- if (!__IN(f, 0x03f1)) {
+ if (!__IN(f, 0xf1, 32)) {
OPB_err(106);
typ = OPT_undftyp;
}
- if ((!__IN(f, 0x70) || y->class != 7) || y->conval->intval != 0) {
- NewOp__41(op, typ, &z, y);
+ if ((f != 4 || y->class != 7) || y->conval->intval != 0) {
+ NewOp__39(op, typ, &z, y);
}
break;
case 8:
@@ -1506,7 +1448,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
} else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) {
} else {
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
}
} else if (f != 0) {
OPB_err(95);
@@ -1514,61 +1456,62 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
break;
case 9: case 10:
- if (__IN(f, 0x6bff) || strings__43(&z, &y)) {
+ if (__IN(f, 0x1aff, 32) || strings__41(&z, &y)) {
typ = OPT_booltyp;
} else {
OPB_err(107);
typ = OPT_undftyp;
}
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
break;
case 11: case 12: case 13: case 14:
- if (__IN(f, 0x01f9) || strings__43(&z, &y)) {
+ if (__IN(f, 0x79, 32) || strings__41(&z, &y)) {
typ = OPT_booltyp;
} else {
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"ELSE in Op()", (LONGINT)13);
+ OPM_LogWStr((CHAR*)"ELSE in Op()", 13);
OPM_LogWLn();
OPB_err(108);
typ = OPT_undftyp;
}
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", (LONGINT)32);
- OPM_LogWNum(op, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", 32);
+ OPM_LogWNum(op, 0);
OPM_LogWLn();
break;
}
}
*x = z;
- Op__40_s = _s.lnk;
+ Op__38_s = _s.lnk;
}
void OPB_SetRange (OPT_Node *x, OPT_Node y)
{
- LONGINT k, l;
+ INT64 k, l;
if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) {
OPB_err(126);
- } else if ((__IN((*x)->typ->form, 0x70) && __IN(y->typ->form, 0x70))) {
+ } else if (((*x)->typ->form == 4 && y->typ->form == 4)) {
if ((*x)->class == 7) {
k = (*x)->conval->intval;
- if (0 > k || k > (int)OPM_MaxSet) {
+ if (0 > k || k > 63) {
OPB_err(202);
}
}
if (y->class == 7) {
l = y->conval->intval;
- if (0 > l || l > (int)OPM_MaxSet) {
+ if (0 > l || l > 63) {
OPB_err(202);
}
}
if (((*x)->class == 7 && y->class == 7)) {
if (k <= l) {
- (*x)->conval->setval = __SETRNG(k, l);
+ (*x)->conval->setval = __SETRNG(k, l, 32);
+ OPB_SetSetType(*x);
} else {
OPB_err(201);
- (*x)->conval->setval = __SETRNG(l, k);
+ (*x)->conval->setval = __SETRNG(l, k, 32);
}
(*x)->obj = NIL;
} else {
@@ -1582,86 +1525,69 @@ void OPB_SetRange (OPT_Node *x, OPT_Node y)
void OPB_SetElem (OPT_Node *x)
{
- LONGINT k;
+ INT64 k;
if ((*x)->class == 8 || (*x)->class == 9) {
OPB_err(126);
- } else if (!__IN((*x)->typ->form, 0x70)) {
+ } else if ((*x)->typ->form != 4) {
OPB_err(93);
} else if ((*x)->class == 7) {
k = (*x)->conval->intval;
- if ((0 <= k && k <= (int)OPM_MaxSet)) {
- (*x)->conval->setval = __SETOF(k);
+ if ((0 <= k && k <= 63)) {
+ (*x)->conval->setval = 0x0;
+ (*x)->conval->setval |= __SETOF(k,64);
} else {
OPB_err(202);
}
+ OPB_SetSetType(*x);
(*x)->obj = NIL;
} else {
OPB_Convert(&*x, OPT_settyp);
+ (*x)->typ = OPT_settyp;
}
- (*x)->typ = OPT_settyp;
}
static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
{
OPT_Struct y = NIL;
- INTEGER f, g;
+ INT16 f, g;
OPT_Struct p = NIL, q = NIL;
- if (OPM_Verbose) {
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"PROCEDURE CheckAssign", (LONGINT)22);
- OPM_LogWLn();
- }
y = ynode->typ;
f = x->form;
g = y->form;
- if (OPM_Verbose) {
- OPM_LogWStr((CHAR*)"y.form = ", (LONGINT)10);
- OPM_LogWNum(y->form, ((LONGINT)(0)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"f = ", (LONGINT)5);
- OPM_LogWNum(f, ((LONGINT)(0)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"g = ", (LONGINT)5);
- OPM_LogWNum(g, ((LONGINT)(0)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"ynode.typ.syze = ", (LONGINT)18);
- OPM_LogWNum(ynode->typ->size, ((LONGINT)(0)));
- OPM_LogWLn();
- }
- if (ynode->class == 8 || (ynode->class == 9 && f != 14)) {
+ if (ynode->class == 8 || (ynode->class == 9 && f != 12)) {
OPB_err(126);
}
switch (f) {
- case 0: case 10:
+ case 0: case 8:
break;
case 1:
- if (!((__IN(g, 0x7a) && y->size == 1))) {
+ if (!((__IN(g, 0x1a, 32) && y->size == 1))) {
OPB_err(113);
}
break;
- case 2: case 3: case 9:
+ case 2: case 3:
if (g != f) {
OPB_err(113);
}
break;
- case 4: case 5: case 6:
- if (!__IN(g, 0x70) || x->size < y->size) {
+ case 4: case 7:
+ if (g != f || x->size < y->size) {
OPB_err(113);
}
break;
- case 7:
- if (!__IN(g, 0xf0)) {
+ case 5:
+ if (!__IN(g, 0x30, 32)) {
OPB_err(113);
}
break;
- case 8:
- if (!__IN(g, 0x01f0)) {
+ case 6:
+ if (!__IN(g, 0x70, 32)) {
OPB_err(113);
}
break;
- case 13:
- if ((x == y || g == 11) || (x == OPT_sysptrtyp && g == 13)) {
- } else if (g == 13) {
+ case 11:
+ if ((x == y || g == 9) || (x == OPT_sysptrtyp && g == 11)) {
+ } else if (g == 11) {
p = x->BaseTyp;
q = y->BaseTyp;
if ((p->comp == 4 && q->comp == 4)) {
@@ -1678,32 +1604,32 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
OPB_err(113);
}
break;
- case 14:
+ case 12:
if (ynode->class == 9) {
OPB_CheckProc(x, ynode->obj);
- } else if (x == y || g == 11) {
+ } else if (x == y || g == 9) {
} else {
OPB_err(113);
}
break;
- case 12: case 11:
+ case 10: case 9:
OPB_err(113);
break;
- case 15:
+ case 13:
x->pvused = 1;
if (x->comp == 2) {
if ((ynode->class == 7 && g == 3)) {
OPB_CharToString(ynode);
y = ynode->typ;
- g = 10;
+ g = 8;
}
if (x == y) {
} else if (x->BaseTyp == OPT_chartyp) {
- if (g == 10) {
+ if (g == 8) {
if (ynode->conval->intval2 > x->n) {
OPB_err(114);
}
- } else if ((__IN(y->comp, 0x0c) && y->BaseTyp == OPT_chartyp)) {
+ } else if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
} else {
OPB_err(113);
}
@@ -1711,7 +1637,7 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
OPB_err(113);
}
} else if ((x->comp == 3 && x->BaseTyp == OPT_chartyp)) {
- if ((__IN(y->comp, 0x0c) && y->BaseTyp == OPT_chartyp)) {
+ if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
} else {
OPB_err(113);
}
@@ -1733,12 +1659,12 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.CheckAssign, f = ", (LONGINT)40);
- OPM_LogWNum(f, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.CheckAssign, f = ", 40);
+ OPM_LogWNum(f, 0);
OPM_LogWLn();
break;
}
- if ((((((ynode->class == 7 && g < f)) && __IN(g, 0xf0))) && __IN(f, 0x01e0))) {
+ if ((((((ynode->class == 7 && g < f)) && __IN(g, 0x30, 32))) && __IN(f, 0x70, 32))) {
OPB_Convert(&ynode, x);
}
}
@@ -1747,16 +1673,16 @@ static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo)
{
}
-void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
+void OPB_StPar0 (OPT_Node *par0, INT16 fctno)
{
- INTEGER f;
+ INT16 f;
OPT_Struct typ = NIL;
OPT_Node x = NIL;
x = *par0;
f = x->typ->form;
switch (fctno) {
case 0:
- if ((__IN(f, 0x70) && x->class == 7)) {
+ if ((f == 4 && x->class == 7)) {
if ((0 <= x->conval->intval && x->conval->intval <= 255)) {
OPB_BindNodes(28, OPT_notyp, &x, x);
} else {
@@ -1771,12 +1697,12 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
typ = OPT_notyp;
if (OPB_NotVar(x)) {
OPB_err(112);
- } else if (f == 13) {
+ } else if (f == 11) {
if (x->readonly) {
OPB_err(76);
}
f = x->typ->BaseTyp->comp;
- if (__IN(f, 0x1c)) {
+ if (__IN(f, 0x1c, 32)) {
if (f == 3) {
typ = x->typ->BaseTyp;
}
@@ -1809,7 +1735,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 5:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
OPB_Convert(&x, OPT_linttyp);
} else {
OPB_err(111);
@@ -1826,20 +1752,20 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
x = OPB_NewBoolConst(0);
break;
case 3:
- x = OPB_NewIntConst(((LONGINT)(0)));
+ x = OPB_NewIntConst(0);
x->typ = OPT_chartyp;
break;
- case 4: case 5: case 6:
+ case 4:
x = OPB_NewIntConst(OPM_SignedMinimum(x->typ->size));
break;
- case 9:
- x = OPB_NewIntConst(((LONGINT)(0)));
+ case 7:
+ x = OPB_NewIntConst(0);
x->typ = OPT_inttyp;
break;
- case 7:
+ case 5:
x = OPB_NewRealConst(OPM_MinReal, OPT_realtyp);
break;
- case 8:
+ case 6:
x = OPB_NewRealConst(OPM_MinLReal, OPT_lrltyp);
break;
default:
@@ -1857,20 +1783,20 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
x = OPB_NewBoolConst(1);
break;
case 3:
- x = OPB_NewIntConst(((LONGINT)(255)));
+ x = OPB_NewIntConst(255);
x->typ = OPT_chartyp;
break;
- case 4: case 5: case 6:
+ case 4:
x = OPB_NewIntConst(OPM_SignedMaximum(x->typ->size));
break;
- case 9:
- x = OPB_NewIntConst(OPM_MaxSet);
+ case 7:
+ x = OPB_NewIntConst(__ASHL(x->typ->size, 3) - 1);
x->typ = OPT_inttyp;
break;
- case 7:
+ case 5:
x = OPB_NewRealConst(OPM_MaxReal, OPT_realtyp);
break;
- case 8:
+ case 6:
x = OPB_NewRealConst(OPM_MaxLReal, OPT_lrltyp);
break;
default:
@@ -1884,7 +1810,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 9:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x71)) {
+ } else if (__IN(f, 0x11, 32)) {
OPB_Convert(&x, OPT_chartyp);
} else {
OPB_err(111);
@@ -1894,9 +1820,14 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 10:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if ((__IN(f, 0x70) && x->typ->size > (int)OPM_SIntSize)) {
- OPB_Convert(&x, OPB_IntType(OPB_ShorterSize(x->typ->size)));
- } else if (f == 8) {
+ } else if (f == 4) {
+ typ = OPT_ShorterOrLongerType(x->typ, -1);
+ if (typ == NIL) {
+ OPB_err(111);
+ } else {
+ OPB_Convert(&x, typ);
+ }
+ } else if (f == 6) {
OPB_Convert(&x, OPT_realtyp);
} else {
OPB_err(111);
@@ -1905,9 +1836,14 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 11:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if ((__IN(f, 0x70) && x->typ->size < (int)OPM_LIntSize)) {
- OPB_Convert(&x, OPB_IntType(OPB_LongerSize(x->typ->size)));
- } else if (f == 7) {
+ } else if (f == 4) {
+ typ = OPT_ShorterOrLongerType(x->typ, 1);
+ if (typ == NIL) {
+ OPB_err(111);
+ } else {
+ OPB_Convert(&x, typ);
+ }
+ } else if (f == 5) {
OPB_Convert(&x, OPT_lrltyp);
} else if (f == 3) {
OPB_Convert(&x, OPT_linttyp);
@@ -1918,7 +1854,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 13: case 14:
if (OPB_NotVar(x)) {
OPB_err(112);
- } else if (!__IN(f, 0x70)) {
+ } else if (f != 4) {
OPB_err(111);
} else if (x->readonly) {
OPB_err(76);
@@ -1927,7 +1863,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 15: case 16:
if (OPB_NotVar(x)) {
OPB_err(112);
- } else if (x->typ != OPT_settyp) {
+ } else if (x->typ->form != 7) {
OPB_err(111);
x->typ = OPT_settyp;
} else if (x->readonly) {
@@ -1935,26 +1871,26 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
}
break;
case 17:
- if (!__IN(x->typ->comp, 0x0c)) {
+ if (!__IN(x->typ->comp, 0x0c, 32)) {
OPB_err(131);
}
break;
case 18:
if ((x->class == 7 && f == 3)) {
OPB_CharToString(x);
- f = 10;
+ f = 8;
}
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (((!__IN(x->typ->comp, 0x0c) || x->typ->BaseTyp->form != 3) && f != 10)) {
+ } else if (((!__IN(x->typ->comp, 0x0c, 32) || x->typ->BaseTyp->form != 3) && f != 8)) {
OPB_err(111);
}
break;
case 19:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
- if (x->typ->size != (int)OPM_LIntSize) {
+ } else if (f == 4) {
+ if (x->typ->size < OPT_linttyp->size) {
OPB_Convert(&x, OPT_linttyp);
}
} else {
@@ -1969,14 +1905,14 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 12:
if (x->class != 8) {
OPB_err(110);
- x = OPB_NewIntConst(((LONGINT)(1)));
- } else if (__IN(f, 0x63fe) || __IN(x->typ->comp, 0x14)) {
- (*OPB_typSize)(x->typ);
+ x = OPB_NewIntConst(1);
+ } else if (__IN(f, 0x18fe, 32) || __IN(x->typ->comp, 0x14, 32)) {
+ OPT_TypSize(x->typ);
x->typ->pvused = 1;
x = OPB_NewIntConst(x->typ->size);
} else {
OPB_err(111);
- x = OPB_NewIntConst(((LONGINT)(1)));
+ x = OPB_NewIntConst(1);
}
break;
case 21:
@@ -1985,22 +1921,22 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 22: case 23:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (!__IN(f, 0x027a)) {
+ } else if (!__IN(f, 0x9a, 32)) {
OPB_err(111);
}
break;
case 24: case 25: case 28: case 31:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if ((((x->class == 7 && __IN(f, 0x70))) && x->typ->size < OPT_linttyp->size)) {
- OPB_Convert(&x, OPT_linttyp);
- } else if (!((__IN(x->typ->form, 0x2070) && x->typ->size == (int)OPM_PointerSize))) {
+ } else if ((((x->class == 7 && f == 4)) && x->typ->size < OPT_adrtyp->size)) {
+ OPB_Convert(&x, OPT_adrtyp);
+ } else if (!((__IN(x->typ->form, 0x0810, 32) && x->typ->size == OPM_AddressSize))) {
OPB_err(111);
- x->typ = OPT_linttyp;
+ x->typ = OPT_adrtyp;
}
break;
case 26: case 27:
- if ((__IN(f, 0x70) && x->class == 7)) {
+ if ((f == 4 && x->class == 7)) {
if (x->conval->intval < 0 || x->conval->intval > -1) {
OPB_err(220);
}
@@ -2011,14 +1947,14 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 29:
if (x->class != 8) {
OPB_err(110);
- } else if (__IN(f, 0x1401) || x->typ->comp == 3) {
+ } else if (__IN(f, 0x0501, 32) || x->typ->comp == 3) {
OPB_err(111);
}
break;
case 30:
if (OPB_NotVar(x)) {
OPB_err(112);
- } else if (f == 13) {
+ } else if (f == 11) {
} else {
OPB_err(111);
}
@@ -2035,40 +1971,38 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.StPar0, fctno = ", (LONGINT)39);
- OPM_LogWNum(fctno, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.StPar0, fctno = ", 39);
+ OPM_LogWNum(fctno, 0);
OPM_LogWLn();
break;
}
*par0 = x;
}
-static struct StPar1__56 {
- struct StPar1__56 *lnk;
-} *StPar1__56_s;
+static struct StPar1__53 {
+ struct StPar1__53 *lnk;
+} *StPar1__53_s;
-static OPT_Node NewOp__57 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right);
+static OPT_Node NewOp__54 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right);
-static OPT_Node NewOp__57 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right)
+static OPT_Node NewOp__54 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right)
{
- OPT_Node _o_result;
OPT_Node node = NIL;
node = OPT_NewNode(class);
node->subcl = subcl;
node->left = left;
node->right = right;
- _o_result = node;
- return _o_result;
+ return node;
}
-void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
+void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
{
- INTEGER f, L;
+ INT16 f, L;
OPT_Struct typ = NIL;
OPT_Node p = NIL, t = NIL;
- struct StPar1__56 _s;
- _s.lnk = StPar1__56_s;
- StPar1__56_s = &_s;
+ struct StPar1__53 _s;
+ _s.lnk = StPar1__53_s;
+ StPar1__53_s = &_s;
p = *par0;
f = x->typ->form;
switch (fctno) {
@@ -2078,40 +2012,40 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
p->typ = OPT_notyp;
} else {
if (x->typ != p->typ) {
- if ((x->class == 7 && __IN(f, 0x70))) {
+ if ((f == 4 && (x->class == 7 || (p->typ->form == 4 && x->typ->size <= p->typ->size)))) {
OPB_Convert(&x, p->typ);
} else {
OPB_err(111);
}
}
- p = NewOp__57(19, fctno, p, x);
+ p = NewOp__54(19, fctno, p, x);
p->typ = OPT_notyp;
}
break;
case 15: case 16:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
- if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval > (int)OPM_MaxSet))) {
+ } else if (f == 4) {
+ if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval >= (INT64)__ASHL(p->typ->size, 3)))) {
OPB_err(202);
}
- p = NewOp__57(19, fctno, p, x);
+ p = NewOp__54(19, fctno, p, x);
} else {
OPB_err(111);
}
p->typ = OPT_notyp;
break;
case 17:
- if (!__IN(f, 0x70) || x->class != 7) {
+ if (!(f == 4) || x->class != 7) {
OPB_err(69);
} else if (x->typ->size == 1) {
- L = (int)x->conval->intval;
+ L = OPM_Integer(x->conval->intval);
typ = p->typ;
- while ((L > 0 && __IN(typ->comp, 0x0c))) {
+ while ((L > 0 && __IN(typ->comp, 0x0c, 32))) {
typ = typ->BaseTyp;
L -= 1;
}
- if (L != 0 || !__IN(typ->comp, 0x0c)) {
+ if (L != 0 || !__IN(typ->comp, 0x0c, 32)) {
OPB_err(132);
} else {
x->obj = NIL;
@@ -2120,7 +2054,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
p = p->left;
x->conval->intval += 1;
}
- p = NewOp__57(12, 19, p, x);
+ p = NewOp__54(12, 19, p, x);
p->typ = OPT_linttyp;
} else {
p = x;
@@ -2135,14 +2069,14 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 18:
if (OPB_NotVar(x)) {
OPB_err(112);
- } else if ((__IN(x->typ->comp, 0x0c) && x->typ->BaseTyp->form == 3)) {
+ } else if ((__IN(x->typ->comp, 0x0c, 32) && x->typ->BaseTyp->form == 3)) {
if (x->readonly) {
OPB_err(76);
}
t = x;
x = p;
p = t;
- p = NewOp__57(19, 18, p, x);
+ p = NewOp__54(19, 18, p, x);
} else {
OPB_err(111);
}
@@ -2151,14 +2085,14 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 19:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
+ } else if (f == 4) {
if ((p->class == 7 && x->class == 7)) {
if (-OPB_maxExp > x->conval->intval || x->conval->intval > OPB_maxExp) {
OPB_err(208);
p->conval->intval = 1;
} else if (x->conval->intval >= 0) {
- if (__ABS(p->conval->intval) <= __DIV(2147483647, __ASH(1, x->conval->intval))) {
- p->conval->intval = p->conval->intval * __ASH(1, x->conval->intval);
+ 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);
p->conval->intval = 1;
@@ -2168,8 +2102,8 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
}
p->obj = NIL;
} else {
- p = NewOp__57(12, 17, p, x);
- p->typ = OPT_linttyp;
+ p = NewOp__54(12, 17, p, x);
+ p->typ = p->left->typ;
}
} else {
OPB_err(111);
@@ -2179,7 +2113,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if (p->typ->comp == 3) {
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) {
OPB_err(63);
}
@@ -2195,13 +2129,13 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 22: case 23:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (!__IN(f, 0x70)) {
+ } else if (f != 4) {
OPB_err(111);
} else {
if (fctno == 22) {
- p = NewOp__57(12, 27, p, x);
+ p = NewOp__54(12, 27, p, x);
} else {
- p = NewOp__57(12, 28, p, x);
+ p = NewOp__54(12, 28, p, x);
}
p->typ = p->left->typ;
}
@@ -2209,7 +2143,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 24: case 25: case 26: case 27:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x63ff)) {
+ } else if (__IN(f, 0x18ff, 32)) {
if (fctno == 24 || fctno == 26) {
if (OPB_NotVar(x)) {
OPB_err(112);
@@ -2218,7 +2152,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
x = p;
p = t;
}
- p = NewOp__57(19, fctno, p, x);
+ p = NewOp__54(19, fctno, p, x);
} else {
OPB_err(111);
}
@@ -2227,32 +2161,38 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 28:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
- p = NewOp__57(12, 26, p, x);
+ } else if (f == 4) {
+ p = NewOp__54(12, 26, p, x);
} else {
OPB_err(111);
}
p->typ = OPT_booltyp;
break;
case 29:
- if (((x->class == 8 || x->class == 9) || __IN(f, 0x1401)) || x->typ->comp == 3) {
+ if (((x->class == 8 || x->class == 9) || __IN(f, 0x0501, 32)) || x->typ->comp == 3) {
OPB_err(126);
}
- if (x->typ->size < p->typ->size) {
+ OPT_TypSize(x->typ);
+ OPT_TypSize(p->typ);
+ if ((x->class != 7 && x->typ->size < p->typ->size)) {
OPB_err(-308);
}
- t = OPT_NewNode(11);
- t->subcl = 29;
- t->left = x;
- x = t;
- x->typ = p->typ;
+ if ((((x->class == 7 && x->typ->form == 4)) && p->typ->form == 4)) {
+ OPB_Convert(&x, p->typ);
+ } else {
+ t = OPT_NewNode(11);
+ t->subcl = 29;
+ t->left = x;
+ x = t;
+ x->typ = p->typ;
+ }
p = x;
break;
case 30:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
- p = NewOp__57(19, 30, p, x);
+ } else if (f == 4) {
+ p = NewOp__54(19, 30, p, x);
} else {
OPB_err(111);
}
@@ -2261,16 +2201,16 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 31:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if ((((x->class == 7 && __IN(f, 0x70))) && x->typ->size < OPT_linttyp->size)) {
- OPB_Convert(&x, OPT_linttyp);
- } else if (!((__IN(x->typ->form, 0x2070) && x->typ->size == (int)OPM_PointerSize))) {
+ } else if ((((x->class == 7 && f == 4)) && x->typ->size < OPT_adrtyp->size)) {
+ OPB_Convert(&x, OPT_adrtyp);
+ } else if (!((__IN(x->typ->form, 0x0810, 32) && x->typ->size == OPM_AddressSize))) {
OPB_err(111);
- x->typ = OPT_linttyp;
+ x->typ = OPT_adrtyp;
}
p->link = x;
break;
case 32:
- if ((__IN(f, 0x70) && x->class == 7)) {
+ if ((f == 4 && x->class == 7)) {
if ((0 <= x->conval->intval && x->conval->intval <= 255)) {
OPB_BindNodes(28, OPT_notyp, &x, x);
x->conval = OPT_NewConst();
@@ -2298,13 +2238,13 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
break;
}
*par0 = p;
- StPar1__56_s = _s.lnk;
+ StPar1__53_s = _s.lnk;
}
-void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
+void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n)
{
OPT_Node node = NIL;
- INTEGER f;
+ INT16 f;
OPT_Node p = NIL;
p = *par0;
f = x->typ->form;
@@ -2313,7 +2253,7 @@ void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
OPB_err(126);
} else if (p->typ->comp != 3) {
OPB_err(64);
- } else if (__IN(f, 0x70)) {
+ } else if (f == 4) {
if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) {
OPB_err(63);
}
@@ -2329,7 +2269,7 @@ void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
} else if ((fctno == 31 && n == 2)) {
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
+ } else if (f == 4) {
node = OPT_NewNode(19);
node->subcl = 31;
node->right = p;
@@ -2346,9 +2286,9 @@ void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
*par0 = p;
}
-void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno)
+void OPB_StFct (OPT_Node *par0, INT8 fctno, INT16 parno)
{
- INTEGER dim;
+ INT16 dim;
OPT_Node x = NIL, p = NIL;
p = *par0;
if (fctno <= 19) {
@@ -2363,7 +2303,7 @@ void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno)
}
} else {
if (((fctno == 13 || fctno == 14) && parno == 1)) {
- OPB_BindNodes(19, OPT_notyp, &p, OPB_NewIntConst(((LONGINT)(1))));
+ OPB_BindNodes(19, OPT_notyp, &p, OPB_NewIntConst(1));
p->subcl = fctno;
p->right->typ = p->left->typ;
} else if ((fctno == 17 && parno == 1)) {
@@ -2385,7 +2325,7 @@ void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno)
} else if (fctno == 32) {
if (parno == 1) {
x = NIL;
- OPB_BindNodes(28, OPT_notyp, &x, OPB_NewIntConst(((LONGINT)(0))));
+ OPB_BindNodes(28, OPT_notyp, &x, OPB_NewIntConst(0));
x->conval = OPT_NewConst();
x->conval->intval = OPM_errpos;
OPB_Construct(15, &p, x);
@@ -2412,21 +2352,21 @@ void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno)
static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar)
{
- INTEGER f;
+ INT16 f;
f = atyp->comp;
ftyp = ftyp->BaseTyp;
atyp = atyp->BaseTyp;
if ((fvarpar && ftyp == OPT_bytetyp)) {
- if (!__IN(f, 0x0c) || !((__IN(atyp->form, 0x7e) && atyp->size == 1))) {
- if (__IN(18, OPM_opt)) {
+ if (!__IN(f, 0x0c, 32) || !((__IN(atyp->form, 0x1e, 32) && atyp->size == 1))) {
+ if (__IN(18, OPM_Options, 32)) {
OPB_err(-301);
}
}
- } else if (__IN(f, 0x0c)) {
+ } else if (__IN(f, 0x0c, 32)) {
if (ftyp->comp == 3) {
OPB_DynArrParCheck(ftyp, atyp, fvarpar);
} else if (ftyp != atyp) {
- if ((((!fvarpar && ftyp->form == 13)) && atyp->form == 13)) {
+ if ((((!fvarpar && ftyp->form == 11)) && atyp->form == 11)) {
ftyp = ftyp->BaseTyp;
atyp = atyp->BaseTyp;
if ((ftyp->comp == 4 && atyp->comp == 4)) {
@@ -2450,7 +2390,7 @@ static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpa
static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp)
{
- if (fp->typ->form == 13) {
+ if (fp->typ->form == 11) {
if ((*x)->class == 3) {
*x = (*x)->left;
} else {
@@ -2461,13 +2401,13 @@ static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp)
void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar)
{
- if (((*x)->obj != NIL && __IN((*x)->obj->mode, 0x22c0))) {
+ if (((*x)->obj != NIL && __IN((*x)->obj->mode, 0x22c0, 32))) {
*fpar = (*x)->obj->link;
if ((*x)->obj->mode == 13) {
OPB_CheckReceiver(&(*x)->left, *fpar);
*fpar = (*fpar)->link;
}
- } else if (((((*x)->class != 8 && (*x)->typ != NIL)) && (*x)->typ->form == 14)) {
+ } else if (((((*x)->class != 8 && (*x)->typ != NIL)) && (*x)->typ->form == 12)) {
*fpar = (*x)->typ->link;
} else {
OPB_err(121);
@@ -2499,17 +2439,17 @@ void OPB_Param (OPT_Node ap, OPT_Object fp)
if (q == NIL) {
OPB_err(111);
}
- } else if ((fp->typ == OPT_sysptrtyp && ap->typ->form == 13)) {
- } else if ((ap->typ != fp->typ && !((fp->typ->form == 1 && ((__IN(ap->typ->form, 0x7e) && ap->typ->size == 1)))))) {
+ } else if ((fp->typ == OPT_sysptrtyp && ap->typ->form == 11)) {
+ } else if ((ap->typ != fp->typ && !((((fp->typ->form == 1 && __IN(ap->typ->form, 0x1e, 32))) && ap->typ->size == 1)))) {
OPB_err(123);
- } else if ((fp->typ->form == 13 && ap->class == 5)) {
+ } else if ((fp->typ->form == 11 && ap->class == 5)) {
OPB_err(123);
}
} else if (fp->typ->comp == 3) {
if ((ap->class == 7 && ap->typ->form == 3)) {
OPB_CharToString(ap);
}
- if ((ap->typ->form == 10 && fp->typ->BaseTyp->form == 3)) {
+ if ((ap->typ->form == 8 && fp->typ->BaseTyp->form == 3)) {
} else if (ap->class >= 7) {
OPB_err(59);
} else {
@@ -2521,13 +2461,13 @@ void OPB_Param (OPT_Node ap, OPT_Object fp)
}
}
-void OPB_StaticLink (SHORTINT dlev)
+void OPB_StaticLink (INT8 dlev)
{
OPT_Object scope = NIL;
scope = OPT_topScope;
while (dlev > 0) {
dlev -= 1;
- scope->link->conval->setval |= __SETOF(3);
+ scope->link->conval->setval |= __SETOF(3,64);
scope = scope->left;
}
}
@@ -2536,7 +2476,7 @@ void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp)
{
OPT_Struct typ = NIL;
OPT_Node p = NIL;
- SHORTINT lev;
+ INT8 lev;
if ((*x)->class == 9) {
typ = (*x)->typ;
lev = (*x)->obj->mnolev;
@@ -2596,7 +2536,7 @@ void OPB_Return (OPT_Node *x, OPT_Object proc)
void OPB_Assign (OPT_Node *x, OPT_Node y)
{
OPT_Node z = NIL;
- SHORTINT subcl;
+ INT8 subcl;
if ((*x)->class >= 7) {
OPB_err(56);
}
@@ -2617,12 +2557,12 @@ void OPB_Assign (OPT_Node *x, OPT_Node y)
OPB_BindNodes(6, (*x)->typ, &z, NIL);
*x = z;
}
- } else if (((((((*x)->typ->comp == 2 && (*x)->typ->BaseTyp == OPT_chartyp)) && y->typ->form == 10)) && y->conval->intval2 == 1)) {
+ } else if (((((((*x)->typ->comp == 2 && (*x)->typ->BaseTyp == OPT_chartyp)) && y->typ->form == 8)) && y->conval->intval2 == 1)) {
y->typ = OPT_chartyp;
y->conval->intval = 0;
- OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0))));
+ OPB_Index(&*x, OPB_NewIntConst(0));
}
- if ((((((__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp == OPT_chartyp)) && __IN(y->typ->comp, 0x0c))) && y->typ->BaseTyp == OPT_chartyp)) {
+ 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;
@@ -2655,7 +2595,7 @@ export void *OPB__init(void)
__MODULE_IMPORT(OPT);
__REGMOD("OPB", 0);
/* BEGIN */
- OPB_maxExp = OPB_log(1073741824);
+ OPB_maxExp = OPB_log(4611686018427387904);
OPB_maxExp = OPB_exp;
__ENDMOD;
}
diff --git a/bootstrap/unix-48/OPB.h b/bootstrap/unix-48/OPB.h
index d1c88266..0be714e8 100644
--- a/bootstrap/unix-48/OPB.h
+++ b/bootstrap/unix-48/OPB.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPB__h
#define OPB__h
@@ -8,13 +8,12 @@
#include "OPT.h"
-import void (*OPB_typSize)(OPT_Struct);
import void OPB_Assign (OPT_Node *x, OPT_Node y);
import void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp);
import void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames);
-import void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y);
+import void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y);
import void OPB_DeRef (OPT_Node *x);
import OPT_Node OPB_EmptySet (void);
import void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc);
@@ -23,27 +22,27 @@ import void OPB_In (OPT_Node *x, OPT_Node y);
import void OPB_Index (OPT_Node *x, OPT_Node y);
import void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ);
import void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y);
-import void OPB_MOp (SHORTINT op, OPT_Node *x);
+import void OPB_MOp (INT8 op, OPT_Node *x);
import OPT_Node OPB_NewBoolConst (BOOLEAN boolval);
-import OPT_Node OPB_NewIntConst (LONGINT intval);
+import OPT_Node OPB_NewIntConst (INT64 intval);
import OPT_Node OPB_NewLeaf (OPT_Object obj);
import OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ);
-import OPT_Node OPB_NewString (OPS_String str, LONGINT len);
+import OPT_Node OPB_NewString (OPS_String str, INT64 len);
import OPT_Node OPB_Nil (void);
-import void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y);
+import void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y);
import void OPB_OptIf (OPT_Node *x);
import void OPB_Param (OPT_Node ap, OPT_Object fp);
import void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar);
import void OPB_Return (OPT_Node *x, OPT_Object proc);
import void OPB_SetElem (OPT_Node *x);
import void OPB_SetRange (OPT_Node *x, OPT_Node y);
-import void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno);
-import void OPB_StPar0 (OPT_Node *par0, INTEGER fctno);
-import void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno);
-import void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n);
-import void OPB_StaticLink (SHORTINT dlev);
+import void OPB_StFct (OPT_Node *par0, INT8 fctno, INT16 parno);
+import void OPB_StPar0 (OPT_Node *par0, INT16 fctno);
+import void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno);
+import void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n);
+import void OPB_StaticLink (INT8 dlev);
import void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard);
import void *OPB__init(void);
-#endif
+#endif // OPB
diff --git a/bootstrap/unix-48/OPC.c b/bootstrap/unix-48/OPC.c
index 3abccc9a..ef4b429f 100644
--- a/bootstrap/unix-48/OPC.c
+++ b/bootstrap/unix-48/OPC.c
@@ -1,31 +1,34 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "Configuration.h"
#include "OPM.h"
#include "OPT.h"
-static INTEGER OPC_indentLevel;
-static BOOLEAN OPC_ptrinit, OPC_mainprog, OPC_ansi;
-static SHORTINT OPC_hashtab[105];
-static CHAR OPC_keytab[36][9];
+static INT16 OPC_indentLevel;
+static INT8 OPC_hashtab[105];
+static CHAR OPC_keytab[50][9];
static BOOLEAN OPC_GlbPtrs;
static CHAR OPC_BodyNameExt[13];
-export void OPC_Align (LONGINT *adr, LONGINT base);
export void OPC_Andent (OPT_Struct typ);
static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames);
-export LONGINT OPC_BaseAlignment (OPT_Struct typ);
export OPT_Object OPC_BaseTProc (OPT_Object obj);
export void OPC_BegBlk (void);
export void OPC_BegStat (void);
-static void OPC_CProcDefs (OPT_Object obj, INTEGER vis);
-export void OPC_Case (LONGINT caseVal, INTEGER form);
-static void OPC_CharacterLiteral (LONGINT c);
-export void OPC_Cmp (INTEGER rel);
+static void OPC_CProcDefs (OPT_Object obj, INT16 vis);
+export void OPC_Case (INT64 caseVal, INT16 form);
+static void OPC_CharacterLiteral (INT64 c);
+export void OPC_Cmp (INT16 rel);
export void OPC_CompleteIdent (OPT_Object obj);
-export void OPC_Constant (OPT_Const con, INTEGER form);
+export void OPC_Constant (OPT_Const con, INT16 form);
static void OPC_DeclareBase (OPT_Object dcl);
static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef);
static void OPC_DeclareParams (OPT_Object par, BOOLEAN macro);
@@ -42,44 +45,45 @@ export void OPC_EnterBody (void);
export void OPC_EnterProc (OPT_Object proc);
export void OPC_ExitBody (void);
export void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet);
-static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *n, LONGINT *curAlign);
-static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LONGINT *curAlign);
+static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, INT32 *off, INT32 *n, INT32 *curAlign);
+static void OPC_FillGap (INT32 gap, INT32 off, INT32 align, INT32 *n, INT32 *curAlign);
export void OPC_GenBdy (OPT_Node n);
-static void OPC_GenDynTypes (OPT_Node n, INTEGER vis);
+static void OPC_GenDynTypes (OPT_Node n, INT16 vis);
export void OPC_GenEnumPtrs (OPT_Object var);
export void OPC_GenHdr (OPT_Node n);
export void OPC_GenHdrIncludes (void);
static void OPC_GenHeaderMsg (void);
-export void OPC_Halt (LONGINT n);
+export void OPC_Halt (INT32 n);
export void OPC_Ident (OPT_Object obj);
-static void OPC_IdentList (OPT_Object obj, INTEGER vis);
+static void OPC_IdentList (OPT_Object obj, INT16 vis);
static void OPC_Include (CHAR *name, LONGINT name__len);
-static void OPC_IncludeImports (OPT_Object obj, INTEGER vis);
+static void OPC_IncludeImports (OPT_Object obj, INT16 vis);
export void OPC_Increment (BOOLEAN decrement);
-export void OPC_Indent (INTEGER count);
+export void OPC_Indent (INT16 count);
export void OPC_Init (void);
static void OPC_InitImports (OPT_Object obj);
static void OPC_InitKeywords (void);
export void OPC_InitTDesc (OPT_Struct typ);
static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj);
-export void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim);
+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 INTEGER OPC_Length (CHAR *s, LONGINT s__len);
-export LONGINT OPC_NofPtrs (OPT_Struct typ);
-static INTEGER OPC_PerfectHash (CHAR *s, LONGINT s__len);
+static 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, LONGINT s__len);
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len);
static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define);
-static void OPC_ProcPredefs (OPT_Object obj, SHORTINT vis);
+static void OPC_ProcPredefs (OPT_Object obj, INT8 vis);
static void OPC_PutBase (OPT_Struct typ);
-static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt);
+static void OPC_PutPtrOffsets (OPT_Struct typ, INT32 adr, INT32 *cnt);
static void OPC_RegCmds (OPT_Object obj);
export void OPC_SetInclude (BOOLEAN exclude);
-export LONGINT OPC_SizeAlignment (LONGINT size);
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause);
-static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x);
-static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT 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, INTEGER vis);
+export void OPC_TypeDefs (OPT_Object obj, INT16 vis);
export void OPC_TypeOf (OPT_Object ap);
static BOOLEAN OPC_Undefined (OPT_Object obj);
@@ -87,24 +91,17 @@ static BOOLEAN OPC_Undefined (OPT_Object obj);
void OPC_Init (void)
{
OPC_indentLevel = 0;
- OPC_ptrinit = __IN(5, OPM_opt);
- OPC_mainprog = OPM_mainProg || OPM_mainLinkStat;
- OPC_ansi = __IN(6, OPM_opt);
- if (OPC_ansi) {
- __MOVE("__init(void)", OPC_BodyNameExt, 13);
- } else {
- __MOVE("__init()", OPC_BodyNameExt, 9);
- }
+ __MOVE("__init(void)", OPC_BodyNameExt, 13);
}
-void OPC_Indent (INTEGER count)
+void OPC_Indent (INT16 count)
{
OPC_indentLevel += count;
}
void OPC_BegStat (void)
{
- INTEGER i;
+ INT16 i;
i = OPC_indentLevel;
while (i > 0) {
OPM_Write(0x09);
@@ -140,10 +137,10 @@ void OPC_EndBlk0 (void)
OPM_Write('}');
}
-static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x)
+static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x)
{
CHAR ch;
- INTEGER i;
+ INT16 i;
__DUP(s, s__len, CHAR);
ch = s[0];
i = 0;
@@ -159,79 +156,86 @@ static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x)
__DEL(s);
}
-static INTEGER OPC_Length (CHAR *s, LONGINT s__len)
+static INT16 OPC_Length (CHAR *s, LONGINT s__len)
{
- INTEGER _o_result;
- INTEGER i;
+ INT16 i;
i = 0;
while (s[__X(i, s__len)] != 0x00) {
i += 1;
}
- _o_result = i;
- return _o_result;
+ return i;
}
-static INTEGER OPC_PerfectHash (CHAR *s, LONGINT s__len)
+static INT16 OPC_PerfectHash (CHAR *s, LONGINT s__len)
{
- INTEGER _o_result;
- INTEGER i, h;
+ INT16 i, h;
i = 0;
h = 0;
while ((s[__X(i, s__len)] != 0x00 && i < 5)) {
- h = 3 * h + (int)s[__X(i, s__len)];
+ h = 3 * h + (INT16)s[__X(i, s__len)];
i += 1;
}
- _o_result = (int)__MOD(h, 105);
- return _o_result;
+ return (int)__MOD(h, 105);
}
void OPC_Ident (OPT_Object obj)
{
- INTEGER mode, level, h;
+ INT16 mode, level, h;
mode = obj->mode;
level = obj->mnolev;
- if ((__IN(mode, 0x62) && level > 0) || __IN(mode, 0x14)) {
- OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256)));
- h = OPC_PerfectHash((void*)obj->name, ((LONGINT)(256)));
- if (OPC_hashtab[__X(h, ((LONGINT)(105)))] >= 0) {
- if (__STRCMP(OPC_keytab[__X(OPC_hashtab[__X(h, ((LONGINT)(105)))], ((LONGINT)(36)))], obj->name) == 0) {
+ if ((__IN(mode, 0x62, 32) && level > 0) || __IN(mode, 0x14, 32)) {
+ OPM_WriteStringVar((void*)obj->name, 256);
+ h = OPC_PerfectHash((void*)obj->name, 256);
+ if (OPC_hashtab[__X(h, 105)] >= 0) {
+ if (__STRCMP(OPC_keytab[__X(OPC_hashtab[__X(h, 105)], 50)], obj->name) == 0) {
OPM_Write('_');
}
}
+ } else if ((mode == 5 && __IN(obj->typ->form, 0x90, 32))) {
+ if (obj->typ == OPT_adrtyp) {
+ OPM_WriteString((CHAR*)"ADDRESS", 8);
+ } else {
+ if (obj->typ->form == 4) {
+ OPM_WriteString((CHAR*)"INT", 4);
+ } else {
+ OPM_WriteString((CHAR*)"UINT", 5);
+ }
+ OPM_WriteInt(__ASHL(obj->typ->size, 3));
+ }
} else {
if (mode != 5 || obj->linkadr != 2) {
if (mode == 13) {
OPC_Ident(obj->link->typ->strobj);
} else if (level < 0) {
- OPM_WriteStringVar((void*)OPT_GlbMod[__X(-level, ((LONGINT)(64)))]->name, ((LONGINT)(256)));
+ OPM_WriteStringVar((void*)OPT_GlbMod[__X(-level, 64)]->name, 256);
if (OPM_currFile == 0) {
- OPT_GlbMod[__X(-level, ((LONGINT)(64)))]->vis = 1;
+ OPT_GlbMod[__X(-level, 64)]->vis = 1;
}
} else {
- OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32)));
+ OPM_WriteStringVar((void*)OPM_modName, 32);
}
OPM_Write('_');
} else if (obj == OPT_sysptrtyp->strobj || obj == OPT_bytetyp->strobj) {
- OPM_WriteString((CHAR*)"SYSTEM_", (LONGINT)8);
+ OPM_WriteString((CHAR*)"SYSTEM_", 8);
}
- OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256)));
+ OPM_WriteStringVar((void*)obj->name, 256);
}
}
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause)
{
- INTEGER pointers;
+ INT16 pointers;
*openClause = 0;
if (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->comp != 4)) {
- if (__IN(typ->comp, 0x0c)) {
+ if (__IN(typ->comp, 0x0c, 32)) {
OPC_Stars(typ->BaseTyp, &*openClause);
*openClause = typ->comp == 2;
- } else if (typ->form == 14) {
+ } else if (typ->form == 12) {
OPM_Write('(');
OPM_Write('*');
} else {
pointers = 0;
- while (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->form == 13)) {
+ while (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->form == 11)) {
pointers += 1;
typ = typ->BaseTyp;
}
@@ -256,7 +260,7 @@ static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef)
{
OPT_Struct typ = NIL;
BOOLEAN varPar, openClause;
- INTEGER form, comp;
+ INT16 form, comp;
typ = dcl->typ;
varPar = ((dcl->mode == 2 && typ->comp != 2) || typ->comp == 3) || scopeDef;
OPC_Stars(typ, &openClause);
@@ -276,22 +280,18 @@ static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef)
for (;;) {
form = typ->form;
comp = typ->comp;
- if (((typ->strobj != NIL && typ->strobj->name[0] != 0x00) || form == 12) || comp == 4) {
+ if (((typ->strobj != NIL && typ->strobj->name[0] != 0x00) || form == 10) || comp == 4) {
break;
- } else if ((form == 13 && typ->BaseTyp->comp != 3)) {
+ } else if ((form == 11 && typ->BaseTyp->comp != 3)) {
openClause = 1;
- } else if (form == 14 || __IN(comp, 0x0c)) {
+ } else if (form == 12 || __IN(comp, 0x0c, 32)) {
if (openClause) {
OPM_Write(')');
openClause = 0;
}
- if (form == 14) {
- if (OPC_ansi) {
- OPM_Write(')');
- OPC_AnsiParamList(typ->link, 0);
- } else {
- OPM_WriteString((CHAR*)")()", (LONGINT)4);
- }
+ if (form == 12) {
+ OPM_Write(')');
+ OPC_AnsiParamList(typ->link, 0);
break;
} else if (comp == 2) {
OPM_Write('[');
@@ -308,8 +308,8 @@ static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef)
void OPC_Andent (OPT_Struct typ)
{
if (typ->strobj == NIL || typ->align >= 65536) {
- OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32)));
- OPC_Str1((CHAR*)"__#", (LONGINT)4, __ASHR(typ->align, 16));
+ OPM_WriteStringVar((void*)OPM_modName, 32);
+ OPC_Str1((CHAR*)"__#", 4, __ASHR(typ->align, 16));
} else {
OPC_Ident(typ->strobj);
}
@@ -317,36 +317,34 @@ void OPC_Andent (OPT_Struct typ)
static BOOLEAN OPC_Undefined (OPT_Object obj)
{
- BOOLEAN _o_result;
- _o_result = obj->name[0] == 0x00 || (((obj->mnolev >= 0 && obj->linkadr != (int)(3 + OPM_currFile))) && obj->linkadr != 2);
- return _o_result;
+ return obj->name[0] == 0x00 || (((obj->mnolev >= 0 && obj->linkadr != (3 + OPM_currFile))) && obj->linkadr != 2);
}
static void OPC_DeclareBase (OPT_Object dcl)
{
OPT_Struct typ = NIL, prev = NIL;
OPT_Object obj = NIL;
- INTEGER nofdims;
- LONGINT off, n, dummy;
+ INT16 nofdims;
+ INT32 off, n, dummy;
typ = dcl->typ;
prev = typ;
- while ((((((((typ->strobj == NIL || typ->comp == 3) || OPC_Undefined(typ->strobj)) && typ->comp != 4)) && typ->form != 12)) && !((typ->form == 13 && typ->BaseTyp->comp == 3)))) {
+ while ((((((((typ->strobj == NIL || typ->comp == 3) || OPC_Undefined(typ->strobj)) && typ->comp != 4)) && typ->form != 10)) && !((typ->form == 11 && typ->BaseTyp->comp == 3)))) {
prev = typ;
typ = typ->BaseTyp;
}
obj = typ->strobj;
- if (typ->form == 12) {
- OPM_WriteString((CHAR*)"void", (LONGINT)5);
+ if (typ->form == 10) {
+ OPM_WriteString((CHAR*)"void", 5);
} else if ((obj != NIL && !OPC_Undefined(obj))) {
OPC_Ident(obj);
} else if (typ->comp == 4) {
- OPM_WriteString((CHAR*)"struct ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"struct ", 8);
OPC_Andent(typ);
- if ((prev->form != 13 && (obj != NIL || dcl->name[0] == 0x00))) {
+ if ((prev->form != 11 && (obj != NIL || dcl->name[0] == 0x00))) {
if ((typ->BaseTyp != NIL && typ->BaseTyp->strobj->vis != 0)) {
- OPM_WriteString((CHAR*)" { /* ", (LONGINT)7);
+ OPM_WriteString((CHAR*)" { /* ", 7);
OPC_Ident(typ->BaseTyp->strobj);
- OPM_WriteString((CHAR*)" */", (LONGINT)4);
+ OPM_WriteString((CHAR*)" */", 4);
OPM_WriteLn();
OPC_Indent(1);
} else {
@@ -356,22 +354,22 @@ static void OPC_DeclareBase (OPT_Object dcl)
OPC_FieldList(typ, 1, &off, &n, &dummy);
OPC_EndBlk0();
}
- } else if ((typ->form == 13 && typ->BaseTyp->comp == 3)) {
+ } else if ((typ->form == 11 && typ->BaseTyp->comp == 3)) {
typ = typ->BaseTyp->BaseTyp;
nofdims = 1;
while (typ->comp == 3) {
nofdims += 1;
typ = typ->BaseTyp;
}
- OPM_WriteString((CHAR*)"struct ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"struct ", 8);
OPC_BegBlk();
OPC_BegStat();
- OPC_Str1((CHAR*)"LONGINT len[#]", (LONGINT)15, nofdims);
+ OPC_Str1((CHAR*)"LONGINT len[#]", 15, nofdims);
OPC_EndStat();
OPC_BegStat();
__NEW(obj, OPT_ObjDesc);
__NEW(obj->typ, OPT_StrDesc);
- obj->typ->form = 15;
+ obj->typ->form = 13;
obj->typ->comp = 2;
obj->typ->n = 1;
obj->typ->BaseTyp = typ;
@@ -386,15 +384,13 @@ static void OPC_DeclareBase (OPT_Object dcl)
}
}
-LONGINT OPC_NofPtrs (OPT_Struct typ)
+INT32 OPC_NofPtrs (OPT_Struct typ)
{
- LONGINT _o_result;
OPT_Object fld = NIL;
OPT_Struct btyp = NIL;
- LONGINT n;
- if ((typ->form == 13 && typ->sysflag == 0)) {
- _o_result = 1;
- return _o_result;
+ INT32 n;
+ if ((typ->form == 11 && typ->sysflag == 0)) {
+ return 1;
} else if ((typ->comp == 4 && __MASK(typ->sysflag, -256) == 0)) {
btyp = typ->BaseTyp;
if (btyp != NIL) {
@@ -411,8 +407,7 @@ LONGINT OPC_NofPtrs (OPT_Struct typ)
}
fld = fld->link;
}
- _o_result = n;
- return _o_result;
+ return n;
} else if (typ->comp == 2) {
btyp = typ->BaseTyp;
n = typ->n;
@@ -420,23 +415,21 @@ LONGINT OPC_NofPtrs (OPT_Struct typ)
n = btyp->n * n;
btyp = btyp->BaseTyp;
}
- _o_result = OPC_NofPtrs(btyp) * n;
- return _o_result;
+ return OPC_NofPtrs(btyp) * n;
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt)
+static void OPC_PutPtrOffsets (OPT_Struct typ, INT32 adr, INT32 *cnt)
{
OPT_Object fld = NIL;
OPT_Struct btyp = NIL;
- LONGINT n, i;
- if ((typ->form == 13 && typ->sysflag == 0)) {
+ INT32 n, i;
+ if ((typ->form == 11 && typ->sysflag == 0)) {
OPM_WriteInt(adr);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
*cnt += 1;
if (__MASK(*cnt, -16) == 0) {
OPM_WriteLn();
@@ -453,7 +446,7 @@ static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt)
OPC_PutPtrOffsets(fld->typ, adr + fld->adr, &*cnt);
} else {
OPM_WriteInt(adr + fld->adr);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
*cnt += 1;
if (__MASK(*cnt, -16) == 0) {
OPM_WriteLn();
@@ -485,11 +478,11 @@ static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj)
OPC_InitTProcs(typ, obj->left);
if (obj->mode == 13) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"__INITBP(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__INITBP(", 10);
OPC_Ident(typ);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Ident(obj);
- OPC_Str1((CHAR*)", #)", (LONGINT)5, __ASHR(obj->adr, 16));
+ OPC_Str1((CHAR*)", #)", 5, __ASHR(obj->adr, 16));
OPC_EndStat();
}
OPC_InitTProcs(typ, obj->right);
@@ -501,30 +494,30 @@ static void OPC_PutBase (OPT_Struct typ)
if (typ != NIL) {
OPC_PutBase(typ->BaseTyp);
OPC_Ident(typ->strobj);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)"__typ", 6);
+ OPM_WriteString((CHAR*)", ", 3);
}
}
static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamName)
{
OPT_Struct typ = NIL;
- INTEGER dim;
+ INT16 dim;
if (showParamName) {
OPC_Ident(par);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
}
dim = 1;
typ = par->typ->BaseTyp;
while (typ->comp == 3) {
if (ansiDefine) {
- OPM_WriteString((CHAR*)", LONGINT ", (LONGINT)11);
+ OPM_WriteString((CHAR*)", LONGINT ", 11);
} else {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
}
if (showParamName) {
OPC_Ident(par);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
OPM_WriteInt(dim);
}
typ = typ->BaseTyp;
@@ -537,24 +530,24 @@ static void OPC_DeclareParams (OPT_Object par, BOOLEAN macro)
OPM_Write('(');
while (par != NIL) {
if (macro) {
- OPM_WriteStringVar((void*)par->name, ((LONGINT)(256)));
+ OPM_WriteStringVar((void*)par->name, 256);
} else {
- if ((par->mode == 1 && par->typ->form == 7)) {
+ if ((par->mode == 1 && par->typ->form == 5)) {
OPM_Write('_');
}
OPC_Ident(par);
}
if (par->typ->comp == 3) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_LenList(par, 0, 1);
} else if ((par->mode == 2 && par->typ->comp == 4)) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPM_WriteStringVar((void*)par->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPM_WriteStringVar((void*)par->name, 256);
+ OPM_WriteString((CHAR*)"__typ", 6);
}
par = par->link;
if (par != NIL) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
}
}
OPM_Write(')');
@@ -566,12 +559,10 @@ static void OPC_DefineTProcTypes (OPT_Object obj)
if (obj->typ != OPT_notyp) {
OPC_DefineType(obj->typ);
}
- if (OPC_ansi) {
- par = obj->link;
- while (par != NIL) {
- OPC_DefineType(par->typ);
- par = par->link;
- }
+ par = obj->link;
+ while (par != NIL) {
+ OPC_DefineType(par->typ);
+ par = par->link;
}
}
@@ -586,7 +577,7 @@ static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty)
if (OPM_currFile == 0) {
if (obj->vis == 1) {
OPC_DefineTProcTypes(obj);
- OPM_WriteString((CHAR*)"import ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"import ", 8);
*empty = 0;
OPC_ProcHeader(obj, 0);
}
@@ -594,9 +585,9 @@ static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty)
*empty = 0;
OPC_DefineTProcTypes(obj);
if (obj->vis == 0) {
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"static ", 8);
} else {
- OPM_WriteString((CHAR*)"export ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"export ", 8);
}
OPC_ProcHeader(obj, 0);
}
@@ -607,11 +598,10 @@ static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty)
OPT_Object OPC_BaseTProc (OPT_Object obj)
{
- OPT_Object _o_result;
OPT_Struct typ = NIL, base = NIL;
- LONGINT mno;
+ INT32 mno;
typ = obj->link->typ;
- if (typ->form == 13) {
+ if (typ->form == 11) {
typ = typ->BaseTyp;
}
base = typ->BaseTyp;
@@ -621,8 +611,7 @@ OPT_Object OPC_BaseTProc (OPT_Object obj)
base = typ->BaseTyp;
}
OPT_FindField(obj->name, typ, &obj);
- _o_result = obj;
- return _o_result;
+ return obj;
}
static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty)
@@ -630,31 +619,27 @@ static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty)
if (obj != NIL) {
OPC_DefineTProcMacros(obj->left, &*empty);
if ((((obj->mode == 13 && obj == OPC_BaseTProc(obj))) && (OPM_currFile != 0 || obj->vis == 1))) {
- OPM_WriteString((CHAR*)"#define __", (LONGINT)11);
+ OPM_WriteString((CHAR*)"#define __", 11);
OPC_Ident(obj);
OPC_DeclareParams(obj->link, 1);
- OPM_WriteString((CHAR*)" __SEND(", (LONGINT)9);
- if (obj->link->typ->form == 13) {
- OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10);
+ 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", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
}
- OPC_Str1((CHAR*)", #, ", (LONGINT)6, __ASHR(obj->adr, 16));
+ OPC_Str1((CHAR*)", #, ", 6, __ASHR(obj->adr, 16));
if (obj->typ == OPT_notyp) {
- OPM_WriteString((CHAR*)"void", (LONGINT)5);
+ OPM_WriteString((CHAR*)"void", 5);
} else {
OPC_Ident(obj->typ->strobj);
}
- OPM_WriteString((CHAR*)"(*)", (LONGINT)4);
- if (OPC_ansi) {
- OPC_AnsiParamList(obj->link, 0);
- } else {
- OPM_WriteString((CHAR*)"()", (LONGINT)3);
- }
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)"(*)", 4);
+ OPC_AnsiParamList(obj->link, 0);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_DeclareParams(obj->link, 1);
OPM_Write(')');
OPM_WriteLn();
@@ -672,7 +657,7 @@ static void OPC_DefineType (OPT_Struct str)
if (obj == NIL || OPC_Undefined(obj)) {
if (obj != NIL) {
if (obj->linkadr == 1) {
- if (str->form != 13) {
+ if (str->form != 11) {
OPM_Mark(244, str->txtpos);
obj->linkadr = 2;
}
@@ -691,13 +676,13 @@ static void OPC_DefineType (OPT_Struct str)
}
field = field->link;
}
- } else if (str->form == 13) {
+ } else if (str->form == 11) {
if (str->BaseTyp->comp != 4) {
OPC_DefineType(str->BaseTyp);
}
- } else if (__IN(str->comp, 0x0c)) {
+ } else if (__IN(str->comp, 0x0c, 32)) {
OPC_DefineType(str->BaseTyp);
- } else if (str->form == 14) {
+ } else if (str->form == 12) {
if (str->BaseTyp != OPT_notyp) {
OPC_DefineType(str->BaseTyp);
}
@@ -709,7 +694,7 @@ static void OPC_DefineType (OPT_Struct str)
}
}
if ((obj != NIL && OPC_Undefined(obj))) {
- OPM_WriteString((CHAR*)"typedef", (LONGINT)8);
+ OPM_WriteString((CHAR*)"typedef", 8);
OPM_WriteLn();
OPM_Write(0x09);
OPC_Indent(1);
@@ -737,40 +722,36 @@ static void OPC_DefineType (OPT_Struct str)
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len)
{
- BOOLEAN _o_result;
- INTEGER i;
- BOOLEAN r;
+ INT16 i;
__DUP(y, y__len, CHAR);
i = 0;
- while ((*x)[__X(i + 1, ((LONGINT)(256)))] == y[__X(i, y__len)]) {
+ while ((*x)[__X(i + 1, 256)] == y[__X(i, y__len)]) {
i += 1;
}
- r = y[__X(i, y__len)] == 0x00;
- _o_result = r;
__DEL(y);
- return _o_result;
+ return y[__X(i, y__len)] == 0x00;
}
-static void OPC_CProcDefs (OPT_Object obj, INTEGER vis)
+static void OPC_CProcDefs (OPT_Object obj, INT16 vis)
{
- INTEGER i;
+ INT16 i;
OPT_ConstExt ext = NIL;
- INTEGER _for__9;
+ INT16 _for__7;
if (obj != NIL) {
OPC_CProcDefs(obj->left, vis);
- if ((((obj->mode == 9 && (int)obj->vis >= vis)) && obj->adr == 1)) {
+ if ((((obj->mode == 9 && (INT16)obj->vis >= vis)) && obj->adr == 1)) {
ext = obj->conval->ext;
i = 1;
- if (((*ext)[1] != '#' && !(OPC_Prefixed(ext, (CHAR*)"extern ", (LONGINT)8) || OPC_Prefixed(ext, (CHAR*)"import ", (LONGINT)8)))) {
- OPM_WriteString((CHAR*)"#define ", (LONGINT)9);
+ if (((*ext)[1] != '#' && !(OPC_Prefixed(ext, (CHAR*)"extern ", 8) || OPC_Prefixed(ext, (CHAR*)"import ", 8)))) {
+ OPM_WriteString((CHAR*)"#define ", 9);
OPC_Ident(obj);
OPC_DeclareParams(obj->link, 1);
OPM_Write(0x09);
}
- _for__9 = (int)(*obj->conval->ext)[0];
+ _for__7 = (INT16)(*obj->conval->ext)[0];
i = i;
- while (i <= _for__9) {
- OPM_Write((*obj->conval->ext)[__X(i, ((LONGINT)(256)))]);
+ while (i <= _for__7) {
+ OPM_Write((*obj->conval->ext)[__X(i, 256)]);
i += 1;
}
OPM_WriteLn();
@@ -779,7 +760,7 @@ static void OPC_CProcDefs (OPT_Object obj, INTEGER vis)
}
}
-void OPC_TypeDefs (OPT_Object obj, INTEGER vis)
+void OPC_TypeDefs (OPT_Object obj, INT16 vis)
{
if (obj != NIL) {
OPC_TypeDefs(obj->left, vis);
@@ -811,130 +792,85 @@ static void OPC_DefAnonRecs (OPT_Node n)
void OPC_TDescDecl (OPT_Struct typ)
{
- LONGINT nofptrs;
+ INT32 nofptrs;
OPT_Object o = NIL;
OPC_BegStat();
- OPM_WriteString((CHAR*)"__TDESC(", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__TDESC(", 9);
OPC_Andent(typ);
- OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1);
- OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ));
+ OPC_Str1((CHAR*)", #", 4, typ->n + 1);
+ OPC_Str1((CHAR*)", #) = {__TDFLDS(", 18, OPC_NofPtrs(typ));
OPM_Write('"');
if (typ->strobj != NIL) {
- OPM_WriteStringVar((void*)typ->strobj->name, ((LONGINT)(256)));
+ OPM_WriteStringVar((void*)typ->strobj->name, 256);
}
OPM_Write('"');
- OPC_Str1((CHAR*)", #), {", (LONGINT)8, typ->size);
+ OPC_Str1((CHAR*)", #), {", 8, typ->size);
nofptrs = 0;
- OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs);
- OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (int)OPM_LIntSize));
+ OPC_PutPtrOffsets(typ, 0, &nofptrs);
+ OPC_Str1((CHAR*)"#}}", 4, -((nofptrs + 1) * OPM_AddressSize));
OPC_EndStat();
}
void OPC_InitTDesc (OPT_Struct typ)
{
OPC_BegStat();
- OPM_WriteString((CHAR*)"__INITYP(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__INITYP(", 10);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
if (typ->BaseTyp != NIL) {
OPC_Andent(typ->BaseTyp);
} else {
OPC_Andent(typ);
}
- OPC_Str1((CHAR*)", #)", (LONGINT)5, typ->extlev);
+ OPC_Str1((CHAR*)", #)", 5, typ->extlev);
OPC_EndStat();
if (typ->strobj != NIL) {
OPC_InitTProcs(typ->strobj, typ->link);
}
}
-void OPC_Align (LONGINT *adr, LONGINT base)
+static void OPC_FillGap (INT32 gap, INT32 off, INT32 align, INT32 *n, INT32 *curAlign)
{
- switch (base) {
- case 2:
- *adr += __MASK(*adr, -2);
- break;
- case 4:
- *adr += __MASK(-*adr, -4);
- break;
- case 8:
- *adr += __MASK(-*adr, -8);
- break;
- case 16:
- *adr += __MASK(-*adr, -16);
- break;
- default:
- break;
- }
-}
-
-LONGINT OPC_SizeAlignment (LONGINT size)
-{
- LONGINT _o_result;
- LONGINT alignment;
- if (size < (int)OPM_Alignment) {
- alignment = 1;
- while (alignment < size) {
- alignment = __ASHL(alignment, 1);
- }
- } else {
- alignment = OPM_Alignment;
- }
- _o_result = alignment;
- return _o_result;
-}
-
-LONGINT OPC_BaseAlignment (OPT_Struct typ)
-{
- LONGINT _o_result;
- LONGINT alignment;
- if (typ->form == 15) {
- if (typ->comp == 4) {
- alignment = __MASK(typ->align, -65536);
- } else {
- alignment = OPC_BaseAlignment(typ->BaseTyp);
- }
- } else {
- alignment = OPC_SizeAlignment(typ->size);
- }
- _o_result = alignment;
- return _o_result;
-}
-
-static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LONGINT *curAlign)
-{
- LONGINT adr;
+ INT32 adr;
adr = off;
- OPC_Align(&adr, align);
+ OPT_Align(&adr, align);
if ((*curAlign < align && gap - (adr - off) >= align)) {
gap -= (adr - off) + align;
OPC_BegStat();
- if (align == (int)OPM_IntSize) {
- OPM_WriteString((CHAR*)"INTEGER", (LONGINT)8);
- } else if (align == (int)OPM_LIntSize) {
- OPM_WriteString((CHAR*)"LONGINT", (LONGINT)8);
- } else if (align == (int)OPM_LRealSize) {
- OPM_WriteString((CHAR*)"LONGREAL", (LONGINT)9);
+ switch (align) {
+ case 2:
+ OPM_WriteString((CHAR*)"INT16", 6);
+ break;
+ case 4:
+ OPM_WriteString((CHAR*)"INT32", 6);
+ break;
+ case 8:
+ OPM_WriteString((CHAR*)"INT64", 6);
+ break;
+ default:
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Unexpected enclosing alignment in FillGap.", 43);
+ break;
}
- OPC_Str1((CHAR*)" _prvt#", (LONGINT)8, *n);
+ OPC_Str1((CHAR*)" _prvt#", 8, *n);
*n += 1;
OPC_EndStat();
*curAlign = align;
}
if (gap > 0) {
OPC_BegStat();
- OPC_Str1((CHAR*)"char _prvt#", (LONGINT)12, *n);
+ OPC_Str1((CHAR*)"char _prvt#", 12, *n);
*n += 1;
- OPC_Str1((CHAR*)"[#]", (LONGINT)4, gap);
+ OPC_Str1((CHAR*)"[#]", 4, gap);
OPC_EndStat();
}
}
-static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *n, LONGINT *curAlign)
+static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, INT32 *off, INT32 *n, INT32 *curAlign)
{
OPT_Object fld = NIL;
OPT_Struct base = NIL;
- LONGINT gap, adr, align, fldAlign;
+ INT32 gap, adr, align, fldAlign;
fld = typ->link;
align = __MASK(typ->align, -65536);
if (typ->BaseTyp != NIL) {
@@ -952,8 +888,8 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
}
} else {
adr = *off;
- fldAlign = OPC_BaseAlignment(fld->typ);
- OPC_Align(&adr, fldAlign);
+ fldAlign = OPT_BaseAlignment(fld->typ);
+ OPT_Align(&adr, fldAlign);
gap = fld->adr - adr;
if (fldAlign > *curAlign) {
*curAlign = fldAlign;
@@ -969,7 +905,7 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
base = fld->typ;
fld = fld->link;
while ((((((((fld != NIL && fld->mode == 4)) && fld->typ == base)) && fld->adr == *off)) && ((OPM_currFile == 1 || fld->vis != 0) || fld->typ->strobj == NIL))) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_DeclareObj(fld, 0);
*off = fld->adr + fld->typ->size;
fld = fld->link;
@@ -978,7 +914,7 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
}
}
if (last) {
- adr = typ->size - (int)__ASHR(typ->sysflag, 8);
+ adr = typ->size - __ASHR(typ->sysflag, 8);
if (adr == 0) {
gap = 1;
} else {
@@ -990,16 +926,16 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
}
}
-static void OPC_IdentList (OPT_Object obj, INTEGER vis)
+static void OPC_IdentList (OPT_Object obj, INT16 vis)
{
OPT_Struct base = NIL;
BOOLEAN first;
- INTEGER lastvis;
+ INT16 lastvis;
base = NIL;
first = 1;
while ((obj != NIL && obj->mode != 13)) {
- if ((__IN(vis, 0x05) || (vis == 1 && obj->vis != 0)) || (vis == 3 && !obj->leaf)) {
- if (obj->typ != base || (int)obj->vis != lastvis) {
+ if ((__IN(vis, 0x05, 32) || (vis == 1 && obj->vis != 0)) || (vis == 3 && !obj->leaf)) {
+ if (obj->typ != base || (INT16)obj->vis != lastvis) {
if (!first) {
OPC_EndStat();
}
@@ -1008,16 +944,16 @@ static void OPC_IdentList (OPT_Object obj, INTEGER vis)
lastvis = obj->vis;
OPC_BegStat();
if ((vis == 1 && obj->vis != 0)) {
- OPM_WriteString((CHAR*)"import ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"import ", 8);
} else if ((obj->mnolev == 0 && vis == 0)) {
if (obj->vis == 0) {
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"static ", 8);
} else {
- OPM_WriteString((CHAR*)"export ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"export ", 8);
}
}
- if ((((vis == 2 && obj->mode == 1)) && base->form == 7)) {
- OPM_WriteString((CHAR*)"double", (LONGINT)7);
+ if ((((vis == 2 && obj->mode == 1)) && base->form == 5)) {
+ OPM_WriteString((CHAR*)"double", 7);
} else {
OPC_DeclareBase(obj);
}
@@ -1025,7 +961,7 @@ static void OPC_IdentList (OPT_Object obj, INTEGER vis)
OPM_Write(',');
}
OPM_Write(' ');
- if ((((vis == 2 && obj->mode == 1)) && base->form == 7)) {
+ if ((((vis == 2 && obj->mode == 1)) && base->form == 5)) {
OPM_Write('_');
}
OPC_DeclareObj(obj, vis == 3);
@@ -1033,17 +969,17 @@ static void OPC_IdentList (OPT_Object obj, INTEGER vis)
OPC_EndStat();
OPC_BegStat();
base = OPT_linttyp;
- OPM_WriteString((CHAR*)"LONGINT ", (LONGINT)9);
+ OPM_WriteString((CHAR*)"LONGINT ", 9);
OPC_LenList(obj, 0, 1);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPC_EndStat();
OPC_BegStat();
- OPM_WriteString((CHAR*)"LONGINT *", (LONGINT)10);
+ OPM_WriteString((CHAR*)"ADDRESS *", 10);
OPC_Ident(obj);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
base = NIL;
- } else if ((((((OPC_ptrinit && vis == 0)) && obj->mnolev > 0)) && obj->typ->form == 13)) {
- OPM_WriteString((CHAR*)" = NIL", (LONGINT)7);
+ } else if ((((((__IN(5, OPM_Options, 32) && vis == 0)) && obj->mnolev > 0)) && obj->typ->form == 11)) {
+ OPM_WriteString((CHAR*)" = NIL", 7);
}
}
obj = obj->link;
@@ -1058,7 +994,7 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
CHAR name[32];
OPM_Write('(');
if (obj == NIL || obj->mode == 13) {
- OPM_WriteString((CHAR*)"void", (LONGINT)5);
+ OPM_WriteString((CHAR*)"void", 5);
} else {
for (;;) {
OPC_DeclareBase(obj);
@@ -1066,25 +1002,25 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
OPM_Write(' ');
OPC_DeclareObj(obj, 0);
} else {
- __COPY(obj->name, name, ((LONGINT)(32)));
+ __COPY(obj->name, name, 32);
obj->name[0] = 0x00;
OPC_DeclareObj(obj, 0);
- __COPY(name, obj->name, ((LONGINT)(256)));
+ __COPY(name, obj->name, 256);
}
if (obj->typ->comp == 3) {
- OPM_WriteString((CHAR*)", LONGINT ", (LONGINT)11);
+ OPM_WriteString((CHAR*)", LONGINT ", 11);
OPC_LenList(obj, 1, showParamNames);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
- OPM_WriteString((CHAR*)", LONGINT *", (LONGINT)12);
+ OPM_WriteString((CHAR*)", ADDRESS *", 12);
if (showParamNames) {
OPC_Ident(obj);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
}
}
if (obj->link == NIL || obj->link->mode == 13) {
break;
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
obj = obj->link;
}
}
@@ -1094,42 +1030,31 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define)
{
if (proc->typ == OPT_notyp) {
- OPM_WriteString((CHAR*)"void", (LONGINT)5);
+ OPM_WriteString((CHAR*)"void", 5);
} else {
OPC_Ident(proc->typ->strobj);
}
OPM_Write(' ');
OPC_Ident(proc);
OPM_Write(' ');
- if (OPC_ansi) {
- OPC_AnsiParamList(proc->link, 1);
- if (!define) {
- OPM_Write(';');
- }
- OPM_WriteLn();
- } else if (define) {
- OPC_DeclareParams(proc->link, 0);
- OPM_WriteLn();
- OPC_Indent(1);
- OPC_IdentList(proc->link, 2);
- OPC_Indent(-1);
- } else {
- OPM_WriteString((CHAR*)"();", (LONGINT)4);
- OPM_WriteLn();
+ OPC_AnsiParamList(proc->link, 1);
+ if (!define) {
+ OPM_Write(';');
}
+ OPM_WriteLn();
}
-static void OPC_ProcPredefs (OPT_Object obj, SHORTINT vis)
+static void OPC_ProcPredefs (OPT_Object obj, INT8 vis)
{
if (obj != NIL) {
OPC_ProcPredefs(obj->left, vis);
- if ((((__IN(obj->mode, 0xc0) && obj->vis >= vis)) && (obj->history != 4 || obj->mode == 6))) {
+ if ((((__IN(obj->mode, 0xc0, 32) && obj->vis >= vis)) && (obj->history != 4 || obj->mode == 6))) {
if (vis == 1) {
- OPM_WriteString((CHAR*)"import ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"import ", 8);
} else if (obj->vis == 0) {
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"static ", 8);
} else {
- OPM_WriteString((CHAR*)"export ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"export ", 8);
}
OPC_ProcHeader(obj, 0);
}
@@ -1140,27 +1065,27 @@ static void OPC_ProcPredefs (OPT_Object obj, SHORTINT vis)
static void OPC_Include (CHAR *name, LONGINT name__len)
{
__DUP(name, name__len, CHAR);
- OPM_WriteString((CHAR*)"#include ", (LONGINT)10);
+ OPM_WriteString((CHAR*)"#include ", 10);
OPM_Write('"');
OPM_WriteStringVar((void*)name, name__len);
- OPM_WriteString((CHAR*)".h", (LONGINT)3);
+ OPM_WriteString((CHAR*)".h", 3);
OPM_Write('"');
OPM_WriteLn();
__DEL(name);
}
-static void OPC_IncludeImports (OPT_Object obj, INTEGER vis)
+static void OPC_IncludeImports (OPT_Object obj, INT16 vis)
{
if (obj != NIL) {
OPC_IncludeImports(obj->left, vis);
- if ((((obj->mode == 11 && obj->mnolev != 0)) && (int)OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->vis >= vis)) {
- OPC_Include(OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, ((LONGINT)(256)));
+ if ((((obj->mode == 11 && obj->mnolev != 0)) && (INT16)OPT_GlbMod[__X(-obj->mnolev, 64)]->vis >= vis)) {
+ OPC_Include(OPT_GlbMod[__X(-obj->mnolev, 64)]->name, 256);
}
OPC_IncludeImports(obj->right, vis);
}
}
-static void OPC_GenDynTypes (OPT_Node n, INTEGER vis)
+static void OPC_GenDynTypes (OPT_Node n, INT16 vis)
{
OPT_Struct typ = NIL;
while ((n != NIL && n->class == 14)) {
@@ -1168,15 +1093,15 @@ static void OPC_GenDynTypes (OPT_Node n, INTEGER vis)
if (vis == 0 || typ->ref < 255) {
OPC_BegStat();
if (vis == 1) {
- OPM_WriteString((CHAR*)"import ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"import ", 8);
} else if ((typ->strobj != NIL && typ->strobj->mnolev > 0)) {
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"static ", 8);
} else {
- OPM_WriteString((CHAR*)"export ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"export ", 8);
}
- OPM_WriteString((CHAR*)"LONGINT *", (LONGINT)10);
+ OPM_WriteString((CHAR*)"ADDRESS *", 10);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
OPC_EndStat();
}
n = n->link;
@@ -1194,29 +1119,30 @@ void OPC_GenHdr (OPT_Node n)
OPC_GenDynTypes(n, 1);
OPM_WriteLn();
OPC_ProcPredefs(OPT_topScope->right, 1);
- OPM_WriteString((CHAR*)"import ", (LONGINT)8);
- OPM_WriteString((CHAR*)"void *", (LONGINT)7);
- OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32)));
- OPM_WriteString(OPC_BodyNameExt, ((LONGINT)(13)));
+ OPM_WriteString((CHAR*)"import ", 8);
+ OPM_WriteString((CHAR*)"void *", 7);
+ OPM_WriteStringVar((void*)OPM_modName, 32);
+ OPM_WriteString(OPC_BodyNameExt, 13);
OPC_EndStat();
OPM_WriteLn();
OPC_CProcDefs(OPT_topScope->right, 1);
OPM_WriteLn();
- OPM_WriteString((CHAR*)"#endif", (LONGINT)7);
+ OPM_WriteString((CHAR*)"#endif // ", 11);
+ OPM_WriteStringVar((void*)OPM_modName, 32);
OPM_WriteLn();
}
static void OPC_GenHeaderMsg (void)
{
- INTEGER i;
- OPM_WriteString((CHAR*)"/* ", (LONGINT)4);
- OPM_WriteString((CHAR*)"voc", (LONGINT)4);
+ INT16 i;
+ OPM_WriteString((CHAR*)"/* ", 4);
+ OPM_WriteString((CHAR*)"voc", 4);
OPM_Write(' ');
- OPM_WriteString(Configuration_versionLong, ((LONGINT)(41)));
+ OPM_WriteString(Configuration_versionLong, 75);
OPM_Write(' ');
i = 0;
while (i <= 31) {
- if (__IN(i, OPM_glbopt)) {
+ if (__IN(i, OPM_Options, 32)) {
switch (i) {
case 0:
OPM_Write('x');
@@ -1233,9 +1159,6 @@ static void OPC_GenHeaderMsg (void)
case 5:
OPM_Write('p');
break;
- case 6:
- OPM_Write('k');
- break;
case 7:
OPM_Write('a');
break;
@@ -1264,14 +1187,14 @@ static void OPC_GenHeaderMsg (void)
OPM_Write('v');
break;
default:
- OPM_LogWStr((CHAR*)"( more options defined in OPM than checked in OPC.GenHeaderMsg, if you are a compiler developer, add them to OPC.GenHeaderMsg", (LONGINT)126);
+ OPM_LogWStr((CHAR*)"( more options defined in OPM than checked in OPC.GenHeaderMsg, if you are a compiler developer, add them to OPC.GenHeaderMsg", 126);
OPM_LogWLn();
break;
}
}
i += 1;
}
- OPM_WriteString((CHAR*)" */", (LONGINT)4);
+ OPM_WriteString((CHAR*)" */", 4);
OPM_WriteLn();
}
@@ -1280,20 +1203,16 @@ void OPC_GenHdrIncludes (void)
OPM_currFile = 2;
OPC_GenHeaderMsg();
OPM_WriteLn();
- OPM_WriteString((CHAR*)"#ifndef ", (LONGINT)9);
- OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32)));
- OPM_WriteString((CHAR*)"__h", (LONGINT)4);
+ OPM_WriteString((CHAR*)"#ifndef ", 9);
+ OPM_WriteStringVar((void*)OPM_modName, 32);
+ OPM_WriteString((CHAR*)"__h", 4);
OPM_WriteLn();
- OPM_WriteString((CHAR*)"#define ", (LONGINT)9);
- OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32)));
- OPM_WriteString((CHAR*)"__h", (LONGINT)4);
+ OPM_WriteString((CHAR*)"#define ", 9);
+ OPM_WriteStringVar((void*)OPM_modName, 32);
+ OPM_WriteString((CHAR*)"__h", 4);
OPM_WriteLn();
OPM_WriteLn();
- if (OPM_LIntSize == 8) {
- OPM_WriteString((CHAR*)"#define LARGE", (LONGINT)14);
- OPM_WriteLn();
- }
- OPC_Include((CHAR*)"SYSTEM", (LONGINT)7);
+ OPC_Include((CHAR*)"SYSTEM", 7);
OPC_IncludeImports(OPT_topScope->right, 1);
OPM_WriteLn();
}
@@ -1302,11 +1221,21 @@ void OPC_GenBdy (OPT_Node n)
{
OPM_currFile = 1;
OPC_GenHeaderMsg();
- if (OPM_LIntSize == 8) {
- OPM_WriteString((CHAR*)"#define LARGE", (LONGINT)14);
- OPM_WriteLn();
- }
- OPC_Include((CHAR*)"SYSTEM", (LONGINT)7);
+ OPM_WriteLn();
+ OPM_WriteString((CHAR*)"#define SHORTINT INT", 21);
+ OPM_WriteInt(__ASHL(OPT_sinttyp->size, 3));
+ OPM_WriteLn();
+ OPM_WriteString((CHAR*)"#define INTEGER INT", 21);
+ OPM_WriteInt(__ASHL(OPT_inttyp->size, 3));
+ OPM_WriteLn();
+ OPM_WriteString((CHAR*)"#define LONGINT INT", 21);
+ OPM_WriteInt(__ASHL(OPT_linttyp->size, 3));
+ OPM_WriteLn();
+ OPM_WriteString((CHAR*)"#define SET UINT", 22);
+ OPM_WriteInt(__ASHL(OPT_settyp->size, 3));
+ OPM_WriteLn();
+ OPM_WriteLn();
+ OPC_Include((CHAR*)"SYSTEM", 7);
OPC_IncludeImports(OPT_topScope->right, 0);
OPM_WriteLn();
OPC_DefAnonRecs(n);
@@ -1329,9 +1258,9 @@ static void OPC_RegCmds (OPT_Object obj)
if ((obj->mode == 7 && obj->history != 4)) {
if ((((obj->vis != 0 && obj->link == NIL)) && obj->typ == OPT_notyp)) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"__REGCMD(\"", (LONGINT)11);
- OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"\", ", (LONGINT)4);
+ OPM_WriteString((CHAR*)"__REGCMD(\"", 11);
+ OPM_WriteStringVar((void*)obj->name, 256);
+ OPM_WriteString((CHAR*)"\", ", 4);
OPC_Ident(obj);
OPM_Write(')');
OPC_EndStat();
@@ -1347,8 +1276,8 @@ static void OPC_InitImports (OPT_Object obj)
OPC_InitImports(obj->left);
if ((obj->mode == 11 && obj->mnolev != 0)) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"__MODULE_IMPORT(", (LONGINT)17);
- OPM_WriteStringVar((void*)OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, ((LONGINT)(256)));
+ OPM_WriteString((CHAR*)"__MODULE_IMPORT(", 17);
+ OPM_WriteStringVar((void*)OPT_GlbMod[__X(-obj->mnolev, 64)]->name, 256);
OPM_Write(')');
OPC_EndStat();
}
@@ -1359,38 +1288,30 @@ static void OPC_InitImports (OPT_Object obj)
void OPC_GenEnumPtrs (OPT_Object var)
{
OPT_Struct typ = NIL;
- LONGINT n;
+ INT32 n;
OPC_GlbPtrs = 0;
while (var != NIL) {
typ = var->typ;
if (OPC_NofPtrs(typ) > 0) {
if (!OPC_GlbPtrs) {
OPC_GlbPtrs = 1;
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
- if (OPC_ansi) {
- OPM_WriteString((CHAR*)"void EnumPtrs(void (*P)(void*))", (LONGINT)32);
- } else {
- OPM_WriteString((CHAR*)"void EnumPtrs(P)", (LONGINT)17);
- OPM_WriteLn();
- OPM_Write(0x09);
- OPM_WriteString((CHAR*)"void (*P)();", (LONGINT)13);
- }
+ OPM_WriteString((CHAR*)"static void EnumPtrs(void (*P)(void*))", 39);
OPM_WriteLn();
OPC_BegBlk();
}
OPC_BegStat();
- if (typ->form == 13) {
- OPM_WriteString((CHAR*)"P(", (LONGINT)3);
+ if (typ->form == 11) {
+ OPM_WriteString((CHAR*)"P(", 3);
OPC_Ident(var);
OPM_Write(')');
} else if (typ->comp == 4) {
- OPM_WriteString((CHAR*)"__ENUMR(&", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__ENUMR(&", 10);
OPC_Ident(var);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
- OPC_Str1((CHAR*)", #", (LONGINT)4, typ->size);
- OPM_WriteString((CHAR*)", 1, P)", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__typ", 6);
+ OPC_Str1((CHAR*)", #", 4, typ->size);
+ OPM_WriteString((CHAR*)", 1, P)", 8);
} else if (typ->comp == 2) {
n = typ->n;
typ = typ->BaseTyp;
@@ -1398,18 +1319,18 @@ void OPC_GenEnumPtrs (OPT_Object var)
n = n * typ->n;
typ = typ->BaseTyp;
}
- if (typ->form == 13) {
- OPM_WriteString((CHAR*)"__ENUMP(", (LONGINT)9);
+ if (typ->form == 11) {
+ OPM_WriteString((CHAR*)"__ENUMP(", 9);
OPC_Ident(var);
- OPC_Str1((CHAR*)", #, P)", (LONGINT)8, n);
+ OPC_Str1((CHAR*)", #, P)", 8, n);
} else if (typ->comp == 4) {
- OPM_WriteString((CHAR*)"__ENUMR(", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__ENUMR(", 9);
OPC_Ident(var);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
- OPC_Str1((CHAR*)", #", (LONGINT)4, typ->size);
- OPC_Str1((CHAR*)", #, P)", (LONGINT)8, n);
+ OPM_WriteString((CHAR*)"__typ", 6);
+ OPC_Str1((CHAR*)", #", 4, typ->size);
+ OPC_Str1((CHAR*)", #, P)", 8, n);
}
}
OPC_EndStat();
@@ -1425,49 +1346,41 @@ void OPC_GenEnumPtrs (OPT_Object var)
void OPC_EnterBody (void)
{
OPM_WriteLn();
- OPM_WriteString((CHAR*)"export ", (LONGINT)8);
- if (OPC_mainprog) {
- if (OPC_ansi) {
- OPM_WriteString((CHAR*)"int main(int argc, char **argv)", (LONGINT)32);
- OPM_WriteLn();
- } else {
- OPM_WriteString((CHAR*)"main(argc, argv)", (LONGINT)17);
- OPM_WriteLn();
- OPM_Write(0x09);
- OPM_WriteString((CHAR*)"int argc; char **argv;", (LONGINT)23);
- OPM_WriteLn();
- }
+ OPM_WriteString((CHAR*)"export ", 8);
+ if (__IN(10, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"int main(int argc, char **argv)", 32);
+ OPM_WriteLn();
} else {
- OPM_WriteString((CHAR*)"void *", (LONGINT)7);
- OPM_WriteString(OPM_modName, ((LONGINT)(32)));
- OPM_WriteString(OPC_BodyNameExt, ((LONGINT)(13)));
+ OPM_WriteString((CHAR*)"void *", 7);
+ OPM_WriteString(OPM_modName, 32);
+ OPM_WriteString(OPC_BodyNameExt, 13);
OPM_WriteLn();
}
OPC_BegBlk();
OPC_BegStat();
- if (OPC_mainprog) {
- OPM_WriteString((CHAR*)"__INIT(argc, argv)", (LONGINT)19);
+ if (__IN(10, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__INIT(argc, argv)", 19);
} else {
- OPM_WriteString((CHAR*)"__DEFMOD", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__DEFMOD", 9);
}
OPC_EndStat();
- if ((OPC_mainprog && 0)) {
+ if ((__IN(10, OPM_Options, 32) && 0)) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"/*don`t do it!*/ printf(\"DEMO VERSION: DO NOT USE THIS PROGRAM FOR ANY COMMERCIAL PURPOSE\\n\")", (LONGINT)94);
+ OPM_WriteString((CHAR*)"/*don`t do it!*/ printf(\"DEMO VERSION: DO NOT USE THIS PROGRAM FOR ANY COMMERCIAL PURPOSE\\n\")", 94);
OPC_EndStat();
}
OPC_InitImports(OPT_topScope->right);
OPC_BegStat();
- if (OPC_mainprog) {
- OPM_WriteString((CHAR*)"__REGMAIN(\"", (LONGINT)12);
+ if (__IN(10, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__REGMAIN(\"", 12);
} else {
- OPM_WriteString((CHAR*)"__REGMOD(\"", (LONGINT)11);
+ OPM_WriteString((CHAR*)"__REGMOD(\"", 11);
}
- OPM_WriteString(OPM_modName, ((LONGINT)(32)));
+ OPM_WriteString(OPM_modName, 32);
if (OPC_GlbPtrs) {
- OPM_WriteString((CHAR*)"\", EnumPtrs)", (LONGINT)13);
+ OPM_WriteString((CHAR*)"\", EnumPtrs)", 13);
} else {
- OPM_WriteString((CHAR*)"\", 0)", (LONGINT)6);
+ OPM_WriteString((CHAR*)"\", 0)", 6);
}
OPC_EndStat();
if (__STRCMP(OPM_modName, "SYSTEM") != 0) {
@@ -1478,10 +1391,10 @@ void OPC_EnterBody (void)
void OPC_ExitBody (void)
{
OPC_BegStat();
- if (OPC_mainprog) {
- OPM_WriteString((CHAR*)"__FINI;", (LONGINT)8);
+ if (__IN(10, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__FINI;", 8);
} else {
- OPM_WriteString((CHAR*)"__ENDMOD;", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__ENDMOD;", 10);
}
OPM_WriteLn();
OPC_EndBlk();
@@ -1491,55 +1404,60 @@ void OPC_DefineInter (OPT_Object proc)
{
OPT_Object scope = NIL;
scope = proc->scope;
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
- OPM_WriteString((CHAR*)"struct ", (LONGINT)8);
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
+ OPM_WriteString((CHAR*)"static ", 8);
+ OPM_WriteString((CHAR*)"struct ", 8);
+ OPM_WriteStringVar((void*)scope->name, 256);
OPM_Write(' ');
OPC_BegBlk();
OPC_IdentList(proc->link, 3);
OPC_IdentList(scope->scope, 3);
OPC_BegStat();
- OPM_WriteString((CHAR*)"struct ", (LONGINT)8);
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
+ OPM_WriteString((CHAR*)"struct ", 8);
+ OPM_WriteStringVar((void*)scope->name, 256);
OPM_Write(' ');
OPM_Write('*');
- OPM_WriteString((CHAR*)"lnk", (LONGINT)4);
+ OPM_WriteString((CHAR*)"lnk", 4);
OPC_EndStat();
OPC_EndBlk0();
OPM_Write(' ');
OPM_Write('*');
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteStringVar((void*)scope->name, 256);
+ OPM_WriteString((CHAR*)"_s", 3);
OPC_EndStat();
OPM_WriteLn();
OPC_ProcPredefs(scope->right, 0);
OPM_WriteLn();
}
+BOOLEAN OPC_NeedsRetval (OPT_Object proc)
+{
+ return (proc->typ != OPT_notyp && !proc->scope->leaf);
+}
+
void OPC_EnterProc (OPT_Object proc)
{
OPT_Object var = NIL, scope = NIL;
OPT_Struct typ = NIL;
- INTEGER dim;
+ INT16 dim;
if (proc->vis != 1) {
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"static ", 8);
}
OPC_ProcHeader(proc, 1);
OPC_BegBlk();
- if (proc->typ != OPT_notyp) {
- OPC_BegStat();
- OPC_Ident(proc->typ->strobj);
- OPM_WriteString((CHAR*)" _o_result;", (LONGINT)12);
- OPM_WriteLn();
- }
scope = proc->scope;
OPC_IdentList(scope->scope, 0);
if (!scope->leaf) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"struct ", (LONGINT)8);
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
+ OPM_WriteString((CHAR*)"struct ", 8);
+ OPM_WriteStringVar((void*)scope->name, 256);
OPM_Write(' ');
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"_s", 3);
+ OPC_EndStat();
+ }
+ if (OPC_NeedsRetval(proc)) {
+ OPC_BegStat();
+ OPC_Ident(proc->typ->strobj);
+ OPM_WriteString((CHAR*)" __retval", 10);
OPC_EndStat();
}
var = proc->link;
@@ -1553,56 +1471,41 @@ void OPC_EnterProc (OPT_Object proc)
}
OPM_Write(' ');
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__copy", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__copy", 7);
OPC_EndStat();
}
var = var->link;
}
- if (!OPC_ansi) {
- var = proc->link;
- while (var != NIL) {
- if ((var->typ->form == 7 && var->mode == 1)) {
- OPC_BegStat();
- OPC_Ident(var->typ->strobj);
- OPM_Write(' ');
- OPC_Ident(var);
- OPM_WriteString((CHAR*)" = _", (LONGINT)5);
- OPC_Ident(var);
- OPC_EndStat();
- }
- var = var->link;
- }
- }
var = proc->link;
while (var != NIL) {
- if ((((__IN(var->typ->comp, 0x0c) && var->mode == 1)) && var->typ->sysflag == 0)) {
+ if ((((__IN(var->typ->comp, 0x0c, 32) && var->mode == 1)) && var->typ->sysflag == 0)) {
OPC_BegStat();
if (var->typ->comp == 2) {
- OPM_WriteString((CHAR*)"__DUPARR(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__DUPARR(", 10);
OPC_Ident(var);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
if (var->typ->strobj == NIL) {
OPM_Mark(200, var->typ->txtpos);
} else {
OPC_Ident(var->typ->strobj);
}
} else {
- OPM_WriteString((CHAR*)"__DUP(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__DUP(", 7);
OPC_Ident(var);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
typ = var->typ->BaseTyp;
dim = 1;
while (typ->comp == 3) {
- OPM_WriteString((CHAR*)" * ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" * ", 4);
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
OPM_WriteInt(dim);
typ = typ->BaseTyp;
dim += 1;
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
if (typ->strobj == NIL) {
OPM_Mark(200, typ->txtpos);
} else {
@@ -1619,12 +1522,12 @@ void OPC_EnterProc (OPT_Object proc)
while (var != NIL) {
if (!var->leaf) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
OPC_Ident(var);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
- if (__IN(var->typ->comp, 0x0c)) {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
+ OPM_WriteString((CHAR*)" = ", 4);
+ if (__IN(var->typ->comp, 0x0c, 32)) {
+ OPM_WriteString((CHAR*)"(void*)", 8);
} else if (var->mode != 2) {
OPM_Write('&');
}
@@ -1633,31 +1536,31 @@ void OPC_EnterProc (OPT_Object proc)
typ = var->typ;
dim = 0;
do {
- OPM_WriteString((CHAR*)"; ", (LONGINT)3);
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"; ", 3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
if (dim != 0) {
OPM_WriteInt(dim);
}
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" = ", 4);
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
if (dim != 0) {
OPM_WriteInt(dim);
}
typ = typ->BaseTyp;
} while (!(typ->comp != 3));
} else if ((var->mode == 2 && var->typ->comp == 4)) {
- OPM_WriteString((CHAR*)"; ", (LONGINT)3);
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"; ", 3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteString((CHAR*)"__typ", 6);
+ OPM_WriteString((CHAR*)" = ", 4);
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
}
OPC_EndStat();
}
@@ -1667,14 +1570,14 @@ void OPC_EnterProc (OPT_Object proc)
while (var != NIL) {
if (!var->leaf) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
OPC_Ident(var);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" = ", 4);
if (var->typ->comp != 2) {
OPM_Write('&');
} else {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
+ OPM_WriteString((CHAR*)"(void*)", 8);
}
OPC_Ident(var);
OPC_EndStat();
@@ -1682,19 +1585,19 @@ void OPC_EnterProc (OPT_Object proc)
var = var->link;
}
OPC_BegStat();
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
- OPM_WriteString((CHAR*)"lnk", (LONGINT)4);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"lnk", 4);
+ OPM_WriteString((CHAR*)" = ", 4);
+ OPM_WriteStringVar((void*)scope->name, 256);
+ OPM_WriteString((CHAR*)"_s", 3);
OPC_EndStat();
OPC_BegStat();
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteStringVar((void*)scope->name, 256);
+ OPM_WriteString((CHAR*)"_s", 3);
+ OPM_WriteString((CHAR*)" = ", 4);
OPM_Write('&');
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPC_EndStat();
}
}
@@ -1706,7 +1609,7 @@ void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet)
indent = eoBlock;
if ((implicitRet && proc->typ != OPT_notyp)) {
OPM_Write(0x09);
- OPM_WriteString((CHAR*)"__RETCHK;", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__RETCHK;", 10);
OPM_WriteLn();
} else if (!eoBlock || implicitRet) {
if (!proc->scope->leaf) {
@@ -1715,12 +1618,12 @@ void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet)
} else {
indent = 1;
}
- OPM_WriteStringVar((void*)proc->scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteStringVar((void*)proc->scope->name, 256);
+ OPM_WriteString((CHAR*)"_s", 3);
+ OPM_WriteString((CHAR*)" = ", 4);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
- OPM_WriteString((CHAR*)"lnk", (LONGINT)4);
+ OPM_WriteString((CHAR*)"lnk", 4);
OPC_EndStat();
}
var = proc->link;
@@ -1731,7 +1634,7 @@ void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet)
} else {
indent = 1;
}
- OPM_WriteString((CHAR*)"__DEL(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__DEL(", 7);
OPC_Ident(var);
OPM_Write(')');
OPC_EndStat();
@@ -1749,14 +1652,14 @@ void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet)
void OPC_CompleteIdent (OPT_Object obj)
{
- INTEGER comp, level;
+ INT16 comp, level;
level = obj->mnolev;
if (obj->adr == 1) {
if (obj->typ->comp == 4) {
OPC_Ident(obj);
- OPM_WriteString((CHAR*)"__", (LONGINT)3);
+ OPM_WriteString((CHAR*)"__", 3);
} else {
- OPM_WriteString((CHAR*)"((", (LONGINT)3);
+ OPM_WriteString((CHAR*)"((", 3);
OPC_Ident(obj->typ->strobj);
OPM_Write(')');
OPC_Ident(obj);
@@ -1767,9 +1670,9 @@ void OPC_CompleteIdent (OPT_Object obj)
if ((obj->mode != 2 && comp != 3)) {
OPM_Write('*');
}
- OPM_WriteStringVar((void*)obj->scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
- OPM_WriteString((CHAR*)"->", (LONGINT)3);
+ OPM_WriteStringVar((void*)obj->scope->name, 256);
+ OPM_WriteString((CHAR*)"_s", 3);
+ OPM_WriteString((CHAR*)"->", 3);
OPC_Ident(obj);
} else {
OPC_Ident(obj);
@@ -1778,58 +1681,58 @@ void OPC_CompleteIdent (OPT_Object obj)
void OPC_TypeOf (OPT_Object ap)
{
- INTEGER i;
+ INT16 i;
__ASSERT(ap->typ->comp == 4, 0);
if (ap->mode == 2) {
- if ((int)ap->mnolev != OPM_level) {
- OPM_WriteStringVar((void*)ap->scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s->", (LONGINT)5);
+ if ((INT16)ap->mnolev != OPM_level) {
+ OPM_WriteStringVar((void*)ap->scope->name, 256);
+ OPM_WriteString((CHAR*)"_s->", 5);
OPC_Ident(ap);
} else {
OPC_Ident(ap);
}
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
} else if (ap->typ->strobj != NIL) {
OPC_Ident(ap->typ->strobj);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
} else {
OPC_Andent(ap->typ);
}
}
-void OPC_Cmp (INTEGER rel)
+void OPC_Cmp (INT16 rel)
{
switch (rel) {
case 9:
- OPM_WriteString((CHAR*)" == ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" == ", 5);
break;
case 10:
- OPM_WriteString((CHAR*)" != ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" != ", 5);
break;
case 11:
- OPM_WriteString((CHAR*)" < ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" < ", 4);
break;
case 12:
- OPM_WriteString((CHAR*)" <= ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" <= ", 5);
break;
case 13:
- OPM_WriteString((CHAR*)" > ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" > ", 4);
break;
case 14:
- OPM_WriteString((CHAR*)" >= ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" >= ", 5);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPC.Cmp, rel = ", (LONGINT)34);
- OPM_LogWNum(rel, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPC.Cmp, rel = ", 34);
+ OPM_LogWNum(rel, 0);
OPM_LogWLn();
break;
}
}
-static void OPC_CharacterLiteral (LONGINT c)
+static void OPC_CharacterLiteral (INT64 c)
{
if (c < 32 || c > 126) {
- OPM_WriteString((CHAR*)"0x", (LONGINT)3);
+ OPM_WriteString((CHAR*)"0x", 3);
OPM_WriteHex(c);
} else {
OPM_Write('\'');
@@ -1841,15 +1744,15 @@ static void OPC_CharacterLiteral (LONGINT c)
}
}
-static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l)
+static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l)
{
- LONGINT i;
- INTEGER c;
+ INT32 i;
+ INT16 c;
__DUP(s, s__len, CHAR);
OPM_Write('"');
i = 0;
while (i < l) {
- c = (int)s[__X(i, s__len)];
+ c = (INT16)s[__X(i, s__len)];
if (c < 32 || c > 126) {
OPM_Write('\\');
OPM_Write((CHAR)(48 + __ASHR(c, 6)));
@@ -1869,54 +1772,67 @@ static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l)
__DEL(s);
}
-void OPC_Case (LONGINT caseVal, INTEGER form)
+void OPC_Case (INT64 caseVal, INT16 form)
{
CHAR ch;
- OPM_WriteString((CHAR*)"case ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"case ", 6);
switch (form) {
case 3:
OPC_CharacterLiteral(caseVal);
break;
- case 4: case 5: case 6:
+ case 4:
OPM_WriteInt(caseVal);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPC.Case, form = ", (LONGINT)36);
- OPM_LogWNum(form, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPC.Case, form = ", 36);
+ OPM_LogWNum(form, 0);
OPM_LogWLn();
break;
}
- OPM_WriteString((CHAR*)": ", (LONGINT)3);
+ OPM_WriteString((CHAR*)": ", 3);
}
void OPC_SetInclude (BOOLEAN exclude)
{
if (exclude) {
- OPM_WriteString((CHAR*)" &= ~", (LONGINT)6);
+ OPM_WriteString((CHAR*)" &= ~", 6);
} else {
- OPM_WriteString((CHAR*)" |= ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" |= ", 5);
}
}
void OPC_Increment (BOOLEAN decrement)
{
if (decrement) {
- OPM_WriteString((CHAR*)" -= ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" -= ", 5);
} else {
- OPM_WriteString((CHAR*)" += ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" += ", 5);
}
}
-void OPC_Halt (LONGINT n)
+void OPC_Halt (INT32 n)
{
- OPC_Str1((CHAR*)"__HALT(#)", (LONGINT)10, n);
+ OPC_Str1((CHAR*)"__HALT(#)", 10, n);
}
-void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim)
+void OPC_IntLiteral (INT64 n, INT32 size)
+{
+ if ((((size > 4 && n <= 2147483647)) && n > (-2147483647-1))) {
+ OPM_WriteString((CHAR*)"((INT", 6);
+ OPM_WriteInt(__ASHL(size, 3));
+ OPM_WriteString((CHAR*)")(", 3);
+ OPM_WriteInt(n);
+ OPM_WriteString((CHAR*)"))", 3);
+ } else {
+ OPM_WriteInt(n);
+ }
+}
+
+void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim)
{
if (array->comp == 3) {
OPC_CompleteIdent(obj);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
if (dim != 0) {
OPM_WriteInt(dim);
}
@@ -1925,17 +1841,15 @@ void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim)
array = array->BaseTyp;
dim -= 1;
}
- OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12);
OPM_WriteInt(array->n);
- OPM_WriteString((CHAR*)"))", (LONGINT)3);
}
}
-void OPC_Constant (OPT_Const con, INTEGER form)
+void OPC_Constant (OPT_Const con, INT16 form)
{
- INTEGER i;
- SET s;
- LONGINT hex;
+ INT16 i;
+ UINT64 s;
+ INT64 hex;
BOOLEAN skipLeading;
switch (form) {
case 1:
@@ -1947,26 +1861,26 @@ void OPC_Constant (OPT_Const con, INTEGER form)
case 3:
OPC_CharacterLiteral(con->intval);
break;
- case 4: case 5: case 6:
+ case 4:
OPM_WriteInt(con->intval);
break;
- case 7:
+ case 5:
OPM_WriteReal(con->realval, 'f');
break;
- case 8:
+ case 6:
OPM_WriteReal(con->realval, 0x00);
break;
- case 9:
- OPM_WriteString((CHAR*)"0x", (LONGINT)3);
+ case 7:
+ OPM_WriteString((CHAR*)"0x", 3);
skipLeading = 1;
s = con->setval;
- i = 32;
+ i = 64;
do {
hex = 0;
do {
i -= 1;
hex = __ASHL(hex, 1);
- if (__IN(i, s)) {
+ if (__IN(i, s, 64)) {
hex += 1;
}
} while (!(__MASK(i, -8) == 0));
@@ -1979,88 +1893,98 @@ void OPC_Constant (OPT_Const con, INTEGER form)
OPM_Write('0');
}
break;
- case 10:
- OPC_StringLiteral(*con->ext, ((LONGINT)(256)), con->intval2 - 1);
+ case 8:
+ OPC_StringLiteral(*con->ext, 256, con->intval2 - 1);
break;
- case 11:
- OPM_WriteString((CHAR*)"NIL", (LONGINT)4);
+ case 9:
+ OPM_WriteString((CHAR*)"NIL", 4);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPC.Constant, form = ", (LONGINT)40);
- OPM_LogWNum(form, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPC.Constant, form = ", 40);
+ OPM_LogWNum(form, 0);
OPM_LogWLn();
break;
}
}
-static struct InitKeywords__48 {
- SHORTINT *n;
- struct InitKeywords__48 *lnk;
-} *InitKeywords__48_s;
+static struct InitKeywords__46 {
+ INT8 *n;
+ struct InitKeywords__46 *lnk;
+} *InitKeywords__46_s;
-static void Enter__49 (CHAR *s, LONGINT s__len);
+static void Enter__47 (CHAR *s, LONGINT s__len);
-static void Enter__49 (CHAR *s, LONGINT s__len)
+static void Enter__47 (CHAR *s, LONGINT s__len)
{
- INTEGER h;
+ INT16 h;
__DUP(s, s__len, CHAR);
h = OPC_PerfectHash((void*)s, s__len);
- OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__48_s->n;
- __COPY(s, OPC_keytab[__X(*InitKeywords__48_s->n, ((LONGINT)(36)))], ((LONGINT)(9)));
- *InitKeywords__48_s->n += 1;
+ OPC_hashtab[__X(h, 105)] = *InitKeywords__46_s->n;
+ __COPY(s, OPC_keytab[__X(*InitKeywords__46_s->n, 50)], 9);
+ *InitKeywords__46_s->n += 1;
__DEL(s);
}
static void OPC_InitKeywords (void)
{
- SHORTINT n, i;
- struct InitKeywords__48 _s;
+ INT8 n, i;
+ struct InitKeywords__46 _s;
_s.n = &n;
- _s.lnk = InitKeywords__48_s;
- InitKeywords__48_s = &_s;
+ _s.lnk = InitKeywords__46_s;
+ InitKeywords__46_s = &_s;
n = 0;
i = 0;
while (i <= 104) {
- OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1;
+ OPC_hashtab[__X(i, 105)] = -1;
i += 1;
}
- Enter__49((CHAR*)"asm", (LONGINT)4);
- Enter__49((CHAR*)"auto", (LONGINT)5);
- Enter__49((CHAR*)"break", (LONGINT)6);
- Enter__49((CHAR*)"case", (LONGINT)5);
- Enter__49((CHAR*)"char", (LONGINT)5);
- Enter__49((CHAR*)"const", (LONGINT)6);
- Enter__49((CHAR*)"continue", (LONGINT)9);
- Enter__49((CHAR*)"default", (LONGINT)8);
- Enter__49((CHAR*)"do", (LONGINT)3);
- Enter__49((CHAR*)"double", (LONGINT)7);
- Enter__49((CHAR*)"else", (LONGINT)5);
- Enter__49((CHAR*)"enum", (LONGINT)5);
- Enter__49((CHAR*)"extern", (LONGINT)7);
- Enter__49((CHAR*)"export", (LONGINT)7);
- Enter__49((CHAR*)"float", (LONGINT)6);
- Enter__49((CHAR*)"for", (LONGINT)4);
- Enter__49((CHAR*)"fortran", (LONGINT)8);
- Enter__49((CHAR*)"goto", (LONGINT)5);
- Enter__49((CHAR*)"if", (LONGINT)3);
- Enter__49((CHAR*)"import", (LONGINT)7);
- Enter__49((CHAR*)"int", (LONGINT)4);
- Enter__49((CHAR*)"long", (LONGINT)5);
- Enter__49((CHAR*)"register", (LONGINT)9);
- Enter__49((CHAR*)"return", (LONGINT)7);
- Enter__49((CHAR*)"short", (LONGINT)6);
- Enter__49((CHAR*)"signed", (LONGINT)7);
- Enter__49((CHAR*)"sizeof", (LONGINT)7);
- Enter__49((CHAR*)"static", (LONGINT)7);
- Enter__49((CHAR*)"struct", (LONGINT)7);
- Enter__49((CHAR*)"switch", (LONGINT)7);
- Enter__49((CHAR*)"typedef", (LONGINT)8);
- Enter__49((CHAR*)"union", (LONGINT)6);
- Enter__49((CHAR*)"unsigned", (LONGINT)9);
- Enter__49((CHAR*)"void", (LONGINT)5);
- Enter__49((CHAR*)"volatile", (LONGINT)9);
- Enter__49((CHAR*)"while", (LONGINT)6);
- InitKeywords__48_s = _s.lnk;
+ Enter__47((CHAR*)"ADDRESS", 8);
+ Enter__47((CHAR*)"INT16", 6);
+ Enter__47((CHAR*)"INT32", 6);
+ Enter__47((CHAR*)"INT64", 6);
+ Enter__47((CHAR*)"INT8", 5);
+ Enter__47((CHAR*)"UINT16", 7);
+ Enter__47((CHAR*)"UINT32", 7);
+ Enter__47((CHAR*)"UINT64", 7);
+ Enter__47((CHAR*)"UINT8", 6);
+ Enter__47((CHAR*)"asm", 4);
+ Enter__47((CHAR*)"auto", 5);
+ Enter__47((CHAR*)"break", 6);
+ Enter__47((CHAR*)"case", 5);
+ Enter__47((CHAR*)"char", 5);
+ Enter__47((CHAR*)"const", 6);
+ Enter__47((CHAR*)"continue", 9);
+ Enter__47((CHAR*)"default", 8);
+ Enter__47((CHAR*)"do", 3);
+ Enter__47((CHAR*)"double", 7);
+ Enter__47((CHAR*)"else", 5);
+ Enter__47((CHAR*)"enum", 5);
+ Enter__47((CHAR*)"extern", 7);
+ Enter__47((CHAR*)"export", 7);
+ Enter__47((CHAR*)"float", 6);
+ Enter__47((CHAR*)"for", 4);
+ Enter__47((CHAR*)"fortran", 8);
+ Enter__47((CHAR*)"goto", 5);
+ Enter__47((CHAR*)"if", 3);
+ Enter__47((CHAR*)"import", 7);
+ Enter__47((CHAR*)"int", 4);
+ Enter__47((CHAR*)"long", 5);
+ Enter__47((CHAR*)"register", 9);
+ Enter__47((CHAR*)"return", 7);
+ Enter__47((CHAR*)"short", 6);
+ Enter__47((CHAR*)"signed", 7);
+ Enter__47((CHAR*)"sizeof", 7);
+ Enter__47((CHAR*)"size_t", 7);
+ Enter__47((CHAR*)"static", 7);
+ Enter__47((CHAR*)"struct", 7);
+ Enter__47((CHAR*)"switch", 7);
+ Enter__47((CHAR*)"typedef", 8);
+ Enter__47((CHAR*)"union", 6);
+ Enter__47((CHAR*)"unsigned", 9);
+ Enter__47((CHAR*)"void", 5);
+ Enter__47((CHAR*)"volatile", 9);
+ Enter__47((CHAR*)"while", 6);
+ InitKeywords__46_s = _s.lnk;
}
diff --git a/bootstrap/unix-48/OPC.h b/bootstrap/unix-48/OPC.h
index b7d34a07..842e7dec 100644
--- a/bootstrap/unix-48/OPC.h
+++ b/bootstrap/unix-48/OPC.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPC__h
#define OPC__h
@@ -9,16 +9,14 @@
-import void OPC_Align (LONGINT *adr, LONGINT base);
import void OPC_Andent (OPT_Struct typ);
-import LONGINT OPC_BaseAlignment (OPT_Struct typ);
import OPT_Object OPC_BaseTProc (OPT_Object obj);
import void OPC_BegBlk (void);
import void OPC_BegStat (void);
-import void OPC_Case (LONGINT caseVal, INTEGER form);
-import void OPC_Cmp (INTEGER rel);
+import void OPC_Case (INT64 caseVal, INT16 form);
+import void OPC_Cmp (INT16 rel);
import void OPC_CompleteIdent (OPT_Object obj);
-import void OPC_Constant (OPT_Const con, INTEGER form);
+import void OPC_Constant (OPT_Const con, INT16 form);
import void OPC_DefineInter (OPT_Object proc);
import void OPC_EndBlk (void);
import void OPC_EndBlk0 (void);
@@ -31,20 +29,21 @@ import void OPC_GenBdy (OPT_Node n);
import void OPC_GenEnumPtrs (OPT_Object var);
import void OPC_GenHdr (OPT_Node n);
import void OPC_GenHdrIncludes (void);
-import void OPC_Halt (LONGINT n);
+import void OPC_Halt (INT32 n);
import void OPC_Ident (OPT_Object obj);
import void OPC_Increment (BOOLEAN decrement);
-import void OPC_Indent (INTEGER count);
+import void OPC_Indent (INT16 count);
import void OPC_Init (void);
import void OPC_InitTDesc (OPT_Struct typ);
-import void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim);
-import LONGINT OPC_NofPtrs (OPT_Struct typ);
+import void OPC_IntLiteral (INT64 n, INT32 size);
+import void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim);
+import BOOLEAN OPC_NeedsRetval (OPT_Object proc);
+import INT32 OPC_NofPtrs (OPT_Struct typ);
import void OPC_SetInclude (BOOLEAN exclude);
-import LONGINT OPC_SizeAlignment (LONGINT size);
import void OPC_TDescDecl (OPT_Struct typ);
-import void OPC_TypeDefs (OPT_Object obj, INTEGER vis);
+import void OPC_TypeDefs (OPT_Object obj, INT16 vis);
import void OPC_TypeOf (OPT_Object ap);
import void *OPC__init(void);
-#endif
+#endif // OPC
diff --git a/bootstrap/unix-48/OPM.c b/bootstrap/unix-48/OPM.c
index bf683e41..e76d763e 100644
--- a/bootstrap/unix-48/OPM.c
+++ b/bootstrap/unix-48/OPM.c
@@ -1,305 +1,474 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "Configuration.h"
-#include "Console.h"
#include "Files.h"
+#include "Out.h"
#include "Platform.h"
#include "Strings.h"
#include "Texts.h"
-#include "errors.h"
-#include "vt100.h"
+#include "VT100.h"
typedef
CHAR OPM_FileName[32];
static CHAR OPM_SourceFileName[256];
-export INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_MaxSet;
-export LONGINT OPM_MaxIndex;
+static CHAR OPM_GlobalModel[10];
+export CHAR OPM_Model[10];
+static INT16 OPM_GlobalAddressSize;
+export INT16 OPM_AddressSize;
+static INT16 OPM_GlobalAlignment;
+export INT16 OPM_Alignment;
+export UINT32 OPM_GlobalOptions, OPM_Options;
+export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize;
+export INT64 OPM_MaxIndex;
export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
export BOOLEAN OPM_noerr;
-export LONGINT OPM_curpos, OPM_errpos, OPM_breakpc;
-export INTEGER OPM_currFile, OPM_level, OPM_pc, OPM_entno;
+export INT32 OPM_curpos, OPM_errpos, OPM_breakpc;
+export INT16 OPM_currFile, OPM_level, OPM_pc, OPM_entno;
export CHAR OPM_modName[32];
export CHAR OPM_objname[64];
-export SET OPM_opt, OPM_glbopt;
-static LONGINT OPM_ErrorLineStartPos, OPM_ErrorLineLimitPos, OPM_ErrorLineNumber, OPM_lasterrpos;
+static INT32 OPM_ErrorLineStartPos, OPM_ErrorLineLimitPos, OPM_ErrorLineNumber, OPM_lasterrpos;
static Texts_Reader OPM_inR;
-static Texts_Text OPM_Log;
-static Texts_Writer OPM_W;
+static Texts_Text OPM_Log, OPM_Errors;
static Files_Rider OPM_oldSF, OPM_newSF;
static Files_Rider OPM_R[3];
static Files_File OPM_oldSFile, OPM_newSFile, OPM_HFile, OPM_BFile, OPM_HIFile;
-static INTEGER OPM_S;
-export BOOLEAN OPM_dontAsm, OPM_dontLink, OPM_mainProg, OPM_mainLinkStat, OPM_notColorOutput, OPM_forceNewSym, OPM_Verbose;
-static CHAR OPM_OBERON[1024];
-static CHAR OPM_MODULES[1024];
+static INT16 OPM_S;
+export CHAR OPM_ResourceDir[1024];
-static void OPM_Append (Files_Rider *R, LONGINT *R__typ, Files_File F);
+static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F);
export void OPM_CloseFiles (void);
export void OPM_CloseOldSym (void);
export void OPM_DeleteNewSym (void);
-export void OPM_FPrint (LONGINT *fp, LONGINT val);
-export void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr);
-export void OPM_FPrintReal (LONGINT *fp, REAL real);
-export void OPM_FPrintSet (LONGINT *fp, SET set);
-static void OPM_FindLine (Files_File f, Files_Rider *r, LONGINT *r__typ, LONGINT pos);
+export void OPM_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_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos);
+static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len);
export void OPM_Get (CHAR *ch);
-static void OPM_GetProperties (void);
-static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align);
export void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
export void OPM_InitOptions (void);
-static void OPM_LogErrMsg (INTEGER n);
+export INT16 OPM_Integer (INT64 n);
+static void OPM_LogErrMsg (INT16 n);
+export void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
export void OPM_LogW (CHAR ch);
export void OPM_LogWLn (void);
-export void OPM_LogWNum (LONGINT i, LONGINT len);
+export void OPM_LogWNum (INT64 i, INT64 len);
export void OPM_LogWStr (CHAR *s, LONGINT s__len);
+export INT32 OPM_Longint (INT64 n);
static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len);
-export void OPM_Mark (INTEGER n, LONGINT pos);
+export void OPM_Mark (INT16 n, INT32 pos);
export void OPM_NewSym (CHAR *modName, LONGINT modName__len);
export void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
export void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
export BOOLEAN OPM_OpenPar (void);
export void OPM_RegisterNewSym (void);
-static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt);
-static void OPM_ShowLine (LONGINT pos);
-export LONGINT OPM_SignedMaximum (LONGINT bytecount);
-export LONGINT OPM_SignedMinimum (LONGINT bytecount);
+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_SymRCh (CHAR *ch);
-export LONGINT OPM_SymRInt (void);
+export INT32 OPM_SymRInt (void);
+export INT64 OPM_SymRInt64 (void);
export void OPM_SymRLReal (LONGREAL *lr);
export void OPM_SymRReal (REAL *r);
-export void OPM_SymRSet (SET *s);
+export void OPM_SymRSet (UINT64 *s);
export void OPM_SymWCh (CHAR ch);
-export void OPM_SymWInt (LONGINT i);
+export void OPM_SymWInt (INT64 i);
export void OPM_SymWLReal (LONGREAL lr);
export void OPM_SymWReal (REAL r);
-export void OPM_SymWSet (SET s);
+export void OPM_SymWSet (UINT64 s);
static void OPM_VerboseListSizes (void);
export void OPM_Write (CHAR ch);
-export void OPM_WriteHex (LONGINT i);
-export void OPM_WriteInt (LONGINT i);
+export void OPM_WriteHex (INT64 i);
+export void OPM_WriteInt (INT64 i);
export void OPM_WriteLn (void);
export void OPM_WriteReal (LONGREAL r, CHAR suffx);
export void OPM_WriteString (CHAR *s, LONGINT s__len);
export void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
export BOOLEAN OPM_eofSF (void);
-export void OPM_err (INTEGER n);
-static LONGINT OPM_minusop (LONGINT i);
-static LONGINT OPM_power0 (LONGINT i, LONGINT j);
+export void OPM_err (INT16 n);
+#define OPM_GetAlignment(a) struct {char c; long long l;} _s; *a = (char*)&_s.l - (char*)&_s
void OPM_LogW (CHAR ch)
{
- Console_Char(ch);
+ Out_Char(ch);
}
void OPM_LogWStr (CHAR *s, LONGINT s__len)
{
__DUP(s, s__len, CHAR);
- Console_String(s, s__len);
+ Out_String(s, s__len);
__DEL(s);
}
-void OPM_LogWNum (LONGINT i, LONGINT len)
+void OPM_LogWNum (INT64 i, INT64 len)
{
- Console_Int(i, len);
+ Out_Int(i, len);
}
void OPM_LogWLn (void)
{
- Console_Ln();
+ Out_Ln();
}
-static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt)
+void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len)
{
- INTEGER i;
+ __DUP(vt100code, vt100code__len, CHAR);
+ if ((Out_IsConsole && !__IN(16, OPM_Options, 32))) {
+ VT100_SetAttr(vt100code, vt100code__len);
+ }
+ __DEL(vt100code);
+}
+
+INT64 OPM_SignedMaximum (INT32 bytecount)
+{
+ INT64 result;
+ result = 1;
+ result = __LSH(result, __ASHL(bytecount, 3) - 1, 64);
+ return result - 1;
+}
+
+INT64 OPM_SignedMinimum (INT32 bytecount)
+{
+ return -OPM_SignedMaximum(bytecount) - 1;
+}
+
+INT32 OPM_Longint (INT64 n)
+{
+ return __VAL(INT32, n);
+}
+
+INT16 OPM_Integer (INT64 n)
+{
+ return __VAL(INT16, n);
+}
+
+static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
+{
+ INT16 i;
+ __DUP(s, s__len, CHAR);
i = 1;
while (s[__X(i, s__len)] != 0x00) {
switch (s[__X(i, s__len)]) {
- case 'a':
- *opt = *opt ^ 0x80;
- break;
- case 'c':
- *opt = *opt ^ 0x4000;
- break;
- case 'e':
- *opt = *opt ^ 0x0200;
- break;
- case 'f':
- *opt = *opt ^ 0x010000;
- break;
- case 'k':
- *opt = *opt ^ 0x40;
- break;
- case 'm':
- *opt = *opt ^ 0x0400;
- break;
case 'p':
- *opt = *opt ^ 0x20;
+ OPM_Options = OPM_Options ^ 0x20;
+ break;
+ case 'a':
+ OPM_Options = OPM_Options ^ 0x80;
break;
case 'r':
- *opt = *opt ^ 0x04;
- break;
- case 's':
- *opt = *opt ^ 0x10;
+ OPM_Options = OPM_Options ^ 0x04;
break;
case 't':
- *opt = *opt ^ 0x08;
+ OPM_Options = OPM_Options ^ 0x08;
break;
case 'x':
- *opt = *opt ^ 0x01;
+ OPM_Options = OPM_Options ^ 0x01;
+ break;
+ case 'e':
+ OPM_Options = OPM_Options ^ 0x0200;
+ break;
+ case 's':
+ OPM_Options = OPM_Options ^ 0x10;
+ break;
+ case 'F':
+ OPM_Options = OPM_Options ^ 0x020000;
+ break;
+ case 'm':
+ OPM_Options = OPM_Options ^ 0x0400;
+ break;
+ case 'M':
+ OPM_Options = OPM_Options ^ 0x8000;
+ break;
+ case 'S':
+ OPM_Options = OPM_Options ^ 0x2000;
+ break;
+ case 'c':
+ OPM_Options = OPM_Options ^ 0x4000;
+ break;
+ case 'f':
+ OPM_Options = OPM_Options ^ 0x010000;
+ break;
+ case 'V':
+ OPM_Options = OPM_Options ^ 0x040000;
+ break;
+ case 'O':
+ if (i + 1 >= Strings_Length(s, s__len)) {
+ OPM_LogWStr((CHAR*)"-O option requires following size model character.", 51);
+ OPM_LogWLn();
+ } else {
+ OPM_Model[0] = s[__X(i + 1, s__len)];
+ OPM_Model[1] = 0x00;
+ if ((((OPM_Model[0] != '2' && OPM_Model[0] != 'C')) && OPM_Model[0] != 'V')) {
+ OPM_LogWStr((CHAR*)"Unrecognised size model character following -O.", 48);
+ OPM_LogWLn();
+ }
+ i += 1;
+ }
+ break;
+ case 'A':
+ if (i + 2 >= Strings_Length(s, s__len)) {
+ OPM_LogWStr((CHAR*)"-M option requires two following digits.", 41);
+ OPM_LogWLn();
+ } else {
+ OPM_AddressSize = (INT16)s[__X(i + 1, s__len)] - 48;
+ OPM_Alignment = (INT16)s[__X(i + 2, s__len)] - 48;
+ i += 2;
+ }
break;
case 'B':
if (s[__X(i + 1, s__len)] != 0x00) {
i += 1;
- OPM_IntSize = (int)s[__X(i, s__len)] - 48;
+ OPM_IntegerSize = (INT16)s[__X(i, s__len)] - 48;
}
if (s[__X(i + 1, s__len)] != 0x00) {
i += 1;
- OPM_PointerSize = (int)s[__X(i, s__len)] - 48;
+ OPM_AddressSize = (INT16)s[__X(i, s__len)] - 48;
}
if (s[__X(i + 1, s__len)] != 0x00) {
i += 1;
- OPM_Alignment = (int)s[__X(i, s__len)] - 48;
+ OPM_Alignment = (INT16)s[__X(i, s__len)] - 48;
}
- __ASSERT(OPM_IntSize == 2 || OPM_IntSize == 4, 0);
- __ASSERT(OPM_PointerSize == 4 || OPM_PointerSize == 8, 0);
+ __ASSERT(OPM_IntegerSize == 2 || OPM_IntegerSize == 4, 0);
+ __ASSERT(OPM_AddressSize == 4 || OPM_AddressSize == 8, 0);
__ASSERT(OPM_Alignment == 4 || OPM_Alignment == 8, 0);
- Files_SetSearchPath((CHAR*)"", (LONGINT)1);
- break;
- case 'F':
- *opt = *opt ^ 0x020000;
- break;
- case 'M':
- *opt = *opt ^ 0x8000;
- break;
- case 'S':
- *opt = *opt ^ 0x2000;
- break;
- case 'V':
- *opt = *opt ^ 0x040000;
+ if (OPM_IntegerSize == 2) {
+ OPM_LongintSize = 4;
+ } else {
+ OPM_LongintSize = 8;
+ }
+ Files_SetSearchPath((CHAR*)"", 1);
break;
default:
- OPM_LogWStr((CHAR*)" warning: option ", (LONGINT)19);
+ OPM_LogWStr((CHAR*)" warning: option ", 19);
OPM_LogW('-');
OPM_LogW(s[__X(i, s__len)]);
- OPM_LogWStr((CHAR*)" ignored", (LONGINT)9);
+ OPM_LogWStr((CHAR*)" ignored", 9);
OPM_LogWLn();
break;
}
i += 1;
}
+ __DEL(s);
}
BOOLEAN OPM_OpenPar (void)
{
- BOOLEAN _o_result;
CHAR s[256];
if (Platform_ArgCount == 1) {
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Vishap Oberon-2 compiler v", (LONGINT)27);
- OPM_LogWStr(Configuration_versionLong, ((LONGINT)(41)));
+ OPM_LogWStr((CHAR*)"Oberon-2 compiler v", 20);
+ OPM_LogWStr(Configuration_versionLong, 75);
OPM_LogW('.');
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Based on Ofront by Software Templ OEG, continued by Norayr Chilingarian and others.", (LONGINT)84);
+ 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_LogWLn();
- OPM_LogWStr((CHAR*)"Usage:", (LONGINT)7);
+ OPM_LogWStr((CHAR*)"Usage:", 7);
OPM_LogWLn();
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" ", (LONGINT)3);
- OPM_LogWStr((CHAR*)"voc", (LONGINT)4);
- OPM_LogWStr((CHAR*)" options {files {options}}.", (LONGINT)28);
+ OPM_LogWStr((CHAR*)" ", 3);
+ OPM_LogWStr((CHAR*)"voc", 4);
+ OPM_LogWStr((CHAR*)" options {files {options}}.", 28);
OPM_LogWLn();
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Where options = [\"-\" {option} ].", (LONGINT)33);
+ OPM_LogWStr((CHAR*)"Options:", 9);
OPM_LogWLn();
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" m - generate code for main module", (LONGINT)36);
+ OPM_LogWStr((CHAR*)" Run time safety", 18);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" M - generate code for main module and link object statically", (LONGINT)63);
+ OPM_LogWStr((CHAR*)" -p Initialise pointers to NIL. On by default.", 52);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" s - generate new symbol file", (LONGINT)31);
+ OPM_LogWStr((CHAR*)" -a Halt on assertion failures. On by default.", 52);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" e - allow extending the module interface", (LONGINT)43);
+ OPM_LogWStr((CHAR*)" -r Halt on range check failures.", 39);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" r - check value ranges", (LONGINT)25);
+ OPM_LogWStr((CHAR*)" -t Halt on type guard failure. On by default.", 52);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" a - don't check ASSERTs at runtime, use this option in tested production code", (LONGINT)80);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" t - don't check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" S - don't call external assembler/compiler, only generate C code", (LONGINT)67);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" c - don't call linker", (LONGINT)24);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" f - don't use color output", (LONGINT)29);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" V - verbose output", (LONGINT)21);
+ OPM_LogWStr((CHAR*)" -x Halt on index out of range. On by default.", 52);
OPM_LogWLn();
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Initial options specify defaults for all files.", (LONGINT)48);
+ OPM_LogWStr((CHAR*)" Symbol file management", 25);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Options following a filename are specific to that file.", (LONGINT)56);
+ OPM_LogWStr((CHAR*)" -e Allow extension of old symbol file.", 45);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Repeating an option toggles its value.", (LONGINT)39);
+ OPM_LogWStr((CHAR*)" -s Allow generation of new symbol file.", 46);
OPM_LogWLn();
- _o_result = 0;
- return _o_result;
+ OPM_LogWStr((CHAR*)" -F Force generation of new symbol file.", 46);
+ OPM_LogWLn();
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" C compiler and linker control", 32);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -m This module is main. Link dynamically.", 48);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -M This module is main. Link statically.", 47);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -S Don't call C compiler", 31);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -c Don't link.", 21);
+ OPM_LogWLn();
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" Miscellaneous", 16);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -f Disable VT100 control characters in status output.", 60);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -V Display compiler debugging messages.", 46);
+ OPM_LogWLn();
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" Size model for elementary types (default O2)", 47);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
+ OPM_LogWLn();
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" Target machine address size and alignment (default is that of the running compiler binary)", 93);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -A44 32 bit addresses, 32 bit alignment (e.g. Unix/linux 32 bit on x86).", 79);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -A48 32 bit addresses, 64 bit alignment (e.g. Windows 32 bit on x86, linux 32 bit on arm).", 97);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -A88 64 bit addresses, 64 bit alignment (e.g. 64 bit platforms).", 71);
+ OPM_LogWLn();
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"All options are off by default, except where noted above.", 58);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Initial options specify defaults for all files.", 48);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Options following a filename are specific to that file.", 56);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Repeating an option toggles its value.", 39);
+ OPM_LogWLn();
+ return 0;
} else {
+ OPM_AddressSize = 4;
+ OPM_GetAlignment(&OPM_Alignment);
+ __MOVE("2", OPM_Model, 2);
+ OPM_Options = 0xa9;
OPM_S = 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256)));
- OPM_glbopt = 0xe9;
+ Platform_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
- OPM_ScanOptions((void*)s, ((LONGINT)(256)), &OPM_glbopt);
+ OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256)));
+ Platform_GetArg(OPM_S, (void*)s, 256);
}
- _o_result = 1;
- return _o_result;
+ OPM_GlobalAddressSize = OPM_AddressSize;
+ OPM_GlobalAlignment = OPM_Alignment;
+ __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];
- OPM_opt = OPM_glbopt;
+ CHAR searchpath[1024], modules[1024];
+ CHAR MODULES[1024];
+ OPM_Options = OPM_GlobalOptions;
+ __COPY(OPM_GlobalModel, OPM_Model, 10);
+ OPM_Alignment = OPM_GlobalAlignment;
+ OPM_AddressSize = OPM_GlobalAddressSize;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256)));
+ Platform_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
- OPM_ScanOptions((void*)s, ((LONGINT)(256)), &OPM_opt);
+ OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256)));
+ Platform_GetArg(OPM_S, (void*)s, 256);
}
- OPM_dontAsm = __IN(13, OPM_opt);
- OPM_dontLink = __IN(14, OPM_opt);
- OPM_mainProg = __IN(10, OPM_opt);
- OPM_mainLinkStat = __IN(15, OPM_opt);
- OPM_notColorOutput = __IN(16, OPM_opt);
- OPM_forceNewSym = __IN(17, OPM_opt);
- OPM_Verbose = __IN(18, OPM_opt);
- if (OPM_mainLinkStat) {
- OPM_glbopt |= __SETOF(10);
+ if (__IN(15, OPM_Options, 32)) {
+ OPM_Options |= __SETOF(10,32);
}
- OPM_GetProperties();
+ OPM_MaxIndex = OPM_SignedMaximum(OPM_AddressSize);
+ switch (OPM_Model[0]) {
+ case '2':
+ OPM_ShortintSize = 1;
+ OPM_IntegerSize = 2;
+ OPM_LongintSize = 4;
+ break;
+ case 'C':
+ OPM_ShortintSize = 2;
+ OPM_IntegerSize = 4;
+ OPM_LongintSize = 8;
+ break;
+ case 'V':
+ OPM_ShortintSize = 1;
+ OPM_IntegerSize = 4;
+ OPM_LongintSize = 8;
+ break;
+ default:
+ OPM_ShortintSize = 1;
+ OPM_IntegerSize = 2;
+ OPM_LongintSize = 4;
+ break;
+ }
+ 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);
+ Platform_GetEnv((CHAR*)"OBERON", 7, (void*)searchpath, 1024);
+ Strings_Append((CHAR*)";.;", 4, (void*)searchpath, 1024);
+ Strings_Append(modules, 1024, (void*)searchpath, 1024);
+ Strings_Append((CHAR*)";", 2, (void*)searchpath, 1024);
+ Strings_Append(OPM_ResourceDir, 1024, (void*)searchpath, 1024);
+ Strings_Append((CHAR*)"/sym;", 6, (void*)searchpath, 1024);
+ Files_SetSearchPath(searchpath, 1024);
}
void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
{
Texts_Text T = NIL;
- LONGINT beg, end, time;
+ INT32 beg, end, time;
CHAR s[256];
*done = 0;
OPM_curpos = 0;
@@ -307,19 +476,19 @@ void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
return;
}
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256)));
+ Platform_GetArg(OPM_S, (void*)s, 256);
__NEW(T, Texts_TextDesc);
- Texts_Open(T, s, ((LONGINT)(256)));
- OPM_LogWStr(s, ((LONGINT)(256)));
- OPM_LogWStr((CHAR*)" ", (LONGINT)3);
+ Texts_Open(T, s, 256);
+ OPM_LogWStr(s, 256);
+ OPM_LogWStr((CHAR*)" ", 3);
__COPY(s, mname, mname__len);
- __COPY(s, OPM_SourceFileName, ((LONGINT)(256)));
+ __COPY(s, OPM_SourceFileName, 256);
if (T->len == 0) {
- OPM_LogWStr(s, ((LONGINT)(256)));
- OPM_LogWStr((CHAR*)" not found.", (LONGINT)12);
+ OPM_LogWStr(s, 256);
+ OPM_LogWStr((CHAR*)" not found.", 12);
OPM_LogWLn();
} else {
- Texts_OpenReader(&OPM_inR, Texts_Reader__typ, T, ((LONGINT)(0)));
+ Texts_OpenReader(&OPM_inR, Texts_Reader__typ, T, 0);
*done = 1;
}
OPM_S += 1;
@@ -347,7 +516,7 @@ void OPM_Get (CHAR *ch)
static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len)
{
- INTEGER i, j;
+ INT16 i, j;
CHAR ch;
__DUP(ext, ext__len, CHAR);
i = 0;
@@ -369,51 +538,56 @@ static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGIN
__DEL(ext);
}
-static void OPM_LogErrMsg (INTEGER n)
+static void OPM_LogErrMsg (INT16 n)
{
+ INT16 l;
Texts_Scanner S;
- Texts_Text T = NIL;
- CHAR ch;
- INTEGER i;
- CHAR buf[1024];
+ CHAR c;
if (n >= 0) {
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"31m", (LONGINT)4);
- }
- OPM_LogWStr((CHAR*)" err ", (LONGINT)7);
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"0m", (LONGINT)3);
- }
+ OPM_LogVT100((CHAR*)"31m", 4);
+ OPM_LogWStr((CHAR*)" err ", 7);
+ OPM_LogVT100((CHAR*)"0m", 3);
} else {
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"35m", (LONGINT)4);
- }
- OPM_LogWStr((CHAR*)" warning ", (LONGINT)11);
+ OPM_LogVT100((CHAR*)"35m", 4);
+ OPM_LogWStr((CHAR*)" warning ", 11);
n = -n;
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"0m", (LONGINT)3);
+ OPM_LogVT100((CHAR*)"0m", 3);
+ }
+ OPM_LogWNum(n, 1);
+ OPM_LogWStr((CHAR*)" ", 3);
+ if (OPM_Errors == NIL) {
+ __NEW(OPM_Errors, Texts_TextDesc);
+ Texts_Open(OPM_Errors, (CHAR*)"Errors.Txt", 11);
+ }
+ Texts_OpenScanner(&S, Texts_Scanner__typ, OPM_Errors, 0);
+ do {
+ l = S.line;
+ Texts_Scan(&S, Texts_Scanner__typ);
+ } while (!((((l != S.line && S.class == 3)) && S.i == n) || S.eot));
+ if (!S.eot) {
+ Texts_Read((void*)&S, Texts_Scanner__typ, &c);
+ while ((!S.eot && c >= ' ')) {
+ Out_Char(c);
+ Texts_Read((void*)&S, Texts_Scanner__typ, &c);
}
}
- OPM_LogWNum(n, ((LONGINT)(1)));
- OPM_LogWStr((CHAR*)" ", (LONGINT)3);
- OPM_LogWStr(errors_errors[__X(n, ((LONGINT)(350)))], ((LONGINT)(128)));
}
-static void OPM_FindLine (Files_File f, Files_Rider *r, LONGINT *r__typ, LONGINT pos)
+static void OPM_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos)
{
CHAR ch, cheol;
- if (pos < OPM_ErrorLineStartPos) {
+ if (pos < (INT64)OPM_ErrorLineStartPos) {
OPM_ErrorLineStartPos = 0;
OPM_ErrorLineLimitPos = 0;
OPM_ErrorLineNumber = 0;
}
- if (pos < OPM_ErrorLineLimitPos) {
+ if (pos < (INT64)OPM_ErrorLineLimitPos) {
Files_Set(&*r, r__typ, f, OPM_ErrorLineStartPos);
return;
}
Files_Set(&*r, r__typ, f, OPM_ErrorLineLimitPos);
Files_Read(&*r, r__typ, (void*)&ch);
- while ((OPM_ErrorLineLimitPos < pos && !(*r).eof)) {
+ while (((INT64)OPM_ErrorLineLimitPos < pos && !(*r).eof)) {
OPM_ErrorLineStartPos = OPM_ErrorLineLimitPos;
OPM_ErrorLineNumber += 1;
while ((((ch != 0x00 && ch != 0x0d)) && ch != 0x0a)) {
@@ -431,49 +605,45 @@ static void OPM_FindLine (Files_File f, Files_Rider *r, LONGINT *r__typ, LONGINT
Files_Set(&*r, r__typ, f, OPM_ErrorLineStartPos);
}
-static void OPM_ShowLine (LONGINT pos)
+static void OPM_ShowLine (INT64 pos)
{
Files_File f = NIL;
Files_Rider r;
CHAR line[1023];
- INTEGER i;
+ INT16 i;
CHAR ch;
- f = Files_Old(OPM_SourceFileName, ((LONGINT)(256)));
+ f = Files_Old(OPM_SourceFileName, 256);
OPM_FindLine(f, &r, Files_Rider__typ, pos);
i = 0;
Files_Read(&r, Files_Rider__typ, (void*)&ch);
while ((((((ch != 0x00 && ch != 0x0d)) && ch != 0x0a)) && i < 1022)) {
- line[__X(i, ((LONGINT)(1023)))] = ch;
+ line[__X(i, 1023)] = ch;
i += 1;
Files_Read(&r, Files_Rider__typ, (void*)&ch);
}
- line[__X(i, ((LONGINT)(1023)))] = 0x00;
+ line[__X(i, 1023)] = 0x00;
OPM_LogWLn();
OPM_LogWLn();
- OPM_LogWNum(OPM_ErrorLineNumber, ((LONGINT)(4)));
- OPM_LogWStr((CHAR*)": ", (LONGINT)3);
- OPM_LogWStr(line, ((LONGINT)(1023)));
+ OPM_LogWNum(OPM_ErrorLineNumber, 4);
+ OPM_LogWStr((CHAR*)": ", 3);
+ OPM_LogWStr(line, 1023);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" ", (LONGINT)7);
- if (pos >= OPM_ErrorLineLimitPos) {
+ OPM_LogWStr((CHAR*)" ", 7);
+ if (pos >= (INT64)OPM_ErrorLineLimitPos) {
pos = OPM_ErrorLineLimitPos - 1;
}
- i = (int)(pos - OPM_ErrorLineStartPos);
+ i = (INT16)OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos);
while (i > 0) {
OPM_LogW(' ');
i -= 1;
}
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"32m", (LONGINT)4);
- }
+ OPM_LogVT100((CHAR*)"32m", 4);
OPM_LogW('^');
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"0m", (LONGINT)3);
- }
+ OPM_LogVT100((CHAR*)"0m", 3);
Files_Close(f);
}
-void OPM_Mark (INTEGER n, LONGINT pos)
+void OPM_Mark (INT16 n, INT32 pos)
{
if (pos == -1) {
pos = 0;
@@ -484,30 +654,30 @@ void OPM_Mark (INTEGER n, LONGINT pos)
OPM_lasterrpos = pos;
OPM_ShowLine(pos);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" ", (LONGINT)3);
+ OPM_LogWStr((CHAR*)" ", 3);
if (n < 249) {
- OPM_LogWStr((CHAR*)" pos", (LONGINT)6);
- OPM_LogWNum(pos, ((LONGINT)(6)));
+ OPM_LogWStr((CHAR*)" pos", 6);
+ OPM_LogWNum(pos, 6);
OPM_LogErrMsg(n);
} else if (n == 255) {
- OPM_LogWStr((CHAR*)"pos", (LONGINT)4);
- OPM_LogWNum(pos, ((LONGINT)(6)));
- OPM_LogWStr((CHAR*)" pc ", (LONGINT)6);
- OPM_LogWNum(OPM_breakpc, ((LONGINT)(1)));
+ OPM_LogWStr((CHAR*)"pos", 4);
+ OPM_LogWNum(pos, 6);
+ OPM_LogWStr((CHAR*)" pc ", 6);
+ OPM_LogWNum(OPM_breakpc, 1);
} else if (n == 254) {
- OPM_LogWStr((CHAR*)"pc not found", (LONGINT)13);
+ OPM_LogWStr((CHAR*)"pc not found", 13);
} else {
- OPM_LogWStr(OPM_objname, ((LONGINT)(64)));
+ OPM_LogWStr(OPM_objname, 64);
if (n == 253) {
- OPM_LogWStr((CHAR*)" is new, compile with option e", (LONGINT)31);
+ OPM_LogWStr((CHAR*)" is new, compile with option e", 31);
} else if (n == 252) {
- OPM_LogWStr((CHAR*)" is redefined, compile with option s", (LONGINT)37);
+ OPM_LogWStr((CHAR*)" is redefined, compile with option s", 37);
} else if (n == 251) {
- OPM_LogWStr((CHAR*)" is redefined (private part only), compile with option s", (LONGINT)57);
+ OPM_LogWStr((CHAR*)" is redefined (private part only), compile with option s", 57);
} else if (n == 250) {
- OPM_LogWStr((CHAR*)" is no longer visible, compile with option s", (LONGINT)45);
+ OPM_LogWStr((CHAR*)" is no longer visible, compile with option s", 45);
} else if (n == 249) {
- OPM_LogWStr((CHAR*)" is not consistently imported, recompile imports", (LONGINT)49);
+ OPM_LogWStr((CHAR*)" is not consistently imported, recompile imports", 49);
}
}
}
@@ -515,8 +685,8 @@ void OPM_Mark (INTEGER n, LONGINT pos)
if (pos >= 0) {
OPM_ShowLine(pos);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" pos", (LONGINT)6);
- OPM_LogWNum(pos, ((LONGINT)(6)));
+ OPM_LogWStr((CHAR*)" pos", 6);
+ OPM_LogWNum(pos, 6);
}
OPM_LogErrMsg(n);
if (pos < 0) {
@@ -525,162 +695,42 @@ void OPM_Mark (INTEGER n, LONGINT pos)
}
}
-void OPM_err (INTEGER n)
+void OPM_err (INT16 n)
{
OPM_Mark(n, OPM_errpos);
}
-void OPM_FPrint (LONGINT *fp, LONGINT val)
+static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len)
{
- *fp = __ROTL((LONGINT)((SET)*fp ^ (SET)val), 1, LONGINT);
-}
-
-void OPM_FPrintSet (LONGINT *fp, SET set)
-{
- OPM_FPrint(&*fp, (LONGINT)set);
-}
-
-void OPM_FPrintReal (LONGINT *fp, REAL real)
-{
- INTEGER i;
- LONGINT l;
- __GET((LONGINT)(SYSTEM_ADDRESS)&real, l, LONGINT);
- OPM_FPrint(&*fp, l);
-}
-
-void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr)
-{
- LONGINT l, h;
- __GET((LONGINT)(SYSTEM_ADDRESS)&lr, l, LONGINT);
- __GET((LONGINT)(SYSTEM_ADDRESS)&lr + 4, h, LONGINT);
- OPM_FPrint(&*fp, l);
- OPM_FPrint(&*fp, h);
-}
-
-static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align)
-{
- __DUP(name, name__len, CHAR);
- if (((*S).class == 1 && __STRCMP((*S).s, name) == 0)) {
- Texts_Scan(&*S, S__typ);
- if ((*S).class == 3) {
- *size = (int)(*S).i;
- Texts_Scan(&*S, S__typ);
- } else {
- OPM_Mark(-157, ((LONGINT)(-1)));
- }
- if ((*S).class == 3) {
- *align = (int)(*S).i;
- Texts_Scan(&*S, S__typ);
- } else {
- OPM_Mark(-157, ((LONGINT)(-1)));
- }
- } else {
- OPM_Mark(-157, ((LONGINT)(-1)));
+ INT16 i;
+ INT32 l;
+ __ASSERT(__MASK(bytes__len, -4) == 0, 0);
+ i = 0;
+ while (i < bytes__len) {
+ __GET((ADDRESS)&bytes[__X(i, bytes__len)], l, INT32);
+ *fp = __ROTL((INT32)((UINT32)*fp ^ (UINT32)l), 1, 32);
+ i += 4;
}
- __DEL(name);
}
-static LONGINT OPM_minusop (LONGINT i)
+void OPM_FPrint (INT32 *fp, INT64 val)
{
- LONGINT _o_result;
- _o_result = -i;
- return _o_result;
+ OPM_FingerprintBytes(&*fp, (void*)&val, 8);
}
-static LONGINT OPM_power0 (LONGINT i, LONGINT j)
+void OPM_FPrintSet (INT32 *fp, UINT64 val)
{
- LONGINT _o_result;
- LONGINT k, p;
- k = 1;
- p = i;
- do {
- p = p * i;
- k += 1;
- } while (!(k == j));
- _o_result = p;
- return _o_result;
+ OPM_FingerprintBytes(&*fp, (void*)&val, 8);
}
-static void OPM_VerboseListSizes (void)
+void OPM_FPrintReal (INT32 *fp, REAL val)
{
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Type Size Alignement", (LONGINT)29);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"CHAR ", (LONGINT)14);
- OPM_LogWNum(OPM_CharSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"BOOLEAN ", (LONGINT)14);
- OPM_LogWNum(OPM_BoolSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"SHORTINT ", (LONGINT)14);
- OPM_LogWNum(OPM_SIntSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"INTEGER ", (LONGINT)14);
- OPM_LogWNum(OPM_IntSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"LONGINT ", (LONGINT)14);
- OPM_LogWNum(OPM_LIntSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"SET ", (LONGINT)14);
- OPM_LogWNum(OPM_SetSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"REAL ", (LONGINT)14);
- OPM_LogWNum(OPM_RealSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"LONGREAL ", (LONGINT)14);
- OPM_LogWNum(OPM_LRealSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"PTR ", (LONGINT)14);
- OPM_LogWNum(OPM_PointerSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"PROC ", (LONGINT)14);
- OPM_LogWNum(OPM_ProcSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"RECORD ", (LONGINT)14);
- OPM_LogWNum(OPM_RecSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWLn();
+ OPM_FingerprintBytes(&*fp, (void*)&val, 4);
}
-LONGINT OPM_SignedMaximum (LONGINT bytecount)
+void OPM_FPrintLReal (INT32 *fp, LONGREAL val)
{
- LONGINT _o_result;
- LONGINT result;
- result = 1;
- result = __LSH(result, __ASHL(bytecount, 3) - 1, LONGINT);
- _o_result = result - 1;
- return _o_result;
-}
-
-LONGINT OPM_SignedMinimum (LONGINT bytecount)
-{
- LONGINT _o_result;
- _o_result = -OPM_SignedMaximum(bytecount) - 1;
- return _o_result;
-}
-
-static void OPM_GetProperties (void)
-{
- OPM_ProcSize = OPM_PointerSize;
- OPM_LIntSize = __ASHL(OPM_IntSize, 1);
- OPM_SetSize = OPM_LIntSize;
- if (OPM_RealSize == 4) {
- OPM_MaxReal = 3.40282346000000e+038;
- } else if (OPM_RealSize == 8) {
- OPM_MaxReal = 1.79769296342094e+308;
- }
- if (OPM_LRealSize == 4) {
- OPM_MaxLReal = 3.40282346000000e+038;
- } else if (OPM_LRealSize == 8) {
- OPM_MaxLReal = 1.79769296342094e+308;
- }
- OPM_MinReal = -OPM_MaxReal;
- OPM_MinLReal = -OPM_MaxLReal;
- OPM_MaxSet = __ASHL(OPM_SetSize, 3) - 1;
- OPM_MaxIndex = OPM_SignedMaximum(OPM_PointerSize);
- if (OPM_Verbose) {
- OPM_VerboseListSizes();
- }
+ OPM_FingerprintBytes(&*fp, (void*)&val, 8);
}
void OPM_SymRCh (CHAR *ch)
@@ -688,18 +738,23 @@ void OPM_SymRCh (CHAR *ch)
Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&*ch);
}
-LONGINT OPM_SymRInt (void)
+INT32 OPM_SymRInt (void)
{
- LONGINT _o_result;
- LONGINT k;
- Files_ReadNum(&OPM_oldSF, Files_Rider__typ, &k);
- _o_result = k;
- return _o_result;
+ INT32 k;
+ Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (void*)&k, 4);
+ return k;
}
-void OPM_SymRSet (SET *s)
+INT64 OPM_SymRInt64 (void)
{
- Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (LONGINT*)&*s);
+ INT64 k;
+ Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (void*)&k, 8);
+ return k;
+}
+
+void OPM_SymRSet (UINT64 *s)
+{
+ Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (void*)&*s, 8);
}
void OPM_SymRReal (REAL *r)
@@ -714,19 +769,21 @@ void OPM_SymRLReal (LONGREAL *lr)
void OPM_CloseOldSym (void)
{
+ Files_Close(Files_Base(&OPM_oldSF, Files_Rider__typ));
}
void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done)
{
- CHAR ch;
+ CHAR tag, ver;
OPM_FileName fileName;
- OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5);
- OPM_oldSFile = Files_Old(fileName, ((LONGINT)(32)));
+ OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
+ OPM_oldSFile = Files_Old(fileName, 32);
*done = OPM_oldSFile != NIL;
if (*done) {
- Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, ((LONGINT)(0)));
- Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ch);
- if (ch != 0xf7) {
+ Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, 0);
+ Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&tag);
+ Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ver);
+ if (tag != 0xf7 || ver != 0x82) {
OPM_err(-306);
OPM_CloseOldSym();
*done = 0;
@@ -736,9 +793,7 @@ void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done)
BOOLEAN OPM_eofSF (void)
{
- BOOLEAN _o_result;
- _o_result = OPM_oldSF.eof;
- return _o_result;
+ return OPM_oldSF.eof;
}
void OPM_SymWCh (CHAR ch)
@@ -746,14 +801,14 @@ void OPM_SymWCh (CHAR ch)
Files_Write(&OPM_newSF, Files_Rider__typ, ch);
}
-void OPM_SymWInt (LONGINT i)
+void OPM_SymWInt (INT64 i)
{
Files_WriteNum(&OPM_newSF, Files_Rider__typ, i);
}
-void OPM_SymWSet (SET s)
+void OPM_SymWSet (UINT64 s)
{
- Files_WriteNum(&OPM_newSF, Files_Rider__typ, (LONGINT)s);
+ Files_WriteNum(&OPM_newSF, Files_Rider__typ, (INT64)s);
}
void OPM_SymWReal (REAL r)
@@ -768,7 +823,7 @@ void OPM_SymWLReal (LONGREAL lr)
void OPM_RegisterNewSym (void)
{
- if (__STRCMP(OPM_modName, "SYSTEM") != 0 || __IN(10, OPM_opt)) {
+ if (__STRCMP(OPM_modName, "SYSTEM") != 0 || __IN(10, OPM_Options, 32)) {
Files_Register(OPM_newSFile);
}
}
@@ -780,11 +835,12 @@ void OPM_DeleteNewSym (void)
void OPM_NewSym (CHAR *modName, LONGINT modName__len)
{
OPM_FileName fileName;
- OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5);
- OPM_newSFile = Files_New(fileName, ((LONGINT)(32)));
+ OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
+ OPM_newSFile = Files_New(fileName, 32);
if (OPM_newSFile != NIL) {
- Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, ((LONGINT)(0)));
+ Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, 0);
Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7);
+ Files_Write(&OPM_newSF, Files_Rider__typ, 0x82);
} else {
OPM_err(153);
}
@@ -792,74 +848,74 @@ void OPM_NewSym (CHAR *modName, LONGINT modName__len)
void OPM_Write (CHAR ch)
{
- Files_Write(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, ch);
+ Files_Write(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, ch);
}
void OPM_WriteString (CHAR *s, LONGINT s__len)
{
- INTEGER i;
+ INT16 i;
i = 0;
while (s[__X(i, s__len)] != 0x00) {
i += 1;
}
- Files_WriteBytes(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, (void*)s, s__len * ((LONGINT)(1)), i);
+ Files_WriteBytes(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, (void*)s, s__len * 1, i);
}
void OPM_WriteStringVar (CHAR *s, LONGINT s__len)
{
- INTEGER i;
+ INT16 i;
i = 0;
while (s[__X(i, s__len)] != 0x00) {
i += 1;
}
- Files_WriteBytes(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, (void*)s, s__len * ((LONGINT)(1)), i);
+ Files_WriteBytes(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, (void*)s, s__len * 1, i);
}
-void OPM_WriteHex (LONGINT i)
+void OPM_WriteHex (INT64 i)
{
CHAR s[3];
- INTEGER digit;
- digit = __ASHR((int)i, 4);
+ INT32 digit;
+ digit = __ASHR((INT32)i, 4);
if (digit < 10) {
s[0] = (CHAR)(48 + digit);
} else {
s[0] = (CHAR)(87 + digit);
}
- digit = __MASK((int)i, -16);
+ digit = __MASK((INT32)i, -16);
if (digit < 10) {
s[1] = (CHAR)(48 + digit);
} else {
s[1] = (CHAR)(87 + digit);
}
s[2] = 0x00;
- OPM_WriteString(s, ((LONGINT)(3)));
+ OPM_WriteString(s, 3);
}
-void OPM_WriteInt (LONGINT i)
+void OPM_WriteInt (INT64 i)
{
- CHAR s[20];
- LONGINT i1, k;
- if (i == OPM_SignedMinimum(OPM_IntSize) || i == OPM_SignedMinimum(OPM_LIntSize)) {
+ CHAR s[24];
+ INT64 i1, k;
+ if ((i == OPM_SignedMinimum(2) || i == OPM_SignedMinimum(4)) || i == OPM_SignedMinimum(8)) {
OPM_Write('(');
OPM_WriteInt(i + 1);
- OPM_WriteString((CHAR*)"-1)", (LONGINT)4);
+ OPM_WriteString((CHAR*)"-1)", 4);
} else {
i1 = __ABS(i);
s[0] = (CHAR)(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k = 1;
while (i1 > 0) {
- s[__X(k, ((LONGINT)(20)))] = (CHAR)(__MOD(i1, 10) + 48);
+ s[__X(k, 24)] = (CHAR)(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k += 1;
}
if (i < 0) {
- s[__X(k, ((LONGINT)(20)))] = '-';
+ s[__X(k, 24)] = '-';
k += 1;
}
while (k > 0) {
k -= 1;
- OPM_Write(s[__X(k, ((LONGINT)(20)))]);
+ OPM_Write(s[__X(k, 24)]);
}
}
}
@@ -871,14 +927,14 @@ void OPM_WriteReal (LONGREAL r, CHAR suffx)
Texts_Reader R;
CHAR s[32];
CHAR ch;
- INTEGER i;
- if ((((r < OPM_SignedMaximum(OPM_LIntSize) && r > OPM_SignedMinimum(OPM_LIntSize))) && r == ((int)__ENTIER(r)))) {
+ INT16 i;
+ if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == ((INT32)__ENTIER(r)))) {
if (suffx == 'f') {
- OPM_WriteString((CHAR*)"(REAL)", (LONGINT)7);
+ OPM_WriteString((CHAR*)"(REAL)", 7);
} else {
- OPM_WriteString((CHAR*)"(LONGREAL)", (LONGINT)11);
+ OPM_WriteString((CHAR*)"(LONGREAL)", 11);
}
- OPM_WriteInt((int)__ENTIER(r));
+ OPM_WriteInt((INT32)__ENTIER(r));
} else {
Texts_OpenWriter(&W, Texts_Writer__typ);
if (suffx == 'f') {
@@ -887,45 +943,45 @@ void OPM_WriteReal (LONGREAL r, CHAR suffx)
Texts_WriteLongReal(&W, Texts_Writer__typ, r, 23);
}
__NEW(T, Texts_TextDesc);
- Texts_Open(T, (CHAR*)"", (LONGINT)1);
+ Texts_Open(T, (CHAR*)"", 1);
Texts_Append(T, W.buf);
- Texts_OpenReader(&R, Texts_Reader__typ, T, ((LONGINT)(0)));
+ Texts_OpenReader(&R, Texts_Reader__typ, T, 0);
i = 0;
Texts_Read(&R, Texts_Reader__typ, &ch);
while (ch != 0x00) {
- s[__X(i, ((LONGINT)(32)))] = ch;
+ s[__X(i, 32)] = ch;
i += 1;
Texts_Read(&R, Texts_Reader__typ, &ch);
}
- s[__X(i, ((LONGINT)(32)))] = 0x00;
+ s[__X(i, 32)] = 0x00;
i = 0;
ch = s[0];
while ((ch != 'D' && ch != 0x00)) {
i += 1;
- ch = s[__X(i, ((LONGINT)(32)))];
+ ch = s[__X(i, 32)];
}
if (ch == 'D') {
- s[__X(i, ((LONGINT)(32)))] = 'e';
+ s[__X(i, 32)] = 'e';
}
- OPM_WriteString(s, ((LONGINT)(32)));
+ OPM_WriteString(s, 32);
}
}
void OPM_WriteLn (void)
{
- Files_Write(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, 0x0a);
+ Files_Write(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, 0x0a);
}
-static void OPM_Append (Files_Rider *R, LONGINT *R__typ, Files_File F)
+static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F)
{
Files_Rider R1;
CHAR buffer[4096];
if (F != NIL) {
- Files_Set(&R1, Files_Rider__typ, F, ((LONGINT)(0)));
- Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, ((LONGINT)(4096)), ((LONGINT)(4096)));
+ Files_Set(&R1, Files_Rider__typ, F, 0);
+ Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, 4096, 4096);
while (4096 - R1.res > 0) {
- Files_WriteBytes(&*R, R__typ, (void*)buffer, ((LONGINT)(4096)), 4096 - R1.res);
- Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, ((LONGINT)(4096)), ((LONGINT)(4096)));
+ Files_WriteBytes(&*R, R__typ, (void*)buffer, 4096, 4096 - R1.res);
+ Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, 4096, 4096);
}
}
}
@@ -933,24 +989,24 @@ static void OPM_Append (Files_Rider *R, LONGINT *R__typ, Files_File F)
void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
{
CHAR FName[32];
- __COPY(moduleName, OPM_modName, ((LONGINT)(32)));
- OPM_HFile = Files_New((CHAR*)"", (LONGINT)1);
+ __COPY(moduleName, OPM_modName, 32);
+ OPM_HFile = Files_New((CHAR*)"", 1);
if (OPM_HFile != NIL) {
- Files_Set(&OPM_R[0], Files_Rider__typ, OPM_HFile, ((LONGINT)(0)));
+ Files_Set(&OPM_R[0], Files_Rider__typ, OPM_HFile, 0);
} else {
OPM_err(153);
}
- OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, ((LONGINT)(32)), (CHAR*)".c", (LONGINT)3);
- OPM_BFile = Files_New(FName, ((LONGINT)(32)));
+ OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, 32, (CHAR*)".c", 3);
+ OPM_BFile = Files_New(FName, 32);
if (OPM_BFile != NIL) {
- Files_Set(&OPM_R[1], Files_Rider__typ, OPM_BFile, ((LONGINT)(0)));
+ Files_Set(&OPM_R[1], Files_Rider__typ, OPM_BFile, 0);
} else {
OPM_err(153);
}
- OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, ((LONGINT)(32)), (CHAR*)".h", (LONGINT)3);
- OPM_HIFile = Files_New(FName, ((LONGINT)(32)));
+ OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, 32, (CHAR*)".h", 3);
+ OPM_HIFile = Files_New(FName, 32);
if (OPM_HIFile != NIL) {
- Files_Set(&OPM_R[2], Files_Rider__typ, OPM_HIFile, ((LONGINT)(0)));
+ Files_Set(&OPM_R[2], Files_Rider__typ, OPM_HIFile, 0);
} else {
OPM_err(153);
}
@@ -959,26 +1015,26 @@ void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
void OPM_CloseFiles (void)
{
CHAR FName[32];
- INTEGER res;
+ INT16 res;
if (OPM_noerr) {
- OPM_LogWStr((CHAR*)" ", (LONGINT)3);
- OPM_LogWNum(Files_Pos(&OPM_R[1], Files_Rider__typ), ((LONGINT)(0)));
- OPM_LogWStr((CHAR*)" chars.", (LONGINT)8);
+ OPM_LogWStr((CHAR*)" ", 3);
+ OPM_LogWNum(Files_Pos(&OPM_R[1], Files_Rider__typ), 0);
+ OPM_LogWStr((CHAR*)" chars.", 8);
}
if (OPM_noerr) {
if (__STRCMP(OPM_modName, "SYSTEM") == 0) {
- if (!__IN(10, OPM_opt)) {
+ if (!__IN(10, OPM_Options, 32)) {
Files_Register(OPM_BFile);
}
- } else if (!__IN(10, OPM_opt)) {
+ } else if (!__IN(10, OPM_Options, 32)) {
OPM_Append(&OPM_R[2], Files_Rider__typ, OPM_HFile);
Files_Register(OPM_HIFile);
Files_Register(OPM_BFile);
} else {
- OPM_MakeFileName((void*)OPM_modName, ((LONGINT)(32)), (void*)FName, ((LONGINT)(32)), (CHAR*)".h", (LONGINT)3);
- Files_Delete(FName, ((LONGINT)(32)), &res);
- OPM_MakeFileName((void*)OPM_modName, ((LONGINT)(32)), (void*)FName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5);
- Files_Delete(FName, ((LONGINT)(32)), &res);
+ OPM_MakeFileName((void*)OPM_modName, 32, (void*)FName, 32, (CHAR*)".h", 3);
+ Files_Delete(FName, 32, &res);
+ OPM_MakeFileName((void*)OPM_modName, 32, (void*)FName, 32, (CHAR*)".sym", 5);
+ Files_Delete(FName, 32, &res);
Files_Register(OPM_BFile);
}
}
@@ -987,18 +1043,18 @@ void OPM_CloseFiles (void)
OPM_HIFile = NIL;
OPM_newSFile = NIL;
OPM_oldSFile = NIL;
- Files_Set(&OPM_R[0], Files_Rider__typ, NIL, ((LONGINT)(0)));
- Files_Set(&OPM_R[1], Files_Rider__typ, NIL, ((LONGINT)(0)));
- Files_Set(&OPM_R[2], Files_Rider__typ, NIL, ((LONGINT)(0)));
- Files_Set(&OPM_newSF, Files_Rider__typ, NIL, ((LONGINT)(0)));
- Files_Set(&OPM_oldSF, Files_Rider__typ, NIL, ((LONGINT)(0)));
+ Files_Set(&OPM_R[0], Files_Rider__typ, NIL, 0);
+ Files_Set(&OPM_R[1], Files_Rider__typ, NIL, 0);
+ Files_Set(&OPM_R[2], Files_Rider__typ, NIL, 0);
+ Files_Set(&OPM_newSF, Files_Rider__typ, NIL, 0);
+ Files_Set(&OPM_oldSF, Files_Rider__typ, NIL, 0);
}
static void EnumPtrs(void (*P)(void*))
{
__ENUMR(&OPM_inR, Texts_Reader__typ, 48, 1, P);
P(OPM_Log);
- __ENUMR(&OPM_W, Texts_Writer__typ, 36, 1, P);
+ P(OPM_Errors);
__ENUMR(&OPM_oldSF, Files_Rider__typ, 20, 1, P);
__ENUMR(&OPM_newSF, Files_Rider__typ, 20, 1, P);
__ENUMR(OPM_R, Files_Rider__typ, 20, 3, P);
@@ -1014,13 +1070,12 @@ export void *OPM__init(void)
{
__DEFMOD;
__MODULE_IMPORT(Configuration);
- __MODULE_IMPORT(Console);
__MODULE_IMPORT(Files);
+ __MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
__MODULE_IMPORT(Texts);
- __MODULE_IMPORT(errors);
- __MODULE_IMPORT(vt100);
+ __MODULE_IMPORT(VT100);
__REGMOD("OPM", EnumPtrs);
__REGCMD("CloseFiles", OPM_CloseFiles);
__REGCMD("CloseOldSym", OPM_CloseOldSym);
@@ -1030,26 +1085,9 @@ export void *OPM__init(void)
__REGCMD("RegisterNewSym", OPM_RegisterNewSym);
__REGCMD("WriteLn", OPM_WriteLn);
/* BEGIN */
- Texts_OpenWriter(&OPM_W, Texts_Writer__typ);
- OPM_MODULES[0] = 0x00;
- Platform_GetEnv((CHAR*)"MODULES", (LONGINT)8, (void*)OPM_MODULES, ((LONGINT)(1024)));
- __MOVE(".", OPM_OBERON, 2);
- Platform_GetEnv((CHAR*)"OBERON", (LONGINT)7, (void*)OPM_OBERON, ((LONGINT)(1024)));
- Strings_Append((CHAR*)";.;", (LONGINT)4, (void*)OPM_OBERON, ((LONGINT)(1024)));
- Strings_Append(OPM_MODULES, ((LONGINT)(1024)), (void*)OPM_OBERON, ((LONGINT)(1024)));
- Strings_Append((CHAR*)";", (LONGINT)2, (void*)OPM_OBERON, ((LONGINT)(1024)));
- Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)OPM_OBERON, ((LONGINT)(1024)));
- Strings_Append((CHAR*)"/sym;", (LONGINT)6, (void*)OPM_OBERON, ((LONGINT)(1024)));
- Files_SetSearchPath(OPM_OBERON, ((LONGINT)(1024)));
- OPM_CharSize = 1;
- OPM_BoolSize = 1;
- OPM_SIntSize = 1;
- OPM_RecSize = 1;
- OPM_ByteSize = 1;
- OPM_RealSize = 4;
- OPM_LRealSize = 8;
- OPM_PointerSize = 8;
- OPM_Alignment = 8;
- OPM_IntSize = 4;
+ OPM_MaxReal = 3.40282346000000e+038;
+ OPM_MaxLReal = 1.79769296342094e+308;
+ OPM_MinReal = -OPM_MaxReal;
+ OPM_MinLReal = -OPM_MaxLReal;
__ENDMOD;
}
diff --git a/bootstrap/unix-48/OPM.h b/bootstrap/unix-48/OPM.h
index ed914bff..2d272feb 100644
--- a/bootstrap/unix-48/OPM.h
+++ b/bootstrap/unix-48/OPM.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPM__h
#define OPM__h
@@ -6,60 +6,66 @@
#include "SYSTEM.h"
-import INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_MaxSet;
-import LONGINT OPM_MaxIndex;
+import CHAR OPM_Model[10];
+import INT16 OPM_AddressSize, OPM_Alignment;
+import UINT32 OPM_GlobalOptions, OPM_Options;
+import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize;
+import INT64 OPM_MaxIndex;
import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
import BOOLEAN OPM_noerr;
-import LONGINT OPM_curpos, OPM_errpos, OPM_breakpc;
-import INTEGER OPM_currFile, OPM_level, OPM_pc, OPM_entno;
+import 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 SET OPM_opt, OPM_glbopt;
-import BOOLEAN OPM_dontAsm, OPM_dontLink, OPM_mainProg, OPM_mainLinkStat, OPM_notColorOutput, OPM_forceNewSym, OPM_Verbose;
+import CHAR OPM_ResourceDir[1024];
import void OPM_CloseFiles (void);
import void OPM_CloseOldSym (void);
import void OPM_DeleteNewSym (void);
-import void OPM_FPrint (LONGINT *fp, LONGINT val);
-import void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr);
-import void OPM_FPrintReal (LONGINT *fp, REAL real);
-import void OPM_FPrintSet (LONGINT *fp, SET set);
+import void OPM_FPrint (INT32 *fp, INT64 val);
+import void OPM_FPrintLReal (INT32 *fp, LONGREAL val);
+import void OPM_FPrintReal (INT32 *fp, REAL val);
+import void OPM_FPrintSet (INT32 *fp, UINT64 val);
import void OPM_Get (CHAR *ch);
import void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
import void OPM_InitOptions (void);
+import INT16 OPM_Integer (INT64 n);
+import void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
import void OPM_LogW (CHAR ch);
import void OPM_LogWLn (void);
-import void OPM_LogWNum (LONGINT i, LONGINT len);
+import void OPM_LogWNum (INT64 i, INT64 len);
import void OPM_LogWStr (CHAR *s, LONGINT s__len);
-import void OPM_Mark (INTEGER n, LONGINT pos);
+import INT32 OPM_Longint (INT64 n);
+import void OPM_Mark (INT16 n, INT32 pos);
import void OPM_NewSym (CHAR *modName, LONGINT modName__len);
import void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
import void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
import BOOLEAN OPM_OpenPar (void);
import void OPM_RegisterNewSym (void);
-import LONGINT OPM_SignedMaximum (LONGINT bytecount);
-import LONGINT OPM_SignedMinimum (LONGINT bytecount);
+import INT64 OPM_SignedMaximum (INT32 bytecount);
+import INT64 OPM_SignedMinimum (INT32 bytecount);
import void OPM_SymRCh (CHAR *ch);
-import LONGINT OPM_SymRInt (void);
+import INT32 OPM_SymRInt (void);
+import INT64 OPM_SymRInt64 (void);
import void OPM_SymRLReal (LONGREAL *lr);
import void OPM_SymRReal (REAL *r);
-import void OPM_SymRSet (SET *s);
+import void OPM_SymRSet (UINT64 *s);
import void OPM_SymWCh (CHAR ch);
-import void OPM_SymWInt (LONGINT i);
+import void OPM_SymWInt (INT64 i);
import void OPM_SymWLReal (LONGREAL lr);
import void OPM_SymWReal (REAL r);
-import void OPM_SymWSet (SET s);
+import void OPM_SymWSet (UINT64 s);
import void OPM_Write (CHAR ch);
-import void OPM_WriteHex (LONGINT i);
-import void OPM_WriteInt (LONGINT i);
+import void OPM_WriteHex (INT64 i);
+import void OPM_WriteInt (INT64 i);
import void OPM_WriteLn (void);
import void OPM_WriteReal (LONGREAL r, CHAR suffx);
import void OPM_WriteString (CHAR *s, LONGINT s__len);
import void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
import BOOLEAN OPM_eofSF (void);
-import void OPM_err (INTEGER n);
+import void OPM_err (INT16 n);
import void *OPM__init(void);
-#endif
+#endif // OPM
diff --git a/bootstrap/unix-48/OPP.c b/bootstrap/unix-48/OPP.c
index 01d2144d..3f360d00 100644
--- a/bootstrap/unix-48/OPP.c
+++ b/bootstrap/unix-48/OPP.c
@@ -1,4 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "OPB.h"
#include "OPM.h"
@@ -6,38 +12,38 @@
#include "OPT.h"
struct OPP__1 {
- LONGINT low, high;
+ INT32 low, high;
};
typedef
struct OPP__1 OPP_CaseTable[128];
-static SHORTINT OPP_sym, OPP_level;
-static INTEGER OPP_LoopLevel;
+static INT8 OPP_sym, OPP_level;
+static INT16 OPP_LoopLevel;
static OPT_Node OPP_TDinit, OPP_lastTDinit;
-static INTEGER OPP_nofFwdPtr;
+static INT16 OPP_nofFwdPtr;
static OPT_Struct OPP_FwdPtr[64];
-export LONGINT *OPP__1__typ;
+export ADDRESS *OPP__1__typ;
static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar);
static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned);
static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq);
-static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab);
-static void OPP_CheckMark (SHORTINT *vis);
-static void OPP_CheckSym (INTEGER s);
-static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_);
+static void OPP_CaseLabelList (OPT_Node *lab, OPT_Struct LabelTyp, INT16 *n, OPP_CaseTable tab);
+static void OPP_CheckMark (INT8 *vis);
+static void OPP_CheckSym (INT16 s);
+static void OPP_CheckSysFlag (INT16 *sysflag, INT16 default_);
static void OPP_ConstExpression (OPT_Node *x);
static void OPP_Element (OPT_Node *x);
static void OPP_Expression (OPT_Node *x);
static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b);
static void OPP_Factor (OPT_Node *x);
static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp);
-export void OPP_Module (OPT_Node *prog, SET opt);
+export void OPP_Module (OPT_Node *prog, UINT32 opt);
static void OPP_PointerType (OPT_Struct *typ);
static void OPP_ProcedureDeclaration (OPT_Node *x);
-static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec);
+static void OPP_Receiver (INT8 *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec);
static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned);
static void OPP_Sets (OPT_Node *x);
static void OPP_SimpleExpression (OPT_Node *x);
@@ -46,19 +52,19 @@ static void OPP_StatSeq (OPT_Node *stat);
static void OPP_Term (OPT_Node *x);
static void OPP_Type (OPT_Struct *typ, OPT_Struct *banned);
static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned);
-static void OPP_err (INTEGER n);
+static void OPP_err (INT16 n);
static void OPP_qualident (OPT_Object *id);
static void OPP_selector (OPT_Node *x);
-static void OPP_err (INTEGER n)
+static void OPP_err (INT16 n)
{
OPM_err(n);
}
-static void OPP_CheckSym (INTEGER s)
+static void OPP_CheckSym (INT16 s)
{
- if ((int)OPP_sym == s) {
+ if ((INT16)OPP_sym == s) {
OPS_Get(&OPP_sym);
} else {
OPM_err(s);
@@ -68,7 +74,7 @@ static void OPP_CheckSym (INTEGER s)
static void OPP_qualident (OPT_Object *id)
{
OPT_Object obj = NIL;
- SHORTINT lev;
+ INT8 lev;
OPT_Find(&obj);
OPS_Get(&OPP_sym);
if ((((OPP_sym == 18 && obj != NIL)) && obj->mode == 11)) {
@@ -89,7 +95,7 @@ static void OPP_qualident (OPT_Object *id)
obj->adr = 0;
} else {
lev = obj->mnolev;
- if ((__IN(obj->mode, 0x06) && lev != OPP_level)) {
+ if ((__IN(obj->mode, 0x06, 32) && lev != OPP_level)) {
obj->leaf = 0;
if (lev > 0) {
OPB_StaticLink(OPP_level - lev);
@@ -104,11 +110,11 @@ static void OPP_ConstExpression (OPT_Node *x)
OPP_Expression(&*x);
if ((*x)->class != 7) {
OPP_err(50);
- *x = OPB_NewIntConst(((LONGINT)(1)));
+ *x = OPB_NewIntConst(1);
}
}
-static void OPP_CheckMark (SHORTINT *vis)
+static void OPP_CheckMark (INT8 *vis)
{
OPS_Get(&OPP_sym);
if (OPP_sym == 1 || OPP_sym == 7) {
@@ -126,17 +132,17 @@ static void OPP_CheckMark (SHORTINT *vis)
}
}
-static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_)
+static void OPP_CheckSysFlag (INT16 *sysflag, INT16 default_)
{
OPT_Node x = NIL;
- LONGINT sf;
+ INT64 sf;
if (OPP_sym == 31) {
OPS_Get(&OPP_sym);
if (!OPT_SYSimported) {
OPP_err(135);
}
OPP_ConstExpression(&x);
- if (__IN(x->typ->form, 0x70)) {
+ if (x->typ->form == 4) {
sf = x->conval->intval;
if (sf < 0 || sf > 1) {
OPP_err(220);
@@ -146,7 +152,7 @@ static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_)
OPP_err(51);
sf = 0;
}
- *sysflag = (int)sf;
+ *sysflag = OPM_Integer(sf);
OPP_CheckSym(23);
} else {
*sysflag = default_;
@@ -157,8 +163,8 @@ static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned)
{
OPT_Object fld = NIL, first = NIL, last = NIL, base = NIL;
OPT_Struct ftyp = NIL;
- INTEGER sysflag;
- *typ = OPT_NewStr(15, 4);
+ INT16 sysflag;
+ *typ = OPT_NewStr(13, 4);
(*typ)->BaseTyp = NIL;
OPP_CheckSysFlag(&sysflag, -1);
if (OPP_sym == 30) {
@@ -249,11 +255,11 @@ static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned)
static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned)
{
OPT_Node x = NIL;
- LONGINT n;
- INTEGER sysflag;
+ INT64 n;
+ INT16 sysflag;
OPP_CheckSysFlag(&sysflag, 0);
if (OPP_sym == 25) {
- *typ = OPT_NewStr(15, 3);
+ *typ = OPT_NewStr(13, 3);
(*typ)->mno = 0;
(*typ)->sysflag = sysflag;
OPS_Get(&OPP_sym);
@@ -265,10 +271,10 @@ static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned)
(*typ)->n = 0;
}
} else {
- *typ = OPT_NewStr(15, 2);
+ *typ = OPT_NewStr(13, 2);
(*typ)->sysflag = sysflag;
OPP_ConstExpression(&x);
- if (__IN(x->typ->form, 0x70)) {
+ if (x->typ->form == 4) {
n = x->conval->intval;
if (n <= 0 || n > OPM_MaxIndex) {
OPP_err(63);
@@ -278,7 +284,7 @@ static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned)
OPP_err(51);
n = 1;
}
- (*typ)->n = n;
+ (*typ)->n = OPM_Longint(n);
if (OPP_sym == 25) {
OPS_Get(&OPP_sym);
OPP_Type(&(*typ)->BaseTyp, &*banned);
@@ -301,26 +307,26 @@ static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned)
static void OPP_PointerType (OPT_Struct *typ)
{
OPT_Object id = NIL;
- *typ = OPT_NewStr(13, 1);
+ *typ = OPT_NewStr(11, 1);
OPP_CheckSysFlag(&(*typ)->sysflag, 0);
OPP_CheckSym(28);
if (OPP_sym == 38) {
OPT_Find(&id);
if (id == NIL) {
if (OPP_nofFwdPtr < 64) {
- OPP_FwdPtr[__X(OPP_nofFwdPtr, ((LONGINT)(64)))] = *typ;
+ OPP_FwdPtr[__X(OPP_nofFwdPtr, 64)] = *typ;
OPP_nofFwdPtr += 1;
} else {
OPP_err(224);
}
(*typ)->link = OPT_NewObj();
- __COPY(OPS_name, (*typ)->link->name, ((LONGINT)(256)));
+ __COPY(OPS_name, (*typ)->link->name, 256);
(*typ)->BaseTyp = OPT_undftyp;
OPS_Get(&OPP_sym);
} else {
OPP_qualident(&id);
if (id->mode == 5) {
- if (__IN(id->typ->comp, 0x1c)) {
+ if (__IN(id->typ->comp, 0x1c, 32)) {
(*typ)->BaseTyp = id->typ;
} else {
(*typ)->BaseTyp = OPT_undftyp;
@@ -333,7 +339,7 @@ static void OPP_PointerType (OPT_Struct *typ)
}
} else {
OPP_Type(&(*typ)->BaseTyp, &OPT_notyp);
- if (!__IN((*typ)->BaseTyp->comp, 0x1c)) {
+ if (!__IN((*typ)->BaseTyp->comp, 0x1c, 32)) {
(*typ)->BaseTyp = OPT_undftyp;
OPP_err(57);
}
@@ -342,7 +348,7 @@ static void OPP_PointerType (OPT_Struct *typ)
static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp)
{
- SHORTINT mode;
+ INT8 mode;
OPT_Object par = NIL, first = NIL, last = NIL, res = NIL;
OPT_Struct typ = NIL;
first = NIL;
@@ -386,6 +392,9 @@ static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp)
}
OPP_CheckSym(20);
OPP_Type(&typ, &OPT_notyp);
+ if (((typ->comp == 2 || typ->comp == 4) && typ->strobj == NIL)) {
+ OPP_err(-309);
+ }
if (mode == 1) {
typ->pvused = 1;
}
@@ -409,7 +418,7 @@ static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp)
if (OPP_sym == 38) {
OPP_qualident(&res);
if (res->mode == 5) {
- if (res->typ->form < 15) {
+ if (res->typ->form < 13) {
*resTyp = res->typ;
} else {
OPP_err(54);
@@ -459,7 +468,7 @@ static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned)
OPP_PointerType(&*typ);
} else if (OPP_sym == 61) {
OPS_Get(&OPP_sym);
- *typ = OPT_NewStr(14, 1);
+ *typ = OPT_NewStr(12, 1);
OPP_CheckSysFlag(&(*typ)->sysflag, 0);
if (OPP_sym == 30) {
OPS_Get(&OPP_sym);
@@ -488,7 +497,7 @@ static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned)
static void OPP_Type (OPT_Struct *typ, OPT_Struct *banned)
{
OPP_TypeDecl(&*typ, &*banned);
- if (((((*typ)->form == 13 && (*typ)->BaseTyp == OPT_undftyp)) && (*typ)->strobj == NIL)) {
+ if (((((*typ)->form == 11 && (*typ)->BaseTyp == OPT_undftyp)) && (*typ)->strobj == NIL)) {
OPP_err(0);
}
}
@@ -503,7 +512,7 @@ static void OPP_selector (OPT_Node *x)
if (OPP_sym == 31) {
OPS_Get(&OPP_sym);
for (;;) {
- if (((*x)->typ != NIL && (*x)->typ->form == 13)) {
+ if (((*x)->typ != NIL && (*x)->typ->form == 11)) {
OPB_DeRef(&*x);
}
OPP_Expression(&y);
@@ -518,10 +527,10 @@ static void OPP_selector (OPT_Node *x)
} else if (OPP_sym == 18) {
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
- __COPY(OPS_name, name, ((LONGINT)(256)));
+ __COPY(OPS_name, name, 256);
OPS_Get(&OPP_sym);
if ((*x)->typ != NIL) {
- if ((*x)->typ->form == 13) {
+ if ((*x)->typ->form == 11) {
OPB_DeRef(&*x);
}
if ((*x)->typ->comp == 4) {
@@ -543,7 +552,7 @@ static void OPP_selector (OPT_Node *x)
OPP_err(75);
}
typ = y->obj->typ;
- if (typ->form == 13) {
+ if (typ->form == 11) {
typ = typ->BaseTyp;
}
OPT_FindField((*x)->obj->name, typ->BaseTyp, &proc);
@@ -572,7 +581,7 @@ static void OPP_selector (OPT_Node *x)
} else if (OPP_sym == 17) {
OPS_Get(&OPP_sym);
OPB_DeRef(&*x);
- } else if ((((((OPP_sym == 30 && (*x)->class < 7)) && (*x)->typ->form != 14)) && ((*x)->obj == NIL || (*x)->obj->mode != 13))) {
+ } else if ((((((OPP_sym == 30 && (*x)->class < 7)) && (*x)->typ->form != 12)) && ((*x)->obj == NIL || (*x)->obj->mode != 13))) {
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
OPP_qualident(&obj);
@@ -623,9 +632,9 @@ static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar)
static void OPP_StandProcCall (OPT_Node *x)
{
OPT_Node y = NIL;
- SHORTINT m;
- INTEGER n;
- m = (int)(*x)->obj->adr;
+ INT8 m;
+ INT16 n;
+ m = (INT8)((INT16)(*x)->obj->adr);
n = 0;
if (OPP_sym == 30) {
OPS_Get(&OPP_sym);
@@ -742,8 +751,8 @@ static void OPP_Factor (OPT_Node *x)
*x = OPB_NewRealConst(OPS_lrlval, OPT_lrltyp);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPP.Factor, OPS.numtyp = ", (LONGINT)44);
- OPM_LogWNum(OPS_numtyp, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPP.Factor, OPS.numtyp = ", 44);
+ OPM_LogWNum(OPS_numtyp, 0);
OPM_LogWLn();
break;
}
@@ -776,7 +785,7 @@ static void OPP_Factor (OPT_Node *x)
*x = NIL;
}
if (*x == NIL) {
- *x = OPB_NewIntConst(((LONGINT)(1)));
+ *x = OPB_NewIntConst(1);
(*x)->typ = OPT_undftyp;
}
}
@@ -784,7 +793,7 @@ static void OPP_Factor (OPT_Node *x)
static void OPP_Term (OPT_Node *x)
{
OPT_Node y = NIL;
- SHORTINT mulop;
+ INT8 mulop;
OPP_Factor(&*x);
while ((1 <= OPP_sym && OPP_sym <= 5)) {
mulop = OPP_sym;
@@ -797,7 +806,7 @@ static void OPP_Term (OPT_Node *x)
static void OPP_SimpleExpression (OPT_Node *x)
{
OPT_Node y = NIL;
- SHORTINT addop;
+ INT8 addop;
if (OPP_sym == 7) {
OPS_Get(&OPP_sym);
OPP_Term(&*x);
@@ -821,7 +830,7 @@ static void OPP_Expression (OPT_Node *x)
{
OPT_Node y = NIL;
OPT_Object obj = NIL;
- SHORTINT relation;
+ INT8 relation;
OPP_SimpleExpression(&*x);
if ((9 <= OPP_sym && OPP_sym <= 14)) {
relation = OPP_sym;
@@ -847,7 +856,7 @@ static void OPP_Expression (OPT_Node *x)
}
}
-static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec)
+static void OPP_Receiver (INT8 *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec)
{
OPT_Object obj = NIL;
*typ = OPT_undftyp;
@@ -858,7 +867,7 @@ static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_St
} else {
*mode = 1;
}
- __COPY(OPS_name, name, ((LONGINT)(256)));
+ __COPY(OPS_name, name, 256);
OPP_CheckSym(38);
OPP_CheckSym(20);
if (OPP_sym == 38) {
@@ -871,10 +880,10 @@ static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_St
} else {
*typ = obj->typ;
*rec = *typ;
- if ((*rec)->form == 13) {
+ if ((*rec)->form == 11) {
*rec = (*rec)->BaseTyp;
}
- if (!((((*mode == 1 && (*typ)->form == 13)) && (*rec)->comp == 4) || (*mode == 2 && (*typ)->comp == 4))) {
+ if (!((((*mode == 1 && (*typ)->form == 11)) && (*rec)->comp == 4) || (*mode == 2 && (*typ)->comp == 4))) {
OPP_err(70);
*rec = NIL;
}
@@ -888,15 +897,14 @@ static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_St
}
OPP_CheckSym(22);
if (*rec == NIL) {
- *rec = OPT_NewStr(15, 4);
+ *rec = OPT_NewStr(13, 4);
(*rec)->BaseTyp = NIL;
}
}
static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b)
{
- BOOLEAN _o_result;
- if ((b->form == 13 && x->form == 13)) {
+ if ((b->form == 11 && x->form == 11)) {
b = b->BaseTyp;
x = x->BaseTyp;
}
@@ -905,15 +913,14 @@ static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b)
x = x->BaseTyp;
} while (!(x == NIL || x == b));
}
- _o_result = x == b;
- return _o_result;
+ return x == b;
}
static struct ProcedureDeclaration__16 {
OPT_Node *x;
OPT_Object *proc, *fwd;
OPS_Name *name;
- SHORTINT *mode, *vis;
+ INT8 *mode, *vis;
BOOLEAN *forward;
struct ProcedureDeclaration__16 *lnk;
} *ProcedureDeclaration__16_s;
@@ -926,14 +933,14 @@ static void TProcDecl__23 (void);
static void GetCode__19 (void)
{
OPT_ConstExt ext = NIL;
- INTEGER n;
- LONGINT c;
+ INT16 n;
+ INT64 c;
ext = OPT_NewExt();
(*ProcedureDeclaration__16_s->proc)->conval->ext = ext;
n = 0;
if (OPP_sym == 37) {
- while (OPS_str[__X(n, ((LONGINT)(256)))] != 0x00) {
- (*ext)[__X(n + 1, ((LONGINT)(256)))] = OPS_str[__X(n, ((LONGINT)(256)))];
+ while (OPS_str[__X(n, 256)] != 0x00) {
+ (*ext)[__X(n + 1, 256)] = OPS_str[__X(n, 256)];
n += 1;
}
(*ext)[0] = (CHAR)n;
@@ -949,7 +956,7 @@ static void GetCode__19 (void)
n = 1;
}
OPS_Get(&OPP_sym);
- (*ext)[__X(n, ((LONGINT)(256)))] = (CHAR)c;
+ (*ext)[__X(n, 256)] = (CHAR)c;
}
if (OPP_sym == 19) {
OPS_Get(&OPP_sym);
@@ -961,7 +968,7 @@ static void GetCode__19 (void)
}
}
}
- (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1);
+ (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1,64);
}
static void GetParams__21 (void)
@@ -991,9 +998,9 @@ static void GetParams__21 (void)
static void Body__17 (void)
{
OPT_Node procdec = NIL, statseq = NIL;
- LONGINT c;
+ INT32 c;
c = OPM_errpos;
- (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1);
+ (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1,64);
OPP_CheckSym(39);
OPP_Block(&procdec, &statseq);
OPB_Enter(&procdec, statseq, *ProcedureDeclaration__16_s->proc);
@@ -1014,7 +1021,7 @@ static void TProcDecl__23 (void)
{
OPT_Object baseProc = NIL;
OPT_Struct objTyp = NIL, recTyp = NIL;
- SHORTINT objMode;
+ INT8 objMode;
OPS_Name objName;
OPS_Get(&OPP_sym);
*ProcedureDeclaration__16_s->mode = 13;
@@ -1023,7 +1030,7 @@ static void TProcDecl__23 (void)
}
OPP_Receiver(&objMode, objName, &objTyp, &recTyp);
if (OPP_sym == 38) {
- __COPY(OPS_name, *ProcedureDeclaration__16_s->name, ((LONGINT)(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);
@@ -1036,7 +1043,7 @@ static void TProcDecl__23 (void)
if ((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mnolev != OPP_level)) {
*ProcedureDeclaration__16_s->fwd = NIL;
}
- if ((((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mode == 13)) && !__IN(1, (*ProcedureDeclaration__16_s->fwd)->conval->setval))) {
+ if ((((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mode == 13)) && !__IN(1, (*ProcedureDeclaration__16_s->fwd)->conval->setval, 64))) {
*ProcedureDeclaration__16_s->proc = OPT_NewObj();
(*ProcedureDeclaration__16_s->proc)->leaf = 1;
if ((*ProcedureDeclaration__16_s->fwd)->vis != *ProcedureDeclaration__16_s->vis) {
@@ -1070,7 +1077,7 @@ static void TProcDecl__23 (void)
if ((((((baseProc->vis == 1 && (*ProcedureDeclaration__16_s->proc)->vis == 0)) && recTyp->strobj != NIL)) && recTyp->strobj->vis == 1)) {
OPP_err(109);
}
- (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(2);
+ (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(2,64);
}
if (!*ProcedureDeclaration__16_s->forward) {
Body__17();
@@ -1086,7 +1093,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
{
OPT_Object proc = NIL, fwd = NIL;
OPS_Name name;
- SHORTINT mode, vis;
+ INT8 mode, vis;
BOOLEAN forward;
struct ProcedureDeclaration__16 _s;
_s.x = x;
@@ -1113,7 +1120,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
} else {
OPP_err(38);
}
- if ((__IN(mode, 0x0600) && !OPT_SYSimported)) {
+ if ((__IN(mode, 0x0600, 32) && !OPT_SYSimported)) {
OPP_err(135);
}
OPS_Get(&OPP_sym);
@@ -1122,7 +1129,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
TProcDecl__23();
} else if (OPP_sym == 38) {
OPT_Find(&fwd);
- __COPY(OPS_name, name, ((LONGINT)(256)));
+ __COPY(OPS_name, name, 256);
OPP_CheckMark(&vis);
if ((vis != 0 && mode == 6)) {
mode = 7;
@@ -1130,7 +1137,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
if ((fwd != NIL && (fwd->mnolev != OPP_level || fwd->mode == 8))) {
fwd = NIL;
}
- if ((((fwd != NIL && __IN(fwd->mode, 0xc0))) && !__IN(1, fwd->conval->setval))) {
+ if ((((fwd != NIL && __IN(fwd->mode, 0xc0, 32))) && !__IN(1, fwd->conval->setval, 64))) {
proc = OPT_NewObj();
proc->leaf = 1;
if (fwd->vis != vis) {
@@ -1163,34 +1170,34 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
ProcedureDeclaration__16_s = _s.lnk;
}
-static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab)
+static void OPP_CaseLabelList (OPT_Node *lab, OPT_Struct LabelTyp, INT16 *n, OPP_CaseTable tab)
{
OPT_Node x = NIL, y = NIL, lastlab = NIL;
- INTEGER i, f;
- LONGINT xval, yval;
+ INT16 i, f;
+ INT32 xval, yval;
*lab = NIL;
lastlab = NIL;
for (;;) {
OPP_ConstExpression(&x);
f = x->typ->form;
- if (__IN(f, 0x78)) {
- xval = x->conval->intval;
+ if (__IN(f, 0x18, 32)) {
+ xval = OPM_Longint(x->conval->intval);
} else {
OPP_err(61);
xval = 1;
}
- if (__IN(f, 0x70)) {
- if (LabelForm < f) {
+ if (f == 4) {
+ if (!(LabelTyp->form == 4) || LabelTyp->size < x->typ->size) {
OPP_err(60);
}
- } else if (LabelForm != f) {
+ } else if ((INT16)LabelTyp->form != f) {
OPP_err(60);
}
if (OPP_sym == 21) {
OPS_Get(&OPP_sym);
OPP_ConstExpression(&y);
- yval = y->conval->intval;
- if (((int)y->typ->form != f && !((__IN(f, 0x70) && __IN(y->typ->form, 0x70))))) {
+ yval = OPM_Longint(y->conval->intval);
+ if (((INT16)y->typ->form != f && !((f == 4 && y->typ->form == 4)))) {
OPP_err(60);
}
if (yval < xval) {
@@ -1207,17 +1214,17 @@ static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP
if (i == 0) {
break;
}
- if (tab[__X(i - 1, ((LONGINT)(128)))].low <= yval) {
- if (tab[__X(i - 1, ((LONGINT)(128)))].high >= xval) {
+ if (tab[__X(i - 1, 128)].low <= yval) {
+ if (tab[__X(i - 1, 128)].high >= xval) {
OPP_err(62);
}
break;
}
- tab[__X(i, ((LONGINT)(128)))] = tab[__X(i - 1, ((LONGINT)(128)))];
+ tab[__X(i, 128)] = tab[__X(i - 1, 128)];
i -= 1;
}
- tab[__X(i, ((LONGINT)(128)))].low = xval;
- tab[__X(i, ((LONGINT)(128)))].high = yval;
+ tab[__X(i, 128)].low = xval;
+ tab[__X(i, 128)].high = yval;
*n += 1;
} else {
OPP_err(213);
@@ -1234,7 +1241,7 @@ static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP
}
static struct StatSeq__30 {
- LONGINT *pos;
+ INT32 *pos;
struct StatSeq__30 *lnk;
} *StatSeq__30_s;
@@ -1244,8 +1251,8 @@ static void SetPos__35 (OPT_Node x);
static void CasePart__31 (OPT_Node *x)
{
- INTEGER n;
- LONGINT low, high;
+ INT16 n;
+ INT32 low, high;
BOOLEAN e;
OPP_CaseTable tab;
OPT_Node cases = NIL, lab = NIL, y = NIL, lastcase = NIL;
@@ -1253,7 +1260,7 @@ static void CasePart__31 (OPT_Node *x)
*StatSeq__30_s->pos = OPM_errpos;
if ((*x)->class == 8 || (*x)->class == 9) {
OPP_err(126);
- } else if (!__IN((*x)->typ->form, 0x78)) {
+ } else if (!__IN((*x)->typ->form, 0x18, 32)) {
OPP_err(125);
}
OPP_CheckSym(25);
@@ -1262,7 +1269,7 @@ static void CasePart__31 (OPT_Node *x)
n = 0;
for (;;) {
if (OPP_sym < 40) {
- OPP_CaseLabelList(&lab, (*x)->typ->form, &n, tab);
+ OPP_CaseLabelList(&lab, (*x)->typ, &n, tab);
OPP_CheckSym(20);
OPP_StatSeq(&y);
OPB_Construct(17, &lab, y);
@@ -1276,7 +1283,7 @@ static void CasePart__31 (OPT_Node *x)
}
if (n > 0) {
low = tab[0].low;
- high = tab[__X(n - 1, ((LONGINT)(128)))].high;
+ high = tab[__X(n - 1, 128)].high;
if (high - low > 512) {
OPP_err(209);
}
@@ -1328,7 +1335,7 @@ static void OPP_StatSeq (OPT_Node *stat)
OPT_Struct idtyp = NIL;
BOOLEAN e;
OPT_Node s = NIL, x = NIL, y = NIL, z = NIL, apar = NIL, last = NIL, lastif = NIL;
- LONGINT pos;
+ INT32 pos;
OPS_Name name;
struct StatSeq__30 _s;
_s.pos = &pos;
@@ -1439,7 +1446,7 @@ static void OPP_StatSeq (OPT_Node *stat)
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
OPP_qualident(&id);
- if (!__IN(id->typ->form, 0x70)) {
+ if (!(id->typ->form == 4)) {
OPP_err(68);
}
OPP_CheckSym(34);
@@ -1471,7 +1478,7 @@ static void OPP_StatSeq (OPT_Node *stat)
SetPos__35(z);
OPB_Link(&*stat, &last, z);
y = OPB_NewLeaf(t);
- } else if (y->typ->form < 4 || y->typ->form > x->left->typ->form) {
+ } else if (!(y->typ->form == 4) || y->typ->size > x->left->typ->size) {
OPP_err(113);
}
OPB_Link(&*stat, &last, x);
@@ -1479,7 +1486,7 @@ static void OPP_StatSeq (OPT_Node *stat)
OPS_Get(&OPP_sym);
OPP_ConstExpression(&z);
} else {
- z = OPB_NewIntConst(((LONGINT)(1)));
+ z = OPB_NewIntConst(1);
}
pos = OPM_errpos;
x = OPB_NewLeaf(id);
@@ -1526,7 +1533,7 @@ static void OPP_StatSeq (OPT_Node *stat)
if (OPP_sym == 38) {
OPP_qualident(&id);
y = OPB_NewLeaf(id);
- if ((((id != NIL && id->typ->form == 13)) && (id->mode == 2 || !id->leaf))) {
+ if ((((id != NIL && id->typ->form == 11)) && (id->mode == 2 || !id->leaf))) {
OPP_err(245);
}
OPP_CheckSym(20);
@@ -1621,7 +1628,7 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
OPT_Struct typ = NIL;
OPT_Object obj = NIL, first = NIL, last = NIL;
OPT_Node x = NIL, lastdec = NIL;
- INTEGER i;
+ INT16 i;
first = NIL;
last = NIL;
OPP_nofFwdPtr = 0;
@@ -1642,7 +1649,7 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
OPP_ConstExpression(&x);
} else {
OPP_err(9);
- x = OPB_NewIntConst(((LONGINT)(1)));
+ x = OPB_NewIntConst(1);
}
obj->mode = 3;
obj->typ = x->typ;
@@ -1670,10 +1677,10 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
if (obj->typ->strobj == NIL) {
obj->typ->strobj = obj;
}
- if (__IN(obj->typ->comp, 0x1c)) {
+ if (__IN(obj->typ->comp, 0x1c, 32)) {
i = 0;
while (i < OPP_nofFwdPtr) {
- typ = OPP_FwdPtr[__X(i, ((LONGINT)(64)))];
+ typ = OPP_FwdPtr[__X(i, 64)];
i += 1;
if (__STRCMP(typ->link->name, obj->name) == 0) {
typ->BaseTyp = obj->typ;
@@ -1735,10 +1742,10 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
}
i = 0;
while (i < OPP_nofFwdPtr) {
- if (OPP_FwdPtr[__X(i, ((LONGINT)(64)))]->link->name[0] != 0x00) {
+ if (OPP_FwdPtr[__X(i, 64)]->link->name[0] != 0x00) {
OPP_err(128);
}
- OPP_FwdPtr[__X(i, ((LONGINT)(64)))] = NIL;
+ OPP_FwdPtr[__X(i, 64)] = NIL;
i += 1;
}
OPT_topScope->adr = OPM_errpos;
@@ -1770,11 +1777,11 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
OPP_CheckSym(41);
}
-void OPP_Module (OPT_Node *prog, SET opt)
+void OPP_Module (OPT_Node *prog, UINT32 opt)
{
OPS_Name impName, aliasName;
OPT_Node procdec = NIL, statseq = NIL;
- LONGINT c;
+ INT32 c;
BOOLEAN done;
OPS_Init();
OPP_LoopLevel = 0;
@@ -1784,28 +1791,28 @@ void OPP_Module (OPT_Node *prog, SET opt)
OPS_Get(&OPP_sym);
} else {
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Unexpected symbol found when MODULE expected:", (LONGINT)46);
+ OPM_LogWStr((CHAR*)"Unexpected symbol found when MODULE expected:", 46);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" sym: ", (LONGINT)15);
- OPM_LogWNum(OPP_sym, ((LONGINT)(1)));
+ OPM_LogWStr((CHAR*)" sym: ", 15);
+ OPM_LogWNum(OPP_sym, 1);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.name: ", (LONGINT)15);
- OPM_LogWStr(OPS_name, ((LONGINT)(256)));
+ OPM_LogWStr((CHAR*)" OPS.name: ", 15);
+ OPM_LogWStr(OPS_name, 256);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.str: ", (LONGINT)15);
- OPM_LogWStr(OPS_str, ((LONGINT)(256)));
+ OPM_LogWStr((CHAR*)" OPS.str: ", 15);
+ OPM_LogWStr(OPS_str, 256);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.numtyp: ", (LONGINT)15);
- OPM_LogWNum(OPS_numtyp, ((LONGINT)(1)));
+ OPM_LogWStr((CHAR*)" OPS.numtyp: ", 15);
+ OPM_LogWNum(OPS_numtyp, 1);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.intval: ", (LONGINT)15);
- OPM_LogWNum(OPS_intval, ((LONGINT)(1)));
+ OPM_LogWStr((CHAR*)" OPS.intval: ", 15);
+ OPM_LogWNum(OPS_intval, 1);
OPM_LogWLn();
OPP_err(16);
}
if (OPP_sym == 38) {
- OPM_LogWStr((CHAR*)"compiling ", (LONGINT)11);
- OPM_LogWStr(OPS_name, ((LONGINT)(256)));
+ OPM_LogWStr((CHAR*)"compiling ", 11);
+ OPM_LogWStr(OPS_name, 256);
OPM_LogW('.');
OPT_Init(OPS_name, opt);
OPS_Get(&OPP_sym);
@@ -1814,13 +1821,13 @@ void OPP_Module (OPT_Node *prog, SET opt)
OPS_Get(&OPP_sym);
for (;;) {
if (OPP_sym == 38) {
- __COPY(OPS_name, aliasName, ((LONGINT)(256)));
- __COPY(aliasName, impName, ((LONGINT)(256)));
+ __COPY(OPS_name, aliasName, 256);
+ __COPY(aliasName, impName, 256);
OPS_Get(&OPP_sym);
if (OPP_sym == 34) {
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
- __COPY(OPS_name, impName, ((LONGINT)(256)));
+ __COPY(OPS_name, impName, 256);
OPS_Get(&OPP_sym);
} else {
OPP_err(38);
diff --git a/bootstrap/unix-48/OPP.h b/bootstrap/unix-48/OPP.h
index bf56b7d7..5a71eb39 100644
--- a/bootstrap/unix-48/OPP.h
+++ b/bootstrap/unix-48/OPP.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPP__h
#define OPP__h
@@ -9,8 +9,8 @@
-import void OPP_Module (OPT_Node *prog, SET opt);
+import void OPP_Module (OPT_Node *prog, UINT32 opt);
import void *OPP__init(void);
-#endif
+#endif // OPP
diff --git a/bootstrap/unix-48/OPS.c b/bootstrap/unix-48/OPS.c
index cacf9256..6ee700e5 100644
--- a/bootstrap/unix-48/OPS.c
+++ b/bootstrap/unix-48/OPS.c
@@ -1,4 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "OPM.h"
@@ -11,29 +17,29 @@ typedef
export OPS_Name OPS_name;
export OPS_String OPS_str;
-export INTEGER OPS_numtyp;
-export LONGINT OPS_intval;
+export INT16 OPS_numtyp;
+export INT64 OPS_intval;
export REAL OPS_realval;
export LONGREAL OPS_lrlval;
static CHAR OPS_ch;
-export void OPS_Get (SHORTINT *sym);
-static void OPS_Identifier (SHORTINT *sym);
+export void OPS_Get (INT8 *sym);
+static void OPS_Identifier (INT8 *sym);
export void OPS_Init (void);
static void OPS_Number (void);
-static void OPS_Str (SHORTINT *sym);
-static void OPS_err (INTEGER n);
+static void OPS_Str (INT8 *sym);
+static void OPS_err (INT16 n);
-static void OPS_err (INTEGER n)
+static void OPS_err (INT16 n)
{
OPM_err(n);
}
-static void OPS_Str (SHORTINT *sym)
+static void OPS_Str (INT8 *sym)
{
- INTEGER i;
+ INT16 i;
CHAR och;
i = 0;
och = OPS_ch;
@@ -59,15 +65,15 @@ static void OPS_Str (SHORTINT *sym)
if (OPS_intval == 2) {
*sym = 35;
OPS_numtyp = 1;
- OPS_intval = (int)OPS_str[0];
+ OPS_intval = (INT16)OPS_str[0];
} else {
*sym = 37;
}
}
-static void OPS_Identifier (SHORTINT *sym)
+static void OPS_Identifier (INT8 *sym)
{
- INTEGER i;
+ INT16 i;
i = 0;
do {
OPS_name[i] = OPS_ch;
@@ -86,12 +92,11 @@ static struct Number__6 {
struct Number__6 *lnk;
} *Number__6_s;
-static INTEGER Ord__7 (CHAR ch, BOOLEAN hex);
-static LONGREAL Ten__9 (INTEGER e);
+static INT16 Ord__7 (CHAR ch, BOOLEAN hex);
+static LONGREAL Ten__9 (INT16 e);
-static LONGREAL Ten__9 (INTEGER e)
+static LONGREAL Ten__9 (INT16 e)
{
- LONGREAL _o_result;
LONGREAL x, p;
x = (LONGREAL)1;
p = (LONGREAL)10;
@@ -104,30 +109,25 @@ static LONGREAL Ten__9 (INTEGER e)
p = p * p;
}
}
- _o_result = x;
- return _o_result;
+ return x;
}
-static INTEGER Ord__7 (CHAR ch, BOOLEAN hex)
+static INT16 Ord__7 (CHAR ch, BOOLEAN hex)
{
- INTEGER _o_result;
if (ch <= '9') {
- _o_result = (int)ch - 48;
- return _o_result;
+ return (INT16)ch - 48;
} else if (hex) {
- _o_result = ((int)ch - 65) + 10;
- return _o_result;
+ return ((INT16)ch - 65) + 10;
} else {
OPS_err(2);
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
static void OPS_Number (void)
{
- INTEGER i, m, n, d, e, maxHdig;
+ INT16 i, m, n, d, e;
CHAR dig[24];
LONGREAL f;
CHAR expCh;
@@ -173,7 +173,7 @@ static void OPS_Number (void)
OPS_numtyp = 1;
if (n <= 2) {
while (i < n) {
- OPS_intval = __ASHL(OPS_intval, 4) + (int)Ord__7(dig[i], 1);
+ OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1);
i += 1;
}
} else {
@@ -182,13 +182,12 @@ static void OPS_Number (void)
} else if (OPS_ch == 'H') {
OPM_Get(&OPS_ch);
OPS_numtyp = 2;
- maxHdig = 8;
- if (n <= maxHdig) {
- if ((n == maxHdig && dig[0] > '7')) {
+ if (n <= 16) {
+ if ((n == 16 && dig[0] > '7')) {
OPS_intval = -1;
}
while (i < n) {
- OPS_intval = __ASHL(OPS_intval, 4) + (int)Ord__7(dig[i], 1);
+ OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1);
i += 1;
}
} else {
@@ -199,8 +198,8 @@ static void OPS_Number (void)
while (i < n) {
d = Ord__7(dig[i], 0);
i += 1;
- if (OPS_intval <= __DIV(2147483647 - (int)d, 10)) {
- OPS_intval = OPS_intval * 10 + (int)d;
+ if (OPS_intval <= __DIV(9223372036854775807 - (INT64)d, 10)) {
+ OPS_intval = OPS_intval * 10 + (INT64)d;
} else {
OPS_err(203);
}
@@ -309,9 +308,9 @@ static void Comment__2 (void)
}
}
-void OPS_Get (SHORTINT *sym)
+void OPS_Get (INT8 *sym)
{
- SHORTINT s;
+ INT8 s;
struct Get__1 _s;
_s.lnk = Get__1_s;
Get__1_s = &_s;
@@ -319,6 +318,7 @@ void OPS_Get (SHORTINT *sym)
while (OPS_ch <= ' ') {
if (OPS_ch == 0x00) {
*sym = 64;
+ Get__1_s = _s.lnk;
return;
} else {
OPM_Get(&OPS_ch);
diff --git a/bootstrap/unix-48/OPS.h b/bootstrap/unix-48/OPS.h
index e901bcfc..1f7a3e58 100644
--- a/bootstrap/unix-48/OPS.h
+++ b/bootstrap/unix-48/OPS.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
#ifndef OPS__h
#define OPS__h
@@ -14,15 +14,15 @@ typedef
import OPS_Name OPS_name;
import OPS_String OPS_str;
-import INTEGER OPS_numtyp;
-import LONGINT OPS_intval;
+import INT16 OPS_numtyp;
+import INT64 OPS_intval;
import REAL OPS_realval;
import LONGREAL OPS_lrlval;
-import void OPS_Get (SHORTINT *sym);
+import void OPS_Get (INT8 *sym);
import void OPS_Init (void);
import void *OPS__init(void);
-#endif
+#endif // OPS
diff --git a/bootstrap/unix-48/OPT.c b/bootstrap/unix-48/OPT.c
index b32d0ebd..75820a95 100644
--- a/bootstrap/unix-48/OPT.c
+++ b/bootstrap/unix-48/OPT.c
@@ -1,4 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "OPM.h"
#include "OPS.h"
@@ -12,17 +18,18 @@ typedef
typedef
struct OPT_ConstDesc {
OPT_ConstExt ext;
- LONGINT intval, intval2;
- SET setval;
+ INT64 intval;
+ INT32 intval2;
+ UINT64 setval;
LONGREAL realval;
} OPT_ConstDesc;
typedef
struct OPT_ExpCtxt {
- LONGINT reffp;
- INTEGER ref;
- SHORTINT nofm;
- SHORTINT locmno[64];
+ INT32 reffp;
+ INT16 ref;
+ INT8 nofm;
+ INT8 locmno[64];
} OPT_ExpCtxt;
typedef
@@ -33,13 +40,13 @@ typedef
typedef
struct OPT_ImpCtxt {
- LONGINT nextTag, reffp;
- INTEGER nofr, minr, nofm;
+ INT32 nextTag, reffp;
+ INT16 nofr, minr, nofm;
BOOLEAN self;
OPT_Struct ref[255];
OPT_Object old[255];
- LONGINT pvfp[255];
- SHORTINT glbmno[64];
+ INT32 pvfp[255];
+ INT8 glbmno[64];
} OPT_ImpCtxt;
typedef
@@ -48,7 +55,7 @@ typedef
typedef
struct OPT_NodeDesc {
OPT_Node left, right, link;
- SHORTINT class, subcl;
+ INT8 class, subcl;
BOOLEAN readonly;
OPT_Struct typ;
OPT_Object obj;
@@ -60,120 +67,319 @@ typedef
OPT_Object left, right, link, scope;
OPS_Name name;
BOOLEAN leaf;
- SHORTINT mode, mnolev, vis, history;
+ INT8 mode, mnolev, vis, history;
BOOLEAN used, fpdone;
- LONGINT fprint;
+ INT32 fprint;
OPT_Struct typ;
OPT_Const conval;
- LONGINT adr, linkadr;
- INTEGER x;
+ INT32 adr, linkadr;
+ INT16 x;
} OPT_ObjDesc;
typedef
struct OPT_StrDesc {
- SHORTINT form, comp, mno, extlev;
- INTEGER ref, sysflag;
- LONGINT n, size, align, txtpos;
+ INT8 form, comp, mno, extlev;
+ INT16 ref, sysflag;
+ INT32 n, size, align, txtpos;
BOOLEAN allocated, pbused, pvused, fpdone, idfpdone;
- LONGINT idfp, pbfp, pvfp;
+ INT32 idfp, pbfp, pvfp;
OPT_Struct BaseTyp;
OPT_Object link, strobj;
} OPT_StrDesc;
-export void (*OPT_typSize)(OPT_Struct);
export OPT_Object OPT_topScope;
-export OPT_Struct OPT_undftyp, OPT_bytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_realtyp, OPT_lrltyp, OPT_settyp, OPT_stringtyp, OPT_niltyp, OPT_notyp, OPT_sysptrtyp;
-export SHORTINT OPT_nofGmod;
+export OPT_Struct OPT_undftyp, OPT_niltyp, OPT_notyp, OPT_bytetyp, OPT_cpbytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_hinttyp, OPT_int8typ, OPT_int16typ, OPT_int32typ, OPT_int64typ, OPT_settyp, OPT_set32typ, OPT_set64typ, OPT_realtyp, OPT_lrltyp, OPT_stringtyp, OPT_adrtyp, OPT_sysptrtyp;
+export OPT_Object OPT_sintobj, OPT_intobj, OPT_lintobj, OPT_setobj;
+export INT8 OPT_nofGmod;
export OPT_Object OPT_GlbMod[64];
export OPS_Name OPT_SelfName;
export BOOLEAN OPT_SYSimported;
static OPT_Object OPT_universe, OPT_syslink;
static OPT_ImpCtxt OPT_impCtxt;
static OPT_ExpCtxt OPT_expCtxt;
-static LONGINT OPT_nofhdfld;
+static INT32 OPT_nofhdfld;
static BOOLEAN OPT_newsf, OPT_findpc, OPT_extsf, OPT_sfpresent, OPT_symExtended, OPT_symNew;
+static INT32 OPT_recno;
-export LONGINT *OPT_ConstDesc__typ;
-export LONGINT *OPT_ObjDesc__typ;
-export LONGINT *OPT_StrDesc__typ;
-export LONGINT *OPT_NodeDesc__typ;
-export LONGINT *OPT_ImpCtxt__typ;
-export LONGINT *OPT_ExpCtxt__typ;
+export ADDRESS *OPT_ConstDesc__typ;
+export ADDRESS *OPT_ObjDesc__typ;
+export ADDRESS *OPT_StrDesc__typ;
+export ADDRESS *OPT_NodeDesc__typ;
+export ADDRESS *OPT_ImpCtxt__typ;
+export ADDRESS *OPT_ExpCtxt__typ;
+export void OPT_Align (INT32 *adr, INT32 base);
+export INT32 OPT_BaseAlignment (OPT_Struct typ);
export void OPT_Close (void);
export void OPT_CloseScope (void);
static void OPT_DebugStruct (OPT_Struct btyp);
-static void OPT_EnterBoolConst (OPS_Name name, LONGINT value);
-static void OPT_EnterProc (OPS_Name name, INTEGER num);
-static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct *res);
+static void OPT_EnterBoolConst (OPS_Name name, INT32 value);
+static void OPT_EnterProc (OPS_Name name, INT16 num);
+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, INTEGER errcode);
-static void OPT_FPrintName (LONGINT *fp, CHAR *name, LONGINT name__len);
+export void OPT_FPrintErr (OPT_Object obj, INT16 errcode);
+static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len);
export void OPT_FPrintObj (OPT_Object obj);
-static void OPT_FPrintSign (LONGINT *fp, OPT_Struct result, OPT_Object par);
+static void OPT_FPrintSign (INT32 *fp, OPT_Struct result, OPT_Object par);
export void OPT_FPrintStr (OPT_Struct typ);
export void OPT_Find (OPT_Object *res);
export void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res);
export void OPT_FindImport (OPT_Object mod, OPT_Object *res);
export void OPT_IdFPrint (OPT_Struct typ);
export void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done);
-static void OPT_InConstant (LONGINT f, OPT_Const conval);
+static void OPT_InConstant (INT32 f, OPT_Const conval);
static OPT_Object OPT_InFld (void);
-static void OPT_InMod (SHORTINT *mno);
+static void OPT_InMod (INT8 *mno);
static void OPT_InName (CHAR *name, LONGINT name__len);
-static OPT_Object OPT_InObj (SHORTINT mno);
-static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par);
+static 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);
-static OPT_Object OPT_InTProc (SHORTINT mno);
-export void OPT_Init (OPS_Name name, SET opt);
-static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form);
+static OPT_Object OPT_InTProc (INT8 mno);
+static OPT_Struct OPT_InTyp (INT32 tag);
+export void OPT_Init (OPS_Name name, UINT32 opt);
+export void OPT_InitRecno (void);
+static void OPT_InitStruct (OPT_Struct *typ, INT8 form);
export void OPT_Insert (OPS_Name name, OPT_Object *obj);
export void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old);
+export INT16 OPT_IntSize (INT64 n);
+export OPT_Struct OPT_IntType (INT32 size);
export OPT_Const OPT_NewConst (void);
export OPT_ConstExt OPT_NewExt (void);
-export OPT_Node OPT_NewNode (SHORTINT class);
+export OPT_Node OPT_NewNode (INT8 class);
export OPT_Object OPT_NewObj (void);
-export OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp);
-export void OPT_OpenScope (SHORTINT level, OPT_Object owner);
+export OPT_Struct OPT_NewStr (INT8 form, INT8 comp);
+export void OPT_OpenScope (INT8 level, OPT_Object owner);
static void OPT_OutConstant (OPT_Object obj);
-static void OPT_OutFlds (OPT_Object fld, LONGINT adr, BOOLEAN visible);
-static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr);
-static void OPT_OutMod (INTEGER mno);
+static void OPT_OutFlds (OPT_Object fld, INT32 adr, BOOLEAN visible);
+static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr);
+static void OPT_OutMod (INT16 mno);
static void OPT_OutName (CHAR *name, LONGINT name__len);
static void OPT_OutObj (OPT_Object obj);
static void OPT_OutSign (OPT_Struct result, OPT_Object par);
static void OPT_OutStr (OPT_Struct typ);
static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj);
-static void OPT_err (INTEGER n);
+export OPT_Struct OPT_SetType (INT32 size);
+export OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir);
+export INT32 OPT_SizeAlignment (INT32 size);
+export void OPT_TypSize (OPT_Struct typ);
+static void OPT_err (INT16 n);
-static void OPT_err (INTEGER n)
+void OPT_InitRecno (void)
+{
+ OPT_recno = 0;
+}
+
+static void OPT_err (INT16 n)
{
OPM_err(n);
}
+INT16 OPT_IntSize (INT64 n)
+{
+ INT16 bytes;
+ if (n < 0) {
+ n = -(n + 1);
+ }
+ bytes = 1;
+ while ((bytes < 8 && __ASH(n, -(__ASHL(bytes, 3) - 1)) != 0)) {
+ bytes += 1;
+ }
+ return bytes;
+}
+
+OPT_Struct OPT_IntType (INT32 size)
+{
+ if (size <= OPT_int8typ->size) {
+ return OPT_int8typ;
+ }
+ if (size <= OPT_int16typ->size) {
+ return OPT_int16typ;
+ }
+ if (size <= OPT_int32typ->size) {
+ return OPT_int32typ;
+ }
+ return OPT_int64typ;
+}
+
+OPT_Struct OPT_SetType (INT32 size)
+{
+ if (size == OPT_set32typ->size) {
+ return OPT_set32typ;
+ }
+ return OPT_set64typ;
+}
+
+OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir)
+{
+ INT16 i;
+ __ASSERT(x->form == 4, 0);
+ __ASSERT(x->BaseTyp == OPT_undftyp, 0);
+ __ASSERT(dir == 1 || dir == -1, 0);
+ if (dir > 0) {
+ if (x->size < OPT_sinttyp->size) {
+ return OPT_sinttyp;
+ }
+ if (x->size < OPT_inttyp->size) {
+ return OPT_inttyp;
+ }
+ if (x->size < OPT_linttyp->size) {
+ return OPT_linttyp;
+ }
+ return OPT_int64typ;
+ } else {
+ if (x->size > OPT_linttyp->size) {
+ return OPT_linttyp;
+ }
+ if (x->size > OPT_inttyp->size) {
+ return OPT_inttyp;
+ }
+ if (x->size > OPT_sinttyp->size) {
+ return OPT_sinttyp;
+ }
+ return OPT_int8typ;
+ }
+ __RETCHK;
+}
+
+void OPT_Align (INT32 *adr, INT32 base)
+{
+ switch (base) {
+ case 2:
+ *adr += __MASK(*adr, -2);
+ break;
+ case 4:
+ *adr += __MASK(-*adr, -4);
+ break;
+ case 8:
+ *adr += __MASK(-*adr, -8);
+ break;
+ case 16:
+ *adr += __MASK(-*adr, -16);
+ break;
+ default:
+ break;
+ }
+}
+
+INT32 OPT_SizeAlignment (INT32 size)
+{
+ INT32 alignment;
+ if (size < OPM_Alignment) {
+ alignment = 1;
+ while (alignment < size) {
+ alignment = __ASHL(alignment, 1);
+ }
+ } else {
+ alignment = OPM_Alignment;
+ }
+ return alignment;
+}
+
+INT32 OPT_BaseAlignment (OPT_Struct typ)
+{
+ INT32 alignment;
+ if (typ->form == 13) {
+ if (typ->comp == 4) {
+ alignment = __MASK(typ->align, -65536);
+ } else {
+ alignment = OPT_BaseAlignment(typ->BaseTyp);
+ }
+ } else {
+ alignment = OPT_SizeAlignment(typ->size);
+ }
+ return alignment;
+}
+
+void OPT_TypSize (OPT_Struct typ)
+{
+ INT16 f, c;
+ INT32 offset, size, base, fbase, off0;
+ OPT_Object fld = NIL;
+ OPT_Struct btyp = NIL;
+ if (typ == OPT_undftyp) {
+ OPM_err(58);
+ } else if (typ->size == -1) {
+ f = typ->form;
+ c = typ->comp;
+ if (c == 4) {
+ btyp = typ->BaseTyp;
+ if (btyp == NIL) {
+ offset = 0;
+ base = 1;
+ } else {
+ OPT_TypSize(btyp);
+ offset = btyp->size - __ASHR(btyp->sysflag, 8);
+ base = btyp->align;
+ }
+ fld = typ->link;
+ while ((fld != NIL && fld->mode == 4)) {
+ btyp = fld->typ;
+ OPT_TypSize(btyp);
+ size = btyp->size;
+ fbase = OPT_BaseAlignment(btyp);
+ OPT_Align(&offset, fbase);
+ fld->adr = offset;
+ offset += size;
+ if (fbase > base) {
+ base = fbase;
+ }
+ fld = fld->link;
+ }
+ off0 = offset;
+ if (offset == 0) {
+ offset = 1;
+ }
+ OPT_Align(&offset, base);
+ if ((typ->strobj == NIL && __MASK(typ->align, -65536) == 0)) {
+ OPT_recno += 1;
+ base += __ASHL(OPT_recno, 16);
+ }
+ typ->size = offset;
+ typ->align = base;
+ 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;
+ } else if (f == 11) {
+ typ->size = OPM_AddressSize;
+ if (typ->BaseTyp == OPT_undftyp) {
+ OPM_Mark(128, typ->n);
+ } else {
+ OPT_TypSize(typ->BaseTyp);
+ }
+ } else if (f == 12) {
+ typ->size = OPM_AddressSize;
+ } else if (c == 3) {
+ btyp = typ->BaseTyp;
+ OPT_TypSize(btyp);
+ if (btyp->comp == 3) {
+ typ->size = btyp->size + 4;
+ } else {
+ typ->size = 8;
+ }
+ }
+ }
+}
+
OPT_Const OPT_NewConst (void)
{
- OPT_Const _o_result;
OPT_Const const_ = NIL;
__NEW(const_, OPT_ConstDesc);
- _o_result = const_;
- return _o_result;
+ return const_;
}
OPT_Object OPT_NewObj (void)
{
- OPT_Object _o_result;
OPT_Object obj = NIL;
__NEW(obj, OPT_ObjDesc);
- _o_result = obj;
- return _o_result;
+ return obj;
}
-OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp)
+OPT_Struct OPT_NewStr (INT8 form, INT8 comp)
{
- OPT_Struct _o_result;
OPT_Struct typ = NIL;
__NEW(typ, OPT_StrDesc);
typ->form = form;
@@ -184,30 +390,25 @@ OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp)
}
typ->size = -1;
typ->BaseTyp = OPT_undftyp;
- _o_result = typ;
- return _o_result;
+ return typ;
}
-OPT_Node OPT_NewNode (SHORTINT class)
+OPT_Node OPT_NewNode (INT8 class)
{
- OPT_Node _o_result;
OPT_Node node = NIL;
__NEW(node, OPT_NodeDesc);
node->class = class;
- _o_result = node;
- return _o_result;
+ return node;
}
OPT_ConstExt OPT_NewExt (void)
{
- OPT_ConstExt _o_result;
OPT_ConstExt ext = NIL;
- ext = __NEWARR(NIL, ((LONGINT)(1)), 1, 1, 0, (LONGINT)256);
- _o_result = ext;
- return _o_result;
+ ext = __NEWARR(NIL, 1, 1, 1, 0, 256);
+ return ext;
}
-void OPT_OpenScope (SHORTINT level, OPT_Object owner)
+void OPT_OpenScope (INT8 level, OPT_Object owner)
{
OPT_Object head = NIL;
head = OPT_NewObj();
@@ -228,34 +429,34 @@ void OPT_CloseScope (void)
OPT_topScope = OPT_topScope->left;
}
-void OPT_Init (OPS_Name name, SET opt)
+void OPT_Init (OPS_Name name, UINT32 opt)
{
OPT_topScope = OPT_universe;
OPT_OpenScope(0, NIL);
OPT_SYSimported = 0;
- __COPY(name, OPT_SelfName, ((LONGINT)(256)));
- __COPY(name, OPT_topScope->name, ((LONGINT)(256)));
+ __COPY(name, OPT_SelfName, 256);
+ __COPY(name, OPT_topScope->name, 256);
OPT_GlbMod[0] = OPT_topScope;
OPT_nofGmod = 1;
- OPT_newsf = __IN(4, opt);
- OPT_findpc = __IN(8, opt);
- OPT_extsf = OPT_newsf || __IN(9, opt);
+ OPT_newsf = __IN(4, opt, 32);
+ OPT_findpc = __IN(8, opt, 32);
+ OPT_extsf = OPT_newsf || __IN(9, opt, 32);
OPT_sfpresent = 1;
}
void OPT_Close (void)
{
- INTEGER i;
+ INT16 i;
OPT_CloseScope();
i = 0;
while (i < 64) {
- OPT_GlbMod[__X(i, ((LONGINT)(64)))] = NIL;
+ OPT_GlbMod[__X(i, 64)] = NIL;
i += 1;
}
- i = 16;
+ i = 14;
while (i < 255) {
- OPT_impCtxt.ref[__X(i, ((LONGINT)(255)))] = NIL;
- OPT_impCtxt.old[__X(i, ((LONGINT)(255)))] = NIL;
+ OPT_impCtxt.ref[__X(i, 255)] = NIL;
+ OPT_impCtxt.old[__X(i, 255)] = NIL;
i += 1;
}
}
@@ -337,7 +538,7 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
{
OPT_Object ob0 = NIL, ob1 = NIL;
BOOLEAN left;
- SHORTINT mnolev;
+ INT8 mnolev;
ob0 = OPT_topScope;
ob1 = ob0->right;
left = 0;
@@ -366,7 +567,7 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
}
ob1->left = NIL;
ob1->right = NIL;
- __COPY(name, ob1->name, ((LONGINT)(256)));
+ __COPY(name, ob1->name, 256);
mnolev = OPT_topScope->mnolev;
ob1->mnolev = mnolev;
break;
@@ -375,14 +576,14 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
*obj = ob1;
}
-static void OPT_FPrintName (LONGINT *fp, CHAR *name, LONGINT name__len)
+static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len)
{
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
do {
ch = name[__X(i, name__len)];
- OPM_FPrint(&*fp, (int)ch);
+ OPM_FPrint(&*fp, (INT16)ch);
i += 1;
} while (!(ch == 0x00));
}
@@ -391,36 +592,36 @@ static void OPT_DebugStruct (OPT_Struct btyp)
{
OPM_LogWLn();
if (btyp == NIL) {
- OPM_LogWStr((CHAR*)"btyp is nil", (LONGINT)12);
+ OPM_LogWStr((CHAR*)"btyp is nil", 12);
OPM_LogWLn();
}
- OPM_LogWStr((CHAR*)"btyp^.strobji^.name = ", (LONGINT)23);
- OPM_LogWStr(btyp->strobj->name, ((LONGINT)(256)));
+ OPM_LogWStr((CHAR*)"btyp^.strobji^.name = ", 23);
+ OPM_LogWStr(btyp->strobj->name, 256);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.form = ", (LONGINT)14);
- OPM_LogWNum(btyp->form, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.form = ", 14);
+ OPM_LogWNum(btyp->form, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.comp = ", (LONGINT)14);
- OPM_LogWNum(btyp->comp, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.comp = ", 14);
+ OPM_LogWNum(btyp->comp, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.mno = ", (LONGINT)13);
- OPM_LogWNum(btyp->mno, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.mno = ", 13);
+ OPM_LogWNum(btyp->mno, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.extlev = ", (LONGINT)16);
- OPM_LogWNum(btyp->extlev, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.extlev = ", 16);
+ OPM_LogWNum(btyp->extlev, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.size = ", (LONGINT)14);
- OPM_LogWNum(btyp->size, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.size = ", 14);
+ OPM_LogWNum(btyp->size, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.align = ", (LONGINT)15);
- OPM_LogWNum(btyp->align, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.align = ", 15);
+ OPM_LogWNum(btyp->align, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.txtpos = ", (LONGINT)16);
- OPM_LogWNum(btyp->txtpos, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.txtpos = ", 16);
+ OPM_LogWNum(btyp->txtpos, 0);
OPM_LogWLn();
}
-static void OPT_FPrintSign (LONGINT *fp, OPT_Struct result, OPT_Object par)
+static void OPT_FPrintSign (INT32 *fp, OPT_Struct result, OPT_Object par)
{
OPT_IdFPrint(result);
OPM_FPrint(&*fp, result->idfp);
@@ -436,50 +637,53 @@ void OPT_IdFPrint (OPT_Struct typ)
{
OPT_Struct btyp = NIL;
OPT_Object strobj = NIL;
- LONGINT idfp;
- INTEGER f, c;
+ INT32 idfp;
+ INT16 f, c;
if (!typ->idfpdone) {
typ->idfpdone = 1;
idfp = 0;
f = typ->form;
- c = typ->comp;
OPM_FPrint(&idfp, f);
+ if (__IN(f, 0x90, 32)) {
+ OPM_FPrint(&idfp, typ->size);
+ }
+ c = typ->comp;
OPM_FPrint(&idfp, c);
btyp = typ->BaseTyp;
strobj = typ->strobj;
if ((strobj != NIL && strobj->name[0] != 0x00)) {
- OPT_FPrintName(&idfp, (void*)OPT_GlbMod[__X(typ->mno, ((LONGINT)(64)))]->name, ((LONGINT)(256)));
- OPT_FPrintName(&idfp, (void*)strobj->name, ((LONGINT)(256)));
+ OPT_FPrintName(&idfp, (void*)OPT_GlbMod[__X(typ->mno, 64)]->name, 256);
+ OPT_FPrintName(&idfp, (void*)strobj->name, 256);
}
- if ((f == 13 || (c == 4 && btyp != NIL)) || c == 3) {
+ if ((f == 11 || (c == 4 && btyp != NIL)) || c == 3) {
OPT_IdFPrint(btyp);
OPM_FPrint(&idfp, btyp->idfp);
} else if (c == 2) {
OPT_IdFPrint(btyp);
OPM_FPrint(&idfp, btyp->idfp);
OPM_FPrint(&idfp, typ->n);
- } else if (f == 14) {
+ } else if (f == 12) {
OPT_FPrintSign(&idfp, btyp, typ->link);
}
typ->idfp = idfp;
}
}
-static struct FPrintStr__12 {
- LONGINT *pbfp, *pvfp;
- struct FPrintStr__12 *lnk;
-} *FPrintStr__12_s;
+static struct FPrintStr__15 {
+ INT32 *pbfp, *pvfp;
+ struct FPrintStr__15 *lnk;
+} *FPrintStr__15_s;
-static void FPrintFlds__13 (OPT_Object fld, LONGINT adr, BOOLEAN visible);
-static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr);
-static void FPrintTProcs__17 (OPT_Object obj);
+static void FPrintFlds__16 (OPT_Object fld, INT32 adr, BOOLEAN visible);
+static void FPrintHdFld__18 (OPT_Struct typ, OPT_Object fld, INT32 adr);
+static void FPrintTProcs__20 (OPT_Object obj);
-static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr)
+static void FPrintHdFld__18 (OPT_Struct typ, OPT_Object fld, INT32 adr)
{
- LONGINT i, j, n;
+ INT32 i, j, n;
OPT_Struct btyp = NIL;
if (typ->comp == 4) {
- FPrintFlds__13(typ->link, adr, 0);
+ FPrintFlds__16(typ->link, adr, 0);
} else if (typ->comp == 2) {
btyp = typ->BaseTyp;
n = typ->n;
@@ -487,69 +691,69 @@ static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr)
n = btyp->n * n;
btyp = btyp->BaseTyp;
}
- if (btyp->form == 13 || btyp->comp == 4) {
+ if (btyp->form == 11 || btyp->comp == 4) {
j = OPT_nofhdfld;
- FPrintHdFld__15(btyp, fld, adr);
+ FPrintHdFld__18(btyp, fld, adr);
if (j != OPT_nofhdfld) {
i = 1;
while ((i < n && OPT_nofhdfld <= 2048)) {
adr += btyp->size;
- FPrintHdFld__15(btyp, fld, adr);
+ FPrintHdFld__18(btyp, fld, adr);
i += 1;
}
}
}
- } else if (typ->form == 13 || __STRCMP(fld->name, "@ptr") == 0) {
- OPM_FPrint(&*FPrintStr__12_s->pvfp, ((LONGINT)(13)));
- OPM_FPrint(&*FPrintStr__12_s->pvfp, adr);
+ } else if (typ->form == 11 || __STRCMP(fld->name, "@ptr") == 0) {
+ OPM_FPrint(&*FPrintStr__15_s->pvfp, 11);
+ OPM_FPrint(&*FPrintStr__15_s->pvfp, adr);
OPT_nofhdfld += 1;
}
}
-static void FPrintFlds__13 (OPT_Object fld, LONGINT adr, BOOLEAN visible)
+static void FPrintFlds__16 (OPT_Object fld, INT32 adr, BOOLEAN visible)
{
while ((fld != NIL && fld->mode == 4)) {
if ((fld->vis != 0 && visible)) {
- OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->vis);
- OPT_FPrintName(&*FPrintStr__12_s->pbfp, (void*)fld->name, ((LONGINT)(256)));
- OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->adr);
+ OPM_FPrint(&*FPrintStr__15_s->pbfp, fld->vis);
+ OPT_FPrintName(&*FPrintStr__15_s->pbfp, (void*)fld->name, 256);
+ OPM_FPrint(&*FPrintStr__15_s->pbfp, fld->adr);
OPT_FPrintStr(fld->typ);
- OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->typ->pbfp);
- OPM_FPrint(&*FPrintStr__12_s->pvfp, fld->typ->pvfp);
+ OPM_FPrint(&*FPrintStr__15_s->pbfp, fld->typ->pbfp);
+ OPM_FPrint(&*FPrintStr__15_s->pvfp, fld->typ->pvfp);
} else {
- FPrintHdFld__15(fld->typ, fld, fld->adr + adr);
+ FPrintHdFld__18(fld->typ, fld, fld->adr + adr);
}
fld = fld->link;
}
}
-static void FPrintTProcs__17 (OPT_Object obj)
+static void FPrintTProcs__20 (OPT_Object obj)
{
if (obj != NIL) {
- FPrintTProcs__17(obj->left);
+ FPrintTProcs__20(obj->left);
if (obj->mode == 13) {
if (obj->vis != 0) {
- OPM_FPrint(&*FPrintStr__12_s->pbfp, ((LONGINT)(13)));
- OPM_FPrint(&*FPrintStr__12_s->pbfp, __ASHR(obj->adr, 16));
- OPT_FPrintSign(&*FPrintStr__12_s->pbfp, obj->typ, obj->link);
- OPT_FPrintName(&*FPrintStr__12_s->pbfp, (void*)obj->name, ((LONGINT)(256)));
+ OPM_FPrint(&*FPrintStr__15_s->pbfp, 13);
+ OPM_FPrint(&*FPrintStr__15_s->pbfp, __ASHR(obj->adr, 16));
+ OPT_FPrintSign(&*FPrintStr__15_s->pbfp, obj->typ, obj->link);
+ OPT_FPrintName(&*FPrintStr__15_s->pbfp, (void*)obj->name, 256);
}
}
- FPrintTProcs__17(obj->right);
+ FPrintTProcs__20(obj->right);
}
}
void OPT_FPrintStr (OPT_Struct typ)
{
- INTEGER f, c;
+ INT16 f, c;
OPT_Struct btyp = NIL;
OPT_Object strobj = NIL, bstrobj = NIL;
- LONGINT pbfp, pvfp;
- struct FPrintStr__12 _s;
+ INT32 pbfp, pvfp;
+ struct FPrintStr__15 _s;
_s.pbfp = &pbfp;
_s.pvfp = &pvfp;
- _s.lnk = FPrintStr__12_s;
- FPrintStr__12_s = &_s;
+ _s.lnk = FPrintStr__15_s;
+ FPrintStr__15_s = &_s;
if (!typ->fpdone) {
OPT_IdFPrint(typ);
pbfp = typ->idfp;
@@ -563,7 +767,7 @@ void OPT_FPrintStr (OPT_Struct typ)
f = typ->form;
c = typ->comp;
btyp = typ->BaseTyp;
- if (f == 13) {
+ if (f == 11) {
strobj = typ->strobj;
bstrobj = btyp->strobj;
if (((strobj == NIL || strobj->name[0] == 0x00) || bstrobj == NIL) || bstrobj->name[0] == 0x00) {
@@ -571,8 +775,8 @@ void OPT_FPrintStr (OPT_Struct typ)
OPM_FPrint(&pbfp, btyp->pbfp);
pvfp = pbfp;
}
- } else if (f == 14) {
- } else if (__IN(c, 0x0c)) {
+ } else if (f == 12) {
+ } else if (__IN(c, 0x0c, 32)) {
OPT_FPrintStr(btyp);
OPM_FPrint(&pbfp, btyp->pvfp);
pvfp = pbfp;
@@ -586,11 +790,11 @@ void OPT_FPrintStr (OPT_Struct typ)
OPM_FPrint(&pvfp, typ->align);
OPM_FPrint(&pvfp, typ->n);
OPT_nofhdfld = 0;
- FPrintFlds__13(typ->link, ((LONGINT)(0)), 1);
+ FPrintFlds__16(typ->link, 0, 1);
if (OPT_nofhdfld > 2048) {
OPM_Mark(225, typ->txtpos);
}
- FPrintTProcs__17(typ->link);
+ FPrintTProcs__20(typ->link);
OPM_FPrint(&pvfp, pbfp);
strobj = typ->strobj;
if (strobj == NIL || strobj->name[0] == 0x00) {
@@ -600,13 +804,13 @@ void OPT_FPrintStr (OPT_Struct typ)
typ->pbfp = pbfp;
typ->pvfp = pvfp;
}
- FPrintStr__12_s = _s.lnk;
+ FPrintStr__15_s = _s.lnk;
}
void OPT_FPrintObj (OPT_Object obj)
{
- LONGINT fprint;
- INTEGER f, m;
+ INT32 fprint;
+ INT16 f, m;
REAL rval;
OPT_ConstExt ext = NIL;
if (!obj->fpdone) {
@@ -617,23 +821,23 @@ void OPT_FPrintObj (OPT_Object obj)
f = obj->typ->form;
OPM_FPrint(&fprint, f);
switch (f) {
- case 2: case 3: case 4: case 5: case 6:
+ case 2: case 3: case 4:
OPM_FPrint(&fprint, obj->conval->intval);
break;
- case 9:
+ case 7:
OPM_FPrintSet(&fprint, obj->conval->setval);
break;
- case 7:
+ case 5:
rval = obj->conval->realval;
OPM_FPrintReal(&fprint, rval);
break;
- case 8:
+ case 6:
OPM_FPrintLReal(&fprint, obj->conval->realval);
break;
- case 10:
- OPT_FPrintName(&fprint, (void*)*obj->conval->ext, ((LONGINT)(256)));
+ case 8:
+ OPT_FPrintName(&fprint, (void*)*obj->conval->ext, 256);
break;
- case 11:
+ case 9:
break;
default:
OPT_err(127);
@@ -643,16 +847,16 @@ void OPT_FPrintObj (OPT_Object obj)
OPM_FPrint(&fprint, obj->vis);
OPT_FPrintStr(obj->typ);
OPM_FPrint(&fprint, obj->typ->pbfp);
- } else if (__IN(obj->mode, 0x0480)) {
+ } else if (__IN(obj->mode, 0x0480, 32)) {
OPT_FPrintSign(&fprint, obj->typ, obj->link);
} else if (obj->mode == 9) {
OPT_FPrintSign(&fprint, obj->typ, obj->link);
ext = obj->conval->ext;
- m = (int)(*ext)[0];
+ m = (INT16)(*ext)[0];
f = 1;
OPM_FPrint(&fprint, m);
while (f <= m) {
- OPM_FPrint(&fprint, (int)(*ext)[__X(f, ((LONGINT)(256)))]);
+ OPM_FPrint(&fprint, (INT16)(*ext)[__X(f, 256)]);
f += 1;
}
} else if (obj->mode == 5) {
@@ -663,27 +867,27 @@ void OPT_FPrintObj (OPT_Object obj)
}
}
-void OPT_FPrintErr (OPT_Object obj, INTEGER errcode)
+void OPT_FPrintErr (OPT_Object obj, INT16 errcode)
{
- INTEGER i, j;
+ INT16 i, j;
CHAR ch;
if (obj->mnolev != 0) {
- __COPY(OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, OPM_objname, ((LONGINT)(64)));
+ __COPY(OPT_GlbMod[__X(-obj->mnolev, 64)]->name, OPM_objname, 64);
i = 0;
- while (OPM_objname[__X(i, ((LONGINT)(64)))] != 0x00) {
+ while (OPM_objname[__X(i, 64)] != 0x00) {
i += 1;
}
- OPM_objname[__X(i, ((LONGINT)(64)))] = '.';
+ OPM_objname[__X(i, 64)] = '.';
j = 0;
i += 1;
do {
- ch = obj->name[__X(j, ((LONGINT)(256)))];
- OPM_objname[__X(i, ((LONGINT)(64)))] = ch;
+ ch = obj->name[__X(j, 256)];
+ OPM_objname[__X(i, 64)] = ch;
j += 1;
i += 1;
} while (!(ch == 0x00));
} else {
- __COPY(obj->name, OPM_objname, ((LONGINT)(64)));
+ __COPY(obj->name, OPM_objname, 64);
}
if (errcode == 249) {
if (OPM_noerr) {
@@ -755,7 +959,7 @@ void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old)
static void OPT_InName (CHAR *name, LONGINT name__len)
{
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
do {
@@ -765,23 +969,23 @@ static void OPT_InName (CHAR *name, LONGINT name__len)
} while (!(ch == 0x00));
}
-static void OPT_InMod (SHORTINT *mno)
+static void OPT_InMod (INT8 *mno)
{
OPT_Object head = NIL;
OPS_Name name;
- LONGINT mn;
- SHORTINT i;
+ INT32 mn;
+ INT8 i;
mn = OPM_SymRInt();
if (mn == 0) {
*mno = OPT_impCtxt.glbmno[0];
} else {
if (mn == 16) {
- OPT_InName((void*)name, ((LONGINT)(256)));
+ OPT_InName((void*)name, 256);
if ((__STRCMP(name, OPT_SelfName) == 0 && !OPT_impCtxt.self)) {
OPT_err(154);
}
i = 0;
- while ((i < OPT_nofGmod && __STRCMP(name, OPT_GlbMod[__X(i, ((LONGINT)(64)))]->name) != 0)) {
+ while ((i < OPT_nofGmod && __STRCMP(name, OPT_GlbMod[__X(i, 64)]->name) != 0)) {
i += 1;
}
if (i < OPT_nofGmod) {
@@ -789,77 +993,77 @@ static void OPT_InMod (SHORTINT *mno)
} else {
head = OPT_NewObj();
head->mode = 12;
- __COPY(name, head->name, ((LONGINT)(256)));
+ __COPY(name, head->name, 256);
*mno = OPT_nofGmod;
head->mnolev = -*mno;
if (OPT_nofGmod < 64) {
- OPT_GlbMod[__X(*mno, ((LONGINT)(64)))] = head;
+ OPT_GlbMod[__X(*mno, 64)] = head;
OPT_nofGmod += 1;
} else {
OPT_err(227);
}
}
- OPT_impCtxt.glbmno[__X(OPT_impCtxt.nofm, ((LONGINT)(64)))] = *mno;
+ OPT_impCtxt.glbmno[__X(OPT_impCtxt.nofm, 64)] = *mno;
OPT_impCtxt.nofm += 1;
} else {
- *mno = OPT_impCtxt.glbmno[__X(-mn, ((LONGINT)(64)))];
+ *mno = OPT_impCtxt.glbmno[__X(-mn, 64)];
}
}
}
-static void OPT_InConstant (LONGINT f, OPT_Const conval)
+static void OPT_InConstant (INT32 f, OPT_Const conval)
{
CHAR ch;
- INTEGER i;
+ INT16 i;
OPT_ConstExt ext = NIL;
REAL rval;
switch (f) {
case 1: case 3: case 2:
OPM_SymRCh(&ch);
- conval->intval = (int)ch;
+ conval->intval = (INT16)ch;
break;
- case 4: case 5: case 6:
+ case 4:
conval->intval = OPM_SymRInt();
break;
- case 9:
+ case 7:
OPM_SymRSet(&conval->setval);
break;
- case 7:
+ case 5:
OPM_SymRReal(&rval);
conval->realval = rval;
conval->intval = -1;
break;
- case 8:
+ case 6:
OPM_SymRLReal(&conval->realval);
conval->intval = -1;
break;
- case 10:
+ case 8:
ext = OPT_NewExt();
conval->ext = ext;
i = 0;
do {
OPM_SymRCh(&ch);
- (*ext)[__X(i, ((LONGINT)(256)))] = ch;
+ (*ext)[__X(i, 256)] = ch;
i += 1;
} while (!(ch == 0x00));
conval->intval2 = i;
conval->intval = -1;
break;
- case 11:
+ case 9:
conval->intval = 0;
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in InConstant(), f = ", (LONGINT)37);
- OPM_LogWNum(f, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in InConstant(), f = ", 37);
+ OPM_LogWNum(f, 0);
OPM_LogWLn();
break;
}
}
-static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par)
+static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par)
{
OPT_Object last = NIL, new = NIL;
- LONGINT tag;
+ INT32 tag;
OPT_InStruct(&*res);
tag = OPM_SymRInt();
last = NIL;
@@ -878,7 +1082,7 @@ static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par)
}
OPT_InStruct(&new->typ);
new->adr = OPM_SymRInt();
- OPT_InName((void*)new->name, ((LONGINT)(256)));
+ OPT_InName((void*)new->name, 256);
last = new;
tag = OPM_SymRInt();
}
@@ -886,8 +1090,7 @@ static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par)
static OPT_Object OPT_InFld (void)
{
- OPT_Object _o_result;
- LONGINT tag;
+ INT32 tag;
OPT_Object obj = NIL;
tag = OPT_impCtxt.nextTag;
obj = OPT_NewObj();
@@ -899,7 +1102,7 @@ static OPT_Object OPT_InFld (void)
obj->vis = 1;
}
OPT_InStruct(&obj->typ);
- OPT_InName((void*)obj->name, ((LONGINT)(256)));
+ OPT_InName((void*)obj->name, 256);
obj->adr = OPM_SymRInt();
} else {
obj->mode = 4;
@@ -912,14 +1115,12 @@ static OPT_Object OPT_InFld (void)
obj->vis = 0;
obj->adr = OPM_SymRInt();
}
- _o_result = obj;
- return _o_result;
+ return obj;
}
-static OPT_Object OPT_InTProc (SHORTINT mno)
+static OPT_Object OPT_InTProc (INT8 mno)
{
- OPT_Object _o_result;
- LONGINT tag;
+ INT32 tag;
OPT_Object obj = NIL;
tag = OPT_impCtxt.nextTag;
obj = OPT_NewObj();
@@ -930,7 +1131,7 @@ static OPT_Object OPT_InTProc (SHORTINT mno)
obj->conval->intval = -1;
OPT_InSign(mno, &obj->typ, &obj->link);
obj->vis = 1;
- OPT_InName((void*)obj->name, ((LONGINT)(256)));
+ OPT_InName((void*)obj->name, 256);
obj->adr = __ASHL(OPM_SymRInt(), 16);
} else {
obj->mode = 13;
@@ -940,21 +1141,32 @@ static OPT_Object OPT_InTProc (SHORTINT mno)
obj->vis = 0;
obj->adr = __ASHL(OPM_SymRInt(), 16);
}
- _o_result = obj;
- return _o_result;
+ return obj;
+}
+
+static OPT_Struct OPT_InTyp (INT32 tag)
+{
+ if (tag == 4) {
+ return OPT_IntType(OPM_SymRInt());
+ } else if (tag == 7) {
+ return OPT_SetType(OPM_SymRInt());
+ } else {
+ return OPT_impCtxt.ref[__X(tag, 255)];
+ }
+ __RETCHK;
}
static void OPT_InStruct (OPT_Struct *typ)
{
- SHORTINT mno;
- INTEGER ref;
- LONGINT tag;
+ INT8 mno;
+ INT16 ref;
+ INT32 tag;
OPS_Name name;
OPT_Struct t = NIL;
OPT_Object obj = NIL, last = NIL, fld = NIL, old = NIL, dummy = NIL;
tag = OPM_SymRInt();
if (tag != 34) {
- *typ = OPT_impCtxt.ref[__X(-tag, ((LONGINT)(255)))];
+ *typ = OPT_InTyp(-tag);
} else {
ref = OPT_impCtxt.nofr;
OPT_impCtxt.nofr += 1;
@@ -962,23 +1174,23 @@ static void OPT_InStruct (OPT_Struct *typ)
OPT_impCtxt.minr = ref;
}
OPT_InMod(&mno);
- OPT_InName((void*)name, ((LONGINT)(256)));
+ OPT_InName((void*)name, 256);
obj = OPT_NewObj();
if (name[0] == 0x00) {
if (OPT_impCtxt.self) {
old = NIL;
} else {
__MOVE("@", obj->name, 2);
- OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old);
+ OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
obj->name[0] = 0x00;
}
*typ = OPT_NewStr(0, 1);
} else {
- __COPY(name, obj->name, ((LONGINT)(256)));
- OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old);
+ __COPY(name, obj->name, 256);
+ OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
if (old != NIL) {
OPT_FPrintObj(old);
- OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] = old->typ->pvfp;
+ OPT_impCtxt.pvfp[__X(ref, 255)] = old->typ->pvfp;
if (OPT_impCtxt.self) {
*typ = OPT_NewStr(0, 1);
} else {
@@ -992,8 +1204,8 @@ static void OPT_InStruct (OPT_Struct *typ)
*typ = OPT_NewStr(0, 1);
}
}
- OPT_impCtxt.ref[__X(ref, ((LONGINT)(255)))] = *typ;
- OPT_impCtxt.old[__X(ref, ((LONGINT)(255)))] = old;
+ OPT_impCtxt.ref[__X(ref, 255)] = *typ;
+ OPT_impCtxt.old[__X(ref, 255)] = old;
(*typ)->ref = ref + 255;
(*typ)->mno = mno;
(*typ)->allocated = 1;
@@ -1004,25 +1216,25 @@ static void OPT_InStruct (OPT_Struct *typ)
obj->vis = 0;
tag = OPM_SymRInt();
if (tag == 35) {
- (*typ)->sysflag = (int)OPM_SymRInt();
+ (*typ)->sysflag = (INT16)OPM_SymRInt();
tag = OPM_SymRInt();
}
switch (tag) {
case 36:
- (*typ)->form = 13;
- (*typ)->size = OPM_PointerSize;
+ (*typ)->form = 11;
+ (*typ)->size = OPM_AddressSize;
(*typ)->n = 0;
OPT_InStruct(&(*typ)->BaseTyp);
break;
case 37:
- (*typ)->form = 15;
+ (*typ)->form = 13;
(*typ)->comp = 2;
OPT_InStruct(&(*typ)->BaseTyp);
(*typ)->n = OPM_SymRInt();
- (*OPT_typSize)(*typ);
+ OPT_TypSize(*typ);
break;
case 38:
- (*typ)->form = 15;
+ (*typ)->form = 13;
(*typ)->comp = 3;
OPT_InStruct(&(*typ)->BaseTyp);
if ((*typ)->BaseTyp->comp == 3) {
@@ -1030,10 +1242,10 @@ static void OPT_InStruct (OPT_Struct *typ)
} else {
(*typ)->n = 0;
}
- (*OPT_typSize)(*typ);
+ OPT_TypSize(*typ);
break;
case 39:
- (*typ)->form = 15;
+ (*typ)->form = 13;
(*typ)->comp = 4;
OPT_InStruct(&(*typ)->BaseTyp);
if ((*typ)->BaseTyp == OPT_notyp) {
@@ -1067,25 +1279,25 @@ static void OPT_InStruct (OPT_Struct *typ)
}
break;
case 40:
- (*typ)->form = 14;
- (*typ)->size = OPM_ProcSize;
+ (*typ)->form = 12;
+ (*typ)->size = OPM_AddressSize;
OPT_InSign(mno, &(*typ)->BaseTyp, &(*typ)->link);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at InStruct, tag = ", (LONGINT)35);
- OPM_LogWNum(tag, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at InStruct, tag = ", 35);
+ OPM_LogWNum(tag, 0);
OPM_LogWLn();
break;
}
if (ref == OPT_impCtxt.minr) {
while (ref < OPT_impCtxt.nofr) {
- t = OPT_impCtxt.ref[__X(ref, ((LONGINT)(255)))];
+ t = OPT_InTyp(ref);
OPT_FPrintStr(t);
obj = t->strobj;
if (obj->name[0] != 0x00) {
OPT_FPrintObj(obj);
}
- old = OPT_impCtxt.old[__X(ref, ((LONGINT)(255)))];
+ old = OPT_impCtxt.old[__X(ref, 255)];
if (old != NIL) {
t->strobj = old;
if (OPT_impCtxt.self) {
@@ -1093,13 +1305,13 @@ static void OPT_InStruct (OPT_Struct *typ)
if (old->history != 5) {
if (old->fprint != obj->fprint) {
old->history = 2;
- } else if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) {
+ } else if (OPT_impCtxt.pvfp[__X(ref, 255)] != t->pvfp) {
old->history = 3;
}
}
} else if (old->fprint != obj->fprint) {
old->history = 2;
- } else if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) {
+ } else if (OPT_impCtxt.pvfp[__X(ref, 255)] != t->pvfp) {
old->history = 3;
} else if (old->vis == 0) {
old->history = 1;
@@ -1107,7 +1319,7 @@ static void OPT_InStruct (OPT_Struct *typ)
old->history = 0;
}
} else {
- if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) {
+ if (OPT_impCtxt.pvfp[__X(ref, 255)] != t->pvfp) {
old->history = 5;
}
if (old->fprint != obj->fprint) {
@@ -1126,14 +1338,13 @@ static void OPT_InStruct (OPT_Struct *typ)
}
}
-static OPT_Object OPT_InObj (SHORTINT mno)
+static OPT_Object OPT_InObj (INT8 mno)
{
- OPT_Object _o_result;
- INTEGER i, s;
+ INT16 i, s;
CHAR ch;
OPT_Object obj = NIL, old = NIL;
OPT_Struct typ = NIL;
- LONGINT tag;
+ INT32 tag;
OPT_ConstExt ext = NIL;
tag = OPT_impCtxt.nextTag;
if (tag == 19) {
@@ -1146,11 +1357,11 @@ static OPT_Object OPT_InObj (SHORTINT mno)
obj = OPT_NewObj();
obj->mnolev = -mno;
obj->vis = 1;
- if (tag <= 13) {
+ if (tag <= 11) {
obj->mode = 3;
- obj->typ = OPT_impCtxt.ref[__X(tag, ((LONGINT)(255)))];
obj->conval = OPT_NewConst();
OPT_InConstant(tag, obj->conval);
+ obj->typ = OPT_InTyp(tag);
} else if (tag >= 31) {
obj->conval = OPT_NewConst();
obj->conval->intval = -1;
@@ -1166,17 +1377,17 @@ static OPT_Object OPT_InObj (SHORTINT mno)
obj->mode = 9;
ext = OPT_NewExt();
obj->conval->ext = ext;
- s = (int)OPM_SymRInt();
+ s = (INT16)OPM_SymRInt();
(*ext)[0] = (CHAR)s;
i = 1;
while (i <= s) {
- OPM_SymRCh(&(*ext)[__X(i, ((LONGINT)(256)))]);
+ OPM_SymRCh(&(*ext)[__X(i, 256)]);
i += 1;
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", (LONGINT)32);
- OPM_LogWNum(tag, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", 32);
+ OPM_LogWNum(tag, 0);
OPM_LogWLn();
break;
}
@@ -1190,14 +1401,14 @@ static OPT_Object OPT_InObj (SHORTINT mno)
}
OPT_InStruct(&obj->typ);
}
- OPT_InName((void*)obj->name, ((LONGINT)(256)));
+ OPT_InName((void*)obj->name, 256);
}
OPT_FPrintObj(obj);
if ((obj->mode == 1 && (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00))) {
OPM_FPrint(&OPT_impCtxt.reffp, obj->typ->ref - 255);
}
if (tag != 19) {
- OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old);
+ OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
if (OPT_impCtxt.self) {
if (old != NIL) {
if (old->vis == 0) {
@@ -1225,14 +1436,13 @@ static OPT_Object OPT_InObj (SHORTINT mno)
}
}
}
- _o_result = obj;
- return _o_result;
+ return obj;
}
void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
{
OPT_Object obj = NIL;
- SHORTINT mno;
+ INT8 mno;
OPS_Name aliasName__copy;
__DUPARR(aliasName, OPS_Name);
if (__STRCMP(name, "SYSTEM") == 0) {
@@ -1243,12 +1453,12 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
obj->scope = OPT_syslink;
obj->typ = OPT_notyp;
} else {
- OPT_impCtxt.nofr = 16;
+ OPT_impCtxt.nofr = 14;
OPT_impCtxt.minr = 255;
OPT_impCtxt.nofm = 0;
OPT_impCtxt.self = __STRCMP(aliasName, "@self") == 0;
OPT_impCtxt.reffp = 0;
- OPM_OldSym((void*)name, ((LONGINT)(256)), &*done);
+ OPM_OldSym((void*)name, 256, &*done);
if (*done) {
OPT_InMod(&mno);
OPT_impCtxt.nextTag = OPM_SymRInt();
@@ -1258,8 +1468,8 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
}
OPT_Insert(aliasName, &obj);
obj->mode = 11;
- obj->scope = OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right;
- OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->link = obj;
+ obj->scope = OPT_GlbMod[__X(mno, 64)]->right;
+ OPT_GlbMod[__X(mno, 64)]->link = obj;
obj->mnolev = -mno;
obj->typ = OPT_notyp;
OPM_CloseOldSym();
@@ -1275,7 +1485,7 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
static void OPT_OutName (CHAR *name, LONGINT name__len)
{
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
do {
@@ -1285,21 +1495,21 @@ static void OPT_OutName (CHAR *name, LONGINT name__len)
} while (!(ch == 0x00));
}
-static void OPT_OutMod (INTEGER mno)
+static void OPT_OutMod (INT16 mno)
{
- if (OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))] < 0) {
- OPM_SymWInt(((LONGINT)(16)));
- OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))] = OPT_expCtxt.nofm;
+ if (OPT_expCtxt.locmno[__X(mno, 64)] < 0) {
+ OPM_SymWInt(16);
+ OPT_expCtxt.locmno[__X(mno, 64)] = OPT_expCtxt.nofm;
OPT_expCtxt.nofm += 1;
- OPT_OutName((void*)OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->name, ((LONGINT)(256)));
+ OPT_OutName((void*)OPT_GlbMod[__X(mno, 64)]->name, 256);
} else {
- OPM_SymWInt(-OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))]);
+ OPM_SymWInt(-OPT_expCtxt.locmno[__X(mno, 64)]);
}
}
-static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr)
+static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr)
{
- LONGINT i, j, n;
+ INT32 i, j, n;
OPT_Struct btyp = NIL;
if (typ->comp == 4) {
OPT_OutFlds(typ->link, adr, 0);
@@ -1310,7 +1520,7 @@ static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr)
n = btyp->n * n;
btyp = btyp->BaseTyp;
}
- if (btyp->form == 13 || btyp->comp == 4) {
+ if (btyp->form == 11 || btyp->comp == 4) {
j = OPT_nofhdfld;
OPT_OutHdFld(btyp, fld, adr);
if (j != OPT_nofhdfld) {
@@ -1322,24 +1532,24 @@ static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr)
}
}
}
- } else if (typ->form == 13 || __STRCMP(fld->name, "@ptr") == 0) {
- OPM_SymWInt(((LONGINT)(27)));
+ } else if (typ->form == 11 || __STRCMP(fld->name, "@ptr") == 0) {
+ OPM_SymWInt(27);
OPM_SymWInt(adr);
OPT_nofhdfld += 1;
}
}
-static void OPT_OutFlds (OPT_Object fld, LONGINT adr, BOOLEAN visible)
+static void OPT_OutFlds (OPT_Object fld, INT32 adr, BOOLEAN visible)
{
while ((fld != NIL && fld->mode == 4)) {
if ((fld->vis != 0 && visible)) {
if (fld->vis == 2) {
- OPM_SymWInt(((LONGINT)(26)));
+ OPM_SymWInt(26);
} else {
- OPM_SymWInt(((LONGINT)(25)));
+ OPM_SymWInt(25);
}
OPT_OutStr(fld->typ);
- OPT_OutName((void*)fld->name, ((LONGINT)(256)));
+ OPT_OutName((void*)fld->name, 256);
OPM_SymWInt(fld->adr);
} else {
OPT_OutHdFld(fld->typ, fld, fld->adr + adr);
@@ -1353,16 +1563,16 @@ static void OPT_OutSign (OPT_Struct result, OPT_Object par)
OPT_OutStr(result);
while (par != NIL) {
if (par->mode == 1) {
- OPM_SymWInt(((LONGINT)(23)));
+ OPM_SymWInt(23);
} else {
- OPM_SymWInt(((LONGINT)(24)));
+ OPM_SymWInt(24);
}
OPT_OutStr(par->typ);
OPM_SymWInt(par->adr);
- OPT_OutName((void*)par->name, ((LONGINT)(256)));
+ OPT_OutName((void*)par->name, 256);
par = par->link;
}
- OPM_SymWInt(((LONGINT)(18)));
+ OPM_SymWInt(18);
}
static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj)
@@ -1375,12 +1585,12 @@ static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj)
}
if (obj->vis != 0) {
if (obj->vis != 0) {
- OPM_SymWInt(((LONGINT)(29)));
+ OPM_SymWInt(29);
OPT_OutSign(obj->typ, obj->link);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
OPM_SymWInt(__ASHR(obj->adr, 16));
} else {
- OPM_SymWInt(((LONGINT)(30)));
+ OPM_SymWInt(30);
OPM_SymWInt(__ASHR(obj->adr, 16));
}
}
@@ -1394,8 +1604,11 @@ static void OPT_OutStr (OPT_Struct typ)
OPT_Object strobj = NIL;
if (typ->ref < OPT_expCtxt.ref) {
OPM_SymWInt(-typ->ref);
+ if (__IN(typ->ref, 0x90, 32)) {
+ OPM_SymWInt(typ->size);
+ }
} else {
- OPM_SymWInt(((LONGINT)(34)));
+ OPM_SymWInt(34);
typ->ref = OPT_expCtxt.ref;
OPT_expCtxt.ref += 1;
if (OPT_expCtxt.ref >= 255) {
@@ -1404,7 +1617,7 @@ static void OPT_OutStr (OPT_Struct typ)
OPT_OutMod(typ->mno);
strobj = typ->strobj;
if ((strobj != NIL && strobj->name[0] != 0x00)) {
- OPT_OutName((void*)strobj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)strobj->name, 256);
switch (strobj->history) {
case 2:
OPT_FPrintErr(strobj, 252);
@@ -1422,31 +1635,31 @@ static void OPT_OutStr (OPT_Struct typ)
OPM_SymWCh(0x00);
}
if (typ->sysflag != 0) {
- OPM_SymWInt(((LONGINT)(35)));
+ OPM_SymWInt(35);
OPM_SymWInt(typ->sysflag);
}
switch (typ->form) {
- case 13:
- OPM_SymWInt(((LONGINT)(36)));
+ case 11:
+ OPM_SymWInt(36);
OPT_OutStr(typ->BaseTyp);
break;
- case 14:
- OPM_SymWInt(((LONGINT)(40)));
+ case 12:
+ OPM_SymWInt(40);
OPT_OutSign(typ->BaseTyp, typ->link);
break;
- case 15:
+ case 13:
switch (typ->comp) {
case 2:
- OPM_SymWInt(((LONGINT)(37)));
+ OPM_SymWInt(37);
OPT_OutStr(typ->BaseTyp);
OPM_SymWInt(typ->n);
break;
case 3:
- OPM_SymWInt(((LONGINT)(38)));
+ OPM_SymWInt(38);
OPT_OutStr(typ->BaseTyp);
break;
case 4:
- OPM_SymWInt(((LONGINT)(39)));
+ OPM_SymWInt(39);
if (typ->BaseTyp == NIL) {
OPT_OutStr(OPT_notyp);
} else {
@@ -1456,23 +1669,23 @@ static void OPT_OutStr (OPT_Struct typ)
OPM_SymWInt(typ->align);
OPM_SymWInt(typ->n);
OPT_nofhdfld = 0;
- OPT_OutFlds(typ->link, ((LONGINT)(0)), 1);
+ OPT_OutFlds(typ->link, 0, 1);
if (OPT_nofhdfld > 2048) {
OPM_Mark(223, typ->txtpos);
}
OPT_OutTProcs(typ, typ->link);
- OPM_SymWInt(((LONGINT)(18)));
+ OPM_SymWInt(18);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.comp = ", (LONGINT)39);
- OPM_LogWNum(typ->comp, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.comp = ", 39);
+ OPM_LogWNum(typ->comp, 0);
OPM_LogWLn();
break;
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.form = ", (LONGINT)39);
- OPM_LogWNum(typ->form, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.form = ", 39);
+ OPM_LogWNum(typ->form, 0);
OPM_LogWLn();
break;
}
@@ -1481,7 +1694,7 @@ static void OPT_OutStr (OPT_Struct typ)
static void OPT_OutConstant (OPT_Object obj)
{
- INTEGER f;
+ INT16 f;
REAL rval;
f = obj->typ->form;
OPM_SymWInt(f);
@@ -1489,23 +1702,25 @@ static void OPT_OutConstant (OPT_Object obj)
case 2: case 3:
OPM_SymWCh((CHAR)obj->conval->intval);
break;
- case 4: case 5: case 6:
+ case 4:
OPM_SymWInt(obj->conval->intval);
- break;
- case 9:
- OPM_SymWSet(obj->conval->setval);
+ OPM_SymWInt(obj->typ->size);
break;
case 7:
+ OPM_SymWSet(obj->conval->setval);
+ OPM_SymWInt(obj->typ->size);
+ break;
+ case 5:
rval = obj->conval->realval;
OPM_SymWReal(rval);
break;
- case 8:
+ case 6:
OPM_SymWLReal(obj->conval->realval);
break;
- case 10:
- OPT_OutName((void*)*obj->conval->ext, ((LONGINT)(256)));
+ case 8:
+ OPT_OutName((void*)*obj->conval->ext, 256);
break;
- case 11:
+ case 9:
break;
default:
OPT_err(127);
@@ -1515,11 +1730,11 @@ static void OPT_OutConstant (OPT_Object obj)
static void OPT_OutObj (OPT_Object obj)
{
- INTEGER i, j;
+ INT16 i, j;
OPT_ConstExt ext = NIL;
if (obj != NIL) {
OPT_OutObj(obj->left);
- if (__IN(obj->mode, 0x06ea)) {
+ if (__IN(obj->mode, 0x06ea, 32)) {
if (obj->history == 4) {
OPT_FPrintErr(obj, 250);
} else if (obj->vis != 0) {
@@ -1536,64 +1751,64 @@ static void OPT_OutObj (OPT_Object obj)
OPT_FPrintErr(obj, 251);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj^.history = ", (LONGINT)42);
- OPM_LogWNum(obj->history, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj^.history = ", 42);
+ OPM_LogWNum(obj->history, 0);
OPM_LogWLn();
break;
}
switch (obj->mode) {
case 3:
OPT_OutConstant(obj);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
break;
case 5:
if (obj->typ->strobj == obj) {
- OPM_SymWInt(((LONGINT)(19)));
+ OPM_SymWInt(19);
OPT_OutStr(obj->typ);
} else {
- OPM_SymWInt(((LONGINT)(20)));
+ OPM_SymWInt(20);
OPT_OutStr(obj->typ);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
}
break;
case 1:
if (obj->vis == 2) {
- OPM_SymWInt(((LONGINT)(22)));
+ OPM_SymWInt(22);
} else {
- OPM_SymWInt(((LONGINT)(21)));
+ OPM_SymWInt(21);
}
OPT_OutStr(obj->typ);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
if (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00) {
OPM_FPrint(&OPT_expCtxt.reffp, obj->typ->ref);
}
break;
case 7:
- OPM_SymWInt(((LONGINT)(31)));
+ OPM_SymWInt(31);
OPT_OutSign(obj->typ, obj->link);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
break;
case 10:
- OPM_SymWInt(((LONGINT)(32)));
+ OPM_SymWInt(32);
OPT_OutSign(obj->typ, obj->link);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
break;
case 9:
- OPM_SymWInt(((LONGINT)(33)));
+ OPM_SymWInt(33);
OPT_OutSign(obj->typ, obj->link);
ext = obj->conval->ext;
- j = (int)(*ext)[0];
+ j = (INT16)(*ext)[0];
i = 1;
OPM_SymWInt(j);
while (i <= j) {
- OPM_SymWCh((*ext)[__X(i, ((LONGINT)(256)))]);
+ OPM_SymWCh((*ext)[__X(i, 256)]);
i += 1;
}
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj.mode = ", (LONGINT)38);
- OPM_LogWNum(obj->mode, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj.mode = ", 38);
+ OPM_LogWNum(obj->mode, 0);
OPM_LogWLn();
break;
}
@@ -1605,8 +1820,8 @@ static void OPT_OutObj (OPT_Object obj)
void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
{
- INTEGER i;
- SHORTINT nofmod;
+ INT16 i;
+ INT8 nofmod;
BOOLEAN done;
OPT_symExtended = 0;
OPT_symNew = 0;
@@ -1614,25 +1829,22 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
OPT_Import((CHAR*)"@self", OPT_SelfName, &done);
OPT_nofGmod = nofmod;
if (OPM_noerr) {
- OPM_NewSym((void*)OPT_SelfName, ((LONGINT)(256)));
+ OPM_NewSym((void*)OPT_SelfName, 256);
if (OPM_noerr) {
- OPM_SymWInt(((LONGINT)(16)));
- OPT_OutName((void*)OPT_SelfName, ((LONGINT)(256)));
+ OPM_SymWInt(16);
+ OPT_OutName((void*)OPT_SelfName, 256);
OPT_expCtxt.reffp = 0;
- OPT_expCtxt.ref = 16;
+ OPT_expCtxt.ref = 14;
OPT_expCtxt.nofm = 1;
OPT_expCtxt.locmno[0] = 0;
i = 1;
while (i < 64) {
- OPT_expCtxt.locmno[__X(i, ((LONGINT)(64)))] = -1;
+ OPT_expCtxt.locmno[__X(i, 64)] = -1;
i += 1;
}
OPT_OutObj(OPT_topScope->right);
*ext = (OPT_sfpresent && OPT_symExtended);
- *new = !OPT_sfpresent || OPT_symNew;
- if (OPM_forceNewSym) {
- *new = 1;
- }
+ *new = (!OPT_sfpresent || OPT_symNew) || __IN(17, OPM_Options, 32);
if ((((OPM_noerr && OPT_sfpresent)) && OPT_impCtxt.reffp != OPT_expCtxt.reffp)) {
*new = 1;
if (!OPT_extsf) {
@@ -1648,11 +1860,11 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
}
}
-static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form)
+static void OPT_InitStruct (OPT_Struct *typ, INT8 form)
{
*typ = OPT_NewStr(form, 1);
(*typ)->ref = form;
- (*typ)->size = OPM_ByteSize;
+ (*typ)->size = 1;
(*typ)->allocated = 1;
(*typ)->strobj = OPT_NewObj();
(*typ)->pbfp = form;
@@ -1662,7 +1874,7 @@ static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form)
(*typ)->idfpdone = 1;
}
-static void OPT_EnterBoolConst (OPS_Name name, LONGINT value)
+static void OPT_EnterBoolConst (OPS_Name name, INT32 value)
{
OPT_Object obj = NIL;
OPS_Name name__copy;
@@ -1674,7 +1886,7 @@ static void OPT_EnterBoolConst (OPS_Name name, LONGINT value)
obj->conval->intval = value;
}
-static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct *res)
+static void OPT_EnterTyp (OPS_Name name, INT8 form, INT16 size, OPT_Struct *res)
{
OPT_Object obj = NIL;
OPT_Struct typ = NIL;
@@ -1694,10 +1906,25 @@ static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct
typ->fpdone = 1;
typ->idfp = form;
typ->idfpdone = 1;
+ if (__IN(form, 0x90, 32)) {
+ OPM_FPrint(&typ->idfp, typ->size);
+ }
*res = typ;
}
-static void OPT_EnterProc (OPS_Name name, INTEGER num)
+static void OPT_EnterTypeAlias (OPS_Name name, OPT_Object *res)
+{
+ OPT_Object obj = NIL;
+ OPS_Name name__copy;
+ __DUPARR(name, OPS_Name);
+ OPT_Insert(name, &obj);
+ obj->mode = 5;
+ obj->typ = NIL;
+ obj->vis = 1;
+ *res = obj;
+}
+
+static void OPT_EnterProc (OPS_Name name, INT16 num)
{
OPT_Object obj = NIL;
OPS_Name name__copy;
@@ -1712,26 +1939,39 @@ static void EnumPtrs(void (*P)(void*))
{
P(OPT_topScope);
P(OPT_undftyp);
+ P(OPT_niltyp);
+ P(OPT_notyp);
P(OPT_bytetyp);
+ P(OPT_cpbytetyp);
P(OPT_booltyp);
P(OPT_chartyp);
P(OPT_sinttyp);
P(OPT_inttyp);
P(OPT_linttyp);
+ P(OPT_hinttyp);
+ P(OPT_int8typ);
+ P(OPT_int16typ);
+ P(OPT_int32typ);
+ P(OPT_int64typ);
+ P(OPT_settyp);
+ P(OPT_set32typ);
+ P(OPT_set64typ);
P(OPT_realtyp);
P(OPT_lrltyp);
- P(OPT_settyp);
P(OPT_stringtyp);
- P(OPT_niltyp);
- P(OPT_notyp);
+ P(OPT_adrtyp);
P(OPT_sysptrtyp);
+ P(OPT_sintobj);
+ P(OPT_intobj);
+ P(OPT_lintobj);
+ P(OPT_setobj);
__ENUMP(OPT_GlbMod, 64, P);
P(OPT_universe);
P(OPT_syslink);
__ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 3140, 1, P);
}
-__TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 24), {0, -8}};
+__TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 40), {0, -8}};
__TDESC(OPT_ObjDesc, 1, 6) = {__TDFLDS("ObjDesc", 304), {0, 4, 8, 12, 284, 288, -28}};
__TDESC(OPT_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}};
@@ -1777,6 +2017,7 @@ export void *OPT__init(void)
__REGMOD("OPT", EnumPtrs);
__REGCMD("Close", OPT_Close);
__REGCMD("CloseScope", OPT_CloseScope);
+ __REGCMD("InitRecno", OPT_InitRecno);
__INITYP(OPT_ConstDesc, OPT_ConstDesc, 0);
__INITYP(OPT_ObjDesc, OPT_ObjDesc, 0);
__INITYP(OPT_StrDesc, OPT_StrDesc, 0);
@@ -1788,12 +2029,19 @@ export void *OPT__init(void)
OPT_OpenScope(0, NIL);
OPM_errpos = 0;
OPT_InitStruct(&OPT_undftyp, 0);
- OPT_InitStruct(&OPT_notyp, 12);
- OPT_InitStruct(&OPT_stringtyp, 10);
- OPT_InitStruct(&OPT_niltyp, 11);
OPT_undftyp->BaseTyp = OPT_undftyp;
- OPT_EnterTyp((CHAR*)"BYTE", 1, OPM_ByteSize, &OPT_bytetyp);
- OPT_EnterTyp((CHAR*)"PTR", 13, OPM_PointerSize, &OPT_sysptrtyp);
+ OPT_InitStruct(&OPT_notyp, 10);
+ OPT_InitStruct(&OPT_stringtyp, 8);
+ OPT_InitStruct(&OPT_niltyp, 9);
+ OPT_EnterTyp((CHAR*)"BYTE", 1, 1, &OPT_bytetyp);
+ OPT_EnterTyp((CHAR*)"PTR", 11, -1, &OPT_sysptrtyp);
+ OPT_EnterTyp((CHAR*)"ADDRESS", 4, -1, &OPT_adrtyp);
+ OPT_EnterTyp((CHAR*)"INT8", 4, 1, &OPT_int8typ);
+ OPT_EnterTyp((CHAR*)"INT16", 4, 2, &OPT_int16typ);
+ OPT_EnterTyp((CHAR*)"INT32", 4, 4, &OPT_int32typ);
+ OPT_EnterTyp((CHAR*)"INT64", 4, 8, &OPT_int64typ);
+ OPT_EnterTyp((CHAR*)"SET32", 7, 4, &OPT_set32typ);
+ OPT_EnterTyp((CHAR*)"SET64", 7, 8, &OPT_set64typ);
OPT_EnterProc((CHAR*)"ADR", 20);
OPT_EnterProc((CHAR*)"CC", 21);
OPT_EnterProc((CHAR*)"LSH", 22);
@@ -1809,16 +2057,18 @@ export void *OPT__init(void)
OPT_syslink = OPT_topScope->right;
OPT_universe = OPT_topScope;
OPT_topScope->right = NIL;
- OPT_EnterTyp((CHAR*)"BOOLEAN", 2, OPM_BoolSize, &OPT_booltyp);
- OPT_EnterTyp((CHAR*)"CHAR", 3, OPM_CharSize, &OPT_chartyp);
- OPT_EnterTyp((CHAR*)"SET", 9, OPM_SetSize, &OPT_settyp);
- OPT_EnterTyp((CHAR*)"REAL", 7, OPM_RealSize, &OPT_realtyp);
- OPT_EnterTyp((CHAR*)"INTEGER", 5, OPM_IntSize, &OPT_inttyp);
- OPT_EnterTyp((CHAR*)"LONGINT", 6, OPM_LIntSize, &OPT_linttyp);
- OPT_EnterTyp((CHAR*)"LONGREAL", 8, OPM_LRealSize, &OPT_lrltyp);
- OPT_EnterTyp((CHAR*)"SHORTINT", 4, OPM_SIntSize, &OPT_sinttyp);
- OPT_EnterBoolConst((CHAR*)"FALSE", ((LONGINT)(0)));
- OPT_EnterBoolConst((CHAR*)"TRUE", ((LONGINT)(1)));
+ OPT_EnterTyp((CHAR*)"BOOLEAN", 2, 1, &OPT_booltyp);
+ OPT_EnterTyp((CHAR*)"CHAR", 3, 1, &OPT_chartyp);
+ OPT_EnterTyp((CHAR*)"REAL", 5, 4, &OPT_realtyp);
+ OPT_EnterTyp((CHAR*)"LONGREAL", 6, 8, &OPT_lrltyp);
+ OPT_EnterTyp((CHAR*)"HUGEINT", 4, 8, &OPT_hinttyp);
+ OPT_EnterTyp((CHAR*)"BYTE@", 4, 1, &OPT_cpbytetyp);
+ OPT_EnterTypeAlias((CHAR*)"SHORTINT", &OPT_sintobj);
+ OPT_EnterTypeAlias((CHAR*)"INTEGER", &OPT_intobj);
+ OPT_EnterTypeAlias((CHAR*)"LONGINT", &OPT_lintobj);
+ OPT_EnterTypeAlias((CHAR*)"SET", &OPT_setobj);
+ OPT_EnterBoolConst((CHAR*)"FALSE", 0);
+ OPT_EnterBoolConst((CHAR*)"TRUE", 1);
OPT_EnterProc((CHAR*)"HALT", 0);
OPT_EnterProc((CHAR*)"NEW", 1);
OPT_EnterProc((CHAR*)"ABS", 2);
@@ -1844,15 +2094,13 @@ export void *OPT__init(void)
OPT_impCtxt.ref[1] = OPT_bytetyp;
OPT_impCtxt.ref[2] = OPT_booltyp;
OPT_impCtxt.ref[3] = OPT_chartyp;
- OPT_impCtxt.ref[4] = OPT_sinttyp;
- OPT_impCtxt.ref[5] = OPT_inttyp;
- OPT_impCtxt.ref[6] = OPT_linttyp;
- OPT_impCtxt.ref[7] = OPT_realtyp;
- OPT_impCtxt.ref[8] = OPT_lrltyp;
- OPT_impCtxt.ref[9] = OPT_settyp;
- OPT_impCtxt.ref[10] = OPT_stringtyp;
- OPT_impCtxt.ref[11] = OPT_niltyp;
- OPT_impCtxt.ref[12] = OPT_notyp;
- OPT_impCtxt.ref[13] = OPT_sysptrtyp;
+ OPT_impCtxt.ref[4] = OPT_int32typ;
+ OPT_impCtxt.ref[5] = OPT_realtyp;
+ OPT_impCtxt.ref[6] = OPT_lrltyp;
+ OPT_impCtxt.ref[7] = OPT_settyp;
+ OPT_impCtxt.ref[8] = OPT_stringtyp;
+ OPT_impCtxt.ref[9] = OPT_niltyp;
+ OPT_impCtxt.ref[10] = OPT_notyp;
+ OPT_impCtxt.ref[11] = OPT_sysptrtyp;
__ENDMOD;
}
diff --git a/bootstrap/unix-48/OPT.h b/bootstrap/unix-48/OPT.h
index 41b3e7ec..90fcacf5 100644
--- a/bootstrap/unix-48/OPT.h
+++ b/bootstrap/unix-48/OPT.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPT__h
#define OPT__h
@@ -15,8 +15,9 @@ typedef
typedef
struct OPT_ConstDesc {
OPT_ConstExt ext;
- LONGINT intval, intval2;
- SET setval;
+ INT64 intval;
+ INT32 intval2;
+ UINT64 setval;
LONGREAL realval;
} OPT_ConstDesc;
@@ -32,7 +33,7 @@ typedef
typedef
struct OPT_NodeDesc {
OPT_Node left, right, link;
- SHORTINT class, subcl;
+ INT8 class, subcl;
BOOLEAN readonly;
OPT_Struct typ;
OPT_Object obj;
@@ -44,44 +45,48 @@ typedef
OPT_Object left, right, link, scope;
OPS_Name name;
BOOLEAN leaf;
- SHORTINT mode, mnolev, vis, history;
+ INT8 mode, mnolev, vis, history;
BOOLEAN used, fpdone;
- LONGINT fprint;
+ INT32 fprint;
OPT_Struct typ;
OPT_Const conval;
- LONGINT adr, linkadr;
- INTEGER x;
+ INT32 adr, linkadr;
+ INT16 x;
} OPT_ObjDesc;
typedef
struct OPT_StrDesc {
- SHORTINT form, comp, mno, extlev;
- INTEGER ref, sysflag;
- LONGINT n, size, align, txtpos;
+ INT8 form, comp, mno, extlev;
+ INT16 ref, sysflag;
+ INT32 n, size, align, txtpos;
BOOLEAN allocated, pbused, pvused;
- char _prvt0[16];
+ char _prvt0[4];
+ INT32 idfp;
+ char _prvt1[8];
OPT_Struct BaseTyp;
OPT_Object link, strobj;
} OPT_StrDesc;
-import void (*OPT_typSize)(OPT_Struct);
import OPT_Object OPT_topScope;
-import OPT_Struct OPT_undftyp, OPT_bytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_realtyp, OPT_lrltyp, OPT_settyp, OPT_stringtyp, OPT_niltyp, OPT_notyp, OPT_sysptrtyp;
-import SHORTINT OPT_nofGmod;
+import OPT_Struct OPT_undftyp, OPT_niltyp, OPT_notyp, OPT_bytetyp, OPT_cpbytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_hinttyp, OPT_int8typ, OPT_int16typ, OPT_int32typ, OPT_int64typ, OPT_settyp, OPT_set32typ, OPT_set64typ, OPT_realtyp, OPT_lrltyp, OPT_stringtyp, OPT_adrtyp, OPT_sysptrtyp;
+import OPT_Object OPT_sintobj, OPT_intobj, OPT_lintobj, OPT_setobj;
+import INT8 OPT_nofGmod;
import OPT_Object OPT_GlbMod[64];
import OPS_Name OPT_SelfName;
import BOOLEAN OPT_SYSimported;
-import LONGINT *OPT_ConstDesc__typ;
-import LONGINT *OPT_ObjDesc__typ;
-import LONGINT *OPT_StrDesc__typ;
-import LONGINT *OPT_NodeDesc__typ;
+import ADDRESS *OPT_ConstDesc__typ;
+import ADDRESS *OPT_ObjDesc__typ;
+import ADDRESS *OPT_StrDesc__typ;
+import ADDRESS *OPT_NodeDesc__typ;
+import void OPT_Align (INT32 *adr, INT32 base);
+import INT32 OPT_BaseAlignment (OPT_Struct typ);
import void OPT_Close (void);
import void OPT_CloseScope (void);
import void OPT_Export (BOOLEAN *ext, BOOLEAN *new);
-import void OPT_FPrintErr (OPT_Object obj, INTEGER errcode);
+import void OPT_FPrintErr (OPT_Object obj, INT16 errcode);
import void OPT_FPrintObj (OPT_Object obj);
import void OPT_FPrintStr (OPT_Struct typ);
import void OPT_Find (OPT_Object *res);
@@ -89,16 +94,23 @@ import void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res);
import void OPT_FindImport (OPT_Object mod, OPT_Object *res);
import void OPT_IdFPrint (OPT_Struct typ);
import void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done);
-import void OPT_Init (OPS_Name name, SET opt);
+import void OPT_Init (OPS_Name name, UINT32 opt);
+import void OPT_InitRecno (void);
import void OPT_Insert (OPS_Name name, OPT_Object *obj);
import void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old);
+import INT16 OPT_IntSize (INT64 n);
+import OPT_Struct OPT_IntType (INT32 size);
import OPT_Const OPT_NewConst (void);
import OPT_ConstExt OPT_NewExt (void);
-import OPT_Node OPT_NewNode (SHORTINT class);
+import OPT_Node OPT_NewNode (INT8 class);
import OPT_Object OPT_NewObj (void);
-import OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp);
-import void OPT_OpenScope (SHORTINT level, OPT_Object owner);
+import OPT_Struct OPT_NewStr (INT8 form, INT8 comp);
+import void OPT_OpenScope (INT8 level, OPT_Object owner);
+import OPT_Struct OPT_SetType (INT32 size);
+import OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir);
+import INT32 OPT_SizeAlignment (INT32 size);
+import void OPT_TypSize (OPT_Struct typ);
import void *OPT__init(void);
-#endif
+#endif // OPT
diff --git a/bootstrap/unix-48/OPV.c b/bootstrap/unix-48/OPV.c
index cf646f5e..5c21cb97 100644
--- a/bootstrap/unix-48/OPV.c
+++ b/bootstrap/unix-48/OPV.c
@@ -1,4 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "OPC.h"
#include "OPM.h"
@@ -7,167 +13,66 @@
typedef
struct OPV_ExitInfo {
- INTEGER level, label;
+ INT16 level, label;
} OPV_ExitInfo;
-static BOOLEAN OPV_assert, OPV_inxchk, OPV_mainprog, OPV_ansi;
-static INTEGER OPV_stamp;
-static LONGINT OPV_recno;
+static INT16 OPV_stamp;
static OPV_ExitInfo OPV_exit;
-static INTEGER OPV_nofExitLabels;
-static BOOLEAN OPV_naturalAlignment;
+static INT16 OPV_nofExitLabels;
-export LONGINT *OPV_ExitInfo__typ;
+export ADDRESS *OPV_ExitInfo__typ;
static void OPV_ActualPar (OPT_Node n, OPT_Object fp);
export void OPV_AdrAndSize (OPT_Object topScope);
static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc);
-static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INTEGER prec);
+static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec);
static void OPV_DefineTDescs (OPT_Node n);
-static void OPV_Entier (OPT_Node n, INTEGER prec);
+static void OPV_Entier (OPT_Node n, INT16 prec);
static void OPV_GetTProcNum (OPT_Object obj);
static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc);
static BOOLEAN OPV_ImplicitReturn (OPT_Node n);
-static void OPV_Index (OPT_Node n, OPT_Node d, INTEGER prec, INTEGER dim);
+static void OPV_Index (OPT_Node n, OPT_Node d, INT16 prec, INT16 dim);
export void OPV_Init (void);
static void OPV_InitTDescs (OPT_Node n);
-static void OPV_Len (OPT_Node n, LONGINT dim);
+static void OPV_Len (OPT_Node n, INT64 dim);
export void OPV_Module (OPT_Node prog);
-static LONGINT OPV_NaturalAlignment (LONGINT size, LONGINT max);
static void OPV_NewArr (OPT_Node d, OPT_Node x);
-static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, INTEGER comp);
+static void OPV_ParIntLiteral (INT64 n, INT32 size);
+static INT16 OPV_Precedence (INT16 class, INT16 subclass, INT16 form, INT16 comp);
static BOOLEAN OPV_SideEffects (OPT_Node n);
-static void OPV_SizeCast (LONGINT size);
+static void OPV_SizeCast (OPT_Node n, INT32 to);
static void OPV_Stamp (OPS_Name s);
static OPT_Object OPV_SuperProc (OPT_Node n);
static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported);
static void OPV_TraverseRecord (OPT_Struct typ);
-export void OPV_TypSize (OPT_Struct typ);
static void OPV_TypeOf (OPT_Node n);
-static void OPV_design (OPT_Node n, INTEGER prec);
-static void OPV_expr (OPT_Node n, INTEGER prec);
+static void OPV_design (OPT_Node n, INT16 prec);
+static void OPV_expr (OPT_Node n, INT16 prec);
static void OPV_stat (OPT_Node n, OPT_Object outerProc);
-static LONGINT OPV_NaturalAlignment (LONGINT size, LONGINT max)
-{
- LONGINT _o_result;
- LONGINT i;
- if (size >= max) {
- _o_result = max;
- return _o_result;
- } else {
- i = 1;
- while (i < size) {
- i += i;
- }
- _o_result = i;
- return _o_result;
- }
- __RETCHK;
-}
-
-void OPV_TypSize (OPT_Struct typ)
-{
- INTEGER f, c;
- LONGINT offset, size, base, fbase, off0;
- OPT_Object fld = NIL;
- OPT_Struct btyp = NIL;
- if (typ == OPT_undftyp) {
- OPM_err(58);
- } else if (typ->size == -1) {
- f = typ->form;
- c = typ->comp;
- if (c == 4) {
- btyp = typ->BaseTyp;
- if (btyp == NIL) {
- offset = 0;
- base = OPC_SizeAlignment(OPM_RecSize);
- } else {
- OPV_TypSize(btyp);
- offset = btyp->size - (int)__ASHR(btyp->sysflag, 8);
- base = btyp->align;
- }
- fld = typ->link;
- while ((fld != NIL && fld->mode == 4)) {
- btyp = fld->typ;
- OPV_TypSize(btyp);
- size = btyp->size;
- fbase = OPC_BaseAlignment(btyp);
- OPC_Align(&offset, fbase);
- fld->adr = offset;
- offset += size;
- if (fbase > base) {
- base = fbase;
- }
- fld = fld->link;
- }
- off0 = offset;
- if (offset == 0) {
- offset = 1;
- }
- if (OPM_RecSize == 0) {
- base = OPV_NaturalAlignment(offset, OPC_SizeAlignment(OPM_RecSize));
- }
- OPC_Align(&offset, base);
- if ((typ->strobj == NIL && __MASK(typ->align, -65536) == 0)) {
- OPV_recno += 1;
- base += __ASHL(OPV_recno, 16);
- }
- typ->size = offset;
- typ->align = base;
- typ->sysflag = __MASK(typ->sysflag, -256) + (int)__ASHL(offset - off0, 8);
- } else if (c == 2) {
- OPV_TypSize(typ->BaseTyp);
- typ->size = typ->n * typ->BaseTyp->size;
- } else if (f == 13) {
- typ->size = OPM_PointerSize;
- if (typ->BaseTyp == OPT_undftyp) {
- OPM_Mark(128, typ->n);
- } else {
- OPV_TypSize(typ->BaseTyp);
- }
- } else if (f == 14) {
- typ->size = OPM_ProcSize;
- } else if (c == 3) {
- btyp = typ->BaseTyp;
- OPV_TypSize(btyp);
- if (btyp->comp == 3) {
- typ->size = btyp->size + 4;
- } else {
- typ->size = 8;
- }
- }
- }
-}
-
void OPV_Init (void)
{
OPV_stamp = 0;
- OPV_recno = 0;
OPV_nofExitLabels = 0;
- OPV_assert = __IN(7, OPM_opt);
- OPV_inxchk = __IN(0, OPM_opt);
- OPV_mainprog = __IN(10, OPM_opt);
- OPV_ansi = __IN(6, OPM_opt);
}
static void OPV_GetTProcNum (OPT_Object obj)
{
- LONGINT oldPos;
+ INT32 oldPos;
OPT_Struct typ = NIL;
OPT_Object redef = NIL;
oldPos = OPM_errpos;
OPM_errpos = obj->scope->adr;
typ = obj->link->typ;
- if (typ->form == 13) {
+ if (typ->form == 11) {
typ = typ->BaseTyp;
}
OPT_FindField(obj->name, typ->BaseTyp, &redef);
if (redef != NIL) {
obj->adr = __ASHL(__ASHR(redef->adr, 16), 16);
- if (!__IN(2, obj->conval->setval)) {
+ if (!__IN(2, obj->conval->setval, 64)) {
OPM_err(119);
}
} else {
@@ -191,37 +96,37 @@ static void OPV_TraverseRecord (OPT_Struct typ)
static void OPV_Stamp (OPS_Name s)
{
- INTEGER i, j, k;
+ INT16 i, j, k;
CHAR n[10];
OPV_stamp += 1;
i = 0;
j = OPV_stamp;
- while (s[__X(i, ((LONGINT)(256)))] != 0x00) {
+ while (s[__X(i, 256)] != 0x00) {
i += 1;
}
if (i > 25) {
i = 25;
}
- s[__X(i, ((LONGINT)(256)))] = '_';
- s[__X(i + 1, ((LONGINT)(256)))] = '_';
+ s[__X(i, 256)] = '_';
+ s[__X(i + 1, 256)] = '_';
i += 2;
k = 0;
do {
- n[__X(k, ((LONGINT)(10)))] = (CHAR)((int)__MOD(j, 10) + 48);
+ n[__X(k, 10)] = (CHAR)((int)__MOD(j, 10) + 48);
j = __DIV(j, 10);
k += 1;
} while (!(j == 0));
do {
k -= 1;
- s[__X(i, ((LONGINT)(256)))] = n[__X(k, ((LONGINT)(10)))];
+ s[__X(i, 256)] = n[__X(k, 10)];
i += 1;
} while (!(k == 0));
- s[__X(i, ((LONGINT)(256)))] = 0x00;
+ s[__X(i, 256)] = 0x00;
}
static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported)
{
- INTEGER mode;
+ INT16 mode;
OPT_Object scope = NIL;
OPT_Struct typ = NIL;
if (obj != NIL) {
@@ -234,8 +139,8 @@ static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exporte
mode = obj->mode;
if ((mode == 5 && (obj->vis != 0) == exported)) {
typ = obj->typ;
- OPV_TypSize(obj->typ);
- if (typ->form == 13) {
+ OPT_TypSize(obj->typ);
+ if (typ->form == 11) {
typ = typ->BaseTyp;
}
if (typ->comp == 4) {
@@ -244,21 +149,21 @@ static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exporte
} else if (mode == 13) {
OPV_GetTProcNum(obj);
} else if (mode == 1) {
- OPV_TypSize(obj->typ);
+ OPT_TypSize(obj->typ);
}
if (!exported) {
- if ((__IN(mode, 0x60) && obj->mnolev > 0)) {
+ if ((__IN(mode, 0x60, 32) && obj->mnolev > 0)) {
OPV_Stamp(obj->name);
}
- if (__IN(mode, 0x26)) {
+ if (__IN(mode, 0x26, 32)) {
obj->scope = outerScope;
- } else if (__IN(mode, 0x26c0)) {
+ } else if (__IN(mode, 0x26c0, 32)) {
if (obj->conval->setval == 0x0) {
OPM_err(129);
}
scope = obj->scope;
scope->leaf = 1;
- __COPY(obj->name, scope->name, ((LONGINT)(256)));
+ __COPY(obj->name, scope->name, 256);
OPV_Stamp(scope->name);
if (mode == 9) {
obj->adr = 1;
@@ -275,66 +180,66 @@ static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exporte
void OPV_AdrAndSize (OPT_Object topScope)
{
+ __ASSERT(OPT_sinttyp != NIL, 0);
+ __ASSERT(OPT_inttyp != NIL, 0);
+ __ASSERT(OPT_linttyp != NIL, 0);
OPM_errpos = topScope->adr;
topScope->leaf = 1;
OPV_Traverse(topScope->right, topScope, 1);
OPV_Traverse(topScope->right, topScope, 0);
OPT_chartyp->strobj->linkadr = 2;
+ OPT_cpbytetyp->strobj->linkadr = 2;
OPT_settyp->strobj->linkadr = 2;
OPT_realtyp->strobj->linkadr = 2;
- OPT_inttyp->strobj->linkadr = 2;
- OPT_linttyp->strobj->linkadr = 2;
+ OPT_adrtyp->strobj->linkadr = 2;
+ OPT_int8typ->strobj->linkadr = 2;
+ OPT_int16typ->strobj->linkadr = 2;
+ OPT_int32typ->strobj->linkadr = 2;
+ OPT_int64typ->strobj->linkadr = 2;
+ OPT_set32typ->strobj->linkadr = 2;
+ OPT_set64typ->strobj->linkadr = 2;
+ OPT_hinttyp->strobj->linkadr = 2;
OPT_lrltyp->strobj->linkadr = 2;
- OPT_sinttyp->strobj->linkadr = 2;
OPT_booltyp->strobj->linkadr = 2;
OPT_bytetyp->strobj->linkadr = 2;
OPT_sysptrtyp->strobj->linkadr = 2;
}
-static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, INTEGER comp)
+static INT16 OPV_Precedence (INT16 class, INT16 subclass, INT16 form, INT16 comp)
{
- INTEGER _o_result;
switch (class) {
case 7: case 0: case 2: case 4: case 9:
case 13:
- _o_result = 10;
- return _o_result;
+ return 10;
break;
case 5:
- if (__IN(3, OPM_opt)) {
- _o_result = 10;
- return _o_result;
+ if (__IN(3, OPM_Options, 32)) {
+ return 10;
} else {
- _o_result = 9;
- return _o_result;
+ return 9;
}
break;
case 1:
- if (__IN(comp, 0x0c)) {
- _o_result = 10;
- return _o_result;
+ if (__IN(comp, 0x0c, 32)) {
+ return 10;
} else {
- _o_result = 9;
- return _o_result;
+ return 9;
}
break;
case 3:
- _o_result = 9;
- return _o_result;
+ return 9;
break;
case 11:
switch (subclass) {
case 33: case 7: case 24: case 29: case 20:
- _o_result = 9;
- return _o_result;
+ return 9;
break;
case 16: case 21: case 22: case 23: case 25:
- _o_result = 10;
- return _o_result;
+ return 10;
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence OPT.Nmop, subclass = ", (LONGINT)55);
- OPM_LogWNum(subclass, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence OPT.Nmop, subclass = ", 55);
+ OPM_LogWNum(subclass, 0);
OPM_LogWLn();
break;
}
@@ -342,91 +247,75 @@ static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, IN
case 12:
switch (subclass) {
case 1:
- if (form == 9) {
- _o_result = 4;
- return _o_result;
+ if (form == 7) {
+ return 4;
} else {
- _o_result = 8;
- return _o_result;
+ return 8;
}
break;
case 2:
- if (form == 9) {
- _o_result = 3;
- return _o_result;
+ if (form == 7) {
+ return 3;
} else {
- _o_result = 8;
- return _o_result;
+ return 8;
}
break;
case 3: case 4:
- _o_result = 10;
- return _o_result;
+ return 10;
break;
case 6:
- if (form == 9) {
- _o_result = 2;
- return _o_result;
+ if (form == 7) {
+ return 2;
} else {
- _o_result = 7;
- return _o_result;
+ return 7;
}
break;
case 7:
- if (form == 9) {
- _o_result = 4;
- return _o_result;
+ if (form == 7) {
+ return 4;
} else {
- _o_result = 7;
- return _o_result;
+ return 7;
}
break;
case 11: case 12: case 13: case 14:
- _o_result = 6;
- return _o_result;
+ return 6;
break;
case 9: case 10:
- _o_result = 5;
- return _o_result;
+ return 5;
break;
case 5:
- _o_result = 1;
- return _o_result;
+ return 1;
break;
case 8:
- _o_result = 0;
- return _o_result;
+ return 0;
break;
case 19: case 15: case 17: case 18: case 26:
case 27: case 28:
- _o_result = 10;
- return _o_result;
+ return 10;
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence OPT.Ndop, subclass = ", (LONGINT)55);
- OPM_LogWNum(subclass, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence OPT.Ndop, subclass = ", 55);
+ OPM_LogWNum(subclass, 0);
OPM_LogWLn();
break;
}
break;
case 10:
- _o_result = 10;
- return _o_result;
+ return 10;
break;
case 8: case 6:
- _o_result = 12;
- return _o_result;
+ return 12;
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence, class = ", (LONGINT)43);
- OPM_LogWNum(class, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence, class = ", 43);
+ OPM_LogWNum(class, 0);
OPM_LogWLn();
break;
}
__RETCHK;
}
-static void OPV_Len (OPT_Node n, LONGINT dim)
+static void OPV_Len (OPT_Node n, INT64 dim)
{
while ((n->class == 4 && n->typ->comp == 3)) {
dim += 1;
@@ -434,7 +323,7 @@ static void OPV_Len (OPT_Node n, LONGINT dim)
}
if ((n->class == 3 && n->typ->comp == 3)) {
OPV_design(n->left, 10);
- OPM_WriteString((CHAR*)"->len[", (LONGINT)7);
+ OPM_WriteString((CHAR*)"->len[", 7);
OPM_WriteInt(dim);
OPM_Write(']');
} else {
@@ -444,21 +333,18 @@ static void OPV_Len (OPT_Node n, LONGINT dim)
static BOOLEAN OPV_SideEffects (OPT_Node n)
{
- BOOLEAN _o_result;
if (n != NIL) {
- _o_result = (n->class == 13 || OPV_SideEffects(n->left)) || OPV_SideEffects(n->right);
- return _o_result;
+ return (n->class == 13 || OPV_SideEffects(n->left)) || OPV_SideEffects(n->right);
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-static void OPV_Entier (OPT_Node n, INTEGER prec)
+static void OPV_Entier (OPT_Node n, INT16 prec)
{
- if (__IN(n->typ->form, 0x0180)) {
- OPM_WriteString((CHAR*)"__ENTIER(", (LONGINT)10);
+ if (__IN(n->typ->form, 0x60, 32)) {
+ OPM_WriteString((CHAR*)"__ENTIER(", 10);
OPV_expr(n, -1);
OPM_Write(')');
} else {
@@ -466,44 +352,49 @@ static void OPV_Entier (OPT_Node n, INTEGER prec)
}
}
-static void OPV_SizeCast (LONGINT size)
+static void OPV_SizeCast (OPT_Node n, INT32 to)
{
- if (size <= 4) {
- OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
+ if ((to < n->typ->size && __IN(2, OPM_Options, 32))) {
+ OPM_WriteString((CHAR*)"__SHORT", 8);
+ if (OPV_SideEffects(n)) {
+ OPM_Write('F');
+ }
+ OPM_Write('(');
+ OPV_Entier(n, -1);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPM_WriteInt(OPM_SignedMaximum(to) + 1);
+ OPM_Write(')');
} else {
- OPM_WriteString((CHAR*)"(SYSTEM_INT64)", (LONGINT)15);
+ if ((n->typ->size != to && (n->typ->size > 4 || to != 4))) {
+ OPM_WriteString((CHAR*)"(INT", 5);
+ OPM_WriteInt(__ASHL(to, 3));
+ OPM_WriteString((CHAR*)")", 2);
+ }
}
}
-static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INTEGER prec)
+static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec)
{
- INTEGER from, to;
+ INT16 from, to;
from = n->typ->form;
to = newtype->form;
- if (to == 9) {
- OPM_WriteString((CHAR*)"__SETOF(", (LONGINT)9);
- OPV_Entier(n, -1);
- OPM_Write(')');
- } else if (__IN(to, 0x70)) {
- if ((newtype->size < n->typ->size && __IN(2, OPM_opt))) {
- OPM_WriteString((CHAR*)"__SHORT", (LONGINT)8);
- if (OPV_SideEffects(n)) {
- OPM_Write('F');
- }
- OPM_Write('(');
- OPV_Entier(n, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPM_WriteInt(OPM_SignedMaximum(newtype->size) + 1);
- OPM_Write(')');
- } else {
- if (newtype->size != n->typ->size) {
- OPV_SizeCast(newtype->size);
- }
+ 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);
+ OPM_WriteString((CHAR*)",", 2);
+ OPM_WriteInt(__ASHL(newtype->size, 3));
+ OPM_Write(')');
}
+ } else if (to == 4) {
+ OPV_SizeCast(n, newtype->size);
+ OPV_Entier(n, 9);
} else if (to == 3) {
- if (__IN(2, OPM_opt)) {
- OPM_WriteString((CHAR*)"__CHR", (LONGINT)6);
+ if (__IN(2, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__CHR", 6);
if (OPV_SideEffects(n)) {
OPM_Write('F');
}
@@ -511,7 +402,7 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INTEGER prec)
OPV_Entier(n, -1);
OPM_Write(')');
} else {
- OPM_WriteString((CHAR*)"(CHAR)", (LONGINT)7);
+ OPM_WriteString((CHAR*)"(CHAR)", 7);
OPV_Entier(n, 9);
}
} else {
@@ -521,15 +412,15 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INTEGER prec)
static void OPV_TypeOf (OPT_Node n)
{
- if (n->typ->form == 13) {
- OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10);
+ if (n->typ->form == 11) {
+ OPM_WriteString((CHAR*)"__TYPEOF(", 10);
OPV_expr(n, -1);
OPM_Write(')');
- } else if (__IN(n->class, 0x15)) {
+ } else if (__IN(n->class, 0x15, 32)) {
OPC_Andent(n->typ);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
} else if (n->class == 3) {
- OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__TYPEOF(", 10);
OPV_expr(n->left, -1);
OPM_Write(')');
} else if (n->class == 5) {
@@ -541,35 +432,35 @@ static void OPV_TypeOf (OPT_Node n)
}
}
-static void OPV_Index (OPT_Node n, OPT_Node d, INTEGER prec, INTEGER dim)
+static void OPV_Index (OPT_Node n, OPT_Node d, INT16 prec, INT16 dim)
{
- if (!OPV_inxchk || (n->right->class == 7 && (n->right->conval->intval == 0 || n->left->typ->comp != 3))) {
+ if (!__IN(0, OPM_Options, 32) || (n->right->class == 7 && (n->right->conval->intval == 0 || n->left->typ->comp != 3))) {
OPV_expr(n->right, prec);
} else {
if (OPV_SideEffects(n->right)) {
- OPM_WriteString((CHAR*)"__XF(", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__XF(", 6);
} else {
- OPM_WriteString((CHAR*)"__X(", (LONGINT)5);
+ OPM_WriteString((CHAR*)"__X(", 5);
}
OPV_expr(n->right, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_Len(d, dim);
OPM_Write(')');
}
}
-static void OPV_design (OPT_Node n, INTEGER prec)
+static void OPV_design (OPT_Node n, INT16 prec)
{
OPT_Object obj = NIL;
OPT_Struct typ = NIL;
- INTEGER class, designPrec, comp;
+ INT16 class, designPrec, comp;
OPT_Node d = NIL, x = NIL;
- INTEGER dims, i, _for__27;
+ INT16 dims, i, _for__26;
comp = n->typ->comp;
obj = n->obj;
class = n->class;
designPrec = OPV_Precedence(class, n->subcl, n->typ->form, comp);
- if ((((((class == 0 && obj->mnolev > 0)) && (int)obj->mnolev != OPM_level)) && prec == 10)) {
+ if ((((((class == 0 && obj->mnolev > 0)) && (INT16)obj->mnolev != OPM_level)) && prec == 10)) {
designPrec = 9;
}
if (prec > designPrec) {
@@ -586,7 +477,7 @@ static void OPV_design (OPT_Node n, INTEGER prec)
OPC_CompleteIdent(n->obj);
break;
case 1:
- if (!__IN(comp, 0x0c)) {
+ if (!__IN(comp, 0x0c, 32)) {
OPM_Write('*');
}
OPC_CompleteIdent(n->obj);
@@ -594,7 +485,7 @@ static void OPV_design (OPT_Node n, INTEGER prec)
case 2:
if (n->left->class == 3) {
OPV_design(n->left->left, designPrec);
- OPM_WriteString((CHAR*)"->", (LONGINT)3);
+ OPM_WriteString((CHAR*)"->", 3);
} else {
OPV_design(n->left, designPrec);
OPM_Write('.');
@@ -604,7 +495,7 @@ static void OPV_design (OPT_Node n, INTEGER prec)
case 3:
if (n->typ->comp == 3) {
OPV_design(n->left, 10);
- OPM_WriteString((CHAR*)"->data", (LONGINT)7);
+ OPM_WriteString((CHAR*)"->data", 7);
} else {
OPM_Write('*');
OPV_design(n->left, designPrec);
@@ -631,25 +522,25 @@ static void OPV_design (OPT_Node n, INTEGER prec)
while (x != d) {
if (x->left != d) {
OPV_Index(x, d, 7, i);
- OPM_WriteString((CHAR*)" + ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" + ", 4);
OPV_Len(d, i);
- OPM_WriteString((CHAR*)" * (", (LONGINT)5);
+ OPM_WriteString((CHAR*)" * (", 5);
i -= 1;
} else {
OPV_Index(x, d, -1, i);
}
x = x->left;
}
- _for__27 = dims;
+ _for__26 = dims;
i = 1;
- while (i <= _for__27) {
+ while (i <= _for__26) {
OPM_Write(')');
i += 1;
}
if (n->typ->comp == 3) {
OPM_Write(')');
- while ((int)i < __ASHR(d->typ->size - 4, 2)) {
- OPM_WriteString((CHAR*)" * ", (LONGINT)4);
+ while (i < __ASHR(d->typ->size - 4, 2)) {
+ OPM_WriteString((CHAR*)" * ", 4);
OPV_Len(d, i);
i += 1;
}
@@ -665,35 +556,35 @@ static void OPV_design (OPT_Node n, INTEGER prec)
case 5:
typ = n->typ;
obj = n->left->obj;
- if (__IN(3, OPM_opt)) {
+ if (__IN(3, OPM_Options, 32)) {
if (typ->comp == 4) {
- OPM_WriteString((CHAR*)"__GUARDR(", (LONGINT)10);
- if ((int)obj->mnolev != OPM_level) {
- OPM_WriteStringVar((void*)obj->scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"__curr->", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__GUARDR(", 10);
+ if ((INT16)obj->mnolev != OPM_level) {
+ OPM_WriteStringVar((void*)obj->scope->name, 256);
+ OPM_WriteString((CHAR*)"__curr->", 9);
OPC_Ident(obj);
} else {
OPC_Ident(obj);
}
} else {
if (typ->BaseTyp->strobj == NIL) {
- OPM_WriteString((CHAR*)"__GUARDA(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__GUARDA(", 10);
} else {
- OPM_WriteString((CHAR*)"__GUARDP(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__GUARDP(", 10);
}
OPV_expr(n->left, -1);
typ = typ->BaseTyp;
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(typ->extlev);
OPM_Write(')');
} else {
if (typ->comp == 4) {
- OPM_WriteString((CHAR*)"*(", (LONGINT)3);
+ OPM_WriteString((CHAR*)"*(", 3);
OPC_Ident(typ->strobj);
- OPM_WriteString((CHAR*)"*)", (LONGINT)3);
+ OPM_WriteString((CHAR*)"*)", 3);
OPC_CompleteIdent(obj);
} else {
OPM_Write('(');
@@ -704,17 +595,17 @@ static void OPV_design (OPT_Node n, INTEGER prec)
}
break;
case 6:
- if (__IN(3, OPM_opt)) {
+ if (__IN(3, OPM_Options, 32)) {
if (n->left->class == 1) {
- OPM_WriteString((CHAR*)"__GUARDEQR(", (LONGINT)12);
+ OPM_WriteString((CHAR*)"__GUARDEQR(", 12);
OPC_CompleteIdent(n->left->obj);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_TypeOf(n->left);
} else {
- OPM_WriteString((CHAR*)"__GUARDEQP(", (LONGINT)12);
+ OPM_WriteString((CHAR*)"__GUARDEQP(", 12);
OPV_expr(n->left->left, -1);
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Ident(n->left->typ->strobj);
OPM_Write(')');
} else {
@@ -727,8 +618,8 @@ static void OPV_design (OPT_Node n, INTEGER prec)
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.design, class = ", (LONGINT)39);
- OPM_LogWNum(class, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.design, class = ", 39);
+ OPM_LogWNum(class, 0);
OPM_LogWLn();
break;
}
@@ -737,10 +628,15 @@ static void OPV_design (OPT_Node n, INTEGER prec)
}
}
+static void OPV_ParIntLiteral (INT64 n, INT32 size)
+{
+ OPM_WriteInt(n);
+}
+
static void OPV_ActualPar (OPT_Node n, OPT_Object fp)
{
OPT_Struct typ = NIL, aptyp = NIL;
- INTEGER comp, form, mode, prec, dim;
+ INT16 comp, form, mode, prec, dim;
OPM_Write('(');
while (n != NIL) {
typ = fp->typ;
@@ -751,81 +647,68 @@ static void OPV_ActualPar (OPT_Node n, OPT_Object fp)
if ((((mode == 2 && n->class == 11)) && n->subcl == 29)) {
OPM_Write('(');
OPC_Ident(n->typ->strobj);
- OPM_WriteString((CHAR*)"*)", (LONGINT)3);
+ OPM_WriteString((CHAR*)"*)", 3);
prec = 10;
}
- if (!__IN(n->typ->comp, 0x0c)) {
+ if (!__IN(n->typ->comp, 0x0c, 32)) {
if (mode == 2) {
- if ((OPV_ansi && typ != n->typ)) {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
+ if (typ != n->typ) {
+ OPM_WriteString((CHAR*)"(void*)", 8);
}
OPM_Write('&');
prec = 9;
- } else if (OPV_ansi) {
- if ((__IN(comp, 0x0c) && n->class == 7)) {
- OPM_WriteString((CHAR*)"(CHAR*)", (LONGINT)8);
- } else if ((((form == 13 && typ != n->typ)) && n->typ != OPT_niltyp)) {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
- }
} else {
- if ((__IN(form, 0x0180) && __IN(n->typ->form, 0x70))) {
- OPM_WriteString((CHAR*)"(double)", (LONGINT)9);
- prec = 9;
- } else if ((form == 6 && n->typ->form < 6)) {
- OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10);
- prec = 9;
+ if ((__IN(comp, 0x0c, 32) && n->class == 7)) {
+ OPM_WriteString((CHAR*)"(CHAR*)", 8);
+ } else if ((((form == 11 && typ != n->typ)) && n->typ != OPT_niltyp)) {
+ OPM_WriteString((CHAR*)"(void*)", 8);
}
}
- } else if (OPV_ansi) {
+ } else {
if ((((mode == 2 && typ != n->typ)) && prec == -1)) {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
+ OPM_WriteString((CHAR*)"(void*)", 8);
}
}
if ((((mode == 2 && n->class == 11)) && n->subcl == 29)) {
OPV_expr(n->left, prec);
- } else if ((((((form == 6 && n->class == 7)) && n->conval->intval <= OPM_SignedMaximum(OPM_IntSize))) && n->conval->intval >= OPM_SignedMinimum(OPM_IntSize))) {
- OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12);
- OPV_expr(n, prec);
- OPM_WriteString((CHAR*)"))", (LONGINT)3);
+ } else if ((form == 4 && n->class == 7)) {
+ OPV_ParIntLiteral(n->conval->intval, n->typ->size);
} else {
OPV_expr(n, prec);
}
if ((comp == 4 && mode == 2)) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_TypeOf(n);
} else if (comp == 3) {
if (n->class == 7) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10);
- OPM_WriteInt(n->conval->intval2);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPV_ParIntLiteral(n->conval->intval2, OPM_AddressSize);
} else {
aptyp = n->typ;
dim = 0;
while ((typ->comp == 3 && typ->BaseTyp->form != 1)) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_Len(n, dim);
typ = typ->BaseTyp;
aptyp = aptyp->BaseTyp;
dim += 1;
}
if ((typ->comp == 3 && typ->BaseTyp->form == 1)) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
while (aptyp->comp == 3) {
OPV_Len(n, dim);
- OPM_WriteString((CHAR*)" * ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" * ", 4);
dim += 1;
aptyp = aptyp->BaseTyp;
}
- OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12);
- OPM_WriteInt(aptyp->size);
- OPM_WriteString((CHAR*)"))", (LONGINT)3);
+ OPV_ParIntLiteral(aptyp->size, OPM_AddressSize);
}
}
}
n = n->link;
fp = fp->link;
if (n != NIL) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
}
}
OPM_Write(')');
@@ -833,21 +716,19 @@ static void OPV_ActualPar (OPT_Node n, OPT_Object fp)
static OPT_Object OPV_SuperProc (OPT_Node n)
{
- OPT_Object _o_result;
OPT_Object obj = NIL;
OPT_Struct typ = NIL;
typ = n->right->typ;
- if (typ->form == 13) {
+ if (typ->form == 11) {
typ = typ->BaseTyp;
}
OPT_FindField(n->left->obj->name, typ->BaseTyp, &obj);
- _o_result = obj;
- return _o_result;
+ return obj;
}
-static void OPV_expr (OPT_Node n, INTEGER prec)
+static void OPV_expr (OPT_Node n, INT16 prec)
{
- INTEGER class, subclass, form, exprPrec;
+ INT16 class, subclass, form, exprPrec;
OPT_Struct typ = NIL;
OPT_Node l = NIL, r = NIL;
OPT_Object proc = NIL;
@@ -857,7 +738,7 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
l = n->left;
r = n->right;
exprPrec = OPV_Precedence(class, subclass, form, n->typ->comp);
- if ((exprPrec <= prec && __IN(class, 0x3ce0))) {
+ if ((exprPrec <= prec && __IN(class, 0x3ce0, 32))) {
OPM_Write('(');
}
switch (class) {
@@ -865,10 +746,12 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPC_Constant(n->conval, form);
break;
case 10:
- OPM_WriteString((CHAR*)"__SETRNG(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__SETRNG(", 10);
OPV_expr(l, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(r, -1);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPM_WriteInt(__ASHL(n->typ->size, 3));
OPM_Write(')');
break;
case 11:
@@ -878,7 +761,7 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPV_expr(l, exprPrec);
break;
case 7:
- if (form == 9) {
+ if (form == 7) {
OPM_Write('~');
} else {
OPM_Write('-');
@@ -888,16 +771,16 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
case 16:
typ = n->obj->typ;
if (l->typ->comp == 4) {
- OPM_WriteString((CHAR*)"__IS(", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__IS(", 6);
OPC_TypeOf(l->obj);
} else {
- OPM_WriteString((CHAR*)"__ISP(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__ISP(", 7);
OPV_expr(l, -1);
typ = typ->BaseTyp;
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(typ->extlev);
OPM_Write(')');
break;
@@ -906,54 +789,54 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
break;
case 21:
if (OPV_SideEffects(l)) {
- if (l->typ->form < 7) {
- if (l->typ->form < 6) {
- OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
+ if (l->typ->form < 5) {
+ if (l->typ->size <= 4) {
+ OPM_WriteString((CHAR*)"(int)", 6);
}
- OPM_WriteString((CHAR*)"__ABSF(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ABSF(", 8);
} else {
- OPM_WriteString((CHAR*)"__ABSFD(", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__ABSFD(", 9);
}
} else {
- OPM_WriteString((CHAR*)"__ABS(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__ABS(", 7);
}
OPV_expr(l, -1);
OPM_Write(')');
break;
case 22:
- OPM_WriteString((CHAR*)"__CAP(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__CAP(", 7);
OPV_expr(l, -1);
OPM_Write(')');
break;
case 23:
- OPM_WriteString((CHAR*)"__ODD(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__ODD(", 7);
OPV_expr(l, -1);
OPM_Write(')');
break;
case 24:
- OPM_WriteString((CHAR*)"(LONGINT)(SYSTEM_ADDRESS)", (LONGINT)26);
+ OPM_WriteString((CHAR*)"(ADDRESS)", 10);
if (l->class == 1) {
OPC_CompleteIdent(l->obj);
} else {
- if ((l->typ->form != 10 && !__IN(l->typ->comp, 0x0c))) {
+ if ((l->typ->form != 8 && !__IN(l->typ->comp, 0x0c, 32))) {
OPM_Write('&');
}
OPV_expr(l, exprPrec);
}
break;
case 29:
- if (!__IN(l->class, 0x17) || (((__IN(n->typ->form, 0x6240) && __IN(l->typ->form, 0x6240))) && n->typ->size == l->typ->size)) {
+ if (!__IN(l->class, 0x17, 32) || (((__IN(n->typ->form, 0x1890, 32) && __IN(l->typ->form, 0x1890, 32))) && n->typ->size == l->typ->size)) {
OPM_Write('(');
OPC_Ident(n->typ->strobj);
OPM_Write(')');
- if (__IN(n->typ->form, 0x6000) || __IN(l->typ->form, 0x6000)) {
- OPM_WriteString((CHAR*)"(SYSTEM_ADDRESS)", (LONGINT)17);
+ if (__IN(n->typ->form, 0x1800, 32) || __IN(l->typ->form, 0x1800, 32)) {
+ OPM_WriteString((CHAR*)"(ADDRESS)", 10);
}
OPV_expr(l, exprPrec);
} else {
- OPM_WriteString((CHAR*)"__VAL(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__VAL(", 7);
OPC_Ident(n->typ->strobj);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(l, -1);
OPM_Write(')');
}
@@ -972,94 +855,98 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
case 28: case 3: case 4:
switch (subclass) {
case 15:
- OPM_WriteString((CHAR*)"__IN(", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__IN(", 6);
break;
case 17:
if (r->class == 7) {
if (r->conval->intval >= 0) {
- OPM_WriteString((CHAR*)"__ASHL(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ASHL(", 8);
} else {
- OPM_WriteString((CHAR*)"__ASHR(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ASHR(", 8);
}
} else if (OPV_SideEffects(r)) {
- OPM_WriteString((CHAR*)"__ASHF(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ASHF(", 8);
} else {
- OPM_WriteString((CHAR*)"__ASH(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__ASH(", 7);
}
break;
case 18:
- OPM_WriteString((CHAR*)"__MASK(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__MASK(", 8);
break;
case 26:
- OPM_WriteString((CHAR*)"__BIT(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__BIT(", 7);
break;
case 27:
if (r->class == 7) {
if (r->conval->intval >= 0) {
- OPM_WriteString((CHAR*)"__LSHL(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__LSHL(", 8);
} else {
- OPM_WriteString((CHAR*)"__LSHR(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__LSHR(", 8);
}
} else {
- OPM_WriteString((CHAR*)"__LSH(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__LSH(", 7);
}
break;
case 28:
if (r->class == 7) {
if (r->conval->intval >= 0) {
- OPM_WriteString((CHAR*)"__ROTL(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ROTL(", 8);
} else {
- OPM_WriteString((CHAR*)"__ROTR(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ROTR(", 8);
}
} else {
- OPM_WriteString((CHAR*)"__ROT(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__ROT(", 7);
}
break;
case 3:
if (OPV_SideEffects(n)) {
- if (form < 6) {
- OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
+ if (n->typ->size <= 4) {
+ OPM_WriteString((CHAR*)"(int)", 6);
}
- OPM_WriteString((CHAR*)"__DIVF(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__DIVF(", 8);
} else {
- OPM_WriteString((CHAR*)"__DIV(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__DIV(", 7);
}
break;
case 4:
- if (form < 6) {
- OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
+ if (n->typ->size <= 4) {
+ OPM_WriteString((CHAR*)"(int)", 6);
}
if (OPV_SideEffects(n)) {
- OPM_WriteString((CHAR*)"__MODF(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__MODF(", 8);
} else {
- OPM_WriteString((CHAR*)"__MOD(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__MOD(", 7);
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", (LONGINT)40);
- OPM_LogWNum(subclass, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", 40);
+ OPM_LogWNum(subclass, 0);
OPM_LogWLn();
break;
}
OPV_expr(l, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- if ((((__IN(subclass, 0x18020000) && r->class == 7)) && r->conval->intval < 0)) {
+ OPM_WriteString((CHAR*)", ", 3);
+ if ((((__IN(subclass, 0x18020000, 32) && r->class == 7)) && r->conval->intval < 0)) {
OPM_WriteInt(-r->conval->intval);
} else {
OPV_expr(r, -1);
}
- if (__IN(subclass, 0x18000000)) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPC_Ident(l->typ->strobj);
+ if (__IN(subclass, 0x18008000, 32)) {
+ OPM_WriteString((CHAR*)", ", 3);
+ if (subclass == 15) {
+ OPM_WriteInt(__ASHL(r->typ->size, 3));
+ } else {
+ OPM_WriteInt(__ASHL(l->typ->size, 3));
+ }
}
OPM_Write(')');
break;
case 9: case 10: case 11: case 12: case 13:
case 14:
- if (__IN(l->typ->form, 0x8400)) {
- OPM_WriteString((CHAR*)"__STRCMP(", (LONGINT)10);
+ if (__IN(l->typ->form, 0x2100, 32)) {
+ OPM_WriteString((CHAR*)"__STRCMP(", 10);
OPV_expr(l, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(r, -1);
OPM_Write(')');
OPC_Cmp(subclass);
@@ -1068,31 +955,31 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPV_expr(l, exprPrec);
OPC_Cmp(subclass);
typ = l->typ;
- if ((((((typ->form == 13 && r->typ->form != 11)) && r->typ != typ)) && r->typ != OPT_sysptrtyp)) {
- OPM_WriteString((CHAR*)"(void *) ", (LONGINT)10);
+ if ((((((typ->form == 11 && r->typ->form != 9)) && r->typ != typ)) && r->typ != OPT_sysptrtyp)) {
+ OPM_WriteString((CHAR*)"(void *) ", 10);
}
OPV_expr(r, exprPrec);
}
break;
default:
- if (subclass == 5 || (form == 9 && (subclass == 1 || subclass == 7))) {
+ if (subclass == 5 || (form == 7 && (subclass == 1 || subclass == 7))) {
OPM_Write('(');
}
OPV_expr(l, exprPrec);
switch (subclass) {
case 1:
- if (form == 9) {
- OPM_WriteString((CHAR*)" & ", (LONGINT)4);
+ if (form == 7) {
+ OPM_WriteString((CHAR*)" & ", 4);
} else {
- OPM_WriteString((CHAR*)" * ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" * ", 4);
}
break;
case 2:
- if (form == 9) {
- OPM_WriteString((CHAR*)" ^ ", (LONGINT)4);
+ if (form == 7) {
+ OPM_WriteString((CHAR*)" ^ ", 4);
} else {
- OPM_WriteString((CHAR*)" / ", (LONGINT)4);
- if (r->obj == NIL || __IN(r->obj->typ->form, 0x70)) {
+ OPM_WriteString((CHAR*)" / ", 4);
+ if (r->obj == NIL || r->obj->typ->form == 4) {
OPM_Write('(');
OPC_Ident(n->typ->strobj);
OPM_Write(')');
@@ -1100,33 +987,33 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
}
break;
case 5:
- OPM_WriteString((CHAR*)" && ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" && ", 5);
break;
case 6:
- if (form == 9) {
- OPM_WriteString((CHAR*)" | ", (LONGINT)4);
+ if (form == 7) {
+ OPM_WriteString((CHAR*)" | ", 4);
} else {
- OPM_WriteString((CHAR*)" + ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" + ", 4);
}
break;
case 7:
- if (form == 9) {
- OPM_WriteString((CHAR*)" & ~", (LONGINT)5);
+ if (form == 7) {
+ OPM_WriteString((CHAR*)" & ~", 5);
} else {
- OPM_WriteString((CHAR*)" - ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" - ", 4);
}
break;
case 8:
- OPM_WriteString((CHAR*)" || ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" || ", 5);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", (LONGINT)40);
- OPM_LogWNum(subclass, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", 40);
+ OPM_LogWNum(subclass, 0);
OPM_LogWLn();
break;
}
OPV_expr(r, exprPrec);
- if (subclass == 5 || (form == 9 && (subclass == 1 || subclass == 7))) {
+ if (subclass == 5 || (form == 7 && (subclass == 1 || subclass == 7))) {
OPM_Write(')');
}
break;
@@ -1137,7 +1024,7 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
if (l->subcl == 1) {
proc = OPV_SuperProc(n);
} else {
- OPM_WriteString((CHAR*)"__", (LONGINT)3);
+ OPM_WriteString((CHAR*)"__", 3);
proc = OPC_BaseTProc(l->obj);
}
OPC_Ident(proc);
@@ -1153,7 +1040,7 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPV_design(n, prec);
break;
}
- if ((exprPrec <= prec && __IN(class, 0x3ca0))) {
+ if ((exprPrec <= prec && __IN(class, 0x3ca0, 32))) {
OPM_Write(')');
}
}
@@ -1163,10 +1050,10 @@ static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc)
OPT_Node if_ = NIL;
OPT_Object obj = NIL;
OPT_Struct typ = NIL;
- LONGINT adr;
+ INT32 adr;
if_ = n->left;
while (if_ != NIL) {
- OPM_WriteString((CHAR*)"if ", (LONGINT)4);
+ OPM_WriteString((CHAR*)"if ", 4);
OPV_expr(if_->left, 12);
OPM_Write(' ');
OPC_BegBlk();
@@ -1177,9 +1064,9 @@ static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc)
if (typ->comp == 4) {
OPC_BegStat();
OPC_Ident(if_->left->obj);
- OPM_WriteString((CHAR*)" *", (LONGINT)3);
- OPM_WriteString(obj->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"__ = (void*)", (LONGINT)13);
+ OPM_WriteString((CHAR*)" *", 3);
+ OPM_WriteString(obj->name, 256);
+ OPM_WriteString((CHAR*)"__ = (void*)", 13);
obj->adr = 0;
OPC_CompleteIdent(obj);
OPC_EndStat();
@@ -1195,13 +1082,13 @@ static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc)
if_ = if_->link;
if ((if_ != NIL || n->right != NIL) || withtrap) {
OPC_EndBlk0();
- OPM_WriteString((CHAR*)" else ", (LONGINT)7);
+ OPM_WriteString((CHAR*)" else ", 7);
} else {
OPC_EndBlk();
}
}
if (withtrap) {
- OPM_WriteString((CHAR*)"__WITHCHK", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__WITHCHK", 10);
OPC_EndStat();
} else if (n->right != NIL) {
OPC_BegBlk();
@@ -1213,9 +1100,9 @@ static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc)
static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc)
{
OPT_Node switchCase = NIL, label = NIL;
- LONGINT low, high;
- INTEGER form, i;
- OPM_WriteString((CHAR*)"switch ", (LONGINT)8);
+ INT64 low, high;
+ INT16 form, i;
+ OPM_WriteString((CHAR*)"switch ", 8);
OPV_expr(n->left, 12);
OPM_Write(' ');
OPC_BegBlk();
@@ -1247,22 +1134,22 @@ static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc)
OPC_Indent(1);
OPV_stat(switchCase->right, outerProc);
OPC_BegStat();
- OPM_WriteString((CHAR*)"break", (LONGINT)6);
+ OPM_WriteString((CHAR*)"break", 6);
OPC_EndStat();
OPC_Indent(-1);
switchCase = switchCase->link;
}
OPC_BegStat();
- OPM_WriteString((CHAR*)"default: ", (LONGINT)10);
+ OPM_WriteString((CHAR*)"default: ", 10);
if (n->right->conval->setval != 0x0) {
OPC_Indent(1);
OPM_WriteLn();
OPV_stat(n->right->right, outerProc);
OPC_BegStat();
- OPM_WriteString((CHAR*)"break", (LONGINT)6);
+ OPM_WriteString((CHAR*)"break", 6);
OPC_Indent(-1);
} else {
- OPM_WriteString((CHAR*)"__CASECHK", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__CASECHK", 10);
}
OPC_EndStat();
OPC_EndBlk();
@@ -1270,18 +1157,16 @@ static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc)
static BOOLEAN OPV_ImplicitReturn (OPT_Node n)
{
- BOOLEAN _o_result;
while ((n != NIL && n->class != 26)) {
n = n->link;
}
- _o_result = n == NIL;
- return _o_result;
+ return n == NIL;
}
static void OPV_NewArr (OPT_Node d, OPT_Node x)
{
OPT_Struct typ = NIL, base = NIL;
- INTEGER nofdim, nofdyn;
+ INT16 nofdim, nofdyn;
typ = d->typ->BaseTyp;
base = typ;
nofdim = 0;
@@ -1292,44 +1177,40 @@ static void OPV_NewArr (OPT_Node d, OPT_Node x)
base = base->BaseTyp;
}
OPV_design(d, -1);
- OPM_WriteString((CHAR*)" = __NEWARR(", (LONGINT)13);
+ OPM_WriteString((CHAR*)" = __NEWARR(", 13);
while (base->comp == 2) {
nofdim += 1;
base = base->BaseTyp;
}
if ((base->comp == 4 && OPC_NofPtrs(base) != 0)) {
OPC_Ident(base->strobj);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
- } else if (base->form == 13) {
- OPM_WriteString((CHAR*)"POINTER__typ", (LONGINT)13);
+ OPM_WriteString((CHAR*)"__typ", 6);
+ } else if (base->form == 11) {
+ OPM_WriteString((CHAR*)"POINTER__typ", 13);
} else {
- OPM_WriteString((CHAR*)"NIL", (LONGINT)4);
+ OPM_WriteString((CHAR*)"NIL", 4);
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12);
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(base->size);
- OPM_WriteString((CHAR*)"))", (LONGINT)3);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPM_WriteInt(OPC_BaseAlignment(base));
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPM_WriteInt(OPT_BaseAlignment(base));
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(nofdim);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(nofdyn);
while (typ != base) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
if (typ->comp == 3) {
if (x->class == 7) {
- OPM_WriteString((CHAR*)"(LONGINT)(", (LONGINT)11);
- OPV_expr(x, -1);
- OPM_WriteString((CHAR*)")", (LONGINT)2);
+ OPC_IntLiteral(x->conval->intval, OPM_AddressSize);
} else {
- OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10);
+ OPM_WriteString((CHAR*)"((ADDRESS)(", 12);
OPV_expr(x, 10);
+ OPM_WriteString((CHAR*)"))", 3);
}
x = x->link;
} else {
- OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10);
- OPM_WriteInt(typ->n);
+ OPC_IntLiteral(typ->n, OPM_AddressSize);
}
typ = typ->BaseTyp;
}
@@ -1358,7 +1239,7 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPV_ExitInfo saved;
OPT_Node l = NIL, r = NIL;
while ((n != NIL && OPM_noerr)) {
- OPM_errpos = n->conval->intval;
+ OPM_errpos = OPM_Longint(n->conval->intval);
if (n->class != 14) {
OPC_BegStat();
}
@@ -1372,7 +1253,7 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPV_DefineTDescs(n->right);
OPC_EnterBody();
OPV_InitTDescs(n->right);
- OPM_WriteString((CHAR*)"/* BEGIN */", (LONGINT)12);
+ OPM_WriteString((CHAR*)"/* BEGIN */", 12);
OPM_WriteLn();
OPV_stat(n->right, outerProc);
OPC_ExitBody();
@@ -1398,11 +1279,11 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
l = n->left;
r = n->right;
if (l->typ->comp == 2) {
- OPM_WriteString((CHAR*)"__MOVE(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__MOVE(", 8);
OPV_expr(r, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(l, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
if (r->typ == OPT_stringtyp) {
OPM_WriteInt(r->conval->intval2);
} else {
@@ -1410,30 +1291,30 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
}
OPM_Write(')');
} else {
- if ((((((l->typ->form == 13 && l->obj != NIL)) && l->obj->adr == 1)) && l->obj->mode == 1)) {
+ if ((((((l->typ->form == 11 && l->obj != NIL)) && l->obj->adr == 1)) && l->obj->mode == 1)) {
l->obj->adr = 0;
OPV_design(l, -1);
l->obj->adr = 1;
- if (r->typ->form != 11) {
- OPM_WriteString((CHAR*)" = (void*)", (LONGINT)11);
+ if (r->typ->form != 9) {
+ OPM_WriteString((CHAR*)" = (void*)", 11);
} else {
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" = ", 4);
}
} else {
OPV_design(l, -1);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" = ", 4);
}
if (l->typ == r->typ) {
OPV_expr(r, -1);
- } else if ((((l->typ->form == 13 && r->typ->form != 11)) && l->typ->strobj != NIL)) {
+ } else if ((((l->typ->form == 11 && r->typ->form != 9)) && l->typ->strobj != NIL)) {
OPM_Write('(');
OPC_Ident(l->typ->strobj);
OPM_Write(')');
OPV_expr(r, -1);
} else if (l->typ->comp == 4) {
- OPM_WriteString((CHAR*)"*(", (LONGINT)3);
+ OPM_WriteString((CHAR*)"*(", 3);
OPC_Andent(l->typ);
- OPM_WriteString((CHAR*)"*)&", (LONGINT)4);
+ OPM_WriteString((CHAR*)"*)&", 4);
OPV_expr(r, 9);
} else {
OPV_expr(r, -1);
@@ -1442,12 +1323,12 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
break;
case 1:
if (n->left->typ->BaseTyp->comp == 4) {
- OPM_WriteString((CHAR*)"__NEW(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__NEW(", 7);
OPV_design(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Andent(n->left->typ->BaseTyp);
- OPM_WriteString((CHAR*)")", (LONGINT)2);
- } else if (__IN(n->left->typ->BaseTyp->comp, 0x0c)) {
+ OPM_WriteString((CHAR*)")", 2);
+ } else if (__IN(n->left->typ->BaseTyp->comp, 0x0c, 32)) {
OPV_NewArr(n->left, n->right);
}
break;
@@ -1459,43 +1340,45 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
case 15: case 16:
OPV_expr(n->left, -1);
OPC_SetInclude(n->subcl == 16);
- OPM_WriteString((CHAR*)"__SETOF(", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__SETOF(", 9);
OPV_expr(n->right, -1);
+ OPM_WriteString((CHAR*)",", 2);
+ OPM_WriteInt(__ASHL(n->left->typ->size, 3));
OPM_Write(')');
break;
case 18:
- OPM_WriteString((CHAR*)"__COPY(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__COPY(", 8);
OPV_expr(n->right, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPV_Len(n->left, ((LONGINT)(0)));
+ OPM_WriteString((CHAR*)", ", 3);
+ OPV_Len(n->left, 0);
OPM_Write(')');
break;
case 31:
- OPM_WriteString((CHAR*)"__MOVE(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__MOVE(", 8);
OPV_expr(n->right, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->right->link, -1);
OPM_Write(')');
break;
case 24:
- OPM_WriteString((CHAR*)"__GET(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__GET(", 7);
OPV_expr(n->right, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Ident(n->left->typ->strobj);
OPM_Write(')');
break;
case 25:
- OPM_WriteString((CHAR*)"__PUT(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__PUT(", 7);
OPV_expr(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->right, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Ident(n->right->typ->strobj);
OPM_Write(')');
break;
@@ -1503,15 +1386,15 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPM_err(200);
break;
case 30:
- OPM_WriteString((CHAR*)"__SYSNEW(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__SYSNEW(", 10);
OPV_design(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->right, -1);
OPM_Write(')');
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.subcl = ", (LONGINT)40);
- OPM_LogWNum(n->subcl, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.subcl = ", 40);
+ OPM_LogWNum(n->subcl, 0);
OPM_LogWLn();
break;
}
@@ -1521,7 +1404,7 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
if (n->left->subcl == 1) {
proc = OPV_SuperProc(n);
} else {
- OPM_WriteString((CHAR*)"__", (LONGINT)3);
+ OPM_WriteString((CHAR*)"__", 3);
proc = OPC_BaseTProc(n->left->obj);
}
OPC_Ident(proc);
@@ -1536,10 +1419,10 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
case 20:
if (n->subcl != 32) {
OPV_IfStat(n, 0, outerProc);
- } else if (OPV_assert) {
- OPM_WriteString((CHAR*)"__ASSERT(", (LONGINT)10);
+ } else if (__IN(7, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__ASSERT(", 10);
OPV_expr(n->left->left->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(n->left->right->right->conval->intval);
OPM_Write(')');
OPC_EndStat();
@@ -1552,7 +1435,7 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
break;
case 22:
OPV_exit.level += 1;
- OPM_WriteString((CHAR*)"while ", (LONGINT)7);
+ OPM_WriteString((CHAR*)"while ", 7);
OPV_expr(n->left, 12);
OPM_Write(' ');
OPC_BegBlk();
@@ -1562,11 +1445,11 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
break;
case 23:
OPV_exit.level += 1;
- OPM_WriteString((CHAR*)"do ", (LONGINT)4);
+ OPM_WriteString((CHAR*)"do ", 4);
OPC_BegBlk();
OPV_stat(n->left, outerProc);
OPC_EndBlk0();
- OPM_WriteString((CHAR*)" while (!", (LONGINT)10);
+ OPM_WriteString((CHAR*)" while (!", 10);
OPV_expr(n->right, 9);
OPM_Write(')');
OPV_exit.level -= 1;
@@ -1575,13 +1458,13 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
saved = OPV_exit;
OPV_exit.level = 0;
OPV_exit.label = -1;
- OPM_WriteString((CHAR*)"for (;;) ", (LONGINT)10);
+ OPM_WriteString((CHAR*)"for (;;) ", 10);
OPC_BegBlk();
OPV_stat(n->left, outerProc);
OPC_EndBlk();
if (OPV_exit.label != -1) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"exit__", (LONGINT)7);
+ OPM_WriteString((CHAR*)"exit__", 7);
OPM_WriteInt(OPV_exit.label);
OPM_Write(':');
OPC_EndStat();
@@ -1590,39 +1473,48 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
break;
case 25:
if (OPV_exit.level == 0) {
- OPM_WriteString((CHAR*)"break", (LONGINT)6);
+ OPM_WriteString((CHAR*)"break", 6);
} else {
if (OPV_exit.label == -1) {
OPV_exit.label = OPV_nofExitLabels;
OPV_nofExitLabels += 1;
}
- OPM_WriteString((CHAR*)"goto exit__", (LONGINT)12);
+ OPM_WriteString((CHAR*)"goto exit__", 12);
OPM_WriteInt(OPV_exit.label);
}
break;
case 26:
if (OPM_level == 0) {
- if (OPV_mainprog) {
- OPM_WriteString((CHAR*)"__FINI", (LONGINT)7);
+ if (__IN(10, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__FINI", 7);
} else {
- OPM_WriteString((CHAR*)"__ENDMOD", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__ENDMOD", 9);
}
+ } else if (OPC_NeedsRetval(outerProc)) {
+ OPM_WriteString((CHAR*)"__retval = ", 12);
+ if ((n->left->typ->form == 11 && n->obj->typ != n->left->typ)) {
+ OPM_WriteString((CHAR*)"(void*)", 8);
+ OPV_expr(n->left, 10);
+ } else {
+ OPV_expr(n->left, -1);
+ }
+ OPC_EndStat();
+ OPC_BegStat();
+ OPC_ExitProc(outerProc, 0, 0);
+ OPC_EndStat();
+ OPC_BegStat();
+ OPM_WriteString((CHAR*)"return __retval", 16);
} else {
+ OPC_ExitProc(outerProc, 0, 0);
+ OPM_WriteString((CHAR*)"return", 7);
if (n->left != NIL) {
- OPM_WriteString((CHAR*)"_o_result = ", (LONGINT)13);
- if ((n->left->typ->form == 13 && n->obj->typ != n->left->typ)) {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
+ OPM_Write(' ');
+ if ((n->left->typ->form == 11 && n->obj->typ != n->left->typ)) {
+ OPM_WriteString((CHAR*)"(void*)", 8);
OPV_expr(n->left, 10);
} else {
OPV_expr(n->left, -1);
}
- OPM_WriteString((CHAR*)";", (LONGINT)2);
- OPM_WriteLn();
- OPC_BegStat();
- OPC_ExitProc(outerProc, 0, 0);
- OPM_WriteString((CHAR*)"return _o_result", (LONGINT)17);
- } else {
- OPM_WriteString((CHAR*)"return", (LONGINT)7);
}
}
break;
@@ -1630,15 +1522,15 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPV_IfStat(n, n->subcl == 0, outerProc);
break;
case 28:
- OPC_Halt(n->right->conval->intval);
+ OPC_Halt(OPM_Longint(n->right->conval->intval));
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.class = ", (LONGINT)40);
- OPM_LogWNum(n->class, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.class = ", 40);
+ OPM_LogWNum(n->class, 0);
OPM_LogWLn();
break;
}
- if (!__IN(n->class, 0x09744000)) {
+ if (!__IN(n->class, 0x09744000, 32)) {
OPC_EndStat();
}
n = n->link;
@@ -1647,7 +1539,7 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
void OPV_Module (OPT_Node prog)
{
- if (!OPV_mainprog) {
+ if (!__IN(10, OPM_Options, 32)) {
OPC_GenHdr(prog->right);
OPC_GenHdrIncludes();
}
diff --git a/bootstrap/unix-48/OPV.h b/bootstrap/unix-48/OPV.h
index 04828b2f..c4a61586 100644
--- a/bootstrap/unix-48/OPV.h
+++ b/bootstrap/unix-48/OPV.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPV__h
#define OPV__h
@@ -12,8 +12,7 @@
import void OPV_AdrAndSize (OPT_Object topScope);
import void OPV_Init (void);
import void OPV_Module (OPT_Node prog);
-import void OPV_TypSize (OPT_Struct typ);
import void *OPV__init(void);
-#endif
+#endif // OPV
diff --git a/bootstrap/unix-48/Out.c b/bootstrap/unix-48/Out.c
new file mode 100644
index 00000000..39f383cf
--- /dev/null
+++ b/bootstrap/unix-48/Out.c
@@ -0,0 +1,318 @@
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
+#include "SYSTEM.h"
+#include "Platform.h"
+
+
+export BOOLEAN Out_IsConsole;
+static CHAR Out_buf[128];
+static INT16 Out_in;
+
+
+export void Out_Char (CHAR ch);
+export void Out_Flush (void);
+export void Out_Int (INT64 x, INT64 n);
+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, LONGINT str__len);
+export LONGREAL Out_Ten (INT16 e);
+static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i);
+static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i);
+
+#define Out_Entier64(x) (INT64)(x)
+
+void Out_Flush (void)
+{
+ INT16 error;
+ if (Out_in > 0) {
+ error = Platform_Write(1, (ADDRESS)Out_buf, Out_in);
+ }
+ Out_in = 0;
+}
+
+void Out_Open (void)
+{
+}
+
+void Out_Char (CHAR ch)
+{
+ if (Out_in >= 128) {
+ Out_Flush();
+ }
+ Out_buf[__X(Out_in, 128)] = ch;
+ Out_in += 1;
+ if (ch == 0x0a) {
+ Out_Flush();
+ }
+}
+
+static INT32 Out_Length (CHAR *s, LONGINT s__len)
+{
+ INT32 l;
+ l = 0;
+ while ((l < s__len && s[__X(l, s__len)] != 0x00)) {
+ l += 1;
+ }
+ return l;
+}
+
+void Out_String (CHAR *str, LONGINT str__len)
+{
+ INT32 l;
+ INT16 error;
+ __DUP(str, str__len, CHAR);
+ l = Out_Length((void*)str, str__len);
+ if (Out_in + l > 128) {
+ Out_Flush();
+ }
+ if (l > 128) {
+ error = Platform_Write(1, (ADDRESS)str, l);
+ } else {
+ __MOVE((ADDRESS)str, (ADDRESS)&Out_buf[__X(Out_in, 128)], l);
+ Out_in += (INT16)l;
+ }
+ __DEL(str);
+}
+
+void Out_Int (INT64 x, INT64 n)
+{
+ CHAR s[22];
+ INT16 i;
+ BOOLEAN negative;
+ negative = x < 0;
+ if (x == (-9223372036854775807-1)) {
+ __MOVE("8085774586302733229", s, 20);
+ i = 19;
+ } else {
+ if (x < 0) {
+ x = -x;
+ }
+ s[0] = (CHAR)(48 + __MOD(x, 10));
+ x = __DIV(x, 10);
+ i = 1;
+ while (x != 0) {
+ s[__X(i, 22)] = (CHAR)(48 + __MOD(x, 10));
+ x = __DIV(x, 10);
+ i += 1;
+ }
+ }
+ if (negative) {
+ s[__X(i, 22)] = '-';
+ i += 1;
+ }
+ while (n > (INT64)i) {
+ Out_Char(' ');
+ n -= 1;
+ }
+ while (i > 0) {
+ i -= 1;
+ Out_Char(s[__X(i, 22)]);
+ }
+}
+
+void Out_Ln (void)
+{
+ Out_String(Platform_NL, 3);
+ Out_Flush();
+}
+
+static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i)
+{
+ *i -= 1;
+ s[__X(*i, s__len)] = (CHAR)(__MOD(n, 10) + 48);
+}
+
+static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i)
+{
+ INT16 j;
+ INT32 l;
+ __DUP(t, t__len, CHAR);
+ l = Out_Length((void*)t, t__len);
+ if (l > *i) {
+ l = *i;
+ }
+ *i -= (INT16)l;
+ j = 0;
+ while (j < l) {
+ s[__X(*i + j, s__len)] = t[__X(j, t__len)];
+ j += 1;
+ }
+ __DEL(t);
+}
+
+LONGREAL Out_Ten (INT16 e)
+{
+ LONGREAL r, power;
+ r = (LONGREAL)1;
+ power = (LONGREAL)10;
+ while (e > 0) {
+ if (__ODD(e)) {
+ r = r * power;
+ }
+ power = power * power;
+ e = __ASHR(e, 1);
+ }
+ return r;
+}
+
+static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_)
+{
+ INT16 e;
+ INT64 f;
+ CHAR s[30];
+ INT16 i, el;
+ LONGREAL x0;
+ BOOLEAN nn, en;
+ INT64 m;
+ INT16 d, dr;
+ e = (INT16)__MASK(__ASHR((__VAL(INT64, x)), 52), -2048);
+ f = __MASK((__VAL(INT64, x)), -4503599627370496);
+ nn = (__VAL(INT64, x) < 0 && !((e == 2047 && f != 0)));
+ if (nn) {
+ n -= 1;
+ }
+ i = 30;
+ if (e == 2047) {
+ if (f == 0) {
+ Out_prepend((CHAR*)"Infinity", 9, (void*)s, 30, &i);
+ } else {
+ Out_prepend((CHAR*)"NaN", 4, (void*)s, 30, &i);
+ }
+ } else {
+ if (long_) {
+ el = 3;
+ dr = n - 6;
+ if (dr > 17) {
+ dr = 17;
+ }
+ d = dr;
+ if (d < 15) {
+ d = 15;
+ }
+ } else {
+ el = 2;
+ dr = n - 5;
+ if (dr > 9) {
+ dr = 9;
+ }
+ d = dr;
+ if (d < 6) {
+ d = 6;
+ }
+ }
+ if (e == 0) {
+ while (el > 0) {
+ i -= 1;
+ s[__X(i, 30)] = '0';
+ el -= 1;
+ }
+ i -= 1;
+ s[__X(i, 30)] = '+';
+ m = 0;
+ } else {
+ if (nn) {
+ x = -x;
+ }
+ e = (INT16)__ASHR((e - 1023) * 77, 8);
+ if (e >= 0) {
+ x = x / (LONGREAL)Out_Ten(e);
+ } else {
+ x = Out_Ten(-e) * x;
+ }
+ if (x >= (LONGREAL)10) {
+ x = 1.00000000000000e-001 * x;
+ e += 1;
+ }
+ en = e < 0;
+ if (en) {
+ e = -e;
+ }
+ while (el > 0) {
+ Out_digit(e, (void*)s, 30, &i);
+ e = __DIV(e, 10);
+ el -= 1;
+ }
+ i -= 1;
+ if (en) {
+ s[__X(i, 30)] = '-';
+ } else {
+ s[__X(i, 30)] = '+';
+ }
+ x0 = Out_Ten(d - 1);
+ x = x0 * x;
+ x = x + 5.00000000000000e-001;
+ if (x >= (LONGREAL)10 * x0) {
+ x = 1.00000000000000e-001 * x;
+ e += 1;
+ }
+ m = Out_Entier64(x);
+ }
+ i -= 1;
+ if (long_) {
+ s[__X(i, 30)] = 'D';
+ } else {
+ s[__X(i, 30)] = 'E';
+ }
+ if (dr < 2) {
+ dr = 2;
+ }
+ while ((d > dr && __MOD(m, 10) == 0)) {
+ m = __DIV(m, 10);
+ d -= 1;
+ }
+ while (d > 1) {
+ Out_digit(m, (void*)s, 30, &i);
+ m = __DIV(m, 10);
+ d -= 1;
+ }
+ i -= 1;
+ s[__X(i, 30)] = '.';
+ Out_digit(m, (void*)s, 30, &i);
+ }
+ n -= 30 - i;
+ while (n > 0) {
+ Out_Char(' ');
+ n -= 1;
+ }
+ if (nn) {
+ Out_Char('-');
+ }
+ while (i < 30) {
+ Out_Char(s[__X(i, 30)]);
+ i += 1;
+ }
+}
+
+void Out_Real (REAL x, INT16 n)
+{
+ Out_RealP(x, n, 0);
+}
+
+void Out_LongReal (LONGREAL x, INT16 n)
+{
+ Out_RealP(x, n, 1);
+}
+
+
+export void *Out__init(void)
+{
+ __DEFMOD;
+ __MODULE_IMPORT(Platform);
+ __REGMOD("Out", 0);
+ __REGCMD("Flush", Out_Flush);
+ __REGCMD("Ln", Out_Ln);
+ __REGCMD("Open", Out_Open);
+/* BEGIN */
+ Out_IsConsole = Platform_IsConsole(1);
+ Out_in = 0;
+ __ENDMOD;
+}
diff --git a/bootstrap/unix-48/Out.h b/bootstrap/unix-48/Out.h
new file mode 100644
index 00000000..0e66420d
--- /dev/null
+++ b/bootstrap/unix-48/Out.h
@@ -0,0 +1,24 @@
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#ifndef Out__h
+#define Out__h
+
+#include "SYSTEM.h"
+
+
+import BOOLEAN Out_IsConsole;
+
+
+import void Out_Char (CHAR ch);
+import void Out_Flush (void);
+import void Out_Int (INT64 x, INT64 n);
+import void Out_Ln (void);
+import void Out_LongReal (LONGREAL x, INT16 n);
+import void Out_Open (void);
+import void Out_Real (REAL x, INT16 n);
+import void Out_String (CHAR *str, LONGINT str__len);
+import LONGREAL Out_Ten (INT16 e);
+import void *Out__init(void);
+
+
+#endif // Out
diff --git a/bootstrap/unix-48/Platform.c b/bootstrap/unix-48/Platform.c
index 74c43788..72c15bf8 100644
--- a/bootstrap/unix-48/Platform.c
+++ b/bootstrap/unix-48/Platform.c
@@ -1,4 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
typedef
@@ -8,90 +14,84 @@ typedef
Platform_ArgPtr (*Platform_ArgVec)[1024];
typedef
- LONGINT (*Platform_ArgVecPtr)[1];
+ INT32 (*Platform_ArgVecPtr)[1];
typedef
CHAR (*Platform_EnvPtr)[1024];
typedef
struct Platform_FileIdentity {
- LONGINT volume, index, mtime;
+ INT32 volume, index, mtime;
} Platform_FileIdentity;
typedef
- void (*Platform_HaltProcedure)(LONGINT);
+ void (*Platform_HaltProcedure)(INT32);
typedef
- void (*Platform_SignalHandler)(INTEGER);
+ void (*Platform_SignalHandler)(INT32);
export BOOLEAN Platform_LittleEndian;
-export LONGINT Platform_MainStackFrame, Platform_HaltCode;
-export INTEGER Platform_PID;
+export INT32 Platform_MainStackFrame;
+export INT16 Platform_PID;
export CHAR Platform_CWD[256];
-export INTEGER Platform_ArgCount;
-export LONGINT Platform_ArgVector;
+export INT16 Platform_ArgCount;
+export INT32 Platform_ArgVector;
static Platform_HaltProcedure Platform_HaltHandler;
-static LONGINT Platform_TimeStart;
-export INTEGER Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
-export CHAR Platform_nl[3];
+static INT32 Platform_TimeStart;
+export INT16 Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
+export CHAR Platform_NL[3];
-export LONGINT *Platform_FileIdentity__typ;
+export ADDRESS *Platform_FileIdentity__typ;
-export BOOLEAN Platform_Absent (INTEGER e);
-export INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len);
-export void Platform_AssertFail (LONGINT code);
-export INTEGER Platform_Chdir (CHAR *n, LONGINT n__len);
-export INTEGER Platform_Close (LONGINT h);
-export BOOLEAN Platform_ConnectionFailed (INTEGER e);
-export void Platform_Delay (LONGINT ms);
-export BOOLEAN Platform_DifferentFilesystems (INTEGER e);
-static void Platform_DisplayHaltCode (LONGINT code);
-export INTEGER Platform_Error (void);
-export void Platform_Exit (INTEGER code);
-export void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len);
-export void Platform_GetClock (LONGINT *t, LONGINT *d);
+export BOOLEAN Platform_Absent (INT16 e);
+export INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
+export INT16 Platform_Chdir (CHAR *n, LONGINT n__len);
+export INT16 Platform_Close (INT32 h);
+export BOOLEAN Platform_ConnectionFailed (INT16 e);
+export void Platform_Delay (INT32 ms);
+export BOOLEAN Platform_DifferentFilesystems (INT16 e);
+export INT16 Platform_Error (void);
+export void Platform_Exit (INT32 code);
+export void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len);
+export void Platform_GetClock (INT32 *t, INT32 *d);
export void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
-export void Platform_GetIntArg (INTEGER n, LONGINT *val);
-export void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec);
-export void Platform_Halt (LONGINT code);
-export INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ);
-export INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ);
-export BOOLEAN Platform_Inaccessible (INTEGER e);
-export void Platform_Init (INTEGER argc, LONGINT argvadr);
-export void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d);
-export INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h);
-export BOOLEAN Platform_NoSuchDirectory (INTEGER e);
-export LONGINT Platform_OSAllocate (LONGINT size);
-export void Platform_OSFree (LONGINT address);
-export INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h);
-export INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h);
-export INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n);
-export INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n);
-export INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
+export 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, 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_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, 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, 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 INTEGER Platform_Seek (LONGINT h, LONGINT offset, INTEGER whence);
+export INT16 Platform_Seek (INT32 h, INT32 offset, INT16 whence);
export void Platform_SetBadInstructionHandler (Platform_SignalHandler handler);
-export void Platform_SetHalt (Platform_HaltProcedure p);
export void Platform_SetInterruptHandler (Platform_SignalHandler handler);
-export void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source);
+export void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__typ, Platform_FileIdentity source);
export void Platform_SetQuitHandler (Platform_SignalHandler handler);
-export INTEGER Platform_Size (LONGINT h, LONGINT *l);
-export INTEGER Platform_Sync (LONGINT h);
-export INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len);
+export INT16 Platform_Size (INT32 h, INT32 *l);
+export INT16 Platform_Sync (INT32 h);
+export INT16 Platform_System (CHAR *cmd, LONGINT cmd__len);
static void Platform_TestLittleEndian (void);
-export LONGINT Platform_Time (void);
-export BOOLEAN Platform_TimedOut (INTEGER e);
-export BOOLEAN Platform_TooManyFiles (INTEGER e);
-export INTEGER Platform_Truncate (LONGINT h, LONGINT l);
-export INTEGER Platform_Unlink (CHAR *n, LONGINT n__len);
-export INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l);
-static void Platform_YMDHMStoClock (LONGINT ye, LONGINT mo, LONGINT da, LONGINT ho, LONGINT mi, LONGINT se, LONGINT *t, LONGINT *d);
-static void Platform_errch (CHAR c);
-static void Platform_errint (LONGINT l);
-static void Platform_errln (void);
-static void Platform_errposint (LONGINT l);
+export INT32 Platform_Time (void);
+export BOOLEAN Platform_TimedOut (INT16 e);
+export BOOLEAN Platform_TooManyFiles (INT16 e);
+export INT16 Platform_Truncate (INT32 h, INT32 l);
+export INT16 Platform_Unlink (CHAR *n, LONGINT n__len);
+export INT16 Platform_Write (INT32 h, INT32 p, INT32 l);
+static void Platform_YMDHMStoClock (INT32 ye, INT32 mo, INT32 da, INT32 ho, INT32 mi, INT32 se, INT32 *t, INT32 *d);
export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
#include
@@ -109,6 +109,7 @@ export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT
#define Platform_ECONNABORTED() ECONNABORTED
#define Platform_ECONNREFUSED() ECONNREFUSED
#define Platform_EHOSTUNREACH() EHOSTUNREACH
+#define Platform_EINTR() EINTR
#define Platform_EMFILE() EMFILE
#define Platform_ENETUNREACH() ENETUNREACH
#define Platform_ENFILE() ENFILE
@@ -118,14 +119,12 @@ export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT
#define Platform_EXDEV() EXDEV
extern void Heap_InitHeap();
#define Platform_HeapInitHeap() Heap_InitHeap()
-#define Platform_allocate(size) (LONGINT)(SYSTEM_ADDRESS)((void*)malloc((size_t)size))
+#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)
#define Platform_err() errno
-#define Platform_errc(c) write(1, &c, 1)
-#define Platform_errstring(s, s__len) write(1, s, s__len-1)
-#define Platform_exit(code) exit(code)
-#define Platform_free(address) free((void*)(SYSTEM_ADDRESS)address)
+#define Platform_exit(code) exit((int)code)
+#define Platform_free(address) free((void*)address)
#define Platform_fstat(fd) fstat(fd, &s)
#define Platform_fsync(fd) fsync(fd)
#define Platform_ftruncate(fd, l) ftruncate(fd, l)
@@ -133,23 +132,24 @@ extern void Heap_InitHeap();
#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)
#define Platform_lseek(fd, o, w) lseek(fd, o, w)
#define Platform_nanosleep(s, ns) struct timespec req, rem; req.tv_sec = s; req.tv_nsec = ns; nanosleep(&req, &rem)
#define Platform_opennew(n, n__len) open((char*)n, O_CREAT | O_TRUNC | O_RDWR, 0664)
#define Platform_openro(n, n__len) open((char*)n, O_RDONLY)
#define Platform_openrw(n, n__len) open((char*)n, O_RDWR)
-#define Platform_readfile(fd, p, l) read(fd, (void*)(SYSTEM_ADDRESS)(p), l)
+#define Platform_readfile(fd, p, l) (LONGINT)read(fd, (void*)(ADDRESS)(p), l)
#define Platform_rename(o, o__len, n, n__len) rename((char*)o, (char*)n)
#define Platform_sectotm(s) struct tm *time = localtime((time_t*)&s)
#define Platform_seekcur() SEEK_CUR
#define Platform_seekend() SEEK_END
#define Platform_seekset() SEEK_SET
-#define Platform_sethandler(s, h) SystemSetHandler(s, (SYSTEM_ADDRESS)h)
+#define Platform_sethandler(s, h) SystemSetHandler(s, (ADDRESS)h)
#define Platform_stat(n, n__len) stat((char*)n, &s)
#define Platform_statdev() (LONGINT)s.st_dev
#define Platform_statino() (LONGINT)s.st_ino
#define Platform_statmtime() (LONGINT)s.st_mtime
-#define Platform_statsize() (LONGINT)s.st_size
+#define Platform_statsize() (ADDRESS)s.st_size
#define Platform_structstats() struct stat s
#define Platform_system(str, str__len) system((char*)str)
#define Platform_tmhour() (LONGINT)time->tm_hour
@@ -161,92 +161,78 @@ extern void Heap_InitHeap();
#define Platform_tvsec() tv.tv_sec
#define Platform_tvusec() tv.tv_usec
#define Platform_unlink(n, n__len) unlink((char*)n)
-#define Platform_writefile(fd, p, l) write(fd, (void*)(SYSTEM_ADDRESS)(p), l)
+#define Platform_writefile(fd, p, l) write(fd, (void*)(ADDRESS)(p), l)
-BOOLEAN Platform_TooManyFiles (INTEGER e)
+BOOLEAN Platform_TooManyFiles (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = e == Platform_EMFILE() || e == Platform_ENFILE();
- return _o_result;
+ return e == Platform_EMFILE() || e == Platform_ENFILE();
}
-BOOLEAN Platform_NoSuchDirectory (INTEGER e)
+BOOLEAN Platform_NoSuchDirectory (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = e == Platform_ENOENT();
- return _o_result;
+ return e == Platform_ENOENT();
}
-BOOLEAN Platform_DifferentFilesystems (INTEGER e)
+BOOLEAN Platform_DifferentFilesystems (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = e == Platform_EXDEV();
- return _o_result;
+ return e == Platform_EXDEV();
}
-BOOLEAN Platform_Inaccessible (INTEGER e)
+BOOLEAN Platform_Inaccessible (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = (e == Platform_EACCES() || e == Platform_EROFS()) || e == Platform_EAGAIN();
- return _o_result;
+ return (e == Platform_EACCES() || e == Platform_EROFS()) || e == Platform_EAGAIN();
}
-BOOLEAN Platform_Absent (INTEGER e)
+BOOLEAN Platform_Absent (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = e == Platform_ENOENT();
- return _o_result;
+ return e == Platform_ENOENT();
}
-BOOLEAN Platform_TimedOut (INTEGER e)
+BOOLEAN Platform_TimedOut (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = e == Platform_ETIMEDOUT();
- return _o_result;
+ return e == Platform_ETIMEDOUT();
}
-BOOLEAN Platform_ConnectionFailed (INTEGER e)
+BOOLEAN Platform_ConnectionFailed (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = ((e == Platform_ECONNREFUSED() || e == Platform_ECONNABORTED()) || e == Platform_ENETUNREACH()) || e == Platform_EHOSTUNREACH();
- return _o_result;
+ return ((e == Platform_ECONNREFUSED() || e == Platform_ECONNABORTED()) || e == Platform_ENETUNREACH()) || e == Platform_EHOSTUNREACH();
}
-LONGINT Platform_OSAllocate (LONGINT size)
+BOOLEAN Platform_Interrupted (INT16 e)
{
- LONGINT _o_result;
- _o_result = Platform_allocate(size);
- return _o_result;
+ return e == Platform_EINTR();
}
-void Platform_OSFree (LONGINT address)
+INT32 Platform_OSAllocate (INT32 size)
+{
+ return Platform_allocate(size);
+}
+
+void Platform_OSFree (INT32 address)
{
Platform_free(address);
}
-void Platform_Init (INTEGER argc, LONGINT argvadr)
+void Platform_Init (INT32 argc, INT32 argvadr)
{
Platform_ArgVecPtr av = NIL;
Platform_MainStackFrame = argvadr;
- Platform_ArgCount = argc;
- av = (Platform_ArgVecPtr)(SYSTEM_ADDRESS)argvadr;
+ Platform_ArgCount = __VAL(INT16, argc);
+ av = (Platform_ArgVecPtr)(ADDRESS)argvadr;
Platform_ArgVector = (*av)[0];
- Platform_HaltCode = -128;
Platform_HeapInitHeap();
}
BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
{
- BOOLEAN _o_result;
Platform_EnvPtr p = NIL;
__DUP(var, var__len, CHAR);
p = Platform_getenv(var, var__len);
if (p != NIL) {
__COPY(*p, val, val__len);
}
- _o_result = p != NIL;
__DEL(var);
- return _o_result;
+ return p != NIL;
}
void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
@@ -258,31 +244,31 @@ void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
__DEL(var);
}
-void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len)
+void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len)
{
Platform_ArgVec av = NIL;
if (n < Platform_ArgCount) {
- av = (Platform_ArgVec)(SYSTEM_ADDRESS)Platform_ArgVector;
- __COPY(*(*av)[__X(n, ((LONGINT)(1024)))], val, val__len);
+ av = (Platform_ArgVec)(ADDRESS)Platform_ArgVector;
+ __COPY(*(*av)[__X(n, 1024)], val, val__len);
}
}
-void Platform_GetIntArg (INTEGER n, LONGINT *val)
+void Platform_GetIntArg (INT16 n, INT32 *val)
{
CHAR s[64];
- LONGINT k, d, i;
+ INT32 k, d, i;
s[0] = 0x00;
- Platform_GetArg(n, (void*)s, ((LONGINT)(64)));
+ Platform_GetArg(n, (void*)s, 64);
i = 0;
if (s[0] == '-') {
i = 1;
}
k = 0;
- d = (int)s[__X(i, ((LONGINT)(64)))] - 48;
+ d = (INT16)s[__X(i, 64)] - 48;
while ((d >= 0 && d <= 9)) {
k = k * 10 + d;
i += 1;
- d = (int)s[__X(i, ((LONGINT)(64)))] - 48;
+ d = (INT16)s[__X(i, 64)] - 48;
}
if (s[0] == '-') {
k = -k;
@@ -293,21 +279,19 @@ void Platform_GetIntArg (INTEGER n, LONGINT *val)
}
}
-INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len)
+INT16 Platform_ArgPos (CHAR *s, LONGINT s__len)
{
- INTEGER _o_result;
- INTEGER i;
+ INT16 i;
CHAR arg[256];
__DUP(s, s__len, CHAR);
i = 0;
- Platform_GetArg(i, (void*)arg, ((LONGINT)(256)));
+ Platform_GetArg(i, (void*)arg, 256);
while ((i < Platform_ArgCount && __STRCMP(s, arg) != 0)) {
i += 1;
- Platform_GetArg(i, (void*)arg, ((LONGINT)(256)));
+ Platform_GetArg(i, (void*)arg, 256);
}
- _o_result = i;
__DEL(s);
- return _o_result;
+ return i;
}
void Platform_SetInterruptHandler (Platform_SignalHandler handler)
@@ -325,447 +309,273 @@ void Platform_SetBadInstructionHandler (Platform_SignalHandler handler)
Platform_sethandler(4, handler);
}
-static void Platform_YMDHMStoClock (LONGINT ye, LONGINT mo, LONGINT da, LONGINT ho, LONGINT mi, LONGINT se, LONGINT *t, LONGINT *d)
+static void Platform_YMDHMStoClock (INT32 ye, INT32 mo, INT32 da, INT32 ho, INT32 mi, INT32 se, INT32 *t, INT32 *d)
{
- *d = (__ASHL(__MOD(ye, 100), 9) + __ASHL(mo + 1, 5)) + da;
+ *d = (__ASHL((int)__MOD(ye, 100), 9) + __ASHL(mo + 1, 5)) + da;
*t = (__ASHL(ho, 12) + __ASHL(mi, 6)) + se;
}
-void Platform_GetClock (LONGINT *t, LONGINT *d)
+void Platform_GetClock (INT32 *t, INT32 *d)
{
Platform_gettimeval();
Platform_sectotm(Platform_tvsec());
Platform_YMDHMStoClock(Platform_tmyear(), Platform_tmmon(), Platform_tmmday(), Platform_tmhour(), Platform_tmmin(), Platform_tmsec(), &*t, &*d);
}
-void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec)
+void Platform_GetTimeOfDay (INT32 *sec, INT32 *usec)
{
Platform_gettimeval();
*sec = Platform_tvsec();
*usec = Platform_tvusec();
}
-LONGINT Platform_Time (void)
+INT32 Platform_Time (void)
{
- LONGINT _o_result;
- LONGINT ms;
+ INT32 ms;
Platform_gettimeval();
- ms = __DIVF(Platform_tvusec(), 1000) + Platform_tvsec() * 1000;
- _o_result = __MOD(ms - Platform_TimeStart, 2147483647);
- return _o_result;
+ ms = (int)__DIVF(Platform_tvusec(), 1000) + Platform_tvsec() * 1000;
+ return (int)__MOD(ms - Platform_TimeStart, 2147483647);
}
-void Platform_Delay (LONGINT ms)
+void Platform_Delay (INT32 ms)
{
- LONGINT s, ns;
+ INT32 s, ns;
s = __DIV(ms, 1000);
- ns = __MOD(ms, 1000) * 1000000;
+ ns = (int)__MOD(ms, 1000) * 1000000;
Platform_nanosleep(s, ns);
}
-INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len)
+INT16 Platform_System (CHAR *cmd, LONGINT cmd__len)
{
- INTEGER _o_result;
__DUP(cmd, cmd__len, CHAR);
- _o_result = Platform_system(cmd, cmd__len);
__DEL(cmd);
- return _o_result;
+ return Platform_system(cmd, cmd__len);
}
-INTEGER Platform_Error (void)
+INT16 Platform_Error (void)
{
- INTEGER _o_result;
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
}
-INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h)
+INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h)
{
- INTEGER _o_result;
- INTEGER fd;
+ INT16 fd;
fd = Platform_openro(n, n__len);
if (fd < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
*h = fd;
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h)
+INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h)
{
- INTEGER _o_result;
- INTEGER fd;
+ INT16 fd;
fd = Platform_openrw(n, n__len);
if (fd < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
*h = fd;
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h)
+INT16 Platform_New (CHAR *n, LONGINT n__len, INT32 *h)
{
- INTEGER _o_result;
- INTEGER fd;
+ INT16 fd;
fd = Platform_opennew(n, n__len);
if (fd < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
*h = fd;
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Close (LONGINT h)
+INT16 Platform_Close (INT32 h)
{
- INTEGER _o_result;
if (Platform_closefile(h) < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ)
+BOOLEAN Platform_IsConsole (INT32 h)
+{
+ return Platform_isatty(h) != 0;
+}
+
+INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *identity__typ)
{
- INTEGER _o_result;
Platform_structstats();
if (Platform_fstat(h) < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
}
(*identity).volume = Platform_statdev();
(*identity).index = Platform_statino();
(*identity).mtime = Platform_statmtime();
- _o_result = 0;
- return _o_result;
+ return 0;
}
-INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ)
+INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
{
- INTEGER _o_result;
__DUP(n, n__len, CHAR);
Platform_structstats();
if (Platform_stat(n, n__len) < 0) {
- _o_result = Platform_err();
__DEL(n);
- return _o_result;
+ return Platform_err();
}
(*identity).volume = Platform_statdev();
(*identity).index = Platform_statino();
(*identity).mtime = Platform_statmtime();
- _o_result = 0;
__DEL(n);
- return _o_result;
+ return 0;
}
BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2)
{
- BOOLEAN _o_result;
- _o_result = (i1.index == i2.index && i1.volume == i2.volume);
- return _o_result;
+ return (i1.index == i2.index && i1.volume == i2.volume);
}
BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2)
{
- BOOLEAN _o_result;
- _o_result = i1.mtime == i2.mtime;
- return _o_result;
+ return i1.mtime == i2.mtime;
}
-void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source)
+void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__typ, Platform_FileIdentity source)
{
(*target).mtime = source.mtime;
}
-void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d)
+void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d)
{
Platform_sectotm(i.mtime);
Platform_YMDHMStoClock(Platform_tmyear(), Platform_tmmon(), Platform_tmmday(), Platform_tmhour(), Platform_tmmin(), Platform_tmsec(), &*t, &*d);
}
-INTEGER Platform_Size (LONGINT h, LONGINT *l)
+INT16 Platform_Size (INT32 h, INT32 *l)
{
- INTEGER _o_result;
Platform_structstats();
if (Platform_fstat(h) < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
}
*l = Platform_statsize();
- _o_result = 0;
- return _o_result;
+ return 0;
}
-INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n)
+INT16 Platform_Read (INT32 h, INT32 p, INT32 l, INT32 *n)
{
- INTEGER _o_result;
*n = Platform_readfile(h, p, l);
if (*n < 0) {
*n = 0;
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n)
+INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n)
{
- INTEGER _o_result;
- *n = Platform_readfile(h, (LONGINT)(SYSTEM_ADDRESS)b, b__len);
+ *n = Platform_readfile(h, (ADDRESS)b, b__len);
if (*n < 0) {
*n = 0;
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l)
+INT16 Platform_Write (INT32 h, INT32 p, INT32 l)
{
- INTEGER _o_result;
- LONGINT written;
+ INT32 written;
written = Platform_writefile(h, p, l);
if (written < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Sync (LONGINT h)
+INT16 Platform_Sync (INT32 h)
{
- INTEGER _o_result;
if (Platform_fsync(h) < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Seek (LONGINT h, LONGINT offset, INTEGER whence)
+INT16 Platform_Seek (INT32 h, INT32 offset, INT16 whence)
{
- INTEGER _o_result;
if (Platform_lseek(h, offset, whence) < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Truncate (LONGINT h, LONGINT l)
+INT16 Platform_Truncate (INT32 h, INT32 l)
{
- INTEGER _o_result;
if (Platform_ftruncate(h, l) < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Unlink (CHAR *n, LONGINT n__len)
+INT16 Platform_Unlink (CHAR *n, LONGINT n__len)
{
- INTEGER _o_result;
if (Platform_unlink(n, n__len) < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Chdir (CHAR *n, LONGINT n__len)
+INT16 Platform_Chdir (CHAR *n, LONGINT n__len)
{
- INTEGER _o_result;
- INTEGER r;
- r = Platform_chdir(n, n__len);
- Platform_getcwd((void*)Platform_CWD, ((LONGINT)(256)));
- if (r < 0) {
- _o_result = Platform_err();
- return _o_result;
+ INT16 r;
+ if ((Platform_chdir(n, n__len) >= 0 && Platform_getcwd((void*)Platform_CWD, 256) != NIL)) {
+ return 0;
} else {
- _o_result = 0;
- return _o_result;
+ return Platform_err();
}
__RETCHK;
}
-INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len)
+INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len)
{
- INTEGER _o_result;
if (Platform_rename(o, o__len, n, n__len) < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-void Platform_Exit (INTEGER code)
+void Platform_Exit (INT32 code)
{
Platform_exit(code);
}
-static void Platform_errch (CHAR c)
-{
- Platform_errc(c);
-}
-
-static void Platform_errln (void)
-{
- Platform_errch(0x0d);
- Platform_errch(0x0a);
-}
-
-static void Platform_errposint (LONGINT l)
-{
- if (l > 10) {
- Platform_errposint(__DIV(l, 10));
- }
- Platform_errch((CHAR)(48 + __MOD(l, 10)));
-}
-
-static void Platform_errint (LONGINT l)
-{
- if (l < 0) {
- Platform_errch('-');
- l = -l;
- }
- Platform_errposint(l);
-}
-
-static void Platform_DisplayHaltCode (LONGINT code)
-{
- switch (code) {
- case -1:
- Platform_errstring((CHAR*)"Assertion failure.", (LONGINT)19);
- break;
- case -2:
- Platform_errstring((CHAR*)"Index out of range.", (LONGINT)20);
- break;
- case -3:
- Platform_errstring((CHAR*)"Reached end of function without reaching RETURN.", (LONGINT)49);
- break;
- case -4:
- Platform_errstring((CHAR*)"CASE statement: no matching label and no ELSE.", (LONGINT)47);
- break;
- case -5:
- Platform_errstring((CHAR*)"Type guard failed.", (LONGINT)19);
- break;
- case -6:
- Platform_errstring((CHAR*)"Implicit type guard in record assignment failed.", (LONGINT)49);
- break;
- case -7:
- Platform_errstring((CHAR*)"Invalid case in WITH statement.", (LONGINT)32);
- break;
- case -8:
- Platform_errstring((CHAR*)"Value out of range.", (LONGINT)20);
- break;
- case -9:
- Platform_errstring((CHAR*)"Heap interrupted while locked, but lockdepth = 0 at unlock.", (LONGINT)60);
- break;
- case -10:
- Platform_errstring((CHAR*)"NIL access.", (LONGINT)12);
- break;
- case -11:
- Platform_errstring((CHAR*)"Alignment error.", (LONGINT)17);
- break;
- case -12:
- Platform_errstring((CHAR*)"Divide by zero.", (LONGINT)16);
- break;
- case -13:
- Platform_errstring((CHAR*)"Arithmetic overflow/underflow.", (LONGINT)31);
- break;
- case -14:
- Platform_errstring((CHAR*)"Invalid function argument.", (LONGINT)27);
- break;
- case -15:
- Platform_errstring((CHAR*)"Internal error, e.g. Type descriptor size mismatch.", (LONGINT)52);
- break;
- case -20:
- Platform_errstring((CHAR*)"Too many, or negative number of, elements in dynamic array.", (LONGINT)60);
- break;
- default:
- break;
- }
-}
-
-void Platform_Halt (LONGINT code)
-{
- INTEGER e;
- Platform_HaltCode = code;
- if (Platform_HaltHandler != NIL) {
- (*Platform_HaltHandler)(code);
- }
- Platform_errstring((CHAR*)"Terminated by Halt(", (LONGINT)20);
- Platform_errint(code);
- Platform_errstring((CHAR*)"). ", (LONGINT)4);
- if (code < 0) {
- Platform_DisplayHaltCode(code);
- }
- Platform_errln();
- Platform_exit(__VAL(INTEGER, code));
-}
-
-void Platform_AssertFail (LONGINT code)
-{
- INTEGER e;
- Platform_errstring((CHAR*)"Assertion failure.", (LONGINT)19);
- if (code != 0) {
- Platform_errstring((CHAR*)" ASSERT code ", (LONGINT)14);
- Platform_errint(code);
- Platform_errstring((CHAR*)".", (LONGINT)2);
- }
- Platform_errln();
- Platform_exit(__VAL(INTEGER, code));
-}
-
-void Platform_SetHalt (Platform_HaltProcedure p)
-{
- Platform_HaltHandler = p;
-}
-
static void Platform_TestLittleEndian (void)
{
- INTEGER i;
+ INT16 i;
i = 1;
- __GET((LONGINT)(SYSTEM_ADDRESS)&i, Platform_LittleEndian, BOOLEAN);
+ __GET((ADDRESS)&i, Platform_LittleEndian, BOOLEAN);
}
__TDESC(Platform_FileIdentity, 1, 0) = {__TDFLDS("FileIdentity", 12), {-4}};
@@ -777,17 +587,17 @@ export void *Platform__init(void)
__INITYP(Platform_FileIdentity, Platform_FileIdentity, 0);
/* BEGIN */
Platform_TestLittleEndian();
- Platform_HaltCode = -128;
Platform_HaltHandler = NIL;
Platform_TimeStart = 0;
Platform_TimeStart = Platform_Time();
- Platform_CWD[0] = 0x00;
- Platform_getcwd((void*)Platform_CWD, ((LONGINT)(256)));
Platform_PID = Platform_getpid();
+ if (Platform_getcwd((void*)Platform_CWD, 256) == NIL) {
+ Platform_CWD[0] = 0x00;
+ }
Platform_SeekSet = Platform_seekset();
Platform_SeekCur = Platform_seekcur();
Platform_SeekEnd = Platform_seekend();
- Platform_nl[0] = 0x0a;
- Platform_nl[1] = 0x00;
+ Platform_NL[0] = 0x0a;
+ Platform_NL[1] = 0x00;
__ENDMOD;
}
diff --git a/bootstrap/unix-48/Platform.h b/bootstrap/unix-48/Platform.h
index dd5ce434..b04f552d 100644
--- a/bootstrap/unix-48/Platform.h
+++ b/bootstrap/unix-48/Platform.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Platform__h
#define Platform__h
@@ -7,76 +7,73 @@
typedef
struct Platform_FileIdentity {
- LONGINT volume, index, mtime;
+ INT32 _prvt0;
+ char _prvt1[8];
} Platform_FileIdentity;
typedef
- void (*Platform_HaltProcedure)(LONGINT);
-
-typedef
- void (*Platform_SignalHandler)(INTEGER);
+ void (*Platform_SignalHandler)(INT32);
import BOOLEAN Platform_LittleEndian;
-import LONGINT Platform_MainStackFrame, Platform_HaltCode;
-import INTEGER Platform_PID;
+import INT32 Platform_MainStackFrame;
+import INT16 Platform_PID;
import CHAR Platform_CWD[256];
-import INTEGER Platform_ArgCount;
-import LONGINT Platform_ArgVector;
-import INTEGER Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
-import CHAR Platform_nl[3];
+import INT16 Platform_ArgCount;
+import INT32 Platform_ArgVector;
+import INT16 Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
+import CHAR Platform_NL[3];
-import LONGINT *Platform_FileIdentity__typ;
+import ADDRESS *Platform_FileIdentity__typ;
-import BOOLEAN Platform_Absent (INTEGER e);
-import INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len);
-import void Platform_AssertFail (LONGINT code);
-import INTEGER Platform_Chdir (CHAR *n, LONGINT n__len);
-import INTEGER Platform_Close (LONGINT h);
-import BOOLEAN Platform_ConnectionFailed (INTEGER e);
-import void Platform_Delay (LONGINT ms);
-import BOOLEAN Platform_DifferentFilesystems (INTEGER e);
-import INTEGER Platform_Error (void);
-import void Platform_Exit (INTEGER code);
-import void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len);
-import void Platform_GetClock (LONGINT *t, LONGINT *d);
+import BOOLEAN Platform_Absent (INT16 e);
+import INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
+import INT16 Platform_Chdir (CHAR *n, LONGINT n__len);
+import INT16 Platform_Close (INT32 h);
+import BOOLEAN Platform_ConnectionFailed (INT16 e);
+import void Platform_Delay (INT32 ms);
+import BOOLEAN Platform_DifferentFilesystems (INT16 e);
+import INT16 Platform_Error (void);
+import void Platform_Exit (INT32 code);
+import void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len);
+import void Platform_GetClock (INT32 *t, INT32 *d);
import void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
-import void Platform_GetIntArg (INTEGER n, LONGINT *val);
-import void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec);
-import void Platform_Halt (LONGINT code);
-import INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ);
-import INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ);
-import BOOLEAN Platform_Inaccessible (INTEGER e);
-import void Platform_Init (INTEGER argc, LONGINT argvadr);
-import void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d);
-import INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h);
-import BOOLEAN Platform_NoSuchDirectory (INTEGER e);
-import LONGINT Platform_OSAllocate (LONGINT size);
-import void Platform_OSFree (LONGINT address);
-import INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h);
-import INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h);
-import INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n);
-import INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n);
-import INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
+import 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, 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_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, 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, 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 INTEGER Platform_Seek (LONGINT h, LONGINT offset, INTEGER whence);
+import INT16 Platform_Seek (INT32 h, INT32 offset, INT16 whence);
import void Platform_SetBadInstructionHandler (Platform_SignalHandler handler);
-import void Platform_SetHalt (Platform_HaltProcedure p);
import void Platform_SetInterruptHandler (Platform_SignalHandler handler);
-import void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source);
+import void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__typ, Platform_FileIdentity source);
import void Platform_SetQuitHandler (Platform_SignalHandler handler);
-import INTEGER Platform_Size (LONGINT h, LONGINT *l);
-import INTEGER Platform_Sync (LONGINT h);
-import INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len);
-import LONGINT Platform_Time (void);
-import BOOLEAN Platform_TimedOut (INTEGER e);
-import BOOLEAN Platform_TooManyFiles (INTEGER e);
-import INTEGER Platform_Truncate (LONGINT h, LONGINT l);
-import INTEGER Platform_Unlink (CHAR *n, LONGINT n__len);
-import INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l);
+import INT16 Platform_Size (INT32 h, INT32 *l);
+import INT16 Platform_Sync (INT32 h);
+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, LONGINT n__len);
+import INT16 Platform_Write (INT32 h, INT32 p, INT32 l);
import BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
import void *Platform__init(void);
-#endif
+#endif // Platform
diff --git a/bootstrap/unix-48/Reals.c b/bootstrap/unix-48/Reals.c
index 2323e34d..cd4c3c61 100644
--- a/bootstrap/unix-48/Reals.c
+++ b/bootstrap/unix-48/Reals.c
@@ -1,25 +1,30 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len);
-export void Reals_Convert (REAL x, INTEGER n, CHAR *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, INTEGER n, CHAR *d, LONGINT d__len);
-export INTEGER Reals_Expo (REAL x);
-export INTEGER Reals_ExpoL (LONGREAL x);
-export void Reals_SetExpo (REAL *x, INTEGER ex);
-export REAL Reals_Ten (INTEGER e);
-export LONGREAL Reals_TenL (INTEGER e);
-static CHAR Reals_ToHex (INTEGER i);
+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);
+export REAL Reals_Ten (INT16 e);
+export LONGREAL Reals_TenL (INT16 e);
+static CHAR Reals_ToHex (INT16 i);
-REAL Reals_Ten (INTEGER e)
+REAL Reals_Ten (INT16 e)
{
- REAL _o_result;
LONGREAL r, power;
r = (LONGREAL)1;
power = (LONGREAL)10;
@@ -30,13 +35,11 @@ REAL Reals_Ten (INTEGER e)
power = power * power;
e = __ASHR(e, 1);
}
- _o_result = r;
- return _o_result;
+ return r;
}
-LONGREAL Reals_TenL (INTEGER e)
+LONGREAL Reals_TenL (INT16 e)
{
- LONGREAL _o_result;
LONGREAL r, power;
r = (LONGREAL)1;
power = (LONGREAL)10;
@@ -46,110 +49,102 @@ LONGREAL Reals_TenL (INTEGER e)
}
e = __ASHR(e, 1);
if (e <= 0) {
- _o_result = r;
- return _o_result;
+ return r;
}
power = power * power;
}
__RETCHK;
}
-INTEGER Reals_Expo (REAL x)
+INT16 Reals_Expo (REAL x)
{
- INTEGER _o_result;
- INTEGER i;
- __GET((LONGINT)(SYSTEM_ADDRESS)&x + 2, i, INTEGER);
- _o_result = __MASK(__ASHR(i, 7), -256);
- return _o_result;
+ INT16 i;
+ __GET((ADDRESS)&x + 2, i, INT16);
+ return __MASK(__ASHR(i, 7), -256);
}
-void Reals_SetExpo (REAL *x, INTEGER ex)
+void Reals_SetExpo (REAL *x, INT16 ex)
{
CHAR c;
- __GET((LONGINT)(SYSTEM_ADDRESS)x + 3, c, CHAR);
- __PUT((LONGINT)(SYSTEM_ADDRESS)x + 3, (CHAR)(__ASHL(__ASHR((int)c, 7), 7) + __MASK(__ASHR(ex, 1), -128)), CHAR);
- __GET((LONGINT)(SYSTEM_ADDRESS)x + 2, c, CHAR);
- __PUT((LONGINT)(SYSTEM_ADDRESS)x + 2, (CHAR)(__MASK((int)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR);
+ __GET((ADDRESS)x + 3, c, 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, (CHAR)(__MASK((INT16)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR);
}
-INTEGER Reals_ExpoL (LONGREAL x)
+INT16 Reals_ExpoL (LONGREAL x)
{
- INTEGER _o_result;
- INTEGER i;
- __GET((LONGINT)(SYSTEM_ADDRESS)&x + 6, i, INTEGER);
- _o_result = __MASK(__ASHR(i, 4), -2048);
- return _o_result;
+ INT16 i;
+ __GET((ADDRESS)&x + 6, i, INT16);
+ return __MASK(__ASHR(i, 4), -2048);
}
-void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len)
+void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len)
{
- LONGINT i, j, k;
+ INT32 i, j, k;
if (x < (LONGREAL)0) {
x = -x;
}
k = 0;
if (n > 9) {
- i = (int)__ENTIER(x / (LONGREAL)(LONGREAL)1000000000);
- j = (int)__ENTIER(x - i * (LONGREAL)1000000000);
+ 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)] = (CHAR)(__MOD(j, 10) + 48);
+ d[__X(k, d__len)] = (CHAR)((int)__MOD(j, 10) + 48);
j = __DIV(j, 10);
k += 1;
}
} else {
- i = (int)__ENTIER(x);
+ i = (INT32)__ENTIER(x);
}
- while (k < (int)n) {
- d[__X(k, d__len)] = (CHAR)(__MOD(i, 10) + 48);
+ while (k < n) {
+ d[__X(k, d__len)] = (CHAR)((int)__MOD(i, 10) + 48);
i = __DIV(i, 10);
k += 1;
}
}
-void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len)
+void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len)
{
Reals_ConvertL(x, n, (void*)d, d__len);
}
-static CHAR Reals_ToHex (INTEGER i)
+static CHAR Reals_ToHex (INT16 i)
{
- CHAR _o_result;
if (i < 10) {
- _o_result = (CHAR)(i + 48);
- return _o_result;
+ return (CHAR)(i + 48);
} else {
- _o_result = (CHAR)(i + 55);
- return _o_result;
+ return (CHAR)(i + 55);
}
__RETCHK;
}
static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len)
{
- INTEGER i;
- LONGINT l;
+ INT16 i;
+ INT32 l;
CHAR by;
i = 0;
l = b__len;
- while ((int)i < l) {
+ while (i < l) {
by = __VAL(CHAR, b[__X(i, b__len)]);
- d[__X(__ASHL(i, 1), d__len)] = Reals_ToHex(__ASHR((int)by, 4));
- d[__X(__ASHL(i, 1) + 1, d__len)] = Reals_ToHex(__MASK((int)by, -16));
+ d[__X(__ASHL(i, 1), d__len)] = Reals_ToHex(__ASHR((INT16)by, 4));
+ d[__X(__ASHL(i, 1) + 1, d__len)] = Reals_ToHex(__MASK((INT16)by, -16));
i += 1;
}
}
void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len)
{
- Reals_BytesToHex((void*)&y, ((LONGINT)(4)), (void*)d, d__len * ((LONGINT)(1)));
+ Reals_BytesToHex((void*)&y, 4, (void*)d, d__len * 1);
}
void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len)
{
- Reals_BytesToHex((void*)&x, ((LONGINT)(8)), (void*)d, d__len * ((LONGINT)(1)));
+ Reals_BytesToHex((void*)&x, 8, (void*)d, d__len * 1);
}
diff --git a/bootstrap/unix-48/Reals.h b/bootstrap/unix-48/Reals.h
index 7e6b534c..f0c84ab1 100644
--- a/bootstrap/unix-48/Reals.h
+++ b/bootstrap/unix-48/Reals.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Reals__h
#define Reals__h
@@ -8,16 +8,16 @@
-import void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT 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, INTEGER n, CHAR *d, LONGINT d__len);
-import INTEGER Reals_Expo (REAL x);
-import INTEGER Reals_ExpoL (LONGREAL x);
-import void Reals_SetExpo (REAL *x, INTEGER ex);
-import REAL Reals_Ten (INTEGER e);
-import LONGREAL Reals_TenL (INTEGER e);
+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);
+import REAL Reals_Ten (INT16 e);
+import LONGREAL Reals_TenL (INT16 e);
import void *Reals__init(void);
-#endif
+#endif // Reals
diff --git a/bootstrap/unix-48/SYSTEM.c b/bootstrap/unix-48/SYSTEM.c
deleted file mode 100644
index 33511a70..00000000
--- a/bootstrap/unix-48/SYSTEM.c
+++ /dev/null
@@ -1,207 +0,0 @@
-/*
-* The body prefix file of the voc(jet backend) runtime system, Version 1.0
-*
-* Copyright (c) Software Templ, 1994, 1995
-*
-* Module SYSTEM is subject to change any time without prior notification.
-* Software Templ disclaims all warranties with regard to module SYSTEM,
-* in particular shall Software Templ not be liable for any damage resulting
-* from inappropriate use or modification of module SYSTEM.
-*
-* Version 1.1 jt, 24.11.95 fixes for correct pointer arithmetic on Cray computers
-* jt 31.1.2007 ANSI prototypes for malloc and exit in order to avoid cc warnings
-*
-*/
-
-#include "SYSTEM.h"
-#include "stdarg.h"
-#include
-
-
-LONGINT SYSTEM_XCHK(LONGINT i, LONGINT ub) {return __X(i, ub);}
-LONGINT SYSTEM_RCHK(LONGINT i, LONGINT ub) {return __R(i, ub);}
-LONGINT SYSTEM_ASH (LONGINT i, LONGINT n) {return __ASH(i, n);}
-LONGINT SYSTEM_ABS (LONGINT i) {return __ABS(i);}
-double SYSTEM_ABSD(double i) {return __ABS(i);}
-
-void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0)
-{
- t -= __TPROC0OFF;
- t0 -= __TPROC0OFF;
- while (*t0 != __EOM) {*t = *t0; t--; t0--;}
-}
-
-
-void SYSTEM_ENUMP(void *adr, LONGINT n, void (*P)())
-{
- while (n > 0) {
- P((LONGINT)(SYSTEM_ADDRESS)(*((void**)(adr))));
- adr = ((void**)adr) + 1;
- n--;
- }
-}
-
-void SYSTEM_ENUMR(void *adr, LONGINT *typ, LONGINT size, LONGINT n, void (*P)())
-{
- LONGINT *t, off;
- typ++;
- while (n > 0) {
- t = typ;
- off = *t;
- while (off >= 0) {P(*(LONGINT*)((char*)adr+off)); t++; off = *t;}
- adr = ((char*)adr) + size;
- n--;
- }
-}
-
-LONGINT SYSTEM_DIV(U_LONGINT x, U_LONGINT y)
-{ if ((LONGINT) x >= 0) return (x / y);
- else return -((y - 1 - x) / y);
-}
-
-LONGINT SYSTEM_MOD(U_LONGINT x, U_LONGINT y)
-{ U_LONGINT m;
- if ((LONGINT) x >= 0) return (x % y);
- else { m = (-x) % y;
- if (m != 0) return (y - m); else return 0;
- }
-}
-
-LONGINT SYSTEM_ENTIER(double x)
-{
- LONGINT y;
- if (x >= 0)
- return (LONGINT)x;
- else {
- y = (LONGINT)x;
- if (y <= x) return y; else return y - 1;
- }
-}
-
-extern void Heap_Lock();
-extern void Heap_Unlock();
-
-SYSTEM_PTR SYSTEM_NEWARR(LONGINT *typ, LONGINT elemsz, int elemalgn, int nofdim, int nofdyn, ...)
-{
- LONGINT nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off;
- va_list ap;
- va_start(ap, nofdyn);
- nofelems = 1;
- while (nofdim > 0) {
- nofelems = nofelems * va_arg(ap, LONGINT); nofdim--;
- if (nofelems <= 0) __HALT(-20);
- }
- va_end(ap);
- dataoff = nofdyn * sizeof(LONGINT);
- if (elemalgn > sizeof(LONGINT)) {
- n = dataoff % elemalgn;
- if (n != 0) dataoff += elemalgn - n;
- }
- size = dataoff + nofelems * elemsz;
- Heap_Lock();
- if (typ == NIL) {
- /* element typ does not contain pointers */
- x = Heap_NEWBLK(size);
- }
- else if (typ == (LONGINT*)POINTER__typ) {
- /* element type is a pointer */
- x = Heap_NEWBLK(size + nofelems * sizeof(LONGINT));
- p = (LONGINT*)(SYSTEM_ADDRESS)x[-1];
- p[-nofelems] = *p; /* build new type desc in situ: 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */
- p -= nofelems - 1; n = 1; /* n =1 for skipping the size field */
- while (n <= nofelems) {*p = n*sizeof(LONGINT); p++; n++;}
- *p = - (nofelems + 1) * sizeof(LONGINT); /* sentinel */
- x[-1] -= nofelems * sizeof(LONGINT);
- }
- else {
- /* element type is a record that contains pointers */
- ptab = typ + 1; nofptrs = 0;
- while (ptab[nofptrs] >= 0) {nofptrs++;} /* number of pointers per element */
- nptr = nofelems * nofptrs; /* total number of pointers */
- x = Heap_NEWBLK(size + nptr * sizeof(LONGINT));
- p = (LONGINT*)(SYSTEM_ADDRESS)x[- 1];
- p[-nptr] = *p; /* build new type desc in situ; 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */
- p -= nptr - 1; n = 0; off = dataoff;
- while (n < nofelems) {i = 0;
- while (i < nofptrs) {*p = off + ptab[i]; p++; i++;}
- off += elemsz; n++;
- }
- *p = - (nptr + 1) * sizeof(LONGINT); /* sentinel */
- x[-1] -= nptr * sizeof(LONGINT);
- }
- if (nofdyn != 0) {
- /* setup len vector for index checks */
- va_start(ap, nofdyn);
- p = x;
- while (nofdyn > 0) {*p = va_arg(ap, LONGINT); p++, nofdyn--;}
- va_end(ap);
- }
- Heap_Unlock();
- return x;
-}
-
-
-
-
-typedef void (*SystemSignalHandler)(INTEGER); // = Platform_SignalHandler
-
-#ifndef _WIN32
-
- SystemSignalHandler handler[3] = {0};
-
- // Provide signal handling for Unix based systems
- void signalHandler(int s) {
- if (s >= 2 && s <= 4) handler[s-2](s);
- // (Ignore other signals)
- }
-
- void SystemSetHandler(int s, SYSTEM_ADDRESS h) {
- if (s >= 2 && s <= 4) {
- int needtosetsystemhandler = handler[s-2] == 0;
- handler[s-2] = (SystemSignalHandler)h;
- if (needtosetsystemhandler) {signal(s, signalHandler);}
- }
- }
-
-#else
-
- // Provides Windows callback handlers for signal-like scenarios
- #include "WindowsWrapper.h"
-
- SystemSignalHandler SystemInterruptHandler = 0;
- SystemSignalHandler SystemQuitHandler = 0;
- BOOL ConsoleCtrlHandlerSet = FALSE;
-
- BOOL WINAPI SystemConsoleCtrlHandler(DWORD ctrlType) {
- if ((ctrlType == CTRL_C_EVENT) || (ctrlType == CTRL_BREAK_EVENT)) {
- if (SystemInterruptHandler) {
- SystemInterruptHandler(2); // SIGINT
- return TRUE;
- }
- } else { // Close, logoff or shutdown
- if (SystemQuitHandler) {
- SystemQuitHandler(3); // SIGQUIT
- return TRUE;
- }
- }
- return FALSE;
- }
-
- void EnsureConsoleCtrlHandler() {
- if (!ConsoleCtrlHandlerSet) {
- SetConsoleCtrlHandler(SystemConsoleCtrlHandler, TRUE);
- ConsoleCtrlHandlerSet = TRUE;
- }
- }
-
- void SystemSetInterruptHandler(SYSTEM_ADDRESS h) {
- EnsureConsoleCtrlHandler();
- SystemInterruptHandler = (SystemSignalHandler)h;
- }
-
- void SystemSetQuitHandler(SYSTEM_ADDRESS h) {
- EnsureConsoleCtrlHandler();
- SystemQuitHandler = (SystemSignalHandler)h;
- }
-
-#endif
diff --git a/bootstrap/unix-48/SYSTEM.h b/bootstrap/unix-48/SYSTEM.h
deleted file mode 100644
index 6377745e..00000000
--- a/bootstrap/unix-48/SYSTEM.h
+++ /dev/null
@@ -1,295 +0,0 @@
-#ifndef SYSTEM__h
-#define SYSTEM__h
-
-#if defined(_WIN64)
- typedef long long SYSTEM_INT64;
- typedef unsigned long long SYSTEM_CARD64;
-#else
- typedef long SYSTEM_INT64;
- typedef unsigned long SYSTEM_CARD64;
-#endif
-
-typedef int SYSTEM_INT32;
-typedef unsigned int SYSTEM_CARD32;
-typedef short int SYSTEM_INT16;
-typedef unsigned short int SYSTEM_CARD16;
-typedef signed char SYSTEM_INT8;
-typedef unsigned char SYSTEM_CARD8;
-
-#if (__SIZEOF_POINTER__ == 8) || defined(_WIN64) || defined(__LP64__)
- #if defined(_WIN64)
- typedef unsigned long long size_t;
- #else
- typedef unsigned long size_t;
- #endif
-#else
- typedef unsigned int size_t;
-#endif
-
-#define SYSTEM_ADDRESS size_t
-#define _SIZE_T_DECLARED // For FreeBSD
-#define _SIZE_T_DEFINED_ // For OpenBSD
-
-void *memcpy(void *dest, const void *source, SYSTEM_ADDRESS size);
-
-
-
-// The compiler uses 'import' and 'export' which translate to 'extern' and
-// nothing respectively.
-
-#define import extern
-#define export
-
-
-
-// Known constants
-
-#define NIL ((void*)0)
-#define __MAXEXT 16
-#define POINTER__typ ((LONGINT*)(1)) // not NIL and not a valid type
-
-
-// Oberon types
-
-typedef char BOOLEAN;
-typedef unsigned char SYSTEM_BYTE;
-typedef unsigned char CHAR;
-typedef signed char SHORTINT;
-typedef float REAL;
-typedef double LONGREAL;
-typedef void* SYSTEM_PTR;
-
-// Unsigned variants are for use by shift and rotate macros.
-
-typedef unsigned char U_SYSTEM_BYTE;
-typedef unsigned char U_CHAR;
-typedef unsigned char U_SHORTINT;
-
-// For 32 bit builds, the size of LONGINT depends on a make option:
-
-#if (__SIZEOF_POINTER__ == 8) || defined(LARGE) || defined(_WIN64)
- typedef int INTEGER; // INTEGER is 32 bit.
- typedef long long LONGINT; // LONGINT is 64 bit. (long long is always 64 bits, while long can be 32 bits e.g. under MSC/MingW)
- typedef unsigned int U_INTEGER;
- typedef unsigned long long U_LONGINT;
-#else
- typedef short int INTEGER; // INTEGER is 16 bit.
- typedef long LONGINT; // LONGINT is 32 bit.
- typedef unsigned short int U_INTEGER;
- typedef unsigned long U_LONGINT;
-#endif
-
-typedef U_LONGINT SET;
-typedef U_LONGINT U_SET;
-
-
-// OS Memory allocation interfaces are in PlatformXXX.Mod
-
-extern LONGINT Platform_OSAllocate (LONGINT size);
-extern void Platform_OSFree (LONGINT addr);
-
-
-// Run time system routines in SYSTEM.c
-
-extern LONGINT SYSTEM_XCHK (LONGINT i, LONGINT ub);
-extern LONGINT SYSTEM_RCHK (LONGINT i, LONGINT ub);
-extern LONGINT SYSTEM_ASH (LONGINT i, LONGINT n);
-extern LONGINT SYSTEM_ABS (LONGINT i);
-extern double SYSTEM_ABSD (double i);
-extern void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0);
-extern void SYSTEM_ENUMP (void *adr, LONGINT n, void (*P)());
-extern void SYSTEM_ENUMR (void *adr, LONGINT *typ, LONGINT size, LONGINT n, void (*P)());
-extern LONGINT SYSTEM_DIV (U_LONGINT x, U_LONGINT y);
-extern LONGINT SYSTEM_MOD (U_LONGINT x, U_LONGINT y);
-extern LONGINT SYSTEM_ENTIER (double x);
-
-
-// Signal handling in SYSTEM.c
-
-#ifndef _WIN32
- extern void SystemSetHandler(int s, SYSTEM_ADDRESS h);
-#else
- extern void SystemSetInterruptHandler(SYSTEM_ADDRESS h);
- extern void SystemSetQuitHandler (SYSTEM_ADDRESS h);
-#endif
-
-
-
-// String comparison
-
-static int __str_cmp(CHAR *x, CHAR *y){
- LONGINT i = 0;
- CHAR ch1, ch2;
- do {ch1 = x[i]; ch2 = y[i]; i++;
- if (!ch1) return -(int)ch2;
- } while (ch1==ch2);
- return (int)ch1 - (int)ch2;
-}
-#define __STRCMP(a,b) __str_cmp((CHAR*)(a), (CHAR*)(b))
-
-
-
-// Inline string, record and array copy
-
-#define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d; LONGINT _i=0,_t=n-1; \
- while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;}
-#define __DUP(x, l, t) x=(void*)memcpy((void*)(SYSTEM_ADDRESS)Platform_OSAllocate(l*sizeof(t)),x,l*sizeof(t))
-#define __DUPARR(v, t) v=(void*)memcpy(v##__copy,v,sizeof(t))
-#define __DEL(x) Platform_OSFree((LONGINT)(SYSTEM_ADDRESS)x)
-
-
-
-
-/* SYSTEM ops */
-
-#define __VAL(t, x) (*(t*)&(x))
-
-
-#define __GET(a, x, t) x= *(t*)(SYSTEM_ADDRESS)(a)
-#define __PUT(a, x, t) *(t*)(SYSTEM_ADDRESS)(a)=x
-
-#define __LSHL(x, n, t) ((t)((U_##t)(x)<<(n)))
-#define __LSHR(x, n, t) ((t)((U_##t)(x)>>(n)))
-#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t))
-
-#define __ASHL(x, n) ((LONGINT)(x)<<(n))
-#define __ASHR(x, n) ((LONGINT)(x)>>(n))
-#define __ASH(x, n) ((n)>=0?__ASHL(x,n):__ASHR(x,-(n)))
-
-#define __ROTL(x, n, t) ((t)((U_##t)(x)<<(n)|(U_##t)(x)>>(8*sizeof(t)-(n))))
-#define __ROTR(x, n, t) ((t)((U_##t)(x)>>(n)|(U_##t)(x)<<(8*sizeof(t)-(n))))
-#define __ROT(x, n, t) ((n)>=0? __ROTL(x, n, t): __ROTR(x, -(n), t))
-
-#define __BIT(x, n) (*(U_LONGINT*)(x)>>(n)&1)
-#define __MOVE(s, d, n) memcpy((char*)(SYSTEM_ADDRESS)(d),(char*)(SYSTEM_ADDRESS)(s),n)
-#define __ASHF(x, n) SYSTEM_ASH((LONGINT)(x), (LONGINT)(n))
-#define __SHORT(x, y) ((int)((U_LONGINT)(x)+(y)<(y)+(y)?(x):(__HALT(-8),0)))
-#define __SHORTF(x, y) ((int)(__RF((x)+(y),(y)+(y))-(y)))
-#define __CHR(x) ((CHAR)__R(x, 256))
-#define __CHRF(x) ((CHAR)__RF(x, 256))
-#define __DIV(x, y) ((x)>=0?(x)/(y):-(((y)-1-(x))/(y)))
-#define __DIVF(x, y) SYSTEM_DIV((LONGINT)(x),(LONGINT)(y))
-#define __MOD(x, y) ((x)>=0?(x)%(y):__MODF(x,y))
-#define __MODF(x, y) SYSTEM_MOD((LONGINT)(x),(LONGINT)(y))
-#define __ENTIER(x) SYSTEM_ENTIER(x)
-#define __ABS(x) (((x)<0)?-(x):(x))
-#define __ABSF(x) SYSTEM_ABS((LONGINT)(x))
-#define __ABSFD(x) SYSTEM_ABSD((double)(x))
-#define __CAP(ch) ((CHAR)((ch)&0x5f))
-#define __ODD(x) ((x)&1)
-#define __IN(x, s) (((s)>>(x))&1)
-#define __SETOF(x) ((SET)1<<(x))
-#define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h)))
-#define __MASK(x, m) ((x)&~(m))
-
-
-
-// Runtime checks
-
-#define __X(i, ub) (((U_LONGINT)(i)<(U_LONGINT)(ub))?i:(__HALT(-2),0))
-#define __XF(i, ub) SYSTEM_XCHK((LONGINT)(i), (LONGINT)(ub))
-#define __R(i, ub) (((U_LONGINT)(i)<(U_LONGINT)(ub))?i:(__HALT(-8),0))
-#define __RF(i, ub) SYSTEM_RCHK((LONGINT)(i),(LONGINT)(ub))
-#define __RETCHK __retchk: __HALT(-3); return 0;
-#define __CASECHK __HALT(-4)
-#define __WITHCHK __HALT(-7)
-
-#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p)))
-#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r))))
-#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p)))
-#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p)
-#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p)
-
-
-
-// Module entry/registration/exit
-
-extern void Heap_REGCMD();
-extern SYSTEM_PTR Heap_REGMOD();
-extern void Heap_REGTYP();
-extern void Heap_INCREF();
-
-#define __DEFMOD static void *m; if (m!=0) {return m;}
-#define __REGCMD(name, cmd) Heap_REGCMD(m, (CHAR*)name, cmd)
-#define __REGMOD(name, enum) if (m==0) {m = Heap_REGMOD((CHAR*)name,enum);}
-#define __ENDMOD return m
-#define __MODULE_IMPORT(name) Heap_INCREF(name##__init())
-
-
-
-// Main module initialisation, registration and finalisation
-
-extern void Platform_Init(INTEGER argc, LONGINT argv);
-extern void Heap_FINALL();
-
-#define __INIT(argc, argv) static void *m; Platform_Init((INTEGER)argc, (LONGINT)(SYSTEM_ADDRESS)&argv);
-#define __REGMAIN(name, enum) m = Heap_REGMOD((CHAR*)name,enum)
-#define __FINI Heap_FINALL(); return 0
-
-
-// Assertions and Halts
-
-extern void Platform_Halt(LONGINT x);
-extern void Platform_AssertFail(LONGINT x);
-
-#define __HALT(x) Platform_Halt(x)
-#define __ASSERT(cond, x) if (!(cond)) Platform_AssertFail((LONGINT)(x))
-
-
-// Memory allocation
-
-extern SYSTEM_PTR Heap_NEWBLK (LONGINT size);
-extern SYSTEM_PTR Heap_NEWREC (LONGINT tag);
-extern SYSTEM_PTR SYSTEM_NEWARR(LONGINT*, LONGINT, int, int, int, ...);
-
-#define __SYSNEW(p, len) p = Heap_NEWBLK((LONGINT)(len))
-#define __NEW(p, t) p = Heap_NEWREC((LONGINT)(SYSTEM_ADDRESS)t##__typ)
-#define __NEWARR SYSTEM_NEWARR
-
-
-
-/* Type handling */
-
-#define __TDESC(t, m, n) \
- static struct t##__desc { \
- LONGINT tproc[m]; /* Proc for each ptr field */ \
- LONGINT tag; \
- LONGINT next; /* Module table type list points here */ \
- LONGINT level; \
- LONGINT module; \
- char name[24]; \
- LONGINT basep[__MAXEXT]; /* List of bases this extends */ \
- LONGINT reserved; \
- LONGINT blksz; /* xxx_typ points here */ \
- LONGINT ptr[n+1]; /* Offsets of ptrs up to -ve sentinel */ \
- } t##__desc
-
-#define __BASEOFF (__MAXEXT+1) // blksz as index to base.
-#define __TPROC0OFF (__BASEOFF+24/sizeof(LONGINT)+5) // blksz as index to tproc IFF m=1.
-#define __EOM 1
-#define __TDFLDS(name, size) {__EOM}, 1, 0, 0, 0, name, {0}, 0, size
-#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (LONGINT)(n), P)
-#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (LONGINT)(size), (LONGINT)(n), P)
-
-#define __INITYP(t, t0, level) \
- t##__typ = (LONGINT*)&t##__desc.blksz; \
- memcpy(t##__desc.basep, t0##__typ - __BASEOFF, level*sizeof(LONGINT)); \
- t##__desc.basep[level] = (LONGINT)(SYSTEM_ADDRESS)t##__typ; \
- t##__desc.module = (LONGINT)(SYSTEM_ADDRESS)m; \
- if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \
- t##__desc.blksz = (t##__desc.blksz+5*sizeof(LONGINT)-1)/(4*sizeof(LONGINT))*(4*sizeof(LONGINT)); \
- Heap_REGTYP(m, (LONGINT)(SYSTEM_ADDRESS)&t##__desc.next); \
- SYSTEM_INHERIT(t##__typ, t0##__typ)
-
-#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(LONGINT)(SYSTEM_ADDRESS)typ##__typ)
-#define __TYPEOF(p) ((LONGINT*)(SYSTEM_ADDRESS)(*(((LONGINT*)(p))-1)))
-#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level)
-
-// Oberon-2 type bound procedures support
-#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(LONGINT)(SYSTEM_ADDRESS)proc
-#define __SEND(typ, num, funtyp, parlist) ((funtyp)((SYSTEM_ADDRESS)*(typ-(__TPROC0OFF+num))))parlist
-
-
-
-
-#endif
diff --git a/bootstrap/unix-48/Strings.c b/bootstrap/unix-48/Strings.c
index 115456ea..b5707327 100644
--- a/bootstrap/unix-48/Strings.c
+++ b/bootstrap/unix-48/Strings.c
@@ -1,4 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
@@ -6,49 +12,53 @@
export void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len);
export void Strings_Cap (CHAR *s, LONGINT s__len);
-export void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n);
-export void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len);
-export void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len);
-export INTEGER Strings_Length (CHAR *s, LONGINT s__len);
+export 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 INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos);
-export void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len);
+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);
-INTEGER Strings_Length (CHAR *s, LONGINT s__len)
+INT16 Strings_Length (CHAR *s, LONGINT s__len)
{
- INTEGER _o_result;
- INTEGER i;
+ INT32 i;
__DUP(s, s__len, CHAR);
i = 0;
- while (((int)i < s__len && s[__X(i, s__len)] != 0x00)) {
+ while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
i += 1;
}
- _o_result = i;
- __DEL(s);
- return _o_result;
+ if (i <= 32767) {
+ __DEL(s);
+ return (INT16)i;
+ } else {
+ __DEL(s);
+ return 32767;
+ }
+ __RETCHK;
}
void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len)
{
- INTEGER n1, n2, i;
+ INT16 n1, n2, i;
__DUP(extra, extra__len, CHAR);
n1 = Strings_Length(dest, dest__len);
n2 = Strings_Length(extra, extra__len);
i = 0;
- while ((i < n2 && (int)(i + n1) < dest__len)) {
+ while ((i < n2 && (i + n1) < dest__len)) {
dest[__X(i + n1, dest__len)] = extra[__X(i, extra__len)];
i += 1;
}
- if ((int)(i + n1) < dest__len) {
+ if ((i + n1) < dest__len) {
dest[__X(i + n1, dest__len)] = 0x00;
}
__DEL(extra);
}
-void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len)
+void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len)
{
- INTEGER n1, n2, i;
+ INT16 n1, n2, i;
__DUP(source, source__len, CHAR);
n1 = Strings_Length(dest, dest__len);
n2 = Strings_Length(source, source__len);
@@ -57,12 +67,13 @@ void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest,
}
if (pos > n1) {
Strings_Append(dest, dest__len, (void*)source, source__len);
+ __DEL(source);
return;
}
- if ((int)(pos + n2) < dest__len) {
+ if ((pos + n2) < dest__len) {
i = n1;
while (i >= pos) {
- if ((int)(i + n2) < dest__len) {
+ if ((i + n2) < dest__len) {
dest[__X(i + n2, dest__len)] = dest[__X(i, dest__len)];
}
i -= 1;
@@ -76,9 +87,9 @@ void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest,
__DEL(source);
}
-void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n)
+void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n)
{
- INTEGER len, i;
+ INT16 len, i;
len = Strings_Length(s, s__len);
if (pos < 0) {
pos = 0;
@@ -91,7 +102,7 @@ void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n)
s[__X(i - n, s__len)] = s[__X(i, s__len)];
i += 1;
}
- if ((int)(i - n) < s__len) {
+ if ((i - n) < s__len) {
s[__X(i - n, s__len)] = 0x00;
}
} else {
@@ -99,7 +110,7 @@ void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n)
}
}
-void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT 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));
@@ -107,21 +118,22 @@ void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest
__DEL(source);
}
-void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len)
+void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len)
{
- INTEGER len, destLen, i;
+ INT16 len, destLen, i;
__DUP(source, source__len, CHAR);
len = Strings_Length(source, source__len);
- destLen = (int)dest__len - 1;
+ destLen = (INT16)dest__len - 1;
if (pos < 0) {
pos = 0;
}
if (pos >= len) {
dest[0] = 0x00;
+ __DEL(source);
return;
}
i = 0;
- while (((((int)(pos + i) <= source__len && source[__X(pos + i, source__len)] != 0x00)) && i < n)) {
+ while (((((pos + i) <= source__len && source[__X(pos + i, source__len)] != 0x00)) && i < n)) {
if (i < destLen) {
dest[__X(i, dest__len)] = source[__X(pos + i, source__len)];
}
@@ -131,19 +143,17 @@ void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n,
__DEL(source);
}
-INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos)
+INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos)
{
- INTEGER _o_result;
- INTEGER n1, n2, i, j;
+ INT16 n1, n2, i, j;
__DUP(pattern, pattern__len, CHAR);
__DUP(s, s__len, CHAR);
n1 = Strings_Length(s, s__len);
n2 = Strings_Length(pattern, pattern__len);
if (n2 == 0) {
- _o_result = 0;
__DEL(pattern);
__DEL(s);
- return _o_result;
+ return 0;
}
i = pos;
while (i <= n1 - n2) {
@@ -153,23 +163,21 @@ INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__le
j += 1;
}
if (j == n2) {
- _o_result = i;
__DEL(pattern);
__DEL(s);
- return _o_result;
+ return i;
}
}
i += 1;
}
- _o_result = -1;
__DEL(pattern);
__DEL(s);
- return _o_result;
+ return -1;
}
void Strings_Cap (CHAR *s, LONGINT s__len)
{
- INTEGER i;
+ INT16 i;
i = 0;
while (s[__X(i, s__len)] != 0x00) {
if (('a' <= s[__X(i, s__len)] && s[__X(i, s__len)] <= 'z')) {
@@ -183,54 +191,49 @@ static struct Match__7 {
struct Match__7 *lnk;
} *Match__7_s;
-static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INTEGER n, INTEGER m);
+static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INT16 n, INT16 m);
-static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INTEGER n, INTEGER m)
+static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INT16 n, INT16 m)
{
- BOOLEAN _o_result;
while ((((n >= 0 && m >= 0)) && mask[__X(m, mask__len)] != '*')) {
if (name[__X(n, name__len)] != mask[__X(m, mask__len)]) {
- _o_result = 0;
- return _o_result;
+ return 0;
}
n -= 1;
m -= 1;
}
if (m < 0) {
- _o_result = n < 0;
- return _o_result;
+ return n < 0;
}
while ((m >= 0 && mask[__X(m, mask__len)] == '*')) {
m -= 1;
}
if (m < 0) {
- _o_result = 1;
- return _o_result;
+ return 1;
}
while (n >= 0) {
if (M__8(name, name__len, mask, mask__len, n, m)) {
- _o_result = 1;
- return _o_result;
+ return 1;
}
n -= 1;
}
- _o_result = 0;
- return _o_result;
+ return 0;
}
BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len)
{
- BOOLEAN _o_result;
struct Match__7 _s;
+ BOOLEAN __retval;
__DUP(string, string__len, CHAR);
__DUP(pattern, pattern__len, CHAR);
_s.lnk = Match__7_s;
Match__7_s = &_s;
- _o_result = M__8((void*)string, string__len, (void*)pattern, pattern__len, Strings_Length(string, string__len) - 1, Strings_Length(pattern, pattern__len) - 1);
+ __retval = M__8((void*)string, string__len, (void*)pattern, pattern__len, Strings_Length(string, string__len) - 1, Strings_Length(pattern, pattern__len) - 1);
Match__7_s = _s.lnk;
__DEL(string);
__DEL(pattern);
- return _o_result;
+ ;
+ return __retval;
}
diff --git a/bootstrap/unix-48/Strings.h b/bootstrap/unix-48/Strings.h
index 96dbb01d..c987af8d 100644
--- a/bootstrap/unix-48/Strings.h
+++ b/bootstrap/unix-48/Strings.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Strings__h
#define Strings__h
@@ -10,14 +10,14 @@
import void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len);
import void Strings_Cap (CHAR *s, LONGINT s__len);
-import void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n);
-import void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len);
-import void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len);
-import INTEGER Strings_Length (CHAR *s, LONGINT s__len);
+import 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 INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos);
-import void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len);
+import 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);
-#endif
+#endif // Strings
diff --git a/bootstrap/unix-48/Texts.c b/bootstrap/unix-48/Texts.c
index cfe34ca7..ad26b1cb 100644
--- a/bootstrap/unix-48/Texts.c
+++ b/bootstrap/unix-48/Texts.c
@@ -1,4 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "Files.h"
#include "Modules.h"
@@ -13,9 +19,9 @@ typedef
typedef
struct Texts_RunDesc {
Texts_Run prev, next;
- LONGINT len;
+ INT32 len;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
BOOLEAN ascii;
} Texts_RunDesc;
@@ -28,7 +34,7 @@ typedef
} Texts_ElemMsg;
typedef
- void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, LONGINT *);
+ void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, ADDRESS *);
typedef
struct Texts_TextDesc *Texts_Text;
@@ -36,26 +42,26 @@ typedef
typedef
struct Texts_ElemDesc {
Texts_Run prev, next;
- LONGINT len;
+ INT32 len;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
BOOLEAN ascii;
- LONGINT W, H;
+ INT32 W, H;
Texts_Handler handle;
Texts_Text base;
} Texts_ElemDesc;
struct Texts__1 { /* Texts_ElemDesc */
Texts_Run prev, next;
- LONGINT len;
+ INT32 len;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
BOOLEAN ascii;
- LONGINT W, H;
+ INT32 W, H;
Texts_Handler handle;
Texts_Text base;
Files_File file;
- LONGINT org, span;
+ INT32 org, span;
CHAR mod[32], proc[32];
};
@@ -64,7 +70,7 @@ typedef
typedef
struct Texts_BufDesc {
- LONGINT len;
+ INT32 len;
Texts_Run head;
} Texts_BufDesc;
@@ -78,8 +84,8 @@ typedef
typedef
struct Texts_FileMsg { /* Texts_ElemMsg */
- INTEGER id;
- LONGINT pos;
+ INT16 id;
+ INT32 pos;
Files_Rider r;
} Texts_FileMsg;
@@ -94,7 +100,7 @@ typedef
} Texts_IdentifyMsg;
typedef
- void (*Texts_Notifier)(Texts_Text, INTEGER, LONGINT, LONGINT);
+ void (*Texts_Notifier)(Texts_Text, INT16, INT32, INT32);
typedef
struct Texts_PieceDesc *Texts_Piece;
@@ -102,57 +108,57 @@ typedef
typedef
struct Texts_PieceDesc {
Texts_Run prev, next;
- LONGINT len;
+ INT32 len;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
BOOLEAN ascii;
Files_File file;
- LONGINT org;
+ INT32 org;
} Texts_PieceDesc;
typedef
struct Texts_Reader {
BOOLEAN eot;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
Texts_Elem elem;
Files_Rider rider;
Texts_Run run;
- LONGINT org, off;
+ INT32 org, off;
} Texts_Reader;
typedef
struct Texts_Scanner { /* Texts_Reader */
BOOLEAN eot;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
Texts_Elem elem;
Files_Rider rider;
Texts_Run run;
- LONGINT org, off;
+ INT32 org, off;
CHAR nextCh;
- INTEGER line, class;
- LONGINT i;
+ INT16 line, class;
+ INT32 i;
REAL x;
LONGREAL y;
CHAR c;
- SHORTINT len;
+ INT8 len;
CHAR s[64];
} Texts_Scanner;
typedef
struct Texts_TextDesc {
- LONGINT len;
+ INT32 len;
Texts_Notifier notify;
Texts_Run head, cache;
- LONGINT corg;
+ INT32 corg;
} Texts_TextDesc;
typedef
struct Texts_Writer {
Texts_Buffer buf;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
Files_Rider rider;
Files_File file;
} Texts_Writer;
@@ -162,84 +168,82 @@ export Texts_Elem Texts_new;
static Texts_Buffer Texts_del;
static Texts_FontsFont Texts_FontsDefault;
-export LONGINT *Texts_FontDesc__typ;
-export LONGINT *Texts_RunDesc__typ;
-export LONGINT *Texts_PieceDesc__typ;
-export LONGINT *Texts_ElemMsg__typ;
-export LONGINT *Texts_ElemDesc__typ;
-export LONGINT *Texts_FileMsg__typ;
-export LONGINT *Texts_CopyMsg__typ;
-export LONGINT *Texts_IdentifyMsg__typ;
-export LONGINT *Texts_BufDesc__typ;
-export LONGINT *Texts_TextDesc__typ;
-export LONGINT *Texts_Reader__typ;
-export LONGINT *Texts_Scanner__typ;
-export LONGINT *Texts_Writer__typ;
-export LONGINT *Texts__1__typ;
+export ADDRESS *Texts_FontDesc__typ;
+export ADDRESS *Texts_RunDesc__typ;
+export ADDRESS *Texts_PieceDesc__typ;
+export ADDRESS *Texts_ElemMsg__typ;
+export ADDRESS *Texts_ElemDesc__typ;
+export ADDRESS *Texts_FileMsg__typ;
+export ADDRESS *Texts_CopyMsg__typ;
+export ADDRESS *Texts_IdentifyMsg__typ;
+export ADDRESS *Texts_BufDesc__typ;
+export ADDRESS *Texts_TextDesc__typ;
+export ADDRESS *Texts_Reader__typ;
+export ADDRESS *Texts_Scanner__typ;
+export ADDRESS *Texts_Writer__typ;
+export ADDRESS *Texts__1__typ;
export void Texts_Append (Texts_Text T, Texts_Buffer B);
-export void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff);
+export void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff);
static Texts_Elem Texts_CloneElem (Texts_Elem e);
static Texts_Piece Texts_ClonePiece (Texts_Piece p);
export void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
export void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
export void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
-export void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end);
+export void Texts_Delete (Texts_Text T, INT32 beg, INT32 end);
export Texts_Text Texts_ElemBase (Texts_Elem E);
-export LONGINT Texts_ElemPos (Texts_Elem E);
-static void Texts_Find (Texts_Text T, LONGINT *pos, Texts_Run *u, LONGINT *org, LONGINT *off);
+export INT32 Texts_ElemPos (Texts_Elem E);
+static void Texts_Find (Texts_Text T, INT32 *pos, Texts_Run *u, INT32 *org, INT32 *off);
static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len);
-static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, LONGINT *msg__typ);
-export void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B);
-export void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T);
-static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T);
+static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, ADDRESS *msg__typ);
+export void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B);
+export void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
+static void Texts_Load0 (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
static void Texts_Merge (Texts_Text T, Texts_Run u, Texts_Run *v);
export void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
export void Texts_OpenBuf (Texts_Buffer B);
-export void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos);
-export void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos);
-export void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ);
-export LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ);
-export void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch);
-export void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ);
-export void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ);
+export void Texts_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);
+export void Texts_OpenWriter (Texts_Writer *W, ADDRESS *W__typ);
+export INT32 Texts_Pos (Texts_Reader *R, ADDRESS *R__typ);
+export void Texts_Read (Texts_Reader *R, ADDRESS *R__typ, CHAR *ch);
+export void Texts_ReadElem (Texts_Reader *R, ADDRESS *R__typ);
+export void Texts_ReadPrevElem (Texts_Reader *R, ADDRESS *R__typ);
export void Texts_Recall (Texts_Buffer *B);
-export void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B);
-export void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ);
-export void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col);
-export void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt);
-export void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff);
+export void Texts_Save (Texts_Text T, INT32 beg, INT32 end, Texts_Buffer B);
+export void Texts_Scan (Texts_Scanner *S, ADDRESS *S__typ);
+export void Texts_SetColor (Texts_Writer *W, ADDRESS *W__typ, INT8 col);
+export void Texts_SetFont (Texts_Writer *W, ADDRESS *W__typ, Texts_FontsFont fnt);
+export void Texts_SetOffset (Texts_Writer *W, ADDRESS *W__typ, INT8 voff);
static void Texts_Splice (Texts_Run un, Texts_Run v, Texts_Run w, Texts_Text base);
-static void Texts_Split (LONGINT off, Texts_Run *u, Texts_Run *un);
-export void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T);
-export void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch);
-export void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d);
-export void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e);
-export void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x);
-export void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n);
-export void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ);
-export void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n);
-export void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x);
-export void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n);
-export void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k);
-export void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x);
-export void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len);
+static void Texts_Split (INT32 off, Texts_Run *u, Texts_Run *un);
+export void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
+export void Texts_Write (Texts_Writer *W, ADDRESS *W__typ, CHAR ch);
+export void Texts_WriteDate (Texts_Writer *W, ADDRESS *W__typ, INT32 t, INT32 d);
+export void Texts_WriteElem (Texts_Writer *W, ADDRESS *W__typ, Texts_Elem e);
+export void Texts_WriteHex (Texts_Writer *W, ADDRESS *W__typ, INT32 x);
+export void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n);
+export void Texts_WriteLn (Texts_Writer *W, ADDRESS *W__typ);
+export void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n);
+export void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x);
+export void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n);
+export void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k);
+export void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x);
+export void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len)
{
- Texts_FontsFont _o_result;
Texts_FontsFont F = NIL;
__NEW(F, Texts_FontDesc);
- __COPY(name, F->name, ((LONGINT)(32)));
- _o_result = F;
- return _o_result;
+ __COPY(name, F->name, 32);
+ return F;
}
-static void Texts_Find (Texts_Text T, LONGINT *pos, Texts_Run *u, LONGINT *org, LONGINT *off)
+static void Texts_Find (Texts_Text T, INT32 *pos, Texts_Run *u, INT32 *org, INT32 *off)
{
Texts_Run v = NIL;
- LONGINT m;
+ INT32 m;
if (*pos >= T->len) {
*pos = T->len;
*u = T->head;
@@ -269,7 +273,7 @@ static void Texts_Find (Texts_Text T, LONGINT *pos, Texts_Run *u, LONGINT *org,
}
}
-static void Texts_Split (LONGINT off, Texts_Run *u, Texts_Run *un)
+static void Texts_Split (INT32 off, Texts_Run *u, Texts_Run *un)
{
Texts_Piece p = NIL, U = NIL;
if (off == 0) {
@@ -332,22 +336,18 @@ static void Texts_Splice (Texts_Run un, Texts_Run v, Texts_Run w, Texts_Text bas
static Texts_Piece Texts_ClonePiece (Texts_Piece p)
{
- Texts_Piece _o_result;
Texts_Piece q = NIL;
__NEW(q, Texts_PieceDesc);
__GUARDEQP(q, Texts_PieceDesc) = *p;
- _o_result = q;
- return _o_result;
+ return q;
}
static Texts_Elem Texts_CloneElem (Texts_Elem e)
{
- Texts_Elem _o_result;
Texts_CopyMsg msg;
msg.e = NIL;
(*e->handle)(e, (void*)&msg, Texts_CopyMsg__typ);
- _o_result = msg.e;
- return _o_result;
+ return msg.e;
}
void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE)
@@ -363,31 +363,27 @@ void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE)
Texts_Text Texts_ElemBase (Texts_Elem E)
{
- Texts_Text _o_result;
- _o_result = E->base;
- return _o_result;
+ return E->base;
}
-LONGINT Texts_ElemPos (Texts_Elem E)
+INT32 Texts_ElemPos (Texts_Elem E)
{
- LONGINT _o_result;
Texts_Run u = NIL;
- LONGINT pos;
+ INT32 pos;
u = E->base->head->next;
pos = 0;
while (u != (void *) E) {
pos = pos + u->len;
u = u->next;
}
- _o_result = pos;
- return _o_result;
+ return pos;
}
-static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, LONGINT *msg__typ)
+static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, ADDRESS *msg__typ)
{
Texts_Alien e = NIL;
Files_Rider r;
- LONGINT i;
+ INT32 i;
CHAR ch;
if (__ISP(E, Texts__1, 2)) {
if (__IS(msg__typ, Texts_CopyMsg, 1)) {
@@ -398,15 +394,15 @@ static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, LONGINT *msg__t
e->file = ((Texts_Alien)E)->file;
e->org = ((Texts_Alien)E)->org;
e->span = ((Texts_Alien)E)->span;
- __COPY(((Texts_Alien)E)->mod, e->mod, ((LONGINT)(32)));
- __COPY(((Texts_Alien)E)->proc, e->proc, ((LONGINT)(32)));
+ __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, ((LONGINT)(32)));
- __COPY(((Texts_Alien)E)->proc, (*msg__).proc, ((LONGINT)(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)) {
@@ -463,10 +459,10 @@ void Texts_Recall (Texts_Buffer *B)
Texts_del = NIL;
}
-void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B)
+void Texts_Save (Texts_Text T, INT32 beg, INT32 end, Texts_Buffer B)
{
Texts_Run u = NIL, v = NIL, w = NIL, wn = NIL;
- LONGINT uo, ud, vo, vd;
+ INT32 uo, ud, vo, vd;
Texts_Find(T, &beg, &u, &uo, &ud);
Texts_Find(T, &end, &v, &vo, &vd);
w = B->head->prev;
@@ -497,11 +493,11 @@ void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B)
B->len += end - beg;
}
-void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B)
+void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B)
{
Texts_Run u = NIL, un = NIL, v = NIL;
Texts_Piece p = NIL, q = NIL;
- LONGINT uo, ud, len;
+ INT32 uo, ud, len;
Texts_Find(T, &pos, &u, &uo, &ud);
Texts_Split(ud, &u, &un);
len = B->len;
@@ -520,7 +516,7 @@ void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B)
void Texts_Append (Texts_Text T, Texts_Buffer B)
{
Texts_Run v = NIL;
- LONGINT pos, len;
+ INT32 pos, len;
pos = T->len;
len = B->len;
v = B->head->next;
@@ -535,10 +531,10 @@ void Texts_Append (Texts_Text T, Texts_Buffer B)
}
}
-void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end)
+void Texts_Delete (Texts_Text T, INT32 beg, INT32 end)
{
Texts_Run c = NIL, u = NIL, un = NIL, v = NIL, vn = NIL;
- LONGINT co, uo, ud, vo, vd;
+ INT32 co, uo, ud, vo, vd;
Texts_Find(T, &beg, &u, &uo, &ud);
Texts_Split(ud, &u, &un);
c = T->cache;
@@ -560,10 +556,10 @@ void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end)
}
}
-void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff)
+void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff)
{
Texts_Run c = NIL, u = NIL, un = NIL, v = NIL, vn = NIL;
- LONGINT co, uo, ud, vo, vd;
+ INT32 co, uo, ud, vo, vd;
Texts_Find(T, &beg, &u, &uo, &ud);
Texts_Split(ud, &u, &un);
c = T->cache;
@@ -573,13 +569,13 @@ void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_F
T->cache = c;
T->corg = co;
while (un != vn) {
- if ((__IN(0, sel) && fnt != NIL)) {
+ if ((__IN(0, sel, 32) && fnt != NIL)) {
un->fnt = fnt;
}
- if (__IN(1, sel)) {
+ if (__IN(1, sel, 32)) {
un->col = col;
}
- if (__IN(2, sel)) {
+ if (__IN(2, sel, 32)) {
un->voff = voff;
}
Texts_Merge(T, u, &un);
@@ -599,7 +595,7 @@ void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_F
}
}
-void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos)
+void Texts_OpenReader (Texts_Reader *R, ADDRESS *R__typ, Texts_Text T, INT32 pos)
{
Texts_Run u = NIL;
if (pos >= T->len) {
@@ -613,10 +609,10 @@ void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT p
}
}
-void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch)
+void Texts_Read (Texts_Reader *R, ADDRESS *R__typ, CHAR *ch)
{
Texts_Run u = NIL;
- LONGINT pos;
+ INT32 pos;
CHAR nextch;
u = (*R).run;
(*R).fnt = u->fnt;
@@ -658,7 +654,7 @@ void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch)
}
}
-void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ)
+void Texts_ReadElem (Texts_Reader *R, ADDRESS *R__typ)
{
Texts_Run u = NIL, un = NIL;
u = (*R).run;
@@ -686,7 +682,7 @@ void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ)
}
}
-void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ)
+void Texts_ReadPrevElem (Texts_Reader *R, ADDRESS *R__typ)
{
Texts_Run u = NIL;
u = (*R).run->prev;
@@ -708,14 +704,12 @@ void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ)
}
}
-LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ)
+INT32 Texts_Pos (Texts_Reader *R, ADDRESS *R__typ)
{
- LONGINT _o_result;
- _o_result = (*R).org + (*R).off;
- return _o_result;
+ return (*R).org + (*R).off;
}
-void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos)
+void Texts_OpenScanner (Texts_Scanner *S, ADDRESS *S__typ, Texts_Text T, INT32 pos)
{
Texts_OpenReader((void*)&*S, S__typ, T, pos);
(*S).line = 0;
@@ -724,10 +718,10 @@ void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT
static struct Scan__31 {
Texts_Scanner *S;
- LONGINT *S__typ;
+ ADDRESS *S__typ;
CHAR *ch;
BOOLEAN *negE;
- INTEGER *e;
+ INT16 *e;
struct Scan__31 *lnk;
} *Scan__31_s;
@@ -746,18 +740,18 @@ static void ReadScaleFactor__32 (void)
}
}
while (('0' <= *Scan__31_s->ch && *Scan__31_s->ch <= '9')) {
- *Scan__31_s->e = (*Scan__31_s->e * 10 + (int)*Scan__31_s->ch) - 48;
+ *Scan__31_s->e = (*Scan__31_s->e * 10 + (INT16)*Scan__31_s->ch) - 48;
Texts_Read((void*)&*Scan__31_s->S, Scan__31_s->S__typ, &*Scan__31_s->ch);
}
}
-void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
+void Texts_Scan (Texts_Scanner *S, ADDRESS *S__typ)
{
CHAR ch, term;
BOOLEAN neg, negE, hex;
- SHORTINT i, j, h;
- INTEGER e;
- LONGINT k;
+ INT8 i, j, h;
+ INT16 e;
+ INT32 k;
REAL x, f;
LONGREAL y, g;
CHAR d[32];
@@ -780,21 +774,21 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
}
if ((('A' <= __CAP(ch) && __CAP(ch) <= 'Z') || ch == '/') || ch == '.') {
do {
- (*S).s[__X(i, ((LONGINT)(64)))] = ch;
+ (*S).s[__X(i, 64)] = ch;
i += 1;
Texts_Read((void*)&*S, S__typ, &ch);
} while (!((((__CAP(ch) > 'Z' && ch != '_') || ('A' > __CAP(ch) && ch > '9')) || ((('0' > ch && ch != '.')) && ch != '/')) || i == 63));
- (*S).s[__X(i, ((LONGINT)(64)))] = 0x00;
+ (*S).s[__X(i, 64)] = 0x00;
(*S).len = i;
(*S).class = 1;
} else if (ch == '"') {
Texts_Read((void*)&*S, S__typ, &ch);
while ((((ch != '"' && ch >= ' ')) && i != 63)) {
- (*S).s[__X(i, ((LONGINT)(64)))] = ch;
+ (*S).s[__X(i, 64)] = ch;
i += 1;
Texts_Read((void*)&*S, S__typ, &ch);
}
- (*S).s[__X(i, ((LONGINT)(64)))] = 0x00;
+ (*S).s[__X(i, 64)] = 0x00;
(*S).len = i + 1;
Texts_Read((void*)&*S, S__typ, &ch);
(*S).class = 2;
@@ -809,7 +803,7 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
hex = 0;
j = 0;
for (;;) {
- d[__X(i, ((LONGINT)(32)))] = ch;
+ d[__X(i, 32)] = ch;
i += 1;
Texts_Read((void*)&*S, S__typ, &ch);
if (ch < '0') {
@@ -818,10 +812,10 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
if ('9' < ch) {
if (('A' <= ch && ch <= 'F')) {
hex = 1;
- ch = (CHAR)((int)ch - 7);
+ ch = (CHAR)((INT16)ch - 7);
} else if (('a' <= ch && ch <= 'f')) {
hex = 1;
- ch = (CHAR)((int)ch - 39);
+ ch = (CHAR)((INT16)ch - 39);
} else {
break;
}
@@ -833,13 +827,13 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
if (i - j > 8) {
j = i - 8;
}
- k = (int)d[__X(j, ((LONGINT)(32)))] - 48;
+ k = (INT16)d[__X(j, 32)] - 48;
j += 1;
if ((i - j == 7 && k >= 8)) {
k -= 16;
}
while (j < i) {
- k = __ASHL(k, 4) + (int)((int)d[__X(j, ((LONGINT)(32)))] - 48);
+ k = __ASHL(k, 4) + ((INT16)d[__X(j, 32)] - 48);
j += 1;
}
if (neg) {
@@ -851,7 +845,7 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
Texts_Read((void*)&*S, S__typ, &ch);
h = i;
while (('0' <= ch && ch <= '9')) {
- d[__X(i, ((LONGINT)(32)))] = ch;
+ d[__X(i, 32)] = ch;
i += 1;
Texts_Read((void*)&*S, S__typ, &ch);
}
@@ -860,12 +854,12 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
y = (LONGREAL)0;
g = (LONGREAL)1;
do {
- y = y * (LONGREAL)10 + ((int)d[__X(j, ((LONGINT)(32)))] - 48);
+ y = y * (LONGREAL)10 + ((INT16)d[__X(j, 32)] - 48);
j += 1;
} while (!(j == h));
while (j < i) {
g = g / (LONGREAL)(LONGREAL)10;
- y = ((int)d[__X(j, ((LONGINT)(32)))] - 48) * g + y;
+ y = ((INT16)d[__X(j, 32)] - 48) * g + y;
j += 1;
}
ReadScaleFactor__32();
@@ -892,12 +886,12 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
x = (REAL)0;
f = (REAL)1;
do {
- x = x * (REAL)10 + ((int)d[__X(j, ((LONGINT)(32)))] - 48);
+ x = x * (REAL)10 + ((INT16)d[__X(j, 32)] - 48);
j += 1;
} while (!(j == h));
while (j < i) {
f = f / (REAL)(REAL)10;
- x = ((int)d[__X(j, ((LONGINT)(32)))] - 48) * f + x;
+ x = ((INT16)d[__X(j, 32)] - 48) * f + x;
j += 1;
}
if (ch == 'E') {
@@ -929,7 +923,7 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
(*S).class = 3;
k = 0;
do {
- k = k * 10 + (int)((int)d[__X(j, ((LONGINT)(32)))] - 48);
+ k = k * 10 + ((INT16)d[__X(j, 32)] - 48);
j += 1;
} while (!(j == i));
if (neg) {
@@ -957,33 +951,33 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
Scan__31_s = _s.lnk;
}
-void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ)
+void Texts_OpenWriter (Texts_Writer *W, ADDRESS *W__typ)
{
__NEW((*W).buf, Texts_BufDesc);
Texts_OpenBuf((*W).buf);
(*W).fnt = Texts_FontsDefault;
(*W).col = 15;
(*W).voff = 0;
- (*W).file = Files_New((CHAR*)"", (LONGINT)1);
- Files_Set(&(*W).rider, Files_Rider__typ, (*W).file, ((LONGINT)(0)));
+ (*W).file = Files_New((CHAR*)"", 1);
+ Files_Set(&(*W).rider, Files_Rider__typ, (*W).file, 0);
}
-void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt)
+void Texts_SetFont (Texts_Writer *W, ADDRESS *W__typ, Texts_FontsFont fnt)
{
(*W).fnt = fnt;
}
-void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col)
+void Texts_SetColor (Texts_Writer *W, ADDRESS *W__typ, INT8 col)
{
(*W).col = col;
}
-void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff)
+void Texts_SetOffset (Texts_Writer *W, ADDRESS *W__typ, INT8 voff)
{
(*W).voff = voff;
}
-void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch)
+void Texts_Write (Texts_Writer *W, ADDRESS *W__typ, CHAR ch)
{
Texts_Run u = NIL, un = NIL;
Texts_Piece p = NIL;
@@ -1009,7 +1003,7 @@ void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch)
}
}
-void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e)
+void Texts_WriteElem (Texts_Writer *W, ADDRESS *W__typ, Texts_Elem e)
{
Texts_Run u = NIL, un = NIL;
if (e->base != NIL) {
@@ -1028,14 +1022,14 @@ void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e)
un->prev = (Texts_Run)e;
}
-void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ)
+void Texts_WriteLn (Texts_Writer *W, ADDRESS *W__typ)
{
Texts_Write(&*W, W__typ, 0x0d);
}
-void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len)
+void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len)
{
- INTEGER i;
+ INT16 i;
__DUP(s, s__len, CHAR);
i = 0;
while (s[__X(i, s__len)] >= ' ') {
@@ -1045,15 +1039,15 @@ void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__le
__DEL(s);
}
-void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n)
+void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n)
{
- INTEGER i;
- LONGINT x0;
- CHAR a[22];
+ INT16 i;
+ INT64 x0;
+ CHAR a[24];
i = 0;
if (x < 0) {
- if (x == (-2147483647-1)) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" -2147483648", (LONGINT)13);
+ if (x == (-9223372036854775807-1)) {
+ Texts_WriteString(&*W, W__typ, (CHAR*)" -9223372036854775808", 22);
return;
} else {
n -= 1;
@@ -1063,11 +1057,11 @@ void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n)
x0 = x;
}
do {
- a[__X(i, ((LONGINT)(22)))] = (CHAR)(__MOD(x0, 10) + 48);
+ a[__X(i, 24)] = (CHAR)(__MOD(x0, 10) + 48);
x0 = __DIV(x0, 10);
i += 1;
} while (!(x0 == 0));
- while (n > (int)i) {
+ while (n > (INT64)i) {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
}
@@ -1076,47 +1070,47 @@ void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n)
}
do {
i -= 1;
- Texts_Write(&*W, W__typ, a[__X(i, ((LONGINT)(22)))]);
+ Texts_Write(&*W, W__typ, a[__X(i, 24)]);
} while (!(i == 0));
}
-void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x)
+void Texts_WriteHex (Texts_Writer *W, ADDRESS *W__typ, INT32 x)
{
- INTEGER i;
- LONGINT y;
+ INT16 i;
+ INT32 y;
CHAR a[20];
i = 0;
Texts_Write(&*W, W__typ, ' ');
do {
y = __MASK(x, -16);
if (y < 10) {
- a[__X(i, ((LONGINT)(20)))] = (CHAR)(y + 48);
+ a[__X(i, 20)] = (CHAR)(y + 48);
} else {
- a[__X(i, ((LONGINT)(20)))] = (CHAR)(y + 55);
+ a[__X(i, 20)] = (CHAR)(y + 55);
}
x = __ASHR(x, 4);
i += 1;
} while (!(i == 8));
do {
i -= 1;
- Texts_Write(&*W, W__typ, a[__X(i, ((LONGINT)(20)))]);
+ Texts_Write(&*W, W__typ, a[__X(i, 20)]);
} while (!(i == 0));
}
-void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n)
+void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n)
{
- INTEGER e;
+ INT16 e;
REAL x0;
CHAR d[9];
e = Reals_Expo(x);
if (e == 0) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" 0", (LONGINT)4);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" 0", 4);
do {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
} while (!(n <= 3));
} else if (e == 255) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", 5);
while (n > 4) {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
@@ -1153,13 +1147,13 @@ void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n)
x = x * 1.0000000e-001;
e += 1;
}
- Reals_Convert(x, n, (void*)d, ((LONGINT)(9)));
+ Reals_Convert(x, n, (void*)d, 9);
n -= 1;
- Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(9)))]);
+ Texts_Write(&*W, W__typ, d[__X(n, 9)]);
Texts_Write(&*W, W__typ, '.');
do {
n -= 1;
- Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(9)))]);
+ Texts_Write(&*W, W__typ, d[__X(n, 9)]);
} while (!(n == 0));
Texts_Write(&*W, W__typ, 'E');
if (e < 0) {
@@ -1175,16 +1169,16 @@ void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n)
static struct WriteRealFix__53 {
Texts_Writer *W;
- LONGINT *W__typ;
- INTEGER *i;
+ ADDRESS *W__typ;
+ INT16 *i;
CHAR (*d)[9];
struct WriteRealFix__53 *lnk;
} *WriteRealFix__53_s;
-static void dig__54 (INTEGER n);
-static void seq__56 (CHAR ch, INTEGER n);
+static void dig__54 (INT16 n);
+static void seq__56 (CHAR ch, INT16 n);
-static void seq__56 (CHAR ch, INTEGER n)
+static void seq__56 (CHAR ch, INT16 n)
{
while (n > 0) {
Texts_Write(&*WriteRealFix__53_s->W, WriteRealFix__53_s->W__typ, ch);
@@ -1192,18 +1186,18 @@ static void seq__56 (CHAR ch, INTEGER n)
}
}
-static void dig__54 (INTEGER n)
+static void dig__54 (INT16 n)
{
while (n > 0) {
*WriteRealFix__53_s->i -= 1;
- Texts_Write(&*WriteRealFix__53_s->W, WriteRealFix__53_s->W__typ, (*WriteRealFix__53_s->d)[__X(*WriteRealFix__53_s->i, ((LONGINT)(9)))]);
+ Texts_Write(&*WriteRealFix__53_s->W, WriteRealFix__53_s->W__typ, (*WriteRealFix__53_s->d)[__X(*WriteRealFix__53_s->i, 9)]);
n -= 1;
}
}
-void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k)
+void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k)
{
- INTEGER e, i;
+ INT16 e, i;
CHAR sign;
REAL x0;
CHAR d[9];
@@ -1222,7 +1216,7 @@ void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, IN
Texts_Write(&*W, W__typ, '0');
seq__56(' ', k + 1);
} else if (e == 255) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", 5);
seq__56(' ', n - 4);
} else {
e = __ASHR((e - 127) * 77, 8);
@@ -1254,7 +1248,7 @@ void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, IN
}
e += 1;
i = k + e;
- Reals_Convert(x, i, (void*)d, ((LONGINT)(9)));
+ Reals_Convert(x, i, (void*)d, 9);
if (e > 0) {
seq__56(' ', ((n - e) - k) - 2);
Texts_Write(&*W, W__typ, sign);
@@ -1273,32 +1267,32 @@ void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, IN
WriteRealFix__53_s = _s.lnk;
}
-void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x)
+void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x)
{
- INTEGER i;
+ INT16 i;
CHAR d[8];
- Reals_ConvertH(x, (void*)d, ((LONGINT)(8)));
+ Reals_ConvertH(x, (void*)d, 8);
i = 0;
do {
- Texts_Write(&*W, W__typ, d[__X(i, ((LONGINT)(8)))]);
+ Texts_Write(&*W, W__typ, d[__X(i, 8)]);
i += 1;
} while (!(i == 8));
}
-void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n)
+void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n)
{
- INTEGER e;
+ INT16 e;
LONGREAL x0;
CHAR d[16];
e = Reals_ExpoL(x);
if (e == 0) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" 0", (LONGINT)4);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" 0", 4);
do {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
} while (!(n <= 3));
} else if (e == 2047) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", 5);
while (n > 4) {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
@@ -1319,7 +1313,7 @@ void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER
} else {
Texts_Write(&*W, W__typ, ' ');
}
- e = (int)__ASHR((int)(e - 1023) * 77, 8);
+ e = (INT16)__ASHR((e - 1023) * 77, 8);
if (e >= 0) {
x = x / (LONGREAL)Reals_TenL(e);
} else {
@@ -1335,13 +1329,13 @@ void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER
x = 1.00000000000000e-001 * x;
e += 1;
}
- Reals_ConvertL(x, n, (void*)d, ((LONGINT)(16)));
+ Reals_ConvertL(x, n, (void*)d, 16);
n -= 1;
- Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(16)))]);
+ Texts_Write(&*W, W__typ, d[__X(n, 16)]);
Texts_Write(&*W, W__typ, '.');
do {
n -= 1;
- Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(16)))]);
+ Texts_Write(&*W, W__typ, d[__X(n, 16)]);
} while (!(n == 0));
Texts_Write(&*W, W__typ, 'D');
if (e < 0) {
@@ -1357,34 +1351,34 @@ void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER
}
}
-void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x)
+void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x)
{
- INTEGER i;
+ INT16 i;
CHAR d[16];
- Reals_ConvertHL(x, (void*)d, ((LONGINT)(16)));
+ Reals_ConvertHL(x, (void*)d, 16);
i = 0;
do {
- Texts_Write(&*W, W__typ, d[__X(i, ((LONGINT)(16)))]);
+ Texts_Write(&*W, W__typ, d[__X(i, 16)]);
i += 1;
} while (!(i == 16));
}
static struct WriteDate__43 {
Texts_Writer *W;
- LONGINT *W__typ;
+ ADDRESS *W__typ;
struct WriteDate__43 *lnk;
} *WriteDate__43_s;
-static void WritePair__44 (CHAR ch, LONGINT x);
+static void WritePair__44 (CHAR ch, INT32 x);
-static void WritePair__44 (CHAR ch, LONGINT x)
+static void WritePair__44 (CHAR ch, INT32 x)
{
Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, ch);
Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, (CHAR)(__DIV(x, 10) + 48));
- Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, (CHAR)(__MOD(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, LONGINT *W__typ, LONGINT t, LONGINT d)
+void Texts_WriteDate (Texts_Writer *W, ADDRESS *W__typ, INT32 t, INT32 d)
{
struct WriteDate__43 _s;
_s.W = W; _s.W__typ = W__typ;
@@ -1401,35 +1395,35 @@ void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d)
static struct Load0__16 {
Texts_Text *T;
- SHORTINT *ecnt;
+ INT8 *ecnt;
Files_File *f;
Texts_FileMsg *msg;
CHAR (*mods)[64][32], (*procs)[64][32];
struct Load0__16 *lnk;
} *Load0__16_s;
-static void LoadElem__17 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, LONGINT span, Texts_Elem *e);
+static void LoadElem__17 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, INT32 span, Texts_Elem *e);
-static void LoadElem__17 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, LONGINT span, Texts_Elem *e)
+static void LoadElem__17 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, INT32 span, Texts_Elem *e)
{
Modules_Module M = NIL;
Modules_Command Cmd;
Texts_Alien a = NIL;
- LONGINT org, ew, eh;
- SHORTINT eno;
+ INT32 org, ew, eh;
+ INT8 eno;
Texts_new = NIL;
Files_ReadLInt(&*r, r__typ, &ew);
Files_ReadLInt(&*r, r__typ, &eh);
Files_Read(&*r, r__typ, (void*)&eno);
if (eno > *Load0__16_s->ecnt) {
*Load0__16_s->ecnt = eno;
- Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32)));
- Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32)));
+ Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->mods)[__X(eno, 64)], 32);
+ Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->procs)[__X(eno, 64)], 32);
}
org = Files_Pos(&*r, r__typ);
- M = Modules_ThisMod((*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32)));
+ M = Modules_ThisMod((*Load0__16_s->mods)[__X(eno, 64)], 32);
if (M != NIL) {
- Cmd = Modules_ThisCommand(M, (*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32)));
+ Cmd = Modules_ThisCommand(M, (*Load0__16_s->procs)[__X(eno, 64)], 32);
if (Cmd != NIL) {
(*Cmd)();
}
@@ -1455,19 +1449,19 @@ static void LoadElem__17 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, LONGINT
a->file = *Load0__16_s->f;
a->org = org;
a->span = span;
- __COPY((*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], a->mod, ((LONGINT)(32)));
- __COPY((*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], a->proc, ((LONGINT)(32)));
+ __COPY((*Load0__16_s->mods)[__X(eno, 64)], a->mod, 32);
+ __COPY((*Load0__16_s->procs)[__X(eno, 64)], a->proc, 32);
*e = (Texts_Elem)a;
}
}
-static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
+static void Texts_Load0 (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
{
Texts_Run u = NIL, un = NIL;
Texts_Piece p = NIL;
Texts_Elem e = NIL;
- LONGINT org, pos, hlen, plen;
- SHORTINT ecnt, fno, fcnt, col, voff;
+ INT32 org, pos, hlen, plen;
+ INT8 ecnt, fcnt, fno, col, voff;
Files_File f = NIL;
Texts_FileMsg msg;
CHAR mods[64][32], procs[64][32];
@@ -1500,8 +1494,8 @@ static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
while (fno != 0) {
if (fno > fcnt) {
fcnt = fno;
- Files_ReadString(&msg.r, Files_Rider__typ, (void*)name, ((LONGINT)(32)));
- fnts[__X(fno, ((LONGINT)(32)))] = Texts_FontsThis((void*)name, ((LONGINT)(32)));
+ Files_ReadString(&msg.r, Files_Rider__typ, (void*)name, 32);
+ fnts[__X(fno, 32)] = Texts_FontsThis((void*)name, 32);
}
Files_Read(&msg.r, Files_Rider__typ, (void*)&col);
Files_Read(&msg.r, Files_Rider__typ, (void*)&voff);
@@ -1535,9 +1529,9 @@ static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
Load0__16_s = _s.lnk;
}
-void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
+void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
{
- INTEGER tag;
+ INT16 tag;
Files_ReadInt(&*r, r__typ, &tag);
if (tag != -4095) {
Files_Set(&*r, r__typ, Files_Base(&*r, r__typ), Files_Pos(&*r, r__typ) - 2);
@@ -1552,13 +1546,13 @@ void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len)
Texts_Run u = NIL;
Texts_Piece p = NIL;
CHAR tag, version;
- LONGINT hlen;
+ INT32 hlen;
__DUP(name, name__len, CHAR);
f = Files_Old(name, name__len);
if (f == NIL) {
- f = Files_New((CHAR*)"", (LONGINT)1);
+ f = Files_New((CHAR*)"", 1);
}
- Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(0)));
+ Files_Set(&r, Files_Rider__typ, f, 0);
Files_Read(&r, Files_Rider__typ, (void*)&tag);
Files_Read(&r, Files_Rider__typ, (void*)&version);
if (tag == 0xf0 || (tag == 0x01 && version == 0xf0)) {
@@ -1570,7 +1564,7 @@ void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len)
u->col = 15;
__NEW(p, Texts_PieceDesc);
if ((tag == 0xf7 && version == 0x07)) {
- Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(28)));
+ Files_Set(&r, Files_Rider__typ, f, 28);
Files_ReadLInt(&r, Files_Rider__typ, &hlen);
Files_Set(&r, Files_Rider__typ, f, 22 + hlen);
Files_ReadLInt(&r, Files_Rider__typ, &T->len);
@@ -1602,35 +1596,35 @@ void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len)
}
static struct Store__39 {
- SHORTINT *ecnt;
+ INT8 *ecnt;
Texts_FileMsg *msg;
Texts_IdentifyMsg *iden;
CHAR (*mods)[64][32], (*procs)[64][32];
struct Store__39 *lnk;
} *Store__39_s;
-static void StoreElem__40 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, Texts_Elem e);
+static void StoreElem__40 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, Texts_Elem e);
-static void StoreElem__40 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, Texts_Elem e)
+static void StoreElem__40 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, Texts_Elem e)
{
Files_Rider r1;
- LONGINT org, span;
- SHORTINT eno;
- __COPY((*Store__39_s->iden).mod, (*Store__39_s->mods)[__X(*Store__39_s->ecnt, ((LONGINT)(64)))], ((LONGINT)(32)));
- __COPY((*Store__39_s->iden).proc, (*Store__39_s->procs)[__X(*Store__39_s->ecnt, ((LONGINT)(64)))], ((LONGINT)(32)));
+ INT32 org, span;
+ INT8 eno;
+ __COPY((*Store__39_s->iden).mod, (*Store__39_s->mods)[__X(*Store__39_s->ecnt, 64)], 32);
+ __COPY((*Store__39_s->iden).proc, (*Store__39_s->procs)[__X(*Store__39_s->ecnt, 64)], 32);
eno = 1;
- while (__STRCMP((*Store__39_s->mods)[__X(eno, ((LONGINT)(64)))], (*Store__39_s->iden).mod) != 0 || __STRCMP((*Store__39_s->procs)[__X(eno, ((LONGINT)(64)))], (*Store__39_s->iden).proc) != 0) {
+ while (__STRCMP((*Store__39_s->mods)[__X(eno, 64)], (*Store__39_s->iden).mod) != 0 || __STRCMP((*Store__39_s->procs)[__X(eno, 64)], (*Store__39_s->iden).proc) != 0) {
eno += 1;
}
Files_Set(&r1, Files_Rider__typ, Files_Base(&*r, r__typ), Files_Pos(&*r, r__typ));
- Files_WriteLInt(&*r, r__typ, ((LONGINT)(0)));
- Files_WriteLInt(&*r, r__typ, ((LONGINT)(0)));
- Files_WriteLInt(&*r, r__typ, ((LONGINT)(0)));
+ Files_WriteLInt(&*r, r__typ, 0);
+ Files_WriteLInt(&*r, r__typ, 0);
+ Files_WriteLInt(&*r, r__typ, 0);
Files_Write(&*r, r__typ, eno);
if (eno == *Store__39_s->ecnt) {
*Store__39_s->ecnt += 1;
- Files_WriteString(&*r, r__typ, (*Store__39_s->iden).mod, ((LONGINT)(32)));
- Files_WriteString(&*r, r__typ, (*Store__39_s->iden).proc, ((LONGINT)(32)));
+ Files_WriteString(&*r, r__typ, (*Store__39_s->iden).mod, 32);
+ Files_WriteString(&*r, r__typ, (*Store__39_s->iden).proc, 32);
}
(*Store__39_s->msg).pos = pos;
org = Files_Pos(&*r, r__typ);
@@ -1641,14 +1635,15 @@ static void StoreElem__40 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, Texts_E
Files_WriteLInt(&r1, Files_Rider__typ, e->H);
}
-void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
+void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
{
Files_Rider r1;
Texts_Run u = NIL, un = NIL;
Texts_Elem e = NIL;
- LONGINT org, pos, delta, hlen, rlen;
- SHORTINT ecnt, fno, fcnt;
+ INT32 org, pos, delta, hlen, rlen;
+ INT8 ecnt, fcnt;
CHAR ch;
+ INT8 fno;
Texts_FileMsg msg;
Texts_IdentifyMsg iden;
CHAR mods[64][32], procs[64][32];
@@ -1665,7 +1660,7 @@ void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
org = Files_Pos(&*r, r__typ);
msg.id = 1;
msg.r = *r;
- Files_WriteLInt(&msg.r, Files_Rider__typ, ((LONGINT)(0)));
+ Files_WriteLInt(&msg.r, Files_Rider__typ, 0);
u = T->head->next;
pos = 0;
delta = 0;
@@ -1679,15 +1674,15 @@ void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
iden.mod[0] = 0x01;
}
if (iden.mod[0] != 0x00) {
- fnts[__X(fcnt, ((LONGINT)(32)))] = u->fnt;
+ fnts[__X(fcnt, 32)] = u->fnt;
fno = 1;
- while (__STRCMP(fnts[__X(fno, ((LONGINT)(32)))]->name, u->fnt->name) != 0) {
+ while (__STRCMP(fnts[__X(fno, 32)]->name, u->fnt->name) != 0) {
fno += 1;
}
Files_Write(&msg.r, Files_Rider__typ, fno);
if (fno == fcnt) {
fcnt += 1;
- Files_WriteString(&msg.r, Files_Rider__typ, u->fnt->name, ((LONGINT)(32)));
+ Files_WriteString(&msg.r, Files_Rider__typ, u->fnt->name, 32);
}
Files_Write(&msg.r, Files_Rider__typ, u->col);
Files_Write(&msg.r, Files_Rider__typ, u->voff);
@@ -1736,12 +1731,12 @@ void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
delta = ((Texts_Piece)u)->len;
while (delta > 1024) {
- Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), ((LONGINT)(1024)));
- Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), ((LONGINT)(1024)));
+ Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, 1024, 1024);
+ Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, 1024, 1024);
delta -= 1024;
}
- Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), delta);
- Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), delta);
+ Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, 1024, delta);
+ Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, 1024, delta);
}
} else __WITHCHK;
} else {
@@ -1755,7 +1750,7 @@ void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
}
__GUARDEQR(r, r__typ, Files_Rider) = msg.r;
if (T->notify != NIL) {
- (*T->notify)(T, 3, ((LONGINT)(0)), ((LONGINT)(0)));
+ (*T->notify)(T, 3, 0, 0);
}
Store__39_s = _s.lnk;
}
@@ -1764,11 +1759,11 @@ void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len)
{
Files_File f = NIL;
Files_Rider r;
- INTEGER i, res;
+ INT16 i, res;
CHAR bak[64];
__DUP(name, name__len, CHAR);
f = Files_New(name, name__len);
- Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(0)));
+ Files_Set(&r, Files_Rider__typ, f, 0);
Files_Write(&r, Files_Rider__typ, 0xf0);
Files_Write(&r, Files_Rider__typ, 0x01);
Texts_Store(&r, Files_Rider__typ, T);
@@ -1776,13 +1771,13 @@ void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len)
while (name[__X(i, name__len)] != 0x00) {
i += 1;
}
- __COPY(name, bak, ((LONGINT)(64)));
- bak[__X(i, ((LONGINT)(64)))] = '.';
- bak[__X(i + 1, ((LONGINT)(64)))] = 'B';
- bak[__X(i + 2, ((LONGINT)(64)))] = 'a';
- bak[__X(i + 3, ((LONGINT)(64)))] = 'k';
- bak[__X(i + 4, ((LONGINT)(64)))] = 0x00;
- Files_Rename(name, name__len, bak, ((LONGINT)(64)), &res);
+ __COPY(name, bak, 64);
+ bak[__X(i, 64)] = '.';
+ bak[__X(i + 1, 64)] = 'B';
+ bak[__X(i + 2, 64)] = 'a';
+ bak[__X(i + 3, 64)] = 'k';
+ bak[__X(i + 4, 64)] = 0x00;
+ Files_Rename(name, name__len, bak, 64, &res);
Files_Register(f);
__DEL(name);
}
diff --git a/bootstrap/unix-48/Texts.h b/bootstrap/unix-48/Texts.h
index 632b644a..e2c03958 100644
--- a/bootstrap/unix-48/Texts.h
+++ b/bootstrap/unix-48/Texts.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Texts__h
#define Texts__h
@@ -8,7 +8,7 @@
typedef
struct Texts_BufDesc {
- LONGINT len;
+ INT32 len;
char _prvt0[4];
} Texts_BufDesc;
@@ -30,25 +30,25 @@ typedef
typedef
struct Texts_RunDesc {
- LONGINT _prvt0;
+ INT32 _prvt0;
char _prvt1[15];
} Texts_RunDesc;
typedef
- void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, LONGINT *);
+ void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, ADDRESS *);
typedef
struct Texts_ElemDesc {
char _prvt0[20];
- LONGINT W, H;
+ INT32 W, H;
Texts_Handler handle;
char _prvt1[4];
} Texts_ElemDesc;
typedef
struct Texts_FileMsg { /* Texts_ElemMsg */
- INTEGER id;
- LONGINT pos;
+ INT16 id;
+ INT32 pos;
Files_Rider r;
} Texts_FileMsg;
@@ -69,13 +69,13 @@ typedef
struct Texts_TextDesc *Texts_Text;
typedef
- void (*Texts_Notifier)(Texts_Text, INTEGER, LONGINT, LONGINT);
+ void (*Texts_Notifier)(Texts_Text, INT16, INT32, INT32);
typedef
struct Texts_Reader {
BOOLEAN eot;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
Texts_Elem elem;
char _prvt0[32];
} Texts_Reader;
@@ -84,23 +84,23 @@ typedef
struct Texts_Scanner { /* Texts_Reader */
BOOLEAN eot;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
Texts_Elem elem;
- LONGREAL _prvt0;
+ INT64 _prvt0;
char _prvt1[24];
CHAR nextCh;
- INTEGER line, class;
- LONGINT i;
+ INT16 line, class;
+ INT32 i;
REAL x;
LONGREAL y;
CHAR c;
- SHORTINT len;
+ INT8 len;
CHAR s[64];
} Texts_Scanner;
typedef
struct Texts_TextDesc {
- LONGINT len;
+ INT32 len;
Texts_Notifier notify;
char _prvt0[12];
} Texts_TextDesc;
@@ -109,65 +109,65 @@ typedef
struct Texts_Writer {
Texts_Buffer buf;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
char _prvt0[26];
} Texts_Writer;
import Texts_Elem Texts_new;
-import LONGINT *Texts_FontDesc__typ;
-import LONGINT *Texts_RunDesc__typ;
-import LONGINT *Texts_ElemMsg__typ;
-import LONGINT *Texts_ElemDesc__typ;
-import LONGINT *Texts_FileMsg__typ;
-import LONGINT *Texts_CopyMsg__typ;
-import LONGINT *Texts_IdentifyMsg__typ;
-import LONGINT *Texts_BufDesc__typ;
-import LONGINT *Texts_TextDesc__typ;
-import LONGINT *Texts_Reader__typ;
-import LONGINT *Texts_Scanner__typ;
-import LONGINT *Texts_Writer__typ;
+import ADDRESS *Texts_FontDesc__typ;
+import ADDRESS *Texts_RunDesc__typ;
+import ADDRESS *Texts_ElemMsg__typ;
+import ADDRESS *Texts_ElemDesc__typ;
+import ADDRESS *Texts_FileMsg__typ;
+import ADDRESS *Texts_CopyMsg__typ;
+import ADDRESS *Texts_IdentifyMsg__typ;
+import ADDRESS *Texts_BufDesc__typ;
+import ADDRESS *Texts_TextDesc__typ;
+import ADDRESS *Texts_Reader__typ;
+import ADDRESS *Texts_Scanner__typ;
+import ADDRESS *Texts_Writer__typ;
import void Texts_Append (Texts_Text T, Texts_Buffer B);
-import void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff);
+import void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff);
import void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
import void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
import void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
-import void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end);
+import void Texts_Delete (Texts_Text T, INT32 beg, INT32 end);
import Texts_Text Texts_ElemBase (Texts_Elem E);
-import LONGINT Texts_ElemPos (Texts_Elem E);
-import void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B);
-import void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T);
+import INT32 Texts_ElemPos (Texts_Elem E);
+import void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B);
+import void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
import void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
import void Texts_OpenBuf (Texts_Buffer B);
-import void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos);
-import void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos);
-import void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ);
-import LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ);
-import void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch);
-import void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ);
-import void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ);
+import void Texts_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);
+import void Texts_OpenWriter (Texts_Writer *W, ADDRESS *W__typ);
+import INT32 Texts_Pos (Texts_Reader *R, ADDRESS *R__typ);
+import void Texts_Read (Texts_Reader *R, ADDRESS *R__typ, CHAR *ch);
+import void Texts_ReadElem (Texts_Reader *R, ADDRESS *R__typ);
+import void Texts_ReadPrevElem (Texts_Reader *R, ADDRESS *R__typ);
import void Texts_Recall (Texts_Buffer *B);
-import void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B);
-import void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ);
-import void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col);
-import void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt);
-import void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff);
-import void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T);
-import void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch);
-import void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d);
-import void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e);
-import void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x);
-import void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n);
-import void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ);
-import void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n);
-import void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x);
-import void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n);
-import void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k);
-import void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x);
-import void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len);
+import void Texts_Save (Texts_Text T, INT32 beg, INT32 end, Texts_Buffer B);
+import void Texts_Scan (Texts_Scanner *S, ADDRESS *S__typ);
+import void Texts_SetColor (Texts_Writer *W, ADDRESS *W__typ, INT8 col);
+import void Texts_SetFont (Texts_Writer *W, ADDRESS *W__typ, Texts_FontsFont fnt);
+import void Texts_SetOffset (Texts_Writer *W, ADDRESS *W__typ, INT8 voff);
+import void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
+import void Texts_Write (Texts_Writer *W, ADDRESS *W__typ, CHAR ch);
+import void Texts_WriteDate (Texts_Writer *W, ADDRESS *W__typ, INT32 t, INT32 d);
+import void Texts_WriteElem (Texts_Writer *W, ADDRESS *W__typ, Texts_Elem e);
+import void Texts_WriteHex (Texts_Writer *W, ADDRESS *W__typ, INT32 x);
+import void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n);
+import void Texts_WriteLn (Texts_Writer *W, ADDRESS *W__typ);
+import void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n);
+import void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x);
+import void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n);
+import void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k);
+import void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x);
+import void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
import void *Texts__init(void);
-#endif
+#endif // Texts
diff --git a/bootstrap/unix-48/VT100.c b/bootstrap/unix-48/VT100.c
new file mode 100644
index 00000000..f69fd90e
--- /dev/null
+++ b/bootstrap/unix-48/VT100.c
@@ -0,0 +1,264 @@
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
+#include "SYSTEM.h"
+#include "Out.h"
+#include "Strings.h"
+
+
+export CHAR VT100_CSI[5];
+static CHAR VT100_tmpstr[32];
+
+
+export void VT100_CHA (INT16 n);
+export void VT100_CNL (INT16 n);
+export void VT100_CPL (INT16 n);
+export void VT100_CUB (INT16 n);
+export void VT100_CUD (INT16 n);
+export void VT100_CUF (INT16 n);
+export void VT100_CUP (INT16 n, INT16 m);
+export void VT100_CUU (INT16 n);
+export void VT100_DECTCEMh (void);
+export void VT100_DECTCEMl (void);
+export void VT100_DSR (INT16 n);
+export void VT100_ED (INT16 n);
+export void VT100_EL (INT16 n);
+static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len);
+static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len);
+static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len);
+static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len);
+export void VT100_HVP (INT16 n, INT16 m);
+export void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len);
+export void VT100_RCP (void);
+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, LONGINT attr__len);
+
+
+static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end)
+{
+ CHAR h;
+ while (start < end) {
+ h = str[__X(start, str__len)];
+ str[__X(start, str__len)] = str[__X(end, str__len)];
+ str[__X(end, str__len)] = h;
+ start += 1;
+ end -= 1;
+ }
+}
+
+void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len)
+{
+ CHAR b[21];
+ INT16 s, e;
+ INT8 maxLength;
+ maxLength = 11;
+ if (int_ == (-2147483647-1)) {
+ __MOVE("-2147483648", b, 12);
+ e = 11;
+ } else {
+ if (int_ < 0) {
+ b[0] = '-';
+ int_ = -int_;
+ s = 1;
+ } else {
+ s = 0;
+ }
+ e = s;
+ do {
+ b[__X(e, 21)] = (CHAR)((int)__MOD(int_, 10) + 48);
+ int_ = __DIV(int_, 10);
+ e += 1;
+ } while (!(int_ == 0));
+ b[__X(e, 21)] = 0x00;
+ VT100_Reverse0((void*)b, 21, s, e - 1);
+ }
+ __COPY(b, str, str__len);
+}
+
+static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len)
+{
+ CHAR cmd[9];
+ __DUP(letter, letter__len, CHAR);
+ __COPY(VT100_CSI, cmd, 9);
+ Strings_Append(letter, letter__len, (void*)cmd, 9);
+ Out_String(cmd, 9);
+ __DEL(letter);
+}
+
+static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len)
+{
+ CHAR nstr[2];
+ CHAR cmd[7];
+ __DUP(letter, letter__len, CHAR);
+ VT100_IntToStr(n, (void*)nstr, 2);
+ __COPY(VT100_CSI, cmd, 7);
+ Strings_Append(nstr, 2, (void*)cmd, 7);
+ Strings_Append(letter, letter__len, (void*)cmd, 7);
+ Out_String(cmd, 7);
+ __DEL(letter);
+}
+
+static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len)
+{
+ CHAR nstr[2];
+ CHAR cmd[7];
+ __DUP(letter, letter__len, CHAR);
+ VT100_IntToStr(n, (void*)nstr, 2);
+ __COPY(VT100_CSI, cmd, 7);
+ Strings_Append(letter, letter__len, (void*)cmd, 7);
+ Strings_Append(nstr, 2, (void*)cmd, 7);
+ Out_String(cmd, 7);
+ __DEL(letter);
+}
+
+static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len)
+{
+ CHAR nstr[5], mstr[5];
+ CHAR cmd[12];
+ __DUP(letter, letter__len, CHAR);
+ VT100_IntToStr(n, (void*)nstr, 5);
+ VT100_IntToStr(m, (void*)mstr, 5);
+ __COPY(VT100_CSI, cmd, 12);
+ Strings_Append(nstr, 5, (void*)cmd, 12);
+ Strings_Append((CHAR*)";", 2, (void*)cmd, 12);
+ Strings_Append(mstr, 5, (void*)cmd, 12);
+ Strings_Append(letter, letter__len, (void*)cmd, 12);
+ Out_String(cmd, 12);
+ __DEL(letter);
+}
+
+void VT100_CUU (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"A", 2);
+}
+
+void VT100_CUD (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"B", 2);
+}
+
+void VT100_CUF (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"C", 2);
+}
+
+void VT100_CUB (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"D", 2);
+}
+
+void VT100_CNL (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"E", 2);
+}
+
+void VT100_CPL (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"F", 2);
+}
+
+void VT100_CHA (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"G", 2);
+}
+
+void VT100_CUP (INT16 n, INT16 m)
+{
+ VT100_EscSeq2(n, m, (CHAR*)"H", 2);
+}
+
+void VT100_ED (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"J", 2);
+}
+
+void VT100_EL (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"K", 2);
+}
+
+void VT100_SU (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"S", 2);
+}
+
+void VT100_SD (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"T", 2);
+}
+
+void VT100_HVP (INT16 n, INT16 m)
+{
+ VT100_EscSeq2(n, m, (CHAR*)"f", 2);
+}
+
+void VT100_SGR (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"m", 2);
+}
+
+void VT100_SGR2 (INT16 n, INT16 m)
+{
+ VT100_EscSeq2(n, m, (CHAR*)"m", 2);
+}
+
+void VT100_DSR (INT16 n)
+{
+ VT100_EscSeq(6, (CHAR*)"n", 2);
+}
+
+void VT100_SCP (void)
+{
+ VT100_EscSeq0((CHAR*)"s", 2);
+}
+
+void VT100_RCP (void)
+{
+ VT100_EscSeq0((CHAR*)"u", 2);
+}
+
+void VT100_DECTCEMl (void)
+{
+ VT100_EscSeq0((CHAR*)"\?25l", 5);
+}
+
+void VT100_DECTCEMh (void)
+{
+ VT100_EscSeq0((CHAR*)"\?25h", 5);
+}
+
+void VT100_SetAttr (CHAR *attr, LONGINT attr__len)
+{
+ CHAR tmpstr[16];
+ __DUP(attr, attr__len, CHAR);
+ __COPY(VT100_CSI, tmpstr, 16);
+ Strings_Append(attr, attr__len, (void*)tmpstr, 16);
+ Out_String(tmpstr, 16);
+ __DEL(attr);
+}
+
+
+export void *VT100__init(void)
+{
+ __DEFMOD;
+ __MODULE_IMPORT(Out);
+ __MODULE_IMPORT(Strings);
+ __REGMOD("VT100", 0);
+ __REGCMD("DECTCEMh", VT100_DECTCEMh);
+ __REGCMD("DECTCEMl", VT100_DECTCEMl);
+ __REGCMD("RCP", VT100_RCP);
+ __REGCMD("SCP", VT100_SCP);
+/* BEGIN */
+ __COPY("\033", VT100_CSI, 5);
+ Strings_Append((CHAR*)"[", 2, (void*)VT100_CSI, 5);
+ __ENDMOD;
+}
diff --git a/bootstrap/unix-48/VT100.h b/bootstrap/unix-48/VT100.h
new file mode 100644
index 00000000..d99406ec
--- /dev/null
+++ b/bootstrap/unix-48/VT100.h
@@ -0,0 +1,37 @@
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#ifndef VT100__h
+#define VT100__h
+
+#include "SYSTEM.h"
+
+
+import CHAR VT100_CSI[5];
+
+
+import void VT100_CHA (INT16 n);
+import void VT100_CNL (INT16 n);
+import void VT100_CPL (INT16 n);
+import void VT100_CUB (INT16 n);
+import void VT100_CUD (INT16 n);
+import void VT100_CUF (INT16 n);
+import void VT100_CUP (INT16 n, INT16 m);
+import void VT100_CUU (INT16 n);
+import void VT100_DECTCEMh (void);
+import void VT100_DECTCEMl (void);
+import void VT100_DSR (INT16 n);
+import void VT100_ED (INT16 n);
+import void VT100_EL (INT16 n);
+import void VT100_HVP (INT16 n, INT16 m);
+import void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len);
+import void VT100_RCP (void);
+import void VT100_SCP (void);
+import void VT100_SD (INT16 n);
+import void VT100_SGR (INT16 n);
+import void VT100_SGR2 (INT16 n, INT16 m);
+import void VT100_SU (INT16 n);
+import void VT100_SetAttr (CHAR *attr, LONGINT attr__len);
+import void *VT100__init(void);
+
+
+#endif // VT100
diff --git a/bootstrap/unix-48/Vishap.c b/bootstrap/unix-48/Vishap.c
deleted file mode 100644
index 4c9e3b45..00000000
--- a/bootstrap/unix-48/Vishap.c
+++ /dev/null
@@ -1,168 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkamSf */
-#include "SYSTEM.h"
-#include "Configuration.h"
-#include "Heap.h"
-#include "OPB.h"
-#include "OPC.h"
-#include "OPM.h"
-#include "OPP.h"
-#include "OPT.h"
-#include "OPV.h"
-#include "Platform.h"
-#include "Strings.h"
-#include "extTools.h"
-#include "vt100.h"
-
-
-static CHAR Vishap_mname[256];
-
-
-export void Vishap_Module (BOOLEAN *done);
-static void Vishap_PropagateElementaryTypeSizes (void);
-export void Vishap_Translate (void);
-static void Vishap_Trap (INTEGER sig);
-
-
-void Vishap_Module (BOOLEAN *done)
-{
- BOOLEAN ext, new;
- OPT_Node p = NIL;
- OPP_Module(&p, OPM_opt);
- if (OPM_noerr) {
- OPV_Init();
- OPV_AdrAndSize(OPT_topScope);
- OPT_Export(&ext, &new);
- if (OPM_noerr) {
- OPM_OpenFiles((void*)OPT_SelfName, ((LONGINT)(256)));
- OPC_Init();
- OPV_Module(p);
- if (OPM_noerr) {
- if (((OPM_mainProg || OPM_mainLinkStat) && __STRCMP(OPM_modName, "SYSTEM") != 0)) {
- OPM_DeleteNewSym();
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"32m", (LONGINT)4);
- }
- OPM_LogWStr((CHAR*)" Main program.", (LONGINT)16);
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"0m", (LONGINT)3);
- }
- } else {
- if (new) {
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"32m", (LONGINT)4);
- }
- OPM_LogWStr((CHAR*)" New symbol file.", (LONGINT)19);
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"0m", (LONGINT)3);
- }
- OPM_RegisterNewSym();
- } else if (ext) {
- OPM_LogWStr((CHAR*)" Extended symbol file.", (LONGINT)24);
- OPM_RegisterNewSym();
- }
- }
- } else {
- OPM_DeleteNewSym();
- }
- }
- }
- OPM_CloseFiles();
- OPT_Close();
- OPM_LogWLn();
- *done = OPM_noerr;
-}
-
-static void Vishap_PropagateElementaryTypeSizes (void)
-{
- OPT_bytetyp->size = OPM_ByteSize;
- OPT_sysptrtyp->size = OPM_PointerSize;
- OPT_chartyp->size = OPM_CharSize;
- OPT_settyp->size = OPM_SetSize;
- OPT_realtyp->size = OPM_RealSize;
- OPT_inttyp->size = OPM_IntSize;
- OPT_linttyp->size = OPM_LIntSize;
- OPT_lrltyp->size = OPM_LRealSize;
- OPT_sinttyp->size = OPM_SIntSize;
- OPT_booltyp->size = OPM_BoolSize;
-}
-
-void Vishap_Translate (void)
-{
- BOOLEAN done;
- CHAR modulesobj[2048];
- modulesobj[0] = 0x00;
- if (OPM_OpenPar()) {
- for (;;) {
- OPM_Init(&done, (void*)Vishap_mname, ((LONGINT)(256)));
- if (!done) {
- return;
- }
- OPM_InitOptions();
- Vishap_PropagateElementaryTypeSizes();
- Heap_GC(0);
- Vishap_Module(&done);
- if (!done) {
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Module compilation failed.", (LONGINT)27);
- OPM_LogWLn();
- Platform_Exit(1);
- }
- if (!OPM_dontAsm) {
- if (OPM_dontLink) {
- extTools_Assemble(OPM_modName, ((LONGINT)(32)));
- } else {
- if (!(OPM_mainProg || OPM_mainLinkStat)) {
- extTools_Assemble(OPM_modName, ((LONGINT)(32)));
- Strings_Append((CHAR*)" ", (LONGINT)2, (void*)modulesobj, ((LONGINT)(2048)));
- Strings_Append(OPM_modName, ((LONGINT)(32)), (void*)modulesobj, ((LONGINT)(2048)));
- Strings_Append((CHAR*)".o", (LONGINT)3, (void*)modulesobj, ((LONGINT)(2048)));
- } else {
- extTools_LinkMain((void*)OPM_modName, ((LONGINT)(32)), OPM_mainLinkStat, modulesobj, ((LONGINT)(2048)));
- }
- }
- }
- }
- }
-}
-
-static void Vishap_Trap (INTEGER sig)
-{
- Heap_FINALL();
- if (sig == 3) {
- Platform_Exit(0);
- } else {
- if ((sig == 4 && Platform_HaltCode == -15)) {
- OPM_LogWStr((CHAR*)" --- Vishap Oberon: internal error", (LONGINT)35);
- OPM_LogWLn();
- }
- Platform_Exit(2);
- }
-}
-
-
-export int main(int argc, char **argv)
-{
- __INIT(argc, argv);
- __MODULE_IMPORT(Configuration);
- __MODULE_IMPORT(Heap);
- __MODULE_IMPORT(OPB);
- __MODULE_IMPORT(OPC);
- __MODULE_IMPORT(OPM);
- __MODULE_IMPORT(OPP);
- __MODULE_IMPORT(OPT);
- __MODULE_IMPORT(OPV);
- __MODULE_IMPORT(Platform);
- __MODULE_IMPORT(Strings);
- __MODULE_IMPORT(extTools);
- __MODULE_IMPORT(vt100);
- __REGMAIN("Vishap", 0);
- __REGCMD("Translate", Vishap_Translate);
-/* BEGIN */
- Platform_SetInterruptHandler(Vishap_Trap);
- Platform_SetQuitHandler(Vishap_Trap);
- Platform_SetBadInstructionHandler(Vishap_Trap);
- OPB_typSize = OPV_TypSize;
- OPT_typSize = OPV_TypSize;
- Vishap_Translate();
- __FINI;
-}
diff --git a/bootstrap/unix-48/errors.c b/bootstrap/unix-48/errors.c
deleted file mode 100644
index 68e433df..00000000
--- a/bootstrap/unix-48/errors.c
+++ /dev/null
@@ -1,199 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#include "SYSTEM.h"
-
-typedef
- CHAR errors_string[128];
-
-
-export errors_string errors_errors[350];
-
-
-
-
-
-export void *errors__init(void)
-{
- __DEFMOD;
- __REGMOD("errors", 0);
-/* BEGIN */
- __MOVE("undeclared identifier", errors_errors[0], 22);
- __MOVE("multiply defined identifier", errors_errors[1], 28);
- __MOVE("illegal character in number", errors_errors[2], 28);
- __MOVE("illegal character in string", errors_errors[3], 28);
- __MOVE("identifier does not match procedure name", errors_errors[4], 41);
- __MOVE("comment not closed", errors_errors[5], 19);
- errors_errors[6][0] = 0x00;
- errors_errors[7][0] = 0x00;
- errors_errors[8][0] = 0x00;
- __MOVE("'=' expected", errors_errors[9], 13);
- errors_errors[10][0] = 0x00;
- errors_errors[11][0] = 0x00;
- __MOVE("type definition starts with incorrect symbol", errors_errors[12], 45);
- __MOVE("factor starts with incorrect symbol", errors_errors[13], 36);
- __MOVE("statement starts with incorrect symbol", errors_errors[14], 39);
- __MOVE("declaration followed by incorrect symbol", errors_errors[15], 41);
- __MOVE("MODULE expected", errors_errors[16], 16);
- errors_errors[17][0] = 0x00;
- __MOVE("'.' missing", errors_errors[18], 12);
- __MOVE("',' missing", errors_errors[19], 12);
- __MOVE("':' missing", errors_errors[20], 12);
- errors_errors[21][0] = 0x00;
- __MOVE("')' missing", errors_errors[22], 12);
- __MOVE("']' missing", errors_errors[23], 12);
- __MOVE("'}' missing", errors_errors[24], 12);
- __MOVE("OF missing", errors_errors[25], 11);
- __MOVE("THEN missing", errors_errors[26], 13);
- __MOVE("DO missing", errors_errors[27], 11);
- __MOVE("TO missing", errors_errors[28], 11);
- errors_errors[29][0] = 0x00;
- __MOVE("'(' missing", errors_errors[30], 12);
- errors_errors[31][0] = 0x00;
- errors_errors[32][0] = 0x00;
- errors_errors[33][0] = 0x00;
- __MOVE("':=' missing", errors_errors[34], 13);
- __MOVE("',' or OF expected", errors_errors[35], 19);
- errors_errors[36][0] = 0x00;
- errors_errors[37][0] = 0x00;
- __MOVE("identifier expected", errors_errors[38], 20);
- __MOVE("';' missing", errors_errors[39], 12);
- errors_errors[40][0] = 0x00;
- __MOVE("END missing", errors_errors[41], 12);
- errors_errors[42][0] = 0x00;
- errors_errors[43][0] = 0x00;
- __MOVE("UNTIL missing", errors_errors[44], 14);
- errors_errors[45][0] = 0x00;
- __MOVE("EXIT not within loop statement", errors_errors[46], 31);
- __MOVE("illegally marked identifier", errors_errors[47], 28);
- errors_errors[48][0] = 0x00;
- errors_errors[49][0] = 0x00;
- __MOVE("expression should be constant", errors_errors[50], 30);
- __MOVE("constant not an integer", errors_errors[51], 24);
- __MOVE("identifier does not denote a type", errors_errors[52], 34);
- __MOVE("identifier does not denote a record type", errors_errors[53], 41);
- __MOVE("result type of procedure is not a basic type", errors_errors[54], 45);
- __MOVE("procedure call of a function", errors_errors[55], 29);
- __MOVE("assignment to non-variable", errors_errors[56], 27);
- __MOVE("pointer not bound to record or array type", errors_errors[57], 42);
- __MOVE("recursive type definition", errors_errors[58], 26);
- __MOVE("illegal open array parameter", errors_errors[59], 29);
- __MOVE("wrong type of case label", errors_errors[60], 25);
- __MOVE("inadmissible type of case label", errors_errors[61], 32);
- __MOVE("case label defined more than once", errors_errors[62], 34);
- __MOVE("illegal value of constant", errors_errors[63], 26);
- __MOVE("more actual than formal parameters", errors_errors[64], 35);
- __MOVE("fewer actual than formal parameters", errors_errors[65], 36);
- __MOVE("element types of actual array and formal open array differ", errors_errors[66], 59);
- __MOVE("actual parameter corresponding to open array is not an array", errors_errors[67], 61);
- __MOVE("control variable must be integer", errors_errors[68], 33);
- __MOVE("parameter must be an integer constant", errors_errors[69], 38);
- __MOVE("pointer or VAR record required as formal receiver", errors_errors[70], 50);
- __MOVE("pointer expected as actual receiver", errors_errors[71], 36);
- __MOVE("procedure must be bound to a record of the same scope", errors_errors[72], 54);
- __MOVE("procedure must have level 0", errors_errors[73], 28);
- __MOVE("procedure unknown in base type", errors_errors[74], 31);
- __MOVE("invalid call of base procedure", errors_errors[75], 31);
- __MOVE("this variable (field) is read only", errors_errors[76], 35);
- __MOVE("object is not a record", errors_errors[77], 23);
- __MOVE("dereferenced object is not a variable", errors_errors[78], 38);
- __MOVE("indexed object is not a variable", errors_errors[79], 33);
- __MOVE("index expression is not an integer", errors_errors[80], 35);
- __MOVE("index out of specified bounds", errors_errors[81], 30);
- __MOVE("indexed variable is not an array", errors_errors[82], 33);
- __MOVE("undefined record field", errors_errors[83], 23);
- __MOVE("dereferenced variable is not a pointer", errors_errors[84], 39);
- __MOVE("guard or test type is not an extension of variable type", errors_errors[85], 56);
- __MOVE("guard or testtype is not a pointer", errors_errors[86], 35);
- __MOVE("guarded or tested variable is neither a pointer nor a VAR-parameter record", errors_errors[87], 75);
- __MOVE("open array not allowed as variable, record field or array element", errors_errors[88], 66);
- errors_errors[89][0] = 0x00;
- errors_errors[90][0] = 0x00;
- errors_errors[91][0] = 0x00;
- __MOVE("operand of IN not an integer, or not a set", errors_errors[92], 43);
- __MOVE("set element type is not an integer", errors_errors[93], 35);
- __MOVE("operand of & is not of type BOOLEAN", errors_errors[94], 36);
- __MOVE("operand of OR is not of type BOOLEAN", errors_errors[95], 37);
- __MOVE("operand not applicable to (unary) +", errors_errors[96], 36);
- __MOVE("operand not applicable to (unary) -", errors_errors[97], 36);
- __MOVE("operand of ~ is not of type BOOLEAN", errors_errors[98], 36);
- __MOVE("ASSERT fault", errors_errors[99], 13);
- __MOVE("incompatible operands of dyadic operator", errors_errors[100], 41);
- __MOVE("operand type inapplicable to *", errors_errors[101], 31);
- __MOVE("operand type inapplicable to /", errors_errors[102], 31);
- __MOVE("operand type inapplicable to DIV", errors_errors[103], 33);
- __MOVE("operand type inapplicable to MOD", errors_errors[104], 33);
- __MOVE("operand type inapplicable to +", errors_errors[105], 31);
- __MOVE("operand type inapplicable to -", errors_errors[106], 31);
- __MOVE("operand type inapplicable to = or #", errors_errors[107], 36);
- __MOVE("operand type inapplicable to relation", errors_errors[108], 38);
- __MOVE("overriding method must be exported", errors_errors[109], 35);
- __MOVE("operand is not a type", errors_errors[110], 22);
- __MOVE("operand inapplicable to (this) function", errors_errors[111], 40);
- __MOVE("operand is not a variable", errors_errors[112], 26);
- __MOVE("incompatible assignment", errors_errors[113], 24);
- __MOVE("string too long to be assigned", errors_errors[114], 31);
- __MOVE("parameter doesn't match", errors_errors[115], 24);
- __MOVE("number of parameters doesn't match", errors_errors[116], 35);
- __MOVE("result type doesn't match", errors_errors[117], 26);
- __MOVE("export mark doesn't match with forward declaration", errors_errors[118], 51);
- __MOVE("redefinition textually precedes procedure bound to base type", errors_errors[119], 61);
- __MOVE("type of expression following IF, WHILE, UNTIL or ASSERT is not BOOLEAN", errors_errors[120], 71);
- __MOVE("called object is not a procedure (or is an interrupt procedure)", errors_errors[121], 64);
- __MOVE("actual VAR-parameter is not a variable", errors_errors[122], 39);
- __MOVE("type of actual parameter is not identical with that of formal VAR-parameter", errors_errors[123], 76);
- __MOVE("type of result expression differs from that of procedure", errors_errors[124], 57);
- __MOVE("type of case expression is neither INTEGER nor CHAR", errors_errors[125], 52);
- __MOVE("this expression cannot be a type or a procedure", errors_errors[126], 48);
- __MOVE("illegal use of object", errors_errors[127], 22);
- __MOVE("unsatisfied forward reference", errors_errors[128], 30);
- __MOVE("unsatisfied forward procedure", errors_errors[129], 30);
- __MOVE("WITH clause does not specify a variable", errors_errors[130], 40);
- __MOVE("LEN not applied to array", errors_errors[131], 25);
- __MOVE("dimension in LEN too large or negative", errors_errors[132], 39);
- __MOVE("SYSTEM not imported", errors_errors[135], 20);
- __MOVE("key inconsistency of imported module", errors_errors[150], 37);
- __MOVE("incorrect symbol file", errors_errors[151], 22);
- __MOVE("symbol file of imported module not found", errors_errors[152], 41);
- __MOVE("object or symbol file not opened (disk full\?)", errors_errors[153], 46);
- __MOVE("recursive import not allowed", errors_errors[154], 29);
- __MOVE("generation of new symbol file not allowed", errors_errors[155], 42);
- __MOVE("parameter file not found", errors_errors[156], 25);
- __MOVE("syntax error in parameter file", errors_errors[157], 31);
- __MOVE("not yet implemented", errors_errors[200], 20);
- __MOVE("lower bound of set range greater than higher bound", errors_errors[201], 51);
- __MOVE("set element greater than MAX(SET) or less than 0", errors_errors[202], 49);
- __MOVE("number too large", errors_errors[203], 17);
- __MOVE("product too large", errors_errors[204], 18);
- __MOVE("division by zero", errors_errors[205], 17);
- __MOVE("sum too large", errors_errors[206], 14);
- __MOVE("difference too large", errors_errors[207], 21);
- __MOVE("overflow in arithmetic shift", errors_errors[208], 29);
- __MOVE("case range too large", errors_errors[209], 21);
- __MOVE("too many cases in case statement", errors_errors[213], 33);
- __MOVE("illegal value of parameter (0 <= p < 256)", errors_errors[218], 42);
- __MOVE("machine registers cannot be accessed", errors_errors[219], 37);
- __MOVE("illegal value of parameter", errors_errors[220], 27);
- __MOVE("too many pointers in a record", errors_errors[221], 30);
- __MOVE("too many global pointers", errors_errors[222], 25);
- __MOVE("too many record types", errors_errors[223], 22);
- __MOVE("too many pointer types", errors_errors[224], 23);
- __MOVE("address of pointer variable too large (move forward in text)", errors_errors[225], 61);
- __MOVE("too many exported procedures", errors_errors[226], 29);
- __MOVE("too many imported modules", errors_errors[227], 26);
- __MOVE("too many exported structures", errors_errors[228], 29);
- __MOVE("too many nested records for import", errors_errors[229], 35);
- __MOVE("too many constants (strings) in module", errors_errors[230], 39);
- __MOVE("too many link table entries (external procedures)", errors_errors[231], 50);
- __MOVE("too many commands in module", errors_errors[232], 28);
- __MOVE("record extension hierarchy too high", errors_errors[233], 36);
- __MOVE("export of recursive type not allowed", errors_errors[234], 37);
- __MOVE("identifier too long", errors_errors[240], 20);
- __MOVE("string too long", errors_errors[241], 16);
- __MOVE("address overflow", errors_errors[242], 17);
- __MOVE("cyclic type definition not allowed", errors_errors[244], 35);
- __MOVE("guarded pointer variable may be manipulated by non-local operations; use auxiliary pointer variable", errors_errors[245], 100);
- __MOVE("implicit type cast", errors_errors[301], 19);
- __MOVE("inappropriate symbol file ignored", errors_errors[306], 34);
- __MOVE("no ELSE symbol after CASE statement sequence may lead to trap", errors_errors[307], 62);
- __MOVE("SYSTEM.VAL result includes memory past end of source variable", errors_errors[308], 62);
- __ENDMOD;
-}
diff --git a/bootstrap/unix-48/errors.h b/bootstrap/unix-48/errors.h
deleted file mode 100644
index 41d399ad..00000000
--- a/bootstrap/unix-48/errors.h
+++ /dev/null
@@ -1,18 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-
-#ifndef errors__h
-#define errors__h
-
-#include "SYSTEM.h"
-
-typedef
- CHAR errors_string[128];
-
-
-import errors_string errors_errors[350];
-
-
-import void *errors__init(void);
-
-
-#endif
diff --git a/bootstrap/unix-48/extTools.c b/bootstrap/unix-48/extTools.c
index 4efd107a..37630d23 100644
--- a/bootstrap/unix-48/extTools.c
+++ b/bootstrap/unix-48/extTools.c
@@ -1,29 +1,37 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "Configuration.h"
-#include "Console.h"
+#include "Modules.h"
#include "OPM.h"
+#include "Out.h"
#include "Platform.h"
#include "Strings.h"
-static CHAR extTools_compilationOptions[1023], extTools_CFLAGS[1023];
+static CHAR extTools_CFLAGS[1023];
export void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len);
+static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT s__len);
export void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len);
static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len);
static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len)
{
- INTEGER r, status, exitcode;
+ INT16 r, status, exitcode;
__DUP(title, title__len, CHAR);
__DUP(cmd, cmd__len, CHAR);
- if (OPM_Verbose) {
- Console_String(title, title__len);
- Console_String(cmd, cmd__len);
- Console_Ln();
+ if (__IN(18, OPM_Options, 32)) {
+ Out_String(title, title__len);
+ Out_String(cmd, cmd__len);
+ Out_Ln();
}
r = Platform_System(cmd, cmd__len);
status = __MASK(r, -128);
@@ -32,39 +40,49 @@ static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGIN
exitcode = exitcode - 256;
}
if (r != 0) {
- Console_String(title, title__len);
- Console_String(cmd, cmd__len);
- Console_Ln();
- Console_String((CHAR*)"-- failed: status ", (LONGINT)19);
- Console_Int(status, ((LONGINT)(1)));
- Console_String((CHAR*)", exitcode ", (LONGINT)12);
- Console_Int(exitcode, ((LONGINT)(1)));
- Console_String((CHAR*)".", (LONGINT)2);
- Console_Ln();
+ Out_String(title, title__len);
+ Out_String(cmd, cmd__len);
+ Out_Ln();
+ Out_String((CHAR*)"-- failed: status ", 19);
+ Out_Int(status, 1);
+ Out_String((CHAR*)", exitcode ", 12);
+ Out_Int(exitcode, 1);
+ Out_String((CHAR*)".", 2);
+ Out_Ln();
if ((status == 0 && exitcode == 127)) {
- Console_String((CHAR*)"Is the C compiler in the current command path\?", (LONGINT)47);
- Console_Ln();
+ Out_String((CHAR*)"Is the C compiler in the current command path\?", 47);
+ Out_Ln();
}
if (status != 0) {
- Platform_Halt(status);
+ Modules_Halt(status);
} else {
- Platform_Halt(exitcode);
+ Modules_Halt(exitcode);
}
}
__DEL(title);
__DEL(cmd);
}
+static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT 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);
+ 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);
+}
+
void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len)
{
CHAR cmd[1023];
__DUP(moduleName, moduleName__len, CHAR);
- __MOVE("gcc -g", cmd, 7);
- Strings_Append(extTools_compilationOptions, ((LONGINT)(1023)), (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)"-c ", (LONGINT)4, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)".c", (LONGINT)3, (void*)cmd, ((LONGINT)(1023)));
- extTools_execute((CHAR*)"Assemble: ", (LONGINT)11, cmd, ((LONGINT)(1023)));
+ 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);
}
@@ -72,22 +90,23 @@ void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN stati
{
CHAR cmd[1023];
__DUP(additionalopts, additionalopts__len, CHAR);
- __MOVE("gcc -g", cmd, 7);
- Strings_Append((CHAR*)" ", (LONGINT)2, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append(extTools_compilationOptions, ((LONGINT)(1023)), (void*)cmd, ((LONGINT)(1023)));
- Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)".c ", (LONGINT)4, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append(additionalopts, additionalopts__len, (void*)cmd, ((LONGINT)(1023)));
+ 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", (LONGINT)8, (void*)cmd, ((LONGINT)(1023)));
+ Strings_Append((CHAR*)"-static", 8, (void*)cmd, 1023);
}
- Strings_Append((CHAR*)" -o ", (LONGINT)5, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)" -L\"", (LONGINT)5, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)"/lib\"", (LONGINT)6, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)" -l voc", (LONGINT)8, (void*)cmd, ((LONGINT)(1023)));
- extTools_execute((CHAR*)"Assemble and link: ", (LONGINT)20, cmd, ((LONGINT)(1023)));
+ 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);
}
@@ -96,17 +115,12 @@ export void *extTools__init(void)
{
__DEFMOD;
__MODULE_IMPORT(Configuration);
- __MODULE_IMPORT(Console);
+ __MODULE_IMPORT(Modules);
__MODULE_IMPORT(OPM);
+ __MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
__REGMOD("extTools", 0);
/* BEGIN */
- Strings_Append((CHAR*)" -I \"", (LONGINT)6, (void*)extTools_compilationOptions, ((LONGINT)(1023)));
- Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)extTools_compilationOptions, ((LONGINT)(1023)));
- Strings_Append((CHAR*)"/include\" ", (LONGINT)11, (void*)extTools_compilationOptions, ((LONGINT)(1023)));
- Platform_GetEnv((CHAR*)"CFLAGS", (LONGINT)7, (void*)extTools_CFLAGS, ((LONGINT)(1023)));
- Strings_Append(extTools_CFLAGS, ((LONGINT)(1023)), (void*)extTools_compilationOptions, ((LONGINT)(1023)));
- Strings_Append((CHAR*)" ", (LONGINT)2, (void*)extTools_compilationOptions, ((LONGINT)(1023)));
__ENDMOD;
}
diff --git a/bootstrap/unix-48/extTools.h b/bootstrap/unix-48/extTools.h
index fc4f0da1..63e5df15 100644
--- a/bootstrap/unix-48/extTools.h
+++ b/bootstrap/unix-48/extTools.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef extTools__h
#define extTools__h
@@ -13,4 +13,4 @@ import void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEA
import void *extTools__init(void);
-#endif
+#endif // extTools
diff --git a/bootstrap/unix-48/vt100.c b/bootstrap/unix-48/vt100.c
deleted file mode 100644
index d77b0b84..00000000
--- a/bootstrap/unix-48/vt100.c
+++ /dev/null
@@ -1,258 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#include "SYSTEM.h"
-#include "Console.h"
-#include "Strings.h"
-
-
-export CHAR vt100_CSI[5];
-static CHAR vt100_tmpstr[32];
-
-
-export void vt100_CHA (INTEGER n);
-export void vt100_CNL (INTEGER n);
-export void vt100_CPL (INTEGER n);
-export void vt100_CUB (INTEGER n);
-export void vt100_CUD (INTEGER n);
-export void vt100_CUF (INTEGER n);
-export void vt100_CUP (INTEGER n, INTEGER m);
-export void vt100_CUU (INTEGER n);
-export void vt100_DECTCEMh (void);
-export void vt100_DECTCEMl (void);
-export void vt100_DSR (INTEGER n);
-export void vt100_ED (INTEGER n);
-export void vt100_EL (INTEGER n);
-static void vt100_EscSeq (INTEGER n, CHAR *letter, LONGINT letter__len);
-static void vt100_EscSeq0 (CHAR *letter, LONGINT letter__len);
-static void vt100_EscSeq2 (INTEGER n, INTEGER m, CHAR *letter, LONGINT letter__len);
-static void vt100_EscSeqSwapped (INTEGER n, CHAR *letter, LONGINT letter__len);
-export void vt100_HVP (INTEGER n, INTEGER m);
-export void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len);
-export void vt100_RCP (void);
-static void vt100_Reverse0 (CHAR *str, LONGINT str__len, INTEGER start, INTEGER end);
-export void vt100_SCP (void);
-export void vt100_SD (INTEGER n);
-export void vt100_SGR (INTEGER n);
-export void vt100_SGR2 (INTEGER n, INTEGER m);
-export void vt100_SU (INTEGER n);
-export void vt100_SetAttr (CHAR *attr, LONGINT attr__len);
-
-
-static void vt100_Reverse0 (CHAR *str, LONGINT str__len, INTEGER start, INTEGER end)
-{
- CHAR h;
- while (start < end) {
- h = str[__X(start, str__len)];
- str[__X(start, str__len)] = str[__X(end, str__len)];
- str[__X(end, str__len)] = h;
- start += 1;
- end -= 1;
- }
-}
-
-void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len)
-{
- CHAR b[21];
- INTEGER s, e;
- SHORTINT maxLength;
- maxLength = 11;
- if (int_ == (-2147483647-1)) {
- __MOVE("-2147483648", b, 12);
- e = 11;
- } else {
- if (int_ < 0) {
- b[0] = '-';
- int_ = -int_;
- s = 1;
- } else {
- s = 0;
- }
- e = s;
- do {
- b[__X(e, ((LONGINT)(21)))] = (CHAR)(__MOD(int_, 10) + 48);
- int_ = __DIV(int_, 10);
- e += 1;
- } while (!(int_ == 0));
- b[__X(e, ((LONGINT)(21)))] = 0x00;
- vt100_Reverse0((void*)b, ((LONGINT)(21)), s, e - 1);
- }
- __COPY(b, str, str__len);
-}
-
-static void vt100_EscSeq0 (CHAR *letter, LONGINT letter__len)
-{
- CHAR cmd[9];
- __DUP(letter, letter__len, CHAR);
- __COPY(vt100_CSI, cmd, ((LONGINT)(9)));
- Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(9)));
- Console_String(cmd, ((LONGINT)(9)));
- __DEL(letter);
-}
-
-static void vt100_EscSeq (INTEGER n, CHAR *letter, LONGINT letter__len)
-{
- CHAR nstr[2];
- CHAR cmd[7];
- __DUP(letter, letter__len, CHAR);
- vt100_IntToStr(n, (void*)nstr, ((LONGINT)(2)));
- __COPY(vt100_CSI, cmd, ((LONGINT)(7)));
- Strings_Append(nstr, ((LONGINT)(2)), (void*)cmd, ((LONGINT)(7)));
- Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(7)));
- Console_String(cmd, ((LONGINT)(7)));
- __DEL(letter);
-}
-
-static void vt100_EscSeqSwapped (INTEGER n, CHAR *letter, LONGINT letter__len)
-{
- CHAR nstr[2];
- CHAR cmd[7];
- __DUP(letter, letter__len, CHAR);
- vt100_IntToStr(n, (void*)nstr, ((LONGINT)(2)));
- __COPY(vt100_CSI, cmd, ((LONGINT)(7)));
- Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(7)));
- Strings_Append(nstr, ((LONGINT)(2)), (void*)cmd, ((LONGINT)(7)));
- Console_String(cmd, ((LONGINT)(7)));
- __DEL(letter);
-}
-
-static void vt100_EscSeq2 (INTEGER n, INTEGER m, CHAR *letter, LONGINT letter__len)
-{
- CHAR nstr[5], mstr[5];
- CHAR cmd[12];
- __DUP(letter, letter__len, CHAR);
- vt100_IntToStr(n, (void*)nstr, ((LONGINT)(5)));
- vt100_IntToStr(m, (void*)mstr, ((LONGINT)(5)));
- __COPY(vt100_CSI, cmd, ((LONGINT)(12)));
- Strings_Append(nstr, ((LONGINT)(5)), (void*)cmd, ((LONGINT)(12)));
- Strings_Append((CHAR*)";", (LONGINT)2, (void*)cmd, ((LONGINT)(12)));
- Strings_Append(mstr, ((LONGINT)(5)), (void*)cmd, ((LONGINT)(12)));
- Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(12)));
- Console_String(cmd, ((LONGINT)(12)));
- __DEL(letter);
-}
-
-void vt100_CUU (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"A", (LONGINT)2);
-}
-
-void vt100_CUD (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"B", (LONGINT)2);
-}
-
-void vt100_CUF (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"C", (LONGINT)2);
-}
-
-void vt100_CUB (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"D", (LONGINT)2);
-}
-
-void vt100_CNL (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"E", (LONGINT)2);
-}
-
-void vt100_CPL (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"F", (LONGINT)2);
-}
-
-void vt100_CHA (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"G", (LONGINT)2);
-}
-
-void vt100_CUP (INTEGER n, INTEGER m)
-{
- vt100_EscSeq2(n, m, (CHAR*)"H", (LONGINT)2);
-}
-
-void vt100_ED (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"J", (LONGINT)2);
-}
-
-void vt100_EL (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"K", (LONGINT)2);
-}
-
-void vt100_SU (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"S", (LONGINT)2);
-}
-
-void vt100_SD (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"T", (LONGINT)2);
-}
-
-void vt100_HVP (INTEGER n, INTEGER m)
-{
- vt100_EscSeq2(n, m, (CHAR*)"f", (LONGINT)2);
-}
-
-void vt100_SGR (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"m", (LONGINT)2);
-}
-
-void vt100_SGR2 (INTEGER n, INTEGER m)
-{
- vt100_EscSeq2(n, m, (CHAR*)"m", (LONGINT)2);
-}
-
-void vt100_DSR (INTEGER n)
-{
- vt100_EscSeq(6, (CHAR*)"n", (LONGINT)2);
-}
-
-void vt100_SCP (void)
-{
- vt100_EscSeq0((CHAR*)"s", (LONGINT)2);
-}
-
-void vt100_RCP (void)
-{
- vt100_EscSeq0((CHAR*)"u", (LONGINT)2);
-}
-
-void vt100_DECTCEMl (void)
-{
- vt100_EscSeq0((CHAR*)"\?25l", (LONGINT)5);
-}
-
-void vt100_DECTCEMh (void)
-{
- vt100_EscSeq0((CHAR*)"\?25h", (LONGINT)5);
-}
-
-void vt100_SetAttr (CHAR *attr, LONGINT attr__len)
-{
- CHAR tmpstr[16];
- __DUP(attr, attr__len, CHAR);
- __COPY(vt100_CSI, tmpstr, ((LONGINT)(16)));
- Strings_Append(attr, attr__len, (void*)tmpstr, ((LONGINT)(16)));
- Console_String(tmpstr, ((LONGINT)(16)));
- __DEL(attr);
-}
-
-
-export void *vt100__init(void)
-{
- __DEFMOD;
- __MODULE_IMPORT(Console);
- __MODULE_IMPORT(Strings);
- __REGMOD("vt100", 0);
- __REGCMD("DECTCEMh", vt100_DECTCEMh);
- __REGCMD("DECTCEMl", vt100_DECTCEMl);
- __REGCMD("RCP", vt100_RCP);
- __REGCMD("SCP", vt100_SCP);
-/* BEGIN */
- __COPY("\033", vt100_CSI, ((LONGINT)(5)));
- Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5)));
- __ENDMOD;
-}
diff --git a/bootstrap/unix-48/vt100.h b/bootstrap/unix-48/vt100.h
deleted file mode 100644
index 4af04d6e..00000000
--- a/bootstrap/unix-48/vt100.h
+++ /dev/null
@@ -1,37 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-
-#ifndef vt100__h
-#define vt100__h
-
-#include "SYSTEM.h"
-
-
-import CHAR vt100_CSI[5];
-
-
-import void vt100_CHA (INTEGER n);
-import void vt100_CNL (INTEGER n);
-import void vt100_CPL (INTEGER n);
-import void vt100_CUB (INTEGER n);
-import void vt100_CUD (INTEGER n);
-import void vt100_CUF (INTEGER n);
-import void vt100_CUP (INTEGER n, INTEGER m);
-import void vt100_CUU (INTEGER n);
-import void vt100_DECTCEMh (void);
-import void vt100_DECTCEMl (void);
-import void vt100_DSR (INTEGER n);
-import void vt100_ED (INTEGER n);
-import void vt100_EL (INTEGER n);
-import void vt100_HVP (INTEGER n, INTEGER m);
-import void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len);
-import void vt100_RCP (void);
-import void vt100_SCP (void);
-import void vt100_SD (INTEGER n);
-import void vt100_SGR (INTEGER n);
-import void vt100_SGR2 (INTEGER n, INTEGER m);
-import void vt100_SU (INTEGER n);
-import void vt100_SetAttr (CHAR *attr, LONGINT attr__len);
-import void *vt100__init(void);
-
-
-#endif
diff --git a/bootstrap/unix-88/Compiler.c b/bootstrap/unix-88/Compiler.c
new file mode 100644
index 00000000..dc4bb660
--- /dev/null
+++ b/bootstrap/unix-88/Compiler.c
@@ -0,0 +1,184 @@
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspamS */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
+#include "SYSTEM.h"
+#include "Configuration.h"
+#include "Heap.h"
+#include "OPB.h"
+#include "OPC.h"
+#include "OPM.h"
+#include "OPP.h"
+#include "OPT.h"
+#include "OPV.h"
+#include "Platform.h"
+#include "Strings.h"
+#include "VT100.h"
+#include "extTools.h"
+
+
+static CHAR Compiler_mname[256];
+
+
+export void Compiler_Module (BOOLEAN *done);
+static void Compiler_PropagateElementaryTypeSizes (void);
+export void Compiler_Translate (void);
+static void Compiler_Trap (INT32 sig);
+
+
+void Compiler_Module (BOOLEAN *done)
+{
+ BOOLEAN ext, new;
+ OPT_Node p = NIL;
+ OPP_Module(&p, OPM_Options);
+ if (OPM_noerr) {
+ OPV_Init();
+ OPT_InitRecno();
+ OPV_AdrAndSize(OPT_topScope);
+ OPT_Export(&ext, &new);
+ if (OPM_noerr) {
+ OPM_OpenFiles((void*)OPT_SelfName, 256);
+ OPC_Init();
+ OPV_Module(p);
+ if (OPM_noerr) {
+ if ((__IN(10, OPM_Options, 32) && __STRCMP(OPM_modName, "SYSTEM") != 0)) {
+ OPM_DeleteNewSym();
+ OPM_LogVT100((CHAR*)"32m", 4);
+ OPM_LogWStr((CHAR*)" Main program.", 16);
+ OPM_LogVT100((CHAR*)"0m", 3);
+ } else {
+ if (new) {
+ OPM_LogVT100((CHAR*)"32m", 4);
+ OPM_LogWStr((CHAR*)" New symbol file.", 19);
+ OPM_LogVT100((CHAR*)"0m", 3);
+ OPM_RegisterNewSym();
+ } else if (ext) {
+ OPM_LogWStr((CHAR*)" Extended symbol file.", 24);
+ OPM_RegisterNewSym();
+ }
+ }
+ } else {
+ OPM_DeleteNewSym();
+ }
+ }
+ }
+ OPM_CloseFiles();
+ OPT_Close();
+ OPM_LogWLn();
+ *done = OPM_noerr;
+}
+
+static void Compiler_PropagateElementaryTypeSizes (void)
+{
+ OPT_Struct adrinttyp = NIL;
+ OPT_sysptrtyp->size = OPM_AddressSize;
+ OPT_sysptrtyp->idfp = OPT_sysptrtyp->form;
+ OPM_FPrint(&OPT_sysptrtyp->idfp, OPT_sysptrtyp->size);
+ OPT_adrtyp->size = OPM_AddressSize;
+ OPT_adrtyp->idfp = OPT_adrtyp->form;
+ OPM_FPrint(&OPT_adrtyp->idfp, OPT_adrtyp->size);
+ adrinttyp = OPT_IntType(OPM_AddressSize);
+ OPT_adrtyp->strobj = adrinttyp->strobj;
+ OPT_sinttyp = OPT_IntType(OPM_ShortintSize);
+ OPT_inttyp = OPT_IntType(OPM_IntegerSize);
+ OPT_linttyp = OPT_IntType(OPM_LongintSize);
+ OPT_sintobj->typ = OPT_sinttyp;
+ OPT_intobj->typ = OPT_inttyp;
+ OPT_lintobj->typ = OPT_linttyp;
+ switch (OPM_LongintSize) {
+ case 4:
+ OPT_settyp = OPT_set32typ;
+ break;
+ default:
+ OPT_settyp = OPT_set64typ;
+ break;
+ }
+ OPT_setobj->typ = OPT_settyp;
+ if (__STRCMP(OPM_Model, "C") == 0) {
+ OPT_cpbytetyp->strobj->name[4] = 0x00;
+ } else {
+ OPT_cpbytetyp->strobj->name[4] = '@';
+ }
+}
+
+void Compiler_Translate (void)
+{
+ BOOLEAN done;
+ CHAR modulesobj[2048];
+ modulesobj[0] = 0x00;
+ if (OPM_OpenPar()) {
+ for (;;) {
+ OPM_Init(&done, (void*)Compiler_mname, 256);
+ if (!done) {
+ return;
+ }
+ OPM_InitOptions();
+ Compiler_PropagateElementaryTypeSizes();
+ Heap_GC(0);
+ Compiler_Module(&done);
+ if (!done) {
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Module compilation failed.", 27);
+ OPM_LogWLn();
+ Platform_Exit(1);
+ }
+ if (!__IN(13, OPM_Options, 32)) {
+ if (__IN(14, OPM_Options, 32)) {
+ extTools_Assemble(OPM_modName, 32);
+ } else {
+ if (!__IN(10, OPM_Options, 32)) {
+ extTools_Assemble(OPM_modName, 32);
+ Strings_Append((CHAR*)" ", 2, (void*)modulesobj, 2048);
+ Strings_Append(OPM_modName, 32, (void*)modulesobj, 2048);
+ Strings_Append((CHAR*)".o", 3, (void*)modulesobj, 2048);
+ } else {
+ extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), modulesobj, 2048);
+ }
+ }
+ }
+ }
+ }
+}
+
+static void Compiler_Trap (INT32 sig)
+{
+ Heap_FINALL();
+ if (sig == 3) {
+ Platform_Exit(0);
+ } else {
+ if (sig == 4) {
+ OPM_LogWStr((CHAR*)" --- Oberon compiler internal error", 36);
+ OPM_LogWLn();
+ }
+ Platform_Exit(2);
+ }
+}
+
+
+export int main(int argc, char **argv)
+{
+ __INIT(argc, argv);
+ __MODULE_IMPORT(Configuration);
+ __MODULE_IMPORT(Heap);
+ __MODULE_IMPORT(OPB);
+ __MODULE_IMPORT(OPC);
+ __MODULE_IMPORT(OPM);
+ __MODULE_IMPORT(OPP);
+ __MODULE_IMPORT(OPT);
+ __MODULE_IMPORT(OPV);
+ __MODULE_IMPORT(Platform);
+ __MODULE_IMPORT(Strings);
+ __MODULE_IMPORT(VT100);
+ __MODULE_IMPORT(extTools);
+ __REGMAIN("Compiler", 0);
+ __REGCMD("Translate", Compiler_Translate);
+/* BEGIN */
+ Platform_SetInterruptHandler(Compiler_Trap);
+ Platform_SetQuitHandler(Compiler_Trap);
+ Platform_SetBadInstructionHandler(Compiler_Trap);
+ Compiler_Translate();
+ __FINI;
+}
diff --git a/bootstrap/unix-88/Configuration.c b/bootstrap/unix-88/Configuration.c
index 47f1ffc7..2d0061df 100644
--- a/bootstrap/unix-88/Configuration.c
+++ b/bootstrap/unix-88/Configuration.c
@@ -1,9 +1,14 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
-export CHAR Configuration_versionLong[41];
+export CHAR Configuration_versionLong[75];
@@ -14,6 +19,6 @@ export void *Configuration__init(void)
__DEFMOD;
__REGMOD("Configuration", 0);
/* BEGIN */
- __MOVE("1.95 [2016/08/23] for gcc LP64 on cygwin", Configuration_versionLong, 41);
+ __MOVE("1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75);
__ENDMOD;
}
diff --git a/bootstrap/unix-88/Configuration.h b/bootstrap/unix-88/Configuration.h
index ba0bbd99..b28e0caa 100644
--- a/bootstrap/unix-88/Configuration.h
+++ b/bootstrap/unix-88/Configuration.h
@@ -1,16 +1,15 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Configuration__h
#define Configuration__h
-#define LARGE
#include "SYSTEM.h"
-import CHAR Configuration_versionLong[41];
+import CHAR Configuration_versionLong[75];
import void *Configuration__init(void);
-#endif
+#endif // Configuration
diff --git a/bootstrap/unix-88/Console.c b/bootstrap/unix-88/Console.c
deleted file mode 100644
index b39e6cf3..00000000
--- a/bootstrap/unix-88/Console.c
+++ /dev/null
@@ -1,151 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
-#include "SYSTEM.h"
-#include "Platform.h"
-
-
-static CHAR Console_line[128];
-static INTEGER Console_pos;
-
-
-export void Console_Bool (BOOLEAN b);
-export void Console_Char (CHAR ch);
-export void Console_Flush (void);
-export void Console_Hex (LONGINT i);
-export void Console_Int (LONGINT i, LONGINT n);
-export void Console_Ln (void);
-export void Console_Read (CHAR *ch);
-export void Console_ReadLine (CHAR *line, LONGINT line__len);
-export void Console_String (CHAR *s, LONGINT s__len);
-
-
-void Console_Flush (void)
-{
- INTEGER error;
- error = Platform_Write(((LONGINT)(1)), (LONGINT)(SYSTEM_ADDRESS)Console_line, Console_pos);
- Console_pos = 0;
-}
-
-void Console_Char (CHAR ch)
-{
- if (Console_pos == 128) {
- Console_Flush();
- }
- Console_line[__X(Console_pos, ((LONGINT)(128)))] = ch;
- Console_pos += 1;
- if (ch == 0x0a) {
- Console_Flush();
- }
-}
-
-void Console_String (CHAR *s, LONGINT s__len)
-{
- INTEGER i;
- __DUP(s, s__len, CHAR);
- i = 0;
- while (s[__X(i, s__len)] != 0x00) {
- Console_Char(s[__X(i, s__len)]);
- i += 1;
- }
- __DEL(s);
-}
-
-void Console_Int (LONGINT i, LONGINT n)
-{
- CHAR s[32];
- LONGINT i1, k;
- if (i == __LSHL(1, 63, LONGINT)) {
- __MOVE("8085774586302733229", s, 20);
- k = 19;
- } else {
- i1 = __ABS(i);
- s[0] = (CHAR)(__MOD(i1, 10) + 48);
- i1 = __DIV(i1, 10);
- k = 1;
- while (i1 > 0) {
- s[__X(k, ((LONGINT)(32)))] = (CHAR)(__MOD(i1, 10) + 48);
- i1 = __DIV(i1, 10);
- k += 1;
- }
- }
- if (i < 0) {
- s[__X(k, ((LONGINT)(32)))] = '-';
- k += 1;
- }
- while (n > k) {
- Console_Char(' ');
- n -= 1;
- }
- while (k > 0) {
- k -= 1;
- Console_Char(s[__X(k, ((LONGINT)(32)))]);
- }
-}
-
-void Console_Ln (void)
-{
- Console_Char(0x0a);
-}
-
-void Console_Bool (BOOLEAN b)
-{
- if (b) {
- Console_String((CHAR*)"TRUE", (LONGINT)5);
- } else {
- Console_String((CHAR*)"FALSE", (LONGINT)6);
- }
-}
-
-void Console_Hex (LONGINT i)
-{
- LONGINT k, n;
- k = -28;
- while (k <= 0) {
- n = __MASK(__ASH(i, k), -16);
- if (n <= 9) {
- Console_Char((CHAR)(48 + n));
- } else {
- Console_Char((CHAR)(55 + n));
- }
- k += 4;
- }
-}
-
-void Console_Read (CHAR *ch)
-{
- LONGINT n;
- INTEGER error;
- Console_Flush();
- error = Platform_ReadBuf(((LONGINT)(0)), (void*)&*ch, ((LONGINT)(1)), &n);
- if (n != 1) {
- *ch = 0x00;
- }
-}
-
-void Console_ReadLine (CHAR *line, LONGINT line__len)
-{
- LONGINT i;
- CHAR ch;
- Console_Flush();
- i = 0;
- Console_Read(&ch);
- while ((((i < line__len - 1 && ch != 0x0a)) && ch != 0x00)) {
- line[__X(i, line__len)] = ch;
- i += 1;
- Console_Read(&ch);
- }
- line[__X(i, line__len)] = 0x00;
-}
-
-
-export void *Console__init(void)
-{
- __DEFMOD;
- __MODULE_IMPORT(Platform);
- __REGMOD("Console", 0);
- __REGCMD("Flush", Console_Flush);
- __REGCMD("Ln", Console_Ln);
-/* BEGIN */
- Console_pos = 0;
- __ENDMOD;
-}
diff --git a/bootstrap/unix-88/Console.h b/bootstrap/unix-88/Console.h
deleted file mode 100644
index 4606384c..00000000
--- a/bootstrap/unix-88/Console.h
+++ /dev/null
@@ -1,24 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-
-#ifndef Console__h
-#define Console__h
-
-#define LARGE
-#include "SYSTEM.h"
-
-
-
-
-import void Console_Bool (BOOLEAN b);
-import void Console_Char (CHAR ch);
-import void Console_Flush (void);
-import void Console_Hex (LONGINT i);
-import void Console_Int (LONGINT i, LONGINT n);
-import void Console_Ln (void);
-import void Console_Read (CHAR *ch);
-import void Console_ReadLine (CHAR *line, LONGINT line__len);
-import void Console_String (CHAR *s, LONGINT s__len);
-import void *Console__init(void);
-
-
-#endif
diff --git a/bootstrap/unix-88/Files.c b/bootstrap/unix-88/Files.c
index 1b144711..826c3d63 100644
--- a/bootstrap/unix-88/Files.c
+++ b/bootstrap/unix-88/Files.c
@@ -1,9 +1,13 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
-#include "Configuration.h"
-#include "Console.h"
#include "Heap.h"
+#include "Out.h"
#include "Platform.h"
#include "Strings.h"
@@ -14,7 +18,7 @@ typedef
struct Files_BufDesc {
Files_File f;
BOOLEAN chg;
- LONGINT org, size;
+ INT32 org, size;
SYSTEM_BYTE data[4096];
} Files_BufDesc;
@@ -29,114 +33,114 @@ typedef
Files_FileName workName, registerName;
BOOLEAN tempFile;
Platform_FileIdentity identity;
- LONGINT fd, len, pos;
+ INT32 fd, len, pos;
Files_Buffer bufs[4];
- INTEGER swapper, state;
+ INT16 swapper, state;
Files_File next;
} Files_FileDesc;
typedef
struct Files_Rider {
- LONGINT res;
+ INT32 res;
BOOLEAN eof;
Files_Buffer buf;
- LONGINT org, offset;
+ INT32 org, offset;
} Files_Rider;
static Files_File Files_files;
-static INTEGER Files_tempno;
+static INT16 Files_tempno;
static CHAR Files_HOME[1024];
static struct {
LONGINT len[1];
CHAR data[1];
} *Files_SearchPath;
-export LONGINT *Files_FileDesc__typ;
-export LONGINT *Files_BufDesc__typ;
-export LONGINT *Files_Rider__typ;
+export ADDRESS *Files_FileDesc__typ;
+export ADDRESS *Files_BufDesc__typ;
+export ADDRESS *Files_Rider__typ;
-export Files_File Files_Base (Files_Rider *r, LONGINT *r__typ);
+export Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
static Files_File Files_CacheEntry (Platform_FileIdentity identity);
-export void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *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, LONGINT name__len, INTEGER *res);
-static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INTEGER 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, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len);
static void Files_Flush (Files_Buffer buf);
-export void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d);
+export void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
export void Files_GetName (Files_File f, CHAR *name, LONGINT name__len);
static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len);
static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len);
-export LONGINT Files_Length (Files_File f);
+export INT32 Files_Length (Files_File f);
static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len);
export Files_File Files_New (CHAR *name, LONGINT name__len);
export Files_File Files_Old (CHAR *name, LONGINT name__len);
-export LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ);
+export INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ);
export void Files_Purge (Files_File f);
-export void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x);
-export void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x);
-export void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len);
-export void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n);
-export void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x);
-export void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x);
-export void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x);
-export void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
-export void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x);
-export void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x);
-export void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x);
-export void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
+export void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
+export void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x);
+export void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+export void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x);
+export void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x);
+export void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
+export void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+export void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
+export void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
+export void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
+export void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
export void Files_Register (Files_File f);
-export void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res);
-static void Files_ScanPath (INTEGER *pos, CHAR *dir, LONGINT dir__len);
-export void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos);
+export void Files_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, LONGINT path__len);
-export void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x);
-export void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x);
-export void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n);
-export void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x);
-export void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x);
-export void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x);
-export void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x);
-export void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x);
-export void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x);
-export void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
+export void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
+export void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
+export void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+export void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
+export void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
+export void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
+export void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
+export void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
+export void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
+export void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
#define Files_IdxTrap() __HALT(-1)
+#define Files_ToAdr(x) (ADDRESS)x
-static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INTEGER errcode)
+static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
{
__DUP(s, s__len, CHAR);
- Console_Ln();
- Console_String((CHAR*)"-- ", (LONGINT)4);
- Console_String(s, s__len);
- Console_String((CHAR*)": ", (LONGINT)3);
+ Out_Ln();
+ Out_String((CHAR*)"-- ", 4);
+ Out_String(s, s__len);
+ Out_String((CHAR*)": ", 3);
if (f != NIL) {
if (f->registerName[0] != 0x00) {
- Console_String(f->registerName, ((LONGINT)(101)));
+ Out_String(f->registerName, 101);
} else {
- Console_String(f->workName, ((LONGINT)(101)));
+ Out_String(f->workName, 101);
}
if (f->fd != 0) {
- Console_String((CHAR*)"f.fd = ", (LONGINT)8);
- Console_Int(f->fd, ((LONGINT)(1)));
+ Out_String((CHAR*)"f.fd = ", 8);
+ Out_Int(f->fd, 1);
}
}
if (errcode != 0) {
- Console_String((CHAR*)" errcode = ", (LONGINT)12);
- Console_Int(errcode, ((LONGINT)(1)));
+ Out_String((CHAR*)" errcode = ", 12);
+ Out_Int(errcode, 1);
}
- Console_Ln();
+ Out_Ln();
__HALT(99);
__DEL(s);
}
static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len)
{
- INTEGER i, j;
+ INT16 i, j;
__DUP(dir, dir__len, CHAR);
__DUP(name, name__len, CHAR);
i = 0;
@@ -161,7 +165,7 @@ static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT
static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len)
{
- LONGINT n, i, j;
+ INT32 n, i, j;
__DUP(finalName, finalName__len, CHAR);
Files_tempno += 1;
n = Files_tempno;
@@ -193,7 +197,7 @@ static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *na
name[i + 5] = '.';
i += 6;
while (n > 0) {
- name[i] = (CHAR)(__MOD(n, 10) + 48);
+ name[i] = (CHAR)((int)__MOD(n, 10) + 48);
n = __DIV(n, 10);
i += 1;
}
@@ -201,7 +205,7 @@ static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *na
i += 1;
n = Platform_PID;
while (n > 0) {
- name[i] = (CHAR)(__MOD(n, 10) + 48);
+ name[i] = (CHAR)((int)__MOD(n, 10) + 48);
n = __DIV(n, 10);
i += 1;
}
@@ -213,19 +217,19 @@ static void Files_Create (Files_File f)
{
Platform_FileIdentity identity;
BOOLEAN done;
- INTEGER error;
+ INT16 error;
CHAR err[32];
if (f->fd == -1) {
if (f->state == 1) {
- Files_GetTempName(f->registerName, ((LONGINT)(101)), (void*)f->workName, ((LONGINT)(101)));
+ Files_GetTempName(f->registerName, 101, (void*)f->workName, 101);
f->tempFile = 1;
} else if (f->state == 2) {
- __COPY(f->registerName, f->workName, ((LONGINT)(101)));
+ __COPY(f->registerName, f->workName, 101);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
- error = Platform_Unlink((void*)f->workName, ((LONGINT)(101)));
- error = Platform_New((void*)f->workName, ((LONGINT)(101)), &f->fd);
+ 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;
@@ -243,14 +247,14 @@ static void Files_Create (Files_File f)
} else {
__MOVE("file not created", err, 17);
}
- Files_Err(err, ((LONGINT)(32)), f, error);
+ Files_Err(err, 32, f, error);
}
}
}
static void Files_Flush (Files_Buffer buf)
{
- INTEGER error;
+ INT16 error;
Files_File f = NIL;
if (buf->chg) {
f = buf->f;
@@ -258,15 +262,15 @@ static void Files_Flush (Files_Buffer buf)
if (buf->org != f->pos) {
error = Platform_Seek(f->fd, buf->org, Platform_SeekSet);
}
- error = Platform_Write(f->fd, (LONGINT)(SYSTEM_ADDRESS)buf->data, buf->size);
+ error = Platform_Write(f->fd, (ADDRESS)buf->data, buf->size);
if (error != 0) {
- Files_Err((CHAR*)"error writing file", (LONGINT)19, f, error);
+ Files_Err((CHAR*)"error writing file", 19, f, error);
}
f->pos = buf->org + buf->size;
buf->chg = 0;
error = Platform_Identify(f->fd, &f->identity, Platform_FileIdentity__typ);
if (error != 0) {
- Files_Err((CHAR*)"error identifying file", (LONGINT)23, f, error);
+ Files_Err((CHAR*)"error identifying file", 23, f, error);
}
}
}
@@ -274,7 +278,7 @@ static void Files_Flush (Files_Buffer buf)
static void Files_CloseOSFile (Files_File f)
{
Files_File prev = NIL;
- INTEGER error;
+ INT16 error;
if (Files_files == f) {
Files_files = f->next;
} else {
@@ -294,8 +298,8 @@ static void Files_CloseOSFile (Files_File f)
void Files_Close (Files_File f)
{
- LONGINT i;
- INTEGER error;
+ INT32 i;
+ INT16 error;
if (f->state != 1 || f->registerName[0] != 0x00) {
Files_Create(f);
i = 0;
@@ -303,42 +307,34 @@ void Files_Close (Files_File f)
Files_Flush(f->bufs[i]);
i += 1;
}
- error = Platform_Sync(f->fd);
- if (error != 0) {
- Files_Err((CHAR*)"error writing file", (LONGINT)19, f, error);
- }
Files_CloseOSFile(f);
}
}
-LONGINT Files_Length (Files_File f)
+INT32 Files_Length (Files_File f)
{
- LONGINT _o_result;
- _o_result = f->len;
- return _o_result;
+ return f->len;
}
Files_File Files_New (CHAR *name, LONGINT name__len)
{
- Files_File _o_result;
Files_File f = NIL;
__DUP(name, name__len, CHAR);
__NEW(f, Files_FileDesc);
f->workName[0] = 0x00;
- __COPY(name, f->registerName, ((LONGINT)(101)));
+ __COPY(name, f->registerName, 101);
f->fd = -1;
f->state = 1;
f->len = 0;
f->pos = 0;
f->swapper = -1;
- _o_result = f;
__DEL(name);
- return _o_result;
+ return f;
}
-static void Files_ScanPath (INTEGER *pos, CHAR *dir, LONGINT dir__len)
+static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len)
{
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
if (Files_SearchPath == NIL) {
@@ -381,8 +377,7 @@ static void Files_ScanPath (INTEGER *pos, CHAR *dir, LONGINT dir__len)
static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len)
{
- BOOLEAN _o_result;
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
ch = name[0];
@@ -390,15 +385,13 @@ static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len)
i += 1;
ch = name[i];
}
- _o_result = ch == '/';
- return _o_result;
+ return ch == '/';
}
static Files_File Files_CacheEntry (Platform_FileIdentity identity)
{
- Files_File _o_result;
Files_File f = NIL;
- INTEGER i, error;
+ INT16 i, error;
f = Files_files;
while (f != NIL) {
if (Platform_SameFile(identity, f->identity)) {
@@ -415,60 +408,56 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
f->identity = identity;
error = Platform_Size(f->fd, &f->len);
}
- _o_result = f;
- return _o_result;
+ return f;
}
f = f->next;
}
- _o_result = NIL;
- return _o_result;
+ return NIL;
}
Files_File Files_Old (CHAR *name, LONGINT name__len)
{
- Files_File _o_result;
Files_File f = NIL;
- LONGINT fd;
- INTEGER pos;
+ INT32 fd;
+ INT16 pos;
BOOLEAN done;
CHAR dir[256], path[256];
- INTEGER error;
+ INT16 error;
Platform_FileIdentity identity;
__DUP(name, name__len, CHAR);
if (name[0] != 0x00) {
if (Files_HasDir((void*)name, name__len)) {
dir[0] = 0x00;
- __COPY(name, path, ((LONGINT)(256)));
+ __COPY(name, path, 256);
} else {
pos = 0;
- Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256)));
- Files_MakeFileName(dir, ((LONGINT)(256)), name, name__len, (void*)path, ((LONGINT)(256)));
- Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256)));
+ Files_ScanPath(&pos, (void*)dir, 256);
+ Files_MakeFileName(dir, 256, name, name__len, (void*)path, 256);
+ Files_ScanPath(&pos, (void*)dir, 256);
}
for (;;) {
- error = Platform_OldRW((void*)path, ((LONGINT)(256)), &fd);
+ error = Platform_OldRW((void*)path, 256, &fd);
done = error == 0;
if ((!done && Platform_TooManyFiles(error))) {
- Files_Err((CHAR*)"too many files open", (LONGINT)20, f, error);
+ Files_Err((CHAR*)"too many files open", 20, f, error);
}
if ((!done && Platform_Inaccessible(error))) {
- error = Platform_OldRO((void*)path, ((LONGINT)(256)), &fd);
+ error = Platform_OldRO((void*)path, 256, &fd);
done = error == 0;
}
if ((!done && !Platform_Absent(error))) {
- Console_String((CHAR*)"Warning: Files.Old ", (LONGINT)20);
- Console_String(name, name__len);
- Console_String((CHAR*)" error = ", (LONGINT)10);
- Console_Int(error, ((LONGINT)(0)));
- Console_Ln();
+ Out_String((CHAR*)"Warning: Files.Old ", 20);
+ Out_String(name, name__len);
+ Out_String((CHAR*)" error = ", 10);
+ Out_Int(error, 0);
+ Out_Ln();
}
if (done) {
error = Platform_Identify(fd, &identity, Platform_FileIdentity__typ);
f = Files_CacheEntry(identity);
if (f != NIL) {
- _o_result = f;
__DEL(name);
- return _o_result;
+ return f;
} else {
__NEW(f, Files_FileDesc);
Heap_RegisterFinalizer((void*)f, Files_Finalize);
@@ -477,39 +466,36 @@ Files_File Files_Old (CHAR *name, LONGINT name__len)
f->pos = 0;
f->swapper = -1;
error = Platform_Size(fd, &f->len);
- __COPY(name, f->workName, ((LONGINT)(101)));
+ __COPY(name, f->workName, 101);
f->registerName[0] = 0x00;
f->tempFile = 0;
f->identity = identity;
f->next = Files_files;
Files_files = f;
Heap_FileCount += 1;
- _o_result = f;
__DEL(name);
- return _o_result;
+ return f;
}
} else if (dir[0] == 0x00) {
- _o_result = NIL;
__DEL(name);
- return _o_result;
+ return NIL;
} else {
- Files_MakeFileName(dir, ((LONGINT)(256)), name, name__len, (void*)path, ((LONGINT)(256)));
- Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256)));
+ Files_MakeFileName(dir, 256, name, name__len, (void*)path, 256);
+ Files_ScanPath(&pos, (void*)dir, 256);
}
}
} else {
- _o_result = NIL;
__DEL(name);
- return _o_result;
+ return NIL;
}
__RETCHK;
}
void Files_Purge (Files_File f)
{
- INTEGER i;
+ INT16 i;
Platform_FileIdentity identity;
- INTEGER error;
+ INT16 error;
i = 0;
while (i < 4) {
if (f->bufs[i] != NIL) {
@@ -519,8 +505,8 @@ void Files_Purge (Files_File f)
i += 1;
}
if (f->fd != -1) {
- error = Platform_Truncate(f->fd, ((LONGINT)(0)));
- error = Platform_Seek(f->fd, ((LONGINT)(0)), Platform_SeekSet);
+ error = Platform_Truncate(f->fd, 0);
+ error = Platform_Seek(f->fd, 0, Platform_SeekSet);
}
f->pos = 0;
f->len = 0;
@@ -529,27 +515,26 @@ void Files_Purge (Files_File f)
Platform_SetMTime(&f->identity, Platform_FileIdentity__typ, identity);
}
-void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d)
+void Files_GetDate (Files_File f, INT32 *t, INT32 *d)
{
Platform_FileIdentity identity;
- INTEGER error;
+ INT16 error;
Files_Create(f);
error = Platform_Identify(f->fd, &identity, Platform_FileIdentity__typ);
Platform_MTimeAsClock(identity, &*t, &*d);
}
-LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ)
+INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ)
{
- LONGINT _o_result;
- _o_result = (*r).org + (*r).offset;
- return _o_result;
+ __ASSERT((*r).offset <= 4096, 0);
+ return (*r).org + (*r).offset;
}
-void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos)
+void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos)
{
- LONGINT org, offset, i, n;
+ INT32 org, offset, i, n;
Files_Buffer buf = NIL;
- INTEGER error;
+ INT16 error;
if (f != NIL) {
if (pos > f->len) {
pos = f->len;
@@ -585,9 +570,9 @@ void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos)
if (f->pos != org) {
error = Platform_Seek(f->fd, org, Platform_SeekSet);
}
- error = Platform_ReadBuf(f->fd, (void*)buf->data, ((LONGINT)(4096)), &n);
+ error = Platform_ReadBuf(f->fd, (void*)buf->data, 4096, &n);
if (error != 0) {
- Files_Err((CHAR*)"read from file not done", (LONGINT)24, f, error);
+ Files_Err((CHAR*)"read from file not done", 24, f, error);
}
f->pos = org + n;
buf->size = n;
@@ -600,6 +585,7 @@ void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos)
org = 0;
offset = 0;
}
+ __ASSERT(offset <= 4096, 0);
(*r).buf = buf;
(*r).org = org;
(*r).offset = offset;
@@ -607,9 +593,9 @@ void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos)
(*r).res = 0;
}
-void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x)
+void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
{
- LONGINT offset;
+ INT32 offset;
Files_Buffer buf = NIL;
buf = (*r).buf;
offset = (*r).offset;
@@ -618,6 +604,7 @@ void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x)
buf = (*r).buf;
offset = (*r).offset;
}
+ __ASSERT(offset <= buf->size, 0);
if (offset < buf->size) {
*x = buf->data[offset];
(*r).offset = offset + 1;
@@ -631,9 +618,9 @@ void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x)
}
}
-void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n)
+void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
{
- LONGINT xpos, min, restInBuf, offset;
+ INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
if (n > x__len) {
Files_IdxTrap();
@@ -657,39 +644,35 @@ void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x
} else {
min = n;
}
- __MOVE((LONGINT)(SYSTEM_ADDRESS)buf->data + offset, (LONGINT)(SYSTEM_ADDRESS)x + xpos, min);
+ __MOVE((ADDRESS)buf->data + Files_ToAdr(offset), (ADDRESS)x + Files_ToAdr(xpos), min);
offset += min;
(*r).offset = offset;
xpos += min;
n -= min;
+ __ASSERT(offset <= 4096, 0);
}
(*r).res = 0;
(*r).eof = 0;
}
-void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len)
+Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ)
{
- Files_ReadBytes(&*r, r__typ, (void*)x, x__len * ((LONGINT)(1)), ((LONGINT)(1)));
+ return (*r).buf->f;
}
-Files_File Files_Base (Files_Rider *r, LONGINT *r__typ)
-{
- Files_File _o_result;
- _o_result = (*r).buf->f;
- return _o_result;
-}
-
-void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x)
+void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
{
Files_Buffer buf = NIL;
- LONGINT offset;
+ INT32 offset;
buf = (*r).buf;
offset = (*r).offset;
+ __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;
}
+ __ASSERT(offset < 4096, 0);
buf->data[offset] = x;
buf->chg = 1;
if (offset == buf->size) {
@@ -700,9 +683,9 @@ void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x)
(*r).res = 0;
}
-void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n)
+void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
{
- LONGINT xpos, min, restInBuf, offset;
+ INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
if (n > x__len) {
Files_IdxTrap();
@@ -711,20 +694,23 @@ void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT
buf = (*r).buf;
offset = (*r).offset;
while (n > 0) {
+ __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;
}
+ __ASSERT(offset <= 4096, 0);
restInBuf = 4096 - offset;
if (n > restInBuf) {
min = restInBuf;
} else {
min = n;
}
- __MOVE((LONGINT)(SYSTEM_ADDRESS)x + xpos, (LONGINT)(SYSTEM_ADDRESS)buf->data + offset, min);
+ __MOVE((ADDRESS)x + Files_ToAdr(xpos), (ADDRESS)buf->data + Files_ToAdr(offset), min);
offset += min;
(*r).offset = offset;
+ __ASSERT(offset <= 4096, 0);
if (offset > buf->size) {
buf->f->len += offset - buf->size;
buf->size = offset;
@@ -736,17 +722,17 @@ void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT
(*r).res = 0;
}
-void Files_Delete (CHAR *name, LONGINT name__len, INTEGER *res)
+void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res)
{
__DUP(name, name__len, CHAR);
*res = Platform_Unlink((void*)name, name__len);
__DEL(name);
}
-void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res)
+void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res)
{
- LONGINT fdold, fdnew, n;
- INTEGER error, ignore;
+ INT32 fdold, fdnew, n;
+ INT16 error, ignore;
Platform_FileIdentity oldidentity, newidentity;
CHAR buf[4096];
__DUP(old, old__len, CHAR);
@@ -760,28 +746,34 @@ void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT
error = Platform_Rename((void*)old, old__len, (void*)new, new__len);
if (!Platform_DifferentFilesystems(error)) {
*res = error;
+ __DEL(old);
+ __DEL(new);
return;
} else {
error = Platform_OldRO((void*)old, old__len, &fdold);
if (error != 0) {
*res = 2;
+ __DEL(old);
+ __DEL(new);
return;
}
error = Platform_New((void*)new, new__len, &fdnew);
if (error != 0) {
error = Platform_Close(fdold);
*res = 3;
+ __DEL(old);
+ __DEL(new);
return;
}
- error = Platform_Read(fdold, (LONGINT)(SYSTEM_ADDRESS)buf, ((LONGINT)(4096)), &n);
+ error = Platform_Read(fdold, (ADDRESS)buf, 4096, &n);
while (n > 0) {
- error = Platform_Write(fdnew, (LONGINT)(SYSTEM_ADDRESS)buf, n);
+ error = Platform_Write(fdnew, (ADDRESS)buf, n);
if (error != 0) {
ignore = Platform_Close(fdold);
ignore = Platform_Close(fdnew);
- Files_Err((CHAR*)"cannot move file", (LONGINT)17, NIL, error);
+ Files_Err((CHAR*)"cannot move file", 17, NIL, error);
}
- error = Platform_Read(fdold, (LONGINT)(SYSTEM_ADDRESS)buf, ((LONGINT)(4096)), &n);
+ error = Platform_Read(fdold, (ADDRESS)buf, 4096, &n);
}
ignore = Platform_Close(fdold);
ignore = Platform_Close(fdnew);
@@ -789,7 +781,7 @@ void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT
error = Platform_Unlink((void*)old, old__len);
*res = 0;
} else {
- Files_Err((CHAR*)"cannot move file", (LONGINT)17, NIL, error);
+ Files_Err((CHAR*)"cannot move file", 17, NIL, error);
}
}
} else {
@@ -801,7 +793,7 @@ void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT
void Files_Register (Files_File f)
{
- INTEGER idx, errcode;
+ INT16 idx, errcode;
Files_File f1 = NIL;
CHAR file[104];
if ((f->state == 1 && f->registerName[0] != 0x00)) {
@@ -809,18 +801,18 @@ void Files_Register (Files_File f)
}
Files_Close(f);
if (f->registerName[0] != 0x00) {
- Files_Rename(f->workName, ((LONGINT)(101)), f->registerName, ((LONGINT)(101)), &errcode);
+ Files_Rename(f->workName, 101, f->registerName, 101, &errcode);
if (errcode != 0) {
- __COPY(f->registerName, file, ((LONGINT)(104)));
+ __COPY(f->registerName, file, 104);
__HALT(99);
}
- __COPY(f->registerName, f->workName, ((LONGINT)(101)));
+ __COPY(f->registerName, f->workName, 101);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
}
-void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res)
+void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res)
{
__DUP(path, path__len, CHAR);
*res = Platform_Chdir((void*)path, path__len);
@@ -829,7 +821,7 @@ void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res)
static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len)
{
- LONGINT i, j;
+ INT32 i, j;
if (!Platform_LittleEndian) {
i = src__len;
j = 0;
@@ -839,55 +831,55 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *de
j += 1;
}
} else {
- __MOVE((LONGINT)(SYSTEM_ADDRESS)src, (LONGINT)(SYSTEM_ADDRESS)dest, src__len);
+ __MOVE((ADDRESS)src, (ADDRESS)dest, src__len);
}
}
-void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x)
+void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x)
{
Files_Read(&*R, R__typ, (CHAR*)(void*)&*x);
}
-void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x)
+void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x)
{
CHAR b[2];
- Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(2)), ((LONGINT)(2)));
- *x = (int)b[0] + __ASHL((int)b[1], 8);
+ Files_ReadBytes(&*R, R__typ, (void*)b, 2, 2);
+ *x = (INT16)b[0] + __ASHL((INT16)b[1], 8);
}
-void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x)
+void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x)
{
CHAR b[4];
- Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
- *x = (((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((int)b[2], 16)) + __ASHL((int)b[3], 24);
+ Files_ReadBytes(&*R, R__typ, (void*)b, 4, 4);
+ *x = (((INT16)b[0] + __ASHL((INT16)b[1], 8)) + __ASHL(b[2], 16)) + __ASHL(b[3], 24);
}
-void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x)
+void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x)
{
CHAR b[4];
- LONGINT l;
- Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
- l = (((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((int)b[2], 16)) + __ASHL((int)b[3], 24);
- *x = (SET)l;
+ INT32 l;
+ Files_ReadBytes(&*R, R__typ, (void*)b, 4, 4);
+ l = (((INT16)b[0] + __ASHL((INT16)b[1], 8)) + __ASHL(b[2], 16)) + __ASHL(b[3], 24);
+ *x = (UINT32)l;
}
-void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x)
+void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x)
{
CHAR b[4];
- Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
- Files_FlipBytes((void*)b, ((LONGINT)(4)), (void*)&*x, ((LONGINT)(4)));
+ Files_ReadBytes(&*R, R__typ, (void*)b, 4, 4);
+ Files_FlipBytes((void*)b, 4, (void*)&*x, 4);
}
-void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x)
+void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x)
{
CHAR b[8];
- Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(8)), ((LONGINT)(8)));
- Files_FlipBytes((void*)b, ((LONGINT)(8)), (void*)&*x, ((LONGINT)(8)));
+ Files_ReadBytes(&*R, R__typ, (void*)b, 8, 8);
+ Files_FlipBytes((void*)b, 8, (void*)&*x, 8);
}
-void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len)
+void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
{
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
do {
@@ -897,101 +889,100 @@ void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len)
} while (!(ch == 0x00));
}
-void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len)
+void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
{
- INTEGER i;
- CHAR ch;
- BOOLEAN b;
+ INT16 i;
i = 0;
- b = 0;
do {
- Files_Read(&*R, R__typ, (void*)&ch);
- if ((ch == 0x00 || ch == 0x0a) || ch == 0x0d) {
- b = 1;
- } else {
- x[i] = ch;
- i += 1;
- }
- } while (!b);
-}
-
-void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x)
-{
- SHORTINT s;
- CHAR ch;
- LONGINT n;
- s = 0;
- n = 0;
- Files_Read(&*R, R__typ, (void*)&ch);
- while ((int)ch >= 128) {
- n += __ASH((SYSTEM_INT64)((int)ch - 128), s);
- s += 7;
- Files_Read(&*R, R__typ, (void*)&ch);
+ Files_Read(&*R, R__typ, (void*)&x[i]);
+ i += 1;
+ } while (!(x[i - 1] == 0x00 || x[i - 1] == 0x0a));
+ if (x[i - 1] == 0x0a) {
+ i -= 1;
}
- n += __ASH((SYSTEM_INT64)(__MASK((int)ch, -64) - __ASHL(__ASHR((int)ch, 6), 6)), s);
- *x = n;
+ if ((i > 0 && x[i - 1] == 0x0d)) {
+ i -= 1;
+ }
+ x[i] = 0x00;
}
-void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x)
+void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len)
+{
+ INT8 s, b;
+ INT64 q;
+ s = 0;
+ q = 0;
+ Files_Read(&*R, R__typ, (void*)&b);
+ while (b < 0) {
+ q += (INT64)__ASH(((INT16)b + 128), s);
+ s += 7;
+ Files_Read(&*R, R__typ, (void*)&b);
+ }
+ q += (INT64)__ASH((__MASK(b, -64) - __ASHL(__ASHR(b, 6), 6)), s);
+ __ASSERT(x__len <= 8, 0);
+ __MOVE((ADDRESS)&q, (ADDRESS)x, x__len);
+}
+
+void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x)
{
Files_Write(&*R, R__typ, __VAL(CHAR, x));
}
-void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x)
+void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x)
{
CHAR b[2];
b[0] = (CHAR)x;
b[1] = (CHAR)__ASHR(x, 8);
- Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(2)), ((LONGINT)(2)));
+ Files_WriteBytes(&*R, R__typ, (void*)b, 2, 2);
}
-void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x)
+void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x)
{
CHAR b[4];
b[0] = (CHAR)x;
b[1] = (CHAR)__ASHR(x, 8);
b[2] = (CHAR)__ASHR(x, 16);
b[3] = (CHAR)__ASHR(x, 24);
- Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
+ Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
}
-void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x)
+void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x)
{
CHAR b[4];
- LONGINT i;
- i = (LONGINT)x;
+ INT32 i;
+ i = (INT32)x;
b[0] = (CHAR)i;
b[1] = (CHAR)__ASHR(i, 8);
b[2] = (CHAR)__ASHR(i, 16);
b[3] = (CHAR)__ASHR(i, 24);
- Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
+ Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
}
-void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x)
+void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x)
{
CHAR b[4];
- Files_FlipBytes((void*)&x, ((LONGINT)(4)), (void*)b, ((LONGINT)(4)));
- Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
+ Files_FlipBytes((void*)&x, 4, (void*)b, 4);
+ Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
}
-void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x)
+void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x)
{
CHAR b[8];
- Files_FlipBytes((void*)&x, ((LONGINT)(8)), (void*)b, ((LONGINT)(8)));
- Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(8)), ((LONGINT)(8)));
+ Files_FlipBytes((void*)&x, 8, (void*)b, 8);
+ Files_WriteBytes(&*R, R__typ, (void*)b, 8, 8);
}
-void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len)
+void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
{
- INTEGER i;
+ INT16 i;
i = 0;
while (x[i] != 0x00) {
i += 1;
}
- Files_WriteBytes(&*R, R__typ, (void*)x, x__len * ((LONGINT)(1)), i + 1);
+ Files_WriteBytes(&*R, R__typ, (void*)x, x__len * 1, i + 1);
}
-void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x)
+void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x)
{
while (x < -64 || x > 63) {
Files_Write(&*R, R__typ, (CHAR)(__MASK(x, -128) + 128));
@@ -1008,12 +999,12 @@ void Files_GetName (Files_File f, CHAR *name, LONGINT name__len)
static void Files_Finalize (SYSTEM_PTR o)
{
Files_File f = NIL;
- LONGINT res;
- f = (Files_File)(SYSTEM_ADDRESS)o;
+ INT32 res;
+ f = (Files_File)(ADDRESS)o;
if (f->fd >= 0) {
Files_CloseOSFile(f);
if (f->tempFile) {
- res = Platform_Unlink((void*)f->workName, ((LONGINT)(101)));
+ res = Platform_Unlink((void*)f->workName, 101);
}
}
}
@@ -1022,7 +1013,7 @@ void Files_SetSearchPath (CHAR *path, LONGINT path__len)
{
__DUP(path, path__len, CHAR);
if (Strings_Length(path, path__len) != 0) {
- Files_SearchPath = __NEWARR(NIL, ((LONGINT)(1)), 1, 1, 1, (LONGINT)(Strings_Length(path, path__len) + 1));
+ Files_SearchPath = __NEWARR(NIL, 1, 1, 1, 1, ((ADDRESS)((Strings_Length(path, path__len) + 1))));
__COPY(path, Files_SearchPath->data, Files_SearchPath->len[0]);
} else {
Files_SearchPath = NIL;
@@ -1036,16 +1027,15 @@ static void EnumPtrs(void (*P)(void*))
P(Files_SearchPath);
}
-__TDESC(Files_FileDesc, 1, 5) = {__TDFLDS("FileDesc", 304), {256, 264, 272, 280, 296, -48}};
-__TDESC(Files_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 4128), {0, -16}};
-__TDESC(Files_Rider, 1, 1) = {__TDFLDS("Rider", 40), {16, -16}};
+__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}};
export void *Files__init(void)
{
__DEFMOD;
- __MODULE_IMPORT(Configuration);
- __MODULE_IMPORT(Console);
__MODULE_IMPORT(Heap);
+ __MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
__REGMOD("Files", EnumPtrs);
@@ -1056,6 +1046,6 @@ export void *Files__init(void)
Files_tempno = -1;
Heap_FileCount = 0;
Files_HOME[0] = 0x00;
- Platform_GetEnv((CHAR*)"HOME", (LONGINT)5, (void*)Files_HOME, ((LONGINT)(1024)));
+ Platform_GetEnv((CHAR*)"HOME", 5, (void*)Files_HOME, 1024);
__ENDMOD;
}
diff --git a/bootstrap/unix-88/Files.h b/bootstrap/unix-88/Files.h
index 62487a35..855c5f7c 100644
--- a/bootstrap/unix-88/Files.h
+++ b/bootstrap/unix-88/Files.h
@@ -1,9 +1,8 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
#ifndef Files__h
#define Files__h
-#define LARGE
#include "SYSTEM.h"
typedef
@@ -11,61 +10,62 @@ typedef
typedef
struct Files_FileDesc {
- char _prvt0[232];
- LONGINT fd;
- char _prvt1[64];
+ INT64 _prvt0;
+ char _prvt1[208];
+ INT32 fd;
+ char _prvt2[60];
} Files_FileDesc;
typedef
struct Files_Rider {
- LONGINT res;
+ INT32 res;
BOOLEAN eof;
- char _prvt0[31];
+ INT64 _prvt0;
+ char _prvt1[8];
} Files_Rider;
-import LONGINT *Files_FileDesc__typ;
-import LONGINT *Files_Rider__typ;
+import ADDRESS *Files_FileDesc__typ;
+import ADDRESS *Files_Rider__typ;
-import Files_File Files_Base (Files_Rider *r, LONGINT *r__typ);
-import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res);
+import Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
+import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res);
import void Files_Close (Files_File f);
-import void Files_Delete (CHAR *name, LONGINT name__len, INTEGER *res);
-import void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d);
+import void Files_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, LONGINT name__len);
-import LONGINT Files_Length (Files_File f);
+import INT32 Files_Length (Files_File f);
import Files_File Files_New (CHAR *name, LONGINT name__len);
import Files_File Files_Old (CHAR *name, LONGINT name__len);
-import LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ);
+import INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ);
import void Files_Purge (Files_File f);
-import void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x);
-import void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x);
-import void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len);
-import void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n);
-import void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x);
-import void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x);
-import void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x);
-import void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
-import void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x);
-import void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x);
-import void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x);
-import void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
+import void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
+import void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x);
+import void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+import void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x);
+import void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x);
+import void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
+import void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+import void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
+import void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
+import void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
+import void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
import void Files_Register (Files_File f);
-import void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res);
-import void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos);
+import void Files_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, LONGINT path__len);
-import void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x);
-import void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x);
-import void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n);
-import void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x);
-import void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x);
-import void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x);
-import void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x);
-import void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x);
-import void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x);
-import void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
+import void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
+import void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
+import void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+import void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
+import void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
+import void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
+import void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
+import void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
+import void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
+import void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
import void *Files__init(void);
-#endif
+#endif // Files
diff --git a/bootstrap/unix-88/Heap.c b/bootstrap/unix-88/Heap.c
index 9873a734..a2bb8f2f 100644
--- a/bootstrap/unix-88/Heap.c
+++ b/bootstrap/unix-88/Heap.c
@@ -1,5 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tskSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tsSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
struct Heap__1 {
@@ -35,7 +40,7 @@ typedef
typedef
struct Heap_FinDesc {
Heap_FinNode next;
- LONGINT obj;
+ INT64 obj;
BOOLEAN marked;
Heap_Finalizer finalize;
} Heap_FinDesc;
@@ -50,62 +55,61 @@ typedef
struct Heap_ModuleDesc {
Heap_Module next;
Heap_ModuleName name;
- LONGINT refcnt;
+ INT32 refcnt;
Heap_Cmd cmds;
- LONGINT types;
+ INT64 types;
Heap_EnumProc enumPtrs;
- LONGINT reserved1, reserved2;
+ INT32 reserved1, reserved2;
} Heap_ModuleDesc;
export SYSTEM_PTR Heap_modules;
-static LONGINT Heap_freeList[10];
-static LONGINT Heap_bigBlocks;
-export LONGINT Heap_allocated;
+static INT64 Heap_freeList[10];
+static INT64 Heap_bigBlocks;
+export INT64 Heap_allocated;
static BOOLEAN Heap_firstTry;
-static LONGINT Heap_heap, Heap_heapend;
-export LONGINT Heap_heapsize;
+static INT64 Heap_heap, Heap_heapend;
+export INT64 Heap_heapsize;
static Heap_FinNode Heap_fin;
-static INTEGER Heap_lockdepth;
+static INT16 Heap_lockdepth;
static BOOLEAN Heap_interrupted;
-export INTEGER Heap_FileCount;
+export INT16 Heap_FileCount;
-export LONGINT *Heap_ModuleDesc__typ;
-export LONGINT *Heap_CmdDesc__typ;
-export LONGINT *Heap_FinDesc__typ;
-export LONGINT *Heap__1__typ;
+export ADDRESS *Heap_ModuleDesc__typ;
+export ADDRESS *Heap_CmdDesc__typ;
+export ADDRESS *Heap_FinDesc__typ;
+export ADDRESS *Heap__1__typ;
static void Heap_CheckFin (void);
-static void Heap_ExtendHeap (LONGINT blksz);
+static void Heap_ExtendHeap (INT64 blksz);
export void Heap_FINALL (void);
static void Heap_Finalize (void);
export void Heap_GC (BOOLEAN markStack);
-static void Heap_HeapSort (LONGINT n, LONGINT *a, LONGINT a__len);
+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 (LONGINT q);
-static void Heap_MarkCandidates (LONGINT n, LONGINT *cand, LONGINT cand__len);
+static void Heap_Mark (INT64 q);
+static void Heap_MarkCandidates (INT64 n, INT64 *cand, LONGINT cand__len);
static void Heap_MarkP (SYSTEM_PTR p);
-static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len);
-export SYSTEM_PTR Heap_NEWBLK (LONGINT size);
-export SYSTEM_PTR Heap_NEWREC (LONGINT tag);
-static LONGINT Heap_NewChunk (LONGINT blksz);
+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);
export void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd);
export SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs);
-export void Heap_REGTYP (Heap_Module m, LONGINT typ);
+export void Heap_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 (LONGINT l, LONGINT r, LONGINT *a, LONGINT 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 LONGINT Platform_MainStackFrame;
-extern LONGINT Platform_OSAllocate(LONGINT size);
-#define Heap_FetchAddress(pointer) (LONGINT)(SYSTEM_ADDRESS)(*((void**)((SYSTEM_ADDRESS)pointer)))
+extern ADDRESS Platform_MainStackFrame;
+extern ADDRESS Platform_OSAllocate(ADDRESS size);
#define Heap_HeapModuleInit() Heap__init()
+#define Heap_ModulesHalt(code) Modules_Halt(code)
#define Heap_OSAllocate(size) Platform_OSAllocate(size)
-#define Heap_PlatformHalt(code) Platform_Halt(code)
#define Heap_PlatformMainStackFrame() Platform_MainStackFrame
void Heap_Lock (void)
@@ -117,28 +121,26 @@ void Heap_Unlock (void)
{
Heap_lockdepth -= 1;
if ((Heap_interrupted && Heap_lockdepth == 0)) {
- Heap_PlatformHalt(((LONGINT)(-9)));
+ Heap_ModulesHalt(-9);
}
}
SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs)
{
- SYSTEM_PTR _o_result;
Heap_Module m;
if (__STRCMP(name, "Heap") == 0) {
- __SYSNEW(m, 80);
+ __SYSNEW(m, 64);
} else {
__NEW(m, Heap_ModuleDesc);
}
m->types = 0;
m->cmds = NIL;
- __COPY(name, m->name, ((LONGINT)(20)));
+ __COPY(name, m->name, 20);
m->refcnt = 0;
m->enumPtrs = enumPtrs;
- m->next = (Heap_Module)(SYSTEM_ADDRESS)Heap_modules;
+ m->next = (Heap_Module)(ADDRESS)Heap_modules;
Heap_modules = (SYSTEM_PTR)m;
- _o_result = (void*)m;
- return _o_result;
+ return (void*)m;
}
void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd)
@@ -149,15 +151,15 @@ void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd)
} else {
__NEW(c, Heap_CmdDesc);
}
- __COPY(name, c->name, ((LONGINT)(24)));
+ __COPY(name, c->name, 24);
c->cmd = cmd;
c->next = m->cmds;
m->cmds = c;
}
-void Heap_REGTYP (Heap_Module m, LONGINT typ)
+void Heap_REGTYP (Heap_Module m, INT64 typ)
{
- __PUT(typ, m->types, LONGINT);
+ __PUT(typ, m->types, INT64);
m->types = typ;
}
@@ -166,27 +168,25 @@ void Heap_INCREF (Heap_Module m)
m->refcnt += 1;
}
-static LONGINT Heap_NewChunk (LONGINT blksz)
+static INT64 Heap_NewChunk (INT64 blksz)
{
- LONGINT _o_result;
- LONGINT chnk;
+ INT64 chnk;
chnk = Heap_OSAllocate(blksz + 24);
if (chnk != 0) {
- __PUT(chnk + 8, chnk + (24 + blksz), LONGINT);
- __PUT(chnk + 24, chnk + 32, LONGINT);
- __PUT(chnk + 32, blksz, LONGINT);
- __PUT(chnk + 40, -8, LONGINT);
- __PUT(chnk + 48, Heap_bigBlocks, LONGINT);
+ __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;
}
- _o_result = chnk;
- return _o_result;
+ return chnk;
}
-static void Heap_ExtendHeap (LONGINT blksz)
+static void Heap_ExtendHeap (INT64 blksz)
{
- LONGINT size, chnk, j, next;
+ INT64 size, chnk, j, next;
if (blksz > 320000) {
size = blksz;
} else {
@@ -195,31 +195,30 @@ static void Heap_ExtendHeap (LONGINT blksz)
chnk = Heap_NewChunk(size);
if (chnk != 0) {
if (chnk < Heap_heap) {
- __PUT(chnk, Heap_heap, LONGINT);
+ __PUT(chnk, Heap_heap, INT64);
Heap_heap = chnk;
} else {
j = Heap_heap;
- next = Heap_FetchAddress(j);
+ __GET(j, next, INT64);
while ((next != 0 && chnk > next)) {
j = next;
- next = Heap_FetchAddress(j);
+ __GET(j, next, INT64);
}
- __PUT(chnk, next, LONGINT);
- __PUT(j, chnk, LONGINT);
+ __PUT(chnk, next, INT64);
+ __PUT(j, chnk, INT64);
}
if (next == 0) {
- Heap_heapend = Heap_FetchAddress(chnk + 8);
+ __GET(chnk + 8, Heap_heapend, INT64);
}
}
}
-SYSTEM_PTR Heap_NEWREC (LONGINT tag)
+SYSTEM_PTR Heap_NEWREC (INT64 tag)
{
- SYSTEM_PTR _o_result;
- LONGINT i, i0, di, blksz, restsize, t, adr, end, next, prev;
+ INT64 i, i0, di, blksz, restsize, t, adr, end, next, prev;
SYSTEM_PTR new;
Heap_Lock();
- blksz = Heap_FetchAddress(tag);
+ __GET(tag, blksz, INT64);
i0 = __ASHR(blksz, 5);
i = i0;
if (i < 9) {
@@ -230,17 +229,17 @@ SYSTEM_PTR Heap_NEWREC (LONGINT tag)
}
}
if (i < 9) {
- next = Heap_FetchAddress(adr + 24);
+ __GET(adr + 24, next, INT64);
Heap_freeList[i] = next;
if (i != i0) {
di = i - i0;
restsize = __ASHL(di, 5);
end = adr + restsize;
- __PUT(end + 8, blksz, LONGINT);
- __PUT(end + 16, -8, LONGINT);
- __PUT(end, end + 8, LONGINT);
- __PUT(adr + 8, restsize, LONGINT);
- __PUT(adr + 24, Heap_freeList[di], LONGINT);
+ __PUT(end + 8, blksz, INT64);
+ __PUT(end + 16, -8, INT64);
+ __PUT(end, end + 8, INT64);
+ __PUT(adr + 8, restsize, INT64);
+ __PUT(adr + 24, Heap_freeList[di], INT64);
Heap_freeList[di] = adr;
adr += restsize;
}
@@ -263,39 +262,37 @@ SYSTEM_PTR Heap_NEWREC (LONGINT tag)
new = Heap_NEWREC(tag);
}
Heap_Unlock();
- _o_result = new;
- return _o_result;
+ return new;
} else {
Heap_Unlock();
- _o_result = NIL;
- return _o_result;
+ return NIL;
}
}
- t = Heap_FetchAddress(adr + 8);
+ __GET(adr + 8, t, INT64);
if (t >= blksz) {
break;
}
prev = adr;
- adr = Heap_FetchAddress(adr + 24);
+ __GET(adr + 24, adr, INT64);
}
restsize = t - blksz;
end = adr + restsize;
- __PUT(end + 8, blksz, LONGINT);
- __PUT(end + 16, -8, LONGINT);
- __PUT(end, end + 8, LONGINT);
+ __PUT(end + 8, blksz, INT64);
+ __PUT(end + 16, -8, INT64);
+ __PUT(end, end + 8, INT64);
if (restsize > 288) {
- __PUT(adr + 8, restsize, LONGINT);
+ __PUT(adr + 8, restsize, INT64);
} else {
- next = Heap_FetchAddress(adr + 24);
+ __GET(adr + 24, next, INT64);
if (prev == 0) {
Heap_bigBlocks = next;
} else {
- __PUT(prev + 24, next, LONGINT);
+ __PUT(prev + 24, next, INT64);
}
if (restsize > 0) {
di = __ASHR(restsize, 5);
- __PUT(adr + 8, restsize, LONGINT);
- __PUT(adr + 24, Heap_freeList[di], LONGINT);
+ __PUT(adr + 8, restsize, INT64);
+ __PUT(adr + 24, Heap_freeList[di], INT64);
Heap_freeList[di] = adr;
}
}
@@ -304,73 +301,70 @@ SYSTEM_PTR Heap_NEWREC (LONGINT tag)
i = adr + 32;
end = adr + blksz;
while (i < end) {
- __PUT(i, 0, LONGINT);
- __PUT(i + 8, 0, LONGINT);
- __PUT(i + 16, 0, LONGINT);
- __PUT(i + 24, 0, LONGINT);
+ __PUT(i, 0, INT64);
+ __PUT(i + 8, 0, INT64);
+ __PUT(i + 16, 0, INT64);
+ __PUT(i + 24, 0, INT64);
i += 32;
}
- __PUT(adr + 24, 0, LONGINT);
- __PUT(adr, tag, LONGINT);
- __PUT(adr + 8, 0, LONGINT);
- __PUT(adr + 16, 0, LONGINT);
+ __PUT(adr + 24, 0, INT64);
+ __PUT(adr, tag, INT64);
+ __PUT(adr + 8, 0, INT64);
+ __PUT(adr + 16, 0, INT64);
Heap_allocated += blksz;
Heap_Unlock();
- _o_result = (SYSTEM_PTR)(SYSTEM_ADDRESS)(adr + 8);
- return _o_result;
+ return (SYSTEM_PTR)(ADDRESS)(adr + 8);
}
-SYSTEM_PTR Heap_NEWBLK (LONGINT size)
+SYSTEM_PTR Heap_NEWBLK (INT64 size)
{
- SYSTEM_PTR _o_result;
- LONGINT blksz, tag;
+ INT64 blksz, tag;
SYSTEM_PTR new;
Heap_Lock();
blksz = __ASHL(__ASHR(size + 63, 5), 5);
- new = Heap_NEWREC((LONGINT)(SYSTEM_ADDRESS)&blksz);
- tag = ((LONGINT)(SYSTEM_ADDRESS)new + blksz) - 24;
- __PUT(tag - 8, 0, LONGINT);
- __PUT(tag, blksz, LONGINT);
- __PUT(tag + 8, -8, LONGINT);
- __PUT((LONGINT)(SYSTEM_ADDRESS)new - 8, tag, LONGINT);
+ new = Heap_NEWREC((ADDRESS)&blksz);
+ tag = ((INT64)(ADDRESS)new + blksz) - 24;
+ __PUT(tag - 8, 0, INT64);
+ __PUT(tag, blksz, INT64);
+ __PUT(tag + 8, -8, INT64);
+ __PUT((INT64)(ADDRESS)new - 8, tag, INT64);
Heap_Unlock();
- _o_result = new;
- return _o_result;
+ return new;
}
-static void Heap_Mark (LONGINT q)
+static void Heap_Mark (INT64 q)
{
- LONGINT p, tag, fld, n, offset, tagbits;
+ INT64 p, tag, offset, fld, n, tagbits;
if (q != 0) {
- tagbits = Heap_FetchAddress(q - 8);
+ __GET(q - 8, tagbits, INT64);
if (!__ODD(tagbits)) {
- __PUT(q - 8, tagbits + 1, LONGINT);
+ __PUT(q - 8, tagbits + 1, INT64);
p = 0;
tag = tagbits + 8;
for (;;) {
- __GET(tag, offset, LONGINT);
+ __GET(tag, offset, INT64);
if (offset < 0) {
- __PUT(q - 8, (tag + offset) + 1, LONGINT);
+ __PUT(q - 8, (tag + offset) + 1, INT64);
if (p == 0) {
break;
}
n = q;
q = p;
- tag = Heap_FetchAddress(q - 8);
+ __GET(q - 8, tag, INT64);
tag -= 1;
- __GET(tag, offset, LONGINT);
+ __GET(tag, offset, INT64);
fld = q + offset;
- p = Heap_FetchAddress(fld);
- __PUT(fld, (SYSTEM_PTR)(SYSTEM_ADDRESS)n, SYSTEM_PTR);
+ __GET(fld, p, INT64);
+ __PUT(fld, (SYSTEM_PTR)(ADDRESS)n, SYSTEM_PTR);
} else {
fld = q + offset;
- n = Heap_FetchAddress(fld);
+ __GET(fld, n, INT64);
if (n != 0) {
- tagbits = Heap_FetchAddress(n - 8);
+ __GET(n - 8, tagbits, INT64);
if (!__ODD(tagbits)) {
- __PUT(n - 8, tagbits + 1, LONGINT);
- __PUT(q - 8, tag + 1, LONGINT);
- __PUT(fld, (SYSTEM_PTR)(SYSTEM_ADDRESS)p, SYSTEM_PTR);
+ __PUT(n - 8, tagbits + 1, INT64);
+ __PUT(q - 8, tag + 1, INT64);
+ __PUT(fld, (SYSTEM_PTR)(ADDRESS)p, SYSTEM_PTR);
p = q;
q = n;
tag = tagbits;
@@ -385,12 +379,12 @@ static void Heap_Mark (LONGINT q)
static void Heap_MarkP (SYSTEM_PTR p)
{
- Heap_Mark((LONGINT)(SYSTEM_ADDRESS)p);
+ Heap_Mark((INT64)(ADDRESS)p);
}
static void Heap_Scan (void)
{
- LONGINT chnk, adr, end, start, tag, i, size, freesize;
+ INT64 chnk, adr, end, start, tag, i, size, freesize;
Heap_bigBlocks = 0;
i = 1;
while (i < 9) {
@@ -402,58 +396,58 @@ static void Heap_Scan (void)
chnk = Heap_heap;
while (chnk != 0) {
adr = chnk + 24;
- end = Heap_FetchAddress(chnk + 8);
+ __GET(chnk + 8, end, INT64);
while (adr < end) {
- tag = Heap_FetchAddress(adr);
+ __GET(adr, tag, INT64);
if (__ODD(tag)) {
if (freesize > 0) {
start = adr - freesize;
- __PUT(start, start + 8, LONGINT);
- __PUT(start + 8, freesize, LONGINT);
- __PUT(start + 16, -8, LONGINT);
+ __PUT(start, start + 8, INT64);
+ __PUT(start + 8, freesize, INT64);
+ __PUT(start + 16, -8, INT64);
i = __ASHR(freesize, 5);
freesize = 0;
if (i < 9) {
- __PUT(start + 24, Heap_freeList[i], LONGINT);
+ __PUT(start + 24, Heap_freeList[i], INT64);
Heap_freeList[i] = start;
} else {
- __PUT(start + 24, Heap_bigBlocks, LONGINT);
+ __PUT(start + 24, Heap_bigBlocks, INT64);
Heap_bigBlocks = start;
}
}
tag -= 1;
- __PUT(adr, tag, LONGINT);
- size = Heap_FetchAddress(tag);
+ __PUT(adr, tag, INT64);
+ __GET(tag, size, INT64);
Heap_allocated += size;
adr += size;
} else {
- size = Heap_FetchAddress(tag);
+ __GET(tag, size, INT64);
freesize += size;
adr += size;
}
}
if (freesize > 0) {
start = adr - freesize;
- __PUT(start, start + 8, LONGINT);
- __PUT(start + 8, freesize, LONGINT);
- __PUT(start + 16, -8, LONGINT);
+ __PUT(start, start + 8, INT64);
+ __PUT(start + 8, freesize, INT64);
+ __PUT(start + 16, -8, INT64);
i = __ASHR(freesize, 5);
freesize = 0;
if (i < 9) {
- __PUT(start + 24, Heap_freeList[i], LONGINT);
+ __PUT(start + 24, Heap_freeList[i], INT64);
Heap_freeList[i] = start;
} else {
- __PUT(start + 24, Heap_bigBlocks, LONGINT);
+ __PUT(start + 24, Heap_bigBlocks, INT64);
Heap_bigBlocks = start;
}
}
- chnk = Heap_FetchAddress(chnk);
+ __GET(chnk, chnk, INT64);
}
}
-static void Heap_Sift (LONGINT l, LONGINT r, LONGINT *a, LONGINT a__len)
+static void Heap_Sift (INT64 l, INT64 r, INT64 *a, LONGINT a__len)
{
- LONGINT i, j, x;
+ INT64 i, j, x;
j = l;
x = a[j];
for (;;) {
@@ -470,9 +464,9 @@ static void Heap_Sift (LONGINT l, LONGINT r, LONGINT *a, LONGINT a__len)
a[i] = x;
}
-static void Heap_HeapSort (LONGINT n, LONGINT *a, LONGINT a__len)
+static void Heap_HeapSort (INT64 n, INT64 *a, LONGINT a__len)
{
- LONGINT l, r, x;
+ INT64 l, r, x;
l = __ASHR(n, 1);
r = n - 1;
while (l > 0) {
@@ -488,25 +482,25 @@ static void Heap_HeapSort (LONGINT n, LONGINT *a, LONGINT a__len)
}
}
-static void Heap_MarkCandidates (LONGINT n, LONGINT *cand, LONGINT cand__len)
+static void Heap_MarkCandidates (INT64 n, INT64 *cand, LONGINT cand__len)
{
- LONGINT chnk, adr, tag, next, lim, lim1, i, ptr, size;
+ INT64 chnk, adr, tag, next, lim, lim1, i, ptr, size;
chnk = Heap_heap;
i = 0;
lim = cand[n - 1];
while ((chnk != 0 && chnk < lim)) {
adr = chnk + 24;
- lim1 = Heap_FetchAddress(chnk + 8);
+ __GET(chnk + 8, lim1, INT64);
if (lim < lim1) {
lim1 = lim;
}
while (adr < lim1) {
- tag = Heap_FetchAddress(adr);
+ __GET(adr, tag, INT64);
if (__ODD(tag)) {
- size = Heap_FetchAddress(tag - 1);
+ __GET(tag - 1, size, INT64);
adr += size;
} else {
- size = Heap_FetchAddress(tag);
+ __GET(tag, size, INT64);
ptr = adr + 8;
while (cand[i] < ptr) {
i += 1;
@@ -521,17 +515,17 @@ static void Heap_MarkCandidates (LONGINT n, LONGINT *cand, LONGINT cand__len)
adr = next;
}
}
- chnk = Heap_FetchAddress(chnk);
+ __GET(chnk, chnk, INT64);
}
}
static void Heap_CheckFin (void)
{
Heap_FinNode n;
- LONGINT tag;
+ INT64 tag;
n = Heap_fin;
while (n != NIL) {
- tag = Heap_FetchAddress(n->obj - 8);
+ __GET(n->obj - 8, tag, INT64);
if (!__ODD(tag)) {
n->marked = 0;
Heap_Mark(n->obj);
@@ -554,7 +548,7 @@ static void Heap_Finalize (void)
} else {
prev->next = n->next;
}
- (*n->finalize)((SYSTEM_PTR)(SYSTEM_ADDRESS)n->obj);
+ (*n->finalize)((SYSTEM_PTR)(ADDRESS)n->obj);
if (prev == NIL) {
n = Heap_fin;
} else {
@@ -573,14 +567,14 @@ void Heap_FINALL (void)
while (Heap_fin != NIL) {
n = Heap_fin;
Heap_fin = Heap_fin->next;
- (*n->finalize)((SYSTEM_PTR)(SYSTEM_ADDRESS)n->obj);
+ (*n->finalize)((SYSTEM_PTR)(ADDRESS)n->obj);
}
}
-static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len)
+static void Heap_MarkStack (INT64 n, INT64 *cand, LONGINT cand__len)
{
SYSTEM_PTR frame;
- LONGINT inc, nofcand, sp, p, stack0;
+ INT64 inc, nofcand, sp, p, stack0;
struct Heap__1 align;
if (n > 0) {
Heap_MarkStack(n - 1, cand, cand__len);
@@ -590,16 +584,16 @@ static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len)
}
if (n == 0) {
nofcand = 0;
- sp = (LONGINT)(SYSTEM_ADDRESS)&frame;
+ sp = (ADDRESS)&frame;
stack0 = Heap_PlatformMainStackFrame();
- inc = (LONGINT)(SYSTEM_ADDRESS)&align.p - (LONGINT)(SYSTEM_ADDRESS)&align;
+ inc = (ADDRESS)&align.p - (ADDRESS)&align;
if (sp > stack0) {
inc = -inc;
}
while (sp != stack0) {
- __GET(sp, p, LONGINT);
+ __GET(sp, p, INT64);
if ((p > Heap_heap && p < Heap_heapend)) {
- if (nofcand == cand__len) {
+ if (nofcand == (INT64)cand__len) {
Heap_HeapSort(nofcand, (void*)cand, cand__len);
Heap_MarkCandidates(nofcand, (void*)cand, cand__len);
nofcand = 0;
@@ -619,11 +613,11 @@ static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len)
void Heap_GC (BOOLEAN markStack)
{
Heap_Module m;
- LONGINT i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23;
- LONGINT cand[10000];
+ INT64 i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23;
+ INT64 cand[10000];
if (Heap_lockdepth == 0 || (Heap_lockdepth == 1 && !markStack)) {
Heap_Lock();
- m = (Heap_Module)(SYSTEM_ADDRESS)Heap_modules;
+ m = (Heap_Module)(ADDRESS)Heap_modules;
while (m != NIL) {
if (m->enumPtrs != NIL) {
(*m->enumPtrs)(Heap_MarkP);
@@ -681,7 +675,7 @@ void Heap_GC (BOOLEAN markStack)
i22 += 23;
i23 += 24;
if ((i0 == -99 && i15 == 24)) {
- Heap_MarkStack(((LONGINT)(32)), (void*)cand, ((LONGINT)(10000)));
+ Heap_MarkStack(32, (void*)cand, 10000);
break;
}
}
@@ -700,7 +694,7 @@ void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
{
Heap_FinNode f;
__NEW(f, Heap_FinDesc);
- f->obj = (LONGINT)(SYSTEM_ADDRESS)obj;
+ f->obj = (INT64)(ADDRESS)obj;
f->finalize = finalize;
f->marked = 1;
f->next = Heap_fin;
@@ -709,9 +703,9 @@ void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
void Heap_InitHeap (void)
{
- Heap_heap = Heap_NewChunk(((LONGINT)(256000)));
- Heap_heapend = Heap_FetchAddress(Heap_heap + 8);
- __PUT(Heap_heap, 0, LONGINT);
+ 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;
@@ -731,7 +725,7 @@ static void EnumPtrs(void (*P)(void*))
P(Heap_fin);
}
-__TDESC(Heap_ModuleDesc, 1, 2) = {__TDFLDS("ModuleDesc", 80), {0, 40, -24}};
+__TDESC(Heap_ModuleDesc, 1, 2) = {__TDFLDS("ModuleDesc", 64), {0, 32, -24}};
__TDESC(Heap_CmdDesc, 1, 1) = {__TDFLDS("CmdDesc", 40), {0, -16}};
__TDESC(Heap_FinDesc, 1, 1) = {__TDFLDS("FinDesc", 32), {0, -16}};
__TDESC(Heap__1, 1, 1) = {__TDFLDS("", 16), {8, -16}};
diff --git a/bootstrap/unix-88/Heap.h b/bootstrap/unix-88/Heap.h
index b1ff5968..163cad8c 100644
--- a/bootstrap/unix-88/Heap.h
+++ b/bootstrap/unix-88/Heap.h
@@ -1,9 +1,8 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tskSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tsSF */
#ifndef Heap__h
#define Heap__h
-#define LARGE
#include "SYSTEM.h"
typedef
@@ -23,8 +22,8 @@ typedef
typedef
struct Heap_ModuleDesc {
- LONGINT _prvt0;
- char _prvt1[72];
+ INT64 _prvt0;
+ char _prvt1[56];
} Heap_ModuleDesc;
typedef
@@ -32,24 +31,24 @@ typedef
import SYSTEM_PTR Heap_modules;
-import LONGINT Heap_allocated, Heap_heapsize;
-import INTEGER Heap_FileCount;
+import INT64 Heap_allocated, Heap_heapsize;
+import INT16 Heap_FileCount;
-import LONGINT *Heap_ModuleDesc__typ;
+import ADDRESS *Heap_ModuleDesc__typ;
import void Heap_FINALL (void);
import void Heap_GC (BOOLEAN markStack);
import void Heap_INCREF (Heap_Module m);
import void Heap_InitHeap (void);
import void Heap_Lock (void);
-import SYSTEM_PTR Heap_NEWBLK (LONGINT size);
-import SYSTEM_PTR Heap_NEWREC (LONGINT tag);
+import SYSTEM_PTR Heap_NEWBLK (INT64 size);
+import SYSTEM_PTR Heap_NEWREC (INT64 tag);
import void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd);
import SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs);
-import void Heap_REGTYP (Heap_Module m, LONGINT typ);
+import void Heap_REGTYP (Heap_Module m, INT64 typ);
import void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize);
import void Heap_Unlock (void);
import void *Heap__init(void);
-#endif
+#endif // Heap
diff --git a/bootstrap/unix-88/Modules.c b/bootstrap/unix-88/Modules.c
index 0c836ead..4e4d62e7 100644
--- a/bootstrap/unix-88/Modules.c
+++ b/bootstrap/unix-88/Modules.c
@@ -1,8 +1,13 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
-#include "Console.h"
#include "Heap.h"
+#include "Platform.h"
typedef
struct Modules_CmdDesc *Modules_Cmd;
@@ -27,32 +32,38 @@ typedef
struct Modules_ModuleDesc {
Modules_Module next;
Modules_ModuleName name;
- LONGINT refcnt;
+ INT32 refcnt;
Modules_Cmd cmds;
- LONGINT types;
- void (*enumPtrs)(void(*)(LONGINT));
- LONGINT reserved1, reserved2;
+ INT32 types;
+ void (*enumPtrs)(void(*)(INT32));
+ INT32 reserved1, reserved2;
} Modules_ModuleDesc;
-export INTEGER Modules_res;
+export INT16 Modules_res;
export CHAR Modules_resMsg[256];
export Modules_ModuleName Modules_imported, Modules_importing;
-export LONGINT *Modules_ModuleDesc__typ;
-export LONGINT *Modules_CmdDesc__typ;
+export ADDRESS *Modules_ModuleDesc__typ;
+export ADDRESS *Modules_CmdDesc__typ;
static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len);
+export void Modules_AssertFail (INT32 code);
+static void Modules_DisplayHaltCode (INT32 code);
export void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
+export void Modules_Halt (INT32 code);
export Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
export Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
+static void Modules_errch (CHAR c);
+static void Modules_errint (INT32 l);
+static void Modules_errstring (CHAR *s, LONGINT s__len);
#define Modules_modules() (Modules_Module)Heap_modules
#define Modules_setmodules(m) Heap_modules = m
static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len)
{
- INTEGER i, j;
+ INT16 i, j;
__DUP(b, b__len, CHAR);
i = 0;
while (a[__X(i, a__len)] != 0x00) {
@@ -70,7 +81,6 @@ static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len)
Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
{
- Modules_Module _o_result;
Modules_Module m = NIL;
CHAR bodyname[64];
Modules_Command body;
@@ -84,19 +94,17 @@ Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
Modules_resMsg[0] = 0x00;
} else {
Modules_res = 1;
- __COPY(name, Modules_importing, ((LONGINT)(20)));
+ __COPY(name, Modules_importing, 20);
__MOVE(" module \"", Modules_resMsg, 10);
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), name, name__len);
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)"\" not found", (LONGINT)12);
+ Modules_Append((void*)Modules_resMsg, 256, name, name__len);
+ Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
}
- _o_result = m;
__DEL(name);
- return _o_result;
+ return m;
}
Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len)
{
- Modules_Command _o_result;
Modules_Cmd c = NIL;
__DUP(name, name__len, CHAR);
c = mod->cmds;
@@ -106,20 +114,18 @@ Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT nam
if (c != NIL) {
Modules_res = 0;
Modules_resMsg[0] = 0x00;
- _o_result = c->cmd;
__DEL(name);
- return _o_result;
+ return c->cmd;
} else {
Modules_res = 2;
__MOVE(" command \"", Modules_resMsg, 11);
- __COPY(name, Modules_importing, ((LONGINT)(20)));
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), mod->name, ((LONGINT)(20)));
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)".", (LONGINT)2);
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), name, name__len);
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)"\" not found", (LONGINT)12);
- _o_result = NIL;
+ __COPY(name, Modules_importing, 20);
+ Modules_Append((void*)Modules_resMsg, 256, mod->name, 20);
+ Modules_Append((void*)Modules_resMsg, 256, (CHAR*)".", 2);
+ Modules_Append((void*)Modules_resMsg, 256, name, name__len);
+ Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
__DEL(name);
- return _o_result;
+ return NIL;
}
__RETCHK;
}
@@ -156,14 +162,124 @@ void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all)
__DEL(name);
}
-__TDESC(Modules_ModuleDesc, 1, 2) = {__TDFLDS("ModuleDesc", 80), {0, 40, -24}};
+static void Modules_errch (CHAR c)
+{
+ INT16 e;
+ e = Platform_Write(1, (ADDRESS)&c, 1);
+}
+
+static void Modules_errstring (CHAR *s, LONGINT s__len)
+{
+ INT32 i;
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
+ Modules_errch(s[__X(i, s__len)]);
+ i += 1;
+ }
+ __DEL(s);
+}
+
+static void Modules_errint (INT32 l)
+{
+ if (l < 0) {
+ Modules_errch('-');
+ l = -l;
+ }
+ if (l >= 10) {
+ Modules_errint(__DIV(l, 10));
+ }
+ Modules_errch((CHAR)((int)__MOD(l, 10) + 48));
+}
+
+static void Modules_DisplayHaltCode (INT32 code)
+{
+ switch (code) {
+ case -1:
+ Modules_errstring((CHAR*)"Assertion failure.", 19);
+ break;
+ case -2:
+ Modules_errstring((CHAR*)"Index out of range.", 20);
+ break;
+ case -3:
+ Modules_errstring((CHAR*)"Reached end of function without reaching RETURN.", 49);
+ break;
+ case -4:
+ Modules_errstring((CHAR*)"CASE statement: no matching label and no ELSE.", 47);
+ break;
+ case -5:
+ Modules_errstring((CHAR*)"Type guard failed.", 19);
+ break;
+ case -6:
+ Modules_errstring((CHAR*)"Implicit type guard in record assignment failed.", 49);
+ break;
+ case -7:
+ Modules_errstring((CHAR*)"Invalid case in WITH statement.", 32);
+ break;
+ case -8:
+ Modules_errstring((CHAR*)"Value out of range.", 20);
+ break;
+ case -9:
+ Modules_errstring((CHAR*)"Heap interrupted while locked, but lockdepth = 0 at unlock.", 60);
+ break;
+ case -10:
+ Modules_errstring((CHAR*)"NIL access.", 12);
+ break;
+ case -11:
+ Modules_errstring((CHAR*)"Alignment error.", 17);
+ break;
+ case -12:
+ Modules_errstring((CHAR*)"Divide by zero.", 16);
+ break;
+ case -13:
+ Modules_errstring((CHAR*)"Arithmetic overflow/underflow.", 31);
+ break;
+ case -14:
+ Modules_errstring((CHAR*)"Invalid function argument.", 27);
+ break;
+ case -15:
+ Modules_errstring((CHAR*)"Internal error, e.g. Type descriptor size mismatch.", 52);
+ break;
+ case -20:
+ Modules_errstring((CHAR*)"Too many, or negative number of, elements in dynamic array.", 60);
+ break;
+ default:
+ break;
+ }
+}
+
+void Modules_Halt (INT32 code)
+{
+ Modules_errstring((CHAR*)"Terminated by Halt(", 20);
+ Modules_errint(code);
+ Modules_errstring((CHAR*)"). ", 4);
+ if (code < 0) {
+ Modules_DisplayHaltCode(code);
+ }
+ Modules_errstring(Platform_NL, 3);
+ Platform_Exit(code);
+}
+
+void Modules_AssertFail (INT32 code)
+{
+ Modules_errstring((CHAR*)"Assertion failure.", 19);
+ if (code != 0) {
+ Modules_errstring((CHAR*)" ASSERT code ", 14);
+ Modules_errint(code);
+ Modules_errstring((CHAR*)".", 2);
+ }
+ Modules_errstring(Platform_NL, 3);
+ 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)
{
__DEFMOD;
- __MODULE_IMPORT(Console);
__MODULE_IMPORT(Heap);
+ __MODULE_IMPORT(Platform);
__REGMOD("Modules", 0);
__INITYP(Modules_ModuleDesc, Modules_ModuleDesc, 0);
__INITYP(Modules_CmdDesc, Modules_CmdDesc, 0);
diff --git a/bootstrap/unix-88/Modules.h b/bootstrap/unix-88/Modules.h
index 6e6ded2e..8bb89fe5 100644
--- a/bootstrap/unix-88/Modules.h
+++ b/bootstrap/unix-88/Modules.h
@@ -1,9 +1,8 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Modules__h
#define Modules__h
-#define LARGE
#include "SYSTEM.h"
typedef
@@ -29,27 +28,27 @@ typedef
struct Modules_ModuleDesc {
Modules_Module next;
Modules_ModuleName name;
- LONGINT refcnt;
+ INT32 refcnt;
Modules_Cmd cmds;
- LONGINT types;
- void (*enumPtrs)(void(*)(LONGINT));
- char _prvt0[16];
+ INT32 types;
+ void (*enumPtrs)(void(*)(INT32));
+ char _prvt0[8];
} Modules_ModuleDesc;
-import INTEGER Modules_res;
+import INT16 Modules_res;
import CHAR Modules_resMsg[256];
import Modules_ModuleName Modules_imported, Modules_importing;
-import LONGINT *Modules_ModuleDesc__typ;
-import LONGINT *Modules_CmdDesc__typ;
+import ADDRESS *Modules_ModuleDesc__typ;
+import ADDRESS *Modules_CmdDesc__typ;
+import void Modules_AssertFail (INT32 code);
import void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
+import void Modules_Halt (INT32 code);
import Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
import Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
import void *Modules__init(void);
-#define Modules_modules() (Modules_Module)Heap_modules
-#define Modules_setmodules(m) Heap_modules = m
-#endif
+#endif // Modules
diff --git a/bootstrap/unix-88/OPB.c b/bootstrap/unix-88/OPB.c
index f4bdb1a8..3ef8e2f9 100644
--- a/bootstrap/unix-88/OPB.c
+++ b/bootstrap/unix-88/OPB.c
@@ -1,19 +1,23 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "OPM.h"
#include "OPS.h"
#include "OPT.h"
-export void (*OPB_typSize)(OPT_Struct);
-static INTEGER OPB_exp;
-static LONGINT OPB_maxExp;
+static INT16 OPB_exp;
+static INT64 OPB_maxExp;
export void OPB_Assign (OPT_Node *x, OPT_Node y);
-static void OPB_BindNodes (SHORTINT class, OPT_Struct typ, OPT_Node *x, OPT_Node y);
-static LONGINT OPB_BoolToInt (BOOLEAN b);
+static void OPB_BindNodes (INT8 class, OPT_Struct typ, OPT_Node *x, OPT_Node y);
+static INT16 OPB_BoolToInt (BOOLEAN b);
export void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp);
static void OPB_CharToString (OPT_Node n);
static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode);
@@ -21,10 +25,10 @@ static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo);
export void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames);
static void OPB_CheckProc (OPT_Struct x, OPT_Object y);
static void OPB_CheckPtr (OPT_Node x, OPT_Node y);
-static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x);
+static void OPB_CheckRealType (INT16 f, INT16 nr, OPT_Const x);
static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp);
-static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y);
-export void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y);
+static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y);
+export void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y);
static void OPB_Convert (OPT_Node *x, OPT_Struct typ);
export void OPB_DeRef (OPT_Node *x);
static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar);
@@ -34,19 +38,17 @@ export void OPB_Field (OPT_Node *x, OPT_Object y);
export void OPB_In (OPT_Node *x, OPT_Node y);
export void OPB_Index (OPT_Node *x, OPT_Node y);
export void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ);
-static BOOLEAN OPB_IntToBool (LONGINT i);
-static OPT_Struct OPB_IntType (LONGINT size);
+static BOOLEAN OPB_IntToBool (INT64 i);
export void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y);
-static LONGINT OPB_LongerSize (LONGINT i);
-export void OPB_MOp (SHORTINT op, OPT_Node *x);
+export void OPB_MOp (INT8 op, OPT_Node *x);
export OPT_Node OPB_NewBoolConst (BOOLEAN boolval);
-export OPT_Node OPB_NewIntConst (LONGINT intval);
+export OPT_Node OPB_NewIntConst (INT64 intval);
export OPT_Node OPB_NewLeaf (OPT_Object obj);
export OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ);
-export OPT_Node OPB_NewString (OPS_String str, LONGINT len);
+export OPT_Node OPB_NewString (OPS_String str, INT64 len);
export OPT_Node OPB_Nil (void);
static BOOLEAN OPB_NotVar (OPT_Node x);
-export void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y);
+export void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y);
export void OPB_OptIf (OPT_Node *x);
export void OPB_Param (OPT_Node ap, OPT_Object fp);
export void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar);
@@ -54,26 +56,24 @@ export void OPB_Return (OPT_Node *x, OPT_Object proc);
export void OPB_SetElem (OPT_Node *x);
static void OPB_SetIntType (OPT_Node node);
export void OPB_SetRange (OPT_Node *x, OPT_Node y);
-static LONGINT OPB_ShorterSize (LONGINT i);
-static INTEGER OPB_SignedByteSize (LONGINT n);
-export void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno);
-export void OPB_StPar0 (OPT_Node *par0, INTEGER fctno);
-export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno);
-export void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n);
-export void OPB_StaticLink (SHORTINT dlev);
+static void OPB_SetSetType (OPT_Node node);
+export void OPB_StFct (OPT_Node *par0, INT8 fctno, INT16 parno);
+export void OPB_StPar0 (OPT_Node *par0, INT16 fctno);
+export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno);
+export void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n);
+export void OPB_StaticLink (INT8 dlev);
export void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard);
-static void OPB_err (INTEGER n);
-static LONGINT OPB_log (LONGINT x);
+static void OPB_err (INT16 n);
+static INT64 OPB_log (INT64 x);
-static void OPB_err (INTEGER n)
+static void OPB_err (INT16 n)
{
OPM_err(n);
}
OPT_Node OPB_NewLeaf (OPT_Object obj)
{
- OPT_Node _o_result;
OPT_Node node = NIL;
switch (obj->mode) {
case 1:
@@ -101,11 +101,10 @@ OPT_Node OPB_NewLeaf (OPT_Object obj)
}
node->obj = obj;
node->typ = obj->typ;
- _o_result = node;
- return _o_result;
+ return node;
}
-void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y)
+void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y)
{
OPT_Node node = NIL;
node = OPT_NewNode(class);
@@ -128,42 +127,29 @@ void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y)
*last = y;
}
-static LONGINT OPB_BoolToInt (BOOLEAN b)
+static INT16 OPB_BoolToInt (BOOLEAN b)
{
- LONGINT _o_result;
if (b) {
- _o_result = 1;
- return _o_result;
+ return 1;
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-static BOOLEAN OPB_IntToBool (LONGINT i)
+static BOOLEAN OPB_IntToBool (INT64 i)
{
- BOOLEAN _o_result;
- if (i == 0) {
- _o_result = 0;
- return _o_result;
- } else {
- _o_result = 1;
- return _o_result;
- }
- __RETCHK;
+ return i != 0;
}
OPT_Node OPB_NewBoolConst (BOOLEAN boolval)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->typ = OPT_booltyp;
x->conval = OPT_NewConst();
x->conval->intval = OPB_BoolToInt(boolval);
- _o_result = x;
- return _o_result;
+ return x;
}
void OPB_OptIf (OPT_Node *x)
@@ -203,130 +189,72 @@ void OPB_OptIf (OPT_Node *x)
OPT_Node OPB_Nil (void)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->typ = OPT_niltyp;
x->conval = OPT_NewConst();
x->conval->intval = 0;
- _o_result = x;
- return _o_result;
+ return x;
}
OPT_Node OPB_EmptySet (void)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->typ = OPT_settyp;
x->conval = OPT_NewConst();
x->conval->setval = 0x0;
- _o_result = x;
- return _o_result;
-}
-
-static INTEGER OPB_SignedByteSize (LONGINT n)
-{
- INTEGER _o_result;
- INTEGER b;
- if (n < 0) {
- n = -(n + 1);
- }
- b = 1;
- while ((b < 8 && __ASH(n, -(__ASHL(b, 3) - 1)) != 0)) {
- b += 1;
- }
- _o_result = b;
- return _o_result;
-}
-
-static LONGINT OPB_ShorterSize (LONGINT i)
-{
- LONGINT _o_result;
- if (i >= (SYSTEM_INT64)OPM_LIntSize) {
- _o_result = OPM_IntSize;
- return _o_result;
- } else {
- _o_result = OPM_SIntSize;
- return _o_result;
- }
- __RETCHK;
-}
-
-static LONGINT OPB_LongerSize (LONGINT i)
-{
- LONGINT _o_result;
- if (i <= (SYSTEM_INT64)OPM_SIntSize) {
- _o_result = OPM_IntSize;
- return _o_result;
- } else {
- _o_result = OPM_LIntSize;
- return _o_result;
- }
- __RETCHK;
-}
-
-static OPT_Struct OPB_IntType (LONGINT size)
-{
- OPT_Struct _o_result;
- OPT_Struct result = NIL;
- if (size <= OPT_sinttyp->size) {
- result = OPT_sinttyp;
- } else if (size <= OPT_inttyp->size) {
- result = OPT_inttyp;
- } else {
- result = OPT_linttyp;
- }
- if (size > OPT_linttyp->size) {
- OPB_err(203);
- }
- _o_result = result;
- return _o_result;
+ return x;
}
static void OPB_SetIntType (OPT_Node node)
{
- node->typ = OPB_IntType(OPB_SignedByteSize(node->conval->intval));
+ node->typ = OPT_IntType(OPT_IntSize(node->conval->intval));
}
-OPT_Node OPB_NewIntConst (LONGINT intval)
+static void OPB_SetSetType (OPT_Node node)
+{
+ INT32 i32;
+ __GET((ADDRESS)&node->conval->setval + 4, i32, INT32);
+ if (i32 == 0) {
+ node->typ = OPT_set32typ;
+ } else {
+ node->typ = OPT_set64typ;
+ }
+}
+
+OPT_Node OPB_NewIntConst (INT64 intval)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->conval = OPT_NewConst();
x->conval->intval = intval;
OPB_SetIntType(x);
- _o_result = x;
- return _o_result;
+ return x;
}
OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->conval = OPT_NewConst();
x->conval->realval = realval;
x->typ = typ;
x->conval->intval = -1;
- _o_result = x;
- return _o_result;
+ return x;
}
-OPT_Node OPB_NewString (OPS_String str, LONGINT len)
+OPT_Node OPB_NewString (OPS_String str, INT64 len)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->conval = OPT_NewConst();
x->typ = OPT_stringtyp;
x->conval->intval = -1;
- x->conval->intval2 = len;
+ x->conval->intval2 = OPM_Longint(len);
x->conval->ext = OPT_NewExt();
- __COPY(str, *x->conval->ext, ((LONGINT)(256)));
- _o_result = x;
- return _o_result;
+ __COPY(str, *x->conval->ext, 256);
+ return x;
}
static void OPB_CharToString (OPT_Node n)
@@ -346,7 +274,7 @@ static void OPB_CharToString (OPT_Node n)
n->obj = NIL;
}
-static void OPB_BindNodes (SHORTINT class, OPT_Struct typ, OPT_Node *x, OPT_Node y)
+static void OPB_BindNodes (INT8 class, OPT_Struct typ, OPT_Node *x, OPT_Node y)
{
OPT_Node node = NIL;
node = OPT_NewNode(class);
@@ -358,9 +286,7 @@ static void OPB_BindNodes (SHORTINT class, OPT_Struct typ, OPT_Node *x, OPT_Node
static BOOLEAN OPB_NotVar (OPT_Node x)
{
- BOOLEAN _o_result;
- _o_result = (x->class >= 7 && ((x->class != 11 || x->subcl != 29) || x->left->class >= 7));
- return _o_result;
+ return (x->class >= 7 && ((x->class != 11 || x->subcl != 29) || x->left->class >= 7));
}
void OPB_DeRef (OPT_Node *x)
@@ -370,7 +296,7 @@ void OPB_DeRef (OPT_Node *x)
typ = (*x)->typ;
if ((*x)->class >= 7) {
OPB_err(78);
- } else if (typ->form == 13) {
+ } else if (typ->form == 11) {
if (typ == OPT_sysptrtyp) {
OPB_err(57);
}
@@ -388,18 +314,18 @@ void OPB_DeRef (OPT_Node *x)
void OPB_Index (OPT_Node *x, OPT_Node y)
{
- INTEGER f;
+ INT16 f;
OPT_Struct typ = NIL;
f = y->typ->form;
if ((*x)->class >= 7) {
OPB_err(79);
- } else if (!__IN(f, 0x70) || __IN(y->class, 0x0300)) {
+ } else if (f != 4 || __IN(y->class, 0x0300, 32)) {
OPB_err(80);
y->typ = OPT_inttyp;
}
if ((*x)->typ->comp == 2) {
typ = (*x)->typ->BaseTyp;
- if ((y->class == 7 && (y->conval->intval < 0 || y->conval->intval >= (*x)->typ->n))) {
+ if ((y->class == 7 && (y->conval->intval < 0 || y->conval->intval >= (INT64)(*x)->typ->n))) {
OPB_err(81);
}
} else if ((*x)->typ->comp == 3) {
@@ -420,7 +346,7 @@ void OPB_Field (OPT_Node *x, OPT_Object y)
if ((*x)->class >= 7) {
OPB_err(77);
}
- if ((y != NIL && __IN(y->mode, 0x2010))) {
+ if ((y != NIL && __IN(y->mode, 0x2010, 32))) {
OPB_BindNodes(2, y->typ, &*x, NIL);
(*x)->obj = y;
(*x)->readonly = (*x)->left->readonly || (y->vis == 2 && y->mnolev < 0);
@@ -430,16 +356,16 @@ void OPB_Field (OPT_Node *x, OPT_Object y)
}
}
-static struct TypTest__61 {
+static struct TypTest__58 {
OPT_Node *x;
OPT_Object *obj;
BOOLEAN *guard;
- struct TypTest__61 *lnk;
-} *TypTest__61_s;
+ struct TypTest__58 *lnk;
+} *TypTest__58_s;
-static void GTT__62 (OPT_Struct t0, OPT_Struct t1);
+static void GTT__59 (OPT_Struct t0, OPT_Struct t1);
-static void GTT__62 (OPT_Struct t0, OPT_Struct t1)
+static void GTT__59 (OPT_Struct t0, OPT_Struct t1)
{
OPT_Node node = NIL;
OPT_Struct t = NIL;
@@ -452,54 +378,54 @@ static void GTT__62 (OPT_Struct t0, OPT_Struct t1)
t1 = t1->BaseTyp;
}
if (t1 == t0 || t0->form == 0) {
- if (*TypTest__61_s->guard) {
- OPB_BindNodes(5, NIL, &*TypTest__61_s->x, NIL);
- (*TypTest__61_s->x)->readonly = (*TypTest__61_s->x)->left->readonly;
+ if (*TypTest__58_s->guard) {
+ OPB_BindNodes(5, NIL, &*TypTest__58_s->x, NIL);
+ (*TypTest__58_s->x)->readonly = (*TypTest__58_s->x)->left->readonly;
} else {
node = OPT_NewNode(11);
node->subcl = 16;
- node->left = *TypTest__61_s->x;
- node->obj = *TypTest__61_s->obj;
- *TypTest__61_s->x = node;
+ node->left = *TypTest__58_s->x;
+ node->obj = *TypTest__58_s->obj;
+ *TypTest__58_s->x = node;
}
} else {
OPB_err(85);
}
} else if (t0 != t1) {
OPB_err(85);
- } else if (!*TypTest__61_s->guard) {
- if ((*TypTest__61_s->x)->class == 5) {
+ } else if (!*TypTest__58_s->guard) {
+ if ((*TypTest__58_s->x)->class == 5) {
node = OPT_NewNode(11);
node->subcl = 16;
- node->left = *TypTest__61_s->x;
- node->obj = *TypTest__61_s->obj;
- *TypTest__61_s->x = node;
+ node->left = *TypTest__58_s->x;
+ node->obj = *TypTest__58_s->obj;
+ *TypTest__58_s->x = node;
} else {
- *TypTest__61_s->x = OPB_NewBoolConst(1);
+ *TypTest__58_s->x = OPB_NewBoolConst(1);
}
}
}
void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
{
- struct TypTest__61 _s;
+ struct TypTest__58 _s;
_s.x = x;
_s.obj = &obj;
_s.guard = &guard;
- _s.lnk = TypTest__61_s;
- TypTest__61_s = &_s;
+ _s.lnk = TypTest__58_s;
+ TypTest__58_s = &_s;
if (OPB_NotVar(*x)) {
OPB_err(112);
- } else if ((*x)->typ->form == 13) {
+ } else if ((*x)->typ->form == 11) {
if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) {
OPB_err(85);
- } else if (obj->typ->form == 13) {
- GTT__62((*x)->typ->BaseTyp, obj->typ->BaseTyp);
+ } else if (obj->typ->form == 11) {
+ GTT__59((*x)->typ->BaseTyp, obj->typ->BaseTyp);
} else {
OPB_err(86);
}
} else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) {
- GTT__62((*x)->typ, obj->typ);
+ GTT__59((*x)->typ, obj->typ);
} else {
OPB_err(87);
}
@@ -508,23 +434,23 @@ void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
} else {
(*x)->typ = OPT_booltyp;
}
- TypTest__61_s = _s.lnk;
+ TypTest__58_s = _s.lnk;
}
void OPB_In (OPT_Node *x, OPT_Node y)
{
- INTEGER f;
- LONGINT k;
+ INT16 f;
+ INT64 k;
f = (*x)->typ->form;
if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) {
OPB_err(126);
- } else if ((__IN(f, 0x70) && y->typ->form == 9)) {
+ } else if ((f == 4 && y->typ->form == 7)) {
if ((*x)->class == 7) {
k = (*x)->conval->intval;
- if (k < 0 || k > (SYSTEM_INT64)OPM_MaxSet) {
+ if (k < 0 || k >= (INT64)__ASHL(y->typ->size, 3)) {
OPB_err(202);
} else if (y->class == 7) {
- (*x)->conval->intval = OPB_BoolToInt(__IN(k, y->conval->setval));
+ (*x)->conval->intval = OPB_BoolToInt(__IN(k, y->conval->setval, 64));
(*x)->obj = NIL;
} else {
OPB_BindNodes(12, OPT_booltyp, &*x, y);
@@ -540,9 +466,8 @@ void OPB_In (OPT_Node *x, OPT_Node y)
(*x)->typ = OPT_booltyp;
}
-static LONGINT OPB_log (LONGINT x)
+static INT64 OPB_log (INT64 x)
{
- LONGINT _o_result;
OPB_exp = 0;
if (x > 0) {
while (!__ODD(x)) {
@@ -550,14 +475,13 @@ static LONGINT OPB_log (LONGINT x)
OPB_exp += 1;
}
}
- _o_result = x;
- return _o_result;
+ return x;
}
-static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x)
+static void OPB_CheckRealType (INT16 f, INT16 nr, OPT_Const x)
{
LONGREAL min, max, r;
- if (f == 7) {
+ if (f == 5) {
min = OPM_MinReal;
max = OPM_MaxReal;
} else {
@@ -568,38 +492,36 @@ static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x)
if (r > max || r < min) {
OPB_err(nr);
x->realval = (LONGREAL)1;
- } else if (f == 7) {
+ } else if (f == 5) {
x->realval = x->realval;
}
x->intval = -1;
}
-static struct MOp__30 {
- struct MOp__30 *lnk;
-} *MOp__30_s;
+static struct MOp__28 {
+ struct MOp__28 *lnk;
+} *MOp__28_s;
-static OPT_Node NewOp__31 (SHORTINT op, OPT_Struct typ, OPT_Node z);
+static OPT_Node NewOp__29 (INT8 op, OPT_Struct typ, OPT_Node z);
-static OPT_Node NewOp__31 (SHORTINT op, OPT_Struct typ, OPT_Node z)
+static OPT_Node NewOp__29 (INT8 op, OPT_Struct typ, OPT_Node z)
{
- OPT_Node _o_result;
OPT_Node node = NIL;
node = OPT_NewNode(11);
node->subcl = op;
node->typ = typ;
node->left = z;
- _o_result = node;
- return _o_result;
+ return node;
}
-void OPB_MOp (SHORTINT op, OPT_Node *x)
+void OPB_MOp (INT8 op, OPT_Node *x)
{
- INTEGER f;
+ INT16 f;
OPT_Struct typ = NIL;
OPT_Node z = NIL;
- struct MOp__30 _s;
- _s.lnk = MOp__30_s;
- MOp__30_s = &_s;
+ struct MOp__28 _s;
+ _s.lnk = MOp__28_s;
+ MOp__28_s = &_s;
z = *x;
if (z->class == 8 || z->class == 9) {
OPB_err(126);
@@ -613,44 +535,48 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval));
z->obj = NIL;
} else {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
}
} else {
OPB_err(98);
}
break;
case 6:
- if (!__IN(f, 0x01f0)) {
+ if (!__IN(f, 0x70, 32)) {
OPB_err(96);
}
break;
case 7:
- if (__IN(f, 0x03f0)) {
+ if (__IN(f, 0xf0, 32)) {
if (z->class == 7) {
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (z->conval->intval == (-9223372036854775807-1)) {
OPB_err(203);
} else {
z->conval->intval = -z->conval->intval;
OPB_SetIntType(z);
}
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
z->conval->realval = -z->conval->realval;
} else {
- z->conval->setval = ~z->conval->setval;
+ if (z->typ->size == 8) {
+ z->conval->setval = ~z->conval->setval;
+ } else {
+ z->conval->setval = z->conval->setval ^ 0xffffffff;
+ }
}
z->obj = NIL;
} else {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
}
} else {
OPB_err(97);
}
break;
case 21:
- if (__IN(f, 0x01f0)) {
+ if (__IN(f, 0x70, 32)) {
if (z->class == 7) {
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (z->conval->intval == (-9223372036854775807-1)) {
OPB_err(203);
} else {
@@ -662,7 +588,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
}
z->obj = NIL;
} else {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
}
} else {
OPB_err(111);
@@ -671,10 +597,10 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
case 22:
if (f == 3) {
if (z->class == 7) {
- z->conval->intval = (int)__CAP((CHAR)z->conval->intval);
+ z->conval->intval = (INT16)__CAP((CHAR)z->conval->intval);
z->obj = NIL;
} else {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
}
} else {
OPB_err(111);
@@ -682,12 +608,12 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
}
break;
case 23:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (z->class == 7) {
z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval));
z->obj = NIL;
} else {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
}
} else {
OPB_err(111);
@@ -697,19 +623,19 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
case 24:
if ((((z->class == 7 && f == 3)) && z->conval->intval >= 32)) {
OPB_CharToString(z);
- f = 10;
+ f = 8;
}
- if (z->class < 7 || f == 10) {
- z = NewOp__31(op, typ, z);
+ if (z->class < 7 || f == 8) {
+ z = NewOp__29(op, typ, z);
} else {
OPB_err(127);
}
- z->typ = OPT_linttyp;
+ z->typ = OPT_adrtyp;
break;
case 25:
- if ((__IN(f, 0x70) && z->class == 7)) {
+ if ((f == 4 && z->class == 7)) {
if ((0 <= z->conval->intval && z->conval->intval <= -1)) {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
} else {
OPB_err(219);
}
@@ -719,22 +645,22 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->typ = OPT_booltyp;
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.MOp, op = ", (LONGINT)33);
- OPM_LogWNum(op, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.MOp, op = ", 33);
+ OPM_LogWNum(op, 0);
OPM_LogWLn();
break;
}
}
*x = z;
- MOp__30_s = _s.lnk;
+ MOp__28_s = _s.lnk;
}
static void OPB_CheckPtr (OPT_Node x, OPT_Node y)
{
- INTEGER g;
+ INT16 g;
OPT_Struct p = NIL, q = NIL, t = NIL;
g = y->typ->form;
- if (g == 13) {
+ if (g == 11) {
p = x->typ->BaseTyp;
q = y->typ->BaseTyp;
if ((p->comp == 4 && q->comp == 4)) {
@@ -752,7 +678,7 @@ static void OPB_CheckPtr (OPT_Node x, OPT_Node y)
} else {
OPB_err(100);
}
- } else if (g != 11) {
+ } else if (g != 9) {
OPB_err(100);
}
}
@@ -769,7 +695,7 @@ void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames)
at = at->BaseTyp;
}
if (ft != at) {
- if ((ft->form == 14 && at->form == 14)) {
+ if ((ft->form == 12 && at->form == 12)) {
if (ft->BaseTyp == at->BaseTyp) {
OPB_CheckParameters(ft->link, at->link, 0);
} else {
@@ -795,7 +721,7 @@ void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames)
static void OPB_CheckProc (OPT_Struct x, OPT_Object y)
{
- if (__IN(y->mode, 0x04c0)) {
+ if (__IN(y->mode, 0x04c0, 32)) {
if (y->mode == 6) {
if (y->mnolev == 0) {
y->mode = 7;
@@ -815,22 +741,21 @@ static void OPB_CheckProc (OPT_Struct x, OPT_Object y)
static struct ConstOp__13 {
OPT_Node *x;
- INTEGER *f;
+ INT16 *f;
OPT_Const *xval, *yval;
struct ConstOp__13 *lnk;
} *ConstOp__13_s;
-static INTEGER ConstCmp__14 (void);
+static INT16 ConstCmp__14 (void);
-static INTEGER ConstCmp__14 (void)
+static INT16 ConstCmp__14 (void)
{
- INTEGER _o_result;
- INTEGER res;
+ INT16 res;
switch (*ConstOp__13_s->f) {
case 0:
res = 9;
break;
- case 1: case 3: case 4: case 5: case 6:
+ case 1: case 3: case 4:
if ((*ConstOp__13_s->xval)->intval < (*ConstOp__13_s->yval)->intval) {
res = 11;
} else if ((*ConstOp__13_s->xval)->intval > (*ConstOp__13_s->yval)->intval) {
@@ -839,7 +764,7 @@ static INTEGER ConstCmp__14 (void)
res = 9;
}
break;
- case 7: case 8:
+ case 5: case 6:
if ((*ConstOp__13_s->xval)->realval < (*ConstOp__13_s->yval)->realval) {
res = 11;
} else if ((*ConstOp__13_s->xval)->realval > (*ConstOp__13_s->yval)->realval) {
@@ -855,14 +780,14 @@ static INTEGER ConstCmp__14 (void)
res = 9;
}
break;
- case 9:
+ case 7:
if ((*ConstOp__13_s->xval)->setval != (*ConstOp__13_s->yval)->setval) {
res = 10;
} else {
res = 9;
}
break;
- case 10:
+ case 8:
if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) < 0) {
res = 11;
} else if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) > 0) {
@@ -871,7 +796,7 @@ static INTEGER ConstCmp__14 (void)
res = 9;
}
break;
- case 11: case 13: case 14:
+ case 9: case 11: case 12:
if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) {
res = 10;
} else {
@@ -879,21 +804,20 @@ static INTEGER ConstCmp__14 (void)
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstCmp, f = ", (LONGINT)37);
- OPM_LogWNum(*ConstOp__13_s->f, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstCmp, f = ", 37);
+ OPM_LogWNum(*ConstOp__13_s->f, 0);
OPM_LogWLn();
break;
}
(*ConstOp__13_s->x)->typ = OPT_booltyp;
- _o_result = res;
- return _o_result;
+ return res;
}
-static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
+static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
{
- INTEGER f, g;
+ INT16 f, g;
OPT_Const xval = NIL, yval = NIL;
- LONGINT xv, yv;
+ INT64 xv, yv;
BOOLEAN temp;
struct ConstOp__13 _s;
_s.x = &x;
@@ -909,7 +833,7 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
if (f != g) {
switch (f) {
case 3:
- if (g == 10) {
+ if (g == 8) {
OPB_CharToString(x);
} else {
OPB_err(100);
@@ -917,17 +841,17 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
- case 4: case 5: case 6:
- if (__IN(g, 0x70)) {
+ case 4:
+ if (g == 4) {
if (x->typ->size <= y->typ->size) {
x->typ = y->typ;
} else {
- x->typ = OPB_IntType(x->typ->size);
+ x->typ = OPT_IntType(x->typ->size);
}
- } else if (g == 7) {
+ } else if (g == 5) {
x->typ = OPT_realtyp;
xval->realval = xval->intval;
- } else if (g == 8) {
+ } else if (g == 6) {
x->typ = OPT_lrltyp;
xval->realval = xval->intval;
} else {
@@ -936,11 +860,11 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
- case 7:
- if (__IN(g, 0x70)) {
+ case 5:
+ if (g == 4) {
y->typ = x->typ;
yval->realval = yval->intval;
- } else if (g == 8) {
+ } else if (g == 6) {
x->typ = OPT_lrltyp;
} else {
OPB_err(100);
@@ -948,11 +872,11 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
- case 8:
- if (__IN(g, 0x70)) {
+ case 6:
+ if (g == 4) {
y->typ = x->typ;
yval->realval = yval->intval;
- } else if (g == 7) {
+ } else if (g == 5) {
y->typ = OPT_lrltyp;
} else {
OPB_err(100);
@@ -960,26 +884,26 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
- case 10:
+ case 8:
if (g == 3) {
OPB_CharToString(y);
- g = 10;
+ g = 8;
} else {
OPB_err(100);
y->typ = x->typ;
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
- case 11:
- if (!__IN(g, 0x6000)) {
+ case 9:
+ if (!__IN(g, 0x1800, 32)) {
OPB_err(100);
}
break;
- case 13:
+ case 11:
OPB_CheckPtr(x, y);
break;
- case 14:
- if (g != 11) {
+ case 12:
+ if (g != 9) {
OPB_err(100);
}
break;
@@ -993,7 +917,7 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
}
switch (op) {
case 1:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
xv = xval->intval;
yv = yval->intval;
if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807-1))) && yv != (-9223372036854775807-1))) && -xv <= __DIV(9223372036854775807, -yv))) {
@@ -1002,7 +926,7 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
} else {
OPB_err(204);
}
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
temp = __ABS(yval->realval) <= (LONGREAL)1;
if (temp || __ABS(xval->realval) <= 1.79769296342094e+308 / (LONGREAL)__ABS(yval->realval)) {
xval->realval = xval->realval * yval->realval;
@@ -1010,23 +934,24 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
} else {
OPB_err(204);
}
- } else if (f == 9) {
+ } else if (f == 7) {
xval->setval = (xval->setval & yval->setval);
+ OPB_SetSetType(x);
} else if (f != 0) {
OPB_err(101);
}
break;
case 2:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (yval->intval != 0) {
xval->realval = xval->intval / (REAL)yval->intval;
- OPB_CheckRealType(7, 205, xval);
+ OPB_CheckRealType(5, 205, xval);
} else {
OPB_err(205);
xval->realval = (LONGREAL)1;
}
x->typ = OPT_realtyp;
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
temp = __ABS(yval->realval) >= (LONGREAL)1;
if (temp || __ABS(xval->realval) <= 1.79769296342094e+308 * __ABS(yval->realval)) {
xval->realval = xval->realval / yval->realval;
@@ -1034,14 +959,15 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
} else {
OPB_err(205);
}
- } else if (f == 9) {
+ } else if (f == 7) {
xval->setval = xval->setval ^ yval->setval;
+ OPB_SetSetType(x);
} else if (f != 0) {
OPB_err(102);
}
break;
case 3:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (yval->intval != 0) {
xval->intval = __DIV(xval->intval, yval->intval);
OPB_SetIntType(x);
@@ -1053,7 +979,7 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
}
break;
case 4:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (yval->intval != 0) {
xval->intval = __MOD(xval->intval, yval->intval);
OPB_SetIntType(x);
@@ -1072,7 +998,7 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
}
break;
case 6:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807 - yval->intval);
if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807-1) - yval->intval)) {
xval->intval += yval->intval;
@@ -1080,7 +1006,7 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
} else {
OPB_err(206);
}
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
temp = (yval->realval >= (LONGREAL)0 && xval->realval <= 1.79769296342094e+308 - yval->realval);
if (temp || (yval->realval < (LONGREAL)0 && xval->realval >= -1.79769296342094e+308 - yval->realval)) {
xval->realval = xval->realval + yval->realval;
@@ -1088,21 +1014,22 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
} else {
OPB_err(206);
}
- } else if (f == 9) {
+ } else if (f == 7) {
xval->setval = xval->setval | yval->setval;
+ OPB_SetSetType(x);
} else if (f != 0) {
OPB_err(105);
}
break;
case 7:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807 + yval->intval)) {
xval->intval -= yval->intval;
OPB_SetIntType(x);
} else {
OPB_err(207);
}
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
temp = (yval->realval >= (LONGREAL)0 && xval->realval >= -1.79769296342094e+308 + yval->realval);
if (temp || (yval->realval < (LONGREAL)0 && xval->realval <= 1.79769296342094e+308 + yval->realval)) {
xval->realval = xval->realval - yval->realval;
@@ -1110,8 +1037,9 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
} else {
OPB_err(207);
}
- } else if (f == 9) {
+ } else if (f == 7) {
xval->setval = (xval->setval & ~yval->setval);
+ OPB_SetSetType(x);
} else if (f != 0) {
OPB_err(106);
}
@@ -1130,36 +1058,36 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
xval->intval = OPB_BoolToInt(ConstCmp__14() != 9);
break;
case 11:
- if (__IN(f, 0x2a04)) {
+ if (__IN(f, 0x0a84, 32)) {
OPB_err(108);
} else {
xval->intval = OPB_BoolToInt(ConstCmp__14() == 11);
}
break;
case 12:
- if (__IN(f, 0x2a04)) {
+ if (__IN(f, 0x0a84, 32)) {
OPB_err(108);
} else {
xval->intval = OPB_BoolToInt(ConstCmp__14() != 13);
}
break;
case 13:
- if (__IN(f, 0x2a04)) {
+ if (__IN(f, 0x0a84, 32)) {
OPB_err(108);
} else {
xval->intval = OPB_BoolToInt(ConstCmp__14() == 13);
}
break;
case 14:
- if (__IN(f, 0x2a04)) {
+ if (__IN(f, 0x0a84, 32)) {
OPB_err(108);
} else {
xval->intval = OPB_BoolToInt(ConstCmp__14() != 11);
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstOp, op = ", (LONGINT)37);
- OPM_LogWNum(op, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstOp, op = ", 37);
+ OPM_LogWNum(op, 0);
OPM_LogWLn();
break;
}
@@ -1169,22 +1097,28 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
{
OPT_Node node = NIL;
- INTEGER f, g;
- LONGINT k;
+ INT16 f, g;
+ INT64 k;
LONGREAL r;
f = (*x)->typ->form;
g = typ->form;
if ((*x)->class == 7) {
- if (__IN(f, 0x70)) {
- if (__IN(g, 0x70)) {
- if (f > g) {
+ if ((((f == 7 && g == 7)) && (*x)->typ->size > typ->size)) {
+ OPB_SetSetType(*x);
+ if ((*x)->typ->size > typ->size) {
+ OPB_err(203);
+ (*x)->conval->setval = 0x0;
+ }
+ } else if (f == 4) {
+ if (g == 4) {
+ if ((*x)->typ->size > typ->size) {
OPB_SetIntType(*x);
- if ((int)(*x)->typ->form > g) {
+ if ((*x)->typ->size > typ->size) {
OPB_err(203);
(*x)->conval->intval = 1;
}
}
- } else if (__IN(g, 0x0180)) {
+ } else if (__IN(g, 0x60, 32)) {
(*x)->conval->realval = (*x)->conval->intval;
(*x)->conval->intval = -1;
} else {
@@ -1193,8 +1127,8 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
OPB_err(220);
}
}
- } else if (__IN(f, 0x0180)) {
- if (__IN(g, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
+ if (__IN(g, 0x60, 32)) {
OPB_CheckRealType(g, 203, (*x)->conval);
} else {
r = (*x)->conval->realval;
@@ -1202,12 +1136,12 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
OPB_err(203);
r = (LONGREAL)1;
}
- (*x)->conval->intval = __ENTIER(r);
+ (*x)->conval->intval = (INT32)__ENTIER(r);
OPB_SetIntType(*x);
}
}
(*x)->obj = NIL;
- } else if (((((*x)->class == 11 && (*x)->subcl == 20)) && ((int)(*x)->left->typ->form < f || f > g))) {
+ } else if (((((*x)->class == 11 && (*x)->subcl == 20)) && ((INT16)(*x)->left->typ->form < f || f > g))) {
if ((*x)->left->typ == typ) {
*x = (*x)->left;
}
@@ -1220,15 +1154,15 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
(*x)->typ = typ;
}
-static struct Op__40 {
- INTEGER *f, *g;
- struct Op__40 *lnk;
-} *Op__40_s;
+static struct Op__38 {
+ INT16 *f, *g;
+ struct Op__38 *lnk;
+} *Op__38_s;
-static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y);
-static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y);
+static void NewOp__39 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y);
+static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y);
-static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
+static void NewOp__39 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
{
OPT_Node node = NIL;
node = OPT_NewNode(12);
@@ -1239,50 +1173,48 @@ static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
*x = node;
}
-static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y)
+static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y)
{
- BOOLEAN _o_result;
BOOLEAN ok, xCharArr, yCharArr;
- xCharArr = (__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp->form == 3) || *Op__40_s->f == 10;
- yCharArr = (__IN((*y)->typ->comp, 0x0c) && (*y)->typ->BaseTyp->form == 3) || *Op__40_s->g == 10;
- if ((((xCharArr && *Op__40_s->g == 3)) && (*y)->class == 7)) {
+ xCharArr = (__IN((*x)->typ->comp, 0x0c, 32) && (*x)->typ->BaseTyp->form == 3) || *Op__38_s->f == 8;
+ yCharArr = (__IN((*y)->typ->comp, 0x0c, 32) && (*y)->typ->BaseTyp->form == 3) || *Op__38_s->g == 8;
+ if ((((xCharArr && *Op__38_s->g == 3)) && (*y)->class == 7)) {
OPB_CharToString(*y);
- *Op__40_s->g = 10;
+ *Op__38_s->g = 8;
yCharArr = 1;
}
- if ((((yCharArr && *Op__40_s->f == 3)) && (*x)->class == 7)) {
+ if ((((yCharArr && *Op__38_s->f == 3)) && (*x)->class == 7)) {
OPB_CharToString(*x);
- *Op__40_s->f = 10;
+ *Op__38_s->f = 8;
xCharArr = 1;
}
ok = (xCharArr && yCharArr);
if (ok) {
- if ((*Op__40_s->f == 10 && (*x)->conval->intval2 == 1)) {
+ if ((*Op__38_s->f == 8 && (*x)->conval->intval2 == 1)) {
(*x)->typ = OPT_chartyp;
(*x)->conval->intval = 0;
- OPB_Index(&*y, OPB_NewIntConst(((LONGINT)(0))));
- } else if ((*Op__40_s->g == 10 && (*y)->conval->intval2 == 1)) {
+ OPB_Index(&*y, OPB_NewIntConst(0));
+ } else if ((*Op__38_s->g == 8 && (*y)->conval->intval2 == 1)) {
(*y)->typ = OPT_chartyp;
(*y)->conval->intval = 0;
- OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0))));
+ OPB_Index(&*x, OPB_NewIntConst(0));
}
}
- _o_result = ok;
- return _o_result;
+ return ok;
}
-void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
+void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
{
- INTEGER f, g;
+ INT16 f, g;
OPT_Node t = NIL, z = NIL;
OPT_Struct typ = NIL;
BOOLEAN do_;
- LONGINT val;
- struct Op__40 _s;
+ INT64 val;
+ struct Op__38 _s;
_s.f = &f;
_s.g = &g;
- _s.lnk = Op__40_s;
- Op__40_s = &_s;
+ _s.lnk = Op__38_s;
+ Op__38_s = &_s;
z = *x;
if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) {
OPB_err(126);
@@ -1300,49 +1232,58 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(100);
}
break;
- case 4: case 5: case 6:
- if ((__IN(g, 0x70) && y->typ->size < z->typ->size)) {
+ case 4:
+ if ((g == 4 && y->typ->size < z->typ->size)) {
OPB_Convert(&y, z->typ);
- } else if (__IN(g, 0x01f0)) {
+ } else if (__IN(g, 0x70, 32)) {
OPB_Convert(&z, y->typ);
} else {
OPB_err(100);
}
break;
case 7:
- if (__IN(g, 0x70)) {
+ if ((g == 7 && y->typ->size < z->typ->size)) {
OPB_Convert(&y, z->typ);
- } else if (__IN(g, 0x0180)) {
+ } else if (g == 7) {
OPB_Convert(&z, y->typ);
} else {
OPB_err(100);
}
break;
- case 8:
- if (__IN(g, 0x01f0)) {
+ case 5:
+ if (g == 4) {
OPB_Convert(&y, z->typ);
- } else if (__IN(g, 0x0180)) {
+ } else if (__IN(g, 0x60, 32)) {
+ OPB_Convert(&z, y->typ);
+ } else {
+ OPB_err(100);
+ }
+ break;
+ case 6:
+ if (__IN(g, 0x70, 32)) {
+ OPB_Convert(&y, z->typ);
+ } else if (__IN(g, 0x60, 32)) {
OPB_Convert(&y, z->typ);
} else {
OPB_err(100);
}
break;
- case 11:
- if (!__IN(g, 0x6000)) {
+ case 9:
+ if (!__IN(g, 0x1800, 32)) {
OPB_err(100);
}
break;
- case 13:
+ case 11:
OPB_CheckPtr(z, y);
break;
- case 14:
- if (g != 11) {
+ case 12:
+ if (g != 9) {
OPB_err(100);
}
break;
- case 10:
+ case 8:
break;
- case 15:
+ case 13:
if (z->typ->comp == 4) {
OPB_err(100);
}
@@ -1358,7 +1299,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
switch (op) {
case 1:
do_ = 1;
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (z->class == 7) {
val = z->conval->intval;
if (val == 1) {
@@ -1389,35 +1330,35 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
y->obj = NIL;
}
}
- } else if (!__IN(f, 0x0381)) {
+ } else if (!__IN(f, 0xe1, 32)) {
OPB_err(105);
typ = OPT_undftyp;
}
if (do_) {
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
}
break;
case 2:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if ((y->class == 7 && y->conval->intval == 0)) {
OPB_err(205);
}
OPB_Convert(&z, OPT_realtyp);
OPB_Convert(&y, OPT_realtyp);
typ = OPT_realtyp;
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
if ((y->class == 7 && y->conval->realval == (LONGREAL)0)) {
OPB_err(205);
}
- } else if ((f != 9 && f != 0)) {
+ } else if ((f != 7 && f != 0)) {
OPB_err(102);
typ = OPT_undftyp;
}
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
break;
case 3:
do_ = 1;
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (y->class == 7) {
val = y->conval->intval;
if (val == 0) {
@@ -1436,11 +1377,11 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp;
}
if (do_) {
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
}
break;
case 4:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (y->class == 7) {
if (y->conval->intval == 0) {
OPB_err(205);
@@ -1454,7 +1395,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(104);
typ = OPT_undftyp;
}
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
break;
case 5:
if (f == 2) {
@@ -1464,7 +1405,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
} else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) {
} else {
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
}
} else if (f != 0) {
OPB_err(94);
@@ -1472,12 +1413,12 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
break;
case 6:
- if (!__IN(f, 0x03f1)) {
+ if (!__IN(f, 0xf1, 32)) {
OPB_err(105);
typ = OPT_undftyp;
}
do_ = 1;
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if ((z->class == 7 && z->conval->intval == 0)) {
do_ = 0;
z = y;
@@ -1487,16 +1428,16 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
}
if (do_) {
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
}
break;
case 7:
- if (!__IN(f, 0x03f1)) {
+ if (!__IN(f, 0xf1, 32)) {
OPB_err(106);
typ = OPT_undftyp;
}
- if ((!__IN(f, 0x70) || y->class != 7) || y->conval->intval != 0) {
- NewOp__41(op, typ, &z, y);
+ if ((f != 4 || y->class != 7) || y->conval->intval != 0) {
+ NewOp__39(op, typ, &z, y);
}
break;
case 8:
@@ -1507,7 +1448,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
} else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) {
} else {
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
}
} else if (f != 0) {
OPB_err(95);
@@ -1515,61 +1456,62 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
break;
case 9: case 10:
- if (__IN(f, 0x6bff) || strings__43(&z, &y)) {
+ if (__IN(f, 0x1aff, 32) || strings__41(&z, &y)) {
typ = OPT_booltyp;
} else {
OPB_err(107);
typ = OPT_undftyp;
}
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
break;
case 11: case 12: case 13: case 14:
- if (__IN(f, 0x01f9) || strings__43(&z, &y)) {
+ if (__IN(f, 0x79, 32) || strings__41(&z, &y)) {
typ = OPT_booltyp;
} else {
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"ELSE in Op()", (LONGINT)13);
+ OPM_LogWStr((CHAR*)"ELSE in Op()", 13);
OPM_LogWLn();
OPB_err(108);
typ = OPT_undftyp;
}
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", (LONGINT)32);
- OPM_LogWNum(op, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", 32);
+ OPM_LogWNum(op, 0);
OPM_LogWLn();
break;
}
}
*x = z;
- Op__40_s = _s.lnk;
+ Op__38_s = _s.lnk;
}
void OPB_SetRange (OPT_Node *x, OPT_Node y)
{
- LONGINT k, l;
+ INT64 k, l;
if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) {
OPB_err(126);
- } else if ((__IN((*x)->typ->form, 0x70) && __IN(y->typ->form, 0x70))) {
+ } else if (((*x)->typ->form == 4 && y->typ->form == 4)) {
if ((*x)->class == 7) {
k = (*x)->conval->intval;
- if (0 > k || k > (SYSTEM_INT64)OPM_MaxSet) {
+ if (0 > k || k > 63) {
OPB_err(202);
}
}
if (y->class == 7) {
l = y->conval->intval;
- if (0 > l || l > (SYSTEM_INT64)OPM_MaxSet) {
+ if (0 > l || l > 63) {
OPB_err(202);
}
}
if (((*x)->class == 7 && y->class == 7)) {
if (k <= l) {
- (*x)->conval->setval = __SETRNG(k, l);
+ (*x)->conval->setval = __SETRNG(k, l, 32);
+ OPB_SetSetType(*x);
} else {
OPB_err(201);
- (*x)->conval->setval = __SETRNG(l, k);
+ (*x)->conval->setval = __SETRNG(l, k, 32);
}
(*x)->obj = NIL;
} else {
@@ -1583,86 +1525,69 @@ void OPB_SetRange (OPT_Node *x, OPT_Node y)
void OPB_SetElem (OPT_Node *x)
{
- LONGINT k;
+ INT64 k;
if ((*x)->class == 8 || (*x)->class == 9) {
OPB_err(126);
- } else if (!__IN((*x)->typ->form, 0x70)) {
+ } else if ((*x)->typ->form != 4) {
OPB_err(93);
} else if ((*x)->class == 7) {
k = (*x)->conval->intval;
- if ((0 <= k && k <= (SYSTEM_INT64)OPM_MaxSet)) {
- (*x)->conval->setval = __SETOF(k);
+ if ((0 <= k && k <= 63)) {
+ (*x)->conval->setval = 0x0;
+ (*x)->conval->setval |= __SETOF(k,64);
} else {
OPB_err(202);
}
+ OPB_SetSetType(*x);
(*x)->obj = NIL;
} else {
OPB_Convert(&*x, OPT_settyp);
+ (*x)->typ = OPT_settyp;
}
- (*x)->typ = OPT_settyp;
}
static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
{
OPT_Struct y = NIL;
- INTEGER f, g;
+ INT16 f, g;
OPT_Struct p = NIL, q = NIL;
- if (OPM_Verbose) {
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"PROCEDURE CheckAssign", (LONGINT)22);
- OPM_LogWLn();
- }
y = ynode->typ;
f = x->form;
g = y->form;
- if (OPM_Verbose) {
- OPM_LogWStr((CHAR*)"y.form = ", (LONGINT)10);
- OPM_LogWNum(y->form, ((LONGINT)(0)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"f = ", (LONGINT)5);
- OPM_LogWNum(f, ((LONGINT)(0)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"g = ", (LONGINT)5);
- OPM_LogWNum(g, ((LONGINT)(0)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"ynode.typ.syze = ", (LONGINT)18);
- OPM_LogWNum(ynode->typ->size, ((LONGINT)(0)));
- OPM_LogWLn();
- }
- if (ynode->class == 8 || (ynode->class == 9 && f != 14)) {
+ if (ynode->class == 8 || (ynode->class == 9 && f != 12)) {
OPB_err(126);
}
switch (f) {
- case 0: case 10:
+ case 0: case 8:
break;
case 1:
- if (!((__IN(g, 0x7a) && y->size == 1))) {
+ if (!((__IN(g, 0x1a, 32) && y->size == 1))) {
OPB_err(113);
}
break;
- case 2: case 3: case 9:
+ case 2: case 3:
if (g != f) {
OPB_err(113);
}
break;
- case 4: case 5: case 6:
- if (!__IN(g, 0x70) || x->size < y->size) {
+ case 4: case 7:
+ if (g != f || x->size < y->size) {
OPB_err(113);
}
break;
- case 7:
- if (!__IN(g, 0xf0)) {
+ case 5:
+ if (!__IN(g, 0x30, 32)) {
OPB_err(113);
}
break;
- case 8:
- if (!__IN(g, 0x01f0)) {
+ case 6:
+ if (!__IN(g, 0x70, 32)) {
OPB_err(113);
}
break;
- case 13:
- if ((x == y || g == 11) || (x == OPT_sysptrtyp && g == 13)) {
- } else if (g == 13) {
+ case 11:
+ if ((x == y || g == 9) || (x == OPT_sysptrtyp && g == 11)) {
+ } else if (g == 11) {
p = x->BaseTyp;
q = y->BaseTyp;
if ((p->comp == 4 && q->comp == 4)) {
@@ -1679,32 +1604,32 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
OPB_err(113);
}
break;
- case 14:
+ case 12:
if (ynode->class == 9) {
OPB_CheckProc(x, ynode->obj);
- } else if (x == y || g == 11) {
+ } else if (x == y || g == 9) {
} else {
OPB_err(113);
}
break;
- case 12: case 11:
+ case 10: case 9:
OPB_err(113);
break;
- case 15:
+ case 13:
x->pvused = 1;
if (x->comp == 2) {
if ((ynode->class == 7 && g == 3)) {
OPB_CharToString(ynode);
y = ynode->typ;
- g = 10;
+ g = 8;
}
if (x == y) {
} else if (x->BaseTyp == OPT_chartyp) {
- if (g == 10) {
+ if (g == 8) {
if (ynode->conval->intval2 > x->n) {
OPB_err(114);
}
- } else if ((__IN(y->comp, 0x0c) && y->BaseTyp == OPT_chartyp)) {
+ } else if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
} else {
OPB_err(113);
}
@@ -1712,7 +1637,7 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
OPB_err(113);
}
} else if ((x->comp == 3 && x->BaseTyp == OPT_chartyp)) {
- if ((__IN(y->comp, 0x0c) && y->BaseTyp == OPT_chartyp)) {
+ if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
} else {
OPB_err(113);
}
@@ -1734,12 +1659,12 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.CheckAssign, f = ", (LONGINT)40);
- OPM_LogWNum(f, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.CheckAssign, f = ", 40);
+ OPM_LogWNum(f, 0);
OPM_LogWLn();
break;
}
- if ((((((ynode->class == 7 && g < f)) && __IN(g, 0xf0))) && __IN(f, 0x01e0))) {
+ if ((((((ynode->class == 7 && g < f)) && __IN(g, 0x30, 32))) && __IN(f, 0x70, 32))) {
OPB_Convert(&ynode, x);
}
}
@@ -1748,16 +1673,16 @@ static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo)
{
}
-void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
+void OPB_StPar0 (OPT_Node *par0, INT16 fctno)
{
- INTEGER f;
+ INT16 f;
OPT_Struct typ = NIL;
OPT_Node x = NIL;
x = *par0;
f = x->typ->form;
switch (fctno) {
case 0:
- if ((__IN(f, 0x70) && x->class == 7)) {
+ if ((f == 4 && x->class == 7)) {
if ((0 <= x->conval->intval && x->conval->intval <= 255)) {
OPB_BindNodes(28, OPT_notyp, &x, x);
} else {
@@ -1772,12 +1697,12 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
typ = OPT_notyp;
if (OPB_NotVar(x)) {
OPB_err(112);
- } else if (f == 13) {
+ } else if (f == 11) {
if (x->readonly) {
OPB_err(76);
}
f = x->typ->BaseTyp->comp;
- if (__IN(f, 0x1c)) {
+ if (__IN(f, 0x1c, 32)) {
if (f == 3) {
typ = x->typ->BaseTyp;
}
@@ -1810,7 +1735,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 5:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
OPB_Convert(&x, OPT_linttyp);
} else {
OPB_err(111);
@@ -1827,20 +1752,20 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
x = OPB_NewBoolConst(0);
break;
case 3:
- x = OPB_NewIntConst(((LONGINT)(0)));
+ x = OPB_NewIntConst(0);
x->typ = OPT_chartyp;
break;
- case 4: case 5: case 6:
+ case 4:
x = OPB_NewIntConst(OPM_SignedMinimum(x->typ->size));
break;
- case 9:
- x = OPB_NewIntConst(((LONGINT)(0)));
+ case 7:
+ x = OPB_NewIntConst(0);
x->typ = OPT_inttyp;
break;
- case 7:
+ case 5:
x = OPB_NewRealConst(OPM_MinReal, OPT_realtyp);
break;
- case 8:
+ case 6:
x = OPB_NewRealConst(OPM_MinLReal, OPT_lrltyp);
break;
default:
@@ -1858,20 +1783,20 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
x = OPB_NewBoolConst(1);
break;
case 3:
- x = OPB_NewIntConst(((LONGINT)(255)));
+ x = OPB_NewIntConst(255);
x->typ = OPT_chartyp;
break;
- case 4: case 5: case 6:
+ case 4:
x = OPB_NewIntConst(OPM_SignedMaximum(x->typ->size));
break;
- case 9:
- x = OPB_NewIntConst(OPM_MaxSet);
+ case 7:
+ x = OPB_NewIntConst(__ASHL(x->typ->size, 3) - 1);
x->typ = OPT_inttyp;
break;
- case 7:
+ case 5:
x = OPB_NewRealConst(OPM_MaxReal, OPT_realtyp);
break;
- case 8:
+ case 6:
x = OPB_NewRealConst(OPM_MaxLReal, OPT_lrltyp);
break;
default:
@@ -1885,7 +1810,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 9:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x71)) {
+ } else if (__IN(f, 0x11, 32)) {
OPB_Convert(&x, OPT_chartyp);
} else {
OPB_err(111);
@@ -1895,9 +1820,14 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 10:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if ((__IN(f, 0x70) && x->typ->size > (SYSTEM_INT64)OPM_SIntSize)) {
- OPB_Convert(&x, OPB_IntType(OPB_ShorterSize(x->typ->size)));
- } else if (f == 8) {
+ } else if (f == 4) {
+ typ = OPT_ShorterOrLongerType(x->typ, -1);
+ if (typ == NIL) {
+ OPB_err(111);
+ } else {
+ OPB_Convert(&x, typ);
+ }
+ } else if (f == 6) {
OPB_Convert(&x, OPT_realtyp);
} else {
OPB_err(111);
@@ -1906,9 +1836,14 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 11:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if ((__IN(f, 0x70) && x->typ->size < (SYSTEM_INT64)OPM_LIntSize)) {
- OPB_Convert(&x, OPB_IntType(OPB_LongerSize(x->typ->size)));
- } else if (f == 7) {
+ } else if (f == 4) {
+ typ = OPT_ShorterOrLongerType(x->typ, 1);
+ if (typ == NIL) {
+ OPB_err(111);
+ } else {
+ OPB_Convert(&x, typ);
+ }
+ } else if (f == 5) {
OPB_Convert(&x, OPT_lrltyp);
} else if (f == 3) {
OPB_Convert(&x, OPT_linttyp);
@@ -1919,7 +1854,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 13: case 14:
if (OPB_NotVar(x)) {
OPB_err(112);
- } else if (!__IN(f, 0x70)) {
+ } else if (f != 4) {
OPB_err(111);
} else if (x->readonly) {
OPB_err(76);
@@ -1928,7 +1863,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 15: case 16:
if (OPB_NotVar(x)) {
OPB_err(112);
- } else if (x->typ != OPT_settyp) {
+ } else if (x->typ->form != 7) {
OPB_err(111);
x->typ = OPT_settyp;
} else if (x->readonly) {
@@ -1936,26 +1871,26 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
}
break;
case 17:
- if (!__IN(x->typ->comp, 0x0c)) {
+ if (!__IN(x->typ->comp, 0x0c, 32)) {
OPB_err(131);
}
break;
case 18:
if ((x->class == 7 && f == 3)) {
OPB_CharToString(x);
- f = 10;
+ f = 8;
}
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (((!__IN(x->typ->comp, 0x0c) || x->typ->BaseTyp->form != 3) && f != 10)) {
+ } else if (((!__IN(x->typ->comp, 0x0c, 32) || x->typ->BaseTyp->form != 3) && f != 8)) {
OPB_err(111);
}
break;
case 19:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
- if (x->typ->size != (SYSTEM_INT64)OPM_LIntSize) {
+ } else if (f == 4) {
+ if (x->typ->size < OPT_linttyp->size) {
OPB_Convert(&x, OPT_linttyp);
}
} else {
@@ -1970,14 +1905,14 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 12:
if (x->class != 8) {
OPB_err(110);
- x = OPB_NewIntConst(((LONGINT)(1)));
- } else if (__IN(f, 0x63fe) || __IN(x->typ->comp, 0x14)) {
- (*OPB_typSize)(x->typ);
+ x = OPB_NewIntConst(1);
+ } else if (__IN(f, 0x18fe, 32) || __IN(x->typ->comp, 0x14, 32)) {
+ OPT_TypSize(x->typ);
x->typ->pvused = 1;
x = OPB_NewIntConst(x->typ->size);
} else {
OPB_err(111);
- x = OPB_NewIntConst(((LONGINT)(1)));
+ x = OPB_NewIntConst(1);
}
break;
case 21:
@@ -1986,22 +1921,22 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 22: case 23:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (!__IN(f, 0x027a)) {
+ } else if (!__IN(f, 0x9a, 32)) {
OPB_err(111);
}
break;
case 24: case 25: case 28: case 31:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if ((((x->class == 7 && __IN(f, 0x70))) && x->typ->size < OPT_linttyp->size)) {
- OPB_Convert(&x, OPT_linttyp);
- } else if (!((__IN(x->typ->form, 0x2070) && x->typ->size == (SYSTEM_INT64)OPM_PointerSize))) {
+ } else if ((((x->class == 7 && f == 4)) && x->typ->size < OPT_adrtyp->size)) {
+ OPB_Convert(&x, OPT_adrtyp);
+ } else if (!((__IN(x->typ->form, 0x0810, 32) && x->typ->size == OPM_AddressSize))) {
OPB_err(111);
- x->typ = OPT_linttyp;
+ x->typ = OPT_adrtyp;
}
break;
case 26: case 27:
- if ((__IN(f, 0x70) && x->class == 7)) {
+ if ((f == 4 && x->class == 7)) {
if (x->conval->intval < 0 || x->conval->intval > -1) {
OPB_err(220);
}
@@ -2012,14 +1947,14 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 29:
if (x->class != 8) {
OPB_err(110);
- } else if (__IN(f, 0x1401) || x->typ->comp == 3) {
+ } else if (__IN(f, 0x0501, 32) || x->typ->comp == 3) {
OPB_err(111);
}
break;
case 30:
if (OPB_NotVar(x)) {
OPB_err(112);
- } else if (f == 13) {
+ } else if (f == 11) {
} else {
OPB_err(111);
}
@@ -2036,40 +1971,38 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.StPar0, fctno = ", (LONGINT)39);
- OPM_LogWNum(fctno, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.StPar0, fctno = ", 39);
+ OPM_LogWNum(fctno, 0);
OPM_LogWLn();
break;
}
*par0 = x;
}
-static struct StPar1__56 {
- struct StPar1__56 *lnk;
-} *StPar1__56_s;
+static struct StPar1__53 {
+ struct StPar1__53 *lnk;
+} *StPar1__53_s;
-static OPT_Node NewOp__57 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right);
+static OPT_Node NewOp__54 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right);
-static OPT_Node NewOp__57 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right)
+static OPT_Node NewOp__54 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right)
{
- OPT_Node _o_result;
OPT_Node node = NIL;
node = OPT_NewNode(class);
node->subcl = subcl;
node->left = left;
node->right = right;
- _o_result = node;
- return _o_result;
+ return node;
}
-void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
+void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
{
- INTEGER f, L;
+ INT16 f, L;
OPT_Struct typ = NIL;
OPT_Node p = NIL, t = NIL;
- struct StPar1__56 _s;
- _s.lnk = StPar1__56_s;
- StPar1__56_s = &_s;
+ struct StPar1__53 _s;
+ _s.lnk = StPar1__53_s;
+ StPar1__53_s = &_s;
p = *par0;
f = x->typ->form;
switch (fctno) {
@@ -2079,40 +2012,40 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
p->typ = OPT_notyp;
} else {
if (x->typ != p->typ) {
- if ((x->class == 7 && __IN(f, 0x70))) {
+ if ((f == 4 && (x->class == 7 || (p->typ->form == 4 && x->typ->size <= p->typ->size)))) {
OPB_Convert(&x, p->typ);
} else {
OPB_err(111);
}
}
- p = NewOp__57(19, fctno, p, x);
+ p = NewOp__54(19, fctno, p, x);
p->typ = OPT_notyp;
}
break;
case 15: case 16:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
- if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval > (SYSTEM_INT64)OPM_MaxSet))) {
+ } else if (f == 4) {
+ if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval >= (INT64)__ASHL(p->typ->size, 3)))) {
OPB_err(202);
}
- p = NewOp__57(19, fctno, p, x);
+ p = NewOp__54(19, fctno, p, x);
} else {
OPB_err(111);
}
p->typ = OPT_notyp;
break;
case 17:
- if (!__IN(f, 0x70) || x->class != 7) {
+ if (!(f == 4) || x->class != 7) {
OPB_err(69);
} else if (x->typ->size == 1) {
- L = (int)x->conval->intval;
+ L = OPM_Integer(x->conval->intval);
typ = p->typ;
- while ((L > 0 && __IN(typ->comp, 0x0c))) {
+ while ((L > 0 && __IN(typ->comp, 0x0c, 32))) {
typ = typ->BaseTyp;
L -= 1;
}
- if (L != 0 || !__IN(typ->comp, 0x0c)) {
+ if (L != 0 || !__IN(typ->comp, 0x0c, 32)) {
OPB_err(132);
} else {
x->obj = NIL;
@@ -2121,7 +2054,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
p = p->left;
x->conval->intval += 1;
}
- p = NewOp__57(12, 19, p, x);
+ p = NewOp__54(12, 19, p, x);
p->typ = OPT_linttyp;
} else {
p = x;
@@ -2136,14 +2069,14 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 18:
if (OPB_NotVar(x)) {
OPB_err(112);
- } else if ((__IN(x->typ->comp, 0x0c) && x->typ->BaseTyp->form == 3)) {
+ } else if ((__IN(x->typ->comp, 0x0c, 32) && x->typ->BaseTyp->form == 3)) {
if (x->readonly) {
OPB_err(76);
}
t = x;
x = p;
p = t;
- p = NewOp__57(19, 18, p, x);
+ p = NewOp__54(19, 18, p, x);
} else {
OPB_err(111);
}
@@ -2152,14 +2085,14 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 19:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
+ } else if (f == 4) {
if ((p->class == 7 && x->class == 7)) {
if (-OPB_maxExp > x->conval->intval || x->conval->intval > OPB_maxExp) {
OPB_err(208);
p->conval->intval = 1;
} else if (x->conval->intval >= 0) {
- if (__ABS(p->conval->intval) <= __DIV(9223372036854775807, __ASH(1, x->conval->intval))) {
- p->conval->intval = p->conval->intval * __ASH(1, x->conval->intval);
+ 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);
p->conval->intval = 1;
@@ -2169,8 +2102,8 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
}
p->obj = NIL;
} else {
- p = NewOp__57(12, 17, p, x);
- p->typ = OPT_linttyp;
+ p = NewOp__54(12, 17, p, x);
+ p->typ = p->left->typ;
}
} else {
OPB_err(111);
@@ -2180,7 +2113,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if (p->typ->comp == 3) {
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) {
OPB_err(63);
}
@@ -2196,13 +2129,13 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 22: case 23:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (!__IN(f, 0x70)) {
+ } else if (f != 4) {
OPB_err(111);
} else {
if (fctno == 22) {
- p = NewOp__57(12, 27, p, x);
+ p = NewOp__54(12, 27, p, x);
} else {
- p = NewOp__57(12, 28, p, x);
+ p = NewOp__54(12, 28, p, x);
}
p->typ = p->left->typ;
}
@@ -2210,7 +2143,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 24: case 25: case 26: case 27:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x63ff)) {
+ } else if (__IN(f, 0x18ff, 32)) {
if (fctno == 24 || fctno == 26) {
if (OPB_NotVar(x)) {
OPB_err(112);
@@ -2219,7 +2152,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
x = p;
p = t;
}
- p = NewOp__57(19, fctno, p, x);
+ p = NewOp__54(19, fctno, p, x);
} else {
OPB_err(111);
}
@@ -2228,32 +2161,38 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 28:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
- p = NewOp__57(12, 26, p, x);
+ } else if (f == 4) {
+ p = NewOp__54(12, 26, p, x);
} else {
OPB_err(111);
}
p->typ = OPT_booltyp;
break;
case 29:
- if (((x->class == 8 || x->class == 9) || __IN(f, 0x1401)) || x->typ->comp == 3) {
+ if (((x->class == 8 || x->class == 9) || __IN(f, 0x0501, 32)) || x->typ->comp == 3) {
OPB_err(126);
}
- if (x->typ->size < p->typ->size) {
+ OPT_TypSize(x->typ);
+ OPT_TypSize(p->typ);
+ if ((x->class != 7 && x->typ->size < p->typ->size)) {
OPB_err(-308);
}
- t = OPT_NewNode(11);
- t->subcl = 29;
- t->left = x;
- x = t;
- x->typ = p->typ;
+ if ((((x->class == 7 && x->typ->form == 4)) && p->typ->form == 4)) {
+ OPB_Convert(&x, p->typ);
+ } else {
+ t = OPT_NewNode(11);
+ t->subcl = 29;
+ t->left = x;
+ x = t;
+ x->typ = p->typ;
+ }
p = x;
break;
case 30:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
- p = NewOp__57(19, 30, p, x);
+ } else if (f == 4) {
+ p = NewOp__54(19, 30, p, x);
} else {
OPB_err(111);
}
@@ -2262,16 +2201,16 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 31:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if ((((x->class == 7 && __IN(f, 0x70))) && x->typ->size < OPT_linttyp->size)) {
- OPB_Convert(&x, OPT_linttyp);
- } else if (!((__IN(x->typ->form, 0x2070) && x->typ->size == (SYSTEM_INT64)OPM_PointerSize))) {
+ } else if ((((x->class == 7 && f == 4)) && x->typ->size < OPT_adrtyp->size)) {
+ OPB_Convert(&x, OPT_adrtyp);
+ } else if (!((__IN(x->typ->form, 0x0810, 32) && x->typ->size == OPM_AddressSize))) {
OPB_err(111);
- x->typ = OPT_linttyp;
+ x->typ = OPT_adrtyp;
}
p->link = x;
break;
case 32:
- if ((__IN(f, 0x70) && x->class == 7)) {
+ if ((f == 4 && x->class == 7)) {
if ((0 <= x->conval->intval && x->conval->intval <= 255)) {
OPB_BindNodes(28, OPT_notyp, &x, x);
x->conval = OPT_NewConst();
@@ -2299,13 +2238,13 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
break;
}
*par0 = p;
- StPar1__56_s = _s.lnk;
+ StPar1__53_s = _s.lnk;
}
-void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
+void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n)
{
OPT_Node node = NIL;
- INTEGER f;
+ INT16 f;
OPT_Node p = NIL;
p = *par0;
f = x->typ->form;
@@ -2314,7 +2253,7 @@ void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
OPB_err(126);
} else if (p->typ->comp != 3) {
OPB_err(64);
- } else if (__IN(f, 0x70)) {
+ } else if (f == 4) {
if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) {
OPB_err(63);
}
@@ -2330,7 +2269,7 @@ void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
} else if ((fctno == 31 && n == 2)) {
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
+ } else if (f == 4) {
node = OPT_NewNode(19);
node->subcl = 31;
node->right = p;
@@ -2347,9 +2286,9 @@ void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
*par0 = p;
}
-void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno)
+void OPB_StFct (OPT_Node *par0, INT8 fctno, INT16 parno)
{
- INTEGER dim;
+ INT16 dim;
OPT_Node x = NIL, p = NIL;
p = *par0;
if (fctno <= 19) {
@@ -2364,7 +2303,7 @@ void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno)
}
} else {
if (((fctno == 13 || fctno == 14) && parno == 1)) {
- OPB_BindNodes(19, OPT_notyp, &p, OPB_NewIntConst(((LONGINT)(1))));
+ OPB_BindNodes(19, OPT_notyp, &p, OPB_NewIntConst(1));
p->subcl = fctno;
p->right->typ = p->left->typ;
} else if ((fctno == 17 && parno == 1)) {
@@ -2386,7 +2325,7 @@ void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno)
} else if (fctno == 32) {
if (parno == 1) {
x = NIL;
- OPB_BindNodes(28, OPT_notyp, &x, OPB_NewIntConst(((LONGINT)(0))));
+ OPB_BindNodes(28, OPT_notyp, &x, OPB_NewIntConst(0));
x->conval = OPT_NewConst();
x->conval->intval = OPM_errpos;
OPB_Construct(15, &p, x);
@@ -2413,21 +2352,21 @@ void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno)
static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar)
{
- INTEGER f;
+ INT16 f;
f = atyp->comp;
ftyp = ftyp->BaseTyp;
atyp = atyp->BaseTyp;
if ((fvarpar && ftyp == OPT_bytetyp)) {
- if (!__IN(f, 0x0c) || !((__IN(atyp->form, 0x7e) && atyp->size == 1))) {
- if (__IN(18, OPM_opt)) {
+ if (!__IN(f, 0x0c, 32) || !((__IN(atyp->form, 0x1e, 32) && atyp->size == 1))) {
+ if (__IN(18, OPM_Options, 32)) {
OPB_err(-301);
}
}
- } else if (__IN(f, 0x0c)) {
+ } else if (__IN(f, 0x0c, 32)) {
if (ftyp->comp == 3) {
OPB_DynArrParCheck(ftyp, atyp, fvarpar);
} else if (ftyp != atyp) {
- if ((((!fvarpar && ftyp->form == 13)) && atyp->form == 13)) {
+ if ((((!fvarpar && ftyp->form == 11)) && atyp->form == 11)) {
ftyp = ftyp->BaseTyp;
atyp = atyp->BaseTyp;
if ((ftyp->comp == 4 && atyp->comp == 4)) {
@@ -2451,7 +2390,7 @@ static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpa
static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp)
{
- if (fp->typ->form == 13) {
+ if (fp->typ->form == 11) {
if ((*x)->class == 3) {
*x = (*x)->left;
} else {
@@ -2462,13 +2401,13 @@ static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp)
void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar)
{
- if (((*x)->obj != NIL && __IN((*x)->obj->mode, 0x22c0))) {
+ if (((*x)->obj != NIL && __IN((*x)->obj->mode, 0x22c0, 32))) {
*fpar = (*x)->obj->link;
if ((*x)->obj->mode == 13) {
OPB_CheckReceiver(&(*x)->left, *fpar);
*fpar = (*fpar)->link;
}
- } else if (((((*x)->class != 8 && (*x)->typ != NIL)) && (*x)->typ->form == 14)) {
+ } else if (((((*x)->class != 8 && (*x)->typ != NIL)) && (*x)->typ->form == 12)) {
*fpar = (*x)->typ->link;
} else {
OPB_err(121);
@@ -2500,17 +2439,17 @@ void OPB_Param (OPT_Node ap, OPT_Object fp)
if (q == NIL) {
OPB_err(111);
}
- } else if ((fp->typ == OPT_sysptrtyp && ap->typ->form == 13)) {
- } else if ((ap->typ != fp->typ && !((fp->typ->form == 1 && ((__IN(ap->typ->form, 0x7e) && ap->typ->size == 1)))))) {
+ } else if ((fp->typ == OPT_sysptrtyp && ap->typ->form == 11)) {
+ } else if ((ap->typ != fp->typ && !((((fp->typ->form == 1 && __IN(ap->typ->form, 0x1e, 32))) && ap->typ->size == 1)))) {
OPB_err(123);
- } else if ((fp->typ->form == 13 && ap->class == 5)) {
+ } else if ((fp->typ->form == 11 && ap->class == 5)) {
OPB_err(123);
}
} else if (fp->typ->comp == 3) {
if ((ap->class == 7 && ap->typ->form == 3)) {
OPB_CharToString(ap);
}
- if ((ap->typ->form == 10 && fp->typ->BaseTyp->form == 3)) {
+ if ((ap->typ->form == 8 && fp->typ->BaseTyp->form == 3)) {
} else if (ap->class >= 7) {
OPB_err(59);
} else {
@@ -2522,13 +2461,13 @@ void OPB_Param (OPT_Node ap, OPT_Object fp)
}
}
-void OPB_StaticLink (SHORTINT dlev)
+void OPB_StaticLink (INT8 dlev)
{
OPT_Object scope = NIL;
scope = OPT_topScope;
while (dlev > 0) {
dlev -= 1;
- scope->link->conval->setval |= __SETOF(3);
+ scope->link->conval->setval |= __SETOF(3,64);
scope = scope->left;
}
}
@@ -2537,7 +2476,7 @@ void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp)
{
OPT_Struct typ = NIL;
OPT_Node p = NIL;
- SHORTINT lev;
+ INT8 lev;
if ((*x)->class == 9) {
typ = (*x)->typ;
lev = (*x)->obj->mnolev;
@@ -2597,7 +2536,7 @@ void OPB_Return (OPT_Node *x, OPT_Object proc)
void OPB_Assign (OPT_Node *x, OPT_Node y)
{
OPT_Node z = NIL;
- SHORTINT subcl;
+ INT8 subcl;
if ((*x)->class >= 7) {
OPB_err(56);
}
@@ -2618,12 +2557,12 @@ void OPB_Assign (OPT_Node *x, OPT_Node y)
OPB_BindNodes(6, (*x)->typ, &z, NIL);
*x = z;
}
- } else if (((((((*x)->typ->comp == 2 && (*x)->typ->BaseTyp == OPT_chartyp)) && y->typ->form == 10)) && y->conval->intval2 == 1)) {
+ } else if (((((((*x)->typ->comp == 2 && (*x)->typ->BaseTyp == OPT_chartyp)) && y->typ->form == 8)) && y->conval->intval2 == 1)) {
y->typ = OPT_chartyp;
y->conval->intval = 0;
- OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0))));
+ OPB_Index(&*x, OPB_NewIntConst(0));
}
- if ((((((__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp == OPT_chartyp)) && __IN(y->typ->comp, 0x0c))) && y->typ->BaseTyp == OPT_chartyp)) {
+ 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;
diff --git a/bootstrap/unix-88/OPB.h b/bootstrap/unix-88/OPB.h
index af419f75..0be714e8 100644
--- a/bootstrap/unix-88/OPB.h
+++ b/bootstrap/unix-88/OPB.h
@@ -1,21 +1,19 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPB__h
#define OPB__h
-#define LARGE
#include "SYSTEM.h"
#include "OPS.h"
#include "OPT.h"
-import void (*OPB_typSize)(OPT_Struct);
import void OPB_Assign (OPT_Node *x, OPT_Node y);
import void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp);
import void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames);
-import void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y);
+import void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y);
import void OPB_DeRef (OPT_Node *x);
import OPT_Node OPB_EmptySet (void);
import void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc);
@@ -24,27 +22,27 @@ import void OPB_In (OPT_Node *x, OPT_Node y);
import void OPB_Index (OPT_Node *x, OPT_Node y);
import void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ);
import void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y);
-import void OPB_MOp (SHORTINT op, OPT_Node *x);
+import void OPB_MOp (INT8 op, OPT_Node *x);
import OPT_Node OPB_NewBoolConst (BOOLEAN boolval);
-import OPT_Node OPB_NewIntConst (LONGINT intval);
+import OPT_Node OPB_NewIntConst (INT64 intval);
import OPT_Node OPB_NewLeaf (OPT_Object obj);
import OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ);
-import OPT_Node OPB_NewString (OPS_String str, LONGINT len);
+import OPT_Node OPB_NewString (OPS_String str, INT64 len);
import OPT_Node OPB_Nil (void);
-import void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y);
+import void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y);
import void OPB_OptIf (OPT_Node *x);
import void OPB_Param (OPT_Node ap, OPT_Object fp);
import void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar);
import void OPB_Return (OPT_Node *x, OPT_Object proc);
import void OPB_SetElem (OPT_Node *x);
import void OPB_SetRange (OPT_Node *x, OPT_Node y);
-import void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno);
-import void OPB_StPar0 (OPT_Node *par0, INTEGER fctno);
-import void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno);
-import void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n);
-import void OPB_StaticLink (SHORTINT dlev);
+import void OPB_StFct (OPT_Node *par0, INT8 fctno, INT16 parno);
+import void OPB_StPar0 (OPT_Node *par0, INT16 fctno);
+import void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno);
+import void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n);
+import void OPB_StaticLink (INT8 dlev);
import void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard);
import void *OPB__init(void);
-#endif
+#endif // OPB
diff --git a/bootstrap/unix-88/OPC.c b/bootstrap/unix-88/OPC.c
index bb9b75e6..ef4b429f 100644
--- a/bootstrap/unix-88/OPC.c
+++ b/bootstrap/unix-88/OPC.c
@@ -1,32 +1,34 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "Configuration.h"
#include "OPM.h"
#include "OPT.h"
-static INTEGER OPC_indentLevel;
-static BOOLEAN OPC_ptrinit, OPC_mainprog, OPC_ansi;
-static SHORTINT OPC_hashtab[105];
-static CHAR OPC_keytab[36][9];
+static INT16 OPC_indentLevel;
+static INT8 OPC_hashtab[105];
+static CHAR OPC_keytab[50][9];
static BOOLEAN OPC_GlbPtrs;
static CHAR OPC_BodyNameExt[13];
-export void OPC_Align (LONGINT *adr, LONGINT base);
export void OPC_Andent (OPT_Struct typ);
static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames);
-export LONGINT OPC_BaseAlignment (OPT_Struct typ);
export OPT_Object OPC_BaseTProc (OPT_Object obj);
export void OPC_BegBlk (void);
export void OPC_BegStat (void);
-static void OPC_CProcDefs (OPT_Object obj, INTEGER vis);
-export void OPC_Case (LONGINT caseVal, INTEGER form);
-static void OPC_CharacterLiteral (LONGINT c);
-export void OPC_Cmp (INTEGER rel);
+static void OPC_CProcDefs (OPT_Object obj, INT16 vis);
+export void OPC_Case (INT64 caseVal, INT16 form);
+static void OPC_CharacterLiteral (INT64 c);
+export void OPC_Cmp (INT16 rel);
export void OPC_CompleteIdent (OPT_Object obj);
-export void OPC_Constant (OPT_Const con, INTEGER form);
+export void OPC_Constant (OPT_Const con, INT16 form);
static void OPC_DeclareBase (OPT_Object dcl);
static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef);
static void OPC_DeclareParams (OPT_Object par, BOOLEAN macro);
@@ -43,44 +45,45 @@ export void OPC_EnterBody (void);
export void OPC_EnterProc (OPT_Object proc);
export void OPC_ExitBody (void);
export void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet);
-static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *n, LONGINT *curAlign);
-static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LONGINT *curAlign);
+static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, INT32 *off, INT32 *n, INT32 *curAlign);
+static void OPC_FillGap (INT32 gap, INT32 off, INT32 align, INT32 *n, INT32 *curAlign);
export void OPC_GenBdy (OPT_Node n);
-static void OPC_GenDynTypes (OPT_Node n, INTEGER vis);
+static void OPC_GenDynTypes (OPT_Node n, INT16 vis);
export void OPC_GenEnumPtrs (OPT_Object var);
export void OPC_GenHdr (OPT_Node n);
export void OPC_GenHdrIncludes (void);
static void OPC_GenHeaderMsg (void);
-export void OPC_Halt (LONGINT n);
+export void OPC_Halt (INT32 n);
export void OPC_Ident (OPT_Object obj);
-static void OPC_IdentList (OPT_Object obj, INTEGER vis);
+static void OPC_IdentList (OPT_Object obj, INT16 vis);
static void OPC_Include (CHAR *name, LONGINT name__len);
-static void OPC_IncludeImports (OPT_Object obj, INTEGER vis);
+static void OPC_IncludeImports (OPT_Object obj, INT16 vis);
export void OPC_Increment (BOOLEAN decrement);
-export void OPC_Indent (INTEGER count);
+export void OPC_Indent (INT16 count);
export void OPC_Init (void);
static void OPC_InitImports (OPT_Object obj);
static void OPC_InitKeywords (void);
export void OPC_InitTDesc (OPT_Struct typ);
static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj);
-export void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim);
+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 INTEGER OPC_Length (CHAR *s, LONGINT s__len);
-export LONGINT OPC_NofPtrs (OPT_Struct typ);
-static INTEGER OPC_PerfectHash (CHAR *s, LONGINT s__len);
+static 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, LONGINT s__len);
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len);
static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define);
-static void OPC_ProcPredefs (OPT_Object obj, SHORTINT vis);
+static void OPC_ProcPredefs (OPT_Object obj, INT8 vis);
static void OPC_PutBase (OPT_Struct typ);
-static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt);
+static void OPC_PutPtrOffsets (OPT_Struct typ, INT32 adr, INT32 *cnt);
static void OPC_RegCmds (OPT_Object obj);
export void OPC_SetInclude (BOOLEAN exclude);
-export LONGINT OPC_SizeAlignment (LONGINT size);
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause);
-static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x);
-static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT 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, INTEGER vis);
+export void OPC_TypeDefs (OPT_Object obj, INT16 vis);
export void OPC_TypeOf (OPT_Object ap);
static BOOLEAN OPC_Undefined (OPT_Object obj);
@@ -88,24 +91,17 @@ static BOOLEAN OPC_Undefined (OPT_Object obj);
void OPC_Init (void)
{
OPC_indentLevel = 0;
- OPC_ptrinit = __IN(5, OPM_opt);
- OPC_mainprog = OPM_mainProg || OPM_mainLinkStat;
- OPC_ansi = __IN(6, OPM_opt);
- if (OPC_ansi) {
- __MOVE("__init(void)", OPC_BodyNameExt, 13);
- } else {
- __MOVE("__init()", OPC_BodyNameExt, 9);
- }
+ __MOVE("__init(void)", OPC_BodyNameExt, 13);
}
-void OPC_Indent (INTEGER count)
+void OPC_Indent (INT16 count)
{
OPC_indentLevel += count;
}
void OPC_BegStat (void)
{
- INTEGER i;
+ INT16 i;
i = OPC_indentLevel;
while (i > 0) {
OPM_Write(0x09);
@@ -141,10 +137,10 @@ void OPC_EndBlk0 (void)
OPM_Write('}');
}
-static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x)
+static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x)
{
CHAR ch;
- INTEGER i;
+ INT16 i;
__DUP(s, s__len, CHAR);
ch = s[0];
i = 0;
@@ -160,79 +156,86 @@ static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x)
__DEL(s);
}
-static INTEGER OPC_Length (CHAR *s, LONGINT s__len)
+static INT16 OPC_Length (CHAR *s, LONGINT s__len)
{
- INTEGER _o_result;
- INTEGER i;
+ INT16 i;
i = 0;
while (s[__X(i, s__len)] != 0x00) {
i += 1;
}
- _o_result = i;
- return _o_result;
+ return i;
}
-static INTEGER OPC_PerfectHash (CHAR *s, LONGINT s__len)
+static INT16 OPC_PerfectHash (CHAR *s, LONGINT s__len)
{
- INTEGER _o_result;
- INTEGER i, h;
+ INT16 i, h;
i = 0;
h = 0;
while ((s[__X(i, s__len)] != 0x00 && i < 5)) {
- h = 3 * h + (int)s[__X(i, s__len)];
+ h = 3 * h + (INT16)s[__X(i, s__len)];
i += 1;
}
- _o_result = (int)__MOD(h, 105);
- return _o_result;
+ return (int)__MOD(h, 105);
}
void OPC_Ident (OPT_Object obj)
{
- INTEGER mode, level, h;
+ INT16 mode, level, h;
mode = obj->mode;
level = obj->mnolev;
- if ((__IN(mode, 0x62) && level > 0) || __IN(mode, 0x14)) {
- OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256)));
- h = OPC_PerfectHash((void*)obj->name, ((LONGINT)(256)));
- if (OPC_hashtab[__X(h, ((LONGINT)(105)))] >= 0) {
- if (__STRCMP(OPC_keytab[__X(OPC_hashtab[__X(h, ((LONGINT)(105)))], ((LONGINT)(36)))], obj->name) == 0) {
+ if ((__IN(mode, 0x62, 32) && level > 0) || __IN(mode, 0x14, 32)) {
+ OPM_WriteStringVar((void*)obj->name, 256);
+ h = OPC_PerfectHash((void*)obj->name, 256);
+ if (OPC_hashtab[__X(h, 105)] >= 0) {
+ if (__STRCMP(OPC_keytab[__X(OPC_hashtab[__X(h, 105)], 50)], obj->name) == 0) {
OPM_Write('_');
}
}
+ } else if ((mode == 5 && __IN(obj->typ->form, 0x90, 32))) {
+ if (obj->typ == OPT_adrtyp) {
+ OPM_WriteString((CHAR*)"ADDRESS", 8);
+ } else {
+ if (obj->typ->form == 4) {
+ OPM_WriteString((CHAR*)"INT", 4);
+ } else {
+ OPM_WriteString((CHAR*)"UINT", 5);
+ }
+ OPM_WriteInt(__ASHL(obj->typ->size, 3));
+ }
} else {
if (mode != 5 || obj->linkadr != 2) {
if (mode == 13) {
OPC_Ident(obj->link->typ->strobj);
} else if (level < 0) {
- OPM_WriteStringVar((void*)OPT_GlbMod[__X(-level, ((LONGINT)(64)))]->name, ((LONGINT)(256)));
+ OPM_WriteStringVar((void*)OPT_GlbMod[__X(-level, 64)]->name, 256);
if (OPM_currFile == 0) {
- OPT_GlbMod[__X(-level, ((LONGINT)(64)))]->vis = 1;
+ OPT_GlbMod[__X(-level, 64)]->vis = 1;
}
} else {
- OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32)));
+ OPM_WriteStringVar((void*)OPM_modName, 32);
}
OPM_Write('_');
} else if (obj == OPT_sysptrtyp->strobj || obj == OPT_bytetyp->strobj) {
- OPM_WriteString((CHAR*)"SYSTEM_", (LONGINT)8);
+ OPM_WriteString((CHAR*)"SYSTEM_", 8);
}
- OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256)));
+ OPM_WriteStringVar((void*)obj->name, 256);
}
}
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause)
{
- INTEGER pointers;
+ INT16 pointers;
*openClause = 0;
if (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->comp != 4)) {
- if (__IN(typ->comp, 0x0c)) {
+ if (__IN(typ->comp, 0x0c, 32)) {
OPC_Stars(typ->BaseTyp, &*openClause);
*openClause = typ->comp == 2;
- } else if (typ->form == 14) {
+ } else if (typ->form == 12) {
OPM_Write('(');
OPM_Write('*');
} else {
pointers = 0;
- while (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->form == 13)) {
+ while (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->form == 11)) {
pointers += 1;
typ = typ->BaseTyp;
}
@@ -257,7 +260,7 @@ static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef)
{
OPT_Struct typ = NIL;
BOOLEAN varPar, openClause;
- INTEGER form, comp;
+ INT16 form, comp;
typ = dcl->typ;
varPar = ((dcl->mode == 2 && typ->comp != 2) || typ->comp == 3) || scopeDef;
OPC_Stars(typ, &openClause);
@@ -277,22 +280,18 @@ static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef)
for (;;) {
form = typ->form;
comp = typ->comp;
- if (((typ->strobj != NIL && typ->strobj->name[0] != 0x00) || form == 12) || comp == 4) {
+ if (((typ->strobj != NIL && typ->strobj->name[0] != 0x00) || form == 10) || comp == 4) {
break;
- } else if ((form == 13 && typ->BaseTyp->comp != 3)) {
+ } else if ((form == 11 && typ->BaseTyp->comp != 3)) {
openClause = 1;
- } else if (form == 14 || __IN(comp, 0x0c)) {
+ } else if (form == 12 || __IN(comp, 0x0c, 32)) {
if (openClause) {
OPM_Write(')');
openClause = 0;
}
- if (form == 14) {
- if (OPC_ansi) {
- OPM_Write(')');
- OPC_AnsiParamList(typ->link, 0);
- } else {
- OPM_WriteString((CHAR*)")()", (LONGINT)4);
- }
+ if (form == 12) {
+ OPM_Write(')');
+ OPC_AnsiParamList(typ->link, 0);
break;
} else if (comp == 2) {
OPM_Write('[');
@@ -309,8 +308,8 @@ static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef)
void OPC_Andent (OPT_Struct typ)
{
if (typ->strobj == NIL || typ->align >= 65536) {
- OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32)));
- OPC_Str1((CHAR*)"__#", (LONGINT)4, __ASHR(typ->align, 16));
+ OPM_WriteStringVar((void*)OPM_modName, 32);
+ OPC_Str1((CHAR*)"__#", 4, __ASHR(typ->align, 16));
} else {
OPC_Ident(typ->strobj);
}
@@ -318,36 +317,34 @@ void OPC_Andent (OPT_Struct typ)
static BOOLEAN OPC_Undefined (OPT_Object obj)
{
- BOOLEAN _o_result;
- _o_result = obj->name[0] == 0x00 || (((obj->mnolev >= 0 && obj->linkadr != (SYSTEM_INT64)(3 + OPM_currFile))) && obj->linkadr != 2);
- return _o_result;
+ return obj->name[0] == 0x00 || (((obj->mnolev >= 0 && obj->linkadr != (3 + OPM_currFile))) && obj->linkadr != 2);
}
static void OPC_DeclareBase (OPT_Object dcl)
{
OPT_Struct typ = NIL, prev = NIL;
OPT_Object obj = NIL;
- INTEGER nofdims;
- LONGINT off, n, dummy;
+ INT16 nofdims;
+ INT32 off, n, dummy;
typ = dcl->typ;
prev = typ;
- while ((((((((typ->strobj == NIL || typ->comp == 3) || OPC_Undefined(typ->strobj)) && typ->comp != 4)) && typ->form != 12)) && !((typ->form == 13 && typ->BaseTyp->comp == 3)))) {
+ while ((((((((typ->strobj == NIL || typ->comp == 3) || OPC_Undefined(typ->strobj)) && typ->comp != 4)) && typ->form != 10)) && !((typ->form == 11 && typ->BaseTyp->comp == 3)))) {
prev = typ;
typ = typ->BaseTyp;
}
obj = typ->strobj;
- if (typ->form == 12) {
- OPM_WriteString((CHAR*)"void", (LONGINT)5);
+ if (typ->form == 10) {
+ OPM_WriteString((CHAR*)"void", 5);
} else if ((obj != NIL && !OPC_Undefined(obj))) {
OPC_Ident(obj);
} else if (typ->comp == 4) {
- OPM_WriteString((CHAR*)"struct ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"struct ", 8);
OPC_Andent(typ);
- if ((prev->form != 13 && (obj != NIL || dcl->name[0] == 0x00))) {
+ if ((prev->form != 11 && (obj != NIL || dcl->name[0] == 0x00))) {
if ((typ->BaseTyp != NIL && typ->BaseTyp->strobj->vis != 0)) {
- OPM_WriteString((CHAR*)" { /* ", (LONGINT)7);
+ OPM_WriteString((CHAR*)" { /* ", 7);
OPC_Ident(typ->BaseTyp->strobj);
- OPM_WriteString((CHAR*)" */", (LONGINT)4);
+ OPM_WriteString((CHAR*)" */", 4);
OPM_WriteLn();
OPC_Indent(1);
} else {
@@ -357,22 +354,22 @@ static void OPC_DeclareBase (OPT_Object dcl)
OPC_FieldList(typ, 1, &off, &n, &dummy);
OPC_EndBlk0();
}
- } else if ((typ->form == 13 && typ->BaseTyp->comp == 3)) {
+ } else if ((typ->form == 11 && typ->BaseTyp->comp == 3)) {
typ = typ->BaseTyp->BaseTyp;
nofdims = 1;
while (typ->comp == 3) {
nofdims += 1;
typ = typ->BaseTyp;
}
- OPM_WriteString((CHAR*)"struct ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"struct ", 8);
OPC_BegBlk();
OPC_BegStat();
- OPC_Str1((CHAR*)"LONGINT len[#]", (LONGINT)15, nofdims);
+ OPC_Str1((CHAR*)"LONGINT len[#]", 15, nofdims);
OPC_EndStat();
OPC_BegStat();
__NEW(obj, OPT_ObjDesc);
__NEW(obj->typ, OPT_StrDesc);
- obj->typ->form = 15;
+ obj->typ->form = 13;
obj->typ->comp = 2;
obj->typ->n = 1;
obj->typ->BaseTyp = typ;
@@ -387,15 +384,13 @@ static void OPC_DeclareBase (OPT_Object dcl)
}
}
-LONGINT OPC_NofPtrs (OPT_Struct typ)
+INT32 OPC_NofPtrs (OPT_Struct typ)
{
- LONGINT _o_result;
OPT_Object fld = NIL;
OPT_Struct btyp = NIL;
- LONGINT n;
- if ((typ->form == 13 && typ->sysflag == 0)) {
- _o_result = 1;
- return _o_result;
+ INT32 n;
+ if ((typ->form == 11 && typ->sysflag == 0)) {
+ return 1;
} else if ((typ->comp == 4 && __MASK(typ->sysflag, -256) == 0)) {
btyp = typ->BaseTyp;
if (btyp != NIL) {
@@ -412,8 +407,7 @@ LONGINT OPC_NofPtrs (OPT_Struct typ)
}
fld = fld->link;
}
- _o_result = n;
- return _o_result;
+ return n;
} else if (typ->comp == 2) {
btyp = typ->BaseTyp;
n = typ->n;
@@ -421,23 +415,21 @@ LONGINT OPC_NofPtrs (OPT_Struct typ)
n = btyp->n * n;
btyp = btyp->BaseTyp;
}
- _o_result = OPC_NofPtrs(btyp) * n;
- return _o_result;
+ return OPC_NofPtrs(btyp) * n;
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt)
+static void OPC_PutPtrOffsets (OPT_Struct typ, INT32 adr, INT32 *cnt)
{
OPT_Object fld = NIL;
OPT_Struct btyp = NIL;
- LONGINT n, i;
- if ((typ->form == 13 && typ->sysflag == 0)) {
+ INT32 n, i;
+ if ((typ->form == 11 && typ->sysflag == 0)) {
OPM_WriteInt(adr);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
*cnt += 1;
if (__MASK(*cnt, -16) == 0) {
OPM_WriteLn();
@@ -454,7 +446,7 @@ static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt)
OPC_PutPtrOffsets(fld->typ, adr + fld->adr, &*cnt);
} else {
OPM_WriteInt(adr + fld->adr);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
*cnt += 1;
if (__MASK(*cnt, -16) == 0) {
OPM_WriteLn();
@@ -486,11 +478,11 @@ static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj)
OPC_InitTProcs(typ, obj->left);
if (obj->mode == 13) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"__INITBP(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__INITBP(", 10);
OPC_Ident(typ);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Ident(obj);
- OPC_Str1((CHAR*)", #)", (LONGINT)5, __ASHR(obj->adr, 16));
+ OPC_Str1((CHAR*)", #)", 5, __ASHR(obj->adr, 16));
OPC_EndStat();
}
OPC_InitTProcs(typ, obj->right);
@@ -502,30 +494,30 @@ static void OPC_PutBase (OPT_Struct typ)
if (typ != NIL) {
OPC_PutBase(typ->BaseTyp);
OPC_Ident(typ->strobj);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)"__typ", 6);
+ OPM_WriteString((CHAR*)", ", 3);
}
}
static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamName)
{
OPT_Struct typ = NIL;
- INTEGER dim;
+ INT16 dim;
if (showParamName) {
OPC_Ident(par);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
}
dim = 1;
typ = par->typ->BaseTyp;
while (typ->comp == 3) {
if (ansiDefine) {
- OPM_WriteString((CHAR*)", LONGINT ", (LONGINT)11);
+ OPM_WriteString((CHAR*)", LONGINT ", 11);
} else {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
}
if (showParamName) {
OPC_Ident(par);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
OPM_WriteInt(dim);
}
typ = typ->BaseTyp;
@@ -538,24 +530,24 @@ static void OPC_DeclareParams (OPT_Object par, BOOLEAN macro)
OPM_Write('(');
while (par != NIL) {
if (macro) {
- OPM_WriteStringVar((void*)par->name, ((LONGINT)(256)));
+ OPM_WriteStringVar((void*)par->name, 256);
} else {
- if ((par->mode == 1 && par->typ->form == 7)) {
+ if ((par->mode == 1 && par->typ->form == 5)) {
OPM_Write('_');
}
OPC_Ident(par);
}
if (par->typ->comp == 3) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_LenList(par, 0, 1);
} else if ((par->mode == 2 && par->typ->comp == 4)) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPM_WriteStringVar((void*)par->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPM_WriteStringVar((void*)par->name, 256);
+ OPM_WriteString((CHAR*)"__typ", 6);
}
par = par->link;
if (par != NIL) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
}
}
OPM_Write(')');
@@ -567,12 +559,10 @@ static void OPC_DefineTProcTypes (OPT_Object obj)
if (obj->typ != OPT_notyp) {
OPC_DefineType(obj->typ);
}
- if (OPC_ansi) {
- par = obj->link;
- while (par != NIL) {
- OPC_DefineType(par->typ);
- par = par->link;
- }
+ par = obj->link;
+ while (par != NIL) {
+ OPC_DefineType(par->typ);
+ par = par->link;
}
}
@@ -587,7 +577,7 @@ static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty)
if (OPM_currFile == 0) {
if (obj->vis == 1) {
OPC_DefineTProcTypes(obj);
- OPM_WriteString((CHAR*)"import ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"import ", 8);
*empty = 0;
OPC_ProcHeader(obj, 0);
}
@@ -595,9 +585,9 @@ static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty)
*empty = 0;
OPC_DefineTProcTypes(obj);
if (obj->vis == 0) {
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"static ", 8);
} else {
- OPM_WriteString((CHAR*)"export ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"export ", 8);
}
OPC_ProcHeader(obj, 0);
}
@@ -608,11 +598,10 @@ static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty)
OPT_Object OPC_BaseTProc (OPT_Object obj)
{
- OPT_Object _o_result;
OPT_Struct typ = NIL, base = NIL;
- LONGINT mno;
+ INT32 mno;
typ = obj->link->typ;
- if (typ->form == 13) {
+ if (typ->form == 11) {
typ = typ->BaseTyp;
}
base = typ->BaseTyp;
@@ -622,8 +611,7 @@ OPT_Object OPC_BaseTProc (OPT_Object obj)
base = typ->BaseTyp;
}
OPT_FindField(obj->name, typ, &obj);
- _o_result = obj;
- return _o_result;
+ return obj;
}
static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty)
@@ -631,31 +619,27 @@ static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty)
if (obj != NIL) {
OPC_DefineTProcMacros(obj->left, &*empty);
if ((((obj->mode == 13 && obj == OPC_BaseTProc(obj))) && (OPM_currFile != 0 || obj->vis == 1))) {
- OPM_WriteString((CHAR*)"#define __", (LONGINT)11);
+ OPM_WriteString((CHAR*)"#define __", 11);
OPC_Ident(obj);
OPC_DeclareParams(obj->link, 1);
- OPM_WriteString((CHAR*)" __SEND(", (LONGINT)9);
- if (obj->link->typ->form == 13) {
- OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10);
+ 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", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
}
- OPC_Str1((CHAR*)", #, ", (LONGINT)6, __ASHR(obj->adr, 16));
+ OPC_Str1((CHAR*)", #, ", 6, __ASHR(obj->adr, 16));
if (obj->typ == OPT_notyp) {
- OPM_WriteString((CHAR*)"void", (LONGINT)5);
+ OPM_WriteString((CHAR*)"void", 5);
} else {
OPC_Ident(obj->typ->strobj);
}
- OPM_WriteString((CHAR*)"(*)", (LONGINT)4);
- if (OPC_ansi) {
- OPC_AnsiParamList(obj->link, 0);
- } else {
- OPM_WriteString((CHAR*)"()", (LONGINT)3);
- }
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)"(*)", 4);
+ OPC_AnsiParamList(obj->link, 0);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_DeclareParams(obj->link, 1);
OPM_Write(')');
OPM_WriteLn();
@@ -673,7 +657,7 @@ static void OPC_DefineType (OPT_Struct str)
if (obj == NIL || OPC_Undefined(obj)) {
if (obj != NIL) {
if (obj->linkadr == 1) {
- if (str->form != 13) {
+ if (str->form != 11) {
OPM_Mark(244, str->txtpos);
obj->linkadr = 2;
}
@@ -692,13 +676,13 @@ static void OPC_DefineType (OPT_Struct str)
}
field = field->link;
}
- } else if (str->form == 13) {
+ } else if (str->form == 11) {
if (str->BaseTyp->comp != 4) {
OPC_DefineType(str->BaseTyp);
}
- } else if (__IN(str->comp, 0x0c)) {
+ } else if (__IN(str->comp, 0x0c, 32)) {
OPC_DefineType(str->BaseTyp);
- } else if (str->form == 14) {
+ } else if (str->form == 12) {
if (str->BaseTyp != OPT_notyp) {
OPC_DefineType(str->BaseTyp);
}
@@ -710,7 +694,7 @@ static void OPC_DefineType (OPT_Struct str)
}
}
if ((obj != NIL && OPC_Undefined(obj))) {
- OPM_WriteString((CHAR*)"typedef", (LONGINT)8);
+ OPM_WriteString((CHAR*)"typedef", 8);
OPM_WriteLn();
OPM_Write(0x09);
OPC_Indent(1);
@@ -738,40 +722,36 @@ static void OPC_DefineType (OPT_Struct str)
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len)
{
- BOOLEAN _o_result;
- INTEGER i;
- BOOLEAN r;
+ INT16 i;
__DUP(y, y__len, CHAR);
i = 0;
- while ((*x)[__X(i + 1, ((LONGINT)(256)))] == y[__X(i, y__len)]) {
+ while ((*x)[__X(i + 1, 256)] == y[__X(i, y__len)]) {
i += 1;
}
- r = y[__X(i, y__len)] == 0x00;
- _o_result = r;
__DEL(y);
- return _o_result;
+ return y[__X(i, y__len)] == 0x00;
}
-static void OPC_CProcDefs (OPT_Object obj, INTEGER vis)
+static void OPC_CProcDefs (OPT_Object obj, INT16 vis)
{
- INTEGER i;
+ INT16 i;
OPT_ConstExt ext = NIL;
- INTEGER _for__9;
+ INT16 _for__7;
if (obj != NIL) {
OPC_CProcDefs(obj->left, vis);
- if ((((obj->mode == 9 && (int)obj->vis >= vis)) && obj->adr == 1)) {
+ if ((((obj->mode == 9 && (INT16)obj->vis >= vis)) && obj->adr == 1)) {
ext = obj->conval->ext;
i = 1;
- if (((*ext)[1] != '#' && !(OPC_Prefixed(ext, (CHAR*)"extern ", (LONGINT)8) || OPC_Prefixed(ext, (CHAR*)"import ", (LONGINT)8)))) {
- OPM_WriteString((CHAR*)"#define ", (LONGINT)9);
+ if (((*ext)[1] != '#' && !(OPC_Prefixed(ext, (CHAR*)"extern ", 8) || OPC_Prefixed(ext, (CHAR*)"import ", 8)))) {
+ OPM_WriteString((CHAR*)"#define ", 9);
OPC_Ident(obj);
OPC_DeclareParams(obj->link, 1);
OPM_Write(0x09);
}
- _for__9 = (int)(*obj->conval->ext)[0];
+ _for__7 = (INT16)(*obj->conval->ext)[0];
i = i;
- while (i <= _for__9) {
- OPM_Write((*obj->conval->ext)[__X(i, ((LONGINT)(256)))]);
+ while (i <= _for__7) {
+ OPM_Write((*obj->conval->ext)[__X(i, 256)]);
i += 1;
}
OPM_WriteLn();
@@ -780,7 +760,7 @@ static void OPC_CProcDefs (OPT_Object obj, INTEGER vis)
}
}
-void OPC_TypeDefs (OPT_Object obj, INTEGER vis)
+void OPC_TypeDefs (OPT_Object obj, INT16 vis)
{
if (obj != NIL) {
OPC_TypeDefs(obj->left, vis);
@@ -812,130 +792,85 @@ static void OPC_DefAnonRecs (OPT_Node n)
void OPC_TDescDecl (OPT_Struct typ)
{
- LONGINT nofptrs;
+ INT32 nofptrs;
OPT_Object o = NIL;
OPC_BegStat();
- OPM_WriteString((CHAR*)"__TDESC(", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__TDESC(", 9);
OPC_Andent(typ);
- OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1);
- OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ));
+ OPC_Str1((CHAR*)", #", 4, typ->n + 1);
+ OPC_Str1((CHAR*)", #) = {__TDFLDS(", 18, OPC_NofPtrs(typ));
OPM_Write('"');
if (typ->strobj != NIL) {
- OPM_WriteStringVar((void*)typ->strobj->name, ((LONGINT)(256)));
+ OPM_WriteStringVar((void*)typ->strobj->name, 256);
}
OPM_Write('"');
- OPC_Str1((CHAR*)", #), {", (LONGINT)8, typ->size);
+ OPC_Str1((CHAR*)", #), {", 8, typ->size);
nofptrs = 0;
- OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs);
- OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (SYSTEM_INT64)OPM_LIntSize));
+ OPC_PutPtrOffsets(typ, 0, &nofptrs);
+ OPC_Str1((CHAR*)"#}}", 4, -((nofptrs + 1) * OPM_AddressSize));
OPC_EndStat();
}
void OPC_InitTDesc (OPT_Struct typ)
{
OPC_BegStat();
- OPM_WriteString((CHAR*)"__INITYP(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__INITYP(", 10);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
if (typ->BaseTyp != NIL) {
OPC_Andent(typ->BaseTyp);
} else {
OPC_Andent(typ);
}
- OPC_Str1((CHAR*)", #)", (LONGINT)5, typ->extlev);
+ OPC_Str1((CHAR*)", #)", 5, typ->extlev);
OPC_EndStat();
if (typ->strobj != NIL) {
OPC_InitTProcs(typ->strobj, typ->link);
}
}
-void OPC_Align (LONGINT *adr, LONGINT base)
+static void OPC_FillGap (INT32 gap, INT32 off, INT32 align, INT32 *n, INT32 *curAlign)
{
- switch (base) {
- case 2:
- *adr += __MASK(*adr, -2);
- break;
- case 4:
- *adr += __MASK(-*adr, -4);
- break;
- case 8:
- *adr += __MASK(-*adr, -8);
- break;
- case 16:
- *adr += __MASK(-*adr, -16);
- break;
- default:
- break;
- }
-}
-
-LONGINT OPC_SizeAlignment (LONGINT size)
-{
- LONGINT _o_result;
- LONGINT alignment;
- if (size < (SYSTEM_INT64)OPM_Alignment) {
- alignment = 1;
- while (alignment < size) {
- alignment = __ASHL(alignment, 1);
- }
- } else {
- alignment = OPM_Alignment;
- }
- _o_result = alignment;
- return _o_result;
-}
-
-LONGINT OPC_BaseAlignment (OPT_Struct typ)
-{
- LONGINT _o_result;
- LONGINT alignment;
- if (typ->form == 15) {
- if (typ->comp == 4) {
- alignment = __MASK(typ->align, -65536);
- } else {
- alignment = OPC_BaseAlignment(typ->BaseTyp);
- }
- } else {
- alignment = OPC_SizeAlignment(typ->size);
- }
- _o_result = alignment;
- return _o_result;
-}
-
-static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LONGINT *curAlign)
-{
- LONGINT adr;
+ INT32 adr;
adr = off;
- OPC_Align(&adr, align);
+ OPT_Align(&adr, align);
if ((*curAlign < align && gap - (adr - off) >= align)) {
gap -= (adr - off) + align;
OPC_BegStat();
- if (align == (SYSTEM_INT64)OPM_IntSize) {
- OPM_WriteString((CHAR*)"INTEGER", (LONGINT)8);
- } else if (align == (SYSTEM_INT64)OPM_LIntSize) {
- OPM_WriteString((CHAR*)"LONGINT", (LONGINT)8);
- } else if (align == (SYSTEM_INT64)OPM_LRealSize) {
- OPM_WriteString((CHAR*)"LONGREAL", (LONGINT)9);
+ switch (align) {
+ case 2:
+ OPM_WriteString((CHAR*)"INT16", 6);
+ break;
+ case 4:
+ OPM_WriteString((CHAR*)"INT32", 6);
+ break;
+ case 8:
+ OPM_WriteString((CHAR*)"INT64", 6);
+ break;
+ default:
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Unexpected enclosing alignment in FillGap.", 43);
+ break;
}
- OPC_Str1((CHAR*)" _prvt#", (LONGINT)8, *n);
+ OPC_Str1((CHAR*)" _prvt#", 8, *n);
*n += 1;
OPC_EndStat();
*curAlign = align;
}
if (gap > 0) {
OPC_BegStat();
- OPC_Str1((CHAR*)"char _prvt#", (LONGINT)12, *n);
+ OPC_Str1((CHAR*)"char _prvt#", 12, *n);
*n += 1;
- OPC_Str1((CHAR*)"[#]", (LONGINT)4, gap);
+ OPC_Str1((CHAR*)"[#]", 4, gap);
OPC_EndStat();
}
}
-static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *n, LONGINT *curAlign)
+static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, INT32 *off, INT32 *n, INT32 *curAlign)
{
OPT_Object fld = NIL;
OPT_Struct base = NIL;
- LONGINT gap, adr, align, fldAlign;
+ INT32 gap, adr, align, fldAlign;
fld = typ->link;
align = __MASK(typ->align, -65536);
if (typ->BaseTyp != NIL) {
@@ -953,8 +888,8 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
}
} else {
adr = *off;
- fldAlign = OPC_BaseAlignment(fld->typ);
- OPC_Align(&adr, fldAlign);
+ fldAlign = OPT_BaseAlignment(fld->typ);
+ OPT_Align(&adr, fldAlign);
gap = fld->adr - adr;
if (fldAlign > *curAlign) {
*curAlign = fldAlign;
@@ -970,7 +905,7 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
base = fld->typ;
fld = fld->link;
while ((((((((fld != NIL && fld->mode == 4)) && fld->typ == base)) && fld->adr == *off)) && ((OPM_currFile == 1 || fld->vis != 0) || fld->typ->strobj == NIL))) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_DeclareObj(fld, 0);
*off = fld->adr + fld->typ->size;
fld = fld->link;
@@ -979,7 +914,7 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
}
}
if (last) {
- adr = typ->size - (SYSTEM_INT64)__ASHR(typ->sysflag, 8);
+ adr = typ->size - __ASHR(typ->sysflag, 8);
if (adr == 0) {
gap = 1;
} else {
@@ -991,16 +926,16 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
}
}
-static void OPC_IdentList (OPT_Object obj, INTEGER vis)
+static void OPC_IdentList (OPT_Object obj, INT16 vis)
{
OPT_Struct base = NIL;
BOOLEAN first;
- INTEGER lastvis;
+ INT16 lastvis;
base = NIL;
first = 1;
while ((obj != NIL && obj->mode != 13)) {
- if ((__IN(vis, 0x05) || (vis == 1 && obj->vis != 0)) || (vis == 3 && !obj->leaf)) {
- if (obj->typ != base || (int)obj->vis != lastvis) {
+ if ((__IN(vis, 0x05, 32) || (vis == 1 && obj->vis != 0)) || (vis == 3 && !obj->leaf)) {
+ if (obj->typ != base || (INT16)obj->vis != lastvis) {
if (!first) {
OPC_EndStat();
}
@@ -1009,16 +944,16 @@ static void OPC_IdentList (OPT_Object obj, INTEGER vis)
lastvis = obj->vis;
OPC_BegStat();
if ((vis == 1 && obj->vis != 0)) {
- OPM_WriteString((CHAR*)"import ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"import ", 8);
} else if ((obj->mnolev == 0 && vis == 0)) {
if (obj->vis == 0) {
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"static ", 8);
} else {
- OPM_WriteString((CHAR*)"export ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"export ", 8);
}
}
- if ((((vis == 2 && obj->mode == 1)) && base->form == 7)) {
- OPM_WriteString((CHAR*)"double", (LONGINT)7);
+ if ((((vis == 2 && obj->mode == 1)) && base->form == 5)) {
+ OPM_WriteString((CHAR*)"double", 7);
} else {
OPC_DeclareBase(obj);
}
@@ -1026,7 +961,7 @@ static void OPC_IdentList (OPT_Object obj, INTEGER vis)
OPM_Write(',');
}
OPM_Write(' ');
- if ((((vis == 2 && obj->mode == 1)) && base->form == 7)) {
+ if ((((vis == 2 && obj->mode == 1)) && base->form == 5)) {
OPM_Write('_');
}
OPC_DeclareObj(obj, vis == 3);
@@ -1034,17 +969,17 @@ static void OPC_IdentList (OPT_Object obj, INTEGER vis)
OPC_EndStat();
OPC_BegStat();
base = OPT_linttyp;
- OPM_WriteString((CHAR*)"LONGINT ", (LONGINT)9);
+ OPM_WriteString((CHAR*)"LONGINT ", 9);
OPC_LenList(obj, 0, 1);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPC_EndStat();
OPC_BegStat();
- OPM_WriteString((CHAR*)"LONGINT *", (LONGINT)10);
+ OPM_WriteString((CHAR*)"ADDRESS *", 10);
OPC_Ident(obj);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
base = NIL;
- } else if ((((((OPC_ptrinit && vis == 0)) && obj->mnolev > 0)) && obj->typ->form == 13)) {
- OPM_WriteString((CHAR*)" = NIL", (LONGINT)7);
+ } else if ((((((__IN(5, OPM_Options, 32) && vis == 0)) && obj->mnolev > 0)) && obj->typ->form == 11)) {
+ OPM_WriteString((CHAR*)" = NIL", 7);
}
}
obj = obj->link;
@@ -1059,7 +994,7 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
CHAR name[32];
OPM_Write('(');
if (obj == NIL || obj->mode == 13) {
- OPM_WriteString((CHAR*)"void", (LONGINT)5);
+ OPM_WriteString((CHAR*)"void", 5);
} else {
for (;;) {
OPC_DeclareBase(obj);
@@ -1067,25 +1002,25 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
OPM_Write(' ');
OPC_DeclareObj(obj, 0);
} else {
- __COPY(obj->name, name, ((LONGINT)(32)));
+ __COPY(obj->name, name, 32);
obj->name[0] = 0x00;
OPC_DeclareObj(obj, 0);
- __COPY(name, obj->name, ((LONGINT)(256)));
+ __COPY(name, obj->name, 256);
}
if (obj->typ->comp == 3) {
- OPM_WriteString((CHAR*)", LONGINT ", (LONGINT)11);
+ OPM_WriteString((CHAR*)", LONGINT ", 11);
OPC_LenList(obj, 1, showParamNames);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
- OPM_WriteString((CHAR*)", LONGINT *", (LONGINT)12);
+ OPM_WriteString((CHAR*)", ADDRESS *", 12);
if (showParamNames) {
OPC_Ident(obj);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
}
}
if (obj->link == NIL || obj->link->mode == 13) {
break;
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
obj = obj->link;
}
}
@@ -1095,42 +1030,31 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define)
{
if (proc->typ == OPT_notyp) {
- OPM_WriteString((CHAR*)"void", (LONGINT)5);
+ OPM_WriteString((CHAR*)"void", 5);
} else {
OPC_Ident(proc->typ->strobj);
}
OPM_Write(' ');
OPC_Ident(proc);
OPM_Write(' ');
- if (OPC_ansi) {
- OPC_AnsiParamList(proc->link, 1);
- if (!define) {
- OPM_Write(';');
- }
- OPM_WriteLn();
- } else if (define) {
- OPC_DeclareParams(proc->link, 0);
- OPM_WriteLn();
- OPC_Indent(1);
- OPC_IdentList(proc->link, 2);
- OPC_Indent(-1);
- } else {
- OPM_WriteString((CHAR*)"();", (LONGINT)4);
- OPM_WriteLn();
+ OPC_AnsiParamList(proc->link, 1);
+ if (!define) {
+ OPM_Write(';');
}
+ OPM_WriteLn();
}
-static void OPC_ProcPredefs (OPT_Object obj, SHORTINT vis)
+static void OPC_ProcPredefs (OPT_Object obj, INT8 vis)
{
if (obj != NIL) {
OPC_ProcPredefs(obj->left, vis);
- if ((((__IN(obj->mode, 0xc0) && obj->vis >= vis)) && (obj->history != 4 || obj->mode == 6))) {
+ if ((((__IN(obj->mode, 0xc0, 32) && obj->vis >= vis)) && (obj->history != 4 || obj->mode == 6))) {
if (vis == 1) {
- OPM_WriteString((CHAR*)"import ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"import ", 8);
} else if (obj->vis == 0) {
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"static ", 8);
} else {
- OPM_WriteString((CHAR*)"export ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"export ", 8);
}
OPC_ProcHeader(obj, 0);
}
@@ -1141,27 +1065,27 @@ static void OPC_ProcPredefs (OPT_Object obj, SHORTINT vis)
static void OPC_Include (CHAR *name, LONGINT name__len)
{
__DUP(name, name__len, CHAR);
- OPM_WriteString((CHAR*)"#include ", (LONGINT)10);
+ OPM_WriteString((CHAR*)"#include ", 10);
OPM_Write('"');
OPM_WriteStringVar((void*)name, name__len);
- OPM_WriteString((CHAR*)".h", (LONGINT)3);
+ OPM_WriteString((CHAR*)".h", 3);
OPM_Write('"');
OPM_WriteLn();
__DEL(name);
}
-static void OPC_IncludeImports (OPT_Object obj, INTEGER vis)
+static void OPC_IncludeImports (OPT_Object obj, INT16 vis)
{
if (obj != NIL) {
OPC_IncludeImports(obj->left, vis);
- if ((((obj->mode == 11 && obj->mnolev != 0)) && (int)OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->vis >= vis)) {
- OPC_Include(OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, ((LONGINT)(256)));
+ if ((((obj->mode == 11 && obj->mnolev != 0)) && (INT16)OPT_GlbMod[__X(-obj->mnolev, 64)]->vis >= vis)) {
+ OPC_Include(OPT_GlbMod[__X(-obj->mnolev, 64)]->name, 256);
}
OPC_IncludeImports(obj->right, vis);
}
}
-static void OPC_GenDynTypes (OPT_Node n, INTEGER vis)
+static void OPC_GenDynTypes (OPT_Node n, INT16 vis)
{
OPT_Struct typ = NIL;
while ((n != NIL && n->class == 14)) {
@@ -1169,15 +1093,15 @@ static void OPC_GenDynTypes (OPT_Node n, INTEGER vis)
if (vis == 0 || typ->ref < 255) {
OPC_BegStat();
if (vis == 1) {
- OPM_WriteString((CHAR*)"import ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"import ", 8);
} else if ((typ->strobj != NIL && typ->strobj->mnolev > 0)) {
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"static ", 8);
} else {
- OPM_WriteString((CHAR*)"export ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"export ", 8);
}
- OPM_WriteString((CHAR*)"LONGINT *", (LONGINT)10);
+ OPM_WriteString((CHAR*)"ADDRESS *", 10);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
OPC_EndStat();
}
n = n->link;
@@ -1195,29 +1119,30 @@ void OPC_GenHdr (OPT_Node n)
OPC_GenDynTypes(n, 1);
OPM_WriteLn();
OPC_ProcPredefs(OPT_topScope->right, 1);
- OPM_WriteString((CHAR*)"import ", (LONGINT)8);
- OPM_WriteString((CHAR*)"void *", (LONGINT)7);
- OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32)));
- OPM_WriteString(OPC_BodyNameExt, ((LONGINT)(13)));
+ OPM_WriteString((CHAR*)"import ", 8);
+ OPM_WriteString((CHAR*)"void *", 7);
+ OPM_WriteStringVar((void*)OPM_modName, 32);
+ OPM_WriteString(OPC_BodyNameExt, 13);
OPC_EndStat();
OPM_WriteLn();
OPC_CProcDefs(OPT_topScope->right, 1);
OPM_WriteLn();
- OPM_WriteString((CHAR*)"#endif", (LONGINT)7);
+ OPM_WriteString((CHAR*)"#endif // ", 11);
+ OPM_WriteStringVar((void*)OPM_modName, 32);
OPM_WriteLn();
}
static void OPC_GenHeaderMsg (void)
{
- INTEGER i;
- OPM_WriteString((CHAR*)"/* ", (LONGINT)4);
- OPM_WriteString((CHAR*)"voc", (LONGINT)4);
+ INT16 i;
+ OPM_WriteString((CHAR*)"/* ", 4);
+ OPM_WriteString((CHAR*)"voc", 4);
OPM_Write(' ');
- OPM_WriteString(Configuration_versionLong, ((LONGINT)(41)));
+ OPM_WriteString(Configuration_versionLong, 75);
OPM_Write(' ');
i = 0;
- while (i <= 63) {
- if (__IN(i, OPM_glbopt)) {
+ while (i <= 31) {
+ if (__IN(i, OPM_Options, 32)) {
switch (i) {
case 0:
OPM_Write('x');
@@ -1234,9 +1159,6 @@ static void OPC_GenHeaderMsg (void)
case 5:
OPM_Write('p');
break;
- case 6:
- OPM_Write('k');
- break;
case 7:
OPM_Write('a');
break;
@@ -1265,14 +1187,14 @@ static void OPC_GenHeaderMsg (void)
OPM_Write('v');
break;
default:
- OPM_LogWStr((CHAR*)"( more options defined in OPM than checked in OPC.GenHeaderMsg, if you are a compiler developer, add them to OPC.GenHeaderMsg", (LONGINT)126);
+ OPM_LogWStr((CHAR*)"( more options defined in OPM than checked in OPC.GenHeaderMsg, if you are a compiler developer, add them to OPC.GenHeaderMsg", 126);
OPM_LogWLn();
break;
}
}
i += 1;
}
- OPM_WriteString((CHAR*)" */", (LONGINT)4);
+ OPM_WriteString((CHAR*)" */", 4);
OPM_WriteLn();
}
@@ -1281,20 +1203,16 @@ void OPC_GenHdrIncludes (void)
OPM_currFile = 2;
OPC_GenHeaderMsg();
OPM_WriteLn();
- OPM_WriteString((CHAR*)"#ifndef ", (LONGINT)9);
- OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32)));
- OPM_WriteString((CHAR*)"__h", (LONGINT)4);
+ OPM_WriteString((CHAR*)"#ifndef ", 9);
+ OPM_WriteStringVar((void*)OPM_modName, 32);
+ OPM_WriteString((CHAR*)"__h", 4);
OPM_WriteLn();
- OPM_WriteString((CHAR*)"#define ", (LONGINT)9);
- OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32)));
- OPM_WriteString((CHAR*)"__h", (LONGINT)4);
+ OPM_WriteString((CHAR*)"#define ", 9);
+ OPM_WriteStringVar((void*)OPM_modName, 32);
+ OPM_WriteString((CHAR*)"__h", 4);
OPM_WriteLn();
OPM_WriteLn();
- if (OPM_LIntSize == 8) {
- OPM_WriteString((CHAR*)"#define LARGE", (LONGINT)14);
- OPM_WriteLn();
- }
- OPC_Include((CHAR*)"SYSTEM", (LONGINT)7);
+ OPC_Include((CHAR*)"SYSTEM", 7);
OPC_IncludeImports(OPT_topScope->right, 1);
OPM_WriteLn();
}
@@ -1303,11 +1221,21 @@ void OPC_GenBdy (OPT_Node n)
{
OPM_currFile = 1;
OPC_GenHeaderMsg();
- if (OPM_LIntSize == 8) {
- OPM_WriteString((CHAR*)"#define LARGE", (LONGINT)14);
- OPM_WriteLn();
- }
- OPC_Include((CHAR*)"SYSTEM", (LONGINT)7);
+ OPM_WriteLn();
+ OPM_WriteString((CHAR*)"#define SHORTINT INT", 21);
+ OPM_WriteInt(__ASHL(OPT_sinttyp->size, 3));
+ OPM_WriteLn();
+ OPM_WriteString((CHAR*)"#define INTEGER INT", 21);
+ OPM_WriteInt(__ASHL(OPT_inttyp->size, 3));
+ OPM_WriteLn();
+ OPM_WriteString((CHAR*)"#define LONGINT INT", 21);
+ OPM_WriteInt(__ASHL(OPT_linttyp->size, 3));
+ OPM_WriteLn();
+ OPM_WriteString((CHAR*)"#define SET UINT", 22);
+ OPM_WriteInt(__ASHL(OPT_settyp->size, 3));
+ OPM_WriteLn();
+ OPM_WriteLn();
+ OPC_Include((CHAR*)"SYSTEM", 7);
OPC_IncludeImports(OPT_topScope->right, 0);
OPM_WriteLn();
OPC_DefAnonRecs(n);
@@ -1330,9 +1258,9 @@ static void OPC_RegCmds (OPT_Object obj)
if ((obj->mode == 7 && obj->history != 4)) {
if ((((obj->vis != 0 && obj->link == NIL)) && obj->typ == OPT_notyp)) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"__REGCMD(\"", (LONGINT)11);
- OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"\", ", (LONGINT)4);
+ OPM_WriteString((CHAR*)"__REGCMD(\"", 11);
+ OPM_WriteStringVar((void*)obj->name, 256);
+ OPM_WriteString((CHAR*)"\", ", 4);
OPC_Ident(obj);
OPM_Write(')');
OPC_EndStat();
@@ -1348,8 +1276,8 @@ static void OPC_InitImports (OPT_Object obj)
OPC_InitImports(obj->left);
if ((obj->mode == 11 && obj->mnolev != 0)) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"__MODULE_IMPORT(", (LONGINT)17);
- OPM_WriteStringVar((void*)OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, ((LONGINT)(256)));
+ OPM_WriteString((CHAR*)"__MODULE_IMPORT(", 17);
+ OPM_WriteStringVar((void*)OPT_GlbMod[__X(-obj->mnolev, 64)]->name, 256);
OPM_Write(')');
OPC_EndStat();
}
@@ -1360,38 +1288,30 @@ static void OPC_InitImports (OPT_Object obj)
void OPC_GenEnumPtrs (OPT_Object var)
{
OPT_Struct typ = NIL;
- LONGINT n;
+ INT32 n;
OPC_GlbPtrs = 0;
while (var != NIL) {
typ = var->typ;
if (OPC_NofPtrs(typ) > 0) {
if (!OPC_GlbPtrs) {
OPC_GlbPtrs = 1;
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
- if (OPC_ansi) {
- OPM_WriteString((CHAR*)"void EnumPtrs(void (*P)(void*))", (LONGINT)32);
- } else {
- OPM_WriteString((CHAR*)"void EnumPtrs(P)", (LONGINT)17);
- OPM_WriteLn();
- OPM_Write(0x09);
- OPM_WriteString((CHAR*)"void (*P)();", (LONGINT)13);
- }
+ OPM_WriteString((CHAR*)"static void EnumPtrs(void (*P)(void*))", 39);
OPM_WriteLn();
OPC_BegBlk();
}
OPC_BegStat();
- if (typ->form == 13) {
- OPM_WriteString((CHAR*)"P(", (LONGINT)3);
+ if (typ->form == 11) {
+ OPM_WriteString((CHAR*)"P(", 3);
OPC_Ident(var);
OPM_Write(')');
} else if (typ->comp == 4) {
- OPM_WriteString((CHAR*)"__ENUMR(&", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__ENUMR(&", 10);
OPC_Ident(var);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
- OPC_Str1((CHAR*)", #", (LONGINT)4, typ->size);
- OPM_WriteString((CHAR*)", 1, P)", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__typ", 6);
+ OPC_Str1((CHAR*)", #", 4, typ->size);
+ OPM_WriteString((CHAR*)", 1, P)", 8);
} else if (typ->comp == 2) {
n = typ->n;
typ = typ->BaseTyp;
@@ -1399,18 +1319,18 @@ void OPC_GenEnumPtrs (OPT_Object var)
n = n * typ->n;
typ = typ->BaseTyp;
}
- if (typ->form == 13) {
- OPM_WriteString((CHAR*)"__ENUMP(", (LONGINT)9);
+ if (typ->form == 11) {
+ OPM_WriteString((CHAR*)"__ENUMP(", 9);
OPC_Ident(var);
- OPC_Str1((CHAR*)", #, P)", (LONGINT)8, n);
+ OPC_Str1((CHAR*)", #, P)", 8, n);
} else if (typ->comp == 4) {
- OPM_WriteString((CHAR*)"__ENUMR(", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__ENUMR(", 9);
OPC_Ident(var);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
- OPC_Str1((CHAR*)", #", (LONGINT)4, typ->size);
- OPC_Str1((CHAR*)", #, P)", (LONGINT)8, n);
+ OPM_WriteString((CHAR*)"__typ", 6);
+ OPC_Str1((CHAR*)", #", 4, typ->size);
+ OPC_Str1((CHAR*)", #, P)", 8, n);
}
}
OPC_EndStat();
@@ -1426,49 +1346,41 @@ void OPC_GenEnumPtrs (OPT_Object var)
void OPC_EnterBody (void)
{
OPM_WriteLn();
- OPM_WriteString((CHAR*)"export ", (LONGINT)8);
- if (OPC_mainprog) {
- if (OPC_ansi) {
- OPM_WriteString((CHAR*)"int main(int argc, char **argv)", (LONGINT)32);
- OPM_WriteLn();
- } else {
- OPM_WriteString((CHAR*)"main(argc, argv)", (LONGINT)17);
- OPM_WriteLn();
- OPM_Write(0x09);
- OPM_WriteString((CHAR*)"int argc; char **argv;", (LONGINT)23);
- OPM_WriteLn();
- }
+ OPM_WriteString((CHAR*)"export ", 8);
+ if (__IN(10, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"int main(int argc, char **argv)", 32);
+ OPM_WriteLn();
} else {
- OPM_WriteString((CHAR*)"void *", (LONGINT)7);
- OPM_WriteString(OPM_modName, ((LONGINT)(32)));
- OPM_WriteString(OPC_BodyNameExt, ((LONGINT)(13)));
+ OPM_WriteString((CHAR*)"void *", 7);
+ OPM_WriteString(OPM_modName, 32);
+ OPM_WriteString(OPC_BodyNameExt, 13);
OPM_WriteLn();
}
OPC_BegBlk();
OPC_BegStat();
- if (OPC_mainprog) {
- OPM_WriteString((CHAR*)"__INIT(argc, argv)", (LONGINT)19);
+ if (__IN(10, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__INIT(argc, argv)", 19);
} else {
- OPM_WriteString((CHAR*)"__DEFMOD", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__DEFMOD", 9);
}
OPC_EndStat();
- if ((OPC_mainprog && 0)) {
+ if ((__IN(10, OPM_Options, 32) && 0)) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"/*don`t do it!*/ printf(\"DEMO VERSION: DO NOT USE THIS PROGRAM FOR ANY COMMERCIAL PURPOSE\\n\")", (LONGINT)94);
+ OPM_WriteString((CHAR*)"/*don`t do it!*/ printf(\"DEMO VERSION: DO NOT USE THIS PROGRAM FOR ANY COMMERCIAL PURPOSE\\n\")", 94);
OPC_EndStat();
}
OPC_InitImports(OPT_topScope->right);
OPC_BegStat();
- if (OPC_mainprog) {
- OPM_WriteString((CHAR*)"__REGMAIN(\"", (LONGINT)12);
+ if (__IN(10, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__REGMAIN(\"", 12);
} else {
- OPM_WriteString((CHAR*)"__REGMOD(\"", (LONGINT)11);
+ OPM_WriteString((CHAR*)"__REGMOD(\"", 11);
}
- OPM_WriteString(OPM_modName, ((LONGINT)(32)));
+ OPM_WriteString(OPM_modName, 32);
if (OPC_GlbPtrs) {
- OPM_WriteString((CHAR*)"\", EnumPtrs)", (LONGINT)13);
+ OPM_WriteString((CHAR*)"\", EnumPtrs)", 13);
} else {
- OPM_WriteString((CHAR*)"\", 0)", (LONGINT)6);
+ OPM_WriteString((CHAR*)"\", 0)", 6);
}
OPC_EndStat();
if (__STRCMP(OPM_modName, "SYSTEM") != 0) {
@@ -1479,10 +1391,10 @@ void OPC_EnterBody (void)
void OPC_ExitBody (void)
{
OPC_BegStat();
- if (OPC_mainprog) {
- OPM_WriteString((CHAR*)"__FINI;", (LONGINT)8);
+ if (__IN(10, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__FINI;", 8);
} else {
- OPM_WriteString((CHAR*)"__ENDMOD;", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__ENDMOD;", 10);
}
OPM_WriteLn();
OPC_EndBlk();
@@ -1492,55 +1404,60 @@ void OPC_DefineInter (OPT_Object proc)
{
OPT_Object scope = NIL;
scope = proc->scope;
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
- OPM_WriteString((CHAR*)"struct ", (LONGINT)8);
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
+ OPM_WriteString((CHAR*)"static ", 8);
+ OPM_WriteString((CHAR*)"struct ", 8);
+ OPM_WriteStringVar((void*)scope->name, 256);
OPM_Write(' ');
OPC_BegBlk();
OPC_IdentList(proc->link, 3);
OPC_IdentList(scope->scope, 3);
OPC_BegStat();
- OPM_WriteString((CHAR*)"struct ", (LONGINT)8);
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
+ OPM_WriteString((CHAR*)"struct ", 8);
+ OPM_WriteStringVar((void*)scope->name, 256);
OPM_Write(' ');
OPM_Write('*');
- OPM_WriteString((CHAR*)"lnk", (LONGINT)4);
+ OPM_WriteString((CHAR*)"lnk", 4);
OPC_EndStat();
OPC_EndBlk0();
OPM_Write(' ');
OPM_Write('*');
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteStringVar((void*)scope->name, 256);
+ OPM_WriteString((CHAR*)"_s", 3);
OPC_EndStat();
OPM_WriteLn();
OPC_ProcPredefs(scope->right, 0);
OPM_WriteLn();
}
+BOOLEAN OPC_NeedsRetval (OPT_Object proc)
+{
+ return (proc->typ != OPT_notyp && !proc->scope->leaf);
+}
+
void OPC_EnterProc (OPT_Object proc)
{
OPT_Object var = NIL, scope = NIL;
OPT_Struct typ = NIL;
- INTEGER dim;
+ INT16 dim;
if (proc->vis != 1) {
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"static ", 8);
}
OPC_ProcHeader(proc, 1);
OPC_BegBlk();
- if (proc->typ != OPT_notyp) {
- OPC_BegStat();
- OPC_Ident(proc->typ->strobj);
- OPM_WriteString((CHAR*)" _o_result;", (LONGINT)12);
- OPM_WriteLn();
- }
scope = proc->scope;
OPC_IdentList(scope->scope, 0);
if (!scope->leaf) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"struct ", (LONGINT)8);
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
+ OPM_WriteString((CHAR*)"struct ", 8);
+ OPM_WriteStringVar((void*)scope->name, 256);
OPM_Write(' ');
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"_s", 3);
+ OPC_EndStat();
+ }
+ if (OPC_NeedsRetval(proc)) {
+ OPC_BegStat();
+ OPC_Ident(proc->typ->strobj);
+ OPM_WriteString((CHAR*)" __retval", 10);
OPC_EndStat();
}
var = proc->link;
@@ -1554,56 +1471,41 @@ void OPC_EnterProc (OPT_Object proc)
}
OPM_Write(' ');
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__copy", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__copy", 7);
OPC_EndStat();
}
var = var->link;
}
- if (!OPC_ansi) {
- var = proc->link;
- while (var != NIL) {
- if ((var->typ->form == 7 && var->mode == 1)) {
- OPC_BegStat();
- OPC_Ident(var->typ->strobj);
- OPM_Write(' ');
- OPC_Ident(var);
- OPM_WriteString((CHAR*)" = _", (LONGINT)5);
- OPC_Ident(var);
- OPC_EndStat();
- }
- var = var->link;
- }
- }
var = proc->link;
while (var != NIL) {
- if ((((__IN(var->typ->comp, 0x0c) && var->mode == 1)) && var->typ->sysflag == 0)) {
+ if ((((__IN(var->typ->comp, 0x0c, 32) && var->mode == 1)) && var->typ->sysflag == 0)) {
OPC_BegStat();
if (var->typ->comp == 2) {
- OPM_WriteString((CHAR*)"__DUPARR(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__DUPARR(", 10);
OPC_Ident(var);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
if (var->typ->strobj == NIL) {
OPM_Mark(200, var->typ->txtpos);
} else {
OPC_Ident(var->typ->strobj);
}
} else {
- OPM_WriteString((CHAR*)"__DUP(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__DUP(", 7);
OPC_Ident(var);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
typ = var->typ->BaseTyp;
dim = 1;
while (typ->comp == 3) {
- OPM_WriteString((CHAR*)" * ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" * ", 4);
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
OPM_WriteInt(dim);
typ = typ->BaseTyp;
dim += 1;
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
if (typ->strobj == NIL) {
OPM_Mark(200, typ->txtpos);
} else {
@@ -1620,12 +1522,12 @@ void OPC_EnterProc (OPT_Object proc)
while (var != NIL) {
if (!var->leaf) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
OPC_Ident(var);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
- if (__IN(var->typ->comp, 0x0c)) {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
+ OPM_WriteString((CHAR*)" = ", 4);
+ if (__IN(var->typ->comp, 0x0c, 32)) {
+ OPM_WriteString((CHAR*)"(void*)", 8);
} else if (var->mode != 2) {
OPM_Write('&');
}
@@ -1634,31 +1536,31 @@ void OPC_EnterProc (OPT_Object proc)
typ = var->typ;
dim = 0;
do {
- OPM_WriteString((CHAR*)"; ", (LONGINT)3);
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"; ", 3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
if (dim != 0) {
OPM_WriteInt(dim);
}
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" = ", 4);
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
if (dim != 0) {
OPM_WriteInt(dim);
}
typ = typ->BaseTyp;
} while (!(typ->comp != 3));
} else if ((var->mode == 2 && var->typ->comp == 4)) {
- OPM_WriteString((CHAR*)"; ", (LONGINT)3);
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"; ", 3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteString((CHAR*)"__typ", 6);
+ OPM_WriteString((CHAR*)" = ", 4);
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
}
OPC_EndStat();
}
@@ -1668,14 +1570,14 @@ void OPC_EnterProc (OPT_Object proc)
while (var != NIL) {
if (!var->leaf) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
OPC_Ident(var);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" = ", 4);
if (var->typ->comp != 2) {
OPM_Write('&');
} else {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
+ OPM_WriteString((CHAR*)"(void*)", 8);
}
OPC_Ident(var);
OPC_EndStat();
@@ -1683,19 +1585,19 @@ void OPC_EnterProc (OPT_Object proc)
var = var->link;
}
OPC_BegStat();
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
- OPM_WriteString((CHAR*)"lnk", (LONGINT)4);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"lnk", 4);
+ OPM_WriteString((CHAR*)" = ", 4);
+ OPM_WriteStringVar((void*)scope->name, 256);
+ OPM_WriteString((CHAR*)"_s", 3);
OPC_EndStat();
OPC_BegStat();
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteStringVar((void*)scope->name, 256);
+ OPM_WriteString((CHAR*)"_s", 3);
+ OPM_WriteString((CHAR*)" = ", 4);
OPM_Write('&');
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPC_EndStat();
}
}
@@ -1707,7 +1609,7 @@ void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet)
indent = eoBlock;
if ((implicitRet && proc->typ != OPT_notyp)) {
OPM_Write(0x09);
- OPM_WriteString((CHAR*)"__RETCHK;", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__RETCHK;", 10);
OPM_WriteLn();
} else if (!eoBlock || implicitRet) {
if (!proc->scope->leaf) {
@@ -1716,12 +1618,12 @@ void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet)
} else {
indent = 1;
}
- OPM_WriteStringVar((void*)proc->scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteStringVar((void*)proc->scope->name, 256);
+ OPM_WriteString((CHAR*)"_s", 3);
+ OPM_WriteString((CHAR*)" = ", 4);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
- OPM_WriteString((CHAR*)"lnk", (LONGINT)4);
+ OPM_WriteString((CHAR*)"lnk", 4);
OPC_EndStat();
}
var = proc->link;
@@ -1732,7 +1634,7 @@ void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet)
} else {
indent = 1;
}
- OPM_WriteString((CHAR*)"__DEL(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__DEL(", 7);
OPC_Ident(var);
OPM_Write(')');
OPC_EndStat();
@@ -1750,14 +1652,14 @@ void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet)
void OPC_CompleteIdent (OPT_Object obj)
{
- INTEGER comp, level;
+ INT16 comp, level;
level = obj->mnolev;
if (obj->adr == 1) {
if (obj->typ->comp == 4) {
OPC_Ident(obj);
- OPM_WriteString((CHAR*)"__", (LONGINT)3);
+ OPM_WriteString((CHAR*)"__", 3);
} else {
- OPM_WriteString((CHAR*)"((", (LONGINT)3);
+ OPM_WriteString((CHAR*)"((", 3);
OPC_Ident(obj->typ->strobj);
OPM_Write(')');
OPC_Ident(obj);
@@ -1768,9 +1670,9 @@ void OPC_CompleteIdent (OPT_Object obj)
if ((obj->mode != 2 && comp != 3)) {
OPM_Write('*');
}
- OPM_WriteStringVar((void*)obj->scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
- OPM_WriteString((CHAR*)"->", (LONGINT)3);
+ OPM_WriteStringVar((void*)obj->scope->name, 256);
+ OPM_WriteString((CHAR*)"_s", 3);
+ OPM_WriteString((CHAR*)"->", 3);
OPC_Ident(obj);
} else {
OPC_Ident(obj);
@@ -1779,58 +1681,58 @@ void OPC_CompleteIdent (OPT_Object obj)
void OPC_TypeOf (OPT_Object ap)
{
- INTEGER i;
+ INT16 i;
__ASSERT(ap->typ->comp == 4, 0);
if (ap->mode == 2) {
- if ((int)ap->mnolev != OPM_level) {
- OPM_WriteStringVar((void*)ap->scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s->", (LONGINT)5);
+ if ((INT16)ap->mnolev != OPM_level) {
+ OPM_WriteStringVar((void*)ap->scope->name, 256);
+ OPM_WriteString((CHAR*)"_s->", 5);
OPC_Ident(ap);
} else {
OPC_Ident(ap);
}
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
} else if (ap->typ->strobj != NIL) {
OPC_Ident(ap->typ->strobj);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
} else {
OPC_Andent(ap->typ);
}
}
-void OPC_Cmp (INTEGER rel)
+void OPC_Cmp (INT16 rel)
{
switch (rel) {
case 9:
- OPM_WriteString((CHAR*)" == ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" == ", 5);
break;
case 10:
- OPM_WriteString((CHAR*)" != ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" != ", 5);
break;
case 11:
- OPM_WriteString((CHAR*)" < ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" < ", 4);
break;
case 12:
- OPM_WriteString((CHAR*)" <= ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" <= ", 5);
break;
case 13:
- OPM_WriteString((CHAR*)" > ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" > ", 4);
break;
case 14:
- OPM_WriteString((CHAR*)" >= ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" >= ", 5);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPC.Cmp, rel = ", (LONGINT)34);
- OPM_LogWNum(rel, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPC.Cmp, rel = ", 34);
+ OPM_LogWNum(rel, 0);
OPM_LogWLn();
break;
}
}
-static void OPC_CharacterLiteral (LONGINT c)
+static void OPC_CharacterLiteral (INT64 c)
{
if (c < 32 || c > 126) {
- OPM_WriteString((CHAR*)"0x", (LONGINT)3);
+ OPM_WriteString((CHAR*)"0x", 3);
OPM_WriteHex(c);
} else {
OPM_Write('\'');
@@ -1842,15 +1744,15 @@ static void OPC_CharacterLiteral (LONGINT c)
}
}
-static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l)
+static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l)
{
- LONGINT i;
- INTEGER c;
+ INT32 i;
+ INT16 c;
__DUP(s, s__len, CHAR);
OPM_Write('"');
i = 0;
while (i < l) {
- c = (int)s[__X(i, s__len)];
+ c = (INT16)s[__X(i, s__len)];
if (c < 32 || c > 126) {
OPM_Write('\\');
OPM_Write((CHAR)(48 + __ASHR(c, 6)));
@@ -1870,54 +1772,67 @@ static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l)
__DEL(s);
}
-void OPC_Case (LONGINT caseVal, INTEGER form)
+void OPC_Case (INT64 caseVal, INT16 form)
{
CHAR ch;
- OPM_WriteString((CHAR*)"case ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"case ", 6);
switch (form) {
case 3:
OPC_CharacterLiteral(caseVal);
break;
- case 4: case 5: case 6:
+ case 4:
OPM_WriteInt(caseVal);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPC.Case, form = ", (LONGINT)36);
- OPM_LogWNum(form, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPC.Case, form = ", 36);
+ OPM_LogWNum(form, 0);
OPM_LogWLn();
break;
}
- OPM_WriteString((CHAR*)": ", (LONGINT)3);
+ OPM_WriteString((CHAR*)": ", 3);
}
void OPC_SetInclude (BOOLEAN exclude)
{
if (exclude) {
- OPM_WriteString((CHAR*)" &= ~", (LONGINT)6);
+ OPM_WriteString((CHAR*)" &= ~", 6);
} else {
- OPM_WriteString((CHAR*)" |= ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" |= ", 5);
}
}
void OPC_Increment (BOOLEAN decrement)
{
if (decrement) {
- OPM_WriteString((CHAR*)" -= ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" -= ", 5);
} else {
- OPM_WriteString((CHAR*)" += ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" += ", 5);
}
}
-void OPC_Halt (LONGINT n)
+void OPC_Halt (INT32 n)
{
- OPC_Str1((CHAR*)"__HALT(#)", (LONGINT)10, n);
+ OPC_Str1((CHAR*)"__HALT(#)", 10, n);
}
-void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim)
+void OPC_IntLiteral (INT64 n, INT32 size)
+{
+ if ((((size > 4 && n <= 2147483647)) && n > (-2147483647-1))) {
+ OPM_WriteString((CHAR*)"((INT", 6);
+ OPM_WriteInt(__ASHL(size, 3));
+ OPM_WriteString((CHAR*)")(", 3);
+ OPM_WriteInt(n);
+ OPM_WriteString((CHAR*)"))", 3);
+ } else {
+ OPM_WriteInt(n);
+ }
+}
+
+void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim)
{
if (array->comp == 3) {
OPC_CompleteIdent(obj);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
if (dim != 0) {
OPM_WriteInt(dim);
}
@@ -1926,17 +1841,15 @@ void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim)
array = array->BaseTyp;
dim -= 1;
}
- OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12);
OPM_WriteInt(array->n);
- OPM_WriteString((CHAR*)"))", (LONGINT)3);
}
}
-void OPC_Constant (OPT_Const con, INTEGER form)
+void OPC_Constant (OPT_Const con, INT16 form)
{
- INTEGER i;
- SET s;
- LONGINT hex;
+ INT16 i;
+ UINT64 s;
+ INT64 hex;
BOOLEAN skipLeading;
switch (form) {
case 1:
@@ -1948,17 +1861,17 @@ void OPC_Constant (OPT_Const con, INTEGER form)
case 3:
OPC_CharacterLiteral(con->intval);
break;
- case 4: case 5: case 6:
+ case 4:
OPM_WriteInt(con->intval);
break;
- case 7:
+ case 5:
OPM_WriteReal(con->realval, 'f');
break;
- case 8:
+ case 6:
OPM_WriteReal(con->realval, 0x00);
break;
- case 9:
- OPM_WriteString((CHAR*)"0x", (LONGINT)3);
+ case 7:
+ OPM_WriteString((CHAR*)"0x", 3);
skipLeading = 1;
s = con->setval;
i = 64;
@@ -1967,7 +1880,7 @@ void OPC_Constant (OPT_Const con, INTEGER form)
do {
i -= 1;
hex = __ASHL(hex, 1);
- if (__IN(i, s)) {
+ if (__IN(i, s, 64)) {
hex += 1;
}
} while (!(__MASK(i, -8) == 0));
@@ -1980,88 +1893,98 @@ void OPC_Constant (OPT_Const con, INTEGER form)
OPM_Write('0');
}
break;
- case 10:
- OPC_StringLiteral(*con->ext, ((LONGINT)(256)), con->intval2 - 1);
+ case 8:
+ OPC_StringLiteral(*con->ext, 256, con->intval2 - 1);
break;
- case 11:
- OPM_WriteString((CHAR*)"NIL", (LONGINT)4);
+ case 9:
+ OPM_WriteString((CHAR*)"NIL", 4);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPC.Constant, form = ", (LONGINT)40);
- OPM_LogWNum(form, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPC.Constant, form = ", 40);
+ OPM_LogWNum(form, 0);
OPM_LogWLn();
break;
}
}
-static struct InitKeywords__48 {
- SHORTINT *n;
- struct InitKeywords__48 *lnk;
-} *InitKeywords__48_s;
+static struct InitKeywords__46 {
+ INT8 *n;
+ struct InitKeywords__46 *lnk;
+} *InitKeywords__46_s;
-static void Enter__49 (CHAR *s, LONGINT s__len);
+static void Enter__47 (CHAR *s, LONGINT s__len);
-static void Enter__49 (CHAR *s, LONGINT s__len)
+static void Enter__47 (CHAR *s, LONGINT s__len)
{
- INTEGER h;
+ INT16 h;
__DUP(s, s__len, CHAR);
h = OPC_PerfectHash((void*)s, s__len);
- OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__48_s->n;
- __COPY(s, OPC_keytab[__X(*InitKeywords__48_s->n, ((LONGINT)(36)))], ((LONGINT)(9)));
- *InitKeywords__48_s->n += 1;
+ OPC_hashtab[__X(h, 105)] = *InitKeywords__46_s->n;
+ __COPY(s, OPC_keytab[__X(*InitKeywords__46_s->n, 50)], 9);
+ *InitKeywords__46_s->n += 1;
__DEL(s);
}
static void OPC_InitKeywords (void)
{
- SHORTINT n, i;
- struct InitKeywords__48 _s;
+ INT8 n, i;
+ struct InitKeywords__46 _s;
_s.n = &n;
- _s.lnk = InitKeywords__48_s;
- InitKeywords__48_s = &_s;
+ _s.lnk = InitKeywords__46_s;
+ InitKeywords__46_s = &_s;
n = 0;
i = 0;
while (i <= 104) {
- OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1;
+ OPC_hashtab[__X(i, 105)] = -1;
i += 1;
}
- Enter__49((CHAR*)"asm", (LONGINT)4);
- Enter__49((CHAR*)"auto", (LONGINT)5);
- Enter__49((CHAR*)"break", (LONGINT)6);
- Enter__49((CHAR*)"case", (LONGINT)5);
- Enter__49((CHAR*)"char", (LONGINT)5);
- Enter__49((CHAR*)"const", (LONGINT)6);
- Enter__49((CHAR*)"continue", (LONGINT)9);
- Enter__49((CHAR*)"default", (LONGINT)8);
- Enter__49((CHAR*)"do", (LONGINT)3);
- Enter__49((CHAR*)"double", (LONGINT)7);
- Enter__49((CHAR*)"else", (LONGINT)5);
- Enter__49((CHAR*)"enum", (LONGINT)5);
- Enter__49((CHAR*)"extern", (LONGINT)7);
- Enter__49((CHAR*)"export", (LONGINT)7);
- Enter__49((CHAR*)"float", (LONGINT)6);
- Enter__49((CHAR*)"for", (LONGINT)4);
- Enter__49((CHAR*)"fortran", (LONGINT)8);
- Enter__49((CHAR*)"goto", (LONGINT)5);
- Enter__49((CHAR*)"if", (LONGINT)3);
- Enter__49((CHAR*)"import", (LONGINT)7);
- Enter__49((CHAR*)"int", (LONGINT)4);
- Enter__49((CHAR*)"long", (LONGINT)5);
- Enter__49((CHAR*)"register", (LONGINT)9);
- Enter__49((CHAR*)"return", (LONGINT)7);
- Enter__49((CHAR*)"short", (LONGINT)6);
- Enter__49((CHAR*)"signed", (LONGINT)7);
- Enter__49((CHAR*)"sizeof", (LONGINT)7);
- Enter__49((CHAR*)"static", (LONGINT)7);
- Enter__49((CHAR*)"struct", (LONGINT)7);
- Enter__49((CHAR*)"switch", (LONGINT)7);
- Enter__49((CHAR*)"typedef", (LONGINT)8);
- Enter__49((CHAR*)"union", (LONGINT)6);
- Enter__49((CHAR*)"unsigned", (LONGINT)9);
- Enter__49((CHAR*)"void", (LONGINT)5);
- Enter__49((CHAR*)"volatile", (LONGINT)9);
- Enter__49((CHAR*)"while", (LONGINT)6);
- InitKeywords__48_s = _s.lnk;
+ Enter__47((CHAR*)"ADDRESS", 8);
+ Enter__47((CHAR*)"INT16", 6);
+ Enter__47((CHAR*)"INT32", 6);
+ Enter__47((CHAR*)"INT64", 6);
+ Enter__47((CHAR*)"INT8", 5);
+ Enter__47((CHAR*)"UINT16", 7);
+ Enter__47((CHAR*)"UINT32", 7);
+ Enter__47((CHAR*)"UINT64", 7);
+ Enter__47((CHAR*)"UINT8", 6);
+ Enter__47((CHAR*)"asm", 4);
+ Enter__47((CHAR*)"auto", 5);
+ Enter__47((CHAR*)"break", 6);
+ Enter__47((CHAR*)"case", 5);
+ Enter__47((CHAR*)"char", 5);
+ Enter__47((CHAR*)"const", 6);
+ Enter__47((CHAR*)"continue", 9);
+ Enter__47((CHAR*)"default", 8);
+ Enter__47((CHAR*)"do", 3);
+ Enter__47((CHAR*)"double", 7);
+ Enter__47((CHAR*)"else", 5);
+ Enter__47((CHAR*)"enum", 5);
+ Enter__47((CHAR*)"extern", 7);
+ Enter__47((CHAR*)"export", 7);
+ Enter__47((CHAR*)"float", 6);
+ Enter__47((CHAR*)"for", 4);
+ Enter__47((CHAR*)"fortran", 8);
+ Enter__47((CHAR*)"goto", 5);
+ Enter__47((CHAR*)"if", 3);
+ Enter__47((CHAR*)"import", 7);
+ Enter__47((CHAR*)"int", 4);
+ Enter__47((CHAR*)"long", 5);
+ Enter__47((CHAR*)"register", 9);
+ Enter__47((CHAR*)"return", 7);
+ Enter__47((CHAR*)"short", 6);
+ Enter__47((CHAR*)"signed", 7);
+ Enter__47((CHAR*)"sizeof", 7);
+ Enter__47((CHAR*)"size_t", 7);
+ Enter__47((CHAR*)"static", 7);
+ Enter__47((CHAR*)"struct", 7);
+ Enter__47((CHAR*)"switch", 7);
+ Enter__47((CHAR*)"typedef", 8);
+ Enter__47((CHAR*)"union", 6);
+ Enter__47((CHAR*)"unsigned", 9);
+ Enter__47((CHAR*)"void", 5);
+ Enter__47((CHAR*)"volatile", 9);
+ Enter__47((CHAR*)"while", 6);
+ InitKeywords__46_s = _s.lnk;
}
diff --git a/bootstrap/unix-88/OPC.h b/bootstrap/unix-88/OPC.h
index 37a86252..842e7dec 100644
--- a/bootstrap/unix-88/OPC.h
+++ b/bootstrap/unix-88/OPC.h
@@ -1,25 +1,22 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPC__h
#define OPC__h
-#define LARGE
#include "SYSTEM.h"
#include "OPT.h"
-import void OPC_Align (LONGINT *adr, LONGINT base);
import void OPC_Andent (OPT_Struct typ);
-import LONGINT OPC_BaseAlignment (OPT_Struct typ);
import OPT_Object OPC_BaseTProc (OPT_Object obj);
import void OPC_BegBlk (void);
import void OPC_BegStat (void);
-import void OPC_Case (LONGINT caseVal, INTEGER form);
-import void OPC_Cmp (INTEGER rel);
+import void OPC_Case (INT64 caseVal, INT16 form);
+import void OPC_Cmp (INT16 rel);
import void OPC_CompleteIdent (OPT_Object obj);
-import void OPC_Constant (OPT_Const con, INTEGER form);
+import void OPC_Constant (OPT_Const con, INT16 form);
import void OPC_DefineInter (OPT_Object proc);
import void OPC_EndBlk (void);
import void OPC_EndBlk0 (void);
@@ -32,20 +29,21 @@ import void OPC_GenBdy (OPT_Node n);
import void OPC_GenEnumPtrs (OPT_Object var);
import void OPC_GenHdr (OPT_Node n);
import void OPC_GenHdrIncludes (void);
-import void OPC_Halt (LONGINT n);
+import void OPC_Halt (INT32 n);
import void OPC_Ident (OPT_Object obj);
import void OPC_Increment (BOOLEAN decrement);
-import void OPC_Indent (INTEGER count);
+import void OPC_Indent (INT16 count);
import void OPC_Init (void);
import void OPC_InitTDesc (OPT_Struct typ);
-import void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim);
-import LONGINT OPC_NofPtrs (OPT_Struct typ);
+import void OPC_IntLiteral (INT64 n, INT32 size);
+import void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim);
+import BOOLEAN OPC_NeedsRetval (OPT_Object proc);
+import INT32 OPC_NofPtrs (OPT_Struct typ);
import void OPC_SetInclude (BOOLEAN exclude);
-import LONGINT OPC_SizeAlignment (LONGINT size);
import void OPC_TDescDecl (OPT_Struct typ);
-import void OPC_TypeDefs (OPT_Object obj, INTEGER vis);
+import void OPC_TypeDefs (OPT_Object obj, INT16 vis);
import void OPC_TypeOf (OPT_Object ap);
import void *OPC__init(void);
-#endif
+#endif // OPC
diff --git a/bootstrap/unix-88/OPM.c b/bootstrap/unix-88/OPM.c
index 50047c9e..60ab38c7 100644
--- a/bootstrap/unix-88/OPM.c
+++ b/bootstrap/unix-88/OPM.c
@@ -1,306 +1,474 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "Configuration.h"
-#include "Console.h"
#include "Files.h"
+#include "Out.h"
#include "Platform.h"
#include "Strings.h"
#include "Texts.h"
-#include "errors.h"
-#include "vt100.h"
+#include "VT100.h"
typedef
CHAR OPM_FileName[32];
static CHAR OPM_SourceFileName[256];
-export INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_MaxSet;
-export LONGINT OPM_MaxIndex;
+static CHAR OPM_GlobalModel[10];
+export CHAR OPM_Model[10];
+static INT16 OPM_GlobalAddressSize;
+export INT16 OPM_AddressSize;
+static INT16 OPM_GlobalAlignment;
+export INT16 OPM_Alignment;
+export UINT32 OPM_GlobalOptions, OPM_Options;
+export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize;
+export INT64 OPM_MaxIndex;
export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
export BOOLEAN OPM_noerr;
-export LONGINT OPM_curpos, OPM_errpos, OPM_breakpc;
-export INTEGER OPM_currFile, OPM_level, OPM_pc, OPM_entno;
+export INT32 OPM_curpos, OPM_errpos, OPM_breakpc;
+export INT16 OPM_currFile, OPM_level, OPM_pc, OPM_entno;
export CHAR OPM_modName[32];
export CHAR OPM_objname[64];
-export SET OPM_opt, OPM_glbopt;
-static LONGINT OPM_ErrorLineStartPos, OPM_ErrorLineLimitPos, OPM_ErrorLineNumber, OPM_lasterrpos;
+static INT32 OPM_ErrorLineStartPos, OPM_ErrorLineLimitPos, OPM_ErrorLineNumber, OPM_lasterrpos;
static Texts_Reader OPM_inR;
-static Texts_Text OPM_Log;
-static Texts_Writer OPM_W;
+static Texts_Text OPM_Log, OPM_Errors;
static Files_Rider OPM_oldSF, OPM_newSF;
static Files_Rider OPM_R[3];
static Files_File OPM_oldSFile, OPM_newSFile, OPM_HFile, OPM_BFile, OPM_HIFile;
-static INTEGER OPM_S;
-export BOOLEAN OPM_dontAsm, OPM_dontLink, OPM_mainProg, OPM_mainLinkStat, OPM_notColorOutput, OPM_forceNewSym, OPM_Verbose;
-static CHAR OPM_OBERON[1024];
-static CHAR OPM_MODULES[1024];
+static INT16 OPM_S;
+export CHAR OPM_ResourceDir[1024];
-static void OPM_Append (Files_Rider *R, LONGINT *R__typ, Files_File F);
+static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F);
export void OPM_CloseFiles (void);
export void OPM_CloseOldSym (void);
export void OPM_DeleteNewSym (void);
-export void OPM_FPrint (LONGINT *fp, LONGINT val);
-export void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr);
-export void OPM_FPrintReal (LONGINT *fp, REAL real);
-export void OPM_FPrintSet (LONGINT *fp, SET set);
-static void OPM_FindLine (Files_File f, Files_Rider *r, LONGINT *r__typ, LONGINT pos);
+export void OPM_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_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos);
+static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len);
export void OPM_Get (CHAR *ch);
-static void OPM_GetProperties (void);
-static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align);
export void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
export void OPM_InitOptions (void);
-static void OPM_LogErrMsg (INTEGER n);
+export INT16 OPM_Integer (INT64 n);
+static void OPM_LogErrMsg (INT16 n);
+export void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
export void OPM_LogW (CHAR ch);
export void OPM_LogWLn (void);
-export void OPM_LogWNum (LONGINT i, LONGINT len);
+export void OPM_LogWNum (INT64 i, INT64 len);
export void OPM_LogWStr (CHAR *s, LONGINT s__len);
+export INT32 OPM_Longint (INT64 n);
static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len);
-export void OPM_Mark (INTEGER n, LONGINT pos);
+export void OPM_Mark (INT16 n, INT32 pos);
export void OPM_NewSym (CHAR *modName, LONGINT modName__len);
export void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
export void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
export BOOLEAN OPM_OpenPar (void);
export void OPM_RegisterNewSym (void);
-static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt);
-static void OPM_ShowLine (LONGINT pos);
-export LONGINT OPM_SignedMaximum (LONGINT bytecount);
-export LONGINT OPM_SignedMinimum (LONGINT bytecount);
+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_SymRCh (CHAR *ch);
-export LONGINT OPM_SymRInt (void);
+export INT32 OPM_SymRInt (void);
+export INT64 OPM_SymRInt64 (void);
export void OPM_SymRLReal (LONGREAL *lr);
export void OPM_SymRReal (REAL *r);
-export void OPM_SymRSet (SET *s);
+export void OPM_SymRSet (UINT64 *s);
export void OPM_SymWCh (CHAR ch);
-export void OPM_SymWInt (LONGINT i);
+export void OPM_SymWInt (INT64 i);
export void OPM_SymWLReal (LONGREAL lr);
export void OPM_SymWReal (REAL r);
-export void OPM_SymWSet (SET s);
+export void OPM_SymWSet (UINT64 s);
static void OPM_VerboseListSizes (void);
export void OPM_Write (CHAR ch);
-export void OPM_WriteHex (LONGINT i);
-export void OPM_WriteInt (LONGINT i);
+export void OPM_WriteHex (INT64 i);
+export void OPM_WriteInt (INT64 i);
export void OPM_WriteLn (void);
export void OPM_WriteReal (LONGREAL r, CHAR suffx);
export void OPM_WriteString (CHAR *s, LONGINT s__len);
export void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
export BOOLEAN OPM_eofSF (void);
-export void OPM_err (INTEGER n);
-static LONGINT OPM_minusop (LONGINT i);
-static LONGINT OPM_power0 (LONGINT i, LONGINT j);
+export void OPM_err (INT16 n);
+#define OPM_GetAlignment(a) struct {char c; long long l;} _s; *a = (char*)&_s.l - (char*)&_s
void OPM_LogW (CHAR ch)
{
- Console_Char(ch);
+ Out_Char(ch);
}
void OPM_LogWStr (CHAR *s, LONGINT s__len)
{
__DUP(s, s__len, CHAR);
- Console_String(s, s__len);
+ Out_String(s, s__len);
__DEL(s);
}
-void OPM_LogWNum (LONGINT i, LONGINT len)
+void OPM_LogWNum (INT64 i, INT64 len)
{
- Console_Int(i, len);
+ Out_Int(i, len);
}
void OPM_LogWLn (void)
{
- Console_Ln();
+ Out_Ln();
}
-static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt)
+void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len)
{
- INTEGER i;
+ __DUP(vt100code, vt100code__len, CHAR);
+ if ((Out_IsConsole && !__IN(16, OPM_Options, 32))) {
+ VT100_SetAttr(vt100code, vt100code__len);
+ }
+ __DEL(vt100code);
+}
+
+INT64 OPM_SignedMaximum (INT32 bytecount)
+{
+ INT64 result;
+ result = 1;
+ result = __LSH(result, __ASHL(bytecount, 3) - 1, 64);
+ return result - 1;
+}
+
+INT64 OPM_SignedMinimum (INT32 bytecount)
+{
+ return -OPM_SignedMaximum(bytecount) - 1;
+}
+
+INT32 OPM_Longint (INT64 n)
+{
+ return __VAL(INT32, n);
+}
+
+INT16 OPM_Integer (INT64 n)
+{
+ return __VAL(INT16, n);
+}
+
+static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
+{
+ INT16 i;
+ __DUP(s, s__len, CHAR);
i = 1;
while (s[__X(i, s__len)] != 0x00) {
switch (s[__X(i, s__len)]) {
- case 'a':
- *opt = *opt ^ 0x80;
- break;
- case 'c':
- *opt = *opt ^ 0x4000;
- break;
- case 'e':
- *opt = *opt ^ 0x0200;
- break;
- case 'f':
- *opt = *opt ^ 0x010000;
- break;
- case 'k':
- *opt = *opt ^ 0x40;
- break;
- case 'm':
- *opt = *opt ^ 0x0400;
- break;
case 'p':
- *opt = *opt ^ 0x20;
+ OPM_Options = OPM_Options ^ 0x20;
+ break;
+ case 'a':
+ OPM_Options = OPM_Options ^ 0x80;
break;
case 'r':
- *opt = *opt ^ 0x04;
- break;
- case 's':
- *opt = *opt ^ 0x10;
+ OPM_Options = OPM_Options ^ 0x04;
break;
case 't':
- *opt = *opt ^ 0x08;
+ OPM_Options = OPM_Options ^ 0x08;
break;
case 'x':
- *opt = *opt ^ 0x01;
+ OPM_Options = OPM_Options ^ 0x01;
+ break;
+ case 'e':
+ OPM_Options = OPM_Options ^ 0x0200;
+ break;
+ case 's':
+ OPM_Options = OPM_Options ^ 0x10;
+ break;
+ case 'F':
+ OPM_Options = OPM_Options ^ 0x020000;
+ break;
+ case 'm':
+ OPM_Options = OPM_Options ^ 0x0400;
+ break;
+ case 'M':
+ OPM_Options = OPM_Options ^ 0x8000;
+ break;
+ case 'S':
+ OPM_Options = OPM_Options ^ 0x2000;
+ break;
+ case 'c':
+ OPM_Options = OPM_Options ^ 0x4000;
+ break;
+ case 'f':
+ OPM_Options = OPM_Options ^ 0x010000;
+ break;
+ case 'V':
+ OPM_Options = OPM_Options ^ 0x040000;
+ break;
+ case 'O':
+ if (i + 1 >= Strings_Length(s, s__len)) {
+ OPM_LogWStr((CHAR*)"-O option requires following size model character.", 51);
+ OPM_LogWLn();
+ } else {
+ OPM_Model[0] = s[__X(i + 1, s__len)];
+ OPM_Model[1] = 0x00;
+ if ((((OPM_Model[0] != '2' && OPM_Model[0] != 'C')) && OPM_Model[0] != 'V')) {
+ OPM_LogWStr((CHAR*)"Unrecognised size model character following -O.", 48);
+ OPM_LogWLn();
+ }
+ i += 1;
+ }
+ break;
+ case 'A':
+ if (i + 2 >= Strings_Length(s, s__len)) {
+ OPM_LogWStr((CHAR*)"-M option requires two following digits.", 41);
+ OPM_LogWLn();
+ } else {
+ OPM_AddressSize = (INT16)s[__X(i + 1, s__len)] - 48;
+ OPM_Alignment = (INT16)s[__X(i + 2, s__len)] - 48;
+ i += 2;
+ }
break;
case 'B':
if (s[__X(i + 1, s__len)] != 0x00) {
i += 1;
- OPM_IntSize = (int)s[__X(i, s__len)] - 48;
+ OPM_IntegerSize = (INT16)s[__X(i, s__len)] - 48;
}
if (s[__X(i + 1, s__len)] != 0x00) {
i += 1;
- OPM_PointerSize = (int)s[__X(i, s__len)] - 48;
+ OPM_AddressSize = (INT16)s[__X(i, s__len)] - 48;
}
if (s[__X(i + 1, s__len)] != 0x00) {
i += 1;
- OPM_Alignment = (int)s[__X(i, s__len)] - 48;
+ OPM_Alignment = (INT16)s[__X(i, s__len)] - 48;
}
- __ASSERT(OPM_IntSize == 2 || OPM_IntSize == 4, 0);
- __ASSERT(OPM_PointerSize == 4 || OPM_PointerSize == 8, 0);
+ __ASSERT(OPM_IntegerSize == 2 || OPM_IntegerSize == 4, 0);
+ __ASSERT(OPM_AddressSize == 4 || OPM_AddressSize == 8, 0);
__ASSERT(OPM_Alignment == 4 || OPM_Alignment == 8, 0);
- Files_SetSearchPath((CHAR*)"", (LONGINT)1);
- break;
- case 'F':
- *opt = *opt ^ 0x020000;
- break;
- case 'M':
- *opt = *opt ^ 0x8000;
- break;
- case 'S':
- *opt = *opt ^ 0x2000;
- break;
- case 'V':
- *opt = *opt ^ 0x040000;
+ if (OPM_IntegerSize == 2) {
+ OPM_LongintSize = 4;
+ } else {
+ OPM_LongintSize = 8;
+ }
+ Files_SetSearchPath((CHAR*)"", 1);
break;
default:
- OPM_LogWStr((CHAR*)" warning: option ", (LONGINT)19);
+ OPM_LogWStr((CHAR*)" warning: option ", 19);
OPM_LogW('-');
OPM_LogW(s[__X(i, s__len)]);
- OPM_LogWStr((CHAR*)" ignored", (LONGINT)9);
+ OPM_LogWStr((CHAR*)" ignored", 9);
OPM_LogWLn();
break;
}
i += 1;
}
+ __DEL(s);
}
BOOLEAN OPM_OpenPar (void)
{
- BOOLEAN _o_result;
CHAR s[256];
if (Platform_ArgCount == 1) {
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Vishap Oberon-2 compiler v", (LONGINT)27);
- OPM_LogWStr(Configuration_versionLong, ((LONGINT)(41)));
+ OPM_LogWStr((CHAR*)"Oberon-2 compiler v", 20);
+ OPM_LogWStr(Configuration_versionLong, 75);
OPM_LogW('.');
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Based on Ofront by Software Templ OEG, continued by Norayr Chilingarian and others.", (LONGINT)84);
+ 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_LogWLn();
- OPM_LogWStr((CHAR*)"Usage:", (LONGINT)7);
+ OPM_LogWStr((CHAR*)"Usage:", 7);
OPM_LogWLn();
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" ", (LONGINT)3);
- OPM_LogWStr((CHAR*)"voc", (LONGINT)4);
- OPM_LogWStr((CHAR*)" options {files {options}}.", (LONGINT)28);
+ OPM_LogWStr((CHAR*)" ", 3);
+ OPM_LogWStr((CHAR*)"voc", 4);
+ OPM_LogWStr((CHAR*)" options {files {options}}.", 28);
OPM_LogWLn();
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Where options = [\"-\" {option} ].", (LONGINT)33);
+ OPM_LogWStr((CHAR*)"Options:", 9);
OPM_LogWLn();
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" m - generate code for main module", (LONGINT)36);
+ OPM_LogWStr((CHAR*)" Run time safety", 18);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" M - generate code for main module and link object statically", (LONGINT)63);
+ OPM_LogWStr((CHAR*)" -p Initialise pointers to NIL. On by default.", 52);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" s - generate new symbol file", (LONGINT)31);
+ OPM_LogWStr((CHAR*)" -a Halt on assertion failures. On by default.", 52);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" e - allow extending the module interface", (LONGINT)43);
+ OPM_LogWStr((CHAR*)" -r Halt on range check failures.", 39);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" r - check value ranges", (LONGINT)25);
+ OPM_LogWStr((CHAR*)" -t Halt on type guard failure. On by default.", 52);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" a - don't check ASSERTs at runtime, use this option in tested production code", (LONGINT)80);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" t - don't check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" S - don't call external assembler/compiler, only generate C code", (LONGINT)67);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" c - don't call linker", (LONGINT)24);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" f - don't use color output", (LONGINT)29);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" V - verbose output", (LONGINT)21);
+ OPM_LogWStr((CHAR*)" -x Halt on index out of range. On by default.", 52);
OPM_LogWLn();
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Initial options specify defaults for all files.", (LONGINT)48);
+ OPM_LogWStr((CHAR*)" Symbol file management", 25);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Options following a filename are specific to that file.", (LONGINT)56);
+ OPM_LogWStr((CHAR*)" -e Allow extension of old symbol file.", 45);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Repeating an option toggles its value.", (LONGINT)39);
+ OPM_LogWStr((CHAR*)" -s Allow generation of new symbol file.", 46);
OPM_LogWLn();
- _o_result = 0;
- return _o_result;
+ OPM_LogWStr((CHAR*)" -F Force generation of new symbol file.", 46);
+ OPM_LogWLn();
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" C compiler and linker control", 32);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -m This module is main. Link dynamically.", 48);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -M This module is main. Link statically.", 47);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -S Don't call C compiler", 31);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -c Don't link.", 21);
+ OPM_LogWLn();
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" Miscellaneous", 16);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -f Disable VT100 control characters in status output.", 60);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -V Display compiler debugging messages.", 46);
+ OPM_LogWLn();
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" Size model for elementary types (default O2)", 47);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
+ OPM_LogWLn();
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" Target machine address size and alignment (default is that of the running compiler binary)", 93);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -A44 32 bit addresses, 32 bit alignment (e.g. Unix/linux 32 bit on x86).", 79);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -A48 32 bit addresses, 64 bit alignment (e.g. Windows 32 bit on x86, linux 32 bit on arm).", 97);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -A88 64 bit addresses, 64 bit alignment (e.g. 64 bit platforms).", 71);
+ OPM_LogWLn();
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"All options are off by default, except where noted above.", 58);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Initial options specify defaults for all files.", 48);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Options following a filename are specific to that file.", 56);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Repeating an option toggles its value.", 39);
+ OPM_LogWLn();
+ return 0;
} else {
+ OPM_AddressSize = 8;
+ OPM_GetAlignment(&OPM_Alignment);
+ __MOVE("2", OPM_Model, 2);
+ OPM_Options = 0xa9;
OPM_S = 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256)));
- OPM_glbopt = 0xe9;
+ Platform_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
- OPM_ScanOptions((void*)s, ((LONGINT)(256)), &OPM_glbopt);
+ OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256)));
+ Platform_GetArg(OPM_S, (void*)s, 256);
}
- _o_result = 1;
- return _o_result;
+ OPM_GlobalAddressSize = OPM_AddressSize;
+ OPM_GlobalAlignment = OPM_Alignment;
+ __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];
- OPM_opt = OPM_glbopt;
+ CHAR searchpath[1024], modules[1024];
+ CHAR MODULES[1024];
+ OPM_Options = OPM_GlobalOptions;
+ __COPY(OPM_GlobalModel, OPM_Model, 10);
+ OPM_Alignment = OPM_GlobalAlignment;
+ OPM_AddressSize = OPM_GlobalAddressSize;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256)));
+ Platform_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
- OPM_ScanOptions((void*)s, ((LONGINT)(256)), &OPM_opt);
+ OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256)));
+ Platform_GetArg(OPM_S, (void*)s, 256);
}
- OPM_dontAsm = __IN(13, OPM_opt);
- OPM_dontLink = __IN(14, OPM_opt);
- OPM_mainProg = __IN(10, OPM_opt);
- OPM_mainLinkStat = __IN(15, OPM_opt);
- OPM_notColorOutput = __IN(16, OPM_opt);
- OPM_forceNewSym = __IN(17, OPM_opt);
- OPM_Verbose = __IN(18, OPM_opt);
- if (OPM_mainLinkStat) {
- OPM_glbopt |= __SETOF(10);
+ if (__IN(15, OPM_Options, 32)) {
+ OPM_Options |= __SETOF(10,32);
}
- OPM_GetProperties();
+ OPM_MaxIndex = OPM_SignedMaximum(OPM_AddressSize);
+ switch (OPM_Model[0]) {
+ case '2':
+ OPM_ShortintSize = 1;
+ OPM_IntegerSize = 2;
+ OPM_LongintSize = 4;
+ break;
+ case 'C':
+ OPM_ShortintSize = 2;
+ OPM_IntegerSize = 4;
+ OPM_LongintSize = 8;
+ break;
+ case 'V':
+ OPM_ShortintSize = 1;
+ OPM_IntegerSize = 4;
+ OPM_LongintSize = 8;
+ break;
+ default:
+ OPM_ShortintSize = 1;
+ OPM_IntegerSize = 2;
+ OPM_LongintSize = 4;
+ break;
+ }
+ 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);
+ Platform_GetEnv((CHAR*)"OBERON", 7, (void*)searchpath, 1024);
+ Strings_Append((CHAR*)";.;", 4, (void*)searchpath, 1024);
+ Strings_Append(modules, 1024, (void*)searchpath, 1024);
+ Strings_Append((CHAR*)";", 2, (void*)searchpath, 1024);
+ Strings_Append(OPM_ResourceDir, 1024, (void*)searchpath, 1024);
+ Strings_Append((CHAR*)"/sym;", 6, (void*)searchpath, 1024);
+ Files_SetSearchPath(searchpath, 1024);
}
void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
{
Texts_Text T = NIL;
- LONGINT beg, end, time;
+ INT32 beg, end, time;
CHAR s[256];
*done = 0;
OPM_curpos = 0;
@@ -308,19 +476,19 @@ void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
return;
}
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256)));
+ Platform_GetArg(OPM_S, (void*)s, 256);
__NEW(T, Texts_TextDesc);
- Texts_Open(T, s, ((LONGINT)(256)));
- OPM_LogWStr(s, ((LONGINT)(256)));
- OPM_LogWStr((CHAR*)" ", (LONGINT)3);
+ Texts_Open(T, s, 256);
+ OPM_LogWStr(s, 256);
+ OPM_LogWStr((CHAR*)" ", 3);
__COPY(s, mname, mname__len);
- __COPY(s, OPM_SourceFileName, ((LONGINT)(256)));
+ __COPY(s, OPM_SourceFileName, 256);
if (T->len == 0) {
- OPM_LogWStr(s, ((LONGINT)(256)));
- OPM_LogWStr((CHAR*)" not found.", (LONGINT)12);
+ OPM_LogWStr(s, 256);
+ OPM_LogWStr((CHAR*)" not found.", 12);
OPM_LogWLn();
} else {
- Texts_OpenReader(&OPM_inR, Texts_Reader__typ, T, ((LONGINT)(0)));
+ Texts_OpenReader(&OPM_inR, Texts_Reader__typ, T, 0);
*done = 1;
}
OPM_S += 1;
@@ -348,7 +516,7 @@ void OPM_Get (CHAR *ch)
static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len)
{
- INTEGER i, j;
+ INT16 i, j;
CHAR ch;
__DUP(ext, ext__len, CHAR);
i = 0;
@@ -370,51 +538,56 @@ static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGIN
__DEL(ext);
}
-static void OPM_LogErrMsg (INTEGER n)
+static void OPM_LogErrMsg (INT16 n)
{
+ INT16 l;
Texts_Scanner S;
- Texts_Text T = NIL;
- CHAR ch;
- INTEGER i;
- CHAR buf[1024];
+ CHAR c;
if (n >= 0) {
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"31m", (LONGINT)4);
- }
- OPM_LogWStr((CHAR*)" err ", (LONGINT)7);
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"0m", (LONGINT)3);
- }
+ OPM_LogVT100((CHAR*)"31m", 4);
+ OPM_LogWStr((CHAR*)" err ", 7);
+ OPM_LogVT100((CHAR*)"0m", 3);
} else {
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"35m", (LONGINT)4);
- }
- OPM_LogWStr((CHAR*)" warning ", (LONGINT)11);
+ OPM_LogVT100((CHAR*)"35m", 4);
+ OPM_LogWStr((CHAR*)" warning ", 11);
n = -n;
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"0m", (LONGINT)3);
+ OPM_LogVT100((CHAR*)"0m", 3);
+ }
+ OPM_LogWNum(n, 1);
+ OPM_LogWStr((CHAR*)" ", 3);
+ if (OPM_Errors == NIL) {
+ __NEW(OPM_Errors, Texts_TextDesc);
+ Texts_Open(OPM_Errors, (CHAR*)"Errors.Txt", 11);
+ }
+ Texts_OpenScanner(&S, Texts_Scanner__typ, OPM_Errors, 0);
+ do {
+ l = S.line;
+ Texts_Scan(&S, Texts_Scanner__typ);
+ } while (!((((l != S.line && S.class == 3)) && S.i == n) || S.eot));
+ if (!S.eot) {
+ Texts_Read((void*)&S, Texts_Scanner__typ, &c);
+ while ((!S.eot && c >= ' ')) {
+ Out_Char(c);
+ Texts_Read((void*)&S, Texts_Scanner__typ, &c);
}
}
- OPM_LogWNum(n, ((LONGINT)(1)));
- OPM_LogWStr((CHAR*)" ", (LONGINT)3);
- OPM_LogWStr(errors_errors[__X(n, ((LONGINT)(350)))], ((LONGINT)(128)));
}
-static void OPM_FindLine (Files_File f, Files_Rider *r, LONGINT *r__typ, LONGINT pos)
+static void OPM_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos)
{
CHAR ch, cheol;
- if (pos < OPM_ErrorLineStartPos) {
+ if (pos < (INT64)OPM_ErrorLineStartPos) {
OPM_ErrorLineStartPos = 0;
OPM_ErrorLineLimitPos = 0;
OPM_ErrorLineNumber = 0;
}
- if (pos < OPM_ErrorLineLimitPos) {
+ if (pos < (INT64)OPM_ErrorLineLimitPos) {
Files_Set(&*r, r__typ, f, OPM_ErrorLineStartPos);
return;
}
Files_Set(&*r, r__typ, f, OPM_ErrorLineLimitPos);
Files_Read(&*r, r__typ, (void*)&ch);
- while ((OPM_ErrorLineLimitPos < pos && !(*r).eof)) {
+ while (((INT64)OPM_ErrorLineLimitPos < pos && !(*r).eof)) {
OPM_ErrorLineStartPos = OPM_ErrorLineLimitPos;
OPM_ErrorLineNumber += 1;
while ((((ch != 0x00 && ch != 0x0d)) && ch != 0x0a)) {
@@ -432,49 +605,45 @@ static void OPM_FindLine (Files_File f, Files_Rider *r, LONGINT *r__typ, LONGINT
Files_Set(&*r, r__typ, f, OPM_ErrorLineStartPos);
}
-static void OPM_ShowLine (LONGINT pos)
+static void OPM_ShowLine (INT64 pos)
{
Files_File f = NIL;
Files_Rider r;
CHAR line[1023];
- INTEGER i;
+ INT16 i;
CHAR ch;
- f = Files_Old(OPM_SourceFileName, ((LONGINT)(256)));
+ f = Files_Old(OPM_SourceFileName, 256);
OPM_FindLine(f, &r, Files_Rider__typ, pos);
i = 0;
Files_Read(&r, Files_Rider__typ, (void*)&ch);
while ((((((ch != 0x00 && ch != 0x0d)) && ch != 0x0a)) && i < 1022)) {
- line[__X(i, ((LONGINT)(1023)))] = ch;
+ line[__X(i, 1023)] = ch;
i += 1;
Files_Read(&r, Files_Rider__typ, (void*)&ch);
}
- line[__X(i, ((LONGINT)(1023)))] = 0x00;
+ line[__X(i, 1023)] = 0x00;
OPM_LogWLn();
OPM_LogWLn();
- OPM_LogWNum(OPM_ErrorLineNumber, ((LONGINT)(4)));
- OPM_LogWStr((CHAR*)": ", (LONGINT)3);
- OPM_LogWStr(line, ((LONGINT)(1023)));
+ OPM_LogWNum(OPM_ErrorLineNumber, 4);
+ OPM_LogWStr((CHAR*)": ", 3);
+ OPM_LogWStr(line, 1023);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" ", (LONGINT)7);
- if (pos >= OPM_ErrorLineLimitPos) {
+ OPM_LogWStr((CHAR*)" ", 7);
+ if (pos >= (INT64)OPM_ErrorLineLimitPos) {
pos = OPM_ErrorLineLimitPos - 1;
}
- i = (int)(pos - OPM_ErrorLineStartPos);
+ i = (INT16)OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos);
while (i > 0) {
OPM_LogW(' ');
i -= 1;
}
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"32m", (LONGINT)4);
- }
+ OPM_LogVT100((CHAR*)"32m", 4);
OPM_LogW('^');
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"0m", (LONGINT)3);
- }
+ OPM_LogVT100((CHAR*)"0m", 3);
Files_Close(f);
}
-void OPM_Mark (INTEGER n, LONGINT pos)
+void OPM_Mark (INT16 n, INT32 pos)
{
if (pos == -1) {
pos = 0;
@@ -485,30 +654,30 @@ void OPM_Mark (INTEGER n, LONGINT pos)
OPM_lasterrpos = pos;
OPM_ShowLine(pos);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" ", (LONGINT)3);
+ OPM_LogWStr((CHAR*)" ", 3);
if (n < 249) {
- OPM_LogWStr((CHAR*)" pos", (LONGINT)6);
- OPM_LogWNum(pos, ((LONGINT)(6)));
+ OPM_LogWStr((CHAR*)" pos", 6);
+ OPM_LogWNum(pos, 6);
OPM_LogErrMsg(n);
} else if (n == 255) {
- OPM_LogWStr((CHAR*)"pos", (LONGINT)4);
- OPM_LogWNum(pos, ((LONGINT)(6)));
- OPM_LogWStr((CHAR*)" pc ", (LONGINT)6);
- OPM_LogWNum(OPM_breakpc, ((LONGINT)(1)));
+ OPM_LogWStr((CHAR*)"pos", 4);
+ OPM_LogWNum(pos, 6);
+ OPM_LogWStr((CHAR*)" pc ", 6);
+ OPM_LogWNum(OPM_breakpc, 1);
} else if (n == 254) {
- OPM_LogWStr((CHAR*)"pc not found", (LONGINT)13);
+ OPM_LogWStr((CHAR*)"pc not found", 13);
} else {
- OPM_LogWStr(OPM_objname, ((LONGINT)(64)));
+ OPM_LogWStr(OPM_objname, 64);
if (n == 253) {
- OPM_LogWStr((CHAR*)" is new, compile with option e", (LONGINT)31);
+ OPM_LogWStr((CHAR*)" is new, compile with option e", 31);
} else if (n == 252) {
- OPM_LogWStr((CHAR*)" is redefined, compile with option s", (LONGINT)37);
+ OPM_LogWStr((CHAR*)" is redefined, compile with option s", 37);
} else if (n == 251) {
- OPM_LogWStr((CHAR*)" is redefined (private part only), compile with option s", (LONGINT)57);
+ OPM_LogWStr((CHAR*)" is redefined (private part only), compile with option s", 57);
} else if (n == 250) {
- OPM_LogWStr((CHAR*)" is no longer visible, compile with option s", (LONGINT)45);
+ OPM_LogWStr((CHAR*)" is no longer visible, compile with option s", 45);
} else if (n == 249) {
- OPM_LogWStr((CHAR*)" is not consistently imported, recompile imports", (LONGINT)49);
+ OPM_LogWStr((CHAR*)" is not consistently imported, recompile imports", 49);
}
}
}
@@ -516,8 +685,8 @@ void OPM_Mark (INTEGER n, LONGINT pos)
if (pos >= 0) {
OPM_ShowLine(pos);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" pos", (LONGINT)6);
- OPM_LogWNum(pos, ((LONGINT)(6)));
+ OPM_LogWStr((CHAR*)" pos", 6);
+ OPM_LogWNum(pos, 6);
}
OPM_LogErrMsg(n);
if (pos < 0) {
@@ -526,160 +695,42 @@ void OPM_Mark (INTEGER n, LONGINT pos)
}
}
-void OPM_err (INTEGER n)
+void OPM_err (INT16 n)
{
OPM_Mark(n, OPM_errpos);
}
-void OPM_FPrint (LONGINT *fp, LONGINT val)
+static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len)
{
- *fp = __ROTL((LONGINT)((SET)*fp ^ (SET)val), 1, LONGINT);
-}
-
-void OPM_FPrintSet (LONGINT *fp, SET set)
-{
- OPM_FPrint(&*fp, (LONGINT)set);
-}
-
-void OPM_FPrintReal (LONGINT *fp, REAL real)
-{
- INTEGER i;
- LONGINT l;
- __GET((LONGINT)(SYSTEM_ADDRESS)&real, i, INTEGER);
- l = i;
- OPM_FPrint(&*fp, l);
-}
-
-void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr)
-{
- LONGINT l, h;
- OPM_FPrint(&*fp, __VAL(LONGINT, lr));
-}
-
-static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align)
-{
- __DUP(name, name__len, CHAR);
- if (((*S).class == 1 && __STRCMP((*S).s, name) == 0)) {
- Texts_Scan(&*S, S__typ);
- if ((*S).class == 3) {
- *size = (int)(*S).i;
- Texts_Scan(&*S, S__typ);
- } else {
- OPM_Mark(-157, ((LONGINT)(-1)));
- }
- if ((*S).class == 3) {
- *align = (int)(*S).i;
- Texts_Scan(&*S, S__typ);
- } else {
- OPM_Mark(-157, ((LONGINT)(-1)));
- }
- } else {
- OPM_Mark(-157, ((LONGINT)(-1)));
+ INT16 i;
+ INT32 l;
+ __ASSERT(__MASK(bytes__len, -4) == 0, 0);
+ i = 0;
+ while (i < bytes__len) {
+ __GET((ADDRESS)&bytes[__X(i, bytes__len)], l, INT32);
+ *fp = __ROTL((INT32)((UINT32)*fp ^ (UINT32)l), 1, 32);
+ i += 4;
}
- __DEL(name);
}
-static LONGINT OPM_minusop (LONGINT i)
+void OPM_FPrint (INT32 *fp, INT64 val)
{
- LONGINT _o_result;
- _o_result = -i;
- return _o_result;
+ OPM_FingerprintBytes(&*fp, (void*)&val, 8);
}
-static LONGINT OPM_power0 (LONGINT i, LONGINT j)
+void OPM_FPrintSet (INT32 *fp, UINT64 val)
{
- LONGINT _o_result;
- LONGINT k, p;
- k = 1;
- p = i;
- do {
- p = p * i;
- k += 1;
- } while (!(k == j));
- _o_result = p;
- return _o_result;
+ OPM_FingerprintBytes(&*fp, (void*)&val, 8);
}
-static void OPM_VerboseListSizes (void)
+void OPM_FPrintReal (INT32 *fp, REAL val)
{
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Type Size Alignement", (LONGINT)29);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"CHAR ", (LONGINT)14);
- OPM_LogWNum(OPM_CharSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"BOOLEAN ", (LONGINT)14);
- OPM_LogWNum(OPM_BoolSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"SHORTINT ", (LONGINT)14);
- OPM_LogWNum(OPM_SIntSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"INTEGER ", (LONGINT)14);
- OPM_LogWNum(OPM_IntSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"LONGINT ", (LONGINT)14);
- OPM_LogWNum(OPM_LIntSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"SET ", (LONGINT)14);
- OPM_LogWNum(OPM_SetSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"REAL ", (LONGINT)14);
- OPM_LogWNum(OPM_RealSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"LONGREAL ", (LONGINT)14);
- OPM_LogWNum(OPM_LRealSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"PTR ", (LONGINT)14);
- OPM_LogWNum(OPM_PointerSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"PROC ", (LONGINT)14);
- OPM_LogWNum(OPM_ProcSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"RECORD ", (LONGINT)14);
- OPM_LogWNum(OPM_RecSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWLn();
+ OPM_FingerprintBytes(&*fp, (void*)&val, 4);
}
-LONGINT OPM_SignedMaximum (LONGINT bytecount)
+void OPM_FPrintLReal (INT32 *fp, LONGREAL val)
{
- LONGINT _o_result;
- LONGINT result;
- result = 1;
- result = __LSH(result, __ASHL(bytecount, 3) - 1, LONGINT);
- _o_result = result - 1;
- return _o_result;
-}
-
-LONGINT OPM_SignedMinimum (LONGINT bytecount)
-{
- LONGINT _o_result;
- _o_result = -OPM_SignedMaximum(bytecount) - 1;
- return _o_result;
-}
-
-static void OPM_GetProperties (void)
-{
- OPM_ProcSize = OPM_PointerSize;
- OPM_LIntSize = __ASHL(OPM_IntSize, 1);
- OPM_SetSize = OPM_LIntSize;
- if (OPM_RealSize == 4) {
- OPM_MaxReal = 3.40282346000000e+038;
- } else if (OPM_RealSize == 8) {
- OPM_MaxReal = 1.79769296342094e+308;
- }
- if (OPM_LRealSize == 4) {
- OPM_MaxLReal = 3.40282346000000e+038;
- } else if (OPM_LRealSize == 8) {
- OPM_MaxLReal = 1.79769296342094e+308;
- }
- OPM_MinReal = -OPM_MaxReal;
- OPM_MinLReal = -OPM_MaxLReal;
- OPM_MaxSet = __ASHL(OPM_SetSize, 3) - 1;
- OPM_MaxIndex = OPM_SignedMaximum(OPM_PointerSize);
- if (OPM_Verbose) {
- OPM_VerboseListSizes();
- }
+ OPM_FingerprintBytes(&*fp, (void*)&val, 8);
}
void OPM_SymRCh (CHAR *ch)
@@ -687,18 +738,23 @@ void OPM_SymRCh (CHAR *ch)
Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&*ch);
}
-LONGINT OPM_SymRInt (void)
+INT32 OPM_SymRInt (void)
{
- LONGINT _o_result;
- LONGINT k;
- Files_ReadNum(&OPM_oldSF, Files_Rider__typ, &k);
- _o_result = k;
- return _o_result;
+ INT32 k;
+ Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (void*)&k, 4);
+ return k;
}
-void OPM_SymRSet (SET *s)
+INT64 OPM_SymRInt64 (void)
{
- Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (LONGINT*)&*s);
+ INT64 k;
+ Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (void*)&k, 8);
+ return k;
+}
+
+void OPM_SymRSet (UINT64 *s)
+{
+ Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (void*)&*s, 8);
}
void OPM_SymRReal (REAL *r)
@@ -713,19 +769,21 @@ void OPM_SymRLReal (LONGREAL *lr)
void OPM_CloseOldSym (void)
{
+ Files_Close(Files_Base(&OPM_oldSF, Files_Rider__typ));
}
void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done)
{
- CHAR ch;
+ CHAR tag, ver;
OPM_FileName fileName;
- OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5);
- OPM_oldSFile = Files_Old(fileName, ((LONGINT)(32)));
+ OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
+ OPM_oldSFile = Files_Old(fileName, 32);
*done = OPM_oldSFile != NIL;
if (*done) {
- Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, ((LONGINT)(0)));
- Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ch);
- if (ch != 0xf7) {
+ Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, 0);
+ Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&tag);
+ Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ver);
+ if (tag != 0xf7 || ver != 0x82) {
OPM_err(-306);
OPM_CloseOldSym();
*done = 0;
@@ -735,9 +793,7 @@ void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done)
BOOLEAN OPM_eofSF (void)
{
- BOOLEAN _o_result;
- _o_result = OPM_oldSF.eof;
- return _o_result;
+ return OPM_oldSF.eof;
}
void OPM_SymWCh (CHAR ch)
@@ -745,14 +801,14 @@ void OPM_SymWCh (CHAR ch)
Files_Write(&OPM_newSF, Files_Rider__typ, ch);
}
-void OPM_SymWInt (LONGINT i)
+void OPM_SymWInt (INT64 i)
{
Files_WriteNum(&OPM_newSF, Files_Rider__typ, i);
}
-void OPM_SymWSet (SET s)
+void OPM_SymWSet (UINT64 s)
{
- Files_WriteNum(&OPM_newSF, Files_Rider__typ, (LONGINT)s);
+ Files_WriteNum(&OPM_newSF, Files_Rider__typ, (INT64)s);
}
void OPM_SymWReal (REAL r)
@@ -767,7 +823,7 @@ void OPM_SymWLReal (LONGREAL lr)
void OPM_RegisterNewSym (void)
{
- if (__STRCMP(OPM_modName, "SYSTEM") != 0 || __IN(10, OPM_opt)) {
+ if (__STRCMP(OPM_modName, "SYSTEM") != 0 || __IN(10, OPM_Options, 32)) {
Files_Register(OPM_newSFile);
}
}
@@ -779,11 +835,12 @@ void OPM_DeleteNewSym (void)
void OPM_NewSym (CHAR *modName, LONGINT modName__len)
{
OPM_FileName fileName;
- OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5);
- OPM_newSFile = Files_New(fileName, ((LONGINT)(32)));
+ OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
+ OPM_newSFile = Files_New(fileName, 32);
if (OPM_newSFile != NIL) {
- Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, ((LONGINT)(0)));
+ Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, 0);
Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7);
+ Files_Write(&OPM_newSF, Files_Rider__typ, 0x82);
} else {
OPM_err(153);
}
@@ -791,74 +848,74 @@ void OPM_NewSym (CHAR *modName, LONGINT modName__len)
void OPM_Write (CHAR ch)
{
- Files_Write(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, ch);
+ Files_Write(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, ch);
}
void OPM_WriteString (CHAR *s, LONGINT s__len)
{
- INTEGER i;
+ INT16 i;
i = 0;
while (s[__X(i, s__len)] != 0x00) {
i += 1;
}
- Files_WriteBytes(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, (void*)s, s__len * ((LONGINT)(1)), i);
+ Files_WriteBytes(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, (void*)s, s__len * 1, i);
}
void OPM_WriteStringVar (CHAR *s, LONGINT s__len)
{
- INTEGER i;
+ INT16 i;
i = 0;
while (s[__X(i, s__len)] != 0x00) {
i += 1;
}
- Files_WriteBytes(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, (void*)s, s__len * ((LONGINT)(1)), i);
+ Files_WriteBytes(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, (void*)s, s__len * 1, i);
}
-void OPM_WriteHex (LONGINT i)
+void OPM_WriteHex (INT64 i)
{
CHAR s[3];
- INTEGER digit;
- digit = __ASHR((int)i, 4);
+ INT32 digit;
+ digit = __ASHR((INT32)i, 4);
if (digit < 10) {
s[0] = (CHAR)(48 + digit);
} else {
s[0] = (CHAR)(87 + digit);
}
- digit = __MASK((int)i, -16);
+ digit = __MASK((INT32)i, -16);
if (digit < 10) {
s[1] = (CHAR)(48 + digit);
} else {
s[1] = (CHAR)(87 + digit);
}
s[2] = 0x00;
- OPM_WriteString(s, ((LONGINT)(3)));
+ OPM_WriteString(s, 3);
}
-void OPM_WriteInt (LONGINT i)
+void OPM_WriteInt (INT64 i)
{
- CHAR s[20];
- LONGINT i1, k;
- if (i == OPM_SignedMinimum(OPM_IntSize) || i == OPM_SignedMinimum(OPM_LIntSize)) {
+ CHAR s[24];
+ INT64 i1, k;
+ if ((i == OPM_SignedMinimum(2) || i == OPM_SignedMinimum(4)) || i == OPM_SignedMinimum(8)) {
OPM_Write('(');
OPM_WriteInt(i + 1);
- OPM_WriteString((CHAR*)"-1)", (LONGINT)4);
+ OPM_WriteString((CHAR*)"-1)", 4);
} else {
i1 = __ABS(i);
s[0] = (CHAR)(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k = 1;
while (i1 > 0) {
- s[__X(k, ((LONGINT)(20)))] = (CHAR)(__MOD(i1, 10) + 48);
+ s[__X(k, 24)] = (CHAR)(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k += 1;
}
if (i < 0) {
- s[__X(k, ((LONGINT)(20)))] = '-';
+ s[__X(k, 24)] = '-';
k += 1;
}
while (k > 0) {
k -= 1;
- OPM_Write(s[__X(k, ((LONGINT)(20)))]);
+ OPM_Write(s[__X(k, 24)]);
}
}
}
@@ -870,14 +927,14 @@ void OPM_WriteReal (LONGREAL r, CHAR suffx)
Texts_Reader R;
CHAR s[32];
CHAR ch;
- INTEGER i;
- if ((((r < OPM_SignedMaximum(OPM_LIntSize) && r > OPM_SignedMinimum(OPM_LIntSize))) && r == (__ENTIER(r)))) {
+ INT16 i;
+ if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == ((INT32)__ENTIER(r)))) {
if (suffx == 'f') {
- OPM_WriteString((CHAR*)"(REAL)", (LONGINT)7);
+ OPM_WriteString((CHAR*)"(REAL)", 7);
} else {
- OPM_WriteString((CHAR*)"(LONGREAL)", (LONGINT)11);
+ OPM_WriteString((CHAR*)"(LONGREAL)", 11);
}
- OPM_WriteInt(__ENTIER(r));
+ OPM_WriteInt((INT32)__ENTIER(r));
} else {
Texts_OpenWriter(&W, Texts_Writer__typ);
if (suffx == 'f') {
@@ -886,45 +943,45 @@ void OPM_WriteReal (LONGREAL r, CHAR suffx)
Texts_WriteLongReal(&W, Texts_Writer__typ, r, 23);
}
__NEW(T, Texts_TextDesc);
- Texts_Open(T, (CHAR*)"", (LONGINT)1);
+ Texts_Open(T, (CHAR*)"", 1);
Texts_Append(T, W.buf);
- Texts_OpenReader(&R, Texts_Reader__typ, T, ((LONGINT)(0)));
+ Texts_OpenReader(&R, Texts_Reader__typ, T, 0);
i = 0;
Texts_Read(&R, Texts_Reader__typ, &ch);
while (ch != 0x00) {
- s[__X(i, ((LONGINT)(32)))] = ch;
+ s[__X(i, 32)] = ch;
i += 1;
Texts_Read(&R, Texts_Reader__typ, &ch);
}
- s[__X(i, ((LONGINT)(32)))] = 0x00;
+ s[__X(i, 32)] = 0x00;
i = 0;
ch = s[0];
while ((ch != 'D' && ch != 0x00)) {
i += 1;
- ch = s[__X(i, ((LONGINT)(32)))];
+ ch = s[__X(i, 32)];
}
if (ch == 'D') {
- s[__X(i, ((LONGINT)(32)))] = 'e';
+ s[__X(i, 32)] = 'e';
}
- OPM_WriteString(s, ((LONGINT)(32)));
+ OPM_WriteString(s, 32);
}
}
void OPM_WriteLn (void)
{
- Files_Write(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, 0x0a);
+ Files_Write(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, 0x0a);
}
-static void OPM_Append (Files_Rider *R, LONGINT *R__typ, Files_File F)
+static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F)
{
Files_Rider R1;
CHAR buffer[4096];
if (F != NIL) {
- Files_Set(&R1, Files_Rider__typ, F, ((LONGINT)(0)));
- Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, ((LONGINT)(4096)), ((LONGINT)(4096)));
+ Files_Set(&R1, Files_Rider__typ, F, 0);
+ Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, 4096, 4096);
while (4096 - R1.res > 0) {
- Files_WriteBytes(&*R, R__typ, (void*)buffer, ((LONGINT)(4096)), 4096 - R1.res);
- Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, ((LONGINT)(4096)), ((LONGINT)(4096)));
+ Files_WriteBytes(&*R, R__typ, (void*)buffer, 4096, 4096 - R1.res);
+ Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, 4096, 4096);
}
}
}
@@ -932,24 +989,24 @@ static void OPM_Append (Files_Rider *R, LONGINT *R__typ, Files_File F)
void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
{
CHAR FName[32];
- __COPY(moduleName, OPM_modName, ((LONGINT)(32)));
- OPM_HFile = Files_New((CHAR*)"", (LONGINT)1);
+ __COPY(moduleName, OPM_modName, 32);
+ OPM_HFile = Files_New((CHAR*)"", 1);
if (OPM_HFile != NIL) {
- Files_Set(&OPM_R[0], Files_Rider__typ, OPM_HFile, ((LONGINT)(0)));
+ Files_Set(&OPM_R[0], Files_Rider__typ, OPM_HFile, 0);
} else {
OPM_err(153);
}
- OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, ((LONGINT)(32)), (CHAR*)".c", (LONGINT)3);
- OPM_BFile = Files_New(FName, ((LONGINT)(32)));
+ OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, 32, (CHAR*)".c", 3);
+ OPM_BFile = Files_New(FName, 32);
if (OPM_BFile != NIL) {
- Files_Set(&OPM_R[1], Files_Rider__typ, OPM_BFile, ((LONGINT)(0)));
+ Files_Set(&OPM_R[1], Files_Rider__typ, OPM_BFile, 0);
} else {
OPM_err(153);
}
- OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, ((LONGINT)(32)), (CHAR*)".h", (LONGINT)3);
- OPM_HIFile = Files_New(FName, ((LONGINT)(32)));
+ OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, 32, (CHAR*)".h", 3);
+ OPM_HIFile = Files_New(FName, 32);
if (OPM_HIFile != NIL) {
- Files_Set(&OPM_R[2], Files_Rider__typ, OPM_HIFile, ((LONGINT)(0)));
+ Files_Set(&OPM_R[2], Files_Rider__typ, OPM_HIFile, 0);
} else {
OPM_err(153);
}
@@ -958,26 +1015,26 @@ void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
void OPM_CloseFiles (void)
{
CHAR FName[32];
- INTEGER res;
+ INT16 res;
if (OPM_noerr) {
- OPM_LogWStr((CHAR*)" ", (LONGINT)3);
- OPM_LogWNum(Files_Pos(&OPM_R[1], Files_Rider__typ), ((LONGINT)(0)));
- OPM_LogWStr((CHAR*)" chars.", (LONGINT)8);
+ OPM_LogWStr((CHAR*)" ", 3);
+ OPM_LogWNum(Files_Pos(&OPM_R[1], Files_Rider__typ), 0);
+ OPM_LogWStr((CHAR*)" chars.", 8);
}
if (OPM_noerr) {
if (__STRCMP(OPM_modName, "SYSTEM") == 0) {
- if (!__IN(10, OPM_opt)) {
+ if (!__IN(10, OPM_Options, 32)) {
Files_Register(OPM_BFile);
}
- } else if (!__IN(10, OPM_opt)) {
+ } else if (!__IN(10, OPM_Options, 32)) {
OPM_Append(&OPM_R[2], Files_Rider__typ, OPM_HFile);
Files_Register(OPM_HIFile);
Files_Register(OPM_BFile);
} else {
- OPM_MakeFileName((void*)OPM_modName, ((LONGINT)(32)), (void*)FName, ((LONGINT)(32)), (CHAR*)".h", (LONGINT)3);
- Files_Delete(FName, ((LONGINT)(32)), &res);
- OPM_MakeFileName((void*)OPM_modName, ((LONGINT)(32)), (void*)FName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5);
- Files_Delete(FName, ((LONGINT)(32)), &res);
+ OPM_MakeFileName((void*)OPM_modName, 32, (void*)FName, 32, (CHAR*)".h", 3);
+ Files_Delete(FName, 32, &res);
+ OPM_MakeFileName((void*)OPM_modName, 32, (void*)FName, 32, (CHAR*)".sym", 5);
+ Files_Delete(FName, 32, &res);
Files_Register(OPM_BFile);
}
}
@@ -986,21 +1043,21 @@ void OPM_CloseFiles (void)
OPM_HIFile = NIL;
OPM_newSFile = NIL;
OPM_oldSFile = NIL;
- Files_Set(&OPM_R[0], Files_Rider__typ, NIL, ((LONGINT)(0)));
- Files_Set(&OPM_R[1], Files_Rider__typ, NIL, ((LONGINT)(0)));
- Files_Set(&OPM_R[2], Files_Rider__typ, NIL, ((LONGINT)(0)));
- Files_Set(&OPM_newSF, Files_Rider__typ, NIL, ((LONGINT)(0)));
- Files_Set(&OPM_oldSF, Files_Rider__typ, NIL, ((LONGINT)(0)));
+ Files_Set(&OPM_R[0], Files_Rider__typ, NIL, 0);
+ Files_Set(&OPM_R[1], Files_Rider__typ, NIL, 0);
+ Files_Set(&OPM_R[2], Files_Rider__typ, NIL, 0);
+ Files_Set(&OPM_newSF, Files_Rider__typ, NIL, 0);
+ Files_Set(&OPM_oldSF, Files_Rider__typ, NIL, 0);
}
static void EnumPtrs(void (*P)(void*))
{
- __ENUMR(&OPM_inR, Texts_Reader__typ, 96, 1, P);
+ __ENUMR(&OPM_inR, Texts_Reader__typ, 72, 1, P);
P(OPM_Log);
- __ENUMR(&OPM_W, Texts_Writer__typ, 72, 1, P);
- __ENUMR(&OPM_oldSF, Files_Rider__typ, 40, 1, P);
- __ENUMR(&OPM_newSF, Files_Rider__typ, 40, 1, P);
- __ENUMR(OPM_R, Files_Rider__typ, 40, 3, P);
+ P(OPM_Errors);
+ __ENUMR(&OPM_oldSF, Files_Rider__typ, 24, 1, P);
+ __ENUMR(&OPM_newSF, Files_Rider__typ, 24, 1, P);
+ __ENUMR(OPM_R, Files_Rider__typ, 24, 3, P);
P(OPM_oldSFile);
P(OPM_newSFile);
P(OPM_HFile);
@@ -1013,13 +1070,12 @@ export void *OPM__init(void)
{
__DEFMOD;
__MODULE_IMPORT(Configuration);
- __MODULE_IMPORT(Console);
__MODULE_IMPORT(Files);
+ __MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
__MODULE_IMPORT(Texts);
- __MODULE_IMPORT(errors);
- __MODULE_IMPORT(vt100);
+ __MODULE_IMPORT(VT100);
__REGMOD("OPM", EnumPtrs);
__REGCMD("CloseFiles", OPM_CloseFiles);
__REGCMD("CloseOldSym", OPM_CloseOldSym);
@@ -1029,26 +1085,9 @@ export void *OPM__init(void)
__REGCMD("RegisterNewSym", OPM_RegisterNewSym);
__REGCMD("WriteLn", OPM_WriteLn);
/* BEGIN */
- Texts_OpenWriter(&OPM_W, Texts_Writer__typ);
- OPM_MODULES[0] = 0x00;
- Platform_GetEnv((CHAR*)"MODULES", (LONGINT)8, (void*)OPM_MODULES, ((LONGINT)(1024)));
- __MOVE(".", OPM_OBERON, 2);
- Platform_GetEnv((CHAR*)"OBERON", (LONGINT)7, (void*)OPM_OBERON, ((LONGINT)(1024)));
- Strings_Append((CHAR*)";.;", (LONGINT)4, (void*)OPM_OBERON, ((LONGINT)(1024)));
- Strings_Append(OPM_MODULES, ((LONGINT)(1024)), (void*)OPM_OBERON, ((LONGINT)(1024)));
- Strings_Append((CHAR*)";", (LONGINT)2, (void*)OPM_OBERON, ((LONGINT)(1024)));
- Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)OPM_OBERON, ((LONGINT)(1024)));
- Strings_Append((CHAR*)"/sym;", (LONGINT)6, (void*)OPM_OBERON, ((LONGINT)(1024)));
- Files_SetSearchPath(OPM_OBERON, ((LONGINT)(1024)));
- OPM_CharSize = 1;
- OPM_BoolSize = 1;
- OPM_SIntSize = 1;
- OPM_RecSize = 1;
- OPM_ByteSize = 1;
- OPM_RealSize = 4;
- OPM_LRealSize = 8;
- OPM_PointerSize = 8;
- OPM_Alignment = 8;
- OPM_IntSize = 4;
+ OPM_MaxReal = 3.40282346000000e+038;
+ OPM_MaxLReal = 1.79769296342094e+308;
+ OPM_MinReal = -OPM_MaxReal;
+ OPM_MinLReal = -OPM_MaxLReal;
__ENDMOD;
}
diff --git a/bootstrap/unix-88/OPM.h b/bootstrap/unix-88/OPM.h
index 1706f8f1..2d272feb 100644
--- a/bootstrap/unix-88/OPM.h
+++ b/bootstrap/unix-88/OPM.h
@@ -1,66 +1,71 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPM__h
#define OPM__h
-#define LARGE
#include "SYSTEM.h"
-import INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_MaxSet;
-import LONGINT OPM_MaxIndex;
+import CHAR OPM_Model[10];
+import INT16 OPM_AddressSize, OPM_Alignment;
+import UINT32 OPM_GlobalOptions, OPM_Options;
+import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize;
+import INT64 OPM_MaxIndex;
import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
import BOOLEAN OPM_noerr;
-import LONGINT OPM_curpos, OPM_errpos, OPM_breakpc;
-import INTEGER OPM_currFile, OPM_level, OPM_pc, OPM_entno;
+import 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 SET OPM_opt, OPM_glbopt;
-import BOOLEAN OPM_dontAsm, OPM_dontLink, OPM_mainProg, OPM_mainLinkStat, OPM_notColorOutput, OPM_forceNewSym, OPM_Verbose;
+import CHAR OPM_ResourceDir[1024];
import void OPM_CloseFiles (void);
import void OPM_CloseOldSym (void);
import void OPM_DeleteNewSym (void);
-import void OPM_FPrint (LONGINT *fp, LONGINT val);
-import void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr);
-import void OPM_FPrintReal (LONGINT *fp, REAL real);
-import void OPM_FPrintSet (LONGINT *fp, SET set);
+import void OPM_FPrint (INT32 *fp, INT64 val);
+import void OPM_FPrintLReal (INT32 *fp, LONGREAL val);
+import void OPM_FPrintReal (INT32 *fp, REAL val);
+import void OPM_FPrintSet (INT32 *fp, UINT64 val);
import void OPM_Get (CHAR *ch);
import void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
import void OPM_InitOptions (void);
+import INT16 OPM_Integer (INT64 n);
+import void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
import void OPM_LogW (CHAR ch);
import void OPM_LogWLn (void);
-import void OPM_LogWNum (LONGINT i, LONGINT len);
+import void OPM_LogWNum (INT64 i, INT64 len);
import void OPM_LogWStr (CHAR *s, LONGINT s__len);
-import void OPM_Mark (INTEGER n, LONGINT pos);
+import INT32 OPM_Longint (INT64 n);
+import void OPM_Mark (INT16 n, INT32 pos);
import void OPM_NewSym (CHAR *modName, LONGINT modName__len);
import void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
import void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
import BOOLEAN OPM_OpenPar (void);
import void OPM_RegisterNewSym (void);
-import LONGINT OPM_SignedMaximum (LONGINT bytecount);
-import LONGINT OPM_SignedMinimum (LONGINT bytecount);
+import INT64 OPM_SignedMaximum (INT32 bytecount);
+import INT64 OPM_SignedMinimum (INT32 bytecount);
import void OPM_SymRCh (CHAR *ch);
-import LONGINT OPM_SymRInt (void);
+import INT32 OPM_SymRInt (void);
+import INT64 OPM_SymRInt64 (void);
import void OPM_SymRLReal (LONGREAL *lr);
import void OPM_SymRReal (REAL *r);
-import void OPM_SymRSet (SET *s);
+import void OPM_SymRSet (UINT64 *s);
import void OPM_SymWCh (CHAR ch);
-import void OPM_SymWInt (LONGINT i);
+import void OPM_SymWInt (INT64 i);
import void OPM_SymWLReal (LONGREAL lr);
import void OPM_SymWReal (REAL r);
-import void OPM_SymWSet (SET s);
+import void OPM_SymWSet (UINT64 s);
import void OPM_Write (CHAR ch);
-import void OPM_WriteHex (LONGINT i);
-import void OPM_WriteInt (LONGINT i);
+import void OPM_WriteHex (INT64 i);
+import void OPM_WriteInt (INT64 i);
import void OPM_WriteLn (void);
import void OPM_WriteReal (LONGREAL r, CHAR suffx);
import void OPM_WriteString (CHAR *s, LONGINT s__len);
import void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
import BOOLEAN OPM_eofSF (void);
-import void OPM_err (INTEGER n);
+import void OPM_err (INT16 n);
import void *OPM__init(void);
-#endif
+#endif // OPM
diff --git a/bootstrap/unix-88/OPP.c b/bootstrap/unix-88/OPP.c
index be7c13b5..df908a43 100644
--- a/bootstrap/unix-88/OPP.c
+++ b/bootstrap/unix-88/OPP.c
@@ -1,5 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "OPB.h"
#include "OPM.h"
@@ -7,38 +12,38 @@
#include "OPT.h"
struct OPP__1 {
- LONGINT low, high;
+ INT32 low, high;
};
typedef
struct OPP__1 OPP_CaseTable[128];
-static SHORTINT OPP_sym, OPP_level;
-static INTEGER OPP_LoopLevel;
+static INT8 OPP_sym, OPP_level;
+static INT16 OPP_LoopLevel;
static OPT_Node OPP_TDinit, OPP_lastTDinit;
-static INTEGER OPP_nofFwdPtr;
+static INT16 OPP_nofFwdPtr;
static OPT_Struct OPP_FwdPtr[64];
-export LONGINT *OPP__1__typ;
+export ADDRESS *OPP__1__typ;
static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar);
static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned);
static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq);
-static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab);
-static void OPP_CheckMark (SHORTINT *vis);
-static void OPP_CheckSym (INTEGER s);
-static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_);
+static void OPP_CaseLabelList (OPT_Node *lab, OPT_Struct LabelTyp, INT16 *n, OPP_CaseTable tab);
+static void OPP_CheckMark (INT8 *vis);
+static void OPP_CheckSym (INT16 s);
+static void OPP_CheckSysFlag (INT16 *sysflag, INT16 default_);
static void OPP_ConstExpression (OPT_Node *x);
static void OPP_Element (OPT_Node *x);
static void OPP_Expression (OPT_Node *x);
static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b);
static void OPP_Factor (OPT_Node *x);
static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp);
-export void OPP_Module (OPT_Node *prog, SET opt);
+export void OPP_Module (OPT_Node *prog, UINT32 opt);
static void OPP_PointerType (OPT_Struct *typ);
static void OPP_ProcedureDeclaration (OPT_Node *x);
-static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec);
+static void OPP_Receiver (INT8 *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec);
static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned);
static void OPP_Sets (OPT_Node *x);
static void OPP_SimpleExpression (OPT_Node *x);
@@ -47,19 +52,19 @@ static void OPP_StatSeq (OPT_Node *stat);
static void OPP_Term (OPT_Node *x);
static void OPP_Type (OPT_Struct *typ, OPT_Struct *banned);
static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned);
-static void OPP_err (INTEGER n);
+static void OPP_err (INT16 n);
static void OPP_qualident (OPT_Object *id);
static void OPP_selector (OPT_Node *x);
-static void OPP_err (INTEGER n)
+static void OPP_err (INT16 n)
{
OPM_err(n);
}
-static void OPP_CheckSym (INTEGER s)
+static void OPP_CheckSym (INT16 s)
{
- if ((int)OPP_sym == s) {
+ if ((INT16)OPP_sym == s) {
OPS_Get(&OPP_sym);
} else {
OPM_err(s);
@@ -69,7 +74,7 @@ static void OPP_CheckSym (INTEGER s)
static void OPP_qualident (OPT_Object *id)
{
OPT_Object obj = NIL;
- SHORTINT lev;
+ INT8 lev;
OPT_Find(&obj);
OPS_Get(&OPP_sym);
if ((((OPP_sym == 18 && obj != NIL)) && obj->mode == 11)) {
@@ -90,7 +95,7 @@ static void OPP_qualident (OPT_Object *id)
obj->adr = 0;
} else {
lev = obj->mnolev;
- if ((__IN(obj->mode, 0x06) && lev != OPP_level)) {
+ if ((__IN(obj->mode, 0x06, 32) && lev != OPP_level)) {
obj->leaf = 0;
if (lev > 0) {
OPB_StaticLink(OPP_level - lev);
@@ -105,11 +110,11 @@ static void OPP_ConstExpression (OPT_Node *x)
OPP_Expression(&*x);
if ((*x)->class != 7) {
OPP_err(50);
- *x = OPB_NewIntConst(((LONGINT)(1)));
+ *x = OPB_NewIntConst(1);
}
}
-static void OPP_CheckMark (SHORTINT *vis)
+static void OPP_CheckMark (INT8 *vis)
{
OPS_Get(&OPP_sym);
if (OPP_sym == 1 || OPP_sym == 7) {
@@ -127,17 +132,17 @@ static void OPP_CheckMark (SHORTINT *vis)
}
}
-static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_)
+static void OPP_CheckSysFlag (INT16 *sysflag, INT16 default_)
{
OPT_Node x = NIL;
- LONGINT sf;
+ INT64 sf;
if (OPP_sym == 31) {
OPS_Get(&OPP_sym);
if (!OPT_SYSimported) {
OPP_err(135);
}
OPP_ConstExpression(&x);
- if (__IN(x->typ->form, 0x70)) {
+ if (x->typ->form == 4) {
sf = x->conval->intval;
if (sf < 0 || sf > 1) {
OPP_err(220);
@@ -147,7 +152,7 @@ static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_)
OPP_err(51);
sf = 0;
}
- *sysflag = (int)sf;
+ *sysflag = OPM_Integer(sf);
OPP_CheckSym(23);
} else {
*sysflag = default_;
@@ -158,8 +163,8 @@ static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned)
{
OPT_Object fld = NIL, first = NIL, last = NIL, base = NIL;
OPT_Struct ftyp = NIL;
- INTEGER sysflag;
- *typ = OPT_NewStr(15, 4);
+ INT16 sysflag;
+ *typ = OPT_NewStr(13, 4);
(*typ)->BaseTyp = NIL;
OPP_CheckSysFlag(&sysflag, -1);
if (OPP_sym == 30) {
@@ -250,11 +255,11 @@ static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned)
static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned)
{
OPT_Node x = NIL;
- LONGINT n;
- INTEGER sysflag;
+ INT64 n;
+ INT16 sysflag;
OPP_CheckSysFlag(&sysflag, 0);
if (OPP_sym == 25) {
- *typ = OPT_NewStr(15, 3);
+ *typ = OPT_NewStr(13, 3);
(*typ)->mno = 0;
(*typ)->sysflag = sysflag;
OPS_Get(&OPP_sym);
@@ -266,10 +271,10 @@ static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned)
(*typ)->n = 0;
}
} else {
- *typ = OPT_NewStr(15, 2);
+ *typ = OPT_NewStr(13, 2);
(*typ)->sysflag = sysflag;
OPP_ConstExpression(&x);
- if (__IN(x->typ->form, 0x70)) {
+ if (x->typ->form == 4) {
n = x->conval->intval;
if (n <= 0 || n > OPM_MaxIndex) {
OPP_err(63);
@@ -279,7 +284,7 @@ static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned)
OPP_err(51);
n = 1;
}
- (*typ)->n = n;
+ (*typ)->n = OPM_Longint(n);
if (OPP_sym == 25) {
OPS_Get(&OPP_sym);
OPP_Type(&(*typ)->BaseTyp, &*banned);
@@ -302,26 +307,26 @@ static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned)
static void OPP_PointerType (OPT_Struct *typ)
{
OPT_Object id = NIL;
- *typ = OPT_NewStr(13, 1);
+ *typ = OPT_NewStr(11, 1);
OPP_CheckSysFlag(&(*typ)->sysflag, 0);
OPP_CheckSym(28);
if (OPP_sym == 38) {
OPT_Find(&id);
if (id == NIL) {
if (OPP_nofFwdPtr < 64) {
- OPP_FwdPtr[__X(OPP_nofFwdPtr, ((LONGINT)(64)))] = *typ;
+ OPP_FwdPtr[__X(OPP_nofFwdPtr, 64)] = *typ;
OPP_nofFwdPtr += 1;
} else {
OPP_err(224);
}
(*typ)->link = OPT_NewObj();
- __COPY(OPS_name, (*typ)->link->name, ((LONGINT)(256)));
+ __COPY(OPS_name, (*typ)->link->name, 256);
(*typ)->BaseTyp = OPT_undftyp;
OPS_Get(&OPP_sym);
} else {
OPP_qualident(&id);
if (id->mode == 5) {
- if (__IN(id->typ->comp, 0x1c)) {
+ if (__IN(id->typ->comp, 0x1c, 32)) {
(*typ)->BaseTyp = id->typ;
} else {
(*typ)->BaseTyp = OPT_undftyp;
@@ -334,7 +339,7 @@ static void OPP_PointerType (OPT_Struct *typ)
}
} else {
OPP_Type(&(*typ)->BaseTyp, &OPT_notyp);
- if (!__IN((*typ)->BaseTyp->comp, 0x1c)) {
+ if (!__IN((*typ)->BaseTyp->comp, 0x1c, 32)) {
(*typ)->BaseTyp = OPT_undftyp;
OPP_err(57);
}
@@ -343,7 +348,7 @@ static void OPP_PointerType (OPT_Struct *typ)
static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp)
{
- SHORTINT mode;
+ INT8 mode;
OPT_Object par = NIL, first = NIL, last = NIL, res = NIL;
OPT_Struct typ = NIL;
first = NIL;
@@ -387,6 +392,9 @@ static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp)
}
OPP_CheckSym(20);
OPP_Type(&typ, &OPT_notyp);
+ if (((typ->comp == 2 || typ->comp == 4) && typ->strobj == NIL)) {
+ OPP_err(-309);
+ }
if (mode == 1) {
typ->pvused = 1;
}
@@ -410,7 +418,7 @@ static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp)
if (OPP_sym == 38) {
OPP_qualident(&res);
if (res->mode == 5) {
- if (res->typ->form < 15) {
+ if (res->typ->form < 13) {
*resTyp = res->typ;
} else {
OPP_err(54);
@@ -460,7 +468,7 @@ static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned)
OPP_PointerType(&*typ);
} else if (OPP_sym == 61) {
OPS_Get(&OPP_sym);
- *typ = OPT_NewStr(14, 1);
+ *typ = OPT_NewStr(12, 1);
OPP_CheckSysFlag(&(*typ)->sysflag, 0);
if (OPP_sym == 30) {
OPS_Get(&OPP_sym);
@@ -489,7 +497,7 @@ static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned)
static void OPP_Type (OPT_Struct *typ, OPT_Struct *banned)
{
OPP_TypeDecl(&*typ, &*banned);
- if (((((*typ)->form == 13 && (*typ)->BaseTyp == OPT_undftyp)) && (*typ)->strobj == NIL)) {
+ if (((((*typ)->form == 11 && (*typ)->BaseTyp == OPT_undftyp)) && (*typ)->strobj == NIL)) {
OPP_err(0);
}
}
@@ -504,7 +512,7 @@ static void OPP_selector (OPT_Node *x)
if (OPP_sym == 31) {
OPS_Get(&OPP_sym);
for (;;) {
- if (((*x)->typ != NIL && (*x)->typ->form == 13)) {
+ if (((*x)->typ != NIL && (*x)->typ->form == 11)) {
OPB_DeRef(&*x);
}
OPP_Expression(&y);
@@ -519,10 +527,10 @@ static void OPP_selector (OPT_Node *x)
} else if (OPP_sym == 18) {
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
- __COPY(OPS_name, name, ((LONGINT)(256)));
+ __COPY(OPS_name, name, 256);
OPS_Get(&OPP_sym);
if ((*x)->typ != NIL) {
- if ((*x)->typ->form == 13) {
+ if ((*x)->typ->form == 11) {
OPB_DeRef(&*x);
}
if ((*x)->typ->comp == 4) {
@@ -544,7 +552,7 @@ static void OPP_selector (OPT_Node *x)
OPP_err(75);
}
typ = y->obj->typ;
- if (typ->form == 13) {
+ if (typ->form == 11) {
typ = typ->BaseTyp;
}
OPT_FindField((*x)->obj->name, typ->BaseTyp, &proc);
@@ -573,7 +581,7 @@ static void OPP_selector (OPT_Node *x)
} else if (OPP_sym == 17) {
OPS_Get(&OPP_sym);
OPB_DeRef(&*x);
- } else if ((((((OPP_sym == 30 && (*x)->class < 7)) && (*x)->typ->form != 14)) && ((*x)->obj == NIL || (*x)->obj->mode != 13))) {
+ } else if ((((((OPP_sym == 30 && (*x)->class < 7)) && (*x)->typ->form != 12)) && ((*x)->obj == NIL || (*x)->obj->mode != 13))) {
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
OPP_qualident(&obj);
@@ -624,9 +632,9 @@ static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar)
static void OPP_StandProcCall (OPT_Node *x)
{
OPT_Node y = NIL;
- SHORTINT m;
- INTEGER n;
- m = (int)(*x)->obj->adr;
+ INT8 m;
+ INT16 n;
+ m = (INT8)((INT16)(*x)->obj->adr);
n = 0;
if (OPP_sym == 30) {
OPS_Get(&OPP_sym);
@@ -743,8 +751,8 @@ static void OPP_Factor (OPT_Node *x)
*x = OPB_NewRealConst(OPS_lrlval, OPT_lrltyp);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPP.Factor, OPS.numtyp = ", (LONGINT)44);
- OPM_LogWNum(OPS_numtyp, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPP.Factor, OPS.numtyp = ", 44);
+ OPM_LogWNum(OPS_numtyp, 0);
OPM_LogWLn();
break;
}
@@ -777,7 +785,7 @@ static void OPP_Factor (OPT_Node *x)
*x = NIL;
}
if (*x == NIL) {
- *x = OPB_NewIntConst(((LONGINT)(1)));
+ *x = OPB_NewIntConst(1);
(*x)->typ = OPT_undftyp;
}
}
@@ -785,7 +793,7 @@ static void OPP_Factor (OPT_Node *x)
static void OPP_Term (OPT_Node *x)
{
OPT_Node y = NIL;
- SHORTINT mulop;
+ INT8 mulop;
OPP_Factor(&*x);
while ((1 <= OPP_sym && OPP_sym <= 5)) {
mulop = OPP_sym;
@@ -798,7 +806,7 @@ static void OPP_Term (OPT_Node *x)
static void OPP_SimpleExpression (OPT_Node *x)
{
OPT_Node y = NIL;
- SHORTINT addop;
+ INT8 addop;
if (OPP_sym == 7) {
OPS_Get(&OPP_sym);
OPP_Term(&*x);
@@ -822,7 +830,7 @@ static void OPP_Expression (OPT_Node *x)
{
OPT_Node y = NIL;
OPT_Object obj = NIL;
- SHORTINT relation;
+ INT8 relation;
OPP_SimpleExpression(&*x);
if ((9 <= OPP_sym && OPP_sym <= 14)) {
relation = OPP_sym;
@@ -848,7 +856,7 @@ static void OPP_Expression (OPT_Node *x)
}
}
-static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec)
+static void OPP_Receiver (INT8 *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec)
{
OPT_Object obj = NIL;
*typ = OPT_undftyp;
@@ -859,7 +867,7 @@ static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_St
} else {
*mode = 1;
}
- __COPY(OPS_name, name, ((LONGINT)(256)));
+ __COPY(OPS_name, name, 256);
OPP_CheckSym(38);
OPP_CheckSym(20);
if (OPP_sym == 38) {
@@ -872,10 +880,10 @@ static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_St
} else {
*typ = obj->typ;
*rec = *typ;
- if ((*rec)->form == 13) {
+ if ((*rec)->form == 11) {
*rec = (*rec)->BaseTyp;
}
- if (!((((*mode == 1 && (*typ)->form == 13)) && (*rec)->comp == 4) || (*mode == 2 && (*typ)->comp == 4))) {
+ if (!((((*mode == 1 && (*typ)->form == 11)) && (*rec)->comp == 4) || (*mode == 2 && (*typ)->comp == 4))) {
OPP_err(70);
*rec = NIL;
}
@@ -889,15 +897,14 @@ static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_St
}
OPP_CheckSym(22);
if (*rec == NIL) {
- *rec = OPT_NewStr(15, 4);
+ *rec = OPT_NewStr(13, 4);
(*rec)->BaseTyp = NIL;
}
}
static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b)
{
- BOOLEAN _o_result;
- if ((b->form == 13 && x->form == 13)) {
+ if ((b->form == 11 && x->form == 11)) {
b = b->BaseTyp;
x = x->BaseTyp;
}
@@ -906,15 +913,14 @@ static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b)
x = x->BaseTyp;
} while (!(x == NIL || x == b));
}
- _o_result = x == b;
- return _o_result;
+ return x == b;
}
static struct ProcedureDeclaration__16 {
OPT_Node *x;
OPT_Object *proc, *fwd;
OPS_Name *name;
- SHORTINT *mode, *vis;
+ INT8 *mode, *vis;
BOOLEAN *forward;
struct ProcedureDeclaration__16 *lnk;
} *ProcedureDeclaration__16_s;
@@ -927,14 +933,14 @@ static void TProcDecl__23 (void);
static void GetCode__19 (void)
{
OPT_ConstExt ext = NIL;
- INTEGER n;
- LONGINT c;
+ INT16 n;
+ INT64 c;
ext = OPT_NewExt();
(*ProcedureDeclaration__16_s->proc)->conval->ext = ext;
n = 0;
if (OPP_sym == 37) {
- while (OPS_str[__X(n, ((LONGINT)(256)))] != 0x00) {
- (*ext)[__X(n + 1, ((LONGINT)(256)))] = OPS_str[__X(n, ((LONGINT)(256)))];
+ while (OPS_str[__X(n, 256)] != 0x00) {
+ (*ext)[__X(n + 1, 256)] = OPS_str[__X(n, 256)];
n += 1;
}
(*ext)[0] = (CHAR)n;
@@ -950,7 +956,7 @@ static void GetCode__19 (void)
n = 1;
}
OPS_Get(&OPP_sym);
- (*ext)[__X(n, ((LONGINT)(256)))] = (CHAR)c;
+ (*ext)[__X(n, 256)] = (CHAR)c;
}
if (OPP_sym == 19) {
OPS_Get(&OPP_sym);
@@ -962,7 +968,7 @@ static void GetCode__19 (void)
}
}
}
- (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1);
+ (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1,64);
}
static void GetParams__21 (void)
@@ -992,9 +998,9 @@ static void GetParams__21 (void)
static void Body__17 (void)
{
OPT_Node procdec = NIL, statseq = NIL;
- LONGINT c;
+ INT32 c;
c = OPM_errpos;
- (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1);
+ (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1,64);
OPP_CheckSym(39);
OPP_Block(&procdec, &statseq);
OPB_Enter(&procdec, statseq, *ProcedureDeclaration__16_s->proc);
@@ -1015,7 +1021,7 @@ static void TProcDecl__23 (void)
{
OPT_Object baseProc = NIL;
OPT_Struct objTyp = NIL, recTyp = NIL;
- SHORTINT objMode;
+ INT8 objMode;
OPS_Name objName;
OPS_Get(&OPP_sym);
*ProcedureDeclaration__16_s->mode = 13;
@@ -1024,7 +1030,7 @@ static void TProcDecl__23 (void)
}
OPP_Receiver(&objMode, objName, &objTyp, &recTyp);
if (OPP_sym == 38) {
- __COPY(OPS_name, *ProcedureDeclaration__16_s->name, ((LONGINT)(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);
@@ -1037,7 +1043,7 @@ static void TProcDecl__23 (void)
if ((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mnolev != OPP_level)) {
*ProcedureDeclaration__16_s->fwd = NIL;
}
- if ((((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mode == 13)) && !__IN(1, (*ProcedureDeclaration__16_s->fwd)->conval->setval))) {
+ if ((((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mode == 13)) && !__IN(1, (*ProcedureDeclaration__16_s->fwd)->conval->setval, 64))) {
*ProcedureDeclaration__16_s->proc = OPT_NewObj();
(*ProcedureDeclaration__16_s->proc)->leaf = 1;
if ((*ProcedureDeclaration__16_s->fwd)->vis != *ProcedureDeclaration__16_s->vis) {
@@ -1071,7 +1077,7 @@ static void TProcDecl__23 (void)
if ((((((baseProc->vis == 1 && (*ProcedureDeclaration__16_s->proc)->vis == 0)) && recTyp->strobj != NIL)) && recTyp->strobj->vis == 1)) {
OPP_err(109);
}
- (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(2);
+ (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(2,64);
}
if (!*ProcedureDeclaration__16_s->forward) {
Body__17();
@@ -1087,7 +1093,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
{
OPT_Object proc = NIL, fwd = NIL;
OPS_Name name;
- SHORTINT mode, vis;
+ INT8 mode, vis;
BOOLEAN forward;
struct ProcedureDeclaration__16 _s;
_s.x = x;
@@ -1114,7 +1120,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
} else {
OPP_err(38);
}
- if ((__IN(mode, 0x0600) && !OPT_SYSimported)) {
+ if ((__IN(mode, 0x0600, 32) && !OPT_SYSimported)) {
OPP_err(135);
}
OPS_Get(&OPP_sym);
@@ -1123,7 +1129,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
TProcDecl__23();
} else if (OPP_sym == 38) {
OPT_Find(&fwd);
- __COPY(OPS_name, name, ((LONGINT)(256)));
+ __COPY(OPS_name, name, 256);
OPP_CheckMark(&vis);
if ((vis != 0 && mode == 6)) {
mode = 7;
@@ -1131,7 +1137,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
if ((fwd != NIL && (fwd->mnolev != OPP_level || fwd->mode == 8))) {
fwd = NIL;
}
- if ((((fwd != NIL && __IN(fwd->mode, 0xc0))) && !__IN(1, fwd->conval->setval))) {
+ if ((((fwd != NIL && __IN(fwd->mode, 0xc0, 32))) && !__IN(1, fwd->conval->setval, 64))) {
proc = OPT_NewObj();
proc->leaf = 1;
if (fwd->vis != vis) {
@@ -1164,34 +1170,34 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
ProcedureDeclaration__16_s = _s.lnk;
}
-static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab)
+static void OPP_CaseLabelList (OPT_Node *lab, OPT_Struct LabelTyp, INT16 *n, OPP_CaseTable tab)
{
OPT_Node x = NIL, y = NIL, lastlab = NIL;
- INTEGER i, f;
- LONGINT xval, yval;
+ INT16 i, f;
+ INT32 xval, yval;
*lab = NIL;
lastlab = NIL;
for (;;) {
OPP_ConstExpression(&x);
f = x->typ->form;
- if (__IN(f, 0x78)) {
- xval = x->conval->intval;
+ if (__IN(f, 0x18, 32)) {
+ xval = OPM_Longint(x->conval->intval);
} else {
OPP_err(61);
xval = 1;
}
- if (__IN(f, 0x70)) {
- if (LabelForm < f) {
+ if (f == 4) {
+ if (!(LabelTyp->form == 4) || LabelTyp->size < x->typ->size) {
OPP_err(60);
}
- } else if (LabelForm != f) {
+ } else if ((INT16)LabelTyp->form != f) {
OPP_err(60);
}
if (OPP_sym == 21) {
OPS_Get(&OPP_sym);
OPP_ConstExpression(&y);
- yval = y->conval->intval;
- if (((int)y->typ->form != f && !((__IN(f, 0x70) && __IN(y->typ->form, 0x70))))) {
+ yval = OPM_Longint(y->conval->intval);
+ if (((INT16)y->typ->form != f && !((f == 4 && y->typ->form == 4)))) {
OPP_err(60);
}
if (yval < xval) {
@@ -1208,17 +1214,17 @@ static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP
if (i == 0) {
break;
}
- if (tab[__X(i - 1, ((LONGINT)(128)))].low <= yval) {
- if (tab[__X(i - 1, ((LONGINT)(128)))].high >= xval) {
+ if (tab[__X(i - 1, 128)].low <= yval) {
+ if (tab[__X(i - 1, 128)].high >= xval) {
OPP_err(62);
}
break;
}
- tab[__X(i, ((LONGINT)(128)))] = tab[__X(i - 1, ((LONGINT)(128)))];
+ tab[__X(i, 128)] = tab[__X(i - 1, 128)];
i -= 1;
}
- tab[__X(i, ((LONGINT)(128)))].low = xval;
- tab[__X(i, ((LONGINT)(128)))].high = yval;
+ tab[__X(i, 128)].low = xval;
+ tab[__X(i, 128)].high = yval;
*n += 1;
} else {
OPP_err(213);
@@ -1235,7 +1241,7 @@ static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP
}
static struct StatSeq__30 {
- LONGINT *pos;
+ INT32 *pos;
struct StatSeq__30 *lnk;
} *StatSeq__30_s;
@@ -1245,8 +1251,8 @@ static void SetPos__35 (OPT_Node x);
static void CasePart__31 (OPT_Node *x)
{
- INTEGER n;
- LONGINT low, high;
+ INT16 n;
+ INT32 low, high;
BOOLEAN e;
OPP_CaseTable tab;
OPT_Node cases = NIL, lab = NIL, y = NIL, lastcase = NIL;
@@ -1254,7 +1260,7 @@ static void CasePart__31 (OPT_Node *x)
*StatSeq__30_s->pos = OPM_errpos;
if ((*x)->class == 8 || (*x)->class == 9) {
OPP_err(126);
- } else if (!__IN((*x)->typ->form, 0x78)) {
+ } else if (!__IN((*x)->typ->form, 0x18, 32)) {
OPP_err(125);
}
OPP_CheckSym(25);
@@ -1263,7 +1269,7 @@ static void CasePart__31 (OPT_Node *x)
n = 0;
for (;;) {
if (OPP_sym < 40) {
- OPP_CaseLabelList(&lab, (*x)->typ->form, &n, tab);
+ OPP_CaseLabelList(&lab, (*x)->typ, &n, tab);
OPP_CheckSym(20);
OPP_StatSeq(&y);
OPB_Construct(17, &lab, y);
@@ -1277,7 +1283,7 @@ static void CasePart__31 (OPT_Node *x)
}
if (n > 0) {
low = tab[0].low;
- high = tab[__X(n - 1, ((LONGINT)(128)))].high;
+ high = tab[__X(n - 1, 128)].high;
if (high - low > 512) {
OPP_err(209);
}
@@ -1329,7 +1335,7 @@ static void OPP_StatSeq (OPT_Node *stat)
OPT_Struct idtyp = NIL;
BOOLEAN e;
OPT_Node s = NIL, x = NIL, y = NIL, z = NIL, apar = NIL, last = NIL, lastif = NIL;
- LONGINT pos;
+ INT32 pos;
OPS_Name name;
struct StatSeq__30 _s;
_s.pos = &pos;
@@ -1440,7 +1446,7 @@ static void OPP_StatSeq (OPT_Node *stat)
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
OPP_qualident(&id);
- if (!__IN(id->typ->form, 0x70)) {
+ if (!(id->typ->form == 4)) {
OPP_err(68);
}
OPP_CheckSym(34);
@@ -1472,7 +1478,7 @@ static void OPP_StatSeq (OPT_Node *stat)
SetPos__35(z);
OPB_Link(&*stat, &last, z);
y = OPB_NewLeaf(t);
- } else if (y->typ->form < 4 || y->typ->form > x->left->typ->form) {
+ } else if (!(y->typ->form == 4) || y->typ->size > x->left->typ->size) {
OPP_err(113);
}
OPB_Link(&*stat, &last, x);
@@ -1480,7 +1486,7 @@ static void OPP_StatSeq (OPT_Node *stat)
OPS_Get(&OPP_sym);
OPP_ConstExpression(&z);
} else {
- z = OPB_NewIntConst(((LONGINT)(1)));
+ z = OPB_NewIntConst(1);
}
pos = OPM_errpos;
x = OPB_NewLeaf(id);
@@ -1527,7 +1533,7 @@ static void OPP_StatSeq (OPT_Node *stat)
if (OPP_sym == 38) {
OPP_qualident(&id);
y = OPB_NewLeaf(id);
- if ((((id != NIL && id->typ->form == 13)) && (id->mode == 2 || !id->leaf))) {
+ if ((((id != NIL && id->typ->form == 11)) && (id->mode == 2 || !id->leaf))) {
OPP_err(245);
}
OPP_CheckSym(20);
@@ -1622,7 +1628,7 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
OPT_Struct typ = NIL;
OPT_Object obj = NIL, first = NIL, last = NIL;
OPT_Node x = NIL, lastdec = NIL;
- INTEGER i;
+ INT16 i;
first = NIL;
last = NIL;
OPP_nofFwdPtr = 0;
@@ -1643,7 +1649,7 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
OPP_ConstExpression(&x);
} else {
OPP_err(9);
- x = OPB_NewIntConst(((LONGINT)(1)));
+ x = OPB_NewIntConst(1);
}
obj->mode = 3;
obj->typ = x->typ;
@@ -1671,10 +1677,10 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
if (obj->typ->strobj == NIL) {
obj->typ->strobj = obj;
}
- if (__IN(obj->typ->comp, 0x1c)) {
+ if (__IN(obj->typ->comp, 0x1c, 32)) {
i = 0;
while (i < OPP_nofFwdPtr) {
- typ = OPP_FwdPtr[__X(i, ((LONGINT)(64)))];
+ typ = OPP_FwdPtr[__X(i, 64)];
i += 1;
if (__STRCMP(typ->link->name, obj->name) == 0) {
typ->BaseTyp = obj->typ;
@@ -1736,10 +1742,10 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
}
i = 0;
while (i < OPP_nofFwdPtr) {
- if (OPP_FwdPtr[__X(i, ((LONGINT)(64)))]->link->name[0] != 0x00) {
+ if (OPP_FwdPtr[__X(i, 64)]->link->name[0] != 0x00) {
OPP_err(128);
}
- OPP_FwdPtr[__X(i, ((LONGINT)(64)))] = NIL;
+ OPP_FwdPtr[__X(i, 64)] = NIL;
i += 1;
}
OPT_topScope->adr = OPM_errpos;
@@ -1771,11 +1777,11 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
OPP_CheckSym(41);
}
-void OPP_Module (OPT_Node *prog, SET opt)
+void OPP_Module (OPT_Node *prog, UINT32 opt)
{
OPS_Name impName, aliasName;
OPT_Node procdec = NIL, statseq = NIL;
- LONGINT c;
+ INT32 c;
BOOLEAN done;
OPS_Init();
OPP_LoopLevel = 0;
@@ -1785,28 +1791,28 @@ void OPP_Module (OPT_Node *prog, SET opt)
OPS_Get(&OPP_sym);
} else {
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Unexpected symbol found when MODULE expected:", (LONGINT)46);
+ OPM_LogWStr((CHAR*)"Unexpected symbol found when MODULE expected:", 46);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" sym: ", (LONGINT)15);
- OPM_LogWNum(OPP_sym, ((LONGINT)(1)));
+ OPM_LogWStr((CHAR*)" sym: ", 15);
+ OPM_LogWNum(OPP_sym, 1);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.name: ", (LONGINT)15);
- OPM_LogWStr(OPS_name, ((LONGINT)(256)));
+ OPM_LogWStr((CHAR*)" OPS.name: ", 15);
+ OPM_LogWStr(OPS_name, 256);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.str: ", (LONGINT)15);
- OPM_LogWStr(OPS_str, ((LONGINT)(256)));
+ OPM_LogWStr((CHAR*)" OPS.str: ", 15);
+ OPM_LogWStr(OPS_str, 256);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.numtyp: ", (LONGINT)15);
- OPM_LogWNum(OPS_numtyp, ((LONGINT)(1)));
+ OPM_LogWStr((CHAR*)" OPS.numtyp: ", 15);
+ OPM_LogWNum(OPS_numtyp, 1);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.intval: ", (LONGINT)15);
- OPM_LogWNum(OPS_intval, ((LONGINT)(1)));
+ OPM_LogWStr((CHAR*)" OPS.intval: ", 15);
+ OPM_LogWNum(OPS_intval, 1);
OPM_LogWLn();
OPP_err(16);
}
if (OPP_sym == 38) {
- OPM_LogWStr((CHAR*)"compiling ", (LONGINT)11);
- OPM_LogWStr(OPS_name, ((LONGINT)(256)));
+ OPM_LogWStr((CHAR*)"compiling ", 11);
+ OPM_LogWStr(OPS_name, 256);
OPM_LogW('.');
OPT_Init(OPS_name, opt);
OPS_Get(&OPP_sym);
@@ -1815,13 +1821,13 @@ void OPP_Module (OPT_Node *prog, SET opt)
OPS_Get(&OPP_sym);
for (;;) {
if (OPP_sym == 38) {
- __COPY(OPS_name, aliasName, ((LONGINT)(256)));
- __COPY(aliasName, impName, ((LONGINT)(256)));
+ __COPY(OPS_name, aliasName, 256);
+ __COPY(aliasName, impName, 256);
OPS_Get(&OPP_sym);
if (OPP_sym == 34) {
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
- __COPY(OPS_name, impName, ((LONGINT)(256)));
+ __COPY(OPS_name, impName, 256);
OPS_Get(&OPP_sym);
} else {
OPP_err(38);
@@ -1876,7 +1882,7 @@ static void EnumPtrs(void (*P)(void*))
__ENUMP(OPP_FwdPtr, 64, P);
}
-__TDESC(OPP__1, 1, 0) = {__TDFLDS("", 16), {-8}};
+__TDESC(OPP__1, 1, 0) = {__TDFLDS("", 8), {-8}};
export void *OPP__init(void)
{
diff --git a/bootstrap/unix-88/OPP.h b/bootstrap/unix-88/OPP.h
index 0b3b1b2c..5a71eb39 100644
--- a/bootstrap/unix-88/OPP.h
+++ b/bootstrap/unix-88/OPP.h
@@ -1,17 +1,16 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPP__h
#define OPP__h
-#define LARGE
#include "SYSTEM.h"
#include "OPT.h"
-import void OPP_Module (OPT_Node *prog, SET opt);
+import void OPP_Module (OPT_Node *prog, UINT32 opt);
import void *OPP__init(void);
-#endif
+#endif // OPP
diff --git a/bootstrap/unix-88/OPS.c b/bootstrap/unix-88/OPS.c
index cc04e014..6ee700e5 100644
--- a/bootstrap/unix-88/OPS.c
+++ b/bootstrap/unix-88/OPS.c
@@ -1,5 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "OPM.h"
@@ -12,29 +17,29 @@ typedef
export OPS_Name OPS_name;
export OPS_String OPS_str;
-export INTEGER OPS_numtyp;
-export LONGINT OPS_intval;
+export INT16 OPS_numtyp;
+export INT64 OPS_intval;
export REAL OPS_realval;
export LONGREAL OPS_lrlval;
static CHAR OPS_ch;
-export void OPS_Get (SHORTINT *sym);
-static void OPS_Identifier (SHORTINT *sym);
+export void OPS_Get (INT8 *sym);
+static void OPS_Identifier (INT8 *sym);
export void OPS_Init (void);
static void OPS_Number (void);
-static void OPS_Str (SHORTINT *sym);
-static void OPS_err (INTEGER n);
+static void OPS_Str (INT8 *sym);
+static void OPS_err (INT16 n);
-static void OPS_err (INTEGER n)
+static void OPS_err (INT16 n)
{
OPM_err(n);
}
-static void OPS_Str (SHORTINT *sym)
+static void OPS_Str (INT8 *sym)
{
- INTEGER i;
+ INT16 i;
CHAR och;
i = 0;
och = OPS_ch;
@@ -60,15 +65,15 @@ static void OPS_Str (SHORTINT *sym)
if (OPS_intval == 2) {
*sym = 35;
OPS_numtyp = 1;
- OPS_intval = (int)OPS_str[0];
+ OPS_intval = (INT16)OPS_str[0];
} else {
*sym = 37;
}
}
-static void OPS_Identifier (SHORTINT *sym)
+static void OPS_Identifier (INT8 *sym)
{
- INTEGER i;
+ INT16 i;
i = 0;
do {
OPS_name[i] = OPS_ch;
@@ -87,12 +92,11 @@ static struct Number__6 {
struct Number__6 *lnk;
} *Number__6_s;
-static INTEGER Ord__7 (CHAR ch, BOOLEAN hex);
-static LONGREAL Ten__9 (INTEGER e);
+static INT16 Ord__7 (CHAR ch, BOOLEAN hex);
+static LONGREAL Ten__9 (INT16 e);
-static LONGREAL Ten__9 (INTEGER e)
+static LONGREAL Ten__9 (INT16 e)
{
- LONGREAL _o_result;
LONGREAL x, p;
x = (LONGREAL)1;
p = (LONGREAL)10;
@@ -105,30 +109,25 @@ static LONGREAL Ten__9 (INTEGER e)
p = p * p;
}
}
- _o_result = x;
- return _o_result;
+ return x;
}
-static INTEGER Ord__7 (CHAR ch, BOOLEAN hex)
+static INT16 Ord__7 (CHAR ch, BOOLEAN hex)
{
- INTEGER _o_result;
if (ch <= '9') {
- _o_result = (int)ch - 48;
- return _o_result;
+ return (INT16)ch - 48;
} else if (hex) {
- _o_result = ((int)ch - 65) + 10;
- return _o_result;
+ return ((INT16)ch - 65) + 10;
} else {
OPS_err(2);
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
static void OPS_Number (void)
{
- INTEGER i, m, n, d, e, maxHdig;
+ INT16 i, m, n, d, e;
CHAR dig[24];
LONGREAL f;
CHAR expCh;
@@ -174,7 +173,7 @@ static void OPS_Number (void)
OPS_numtyp = 1;
if (n <= 2) {
while (i < n) {
- OPS_intval = __ASHL(OPS_intval, 4) + (SYSTEM_INT64)Ord__7(dig[i], 1);
+ OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1);
i += 1;
}
} else {
@@ -183,13 +182,12 @@ static void OPS_Number (void)
} else if (OPS_ch == 'H') {
OPM_Get(&OPS_ch);
OPS_numtyp = 2;
- maxHdig = 16;
- if (n <= maxHdig) {
- if ((n == maxHdig && dig[0] > '7')) {
+ if (n <= 16) {
+ if ((n == 16 && dig[0] > '7')) {
OPS_intval = -1;
}
while (i < n) {
- OPS_intval = __ASHL(OPS_intval, 4) + (SYSTEM_INT64)Ord__7(dig[i], 1);
+ OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1);
i += 1;
}
} else {
@@ -200,8 +198,8 @@ static void OPS_Number (void)
while (i < n) {
d = Ord__7(dig[i], 0);
i += 1;
- if (OPS_intval <= __DIV(9223372036854775807 - (SYSTEM_INT64)d, 10)) {
- OPS_intval = OPS_intval * 10 + (SYSTEM_INT64)d;
+ if (OPS_intval <= __DIV(9223372036854775807 - (INT64)d, 10)) {
+ OPS_intval = OPS_intval * 10 + (INT64)d;
} else {
OPS_err(203);
}
@@ -232,7 +230,7 @@ static void OPS_Number (void)
do {
n = Ord__7(OPS_ch, 0);
OPM_Get(&OPS_ch);
- if (e <= __DIV(2147483647 - n, 10)) {
+ if (e <= __DIV(32767 - n, 10)) {
e = e * 10 + n;
} else {
OPS_err(203);
@@ -310,9 +308,9 @@ static void Comment__2 (void)
}
}
-void OPS_Get (SHORTINT *sym)
+void OPS_Get (INT8 *sym)
{
- SHORTINT s;
+ INT8 s;
struct Get__1 _s;
_s.lnk = Get__1_s;
Get__1_s = &_s;
@@ -320,6 +318,7 @@ void OPS_Get (SHORTINT *sym)
while (OPS_ch <= ' ') {
if (OPS_ch == 0x00) {
*sym = 64;
+ Get__1_s = _s.lnk;
return;
} else {
OPM_Get(&OPS_ch);
diff --git a/bootstrap/unix-88/OPS.h b/bootstrap/unix-88/OPS.h
index 32148c49..1f7a3e58 100644
--- a/bootstrap/unix-88/OPS.h
+++ b/bootstrap/unix-88/OPS.h
@@ -1,9 +1,8 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
#ifndef OPS__h
#define OPS__h
-#define LARGE
#include "SYSTEM.h"
typedef
@@ -15,15 +14,15 @@ typedef
import OPS_Name OPS_name;
import OPS_String OPS_str;
-import INTEGER OPS_numtyp;
-import LONGINT OPS_intval;
+import INT16 OPS_numtyp;
+import INT64 OPS_intval;
import REAL OPS_realval;
import LONGREAL OPS_lrlval;
-import void OPS_Get (SHORTINT *sym);
+import void OPS_Get (INT8 *sym);
import void OPS_Init (void);
import void *OPS__init(void);
-#endif
+#endif // OPS
diff --git a/bootstrap/unix-88/OPT.c b/bootstrap/unix-88/OPT.c
index a0d41c71..a8d42b40 100644
--- a/bootstrap/unix-88/OPT.c
+++ b/bootstrap/unix-88/OPT.c
@@ -1,5 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "OPM.h"
#include "OPS.h"
@@ -13,17 +18,18 @@ typedef
typedef
struct OPT_ConstDesc {
OPT_ConstExt ext;
- LONGINT intval, intval2;
- SET setval;
+ INT64 intval;
+ INT32 intval2;
+ UINT64 setval;
LONGREAL realval;
} OPT_ConstDesc;
typedef
struct OPT_ExpCtxt {
- LONGINT reffp;
- INTEGER ref;
- SHORTINT nofm;
- SHORTINT locmno[64];
+ INT32 reffp;
+ INT16 ref;
+ INT8 nofm;
+ INT8 locmno[64];
} OPT_ExpCtxt;
typedef
@@ -34,13 +40,13 @@ typedef
typedef
struct OPT_ImpCtxt {
- LONGINT nextTag, reffp;
- INTEGER nofr, minr, nofm;
+ INT32 nextTag, reffp;
+ INT16 nofr, minr, nofm;
BOOLEAN self;
OPT_Struct ref[255];
OPT_Object old[255];
- LONGINT pvfp[255];
- SHORTINT glbmno[64];
+ INT32 pvfp[255];
+ INT8 glbmno[64];
} OPT_ImpCtxt;
typedef
@@ -49,7 +55,7 @@ typedef
typedef
struct OPT_NodeDesc {
OPT_Node left, right, link;
- SHORTINT class, subcl;
+ INT8 class, subcl;
BOOLEAN readonly;
OPT_Struct typ;
OPT_Object obj;
@@ -61,120 +67,319 @@ typedef
OPT_Object left, right, link, scope;
OPS_Name name;
BOOLEAN leaf;
- SHORTINT mode, mnolev, vis, history;
+ INT8 mode, mnolev, vis, history;
BOOLEAN used, fpdone;
- LONGINT fprint;
+ INT32 fprint;
OPT_Struct typ;
OPT_Const conval;
- LONGINT adr, linkadr;
- INTEGER x;
+ INT32 adr, linkadr;
+ INT16 x;
} OPT_ObjDesc;
typedef
struct OPT_StrDesc {
- SHORTINT form, comp, mno, extlev;
- INTEGER ref, sysflag;
- LONGINT n, size, align, txtpos;
+ INT8 form, comp, mno, extlev;
+ INT16 ref, sysflag;
+ INT32 n, size, align, txtpos;
BOOLEAN allocated, pbused, pvused, fpdone, idfpdone;
- LONGINT idfp, pbfp, pvfp;
+ INT32 idfp, pbfp, pvfp;
OPT_Struct BaseTyp;
OPT_Object link, strobj;
} OPT_StrDesc;
-export void (*OPT_typSize)(OPT_Struct);
export OPT_Object OPT_topScope;
-export OPT_Struct OPT_undftyp, OPT_bytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_realtyp, OPT_lrltyp, OPT_settyp, OPT_stringtyp, OPT_niltyp, OPT_notyp, OPT_sysptrtyp;
-export SHORTINT OPT_nofGmod;
+export OPT_Struct OPT_undftyp, OPT_niltyp, OPT_notyp, OPT_bytetyp, OPT_cpbytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_hinttyp, OPT_int8typ, OPT_int16typ, OPT_int32typ, OPT_int64typ, OPT_settyp, OPT_set32typ, OPT_set64typ, OPT_realtyp, OPT_lrltyp, OPT_stringtyp, OPT_adrtyp, OPT_sysptrtyp;
+export OPT_Object OPT_sintobj, OPT_intobj, OPT_lintobj, OPT_setobj;
+export INT8 OPT_nofGmod;
export OPT_Object OPT_GlbMod[64];
export OPS_Name OPT_SelfName;
export BOOLEAN OPT_SYSimported;
static OPT_Object OPT_universe, OPT_syslink;
static OPT_ImpCtxt OPT_impCtxt;
static OPT_ExpCtxt OPT_expCtxt;
-static LONGINT OPT_nofhdfld;
+static INT32 OPT_nofhdfld;
static BOOLEAN OPT_newsf, OPT_findpc, OPT_extsf, OPT_sfpresent, OPT_symExtended, OPT_symNew;
+static INT32 OPT_recno;
-export LONGINT *OPT_ConstDesc__typ;
-export LONGINT *OPT_ObjDesc__typ;
-export LONGINT *OPT_StrDesc__typ;
-export LONGINT *OPT_NodeDesc__typ;
-export LONGINT *OPT_ImpCtxt__typ;
-export LONGINT *OPT_ExpCtxt__typ;
+export ADDRESS *OPT_ConstDesc__typ;
+export ADDRESS *OPT_ObjDesc__typ;
+export ADDRESS *OPT_StrDesc__typ;
+export ADDRESS *OPT_NodeDesc__typ;
+export ADDRESS *OPT_ImpCtxt__typ;
+export ADDRESS *OPT_ExpCtxt__typ;
+export void OPT_Align (INT32 *adr, INT32 base);
+export INT32 OPT_BaseAlignment (OPT_Struct typ);
export void OPT_Close (void);
export void OPT_CloseScope (void);
static void OPT_DebugStruct (OPT_Struct btyp);
-static void OPT_EnterBoolConst (OPS_Name name, LONGINT value);
-static void OPT_EnterProc (OPS_Name name, INTEGER num);
-static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct *res);
+static void OPT_EnterBoolConst (OPS_Name name, INT32 value);
+static void OPT_EnterProc (OPS_Name name, INT16 num);
+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, INTEGER errcode);
-static void OPT_FPrintName (LONGINT *fp, CHAR *name, LONGINT name__len);
+export void OPT_FPrintErr (OPT_Object obj, INT16 errcode);
+static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len);
export void OPT_FPrintObj (OPT_Object obj);
-static void OPT_FPrintSign (LONGINT *fp, OPT_Struct result, OPT_Object par);
+static void OPT_FPrintSign (INT32 *fp, OPT_Struct result, OPT_Object par);
export void OPT_FPrintStr (OPT_Struct typ);
export void OPT_Find (OPT_Object *res);
export void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res);
export void OPT_FindImport (OPT_Object mod, OPT_Object *res);
export void OPT_IdFPrint (OPT_Struct typ);
export void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done);
-static void OPT_InConstant (LONGINT f, OPT_Const conval);
+static void OPT_InConstant (INT32 f, OPT_Const conval);
static OPT_Object OPT_InFld (void);
-static void OPT_InMod (SHORTINT *mno);
+static void OPT_InMod (INT8 *mno);
static void OPT_InName (CHAR *name, LONGINT name__len);
-static OPT_Object OPT_InObj (SHORTINT mno);
-static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par);
+static 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);
-static OPT_Object OPT_InTProc (SHORTINT mno);
-export void OPT_Init (OPS_Name name, SET opt);
-static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form);
+static OPT_Object OPT_InTProc (INT8 mno);
+static OPT_Struct OPT_InTyp (INT32 tag);
+export void OPT_Init (OPS_Name name, UINT32 opt);
+export void OPT_InitRecno (void);
+static void OPT_InitStruct (OPT_Struct *typ, INT8 form);
export void OPT_Insert (OPS_Name name, OPT_Object *obj);
export void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old);
+export INT16 OPT_IntSize (INT64 n);
+export OPT_Struct OPT_IntType (INT32 size);
export OPT_Const OPT_NewConst (void);
export OPT_ConstExt OPT_NewExt (void);
-export OPT_Node OPT_NewNode (SHORTINT class);
+export OPT_Node OPT_NewNode (INT8 class);
export OPT_Object OPT_NewObj (void);
-export OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp);
-export void OPT_OpenScope (SHORTINT level, OPT_Object owner);
+export OPT_Struct OPT_NewStr (INT8 form, INT8 comp);
+export void OPT_OpenScope (INT8 level, OPT_Object owner);
static void OPT_OutConstant (OPT_Object obj);
-static void OPT_OutFlds (OPT_Object fld, LONGINT adr, BOOLEAN visible);
-static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr);
-static void OPT_OutMod (INTEGER mno);
+static void OPT_OutFlds (OPT_Object fld, INT32 adr, BOOLEAN visible);
+static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr);
+static void OPT_OutMod (INT16 mno);
static void OPT_OutName (CHAR *name, LONGINT name__len);
static void OPT_OutObj (OPT_Object obj);
static void OPT_OutSign (OPT_Struct result, OPT_Object par);
static void OPT_OutStr (OPT_Struct typ);
static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj);
-static void OPT_err (INTEGER n);
+export OPT_Struct OPT_SetType (INT32 size);
+export OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir);
+export INT32 OPT_SizeAlignment (INT32 size);
+export void OPT_TypSize (OPT_Struct typ);
+static void OPT_err (INT16 n);
-static void OPT_err (INTEGER n)
+void OPT_InitRecno (void)
+{
+ OPT_recno = 0;
+}
+
+static void OPT_err (INT16 n)
{
OPM_err(n);
}
+INT16 OPT_IntSize (INT64 n)
+{
+ INT16 bytes;
+ if (n < 0) {
+ n = -(n + 1);
+ }
+ bytes = 1;
+ while ((bytes < 8 && __ASH(n, -(__ASHL(bytes, 3) - 1)) != 0)) {
+ bytes += 1;
+ }
+ return bytes;
+}
+
+OPT_Struct OPT_IntType (INT32 size)
+{
+ if (size <= OPT_int8typ->size) {
+ return OPT_int8typ;
+ }
+ if (size <= OPT_int16typ->size) {
+ return OPT_int16typ;
+ }
+ if (size <= OPT_int32typ->size) {
+ return OPT_int32typ;
+ }
+ return OPT_int64typ;
+}
+
+OPT_Struct OPT_SetType (INT32 size)
+{
+ if (size == OPT_set32typ->size) {
+ return OPT_set32typ;
+ }
+ return OPT_set64typ;
+}
+
+OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir)
+{
+ INT16 i;
+ __ASSERT(x->form == 4, 0);
+ __ASSERT(x->BaseTyp == OPT_undftyp, 0);
+ __ASSERT(dir == 1 || dir == -1, 0);
+ if (dir > 0) {
+ if (x->size < OPT_sinttyp->size) {
+ return OPT_sinttyp;
+ }
+ if (x->size < OPT_inttyp->size) {
+ return OPT_inttyp;
+ }
+ if (x->size < OPT_linttyp->size) {
+ return OPT_linttyp;
+ }
+ return OPT_int64typ;
+ } else {
+ if (x->size > OPT_linttyp->size) {
+ return OPT_linttyp;
+ }
+ if (x->size > OPT_inttyp->size) {
+ return OPT_inttyp;
+ }
+ if (x->size > OPT_sinttyp->size) {
+ return OPT_sinttyp;
+ }
+ return OPT_int8typ;
+ }
+ __RETCHK;
+}
+
+void OPT_Align (INT32 *adr, INT32 base)
+{
+ switch (base) {
+ case 2:
+ *adr += __MASK(*adr, -2);
+ break;
+ case 4:
+ *adr += __MASK(-*adr, -4);
+ break;
+ case 8:
+ *adr += __MASK(-*adr, -8);
+ break;
+ case 16:
+ *adr += __MASK(-*adr, -16);
+ break;
+ default:
+ break;
+ }
+}
+
+INT32 OPT_SizeAlignment (INT32 size)
+{
+ INT32 alignment;
+ if (size < OPM_Alignment) {
+ alignment = 1;
+ while (alignment < size) {
+ alignment = __ASHL(alignment, 1);
+ }
+ } else {
+ alignment = OPM_Alignment;
+ }
+ return alignment;
+}
+
+INT32 OPT_BaseAlignment (OPT_Struct typ)
+{
+ INT32 alignment;
+ if (typ->form == 13) {
+ if (typ->comp == 4) {
+ alignment = __MASK(typ->align, -65536);
+ } else {
+ alignment = OPT_BaseAlignment(typ->BaseTyp);
+ }
+ } else {
+ alignment = OPT_SizeAlignment(typ->size);
+ }
+ return alignment;
+}
+
+void OPT_TypSize (OPT_Struct typ)
+{
+ INT16 f, c;
+ INT32 offset, size, base, fbase, off0;
+ OPT_Object fld = NIL;
+ OPT_Struct btyp = NIL;
+ if (typ == OPT_undftyp) {
+ OPM_err(58);
+ } else if (typ->size == -1) {
+ f = typ->form;
+ c = typ->comp;
+ if (c == 4) {
+ btyp = typ->BaseTyp;
+ if (btyp == NIL) {
+ offset = 0;
+ base = 1;
+ } else {
+ OPT_TypSize(btyp);
+ offset = btyp->size - __ASHR(btyp->sysflag, 8);
+ base = btyp->align;
+ }
+ fld = typ->link;
+ while ((fld != NIL && fld->mode == 4)) {
+ btyp = fld->typ;
+ OPT_TypSize(btyp);
+ size = btyp->size;
+ fbase = OPT_BaseAlignment(btyp);
+ OPT_Align(&offset, fbase);
+ fld->adr = offset;
+ offset += size;
+ if (fbase > base) {
+ base = fbase;
+ }
+ fld = fld->link;
+ }
+ off0 = offset;
+ if (offset == 0) {
+ offset = 1;
+ }
+ OPT_Align(&offset, base);
+ if ((typ->strobj == NIL && __MASK(typ->align, -65536) == 0)) {
+ OPT_recno += 1;
+ base += __ASHL(OPT_recno, 16);
+ }
+ typ->size = offset;
+ typ->align = base;
+ 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;
+ } else if (f == 11) {
+ typ->size = OPM_AddressSize;
+ if (typ->BaseTyp == OPT_undftyp) {
+ OPM_Mark(128, typ->n);
+ } else {
+ OPT_TypSize(typ->BaseTyp);
+ }
+ } else if (f == 12) {
+ typ->size = OPM_AddressSize;
+ } else if (c == 3) {
+ btyp = typ->BaseTyp;
+ OPT_TypSize(btyp);
+ if (btyp->comp == 3) {
+ typ->size = btyp->size + 4;
+ } else {
+ typ->size = 8;
+ }
+ }
+ }
+}
+
OPT_Const OPT_NewConst (void)
{
- OPT_Const _o_result;
OPT_Const const_ = NIL;
__NEW(const_, OPT_ConstDesc);
- _o_result = const_;
- return _o_result;
+ return const_;
}
OPT_Object OPT_NewObj (void)
{
- OPT_Object _o_result;
OPT_Object obj = NIL;
__NEW(obj, OPT_ObjDesc);
- _o_result = obj;
- return _o_result;
+ return obj;
}
-OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp)
+OPT_Struct OPT_NewStr (INT8 form, INT8 comp)
{
- OPT_Struct _o_result;
OPT_Struct typ = NIL;
__NEW(typ, OPT_StrDesc);
typ->form = form;
@@ -185,30 +390,25 @@ OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp)
}
typ->size = -1;
typ->BaseTyp = OPT_undftyp;
- _o_result = typ;
- return _o_result;
+ return typ;
}
-OPT_Node OPT_NewNode (SHORTINT class)
+OPT_Node OPT_NewNode (INT8 class)
{
- OPT_Node _o_result;
OPT_Node node = NIL;
__NEW(node, OPT_NodeDesc);
node->class = class;
- _o_result = node;
- return _o_result;
+ return node;
}
OPT_ConstExt OPT_NewExt (void)
{
- OPT_ConstExt _o_result;
OPT_ConstExt ext = NIL;
- ext = __NEWARR(NIL, ((LONGINT)(1)), 1, 1, 0, (LONGINT)256);
- _o_result = ext;
- return _o_result;
+ ext = __NEWARR(NIL, 1, 1, 1, 0, ((INT64)(256)));
+ return ext;
}
-void OPT_OpenScope (SHORTINT level, OPT_Object owner)
+void OPT_OpenScope (INT8 level, OPT_Object owner)
{
OPT_Object head = NIL;
head = OPT_NewObj();
@@ -229,34 +429,34 @@ void OPT_CloseScope (void)
OPT_topScope = OPT_topScope->left;
}
-void OPT_Init (OPS_Name name, SET opt)
+void OPT_Init (OPS_Name name, UINT32 opt)
{
OPT_topScope = OPT_universe;
OPT_OpenScope(0, NIL);
OPT_SYSimported = 0;
- __COPY(name, OPT_SelfName, ((LONGINT)(256)));
- __COPY(name, OPT_topScope->name, ((LONGINT)(256)));
+ __COPY(name, OPT_SelfName, 256);
+ __COPY(name, OPT_topScope->name, 256);
OPT_GlbMod[0] = OPT_topScope;
OPT_nofGmod = 1;
- OPT_newsf = __IN(4, opt);
- OPT_findpc = __IN(8, opt);
- OPT_extsf = OPT_newsf || __IN(9, opt);
+ OPT_newsf = __IN(4, opt, 32);
+ OPT_findpc = __IN(8, opt, 32);
+ OPT_extsf = OPT_newsf || __IN(9, opt, 32);
OPT_sfpresent = 1;
}
void OPT_Close (void)
{
- INTEGER i;
+ INT16 i;
OPT_CloseScope();
i = 0;
while (i < 64) {
- OPT_GlbMod[__X(i, ((LONGINT)(64)))] = NIL;
+ OPT_GlbMod[__X(i, 64)] = NIL;
i += 1;
}
- i = 16;
+ i = 14;
while (i < 255) {
- OPT_impCtxt.ref[__X(i, ((LONGINT)(255)))] = NIL;
- OPT_impCtxt.old[__X(i, ((LONGINT)(255)))] = NIL;
+ OPT_impCtxt.ref[__X(i, 255)] = NIL;
+ OPT_impCtxt.old[__X(i, 255)] = NIL;
i += 1;
}
}
@@ -338,7 +538,7 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
{
OPT_Object ob0 = NIL, ob1 = NIL;
BOOLEAN left;
- SHORTINT mnolev;
+ INT8 mnolev;
ob0 = OPT_topScope;
ob1 = ob0->right;
left = 0;
@@ -367,7 +567,7 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
}
ob1->left = NIL;
ob1->right = NIL;
- __COPY(name, ob1->name, ((LONGINT)(256)));
+ __COPY(name, ob1->name, 256);
mnolev = OPT_topScope->mnolev;
ob1->mnolev = mnolev;
break;
@@ -376,14 +576,14 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
*obj = ob1;
}
-static void OPT_FPrintName (LONGINT *fp, CHAR *name, LONGINT name__len)
+static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len)
{
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
do {
ch = name[__X(i, name__len)];
- OPM_FPrint(&*fp, (int)ch);
+ OPM_FPrint(&*fp, (INT16)ch);
i += 1;
} while (!(ch == 0x00));
}
@@ -392,36 +592,36 @@ static void OPT_DebugStruct (OPT_Struct btyp)
{
OPM_LogWLn();
if (btyp == NIL) {
- OPM_LogWStr((CHAR*)"btyp is nil", (LONGINT)12);
+ OPM_LogWStr((CHAR*)"btyp is nil", 12);
OPM_LogWLn();
}
- OPM_LogWStr((CHAR*)"btyp^.strobji^.name = ", (LONGINT)23);
- OPM_LogWStr(btyp->strobj->name, ((LONGINT)(256)));
+ OPM_LogWStr((CHAR*)"btyp^.strobji^.name = ", 23);
+ OPM_LogWStr(btyp->strobj->name, 256);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.form = ", (LONGINT)14);
- OPM_LogWNum(btyp->form, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.form = ", 14);
+ OPM_LogWNum(btyp->form, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.comp = ", (LONGINT)14);
- OPM_LogWNum(btyp->comp, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.comp = ", 14);
+ OPM_LogWNum(btyp->comp, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.mno = ", (LONGINT)13);
- OPM_LogWNum(btyp->mno, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.mno = ", 13);
+ OPM_LogWNum(btyp->mno, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.extlev = ", (LONGINT)16);
- OPM_LogWNum(btyp->extlev, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.extlev = ", 16);
+ OPM_LogWNum(btyp->extlev, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.size = ", (LONGINT)14);
- OPM_LogWNum(btyp->size, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.size = ", 14);
+ OPM_LogWNum(btyp->size, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.align = ", (LONGINT)15);
- OPM_LogWNum(btyp->align, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.align = ", 15);
+ OPM_LogWNum(btyp->align, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.txtpos = ", (LONGINT)16);
- OPM_LogWNum(btyp->txtpos, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.txtpos = ", 16);
+ OPM_LogWNum(btyp->txtpos, 0);
OPM_LogWLn();
}
-static void OPT_FPrintSign (LONGINT *fp, OPT_Struct result, OPT_Object par)
+static void OPT_FPrintSign (INT32 *fp, OPT_Struct result, OPT_Object par)
{
OPT_IdFPrint(result);
OPM_FPrint(&*fp, result->idfp);
@@ -437,50 +637,53 @@ void OPT_IdFPrint (OPT_Struct typ)
{
OPT_Struct btyp = NIL;
OPT_Object strobj = NIL;
- LONGINT idfp;
- INTEGER f, c;
+ INT32 idfp;
+ INT16 f, c;
if (!typ->idfpdone) {
typ->idfpdone = 1;
idfp = 0;
f = typ->form;
- c = typ->comp;
OPM_FPrint(&idfp, f);
+ if (__IN(f, 0x90, 32)) {
+ OPM_FPrint(&idfp, typ->size);
+ }
+ c = typ->comp;
OPM_FPrint(&idfp, c);
btyp = typ->BaseTyp;
strobj = typ->strobj;
if ((strobj != NIL && strobj->name[0] != 0x00)) {
- OPT_FPrintName(&idfp, (void*)OPT_GlbMod[__X(typ->mno, ((LONGINT)(64)))]->name, ((LONGINT)(256)));
- OPT_FPrintName(&idfp, (void*)strobj->name, ((LONGINT)(256)));
+ OPT_FPrintName(&idfp, (void*)OPT_GlbMod[__X(typ->mno, 64)]->name, 256);
+ OPT_FPrintName(&idfp, (void*)strobj->name, 256);
}
- if ((f == 13 || (c == 4 && btyp != NIL)) || c == 3) {
+ if ((f == 11 || (c == 4 && btyp != NIL)) || c == 3) {
OPT_IdFPrint(btyp);
OPM_FPrint(&idfp, btyp->idfp);
} else if (c == 2) {
OPT_IdFPrint(btyp);
OPM_FPrint(&idfp, btyp->idfp);
OPM_FPrint(&idfp, typ->n);
- } else if (f == 14) {
+ } else if (f == 12) {
OPT_FPrintSign(&idfp, btyp, typ->link);
}
typ->idfp = idfp;
}
}
-static struct FPrintStr__12 {
- LONGINT *pbfp, *pvfp;
- struct FPrintStr__12 *lnk;
-} *FPrintStr__12_s;
+static struct FPrintStr__15 {
+ INT32 *pbfp, *pvfp;
+ struct FPrintStr__15 *lnk;
+} *FPrintStr__15_s;
-static void FPrintFlds__13 (OPT_Object fld, LONGINT adr, BOOLEAN visible);
-static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr);
-static void FPrintTProcs__17 (OPT_Object obj);
+static void FPrintFlds__16 (OPT_Object fld, INT32 adr, BOOLEAN visible);
+static void FPrintHdFld__18 (OPT_Struct typ, OPT_Object fld, INT32 adr);
+static void FPrintTProcs__20 (OPT_Object obj);
-static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr)
+static void FPrintHdFld__18 (OPT_Struct typ, OPT_Object fld, INT32 adr)
{
- LONGINT i, j, n;
+ INT32 i, j, n;
OPT_Struct btyp = NIL;
if (typ->comp == 4) {
- FPrintFlds__13(typ->link, adr, 0);
+ FPrintFlds__16(typ->link, adr, 0);
} else if (typ->comp == 2) {
btyp = typ->BaseTyp;
n = typ->n;
@@ -488,69 +691,69 @@ static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr)
n = btyp->n * n;
btyp = btyp->BaseTyp;
}
- if (btyp->form == 13 || btyp->comp == 4) {
+ if (btyp->form == 11 || btyp->comp == 4) {
j = OPT_nofhdfld;
- FPrintHdFld__15(btyp, fld, adr);
+ FPrintHdFld__18(btyp, fld, adr);
if (j != OPT_nofhdfld) {
i = 1;
while ((i < n && OPT_nofhdfld <= 2048)) {
adr += btyp->size;
- FPrintHdFld__15(btyp, fld, adr);
+ FPrintHdFld__18(btyp, fld, adr);
i += 1;
}
}
}
- } else if (typ->form == 13 || __STRCMP(fld->name, "@ptr") == 0) {
- OPM_FPrint(&*FPrintStr__12_s->pvfp, ((LONGINT)(13)));
- OPM_FPrint(&*FPrintStr__12_s->pvfp, adr);
+ } else if (typ->form == 11 || __STRCMP(fld->name, "@ptr") == 0) {
+ OPM_FPrint(&*FPrintStr__15_s->pvfp, 11);
+ OPM_FPrint(&*FPrintStr__15_s->pvfp, adr);
OPT_nofhdfld += 1;
}
}
-static void FPrintFlds__13 (OPT_Object fld, LONGINT adr, BOOLEAN visible)
+static void FPrintFlds__16 (OPT_Object fld, INT32 adr, BOOLEAN visible)
{
while ((fld != NIL && fld->mode == 4)) {
if ((fld->vis != 0 && visible)) {
- OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->vis);
- OPT_FPrintName(&*FPrintStr__12_s->pbfp, (void*)fld->name, ((LONGINT)(256)));
- OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->adr);
+ OPM_FPrint(&*FPrintStr__15_s->pbfp, fld->vis);
+ OPT_FPrintName(&*FPrintStr__15_s->pbfp, (void*)fld->name, 256);
+ OPM_FPrint(&*FPrintStr__15_s->pbfp, fld->adr);
OPT_FPrintStr(fld->typ);
- OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->typ->pbfp);
- OPM_FPrint(&*FPrintStr__12_s->pvfp, fld->typ->pvfp);
+ OPM_FPrint(&*FPrintStr__15_s->pbfp, fld->typ->pbfp);
+ OPM_FPrint(&*FPrintStr__15_s->pvfp, fld->typ->pvfp);
} else {
- FPrintHdFld__15(fld->typ, fld, fld->adr + adr);
+ FPrintHdFld__18(fld->typ, fld, fld->adr + adr);
}
fld = fld->link;
}
}
-static void FPrintTProcs__17 (OPT_Object obj)
+static void FPrintTProcs__20 (OPT_Object obj)
{
if (obj != NIL) {
- FPrintTProcs__17(obj->left);
+ FPrintTProcs__20(obj->left);
if (obj->mode == 13) {
if (obj->vis != 0) {
- OPM_FPrint(&*FPrintStr__12_s->pbfp, ((LONGINT)(13)));
- OPM_FPrint(&*FPrintStr__12_s->pbfp, __ASHR(obj->adr, 16));
- OPT_FPrintSign(&*FPrintStr__12_s->pbfp, obj->typ, obj->link);
- OPT_FPrintName(&*FPrintStr__12_s->pbfp, (void*)obj->name, ((LONGINT)(256)));
+ OPM_FPrint(&*FPrintStr__15_s->pbfp, 13);
+ OPM_FPrint(&*FPrintStr__15_s->pbfp, __ASHR(obj->adr, 16));
+ OPT_FPrintSign(&*FPrintStr__15_s->pbfp, obj->typ, obj->link);
+ OPT_FPrintName(&*FPrintStr__15_s->pbfp, (void*)obj->name, 256);
}
}
- FPrintTProcs__17(obj->right);
+ FPrintTProcs__20(obj->right);
}
}
void OPT_FPrintStr (OPT_Struct typ)
{
- INTEGER f, c;
+ INT16 f, c;
OPT_Struct btyp = NIL;
OPT_Object strobj = NIL, bstrobj = NIL;
- LONGINT pbfp, pvfp;
- struct FPrintStr__12 _s;
+ INT32 pbfp, pvfp;
+ struct FPrintStr__15 _s;
_s.pbfp = &pbfp;
_s.pvfp = &pvfp;
- _s.lnk = FPrintStr__12_s;
- FPrintStr__12_s = &_s;
+ _s.lnk = FPrintStr__15_s;
+ FPrintStr__15_s = &_s;
if (!typ->fpdone) {
OPT_IdFPrint(typ);
pbfp = typ->idfp;
@@ -564,7 +767,7 @@ void OPT_FPrintStr (OPT_Struct typ)
f = typ->form;
c = typ->comp;
btyp = typ->BaseTyp;
- if (f == 13) {
+ if (f == 11) {
strobj = typ->strobj;
bstrobj = btyp->strobj;
if (((strobj == NIL || strobj->name[0] == 0x00) || bstrobj == NIL) || bstrobj->name[0] == 0x00) {
@@ -572,8 +775,8 @@ void OPT_FPrintStr (OPT_Struct typ)
OPM_FPrint(&pbfp, btyp->pbfp);
pvfp = pbfp;
}
- } else if (f == 14) {
- } else if (__IN(c, 0x0c)) {
+ } else if (f == 12) {
+ } else if (__IN(c, 0x0c, 32)) {
OPT_FPrintStr(btyp);
OPM_FPrint(&pbfp, btyp->pvfp);
pvfp = pbfp;
@@ -587,11 +790,11 @@ void OPT_FPrintStr (OPT_Struct typ)
OPM_FPrint(&pvfp, typ->align);
OPM_FPrint(&pvfp, typ->n);
OPT_nofhdfld = 0;
- FPrintFlds__13(typ->link, ((LONGINT)(0)), 1);
+ FPrintFlds__16(typ->link, 0, 1);
if (OPT_nofhdfld > 2048) {
OPM_Mark(225, typ->txtpos);
}
- FPrintTProcs__17(typ->link);
+ FPrintTProcs__20(typ->link);
OPM_FPrint(&pvfp, pbfp);
strobj = typ->strobj;
if (strobj == NIL || strobj->name[0] == 0x00) {
@@ -601,13 +804,13 @@ void OPT_FPrintStr (OPT_Struct typ)
typ->pbfp = pbfp;
typ->pvfp = pvfp;
}
- FPrintStr__12_s = _s.lnk;
+ FPrintStr__15_s = _s.lnk;
}
void OPT_FPrintObj (OPT_Object obj)
{
- LONGINT fprint;
- INTEGER f, m;
+ INT32 fprint;
+ INT16 f, m;
REAL rval;
OPT_ConstExt ext = NIL;
if (!obj->fpdone) {
@@ -618,23 +821,23 @@ void OPT_FPrintObj (OPT_Object obj)
f = obj->typ->form;
OPM_FPrint(&fprint, f);
switch (f) {
- case 2: case 3: case 4: case 5: case 6:
+ case 2: case 3: case 4:
OPM_FPrint(&fprint, obj->conval->intval);
break;
- case 9:
+ case 7:
OPM_FPrintSet(&fprint, obj->conval->setval);
break;
- case 7:
+ case 5:
rval = obj->conval->realval;
OPM_FPrintReal(&fprint, rval);
break;
- case 8:
+ case 6:
OPM_FPrintLReal(&fprint, obj->conval->realval);
break;
- case 10:
- OPT_FPrintName(&fprint, (void*)*obj->conval->ext, ((LONGINT)(256)));
+ case 8:
+ OPT_FPrintName(&fprint, (void*)*obj->conval->ext, 256);
break;
- case 11:
+ case 9:
break;
default:
OPT_err(127);
@@ -644,16 +847,16 @@ void OPT_FPrintObj (OPT_Object obj)
OPM_FPrint(&fprint, obj->vis);
OPT_FPrintStr(obj->typ);
OPM_FPrint(&fprint, obj->typ->pbfp);
- } else if (__IN(obj->mode, 0x0480)) {
+ } else if (__IN(obj->mode, 0x0480, 32)) {
OPT_FPrintSign(&fprint, obj->typ, obj->link);
} else if (obj->mode == 9) {
OPT_FPrintSign(&fprint, obj->typ, obj->link);
ext = obj->conval->ext;
- m = (int)(*ext)[0];
+ m = (INT16)(*ext)[0];
f = 1;
OPM_FPrint(&fprint, m);
while (f <= m) {
- OPM_FPrint(&fprint, (int)(*ext)[__X(f, ((LONGINT)(256)))]);
+ OPM_FPrint(&fprint, (INT16)(*ext)[__X(f, 256)]);
f += 1;
}
} else if (obj->mode == 5) {
@@ -664,27 +867,27 @@ void OPT_FPrintObj (OPT_Object obj)
}
}
-void OPT_FPrintErr (OPT_Object obj, INTEGER errcode)
+void OPT_FPrintErr (OPT_Object obj, INT16 errcode)
{
- INTEGER i, j;
+ INT16 i, j;
CHAR ch;
if (obj->mnolev != 0) {
- __COPY(OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, OPM_objname, ((LONGINT)(64)));
+ __COPY(OPT_GlbMod[__X(-obj->mnolev, 64)]->name, OPM_objname, 64);
i = 0;
- while (OPM_objname[__X(i, ((LONGINT)(64)))] != 0x00) {
+ while (OPM_objname[__X(i, 64)] != 0x00) {
i += 1;
}
- OPM_objname[__X(i, ((LONGINT)(64)))] = '.';
+ OPM_objname[__X(i, 64)] = '.';
j = 0;
i += 1;
do {
- ch = obj->name[__X(j, ((LONGINT)(256)))];
- OPM_objname[__X(i, ((LONGINT)(64)))] = ch;
+ ch = obj->name[__X(j, 256)];
+ OPM_objname[__X(i, 64)] = ch;
j += 1;
i += 1;
} while (!(ch == 0x00));
} else {
- __COPY(obj->name, OPM_objname, ((LONGINT)(64)));
+ __COPY(obj->name, OPM_objname, 64);
}
if (errcode == 249) {
if (OPM_noerr) {
@@ -756,7 +959,7 @@ void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old)
static void OPT_InName (CHAR *name, LONGINT name__len)
{
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
do {
@@ -766,23 +969,23 @@ static void OPT_InName (CHAR *name, LONGINT name__len)
} while (!(ch == 0x00));
}
-static void OPT_InMod (SHORTINT *mno)
+static void OPT_InMod (INT8 *mno)
{
OPT_Object head = NIL;
OPS_Name name;
- LONGINT mn;
- SHORTINT i;
+ INT32 mn;
+ INT8 i;
mn = OPM_SymRInt();
if (mn == 0) {
*mno = OPT_impCtxt.glbmno[0];
} else {
if (mn == 16) {
- OPT_InName((void*)name, ((LONGINT)(256)));
+ OPT_InName((void*)name, 256);
if ((__STRCMP(name, OPT_SelfName) == 0 && !OPT_impCtxt.self)) {
OPT_err(154);
}
i = 0;
- while ((i < OPT_nofGmod && __STRCMP(name, OPT_GlbMod[__X(i, ((LONGINT)(64)))]->name) != 0)) {
+ while ((i < OPT_nofGmod && __STRCMP(name, OPT_GlbMod[__X(i, 64)]->name) != 0)) {
i += 1;
}
if (i < OPT_nofGmod) {
@@ -790,77 +993,77 @@ static void OPT_InMod (SHORTINT *mno)
} else {
head = OPT_NewObj();
head->mode = 12;
- __COPY(name, head->name, ((LONGINT)(256)));
+ __COPY(name, head->name, 256);
*mno = OPT_nofGmod;
head->mnolev = -*mno;
if (OPT_nofGmod < 64) {
- OPT_GlbMod[__X(*mno, ((LONGINT)(64)))] = head;
+ OPT_GlbMod[__X(*mno, 64)] = head;
OPT_nofGmod += 1;
} else {
OPT_err(227);
}
}
- OPT_impCtxt.glbmno[__X(OPT_impCtxt.nofm, ((LONGINT)(64)))] = *mno;
+ OPT_impCtxt.glbmno[__X(OPT_impCtxt.nofm, 64)] = *mno;
OPT_impCtxt.nofm += 1;
} else {
- *mno = OPT_impCtxt.glbmno[__X(-mn, ((LONGINT)(64)))];
+ *mno = OPT_impCtxt.glbmno[__X(-mn, 64)];
}
}
}
-static void OPT_InConstant (LONGINT f, OPT_Const conval)
+static void OPT_InConstant (INT32 f, OPT_Const conval)
{
CHAR ch;
- INTEGER i;
+ INT16 i;
OPT_ConstExt ext = NIL;
REAL rval;
switch (f) {
case 1: case 3: case 2:
OPM_SymRCh(&ch);
- conval->intval = (int)ch;
+ conval->intval = (INT16)ch;
break;
- case 4: case 5: case 6:
+ case 4:
conval->intval = OPM_SymRInt();
break;
- case 9:
+ case 7:
OPM_SymRSet(&conval->setval);
break;
- case 7:
+ case 5:
OPM_SymRReal(&rval);
conval->realval = rval;
conval->intval = -1;
break;
- case 8:
+ case 6:
OPM_SymRLReal(&conval->realval);
conval->intval = -1;
break;
- case 10:
+ case 8:
ext = OPT_NewExt();
conval->ext = ext;
i = 0;
do {
OPM_SymRCh(&ch);
- (*ext)[__X(i, ((LONGINT)(256)))] = ch;
+ (*ext)[__X(i, 256)] = ch;
i += 1;
} while (!(ch == 0x00));
conval->intval2 = i;
conval->intval = -1;
break;
- case 11:
+ case 9:
conval->intval = 0;
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in InConstant(), f = ", (LONGINT)37);
- OPM_LogWNum(f, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in InConstant(), f = ", 37);
+ OPM_LogWNum(f, 0);
OPM_LogWLn();
break;
}
}
-static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par)
+static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par)
{
OPT_Object last = NIL, new = NIL;
- LONGINT tag;
+ INT32 tag;
OPT_InStruct(&*res);
tag = OPM_SymRInt();
last = NIL;
@@ -879,7 +1082,7 @@ static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par)
}
OPT_InStruct(&new->typ);
new->adr = OPM_SymRInt();
- OPT_InName((void*)new->name, ((LONGINT)(256)));
+ OPT_InName((void*)new->name, 256);
last = new;
tag = OPM_SymRInt();
}
@@ -887,8 +1090,7 @@ static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par)
static OPT_Object OPT_InFld (void)
{
- OPT_Object _o_result;
- LONGINT tag;
+ INT32 tag;
OPT_Object obj = NIL;
tag = OPT_impCtxt.nextTag;
obj = OPT_NewObj();
@@ -900,7 +1102,7 @@ static OPT_Object OPT_InFld (void)
obj->vis = 1;
}
OPT_InStruct(&obj->typ);
- OPT_InName((void*)obj->name, ((LONGINT)(256)));
+ OPT_InName((void*)obj->name, 256);
obj->adr = OPM_SymRInt();
} else {
obj->mode = 4;
@@ -913,14 +1115,12 @@ static OPT_Object OPT_InFld (void)
obj->vis = 0;
obj->adr = OPM_SymRInt();
}
- _o_result = obj;
- return _o_result;
+ return obj;
}
-static OPT_Object OPT_InTProc (SHORTINT mno)
+static OPT_Object OPT_InTProc (INT8 mno)
{
- OPT_Object _o_result;
- LONGINT tag;
+ INT32 tag;
OPT_Object obj = NIL;
tag = OPT_impCtxt.nextTag;
obj = OPT_NewObj();
@@ -931,7 +1131,7 @@ static OPT_Object OPT_InTProc (SHORTINT mno)
obj->conval->intval = -1;
OPT_InSign(mno, &obj->typ, &obj->link);
obj->vis = 1;
- OPT_InName((void*)obj->name, ((LONGINT)(256)));
+ OPT_InName((void*)obj->name, 256);
obj->adr = __ASHL(OPM_SymRInt(), 16);
} else {
obj->mode = 13;
@@ -941,21 +1141,32 @@ static OPT_Object OPT_InTProc (SHORTINT mno)
obj->vis = 0;
obj->adr = __ASHL(OPM_SymRInt(), 16);
}
- _o_result = obj;
- return _o_result;
+ return obj;
+}
+
+static OPT_Struct OPT_InTyp (INT32 tag)
+{
+ if (tag == 4) {
+ return OPT_IntType(OPM_SymRInt());
+ } else if (tag == 7) {
+ return OPT_SetType(OPM_SymRInt());
+ } else {
+ return OPT_impCtxt.ref[__X(tag, 255)];
+ }
+ __RETCHK;
}
static void OPT_InStruct (OPT_Struct *typ)
{
- SHORTINT mno;
- INTEGER ref;
- LONGINT tag;
+ INT8 mno;
+ INT16 ref;
+ INT32 tag;
OPS_Name name;
OPT_Struct t = NIL;
OPT_Object obj = NIL, last = NIL, fld = NIL, old = NIL, dummy = NIL;
tag = OPM_SymRInt();
if (tag != 34) {
- *typ = OPT_impCtxt.ref[__X(-tag, ((LONGINT)(255)))];
+ *typ = OPT_InTyp(-tag);
} else {
ref = OPT_impCtxt.nofr;
OPT_impCtxt.nofr += 1;
@@ -963,23 +1174,23 @@ static void OPT_InStruct (OPT_Struct *typ)
OPT_impCtxt.minr = ref;
}
OPT_InMod(&mno);
- OPT_InName((void*)name, ((LONGINT)(256)));
+ OPT_InName((void*)name, 256);
obj = OPT_NewObj();
if (name[0] == 0x00) {
if (OPT_impCtxt.self) {
old = NIL;
} else {
__MOVE("@", obj->name, 2);
- OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old);
+ OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
obj->name[0] = 0x00;
}
*typ = OPT_NewStr(0, 1);
} else {
- __COPY(name, obj->name, ((LONGINT)(256)));
- OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old);
+ __COPY(name, obj->name, 256);
+ OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
if (old != NIL) {
OPT_FPrintObj(old);
- OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] = old->typ->pvfp;
+ OPT_impCtxt.pvfp[__X(ref, 255)] = old->typ->pvfp;
if (OPT_impCtxt.self) {
*typ = OPT_NewStr(0, 1);
} else {
@@ -993,8 +1204,8 @@ static void OPT_InStruct (OPT_Struct *typ)
*typ = OPT_NewStr(0, 1);
}
}
- OPT_impCtxt.ref[__X(ref, ((LONGINT)(255)))] = *typ;
- OPT_impCtxt.old[__X(ref, ((LONGINT)(255)))] = old;
+ OPT_impCtxt.ref[__X(ref, 255)] = *typ;
+ OPT_impCtxt.old[__X(ref, 255)] = old;
(*typ)->ref = ref + 255;
(*typ)->mno = mno;
(*typ)->allocated = 1;
@@ -1005,25 +1216,25 @@ static void OPT_InStruct (OPT_Struct *typ)
obj->vis = 0;
tag = OPM_SymRInt();
if (tag == 35) {
- (*typ)->sysflag = (int)OPM_SymRInt();
+ (*typ)->sysflag = (INT16)OPM_SymRInt();
tag = OPM_SymRInt();
}
switch (tag) {
case 36:
- (*typ)->form = 13;
- (*typ)->size = OPM_PointerSize;
+ (*typ)->form = 11;
+ (*typ)->size = OPM_AddressSize;
(*typ)->n = 0;
OPT_InStruct(&(*typ)->BaseTyp);
break;
case 37:
- (*typ)->form = 15;
+ (*typ)->form = 13;
(*typ)->comp = 2;
OPT_InStruct(&(*typ)->BaseTyp);
(*typ)->n = OPM_SymRInt();
- (*OPT_typSize)(*typ);
+ OPT_TypSize(*typ);
break;
case 38:
- (*typ)->form = 15;
+ (*typ)->form = 13;
(*typ)->comp = 3;
OPT_InStruct(&(*typ)->BaseTyp);
if ((*typ)->BaseTyp->comp == 3) {
@@ -1031,10 +1242,10 @@ static void OPT_InStruct (OPT_Struct *typ)
} else {
(*typ)->n = 0;
}
- (*OPT_typSize)(*typ);
+ OPT_TypSize(*typ);
break;
case 39:
- (*typ)->form = 15;
+ (*typ)->form = 13;
(*typ)->comp = 4;
OPT_InStruct(&(*typ)->BaseTyp);
if ((*typ)->BaseTyp == OPT_notyp) {
@@ -1068,25 +1279,25 @@ static void OPT_InStruct (OPT_Struct *typ)
}
break;
case 40:
- (*typ)->form = 14;
- (*typ)->size = OPM_ProcSize;
+ (*typ)->form = 12;
+ (*typ)->size = OPM_AddressSize;
OPT_InSign(mno, &(*typ)->BaseTyp, &(*typ)->link);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at InStruct, tag = ", (LONGINT)35);
- OPM_LogWNum(tag, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at InStruct, tag = ", 35);
+ OPM_LogWNum(tag, 0);
OPM_LogWLn();
break;
}
if (ref == OPT_impCtxt.minr) {
while (ref < OPT_impCtxt.nofr) {
- t = OPT_impCtxt.ref[__X(ref, ((LONGINT)(255)))];
+ t = OPT_InTyp(ref);
OPT_FPrintStr(t);
obj = t->strobj;
if (obj->name[0] != 0x00) {
OPT_FPrintObj(obj);
}
- old = OPT_impCtxt.old[__X(ref, ((LONGINT)(255)))];
+ old = OPT_impCtxt.old[__X(ref, 255)];
if (old != NIL) {
t->strobj = old;
if (OPT_impCtxt.self) {
@@ -1094,13 +1305,13 @@ static void OPT_InStruct (OPT_Struct *typ)
if (old->history != 5) {
if (old->fprint != obj->fprint) {
old->history = 2;
- } else if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) {
+ } else if (OPT_impCtxt.pvfp[__X(ref, 255)] != t->pvfp) {
old->history = 3;
}
}
} else if (old->fprint != obj->fprint) {
old->history = 2;
- } else if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) {
+ } else if (OPT_impCtxt.pvfp[__X(ref, 255)] != t->pvfp) {
old->history = 3;
} else if (old->vis == 0) {
old->history = 1;
@@ -1108,7 +1319,7 @@ static void OPT_InStruct (OPT_Struct *typ)
old->history = 0;
}
} else {
- if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) {
+ if (OPT_impCtxt.pvfp[__X(ref, 255)] != t->pvfp) {
old->history = 5;
}
if (old->fprint != obj->fprint) {
@@ -1127,14 +1338,13 @@ static void OPT_InStruct (OPT_Struct *typ)
}
}
-static OPT_Object OPT_InObj (SHORTINT mno)
+static OPT_Object OPT_InObj (INT8 mno)
{
- OPT_Object _o_result;
- INTEGER i, s;
+ INT16 i, s;
CHAR ch;
OPT_Object obj = NIL, old = NIL;
OPT_Struct typ = NIL;
- LONGINT tag;
+ INT32 tag;
OPT_ConstExt ext = NIL;
tag = OPT_impCtxt.nextTag;
if (tag == 19) {
@@ -1147,11 +1357,11 @@ static OPT_Object OPT_InObj (SHORTINT mno)
obj = OPT_NewObj();
obj->mnolev = -mno;
obj->vis = 1;
- if (tag <= 13) {
+ if (tag <= 11) {
obj->mode = 3;
- obj->typ = OPT_impCtxt.ref[__X(tag, ((LONGINT)(255)))];
obj->conval = OPT_NewConst();
OPT_InConstant(tag, obj->conval);
+ obj->typ = OPT_InTyp(tag);
} else if (tag >= 31) {
obj->conval = OPT_NewConst();
obj->conval->intval = -1;
@@ -1167,17 +1377,17 @@ static OPT_Object OPT_InObj (SHORTINT mno)
obj->mode = 9;
ext = OPT_NewExt();
obj->conval->ext = ext;
- s = (int)OPM_SymRInt();
+ s = (INT16)OPM_SymRInt();
(*ext)[0] = (CHAR)s;
i = 1;
while (i <= s) {
- OPM_SymRCh(&(*ext)[__X(i, ((LONGINT)(256)))]);
+ OPM_SymRCh(&(*ext)[__X(i, 256)]);
i += 1;
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", (LONGINT)32);
- OPM_LogWNum(tag, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", 32);
+ OPM_LogWNum(tag, 0);
OPM_LogWLn();
break;
}
@@ -1191,14 +1401,14 @@ static OPT_Object OPT_InObj (SHORTINT mno)
}
OPT_InStruct(&obj->typ);
}
- OPT_InName((void*)obj->name, ((LONGINT)(256)));
+ OPT_InName((void*)obj->name, 256);
}
OPT_FPrintObj(obj);
if ((obj->mode == 1 && (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00))) {
OPM_FPrint(&OPT_impCtxt.reffp, obj->typ->ref - 255);
}
if (tag != 19) {
- OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old);
+ OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
if (OPT_impCtxt.self) {
if (old != NIL) {
if (old->vis == 0) {
@@ -1226,14 +1436,13 @@ static OPT_Object OPT_InObj (SHORTINT mno)
}
}
}
- _o_result = obj;
- return _o_result;
+ return obj;
}
void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
{
OPT_Object obj = NIL;
- SHORTINT mno;
+ INT8 mno;
OPS_Name aliasName__copy;
__DUPARR(aliasName, OPS_Name);
if (__STRCMP(name, "SYSTEM") == 0) {
@@ -1244,12 +1453,12 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
obj->scope = OPT_syslink;
obj->typ = OPT_notyp;
} else {
- OPT_impCtxt.nofr = 16;
+ OPT_impCtxt.nofr = 14;
OPT_impCtxt.minr = 255;
OPT_impCtxt.nofm = 0;
OPT_impCtxt.self = __STRCMP(aliasName, "@self") == 0;
OPT_impCtxt.reffp = 0;
- OPM_OldSym((void*)name, ((LONGINT)(256)), &*done);
+ OPM_OldSym((void*)name, 256, &*done);
if (*done) {
OPT_InMod(&mno);
OPT_impCtxt.nextTag = OPM_SymRInt();
@@ -1259,8 +1468,8 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
}
OPT_Insert(aliasName, &obj);
obj->mode = 11;
- obj->scope = OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right;
- OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->link = obj;
+ obj->scope = OPT_GlbMod[__X(mno, 64)]->right;
+ OPT_GlbMod[__X(mno, 64)]->link = obj;
obj->mnolev = -mno;
obj->typ = OPT_notyp;
OPM_CloseOldSym();
@@ -1276,7 +1485,7 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
static void OPT_OutName (CHAR *name, LONGINT name__len)
{
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
do {
@@ -1286,21 +1495,21 @@ static void OPT_OutName (CHAR *name, LONGINT name__len)
} while (!(ch == 0x00));
}
-static void OPT_OutMod (INTEGER mno)
+static void OPT_OutMod (INT16 mno)
{
- if (OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))] < 0) {
- OPM_SymWInt(((LONGINT)(16)));
- OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))] = OPT_expCtxt.nofm;
+ if (OPT_expCtxt.locmno[__X(mno, 64)] < 0) {
+ OPM_SymWInt(16);
+ OPT_expCtxt.locmno[__X(mno, 64)] = OPT_expCtxt.nofm;
OPT_expCtxt.nofm += 1;
- OPT_OutName((void*)OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->name, ((LONGINT)(256)));
+ OPT_OutName((void*)OPT_GlbMod[__X(mno, 64)]->name, 256);
} else {
- OPM_SymWInt(-OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))]);
+ OPM_SymWInt(-OPT_expCtxt.locmno[__X(mno, 64)]);
}
}
-static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr)
+static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr)
{
- LONGINT i, j, n;
+ INT32 i, j, n;
OPT_Struct btyp = NIL;
if (typ->comp == 4) {
OPT_OutFlds(typ->link, adr, 0);
@@ -1311,7 +1520,7 @@ static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr)
n = btyp->n * n;
btyp = btyp->BaseTyp;
}
- if (btyp->form == 13 || btyp->comp == 4) {
+ if (btyp->form == 11 || btyp->comp == 4) {
j = OPT_nofhdfld;
OPT_OutHdFld(btyp, fld, adr);
if (j != OPT_nofhdfld) {
@@ -1323,24 +1532,24 @@ static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr)
}
}
}
- } else if (typ->form == 13 || __STRCMP(fld->name, "@ptr") == 0) {
- OPM_SymWInt(((LONGINT)(27)));
+ } else if (typ->form == 11 || __STRCMP(fld->name, "@ptr") == 0) {
+ OPM_SymWInt(27);
OPM_SymWInt(adr);
OPT_nofhdfld += 1;
}
}
-static void OPT_OutFlds (OPT_Object fld, LONGINT adr, BOOLEAN visible)
+static void OPT_OutFlds (OPT_Object fld, INT32 adr, BOOLEAN visible)
{
while ((fld != NIL && fld->mode == 4)) {
if ((fld->vis != 0 && visible)) {
if (fld->vis == 2) {
- OPM_SymWInt(((LONGINT)(26)));
+ OPM_SymWInt(26);
} else {
- OPM_SymWInt(((LONGINT)(25)));
+ OPM_SymWInt(25);
}
OPT_OutStr(fld->typ);
- OPT_OutName((void*)fld->name, ((LONGINT)(256)));
+ OPT_OutName((void*)fld->name, 256);
OPM_SymWInt(fld->adr);
} else {
OPT_OutHdFld(fld->typ, fld, fld->adr + adr);
@@ -1354,16 +1563,16 @@ static void OPT_OutSign (OPT_Struct result, OPT_Object par)
OPT_OutStr(result);
while (par != NIL) {
if (par->mode == 1) {
- OPM_SymWInt(((LONGINT)(23)));
+ OPM_SymWInt(23);
} else {
- OPM_SymWInt(((LONGINT)(24)));
+ OPM_SymWInt(24);
}
OPT_OutStr(par->typ);
OPM_SymWInt(par->adr);
- OPT_OutName((void*)par->name, ((LONGINT)(256)));
+ OPT_OutName((void*)par->name, 256);
par = par->link;
}
- OPM_SymWInt(((LONGINT)(18)));
+ OPM_SymWInt(18);
}
static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj)
@@ -1376,12 +1585,12 @@ static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj)
}
if (obj->vis != 0) {
if (obj->vis != 0) {
- OPM_SymWInt(((LONGINT)(29)));
+ OPM_SymWInt(29);
OPT_OutSign(obj->typ, obj->link);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
OPM_SymWInt(__ASHR(obj->adr, 16));
} else {
- OPM_SymWInt(((LONGINT)(30)));
+ OPM_SymWInt(30);
OPM_SymWInt(__ASHR(obj->adr, 16));
}
}
@@ -1395,8 +1604,11 @@ static void OPT_OutStr (OPT_Struct typ)
OPT_Object strobj = NIL;
if (typ->ref < OPT_expCtxt.ref) {
OPM_SymWInt(-typ->ref);
+ if (__IN(typ->ref, 0x90, 32)) {
+ OPM_SymWInt(typ->size);
+ }
} else {
- OPM_SymWInt(((LONGINT)(34)));
+ OPM_SymWInt(34);
typ->ref = OPT_expCtxt.ref;
OPT_expCtxt.ref += 1;
if (OPT_expCtxt.ref >= 255) {
@@ -1405,7 +1617,7 @@ static void OPT_OutStr (OPT_Struct typ)
OPT_OutMod(typ->mno);
strobj = typ->strobj;
if ((strobj != NIL && strobj->name[0] != 0x00)) {
- OPT_OutName((void*)strobj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)strobj->name, 256);
switch (strobj->history) {
case 2:
OPT_FPrintErr(strobj, 252);
@@ -1423,31 +1635,31 @@ static void OPT_OutStr (OPT_Struct typ)
OPM_SymWCh(0x00);
}
if (typ->sysflag != 0) {
- OPM_SymWInt(((LONGINT)(35)));
+ OPM_SymWInt(35);
OPM_SymWInt(typ->sysflag);
}
switch (typ->form) {
- case 13:
- OPM_SymWInt(((LONGINT)(36)));
+ case 11:
+ OPM_SymWInt(36);
OPT_OutStr(typ->BaseTyp);
break;
- case 14:
- OPM_SymWInt(((LONGINT)(40)));
+ case 12:
+ OPM_SymWInt(40);
OPT_OutSign(typ->BaseTyp, typ->link);
break;
- case 15:
+ case 13:
switch (typ->comp) {
case 2:
- OPM_SymWInt(((LONGINT)(37)));
+ OPM_SymWInt(37);
OPT_OutStr(typ->BaseTyp);
OPM_SymWInt(typ->n);
break;
case 3:
- OPM_SymWInt(((LONGINT)(38)));
+ OPM_SymWInt(38);
OPT_OutStr(typ->BaseTyp);
break;
case 4:
- OPM_SymWInt(((LONGINT)(39)));
+ OPM_SymWInt(39);
if (typ->BaseTyp == NIL) {
OPT_OutStr(OPT_notyp);
} else {
@@ -1457,23 +1669,23 @@ static void OPT_OutStr (OPT_Struct typ)
OPM_SymWInt(typ->align);
OPM_SymWInt(typ->n);
OPT_nofhdfld = 0;
- OPT_OutFlds(typ->link, ((LONGINT)(0)), 1);
+ OPT_OutFlds(typ->link, 0, 1);
if (OPT_nofhdfld > 2048) {
OPM_Mark(223, typ->txtpos);
}
OPT_OutTProcs(typ, typ->link);
- OPM_SymWInt(((LONGINT)(18)));
+ OPM_SymWInt(18);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.comp = ", (LONGINT)39);
- OPM_LogWNum(typ->comp, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.comp = ", 39);
+ OPM_LogWNum(typ->comp, 0);
OPM_LogWLn();
break;
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.form = ", (LONGINT)39);
- OPM_LogWNum(typ->form, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.form = ", 39);
+ OPM_LogWNum(typ->form, 0);
OPM_LogWLn();
break;
}
@@ -1482,7 +1694,7 @@ static void OPT_OutStr (OPT_Struct typ)
static void OPT_OutConstant (OPT_Object obj)
{
- INTEGER f;
+ INT16 f;
REAL rval;
f = obj->typ->form;
OPM_SymWInt(f);
@@ -1490,23 +1702,25 @@ static void OPT_OutConstant (OPT_Object obj)
case 2: case 3:
OPM_SymWCh((CHAR)obj->conval->intval);
break;
- case 4: case 5: case 6:
+ case 4:
OPM_SymWInt(obj->conval->intval);
- break;
- case 9:
- OPM_SymWSet(obj->conval->setval);
+ OPM_SymWInt(obj->typ->size);
break;
case 7:
+ OPM_SymWSet(obj->conval->setval);
+ OPM_SymWInt(obj->typ->size);
+ break;
+ case 5:
rval = obj->conval->realval;
OPM_SymWReal(rval);
break;
- case 8:
+ case 6:
OPM_SymWLReal(obj->conval->realval);
break;
- case 10:
- OPT_OutName((void*)*obj->conval->ext, ((LONGINT)(256)));
+ case 8:
+ OPT_OutName((void*)*obj->conval->ext, 256);
break;
- case 11:
+ case 9:
break;
default:
OPT_err(127);
@@ -1516,11 +1730,11 @@ static void OPT_OutConstant (OPT_Object obj)
static void OPT_OutObj (OPT_Object obj)
{
- INTEGER i, j;
+ INT16 i, j;
OPT_ConstExt ext = NIL;
if (obj != NIL) {
OPT_OutObj(obj->left);
- if (__IN(obj->mode, 0x06ea)) {
+ if (__IN(obj->mode, 0x06ea, 32)) {
if (obj->history == 4) {
OPT_FPrintErr(obj, 250);
} else if (obj->vis != 0) {
@@ -1537,64 +1751,64 @@ static void OPT_OutObj (OPT_Object obj)
OPT_FPrintErr(obj, 251);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj^.history = ", (LONGINT)42);
- OPM_LogWNum(obj->history, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj^.history = ", 42);
+ OPM_LogWNum(obj->history, 0);
OPM_LogWLn();
break;
}
switch (obj->mode) {
case 3:
OPT_OutConstant(obj);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
break;
case 5:
if (obj->typ->strobj == obj) {
- OPM_SymWInt(((LONGINT)(19)));
+ OPM_SymWInt(19);
OPT_OutStr(obj->typ);
} else {
- OPM_SymWInt(((LONGINT)(20)));
+ OPM_SymWInt(20);
OPT_OutStr(obj->typ);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
}
break;
case 1:
if (obj->vis == 2) {
- OPM_SymWInt(((LONGINT)(22)));
+ OPM_SymWInt(22);
} else {
- OPM_SymWInt(((LONGINT)(21)));
+ OPM_SymWInt(21);
}
OPT_OutStr(obj->typ);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
if (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00) {
OPM_FPrint(&OPT_expCtxt.reffp, obj->typ->ref);
}
break;
case 7:
- OPM_SymWInt(((LONGINT)(31)));
+ OPM_SymWInt(31);
OPT_OutSign(obj->typ, obj->link);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
break;
case 10:
- OPM_SymWInt(((LONGINT)(32)));
+ OPM_SymWInt(32);
OPT_OutSign(obj->typ, obj->link);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
break;
case 9:
- OPM_SymWInt(((LONGINT)(33)));
+ OPM_SymWInt(33);
OPT_OutSign(obj->typ, obj->link);
ext = obj->conval->ext;
- j = (int)(*ext)[0];
+ j = (INT16)(*ext)[0];
i = 1;
OPM_SymWInt(j);
while (i <= j) {
- OPM_SymWCh((*ext)[__X(i, ((LONGINT)(256)))]);
+ OPM_SymWCh((*ext)[__X(i, 256)]);
i += 1;
}
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj.mode = ", (LONGINT)38);
- OPM_LogWNum(obj->mode, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj.mode = ", 38);
+ OPM_LogWNum(obj->mode, 0);
OPM_LogWLn();
break;
}
@@ -1606,8 +1820,8 @@ static void OPT_OutObj (OPT_Object obj)
void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
{
- INTEGER i;
- SHORTINT nofmod;
+ INT16 i;
+ INT8 nofmod;
BOOLEAN done;
OPT_symExtended = 0;
OPT_symNew = 0;
@@ -1615,25 +1829,22 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
OPT_Import((CHAR*)"@self", OPT_SelfName, &done);
OPT_nofGmod = nofmod;
if (OPM_noerr) {
- OPM_NewSym((void*)OPT_SelfName, ((LONGINT)(256)));
+ OPM_NewSym((void*)OPT_SelfName, 256);
if (OPM_noerr) {
- OPM_SymWInt(((LONGINT)(16)));
- OPT_OutName((void*)OPT_SelfName, ((LONGINT)(256)));
+ OPM_SymWInt(16);
+ OPT_OutName((void*)OPT_SelfName, 256);
OPT_expCtxt.reffp = 0;
- OPT_expCtxt.ref = 16;
+ OPT_expCtxt.ref = 14;
OPT_expCtxt.nofm = 1;
OPT_expCtxt.locmno[0] = 0;
i = 1;
while (i < 64) {
- OPT_expCtxt.locmno[__X(i, ((LONGINT)(64)))] = -1;
+ OPT_expCtxt.locmno[__X(i, 64)] = -1;
i += 1;
}
OPT_OutObj(OPT_topScope->right);
*ext = (OPT_sfpresent && OPT_symExtended);
- *new = !OPT_sfpresent || OPT_symNew;
- if (OPM_forceNewSym) {
- *new = 1;
- }
+ *new = (!OPT_sfpresent || OPT_symNew) || __IN(17, OPM_Options, 32);
if ((((OPM_noerr && OPT_sfpresent)) && OPT_impCtxt.reffp != OPT_expCtxt.reffp)) {
*new = 1;
if (!OPT_extsf) {
@@ -1649,11 +1860,11 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
}
}
-static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form)
+static void OPT_InitStruct (OPT_Struct *typ, INT8 form)
{
*typ = OPT_NewStr(form, 1);
(*typ)->ref = form;
- (*typ)->size = OPM_ByteSize;
+ (*typ)->size = 1;
(*typ)->allocated = 1;
(*typ)->strobj = OPT_NewObj();
(*typ)->pbfp = form;
@@ -1663,7 +1874,7 @@ static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form)
(*typ)->idfpdone = 1;
}
-static void OPT_EnterBoolConst (OPS_Name name, LONGINT value)
+static void OPT_EnterBoolConst (OPS_Name name, INT32 value)
{
OPT_Object obj = NIL;
OPS_Name name__copy;
@@ -1675,7 +1886,7 @@ static void OPT_EnterBoolConst (OPS_Name name, LONGINT value)
obj->conval->intval = value;
}
-static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct *res)
+static void OPT_EnterTyp (OPS_Name name, INT8 form, INT16 size, OPT_Struct *res)
{
OPT_Object obj = NIL;
OPT_Struct typ = NIL;
@@ -1695,10 +1906,25 @@ static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct
typ->fpdone = 1;
typ->idfp = form;
typ->idfpdone = 1;
+ if (__IN(form, 0x90, 32)) {
+ OPM_FPrint(&typ->idfp, typ->size);
+ }
*res = typ;
}
-static void OPT_EnterProc (OPS_Name name, INTEGER num)
+static void OPT_EnterTypeAlias (OPS_Name name, OPT_Object *res)
+{
+ OPT_Object obj = NIL;
+ OPS_Name name__copy;
+ __DUPARR(name, OPS_Name);
+ OPT_Insert(name, &obj);
+ obj->mode = 5;
+ obj->typ = NIL;
+ obj->vis = 1;
+ *res = obj;
+}
+
+static void OPT_EnterProc (OPS_Name name, INT16 num)
{
OPT_Object obj = NIL;
OPS_Name name__copy;
@@ -1713,62 +1939,75 @@ static void EnumPtrs(void (*P)(void*))
{
P(OPT_topScope);
P(OPT_undftyp);
+ P(OPT_niltyp);
+ P(OPT_notyp);
P(OPT_bytetyp);
+ P(OPT_cpbytetyp);
P(OPT_booltyp);
P(OPT_chartyp);
P(OPT_sinttyp);
P(OPT_inttyp);
P(OPT_linttyp);
+ P(OPT_hinttyp);
+ P(OPT_int8typ);
+ P(OPT_int16typ);
+ P(OPT_int32typ);
+ P(OPT_int64typ);
+ P(OPT_settyp);
+ P(OPT_set32typ);
+ P(OPT_set64typ);
P(OPT_realtyp);
P(OPT_lrltyp);
- P(OPT_settyp);
P(OPT_stringtyp);
- P(OPT_niltyp);
- P(OPT_notyp);
+ P(OPT_adrtyp);
P(OPT_sysptrtyp);
+ P(OPT_sintobj);
+ P(OPT_intobj);
+ P(OPT_lintobj);
+ P(OPT_setobj);
__ENUMP(OPT_GlbMod, 64, P);
P(OPT_universe);
P(OPT_syslink);
- __ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 6216, 1, P);
+ __ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 5184, 1, P);
}
__TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 40), {0, -16}};
-__TDESC(OPT_ObjDesc, 1, 6) = {__TDFLDS("ObjDesc", 344), {0, 8, 16, 24, 304, 312, -56}};
-__TDESC(OPT_StrDesc, 1, 3) = {__TDFLDS("StrDesc", 104), {80, 88, 96, -32}};
+__TDESC(OPT_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", 6216), {32, 40, 48, 56, 64, 72, 80, 88, 96, 104, 112, 120, 128, 136, 144, 152,
- 160, 168, 176, 184, 192, 200, 208, 216, 224, 232, 240, 248, 256, 264, 272, 280,
- 288, 296, 304, 312, 320, 328, 336, 344, 352, 360, 368, 376, 384, 392, 400, 408,
- 416, 424, 432, 440, 448, 456, 464, 472, 480, 488, 496, 504, 512, 520, 528, 536,
- 544, 552, 560, 568, 576, 584, 592, 600, 608, 616, 624, 632, 640, 648, 656, 664,
- 672, 680, 688, 696, 704, 712, 720, 728, 736, 744, 752, 760, 768, 776, 784, 792,
- 800, 808, 816, 824, 832, 840, 848, 856, 864, 872, 880, 888, 896, 904, 912, 920,
- 928, 936, 944, 952, 960, 968, 976, 984, 992, 1000, 1008, 1016, 1024, 1032, 1040, 1048,
- 1056, 1064, 1072, 1080, 1088, 1096, 1104, 1112, 1120, 1128, 1136, 1144, 1152, 1160, 1168, 1176,
- 1184, 1192, 1200, 1208, 1216, 1224, 1232, 1240, 1248, 1256, 1264, 1272, 1280, 1288, 1296, 1304,
- 1312, 1320, 1328, 1336, 1344, 1352, 1360, 1368, 1376, 1384, 1392, 1400, 1408, 1416, 1424, 1432,
- 1440, 1448, 1456, 1464, 1472, 1480, 1488, 1496, 1504, 1512, 1520, 1528, 1536, 1544, 1552, 1560,
- 1568, 1576, 1584, 1592, 1600, 1608, 1616, 1624, 1632, 1640, 1648, 1656, 1664, 1672, 1680, 1688,
- 1696, 1704, 1712, 1720, 1728, 1736, 1744, 1752, 1760, 1768, 1776, 1784, 1792, 1800, 1808, 1816,
- 1824, 1832, 1840, 1848, 1856, 1864, 1872, 1880, 1888, 1896, 1904, 1912, 1920, 1928, 1936, 1944,
- 1952, 1960, 1968, 1976, 1984, 1992, 2000, 2008, 2016, 2024, 2032, 2040, 2048, 2056, 2064, 2072,
- 2080, 2088, 2096, 2104, 2112, 2120, 2128, 2136, 2144, 2152, 2160, 2168, 2176, 2184, 2192, 2200,
- 2208, 2216, 2224, 2232, 2240, 2248, 2256, 2264, 2272, 2280, 2288, 2296, 2304, 2312, 2320, 2328,
- 2336, 2344, 2352, 2360, 2368, 2376, 2384, 2392, 2400, 2408, 2416, 2424, 2432, 2440, 2448, 2456,
- 2464, 2472, 2480, 2488, 2496, 2504, 2512, 2520, 2528, 2536, 2544, 2552, 2560, 2568, 2576, 2584,
- 2592, 2600, 2608, 2616, 2624, 2632, 2640, 2648, 2656, 2664, 2672, 2680, 2688, 2696, 2704, 2712,
- 2720, 2728, 2736, 2744, 2752, 2760, 2768, 2776, 2784, 2792, 2800, 2808, 2816, 2824, 2832, 2840,
- 2848, 2856, 2864, 2872, 2880, 2888, 2896, 2904, 2912, 2920, 2928, 2936, 2944, 2952, 2960, 2968,
- 2976, 2984, 2992, 3000, 3008, 3016, 3024, 3032, 3040, 3048, 3056, 3064, 3072, 3080, 3088, 3096,
- 3104, 3112, 3120, 3128, 3136, 3144, 3152, 3160, 3168, 3176, 3184, 3192, 3200, 3208, 3216, 3224,
- 3232, 3240, 3248, 3256, 3264, 3272, 3280, 3288, 3296, 3304, 3312, 3320, 3328, 3336, 3344, 3352,
- 3360, 3368, 3376, 3384, 3392, 3400, 3408, 3416, 3424, 3432, 3440, 3448, 3456, 3464, 3472, 3480,
- 3488, 3496, 3504, 3512, 3520, 3528, 3536, 3544, 3552, 3560, 3568, 3576, 3584, 3592, 3600, 3608,
- 3616, 3624, 3632, 3640, 3648, 3656, 3664, 3672, 3680, 3688, 3696, 3704, 3712, 3720, 3728, 3736,
- 3744, 3752, 3760, 3768, 3776, 3784, 3792, 3800, 3808, 3816, 3824, 3832, 3840, 3848, 3856, 3864,
- 3872, 3880, 3888, 3896, 3904, 3912, 3920, 3928, 3936, 3944, 3952, 3960, 3968, 3976, 3984, 3992,
- 4000, 4008, 4016, 4024, 4032, 4040, 4048, 4056, 4064, 4072, 4080, 4088, 4096, 4104, -4088}};
-__TDESC(OPT_ExpCtxt, 1, 0) = {__TDFLDS("ExpCtxt", 80), {-8}};
+__TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 5184), {16, 24, 32, 40, 48, 56, 64, 72, 80, 88, 96, 104, 112, 120, 128, 136,
+ 144, 152, 160, 168, 176, 184, 192, 200, 208, 216, 224, 232, 240, 248, 256, 264,
+ 272, 280, 288, 296, 304, 312, 320, 328, 336, 344, 352, 360, 368, 376, 384, 392,
+ 400, 408, 416, 424, 432, 440, 448, 456, 464, 472, 480, 488, 496, 504, 512, 520,
+ 528, 536, 544, 552, 560, 568, 576, 584, 592, 600, 608, 616, 624, 632, 640, 648,
+ 656, 664, 672, 680, 688, 696, 704, 712, 720, 728, 736, 744, 752, 760, 768, 776,
+ 784, 792, 800, 808, 816, 824, 832, 840, 848, 856, 864, 872, 880, 888, 896, 904,
+ 912, 920, 928, 936, 944, 952, 960, 968, 976, 984, 992, 1000, 1008, 1016, 1024, 1032,
+ 1040, 1048, 1056, 1064, 1072, 1080, 1088, 1096, 1104, 1112, 1120, 1128, 1136, 1144, 1152, 1160,
+ 1168, 1176, 1184, 1192, 1200, 1208, 1216, 1224, 1232, 1240, 1248, 1256, 1264, 1272, 1280, 1288,
+ 1296, 1304, 1312, 1320, 1328, 1336, 1344, 1352, 1360, 1368, 1376, 1384, 1392, 1400, 1408, 1416,
+ 1424, 1432, 1440, 1448, 1456, 1464, 1472, 1480, 1488, 1496, 1504, 1512, 1520, 1528, 1536, 1544,
+ 1552, 1560, 1568, 1576, 1584, 1592, 1600, 1608, 1616, 1624, 1632, 1640, 1648, 1656, 1664, 1672,
+ 1680, 1688, 1696, 1704, 1712, 1720, 1728, 1736, 1744, 1752, 1760, 1768, 1776, 1784, 1792, 1800,
+ 1808, 1816, 1824, 1832, 1840, 1848, 1856, 1864, 1872, 1880, 1888, 1896, 1904, 1912, 1920, 1928,
+ 1936, 1944, 1952, 1960, 1968, 1976, 1984, 1992, 2000, 2008, 2016, 2024, 2032, 2040, 2048, 2056,
+ 2064, 2072, 2080, 2088, 2096, 2104, 2112, 2120, 2128, 2136, 2144, 2152, 2160, 2168, 2176, 2184,
+ 2192, 2200, 2208, 2216, 2224, 2232, 2240, 2248, 2256, 2264, 2272, 2280, 2288, 2296, 2304, 2312,
+ 2320, 2328, 2336, 2344, 2352, 2360, 2368, 2376, 2384, 2392, 2400, 2408, 2416, 2424, 2432, 2440,
+ 2448, 2456, 2464, 2472, 2480, 2488, 2496, 2504, 2512, 2520, 2528, 2536, 2544, 2552, 2560, 2568,
+ 2576, 2584, 2592, 2600, 2608, 2616, 2624, 2632, 2640, 2648, 2656, 2664, 2672, 2680, 2688, 2696,
+ 2704, 2712, 2720, 2728, 2736, 2744, 2752, 2760, 2768, 2776, 2784, 2792, 2800, 2808, 2816, 2824,
+ 2832, 2840, 2848, 2856, 2864, 2872, 2880, 2888, 2896, 2904, 2912, 2920, 2928, 2936, 2944, 2952,
+ 2960, 2968, 2976, 2984, 2992, 3000, 3008, 3016, 3024, 3032, 3040, 3048, 3056, 3064, 3072, 3080,
+ 3088, 3096, 3104, 3112, 3120, 3128, 3136, 3144, 3152, 3160, 3168, 3176, 3184, 3192, 3200, 3208,
+ 3216, 3224, 3232, 3240, 3248, 3256, 3264, 3272, 3280, 3288, 3296, 3304, 3312, 3320, 3328, 3336,
+ 3344, 3352, 3360, 3368, 3376, 3384, 3392, 3400, 3408, 3416, 3424, 3432, 3440, 3448, 3456, 3464,
+ 3472, 3480, 3488, 3496, 3504, 3512, 3520, 3528, 3536, 3544, 3552, 3560, 3568, 3576, 3584, 3592,
+ 3600, 3608, 3616, 3624, 3632, 3640, 3648, 3656, 3664, 3672, 3680, 3688, 3696, 3704, 3712, 3720,
+ 3728, 3736, 3744, 3752, 3760, 3768, 3776, 3784, 3792, 3800, 3808, 3816, 3824, 3832, 3840, 3848,
+ 3856, 3864, 3872, 3880, 3888, 3896, 3904, 3912, 3920, 3928, 3936, 3944, 3952, 3960, 3968, 3976,
+ 3984, 3992, 4000, 4008, 4016, 4024, 4032, 4040, 4048, 4056, 4064, 4072, 4080, 4088, -4088}};
+__TDESC(OPT_ExpCtxt, 1, 0) = {__TDFLDS("ExpCtxt", 72), {-8}};
export void *OPT__init(void)
{
@@ -1778,6 +2017,7 @@ export void *OPT__init(void)
__REGMOD("OPT", EnumPtrs);
__REGCMD("Close", OPT_Close);
__REGCMD("CloseScope", OPT_CloseScope);
+ __REGCMD("InitRecno", OPT_InitRecno);
__INITYP(OPT_ConstDesc, OPT_ConstDesc, 0);
__INITYP(OPT_ObjDesc, OPT_ObjDesc, 0);
__INITYP(OPT_StrDesc, OPT_StrDesc, 0);
@@ -1789,12 +2029,19 @@ export void *OPT__init(void)
OPT_OpenScope(0, NIL);
OPM_errpos = 0;
OPT_InitStruct(&OPT_undftyp, 0);
- OPT_InitStruct(&OPT_notyp, 12);
- OPT_InitStruct(&OPT_stringtyp, 10);
- OPT_InitStruct(&OPT_niltyp, 11);
OPT_undftyp->BaseTyp = OPT_undftyp;
- OPT_EnterTyp((CHAR*)"BYTE", 1, OPM_ByteSize, &OPT_bytetyp);
- OPT_EnterTyp((CHAR*)"PTR", 13, OPM_PointerSize, &OPT_sysptrtyp);
+ OPT_InitStruct(&OPT_notyp, 10);
+ OPT_InitStruct(&OPT_stringtyp, 8);
+ OPT_InitStruct(&OPT_niltyp, 9);
+ OPT_EnterTyp((CHAR*)"BYTE", 1, 1, &OPT_bytetyp);
+ OPT_EnterTyp((CHAR*)"PTR", 11, -1, &OPT_sysptrtyp);
+ OPT_EnterTyp((CHAR*)"ADDRESS", 4, -1, &OPT_adrtyp);
+ OPT_EnterTyp((CHAR*)"INT8", 4, 1, &OPT_int8typ);
+ OPT_EnterTyp((CHAR*)"INT16", 4, 2, &OPT_int16typ);
+ OPT_EnterTyp((CHAR*)"INT32", 4, 4, &OPT_int32typ);
+ OPT_EnterTyp((CHAR*)"INT64", 4, 8, &OPT_int64typ);
+ OPT_EnterTyp((CHAR*)"SET32", 7, 4, &OPT_set32typ);
+ OPT_EnterTyp((CHAR*)"SET64", 7, 8, &OPT_set64typ);
OPT_EnterProc((CHAR*)"ADR", 20);
OPT_EnterProc((CHAR*)"CC", 21);
OPT_EnterProc((CHAR*)"LSH", 22);
@@ -1810,16 +2057,18 @@ export void *OPT__init(void)
OPT_syslink = OPT_topScope->right;
OPT_universe = OPT_topScope;
OPT_topScope->right = NIL;
- OPT_EnterTyp((CHAR*)"BOOLEAN", 2, OPM_BoolSize, &OPT_booltyp);
- OPT_EnterTyp((CHAR*)"CHAR", 3, OPM_CharSize, &OPT_chartyp);
- OPT_EnterTyp((CHAR*)"SET", 9, OPM_SetSize, &OPT_settyp);
- OPT_EnterTyp((CHAR*)"REAL", 7, OPM_RealSize, &OPT_realtyp);
- OPT_EnterTyp((CHAR*)"INTEGER", 5, OPM_IntSize, &OPT_inttyp);
- OPT_EnterTyp((CHAR*)"LONGINT", 6, OPM_LIntSize, &OPT_linttyp);
- OPT_EnterTyp((CHAR*)"LONGREAL", 8, OPM_LRealSize, &OPT_lrltyp);
- OPT_EnterTyp((CHAR*)"SHORTINT", 4, OPM_SIntSize, &OPT_sinttyp);
- OPT_EnterBoolConst((CHAR*)"FALSE", ((LONGINT)(0)));
- OPT_EnterBoolConst((CHAR*)"TRUE", ((LONGINT)(1)));
+ OPT_EnterTyp((CHAR*)"BOOLEAN", 2, 1, &OPT_booltyp);
+ OPT_EnterTyp((CHAR*)"CHAR", 3, 1, &OPT_chartyp);
+ OPT_EnterTyp((CHAR*)"REAL", 5, 4, &OPT_realtyp);
+ OPT_EnterTyp((CHAR*)"LONGREAL", 6, 8, &OPT_lrltyp);
+ OPT_EnterTyp((CHAR*)"HUGEINT", 4, 8, &OPT_hinttyp);
+ OPT_EnterTyp((CHAR*)"BYTE@", 4, 1, &OPT_cpbytetyp);
+ OPT_EnterTypeAlias((CHAR*)"SHORTINT", &OPT_sintobj);
+ OPT_EnterTypeAlias((CHAR*)"INTEGER", &OPT_intobj);
+ OPT_EnterTypeAlias((CHAR*)"LONGINT", &OPT_lintobj);
+ OPT_EnterTypeAlias((CHAR*)"SET", &OPT_setobj);
+ OPT_EnterBoolConst((CHAR*)"FALSE", 0);
+ OPT_EnterBoolConst((CHAR*)"TRUE", 1);
OPT_EnterProc((CHAR*)"HALT", 0);
OPT_EnterProc((CHAR*)"NEW", 1);
OPT_EnterProc((CHAR*)"ABS", 2);
@@ -1845,15 +2094,13 @@ export void *OPT__init(void)
OPT_impCtxt.ref[1] = OPT_bytetyp;
OPT_impCtxt.ref[2] = OPT_booltyp;
OPT_impCtxt.ref[3] = OPT_chartyp;
- OPT_impCtxt.ref[4] = OPT_sinttyp;
- OPT_impCtxt.ref[5] = OPT_inttyp;
- OPT_impCtxt.ref[6] = OPT_linttyp;
- OPT_impCtxt.ref[7] = OPT_realtyp;
- OPT_impCtxt.ref[8] = OPT_lrltyp;
- OPT_impCtxt.ref[9] = OPT_settyp;
- OPT_impCtxt.ref[10] = OPT_stringtyp;
- OPT_impCtxt.ref[11] = OPT_niltyp;
- OPT_impCtxt.ref[12] = OPT_notyp;
- OPT_impCtxt.ref[13] = OPT_sysptrtyp;
+ OPT_impCtxt.ref[4] = OPT_int32typ;
+ OPT_impCtxt.ref[5] = OPT_realtyp;
+ OPT_impCtxt.ref[6] = OPT_lrltyp;
+ OPT_impCtxt.ref[7] = OPT_settyp;
+ OPT_impCtxt.ref[8] = OPT_stringtyp;
+ OPT_impCtxt.ref[9] = OPT_niltyp;
+ OPT_impCtxt.ref[10] = OPT_notyp;
+ OPT_impCtxt.ref[11] = OPT_sysptrtyp;
__ENDMOD;
}
diff --git a/bootstrap/unix-88/OPT.h b/bootstrap/unix-88/OPT.h
index ab2c4684..90fcacf5 100644
--- a/bootstrap/unix-88/OPT.h
+++ b/bootstrap/unix-88/OPT.h
@@ -1,9 +1,8 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPT__h
#define OPT__h
-#define LARGE
#include "SYSTEM.h"
#include "OPS.h"
@@ -16,8 +15,9 @@ typedef
typedef
struct OPT_ConstDesc {
OPT_ConstExt ext;
- LONGINT intval, intval2;
- SET setval;
+ INT64 intval;
+ INT32 intval2;
+ UINT64 setval;
LONGREAL realval;
} OPT_ConstDesc;
@@ -33,7 +33,7 @@ typedef
typedef
struct OPT_NodeDesc {
OPT_Node left, right, link;
- SHORTINT class, subcl;
+ INT8 class, subcl;
BOOLEAN readonly;
OPT_Struct typ;
OPT_Object obj;
@@ -45,44 +45,48 @@ typedef
OPT_Object left, right, link, scope;
OPS_Name name;
BOOLEAN leaf;
- SHORTINT mode, mnolev, vis, history;
+ INT8 mode, mnolev, vis, history;
BOOLEAN used, fpdone;
- LONGINT fprint;
+ INT32 fprint;
OPT_Struct typ;
OPT_Const conval;
- LONGINT adr, linkadr;
- INTEGER x;
+ INT32 adr, linkadr;
+ INT16 x;
} OPT_ObjDesc;
typedef
struct OPT_StrDesc {
- SHORTINT form, comp, mno, extlev;
- INTEGER ref, sysflag;
- LONGINT n, size, align, txtpos;
+ INT8 form, comp, mno, extlev;
+ INT16 ref, sysflag;
+ INT32 n, size, align, txtpos;
BOOLEAN allocated, pbused, pvused;
- char _prvt0[24];
+ char _prvt0[4];
+ INT32 idfp;
+ char _prvt1[8];
OPT_Struct BaseTyp;
OPT_Object link, strobj;
} OPT_StrDesc;
-import void (*OPT_typSize)(OPT_Struct);
import OPT_Object OPT_topScope;
-import OPT_Struct OPT_undftyp, OPT_bytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_realtyp, OPT_lrltyp, OPT_settyp, OPT_stringtyp, OPT_niltyp, OPT_notyp, OPT_sysptrtyp;
-import SHORTINT OPT_nofGmod;
+import OPT_Struct OPT_undftyp, OPT_niltyp, OPT_notyp, OPT_bytetyp, OPT_cpbytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_hinttyp, OPT_int8typ, OPT_int16typ, OPT_int32typ, OPT_int64typ, OPT_settyp, OPT_set32typ, OPT_set64typ, OPT_realtyp, OPT_lrltyp, OPT_stringtyp, OPT_adrtyp, OPT_sysptrtyp;
+import OPT_Object OPT_sintobj, OPT_intobj, OPT_lintobj, OPT_setobj;
+import INT8 OPT_nofGmod;
import OPT_Object OPT_GlbMod[64];
import OPS_Name OPT_SelfName;
import BOOLEAN OPT_SYSimported;
-import LONGINT *OPT_ConstDesc__typ;
-import LONGINT *OPT_ObjDesc__typ;
-import LONGINT *OPT_StrDesc__typ;
-import LONGINT *OPT_NodeDesc__typ;
+import ADDRESS *OPT_ConstDesc__typ;
+import ADDRESS *OPT_ObjDesc__typ;
+import ADDRESS *OPT_StrDesc__typ;
+import ADDRESS *OPT_NodeDesc__typ;
+import void OPT_Align (INT32 *adr, INT32 base);
+import INT32 OPT_BaseAlignment (OPT_Struct typ);
import void OPT_Close (void);
import void OPT_CloseScope (void);
import void OPT_Export (BOOLEAN *ext, BOOLEAN *new);
-import void OPT_FPrintErr (OPT_Object obj, INTEGER errcode);
+import void OPT_FPrintErr (OPT_Object obj, INT16 errcode);
import void OPT_FPrintObj (OPT_Object obj);
import void OPT_FPrintStr (OPT_Struct typ);
import void OPT_Find (OPT_Object *res);
@@ -90,16 +94,23 @@ import void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res);
import void OPT_FindImport (OPT_Object mod, OPT_Object *res);
import void OPT_IdFPrint (OPT_Struct typ);
import void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done);
-import void OPT_Init (OPS_Name name, SET opt);
+import void OPT_Init (OPS_Name name, UINT32 opt);
+import void OPT_InitRecno (void);
import void OPT_Insert (OPS_Name name, OPT_Object *obj);
import void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old);
+import INT16 OPT_IntSize (INT64 n);
+import OPT_Struct OPT_IntType (INT32 size);
import OPT_Const OPT_NewConst (void);
import OPT_ConstExt OPT_NewExt (void);
-import OPT_Node OPT_NewNode (SHORTINT class);
+import OPT_Node OPT_NewNode (INT8 class);
import OPT_Object OPT_NewObj (void);
-import OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp);
-import void OPT_OpenScope (SHORTINT level, OPT_Object owner);
+import OPT_Struct OPT_NewStr (INT8 form, INT8 comp);
+import void OPT_OpenScope (INT8 level, OPT_Object owner);
+import OPT_Struct OPT_SetType (INT32 size);
+import OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir);
+import INT32 OPT_SizeAlignment (INT32 size);
+import void OPT_TypSize (OPT_Struct typ);
import void *OPT__init(void);
-#endif
+#endif // OPT
diff --git a/bootstrap/unix-88/OPV.c b/bootstrap/unix-88/OPV.c
index ae14f629..4bd6b3fb 100644
--- a/bootstrap/unix-88/OPV.c
+++ b/bootstrap/unix-88/OPV.c
@@ -1,5 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "OPC.h"
#include "OPM.h"
@@ -8,167 +13,66 @@
typedef
struct OPV_ExitInfo {
- INTEGER level, label;
+ INT16 level, label;
} OPV_ExitInfo;
-static BOOLEAN OPV_assert, OPV_inxchk, OPV_mainprog, OPV_ansi;
-static INTEGER OPV_stamp;
-static LONGINT OPV_recno;
+static INT16 OPV_stamp;
static OPV_ExitInfo OPV_exit;
-static INTEGER OPV_nofExitLabels;
-static BOOLEAN OPV_naturalAlignment;
+static INT16 OPV_nofExitLabels;
-export LONGINT *OPV_ExitInfo__typ;
+export ADDRESS *OPV_ExitInfo__typ;
static void OPV_ActualPar (OPT_Node n, OPT_Object fp);
export void OPV_AdrAndSize (OPT_Object topScope);
static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc);
-static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INTEGER prec);
+static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec);
static void OPV_DefineTDescs (OPT_Node n);
-static void OPV_Entier (OPT_Node n, INTEGER prec);
+static void OPV_Entier (OPT_Node n, INT16 prec);
static void OPV_GetTProcNum (OPT_Object obj);
static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc);
static BOOLEAN OPV_ImplicitReturn (OPT_Node n);
-static void OPV_Index (OPT_Node n, OPT_Node d, INTEGER prec, INTEGER dim);
+static void OPV_Index (OPT_Node n, OPT_Node d, INT16 prec, INT16 dim);
export void OPV_Init (void);
static void OPV_InitTDescs (OPT_Node n);
-static void OPV_Len (OPT_Node n, LONGINT dim);
+static void OPV_Len (OPT_Node n, INT64 dim);
export void OPV_Module (OPT_Node prog);
-static LONGINT OPV_NaturalAlignment (LONGINT size, LONGINT max);
static void OPV_NewArr (OPT_Node d, OPT_Node x);
-static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, INTEGER comp);
+static void OPV_ParIntLiteral (INT64 n, INT32 size);
+static INT16 OPV_Precedence (INT16 class, INT16 subclass, INT16 form, INT16 comp);
static BOOLEAN OPV_SideEffects (OPT_Node n);
-static void OPV_SizeCast (LONGINT size);
+static void OPV_SizeCast (OPT_Node n, INT32 to);
static void OPV_Stamp (OPS_Name s);
static OPT_Object OPV_SuperProc (OPT_Node n);
static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported);
static void OPV_TraverseRecord (OPT_Struct typ);
-export void OPV_TypSize (OPT_Struct typ);
static void OPV_TypeOf (OPT_Node n);
-static void OPV_design (OPT_Node n, INTEGER prec);
-static void OPV_expr (OPT_Node n, INTEGER prec);
+static void OPV_design (OPT_Node n, INT16 prec);
+static void OPV_expr (OPT_Node n, INT16 prec);
static void OPV_stat (OPT_Node n, OPT_Object outerProc);
-static LONGINT OPV_NaturalAlignment (LONGINT size, LONGINT max)
-{
- LONGINT _o_result;
- LONGINT i;
- if (size >= max) {
- _o_result = max;
- return _o_result;
- } else {
- i = 1;
- while (i < size) {
- i += i;
- }
- _o_result = i;
- return _o_result;
- }
- __RETCHK;
-}
-
-void OPV_TypSize (OPT_Struct typ)
-{
- INTEGER f, c;
- LONGINT offset, size, base, fbase, off0;
- OPT_Object fld = NIL;
- OPT_Struct btyp = NIL;
- if (typ == OPT_undftyp) {
- OPM_err(58);
- } else if (typ->size == -1) {
- f = typ->form;
- c = typ->comp;
- if (c == 4) {
- btyp = typ->BaseTyp;
- if (btyp == NIL) {
- offset = 0;
- base = OPC_SizeAlignment(OPM_RecSize);
- } else {
- OPV_TypSize(btyp);
- offset = btyp->size - (SYSTEM_INT64)__ASHR(btyp->sysflag, 8);
- base = btyp->align;
- }
- fld = typ->link;
- while ((fld != NIL && fld->mode == 4)) {
- btyp = fld->typ;
- OPV_TypSize(btyp);
- size = btyp->size;
- fbase = OPC_BaseAlignment(btyp);
- OPC_Align(&offset, fbase);
- fld->adr = offset;
- offset += size;
- if (fbase > base) {
- base = fbase;
- }
- fld = fld->link;
- }
- off0 = offset;
- if (offset == 0) {
- offset = 1;
- }
- if (OPM_RecSize == 0) {
- base = OPV_NaturalAlignment(offset, OPC_SizeAlignment(OPM_RecSize));
- }
- OPC_Align(&offset, base);
- if ((typ->strobj == NIL && __MASK(typ->align, -65536) == 0)) {
- OPV_recno += 1;
- base += __ASHL(OPV_recno, 16);
- }
- typ->size = offset;
- typ->align = base;
- typ->sysflag = __MASK(typ->sysflag, -256) + (int)__ASHL(offset - off0, 8);
- } else if (c == 2) {
- OPV_TypSize(typ->BaseTyp);
- typ->size = typ->n * typ->BaseTyp->size;
- } else if (f == 13) {
- typ->size = OPM_PointerSize;
- if (typ->BaseTyp == OPT_undftyp) {
- OPM_Mark(128, typ->n);
- } else {
- OPV_TypSize(typ->BaseTyp);
- }
- } else if (f == 14) {
- typ->size = OPM_ProcSize;
- } else if (c == 3) {
- btyp = typ->BaseTyp;
- OPV_TypSize(btyp);
- if (btyp->comp == 3) {
- typ->size = btyp->size + 4;
- } else {
- typ->size = 8;
- }
- }
- }
-}
-
void OPV_Init (void)
{
OPV_stamp = 0;
- OPV_recno = 0;
OPV_nofExitLabels = 0;
- OPV_assert = __IN(7, OPM_opt);
- OPV_inxchk = __IN(0, OPM_opt);
- OPV_mainprog = __IN(10, OPM_opt);
- OPV_ansi = __IN(6, OPM_opt);
}
static void OPV_GetTProcNum (OPT_Object obj)
{
- LONGINT oldPos;
+ INT32 oldPos;
OPT_Struct typ = NIL;
OPT_Object redef = NIL;
oldPos = OPM_errpos;
OPM_errpos = obj->scope->adr;
typ = obj->link->typ;
- if (typ->form == 13) {
+ if (typ->form == 11) {
typ = typ->BaseTyp;
}
OPT_FindField(obj->name, typ->BaseTyp, &redef);
if (redef != NIL) {
obj->adr = __ASHL(__ASHR(redef->adr, 16), 16);
- if (!__IN(2, obj->conval->setval)) {
+ if (!__IN(2, obj->conval->setval, 64)) {
OPM_err(119);
}
} else {
@@ -192,37 +96,37 @@ static void OPV_TraverseRecord (OPT_Struct typ)
static void OPV_Stamp (OPS_Name s)
{
- INTEGER i, j, k;
+ INT16 i, j, k;
CHAR n[10];
OPV_stamp += 1;
i = 0;
j = OPV_stamp;
- while (s[__X(i, ((LONGINT)(256)))] != 0x00) {
+ while (s[__X(i, 256)] != 0x00) {
i += 1;
}
if (i > 25) {
i = 25;
}
- s[__X(i, ((LONGINT)(256)))] = '_';
- s[__X(i + 1, ((LONGINT)(256)))] = '_';
+ s[__X(i, 256)] = '_';
+ s[__X(i + 1, 256)] = '_';
i += 2;
k = 0;
do {
- n[__X(k, ((LONGINT)(10)))] = (CHAR)((int)__MOD(j, 10) + 48);
+ n[__X(k, 10)] = (CHAR)((int)__MOD(j, 10) + 48);
j = __DIV(j, 10);
k += 1;
} while (!(j == 0));
do {
k -= 1;
- s[__X(i, ((LONGINT)(256)))] = n[__X(k, ((LONGINT)(10)))];
+ s[__X(i, 256)] = n[__X(k, 10)];
i += 1;
} while (!(k == 0));
- s[__X(i, ((LONGINT)(256)))] = 0x00;
+ s[__X(i, 256)] = 0x00;
}
static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported)
{
- INTEGER mode;
+ INT16 mode;
OPT_Object scope = NIL;
OPT_Struct typ = NIL;
if (obj != NIL) {
@@ -235,8 +139,8 @@ static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exporte
mode = obj->mode;
if ((mode == 5 && (obj->vis != 0) == exported)) {
typ = obj->typ;
- OPV_TypSize(obj->typ);
- if (typ->form == 13) {
+ OPT_TypSize(obj->typ);
+ if (typ->form == 11) {
typ = typ->BaseTyp;
}
if (typ->comp == 4) {
@@ -245,21 +149,21 @@ static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exporte
} else if (mode == 13) {
OPV_GetTProcNum(obj);
} else if (mode == 1) {
- OPV_TypSize(obj->typ);
+ OPT_TypSize(obj->typ);
}
if (!exported) {
- if ((__IN(mode, 0x60) && obj->mnolev > 0)) {
+ if ((__IN(mode, 0x60, 32) && obj->mnolev > 0)) {
OPV_Stamp(obj->name);
}
- if (__IN(mode, 0x26)) {
+ if (__IN(mode, 0x26, 32)) {
obj->scope = outerScope;
- } else if (__IN(mode, 0x26c0)) {
+ } else if (__IN(mode, 0x26c0, 32)) {
if (obj->conval->setval == 0x0) {
OPM_err(129);
}
scope = obj->scope;
scope->leaf = 1;
- __COPY(obj->name, scope->name, ((LONGINT)(256)));
+ __COPY(obj->name, scope->name, 256);
OPV_Stamp(scope->name);
if (mode == 9) {
obj->adr = 1;
@@ -276,66 +180,66 @@ static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exporte
void OPV_AdrAndSize (OPT_Object topScope)
{
+ __ASSERT(OPT_sinttyp != NIL, 0);
+ __ASSERT(OPT_inttyp != NIL, 0);
+ __ASSERT(OPT_linttyp != NIL, 0);
OPM_errpos = topScope->adr;
topScope->leaf = 1;
OPV_Traverse(topScope->right, topScope, 1);
OPV_Traverse(topScope->right, topScope, 0);
OPT_chartyp->strobj->linkadr = 2;
+ OPT_cpbytetyp->strobj->linkadr = 2;
OPT_settyp->strobj->linkadr = 2;
OPT_realtyp->strobj->linkadr = 2;
- OPT_inttyp->strobj->linkadr = 2;
- OPT_linttyp->strobj->linkadr = 2;
+ OPT_adrtyp->strobj->linkadr = 2;
+ OPT_int8typ->strobj->linkadr = 2;
+ OPT_int16typ->strobj->linkadr = 2;
+ OPT_int32typ->strobj->linkadr = 2;
+ OPT_int64typ->strobj->linkadr = 2;
+ OPT_set32typ->strobj->linkadr = 2;
+ OPT_set64typ->strobj->linkadr = 2;
+ OPT_hinttyp->strobj->linkadr = 2;
OPT_lrltyp->strobj->linkadr = 2;
- OPT_sinttyp->strobj->linkadr = 2;
OPT_booltyp->strobj->linkadr = 2;
OPT_bytetyp->strobj->linkadr = 2;
OPT_sysptrtyp->strobj->linkadr = 2;
}
-static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, INTEGER comp)
+static INT16 OPV_Precedence (INT16 class, INT16 subclass, INT16 form, INT16 comp)
{
- INTEGER _o_result;
switch (class) {
case 7: case 0: case 2: case 4: case 9:
case 13:
- _o_result = 10;
- return _o_result;
+ return 10;
break;
case 5:
- if (__IN(3, OPM_opt)) {
- _o_result = 10;
- return _o_result;
+ if (__IN(3, OPM_Options, 32)) {
+ return 10;
} else {
- _o_result = 9;
- return _o_result;
+ return 9;
}
break;
case 1:
- if (__IN(comp, 0x0c)) {
- _o_result = 10;
- return _o_result;
+ if (__IN(comp, 0x0c, 32)) {
+ return 10;
} else {
- _o_result = 9;
- return _o_result;
+ return 9;
}
break;
case 3:
- _o_result = 9;
- return _o_result;
+ return 9;
break;
case 11:
switch (subclass) {
case 33: case 7: case 24: case 29: case 20:
- _o_result = 9;
- return _o_result;
+ return 9;
break;
case 16: case 21: case 22: case 23: case 25:
- _o_result = 10;
- return _o_result;
+ return 10;
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence OPT.Nmop, subclass = ", (LONGINT)55);
- OPM_LogWNum(subclass, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence OPT.Nmop, subclass = ", 55);
+ OPM_LogWNum(subclass, 0);
OPM_LogWLn();
break;
}
@@ -343,91 +247,75 @@ static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, IN
case 12:
switch (subclass) {
case 1:
- if (form == 9) {
- _o_result = 4;
- return _o_result;
+ if (form == 7) {
+ return 4;
} else {
- _o_result = 8;
- return _o_result;
+ return 8;
}
break;
case 2:
- if (form == 9) {
- _o_result = 3;
- return _o_result;
+ if (form == 7) {
+ return 3;
} else {
- _o_result = 8;
- return _o_result;
+ return 8;
}
break;
case 3: case 4:
- _o_result = 10;
- return _o_result;
+ return 10;
break;
case 6:
- if (form == 9) {
- _o_result = 2;
- return _o_result;
+ if (form == 7) {
+ return 2;
} else {
- _o_result = 7;
- return _o_result;
+ return 7;
}
break;
case 7:
- if (form == 9) {
- _o_result = 4;
- return _o_result;
+ if (form == 7) {
+ return 4;
} else {
- _o_result = 7;
- return _o_result;
+ return 7;
}
break;
case 11: case 12: case 13: case 14:
- _o_result = 6;
- return _o_result;
+ return 6;
break;
case 9: case 10:
- _o_result = 5;
- return _o_result;
+ return 5;
break;
case 5:
- _o_result = 1;
- return _o_result;
+ return 1;
break;
case 8:
- _o_result = 0;
- return _o_result;
+ return 0;
break;
case 19: case 15: case 17: case 18: case 26:
case 27: case 28:
- _o_result = 10;
- return _o_result;
+ return 10;
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence OPT.Ndop, subclass = ", (LONGINT)55);
- OPM_LogWNum(subclass, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence OPT.Ndop, subclass = ", 55);
+ OPM_LogWNum(subclass, 0);
OPM_LogWLn();
break;
}
break;
case 10:
- _o_result = 10;
- return _o_result;
+ return 10;
break;
case 8: case 6:
- _o_result = 12;
- return _o_result;
+ return 12;
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence, class = ", (LONGINT)43);
- OPM_LogWNum(class, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence, class = ", 43);
+ OPM_LogWNum(class, 0);
OPM_LogWLn();
break;
}
__RETCHK;
}
-static void OPV_Len (OPT_Node n, LONGINT dim)
+static void OPV_Len (OPT_Node n, INT64 dim)
{
while ((n->class == 4 && n->typ->comp == 3)) {
dim += 1;
@@ -435,7 +323,7 @@ static void OPV_Len (OPT_Node n, LONGINT dim)
}
if ((n->class == 3 && n->typ->comp == 3)) {
OPV_design(n->left, 10);
- OPM_WriteString((CHAR*)"->len[", (LONGINT)7);
+ OPM_WriteString((CHAR*)"->len[", 7);
OPM_WriteInt(dim);
OPM_Write(']');
} else {
@@ -445,21 +333,18 @@ static void OPV_Len (OPT_Node n, LONGINT dim)
static BOOLEAN OPV_SideEffects (OPT_Node n)
{
- BOOLEAN _o_result;
if (n != NIL) {
- _o_result = (n->class == 13 || OPV_SideEffects(n->left)) || OPV_SideEffects(n->right);
- return _o_result;
+ return (n->class == 13 || OPV_SideEffects(n->left)) || OPV_SideEffects(n->right);
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-static void OPV_Entier (OPT_Node n, INTEGER prec)
+static void OPV_Entier (OPT_Node n, INT16 prec)
{
- if (__IN(n->typ->form, 0x0180)) {
- OPM_WriteString((CHAR*)"__ENTIER(", (LONGINT)10);
+ if (__IN(n->typ->form, 0x60, 32)) {
+ OPM_WriteString((CHAR*)"__ENTIER(", 10);
OPV_expr(n, -1);
OPM_Write(')');
} else {
@@ -467,44 +352,49 @@ static void OPV_Entier (OPT_Node n, INTEGER prec)
}
}
-static void OPV_SizeCast (LONGINT size)
+static void OPV_SizeCast (OPT_Node n, INT32 to)
{
- if (size <= 4) {
- OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
+ if ((to < n->typ->size && __IN(2, OPM_Options, 32))) {
+ OPM_WriteString((CHAR*)"__SHORT", 8);
+ if (OPV_SideEffects(n)) {
+ OPM_Write('F');
+ }
+ OPM_Write('(');
+ OPV_Entier(n, -1);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPM_WriteInt(OPM_SignedMaximum(to) + 1);
+ OPM_Write(')');
} else {
- OPM_WriteString((CHAR*)"(SYSTEM_INT64)", (LONGINT)15);
+ if ((n->typ->size != to && (n->typ->size > 4 || to != 4))) {
+ OPM_WriteString((CHAR*)"(INT", 5);
+ OPM_WriteInt(__ASHL(to, 3));
+ OPM_WriteString((CHAR*)")", 2);
+ }
}
}
-static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INTEGER prec)
+static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec)
{
- INTEGER from, to;
+ INT16 from, to;
from = n->typ->form;
to = newtype->form;
- if (to == 9) {
- OPM_WriteString((CHAR*)"__SETOF(", (LONGINT)9);
- OPV_Entier(n, -1);
- OPM_Write(')');
- } else if (__IN(to, 0x70)) {
- if ((newtype->size < n->typ->size && __IN(2, OPM_opt))) {
- OPM_WriteString((CHAR*)"__SHORT", (LONGINT)8);
- if (OPV_SideEffects(n)) {
- OPM_Write('F');
- }
- OPM_Write('(');
- OPV_Entier(n, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPM_WriteInt(OPM_SignedMaximum(newtype->size) + 1);
- OPM_Write(')');
- } else {
- if (newtype->size != n->typ->size) {
- OPV_SizeCast(newtype->size);
- }
+ 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);
+ OPM_WriteString((CHAR*)",", 2);
+ OPM_WriteInt(__ASHL(newtype->size, 3));
+ OPM_Write(')');
}
+ } else if (to == 4) {
+ OPV_SizeCast(n, newtype->size);
+ OPV_Entier(n, 9);
} else if (to == 3) {
- if (__IN(2, OPM_opt)) {
- OPM_WriteString((CHAR*)"__CHR", (LONGINT)6);
+ if (__IN(2, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__CHR", 6);
if (OPV_SideEffects(n)) {
OPM_Write('F');
}
@@ -512,7 +402,7 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INTEGER prec)
OPV_Entier(n, -1);
OPM_Write(')');
} else {
- OPM_WriteString((CHAR*)"(CHAR)", (LONGINT)7);
+ OPM_WriteString((CHAR*)"(CHAR)", 7);
OPV_Entier(n, 9);
}
} else {
@@ -522,15 +412,15 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INTEGER prec)
static void OPV_TypeOf (OPT_Node n)
{
- if (n->typ->form == 13) {
- OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10);
+ if (n->typ->form == 11) {
+ OPM_WriteString((CHAR*)"__TYPEOF(", 10);
OPV_expr(n, -1);
OPM_Write(')');
- } else if (__IN(n->class, 0x15)) {
+ } else if (__IN(n->class, 0x15, 32)) {
OPC_Andent(n->typ);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
} else if (n->class == 3) {
- OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__TYPEOF(", 10);
OPV_expr(n->left, -1);
OPM_Write(')');
} else if (n->class == 5) {
@@ -542,35 +432,35 @@ static void OPV_TypeOf (OPT_Node n)
}
}
-static void OPV_Index (OPT_Node n, OPT_Node d, INTEGER prec, INTEGER dim)
+static void OPV_Index (OPT_Node n, OPT_Node d, INT16 prec, INT16 dim)
{
- if (!OPV_inxchk || (n->right->class == 7 && (n->right->conval->intval == 0 || n->left->typ->comp != 3))) {
+ if (!__IN(0, OPM_Options, 32) || (n->right->class == 7 && (n->right->conval->intval == 0 || n->left->typ->comp != 3))) {
OPV_expr(n->right, prec);
} else {
if (OPV_SideEffects(n->right)) {
- OPM_WriteString((CHAR*)"__XF(", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__XF(", 6);
} else {
- OPM_WriteString((CHAR*)"__X(", (LONGINT)5);
+ OPM_WriteString((CHAR*)"__X(", 5);
}
OPV_expr(n->right, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_Len(d, dim);
OPM_Write(')');
}
}
-static void OPV_design (OPT_Node n, INTEGER prec)
+static void OPV_design (OPT_Node n, INT16 prec)
{
OPT_Object obj = NIL;
OPT_Struct typ = NIL;
- INTEGER class, designPrec, comp;
+ INT16 class, designPrec, comp;
OPT_Node d = NIL, x = NIL;
- INTEGER dims, i, _for__27;
+ INT16 dims, i, _for__26;
comp = n->typ->comp;
obj = n->obj;
class = n->class;
designPrec = OPV_Precedence(class, n->subcl, n->typ->form, comp);
- if ((((((class == 0 && obj->mnolev > 0)) && (int)obj->mnolev != OPM_level)) && prec == 10)) {
+ if ((((((class == 0 && obj->mnolev > 0)) && (INT16)obj->mnolev != OPM_level)) && prec == 10)) {
designPrec = 9;
}
if (prec > designPrec) {
@@ -587,7 +477,7 @@ static void OPV_design (OPT_Node n, INTEGER prec)
OPC_CompleteIdent(n->obj);
break;
case 1:
- if (!__IN(comp, 0x0c)) {
+ if (!__IN(comp, 0x0c, 32)) {
OPM_Write('*');
}
OPC_CompleteIdent(n->obj);
@@ -595,7 +485,7 @@ static void OPV_design (OPT_Node n, INTEGER prec)
case 2:
if (n->left->class == 3) {
OPV_design(n->left->left, designPrec);
- OPM_WriteString((CHAR*)"->", (LONGINT)3);
+ OPM_WriteString((CHAR*)"->", 3);
} else {
OPV_design(n->left, designPrec);
OPM_Write('.');
@@ -605,7 +495,7 @@ static void OPV_design (OPT_Node n, INTEGER prec)
case 3:
if (n->typ->comp == 3) {
OPV_design(n->left, 10);
- OPM_WriteString((CHAR*)"->data", (LONGINT)7);
+ OPM_WriteString((CHAR*)"->data", 7);
} else {
OPM_Write('*');
OPV_design(n->left, designPrec);
@@ -632,25 +522,25 @@ static void OPV_design (OPT_Node n, INTEGER prec)
while (x != d) {
if (x->left != d) {
OPV_Index(x, d, 7, i);
- OPM_WriteString((CHAR*)" + ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" + ", 4);
OPV_Len(d, i);
- OPM_WriteString((CHAR*)" * (", (LONGINT)5);
+ OPM_WriteString((CHAR*)" * (", 5);
i -= 1;
} else {
OPV_Index(x, d, -1, i);
}
x = x->left;
}
- _for__27 = dims;
+ _for__26 = dims;
i = 1;
- while (i <= _for__27) {
+ while (i <= _for__26) {
OPM_Write(')');
i += 1;
}
if (n->typ->comp == 3) {
OPM_Write(')');
- while ((SYSTEM_INT64)i < __ASHR(d->typ->size - 4, 2)) {
- OPM_WriteString((CHAR*)" * ", (LONGINT)4);
+ while (i < __ASHR(d->typ->size - 4, 2)) {
+ OPM_WriteString((CHAR*)" * ", 4);
OPV_Len(d, i);
i += 1;
}
@@ -666,35 +556,35 @@ static void OPV_design (OPT_Node n, INTEGER prec)
case 5:
typ = n->typ;
obj = n->left->obj;
- if (__IN(3, OPM_opt)) {
+ if (__IN(3, OPM_Options, 32)) {
if (typ->comp == 4) {
- OPM_WriteString((CHAR*)"__GUARDR(", (LONGINT)10);
- if ((int)obj->mnolev != OPM_level) {
- OPM_WriteStringVar((void*)obj->scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"__curr->", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__GUARDR(", 10);
+ if ((INT16)obj->mnolev != OPM_level) {
+ OPM_WriteStringVar((void*)obj->scope->name, 256);
+ OPM_WriteString((CHAR*)"__curr->", 9);
OPC_Ident(obj);
} else {
OPC_Ident(obj);
}
} else {
if (typ->BaseTyp->strobj == NIL) {
- OPM_WriteString((CHAR*)"__GUARDA(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__GUARDA(", 10);
} else {
- OPM_WriteString((CHAR*)"__GUARDP(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__GUARDP(", 10);
}
OPV_expr(n->left, -1);
typ = typ->BaseTyp;
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(typ->extlev);
OPM_Write(')');
} else {
if (typ->comp == 4) {
- OPM_WriteString((CHAR*)"*(", (LONGINT)3);
+ OPM_WriteString((CHAR*)"*(", 3);
OPC_Ident(typ->strobj);
- OPM_WriteString((CHAR*)"*)", (LONGINT)3);
+ OPM_WriteString((CHAR*)"*)", 3);
OPC_CompleteIdent(obj);
} else {
OPM_Write('(');
@@ -705,17 +595,17 @@ static void OPV_design (OPT_Node n, INTEGER prec)
}
break;
case 6:
- if (__IN(3, OPM_opt)) {
+ if (__IN(3, OPM_Options, 32)) {
if (n->left->class == 1) {
- OPM_WriteString((CHAR*)"__GUARDEQR(", (LONGINT)12);
+ OPM_WriteString((CHAR*)"__GUARDEQR(", 12);
OPC_CompleteIdent(n->left->obj);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_TypeOf(n->left);
} else {
- OPM_WriteString((CHAR*)"__GUARDEQP(", (LONGINT)12);
+ OPM_WriteString((CHAR*)"__GUARDEQP(", 12);
OPV_expr(n->left->left, -1);
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Ident(n->left->typ->strobj);
OPM_Write(')');
} else {
@@ -728,8 +618,8 @@ static void OPV_design (OPT_Node n, INTEGER prec)
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.design, class = ", (LONGINT)39);
- OPM_LogWNum(class, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.design, class = ", 39);
+ OPM_LogWNum(class, 0);
OPM_LogWLn();
break;
}
@@ -738,10 +628,15 @@ static void OPV_design (OPT_Node n, INTEGER prec)
}
}
+static void OPV_ParIntLiteral (INT64 n, INT32 size)
+{
+ OPM_WriteInt(n);
+}
+
static void OPV_ActualPar (OPT_Node n, OPT_Object fp)
{
OPT_Struct typ = NIL, aptyp = NIL;
- INTEGER comp, form, mode, prec, dim;
+ INT16 comp, form, mode, prec, dim;
OPM_Write('(');
while (n != NIL) {
typ = fp->typ;
@@ -752,81 +647,68 @@ static void OPV_ActualPar (OPT_Node n, OPT_Object fp)
if ((((mode == 2 && n->class == 11)) && n->subcl == 29)) {
OPM_Write('(');
OPC_Ident(n->typ->strobj);
- OPM_WriteString((CHAR*)"*)", (LONGINT)3);
+ OPM_WriteString((CHAR*)"*)", 3);
prec = 10;
}
- if (!__IN(n->typ->comp, 0x0c)) {
+ if (!__IN(n->typ->comp, 0x0c, 32)) {
if (mode == 2) {
- if ((OPV_ansi && typ != n->typ)) {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
+ if (typ != n->typ) {
+ OPM_WriteString((CHAR*)"(void*)", 8);
}
OPM_Write('&');
prec = 9;
- } else if (OPV_ansi) {
- if ((__IN(comp, 0x0c) && n->class == 7)) {
- OPM_WriteString((CHAR*)"(CHAR*)", (LONGINT)8);
- } else if ((((form == 13 && typ != n->typ)) && n->typ != OPT_niltyp)) {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
- }
} else {
- if ((__IN(form, 0x0180) && __IN(n->typ->form, 0x70))) {
- OPM_WriteString((CHAR*)"(double)", (LONGINT)9);
- prec = 9;
- } else if ((form == 6 && n->typ->form < 6)) {
- OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10);
- prec = 9;
+ if ((__IN(comp, 0x0c, 32) && n->class == 7)) {
+ OPM_WriteString((CHAR*)"(CHAR*)", 8);
+ } else if ((((form == 11 && typ != n->typ)) && n->typ != OPT_niltyp)) {
+ OPM_WriteString((CHAR*)"(void*)", 8);
}
}
- } else if (OPV_ansi) {
+ } else {
if ((((mode == 2 && typ != n->typ)) && prec == -1)) {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
+ OPM_WriteString((CHAR*)"(void*)", 8);
}
}
if ((((mode == 2 && n->class == 11)) && n->subcl == 29)) {
OPV_expr(n->left, prec);
- } else if ((((((form == 6 && n->class == 7)) && n->conval->intval <= OPM_SignedMaximum(OPM_IntSize))) && n->conval->intval >= OPM_SignedMinimum(OPM_IntSize))) {
- OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12);
- OPV_expr(n, prec);
- OPM_WriteString((CHAR*)"))", (LONGINT)3);
+ } else if ((form == 4 && n->class == 7)) {
+ OPV_ParIntLiteral(n->conval->intval, n->typ->size);
} else {
OPV_expr(n, prec);
}
if ((comp == 4 && mode == 2)) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_TypeOf(n);
} else if (comp == 3) {
if (n->class == 7) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10);
- OPM_WriteInt(n->conval->intval2);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPV_ParIntLiteral(n->conval->intval2, OPM_AddressSize);
} else {
aptyp = n->typ;
dim = 0;
while ((typ->comp == 3 && typ->BaseTyp->form != 1)) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_Len(n, dim);
typ = typ->BaseTyp;
aptyp = aptyp->BaseTyp;
dim += 1;
}
if ((typ->comp == 3 && typ->BaseTyp->form == 1)) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
while (aptyp->comp == 3) {
OPV_Len(n, dim);
- OPM_WriteString((CHAR*)" * ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" * ", 4);
dim += 1;
aptyp = aptyp->BaseTyp;
}
- OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12);
- OPM_WriteInt(aptyp->size);
- OPM_WriteString((CHAR*)"))", (LONGINT)3);
+ OPV_ParIntLiteral(aptyp->size, OPM_AddressSize);
}
}
}
n = n->link;
fp = fp->link;
if (n != NIL) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
}
}
OPM_Write(')');
@@ -834,21 +716,19 @@ static void OPV_ActualPar (OPT_Node n, OPT_Object fp)
static OPT_Object OPV_SuperProc (OPT_Node n)
{
- OPT_Object _o_result;
OPT_Object obj = NIL;
OPT_Struct typ = NIL;
typ = n->right->typ;
- if (typ->form == 13) {
+ if (typ->form == 11) {
typ = typ->BaseTyp;
}
OPT_FindField(n->left->obj->name, typ->BaseTyp, &obj);
- _o_result = obj;
- return _o_result;
+ return obj;
}
-static void OPV_expr (OPT_Node n, INTEGER prec)
+static void OPV_expr (OPT_Node n, INT16 prec)
{
- INTEGER class, subclass, form, exprPrec;
+ INT16 class, subclass, form, exprPrec;
OPT_Struct typ = NIL;
OPT_Node l = NIL, r = NIL;
OPT_Object proc = NIL;
@@ -858,7 +738,7 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
l = n->left;
r = n->right;
exprPrec = OPV_Precedence(class, subclass, form, n->typ->comp);
- if ((exprPrec <= prec && __IN(class, 0x3ce0))) {
+ if ((exprPrec <= prec && __IN(class, 0x3ce0, 32))) {
OPM_Write('(');
}
switch (class) {
@@ -866,10 +746,12 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPC_Constant(n->conval, form);
break;
case 10:
- OPM_WriteString((CHAR*)"__SETRNG(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__SETRNG(", 10);
OPV_expr(l, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(r, -1);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPM_WriteInt(__ASHL(n->typ->size, 3));
OPM_Write(')');
break;
case 11:
@@ -879,7 +761,7 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPV_expr(l, exprPrec);
break;
case 7:
- if (form == 9) {
+ if (form == 7) {
OPM_Write('~');
} else {
OPM_Write('-');
@@ -889,16 +771,16 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
case 16:
typ = n->obj->typ;
if (l->typ->comp == 4) {
- OPM_WriteString((CHAR*)"__IS(", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__IS(", 6);
OPC_TypeOf(l->obj);
} else {
- OPM_WriteString((CHAR*)"__ISP(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__ISP(", 7);
OPV_expr(l, -1);
typ = typ->BaseTyp;
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(typ->extlev);
OPM_Write(')');
break;
@@ -907,54 +789,54 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
break;
case 21:
if (OPV_SideEffects(l)) {
- if (l->typ->form < 7) {
- if (l->typ->form < 6) {
- OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
+ if (l->typ->form < 5) {
+ if (l->typ->size <= 4) {
+ OPM_WriteString((CHAR*)"(int)", 6);
}
- OPM_WriteString((CHAR*)"__ABSF(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ABSF(", 8);
} else {
- OPM_WriteString((CHAR*)"__ABSFD(", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__ABSFD(", 9);
}
} else {
- OPM_WriteString((CHAR*)"__ABS(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__ABS(", 7);
}
OPV_expr(l, -1);
OPM_Write(')');
break;
case 22:
- OPM_WriteString((CHAR*)"__CAP(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__CAP(", 7);
OPV_expr(l, -1);
OPM_Write(')');
break;
case 23:
- OPM_WriteString((CHAR*)"__ODD(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__ODD(", 7);
OPV_expr(l, -1);
OPM_Write(')');
break;
case 24:
- OPM_WriteString((CHAR*)"(LONGINT)(SYSTEM_ADDRESS)", (LONGINT)26);
+ OPM_WriteString((CHAR*)"(ADDRESS)", 10);
if (l->class == 1) {
OPC_CompleteIdent(l->obj);
} else {
- if ((l->typ->form != 10 && !__IN(l->typ->comp, 0x0c))) {
+ if ((l->typ->form != 8 && !__IN(l->typ->comp, 0x0c, 32))) {
OPM_Write('&');
}
OPV_expr(l, exprPrec);
}
break;
case 29:
- if (!__IN(l->class, 0x17) || (((__IN(n->typ->form, 0x6240) && __IN(l->typ->form, 0x6240))) && n->typ->size == l->typ->size)) {
+ if (!__IN(l->class, 0x17, 32) || (((__IN(n->typ->form, 0x1890, 32) && __IN(l->typ->form, 0x1890, 32))) && n->typ->size == l->typ->size)) {
OPM_Write('(');
OPC_Ident(n->typ->strobj);
OPM_Write(')');
- if (__IN(n->typ->form, 0x6000) || __IN(l->typ->form, 0x6000)) {
- OPM_WriteString((CHAR*)"(SYSTEM_ADDRESS)", (LONGINT)17);
+ if (__IN(n->typ->form, 0x1800, 32) || __IN(l->typ->form, 0x1800, 32)) {
+ OPM_WriteString((CHAR*)"(ADDRESS)", 10);
}
OPV_expr(l, exprPrec);
} else {
- OPM_WriteString((CHAR*)"__VAL(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__VAL(", 7);
OPC_Ident(n->typ->strobj);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(l, -1);
OPM_Write(')');
}
@@ -973,94 +855,98 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
case 28: case 3: case 4:
switch (subclass) {
case 15:
- OPM_WriteString((CHAR*)"__IN(", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__IN(", 6);
break;
case 17:
if (r->class == 7) {
if (r->conval->intval >= 0) {
- OPM_WriteString((CHAR*)"__ASHL(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ASHL(", 8);
} else {
- OPM_WriteString((CHAR*)"__ASHR(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ASHR(", 8);
}
} else if (OPV_SideEffects(r)) {
- OPM_WriteString((CHAR*)"__ASHF(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ASHF(", 8);
} else {
- OPM_WriteString((CHAR*)"__ASH(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__ASH(", 7);
}
break;
case 18:
- OPM_WriteString((CHAR*)"__MASK(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__MASK(", 8);
break;
case 26:
- OPM_WriteString((CHAR*)"__BIT(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__BIT(", 7);
break;
case 27:
if (r->class == 7) {
if (r->conval->intval >= 0) {
- OPM_WriteString((CHAR*)"__LSHL(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__LSHL(", 8);
} else {
- OPM_WriteString((CHAR*)"__LSHR(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__LSHR(", 8);
}
} else {
- OPM_WriteString((CHAR*)"__LSH(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__LSH(", 7);
}
break;
case 28:
if (r->class == 7) {
if (r->conval->intval >= 0) {
- OPM_WriteString((CHAR*)"__ROTL(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ROTL(", 8);
} else {
- OPM_WriteString((CHAR*)"__ROTR(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ROTR(", 8);
}
} else {
- OPM_WriteString((CHAR*)"__ROT(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__ROT(", 7);
}
break;
case 3:
if (OPV_SideEffects(n)) {
- if (form < 6) {
- OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
+ if (n->typ->size <= 4) {
+ OPM_WriteString((CHAR*)"(int)", 6);
}
- OPM_WriteString((CHAR*)"__DIVF(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__DIVF(", 8);
} else {
- OPM_WriteString((CHAR*)"__DIV(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__DIV(", 7);
}
break;
case 4:
- if (form < 6) {
- OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
+ if (n->typ->size <= 4) {
+ OPM_WriteString((CHAR*)"(int)", 6);
}
if (OPV_SideEffects(n)) {
- OPM_WriteString((CHAR*)"__MODF(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__MODF(", 8);
} else {
- OPM_WriteString((CHAR*)"__MOD(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__MOD(", 7);
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", (LONGINT)40);
- OPM_LogWNum(subclass, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", 40);
+ OPM_LogWNum(subclass, 0);
OPM_LogWLn();
break;
}
OPV_expr(l, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- if ((((__IN(subclass, 0x18020000) && r->class == 7)) && r->conval->intval < 0)) {
+ OPM_WriteString((CHAR*)", ", 3);
+ if ((((__IN(subclass, 0x18020000, 32) && r->class == 7)) && r->conval->intval < 0)) {
OPM_WriteInt(-r->conval->intval);
} else {
OPV_expr(r, -1);
}
- if (__IN(subclass, 0x18000000)) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPC_Ident(l->typ->strobj);
+ if (__IN(subclass, 0x18008000, 32)) {
+ OPM_WriteString((CHAR*)", ", 3);
+ if (subclass == 15) {
+ OPM_WriteInt(__ASHL(r->typ->size, 3));
+ } else {
+ OPM_WriteInt(__ASHL(l->typ->size, 3));
+ }
}
OPM_Write(')');
break;
case 9: case 10: case 11: case 12: case 13:
case 14:
- if (__IN(l->typ->form, 0x8400)) {
- OPM_WriteString((CHAR*)"__STRCMP(", (LONGINT)10);
+ if (__IN(l->typ->form, 0x2100, 32)) {
+ OPM_WriteString((CHAR*)"__STRCMP(", 10);
OPV_expr(l, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(r, -1);
OPM_Write(')');
OPC_Cmp(subclass);
@@ -1069,31 +955,31 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPV_expr(l, exprPrec);
OPC_Cmp(subclass);
typ = l->typ;
- if ((((((typ->form == 13 && r->typ->form != 11)) && r->typ != typ)) && r->typ != OPT_sysptrtyp)) {
- OPM_WriteString((CHAR*)"(void *) ", (LONGINT)10);
+ if ((((((typ->form == 11 && r->typ->form != 9)) && r->typ != typ)) && r->typ != OPT_sysptrtyp)) {
+ OPM_WriteString((CHAR*)"(void *) ", 10);
}
OPV_expr(r, exprPrec);
}
break;
default:
- if (subclass == 5 || (form == 9 && (subclass == 1 || subclass == 7))) {
+ if (subclass == 5 || (form == 7 && (subclass == 1 || subclass == 7))) {
OPM_Write('(');
}
OPV_expr(l, exprPrec);
switch (subclass) {
case 1:
- if (form == 9) {
- OPM_WriteString((CHAR*)" & ", (LONGINT)4);
+ if (form == 7) {
+ OPM_WriteString((CHAR*)" & ", 4);
} else {
- OPM_WriteString((CHAR*)" * ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" * ", 4);
}
break;
case 2:
- if (form == 9) {
- OPM_WriteString((CHAR*)" ^ ", (LONGINT)4);
+ if (form == 7) {
+ OPM_WriteString((CHAR*)" ^ ", 4);
} else {
- OPM_WriteString((CHAR*)" / ", (LONGINT)4);
- if (r->obj == NIL || __IN(r->obj->typ->form, 0x70)) {
+ OPM_WriteString((CHAR*)" / ", 4);
+ if (r->obj == NIL || r->obj->typ->form == 4) {
OPM_Write('(');
OPC_Ident(n->typ->strobj);
OPM_Write(')');
@@ -1101,33 +987,33 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
}
break;
case 5:
- OPM_WriteString((CHAR*)" && ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" && ", 5);
break;
case 6:
- if (form == 9) {
- OPM_WriteString((CHAR*)" | ", (LONGINT)4);
+ if (form == 7) {
+ OPM_WriteString((CHAR*)" | ", 4);
} else {
- OPM_WriteString((CHAR*)" + ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" + ", 4);
}
break;
case 7:
- if (form == 9) {
- OPM_WriteString((CHAR*)" & ~", (LONGINT)5);
+ if (form == 7) {
+ OPM_WriteString((CHAR*)" & ~", 5);
} else {
- OPM_WriteString((CHAR*)" - ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" - ", 4);
}
break;
case 8:
- OPM_WriteString((CHAR*)" || ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" || ", 5);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", (LONGINT)40);
- OPM_LogWNum(subclass, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", 40);
+ OPM_LogWNum(subclass, 0);
OPM_LogWLn();
break;
}
OPV_expr(r, exprPrec);
- if (subclass == 5 || (form == 9 && (subclass == 1 || subclass == 7))) {
+ if (subclass == 5 || (form == 7 && (subclass == 1 || subclass == 7))) {
OPM_Write(')');
}
break;
@@ -1138,7 +1024,7 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
if (l->subcl == 1) {
proc = OPV_SuperProc(n);
} else {
- OPM_WriteString((CHAR*)"__", (LONGINT)3);
+ OPM_WriteString((CHAR*)"__", 3);
proc = OPC_BaseTProc(l->obj);
}
OPC_Ident(proc);
@@ -1154,7 +1040,7 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPV_design(n, prec);
break;
}
- if ((exprPrec <= prec && __IN(class, 0x3ca0))) {
+ if ((exprPrec <= prec && __IN(class, 0x3ca0, 32))) {
OPM_Write(')');
}
}
@@ -1164,10 +1050,10 @@ static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc)
OPT_Node if_ = NIL;
OPT_Object obj = NIL;
OPT_Struct typ = NIL;
- LONGINT adr;
+ INT32 adr;
if_ = n->left;
while (if_ != NIL) {
- OPM_WriteString((CHAR*)"if ", (LONGINT)4);
+ OPM_WriteString((CHAR*)"if ", 4);
OPV_expr(if_->left, 12);
OPM_Write(' ');
OPC_BegBlk();
@@ -1178,9 +1064,9 @@ static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc)
if (typ->comp == 4) {
OPC_BegStat();
OPC_Ident(if_->left->obj);
- OPM_WriteString((CHAR*)" *", (LONGINT)3);
- OPM_WriteString(obj->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"__ = (void*)", (LONGINT)13);
+ OPM_WriteString((CHAR*)" *", 3);
+ OPM_WriteString(obj->name, 256);
+ OPM_WriteString((CHAR*)"__ = (void*)", 13);
obj->adr = 0;
OPC_CompleteIdent(obj);
OPC_EndStat();
@@ -1196,13 +1082,13 @@ static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc)
if_ = if_->link;
if ((if_ != NIL || n->right != NIL) || withtrap) {
OPC_EndBlk0();
- OPM_WriteString((CHAR*)" else ", (LONGINT)7);
+ OPM_WriteString((CHAR*)" else ", 7);
} else {
OPC_EndBlk();
}
}
if (withtrap) {
- OPM_WriteString((CHAR*)"__WITHCHK", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__WITHCHK", 10);
OPC_EndStat();
} else if (n->right != NIL) {
OPC_BegBlk();
@@ -1214,9 +1100,9 @@ static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc)
static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc)
{
OPT_Node switchCase = NIL, label = NIL;
- LONGINT low, high;
- INTEGER form, i;
- OPM_WriteString((CHAR*)"switch ", (LONGINT)8);
+ INT64 low, high;
+ INT16 form, i;
+ OPM_WriteString((CHAR*)"switch ", 8);
OPV_expr(n->left, 12);
OPM_Write(' ');
OPC_BegBlk();
@@ -1248,22 +1134,22 @@ static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc)
OPC_Indent(1);
OPV_stat(switchCase->right, outerProc);
OPC_BegStat();
- OPM_WriteString((CHAR*)"break", (LONGINT)6);
+ OPM_WriteString((CHAR*)"break", 6);
OPC_EndStat();
OPC_Indent(-1);
switchCase = switchCase->link;
}
OPC_BegStat();
- OPM_WriteString((CHAR*)"default: ", (LONGINT)10);
+ OPM_WriteString((CHAR*)"default: ", 10);
if (n->right->conval->setval != 0x0) {
OPC_Indent(1);
OPM_WriteLn();
OPV_stat(n->right->right, outerProc);
OPC_BegStat();
- OPM_WriteString((CHAR*)"break", (LONGINT)6);
+ OPM_WriteString((CHAR*)"break", 6);
OPC_Indent(-1);
} else {
- OPM_WriteString((CHAR*)"__CASECHK", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__CASECHK", 10);
}
OPC_EndStat();
OPC_EndBlk();
@@ -1271,18 +1157,16 @@ static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc)
static BOOLEAN OPV_ImplicitReturn (OPT_Node n)
{
- BOOLEAN _o_result;
while ((n != NIL && n->class != 26)) {
n = n->link;
}
- _o_result = n == NIL;
- return _o_result;
+ return n == NIL;
}
static void OPV_NewArr (OPT_Node d, OPT_Node x)
{
OPT_Struct typ = NIL, base = NIL;
- INTEGER nofdim, nofdyn;
+ INT16 nofdim, nofdyn;
typ = d->typ->BaseTyp;
base = typ;
nofdim = 0;
@@ -1293,44 +1177,40 @@ static void OPV_NewArr (OPT_Node d, OPT_Node x)
base = base->BaseTyp;
}
OPV_design(d, -1);
- OPM_WriteString((CHAR*)" = __NEWARR(", (LONGINT)13);
+ OPM_WriteString((CHAR*)" = __NEWARR(", 13);
while (base->comp == 2) {
nofdim += 1;
base = base->BaseTyp;
}
if ((base->comp == 4 && OPC_NofPtrs(base) != 0)) {
OPC_Ident(base->strobj);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
- } else if (base->form == 13) {
- OPM_WriteString((CHAR*)"POINTER__typ", (LONGINT)13);
+ OPM_WriteString((CHAR*)"__typ", 6);
+ } else if (base->form == 11) {
+ OPM_WriteString((CHAR*)"POINTER__typ", 13);
} else {
- OPM_WriteString((CHAR*)"NIL", (LONGINT)4);
+ OPM_WriteString((CHAR*)"NIL", 4);
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12);
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(base->size);
- OPM_WriteString((CHAR*)"))", (LONGINT)3);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPM_WriteInt(OPC_BaseAlignment(base));
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPM_WriteInt(OPT_BaseAlignment(base));
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(nofdim);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(nofdyn);
while (typ != base) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
if (typ->comp == 3) {
if (x->class == 7) {
- OPM_WriteString((CHAR*)"(LONGINT)(", (LONGINT)11);
- OPV_expr(x, -1);
- OPM_WriteString((CHAR*)")", (LONGINT)2);
+ OPC_IntLiteral(x->conval->intval, OPM_AddressSize);
} else {
- OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10);
+ OPM_WriteString((CHAR*)"((ADDRESS)(", 12);
OPV_expr(x, 10);
+ OPM_WriteString((CHAR*)"))", 3);
}
x = x->link;
} else {
- OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10);
- OPM_WriteInt(typ->n);
+ OPC_IntLiteral(typ->n, OPM_AddressSize);
}
typ = typ->BaseTyp;
}
@@ -1359,7 +1239,7 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPV_ExitInfo saved;
OPT_Node l = NIL, r = NIL;
while ((n != NIL && OPM_noerr)) {
- OPM_errpos = n->conval->intval;
+ OPM_errpos = OPM_Longint(n->conval->intval);
if (n->class != 14) {
OPC_BegStat();
}
@@ -1373,7 +1253,7 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPV_DefineTDescs(n->right);
OPC_EnterBody();
OPV_InitTDescs(n->right);
- OPM_WriteString((CHAR*)"/* BEGIN */", (LONGINT)12);
+ OPM_WriteString((CHAR*)"/* BEGIN */", 12);
OPM_WriteLn();
OPV_stat(n->right, outerProc);
OPC_ExitBody();
@@ -1399,11 +1279,11 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
l = n->left;
r = n->right;
if (l->typ->comp == 2) {
- OPM_WriteString((CHAR*)"__MOVE(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__MOVE(", 8);
OPV_expr(r, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(l, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
if (r->typ == OPT_stringtyp) {
OPM_WriteInt(r->conval->intval2);
} else {
@@ -1411,30 +1291,30 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
}
OPM_Write(')');
} else {
- if ((((((l->typ->form == 13 && l->obj != NIL)) && l->obj->adr == 1)) && l->obj->mode == 1)) {
+ if ((((((l->typ->form == 11 && l->obj != NIL)) && l->obj->adr == 1)) && l->obj->mode == 1)) {
l->obj->adr = 0;
OPV_design(l, -1);
l->obj->adr = 1;
- if (r->typ->form != 11) {
- OPM_WriteString((CHAR*)" = (void*)", (LONGINT)11);
+ if (r->typ->form != 9) {
+ OPM_WriteString((CHAR*)" = (void*)", 11);
} else {
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" = ", 4);
}
} else {
OPV_design(l, -1);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" = ", 4);
}
if (l->typ == r->typ) {
OPV_expr(r, -1);
- } else if ((((l->typ->form == 13 && r->typ->form != 11)) && l->typ->strobj != NIL)) {
+ } else if ((((l->typ->form == 11 && r->typ->form != 9)) && l->typ->strobj != NIL)) {
OPM_Write('(');
OPC_Ident(l->typ->strobj);
OPM_Write(')');
OPV_expr(r, -1);
} else if (l->typ->comp == 4) {
- OPM_WriteString((CHAR*)"*(", (LONGINT)3);
+ OPM_WriteString((CHAR*)"*(", 3);
OPC_Andent(l->typ);
- OPM_WriteString((CHAR*)"*)&", (LONGINT)4);
+ OPM_WriteString((CHAR*)"*)&", 4);
OPV_expr(r, 9);
} else {
OPV_expr(r, -1);
@@ -1443,12 +1323,12 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
break;
case 1:
if (n->left->typ->BaseTyp->comp == 4) {
- OPM_WriteString((CHAR*)"__NEW(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__NEW(", 7);
OPV_design(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Andent(n->left->typ->BaseTyp);
- OPM_WriteString((CHAR*)")", (LONGINT)2);
- } else if (__IN(n->left->typ->BaseTyp->comp, 0x0c)) {
+ OPM_WriteString((CHAR*)")", 2);
+ } else if (__IN(n->left->typ->BaseTyp->comp, 0x0c, 32)) {
OPV_NewArr(n->left, n->right);
}
break;
@@ -1460,43 +1340,45 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
case 15: case 16:
OPV_expr(n->left, -1);
OPC_SetInclude(n->subcl == 16);
- OPM_WriteString((CHAR*)"__SETOF(", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__SETOF(", 9);
OPV_expr(n->right, -1);
+ OPM_WriteString((CHAR*)",", 2);
+ OPM_WriteInt(__ASHL(n->left->typ->size, 3));
OPM_Write(')');
break;
case 18:
- OPM_WriteString((CHAR*)"__COPY(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__COPY(", 8);
OPV_expr(n->right, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPV_Len(n->left, ((LONGINT)(0)));
+ OPM_WriteString((CHAR*)", ", 3);
+ OPV_Len(n->left, 0);
OPM_Write(')');
break;
case 31:
- OPM_WriteString((CHAR*)"__MOVE(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__MOVE(", 8);
OPV_expr(n->right, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->right->link, -1);
OPM_Write(')');
break;
case 24:
- OPM_WriteString((CHAR*)"__GET(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__GET(", 7);
OPV_expr(n->right, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Ident(n->left->typ->strobj);
OPM_Write(')');
break;
case 25:
- OPM_WriteString((CHAR*)"__PUT(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__PUT(", 7);
OPV_expr(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->right, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Ident(n->right->typ->strobj);
OPM_Write(')');
break;
@@ -1504,15 +1386,15 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPM_err(200);
break;
case 30:
- OPM_WriteString((CHAR*)"__SYSNEW(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__SYSNEW(", 10);
OPV_design(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->right, -1);
OPM_Write(')');
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.subcl = ", (LONGINT)40);
- OPM_LogWNum(n->subcl, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.subcl = ", 40);
+ OPM_LogWNum(n->subcl, 0);
OPM_LogWLn();
break;
}
@@ -1522,7 +1404,7 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
if (n->left->subcl == 1) {
proc = OPV_SuperProc(n);
} else {
- OPM_WriteString((CHAR*)"__", (LONGINT)3);
+ OPM_WriteString((CHAR*)"__", 3);
proc = OPC_BaseTProc(n->left->obj);
}
OPC_Ident(proc);
@@ -1537,10 +1419,10 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
case 20:
if (n->subcl != 32) {
OPV_IfStat(n, 0, outerProc);
- } else if (OPV_assert) {
- OPM_WriteString((CHAR*)"__ASSERT(", (LONGINT)10);
+ } else if (__IN(7, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__ASSERT(", 10);
OPV_expr(n->left->left->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(n->left->right->right->conval->intval);
OPM_Write(')');
OPC_EndStat();
@@ -1553,7 +1435,7 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
break;
case 22:
OPV_exit.level += 1;
- OPM_WriteString((CHAR*)"while ", (LONGINT)7);
+ OPM_WriteString((CHAR*)"while ", 7);
OPV_expr(n->left, 12);
OPM_Write(' ');
OPC_BegBlk();
@@ -1563,11 +1445,11 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
break;
case 23:
OPV_exit.level += 1;
- OPM_WriteString((CHAR*)"do ", (LONGINT)4);
+ OPM_WriteString((CHAR*)"do ", 4);
OPC_BegBlk();
OPV_stat(n->left, outerProc);
OPC_EndBlk0();
- OPM_WriteString((CHAR*)" while (!", (LONGINT)10);
+ OPM_WriteString((CHAR*)" while (!", 10);
OPV_expr(n->right, 9);
OPM_Write(')');
OPV_exit.level -= 1;
@@ -1576,13 +1458,13 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
saved = OPV_exit;
OPV_exit.level = 0;
OPV_exit.label = -1;
- OPM_WriteString((CHAR*)"for (;;) ", (LONGINT)10);
+ OPM_WriteString((CHAR*)"for (;;) ", 10);
OPC_BegBlk();
OPV_stat(n->left, outerProc);
OPC_EndBlk();
if (OPV_exit.label != -1) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"exit__", (LONGINT)7);
+ OPM_WriteString((CHAR*)"exit__", 7);
OPM_WriteInt(OPV_exit.label);
OPM_Write(':');
OPC_EndStat();
@@ -1591,39 +1473,48 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
break;
case 25:
if (OPV_exit.level == 0) {
- OPM_WriteString((CHAR*)"break", (LONGINT)6);
+ OPM_WriteString((CHAR*)"break", 6);
} else {
if (OPV_exit.label == -1) {
OPV_exit.label = OPV_nofExitLabels;
OPV_nofExitLabels += 1;
}
- OPM_WriteString((CHAR*)"goto exit__", (LONGINT)12);
+ OPM_WriteString((CHAR*)"goto exit__", 12);
OPM_WriteInt(OPV_exit.label);
}
break;
case 26:
if (OPM_level == 0) {
- if (OPV_mainprog) {
- OPM_WriteString((CHAR*)"__FINI", (LONGINT)7);
+ if (__IN(10, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__FINI", 7);
} else {
- OPM_WriteString((CHAR*)"__ENDMOD", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__ENDMOD", 9);
}
+ } else if (OPC_NeedsRetval(outerProc)) {
+ OPM_WriteString((CHAR*)"__retval = ", 12);
+ if ((n->left->typ->form == 11 && n->obj->typ != n->left->typ)) {
+ OPM_WriteString((CHAR*)"(void*)", 8);
+ OPV_expr(n->left, 10);
+ } else {
+ OPV_expr(n->left, -1);
+ }
+ OPC_EndStat();
+ OPC_BegStat();
+ OPC_ExitProc(outerProc, 0, 0);
+ OPC_EndStat();
+ OPC_BegStat();
+ OPM_WriteString((CHAR*)"return __retval", 16);
} else {
+ OPC_ExitProc(outerProc, 0, 0);
+ OPM_WriteString((CHAR*)"return", 7);
if (n->left != NIL) {
- OPM_WriteString((CHAR*)"_o_result = ", (LONGINT)13);
- if ((n->left->typ->form == 13 && n->obj->typ != n->left->typ)) {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
+ OPM_Write(' ');
+ if ((n->left->typ->form == 11 && n->obj->typ != n->left->typ)) {
+ OPM_WriteString((CHAR*)"(void*)", 8);
OPV_expr(n->left, 10);
} else {
OPV_expr(n->left, -1);
}
- OPM_WriteString((CHAR*)";", (LONGINT)2);
- OPM_WriteLn();
- OPC_BegStat();
- OPC_ExitProc(outerProc, 0, 0);
- OPM_WriteString((CHAR*)"return _o_result", (LONGINT)17);
- } else {
- OPM_WriteString((CHAR*)"return", (LONGINT)7);
}
}
break;
@@ -1631,15 +1522,15 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPV_IfStat(n, n->subcl == 0, outerProc);
break;
case 28:
- OPC_Halt(n->right->conval->intval);
+ OPC_Halt(OPM_Longint(n->right->conval->intval));
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.class = ", (LONGINT)40);
- OPM_LogWNum(n->class, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.class = ", 40);
+ OPM_LogWNum(n->class, 0);
OPM_LogWLn();
break;
}
- if (!__IN(n->class, 0x09744000)) {
+ if (!__IN(n->class, 0x09744000, 32)) {
OPC_EndStat();
}
n = n->link;
@@ -1648,7 +1539,7 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
void OPV_Module (OPT_Node prog)
{
- if (!OPV_mainprog) {
+ if (!__IN(10, OPM_Options, 32)) {
OPC_GenHdr(prog->right);
OPC_GenHdrIncludes();
}
@@ -1656,7 +1547,7 @@ void OPV_Module (OPT_Node prog)
OPV_stat(prog, NIL);
}
-__TDESC(OPV_ExitInfo, 1, 0) = {__TDFLDS("ExitInfo", 8), {-8}};
+__TDESC(OPV_ExitInfo, 1, 0) = {__TDFLDS("ExitInfo", 4), {-8}};
export void *OPV__init(void)
{
diff --git a/bootstrap/unix-88/OPV.h b/bootstrap/unix-88/OPV.h
index 4eba5b89..c4a61586 100644
--- a/bootstrap/unix-88/OPV.h
+++ b/bootstrap/unix-88/OPV.h
@@ -1,9 +1,8 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPV__h
#define OPV__h
-#define LARGE
#include "SYSTEM.h"
#include "OPT.h"
@@ -13,8 +12,7 @@
import void OPV_AdrAndSize (OPT_Object topScope);
import void OPV_Init (void);
import void OPV_Module (OPT_Node prog);
-import void OPV_TypSize (OPT_Struct typ);
import void *OPV__init(void);
-#endif
+#endif // OPV
diff --git a/bootstrap/unix-88/Out.c b/bootstrap/unix-88/Out.c
new file mode 100644
index 00000000..39f383cf
--- /dev/null
+++ b/bootstrap/unix-88/Out.c
@@ -0,0 +1,318 @@
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
+#include "SYSTEM.h"
+#include "Platform.h"
+
+
+export BOOLEAN Out_IsConsole;
+static CHAR Out_buf[128];
+static INT16 Out_in;
+
+
+export void Out_Char (CHAR ch);
+export void Out_Flush (void);
+export void Out_Int (INT64 x, INT64 n);
+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, LONGINT str__len);
+export LONGREAL Out_Ten (INT16 e);
+static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i);
+static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i);
+
+#define Out_Entier64(x) (INT64)(x)
+
+void Out_Flush (void)
+{
+ INT16 error;
+ if (Out_in > 0) {
+ error = Platform_Write(1, (ADDRESS)Out_buf, Out_in);
+ }
+ Out_in = 0;
+}
+
+void Out_Open (void)
+{
+}
+
+void Out_Char (CHAR ch)
+{
+ if (Out_in >= 128) {
+ Out_Flush();
+ }
+ Out_buf[__X(Out_in, 128)] = ch;
+ Out_in += 1;
+ if (ch == 0x0a) {
+ Out_Flush();
+ }
+}
+
+static INT32 Out_Length (CHAR *s, LONGINT s__len)
+{
+ INT32 l;
+ l = 0;
+ while ((l < s__len && s[__X(l, s__len)] != 0x00)) {
+ l += 1;
+ }
+ return l;
+}
+
+void Out_String (CHAR *str, LONGINT str__len)
+{
+ INT32 l;
+ INT16 error;
+ __DUP(str, str__len, CHAR);
+ l = Out_Length((void*)str, str__len);
+ if (Out_in + l > 128) {
+ Out_Flush();
+ }
+ if (l > 128) {
+ error = Platform_Write(1, (ADDRESS)str, l);
+ } else {
+ __MOVE((ADDRESS)str, (ADDRESS)&Out_buf[__X(Out_in, 128)], l);
+ Out_in += (INT16)l;
+ }
+ __DEL(str);
+}
+
+void Out_Int (INT64 x, INT64 n)
+{
+ CHAR s[22];
+ INT16 i;
+ BOOLEAN negative;
+ negative = x < 0;
+ if (x == (-9223372036854775807-1)) {
+ __MOVE("8085774586302733229", s, 20);
+ i = 19;
+ } else {
+ if (x < 0) {
+ x = -x;
+ }
+ s[0] = (CHAR)(48 + __MOD(x, 10));
+ x = __DIV(x, 10);
+ i = 1;
+ while (x != 0) {
+ s[__X(i, 22)] = (CHAR)(48 + __MOD(x, 10));
+ x = __DIV(x, 10);
+ i += 1;
+ }
+ }
+ if (negative) {
+ s[__X(i, 22)] = '-';
+ i += 1;
+ }
+ while (n > (INT64)i) {
+ Out_Char(' ');
+ n -= 1;
+ }
+ while (i > 0) {
+ i -= 1;
+ Out_Char(s[__X(i, 22)]);
+ }
+}
+
+void Out_Ln (void)
+{
+ Out_String(Platform_NL, 3);
+ Out_Flush();
+}
+
+static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i)
+{
+ *i -= 1;
+ s[__X(*i, s__len)] = (CHAR)(__MOD(n, 10) + 48);
+}
+
+static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i)
+{
+ INT16 j;
+ INT32 l;
+ __DUP(t, t__len, CHAR);
+ l = Out_Length((void*)t, t__len);
+ if (l > *i) {
+ l = *i;
+ }
+ *i -= (INT16)l;
+ j = 0;
+ while (j < l) {
+ s[__X(*i + j, s__len)] = t[__X(j, t__len)];
+ j += 1;
+ }
+ __DEL(t);
+}
+
+LONGREAL Out_Ten (INT16 e)
+{
+ LONGREAL r, power;
+ r = (LONGREAL)1;
+ power = (LONGREAL)10;
+ while (e > 0) {
+ if (__ODD(e)) {
+ r = r * power;
+ }
+ power = power * power;
+ e = __ASHR(e, 1);
+ }
+ return r;
+}
+
+static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_)
+{
+ INT16 e;
+ INT64 f;
+ CHAR s[30];
+ INT16 i, el;
+ LONGREAL x0;
+ BOOLEAN nn, en;
+ INT64 m;
+ INT16 d, dr;
+ e = (INT16)__MASK(__ASHR((__VAL(INT64, x)), 52), -2048);
+ f = __MASK((__VAL(INT64, x)), -4503599627370496);
+ nn = (__VAL(INT64, x) < 0 && !((e == 2047 && f != 0)));
+ if (nn) {
+ n -= 1;
+ }
+ i = 30;
+ if (e == 2047) {
+ if (f == 0) {
+ Out_prepend((CHAR*)"Infinity", 9, (void*)s, 30, &i);
+ } else {
+ Out_prepend((CHAR*)"NaN", 4, (void*)s, 30, &i);
+ }
+ } else {
+ if (long_) {
+ el = 3;
+ dr = n - 6;
+ if (dr > 17) {
+ dr = 17;
+ }
+ d = dr;
+ if (d < 15) {
+ d = 15;
+ }
+ } else {
+ el = 2;
+ dr = n - 5;
+ if (dr > 9) {
+ dr = 9;
+ }
+ d = dr;
+ if (d < 6) {
+ d = 6;
+ }
+ }
+ if (e == 0) {
+ while (el > 0) {
+ i -= 1;
+ s[__X(i, 30)] = '0';
+ el -= 1;
+ }
+ i -= 1;
+ s[__X(i, 30)] = '+';
+ m = 0;
+ } else {
+ if (nn) {
+ x = -x;
+ }
+ e = (INT16)__ASHR((e - 1023) * 77, 8);
+ if (e >= 0) {
+ x = x / (LONGREAL)Out_Ten(e);
+ } else {
+ x = Out_Ten(-e) * x;
+ }
+ if (x >= (LONGREAL)10) {
+ x = 1.00000000000000e-001 * x;
+ e += 1;
+ }
+ en = e < 0;
+ if (en) {
+ e = -e;
+ }
+ while (el > 0) {
+ Out_digit(e, (void*)s, 30, &i);
+ e = __DIV(e, 10);
+ el -= 1;
+ }
+ i -= 1;
+ if (en) {
+ s[__X(i, 30)] = '-';
+ } else {
+ s[__X(i, 30)] = '+';
+ }
+ x0 = Out_Ten(d - 1);
+ x = x0 * x;
+ x = x + 5.00000000000000e-001;
+ if (x >= (LONGREAL)10 * x0) {
+ x = 1.00000000000000e-001 * x;
+ e += 1;
+ }
+ m = Out_Entier64(x);
+ }
+ i -= 1;
+ if (long_) {
+ s[__X(i, 30)] = 'D';
+ } else {
+ s[__X(i, 30)] = 'E';
+ }
+ if (dr < 2) {
+ dr = 2;
+ }
+ while ((d > dr && __MOD(m, 10) == 0)) {
+ m = __DIV(m, 10);
+ d -= 1;
+ }
+ while (d > 1) {
+ Out_digit(m, (void*)s, 30, &i);
+ m = __DIV(m, 10);
+ d -= 1;
+ }
+ i -= 1;
+ s[__X(i, 30)] = '.';
+ Out_digit(m, (void*)s, 30, &i);
+ }
+ n -= 30 - i;
+ while (n > 0) {
+ Out_Char(' ');
+ n -= 1;
+ }
+ if (nn) {
+ Out_Char('-');
+ }
+ while (i < 30) {
+ Out_Char(s[__X(i, 30)]);
+ i += 1;
+ }
+}
+
+void Out_Real (REAL x, INT16 n)
+{
+ Out_RealP(x, n, 0);
+}
+
+void Out_LongReal (LONGREAL x, INT16 n)
+{
+ Out_RealP(x, n, 1);
+}
+
+
+export void *Out__init(void)
+{
+ __DEFMOD;
+ __MODULE_IMPORT(Platform);
+ __REGMOD("Out", 0);
+ __REGCMD("Flush", Out_Flush);
+ __REGCMD("Ln", Out_Ln);
+ __REGCMD("Open", Out_Open);
+/* BEGIN */
+ Out_IsConsole = Platform_IsConsole(1);
+ Out_in = 0;
+ __ENDMOD;
+}
diff --git a/bootstrap/unix-88/Out.h b/bootstrap/unix-88/Out.h
new file mode 100644
index 00000000..0e66420d
--- /dev/null
+++ b/bootstrap/unix-88/Out.h
@@ -0,0 +1,24 @@
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#ifndef Out__h
+#define Out__h
+
+#include "SYSTEM.h"
+
+
+import BOOLEAN Out_IsConsole;
+
+
+import void Out_Char (CHAR ch);
+import void Out_Flush (void);
+import void Out_Int (INT64 x, INT64 n);
+import void Out_Ln (void);
+import void Out_LongReal (LONGREAL x, INT16 n);
+import void Out_Open (void);
+import void Out_Real (REAL x, INT16 n);
+import void Out_String (CHAR *str, LONGINT str__len);
+import LONGREAL Out_Ten (INT16 e);
+import void *Out__init(void);
+
+
+#endif // Out
diff --git a/bootstrap/unix-88/Platform.c b/bootstrap/unix-88/Platform.c
index c1a0ea9e..46e18441 100644
--- a/bootstrap/unix-88/Platform.c
+++ b/bootstrap/unix-88/Platform.c
@@ -1,5 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
typedef
@@ -9,90 +14,84 @@ typedef
Platform_ArgPtr (*Platform_ArgVec)[1024];
typedef
- LONGINT (*Platform_ArgVecPtr)[1];
+ INT64 (*Platform_ArgVecPtr)[1];
typedef
CHAR (*Platform_EnvPtr)[1024];
typedef
struct Platform_FileIdentity {
- LONGINT volume, index, mtime;
+ INT32 volume, index, mtime;
} Platform_FileIdentity;
typedef
- void (*Platform_HaltProcedure)(LONGINT);
+ void (*Platform_HaltProcedure)(INT32);
typedef
- void (*Platform_SignalHandler)(INTEGER);
+ void (*Platform_SignalHandler)(INT32);
export BOOLEAN Platform_LittleEndian;
-export LONGINT Platform_MainStackFrame, Platform_HaltCode;
-export INTEGER Platform_PID;
+export INT64 Platform_MainStackFrame;
+export INT16 Platform_PID;
export CHAR Platform_CWD[256];
-export INTEGER Platform_ArgCount;
-export LONGINT Platform_ArgVector;
+export INT16 Platform_ArgCount;
+export INT64 Platform_ArgVector;
static Platform_HaltProcedure Platform_HaltHandler;
-static LONGINT Platform_TimeStart;
-export INTEGER Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
-export CHAR Platform_nl[3];
+static INT32 Platform_TimeStart;
+export INT16 Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
+export CHAR Platform_NL[3];
-export LONGINT *Platform_FileIdentity__typ;
+export ADDRESS *Platform_FileIdentity__typ;
-export BOOLEAN Platform_Absent (INTEGER e);
-export INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len);
-export void Platform_AssertFail (LONGINT code);
-export INTEGER Platform_Chdir (CHAR *n, LONGINT n__len);
-export INTEGER Platform_Close (LONGINT h);
-export BOOLEAN Platform_ConnectionFailed (INTEGER e);
-export void Platform_Delay (LONGINT ms);
-export BOOLEAN Platform_DifferentFilesystems (INTEGER e);
-static void Platform_DisplayHaltCode (LONGINT code);
-export INTEGER Platform_Error (void);
-export void Platform_Exit (INTEGER code);
-export void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len);
-export void Platform_GetClock (LONGINT *t, LONGINT *d);
+export BOOLEAN Platform_Absent (INT16 e);
+export INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
+export INT16 Platform_Chdir (CHAR *n, LONGINT n__len);
+export INT16 Platform_Close (INT32 h);
+export BOOLEAN Platform_ConnectionFailed (INT16 e);
+export void Platform_Delay (INT32 ms);
+export BOOLEAN Platform_DifferentFilesystems (INT16 e);
+export INT16 Platform_Error (void);
+export void Platform_Exit (INT32 code);
+export void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len);
+export void Platform_GetClock (INT32 *t, INT32 *d);
export void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
-export void Platform_GetIntArg (INTEGER n, LONGINT *val);
-export void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec);
-export void Platform_Halt (LONGINT code);
-export INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ);
-export INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ);
-export BOOLEAN Platform_Inaccessible (INTEGER e);
-export void Platform_Init (INTEGER argc, LONGINT argvadr);
-export void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d);
-export INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h);
-export BOOLEAN Platform_NoSuchDirectory (INTEGER e);
-export LONGINT Platform_OSAllocate (LONGINT size);
-export void Platform_OSFree (LONGINT address);
-export INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h);
-export INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h);
-export INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n);
-export INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n);
-export INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
+export 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, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
+export BOOLEAN Platform_Inaccessible (INT16 e);
+export void Platform_Init (INT32 argc, INT64 argvadr);
+export BOOLEAN Platform_Interrupted (INT16 e);
+export BOOLEAN Platform_IsConsole (INT32 h);
+export void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d);
+export INT16 Platform_New (CHAR *n, LONGINT n__len, INT32 *h);
+export BOOLEAN Platform_NoSuchDirectory (INT16 e);
+export INT64 Platform_OSAllocate (INT64 size);
+export void Platform_OSFree (INT64 address);
+export INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h);
+export INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h);
+export INT16 Platform_Read (INT32 h, INT64 p, INT32 l, INT32 *n);
+export INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n);
+export INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
export BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2);
export BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2);
-export INTEGER Platform_Seek (LONGINT h, LONGINT offset, INTEGER whence);
+export INT16 Platform_Seek (INT32 h, INT32 offset, INT16 whence);
export void Platform_SetBadInstructionHandler (Platform_SignalHandler handler);
-export void Platform_SetHalt (Platform_HaltProcedure p);
export void Platform_SetInterruptHandler (Platform_SignalHandler handler);
-export void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source);
+export void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__typ, Platform_FileIdentity source);
export void Platform_SetQuitHandler (Platform_SignalHandler handler);
-export INTEGER Platform_Size (LONGINT h, LONGINT *l);
-export INTEGER Platform_Sync (LONGINT h);
-export INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len);
+export INT16 Platform_Size (INT32 h, INT32 *l);
+export INT16 Platform_Sync (INT32 h);
+export INT16 Platform_System (CHAR *cmd, LONGINT cmd__len);
static void Platform_TestLittleEndian (void);
-export LONGINT Platform_Time (void);
-export BOOLEAN Platform_TimedOut (INTEGER e);
-export BOOLEAN Platform_TooManyFiles (INTEGER e);
-export INTEGER Platform_Truncate (LONGINT h, LONGINT l);
-export INTEGER Platform_Unlink (CHAR *n, LONGINT n__len);
-export INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l);
-static void Platform_YMDHMStoClock (LONGINT ye, LONGINT mo, LONGINT da, LONGINT ho, LONGINT mi, LONGINT se, LONGINT *t, LONGINT *d);
-static void Platform_errch (CHAR c);
-static void Platform_errint (LONGINT l);
-static void Platform_errln (void);
-static void Platform_errposint (LONGINT l);
+export INT32 Platform_Time (void);
+export BOOLEAN Platform_TimedOut (INT16 e);
+export BOOLEAN Platform_TooManyFiles (INT16 e);
+export INT16 Platform_Truncate (INT32 h, INT32 l);
+export INT16 Platform_Unlink (CHAR *n, LONGINT n__len);
+export INT16 Platform_Write (INT32 h, INT64 p, INT32 l);
+static void Platform_YMDHMStoClock (INT32 ye, INT32 mo, INT32 da, INT32 ho, INT32 mi, INT32 se, INT32 *t, INT32 *d);
export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
#include
@@ -110,6 +109,7 @@ export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT
#define Platform_ECONNABORTED() ECONNABORTED
#define Platform_ECONNREFUSED() ECONNREFUSED
#define Platform_EHOSTUNREACH() EHOSTUNREACH
+#define Platform_EINTR() EINTR
#define Platform_EMFILE() EMFILE
#define Platform_ENETUNREACH() ENETUNREACH
#define Platform_ENFILE() ENFILE
@@ -119,14 +119,12 @@ export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT
#define Platform_EXDEV() EXDEV
extern void Heap_InitHeap();
#define Platform_HeapInitHeap() Heap_InitHeap()
-#define Platform_allocate(size) (LONGINT)(SYSTEM_ADDRESS)((void*)malloc((size_t)size))
+#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)
#define Platform_err() errno
-#define Platform_errc(c) write(1, &c, 1)
-#define Platform_errstring(s, s__len) write(1, s, s__len-1)
-#define Platform_exit(code) exit(code)
-#define Platform_free(address) free((void*)(SYSTEM_ADDRESS)address)
+#define Platform_exit(code) exit((int)code)
+#define Platform_free(address) free((void*)address)
#define Platform_fstat(fd) fstat(fd, &s)
#define Platform_fsync(fd) fsync(fd)
#define Platform_ftruncate(fd, l) ftruncate(fd, l)
@@ -134,23 +132,24 @@ extern void Heap_InitHeap();
#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)
#define Platform_lseek(fd, o, w) lseek(fd, o, w)
#define Platform_nanosleep(s, ns) struct timespec req, rem; req.tv_sec = s; req.tv_nsec = ns; nanosleep(&req, &rem)
#define Platform_opennew(n, n__len) open((char*)n, O_CREAT | O_TRUNC | O_RDWR, 0664)
#define Platform_openro(n, n__len) open((char*)n, O_RDONLY)
#define Platform_openrw(n, n__len) open((char*)n, O_RDWR)
-#define Platform_readfile(fd, p, l) read(fd, (void*)(SYSTEM_ADDRESS)(p), l)
+#define Platform_readfile(fd, p, l) (LONGINT)read(fd, (void*)(ADDRESS)(p), l)
#define Platform_rename(o, o__len, n, n__len) rename((char*)o, (char*)n)
#define Platform_sectotm(s) struct tm *time = localtime((time_t*)&s)
#define Platform_seekcur() SEEK_CUR
#define Platform_seekend() SEEK_END
#define Platform_seekset() SEEK_SET
-#define Platform_sethandler(s, h) SystemSetHandler(s, (SYSTEM_ADDRESS)h)
+#define Platform_sethandler(s, h) SystemSetHandler(s, (ADDRESS)h)
#define Platform_stat(n, n__len) stat((char*)n, &s)
#define Platform_statdev() (LONGINT)s.st_dev
#define Platform_statino() (LONGINT)s.st_ino
#define Platform_statmtime() (LONGINT)s.st_mtime
-#define Platform_statsize() (LONGINT)s.st_size
+#define Platform_statsize() (ADDRESS)s.st_size
#define Platform_structstats() struct stat s
#define Platform_system(str, str__len) system((char*)str)
#define Platform_tmhour() (LONGINT)time->tm_hour
@@ -162,92 +161,78 @@ extern void Heap_InitHeap();
#define Platform_tvsec() tv.tv_sec
#define Platform_tvusec() tv.tv_usec
#define Platform_unlink(n, n__len) unlink((char*)n)
-#define Platform_writefile(fd, p, l) write(fd, (void*)(SYSTEM_ADDRESS)(p), l)
+#define Platform_writefile(fd, p, l) write(fd, (void*)(ADDRESS)(p), l)
-BOOLEAN Platform_TooManyFiles (INTEGER e)
+BOOLEAN Platform_TooManyFiles (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = e == Platform_EMFILE() || e == Platform_ENFILE();
- return _o_result;
+ return e == Platform_EMFILE() || e == Platform_ENFILE();
}
-BOOLEAN Platform_NoSuchDirectory (INTEGER e)
+BOOLEAN Platform_NoSuchDirectory (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = e == Platform_ENOENT();
- return _o_result;
+ return e == Platform_ENOENT();
}
-BOOLEAN Platform_DifferentFilesystems (INTEGER e)
+BOOLEAN Platform_DifferentFilesystems (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = e == Platform_EXDEV();
- return _o_result;
+ return e == Platform_EXDEV();
}
-BOOLEAN Platform_Inaccessible (INTEGER e)
+BOOLEAN Platform_Inaccessible (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = (e == Platform_EACCES() || e == Platform_EROFS()) || e == Platform_EAGAIN();
- return _o_result;
+ return (e == Platform_EACCES() || e == Platform_EROFS()) || e == Platform_EAGAIN();
}
-BOOLEAN Platform_Absent (INTEGER e)
+BOOLEAN Platform_Absent (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = e == Platform_ENOENT();
- return _o_result;
+ return e == Platform_ENOENT();
}
-BOOLEAN Platform_TimedOut (INTEGER e)
+BOOLEAN Platform_TimedOut (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = e == Platform_ETIMEDOUT();
- return _o_result;
+ return e == Platform_ETIMEDOUT();
}
-BOOLEAN Platform_ConnectionFailed (INTEGER e)
+BOOLEAN Platform_ConnectionFailed (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = ((e == Platform_ECONNREFUSED() || e == Platform_ECONNABORTED()) || e == Platform_ENETUNREACH()) || e == Platform_EHOSTUNREACH();
- return _o_result;
+ return ((e == Platform_ECONNREFUSED() || e == Platform_ECONNABORTED()) || e == Platform_ENETUNREACH()) || e == Platform_EHOSTUNREACH();
}
-LONGINT Platform_OSAllocate (LONGINT size)
+BOOLEAN Platform_Interrupted (INT16 e)
{
- LONGINT _o_result;
- _o_result = Platform_allocate(size);
- return _o_result;
+ return e == Platform_EINTR();
}
-void Platform_OSFree (LONGINT address)
+INT64 Platform_OSAllocate (INT64 size)
+{
+ return Platform_allocate(size);
+}
+
+void Platform_OSFree (INT64 address)
{
Platform_free(address);
}
-void Platform_Init (INTEGER argc, LONGINT argvadr)
+void Platform_Init (INT32 argc, INT64 argvadr)
{
Platform_ArgVecPtr av = NIL;
Platform_MainStackFrame = argvadr;
- Platform_ArgCount = argc;
- av = (Platform_ArgVecPtr)(SYSTEM_ADDRESS)argvadr;
+ Platform_ArgCount = __VAL(INT16, argc);
+ av = (Platform_ArgVecPtr)(ADDRESS)argvadr;
Platform_ArgVector = (*av)[0];
- Platform_HaltCode = -128;
Platform_HeapInitHeap();
}
BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
{
- BOOLEAN _o_result;
Platform_EnvPtr p = NIL;
__DUP(var, var__len, CHAR);
p = Platform_getenv(var, var__len);
if (p != NIL) {
__COPY(*p, val, val__len);
}
- _o_result = p != NIL;
__DEL(var);
- return _o_result;
+ return p != NIL;
}
void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
@@ -259,31 +244,31 @@ void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
__DEL(var);
}
-void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len)
+void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len)
{
Platform_ArgVec av = NIL;
if (n < Platform_ArgCount) {
- av = (Platform_ArgVec)(SYSTEM_ADDRESS)Platform_ArgVector;
- __COPY(*(*av)[__X(n, ((LONGINT)(1024)))], val, val__len);
+ av = (Platform_ArgVec)(ADDRESS)Platform_ArgVector;
+ __COPY(*(*av)[__X(n, 1024)], val, val__len);
}
}
-void Platform_GetIntArg (INTEGER n, LONGINT *val)
+void Platform_GetIntArg (INT16 n, INT32 *val)
{
CHAR s[64];
- LONGINT k, d, i;
+ INT32 k, d, i;
s[0] = 0x00;
- Platform_GetArg(n, (void*)s, ((LONGINT)(64)));
+ Platform_GetArg(n, (void*)s, 64);
i = 0;
if (s[0] == '-') {
i = 1;
}
k = 0;
- d = (int)s[__X(i, ((LONGINT)(64)))] - 48;
+ d = (INT16)s[__X(i, 64)] - 48;
while ((d >= 0 && d <= 9)) {
k = k * 10 + d;
i += 1;
- d = (int)s[__X(i, ((LONGINT)(64)))] - 48;
+ d = (INT16)s[__X(i, 64)] - 48;
}
if (s[0] == '-') {
k = -k;
@@ -294,21 +279,19 @@ void Platform_GetIntArg (INTEGER n, LONGINT *val)
}
}
-INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len)
+INT16 Platform_ArgPos (CHAR *s, LONGINT s__len)
{
- INTEGER _o_result;
- INTEGER i;
+ INT16 i;
CHAR arg[256];
__DUP(s, s__len, CHAR);
i = 0;
- Platform_GetArg(i, (void*)arg, ((LONGINT)(256)));
+ Platform_GetArg(i, (void*)arg, 256);
while ((i < Platform_ArgCount && __STRCMP(s, arg) != 0)) {
i += 1;
- Platform_GetArg(i, (void*)arg, ((LONGINT)(256)));
+ Platform_GetArg(i, (void*)arg, 256);
}
- _o_result = i;
__DEL(s);
- return _o_result;
+ return i;
}
void Platform_SetInterruptHandler (Platform_SignalHandler handler)
@@ -326,450 +309,276 @@ void Platform_SetBadInstructionHandler (Platform_SignalHandler handler)
Platform_sethandler(4, handler);
}
-static void Platform_YMDHMStoClock (LONGINT ye, LONGINT mo, LONGINT da, LONGINT ho, LONGINT mi, LONGINT se, LONGINT *t, LONGINT *d)
+static void Platform_YMDHMStoClock (INT32 ye, INT32 mo, INT32 da, INT32 ho, INT32 mi, INT32 se, INT32 *t, INT32 *d)
{
- *d = (__ASHL(__MOD(ye, 100), 9) + __ASHL(mo + 1, 5)) + da;
+ *d = (__ASHL((int)__MOD(ye, 100), 9) + __ASHL(mo + 1, 5)) + da;
*t = (__ASHL(ho, 12) + __ASHL(mi, 6)) + se;
}
-void Platform_GetClock (LONGINT *t, LONGINT *d)
+void Platform_GetClock (INT32 *t, INT32 *d)
{
Platform_gettimeval();
Platform_sectotm(Platform_tvsec());
Platform_YMDHMStoClock(Platform_tmyear(), Platform_tmmon(), Platform_tmmday(), Platform_tmhour(), Platform_tmmin(), Platform_tmsec(), &*t, &*d);
}
-void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec)
+void Platform_GetTimeOfDay (INT32 *sec, INT32 *usec)
{
Platform_gettimeval();
*sec = Platform_tvsec();
*usec = Platform_tvusec();
}
-LONGINT Platform_Time (void)
+INT32 Platform_Time (void)
{
- LONGINT _o_result;
- LONGINT ms;
+ INT32 ms;
Platform_gettimeval();
- ms = __DIVF(Platform_tvusec(), 1000) + Platform_tvsec() * 1000;
- _o_result = __MOD(ms - Platform_TimeStart, 2147483647);
- return _o_result;
+ ms = (int)__DIVF(Platform_tvusec(), 1000) + Platform_tvsec() * 1000;
+ return (int)__MOD(ms - Platform_TimeStart, 2147483647);
}
-void Platform_Delay (LONGINT ms)
+void Platform_Delay (INT32 ms)
{
- LONGINT s, ns;
+ INT32 s, ns;
s = __DIV(ms, 1000);
- ns = __MOD(ms, 1000) * 1000000;
+ ns = (int)__MOD(ms, 1000) * 1000000;
Platform_nanosleep(s, ns);
}
-INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len)
+INT16 Platform_System (CHAR *cmd, LONGINT cmd__len)
{
- INTEGER _o_result;
__DUP(cmd, cmd__len, CHAR);
- _o_result = Platform_system(cmd, cmd__len);
__DEL(cmd);
- return _o_result;
+ return Platform_system(cmd, cmd__len);
}
-INTEGER Platform_Error (void)
+INT16 Platform_Error (void)
{
- INTEGER _o_result;
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
}
-INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h)
+INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h)
{
- INTEGER _o_result;
- INTEGER fd;
+ INT16 fd;
fd = Platform_openro(n, n__len);
if (fd < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
*h = fd;
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h)
+INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h)
{
- INTEGER _o_result;
- INTEGER fd;
+ INT16 fd;
fd = Platform_openrw(n, n__len);
if (fd < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
*h = fd;
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h)
+INT16 Platform_New (CHAR *n, LONGINT n__len, INT32 *h)
{
- INTEGER _o_result;
- INTEGER fd;
+ INT16 fd;
fd = Platform_opennew(n, n__len);
if (fd < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
*h = fd;
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Close (LONGINT h)
+INT16 Platform_Close (INT32 h)
{
- INTEGER _o_result;
if (Platform_closefile(h) < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ)
+BOOLEAN Platform_IsConsole (INT32 h)
+{
+ return Platform_isatty(h) != 0;
+}
+
+INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *identity__typ)
{
- INTEGER _o_result;
Platform_structstats();
if (Platform_fstat(h) < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
}
(*identity).volume = Platform_statdev();
(*identity).index = Platform_statino();
(*identity).mtime = Platform_statmtime();
- _o_result = 0;
- return _o_result;
+ return 0;
}
-INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ)
+INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
{
- INTEGER _o_result;
__DUP(n, n__len, CHAR);
Platform_structstats();
if (Platform_stat(n, n__len) < 0) {
- _o_result = Platform_err();
__DEL(n);
- return _o_result;
+ return Platform_err();
}
(*identity).volume = Platform_statdev();
(*identity).index = Platform_statino();
(*identity).mtime = Platform_statmtime();
- _o_result = 0;
__DEL(n);
- return _o_result;
+ return 0;
}
BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2)
{
- BOOLEAN _o_result;
- _o_result = (i1.index == i2.index && i1.volume == i2.volume);
- return _o_result;
+ return (i1.index == i2.index && i1.volume == i2.volume);
}
BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2)
{
- BOOLEAN _o_result;
- _o_result = i1.mtime == i2.mtime;
- return _o_result;
+ return i1.mtime == i2.mtime;
}
-void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source)
+void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__typ, Platform_FileIdentity source)
{
(*target).mtime = source.mtime;
}
-void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d)
+void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d)
{
Platform_sectotm(i.mtime);
Platform_YMDHMStoClock(Platform_tmyear(), Platform_tmmon(), Platform_tmmday(), Platform_tmhour(), Platform_tmmin(), Platform_tmsec(), &*t, &*d);
}
-INTEGER Platform_Size (LONGINT h, LONGINT *l)
+INT16 Platform_Size (INT32 h, INT32 *l)
{
- INTEGER _o_result;
Platform_structstats();
if (Platform_fstat(h) < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
}
*l = Platform_statsize();
- _o_result = 0;
- return _o_result;
+ return 0;
}
-INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n)
+INT16 Platform_Read (INT32 h, INT64 p, INT32 l, INT32 *n)
{
- INTEGER _o_result;
*n = Platform_readfile(h, p, l);
if (*n < 0) {
*n = 0;
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n)
+INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n)
{
- INTEGER _o_result;
- *n = Platform_readfile(h, (LONGINT)(SYSTEM_ADDRESS)b, b__len);
+ *n = Platform_readfile(h, (ADDRESS)b, b__len);
if (*n < 0) {
*n = 0;
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l)
+INT16 Platform_Write (INT32 h, INT64 p, INT32 l)
{
- INTEGER _o_result;
- LONGINT written;
+ INT64 written;
written = Platform_writefile(h, p, l);
if (written < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Sync (LONGINT h)
+INT16 Platform_Sync (INT32 h)
{
- INTEGER _o_result;
if (Platform_fsync(h) < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Seek (LONGINT h, LONGINT offset, INTEGER whence)
+INT16 Platform_Seek (INT32 h, INT32 offset, INT16 whence)
{
- INTEGER _o_result;
if (Platform_lseek(h, offset, whence) < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Truncate (LONGINT h, LONGINT l)
+INT16 Platform_Truncate (INT32 h, INT32 l)
{
- INTEGER _o_result;
if (Platform_ftruncate(h, l) < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Unlink (CHAR *n, LONGINT n__len)
+INT16 Platform_Unlink (CHAR *n, LONGINT n__len)
{
- INTEGER _o_result;
if (Platform_unlink(n, n__len) < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Chdir (CHAR *n, LONGINT n__len)
+INT16 Platform_Chdir (CHAR *n, LONGINT n__len)
{
- INTEGER _o_result;
- INTEGER r;
- r = Platform_chdir(n, n__len);
- Platform_getcwd((void*)Platform_CWD, ((LONGINT)(256)));
- if (r < 0) {
- _o_result = Platform_err();
- return _o_result;
+ INT16 r;
+ if ((Platform_chdir(n, n__len) >= 0 && Platform_getcwd((void*)Platform_CWD, 256) != NIL)) {
+ return 0;
} else {
- _o_result = 0;
- return _o_result;
+ return Platform_err();
}
__RETCHK;
}
-INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len)
+INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len)
{
- INTEGER _o_result;
if (Platform_rename(o, o__len, n, n__len) < 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-void Platform_Exit (INTEGER code)
+void Platform_Exit (INT32 code)
{
Platform_exit(code);
}
-static void Platform_errch (CHAR c)
-{
- Platform_errc(c);
-}
-
-static void Platform_errln (void)
-{
- Platform_errch(0x0d);
- Platform_errch(0x0a);
-}
-
-static void Platform_errposint (LONGINT l)
-{
- if (l > 10) {
- Platform_errposint(__DIV(l, 10));
- }
- Platform_errch((CHAR)(48 + __MOD(l, 10)));
-}
-
-static void Platform_errint (LONGINT l)
-{
- if (l < 0) {
- Platform_errch('-');
- l = -l;
- }
- Platform_errposint(l);
-}
-
-static void Platform_DisplayHaltCode (LONGINT code)
-{
- switch (code) {
- case -1:
- Platform_errstring((CHAR*)"Assertion failure.", (LONGINT)19);
- break;
- case -2:
- Platform_errstring((CHAR*)"Index out of range.", (LONGINT)20);
- break;
- case -3:
- Platform_errstring((CHAR*)"Reached end of function without reaching RETURN.", (LONGINT)49);
- break;
- case -4:
- Platform_errstring((CHAR*)"CASE statement: no matching label and no ELSE.", (LONGINT)47);
- break;
- case -5:
- Platform_errstring((CHAR*)"Type guard failed.", (LONGINT)19);
- break;
- case -6:
- Platform_errstring((CHAR*)"Implicit type guard in record assignment failed.", (LONGINT)49);
- break;
- case -7:
- Platform_errstring((CHAR*)"Invalid case in WITH statement.", (LONGINT)32);
- break;
- case -8:
- Platform_errstring((CHAR*)"Value out of range.", (LONGINT)20);
- break;
- case -9:
- Platform_errstring((CHAR*)"Heap interrupted while locked, but lockdepth = 0 at unlock.", (LONGINT)60);
- break;
- case -10:
- Platform_errstring((CHAR*)"NIL access.", (LONGINT)12);
- break;
- case -11:
- Platform_errstring((CHAR*)"Alignment error.", (LONGINT)17);
- break;
- case -12:
- Platform_errstring((CHAR*)"Divide by zero.", (LONGINT)16);
- break;
- case -13:
- Platform_errstring((CHAR*)"Arithmetic overflow/underflow.", (LONGINT)31);
- break;
- case -14:
- Platform_errstring((CHAR*)"Invalid function argument.", (LONGINT)27);
- break;
- case -15:
- Platform_errstring((CHAR*)"Internal error, e.g. Type descriptor size mismatch.", (LONGINT)52);
- break;
- case -20:
- Platform_errstring((CHAR*)"Too many, or negative number of, elements in dynamic array.", (LONGINT)60);
- break;
- default:
- break;
- }
-}
-
-void Platform_Halt (LONGINT code)
-{
- INTEGER e;
- Platform_HaltCode = code;
- if (Platform_HaltHandler != NIL) {
- (*Platform_HaltHandler)(code);
- }
- Platform_errstring((CHAR*)"Terminated by Halt(", (LONGINT)20);
- Platform_errint(code);
- Platform_errstring((CHAR*)"). ", (LONGINT)4);
- if (code < 0) {
- Platform_DisplayHaltCode(code);
- }
- Platform_errln();
- Platform_exit(__VAL(INTEGER, code));
-}
-
-void Platform_AssertFail (LONGINT code)
-{
- INTEGER e;
- Platform_errstring((CHAR*)"Assertion failure.", (LONGINT)19);
- if (code != 0) {
- Platform_errstring((CHAR*)" ASSERT code ", (LONGINT)14);
- Platform_errint(code);
- Platform_errstring((CHAR*)".", (LONGINT)2);
- }
- Platform_errln();
- Platform_exit(__VAL(INTEGER, code));
-}
-
-void Platform_SetHalt (Platform_HaltProcedure p)
-{
- Platform_HaltHandler = p;
-}
-
static void Platform_TestLittleEndian (void)
{
- INTEGER i;
+ INT16 i;
i = 1;
- __GET((LONGINT)(SYSTEM_ADDRESS)&i, Platform_LittleEndian, BOOLEAN);
+ __GET((ADDRESS)&i, Platform_LittleEndian, BOOLEAN);
}
-__TDESC(Platform_FileIdentity, 1, 0) = {__TDFLDS("FileIdentity", 24), {-8}};
+__TDESC(Platform_FileIdentity, 1, 0) = {__TDFLDS("FileIdentity", 12), {-8}};
export void *Platform__init(void)
{
@@ -778,17 +587,17 @@ export void *Platform__init(void)
__INITYP(Platform_FileIdentity, Platform_FileIdentity, 0);
/* BEGIN */
Platform_TestLittleEndian();
- Platform_HaltCode = -128;
Platform_HaltHandler = NIL;
Platform_TimeStart = 0;
Platform_TimeStart = Platform_Time();
- Platform_CWD[0] = 0x00;
- Platform_getcwd((void*)Platform_CWD, ((LONGINT)(256)));
Platform_PID = Platform_getpid();
+ if (Platform_getcwd((void*)Platform_CWD, 256) == NIL) {
+ Platform_CWD[0] = 0x00;
+ }
Platform_SeekSet = Platform_seekset();
Platform_SeekCur = Platform_seekcur();
Platform_SeekEnd = Platform_seekend();
- Platform_nl[0] = 0x0a;
- Platform_nl[1] = 0x00;
+ Platform_NL[0] = 0x0a;
+ Platform_NL[1] = 0x00;
__ENDMOD;
}
diff --git a/bootstrap/unix-88/Platform.h b/bootstrap/unix-88/Platform.h
index 49702e6d..80307386 100644
--- a/bootstrap/unix-88/Platform.h
+++ b/bootstrap/unix-88/Platform.h
@@ -1,83 +1,79 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Platform__h
#define Platform__h
-#define LARGE
#include "SYSTEM.h"
typedef
struct Platform_FileIdentity {
- LONGINT volume, index, mtime;
+ INT32 _prvt0;
+ char _prvt1[8];
} Platform_FileIdentity;
typedef
- void (*Platform_HaltProcedure)(LONGINT);
-
-typedef
- void (*Platform_SignalHandler)(INTEGER);
+ void (*Platform_SignalHandler)(INT32);
import BOOLEAN Platform_LittleEndian;
-import LONGINT Platform_MainStackFrame, Platform_HaltCode;
-import INTEGER Platform_PID;
+import INT64 Platform_MainStackFrame;
+import INT16 Platform_PID;
import CHAR Platform_CWD[256];
-import INTEGER Platform_ArgCount;
-import LONGINT Platform_ArgVector;
-import INTEGER Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
-import CHAR Platform_nl[3];
+import INT16 Platform_ArgCount;
+import INT64 Platform_ArgVector;
+import INT16 Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
+import CHAR Platform_NL[3];
-import LONGINT *Platform_FileIdentity__typ;
+import ADDRESS *Platform_FileIdentity__typ;
-import BOOLEAN Platform_Absent (INTEGER e);
-import INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len);
-import void Platform_AssertFail (LONGINT code);
-import INTEGER Platform_Chdir (CHAR *n, LONGINT n__len);
-import INTEGER Platform_Close (LONGINT h);
-import BOOLEAN Platform_ConnectionFailed (INTEGER e);
-import void Platform_Delay (LONGINT ms);
-import BOOLEAN Platform_DifferentFilesystems (INTEGER e);
-import INTEGER Platform_Error (void);
-import void Platform_Exit (INTEGER code);
-import void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len);
-import void Platform_GetClock (LONGINT *t, LONGINT *d);
+import BOOLEAN Platform_Absent (INT16 e);
+import INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
+import INT16 Platform_Chdir (CHAR *n, LONGINT n__len);
+import INT16 Platform_Close (INT32 h);
+import BOOLEAN Platform_ConnectionFailed (INT16 e);
+import void Platform_Delay (INT32 ms);
+import BOOLEAN Platform_DifferentFilesystems (INT16 e);
+import INT16 Platform_Error (void);
+import void Platform_Exit (INT32 code);
+import void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len);
+import void Platform_GetClock (INT32 *t, INT32 *d);
import void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
-import void Platform_GetIntArg (INTEGER n, LONGINT *val);
-import void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec);
-import void Platform_Halt (LONGINT code);
-import INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ);
-import INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ);
-import BOOLEAN Platform_Inaccessible (INTEGER e);
-import void Platform_Init (INTEGER argc, LONGINT argvadr);
-import void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d);
-import INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h);
-import BOOLEAN Platform_NoSuchDirectory (INTEGER e);
-import LONGINT Platform_OSAllocate (LONGINT size);
-import void Platform_OSFree (LONGINT address);
-import INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h);
-import INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h);
-import INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n);
-import INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n);
-import INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
+import 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, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
+import BOOLEAN Platform_Inaccessible (INT16 e);
+import void Platform_Init (INT32 argc, INT64 argvadr);
+import BOOLEAN Platform_Interrupted (INT16 e);
+import BOOLEAN Platform_IsConsole (INT32 h);
+import void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d);
+import INT16 Platform_New (CHAR *n, LONGINT n__len, INT32 *h);
+import BOOLEAN Platform_NoSuchDirectory (INT16 e);
+import INT64 Platform_OSAllocate (INT64 size);
+import void Platform_OSFree (INT64 address);
+import INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h);
+import INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h);
+import INT16 Platform_Read (INT32 h, INT64 p, INT32 l, INT32 *n);
+import INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n);
+import INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
import BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2);
import BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2);
-import INTEGER Platform_Seek (LONGINT h, LONGINT offset, INTEGER whence);
+import INT16 Platform_Seek (INT32 h, INT32 offset, INT16 whence);
import void Platform_SetBadInstructionHandler (Platform_SignalHandler handler);
-import void Platform_SetHalt (Platform_HaltProcedure p);
import void Platform_SetInterruptHandler (Platform_SignalHandler handler);
-import void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source);
+import void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__typ, Platform_FileIdentity source);
import void Platform_SetQuitHandler (Platform_SignalHandler handler);
-import INTEGER Platform_Size (LONGINT h, LONGINT *l);
-import INTEGER Platform_Sync (LONGINT h);
-import INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len);
-import LONGINT Platform_Time (void);
-import BOOLEAN Platform_TimedOut (INTEGER e);
-import BOOLEAN Platform_TooManyFiles (INTEGER e);
-import INTEGER Platform_Truncate (LONGINT h, LONGINT l);
-import INTEGER Platform_Unlink (CHAR *n, LONGINT n__len);
-import INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l);
+import INT16 Platform_Size (INT32 h, INT32 *l);
+import INT16 Platform_Sync (INT32 h);
+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, LONGINT n__len);
+import INT16 Platform_Write (INT32 h, INT64 p, INT32 l);
import BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
import void *Platform__init(void);
-#endif
+#endif // Platform
diff --git a/bootstrap/unix-88/Reals.c b/bootstrap/unix-88/Reals.c
index 8b61d8cd..cd4c3c61 100644
--- a/bootstrap/unix-88/Reals.c
+++ b/bootstrap/unix-88/Reals.c
@@ -1,26 +1,30 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len);
-export void Reals_Convert (REAL x, INTEGER n, CHAR *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, INTEGER n, CHAR *d, LONGINT d__len);
-export INTEGER Reals_Expo (REAL x);
-export INTEGER Reals_ExpoL (LONGREAL x);
-export void Reals_SetExpo (REAL *x, INTEGER ex);
-export REAL Reals_Ten (INTEGER e);
-export LONGREAL Reals_TenL (INTEGER e);
-static CHAR Reals_ToHex (INTEGER i);
+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);
+export REAL Reals_Ten (INT16 e);
+export LONGREAL Reals_TenL (INT16 e);
+static CHAR Reals_ToHex (INT16 i);
-REAL Reals_Ten (INTEGER e)
+REAL Reals_Ten (INT16 e)
{
- REAL _o_result;
LONGREAL r, power;
r = (LONGREAL)1;
power = (LONGREAL)10;
@@ -31,13 +35,11 @@ REAL Reals_Ten (INTEGER e)
power = power * power;
e = __ASHR(e, 1);
}
- _o_result = r;
- return _o_result;
+ return r;
}
-LONGREAL Reals_TenL (INTEGER e)
+LONGREAL Reals_TenL (INT16 e)
{
- LONGREAL _o_result;
LONGREAL r, power;
r = (LONGREAL)1;
power = (LONGREAL)10;
@@ -47,97 +49,102 @@ LONGREAL Reals_TenL (INTEGER e)
}
e = __ASHR(e, 1);
if (e <= 0) {
- _o_result = r;
- return _o_result;
+ return r;
}
power = power * power;
}
__RETCHK;
}
-INTEGER Reals_Expo (REAL x)
+INT16 Reals_Expo (REAL x)
{
- INTEGER _o_result;
- INTEGER i;
- __GET((LONGINT)(SYSTEM_ADDRESS)&x + 2, i, INTEGER);
- _o_result = __MASK(__ASHR(i, 7), -256);
- return _o_result;
+ INT16 i;
+ __GET((ADDRESS)&x + 2, i, INT16);
+ return __MASK(__ASHR(i, 7), -256);
}
-void Reals_SetExpo (REAL *x, INTEGER ex)
+void Reals_SetExpo (REAL *x, INT16 ex)
{
CHAR c;
- __GET((LONGINT)(SYSTEM_ADDRESS)x + 3, c, CHAR);
- __PUT((LONGINT)(SYSTEM_ADDRESS)x + 3, (CHAR)(__ASHL(__ASHR((int)c, 7), 7) + __MASK(__ASHR(ex, 1), -128)), CHAR);
- __GET((LONGINT)(SYSTEM_ADDRESS)x + 2, c, CHAR);
- __PUT((LONGINT)(SYSTEM_ADDRESS)x + 2, (CHAR)(__MASK((int)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR);
+ __GET((ADDRESS)x + 3, c, 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, (CHAR)(__MASK((INT16)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR);
}
-INTEGER Reals_ExpoL (LONGREAL x)
+INT16 Reals_ExpoL (LONGREAL x)
{
- INTEGER _o_result;
- INTEGER i;
- __GET((LONGINT)(SYSTEM_ADDRESS)&x + 6, i, INTEGER);
- _o_result = __MASK(__ASHR(i, 4), -2048);
- return _o_result;
+ INT16 i;
+ __GET((ADDRESS)&x + 6, i, INT16);
+ return __MASK(__ASHR(i, 4), -2048);
}
-void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len)
+void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len)
{
- LONGINT i, j, k;
+ INT32 i, j, k;
if (x < (LONGREAL)0) {
x = -x;
}
k = 0;
- i = __ENTIER(x);
- while (k < (SYSTEM_INT64)n) {
- d[__X(k, d__len)] = (CHAR)(__MOD(i, 10) + 48);
+ if (n > 9) {
+ 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)] = (CHAR)((int)__MOD(j, 10) + 48);
+ j = __DIV(j, 10);
+ k += 1;
+ }
+ } else {
+ i = (INT32)__ENTIER(x);
+ }
+ while (k < n) {
+ d[__X(k, d__len)] = (CHAR)((int)__MOD(i, 10) + 48);
i = __DIV(i, 10);
k += 1;
}
}
-void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len)
+void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len)
{
Reals_ConvertL(x, n, (void*)d, d__len);
}
-static CHAR Reals_ToHex (INTEGER i)
+static CHAR Reals_ToHex (INT16 i)
{
- CHAR _o_result;
if (i < 10) {
- _o_result = (CHAR)(i + 48);
- return _o_result;
+ return (CHAR)(i + 48);
} else {
- _o_result = (CHAR)(i + 55);
- return _o_result;
+ return (CHAR)(i + 55);
}
__RETCHK;
}
static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len)
{
- INTEGER i;
- LONGINT l;
+ INT16 i;
+ INT32 l;
CHAR by;
i = 0;
l = b__len;
- while ((SYSTEM_INT64)i < l) {
+ while (i < l) {
by = __VAL(CHAR, b[__X(i, b__len)]);
- d[__X(__ASHL(i, 1), d__len)] = Reals_ToHex(__ASHR((int)by, 4));
- d[__X(__ASHL(i, 1) + 1, d__len)] = Reals_ToHex(__MASK((int)by, -16));
+ d[__X(__ASHL(i, 1), d__len)] = Reals_ToHex(__ASHR((INT16)by, 4));
+ d[__X(__ASHL(i, 1) + 1, d__len)] = Reals_ToHex(__MASK((INT16)by, -16));
i += 1;
}
}
void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len)
{
- Reals_BytesToHex((void*)&y, ((LONGINT)(4)), (void*)d, d__len * ((LONGINT)(1)));
+ Reals_BytesToHex((void*)&y, 4, (void*)d, d__len * 1);
}
void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len)
{
- Reals_BytesToHex((void*)&x, ((LONGINT)(8)), (void*)d, d__len * ((LONGINT)(1)));
+ Reals_BytesToHex((void*)&x, 8, (void*)d, d__len * 1);
}
diff --git a/bootstrap/unix-88/Reals.h b/bootstrap/unix-88/Reals.h
index ff21c192..f0c84ab1 100644
--- a/bootstrap/unix-88/Reals.h
+++ b/bootstrap/unix-88/Reals.h
@@ -1,24 +1,23 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Reals__h
#define Reals__h
-#define LARGE
#include "SYSTEM.h"
-import void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len);
+import void Reals_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, INTEGER n, CHAR *d, LONGINT d__len);
-import INTEGER Reals_Expo (REAL x);
-import INTEGER Reals_ExpoL (LONGREAL x);
-import void Reals_SetExpo (REAL *x, INTEGER ex);
-import REAL Reals_Ten (INTEGER e);
-import LONGREAL Reals_TenL (INTEGER e);
+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);
+import REAL Reals_Ten (INT16 e);
+import LONGREAL Reals_TenL (INT16 e);
import void *Reals__init(void);
-#endif
+#endif // Reals
diff --git a/bootstrap/unix-88/SYSTEM.h b/bootstrap/unix-88/SYSTEM.h
deleted file mode 100644
index 6377745e..00000000
--- a/bootstrap/unix-88/SYSTEM.h
+++ /dev/null
@@ -1,295 +0,0 @@
-#ifndef SYSTEM__h
-#define SYSTEM__h
-
-#if defined(_WIN64)
- typedef long long SYSTEM_INT64;
- typedef unsigned long long SYSTEM_CARD64;
-#else
- typedef long SYSTEM_INT64;
- typedef unsigned long SYSTEM_CARD64;
-#endif
-
-typedef int SYSTEM_INT32;
-typedef unsigned int SYSTEM_CARD32;
-typedef short int SYSTEM_INT16;
-typedef unsigned short int SYSTEM_CARD16;
-typedef signed char SYSTEM_INT8;
-typedef unsigned char SYSTEM_CARD8;
-
-#if (__SIZEOF_POINTER__ == 8) || defined(_WIN64) || defined(__LP64__)
- #if defined(_WIN64)
- typedef unsigned long long size_t;
- #else
- typedef unsigned long size_t;
- #endif
-#else
- typedef unsigned int size_t;
-#endif
-
-#define SYSTEM_ADDRESS size_t
-#define _SIZE_T_DECLARED // For FreeBSD
-#define _SIZE_T_DEFINED_ // For OpenBSD
-
-void *memcpy(void *dest, const void *source, SYSTEM_ADDRESS size);
-
-
-
-// The compiler uses 'import' and 'export' which translate to 'extern' and
-// nothing respectively.
-
-#define import extern
-#define export
-
-
-
-// Known constants
-
-#define NIL ((void*)0)
-#define __MAXEXT 16
-#define POINTER__typ ((LONGINT*)(1)) // not NIL and not a valid type
-
-
-// Oberon types
-
-typedef char BOOLEAN;
-typedef unsigned char SYSTEM_BYTE;
-typedef unsigned char CHAR;
-typedef signed char SHORTINT;
-typedef float REAL;
-typedef double LONGREAL;
-typedef void* SYSTEM_PTR;
-
-// Unsigned variants are for use by shift and rotate macros.
-
-typedef unsigned char U_SYSTEM_BYTE;
-typedef unsigned char U_CHAR;
-typedef unsigned char U_SHORTINT;
-
-// For 32 bit builds, the size of LONGINT depends on a make option:
-
-#if (__SIZEOF_POINTER__ == 8) || defined(LARGE) || defined(_WIN64)
- typedef int INTEGER; // INTEGER is 32 bit.
- typedef long long LONGINT; // LONGINT is 64 bit. (long long is always 64 bits, while long can be 32 bits e.g. under MSC/MingW)
- typedef unsigned int U_INTEGER;
- typedef unsigned long long U_LONGINT;
-#else
- typedef short int INTEGER; // INTEGER is 16 bit.
- typedef long LONGINT; // LONGINT is 32 bit.
- typedef unsigned short int U_INTEGER;
- typedef unsigned long U_LONGINT;
-#endif
-
-typedef U_LONGINT SET;
-typedef U_LONGINT U_SET;
-
-
-// OS Memory allocation interfaces are in PlatformXXX.Mod
-
-extern LONGINT Platform_OSAllocate (LONGINT size);
-extern void Platform_OSFree (LONGINT addr);
-
-
-// Run time system routines in SYSTEM.c
-
-extern LONGINT SYSTEM_XCHK (LONGINT i, LONGINT ub);
-extern LONGINT SYSTEM_RCHK (LONGINT i, LONGINT ub);
-extern LONGINT SYSTEM_ASH (LONGINT i, LONGINT n);
-extern LONGINT SYSTEM_ABS (LONGINT i);
-extern double SYSTEM_ABSD (double i);
-extern void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0);
-extern void SYSTEM_ENUMP (void *adr, LONGINT n, void (*P)());
-extern void SYSTEM_ENUMR (void *adr, LONGINT *typ, LONGINT size, LONGINT n, void (*P)());
-extern LONGINT SYSTEM_DIV (U_LONGINT x, U_LONGINT y);
-extern LONGINT SYSTEM_MOD (U_LONGINT x, U_LONGINT y);
-extern LONGINT SYSTEM_ENTIER (double x);
-
-
-// Signal handling in SYSTEM.c
-
-#ifndef _WIN32
- extern void SystemSetHandler(int s, SYSTEM_ADDRESS h);
-#else
- extern void SystemSetInterruptHandler(SYSTEM_ADDRESS h);
- extern void SystemSetQuitHandler (SYSTEM_ADDRESS h);
-#endif
-
-
-
-// String comparison
-
-static int __str_cmp(CHAR *x, CHAR *y){
- LONGINT i = 0;
- CHAR ch1, ch2;
- do {ch1 = x[i]; ch2 = y[i]; i++;
- if (!ch1) return -(int)ch2;
- } while (ch1==ch2);
- return (int)ch1 - (int)ch2;
-}
-#define __STRCMP(a,b) __str_cmp((CHAR*)(a), (CHAR*)(b))
-
-
-
-// Inline string, record and array copy
-
-#define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d; LONGINT _i=0,_t=n-1; \
- while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;}
-#define __DUP(x, l, t) x=(void*)memcpy((void*)(SYSTEM_ADDRESS)Platform_OSAllocate(l*sizeof(t)),x,l*sizeof(t))
-#define __DUPARR(v, t) v=(void*)memcpy(v##__copy,v,sizeof(t))
-#define __DEL(x) Platform_OSFree((LONGINT)(SYSTEM_ADDRESS)x)
-
-
-
-
-/* SYSTEM ops */
-
-#define __VAL(t, x) (*(t*)&(x))
-
-
-#define __GET(a, x, t) x= *(t*)(SYSTEM_ADDRESS)(a)
-#define __PUT(a, x, t) *(t*)(SYSTEM_ADDRESS)(a)=x
-
-#define __LSHL(x, n, t) ((t)((U_##t)(x)<<(n)))
-#define __LSHR(x, n, t) ((t)((U_##t)(x)>>(n)))
-#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t))
-
-#define __ASHL(x, n) ((LONGINT)(x)<<(n))
-#define __ASHR(x, n) ((LONGINT)(x)>>(n))
-#define __ASH(x, n) ((n)>=0?__ASHL(x,n):__ASHR(x,-(n)))
-
-#define __ROTL(x, n, t) ((t)((U_##t)(x)<<(n)|(U_##t)(x)>>(8*sizeof(t)-(n))))
-#define __ROTR(x, n, t) ((t)((U_##t)(x)>>(n)|(U_##t)(x)<<(8*sizeof(t)-(n))))
-#define __ROT(x, n, t) ((n)>=0? __ROTL(x, n, t): __ROTR(x, -(n), t))
-
-#define __BIT(x, n) (*(U_LONGINT*)(x)>>(n)&1)
-#define __MOVE(s, d, n) memcpy((char*)(SYSTEM_ADDRESS)(d),(char*)(SYSTEM_ADDRESS)(s),n)
-#define __ASHF(x, n) SYSTEM_ASH((LONGINT)(x), (LONGINT)(n))
-#define __SHORT(x, y) ((int)((U_LONGINT)(x)+(y)<(y)+(y)?(x):(__HALT(-8),0)))
-#define __SHORTF(x, y) ((int)(__RF((x)+(y),(y)+(y))-(y)))
-#define __CHR(x) ((CHAR)__R(x, 256))
-#define __CHRF(x) ((CHAR)__RF(x, 256))
-#define __DIV(x, y) ((x)>=0?(x)/(y):-(((y)-1-(x))/(y)))
-#define __DIVF(x, y) SYSTEM_DIV((LONGINT)(x),(LONGINT)(y))
-#define __MOD(x, y) ((x)>=0?(x)%(y):__MODF(x,y))
-#define __MODF(x, y) SYSTEM_MOD((LONGINT)(x),(LONGINT)(y))
-#define __ENTIER(x) SYSTEM_ENTIER(x)
-#define __ABS(x) (((x)<0)?-(x):(x))
-#define __ABSF(x) SYSTEM_ABS((LONGINT)(x))
-#define __ABSFD(x) SYSTEM_ABSD((double)(x))
-#define __CAP(ch) ((CHAR)((ch)&0x5f))
-#define __ODD(x) ((x)&1)
-#define __IN(x, s) (((s)>>(x))&1)
-#define __SETOF(x) ((SET)1<<(x))
-#define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h)))
-#define __MASK(x, m) ((x)&~(m))
-
-
-
-// Runtime checks
-
-#define __X(i, ub) (((U_LONGINT)(i)<(U_LONGINT)(ub))?i:(__HALT(-2),0))
-#define __XF(i, ub) SYSTEM_XCHK((LONGINT)(i), (LONGINT)(ub))
-#define __R(i, ub) (((U_LONGINT)(i)<(U_LONGINT)(ub))?i:(__HALT(-8),0))
-#define __RF(i, ub) SYSTEM_RCHK((LONGINT)(i),(LONGINT)(ub))
-#define __RETCHK __retchk: __HALT(-3); return 0;
-#define __CASECHK __HALT(-4)
-#define __WITHCHK __HALT(-7)
-
-#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p)))
-#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r))))
-#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p)))
-#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p)
-#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p)
-
-
-
-// Module entry/registration/exit
-
-extern void Heap_REGCMD();
-extern SYSTEM_PTR Heap_REGMOD();
-extern void Heap_REGTYP();
-extern void Heap_INCREF();
-
-#define __DEFMOD static void *m; if (m!=0) {return m;}
-#define __REGCMD(name, cmd) Heap_REGCMD(m, (CHAR*)name, cmd)
-#define __REGMOD(name, enum) if (m==0) {m = Heap_REGMOD((CHAR*)name,enum);}
-#define __ENDMOD return m
-#define __MODULE_IMPORT(name) Heap_INCREF(name##__init())
-
-
-
-// Main module initialisation, registration and finalisation
-
-extern void Platform_Init(INTEGER argc, LONGINT argv);
-extern void Heap_FINALL();
-
-#define __INIT(argc, argv) static void *m; Platform_Init((INTEGER)argc, (LONGINT)(SYSTEM_ADDRESS)&argv);
-#define __REGMAIN(name, enum) m = Heap_REGMOD((CHAR*)name,enum)
-#define __FINI Heap_FINALL(); return 0
-
-
-// Assertions and Halts
-
-extern void Platform_Halt(LONGINT x);
-extern void Platform_AssertFail(LONGINT x);
-
-#define __HALT(x) Platform_Halt(x)
-#define __ASSERT(cond, x) if (!(cond)) Platform_AssertFail((LONGINT)(x))
-
-
-// Memory allocation
-
-extern SYSTEM_PTR Heap_NEWBLK (LONGINT size);
-extern SYSTEM_PTR Heap_NEWREC (LONGINT tag);
-extern SYSTEM_PTR SYSTEM_NEWARR(LONGINT*, LONGINT, int, int, int, ...);
-
-#define __SYSNEW(p, len) p = Heap_NEWBLK((LONGINT)(len))
-#define __NEW(p, t) p = Heap_NEWREC((LONGINT)(SYSTEM_ADDRESS)t##__typ)
-#define __NEWARR SYSTEM_NEWARR
-
-
-
-/* Type handling */
-
-#define __TDESC(t, m, n) \
- static struct t##__desc { \
- LONGINT tproc[m]; /* Proc for each ptr field */ \
- LONGINT tag; \
- LONGINT next; /* Module table type list points here */ \
- LONGINT level; \
- LONGINT module; \
- char name[24]; \
- LONGINT basep[__MAXEXT]; /* List of bases this extends */ \
- LONGINT reserved; \
- LONGINT blksz; /* xxx_typ points here */ \
- LONGINT ptr[n+1]; /* Offsets of ptrs up to -ve sentinel */ \
- } t##__desc
-
-#define __BASEOFF (__MAXEXT+1) // blksz as index to base.
-#define __TPROC0OFF (__BASEOFF+24/sizeof(LONGINT)+5) // blksz as index to tproc IFF m=1.
-#define __EOM 1
-#define __TDFLDS(name, size) {__EOM}, 1, 0, 0, 0, name, {0}, 0, size
-#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (LONGINT)(n), P)
-#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (LONGINT)(size), (LONGINT)(n), P)
-
-#define __INITYP(t, t0, level) \
- t##__typ = (LONGINT*)&t##__desc.blksz; \
- memcpy(t##__desc.basep, t0##__typ - __BASEOFF, level*sizeof(LONGINT)); \
- t##__desc.basep[level] = (LONGINT)(SYSTEM_ADDRESS)t##__typ; \
- t##__desc.module = (LONGINT)(SYSTEM_ADDRESS)m; \
- if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \
- t##__desc.blksz = (t##__desc.blksz+5*sizeof(LONGINT)-1)/(4*sizeof(LONGINT))*(4*sizeof(LONGINT)); \
- Heap_REGTYP(m, (LONGINT)(SYSTEM_ADDRESS)&t##__desc.next); \
- SYSTEM_INHERIT(t##__typ, t0##__typ)
-
-#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(LONGINT)(SYSTEM_ADDRESS)typ##__typ)
-#define __TYPEOF(p) ((LONGINT*)(SYSTEM_ADDRESS)(*(((LONGINT*)(p))-1)))
-#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level)
-
-// Oberon-2 type bound procedures support
-#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(LONGINT)(SYSTEM_ADDRESS)proc
-#define __SEND(typ, num, funtyp, parlist) ((funtyp)((SYSTEM_ADDRESS)*(typ-(__TPROC0OFF+num))))parlist
-
-
-
-
-#endif
diff --git a/bootstrap/unix-88/Strings.c b/bootstrap/unix-88/Strings.c
index 20a14540..b5707327 100644
--- a/bootstrap/unix-88/Strings.c
+++ b/bootstrap/unix-88/Strings.c
@@ -1,5 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
@@ -7,49 +12,53 @@
export void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len);
export void Strings_Cap (CHAR *s, LONGINT s__len);
-export void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n);
-export void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len);
-export void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len);
-export INTEGER Strings_Length (CHAR *s, LONGINT s__len);
+export 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 INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos);
-export void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len);
+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);
-INTEGER Strings_Length (CHAR *s, LONGINT s__len)
+INT16 Strings_Length (CHAR *s, LONGINT s__len)
{
- INTEGER _o_result;
- INTEGER i;
+ INT32 i;
__DUP(s, s__len, CHAR);
i = 0;
- while (((SYSTEM_INT64)i < s__len && s[__X(i, s__len)] != 0x00)) {
+ while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
i += 1;
}
- _o_result = i;
- __DEL(s);
- return _o_result;
+ if (i <= 32767) {
+ __DEL(s);
+ return (INT16)i;
+ } else {
+ __DEL(s);
+ return 32767;
+ }
+ __RETCHK;
}
void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len)
{
- INTEGER n1, n2, i;
+ INT16 n1, n2, i;
__DUP(extra, extra__len, CHAR);
n1 = Strings_Length(dest, dest__len);
n2 = Strings_Length(extra, extra__len);
i = 0;
- while ((i < n2 && (SYSTEM_INT64)(i + n1) < dest__len)) {
+ while ((i < n2 && (i + n1) < dest__len)) {
dest[__X(i + n1, dest__len)] = extra[__X(i, extra__len)];
i += 1;
}
- if ((SYSTEM_INT64)(i + n1) < dest__len) {
+ if ((i + n1) < dest__len) {
dest[__X(i + n1, dest__len)] = 0x00;
}
__DEL(extra);
}
-void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len)
+void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len)
{
- INTEGER n1, n2, i;
+ INT16 n1, n2, i;
__DUP(source, source__len, CHAR);
n1 = Strings_Length(dest, dest__len);
n2 = Strings_Length(source, source__len);
@@ -58,12 +67,13 @@ void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest,
}
if (pos > n1) {
Strings_Append(dest, dest__len, (void*)source, source__len);
+ __DEL(source);
return;
}
- if ((SYSTEM_INT64)(pos + n2) < dest__len) {
+ if ((pos + n2) < dest__len) {
i = n1;
while (i >= pos) {
- if ((SYSTEM_INT64)(i + n2) < dest__len) {
+ if ((i + n2) < dest__len) {
dest[__X(i + n2, dest__len)] = dest[__X(i, dest__len)];
}
i -= 1;
@@ -77,9 +87,9 @@ void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest,
__DEL(source);
}
-void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n)
+void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n)
{
- INTEGER len, i;
+ INT16 len, i;
len = Strings_Length(s, s__len);
if (pos < 0) {
pos = 0;
@@ -92,7 +102,7 @@ void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n)
s[__X(i - n, s__len)] = s[__X(i, s__len)];
i += 1;
}
- if ((SYSTEM_INT64)(i - n) < s__len) {
+ if ((i - n) < s__len) {
s[__X(i - n, s__len)] = 0x00;
}
} else {
@@ -100,7 +110,7 @@ void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n)
}
}
-void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT 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));
@@ -108,21 +118,22 @@ void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest
__DEL(source);
}
-void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len)
+void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len)
{
- INTEGER len, destLen, i;
+ INT16 len, destLen, i;
__DUP(source, source__len, CHAR);
len = Strings_Length(source, source__len);
- destLen = (int)dest__len - 1;
+ destLen = (INT16)dest__len - 1;
if (pos < 0) {
pos = 0;
}
if (pos >= len) {
dest[0] = 0x00;
+ __DEL(source);
return;
}
i = 0;
- while (((((SYSTEM_INT64)(pos + i) <= source__len && source[__X(pos + i, source__len)] != 0x00)) && i < n)) {
+ while (((((pos + i) <= source__len && source[__X(pos + i, source__len)] != 0x00)) && i < n)) {
if (i < destLen) {
dest[__X(i, dest__len)] = source[__X(pos + i, source__len)];
}
@@ -132,19 +143,17 @@ void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n,
__DEL(source);
}
-INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos)
+INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos)
{
- INTEGER _o_result;
- INTEGER n1, n2, i, j;
+ INT16 n1, n2, i, j;
__DUP(pattern, pattern__len, CHAR);
__DUP(s, s__len, CHAR);
n1 = Strings_Length(s, s__len);
n2 = Strings_Length(pattern, pattern__len);
if (n2 == 0) {
- _o_result = 0;
__DEL(pattern);
__DEL(s);
- return _o_result;
+ return 0;
}
i = pos;
while (i <= n1 - n2) {
@@ -154,23 +163,21 @@ INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__le
j += 1;
}
if (j == n2) {
- _o_result = i;
__DEL(pattern);
__DEL(s);
- return _o_result;
+ return i;
}
}
i += 1;
}
- _o_result = -1;
__DEL(pattern);
__DEL(s);
- return _o_result;
+ return -1;
}
void Strings_Cap (CHAR *s, LONGINT s__len)
{
- INTEGER i;
+ INT16 i;
i = 0;
while (s[__X(i, s__len)] != 0x00) {
if (('a' <= s[__X(i, s__len)] && s[__X(i, s__len)] <= 'z')) {
@@ -184,54 +191,49 @@ static struct Match__7 {
struct Match__7 *lnk;
} *Match__7_s;
-static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INTEGER n, INTEGER m);
+static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INT16 n, INT16 m);
-static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INTEGER n, INTEGER m)
+static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INT16 n, INT16 m)
{
- BOOLEAN _o_result;
while ((((n >= 0 && m >= 0)) && mask[__X(m, mask__len)] != '*')) {
if (name[__X(n, name__len)] != mask[__X(m, mask__len)]) {
- _o_result = 0;
- return _o_result;
+ return 0;
}
n -= 1;
m -= 1;
}
if (m < 0) {
- _o_result = n < 0;
- return _o_result;
+ return n < 0;
}
while ((m >= 0 && mask[__X(m, mask__len)] == '*')) {
m -= 1;
}
if (m < 0) {
- _o_result = 1;
- return _o_result;
+ return 1;
}
while (n >= 0) {
if (M__8(name, name__len, mask, mask__len, n, m)) {
- _o_result = 1;
- return _o_result;
+ return 1;
}
n -= 1;
}
- _o_result = 0;
- return _o_result;
+ return 0;
}
BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len)
{
- BOOLEAN _o_result;
struct Match__7 _s;
+ BOOLEAN __retval;
__DUP(string, string__len, CHAR);
__DUP(pattern, pattern__len, CHAR);
_s.lnk = Match__7_s;
Match__7_s = &_s;
- _o_result = M__8((void*)string, string__len, (void*)pattern, pattern__len, Strings_Length(string, string__len) - 1, Strings_Length(pattern, pattern__len) - 1);
+ __retval = M__8((void*)string, string__len, (void*)pattern, pattern__len, Strings_Length(string, string__len) - 1, Strings_Length(pattern, pattern__len) - 1);
Match__7_s = _s.lnk;
__DEL(string);
__DEL(pattern);
- return _o_result;
+ ;
+ return __retval;
}
diff --git a/bootstrap/unix-88/Strings.h b/bootstrap/unix-88/Strings.h
index d64d3478..c987af8d 100644
--- a/bootstrap/unix-88/Strings.h
+++ b/bootstrap/unix-88/Strings.h
@@ -1,9 +1,8 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Strings__h
#define Strings__h
-#define LARGE
#include "SYSTEM.h"
@@ -11,14 +10,14 @@
import void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len);
import void Strings_Cap (CHAR *s, LONGINT s__len);
-import void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n);
-import void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len);
-import void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len);
-import INTEGER Strings_Length (CHAR *s, LONGINT s__len);
+import 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 INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos);
-import void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len);
+import 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);
-#endif
+#endif // Strings
diff --git a/bootstrap/unix-88/Texts.c b/bootstrap/unix-88/Texts.c
index a1fb81c0..ae12961b 100644
--- a/bootstrap/unix-88/Texts.c
+++ b/bootstrap/unix-88/Texts.c
@@ -1,5 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "Files.h"
#include "Modules.h"
@@ -14,9 +19,9 @@ typedef
typedef
struct Texts_RunDesc {
Texts_Run prev, next;
- LONGINT len;
+ INT32 len;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
BOOLEAN ascii;
} Texts_RunDesc;
@@ -29,7 +34,7 @@ typedef
} Texts_ElemMsg;
typedef
- void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, LONGINT *);
+ void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, ADDRESS *);
typedef
struct Texts_TextDesc *Texts_Text;
@@ -37,26 +42,26 @@ typedef
typedef
struct Texts_ElemDesc {
Texts_Run prev, next;
- LONGINT len;
+ INT32 len;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
BOOLEAN ascii;
- LONGINT W, H;
+ INT32 W, H;
Texts_Handler handle;
Texts_Text base;
} Texts_ElemDesc;
struct Texts__1 { /* Texts_ElemDesc */
Texts_Run prev, next;
- LONGINT len;
+ INT32 len;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
BOOLEAN ascii;
- LONGINT W, H;
+ INT32 W, H;
Texts_Handler handle;
Texts_Text base;
Files_File file;
- LONGINT org, span;
+ INT32 org, span;
CHAR mod[32], proc[32];
};
@@ -65,7 +70,7 @@ typedef
typedef
struct Texts_BufDesc {
- LONGINT len;
+ INT32 len;
Texts_Run head;
} Texts_BufDesc;
@@ -79,8 +84,8 @@ typedef
typedef
struct Texts_FileMsg { /* Texts_ElemMsg */
- INTEGER id;
- LONGINT pos;
+ INT16 id;
+ INT32 pos;
Files_Rider r;
} Texts_FileMsg;
@@ -95,7 +100,7 @@ typedef
} Texts_IdentifyMsg;
typedef
- void (*Texts_Notifier)(Texts_Text, INTEGER, LONGINT, LONGINT);
+ void (*Texts_Notifier)(Texts_Text, INT16, INT32, INT32);
typedef
struct Texts_PieceDesc *Texts_Piece;
@@ -103,57 +108,57 @@ typedef
typedef
struct Texts_PieceDesc {
Texts_Run prev, next;
- LONGINT len;
+ INT32 len;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
BOOLEAN ascii;
Files_File file;
- LONGINT org;
+ INT32 org;
} Texts_PieceDesc;
typedef
struct Texts_Reader {
BOOLEAN eot;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
Texts_Elem elem;
Files_Rider rider;
Texts_Run run;
- LONGINT org, off;
+ INT32 org, off;
} Texts_Reader;
typedef
struct Texts_Scanner { /* Texts_Reader */
BOOLEAN eot;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
Texts_Elem elem;
Files_Rider rider;
Texts_Run run;
- LONGINT org, off;
+ INT32 org, off;
CHAR nextCh;
- INTEGER line, class;
- LONGINT i;
+ INT16 line, class;
+ INT32 i;
REAL x;
LONGREAL y;
CHAR c;
- SHORTINT len;
+ INT8 len;
CHAR s[64];
} Texts_Scanner;
typedef
struct Texts_TextDesc {
- LONGINT len;
+ INT32 len;
Texts_Notifier notify;
Texts_Run head, cache;
- LONGINT corg;
+ INT32 corg;
} Texts_TextDesc;
typedef
struct Texts_Writer {
Texts_Buffer buf;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
Files_Rider rider;
Files_File file;
} Texts_Writer;
@@ -163,84 +168,82 @@ export Texts_Elem Texts_new;
static Texts_Buffer Texts_del;
static Texts_FontsFont Texts_FontsDefault;
-export LONGINT *Texts_FontDesc__typ;
-export LONGINT *Texts_RunDesc__typ;
-export LONGINT *Texts_PieceDesc__typ;
-export LONGINT *Texts_ElemMsg__typ;
-export LONGINT *Texts_ElemDesc__typ;
-export LONGINT *Texts_FileMsg__typ;
-export LONGINT *Texts_CopyMsg__typ;
-export LONGINT *Texts_IdentifyMsg__typ;
-export LONGINT *Texts_BufDesc__typ;
-export LONGINT *Texts_TextDesc__typ;
-export LONGINT *Texts_Reader__typ;
-export LONGINT *Texts_Scanner__typ;
-export LONGINT *Texts_Writer__typ;
-export LONGINT *Texts__1__typ;
+export ADDRESS *Texts_FontDesc__typ;
+export ADDRESS *Texts_RunDesc__typ;
+export ADDRESS *Texts_PieceDesc__typ;
+export ADDRESS *Texts_ElemMsg__typ;
+export ADDRESS *Texts_ElemDesc__typ;
+export ADDRESS *Texts_FileMsg__typ;
+export ADDRESS *Texts_CopyMsg__typ;
+export ADDRESS *Texts_IdentifyMsg__typ;
+export ADDRESS *Texts_BufDesc__typ;
+export ADDRESS *Texts_TextDesc__typ;
+export ADDRESS *Texts_Reader__typ;
+export ADDRESS *Texts_Scanner__typ;
+export ADDRESS *Texts_Writer__typ;
+export ADDRESS *Texts__1__typ;
export void Texts_Append (Texts_Text T, Texts_Buffer B);
-export void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff);
+export void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff);
static Texts_Elem Texts_CloneElem (Texts_Elem e);
static Texts_Piece Texts_ClonePiece (Texts_Piece p);
export void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
export void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
export void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
-export void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end);
+export void Texts_Delete (Texts_Text T, INT32 beg, INT32 end);
export Texts_Text Texts_ElemBase (Texts_Elem E);
-export LONGINT Texts_ElemPos (Texts_Elem E);
-static void Texts_Find (Texts_Text T, LONGINT *pos, Texts_Run *u, LONGINT *org, LONGINT *off);
+export INT32 Texts_ElemPos (Texts_Elem E);
+static void Texts_Find (Texts_Text T, INT32 *pos, Texts_Run *u, INT32 *org, INT32 *off);
static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len);
-static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, LONGINT *msg__typ);
-export void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B);
-export void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T);
-static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T);
+static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, ADDRESS *msg__typ);
+export void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B);
+export void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
+static void Texts_Load0 (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
static void Texts_Merge (Texts_Text T, Texts_Run u, Texts_Run *v);
export void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
export void Texts_OpenBuf (Texts_Buffer B);
-export void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos);
-export void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos);
-export void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ);
-export LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ);
-export void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch);
-export void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ);
-export void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ);
+export void Texts_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);
+export void Texts_OpenWriter (Texts_Writer *W, ADDRESS *W__typ);
+export INT32 Texts_Pos (Texts_Reader *R, ADDRESS *R__typ);
+export void Texts_Read (Texts_Reader *R, ADDRESS *R__typ, CHAR *ch);
+export void Texts_ReadElem (Texts_Reader *R, ADDRESS *R__typ);
+export void Texts_ReadPrevElem (Texts_Reader *R, ADDRESS *R__typ);
export void Texts_Recall (Texts_Buffer *B);
-export void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B);
-export void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ);
-export void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col);
-export void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt);
-export void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff);
+export void Texts_Save (Texts_Text T, INT32 beg, INT32 end, Texts_Buffer B);
+export void Texts_Scan (Texts_Scanner *S, ADDRESS *S__typ);
+export void Texts_SetColor (Texts_Writer *W, ADDRESS *W__typ, INT8 col);
+export void Texts_SetFont (Texts_Writer *W, ADDRESS *W__typ, Texts_FontsFont fnt);
+export void Texts_SetOffset (Texts_Writer *W, ADDRESS *W__typ, INT8 voff);
static void Texts_Splice (Texts_Run un, Texts_Run v, Texts_Run w, Texts_Text base);
-static void Texts_Split (LONGINT off, Texts_Run *u, Texts_Run *un);
-export void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T);
-export void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch);
-export void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d);
-export void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e);
-export void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x);
-export void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n);
-export void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ);
-export void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n);
-export void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x);
-export void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n);
-export void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k);
-export void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x);
-export void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len);
+static void Texts_Split (INT32 off, Texts_Run *u, Texts_Run *un);
+export void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
+export void Texts_Write (Texts_Writer *W, ADDRESS *W__typ, CHAR ch);
+export void Texts_WriteDate (Texts_Writer *W, ADDRESS *W__typ, INT32 t, INT32 d);
+export void Texts_WriteElem (Texts_Writer *W, ADDRESS *W__typ, Texts_Elem e);
+export void Texts_WriteHex (Texts_Writer *W, ADDRESS *W__typ, INT32 x);
+export void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n);
+export void Texts_WriteLn (Texts_Writer *W, ADDRESS *W__typ);
+export void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n);
+export void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x);
+export void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n);
+export void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k);
+export void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x);
+export void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len)
{
- Texts_FontsFont _o_result;
Texts_FontsFont F = NIL;
__NEW(F, Texts_FontDesc);
- __COPY(name, F->name, ((LONGINT)(32)));
- _o_result = F;
- return _o_result;
+ __COPY(name, F->name, 32);
+ return F;
}
-static void Texts_Find (Texts_Text T, LONGINT *pos, Texts_Run *u, LONGINT *org, LONGINT *off)
+static void Texts_Find (Texts_Text T, INT32 *pos, Texts_Run *u, INT32 *org, INT32 *off)
{
Texts_Run v = NIL;
- LONGINT m;
+ INT32 m;
if (*pos >= T->len) {
*pos = T->len;
*u = T->head;
@@ -270,7 +273,7 @@ static void Texts_Find (Texts_Text T, LONGINT *pos, Texts_Run *u, LONGINT *org,
}
}
-static void Texts_Split (LONGINT off, Texts_Run *u, Texts_Run *un)
+static void Texts_Split (INT32 off, Texts_Run *u, Texts_Run *un)
{
Texts_Piece p = NIL, U = NIL;
if (off == 0) {
@@ -333,22 +336,18 @@ static void Texts_Splice (Texts_Run un, Texts_Run v, Texts_Run w, Texts_Text bas
static Texts_Piece Texts_ClonePiece (Texts_Piece p)
{
- Texts_Piece _o_result;
Texts_Piece q = NIL;
__NEW(q, Texts_PieceDesc);
__GUARDEQP(q, Texts_PieceDesc) = *p;
- _o_result = q;
- return _o_result;
+ return q;
}
static Texts_Elem Texts_CloneElem (Texts_Elem e)
{
- Texts_Elem _o_result;
Texts_CopyMsg msg;
msg.e = NIL;
(*e->handle)(e, (void*)&msg, Texts_CopyMsg__typ);
- _o_result = msg.e;
- return _o_result;
+ return msg.e;
}
void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE)
@@ -364,31 +363,27 @@ void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE)
Texts_Text Texts_ElemBase (Texts_Elem E)
{
- Texts_Text _o_result;
- _o_result = E->base;
- return _o_result;
+ return E->base;
}
-LONGINT Texts_ElemPos (Texts_Elem E)
+INT32 Texts_ElemPos (Texts_Elem E)
{
- LONGINT _o_result;
Texts_Run u = NIL;
- LONGINT pos;
+ INT32 pos;
u = E->base->head->next;
pos = 0;
while (u != (void *) E) {
pos = pos + u->len;
u = u->next;
}
- _o_result = pos;
- return _o_result;
+ return pos;
}
-static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, LONGINT *msg__typ)
+static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, ADDRESS *msg__typ)
{
Texts_Alien e = NIL;
Files_Rider r;
- LONGINT i;
+ INT32 i;
CHAR ch;
if (__ISP(E, Texts__1, 2)) {
if (__IS(msg__typ, Texts_CopyMsg, 1)) {
@@ -399,15 +394,15 @@ static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, LONGINT *msg__t
e->file = ((Texts_Alien)E)->file;
e->org = ((Texts_Alien)E)->org;
e->span = ((Texts_Alien)E)->span;
- __COPY(((Texts_Alien)E)->mod, e->mod, ((LONGINT)(32)));
- __COPY(((Texts_Alien)E)->proc, e->proc, ((LONGINT)(32)));
+ __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, ((LONGINT)(32)));
- __COPY(((Texts_Alien)E)->proc, (*msg__).proc, ((LONGINT)(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)) {
@@ -464,10 +459,10 @@ void Texts_Recall (Texts_Buffer *B)
Texts_del = NIL;
}
-void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B)
+void Texts_Save (Texts_Text T, INT32 beg, INT32 end, Texts_Buffer B)
{
Texts_Run u = NIL, v = NIL, w = NIL, wn = NIL;
- LONGINT uo, ud, vo, vd;
+ INT32 uo, ud, vo, vd;
Texts_Find(T, &beg, &u, &uo, &ud);
Texts_Find(T, &end, &v, &vo, &vd);
w = B->head->prev;
@@ -498,11 +493,11 @@ void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B)
B->len += end - beg;
}
-void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B)
+void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B)
{
Texts_Run u = NIL, un = NIL, v = NIL;
Texts_Piece p = NIL, q = NIL;
- LONGINT uo, ud, len;
+ INT32 uo, ud, len;
Texts_Find(T, &pos, &u, &uo, &ud);
Texts_Split(ud, &u, &un);
len = B->len;
@@ -521,7 +516,7 @@ void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B)
void Texts_Append (Texts_Text T, Texts_Buffer B)
{
Texts_Run v = NIL;
- LONGINT pos, len;
+ INT32 pos, len;
pos = T->len;
len = B->len;
v = B->head->next;
@@ -536,10 +531,10 @@ void Texts_Append (Texts_Text T, Texts_Buffer B)
}
}
-void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end)
+void Texts_Delete (Texts_Text T, INT32 beg, INT32 end)
{
Texts_Run c = NIL, u = NIL, un = NIL, v = NIL, vn = NIL;
- LONGINT co, uo, ud, vo, vd;
+ INT32 co, uo, ud, vo, vd;
Texts_Find(T, &beg, &u, &uo, &ud);
Texts_Split(ud, &u, &un);
c = T->cache;
@@ -561,10 +556,10 @@ void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end)
}
}
-void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff)
+void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff)
{
Texts_Run c = NIL, u = NIL, un = NIL, v = NIL, vn = NIL;
- LONGINT co, uo, ud, vo, vd;
+ INT32 co, uo, ud, vo, vd;
Texts_Find(T, &beg, &u, &uo, &ud);
Texts_Split(ud, &u, &un);
c = T->cache;
@@ -574,13 +569,13 @@ void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_F
T->cache = c;
T->corg = co;
while (un != vn) {
- if ((__IN(0, sel) && fnt != NIL)) {
+ if ((__IN(0, sel, 32) && fnt != NIL)) {
un->fnt = fnt;
}
- if (__IN(1, sel)) {
+ if (__IN(1, sel, 32)) {
un->col = col;
}
- if (__IN(2, sel)) {
+ if (__IN(2, sel, 32)) {
un->voff = voff;
}
Texts_Merge(T, u, &un);
@@ -600,7 +595,7 @@ void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_F
}
}
-void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos)
+void Texts_OpenReader (Texts_Reader *R, ADDRESS *R__typ, Texts_Text T, INT32 pos)
{
Texts_Run u = NIL;
if (pos >= T->len) {
@@ -614,10 +609,10 @@ void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT p
}
}
-void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch)
+void Texts_Read (Texts_Reader *R, ADDRESS *R__typ, CHAR *ch)
{
Texts_Run u = NIL;
- LONGINT pos;
+ INT32 pos;
CHAR nextch;
u = (*R).run;
(*R).fnt = u->fnt;
@@ -659,7 +654,7 @@ void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch)
}
}
-void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ)
+void Texts_ReadElem (Texts_Reader *R, ADDRESS *R__typ)
{
Texts_Run u = NIL, un = NIL;
u = (*R).run;
@@ -687,7 +682,7 @@ void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ)
}
}
-void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ)
+void Texts_ReadPrevElem (Texts_Reader *R, ADDRESS *R__typ)
{
Texts_Run u = NIL;
u = (*R).run->prev;
@@ -709,14 +704,12 @@ void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ)
}
}
-LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ)
+INT32 Texts_Pos (Texts_Reader *R, ADDRESS *R__typ)
{
- LONGINT _o_result;
- _o_result = (*R).org + (*R).off;
- return _o_result;
+ return (*R).org + (*R).off;
}
-void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos)
+void Texts_OpenScanner (Texts_Scanner *S, ADDRESS *S__typ, Texts_Text T, INT32 pos)
{
Texts_OpenReader((void*)&*S, S__typ, T, pos);
(*S).line = 0;
@@ -725,10 +718,10 @@ void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT
static struct Scan__31 {
Texts_Scanner *S;
- LONGINT *S__typ;
+ ADDRESS *S__typ;
CHAR *ch;
BOOLEAN *negE;
- INTEGER *e;
+ INT16 *e;
struct Scan__31 *lnk;
} *Scan__31_s;
@@ -747,18 +740,18 @@ static void ReadScaleFactor__32 (void)
}
}
while (('0' <= *Scan__31_s->ch && *Scan__31_s->ch <= '9')) {
- *Scan__31_s->e = (*Scan__31_s->e * 10 + (int)*Scan__31_s->ch) - 48;
+ *Scan__31_s->e = (*Scan__31_s->e * 10 + (INT16)*Scan__31_s->ch) - 48;
Texts_Read((void*)&*Scan__31_s->S, Scan__31_s->S__typ, &*Scan__31_s->ch);
}
}
-void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
+void Texts_Scan (Texts_Scanner *S, ADDRESS *S__typ)
{
CHAR ch, term;
BOOLEAN neg, negE, hex;
- SHORTINT i, j, h;
- INTEGER e;
- LONGINT k;
+ INT8 i, j, h;
+ INT16 e;
+ INT32 k;
REAL x, f;
LONGREAL y, g;
CHAR d[32];
@@ -781,21 +774,21 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
}
if ((('A' <= __CAP(ch) && __CAP(ch) <= 'Z') || ch == '/') || ch == '.') {
do {
- (*S).s[__X(i, ((LONGINT)(64)))] = ch;
+ (*S).s[__X(i, 64)] = ch;
i += 1;
Texts_Read((void*)&*S, S__typ, &ch);
} while (!((((__CAP(ch) > 'Z' && ch != '_') || ('A' > __CAP(ch) && ch > '9')) || ((('0' > ch && ch != '.')) && ch != '/')) || i == 63));
- (*S).s[__X(i, ((LONGINT)(64)))] = 0x00;
+ (*S).s[__X(i, 64)] = 0x00;
(*S).len = i;
(*S).class = 1;
} else if (ch == '"') {
Texts_Read((void*)&*S, S__typ, &ch);
while ((((ch != '"' && ch >= ' ')) && i != 63)) {
- (*S).s[__X(i, ((LONGINT)(64)))] = ch;
+ (*S).s[__X(i, 64)] = ch;
i += 1;
Texts_Read((void*)&*S, S__typ, &ch);
}
- (*S).s[__X(i, ((LONGINT)(64)))] = 0x00;
+ (*S).s[__X(i, 64)] = 0x00;
(*S).len = i + 1;
Texts_Read((void*)&*S, S__typ, &ch);
(*S).class = 2;
@@ -810,7 +803,7 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
hex = 0;
j = 0;
for (;;) {
- d[__X(i, ((LONGINT)(32)))] = ch;
+ d[__X(i, 32)] = ch;
i += 1;
Texts_Read((void*)&*S, S__typ, &ch);
if (ch < '0') {
@@ -819,10 +812,10 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
if ('9' < ch) {
if (('A' <= ch && ch <= 'F')) {
hex = 1;
- ch = (CHAR)((int)ch - 7);
+ ch = (CHAR)((INT16)ch - 7);
} else if (('a' <= ch && ch <= 'f')) {
hex = 1;
- ch = (CHAR)((int)ch - 39);
+ ch = (CHAR)((INT16)ch - 39);
} else {
break;
}
@@ -834,13 +827,13 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
if (i - j > 8) {
j = i - 8;
}
- k = (int)d[__X(j, ((LONGINT)(32)))] - 48;
+ k = (INT16)d[__X(j, 32)] - 48;
j += 1;
if ((i - j == 7 && k >= 8)) {
k -= 16;
}
while (j < i) {
- k = __ASHL(k, 4) + (SYSTEM_INT64)((int)d[__X(j, ((LONGINT)(32)))] - 48);
+ k = __ASHL(k, 4) + ((INT16)d[__X(j, 32)] - 48);
j += 1;
}
if (neg) {
@@ -852,7 +845,7 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
Texts_Read((void*)&*S, S__typ, &ch);
h = i;
while (('0' <= ch && ch <= '9')) {
- d[__X(i, ((LONGINT)(32)))] = ch;
+ d[__X(i, 32)] = ch;
i += 1;
Texts_Read((void*)&*S, S__typ, &ch);
}
@@ -861,12 +854,12 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
y = (LONGREAL)0;
g = (LONGREAL)1;
do {
- y = y * (LONGREAL)10 + ((int)d[__X(j, ((LONGINT)(32)))] - 48);
+ y = y * (LONGREAL)10 + ((INT16)d[__X(j, 32)] - 48);
j += 1;
} while (!(j == h));
while (j < i) {
g = g / (LONGREAL)(LONGREAL)10;
- y = ((int)d[__X(j, ((LONGINT)(32)))] - 48) * g + y;
+ y = ((INT16)d[__X(j, 32)] - 48) * g + y;
j += 1;
}
ReadScaleFactor__32();
@@ -893,12 +886,12 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
x = (REAL)0;
f = (REAL)1;
do {
- x = x * (REAL)10 + ((int)d[__X(j, ((LONGINT)(32)))] - 48);
+ x = x * (REAL)10 + ((INT16)d[__X(j, 32)] - 48);
j += 1;
} while (!(j == h));
while (j < i) {
f = f / (REAL)(REAL)10;
- x = ((int)d[__X(j, ((LONGINT)(32)))] - 48) * f + x;
+ x = ((INT16)d[__X(j, 32)] - 48) * f + x;
j += 1;
}
if (ch == 'E') {
@@ -930,7 +923,7 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
(*S).class = 3;
k = 0;
do {
- k = k * 10 + (SYSTEM_INT64)((int)d[__X(j, ((LONGINT)(32)))] - 48);
+ k = k * 10 + ((INT16)d[__X(j, 32)] - 48);
j += 1;
} while (!(j == i));
if (neg) {
@@ -958,33 +951,33 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
Scan__31_s = _s.lnk;
}
-void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ)
+void Texts_OpenWriter (Texts_Writer *W, ADDRESS *W__typ)
{
__NEW((*W).buf, Texts_BufDesc);
Texts_OpenBuf((*W).buf);
(*W).fnt = Texts_FontsDefault;
(*W).col = 15;
(*W).voff = 0;
- (*W).file = Files_New((CHAR*)"", (LONGINT)1);
- Files_Set(&(*W).rider, Files_Rider__typ, (*W).file, ((LONGINT)(0)));
+ (*W).file = Files_New((CHAR*)"", 1);
+ Files_Set(&(*W).rider, Files_Rider__typ, (*W).file, 0);
}
-void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt)
+void Texts_SetFont (Texts_Writer *W, ADDRESS *W__typ, Texts_FontsFont fnt)
{
(*W).fnt = fnt;
}
-void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col)
+void Texts_SetColor (Texts_Writer *W, ADDRESS *W__typ, INT8 col)
{
(*W).col = col;
}
-void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff)
+void Texts_SetOffset (Texts_Writer *W, ADDRESS *W__typ, INT8 voff)
{
(*W).voff = voff;
}
-void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch)
+void Texts_Write (Texts_Writer *W, ADDRESS *W__typ, CHAR ch)
{
Texts_Run u = NIL, un = NIL;
Texts_Piece p = NIL;
@@ -1010,7 +1003,7 @@ void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch)
}
}
-void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e)
+void Texts_WriteElem (Texts_Writer *W, ADDRESS *W__typ, Texts_Elem e)
{
Texts_Run u = NIL, un = NIL;
if (e->base != NIL) {
@@ -1029,14 +1022,14 @@ void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e)
un->prev = (Texts_Run)e;
}
-void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ)
+void Texts_WriteLn (Texts_Writer *W, ADDRESS *W__typ)
{
Texts_Write(&*W, W__typ, 0x0d);
}
-void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len)
+void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len)
{
- INTEGER i;
+ INT16 i;
__DUP(s, s__len, CHAR);
i = 0;
while (s[__X(i, s__len)] >= ' ') {
@@ -1046,15 +1039,15 @@ void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__le
__DEL(s);
}
-void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n)
+void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n)
{
- INTEGER i;
- LONGINT x0;
- CHAR a[22];
+ INT16 i;
+ INT64 x0;
+ CHAR a[24];
i = 0;
if (x < 0) {
if (x == (-9223372036854775807-1)) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" -9223372036854775808", (LONGINT)22);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" -9223372036854775808", 22);
return;
} else {
n -= 1;
@@ -1064,11 +1057,11 @@ void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n)
x0 = x;
}
do {
- a[__X(i, ((LONGINT)(22)))] = (CHAR)(__MOD(x0, 10) + 48);
+ a[__X(i, 24)] = (CHAR)(__MOD(x0, 10) + 48);
x0 = __DIV(x0, 10);
i += 1;
} while (!(x0 == 0));
- while (n > (SYSTEM_INT64)i) {
+ while (n > (INT64)i) {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
}
@@ -1077,47 +1070,47 @@ void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n)
}
do {
i -= 1;
- Texts_Write(&*W, W__typ, a[__X(i, ((LONGINT)(22)))]);
+ Texts_Write(&*W, W__typ, a[__X(i, 24)]);
} while (!(i == 0));
}
-void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x)
+void Texts_WriteHex (Texts_Writer *W, ADDRESS *W__typ, INT32 x)
{
- INTEGER i;
- LONGINT y;
+ INT16 i;
+ INT32 y;
CHAR a[20];
i = 0;
Texts_Write(&*W, W__typ, ' ');
do {
y = __MASK(x, -16);
if (y < 10) {
- a[__X(i, ((LONGINT)(20)))] = (CHAR)(y + 48);
+ a[__X(i, 20)] = (CHAR)(y + 48);
} else {
- a[__X(i, ((LONGINT)(20)))] = (CHAR)(y + 55);
+ a[__X(i, 20)] = (CHAR)(y + 55);
}
x = __ASHR(x, 4);
i += 1;
} while (!(i == 8));
do {
i -= 1;
- Texts_Write(&*W, W__typ, a[__X(i, ((LONGINT)(20)))]);
+ Texts_Write(&*W, W__typ, a[__X(i, 20)]);
} while (!(i == 0));
}
-void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n)
+void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n)
{
- INTEGER e;
+ INT16 e;
REAL x0;
CHAR d[9];
e = Reals_Expo(x);
if (e == 0) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" 0", (LONGINT)4);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" 0", 4);
do {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
} while (!(n <= 3));
} else if (e == 255) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", 5);
while (n > 4) {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
@@ -1154,13 +1147,13 @@ void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n)
x = x * 1.0000000e-001;
e += 1;
}
- Reals_Convert(x, n, (void*)d, ((LONGINT)(9)));
+ Reals_Convert(x, n, (void*)d, 9);
n -= 1;
- Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(9)))]);
+ Texts_Write(&*W, W__typ, d[__X(n, 9)]);
Texts_Write(&*W, W__typ, '.');
do {
n -= 1;
- Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(9)))]);
+ Texts_Write(&*W, W__typ, d[__X(n, 9)]);
} while (!(n == 0));
Texts_Write(&*W, W__typ, 'E');
if (e < 0) {
@@ -1176,16 +1169,16 @@ void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n)
static struct WriteRealFix__53 {
Texts_Writer *W;
- LONGINT *W__typ;
- INTEGER *i;
+ ADDRESS *W__typ;
+ INT16 *i;
CHAR (*d)[9];
struct WriteRealFix__53 *lnk;
} *WriteRealFix__53_s;
-static void dig__54 (INTEGER n);
-static void seq__56 (CHAR ch, INTEGER n);
+static void dig__54 (INT16 n);
+static void seq__56 (CHAR ch, INT16 n);
-static void seq__56 (CHAR ch, INTEGER n)
+static void seq__56 (CHAR ch, INT16 n)
{
while (n > 0) {
Texts_Write(&*WriteRealFix__53_s->W, WriteRealFix__53_s->W__typ, ch);
@@ -1193,18 +1186,18 @@ static void seq__56 (CHAR ch, INTEGER n)
}
}
-static void dig__54 (INTEGER n)
+static void dig__54 (INT16 n)
{
while (n > 0) {
*WriteRealFix__53_s->i -= 1;
- Texts_Write(&*WriteRealFix__53_s->W, WriteRealFix__53_s->W__typ, (*WriteRealFix__53_s->d)[__X(*WriteRealFix__53_s->i, ((LONGINT)(9)))]);
+ Texts_Write(&*WriteRealFix__53_s->W, WriteRealFix__53_s->W__typ, (*WriteRealFix__53_s->d)[__X(*WriteRealFix__53_s->i, 9)]);
n -= 1;
}
}
-void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k)
+void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k)
{
- INTEGER e, i;
+ INT16 e, i;
CHAR sign;
REAL x0;
CHAR d[9];
@@ -1223,7 +1216,7 @@ void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, IN
Texts_Write(&*W, W__typ, '0');
seq__56(' ', k + 1);
} else if (e == 255) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", 5);
seq__56(' ', n - 4);
} else {
e = __ASHR((e - 127) * 77, 8);
@@ -1255,7 +1248,7 @@ void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, IN
}
e += 1;
i = k + e;
- Reals_Convert(x, i, (void*)d, ((LONGINT)(9)));
+ Reals_Convert(x, i, (void*)d, 9);
if (e > 0) {
seq__56(' ', ((n - e) - k) - 2);
Texts_Write(&*W, W__typ, sign);
@@ -1274,32 +1267,32 @@ void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, IN
WriteRealFix__53_s = _s.lnk;
}
-void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x)
+void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x)
{
- INTEGER i;
+ INT16 i;
CHAR d[8];
- Reals_ConvertH(x, (void*)d, ((LONGINT)(8)));
+ Reals_ConvertH(x, (void*)d, 8);
i = 0;
do {
- Texts_Write(&*W, W__typ, d[__X(i, ((LONGINT)(8)))]);
+ Texts_Write(&*W, W__typ, d[__X(i, 8)]);
i += 1;
} while (!(i == 8));
}
-void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n)
+void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n)
{
- INTEGER e;
+ INT16 e;
LONGREAL x0;
CHAR d[16];
e = Reals_ExpoL(x);
if (e == 0) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" 0", (LONGINT)4);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" 0", 4);
do {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
} while (!(n <= 3));
} else if (e == 2047) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", 5);
while (n > 4) {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
@@ -1320,7 +1313,7 @@ void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER
} else {
Texts_Write(&*W, W__typ, ' ');
}
- e = (int)__ASHR((SYSTEM_INT64)(e - 1023) * 77, 8);
+ e = (INT16)__ASHR((e - 1023) * 77, 8);
if (e >= 0) {
x = x / (LONGREAL)Reals_TenL(e);
} else {
@@ -1336,13 +1329,13 @@ void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER
x = 1.00000000000000e-001 * x;
e += 1;
}
- Reals_ConvertL(x, n, (void*)d, ((LONGINT)(16)));
+ Reals_ConvertL(x, n, (void*)d, 16);
n -= 1;
- Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(16)))]);
+ Texts_Write(&*W, W__typ, d[__X(n, 16)]);
Texts_Write(&*W, W__typ, '.');
do {
n -= 1;
- Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(16)))]);
+ Texts_Write(&*W, W__typ, d[__X(n, 16)]);
} while (!(n == 0));
Texts_Write(&*W, W__typ, 'D');
if (e < 0) {
@@ -1358,34 +1351,34 @@ void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER
}
}
-void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x)
+void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x)
{
- INTEGER i;
+ INT16 i;
CHAR d[16];
- Reals_ConvertHL(x, (void*)d, ((LONGINT)(16)));
+ Reals_ConvertHL(x, (void*)d, 16);
i = 0;
do {
- Texts_Write(&*W, W__typ, d[__X(i, ((LONGINT)(16)))]);
+ Texts_Write(&*W, W__typ, d[__X(i, 16)]);
i += 1;
} while (!(i == 16));
}
static struct WriteDate__43 {
Texts_Writer *W;
- LONGINT *W__typ;
+ ADDRESS *W__typ;
struct WriteDate__43 *lnk;
} *WriteDate__43_s;
-static void WritePair__44 (CHAR ch, LONGINT x);
+static void WritePair__44 (CHAR ch, INT32 x);
-static void WritePair__44 (CHAR ch, LONGINT x)
+static void WritePair__44 (CHAR ch, INT32 x)
{
Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, ch);
Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, (CHAR)(__DIV(x, 10) + 48));
- Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, (CHAR)(__MOD(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, LONGINT *W__typ, LONGINT t, LONGINT d)
+void Texts_WriteDate (Texts_Writer *W, ADDRESS *W__typ, INT32 t, INT32 d)
{
struct WriteDate__43 _s;
_s.W = W; _s.W__typ = W__typ;
@@ -1402,35 +1395,35 @@ void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d)
static struct Load0__16 {
Texts_Text *T;
- SHORTINT *ecnt;
+ INT8 *ecnt;
Files_File *f;
Texts_FileMsg *msg;
CHAR (*mods)[64][32], (*procs)[64][32];
struct Load0__16 *lnk;
} *Load0__16_s;
-static void LoadElem__17 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, LONGINT span, Texts_Elem *e);
+static void LoadElem__17 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, INT32 span, Texts_Elem *e);
-static void LoadElem__17 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, LONGINT span, Texts_Elem *e)
+static void LoadElem__17 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, INT32 span, Texts_Elem *e)
{
Modules_Module M = NIL;
Modules_Command Cmd;
Texts_Alien a = NIL;
- LONGINT org, ew, eh;
- SHORTINT eno;
+ INT32 org, ew, eh;
+ INT8 eno;
Texts_new = NIL;
Files_ReadLInt(&*r, r__typ, &ew);
Files_ReadLInt(&*r, r__typ, &eh);
Files_Read(&*r, r__typ, (void*)&eno);
if (eno > *Load0__16_s->ecnt) {
*Load0__16_s->ecnt = eno;
- Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32)));
- Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32)));
+ Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->mods)[__X(eno, 64)], 32);
+ Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->procs)[__X(eno, 64)], 32);
}
org = Files_Pos(&*r, r__typ);
- M = Modules_ThisMod((*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32)));
+ M = Modules_ThisMod((*Load0__16_s->mods)[__X(eno, 64)], 32);
if (M != NIL) {
- Cmd = Modules_ThisCommand(M, (*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32)));
+ Cmd = Modules_ThisCommand(M, (*Load0__16_s->procs)[__X(eno, 64)], 32);
if (Cmd != NIL) {
(*Cmd)();
}
@@ -1456,19 +1449,19 @@ static void LoadElem__17 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, LONGINT
a->file = *Load0__16_s->f;
a->org = org;
a->span = span;
- __COPY((*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], a->mod, ((LONGINT)(32)));
- __COPY((*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], a->proc, ((LONGINT)(32)));
+ __COPY((*Load0__16_s->mods)[__X(eno, 64)], a->mod, 32);
+ __COPY((*Load0__16_s->procs)[__X(eno, 64)], a->proc, 32);
*e = (Texts_Elem)a;
}
}
-static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
+static void Texts_Load0 (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
{
Texts_Run u = NIL, un = NIL;
Texts_Piece p = NIL;
Texts_Elem e = NIL;
- LONGINT org, pos, hlen, plen;
- SHORTINT ecnt, fno, fcnt, col, voff;
+ INT32 org, pos, hlen, plen;
+ INT8 ecnt, fcnt, fno, col, voff;
Files_File f = NIL;
Texts_FileMsg msg;
CHAR mods[64][32], procs[64][32];
@@ -1486,7 +1479,7 @@ static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
pos = Files_Pos(&*r, r__typ);
f = Files_Base(&*r, r__typ);
__NEW(u, Texts_RunDesc);
- u->len = 9223372036854775807;
+ u->len = 2147483647;
u->fnt = NIL;
u->col = 15;
T->head = u;
@@ -1501,8 +1494,8 @@ static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
while (fno != 0) {
if (fno > fcnt) {
fcnt = fno;
- Files_ReadString(&msg.r, Files_Rider__typ, (void*)name, ((LONGINT)(32)));
- fnts[__X(fno, ((LONGINT)(32)))] = Texts_FontsThis((void*)name, ((LONGINT)(32)));
+ Files_ReadString(&msg.r, Files_Rider__typ, (void*)name, 32);
+ fnts[__X(fno, 32)] = Texts_FontsThis((void*)name, 32);
}
Files_Read(&msg.r, Files_Rider__typ, (void*)&col);
Files_Read(&msg.r, Files_Rider__typ, (void*)&voff);
@@ -1536,9 +1529,9 @@ static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
Load0__16_s = _s.lnk;
}
-void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
+void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
{
- INTEGER tag;
+ INT16 tag;
Files_ReadInt(&*r, r__typ, &tag);
if (tag != -4095) {
Files_Set(&*r, r__typ, Files_Base(&*r, r__typ), Files_Pos(&*r, r__typ) - 2);
@@ -1553,25 +1546,25 @@ void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len)
Texts_Run u = NIL;
Texts_Piece p = NIL;
CHAR tag, version;
- LONGINT hlen;
+ INT32 hlen;
__DUP(name, name__len, CHAR);
f = Files_Old(name, name__len);
if (f == NIL) {
- f = Files_New((CHAR*)"", (LONGINT)1);
+ f = Files_New((CHAR*)"", 1);
}
- Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(0)));
+ Files_Set(&r, Files_Rider__typ, f, 0);
Files_Read(&r, Files_Rider__typ, (void*)&tag);
Files_Read(&r, Files_Rider__typ, (void*)&version);
if (tag == 0xf0 || (tag == 0x01 && version == 0xf0)) {
Texts_Load0(&r, Files_Rider__typ, T);
} else {
__NEW(u, Texts_RunDesc);
- u->len = 9223372036854775807;
+ u->len = 2147483647;
u->fnt = NIL;
u->col = 15;
__NEW(p, Texts_PieceDesc);
if ((tag == 0xf7 && version == 0x07)) {
- Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(28)));
+ Files_Set(&r, Files_Rider__typ, f, 28);
Files_ReadLInt(&r, Files_Rider__typ, &hlen);
Files_Set(&r, Files_Rider__typ, f, 22 + hlen);
Files_ReadLInt(&r, Files_Rider__typ, &T->len);
@@ -1603,35 +1596,35 @@ void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len)
}
static struct Store__39 {
- SHORTINT *ecnt;
+ INT8 *ecnt;
Texts_FileMsg *msg;
Texts_IdentifyMsg *iden;
CHAR (*mods)[64][32], (*procs)[64][32];
struct Store__39 *lnk;
} *Store__39_s;
-static void StoreElem__40 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, Texts_Elem e);
+static void StoreElem__40 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, Texts_Elem e);
-static void StoreElem__40 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, Texts_Elem e)
+static void StoreElem__40 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, Texts_Elem e)
{
Files_Rider r1;
- LONGINT org, span;
- SHORTINT eno;
- __COPY((*Store__39_s->iden).mod, (*Store__39_s->mods)[__X(*Store__39_s->ecnt, ((LONGINT)(64)))], ((LONGINT)(32)));
- __COPY((*Store__39_s->iden).proc, (*Store__39_s->procs)[__X(*Store__39_s->ecnt, ((LONGINT)(64)))], ((LONGINT)(32)));
+ INT32 org, span;
+ INT8 eno;
+ __COPY((*Store__39_s->iden).mod, (*Store__39_s->mods)[__X(*Store__39_s->ecnt, 64)], 32);
+ __COPY((*Store__39_s->iden).proc, (*Store__39_s->procs)[__X(*Store__39_s->ecnt, 64)], 32);
eno = 1;
- while (__STRCMP((*Store__39_s->mods)[__X(eno, ((LONGINT)(64)))], (*Store__39_s->iden).mod) != 0 || __STRCMP((*Store__39_s->procs)[__X(eno, ((LONGINT)(64)))], (*Store__39_s->iden).proc) != 0) {
+ while (__STRCMP((*Store__39_s->mods)[__X(eno, 64)], (*Store__39_s->iden).mod) != 0 || __STRCMP((*Store__39_s->procs)[__X(eno, 64)], (*Store__39_s->iden).proc) != 0) {
eno += 1;
}
Files_Set(&r1, Files_Rider__typ, Files_Base(&*r, r__typ), Files_Pos(&*r, r__typ));
- Files_WriteLInt(&*r, r__typ, ((LONGINT)(0)));
- Files_WriteLInt(&*r, r__typ, ((LONGINT)(0)));
- Files_WriteLInt(&*r, r__typ, ((LONGINT)(0)));
+ Files_WriteLInt(&*r, r__typ, 0);
+ Files_WriteLInt(&*r, r__typ, 0);
+ Files_WriteLInt(&*r, r__typ, 0);
Files_Write(&*r, r__typ, eno);
if (eno == *Store__39_s->ecnt) {
*Store__39_s->ecnt += 1;
- Files_WriteString(&*r, r__typ, (*Store__39_s->iden).mod, ((LONGINT)(32)));
- Files_WriteString(&*r, r__typ, (*Store__39_s->iden).proc, ((LONGINT)(32)));
+ Files_WriteString(&*r, r__typ, (*Store__39_s->iden).mod, 32);
+ Files_WriteString(&*r, r__typ, (*Store__39_s->iden).proc, 32);
}
(*Store__39_s->msg).pos = pos;
org = Files_Pos(&*r, r__typ);
@@ -1642,14 +1635,15 @@ static void StoreElem__40 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, Texts_E
Files_WriteLInt(&r1, Files_Rider__typ, e->H);
}
-void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
+void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
{
Files_Rider r1;
Texts_Run u = NIL, un = NIL;
Texts_Elem e = NIL;
- LONGINT org, pos, delta, hlen, rlen;
- SHORTINT ecnt, fno, fcnt;
+ INT32 org, pos, delta, hlen, rlen;
+ INT8 ecnt, fcnt;
CHAR ch;
+ INT8 fno;
Texts_FileMsg msg;
Texts_IdentifyMsg iden;
CHAR mods[64][32], procs[64][32];
@@ -1666,7 +1660,7 @@ void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
org = Files_Pos(&*r, r__typ);
msg.id = 1;
msg.r = *r;
- Files_WriteLInt(&msg.r, Files_Rider__typ, ((LONGINT)(0)));
+ Files_WriteLInt(&msg.r, Files_Rider__typ, 0);
u = T->head->next;
pos = 0;
delta = 0;
@@ -1680,15 +1674,15 @@ void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
iden.mod[0] = 0x01;
}
if (iden.mod[0] != 0x00) {
- fnts[__X(fcnt, ((LONGINT)(32)))] = u->fnt;
+ fnts[__X(fcnt, 32)] = u->fnt;
fno = 1;
- while (__STRCMP(fnts[__X(fno, ((LONGINT)(32)))]->name, u->fnt->name) != 0) {
+ while (__STRCMP(fnts[__X(fno, 32)]->name, u->fnt->name) != 0) {
fno += 1;
}
Files_Write(&msg.r, Files_Rider__typ, fno);
if (fno == fcnt) {
fcnt += 1;
- Files_WriteString(&msg.r, Files_Rider__typ, u->fnt->name, ((LONGINT)(32)));
+ Files_WriteString(&msg.r, Files_Rider__typ, u->fnt->name, 32);
}
Files_Write(&msg.r, Files_Rider__typ, u->col);
Files_Write(&msg.r, Files_Rider__typ, u->voff);
@@ -1737,12 +1731,12 @@ void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
delta = ((Texts_Piece)u)->len;
while (delta > 1024) {
- Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), ((LONGINT)(1024)));
- Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), ((LONGINT)(1024)));
+ Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, 1024, 1024);
+ Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, 1024, 1024);
delta -= 1024;
}
- Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), delta);
- Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), delta);
+ Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, 1024, delta);
+ Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, 1024, delta);
}
} else __WITHCHK;
} else {
@@ -1756,7 +1750,7 @@ void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
}
__GUARDEQR(r, r__typ, Files_Rider) = msg.r;
if (T->notify != NIL) {
- (*T->notify)(T, 3, ((LONGINT)(0)), ((LONGINT)(0)));
+ (*T->notify)(T, 3, 0, 0);
}
Store__39_s = _s.lnk;
}
@@ -1765,11 +1759,11 @@ void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len)
{
Files_File f = NIL;
Files_Rider r;
- INTEGER i, res;
+ INT16 i, res;
CHAR bak[64];
__DUP(name, name__len, CHAR);
f = Files_New(name, name__len);
- Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(0)));
+ Files_Set(&r, Files_Rider__typ, f, 0);
Files_Write(&r, Files_Rider__typ, 0xf0);
Files_Write(&r, Files_Rider__typ, 0x01);
Texts_Store(&r, Files_Rider__typ, T);
@@ -1777,13 +1771,13 @@ void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len)
while (name[__X(i, name__len)] != 0x00) {
i += 1;
}
- __COPY(name, bak, ((LONGINT)(64)));
- bak[__X(i, ((LONGINT)(64)))] = '.';
- bak[__X(i + 1, ((LONGINT)(64)))] = 'B';
- bak[__X(i + 2, ((LONGINT)(64)))] = 'a';
- bak[__X(i + 3, ((LONGINT)(64)))] = 'k';
- bak[__X(i + 4, ((LONGINT)(64)))] = 0x00;
- Files_Rename(name, name__len, bak, ((LONGINT)(64)), &res);
+ __COPY(name, bak, 64);
+ bak[__X(i, 64)] = '.';
+ bak[__X(i + 1, 64)] = 'B';
+ bak[__X(i + 2, 64)] = 'a';
+ bak[__X(i + 3, 64)] = 'k';
+ bak[__X(i + 4, 64)] = 0x00;
+ Files_Rename(name, name__len, bak, 64, &res);
Files_Register(f);
__DEL(name);
}
@@ -1799,16 +1793,16 @@ __TDESC(Texts_FontDesc, 1, 0) = {__TDFLDS("FontDesc", 32), {-8}};
__TDESC(Texts_RunDesc, 1, 3) = {__TDFLDS("RunDesc", 40), {0, 8, 24, -32}};
__TDESC(Texts_PieceDesc, 1, 4) = {__TDFLDS("PieceDesc", 56), {0, 8, 24, 40, -40}};
__TDESC(Texts_ElemMsg, 1, 0) = {__TDFLDS("ElemMsg", 1), {-8}};
-__TDESC(Texts_ElemDesc, 1, 4) = {__TDFLDS("ElemDesc", 72), {0, 8, 24, 64, -40}};
-__TDESC(Texts_FileMsg, 1, 1) = {__TDFLDS("FileMsg", 56), {32, -16}};
+__TDESC(Texts_ElemDesc, 1, 4) = {__TDFLDS("ElemDesc", 64), {0, 8, 24, 56, -40}};
+__TDESC(Texts_FileMsg, 1, 1) = {__TDFLDS("FileMsg", 32), {16, -16}};
__TDESC(Texts_CopyMsg, 1, 1) = {__TDFLDS("CopyMsg", 8), {0, -16}};
__TDESC(Texts_IdentifyMsg, 1, 0) = {__TDFLDS("IdentifyMsg", 64), {-8}};
__TDESC(Texts_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 16), {8, -16}};
__TDESC(Texts_TextDesc, 1, 2) = {__TDFLDS("TextDesc", 40), {16, 24, -24}};
-__TDESC(Texts_Reader, 1, 4) = {__TDFLDS("Reader", 96), {8, 24, 48, 72, -40}};
-__TDESC(Texts_Scanner, 1, 4) = {__TDFLDS("Scanner", 208), {8, 24, 48, 72, -40}};
-__TDESC(Texts_Writer, 1, 4) = {__TDFLDS("Writer", 72), {0, 8, 40, 64, -40}};
-__TDESC(Texts__1, 1, 5) = {__TDFLDS("", 160), {0, 8, 24, 64, 72, -48}};
+__TDESC(Texts_Reader, 1, 4) = {__TDFLDS("Reader", 72), {8, 24, 40, 56, -40}};
+__TDESC(Texts_Scanner, 1, 4) = {__TDFLDS("Scanner", 168), {8, 24, 40, 56, -40}};
+__TDESC(Texts_Writer, 1, 4) = {__TDFLDS("Writer", 56), {0, 8, 32, 48, -40}};
+__TDESC(Texts__1, 1, 5) = {__TDFLDS("", 144), {0, 8, 24, 56, 64, -48}};
export void *Texts__init(void)
{
diff --git a/bootstrap/unix-88/Texts.h b/bootstrap/unix-88/Texts.h
index bca5665d..61a97dda 100644
--- a/bootstrap/unix-88/Texts.h
+++ b/bootstrap/unix-88/Texts.h
@@ -1,16 +1,15 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Texts__h
#define Texts__h
-#define LARGE
#include "SYSTEM.h"
#include "Files.h"
typedef
struct Texts_BufDesc {
- LONGINT len;
- char _prvt0[8];
+ INT32 len;
+ INT64 _prvt0;
} Texts_BufDesc;
typedef
@@ -31,25 +30,26 @@ typedef
typedef
struct Texts_RunDesc {
- LONGINT _prvt0;
+ INT64 _prvt0;
char _prvt1[27];
} Texts_RunDesc;
typedef
- void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, LONGINT *);
+ void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, ADDRESS *);
typedef
struct Texts_ElemDesc {
- char _prvt0[40];
- LONGINT W, H;
+ INT64 _prvt0;
+ char _prvt1[28];
+ INT32 W, H;
Texts_Handler handle;
- char _prvt1[8];
+ char _prvt2[8];
} Texts_ElemDesc;
typedef
struct Texts_FileMsg { /* Texts_ElemMsg */
- INTEGER id;
- LONGINT pos;
+ INT16 id;
+ INT32 pos;
Files_Rider r;
} Texts_FileMsg;
@@ -70,104 +70,104 @@ typedef
struct Texts_TextDesc *Texts_Text;
typedef
- void (*Texts_Notifier)(Texts_Text, INTEGER, LONGINT, LONGINT);
+ void (*Texts_Notifier)(Texts_Text, INT16, INT32, INT32);
typedef
struct Texts_Reader {
BOOLEAN eot;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
Texts_Elem elem;
- char _prvt0[64];
+ char _prvt0[40];
} Texts_Reader;
typedef
struct Texts_Scanner { /* Texts_Reader */
BOOLEAN eot;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
Texts_Elem elem;
- char _prvt0[64];
+ char _prvt0[40];
CHAR nextCh;
- INTEGER line, class;
- LONGINT i;
+ INT16 line, class;
+ INT32 i;
REAL x;
LONGREAL y;
CHAR c;
- SHORTINT len;
+ INT8 len;
CHAR s[64];
} Texts_Scanner;
typedef
struct Texts_TextDesc {
- LONGINT len;
+ INT32 len;
Texts_Notifier notify;
- char _prvt0[24];
+ char _prvt0[20];
} Texts_TextDesc;
typedef
struct Texts_Writer {
Texts_Buffer buf;
Texts_FontsFont fnt;
- SHORTINT col, voff;
- char _prvt0[54];
+ INT8 col, voff;
+ char _prvt0[38];
} Texts_Writer;
import Texts_Elem Texts_new;
-import LONGINT *Texts_FontDesc__typ;
-import LONGINT *Texts_RunDesc__typ;
-import LONGINT *Texts_ElemMsg__typ;
-import LONGINT *Texts_ElemDesc__typ;
-import LONGINT *Texts_FileMsg__typ;
-import LONGINT *Texts_CopyMsg__typ;
-import LONGINT *Texts_IdentifyMsg__typ;
-import LONGINT *Texts_BufDesc__typ;
-import LONGINT *Texts_TextDesc__typ;
-import LONGINT *Texts_Reader__typ;
-import LONGINT *Texts_Scanner__typ;
-import LONGINT *Texts_Writer__typ;
+import ADDRESS *Texts_FontDesc__typ;
+import ADDRESS *Texts_RunDesc__typ;
+import ADDRESS *Texts_ElemMsg__typ;
+import ADDRESS *Texts_ElemDesc__typ;
+import ADDRESS *Texts_FileMsg__typ;
+import ADDRESS *Texts_CopyMsg__typ;
+import ADDRESS *Texts_IdentifyMsg__typ;
+import ADDRESS *Texts_BufDesc__typ;
+import ADDRESS *Texts_TextDesc__typ;
+import ADDRESS *Texts_Reader__typ;
+import ADDRESS *Texts_Scanner__typ;
+import ADDRESS *Texts_Writer__typ;
import void Texts_Append (Texts_Text T, Texts_Buffer B);
-import void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff);
+import void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff);
import void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
import void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
import void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
-import void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end);
+import void Texts_Delete (Texts_Text T, INT32 beg, INT32 end);
import Texts_Text Texts_ElemBase (Texts_Elem E);
-import LONGINT Texts_ElemPos (Texts_Elem E);
-import void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B);
-import void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T);
+import INT32 Texts_ElemPos (Texts_Elem E);
+import void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B);
+import void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
import void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
import void Texts_OpenBuf (Texts_Buffer B);
-import void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos);
-import void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos);
-import void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ);
-import LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ);
-import void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch);
-import void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ);
-import void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ);
+import void Texts_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);
+import void Texts_OpenWriter (Texts_Writer *W, ADDRESS *W__typ);
+import INT32 Texts_Pos (Texts_Reader *R, ADDRESS *R__typ);
+import void Texts_Read (Texts_Reader *R, ADDRESS *R__typ, CHAR *ch);
+import void Texts_ReadElem (Texts_Reader *R, ADDRESS *R__typ);
+import void Texts_ReadPrevElem (Texts_Reader *R, ADDRESS *R__typ);
import void Texts_Recall (Texts_Buffer *B);
-import void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B);
-import void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ);
-import void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col);
-import void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt);
-import void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff);
-import void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T);
-import void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch);
-import void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d);
-import void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e);
-import void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x);
-import void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n);
-import void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ);
-import void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n);
-import void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x);
-import void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n);
-import void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k);
-import void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x);
-import void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len);
+import void Texts_Save (Texts_Text T, INT32 beg, INT32 end, Texts_Buffer B);
+import void Texts_Scan (Texts_Scanner *S, ADDRESS *S__typ);
+import void Texts_SetColor (Texts_Writer *W, ADDRESS *W__typ, INT8 col);
+import void Texts_SetFont (Texts_Writer *W, ADDRESS *W__typ, Texts_FontsFont fnt);
+import void Texts_SetOffset (Texts_Writer *W, ADDRESS *W__typ, INT8 voff);
+import void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
+import void Texts_Write (Texts_Writer *W, ADDRESS *W__typ, CHAR ch);
+import void Texts_WriteDate (Texts_Writer *W, ADDRESS *W__typ, INT32 t, INT32 d);
+import void Texts_WriteElem (Texts_Writer *W, ADDRESS *W__typ, Texts_Elem e);
+import void Texts_WriteHex (Texts_Writer *W, ADDRESS *W__typ, INT32 x);
+import void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n);
+import void Texts_WriteLn (Texts_Writer *W, ADDRESS *W__typ);
+import void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n);
+import void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x);
+import void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n);
+import void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k);
+import void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x);
+import void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
import void *Texts__init(void);
-#endif
+#endif // Texts
diff --git a/bootstrap/unix-88/VT100.c b/bootstrap/unix-88/VT100.c
new file mode 100644
index 00000000..f69fd90e
--- /dev/null
+++ b/bootstrap/unix-88/VT100.c
@@ -0,0 +1,264 @@
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
+#include "SYSTEM.h"
+#include "Out.h"
+#include "Strings.h"
+
+
+export CHAR VT100_CSI[5];
+static CHAR VT100_tmpstr[32];
+
+
+export void VT100_CHA (INT16 n);
+export void VT100_CNL (INT16 n);
+export void VT100_CPL (INT16 n);
+export void VT100_CUB (INT16 n);
+export void VT100_CUD (INT16 n);
+export void VT100_CUF (INT16 n);
+export void VT100_CUP (INT16 n, INT16 m);
+export void VT100_CUU (INT16 n);
+export void VT100_DECTCEMh (void);
+export void VT100_DECTCEMl (void);
+export void VT100_DSR (INT16 n);
+export void VT100_ED (INT16 n);
+export void VT100_EL (INT16 n);
+static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len);
+static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len);
+static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len);
+static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len);
+export void VT100_HVP (INT16 n, INT16 m);
+export void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len);
+export void VT100_RCP (void);
+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, LONGINT attr__len);
+
+
+static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end)
+{
+ CHAR h;
+ while (start < end) {
+ h = str[__X(start, str__len)];
+ str[__X(start, str__len)] = str[__X(end, str__len)];
+ str[__X(end, str__len)] = h;
+ start += 1;
+ end -= 1;
+ }
+}
+
+void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len)
+{
+ CHAR b[21];
+ INT16 s, e;
+ INT8 maxLength;
+ maxLength = 11;
+ if (int_ == (-2147483647-1)) {
+ __MOVE("-2147483648", b, 12);
+ e = 11;
+ } else {
+ if (int_ < 0) {
+ b[0] = '-';
+ int_ = -int_;
+ s = 1;
+ } else {
+ s = 0;
+ }
+ e = s;
+ do {
+ b[__X(e, 21)] = (CHAR)((int)__MOD(int_, 10) + 48);
+ int_ = __DIV(int_, 10);
+ e += 1;
+ } while (!(int_ == 0));
+ b[__X(e, 21)] = 0x00;
+ VT100_Reverse0((void*)b, 21, s, e - 1);
+ }
+ __COPY(b, str, str__len);
+}
+
+static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len)
+{
+ CHAR cmd[9];
+ __DUP(letter, letter__len, CHAR);
+ __COPY(VT100_CSI, cmd, 9);
+ Strings_Append(letter, letter__len, (void*)cmd, 9);
+ Out_String(cmd, 9);
+ __DEL(letter);
+}
+
+static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len)
+{
+ CHAR nstr[2];
+ CHAR cmd[7];
+ __DUP(letter, letter__len, CHAR);
+ VT100_IntToStr(n, (void*)nstr, 2);
+ __COPY(VT100_CSI, cmd, 7);
+ Strings_Append(nstr, 2, (void*)cmd, 7);
+ Strings_Append(letter, letter__len, (void*)cmd, 7);
+ Out_String(cmd, 7);
+ __DEL(letter);
+}
+
+static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len)
+{
+ CHAR nstr[2];
+ CHAR cmd[7];
+ __DUP(letter, letter__len, CHAR);
+ VT100_IntToStr(n, (void*)nstr, 2);
+ __COPY(VT100_CSI, cmd, 7);
+ Strings_Append(letter, letter__len, (void*)cmd, 7);
+ Strings_Append(nstr, 2, (void*)cmd, 7);
+ Out_String(cmd, 7);
+ __DEL(letter);
+}
+
+static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len)
+{
+ CHAR nstr[5], mstr[5];
+ CHAR cmd[12];
+ __DUP(letter, letter__len, CHAR);
+ VT100_IntToStr(n, (void*)nstr, 5);
+ VT100_IntToStr(m, (void*)mstr, 5);
+ __COPY(VT100_CSI, cmd, 12);
+ Strings_Append(nstr, 5, (void*)cmd, 12);
+ Strings_Append((CHAR*)";", 2, (void*)cmd, 12);
+ Strings_Append(mstr, 5, (void*)cmd, 12);
+ Strings_Append(letter, letter__len, (void*)cmd, 12);
+ Out_String(cmd, 12);
+ __DEL(letter);
+}
+
+void VT100_CUU (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"A", 2);
+}
+
+void VT100_CUD (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"B", 2);
+}
+
+void VT100_CUF (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"C", 2);
+}
+
+void VT100_CUB (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"D", 2);
+}
+
+void VT100_CNL (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"E", 2);
+}
+
+void VT100_CPL (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"F", 2);
+}
+
+void VT100_CHA (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"G", 2);
+}
+
+void VT100_CUP (INT16 n, INT16 m)
+{
+ VT100_EscSeq2(n, m, (CHAR*)"H", 2);
+}
+
+void VT100_ED (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"J", 2);
+}
+
+void VT100_EL (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"K", 2);
+}
+
+void VT100_SU (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"S", 2);
+}
+
+void VT100_SD (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"T", 2);
+}
+
+void VT100_HVP (INT16 n, INT16 m)
+{
+ VT100_EscSeq2(n, m, (CHAR*)"f", 2);
+}
+
+void VT100_SGR (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"m", 2);
+}
+
+void VT100_SGR2 (INT16 n, INT16 m)
+{
+ VT100_EscSeq2(n, m, (CHAR*)"m", 2);
+}
+
+void VT100_DSR (INT16 n)
+{
+ VT100_EscSeq(6, (CHAR*)"n", 2);
+}
+
+void VT100_SCP (void)
+{
+ VT100_EscSeq0((CHAR*)"s", 2);
+}
+
+void VT100_RCP (void)
+{
+ VT100_EscSeq0((CHAR*)"u", 2);
+}
+
+void VT100_DECTCEMl (void)
+{
+ VT100_EscSeq0((CHAR*)"\?25l", 5);
+}
+
+void VT100_DECTCEMh (void)
+{
+ VT100_EscSeq0((CHAR*)"\?25h", 5);
+}
+
+void VT100_SetAttr (CHAR *attr, LONGINT attr__len)
+{
+ CHAR tmpstr[16];
+ __DUP(attr, attr__len, CHAR);
+ __COPY(VT100_CSI, tmpstr, 16);
+ Strings_Append(attr, attr__len, (void*)tmpstr, 16);
+ Out_String(tmpstr, 16);
+ __DEL(attr);
+}
+
+
+export void *VT100__init(void)
+{
+ __DEFMOD;
+ __MODULE_IMPORT(Out);
+ __MODULE_IMPORT(Strings);
+ __REGMOD("VT100", 0);
+ __REGCMD("DECTCEMh", VT100_DECTCEMh);
+ __REGCMD("DECTCEMl", VT100_DECTCEMl);
+ __REGCMD("RCP", VT100_RCP);
+ __REGCMD("SCP", VT100_SCP);
+/* BEGIN */
+ __COPY("\033", VT100_CSI, 5);
+ Strings_Append((CHAR*)"[", 2, (void*)VT100_CSI, 5);
+ __ENDMOD;
+}
diff --git a/bootstrap/unix-88/VT100.h b/bootstrap/unix-88/VT100.h
new file mode 100644
index 00000000..d99406ec
--- /dev/null
+++ b/bootstrap/unix-88/VT100.h
@@ -0,0 +1,37 @@
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#ifndef VT100__h
+#define VT100__h
+
+#include "SYSTEM.h"
+
+
+import CHAR VT100_CSI[5];
+
+
+import void VT100_CHA (INT16 n);
+import void VT100_CNL (INT16 n);
+import void VT100_CPL (INT16 n);
+import void VT100_CUB (INT16 n);
+import void VT100_CUD (INT16 n);
+import void VT100_CUF (INT16 n);
+import void VT100_CUP (INT16 n, INT16 m);
+import void VT100_CUU (INT16 n);
+import void VT100_DECTCEMh (void);
+import void VT100_DECTCEMl (void);
+import void VT100_DSR (INT16 n);
+import void VT100_ED (INT16 n);
+import void VT100_EL (INT16 n);
+import void VT100_HVP (INT16 n, INT16 m);
+import void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len);
+import void VT100_RCP (void);
+import void VT100_SCP (void);
+import void VT100_SD (INT16 n);
+import void VT100_SGR (INT16 n);
+import void VT100_SGR2 (INT16 n, INT16 m);
+import void VT100_SU (INT16 n);
+import void VT100_SetAttr (CHAR *attr, LONGINT attr__len);
+import void *VT100__init(void);
+
+
+#endif // VT100
diff --git a/bootstrap/unix-88/Vishap.c b/bootstrap/unix-88/Vishap.c
deleted file mode 100644
index 6eda4f2c..00000000
--- a/bootstrap/unix-88/Vishap.c
+++ /dev/null
@@ -1,169 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkamSf */
-#define LARGE
-#include "SYSTEM.h"
-#include "Configuration.h"
-#include "Heap.h"
-#include "OPB.h"
-#include "OPC.h"
-#include "OPM.h"
-#include "OPP.h"
-#include "OPT.h"
-#include "OPV.h"
-#include "Platform.h"
-#include "Strings.h"
-#include "extTools.h"
-#include "vt100.h"
-
-
-static CHAR Vishap_mname[256];
-
-
-export void Vishap_Module (BOOLEAN *done);
-static void Vishap_PropagateElementaryTypeSizes (void);
-export void Vishap_Translate (void);
-static void Vishap_Trap (INTEGER sig);
-
-
-void Vishap_Module (BOOLEAN *done)
-{
- BOOLEAN ext, new;
- OPT_Node p = NIL;
- OPP_Module(&p, OPM_opt);
- if (OPM_noerr) {
- OPV_Init();
- OPV_AdrAndSize(OPT_topScope);
- OPT_Export(&ext, &new);
- if (OPM_noerr) {
- OPM_OpenFiles((void*)OPT_SelfName, ((LONGINT)(256)));
- OPC_Init();
- OPV_Module(p);
- if (OPM_noerr) {
- if (((OPM_mainProg || OPM_mainLinkStat) && __STRCMP(OPM_modName, "SYSTEM") != 0)) {
- OPM_DeleteNewSym();
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"32m", (LONGINT)4);
- }
- OPM_LogWStr((CHAR*)" Main program.", (LONGINT)16);
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"0m", (LONGINT)3);
- }
- } else {
- if (new) {
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"32m", (LONGINT)4);
- }
- OPM_LogWStr((CHAR*)" New symbol file.", (LONGINT)19);
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"0m", (LONGINT)3);
- }
- OPM_RegisterNewSym();
- } else if (ext) {
- OPM_LogWStr((CHAR*)" Extended symbol file.", (LONGINT)24);
- OPM_RegisterNewSym();
- }
- }
- } else {
- OPM_DeleteNewSym();
- }
- }
- }
- OPM_CloseFiles();
- OPT_Close();
- OPM_LogWLn();
- *done = OPM_noerr;
-}
-
-static void Vishap_PropagateElementaryTypeSizes (void)
-{
- OPT_bytetyp->size = OPM_ByteSize;
- OPT_sysptrtyp->size = OPM_PointerSize;
- OPT_chartyp->size = OPM_CharSize;
- OPT_settyp->size = OPM_SetSize;
- OPT_realtyp->size = OPM_RealSize;
- OPT_inttyp->size = OPM_IntSize;
- OPT_linttyp->size = OPM_LIntSize;
- OPT_lrltyp->size = OPM_LRealSize;
- OPT_sinttyp->size = OPM_SIntSize;
- OPT_booltyp->size = OPM_BoolSize;
-}
-
-void Vishap_Translate (void)
-{
- BOOLEAN done;
- CHAR modulesobj[2048];
- modulesobj[0] = 0x00;
- if (OPM_OpenPar()) {
- for (;;) {
- OPM_Init(&done, (void*)Vishap_mname, ((LONGINT)(256)));
- if (!done) {
- return;
- }
- OPM_InitOptions();
- Vishap_PropagateElementaryTypeSizes();
- Heap_GC(0);
- Vishap_Module(&done);
- if (!done) {
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Module compilation failed.", (LONGINT)27);
- OPM_LogWLn();
- Platform_Exit(1);
- }
- if (!OPM_dontAsm) {
- if (OPM_dontLink) {
- extTools_Assemble(OPM_modName, ((LONGINT)(32)));
- } else {
- if (!(OPM_mainProg || OPM_mainLinkStat)) {
- extTools_Assemble(OPM_modName, ((LONGINT)(32)));
- Strings_Append((CHAR*)" ", (LONGINT)2, (void*)modulesobj, ((LONGINT)(2048)));
- Strings_Append(OPM_modName, ((LONGINT)(32)), (void*)modulesobj, ((LONGINT)(2048)));
- Strings_Append((CHAR*)".o", (LONGINT)3, (void*)modulesobj, ((LONGINT)(2048)));
- } else {
- extTools_LinkMain((void*)OPM_modName, ((LONGINT)(32)), OPM_mainLinkStat, modulesobj, ((LONGINT)(2048)));
- }
- }
- }
- }
- }
-}
-
-static void Vishap_Trap (INTEGER sig)
-{
- Heap_FINALL();
- if (sig == 3) {
- Platform_Exit(0);
- } else {
- if ((sig == 4 && Platform_HaltCode == -15)) {
- OPM_LogWStr((CHAR*)" --- Vishap Oberon: internal error", (LONGINT)35);
- OPM_LogWLn();
- }
- Platform_Exit(2);
- }
-}
-
-
-export int main(int argc, char **argv)
-{
- __INIT(argc, argv);
- __MODULE_IMPORT(Configuration);
- __MODULE_IMPORT(Heap);
- __MODULE_IMPORT(OPB);
- __MODULE_IMPORT(OPC);
- __MODULE_IMPORT(OPM);
- __MODULE_IMPORT(OPP);
- __MODULE_IMPORT(OPT);
- __MODULE_IMPORT(OPV);
- __MODULE_IMPORT(Platform);
- __MODULE_IMPORT(Strings);
- __MODULE_IMPORT(extTools);
- __MODULE_IMPORT(vt100);
- __REGMAIN("Vishap", 0);
- __REGCMD("Translate", Vishap_Translate);
-/* BEGIN */
- Platform_SetInterruptHandler(Vishap_Trap);
- Platform_SetQuitHandler(Vishap_Trap);
- Platform_SetBadInstructionHandler(Vishap_Trap);
- OPB_typSize = OPV_TypSize;
- OPT_typSize = OPV_TypSize;
- Vishap_Translate();
- __FINI;
-}
diff --git a/bootstrap/unix-88/WindowsWrapper.h b/bootstrap/unix-88/WindowsWrapper.h
deleted file mode 100644
index b72c815a..00000000
--- a/bootstrap/unix-88/WindowsWrapper.h
+++ /dev/null
@@ -1,10 +0,0 @@
-// WindowsWrapper.h
-//
-// Includes Windows.h while avoiding conflicts with Oberon types.
-
-
-#define BOOLEAN _BOOLEAN
-#define CHAR _CHAR
-#include
-#undef BOOLEAN
-#undef CHAR
diff --git a/bootstrap/unix-88/errors.c b/bootstrap/unix-88/errors.c
deleted file mode 100644
index 48246ffa..00000000
--- a/bootstrap/unix-88/errors.c
+++ /dev/null
@@ -1,200 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
-#include "SYSTEM.h"
-
-typedef
- CHAR errors_string[128];
-
-
-export errors_string errors_errors[350];
-
-
-
-
-
-export void *errors__init(void)
-{
- __DEFMOD;
- __REGMOD("errors", 0);
-/* BEGIN */
- __MOVE("undeclared identifier", errors_errors[0], 22);
- __MOVE("multiply defined identifier", errors_errors[1], 28);
- __MOVE("illegal character in number", errors_errors[2], 28);
- __MOVE("illegal character in string", errors_errors[3], 28);
- __MOVE("identifier does not match procedure name", errors_errors[4], 41);
- __MOVE("comment not closed", errors_errors[5], 19);
- errors_errors[6][0] = 0x00;
- errors_errors[7][0] = 0x00;
- errors_errors[8][0] = 0x00;
- __MOVE("'=' expected", errors_errors[9], 13);
- errors_errors[10][0] = 0x00;
- errors_errors[11][0] = 0x00;
- __MOVE("type definition starts with incorrect symbol", errors_errors[12], 45);
- __MOVE("factor starts with incorrect symbol", errors_errors[13], 36);
- __MOVE("statement starts with incorrect symbol", errors_errors[14], 39);
- __MOVE("declaration followed by incorrect symbol", errors_errors[15], 41);
- __MOVE("MODULE expected", errors_errors[16], 16);
- errors_errors[17][0] = 0x00;
- __MOVE("'.' missing", errors_errors[18], 12);
- __MOVE("',' missing", errors_errors[19], 12);
- __MOVE("':' missing", errors_errors[20], 12);
- errors_errors[21][0] = 0x00;
- __MOVE("')' missing", errors_errors[22], 12);
- __MOVE("']' missing", errors_errors[23], 12);
- __MOVE("'}' missing", errors_errors[24], 12);
- __MOVE("OF missing", errors_errors[25], 11);
- __MOVE("THEN missing", errors_errors[26], 13);
- __MOVE("DO missing", errors_errors[27], 11);
- __MOVE("TO missing", errors_errors[28], 11);
- errors_errors[29][0] = 0x00;
- __MOVE("'(' missing", errors_errors[30], 12);
- errors_errors[31][0] = 0x00;
- errors_errors[32][0] = 0x00;
- errors_errors[33][0] = 0x00;
- __MOVE("':=' missing", errors_errors[34], 13);
- __MOVE("',' or OF expected", errors_errors[35], 19);
- errors_errors[36][0] = 0x00;
- errors_errors[37][0] = 0x00;
- __MOVE("identifier expected", errors_errors[38], 20);
- __MOVE("';' missing", errors_errors[39], 12);
- errors_errors[40][0] = 0x00;
- __MOVE("END missing", errors_errors[41], 12);
- errors_errors[42][0] = 0x00;
- errors_errors[43][0] = 0x00;
- __MOVE("UNTIL missing", errors_errors[44], 14);
- errors_errors[45][0] = 0x00;
- __MOVE("EXIT not within loop statement", errors_errors[46], 31);
- __MOVE("illegally marked identifier", errors_errors[47], 28);
- errors_errors[48][0] = 0x00;
- errors_errors[49][0] = 0x00;
- __MOVE("expression should be constant", errors_errors[50], 30);
- __MOVE("constant not an integer", errors_errors[51], 24);
- __MOVE("identifier does not denote a type", errors_errors[52], 34);
- __MOVE("identifier does not denote a record type", errors_errors[53], 41);
- __MOVE("result type of procedure is not a basic type", errors_errors[54], 45);
- __MOVE("procedure call of a function", errors_errors[55], 29);
- __MOVE("assignment to non-variable", errors_errors[56], 27);
- __MOVE("pointer not bound to record or array type", errors_errors[57], 42);
- __MOVE("recursive type definition", errors_errors[58], 26);
- __MOVE("illegal open array parameter", errors_errors[59], 29);
- __MOVE("wrong type of case label", errors_errors[60], 25);
- __MOVE("inadmissible type of case label", errors_errors[61], 32);
- __MOVE("case label defined more than once", errors_errors[62], 34);
- __MOVE("illegal value of constant", errors_errors[63], 26);
- __MOVE("more actual than formal parameters", errors_errors[64], 35);
- __MOVE("fewer actual than formal parameters", errors_errors[65], 36);
- __MOVE("element types of actual array and formal open array differ", errors_errors[66], 59);
- __MOVE("actual parameter corresponding to open array is not an array", errors_errors[67], 61);
- __MOVE("control variable must be integer", errors_errors[68], 33);
- __MOVE("parameter must be an integer constant", errors_errors[69], 38);
- __MOVE("pointer or VAR record required as formal receiver", errors_errors[70], 50);
- __MOVE("pointer expected as actual receiver", errors_errors[71], 36);
- __MOVE("procedure must be bound to a record of the same scope", errors_errors[72], 54);
- __MOVE("procedure must have level 0", errors_errors[73], 28);
- __MOVE("procedure unknown in base type", errors_errors[74], 31);
- __MOVE("invalid call of base procedure", errors_errors[75], 31);
- __MOVE("this variable (field) is read only", errors_errors[76], 35);
- __MOVE("object is not a record", errors_errors[77], 23);
- __MOVE("dereferenced object is not a variable", errors_errors[78], 38);
- __MOVE("indexed object is not a variable", errors_errors[79], 33);
- __MOVE("index expression is not an integer", errors_errors[80], 35);
- __MOVE("index out of specified bounds", errors_errors[81], 30);
- __MOVE("indexed variable is not an array", errors_errors[82], 33);
- __MOVE("undefined record field", errors_errors[83], 23);
- __MOVE("dereferenced variable is not a pointer", errors_errors[84], 39);
- __MOVE("guard or test type is not an extension of variable type", errors_errors[85], 56);
- __MOVE("guard or testtype is not a pointer", errors_errors[86], 35);
- __MOVE("guarded or tested variable is neither a pointer nor a VAR-parameter record", errors_errors[87], 75);
- __MOVE("open array not allowed as variable, record field or array element", errors_errors[88], 66);
- errors_errors[89][0] = 0x00;
- errors_errors[90][0] = 0x00;
- errors_errors[91][0] = 0x00;
- __MOVE("operand of IN not an integer, or not a set", errors_errors[92], 43);
- __MOVE("set element type is not an integer", errors_errors[93], 35);
- __MOVE("operand of & is not of type BOOLEAN", errors_errors[94], 36);
- __MOVE("operand of OR is not of type BOOLEAN", errors_errors[95], 37);
- __MOVE("operand not applicable to (unary) +", errors_errors[96], 36);
- __MOVE("operand not applicable to (unary) -", errors_errors[97], 36);
- __MOVE("operand of ~ is not of type BOOLEAN", errors_errors[98], 36);
- __MOVE("ASSERT fault", errors_errors[99], 13);
- __MOVE("incompatible operands of dyadic operator", errors_errors[100], 41);
- __MOVE("operand type inapplicable to *", errors_errors[101], 31);
- __MOVE("operand type inapplicable to /", errors_errors[102], 31);
- __MOVE("operand type inapplicable to DIV", errors_errors[103], 33);
- __MOVE("operand type inapplicable to MOD", errors_errors[104], 33);
- __MOVE("operand type inapplicable to +", errors_errors[105], 31);
- __MOVE("operand type inapplicable to -", errors_errors[106], 31);
- __MOVE("operand type inapplicable to = or #", errors_errors[107], 36);
- __MOVE("operand type inapplicable to relation", errors_errors[108], 38);
- __MOVE("overriding method must be exported", errors_errors[109], 35);
- __MOVE("operand is not a type", errors_errors[110], 22);
- __MOVE("operand inapplicable to (this) function", errors_errors[111], 40);
- __MOVE("operand is not a variable", errors_errors[112], 26);
- __MOVE("incompatible assignment", errors_errors[113], 24);
- __MOVE("string too long to be assigned", errors_errors[114], 31);
- __MOVE("parameter doesn't match", errors_errors[115], 24);
- __MOVE("number of parameters doesn't match", errors_errors[116], 35);
- __MOVE("result type doesn't match", errors_errors[117], 26);
- __MOVE("export mark doesn't match with forward declaration", errors_errors[118], 51);
- __MOVE("redefinition textually precedes procedure bound to base type", errors_errors[119], 61);
- __MOVE("type of expression following IF, WHILE, UNTIL or ASSERT is not BOOLEAN", errors_errors[120], 71);
- __MOVE("called object is not a procedure (or is an interrupt procedure)", errors_errors[121], 64);
- __MOVE("actual VAR-parameter is not a variable", errors_errors[122], 39);
- __MOVE("type of actual parameter is not identical with that of formal VAR-parameter", errors_errors[123], 76);
- __MOVE("type of result expression differs from that of procedure", errors_errors[124], 57);
- __MOVE("type of case expression is neither INTEGER nor CHAR", errors_errors[125], 52);
- __MOVE("this expression cannot be a type or a procedure", errors_errors[126], 48);
- __MOVE("illegal use of object", errors_errors[127], 22);
- __MOVE("unsatisfied forward reference", errors_errors[128], 30);
- __MOVE("unsatisfied forward procedure", errors_errors[129], 30);
- __MOVE("WITH clause does not specify a variable", errors_errors[130], 40);
- __MOVE("LEN not applied to array", errors_errors[131], 25);
- __MOVE("dimension in LEN too large or negative", errors_errors[132], 39);
- __MOVE("SYSTEM not imported", errors_errors[135], 20);
- __MOVE("key inconsistency of imported module", errors_errors[150], 37);
- __MOVE("incorrect symbol file", errors_errors[151], 22);
- __MOVE("symbol file of imported module not found", errors_errors[152], 41);
- __MOVE("object or symbol file not opened (disk full\?)", errors_errors[153], 46);
- __MOVE("recursive import not allowed", errors_errors[154], 29);
- __MOVE("generation of new symbol file not allowed", errors_errors[155], 42);
- __MOVE("parameter file not found", errors_errors[156], 25);
- __MOVE("syntax error in parameter file", errors_errors[157], 31);
- __MOVE("not yet implemented", errors_errors[200], 20);
- __MOVE("lower bound of set range greater than higher bound", errors_errors[201], 51);
- __MOVE("set element greater than MAX(SET) or less than 0", errors_errors[202], 49);
- __MOVE("number too large", errors_errors[203], 17);
- __MOVE("product too large", errors_errors[204], 18);
- __MOVE("division by zero", errors_errors[205], 17);
- __MOVE("sum too large", errors_errors[206], 14);
- __MOVE("difference too large", errors_errors[207], 21);
- __MOVE("overflow in arithmetic shift", errors_errors[208], 29);
- __MOVE("case range too large", errors_errors[209], 21);
- __MOVE("too many cases in case statement", errors_errors[213], 33);
- __MOVE("illegal value of parameter (0 <= p < 256)", errors_errors[218], 42);
- __MOVE("machine registers cannot be accessed", errors_errors[219], 37);
- __MOVE("illegal value of parameter", errors_errors[220], 27);
- __MOVE("too many pointers in a record", errors_errors[221], 30);
- __MOVE("too many global pointers", errors_errors[222], 25);
- __MOVE("too many record types", errors_errors[223], 22);
- __MOVE("too many pointer types", errors_errors[224], 23);
- __MOVE("address of pointer variable too large (move forward in text)", errors_errors[225], 61);
- __MOVE("too many exported procedures", errors_errors[226], 29);
- __MOVE("too many imported modules", errors_errors[227], 26);
- __MOVE("too many exported structures", errors_errors[228], 29);
- __MOVE("too many nested records for import", errors_errors[229], 35);
- __MOVE("too many constants (strings) in module", errors_errors[230], 39);
- __MOVE("too many link table entries (external procedures)", errors_errors[231], 50);
- __MOVE("too many commands in module", errors_errors[232], 28);
- __MOVE("record extension hierarchy too high", errors_errors[233], 36);
- __MOVE("export of recursive type not allowed", errors_errors[234], 37);
- __MOVE("identifier too long", errors_errors[240], 20);
- __MOVE("string too long", errors_errors[241], 16);
- __MOVE("address overflow", errors_errors[242], 17);
- __MOVE("cyclic type definition not allowed", errors_errors[244], 35);
- __MOVE("guarded pointer variable may be manipulated by non-local operations; use auxiliary pointer variable", errors_errors[245], 100);
- __MOVE("implicit type cast", errors_errors[301], 19);
- __MOVE("inappropriate symbol file ignored", errors_errors[306], 34);
- __MOVE("no ELSE symbol after CASE statement sequence may lead to trap", errors_errors[307], 62);
- __MOVE("SYSTEM.VAL result includes memory past end of source variable", errors_errors[308], 62);
- __ENDMOD;
-}
diff --git a/bootstrap/unix-88/errors.h b/bootstrap/unix-88/errors.h
deleted file mode 100644
index 9081238a..00000000
--- a/bootstrap/unix-88/errors.h
+++ /dev/null
@@ -1,19 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-
-#ifndef errors__h
-#define errors__h
-
-#define LARGE
-#include "SYSTEM.h"
-
-typedef
- CHAR errors_string[128];
-
-
-import errors_string errors_errors[350];
-
-
-import void *errors__init(void);
-
-
-#endif
diff --git a/bootstrap/unix-88/extTools.c b/bootstrap/unix-88/extTools.c
index 4005b0a6..37630d23 100644
--- a/bootstrap/unix-88/extTools.c
+++ b/bootstrap/unix-88/extTools.c
@@ -1,30 +1,37 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "Configuration.h"
-#include "Console.h"
+#include "Modules.h"
#include "OPM.h"
+#include "Out.h"
#include "Platform.h"
#include "Strings.h"
-static CHAR extTools_compilationOptions[1023], extTools_CFLAGS[1023];
+static CHAR extTools_CFLAGS[1023];
export void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len);
+static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT s__len);
export void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len);
static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len);
static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len)
{
- INTEGER r, status, exitcode;
+ INT16 r, status, exitcode;
__DUP(title, title__len, CHAR);
__DUP(cmd, cmd__len, CHAR);
- if (OPM_Verbose) {
- Console_String(title, title__len);
- Console_String(cmd, cmd__len);
- Console_Ln();
+ if (__IN(18, OPM_Options, 32)) {
+ Out_String(title, title__len);
+ Out_String(cmd, cmd__len);
+ Out_Ln();
}
r = Platform_System(cmd, cmd__len);
status = __MASK(r, -128);
@@ -33,39 +40,49 @@ static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGIN
exitcode = exitcode - 256;
}
if (r != 0) {
- Console_String(title, title__len);
- Console_String(cmd, cmd__len);
- Console_Ln();
- Console_String((CHAR*)"-- failed: status ", (LONGINT)19);
- Console_Int(status, ((LONGINT)(1)));
- Console_String((CHAR*)", exitcode ", (LONGINT)12);
- Console_Int(exitcode, ((LONGINT)(1)));
- Console_String((CHAR*)".", (LONGINT)2);
- Console_Ln();
+ Out_String(title, title__len);
+ Out_String(cmd, cmd__len);
+ Out_Ln();
+ Out_String((CHAR*)"-- failed: status ", 19);
+ Out_Int(status, 1);
+ Out_String((CHAR*)", exitcode ", 12);
+ Out_Int(exitcode, 1);
+ Out_String((CHAR*)".", 2);
+ Out_Ln();
if ((status == 0 && exitcode == 127)) {
- Console_String((CHAR*)"Is the C compiler in the current command path\?", (LONGINT)47);
- Console_Ln();
+ Out_String((CHAR*)"Is the C compiler in the current command path\?", 47);
+ Out_Ln();
}
if (status != 0) {
- Platform_Halt(status);
+ Modules_Halt(status);
} else {
- Platform_Halt(exitcode);
+ Modules_Halt(exitcode);
}
}
__DEL(title);
__DEL(cmd);
}
+static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT 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);
+ 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);
+}
+
void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len)
{
CHAR cmd[1023];
__DUP(moduleName, moduleName__len, CHAR);
- __MOVE("gcc -g", cmd, 7);
- Strings_Append(extTools_compilationOptions, ((LONGINT)(1023)), (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)"-c ", (LONGINT)4, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)".c", (LONGINT)3, (void*)cmd, ((LONGINT)(1023)));
- extTools_execute((CHAR*)"Assemble: ", (LONGINT)11, cmd, ((LONGINT)(1023)));
+ 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);
}
@@ -73,22 +90,23 @@ void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN stati
{
CHAR cmd[1023];
__DUP(additionalopts, additionalopts__len, CHAR);
- __MOVE("gcc -g", cmd, 7);
- Strings_Append((CHAR*)" ", (LONGINT)2, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append(extTools_compilationOptions, ((LONGINT)(1023)), (void*)cmd, ((LONGINT)(1023)));
- Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)".c ", (LONGINT)4, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append(additionalopts, additionalopts__len, (void*)cmd, ((LONGINT)(1023)));
+ 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", (LONGINT)8, (void*)cmd, ((LONGINT)(1023)));
+ Strings_Append((CHAR*)"-static", 8, (void*)cmd, 1023);
}
- Strings_Append((CHAR*)" -o ", (LONGINT)5, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)" -L\"", (LONGINT)5, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)"/lib\"", (LONGINT)6, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)" -l voc", (LONGINT)8, (void*)cmd, ((LONGINT)(1023)));
- extTools_execute((CHAR*)"Assemble and link: ", (LONGINT)20, cmd, ((LONGINT)(1023)));
+ 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);
}
@@ -97,17 +115,12 @@ export void *extTools__init(void)
{
__DEFMOD;
__MODULE_IMPORT(Configuration);
- __MODULE_IMPORT(Console);
+ __MODULE_IMPORT(Modules);
__MODULE_IMPORT(OPM);
+ __MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
__REGMOD("extTools", 0);
/* BEGIN */
- Strings_Append((CHAR*)" -I \"", (LONGINT)6, (void*)extTools_compilationOptions, ((LONGINT)(1023)));
- Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)extTools_compilationOptions, ((LONGINT)(1023)));
- Strings_Append((CHAR*)"/include\" ", (LONGINT)11, (void*)extTools_compilationOptions, ((LONGINT)(1023)));
- Platform_GetEnv((CHAR*)"CFLAGS", (LONGINT)7, (void*)extTools_CFLAGS, ((LONGINT)(1023)));
- Strings_Append(extTools_CFLAGS, ((LONGINT)(1023)), (void*)extTools_compilationOptions, ((LONGINT)(1023)));
- Strings_Append((CHAR*)" ", (LONGINT)2, (void*)extTools_compilationOptions, ((LONGINT)(1023)));
__ENDMOD;
}
diff --git a/bootstrap/unix-88/extTools.h b/bootstrap/unix-88/extTools.h
index 6ac1ab91..63e5df15 100644
--- a/bootstrap/unix-88/extTools.h
+++ b/bootstrap/unix-88/extTools.h
@@ -1,9 +1,8 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef extTools__h
#define extTools__h
-#define LARGE
#include "SYSTEM.h"
@@ -14,4 +13,4 @@ import void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEA
import void *extTools__init(void);
-#endif
+#endif // extTools
diff --git a/bootstrap/unix-88/vt100.c b/bootstrap/unix-88/vt100.c
deleted file mode 100644
index a9110e8a..00000000
--- a/bootstrap/unix-88/vt100.c
+++ /dev/null
@@ -1,259 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
-#include "SYSTEM.h"
-#include "Console.h"
-#include "Strings.h"
-
-
-export CHAR vt100_CSI[5];
-static CHAR vt100_tmpstr[32];
-
-
-export void vt100_CHA (INTEGER n);
-export void vt100_CNL (INTEGER n);
-export void vt100_CPL (INTEGER n);
-export void vt100_CUB (INTEGER n);
-export void vt100_CUD (INTEGER n);
-export void vt100_CUF (INTEGER n);
-export void vt100_CUP (INTEGER n, INTEGER m);
-export void vt100_CUU (INTEGER n);
-export void vt100_DECTCEMh (void);
-export void vt100_DECTCEMl (void);
-export void vt100_DSR (INTEGER n);
-export void vt100_ED (INTEGER n);
-export void vt100_EL (INTEGER n);
-static void vt100_EscSeq (INTEGER n, CHAR *letter, LONGINT letter__len);
-static void vt100_EscSeq0 (CHAR *letter, LONGINT letter__len);
-static void vt100_EscSeq2 (INTEGER n, INTEGER m, CHAR *letter, LONGINT letter__len);
-static void vt100_EscSeqSwapped (INTEGER n, CHAR *letter, LONGINT letter__len);
-export void vt100_HVP (INTEGER n, INTEGER m);
-export void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len);
-export void vt100_RCP (void);
-static void vt100_Reverse0 (CHAR *str, LONGINT str__len, INTEGER start, INTEGER end);
-export void vt100_SCP (void);
-export void vt100_SD (INTEGER n);
-export void vt100_SGR (INTEGER n);
-export void vt100_SGR2 (INTEGER n, INTEGER m);
-export void vt100_SU (INTEGER n);
-export void vt100_SetAttr (CHAR *attr, LONGINT attr__len);
-
-
-static void vt100_Reverse0 (CHAR *str, LONGINT str__len, INTEGER start, INTEGER end)
-{
- CHAR h;
- while (start < end) {
- h = str[__X(start, str__len)];
- str[__X(start, str__len)] = str[__X(end, str__len)];
- str[__X(end, str__len)] = h;
- start += 1;
- end -= 1;
- }
-}
-
-void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len)
-{
- CHAR b[21];
- INTEGER s, e;
- SHORTINT maxLength;
- maxLength = 20;
- if (int_ == (-9223372036854775807-1)) {
- __MOVE("-9223372036854775808", b, 21);
- e = 20;
- } else {
- if (int_ < 0) {
- b[0] = '-';
- int_ = -int_;
- s = 1;
- } else {
- s = 0;
- }
- e = s;
- do {
- b[__X(e, ((LONGINT)(21)))] = (CHAR)(__MOD(int_, 10) + 48);
- int_ = __DIV(int_, 10);
- e += 1;
- } while (!(int_ == 0));
- b[__X(e, ((LONGINT)(21)))] = 0x00;
- vt100_Reverse0((void*)b, ((LONGINT)(21)), s, e - 1);
- }
- __COPY(b, str, str__len);
-}
-
-static void vt100_EscSeq0 (CHAR *letter, LONGINT letter__len)
-{
- CHAR cmd[9];
- __DUP(letter, letter__len, CHAR);
- __COPY(vt100_CSI, cmd, ((LONGINT)(9)));
- Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(9)));
- Console_String(cmd, ((LONGINT)(9)));
- __DEL(letter);
-}
-
-static void vt100_EscSeq (INTEGER n, CHAR *letter, LONGINT letter__len)
-{
- CHAR nstr[2];
- CHAR cmd[7];
- __DUP(letter, letter__len, CHAR);
- vt100_IntToStr(n, (void*)nstr, ((LONGINT)(2)));
- __COPY(vt100_CSI, cmd, ((LONGINT)(7)));
- Strings_Append(nstr, ((LONGINT)(2)), (void*)cmd, ((LONGINT)(7)));
- Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(7)));
- Console_String(cmd, ((LONGINT)(7)));
- __DEL(letter);
-}
-
-static void vt100_EscSeqSwapped (INTEGER n, CHAR *letter, LONGINT letter__len)
-{
- CHAR nstr[2];
- CHAR cmd[7];
- __DUP(letter, letter__len, CHAR);
- vt100_IntToStr(n, (void*)nstr, ((LONGINT)(2)));
- __COPY(vt100_CSI, cmd, ((LONGINT)(7)));
- Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(7)));
- Strings_Append(nstr, ((LONGINT)(2)), (void*)cmd, ((LONGINT)(7)));
- Console_String(cmd, ((LONGINT)(7)));
- __DEL(letter);
-}
-
-static void vt100_EscSeq2 (INTEGER n, INTEGER m, CHAR *letter, LONGINT letter__len)
-{
- CHAR nstr[5], mstr[5];
- CHAR cmd[12];
- __DUP(letter, letter__len, CHAR);
- vt100_IntToStr(n, (void*)nstr, ((LONGINT)(5)));
- vt100_IntToStr(m, (void*)mstr, ((LONGINT)(5)));
- __COPY(vt100_CSI, cmd, ((LONGINT)(12)));
- Strings_Append(nstr, ((LONGINT)(5)), (void*)cmd, ((LONGINT)(12)));
- Strings_Append((CHAR*)";", (LONGINT)2, (void*)cmd, ((LONGINT)(12)));
- Strings_Append(mstr, ((LONGINT)(5)), (void*)cmd, ((LONGINT)(12)));
- Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(12)));
- Console_String(cmd, ((LONGINT)(12)));
- __DEL(letter);
-}
-
-void vt100_CUU (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"A", (LONGINT)2);
-}
-
-void vt100_CUD (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"B", (LONGINT)2);
-}
-
-void vt100_CUF (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"C", (LONGINT)2);
-}
-
-void vt100_CUB (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"D", (LONGINT)2);
-}
-
-void vt100_CNL (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"E", (LONGINT)2);
-}
-
-void vt100_CPL (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"F", (LONGINT)2);
-}
-
-void vt100_CHA (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"G", (LONGINT)2);
-}
-
-void vt100_CUP (INTEGER n, INTEGER m)
-{
- vt100_EscSeq2(n, m, (CHAR*)"H", (LONGINT)2);
-}
-
-void vt100_ED (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"J", (LONGINT)2);
-}
-
-void vt100_EL (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"K", (LONGINT)2);
-}
-
-void vt100_SU (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"S", (LONGINT)2);
-}
-
-void vt100_SD (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"T", (LONGINT)2);
-}
-
-void vt100_HVP (INTEGER n, INTEGER m)
-{
- vt100_EscSeq2(n, m, (CHAR*)"f", (LONGINT)2);
-}
-
-void vt100_SGR (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"m", (LONGINT)2);
-}
-
-void vt100_SGR2 (INTEGER n, INTEGER m)
-{
- vt100_EscSeq2(n, m, (CHAR*)"m", (LONGINT)2);
-}
-
-void vt100_DSR (INTEGER n)
-{
- vt100_EscSeq(6, (CHAR*)"n", (LONGINT)2);
-}
-
-void vt100_SCP (void)
-{
- vt100_EscSeq0((CHAR*)"s", (LONGINT)2);
-}
-
-void vt100_RCP (void)
-{
- vt100_EscSeq0((CHAR*)"u", (LONGINT)2);
-}
-
-void vt100_DECTCEMl (void)
-{
- vt100_EscSeq0((CHAR*)"\?25l", (LONGINT)5);
-}
-
-void vt100_DECTCEMh (void)
-{
- vt100_EscSeq0((CHAR*)"\?25h", (LONGINT)5);
-}
-
-void vt100_SetAttr (CHAR *attr, LONGINT attr__len)
-{
- CHAR tmpstr[16];
- __DUP(attr, attr__len, CHAR);
- __COPY(vt100_CSI, tmpstr, ((LONGINT)(16)));
- Strings_Append(attr, attr__len, (void*)tmpstr, ((LONGINT)(16)));
- Console_String(tmpstr, ((LONGINT)(16)));
- __DEL(attr);
-}
-
-
-export void *vt100__init(void)
-{
- __DEFMOD;
- __MODULE_IMPORT(Console);
- __MODULE_IMPORT(Strings);
- __REGMOD("vt100", 0);
- __REGCMD("DECTCEMh", vt100_DECTCEMh);
- __REGCMD("DECTCEMl", vt100_DECTCEMl);
- __REGCMD("RCP", vt100_RCP);
- __REGCMD("SCP", vt100_SCP);
-/* BEGIN */
- __COPY("\033", vt100_CSI, ((LONGINT)(5)));
- Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5)));
- __ENDMOD;
-}
diff --git a/bootstrap/unix-88/vt100.h b/bootstrap/unix-88/vt100.h
deleted file mode 100644
index 801bc8f9..00000000
--- a/bootstrap/unix-88/vt100.h
+++ /dev/null
@@ -1,38 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-
-#ifndef vt100__h
-#define vt100__h
-
-#define LARGE
-#include "SYSTEM.h"
-
-
-import CHAR vt100_CSI[5];
-
-
-import void vt100_CHA (INTEGER n);
-import void vt100_CNL (INTEGER n);
-import void vt100_CPL (INTEGER n);
-import void vt100_CUB (INTEGER n);
-import void vt100_CUD (INTEGER n);
-import void vt100_CUF (INTEGER n);
-import void vt100_CUP (INTEGER n, INTEGER m);
-import void vt100_CUU (INTEGER n);
-import void vt100_DECTCEMh (void);
-import void vt100_DECTCEMl (void);
-import void vt100_DSR (INTEGER n);
-import void vt100_ED (INTEGER n);
-import void vt100_EL (INTEGER n);
-import void vt100_HVP (INTEGER n, INTEGER m);
-import void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len);
-import void vt100_RCP (void);
-import void vt100_SCP (void);
-import void vt100_SD (INTEGER n);
-import void vt100_SGR (INTEGER n);
-import void vt100_SGR2 (INTEGER n, INTEGER m);
-import void vt100_SU (INTEGER n);
-import void vt100_SetAttr (CHAR *attr, LONGINT attr__len);
-import void *vt100__init(void);
-
-
-#endif
diff --git a/bootstrap/windows-48/Compiler.c b/bootstrap/windows-48/Compiler.c
new file mode 100644
index 00000000..dc4bb660
--- /dev/null
+++ b/bootstrap/windows-48/Compiler.c
@@ -0,0 +1,184 @@
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspamS */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
+#include "SYSTEM.h"
+#include "Configuration.h"
+#include "Heap.h"
+#include "OPB.h"
+#include "OPC.h"
+#include "OPM.h"
+#include "OPP.h"
+#include "OPT.h"
+#include "OPV.h"
+#include "Platform.h"
+#include "Strings.h"
+#include "VT100.h"
+#include "extTools.h"
+
+
+static CHAR Compiler_mname[256];
+
+
+export void Compiler_Module (BOOLEAN *done);
+static void Compiler_PropagateElementaryTypeSizes (void);
+export void Compiler_Translate (void);
+static void Compiler_Trap (INT32 sig);
+
+
+void Compiler_Module (BOOLEAN *done)
+{
+ BOOLEAN ext, new;
+ OPT_Node p = NIL;
+ OPP_Module(&p, OPM_Options);
+ if (OPM_noerr) {
+ OPV_Init();
+ OPT_InitRecno();
+ OPV_AdrAndSize(OPT_topScope);
+ OPT_Export(&ext, &new);
+ if (OPM_noerr) {
+ OPM_OpenFiles((void*)OPT_SelfName, 256);
+ OPC_Init();
+ OPV_Module(p);
+ if (OPM_noerr) {
+ if ((__IN(10, OPM_Options, 32) && __STRCMP(OPM_modName, "SYSTEM") != 0)) {
+ OPM_DeleteNewSym();
+ OPM_LogVT100((CHAR*)"32m", 4);
+ OPM_LogWStr((CHAR*)" Main program.", 16);
+ OPM_LogVT100((CHAR*)"0m", 3);
+ } else {
+ if (new) {
+ OPM_LogVT100((CHAR*)"32m", 4);
+ OPM_LogWStr((CHAR*)" New symbol file.", 19);
+ OPM_LogVT100((CHAR*)"0m", 3);
+ OPM_RegisterNewSym();
+ } else if (ext) {
+ OPM_LogWStr((CHAR*)" Extended symbol file.", 24);
+ OPM_RegisterNewSym();
+ }
+ }
+ } else {
+ OPM_DeleteNewSym();
+ }
+ }
+ }
+ OPM_CloseFiles();
+ OPT_Close();
+ OPM_LogWLn();
+ *done = OPM_noerr;
+}
+
+static void Compiler_PropagateElementaryTypeSizes (void)
+{
+ OPT_Struct adrinttyp = NIL;
+ OPT_sysptrtyp->size = OPM_AddressSize;
+ OPT_sysptrtyp->idfp = OPT_sysptrtyp->form;
+ OPM_FPrint(&OPT_sysptrtyp->idfp, OPT_sysptrtyp->size);
+ OPT_adrtyp->size = OPM_AddressSize;
+ OPT_adrtyp->idfp = OPT_adrtyp->form;
+ OPM_FPrint(&OPT_adrtyp->idfp, OPT_adrtyp->size);
+ adrinttyp = OPT_IntType(OPM_AddressSize);
+ OPT_adrtyp->strobj = adrinttyp->strobj;
+ OPT_sinttyp = OPT_IntType(OPM_ShortintSize);
+ OPT_inttyp = OPT_IntType(OPM_IntegerSize);
+ OPT_linttyp = OPT_IntType(OPM_LongintSize);
+ OPT_sintobj->typ = OPT_sinttyp;
+ OPT_intobj->typ = OPT_inttyp;
+ OPT_lintobj->typ = OPT_linttyp;
+ switch (OPM_LongintSize) {
+ case 4:
+ OPT_settyp = OPT_set32typ;
+ break;
+ default:
+ OPT_settyp = OPT_set64typ;
+ break;
+ }
+ OPT_setobj->typ = OPT_settyp;
+ if (__STRCMP(OPM_Model, "C") == 0) {
+ OPT_cpbytetyp->strobj->name[4] = 0x00;
+ } else {
+ OPT_cpbytetyp->strobj->name[4] = '@';
+ }
+}
+
+void Compiler_Translate (void)
+{
+ BOOLEAN done;
+ CHAR modulesobj[2048];
+ modulesobj[0] = 0x00;
+ if (OPM_OpenPar()) {
+ for (;;) {
+ OPM_Init(&done, (void*)Compiler_mname, 256);
+ if (!done) {
+ return;
+ }
+ OPM_InitOptions();
+ Compiler_PropagateElementaryTypeSizes();
+ Heap_GC(0);
+ Compiler_Module(&done);
+ if (!done) {
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Module compilation failed.", 27);
+ OPM_LogWLn();
+ Platform_Exit(1);
+ }
+ if (!__IN(13, OPM_Options, 32)) {
+ if (__IN(14, OPM_Options, 32)) {
+ extTools_Assemble(OPM_modName, 32);
+ } else {
+ if (!__IN(10, OPM_Options, 32)) {
+ extTools_Assemble(OPM_modName, 32);
+ Strings_Append((CHAR*)" ", 2, (void*)modulesobj, 2048);
+ Strings_Append(OPM_modName, 32, (void*)modulesobj, 2048);
+ Strings_Append((CHAR*)".o", 3, (void*)modulesobj, 2048);
+ } else {
+ extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), modulesobj, 2048);
+ }
+ }
+ }
+ }
+ }
+}
+
+static void Compiler_Trap (INT32 sig)
+{
+ Heap_FINALL();
+ if (sig == 3) {
+ Platform_Exit(0);
+ } else {
+ if (sig == 4) {
+ OPM_LogWStr((CHAR*)" --- Oberon compiler internal error", 36);
+ OPM_LogWLn();
+ }
+ Platform_Exit(2);
+ }
+}
+
+
+export int main(int argc, char **argv)
+{
+ __INIT(argc, argv);
+ __MODULE_IMPORT(Configuration);
+ __MODULE_IMPORT(Heap);
+ __MODULE_IMPORT(OPB);
+ __MODULE_IMPORT(OPC);
+ __MODULE_IMPORT(OPM);
+ __MODULE_IMPORT(OPP);
+ __MODULE_IMPORT(OPT);
+ __MODULE_IMPORT(OPV);
+ __MODULE_IMPORT(Platform);
+ __MODULE_IMPORT(Strings);
+ __MODULE_IMPORT(VT100);
+ __MODULE_IMPORT(extTools);
+ __REGMAIN("Compiler", 0);
+ __REGCMD("Translate", Compiler_Translate);
+/* BEGIN */
+ Platform_SetInterruptHandler(Compiler_Trap);
+ Platform_SetQuitHandler(Compiler_Trap);
+ Platform_SetBadInstructionHandler(Compiler_Trap);
+ Compiler_Translate();
+ __FINI;
+}
diff --git a/bootstrap/windows-48/Configuration.c b/bootstrap/windows-48/Configuration.c
index 821dff97..2d0061df 100644
--- a/bootstrap/windows-48/Configuration.c
+++ b/bootstrap/windows-48/Configuration.c
@@ -1,8 +1,14 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
-export CHAR Configuration_versionLong[41];
+export CHAR Configuration_versionLong[75];
@@ -13,6 +19,6 @@ export void *Configuration__init(void)
__DEFMOD;
__REGMOD("Configuration", 0);
/* BEGIN */
- __MOVE("1.95 [2016/08/23] for gcc LP64 on cygwin", Configuration_versionLong, 41);
+ __MOVE("1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75);
__ENDMOD;
}
diff --git a/bootstrap/windows-48/Configuration.h b/bootstrap/windows-48/Configuration.h
index ec5e865a..b28e0caa 100644
--- a/bootstrap/windows-48/Configuration.h
+++ b/bootstrap/windows-48/Configuration.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Configuration__h
#define Configuration__h
@@ -6,10 +6,10 @@
#include "SYSTEM.h"
-import CHAR Configuration_versionLong[41];
+import CHAR Configuration_versionLong[75];
import void *Configuration__init(void);
-#endif
+#endif // Configuration
diff --git a/bootstrap/windows-48/Console.c b/bootstrap/windows-48/Console.c
deleted file mode 100644
index ebd86b8d..00000000
--- a/bootstrap/windows-48/Console.c
+++ /dev/null
@@ -1,150 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#include "SYSTEM.h"
-#include "Platform.h"
-
-
-static CHAR Console_line[128];
-static INTEGER Console_pos;
-
-
-export void Console_Bool (BOOLEAN b);
-export void Console_Char (CHAR ch);
-export void Console_Flush (void);
-export void Console_Hex (LONGINT i);
-export void Console_Int (LONGINT i, LONGINT n);
-export void Console_Ln (void);
-export void Console_Read (CHAR *ch);
-export void Console_ReadLine (CHAR *line, LONGINT line__len);
-export void Console_String (CHAR *s, LONGINT s__len);
-
-
-void Console_Flush (void)
-{
- INTEGER error;
- error = Platform_Write(Platform_StdOut, (LONGINT)(SYSTEM_ADDRESS)Console_line, Console_pos);
- Console_pos = 0;
-}
-
-void Console_Char (CHAR ch)
-{
- if (Console_pos == 128) {
- Console_Flush();
- }
- Console_line[__X(Console_pos, ((LONGINT)(128)))] = ch;
- Console_pos += 1;
- if (ch == 0x0a) {
- Console_Flush();
- }
-}
-
-void Console_String (CHAR *s, LONGINT s__len)
-{
- INTEGER i;
- __DUP(s, s__len, CHAR);
- i = 0;
- while (s[__X(i, s__len)] != 0x00) {
- Console_Char(s[__X(i, s__len)]);
- i += 1;
- }
- __DEL(s);
-}
-
-void Console_Int (LONGINT i, LONGINT n)
-{
- CHAR s[32];
- LONGINT i1, k;
- if (i == __LSHL(1, 31, LONGINT)) {
- __MOVE("8463847412", s, 11);
- k = 10;
- } else {
- i1 = __ABS(i);
- s[0] = (CHAR)(__MOD(i1, 10) + 48);
- i1 = __DIV(i1, 10);
- k = 1;
- while (i1 > 0) {
- s[__X(k, ((LONGINT)(32)))] = (CHAR)(__MOD(i1, 10) + 48);
- i1 = __DIV(i1, 10);
- k += 1;
- }
- }
- if (i < 0) {
- s[__X(k, ((LONGINT)(32)))] = '-';
- k += 1;
- }
- while (n > k) {
- Console_Char(' ');
- n -= 1;
- }
- while (k > 0) {
- k -= 1;
- Console_Char(s[__X(k, ((LONGINT)(32)))]);
- }
-}
-
-void Console_Ln (void)
-{
- Console_Char(0x0a);
-}
-
-void Console_Bool (BOOLEAN b)
-{
- if (b) {
- Console_String((CHAR*)"TRUE", (LONGINT)5);
- } else {
- Console_String((CHAR*)"FALSE", (LONGINT)6);
- }
-}
-
-void Console_Hex (LONGINT i)
-{
- LONGINT k, n;
- k = -28;
- while (k <= 0) {
- n = __MASK(__ASH(i, k), -16);
- if (n <= 9) {
- Console_Char((CHAR)(48 + n));
- } else {
- Console_Char((CHAR)(55 + n));
- }
- k += 4;
- }
-}
-
-void Console_Read (CHAR *ch)
-{
- LONGINT n;
- INTEGER error;
- Console_Flush();
- error = Platform_ReadBuf(Platform_StdIn, (void*)&*ch, ((LONGINT)(1)), &n);
- if (n != 1) {
- *ch = 0x00;
- }
-}
-
-void Console_ReadLine (CHAR *line, LONGINT line__len)
-{
- LONGINT i;
- CHAR ch;
- Console_Flush();
- i = 0;
- Console_Read(&ch);
- while ((((i < line__len - 1 && ch != 0x0a)) && ch != 0x00)) {
- line[__X(i, line__len)] = ch;
- i += 1;
- Console_Read(&ch);
- }
- line[__X(i, line__len)] = 0x00;
-}
-
-
-export void *Console__init(void)
-{
- __DEFMOD;
- __MODULE_IMPORT(Platform);
- __REGMOD("Console", 0);
- __REGCMD("Flush", Console_Flush);
- __REGCMD("Ln", Console_Ln);
-/* BEGIN */
- Console_pos = 0;
- __ENDMOD;
-}
diff --git a/bootstrap/windows-48/Console.h b/bootstrap/windows-48/Console.h
deleted file mode 100644
index 5fdd4e4d..00000000
--- a/bootstrap/windows-48/Console.h
+++ /dev/null
@@ -1,23 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-
-#ifndef Console__h
-#define Console__h
-
-#include "SYSTEM.h"
-
-
-
-
-import void Console_Bool (BOOLEAN b);
-import void Console_Char (CHAR ch);
-import void Console_Flush (void);
-import void Console_Hex (LONGINT i);
-import void Console_Int (LONGINT i, LONGINT n);
-import void Console_Ln (void);
-import void Console_Read (CHAR *ch);
-import void Console_ReadLine (CHAR *line, LONGINT line__len);
-import void Console_String (CHAR *s, LONGINT s__len);
-import void *Console__init(void);
-
-
-#endif
diff --git a/bootstrap/windows-48/Files.c b/bootstrap/windows-48/Files.c
index 1f3a8e9c..5326fe10 100644
--- a/bootstrap/windows-48/Files.c
+++ b/bootstrap/windows-48/Files.c
@@ -1,8 +1,13 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
-#include "Configuration.h"
-#include "Console.h"
#include "Heap.h"
+#include "Out.h"
#include "Platform.h"
#include "Strings.h"
@@ -13,7 +18,7 @@ typedef
struct Files_BufDesc {
Files_File f;
BOOLEAN chg;
- LONGINT org, size;
+ INT32 org, size;
SYSTEM_BYTE data[4096];
} Files_BufDesc;
@@ -28,114 +33,114 @@ typedef
Files_FileName workName, registerName;
BOOLEAN tempFile;
Platform_FileIdentity identity;
- LONGINT fd, len, pos;
+ INT32 fd, len, pos;
Files_Buffer bufs[4];
- INTEGER swapper, state;
+ INT16 swapper, state;
Files_File next;
} Files_FileDesc;
typedef
struct Files_Rider {
- LONGINT res;
+ INT32 res;
BOOLEAN eof;
Files_Buffer buf;
- LONGINT org, offset;
+ INT32 org, offset;
} Files_Rider;
static Files_File Files_files;
-static INTEGER Files_tempno;
+static INT16 Files_tempno;
static CHAR Files_HOME[1024];
static struct {
LONGINT len[1];
CHAR data[1];
} *Files_SearchPath;
-export LONGINT *Files_FileDesc__typ;
-export LONGINT *Files_BufDesc__typ;
-export LONGINT *Files_Rider__typ;
+export ADDRESS *Files_FileDesc__typ;
+export ADDRESS *Files_BufDesc__typ;
+export ADDRESS *Files_Rider__typ;
-export Files_File Files_Base (Files_Rider *r, LONGINT *r__typ);
+export Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
static Files_File Files_CacheEntry (Platform_FileIdentity identity);
-export void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *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, LONGINT name__len, INTEGER *res);
-static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INTEGER 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, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len);
static void Files_Flush (Files_Buffer buf);
-export void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d);
+export void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
export void Files_GetName (Files_File f, CHAR *name, LONGINT name__len);
static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len);
static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len);
-export LONGINT Files_Length (Files_File f);
+export INT32 Files_Length (Files_File f);
static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len);
export Files_File Files_New (CHAR *name, LONGINT name__len);
export Files_File Files_Old (CHAR *name, LONGINT name__len);
-export LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ);
+export INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ);
export void Files_Purge (Files_File f);
-export void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x);
-export void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x);
-export void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len);
-export void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n);
-export void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x);
-export void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x);
-export void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x);
-export void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
-export void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x);
-export void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x);
-export void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x);
-export void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
+export void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
+export void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x);
+export void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+export void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x);
+export void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x);
+export void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
+export void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+export void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
+export void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
+export void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
+export void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
export void Files_Register (Files_File f);
-export void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res);
-static void Files_ScanPath (INTEGER *pos, CHAR *dir, LONGINT dir__len);
-export void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos);
+export void Files_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, LONGINT path__len);
-export void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x);
-export void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x);
-export void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n);
-export void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x);
-export void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x);
-export void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x);
-export void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x);
-export void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x);
-export void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x);
-export void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
+export void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
+export void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
+export void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+export void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
+export void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
+export void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
+export void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
+export void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
+export void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
+export void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
#define Files_IdxTrap() __HALT(-1)
+#define Files_ToAdr(x) (ADDRESS)x
-static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INTEGER errcode)
+static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
{
__DUP(s, s__len, CHAR);
- Console_Ln();
- Console_String((CHAR*)"-- ", (LONGINT)4);
- Console_String(s, s__len);
- Console_String((CHAR*)": ", (LONGINT)3);
+ Out_Ln();
+ Out_String((CHAR*)"-- ", 4);
+ Out_String(s, s__len);
+ Out_String((CHAR*)": ", 3);
if (f != NIL) {
if (f->registerName[0] != 0x00) {
- Console_String(f->registerName, ((LONGINT)(101)));
+ Out_String(f->registerName, 101);
} else {
- Console_String(f->workName, ((LONGINT)(101)));
+ Out_String(f->workName, 101);
}
if (f->fd != 0) {
- Console_String((CHAR*)"f.fd = ", (LONGINT)8);
- Console_Int(f->fd, ((LONGINT)(1)));
+ Out_String((CHAR*)"f.fd = ", 8);
+ Out_Int(f->fd, 1);
}
}
if (errcode != 0) {
- Console_String((CHAR*)" errcode = ", (LONGINT)12);
- Console_Int(errcode, ((LONGINT)(1)));
+ Out_String((CHAR*)" errcode = ", 12);
+ Out_Int(errcode, 1);
}
- Console_Ln();
+ Out_Ln();
__HALT(99);
__DEL(s);
}
static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len)
{
- INTEGER i, j;
+ INT16 i, j;
__DUP(dir, dir__len, CHAR);
__DUP(name, name__len, CHAR);
i = 0;
@@ -160,7 +165,7 @@ static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT
static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len)
{
- LONGINT n, i, j;
+ INT32 n, i, j;
__DUP(finalName, finalName__len, CHAR);
Files_tempno += 1;
n = Files_tempno;
@@ -192,7 +197,7 @@ static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *na
name[i + 5] = '.';
i += 6;
while (n > 0) {
- name[i] = (CHAR)(__MOD(n, 10) + 48);
+ name[i] = (CHAR)((int)__MOD(n, 10) + 48);
n = __DIV(n, 10);
i += 1;
}
@@ -200,7 +205,7 @@ static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *na
i += 1;
n = Platform_PID;
while (n > 0) {
- name[i] = (CHAR)(__MOD(n, 10) + 48);
+ name[i] = (CHAR)((int)__MOD(n, 10) + 48);
n = __DIV(n, 10);
i += 1;
}
@@ -212,19 +217,19 @@ static void Files_Create (Files_File f)
{
Platform_FileIdentity identity;
BOOLEAN done;
- INTEGER error;
+ INT16 error;
CHAR err[32];
if (f->fd == -1) {
if (f->state == 1) {
- Files_GetTempName(f->registerName, ((LONGINT)(101)), (void*)f->workName, ((LONGINT)(101)));
+ Files_GetTempName(f->registerName, 101, (void*)f->workName, 101);
f->tempFile = 1;
} else if (f->state == 2) {
- __COPY(f->registerName, f->workName, ((LONGINT)(101)));
+ __COPY(f->registerName, f->workName, 101);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
- error = Platform_Unlink((void*)f->workName, ((LONGINT)(101)));
- error = Platform_New((void*)f->workName, ((LONGINT)(101)), &f->fd);
+ 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;
@@ -242,14 +247,14 @@ static void Files_Create (Files_File f)
} else {
__MOVE("file not created", err, 17);
}
- Files_Err(err, ((LONGINT)(32)), f, error);
+ Files_Err(err, 32, f, error);
}
}
}
static void Files_Flush (Files_Buffer buf)
{
- INTEGER error;
+ INT16 error;
Files_File f = NIL;
if (buf->chg) {
f = buf->f;
@@ -257,15 +262,15 @@ static void Files_Flush (Files_Buffer buf)
if (buf->org != f->pos) {
error = Platform_Seek(f->fd, buf->org, Platform_SeekSet);
}
- error = Platform_Write(f->fd, (LONGINT)(SYSTEM_ADDRESS)buf->data, buf->size);
+ error = Platform_Write(f->fd, (ADDRESS)buf->data, buf->size);
if (error != 0) {
- Files_Err((CHAR*)"error writing file", (LONGINT)19, f, error);
+ Files_Err((CHAR*)"error writing file", 19, f, error);
}
f->pos = buf->org + buf->size;
buf->chg = 0;
error = Platform_Identify(f->fd, &f->identity, Platform_FileIdentity__typ);
if (error != 0) {
- Files_Err((CHAR*)"error identifying file", (LONGINT)23, f, error);
+ Files_Err((CHAR*)"error identifying file", 23, f, error);
}
}
}
@@ -273,7 +278,7 @@ static void Files_Flush (Files_Buffer buf)
static void Files_CloseOSFile (Files_File f)
{
Files_File prev = NIL;
- INTEGER error;
+ INT16 error;
if (Files_files == f) {
Files_files = f->next;
} else {
@@ -293,8 +298,8 @@ static void Files_CloseOSFile (Files_File f)
void Files_Close (Files_File f)
{
- LONGINT i;
- INTEGER error;
+ INT32 i;
+ INT16 error;
if (f->state != 1 || f->registerName[0] != 0x00) {
Files_Create(f);
i = 0;
@@ -302,42 +307,34 @@ void Files_Close (Files_File f)
Files_Flush(f->bufs[i]);
i += 1;
}
- error = Platform_Sync(f->fd);
- if (error != 0) {
- Files_Err((CHAR*)"error writing file", (LONGINT)19, f, error);
- }
Files_CloseOSFile(f);
}
}
-LONGINT Files_Length (Files_File f)
+INT32 Files_Length (Files_File f)
{
- LONGINT _o_result;
- _o_result = f->len;
- return _o_result;
+ return f->len;
}
Files_File Files_New (CHAR *name, LONGINT name__len)
{
- Files_File _o_result;
Files_File f = NIL;
__DUP(name, name__len, CHAR);
__NEW(f, Files_FileDesc);
f->workName[0] = 0x00;
- __COPY(name, f->registerName, ((LONGINT)(101)));
+ __COPY(name, f->registerName, 101);
f->fd = -1;
f->state = 1;
f->len = 0;
f->pos = 0;
f->swapper = -1;
- _o_result = f;
__DEL(name);
- return _o_result;
+ return f;
}
-static void Files_ScanPath (INTEGER *pos, CHAR *dir, LONGINT dir__len)
+static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len)
{
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
if (Files_SearchPath == NIL) {
@@ -380,8 +377,7 @@ static void Files_ScanPath (INTEGER *pos, CHAR *dir, LONGINT dir__len)
static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len)
{
- BOOLEAN _o_result;
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
ch = name[0];
@@ -389,15 +385,13 @@ static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len)
i += 1;
ch = name[i];
}
- _o_result = ch == '/';
- return _o_result;
+ return ch == '/';
}
static Files_File Files_CacheEntry (Platform_FileIdentity identity)
{
- Files_File _o_result;
Files_File f = NIL;
- INTEGER i, error;
+ INT16 i, error;
f = Files_files;
while (f != NIL) {
if (Platform_SameFile(identity, f->identity)) {
@@ -414,60 +408,56 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
f->identity = identity;
error = Platform_Size(f->fd, &f->len);
}
- _o_result = f;
- return _o_result;
+ return f;
}
f = f->next;
}
- _o_result = NIL;
- return _o_result;
+ return NIL;
}
Files_File Files_Old (CHAR *name, LONGINT name__len)
{
- Files_File _o_result;
Files_File f = NIL;
- LONGINT fd;
- INTEGER pos;
+ INT32 fd;
+ INT16 pos;
BOOLEAN done;
CHAR dir[256], path[256];
- INTEGER error;
+ INT16 error;
Platform_FileIdentity identity;
__DUP(name, name__len, CHAR);
if (name[0] != 0x00) {
if (Files_HasDir((void*)name, name__len)) {
dir[0] = 0x00;
- __COPY(name, path, ((LONGINT)(256)));
+ __COPY(name, path, 256);
} else {
pos = 0;
- Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256)));
- Files_MakeFileName(dir, ((LONGINT)(256)), name, name__len, (void*)path, ((LONGINT)(256)));
- Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256)));
+ Files_ScanPath(&pos, (void*)dir, 256);
+ Files_MakeFileName(dir, 256, name, name__len, (void*)path, 256);
+ Files_ScanPath(&pos, (void*)dir, 256);
}
for (;;) {
- error = Platform_OldRW((void*)path, ((LONGINT)(256)), &fd);
+ error = Platform_OldRW((void*)path, 256, &fd);
done = error == 0;
if ((!done && Platform_TooManyFiles(error))) {
- Files_Err((CHAR*)"too many files open", (LONGINT)20, f, error);
+ Files_Err((CHAR*)"too many files open", 20, f, error);
}
if ((!done && Platform_Inaccessible(error))) {
- error = Platform_OldRO((void*)path, ((LONGINT)(256)), &fd);
+ error = Platform_OldRO((void*)path, 256, &fd);
done = error == 0;
}
if ((!done && !Platform_Absent(error))) {
- Console_String((CHAR*)"Warning: Files.Old ", (LONGINT)20);
- Console_String(name, name__len);
- Console_String((CHAR*)" error = ", (LONGINT)10);
- Console_Int(error, ((LONGINT)(0)));
- Console_Ln();
+ Out_String((CHAR*)"Warning: Files.Old ", 20);
+ Out_String(name, name__len);
+ Out_String((CHAR*)" error = ", 10);
+ Out_Int(error, 0);
+ Out_Ln();
}
if (done) {
error = Platform_Identify(fd, &identity, Platform_FileIdentity__typ);
f = Files_CacheEntry(identity);
if (f != NIL) {
- _o_result = f;
__DEL(name);
- return _o_result;
+ return f;
} else {
__NEW(f, Files_FileDesc);
Heap_RegisterFinalizer((void*)f, Files_Finalize);
@@ -476,39 +466,36 @@ Files_File Files_Old (CHAR *name, LONGINT name__len)
f->pos = 0;
f->swapper = -1;
error = Platform_Size(fd, &f->len);
- __COPY(name, f->workName, ((LONGINT)(101)));
+ __COPY(name, f->workName, 101);
f->registerName[0] = 0x00;
f->tempFile = 0;
f->identity = identity;
f->next = Files_files;
Files_files = f;
Heap_FileCount += 1;
- _o_result = f;
__DEL(name);
- return _o_result;
+ return f;
}
} else if (dir[0] == 0x00) {
- _o_result = NIL;
__DEL(name);
- return _o_result;
+ return NIL;
} else {
- Files_MakeFileName(dir, ((LONGINT)(256)), name, name__len, (void*)path, ((LONGINT)(256)));
- Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256)));
+ Files_MakeFileName(dir, 256, name, name__len, (void*)path, 256);
+ Files_ScanPath(&pos, (void*)dir, 256);
}
}
} else {
- _o_result = NIL;
__DEL(name);
- return _o_result;
+ return NIL;
}
__RETCHK;
}
void Files_Purge (Files_File f)
{
- INTEGER i;
+ INT16 i;
Platform_FileIdentity identity;
- INTEGER error;
+ INT16 error;
i = 0;
while (i < 4) {
if (f->bufs[i] != NIL) {
@@ -518,8 +505,8 @@ void Files_Purge (Files_File f)
i += 1;
}
if (f->fd != -1) {
- error = Platform_Truncate(f->fd, ((LONGINT)(0)));
- error = Platform_Seek(f->fd, ((LONGINT)(0)), Platform_SeekSet);
+ error = Platform_Truncate(f->fd, 0);
+ error = Platform_Seek(f->fd, 0, Platform_SeekSet);
}
f->pos = 0;
f->len = 0;
@@ -528,27 +515,26 @@ void Files_Purge (Files_File f)
Platform_SetMTime(&f->identity, Platform_FileIdentity__typ, identity);
}
-void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d)
+void Files_GetDate (Files_File f, INT32 *t, INT32 *d)
{
Platform_FileIdentity identity;
- INTEGER error;
+ INT16 error;
Files_Create(f);
error = Platform_Identify(f->fd, &identity, Platform_FileIdentity__typ);
Platform_MTimeAsClock(identity, &*t, &*d);
}
-LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ)
+INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ)
{
- LONGINT _o_result;
- _o_result = (*r).org + (*r).offset;
- return _o_result;
+ __ASSERT((*r).offset <= 4096, 0);
+ return (*r).org + (*r).offset;
}
-void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos)
+void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos)
{
- LONGINT org, offset, i, n;
+ INT32 org, offset, i, n;
Files_Buffer buf = NIL;
- INTEGER error;
+ INT16 error;
if (f != NIL) {
if (pos > f->len) {
pos = f->len;
@@ -584,9 +570,9 @@ void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos)
if (f->pos != org) {
error = Platform_Seek(f->fd, org, Platform_SeekSet);
}
- error = Platform_ReadBuf(f->fd, (void*)buf->data, ((LONGINT)(4096)), &n);
+ error = Platform_ReadBuf(f->fd, (void*)buf->data, 4096, &n);
if (error != 0) {
- Files_Err((CHAR*)"read from file not done", (LONGINT)24, f, error);
+ Files_Err((CHAR*)"read from file not done", 24, f, error);
}
f->pos = org + n;
buf->size = n;
@@ -599,6 +585,7 @@ void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos)
org = 0;
offset = 0;
}
+ __ASSERT(offset <= 4096, 0);
(*r).buf = buf;
(*r).org = org;
(*r).offset = offset;
@@ -606,9 +593,9 @@ void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos)
(*r).res = 0;
}
-void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x)
+void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
{
- LONGINT offset;
+ INT32 offset;
Files_Buffer buf = NIL;
buf = (*r).buf;
offset = (*r).offset;
@@ -617,6 +604,7 @@ void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x)
buf = (*r).buf;
offset = (*r).offset;
}
+ __ASSERT(offset <= buf->size, 0);
if (offset < buf->size) {
*x = buf->data[offset];
(*r).offset = offset + 1;
@@ -630,9 +618,9 @@ void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x)
}
}
-void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n)
+void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
{
- LONGINT xpos, min, restInBuf, offset;
+ INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
if (n > x__len) {
Files_IdxTrap();
@@ -656,39 +644,35 @@ void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x
} else {
min = n;
}
- __MOVE((LONGINT)(SYSTEM_ADDRESS)buf->data + offset, (LONGINT)(SYSTEM_ADDRESS)x + xpos, min);
+ __MOVE((ADDRESS)buf->data + Files_ToAdr(offset), (ADDRESS)x + Files_ToAdr(xpos), min);
offset += min;
(*r).offset = offset;
xpos += min;
n -= min;
+ __ASSERT(offset <= 4096, 0);
}
(*r).res = 0;
(*r).eof = 0;
}
-void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len)
+Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ)
{
- Files_ReadBytes(&*r, r__typ, (void*)x, x__len * ((LONGINT)(1)), ((LONGINT)(1)));
+ return (*r).buf->f;
}
-Files_File Files_Base (Files_Rider *r, LONGINT *r__typ)
-{
- Files_File _o_result;
- _o_result = (*r).buf->f;
- return _o_result;
-}
-
-void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x)
+void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
{
Files_Buffer buf = NIL;
- LONGINT offset;
+ INT32 offset;
buf = (*r).buf;
offset = (*r).offset;
+ __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;
}
+ __ASSERT(offset < 4096, 0);
buf->data[offset] = x;
buf->chg = 1;
if (offset == buf->size) {
@@ -699,9 +683,9 @@ void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x)
(*r).res = 0;
}
-void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n)
+void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
{
- LONGINT xpos, min, restInBuf, offset;
+ INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
if (n > x__len) {
Files_IdxTrap();
@@ -710,20 +694,23 @@ void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT
buf = (*r).buf;
offset = (*r).offset;
while (n > 0) {
+ __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;
}
+ __ASSERT(offset <= 4096, 0);
restInBuf = 4096 - offset;
if (n > restInBuf) {
min = restInBuf;
} else {
min = n;
}
- __MOVE((LONGINT)(SYSTEM_ADDRESS)x + xpos, (LONGINT)(SYSTEM_ADDRESS)buf->data + offset, min);
+ __MOVE((ADDRESS)x + Files_ToAdr(xpos), (ADDRESS)buf->data + Files_ToAdr(offset), min);
offset += min;
(*r).offset = offset;
+ __ASSERT(offset <= 4096, 0);
if (offset > buf->size) {
buf->f->len += offset - buf->size;
buf->size = offset;
@@ -735,17 +722,17 @@ void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT
(*r).res = 0;
}
-void Files_Delete (CHAR *name, LONGINT name__len, INTEGER *res)
+void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res)
{
__DUP(name, name__len, CHAR);
*res = Platform_Unlink((void*)name, name__len);
__DEL(name);
}
-void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res)
+void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res)
{
- LONGINT fdold, fdnew, n;
- INTEGER error, ignore;
+ INT32 fdold, fdnew, n;
+ INT16 error, ignore;
Platform_FileIdentity oldidentity, newidentity;
CHAR buf[4096];
__DUP(old, old__len, CHAR);
@@ -759,28 +746,34 @@ void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT
error = Platform_Rename((void*)old, old__len, (void*)new, new__len);
if (!Platform_DifferentFilesystems(error)) {
*res = error;
+ __DEL(old);
+ __DEL(new);
return;
} else {
error = Platform_OldRO((void*)old, old__len, &fdold);
if (error != 0) {
*res = 2;
+ __DEL(old);
+ __DEL(new);
return;
}
error = Platform_New((void*)new, new__len, &fdnew);
if (error != 0) {
error = Platform_Close(fdold);
*res = 3;
+ __DEL(old);
+ __DEL(new);
return;
}
- error = Platform_Read(fdold, (LONGINT)(SYSTEM_ADDRESS)buf, ((LONGINT)(4096)), &n);
+ error = Platform_Read(fdold, (ADDRESS)buf, 4096, &n);
while (n > 0) {
- error = Platform_Write(fdnew, (LONGINT)(SYSTEM_ADDRESS)buf, n);
+ error = Platform_Write(fdnew, (ADDRESS)buf, n);
if (error != 0) {
ignore = Platform_Close(fdold);
ignore = Platform_Close(fdnew);
- Files_Err((CHAR*)"cannot move file", (LONGINT)17, NIL, error);
+ Files_Err((CHAR*)"cannot move file", 17, NIL, error);
}
- error = Platform_Read(fdold, (LONGINT)(SYSTEM_ADDRESS)buf, ((LONGINT)(4096)), &n);
+ error = Platform_Read(fdold, (ADDRESS)buf, 4096, &n);
}
ignore = Platform_Close(fdold);
ignore = Platform_Close(fdnew);
@@ -788,7 +781,7 @@ void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT
error = Platform_Unlink((void*)old, old__len);
*res = 0;
} else {
- Files_Err((CHAR*)"cannot move file", (LONGINT)17, NIL, error);
+ Files_Err((CHAR*)"cannot move file", 17, NIL, error);
}
}
} else {
@@ -800,7 +793,7 @@ void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT
void Files_Register (Files_File f)
{
- INTEGER idx, errcode;
+ INT16 idx, errcode;
Files_File f1 = NIL;
CHAR file[104];
if ((f->state == 1 && f->registerName[0] != 0x00)) {
@@ -808,18 +801,18 @@ void Files_Register (Files_File f)
}
Files_Close(f);
if (f->registerName[0] != 0x00) {
- Files_Rename(f->workName, ((LONGINT)(101)), f->registerName, ((LONGINT)(101)), &errcode);
+ Files_Rename(f->workName, 101, f->registerName, 101, &errcode);
if (errcode != 0) {
- __COPY(f->registerName, file, ((LONGINT)(104)));
+ __COPY(f->registerName, file, 104);
__HALT(99);
}
- __COPY(f->registerName, f->workName, ((LONGINT)(101)));
+ __COPY(f->registerName, f->workName, 101);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
}
-void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res)
+void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res)
{
__DUP(path, path__len, CHAR);
*res = Platform_Chdir((void*)path, path__len);
@@ -828,7 +821,7 @@ void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res)
static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len)
{
- LONGINT i, j;
+ INT32 i, j;
if (!Platform_LittleEndian) {
i = src__len;
j = 0;
@@ -838,55 +831,55 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *de
j += 1;
}
} else {
- __MOVE((LONGINT)(SYSTEM_ADDRESS)src, (LONGINT)(SYSTEM_ADDRESS)dest, src__len);
+ __MOVE((ADDRESS)src, (ADDRESS)dest, src__len);
}
}
-void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x)
+void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x)
{
Files_Read(&*R, R__typ, (CHAR*)(void*)&*x);
}
-void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x)
+void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x)
{
CHAR b[2];
- Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(2)), ((LONGINT)(2)));
- *x = (int)b[0] + __ASHL((int)b[1], 8);
+ Files_ReadBytes(&*R, R__typ, (void*)b, 2, 2);
+ *x = (INT16)b[0] + __ASHL((INT16)b[1], 8);
}
-void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x)
+void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x)
{
CHAR b[4];
- Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
- *x = ((int)((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((int)b[2], 16)) + __ASHL((int)b[3], 24);
+ Files_ReadBytes(&*R, R__typ, (void*)b, 4, 4);
+ *x = (((INT16)b[0] + __ASHL((INT16)b[1], 8)) + __ASHL(b[2], 16)) + __ASHL(b[3], 24);
}
-void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x)
+void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x)
{
CHAR b[4];
- LONGINT l;
- Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
- l = ((int)((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((int)b[2], 16)) + __ASHL((int)b[3], 24);
- *x = (SET)l;
+ INT32 l;
+ Files_ReadBytes(&*R, R__typ, (void*)b, 4, 4);
+ l = (((INT16)b[0] + __ASHL((INT16)b[1], 8)) + __ASHL(b[2], 16)) + __ASHL(b[3], 24);
+ *x = (UINT32)l;
}
-void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x)
+void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x)
{
CHAR b[4];
- Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
- Files_FlipBytes((void*)b, ((LONGINT)(4)), (void*)&*x, ((LONGINT)(4)));
+ Files_ReadBytes(&*R, R__typ, (void*)b, 4, 4);
+ Files_FlipBytes((void*)b, 4, (void*)&*x, 4);
}
-void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x)
+void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x)
{
CHAR b[8];
- Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(8)), ((LONGINT)(8)));
- Files_FlipBytes((void*)b, ((LONGINT)(8)), (void*)&*x, ((LONGINT)(8)));
+ Files_ReadBytes(&*R, R__typ, (void*)b, 8, 8);
+ Files_FlipBytes((void*)b, 8, (void*)&*x, 8);
}
-void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len)
+void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
{
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
do {
@@ -896,101 +889,100 @@ void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len)
} while (!(ch == 0x00));
}
-void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len)
+void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
{
- INTEGER i;
- CHAR ch;
- BOOLEAN b;
+ INT16 i;
i = 0;
- b = 0;
do {
- Files_Read(&*R, R__typ, (void*)&ch);
- if ((ch == 0x00 || ch == 0x0a) || ch == 0x0d) {
- b = 1;
- } else {
- x[i] = ch;
- i += 1;
- }
- } while (!b);
-}
-
-void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x)
-{
- SHORTINT s;
- CHAR ch;
- LONGINT n;
- s = 0;
- n = 0;
- Files_Read(&*R, R__typ, (void*)&ch);
- while ((int)ch >= 128) {
- n += __ASH((int)((int)ch - 128), s);
- s += 7;
- Files_Read(&*R, R__typ, (void*)&ch);
+ Files_Read(&*R, R__typ, (void*)&x[i]);
+ i += 1;
+ } while (!(x[i - 1] == 0x00 || x[i - 1] == 0x0a));
+ if (x[i - 1] == 0x0a) {
+ i -= 1;
}
- n += __ASH((int)(__MASK((int)ch, -64) - __ASHL(__ASHR((int)ch, 6), 6)), s);
- *x = n;
+ if ((i > 0 && x[i - 1] == 0x0d)) {
+ i -= 1;
+ }
+ x[i] = 0x00;
}
-void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x)
+void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len)
+{
+ INT8 s, b;
+ INT64 q;
+ s = 0;
+ q = 0;
+ Files_Read(&*R, R__typ, (void*)&b);
+ while (b < 0) {
+ q += (INT64)__ASH(((INT16)b + 128), s);
+ s += 7;
+ Files_Read(&*R, R__typ, (void*)&b);
+ }
+ q += (INT64)__ASH((__MASK(b, -64) - __ASHL(__ASHR(b, 6), 6)), s);
+ __ASSERT(x__len <= 8, 0);
+ __MOVE((ADDRESS)&q, (ADDRESS)x, x__len);
+}
+
+void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x)
{
Files_Write(&*R, R__typ, __VAL(CHAR, x));
}
-void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x)
+void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x)
{
CHAR b[2];
b[0] = (CHAR)x;
b[1] = (CHAR)__ASHR(x, 8);
- Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(2)), ((LONGINT)(2)));
+ Files_WriteBytes(&*R, R__typ, (void*)b, 2, 2);
}
-void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x)
+void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x)
{
CHAR b[4];
b[0] = (CHAR)x;
b[1] = (CHAR)__ASHR(x, 8);
b[2] = (CHAR)__ASHR(x, 16);
b[3] = (CHAR)__ASHR(x, 24);
- Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
+ Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
}
-void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x)
+void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x)
{
CHAR b[4];
- LONGINT i;
- i = (LONGINT)x;
+ INT32 i;
+ i = (INT32)x;
b[0] = (CHAR)i;
b[1] = (CHAR)__ASHR(i, 8);
b[2] = (CHAR)__ASHR(i, 16);
b[3] = (CHAR)__ASHR(i, 24);
- Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
+ Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
}
-void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x)
+void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x)
{
CHAR b[4];
- Files_FlipBytes((void*)&x, ((LONGINT)(4)), (void*)b, ((LONGINT)(4)));
- Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
+ Files_FlipBytes((void*)&x, 4, (void*)b, 4);
+ Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
}
-void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x)
+void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x)
{
CHAR b[8];
- Files_FlipBytes((void*)&x, ((LONGINT)(8)), (void*)b, ((LONGINT)(8)));
- Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(8)), ((LONGINT)(8)));
+ Files_FlipBytes((void*)&x, 8, (void*)b, 8);
+ Files_WriteBytes(&*R, R__typ, (void*)b, 8, 8);
}
-void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len)
+void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
{
- INTEGER i;
+ INT16 i;
i = 0;
while (x[i] != 0x00) {
i += 1;
}
- Files_WriteBytes(&*R, R__typ, (void*)x, x__len * ((LONGINT)(1)), i + 1);
+ Files_WriteBytes(&*R, R__typ, (void*)x, x__len * 1, i + 1);
}
-void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x)
+void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x)
{
while (x < -64 || x > 63) {
Files_Write(&*R, R__typ, (CHAR)(__MASK(x, -128) + 128));
@@ -1007,12 +999,12 @@ void Files_GetName (Files_File f, CHAR *name, LONGINT name__len)
static void Files_Finalize (SYSTEM_PTR o)
{
Files_File f = NIL;
- LONGINT res;
- f = (Files_File)(SYSTEM_ADDRESS)o;
+ INT32 res;
+ f = (Files_File)(ADDRESS)o;
if (f->fd >= 0) {
Files_CloseOSFile(f);
if (f->tempFile) {
- res = Platform_Unlink((void*)f->workName, ((LONGINT)(101)));
+ res = Platform_Unlink((void*)f->workName, 101);
}
}
}
@@ -1021,7 +1013,7 @@ void Files_SetSearchPath (CHAR *path, LONGINT path__len)
{
__DUP(path, path__len, CHAR);
if (Strings_Length(path, path__len) != 0) {
- Files_SearchPath = __NEWARR(NIL, ((LONGINT)(1)), 1, 1, 1, (LONGINT)(Strings_Length(path, path__len) + 1));
+ Files_SearchPath = __NEWARR(NIL, 1, 1, 1, 1, ((ADDRESS)((Strings_Length(path, path__len) + 1))));
__COPY(path, Files_SearchPath->data, Files_SearchPath->len[0]);
} else {
Files_SearchPath = NIL;
@@ -1042,9 +1034,8 @@ __TDESC(Files_Rider, 1, 1) = {__TDFLDS("Rider", 20), {8, -8}};
export void *Files__init(void)
{
__DEFMOD;
- __MODULE_IMPORT(Configuration);
- __MODULE_IMPORT(Console);
__MODULE_IMPORT(Heap);
+ __MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
__REGMOD("Files", EnumPtrs);
@@ -1055,6 +1046,6 @@ export void *Files__init(void)
Files_tempno = -1;
Heap_FileCount = 0;
Files_HOME[0] = 0x00;
- Platform_GetEnv((CHAR*)"HOME", (LONGINT)5, (void*)Files_HOME, ((LONGINT)(1024)));
+ Platform_GetEnv((CHAR*)"HOME", 5, (void*)Files_HOME, 1024);
__ENDMOD;
}
diff --git a/bootstrap/windows-48/Files.h b/bootstrap/windows-48/Files.h
index 868f24df..62df86fc 100644
--- a/bootstrap/windows-48/Files.h
+++ b/bootstrap/windows-48/Files.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
#ifndef Files__h
#define Files__h
@@ -11,60 +11,59 @@ typedef
typedef
struct Files_FileDesc {
char _prvt0[224];
- LONGINT fd;
+ INT32 fd;
char _prvt1[32];
} Files_FileDesc;
typedef
struct Files_Rider {
- LONGINT res;
+ INT32 res;
BOOLEAN eof;
char _prvt0[15];
} Files_Rider;
-import LONGINT *Files_FileDesc__typ;
-import LONGINT *Files_Rider__typ;
+import ADDRESS *Files_FileDesc__typ;
+import ADDRESS *Files_Rider__typ;
-import Files_File Files_Base (Files_Rider *r, LONGINT *r__typ);
-import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res);
+import Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
+import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res);
import void Files_Close (Files_File f);
-import void Files_Delete (CHAR *name, LONGINT name__len, INTEGER *res);
-import void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d);
+import void Files_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, LONGINT name__len);
-import LONGINT Files_Length (Files_File f);
+import INT32 Files_Length (Files_File f);
import Files_File Files_New (CHAR *name, LONGINT name__len);
import Files_File Files_Old (CHAR *name, LONGINT name__len);
-import LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ);
+import INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ);
import void Files_Purge (Files_File f);
-import void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x);
-import void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x);
-import void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len);
-import void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n);
-import void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x);
-import void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x);
-import void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x);
-import void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
-import void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x);
-import void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x);
-import void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x);
-import void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
+import void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
+import void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x);
+import void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+import void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x);
+import void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x);
+import void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
+import void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+import void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
+import void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
+import void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
+import void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
import void Files_Register (Files_File f);
-import void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res);
-import void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos);
+import void Files_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, LONGINT path__len);
-import void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x);
-import void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x);
-import void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n);
-import void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x);
-import void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x);
-import void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x);
-import void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x);
-import void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x);
-import void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x);
-import void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
+import void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
+import void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
+import void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+import void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
+import void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
+import void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
+import void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
+import void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
+import void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
+import void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
import void *Files__init(void);
-#endif
+#endif // Files
diff --git a/bootstrap/windows-48/Heap.c b/bootstrap/windows-48/Heap.c
index 30ec687a..72677604 100644
--- a/bootstrap/windows-48/Heap.c
+++ b/bootstrap/windows-48/Heap.c
@@ -1,4 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tskSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tsSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
struct Heap__1 {
@@ -34,7 +40,7 @@ typedef
typedef
struct Heap_FinDesc {
Heap_FinNode next;
- LONGINT obj;
+ INT32 obj;
BOOLEAN marked;
Heap_Finalizer finalize;
} Heap_FinDesc;
@@ -49,62 +55,61 @@ typedef
struct Heap_ModuleDesc {
Heap_Module next;
Heap_ModuleName name;
- LONGINT refcnt;
+ INT32 refcnt;
Heap_Cmd cmds;
- LONGINT types;
+ INT32 types;
Heap_EnumProc enumPtrs;
- LONGINT reserved1, reserved2;
+ INT32 reserved1, reserved2;
} Heap_ModuleDesc;
export SYSTEM_PTR Heap_modules;
-static LONGINT Heap_freeList[10];
-static LONGINT Heap_bigBlocks;
-export LONGINT Heap_allocated;
+static INT32 Heap_freeList[10];
+static INT32 Heap_bigBlocks;
+export INT32 Heap_allocated;
static BOOLEAN Heap_firstTry;
-static LONGINT Heap_heap, Heap_heapend;
-export LONGINT Heap_heapsize;
+static INT32 Heap_heap, Heap_heapend;
+export INT32 Heap_heapsize;
static Heap_FinNode Heap_fin;
-static INTEGER Heap_lockdepth;
+static INT16 Heap_lockdepth;
static BOOLEAN Heap_interrupted;
-export INTEGER Heap_FileCount;
+export INT16 Heap_FileCount;
-export LONGINT *Heap_ModuleDesc__typ;
-export LONGINT *Heap_CmdDesc__typ;
-export LONGINT *Heap_FinDesc__typ;
-export LONGINT *Heap__1__typ;
+export ADDRESS *Heap_ModuleDesc__typ;
+export ADDRESS *Heap_CmdDesc__typ;
+export ADDRESS *Heap_FinDesc__typ;
+export ADDRESS *Heap__1__typ;
static void Heap_CheckFin (void);
-static void Heap_ExtendHeap (LONGINT blksz);
+static void Heap_ExtendHeap (INT32 blksz);
export void Heap_FINALL (void);
static void Heap_Finalize (void);
export void Heap_GC (BOOLEAN markStack);
-static void Heap_HeapSort (LONGINT n, LONGINT *a, LONGINT a__len);
+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 (LONGINT q);
-static void Heap_MarkCandidates (LONGINT n, LONGINT *cand, LONGINT cand__len);
+static void Heap_Mark (INT32 q);
+static void Heap_MarkCandidates (INT32 n, INT32 *cand, LONGINT cand__len);
static void Heap_MarkP (SYSTEM_PTR p);
-static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len);
-export SYSTEM_PTR Heap_NEWBLK (LONGINT size);
-export SYSTEM_PTR Heap_NEWREC (LONGINT tag);
-static LONGINT Heap_NewChunk (LONGINT blksz);
+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);
export void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd);
export SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs);
-export void Heap_REGTYP (Heap_Module m, LONGINT typ);
+export void Heap_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 (LONGINT l, LONGINT r, LONGINT *a, LONGINT 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 LONGINT Platform_MainStackFrame;
-extern LONGINT Platform_OSAllocate(LONGINT size);
-#define Heap_FetchAddress(pointer) (LONGINT)(SYSTEM_ADDRESS)(*((void**)((SYSTEM_ADDRESS)pointer)))
+extern ADDRESS Platform_MainStackFrame;
+extern ADDRESS Platform_OSAllocate(ADDRESS size);
#define Heap_HeapModuleInit() Heap__init()
+#define Heap_ModulesHalt(code) Modules_Halt(code)
#define Heap_OSAllocate(size) Platform_OSAllocate(size)
-#define Heap_PlatformHalt(code) Platform_Halt(code)
#define Heap_PlatformMainStackFrame() Platform_MainStackFrame
void Heap_Lock (void)
@@ -116,13 +121,12 @@ void Heap_Unlock (void)
{
Heap_lockdepth -= 1;
if ((Heap_interrupted && Heap_lockdepth == 0)) {
- Heap_PlatformHalt(((LONGINT)(-9)));
+ Heap_ModulesHalt(-9);
}
}
SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs)
{
- SYSTEM_PTR _o_result;
Heap_Module m;
if (__STRCMP(name, "Heap") == 0) {
__SYSNEW(m, 48);
@@ -131,13 +135,12 @@ SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs)
}
m->types = 0;
m->cmds = NIL;
- __COPY(name, m->name, ((LONGINT)(20)));
+ __COPY(name, m->name, 20);
m->refcnt = 0;
m->enumPtrs = enumPtrs;
- m->next = (Heap_Module)(SYSTEM_ADDRESS)Heap_modules;
+ m->next = (Heap_Module)(ADDRESS)Heap_modules;
Heap_modules = (SYSTEM_PTR)m;
- _o_result = (void*)m;
- return _o_result;
+ return (void*)m;
}
void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd)
@@ -148,15 +151,15 @@ void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd)
} else {
__NEW(c, Heap_CmdDesc);
}
- __COPY(name, c->name, ((LONGINT)(24)));
+ __COPY(name, c->name, 24);
c->cmd = cmd;
c->next = m->cmds;
m->cmds = c;
}
-void Heap_REGTYP (Heap_Module m, LONGINT typ)
+void Heap_REGTYP (Heap_Module m, INT32 typ)
{
- __PUT(typ, m->types, LONGINT);
+ __PUT(typ, m->types, INT32);
m->types = typ;
}
@@ -165,27 +168,25 @@ void Heap_INCREF (Heap_Module m)
m->refcnt += 1;
}
-static LONGINT Heap_NewChunk (LONGINT blksz)
+static INT32 Heap_NewChunk (INT32 blksz)
{
- LONGINT _o_result;
- LONGINT chnk;
+ INT32 chnk;
chnk = Heap_OSAllocate(blksz + 12);
if (chnk != 0) {
- __PUT(chnk + 4, chnk + (12 + blksz), LONGINT);
- __PUT(chnk + 12, chnk + 16, LONGINT);
- __PUT(chnk + 16, blksz, LONGINT);
- __PUT(chnk + 20, -4, LONGINT);
- __PUT(chnk + 24, Heap_bigBlocks, LONGINT);
+ __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;
}
- _o_result = chnk;
- return _o_result;
+ return chnk;
}
-static void Heap_ExtendHeap (LONGINT blksz)
+static void Heap_ExtendHeap (INT32 blksz)
{
- LONGINT size, chnk, j, next;
+ INT32 size, chnk, j, next;
if (blksz > 160000) {
size = blksz;
} else {
@@ -194,31 +195,30 @@ static void Heap_ExtendHeap (LONGINT blksz)
chnk = Heap_NewChunk(size);
if (chnk != 0) {
if (chnk < Heap_heap) {
- __PUT(chnk, Heap_heap, LONGINT);
+ __PUT(chnk, Heap_heap, INT32);
Heap_heap = chnk;
} else {
j = Heap_heap;
- next = Heap_FetchAddress(j);
+ __GET(j, next, INT32);
while ((next != 0 && chnk > next)) {
j = next;
- next = Heap_FetchAddress(j);
+ __GET(j, next, INT32);
}
- __PUT(chnk, next, LONGINT);
- __PUT(j, chnk, LONGINT);
+ __PUT(chnk, next, INT32);
+ __PUT(j, chnk, INT32);
}
if (next == 0) {
- Heap_heapend = Heap_FetchAddress(chnk + 4);
+ __GET(chnk + 4, Heap_heapend, INT32);
}
}
}
-SYSTEM_PTR Heap_NEWREC (LONGINT tag)
+SYSTEM_PTR Heap_NEWREC (INT32 tag)
{
- SYSTEM_PTR _o_result;
- LONGINT i, i0, di, blksz, restsize, t, adr, end, next, prev;
+ INT32 i, i0, di, blksz, restsize, t, adr, end, next, prev;
SYSTEM_PTR new;
Heap_Lock();
- blksz = Heap_FetchAddress(tag);
+ __GET(tag, blksz, INT32);
i0 = __ASHR(blksz, 4);
i = i0;
if (i < 9) {
@@ -229,17 +229,17 @@ SYSTEM_PTR Heap_NEWREC (LONGINT tag)
}
}
if (i < 9) {
- next = Heap_FetchAddress(adr + 12);
+ __GET(adr + 12, next, INT32);
Heap_freeList[i] = next;
if (i != i0) {
di = i - i0;
restsize = __ASHL(di, 4);
end = adr + restsize;
- __PUT(end + 4, blksz, LONGINT);
- __PUT(end + 8, -4, LONGINT);
- __PUT(end, end + 4, LONGINT);
- __PUT(adr + 4, restsize, LONGINT);
- __PUT(adr + 12, Heap_freeList[di], LONGINT);
+ __PUT(end + 4, blksz, INT32);
+ __PUT(end + 8, -4, INT32);
+ __PUT(end, end + 4, INT32);
+ __PUT(adr + 4, restsize, INT32);
+ __PUT(adr + 12, Heap_freeList[di], INT32);
Heap_freeList[di] = adr;
adr += restsize;
}
@@ -262,39 +262,37 @@ SYSTEM_PTR Heap_NEWREC (LONGINT tag)
new = Heap_NEWREC(tag);
}
Heap_Unlock();
- _o_result = new;
- return _o_result;
+ return new;
} else {
Heap_Unlock();
- _o_result = NIL;
- return _o_result;
+ return NIL;
}
}
- t = Heap_FetchAddress(adr + 4);
+ __GET(adr + 4, t, INT32);
if (t >= blksz) {
break;
}
prev = adr;
- adr = Heap_FetchAddress(adr + 12);
+ __GET(adr + 12, adr, INT32);
}
restsize = t - blksz;
end = adr + restsize;
- __PUT(end + 4, blksz, LONGINT);
- __PUT(end + 8, -4, LONGINT);
- __PUT(end, end + 4, LONGINT);
+ __PUT(end + 4, blksz, INT32);
+ __PUT(end + 8, -4, INT32);
+ __PUT(end, end + 4, INT32);
if (restsize > 144) {
- __PUT(adr + 4, restsize, LONGINT);
+ __PUT(adr + 4, restsize, INT32);
} else {
- next = Heap_FetchAddress(adr + 12);
+ __GET(adr + 12, next, INT32);
if (prev == 0) {
Heap_bigBlocks = next;
} else {
- __PUT(prev + 12, next, LONGINT);
+ __PUT(prev + 12, next, INT32);
}
if (restsize > 0) {
di = __ASHR(restsize, 4);
- __PUT(adr + 4, restsize, LONGINT);
- __PUT(adr + 12, Heap_freeList[di], LONGINT);
+ __PUT(adr + 4, restsize, INT32);
+ __PUT(adr + 12, Heap_freeList[di], INT32);
Heap_freeList[di] = adr;
}
}
@@ -303,73 +301,70 @@ SYSTEM_PTR Heap_NEWREC (LONGINT tag)
i = adr + 16;
end = adr + blksz;
while (i < end) {
- __PUT(i, 0, LONGINT);
- __PUT(i + 4, 0, LONGINT);
- __PUT(i + 8, 0, LONGINT);
- __PUT(i + 12, 0, LONGINT);
+ __PUT(i, 0, INT32);
+ __PUT(i + 4, 0, INT32);
+ __PUT(i + 8, 0, INT32);
+ __PUT(i + 12, 0, INT32);
i += 16;
}
- __PUT(adr + 12, 0, LONGINT);
- __PUT(adr, tag, LONGINT);
- __PUT(adr + 4, 0, LONGINT);
- __PUT(adr + 8, 0, LONGINT);
+ __PUT(adr + 12, 0, INT32);
+ __PUT(adr, tag, INT32);
+ __PUT(adr + 4, 0, INT32);
+ __PUT(adr + 8, 0, INT32);
Heap_allocated += blksz;
Heap_Unlock();
- _o_result = (SYSTEM_PTR)(SYSTEM_ADDRESS)(adr + 4);
- return _o_result;
+ return (SYSTEM_PTR)(ADDRESS)(adr + 4);
}
-SYSTEM_PTR Heap_NEWBLK (LONGINT size)
+SYSTEM_PTR Heap_NEWBLK (INT32 size)
{
- SYSTEM_PTR _o_result;
- LONGINT blksz, tag;
+ INT32 blksz, tag;
SYSTEM_PTR new;
Heap_Lock();
blksz = __ASHL(__ASHR(size + 31, 4), 4);
- new = Heap_NEWREC((LONGINT)(SYSTEM_ADDRESS)&blksz);
- tag = ((LONGINT)(SYSTEM_ADDRESS)new + blksz) - 12;
- __PUT(tag - 4, 0, LONGINT);
- __PUT(tag, blksz, LONGINT);
- __PUT(tag + 4, -4, LONGINT);
- __PUT((LONGINT)(SYSTEM_ADDRESS)new - 4, tag, LONGINT);
+ new = Heap_NEWREC((ADDRESS)&blksz);
+ tag = ((INT32)(ADDRESS)new + blksz) - 12;
+ __PUT(tag - 4, 0, INT32);
+ __PUT(tag, blksz, INT32);
+ __PUT(tag + 4, -4, INT32);
+ __PUT((INT32)(ADDRESS)new - 4, tag, INT32);
Heap_Unlock();
- _o_result = new;
- return _o_result;
+ return new;
}
-static void Heap_Mark (LONGINT q)
+static void Heap_Mark (INT32 q)
{
- LONGINT p, tag, fld, n, offset, tagbits;
+ INT32 p, tag, offset, fld, n, tagbits;
if (q != 0) {
- tagbits = Heap_FetchAddress(q - 4);
+ __GET(q - 4, tagbits, INT32);
if (!__ODD(tagbits)) {
- __PUT(q - 4, tagbits + 1, LONGINT);
+ __PUT(q - 4, tagbits + 1, INT32);
p = 0;
tag = tagbits + 4;
for (;;) {
- __GET(tag, offset, LONGINT);
+ __GET(tag, offset, INT32);
if (offset < 0) {
- __PUT(q - 4, (tag + offset) + 1, LONGINT);
+ __PUT(q - 4, (tag + offset) + 1, INT32);
if (p == 0) {
break;
}
n = q;
q = p;
- tag = Heap_FetchAddress(q - 4);
+ __GET(q - 4, tag, INT32);
tag -= 1;
- __GET(tag, offset, LONGINT);
+ __GET(tag, offset, INT32);
fld = q + offset;
- p = Heap_FetchAddress(fld);
- __PUT(fld, (SYSTEM_PTR)(SYSTEM_ADDRESS)n, SYSTEM_PTR);
+ __GET(fld, p, INT32);
+ __PUT(fld, (SYSTEM_PTR)(ADDRESS)n, SYSTEM_PTR);
} else {
fld = q + offset;
- n = Heap_FetchAddress(fld);
+ __GET(fld, n, INT32);
if (n != 0) {
- tagbits = Heap_FetchAddress(n - 4);
+ __GET(n - 4, tagbits, INT32);
if (!__ODD(tagbits)) {
- __PUT(n - 4, tagbits + 1, LONGINT);
- __PUT(q - 4, tag + 1, LONGINT);
- __PUT(fld, (SYSTEM_PTR)(SYSTEM_ADDRESS)p, SYSTEM_PTR);
+ __PUT(n - 4, tagbits + 1, INT32);
+ __PUT(q - 4, tag + 1, INT32);
+ __PUT(fld, (SYSTEM_PTR)(ADDRESS)p, SYSTEM_PTR);
p = q;
q = n;
tag = tagbits;
@@ -384,12 +379,12 @@ static void Heap_Mark (LONGINT q)
static void Heap_MarkP (SYSTEM_PTR p)
{
- Heap_Mark((LONGINT)(SYSTEM_ADDRESS)p);
+ Heap_Mark((INT32)(ADDRESS)p);
}
static void Heap_Scan (void)
{
- LONGINT chnk, adr, end, start, tag, i, size, freesize;
+ INT32 chnk, adr, end, start, tag, i, size, freesize;
Heap_bigBlocks = 0;
i = 1;
while (i < 9) {
@@ -401,58 +396,58 @@ static void Heap_Scan (void)
chnk = Heap_heap;
while (chnk != 0) {
adr = chnk + 12;
- end = Heap_FetchAddress(chnk + 4);
+ __GET(chnk + 4, end, INT32);
while (adr < end) {
- tag = Heap_FetchAddress(adr);
+ __GET(adr, tag, INT32);
if (__ODD(tag)) {
if (freesize > 0) {
start = adr - freesize;
- __PUT(start, start + 4, LONGINT);
- __PUT(start + 4, freesize, LONGINT);
- __PUT(start + 8, -4, LONGINT);
+ __PUT(start, start + 4, INT32);
+ __PUT(start + 4, freesize, INT32);
+ __PUT(start + 8, -4, INT32);
i = __ASHR(freesize, 4);
freesize = 0;
if (i < 9) {
- __PUT(start + 12, Heap_freeList[i], LONGINT);
+ __PUT(start + 12, Heap_freeList[i], INT32);
Heap_freeList[i] = start;
} else {
- __PUT(start + 12, Heap_bigBlocks, LONGINT);
+ __PUT(start + 12, Heap_bigBlocks, INT32);
Heap_bigBlocks = start;
}
}
tag -= 1;
- __PUT(adr, tag, LONGINT);
- size = Heap_FetchAddress(tag);
+ __PUT(adr, tag, INT32);
+ __GET(tag, size, INT32);
Heap_allocated += size;
adr += size;
} else {
- size = Heap_FetchAddress(tag);
+ __GET(tag, size, INT32);
freesize += size;
adr += size;
}
}
if (freesize > 0) {
start = adr - freesize;
- __PUT(start, start + 4, LONGINT);
- __PUT(start + 4, freesize, LONGINT);
- __PUT(start + 8, -4, LONGINT);
+ __PUT(start, start + 4, INT32);
+ __PUT(start + 4, freesize, INT32);
+ __PUT(start + 8, -4, INT32);
i = __ASHR(freesize, 4);
freesize = 0;
if (i < 9) {
- __PUT(start + 12, Heap_freeList[i], LONGINT);
+ __PUT(start + 12, Heap_freeList[i], INT32);
Heap_freeList[i] = start;
} else {
- __PUT(start + 12, Heap_bigBlocks, LONGINT);
+ __PUT(start + 12, Heap_bigBlocks, INT32);
Heap_bigBlocks = start;
}
}
- chnk = Heap_FetchAddress(chnk);
+ __GET(chnk, chnk, INT32);
}
}
-static void Heap_Sift (LONGINT l, LONGINT r, LONGINT *a, LONGINT a__len)
+static void Heap_Sift (INT32 l, INT32 r, INT32 *a, LONGINT a__len)
{
- LONGINT i, j, x;
+ INT32 i, j, x;
j = l;
x = a[j];
for (;;) {
@@ -469,9 +464,9 @@ static void Heap_Sift (LONGINT l, LONGINT r, LONGINT *a, LONGINT a__len)
a[i] = x;
}
-static void Heap_HeapSort (LONGINT n, LONGINT *a, LONGINT a__len)
+static void Heap_HeapSort (INT32 n, INT32 *a, LONGINT a__len)
{
- LONGINT l, r, x;
+ INT32 l, r, x;
l = __ASHR(n, 1);
r = n - 1;
while (l > 0) {
@@ -487,25 +482,25 @@ static void Heap_HeapSort (LONGINT n, LONGINT *a, LONGINT a__len)
}
}
-static void Heap_MarkCandidates (LONGINT n, LONGINT *cand, LONGINT cand__len)
+static void Heap_MarkCandidates (INT32 n, INT32 *cand, LONGINT cand__len)
{
- LONGINT chnk, adr, tag, next, lim, lim1, i, ptr, size;
+ INT32 chnk, adr, tag, next, lim, lim1, i, ptr, size;
chnk = Heap_heap;
i = 0;
lim = cand[n - 1];
while ((chnk != 0 && chnk < lim)) {
adr = chnk + 12;
- lim1 = Heap_FetchAddress(chnk + 4);
+ __GET(chnk + 4, lim1, INT32);
if (lim < lim1) {
lim1 = lim;
}
while (adr < lim1) {
- tag = Heap_FetchAddress(adr);
+ __GET(adr, tag, INT32);
if (__ODD(tag)) {
- size = Heap_FetchAddress(tag - 1);
+ __GET(tag - 1, size, INT32);
adr += size;
} else {
- size = Heap_FetchAddress(tag);
+ __GET(tag, size, INT32);
ptr = adr + 4;
while (cand[i] < ptr) {
i += 1;
@@ -520,17 +515,17 @@ static void Heap_MarkCandidates (LONGINT n, LONGINT *cand, LONGINT cand__len)
adr = next;
}
}
- chnk = Heap_FetchAddress(chnk);
+ __GET(chnk, chnk, INT32);
}
}
static void Heap_CheckFin (void)
{
Heap_FinNode n;
- LONGINT tag;
+ INT32 tag;
n = Heap_fin;
while (n != NIL) {
- tag = Heap_FetchAddress(n->obj - 4);
+ __GET(n->obj - 4, tag, INT32);
if (!__ODD(tag)) {
n->marked = 0;
Heap_Mark(n->obj);
@@ -553,7 +548,7 @@ static void Heap_Finalize (void)
} else {
prev->next = n->next;
}
- (*n->finalize)((SYSTEM_PTR)(SYSTEM_ADDRESS)n->obj);
+ (*n->finalize)((SYSTEM_PTR)(ADDRESS)n->obj);
if (prev == NIL) {
n = Heap_fin;
} else {
@@ -572,14 +567,14 @@ void Heap_FINALL (void)
while (Heap_fin != NIL) {
n = Heap_fin;
Heap_fin = Heap_fin->next;
- (*n->finalize)((SYSTEM_PTR)(SYSTEM_ADDRESS)n->obj);
+ (*n->finalize)((SYSTEM_PTR)(ADDRESS)n->obj);
}
}
-static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len)
+static void Heap_MarkStack (INT32 n, INT32 *cand, LONGINT cand__len)
{
SYSTEM_PTR frame;
- LONGINT inc, nofcand, sp, p, stack0;
+ INT32 inc, nofcand, sp, p, stack0;
struct Heap__1 align;
if (n > 0) {
Heap_MarkStack(n - 1, cand, cand__len);
@@ -589,14 +584,14 @@ static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len)
}
if (n == 0) {
nofcand = 0;
- sp = (LONGINT)(SYSTEM_ADDRESS)&frame;
+ sp = (ADDRESS)&frame;
stack0 = Heap_PlatformMainStackFrame();
- inc = (LONGINT)(SYSTEM_ADDRESS)&align.p - (LONGINT)(SYSTEM_ADDRESS)&align;
+ inc = (ADDRESS)&align.p - (ADDRESS)&align;
if (sp > stack0) {
inc = -inc;
}
while (sp != stack0) {
- __GET(sp, p, LONGINT);
+ __GET(sp, p, INT32);
if ((p > Heap_heap && p < Heap_heapend)) {
if (nofcand == cand__len) {
Heap_HeapSort(nofcand, (void*)cand, cand__len);
@@ -618,11 +613,11 @@ static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len)
void Heap_GC (BOOLEAN markStack)
{
Heap_Module m;
- LONGINT i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23;
- LONGINT cand[10000];
+ INT32 i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23;
+ INT32 cand[10000];
if (Heap_lockdepth == 0 || (Heap_lockdepth == 1 && !markStack)) {
Heap_Lock();
- m = (Heap_Module)(SYSTEM_ADDRESS)Heap_modules;
+ m = (Heap_Module)(ADDRESS)Heap_modules;
while (m != NIL) {
if (m->enumPtrs != NIL) {
(*m->enumPtrs)(Heap_MarkP);
@@ -680,7 +675,7 @@ void Heap_GC (BOOLEAN markStack)
i22 += 23;
i23 += 24;
if ((i0 == -99 && i15 == 24)) {
- Heap_MarkStack(((LONGINT)(32)), (void*)cand, ((LONGINT)(10000)));
+ Heap_MarkStack(32, (void*)cand, 10000);
break;
}
}
@@ -699,7 +694,7 @@ void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
{
Heap_FinNode f;
__NEW(f, Heap_FinDesc);
- f->obj = (LONGINT)(SYSTEM_ADDRESS)obj;
+ f->obj = (INT32)(ADDRESS)obj;
f->finalize = finalize;
f->marked = 1;
f->next = Heap_fin;
@@ -709,8 +704,8 @@ void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
void Heap_InitHeap (void)
{
Heap_heap = Heap_NewChunk(128000);
- Heap_heapend = Heap_FetchAddress(Heap_heap + 4);
- __PUT(Heap_heap, 0, LONGINT);
+ __GET(Heap_heap + 4, Heap_heapend, INT32);
+ __PUT(Heap_heap, 0, INT32);
Heap_allocated = 0;
Heap_firstTry = 1;
Heap_freeList[9] = 1;
diff --git a/bootstrap/windows-48/Heap.h b/bootstrap/windows-48/Heap.h
index a2cab30c..0aa0a18b 100644
--- a/bootstrap/windows-48/Heap.h
+++ b/bootstrap/windows-48/Heap.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tskSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tsSF */
#ifndef Heap__h
#define Heap__h
@@ -22,7 +22,7 @@ typedef
typedef
struct Heap_ModuleDesc {
- LONGINT _prvt0;
+ INT32 _prvt0;
char _prvt1[44];
} Heap_ModuleDesc;
@@ -31,24 +31,24 @@ typedef
import SYSTEM_PTR Heap_modules;
-import LONGINT Heap_allocated, Heap_heapsize;
-import INTEGER Heap_FileCount;
+import INT32 Heap_allocated, Heap_heapsize;
+import INT16 Heap_FileCount;
-import LONGINT *Heap_ModuleDesc__typ;
+import ADDRESS *Heap_ModuleDesc__typ;
import void Heap_FINALL (void);
import void Heap_GC (BOOLEAN markStack);
import void Heap_INCREF (Heap_Module m);
import void Heap_InitHeap (void);
import void Heap_Lock (void);
-import SYSTEM_PTR Heap_NEWBLK (LONGINT size);
-import SYSTEM_PTR Heap_NEWREC (LONGINT tag);
+import SYSTEM_PTR Heap_NEWBLK (INT32 size);
+import SYSTEM_PTR Heap_NEWREC (INT32 tag);
import void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd);
import SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs);
-import void Heap_REGTYP (Heap_Module m, LONGINT typ);
+import void Heap_REGTYP (Heap_Module m, INT32 typ);
import void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize);
import void Heap_Unlock (void);
import void *Heap__init(void);
-#endif
+#endif // Heap
diff --git a/bootstrap/windows-48/Modules.c b/bootstrap/windows-48/Modules.c
index 330b7506..a5e72ba3 100644
--- a/bootstrap/windows-48/Modules.c
+++ b/bootstrap/windows-48/Modules.c
@@ -1,7 +1,13 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
-#include "Console.h"
#include "Heap.h"
+#include "Platform.h"
typedef
struct Modules_CmdDesc *Modules_Cmd;
@@ -26,32 +32,38 @@ typedef
struct Modules_ModuleDesc {
Modules_Module next;
Modules_ModuleName name;
- LONGINT refcnt;
+ INT32 refcnt;
Modules_Cmd cmds;
- LONGINT types;
- void (*enumPtrs)(void(*)(LONGINT));
- LONGINT reserved1, reserved2;
+ INT32 types;
+ void (*enumPtrs)(void(*)(INT32));
+ INT32 reserved1, reserved2;
} Modules_ModuleDesc;
-export INTEGER Modules_res;
+export INT16 Modules_res;
export CHAR Modules_resMsg[256];
export Modules_ModuleName Modules_imported, Modules_importing;
-export LONGINT *Modules_ModuleDesc__typ;
-export LONGINT *Modules_CmdDesc__typ;
+export ADDRESS *Modules_ModuleDesc__typ;
+export ADDRESS *Modules_CmdDesc__typ;
static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len);
+export void Modules_AssertFail (INT32 code);
+static void Modules_DisplayHaltCode (INT32 code);
export void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
+export void Modules_Halt (INT32 code);
export Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
export Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
+static void Modules_errch (CHAR c);
+static void Modules_errint (INT32 l);
+static void Modules_errstring (CHAR *s, LONGINT s__len);
#define Modules_modules() (Modules_Module)Heap_modules
#define Modules_setmodules(m) Heap_modules = m
static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len)
{
- INTEGER i, j;
+ INT16 i, j;
__DUP(b, b__len, CHAR);
i = 0;
while (a[__X(i, a__len)] != 0x00) {
@@ -69,7 +81,6 @@ static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len)
Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
{
- Modules_Module _o_result;
Modules_Module m = NIL;
CHAR bodyname[64];
Modules_Command body;
@@ -83,19 +94,17 @@ Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
Modules_resMsg[0] = 0x00;
} else {
Modules_res = 1;
- __COPY(name, Modules_importing, ((LONGINT)(20)));
+ __COPY(name, Modules_importing, 20);
__MOVE(" module \"", Modules_resMsg, 10);
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), name, name__len);
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)"\" not found", (LONGINT)12);
+ Modules_Append((void*)Modules_resMsg, 256, name, name__len);
+ Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
}
- _o_result = m;
__DEL(name);
- return _o_result;
+ return m;
}
Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len)
{
- Modules_Command _o_result;
Modules_Cmd c = NIL;
__DUP(name, name__len, CHAR);
c = mod->cmds;
@@ -105,20 +114,18 @@ Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT nam
if (c != NIL) {
Modules_res = 0;
Modules_resMsg[0] = 0x00;
- _o_result = c->cmd;
__DEL(name);
- return _o_result;
+ return c->cmd;
} else {
Modules_res = 2;
__MOVE(" command \"", Modules_resMsg, 11);
- __COPY(name, Modules_importing, ((LONGINT)(20)));
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), mod->name, ((LONGINT)(20)));
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)".", (LONGINT)2);
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), name, name__len);
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)"\" not found", (LONGINT)12);
- _o_result = NIL;
+ __COPY(name, Modules_importing, 20);
+ Modules_Append((void*)Modules_resMsg, 256, mod->name, 20);
+ Modules_Append((void*)Modules_resMsg, 256, (CHAR*)".", 2);
+ Modules_Append((void*)Modules_resMsg, 256, name, name__len);
+ Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
__DEL(name);
- return _o_result;
+ return NIL;
}
__RETCHK;
}
@@ -155,14 +162,124 @@ void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all)
__DEL(name);
}
+static void Modules_errch (CHAR c)
+{
+ INT16 e;
+ e = Platform_Write(1, (ADDRESS)&c, 1);
+}
+
+static void Modules_errstring (CHAR *s, LONGINT s__len)
+{
+ INT32 i;
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
+ Modules_errch(s[__X(i, s__len)]);
+ i += 1;
+ }
+ __DEL(s);
+}
+
+static void Modules_errint (INT32 l)
+{
+ if (l < 0) {
+ Modules_errch('-');
+ l = -l;
+ }
+ if (l >= 10) {
+ Modules_errint(__DIV(l, 10));
+ }
+ Modules_errch((CHAR)((int)__MOD(l, 10) + 48));
+}
+
+static void Modules_DisplayHaltCode (INT32 code)
+{
+ switch (code) {
+ case -1:
+ Modules_errstring((CHAR*)"Assertion failure.", 19);
+ break;
+ case -2:
+ Modules_errstring((CHAR*)"Index out of range.", 20);
+ break;
+ case -3:
+ Modules_errstring((CHAR*)"Reached end of function without reaching RETURN.", 49);
+ break;
+ case -4:
+ Modules_errstring((CHAR*)"CASE statement: no matching label and no ELSE.", 47);
+ break;
+ case -5:
+ Modules_errstring((CHAR*)"Type guard failed.", 19);
+ break;
+ case -6:
+ Modules_errstring((CHAR*)"Implicit type guard in record assignment failed.", 49);
+ break;
+ case -7:
+ Modules_errstring((CHAR*)"Invalid case in WITH statement.", 32);
+ break;
+ case -8:
+ Modules_errstring((CHAR*)"Value out of range.", 20);
+ break;
+ case -9:
+ Modules_errstring((CHAR*)"Heap interrupted while locked, but lockdepth = 0 at unlock.", 60);
+ break;
+ case -10:
+ Modules_errstring((CHAR*)"NIL access.", 12);
+ break;
+ case -11:
+ Modules_errstring((CHAR*)"Alignment error.", 17);
+ break;
+ case -12:
+ Modules_errstring((CHAR*)"Divide by zero.", 16);
+ break;
+ case -13:
+ Modules_errstring((CHAR*)"Arithmetic overflow/underflow.", 31);
+ break;
+ case -14:
+ Modules_errstring((CHAR*)"Invalid function argument.", 27);
+ break;
+ case -15:
+ Modules_errstring((CHAR*)"Internal error, e.g. Type descriptor size mismatch.", 52);
+ break;
+ case -20:
+ Modules_errstring((CHAR*)"Too many, or negative number of, elements in dynamic array.", 60);
+ break;
+ default:
+ break;
+ }
+}
+
+void Modules_Halt (INT32 code)
+{
+ Modules_errstring((CHAR*)"Terminated by Halt(", 20);
+ Modules_errint(code);
+ Modules_errstring((CHAR*)"). ", 4);
+ if (code < 0) {
+ Modules_DisplayHaltCode(code);
+ }
+ Modules_errstring(Platform_NL, 3);
+ Platform_Exit(code);
+}
+
+void Modules_AssertFail (INT32 code)
+{
+ Modules_errstring((CHAR*)"Assertion failure.", 19);
+ if (code != 0) {
+ Modules_errstring((CHAR*)" ASSERT code ", 14);
+ Modules_errint(code);
+ Modules_errstring((CHAR*)".", 2);
+ }
+ Modules_errstring(Platform_NL, 3);
+ 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)
{
__DEFMOD;
- __MODULE_IMPORT(Console);
__MODULE_IMPORT(Heap);
+ __MODULE_IMPORT(Platform);
__REGMOD("Modules", 0);
__INITYP(Modules_ModuleDesc, Modules_ModuleDesc, 0);
__INITYP(Modules_CmdDesc, Modules_CmdDesc, 0);
diff --git a/bootstrap/windows-48/Modules.h b/bootstrap/windows-48/Modules.h
index ac8ac89e..8bb89fe5 100644
--- a/bootstrap/windows-48/Modules.h
+++ b/bootstrap/windows-48/Modules.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Modules__h
#define Modules__h
@@ -28,27 +28,27 @@ typedef
struct Modules_ModuleDesc {
Modules_Module next;
Modules_ModuleName name;
- LONGINT refcnt;
+ INT32 refcnt;
Modules_Cmd cmds;
- LONGINT types;
- void (*enumPtrs)(void(*)(LONGINT));
+ INT32 types;
+ void (*enumPtrs)(void(*)(INT32));
char _prvt0[8];
} Modules_ModuleDesc;
-import INTEGER Modules_res;
+import INT16 Modules_res;
import CHAR Modules_resMsg[256];
import Modules_ModuleName Modules_imported, Modules_importing;
-import LONGINT *Modules_ModuleDesc__typ;
-import LONGINT *Modules_CmdDesc__typ;
+import ADDRESS *Modules_ModuleDesc__typ;
+import ADDRESS *Modules_CmdDesc__typ;
+import void Modules_AssertFail (INT32 code);
import void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
+import void Modules_Halt (INT32 code);
import Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
import Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
import void *Modules__init(void);
-#define Modules_modules() (Modules_Module)Heap_modules
-#define Modules_setmodules(m) Heap_modules = m
-#endif
+#endif // Modules
diff --git a/bootstrap/windows-48/OPB.c b/bootstrap/windows-48/OPB.c
index 0f614e6a..3ef8e2f9 100644
--- a/bootstrap/windows-48/OPB.c
+++ b/bootstrap/windows-48/OPB.c
@@ -1,18 +1,23 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "OPM.h"
#include "OPS.h"
#include "OPT.h"
-export void (*OPB_typSize)(OPT_Struct);
-static INTEGER OPB_exp;
-static LONGINT OPB_maxExp;
+static INT16 OPB_exp;
+static INT64 OPB_maxExp;
export void OPB_Assign (OPT_Node *x, OPT_Node y);
-static void OPB_BindNodes (SHORTINT class, OPT_Struct typ, OPT_Node *x, OPT_Node y);
-static LONGINT OPB_BoolToInt (BOOLEAN b);
+static void OPB_BindNodes (INT8 class, OPT_Struct typ, OPT_Node *x, OPT_Node y);
+static INT16 OPB_BoolToInt (BOOLEAN b);
export void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp);
static void OPB_CharToString (OPT_Node n);
static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode);
@@ -20,10 +25,10 @@ static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo);
export void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames);
static void OPB_CheckProc (OPT_Struct x, OPT_Object y);
static void OPB_CheckPtr (OPT_Node x, OPT_Node y);
-static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x);
+static void OPB_CheckRealType (INT16 f, INT16 nr, OPT_Const x);
static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp);
-static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y);
-export void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y);
+static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y);
+export void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y);
static void OPB_Convert (OPT_Node *x, OPT_Struct typ);
export void OPB_DeRef (OPT_Node *x);
static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar);
@@ -33,19 +38,17 @@ export void OPB_Field (OPT_Node *x, OPT_Object y);
export void OPB_In (OPT_Node *x, OPT_Node y);
export void OPB_Index (OPT_Node *x, OPT_Node y);
export void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ);
-static BOOLEAN OPB_IntToBool (LONGINT i);
-static OPT_Struct OPB_IntType (LONGINT size);
+static BOOLEAN OPB_IntToBool (INT64 i);
export void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y);
-static LONGINT OPB_LongerSize (LONGINT i);
-export void OPB_MOp (SHORTINT op, OPT_Node *x);
+export void OPB_MOp (INT8 op, OPT_Node *x);
export OPT_Node OPB_NewBoolConst (BOOLEAN boolval);
-export OPT_Node OPB_NewIntConst (LONGINT intval);
+export OPT_Node OPB_NewIntConst (INT64 intval);
export OPT_Node OPB_NewLeaf (OPT_Object obj);
export OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ);
-export OPT_Node OPB_NewString (OPS_String str, LONGINT len);
+export OPT_Node OPB_NewString (OPS_String str, INT64 len);
export OPT_Node OPB_Nil (void);
static BOOLEAN OPB_NotVar (OPT_Node x);
-export void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y);
+export void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y);
export void OPB_OptIf (OPT_Node *x);
export void OPB_Param (OPT_Node ap, OPT_Object fp);
export void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar);
@@ -53,26 +56,24 @@ export void OPB_Return (OPT_Node *x, OPT_Object proc);
export void OPB_SetElem (OPT_Node *x);
static void OPB_SetIntType (OPT_Node node);
export void OPB_SetRange (OPT_Node *x, OPT_Node y);
-static LONGINT OPB_ShorterSize (LONGINT i);
-static INTEGER OPB_SignedByteSize (LONGINT n);
-export void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno);
-export void OPB_StPar0 (OPT_Node *par0, INTEGER fctno);
-export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno);
-export void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n);
-export void OPB_StaticLink (SHORTINT dlev);
+static void OPB_SetSetType (OPT_Node node);
+export void OPB_StFct (OPT_Node *par0, INT8 fctno, INT16 parno);
+export void OPB_StPar0 (OPT_Node *par0, INT16 fctno);
+export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno);
+export void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n);
+export void OPB_StaticLink (INT8 dlev);
export void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard);
-static void OPB_err (INTEGER n);
-static LONGINT OPB_log (LONGINT x);
+static void OPB_err (INT16 n);
+static INT64 OPB_log (INT64 x);
-static void OPB_err (INTEGER n)
+static void OPB_err (INT16 n)
{
OPM_err(n);
}
OPT_Node OPB_NewLeaf (OPT_Object obj)
{
- OPT_Node _o_result;
OPT_Node node = NIL;
switch (obj->mode) {
case 1:
@@ -100,11 +101,10 @@ OPT_Node OPB_NewLeaf (OPT_Object obj)
}
node->obj = obj;
node->typ = obj->typ;
- _o_result = node;
- return _o_result;
+ return node;
}
-void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y)
+void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y)
{
OPT_Node node = NIL;
node = OPT_NewNode(class);
@@ -127,42 +127,29 @@ void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y)
*last = y;
}
-static LONGINT OPB_BoolToInt (BOOLEAN b)
+static INT16 OPB_BoolToInt (BOOLEAN b)
{
- LONGINT _o_result;
if (b) {
- _o_result = 1;
- return _o_result;
+ return 1;
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-static BOOLEAN OPB_IntToBool (LONGINT i)
+static BOOLEAN OPB_IntToBool (INT64 i)
{
- BOOLEAN _o_result;
- if (i == 0) {
- _o_result = 0;
- return _o_result;
- } else {
- _o_result = 1;
- return _o_result;
- }
- __RETCHK;
+ return i != 0;
}
OPT_Node OPB_NewBoolConst (BOOLEAN boolval)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->typ = OPT_booltyp;
x->conval = OPT_NewConst();
x->conval->intval = OPB_BoolToInt(boolval);
- _o_result = x;
- return _o_result;
+ return x;
}
void OPB_OptIf (OPT_Node *x)
@@ -202,130 +189,72 @@ void OPB_OptIf (OPT_Node *x)
OPT_Node OPB_Nil (void)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->typ = OPT_niltyp;
x->conval = OPT_NewConst();
x->conval->intval = 0;
- _o_result = x;
- return _o_result;
+ return x;
}
OPT_Node OPB_EmptySet (void)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->typ = OPT_settyp;
x->conval = OPT_NewConst();
x->conval->setval = 0x0;
- _o_result = x;
- return _o_result;
-}
-
-static INTEGER OPB_SignedByteSize (LONGINT n)
-{
- INTEGER _o_result;
- INTEGER b;
- if (n < 0) {
- n = -(n + 1);
- }
- b = 1;
- while ((b < 8 && __ASH(n, -(__ASHL(b, 3) - 1)) != 0)) {
- b += 1;
- }
- _o_result = b;
- return _o_result;
-}
-
-static LONGINT OPB_ShorterSize (LONGINT i)
-{
- LONGINT _o_result;
- if (i >= (int)OPM_LIntSize) {
- _o_result = OPM_IntSize;
- return _o_result;
- } else {
- _o_result = OPM_SIntSize;
- return _o_result;
- }
- __RETCHK;
-}
-
-static LONGINT OPB_LongerSize (LONGINT i)
-{
- LONGINT _o_result;
- if (i <= (int)OPM_SIntSize) {
- _o_result = OPM_IntSize;
- return _o_result;
- } else {
- _o_result = OPM_LIntSize;
- return _o_result;
- }
- __RETCHK;
-}
-
-static OPT_Struct OPB_IntType (LONGINT size)
-{
- OPT_Struct _o_result;
- OPT_Struct result = NIL;
- if (size <= OPT_sinttyp->size) {
- result = OPT_sinttyp;
- } else if (size <= OPT_inttyp->size) {
- result = OPT_inttyp;
- } else {
- result = OPT_linttyp;
- }
- if (size > OPT_linttyp->size) {
- OPB_err(203);
- }
- _o_result = result;
- return _o_result;
+ return x;
}
static void OPB_SetIntType (OPT_Node node)
{
- node->typ = OPB_IntType(OPB_SignedByteSize(node->conval->intval));
+ node->typ = OPT_IntType(OPT_IntSize(node->conval->intval));
}
-OPT_Node OPB_NewIntConst (LONGINT intval)
+static void OPB_SetSetType (OPT_Node node)
+{
+ INT32 i32;
+ __GET((ADDRESS)&node->conval->setval + 4, i32, INT32);
+ if (i32 == 0) {
+ node->typ = OPT_set32typ;
+ } else {
+ node->typ = OPT_set64typ;
+ }
+}
+
+OPT_Node OPB_NewIntConst (INT64 intval)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->conval = OPT_NewConst();
x->conval->intval = intval;
OPB_SetIntType(x);
- _o_result = x;
- return _o_result;
+ return x;
}
OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->conval = OPT_NewConst();
x->conval->realval = realval;
x->typ = typ;
x->conval->intval = -1;
- _o_result = x;
- return _o_result;
+ return x;
}
-OPT_Node OPB_NewString (OPS_String str, LONGINT len)
+OPT_Node OPB_NewString (OPS_String str, INT64 len)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->conval = OPT_NewConst();
x->typ = OPT_stringtyp;
x->conval->intval = -1;
- x->conval->intval2 = len;
+ x->conval->intval2 = OPM_Longint(len);
x->conval->ext = OPT_NewExt();
- __COPY(str, *x->conval->ext, ((LONGINT)(256)));
- _o_result = x;
- return _o_result;
+ __COPY(str, *x->conval->ext, 256);
+ return x;
}
static void OPB_CharToString (OPT_Node n)
@@ -345,7 +274,7 @@ static void OPB_CharToString (OPT_Node n)
n->obj = NIL;
}
-static void OPB_BindNodes (SHORTINT class, OPT_Struct typ, OPT_Node *x, OPT_Node y)
+static void OPB_BindNodes (INT8 class, OPT_Struct typ, OPT_Node *x, OPT_Node y)
{
OPT_Node node = NIL;
node = OPT_NewNode(class);
@@ -357,9 +286,7 @@ static void OPB_BindNodes (SHORTINT class, OPT_Struct typ, OPT_Node *x, OPT_Node
static BOOLEAN OPB_NotVar (OPT_Node x)
{
- BOOLEAN _o_result;
- _o_result = (x->class >= 7 && ((x->class != 11 || x->subcl != 29) || x->left->class >= 7));
- return _o_result;
+ return (x->class >= 7 && ((x->class != 11 || x->subcl != 29) || x->left->class >= 7));
}
void OPB_DeRef (OPT_Node *x)
@@ -369,7 +296,7 @@ void OPB_DeRef (OPT_Node *x)
typ = (*x)->typ;
if ((*x)->class >= 7) {
OPB_err(78);
- } else if (typ->form == 13) {
+ } else if (typ->form == 11) {
if (typ == OPT_sysptrtyp) {
OPB_err(57);
}
@@ -387,18 +314,18 @@ void OPB_DeRef (OPT_Node *x)
void OPB_Index (OPT_Node *x, OPT_Node y)
{
- INTEGER f;
+ INT16 f;
OPT_Struct typ = NIL;
f = y->typ->form;
if ((*x)->class >= 7) {
OPB_err(79);
- } else if (!__IN(f, 0x70) || __IN(y->class, 0x0300)) {
+ } else if (f != 4 || __IN(y->class, 0x0300, 32)) {
OPB_err(80);
y->typ = OPT_inttyp;
}
if ((*x)->typ->comp == 2) {
typ = (*x)->typ->BaseTyp;
- if ((y->class == 7 && (y->conval->intval < 0 || y->conval->intval >= (*x)->typ->n))) {
+ if ((y->class == 7 && (y->conval->intval < 0 || y->conval->intval >= (INT64)(*x)->typ->n))) {
OPB_err(81);
}
} else if ((*x)->typ->comp == 3) {
@@ -419,7 +346,7 @@ void OPB_Field (OPT_Node *x, OPT_Object y)
if ((*x)->class >= 7) {
OPB_err(77);
}
- if ((y != NIL && __IN(y->mode, 0x2010))) {
+ if ((y != NIL && __IN(y->mode, 0x2010, 32))) {
OPB_BindNodes(2, y->typ, &*x, NIL);
(*x)->obj = y;
(*x)->readonly = (*x)->left->readonly || (y->vis == 2 && y->mnolev < 0);
@@ -429,16 +356,16 @@ void OPB_Field (OPT_Node *x, OPT_Object y)
}
}
-static struct TypTest__61 {
+static struct TypTest__58 {
OPT_Node *x;
OPT_Object *obj;
BOOLEAN *guard;
- struct TypTest__61 *lnk;
-} *TypTest__61_s;
+ struct TypTest__58 *lnk;
+} *TypTest__58_s;
-static void GTT__62 (OPT_Struct t0, OPT_Struct t1);
+static void GTT__59 (OPT_Struct t0, OPT_Struct t1);
-static void GTT__62 (OPT_Struct t0, OPT_Struct t1)
+static void GTT__59 (OPT_Struct t0, OPT_Struct t1)
{
OPT_Node node = NIL;
OPT_Struct t = NIL;
@@ -451,54 +378,54 @@ static void GTT__62 (OPT_Struct t0, OPT_Struct t1)
t1 = t1->BaseTyp;
}
if (t1 == t0 || t0->form == 0) {
- if (*TypTest__61_s->guard) {
- OPB_BindNodes(5, NIL, &*TypTest__61_s->x, NIL);
- (*TypTest__61_s->x)->readonly = (*TypTest__61_s->x)->left->readonly;
+ if (*TypTest__58_s->guard) {
+ OPB_BindNodes(5, NIL, &*TypTest__58_s->x, NIL);
+ (*TypTest__58_s->x)->readonly = (*TypTest__58_s->x)->left->readonly;
} else {
node = OPT_NewNode(11);
node->subcl = 16;
- node->left = *TypTest__61_s->x;
- node->obj = *TypTest__61_s->obj;
- *TypTest__61_s->x = node;
+ node->left = *TypTest__58_s->x;
+ node->obj = *TypTest__58_s->obj;
+ *TypTest__58_s->x = node;
}
} else {
OPB_err(85);
}
} else if (t0 != t1) {
OPB_err(85);
- } else if (!*TypTest__61_s->guard) {
- if ((*TypTest__61_s->x)->class == 5) {
+ } else if (!*TypTest__58_s->guard) {
+ if ((*TypTest__58_s->x)->class == 5) {
node = OPT_NewNode(11);
node->subcl = 16;
- node->left = *TypTest__61_s->x;
- node->obj = *TypTest__61_s->obj;
- *TypTest__61_s->x = node;
+ node->left = *TypTest__58_s->x;
+ node->obj = *TypTest__58_s->obj;
+ *TypTest__58_s->x = node;
} else {
- *TypTest__61_s->x = OPB_NewBoolConst(1);
+ *TypTest__58_s->x = OPB_NewBoolConst(1);
}
}
}
void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
{
- struct TypTest__61 _s;
+ struct TypTest__58 _s;
_s.x = x;
_s.obj = &obj;
_s.guard = &guard;
- _s.lnk = TypTest__61_s;
- TypTest__61_s = &_s;
+ _s.lnk = TypTest__58_s;
+ TypTest__58_s = &_s;
if (OPB_NotVar(*x)) {
OPB_err(112);
- } else if ((*x)->typ->form == 13) {
+ } else if ((*x)->typ->form == 11) {
if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) {
OPB_err(85);
- } else if (obj->typ->form == 13) {
- GTT__62((*x)->typ->BaseTyp, obj->typ->BaseTyp);
+ } else if (obj->typ->form == 11) {
+ GTT__59((*x)->typ->BaseTyp, obj->typ->BaseTyp);
} else {
OPB_err(86);
}
} else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) {
- GTT__62((*x)->typ, obj->typ);
+ GTT__59((*x)->typ, obj->typ);
} else {
OPB_err(87);
}
@@ -507,23 +434,23 @@ void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
} else {
(*x)->typ = OPT_booltyp;
}
- TypTest__61_s = _s.lnk;
+ TypTest__58_s = _s.lnk;
}
void OPB_In (OPT_Node *x, OPT_Node y)
{
- INTEGER f;
- LONGINT k;
+ INT16 f;
+ INT64 k;
f = (*x)->typ->form;
if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) {
OPB_err(126);
- } else if ((__IN(f, 0x70) && y->typ->form == 9)) {
+ } else if ((f == 4 && y->typ->form == 7)) {
if ((*x)->class == 7) {
k = (*x)->conval->intval;
- if (k < 0 || k > (int)OPM_MaxSet) {
+ if (k < 0 || k >= (INT64)__ASHL(y->typ->size, 3)) {
OPB_err(202);
} else if (y->class == 7) {
- (*x)->conval->intval = OPB_BoolToInt(__IN(k, y->conval->setval));
+ (*x)->conval->intval = OPB_BoolToInt(__IN(k, y->conval->setval, 64));
(*x)->obj = NIL;
} else {
OPB_BindNodes(12, OPT_booltyp, &*x, y);
@@ -539,9 +466,8 @@ void OPB_In (OPT_Node *x, OPT_Node y)
(*x)->typ = OPT_booltyp;
}
-static LONGINT OPB_log (LONGINT x)
+static INT64 OPB_log (INT64 x)
{
- LONGINT _o_result;
OPB_exp = 0;
if (x > 0) {
while (!__ODD(x)) {
@@ -549,14 +475,13 @@ static LONGINT OPB_log (LONGINT x)
OPB_exp += 1;
}
}
- _o_result = x;
- return _o_result;
+ return x;
}
-static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x)
+static void OPB_CheckRealType (INT16 f, INT16 nr, OPT_Const x)
{
LONGREAL min, max, r;
- if (f == 7) {
+ if (f == 5) {
min = OPM_MinReal;
max = OPM_MaxReal;
} else {
@@ -567,38 +492,36 @@ static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x)
if (r > max || r < min) {
OPB_err(nr);
x->realval = (LONGREAL)1;
- } else if (f == 7) {
+ } else if (f == 5) {
x->realval = x->realval;
}
x->intval = -1;
}
-static struct MOp__30 {
- struct MOp__30 *lnk;
-} *MOp__30_s;
+static struct MOp__28 {
+ struct MOp__28 *lnk;
+} *MOp__28_s;
-static OPT_Node NewOp__31 (SHORTINT op, OPT_Struct typ, OPT_Node z);
+static OPT_Node NewOp__29 (INT8 op, OPT_Struct typ, OPT_Node z);
-static OPT_Node NewOp__31 (SHORTINT op, OPT_Struct typ, OPT_Node z)
+static OPT_Node NewOp__29 (INT8 op, OPT_Struct typ, OPT_Node z)
{
- OPT_Node _o_result;
OPT_Node node = NIL;
node = OPT_NewNode(11);
node->subcl = op;
node->typ = typ;
node->left = z;
- _o_result = node;
- return _o_result;
+ return node;
}
-void OPB_MOp (SHORTINT op, OPT_Node *x)
+void OPB_MOp (INT8 op, OPT_Node *x)
{
- INTEGER f;
+ INT16 f;
OPT_Struct typ = NIL;
OPT_Node z = NIL;
- struct MOp__30 _s;
- _s.lnk = MOp__30_s;
- MOp__30_s = &_s;
+ struct MOp__28 _s;
+ _s.lnk = MOp__28_s;
+ MOp__28_s = &_s;
z = *x;
if (z->class == 8 || z->class == 9) {
OPB_err(126);
@@ -612,45 +535,49 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval));
z->obj = NIL;
} else {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
}
} else {
OPB_err(98);
}
break;
case 6:
- if (!__IN(f, 0x01f0)) {
+ if (!__IN(f, 0x70, 32)) {
OPB_err(96);
}
break;
case 7:
- if (__IN(f, 0x03f0)) {
+ if (__IN(f, 0xf0, 32)) {
if (z->class == 7) {
- if (__IN(f, 0x70)) {
- if (z->conval->intval == (-2147483647-1)) {
+ if (f == 4) {
+ if (z->conval->intval == (-9223372036854775807-1)) {
OPB_err(203);
} else {
z->conval->intval = -z->conval->intval;
OPB_SetIntType(z);
}
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
z->conval->realval = -z->conval->realval;
} else {
- z->conval->setval = ~z->conval->setval;
+ if (z->typ->size == 8) {
+ z->conval->setval = ~z->conval->setval;
+ } else {
+ z->conval->setval = z->conval->setval ^ 0xffffffff;
+ }
}
z->obj = NIL;
} else {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
}
} else {
OPB_err(97);
}
break;
case 21:
- if (__IN(f, 0x01f0)) {
+ if (__IN(f, 0x70, 32)) {
if (z->class == 7) {
- if (__IN(f, 0x70)) {
- if (z->conval->intval == (-2147483647-1)) {
+ if (f == 4) {
+ if (z->conval->intval == (-9223372036854775807-1)) {
OPB_err(203);
} else {
z->conval->intval = __ABS(z->conval->intval);
@@ -661,7 +588,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
}
z->obj = NIL;
} else {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
}
} else {
OPB_err(111);
@@ -670,10 +597,10 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
case 22:
if (f == 3) {
if (z->class == 7) {
- z->conval->intval = (int)__CAP((CHAR)z->conval->intval);
+ z->conval->intval = (INT16)__CAP((CHAR)z->conval->intval);
z->obj = NIL;
} else {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
}
} else {
OPB_err(111);
@@ -681,12 +608,12 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
}
break;
case 23:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (z->class == 7) {
z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval));
z->obj = NIL;
} else {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
}
} else {
OPB_err(111);
@@ -696,19 +623,19 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
case 24:
if ((((z->class == 7 && f == 3)) && z->conval->intval >= 32)) {
OPB_CharToString(z);
- f = 10;
+ f = 8;
}
- if (z->class < 7 || f == 10) {
- z = NewOp__31(op, typ, z);
+ if (z->class < 7 || f == 8) {
+ z = NewOp__29(op, typ, z);
} else {
OPB_err(127);
}
- z->typ = OPT_linttyp;
+ z->typ = OPT_adrtyp;
break;
case 25:
- if ((__IN(f, 0x70) && z->class == 7)) {
+ if ((f == 4 && z->class == 7)) {
if ((0 <= z->conval->intval && z->conval->intval <= -1)) {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
} else {
OPB_err(219);
}
@@ -718,22 +645,22 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->typ = OPT_booltyp;
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.MOp, op = ", (LONGINT)33);
- OPM_LogWNum(op, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.MOp, op = ", 33);
+ OPM_LogWNum(op, 0);
OPM_LogWLn();
break;
}
}
*x = z;
- MOp__30_s = _s.lnk;
+ MOp__28_s = _s.lnk;
}
static void OPB_CheckPtr (OPT_Node x, OPT_Node y)
{
- INTEGER g;
+ INT16 g;
OPT_Struct p = NIL, q = NIL, t = NIL;
g = y->typ->form;
- if (g == 13) {
+ if (g == 11) {
p = x->typ->BaseTyp;
q = y->typ->BaseTyp;
if ((p->comp == 4 && q->comp == 4)) {
@@ -751,7 +678,7 @@ static void OPB_CheckPtr (OPT_Node x, OPT_Node y)
} else {
OPB_err(100);
}
- } else if (g != 11) {
+ } else if (g != 9) {
OPB_err(100);
}
}
@@ -768,7 +695,7 @@ void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames)
at = at->BaseTyp;
}
if (ft != at) {
- if ((ft->form == 14 && at->form == 14)) {
+ if ((ft->form == 12 && at->form == 12)) {
if (ft->BaseTyp == at->BaseTyp) {
OPB_CheckParameters(ft->link, at->link, 0);
} else {
@@ -794,7 +721,7 @@ void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames)
static void OPB_CheckProc (OPT_Struct x, OPT_Object y)
{
- if (__IN(y->mode, 0x04c0)) {
+ if (__IN(y->mode, 0x04c0, 32)) {
if (y->mode == 6) {
if (y->mnolev == 0) {
y->mode = 7;
@@ -814,22 +741,21 @@ static void OPB_CheckProc (OPT_Struct x, OPT_Object y)
static struct ConstOp__13 {
OPT_Node *x;
- INTEGER *f;
+ INT16 *f;
OPT_Const *xval, *yval;
struct ConstOp__13 *lnk;
} *ConstOp__13_s;
-static INTEGER ConstCmp__14 (void);
+static INT16 ConstCmp__14 (void);
-static INTEGER ConstCmp__14 (void)
+static INT16 ConstCmp__14 (void)
{
- INTEGER _o_result;
- INTEGER res;
+ INT16 res;
switch (*ConstOp__13_s->f) {
case 0:
res = 9;
break;
- case 1: case 3: case 4: case 5: case 6:
+ case 1: case 3: case 4:
if ((*ConstOp__13_s->xval)->intval < (*ConstOp__13_s->yval)->intval) {
res = 11;
} else if ((*ConstOp__13_s->xval)->intval > (*ConstOp__13_s->yval)->intval) {
@@ -838,7 +764,7 @@ static INTEGER ConstCmp__14 (void)
res = 9;
}
break;
- case 7: case 8:
+ case 5: case 6:
if ((*ConstOp__13_s->xval)->realval < (*ConstOp__13_s->yval)->realval) {
res = 11;
} else if ((*ConstOp__13_s->xval)->realval > (*ConstOp__13_s->yval)->realval) {
@@ -854,14 +780,14 @@ static INTEGER ConstCmp__14 (void)
res = 9;
}
break;
- case 9:
+ case 7:
if ((*ConstOp__13_s->xval)->setval != (*ConstOp__13_s->yval)->setval) {
res = 10;
} else {
res = 9;
}
break;
- case 10:
+ case 8:
if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) < 0) {
res = 11;
} else if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) > 0) {
@@ -870,7 +796,7 @@ static INTEGER ConstCmp__14 (void)
res = 9;
}
break;
- case 11: case 13: case 14:
+ case 9: case 11: case 12:
if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) {
res = 10;
} else {
@@ -878,21 +804,20 @@ static INTEGER ConstCmp__14 (void)
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstCmp, f = ", (LONGINT)37);
- OPM_LogWNum(*ConstOp__13_s->f, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstCmp, f = ", 37);
+ OPM_LogWNum(*ConstOp__13_s->f, 0);
OPM_LogWLn();
break;
}
(*ConstOp__13_s->x)->typ = OPT_booltyp;
- _o_result = res;
- return _o_result;
+ return res;
}
-static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
+static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
{
- INTEGER f, g;
+ INT16 f, g;
OPT_Const xval = NIL, yval = NIL;
- LONGINT xv, yv;
+ INT64 xv, yv;
BOOLEAN temp;
struct ConstOp__13 _s;
_s.x = &x;
@@ -908,7 +833,7 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
if (f != g) {
switch (f) {
case 3:
- if (g == 10) {
+ if (g == 8) {
OPB_CharToString(x);
} else {
OPB_err(100);
@@ -916,17 +841,17 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
- case 4: case 5: case 6:
- if (__IN(g, 0x70)) {
+ case 4:
+ if (g == 4) {
if (x->typ->size <= y->typ->size) {
x->typ = y->typ;
} else {
- x->typ = OPB_IntType(x->typ->size);
+ x->typ = OPT_IntType(x->typ->size);
}
- } else if (g == 7) {
+ } else if (g == 5) {
x->typ = OPT_realtyp;
xval->realval = xval->intval;
- } else if (g == 8) {
+ } else if (g == 6) {
x->typ = OPT_lrltyp;
xval->realval = xval->intval;
} else {
@@ -935,11 +860,11 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
- case 7:
- if (__IN(g, 0x70)) {
+ case 5:
+ if (g == 4) {
y->typ = x->typ;
yval->realval = yval->intval;
- } else if (g == 8) {
+ } else if (g == 6) {
x->typ = OPT_lrltyp;
} else {
OPB_err(100);
@@ -947,11 +872,11 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
- case 8:
- if (__IN(g, 0x70)) {
+ case 6:
+ if (g == 4) {
y->typ = x->typ;
yval->realval = yval->intval;
- } else if (g == 7) {
+ } else if (g == 5) {
y->typ = OPT_lrltyp;
} else {
OPB_err(100);
@@ -959,26 +884,26 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
- case 10:
+ case 8:
if (g == 3) {
OPB_CharToString(y);
- g = 10;
+ g = 8;
} else {
OPB_err(100);
y->typ = x->typ;
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
- case 11:
- if (!__IN(g, 0x6000)) {
+ case 9:
+ if (!__IN(g, 0x1800, 32)) {
OPB_err(100);
}
break;
- case 13:
+ case 11:
OPB_CheckPtr(x, y);
break;
- case 14:
- if (g != 11) {
+ case 12:
+ if (g != 9) {
OPB_err(100);
}
break;
@@ -992,16 +917,16 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
}
switch (op) {
case 1:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
xv = xval->intval;
yv = yval->intval;
- if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(2147483647, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-2147483647-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-2147483647-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-2147483647-1))) && yv != (-2147483647-1))) && -xv <= __DIV(2147483647, -yv))) {
+ if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807-1))) && yv != (-9223372036854775807-1))) && -xv <= __DIV(9223372036854775807, -yv))) {
xval->intval = xv * yv;
OPB_SetIntType(x);
} else {
OPB_err(204);
}
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
temp = __ABS(yval->realval) <= (LONGREAL)1;
if (temp || __ABS(xval->realval) <= 1.79769296342094e+308 / (LONGREAL)__ABS(yval->realval)) {
xval->realval = xval->realval * yval->realval;
@@ -1009,23 +934,24 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
} else {
OPB_err(204);
}
- } else if (f == 9) {
+ } else if (f == 7) {
xval->setval = (xval->setval & yval->setval);
+ OPB_SetSetType(x);
} else if (f != 0) {
OPB_err(101);
}
break;
case 2:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (yval->intval != 0) {
xval->realval = xval->intval / (REAL)yval->intval;
- OPB_CheckRealType(7, 205, xval);
+ OPB_CheckRealType(5, 205, xval);
} else {
OPB_err(205);
xval->realval = (LONGREAL)1;
}
x->typ = OPT_realtyp;
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
temp = __ABS(yval->realval) >= (LONGREAL)1;
if (temp || __ABS(xval->realval) <= 1.79769296342094e+308 * __ABS(yval->realval)) {
xval->realval = xval->realval / yval->realval;
@@ -1033,14 +959,15 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
} else {
OPB_err(205);
}
- } else if (f == 9) {
+ } else if (f == 7) {
xval->setval = xval->setval ^ yval->setval;
+ OPB_SetSetType(x);
} else if (f != 0) {
OPB_err(102);
}
break;
case 3:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (yval->intval != 0) {
xval->intval = __DIV(xval->intval, yval->intval);
OPB_SetIntType(x);
@@ -1052,7 +979,7 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
}
break;
case 4:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (yval->intval != 0) {
xval->intval = __MOD(xval->intval, yval->intval);
OPB_SetIntType(x);
@@ -1071,15 +998,15 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
}
break;
case 6:
- if (__IN(f, 0x70)) {
- temp = (yval->intval >= 0 && xval->intval <= 2147483647 - yval->intval);
- if (temp || (yval->intval < 0 && xval->intval >= (-2147483647-1) - yval->intval)) {
+ if (f == 4) {
+ temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807 - yval->intval);
+ if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807-1) - yval->intval)) {
xval->intval += yval->intval;
OPB_SetIntType(x);
} else {
OPB_err(206);
}
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
temp = (yval->realval >= (LONGREAL)0 && xval->realval <= 1.79769296342094e+308 - yval->realval);
if (temp || (yval->realval < (LONGREAL)0 && xval->realval >= -1.79769296342094e+308 - yval->realval)) {
xval->realval = xval->realval + yval->realval;
@@ -1087,21 +1014,22 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
} else {
OPB_err(206);
}
- } else if (f == 9) {
+ } else if (f == 7) {
xval->setval = xval->setval | yval->setval;
+ OPB_SetSetType(x);
} else if (f != 0) {
OPB_err(105);
}
break;
case 7:
- if (__IN(f, 0x70)) {
- if ((yval->intval >= 0 && xval->intval >= (-2147483647-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 2147483647 + yval->intval)) {
+ if (f == 4) {
+ if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807 + yval->intval)) {
xval->intval -= yval->intval;
OPB_SetIntType(x);
} else {
OPB_err(207);
}
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
temp = (yval->realval >= (LONGREAL)0 && xval->realval >= -1.79769296342094e+308 + yval->realval);
if (temp || (yval->realval < (LONGREAL)0 && xval->realval <= 1.79769296342094e+308 + yval->realval)) {
xval->realval = xval->realval - yval->realval;
@@ -1109,8 +1037,9 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
} else {
OPB_err(207);
}
- } else if (f == 9) {
+ } else if (f == 7) {
xval->setval = (xval->setval & ~yval->setval);
+ OPB_SetSetType(x);
} else if (f != 0) {
OPB_err(106);
}
@@ -1129,36 +1058,36 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
xval->intval = OPB_BoolToInt(ConstCmp__14() != 9);
break;
case 11:
- if (__IN(f, 0x2a04)) {
+ if (__IN(f, 0x0a84, 32)) {
OPB_err(108);
} else {
xval->intval = OPB_BoolToInt(ConstCmp__14() == 11);
}
break;
case 12:
- if (__IN(f, 0x2a04)) {
+ if (__IN(f, 0x0a84, 32)) {
OPB_err(108);
} else {
xval->intval = OPB_BoolToInt(ConstCmp__14() != 13);
}
break;
case 13:
- if (__IN(f, 0x2a04)) {
+ if (__IN(f, 0x0a84, 32)) {
OPB_err(108);
} else {
xval->intval = OPB_BoolToInt(ConstCmp__14() == 13);
}
break;
case 14:
- if (__IN(f, 0x2a04)) {
+ if (__IN(f, 0x0a84, 32)) {
OPB_err(108);
} else {
xval->intval = OPB_BoolToInt(ConstCmp__14() != 11);
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstOp, op = ", (LONGINT)37);
- OPM_LogWNum(op, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstOp, op = ", 37);
+ OPM_LogWNum(op, 0);
OPM_LogWLn();
break;
}
@@ -1168,22 +1097,28 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
{
OPT_Node node = NIL;
- INTEGER f, g;
- LONGINT k;
+ INT16 f, g;
+ INT64 k;
LONGREAL r;
f = (*x)->typ->form;
g = typ->form;
if ((*x)->class == 7) {
- if (__IN(f, 0x70)) {
- if (__IN(g, 0x70)) {
- if (f > g) {
+ if ((((f == 7 && g == 7)) && (*x)->typ->size > typ->size)) {
+ OPB_SetSetType(*x);
+ if ((*x)->typ->size > typ->size) {
+ OPB_err(203);
+ (*x)->conval->setval = 0x0;
+ }
+ } else if (f == 4) {
+ if (g == 4) {
+ if ((*x)->typ->size > typ->size) {
OPB_SetIntType(*x);
- if ((int)(*x)->typ->form > g) {
+ if ((*x)->typ->size > typ->size) {
OPB_err(203);
(*x)->conval->intval = 1;
}
}
- } else if (__IN(g, 0x0180)) {
+ } else if (__IN(g, 0x60, 32)) {
(*x)->conval->realval = (*x)->conval->intval;
(*x)->conval->intval = -1;
} else {
@@ -1192,21 +1127,21 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
OPB_err(220);
}
}
- } else if (__IN(f, 0x0180)) {
- if (__IN(g, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
+ if (__IN(g, 0x60, 32)) {
OPB_CheckRealType(g, 203, (*x)->conval);
} else {
r = (*x)->conval->realval;
- if (r < -2.14748364800000e+009 || r > 2.14748364700000e+009) {
+ if (r < -9.22337203685478e+018 || r > 9.22337203685478e+018) {
OPB_err(203);
r = (LONGREAL)1;
}
- (*x)->conval->intval = (int)__ENTIER(r);
+ (*x)->conval->intval = (INT32)__ENTIER(r);
OPB_SetIntType(*x);
}
}
(*x)->obj = NIL;
- } else if (((((*x)->class == 11 && (*x)->subcl == 20)) && ((int)(*x)->left->typ->form < f || f > g))) {
+ } else if (((((*x)->class == 11 && (*x)->subcl == 20)) && ((INT16)(*x)->left->typ->form < f || f > g))) {
if ((*x)->left->typ == typ) {
*x = (*x)->left;
}
@@ -1219,15 +1154,15 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
(*x)->typ = typ;
}
-static struct Op__40 {
- INTEGER *f, *g;
- struct Op__40 *lnk;
-} *Op__40_s;
+static struct Op__38 {
+ INT16 *f, *g;
+ struct Op__38 *lnk;
+} *Op__38_s;
-static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y);
-static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y);
+static void NewOp__39 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y);
+static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y);
-static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
+static void NewOp__39 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
{
OPT_Node node = NIL;
node = OPT_NewNode(12);
@@ -1238,50 +1173,48 @@ static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
*x = node;
}
-static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y)
+static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y)
{
- BOOLEAN _o_result;
BOOLEAN ok, xCharArr, yCharArr;
- xCharArr = (__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp->form == 3) || *Op__40_s->f == 10;
- yCharArr = (__IN((*y)->typ->comp, 0x0c) && (*y)->typ->BaseTyp->form == 3) || *Op__40_s->g == 10;
- if ((((xCharArr && *Op__40_s->g == 3)) && (*y)->class == 7)) {
+ xCharArr = (__IN((*x)->typ->comp, 0x0c, 32) && (*x)->typ->BaseTyp->form == 3) || *Op__38_s->f == 8;
+ yCharArr = (__IN((*y)->typ->comp, 0x0c, 32) && (*y)->typ->BaseTyp->form == 3) || *Op__38_s->g == 8;
+ if ((((xCharArr && *Op__38_s->g == 3)) && (*y)->class == 7)) {
OPB_CharToString(*y);
- *Op__40_s->g = 10;
+ *Op__38_s->g = 8;
yCharArr = 1;
}
- if ((((yCharArr && *Op__40_s->f == 3)) && (*x)->class == 7)) {
+ if ((((yCharArr && *Op__38_s->f == 3)) && (*x)->class == 7)) {
OPB_CharToString(*x);
- *Op__40_s->f = 10;
+ *Op__38_s->f = 8;
xCharArr = 1;
}
ok = (xCharArr && yCharArr);
if (ok) {
- if ((*Op__40_s->f == 10 && (*x)->conval->intval2 == 1)) {
+ if ((*Op__38_s->f == 8 && (*x)->conval->intval2 == 1)) {
(*x)->typ = OPT_chartyp;
(*x)->conval->intval = 0;
- OPB_Index(&*y, OPB_NewIntConst(((LONGINT)(0))));
- } else if ((*Op__40_s->g == 10 && (*y)->conval->intval2 == 1)) {
+ OPB_Index(&*y, OPB_NewIntConst(0));
+ } else if ((*Op__38_s->g == 8 && (*y)->conval->intval2 == 1)) {
(*y)->typ = OPT_chartyp;
(*y)->conval->intval = 0;
- OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0))));
+ OPB_Index(&*x, OPB_NewIntConst(0));
}
}
- _o_result = ok;
- return _o_result;
+ return ok;
}
-void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
+void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
{
- INTEGER f, g;
+ INT16 f, g;
OPT_Node t = NIL, z = NIL;
OPT_Struct typ = NIL;
BOOLEAN do_;
- LONGINT val;
- struct Op__40 _s;
+ INT64 val;
+ struct Op__38 _s;
_s.f = &f;
_s.g = &g;
- _s.lnk = Op__40_s;
- Op__40_s = &_s;
+ _s.lnk = Op__38_s;
+ Op__38_s = &_s;
z = *x;
if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) {
OPB_err(126);
@@ -1299,49 +1232,58 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(100);
}
break;
- case 4: case 5: case 6:
- if ((__IN(g, 0x70) && y->typ->size < z->typ->size)) {
+ case 4:
+ if ((g == 4 && y->typ->size < z->typ->size)) {
OPB_Convert(&y, z->typ);
- } else if (__IN(g, 0x01f0)) {
+ } else if (__IN(g, 0x70, 32)) {
OPB_Convert(&z, y->typ);
} else {
OPB_err(100);
}
break;
case 7:
- if (__IN(g, 0x70)) {
+ if ((g == 7 && y->typ->size < z->typ->size)) {
OPB_Convert(&y, z->typ);
- } else if (__IN(g, 0x0180)) {
+ } else if (g == 7) {
OPB_Convert(&z, y->typ);
} else {
OPB_err(100);
}
break;
- case 8:
- if (__IN(g, 0x01f0)) {
+ case 5:
+ if (g == 4) {
OPB_Convert(&y, z->typ);
- } else if (__IN(g, 0x0180)) {
+ } else if (__IN(g, 0x60, 32)) {
+ OPB_Convert(&z, y->typ);
+ } else {
+ OPB_err(100);
+ }
+ break;
+ case 6:
+ if (__IN(g, 0x70, 32)) {
+ OPB_Convert(&y, z->typ);
+ } else if (__IN(g, 0x60, 32)) {
OPB_Convert(&y, z->typ);
} else {
OPB_err(100);
}
break;
- case 11:
- if (!__IN(g, 0x6000)) {
+ case 9:
+ if (!__IN(g, 0x1800, 32)) {
OPB_err(100);
}
break;
- case 13:
+ case 11:
OPB_CheckPtr(z, y);
break;
- case 14:
- if (g != 11) {
+ case 12:
+ if (g != 9) {
OPB_err(100);
}
break;
- case 10:
+ case 8:
break;
- case 15:
+ case 13:
if (z->typ->comp == 4) {
OPB_err(100);
}
@@ -1357,7 +1299,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
switch (op) {
case 1:
do_ = 1;
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (z->class == 7) {
val = z->conval->intval;
if (val == 1) {
@@ -1388,35 +1330,35 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
y->obj = NIL;
}
}
- } else if (!__IN(f, 0x0381)) {
+ } else if (!__IN(f, 0xe1, 32)) {
OPB_err(105);
typ = OPT_undftyp;
}
if (do_) {
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
}
break;
case 2:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if ((y->class == 7 && y->conval->intval == 0)) {
OPB_err(205);
}
OPB_Convert(&z, OPT_realtyp);
OPB_Convert(&y, OPT_realtyp);
typ = OPT_realtyp;
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
if ((y->class == 7 && y->conval->realval == (LONGREAL)0)) {
OPB_err(205);
}
- } else if ((f != 9 && f != 0)) {
+ } else if ((f != 7 && f != 0)) {
OPB_err(102);
typ = OPT_undftyp;
}
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
break;
case 3:
do_ = 1;
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (y->class == 7) {
val = y->conval->intval;
if (val == 0) {
@@ -1435,11 +1377,11 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp;
}
if (do_) {
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
}
break;
case 4:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (y->class == 7) {
if (y->conval->intval == 0) {
OPB_err(205);
@@ -1453,7 +1395,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(104);
typ = OPT_undftyp;
}
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
break;
case 5:
if (f == 2) {
@@ -1463,7 +1405,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
} else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) {
} else {
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
}
} else if (f != 0) {
OPB_err(94);
@@ -1471,12 +1413,12 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
break;
case 6:
- if (!__IN(f, 0x03f1)) {
+ if (!__IN(f, 0xf1, 32)) {
OPB_err(105);
typ = OPT_undftyp;
}
do_ = 1;
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if ((z->class == 7 && z->conval->intval == 0)) {
do_ = 0;
z = y;
@@ -1486,16 +1428,16 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
}
if (do_) {
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
}
break;
case 7:
- if (!__IN(f, 0x03f1)) {
+ if (!__IN(f, 0xf1, 32)) {
OPB_err(106);
typ = OPT_undftyp;
}
- if ((!__IN(f, 0x70) || y->class != 7) || y->conval->intval != 0) {
- NewOp__41(op, typ, &z, y);
+ if ((f != 4 || y->class != 7) || y->conval->intval != 0) {
+ NewOp__39(op, typ, &z, y);
}
break;
case 8:
@@ -1506,7 +1448,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
} else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) {
} else {
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
}
} else if (f != 0) {
OPB_err(95);
@@ -1514,61 +1456,62 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
break;
case 9: case 10:
- if (__IN(f, 0x6bff) || strings__43(&z, &y)) {
+ if (__IN(f, 0x1aff, 32) || strings__41(&z, &y)) {
typ = OPT_booltyp;
} else {
OPB_err(107);
typ = OPT_undftyp;
}
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
break;
case 11: case 12: case 13: case 14:
- if (__IN(f, 0x01f9) || strings__43(&z, &y)) {
+ if (__IN(f, 0x79, 32) || strings__41(&z, &y)) {
typ = OPT_booltyp;
} else {
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"ELSE in Op()", (LONGINT)13);
+ OPM_LogWStr((CHAR*)"ELSE in Op()", 13);
OPM_LogWLn();
OPB_err(108);
typ = OPT_undftyp;
}
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", (LONGINT)32);
- OPM_LogWNum(op, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", 32);
+ OPM_LogWNum(op, 0);
OPM_LogWLn();
break;
}
}
*x = z;
- Op__40_s = _s.lnk;
+ Op__38_s = _s.lnk;
}
void OPB_SetRange (OPT_Node *x, OPT_Node y)
{
- LONGINT k, l;
+ INT64 k, l;
if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) {
OPB_err(126);
- } else if ((__IN((*x)->typ->form, 0x70) && __IN(y->typ->form, 0x70))) {
+ } else if (((*x)->typ->form == 4 && y->typ->form == 4)) {
if ((*x)->class == 7) {
k = (*x)->conval->intval;
- if (0 > k || k > (int)OPM_MaxSet) {
+ if (0 > k || k > 63) {
OPB_err(202);
}
}
if (y->class == 7) {
l = y->conval->intval;
- if (0 > l || l > (int)OPM_MaxSet) {
+ if (0 > l || l > 63) {
OPB_err(202);
}
}
if (((*x)->class == 7 && y->class == 7)) {
if (k <= l) {
- (*x)->conval->setval = __SETRNG(k, l);
+ (*x)->conval->setval = __SETRNG(k, l, 32);
+ OPB_SetSetType(*x);
} else {
OPB_err(201);
- (*x)->conval->setval = __SETRNG(l, k);
+ (*x)->conval->setval = __SETRNG(l, k, 32);
}
(*x)->obj = NIL;
} else {
@@ -1582,86 +1525,69 @@ void OPB_SetRange (OPT_Node *x, OPT_Node y)
void OPB_SetElem (OPT_Node *x)
{
- LONGINT k;
+ INT64 k;
if ((*x)->class == 8 || (*x)->class == 9) {
OPB_err(126);
- } else if (!__IN((*x)->typ->form, 0x70)) {
+ } else if ((*x)->typ->form != 4) {
OPB_err(93);
} else if ((*x)->class == 7) {
k = (*x)->conval->intval;
- if ((0 <= k && k <= (int)OPM_MaxSet)) {
- (*x)->conval->setval = __SETOF(k);
+ if ((0 <= k && k <= 63)) {
+ (*x)->conval->setval = 0x0;
+ (*x)->conval->setval |= __SETOF(k,64);
} else {
OPB_err(202);
}
+ OPB_SetSetType(*x);
(*x)->obj = NIL;
} else {
OPB_Convert(&*x, OPT_settyp);
+ (*x)->typ = OPT_settyp;
}
- (*x)->typ = OPT_settyp;
}
static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
{
OPT_Struct y = NIL;
- INTEGER f, g;
+ INT16 f, g;
OPT_Struct p = NIL, q = NIL;
- if (OPM_Verbose) {
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"PROCEDURE CheckAssign", (LONGINT)22);
- OPM_LogWLn();
- }
y = ynode->typ;
f = x->form;
g = y->form;
- if (OPM_Verbose) {
- OPM_LogWStr((CHAR*)"y.form = ", (LONGINT)10);
- OPM_LogWNum(y->form, ((LONGINT)(0)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"f = ", (LONGINT)5);
- OPM_LogWNum(f, ((LONGINT)(0)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"g = ", (LONGINT)5);
- OPM_LogWNum(g, ((LONGINT)(0)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"ynode.typ.syze = ", (LONGINT)18);
- OPM_LogWNum(ynode->typ->size, ((LONGINT)(0)));
- OPM_LogWLn();
- }
- if (ynode->class == 8 || (ynode->class == 9 && f != 14)) {
+ if (ynode->class == 8 || (ynode->class == 9 && f != 12)) {
OPB_err(126);
}
switch (f) {
- case 0: case 10:
+ case 0: case 8:
break;
case 1:
- if (!((__IN(g, 0x7a) && y->size == 1))) {
+ if (!((__IN(g, 0x1a, 32) && y->size == 1))) {
OPB_err(113);
}
break;
- case 2: case 3: case 9:
+ case 2: case 3:
if (g != f) {
OPB_err(113);
}
break;
- case 4: case 5: case 6:
- if (!__IN(g, 0x70) || x->size < y->size) {
+ case 4: case 7:
+ if (g != f || x->size < y->size) {
OPB_err(113);
}
break;
- case 7:
- if (!__IN(g, 0xf0)) {
+ case 5:
+ if (!__IN(g, 0x30, 32)) {
OPB_err(113);
}
break;
- case 8:
- if (!__IN(g, 0x01f0)) {
+ case 6:
+ if (!__IN(g, 0x70, 32)) {
OPB_err(113);
}
break;
- case 13:
- if ((x == y || g == 11) || (x == OPT_sysptrtyp && g == 13)) {
- } else if (g == 13) {
+ case 11:
+ if ((x == y || g == 9) || (x == OPT_sysptrtyp && g == 11)) {
+ } else if (g == 11) {
p = x->BaseTyp;
q = y->BaseTyp;
if ((p->comp == 4 && q->comp == 4)) {
@@ -1678,32 +1604,32 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
OPB_err(113);
}
break;
- case 14:
+ case 12:
if (ynode->class == 9) {
OPB_CheckProc(x, ynode->obj);
- } else if (x == y || g == 11) {
+ } else if (x == y || g == 9) {
} else {
OPB_err(113);
}
break;
- case 12: case 11:
+ case 10: case 9:
OPB_err(113);
break;
- case 15:
+ case 13:
x->pvused = 1;
if (x->comp == 2) {
if ((ynode->class == 7 && g == 3)) {
OPB_CharToString(ynode);
y = ynode->typ;
- g = 10;
+ g = 8;
}
if (x == y) {
} else if (x->BaseTyp == OPT_chartyp) {
- if (g == 10) {
+ if (g == 8) {
if (ynode->conval->intval2 > x->n) {
OPB_err(114);
}
- } else if ((__IN(y->comp, 0x0c) && y->BaseTyp == OPT_chartyp)) {
+ } else if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
} else {
OPB_err(113);
}
@@ -1711,7 +1637,7 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
OPB_err(113);
}
} else if ((x->comp == 3 && x->BaseTyp == OPT_chartyp)) {
- if ((__IN(y->comp, 0x0c) && y->BaseTyp == OPT_chartyp)) {
+ if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
} else {
OPB_err(113);
}
@@ -1733,12 +1659,12 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.CheckAssign, f = ", (LONGINT)40);
- OPM_LogWNum(f, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.CheckAssign, f = ", 40);
+ OPM_LogWNum(f, 0);
OPM_LogWLn();
break;
}
- if ((((((ynode->class == 7 && g < f)) && __IN(g, 0xf0))) && __IN(f, 0x01e0))) {
+ if ((((((ynode->class == 7 && g < f)) && __IN(g, 0x30, 32))) && __IN(f, 0x70, 32))) {
OPB_Convert(&ynode, x);
}
}
@@ -1747,16 +1673,16 @@ static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo)
{
}
-void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
+void OPB_StPar0 (OPT_Node *par0, INT16 fctno)
{
- INTEGER f;
+ INT16 f;
OPT_Struct typ = NIL;
OPT_Node x = NIL;
x = *par0;
f = x->typ->form;
switch (fctno) {
case 0:
- if ((__IN(f, 0x70) && x->class == 7)) {
+ if ((f == 4 && x->class == 7)) {
if ((0 <= x->conval->intval && x->conval->intval <= 255)) {
OPB_BindNodes(28, OPT_notyp, &x, x);
} else {
@@ -1771,12 +1697,12 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
typ = OPT_notyp;
if (OPB_NotVar(x)) {
OPB_err(112);
- } else if (f == 13) {
+ } else if (f == 11) {
if (x->readonly) {
OPB_err(76);
}
f = x->typ->BaseTyp->comp;
- if (__IN(f, 0x1c)) {
+ if (__IN(f, 0x1c, 32)) {
if (f == 3) {
typ = x->typ->BaseTyp;
}
@@ -1809,7 +1735,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 5:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
OPB_Convert(&x, OPT_linttyp);
} else {
OPB_err(111);
@@ -1826,20 +1752,20 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
x = OPB_NewBoolConst(0);
break;
case 3:
- x = OPB_NewIntConst(((LONGINT)(0)));
+ x = OPB_NewIntConst(0);
x->typ = OPT_chartyp;
break;
- case 4: case 5: case 6:
+ case 4:
x = OPB_NewIntConst(OPM_SignedMinimum(x->typ->size));
break;
- case 9:
- x = OPB_NewIntConst(((LONGINT)(0)));
+ case 7:
+ x = OPB_NewIntConst(0);
x->typ = OPT_inttyp;
break;
- case 7:
+ case 5:
x = OPB_NewRealConst(OPM_MinReal, OPT_realtyp);
break;
- case 8:
+ case 6:
x = OPB_NewRealConst(OPM_MinLReal, OPT_lrltyp);
break;
default:
@@ -1857,20 +1783,20 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
x = OPB_NewBoolConst(1);
break;
case 3:
- x = OPB_NewIntConst(((LONGINT)(255)));
+ x = OPB_NewIntConst(255);
x->typ = OPT_chartyp;
break;
- case 4: case 5: case 6:
+ case 4:
x = OPB_NewIntConst(OPM_SignedMaximum(x->typ->size));
break;
- case 9:
- x = OPB_NewIntConst(OPM_MaxSet);
+ case 7:
+ x = OPB_NewIntConst(__ASHL(x->typ->size, 3) - 1);
x->typ = OPT_inttyp;
break;
- case 7:
+ case 5:
x = OPB_NewRealConst(OPM_MaxReal, OPT_realtyp);
break;
- case 8:
+ case 6:
x = OPB_NewRealConst(OPM_MaxLReal, OPT_lrltyp);
break;
default:
@@ -1884,7 +1810,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 9:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x71)) {
+ } else if (__IN(f, 0x11, 32)) {
OPB_Convert(&x, OPT_chartyp);
} else {
OPB_err(111);
@@ -1894,9 +1820,14 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 10:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if ((__IN(f, 0x70) && x->typ->size > (int)OPM_SIntSize)) {
- OPB_Convert(&x, OPB_IntType(OPB_ShorterSize(x->typ->size)));
- } else if (f == 8) {
+ } else if (f == 4) {
+ typ = OPT_ShorterOrLongerType(x->typ, -1);
+ if (typ == NIL) {
+ OPB_err(111);
+ } else {
+ OPB_Convert(&x, typ);
+ }
+ } else if (f == 6) {
OPB_Convert(&x, OPT_realtyp);
} else {
OPB_err(111);
@@ -1905,9 +1836,14 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 11:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if ((__IN(f, 0x70) && x->typ->size < (int)OPM_LIntSize)) {
- OPB_Convert(&x, OPB_IntType(OPB_LongerSize(x->typ->size)));
- } else if (f == 7) {
+ } else if (f == 4) {
+ typ = OPT_ShorterOrLongerType(x->typ, 1);
+ if (typ == NIL) {
+ OPB_err(111);
+ } else {
+ OPB_Convert(&x, typ);
+ }
+ } else if (f == 5) {
OPB_Convert(&x, OPT_lrltyp);
} else if (f == 3) {
OPB_Convert(&x, OPT_linttyp);
@@ -1918,7 +1854,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 13: case 14:
if (OPB_NotVar(x)) {
OPB_err(112);
- } else if (!__IN(f, 0x70)) {
+ } else if (f != 4) {
OPB_err(111);
} else if (x->readonly) {
OPB_err(76);
@@ -1927,7 +1863,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 15: case 16:
if (OPB_NotVar(x)) {
OPB_err(112);
- } else if (x->typ != OPT_settyp) {
+ } else if (x->typ->form != 7) {
OPB_err(111);
x->typ = OPT_settyp;
} else if (x->readonly) {
@@ -1935,26 +1871,26 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
}
break;
case 17:
- if (!__IN(x->typ->comp, 0x0c)) {
+ if (!__IN(x->typ->comp, 0x0c, 32)) {
OPB_err(131);
}
break;
case 18:
if ((x->class == 7 && f == 3)) {
OPB_CharToString(x);
- f = 10;
+ f = 8;
}
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (((!__IN(x->typ->comp, 0x0c) || x->typ->BaseTyp->form != 3) && f != 10)) {
+ } else if (((!__IN(x->typ->comp, 0x0c, 32) || x->typ->BaseTyp->form != 3) && f != 8)) {
OPB_err(111);
}
break;
case 19:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
- if (x->typ->size != (int)OPM_LIntSize) {
+ } else if (f == 4) {
+ if (x->typ->size < OPT_linttyp->size) {
OPB_Convert(&x, OPT_linttyp);
}
} else {
@@ -1969,14 +1905,14 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 12:
if (x->class != 8) {
OPB_err(110);
- x = OPB_NewIntConst(((LONGINT)(1)));
- } else if (__IN(f, 0x63fe) || __IN(x->typ->comp, 0x14)) {
- (*OPB_typSize)(x->typ);
+ x = OPB_NewIntConst(1);
+ } else if (__IN(f, 0x18fe, 32) || __IN(x->typ->comp, 0x14, 32)) {
+ OPT_TypSize(x->typ);
x->typ->pvused = 1;
x = OPB_NewIntConst(x->typ->size);
} else {
OPB_err(111);
- x = OPB_NewIntConst(((LONGINT)(1)));
+ x = OPB_NewIntConst(1);
}
break;
case 21:
@@ -1985,22 +1921,22 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 22: case 23:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (!__IN(f, 0x027a)) {
+ } else if (!__IN(f, 0x9a, 32)) {
OPB_err(111);
}
break;
case 24: case 25: case 28: case 31:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if ((((x->class == 7 && __IN(f, 0x70))) && x->typ->size < OPT_linttyp->size)) {
- OPB_Convert(&x, OPT_linttyp);
- } else if (!((__IN(x->typ->form, 0x2070) && x->typ->size == (int)OPM_PointerSize))) {
+ } else if ((((x->class == 7 && f == 4)) && x->typ->size < OPT_adrtyp->size)) {
+ OPB_Convert(&x, OPT_adrtyp);
+ } else if (!((__IN(x->typ->form, 0x0810, 32) && x->typ->size == OPM_AddressSize))) {
OPB_err(111);
- x->typ = OPT_linttyp;
+ x->typ = OPT_adrtyp;
}
break;
case 26: case 27:
- if ((__IN(f, 0x70) && x->class == 7)) {
+ if ((f == 4 && x->class == 7)) {
if (x->conval->intval < 0 || x->conval->intval > -1) {
OPB_err(220);
}
@@ -2011,14 +1947,14 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 29:
if (x->class != 8) {
OPB_err(110);
- } else if (__IN(f, 0x1401) || x->typ->comp == 3) {
+ } else if (__IN(f, 0x0501, 32) || x->typ->comp == 3) {
OPB_err(111);
}
break;
case 30:
if (OPB_NotVar(x)) {
OPB_err(112);
- } else if (f == 13) {
+ } else if (f == 11) {
} else {
OPB_err(111);
}
@@ -2035,40 +1971,38 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.StPar0, fctno = ", (LONGINT)39);
- OPM_LogWNum(fctno, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.StPar0, fctno = ", 39);
+ OPM_LogWNum(fctno, 0);
OPM_LogWLn();
break;
}
*par0 = x;
}
-static struct StPar1__56 {
- struct StPar1__56 *lnk;
-} *StPar1__56_s;
+static struct StPar1__53 {
+ struct StPar1__53 *lnk;
+} *StPar1__53_s;
-static OPT_Node NewOp__57 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right);
+static OPT_Node NewOp__54 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right);
-static OPT_Node NewOp__57 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right)
+static OPT_Node NewOp__54 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right)
{
- OPT_Node _o_result;
OPT_Node node = NIL;
node = OPT_NewNode(class);
node->subcl = subcl;
node->left = left;
node->right = right;
- _o_result = node;
- return _o_result;
+ return node;
}
-void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
+void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
{
- INTEGER f, L;
+ INT16 f, L;
OPT_Struct typ = NIL;
OPT_Node p = NIL, t = NIL;
- struct StPar1__56 _s;
- _s.lnk = StPar1__56_s;
- StPar1__56_s = &_s;
+ struct StPar1__53 _s;
+ _s.lnk = StPar1__53_s;
+ StPar1__53_s = &_s;
p = *par0;
f = x->typ->form;
switch (fctno) {
@@ -2078,40 +2012,40 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
p->typ = OPT_notyp;
} else {
if (x->typ != p->typ) {
- if ((x->class == 7 && __IN(f, 0x70))) {
+ if ((f == 4 && (x->class == 7 || (p->typ->form == 4 && x->typ->size <= p->typ->size)))) {
OPB_Convert(&x, p->typ);
} else {
OPB_err(111);
}
}
- p = NewOp__57(19, fctno, p, x);
+ p = NewOp__54(19, fctno, p, x);
p->typ = OPT_notyp;
}
break;
case 15: case 16:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
- if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval > (int)OPM_MaxSet))) {
+ } else if (f == 4) {
+ if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval >= (INT64)__ASHL(p->typ->size, 3)))) {
OPB_err(202);
}
- p = NewOp__57(19, fctno, p, x);
+ p = NewOp__54(19, fctno, p, x);
} else {
OPB_err(111);
}
p->typ = OPT_notyp;
break;
case 17:
- if (!__IN(f, 0x70) || x->class != 7) {
+ if (!(f == 4) || x->class != 7) {
OPB_err(69);
} else if (x->typ->size == 1) {
- L = (int)x->conval->intval;
+ L = OPM_Integer(x->conval->intval);
typ = p->typ;
- while ((L > 0 && __IN(typ->comp, 0x0c))) {
+ while ((L > 0 && __IN(typ->comp, 0x0c, 32))) {
typ = typ->BaseTyp;
L -= 1;
}
- if (L != 0 || !__IN(typ->comp, 0x0c)) {
+ if (L != 0 || !__IN(typ->comp, 0x0c, 32)) {
OPB_err(132);
} else {
x->obj = NIL;
@@ -2120,7 +2054,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
p = p->left;
x->conval->intval += 1;
}
- p = NewOp__57(12, 19, p, x);
+ p = NewOp__54(12, 19, p, x);
p->typ = OPT_linttyp;
} else {
p = x;
@@ -2135,14 +2069,14 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 18:
if (OPB_NotVar(x)) {
OPB_err(112);
- } else if ((__IN(x->typ->comp, 0x0c) && x->typ->BaseTyp->form == 3)) {
+ } else if ((__IN(x->typ->comp, 0x0c, 32) && x->typ->BaseTyp->form == 3)) {
if (x->readonly) {
OPB_err(76);
}
t = x;
x = p;
p = t;
- p = NewOp__57(19, 18, p, x);
+ p = NewOp__54(19, 18, p, x);
} else {
OPB_err(111);
}
@@ -2151,14 +2085,14 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 19:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
+ } else if (f == 4) {
if ((p->class == 7 && x->class == 7)) {
if (-OPB_maxExp > x->conval->intval || x->conval->intval > OPB_maxExp) {
OPB_err(208);
p->conval->intval = 1;
} else if (x->conval->intval >= 0) {
- if (__ABS(p->conval->intval) <= __DIV(2147483647, __ASH(1, x->conval->intval))) {
- p->conval->intval = p->conval->intval * __ASH(1, x->conval->intval);
+ 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);
p->conval->intval = 1;
@@ -2168,8 +2102,8 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
}
p->obj = NIL;
} else {
- p = NewOp__57(12, 17, p, x);
- p->typ = OPT_linttyp;
+ p = NewOp__54(12, 17, p, x);
+ p->typ = p->left->typ;
}
} else {
OPB_err(111);
@@ -2179,7 +2113,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if (p->typ->comp == 3) {
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) {
OPB_err(63);
}
@@ -2195,13 +2129,13 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 22: case 23:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (!__IN(f, 0x70)) {
+ } else if (f != 4) {
OPB_err(111);
} else {
if (fctno == 22) {
- p = NewOp__57(12, 27, p, x);
+ p = NewOp__54(12, 27, p, x);
} else {
- p = NewOp__57(12, 28, p, x);
+ p = NewOp__54(12, 28, p, x);
}
p->typ = p->left->typ;
}
@@ -2209,7 +2143,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 24: case 25: case 26: case 27:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x63ff)) {
+ } else if (__IN(f, 0x18ff, 32)) {
if (fctno == 24 || fctno == 26) {
if (OPB_NotVar(x)) {
OPB_err(112);
@@ -2218,7 +2152,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
x = p;
p = t;
}
- p = NewOp__57(19, fctno, p, x);
+ p = NewOp__54(19, fctno, p, x);
} else {
OPB_err(111);
}
@@ -2227,32 +2161,38 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 28:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
- p = NewOp__57(12, 26, p, x);
+ } else if (f == 4) {
+ p = NewOp__54(12, 26, p, x);
} else {
OPB_err(111);
}
p->typ = OPT_booltyp;
break;
case 29:
- if (((x->class == 8 || x->class == 9) || __IN(f, 0x1401)) || x->typ->comp == 3) {
+ if (((x->class == 8 || x->class == 9) || __IN(f, 0x0501, 32)) || x->typ->comp == 3) {
OPB_err(126);
}
- if (x->typ->size < p->typ->size) {
+ OPT_TypSize(x->typ);
+ OPT_TypSize(p->typ);
+ if ((x->class != 7 && x->typ->size < p->typ->size)) {
OPB_err(-308);
}
- t = OPT_NewNode(11);
- t->subcl = 29;
- t->left = x;
- x = t;
- x->typ = p->typ;
+ if ((((x->class == 7 && x->typ->form == 4)) && p->typ->form == 4)) {
+ OPB_Convert(&x, p->typ);
+ } else {
+ t = OPT_NewNode(11);
+ t->subcl = 29;
+ t->left = x;
+ x = t;
+ x->typ = p->typ;
+ }
p = x;
break;
case 30:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
- p = NewOp__57(19, 30, p, x);
+ } else if (f == 4) {
+ p = NewOp__54(19, 30, p, x);
} else {
OPB_err(111);
}
@@ -2261,16 +2201,16 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 31:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if ((((x->class == 7 && __IN(f, 0x70))) && x->typ->size < OPT_linttyp->size)) {
- OPB_Convert(&x, OPT_linttyp);
- } else if (!((__IN(x->typ->form, 0x2070) && x->typ->size == (int)OPM_PointerSize))) {
+ } else if ((((x->class == 7 && f == 4)) && x->typ->size < OPT_adrtyp->size)) {
+ OPB_Convert(&x, OPT_adrtyp);
+ } else if (!((__IN(x->typ->form, 0x0810, 32) && x->typ->size == OPM_AddressSize))) {
OPB_err(111);
- x->typ = OPT_linttyp;
+ x->typ = OPT_adrtyp;
}
p->link = x;
break;
case 32:
- if ((__IN(f, 0x70) && x->class == 7)) {
+ if ((f == 4 && x->class == 7)) {
if ((0 <= x->conval->intval && x->conval->intval <= 255)) {
OPB_BindNodes(28, OPT_notyp, &x, x);
x->conval = OPT_NewConst();
@@ -2298,13 +2238,13 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
break;
}
*par0 = p;
- StPar1__56_s = _s.lnk;
+ StPar1__53_s = _s.lnk;
}
-void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
+void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n)
{
OPT_Node node = NIL;
- INTEGER f;
+ INT16 f;
OPT_Node p = NIL;
p = *par0;
f = x->typ->form;
@@ -2313,7 +2253,7 @@ void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
OPB_err(126);
} else if (p->typ->comp != 3) {
OPB_err(64);
- } else if (__IN(f, 0x70)) {
+ } else if (f == 4) {
if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) {
OPB_err(63);
}
@@ -2329,7 +2269,7 @@ void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
} else if ((fctno == 31 && n == 2)) {
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
+ } else if (f == 4) {
node = OPT_NewNode(19);
node->subcl = 31;
node->right = p;
@@ -2346,9 +2286,9 @@ void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
*par0 = p;
}
-void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno)
+void OPB_StFct (OPT_Node *par0, INT8 fctno, INT16 parno)
{
- INTEGER dim;
+ INT16 dim;
OPT_Node x = NIL, p = NIL;
p = *par0;
if (fctno <= 19) {
@@ -2363,7 +2303,7 @@ void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno)
}
} else {
if (((fctno == 13 || fctno == 14) && parno == 1)) {
- OPB_BindNodes(19, OPT_notyp, &p, OPB_NewIntConst(((LONGINT)(1))));
+ OPB_BindNodes(19, OPT_notyp, &p, OPB_NewIntConst(1));
p->subcl = fctno;
p->right->typ = p->left->typ;
} else if ((fctno == 17 && parno == 1)) {
@@ -2385,7 +2325,7 @@ void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno)
} else if (fctno == 32) {
if (parno == 1) {
x = NIL;
- OPB_BindNodes(28, OPT_notyp, &x, OPB_NewIntConst(((LONGINT)(0))));
+ OPB_BindNodes(28, OPT_notyp, &x, OPB_NewIntConst(0));
x->conval = OPT_NewConst();
x->conval->intval = OPM_errpos;
OPB_Construct(15, &p, x);
@@ -2412,21 +2352,21 @@ void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno)
static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar)
{
- INTEGER f;
+ INT16 f;
f = atyp->comp;
ftyp = ftyp->BaseTyp;
atyp = atyp->BaseTyp;
if ((fvarpar && ftyp == OPT_bytetyp)) {
- if (!__IN(f, 0x0c) || !((__IN(atyp->form, 0x7e) && atyp->size == 1))) {
- if (__IN(18, OPM_opt)) {
+ if (!__IN(f, 0x0c, 32) || !((__IN(atyp->form, 0x1e, 32) && atyp->size == 1))) {
+ if (__IN(18, OPM_Options, 32)) {
OPB_err(-301);
}
}
- } else if (__IN(f, 0x0c)) {
+ } else if (__IN(f, 0x0c, 32)) {
if (ftyp->comp == 3) {
OPB_DynArrParCheck(ftyp, atyp, fvarpar);
} else if (ftyp != atyp) {
- if ((((!fvarpar && ftyp->form == 13)) && atyp->form == 13)) {
+ if ((((!fvarpar && ftyp->form == 11)) && atyp->form == 11)) {
ftyp = ftyp->BaseTyp;
atyp = atyp->BaseTyp;
if ((ftyp->comp == 4 && atyp->comp == 4)) {
@@ -2450,7 +2390,7 @@ static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpa
static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp)
{
- if (fp->typ->form == 13) {
+ if (fp->typ->form == 11) {
if ((*x)->class == 3) {
*x = (*x)->left;
} else {
@@ -2461,13 +2401,13 @@ static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp)
void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar)
{
- if (((*x)->obj != NIL && __IN((*x)->obj->mode, 0x22c0))) {
+ if (((*x)->obj != NIL && __IN((*x)->obj->mode, 0x22c0, 32))) {
*fpar = (*x)->obj->link;
if ((*x)->obj->mode == 13) {
OPB_CheckReceiver(&(*x)->left, *fpar);
*fpar = (*fpar)->link;
}
- } else if (((((*x)->class != 8 && (*x)->typ != NIL)) && (*x)->typ->form == 14)) {
+ } else if (((((*x)->class != 8 && (*x)->typ != NIL)) && (*x)->typ->form == 12)) {
*fpar = (*x)->typ->link;
} else {
OPB_err(121);
@@ -2499,17 +2439,17 @@ void OPB_Param (OPT_Node ap, OPT_Object fp)
if (q == NIL) {
OPB_err(111);
}
- } else if ((fp->typ == OPT_sysptrtyp && ap->typ->form == 13)) {
- } else if ((ap->typ != fp->typ && !((fp->typ->form == 1 && ((__IN(ap->typ->form, 0x7e) && ap->typ->size == 1)))))) {
+ } else if ((fp->typ == OPT_sysptrtyp && ap->typ->form == 11)) {
+ } else if ((ap->typ != fp->typ && !((((fp->typ->form == 1 && __IN(ap->typ->form, 0x1e, 32))) && ap->typ->size == 1)))) {
OPB_err(123);
- } else if ((fp->typ->form == 13 && ap->class == 5)) {
+ } else if ((fp->typ->form == 11 && ap->class == 5)) {
OPB_err(123);
}
} else if (fp->typ->comp == 3) {
if ((ap->class == 7 && ap->typ->form == 3)) {
OPB_CharToString(ap);
}
- if ((ap->typ->form == 10 && fp->typ->BaseTyp->form == 3)) {
+ if ((ap->typ->form == 8 && fp->typ->BaseTyp->form == 3)) {
} else if (ap->class >= 7) {
OPB_err(59);
} else {
@@ -2521,13 +2461,13 @@ void OPB_Param (OPT_Node ap, OPT_Object fp)
}
}
-void OPB_StaticLink (SHORTINT dlev)
+void OPB_StaticLink (INT8 dlev)
{
OPT_Object scope = NIL;
scope = OPT_topScope;
while (dlev > 0) {
dlev -= 1;
- scope->link->conval->setval |= __SETOF(3);
+ scope->link->conval->setval |= __SETOF(3,64);
scope = scope->left;
}
}
@@ -2536,7 +2476,7 @@ void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp)
{
OPT_Struct typ = NIL;
OPT_Node p = NIL;
- SHORTINT lev;
+ INT8 lev;
if ((*x)->class == 9) {
typ = (*x)->typ;
lev = (*x)->obj->mnolev;
@@ -2596,7 +2536,7 @@ void OPB_Return (OPT_Node *x, OPT_Object proc)
void OPB_Assign (OPT_Node *x, OPT_Node y)
{
OPT_Node z = NIL;
- SHORTINT subcl;
+ INT8 subcl;
if ((*x)->class >= 7) {
OPB_err(56);
}
@@ -2617,12 +2557,12 @@ void OPB_Assign (OPT_Node *x, OPT_Node y)
OPB_BindNodes(6, (*x)->typ, &z, NIL);
*x = z;
}
- } else if (((((((*x)->typ->comp == 2 && (*x)->typ->BaseTyp == OPT_chartyp)) && y->typ->form == 10)) && y->conval->intval2 == 1)) {
+ } else if (((((((*x)->typ->comp == 2 && (*x)->typ->BaseTyp == OPT_chartyp)) && y->typ->form == 8)) && y->conval->intval2 == 1)) {
y->typ = OPT_chartyp;
y->conval->intval = 0;
- OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0))));
+ OPB_Index(&*x, OPB_NewIntConst(0));
}
- if ((((((__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp == OPT_chartyp)) && __IN(y->typ->comp, 0x0c))) && y->typ->BaseTyp == OPT_chartyp)) {
+ 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;
@@ -2655,7 +2595,7 @@ export void *OPB__init(void)
__MODULE_IMPORT(OPT);
__REGMOD("OPB", 0);
/* BEGIN */
- OPB_maxExp = OPB_log(1073741824);
+ OPB_maxExp = OPB_log(4611686018427387904);
OPB_maxExp = OPB_exp;
__ENDMOD;
}
diff --git a/bootstrap/windows-48/OPB.h b/bootstrap/windows-48/OPB.h
index d1c88266..0be714e8 100644
--- a/bootstrap/windows-48/OPB.h
+++ b/bootstrap/windows-48/OPB.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPB__h
#define OPB__h
@@ -8,13 +8,12 @@
#include "OPT.h"
-import void (*OPB_typSize)(OPT_Struct);
import void OPB_Assign (OPT_Node *x, OPT_Node y);
import void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp);
import void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames);
-import void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y);
+import void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y);
import void OPB_DeRef (OPT_Node *x);
import OPT_Node OPB_EmptySet (void);
import void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc);
@@ -23,27 +22,27 @@ import void OPB_In (OPT_Node *x, OPT_Node y);
import void OPB_Index (OPT_Node *x, OPT_Node y);
import void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ);
import void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y);
-import void OPB_MOp (SHORTINT op, OPT_Node *x);
+import void OPB_MOp (INT8 op, OPT_Node *x);
import OPT_Node OPB_NewBoolConst (BOOLEAN boolval);
-import OPT_Node OPB_NewIntConst (LONGINT intval);
+import OPT_Node OPB_NewIntConst (INT64 intval);
import OPT_Node OPB_NewLeaf (OPT_Object obj);
import OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ);
-import OPT_Node OPB_NewString (OPS_String str, LONGINT len);
+import OPT_Node OPB_NewString (OPS_String str, INT64 len);
import OPT_Node OPB_Nil (void);
-import void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y);
+import void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y);
import void OPB_OptIf (OPT_Node *x);
import void OPB_Param (OPT_Node ap, OPT_Object fp);
import void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar);
import void OPB_Return (OPT_Node *x, OPT_Object proc);
import void OPB_SetElem (OPT_Node *x);
import void OPB_SetRange (OPT_Node *x, OPT_Node y);
-import void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno);
-import void OPB_StPar0 (OPT_Node *par0, INTEGER fctno);
-import void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno);
-import void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n);
-import void OPB_StaticLink (SHORTINT dlev);
+import void OPB_StFct (OPT_Node *par0, INT8 fctno, INT16 parno);
+import void OPB_StPar0 (OPT_Node *par0, INT16 fctno);
+import void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno);
+import void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n);
+import void OPB_StaticLink (INT8 dlev);
import void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard);
import void *OPB__init(void);
-#endif
+#endif // OPB
diff --git a/bootstrap/windows-48/OPC.c b/bootstrap/windows-48/OPC.c
index 3abccc9a..ef4b429f 100644
--- a/bootstrap/windows-48/OPC.c
+++ b/bootstrap/windows-48/OPC.c
@@ -1,31 +1,34 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "Configuration.h"
#include "OPM.h"
#include "OPT.h"
-static INTEGER OPC_indentLevel;
-static BOOLEAN OPC_ptrinit, OPC_mainprog, OPC_ansi;
-static SHORTINT OPC_hashtab[105];
-static CHAR OPC_keytab[36][9];
+static INT16 OPC_indentLevel;
+static INT8 OPC_hashtab[105];
+static CHAR OPC_keytab[50][9];
static BOOLEAN OPC_GlbPtrs;
static CHAR OPC_BodyNameExt[13];
-export void OPC_Align (LONGINT *adr, LONGINT base);
export void OPC_Andent (OPT_Struct typ);
static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames);
-export LONGINT OPC_BaseAlignment (OPT_Struct typ);
export OPT_Object OPC_BaseTProc (OPT_Object obj);
export void OPC_BegBlk (void);
export void OPC_BegStat (void);
-static void OPC_CProcDefs (OPT_Object obj, INTEGER vis);
-export void OPC_Case (LONGINT caseVal, INTEGER form);
-static void OPC_CharacterLiteral (LONGINT c);
-export void OPC_Cmp (INTEGER rel);
+static void OPC_CProcDefs (OPT_Object obj, INT16 vis);
+export void OPC_Case (INT64 caseVal, INT16 form);
+static void OPC_CharacterLiteral (INT64 c);
+export void OPC_Cmp (INT16 rel);
export void OPC_CompleteIdent (OPT_Object obj);
-export void OPC_Constant (OPT_Const con, INTEGER form);
+export void OPC_Constant (OPT_Const con, INT16 form);
static void OPC_DeclareBase (OPT_Object dcl);
static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef);
static void OPC_DeclareParams (OPT_Object par, BOOLEAN macro);
@@ -42,44 +45,45 @@ export void OPC_EnterBody (void);
export void OPC_EnterProc (OPT_Object proc);
export void OPC_ExitBody (void);
export void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet);
-static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *n, LONGINT *curAlign);
-static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LONGINT *curAlign);
+static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, INT32 *off, INT32 *n, INT32 *curAlign);
+static void OPC_FillGap (INT32 gap, INT32 off, INT32 align, INT32 *n, INT32 *curAlign);
export void OPC_GenBdy (OPT_Node n);
-static void OPC_GenDynTypes (OPT_Node n, INTEGER vis);
+static void OPC_GenDynTypes (OPT_Node n, INT16 vis);
export void OPC_GenEnumPtrs (OPT_Object var);
export void OPC_GenHdr (OPT_Node n);
export void OPC_GenHdrIncludes (void);
static void OPC_GenHeaderMsg (void);
-export void OPC_Halt (LONGINT n);
+export void OPC_Halt (INT32 n);
export void OPC_Ident (OPT_Object obj);
-static void OPC_IdentList (OPT_Object obj, INTEGER vis);
+static void OPC_IdentList (OPT_Object obj, INT16 vis);
static void OPC_Include (CHAR *name, LONGINT name__len);
-static void OPC_IncludeImports (OPT_Object obj, INTEGER vis);
+static void OPC_IncludeImports (OPT_Object obj, INT16 vis);
export void OPC_Increment (BOOLEAN decrement);
-export void OPC_Indent (INTEGER count);
+export void OPC_Indent (INT16 count);
export void OPC_Init (void);
static void OPC_InitImports (OPT_Object obj);
static void OPC_InitKeywords (void);
export void OPC_InitTDesc (OPT_Struct typ);
static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj);
-export void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim);
+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 INTEGER OPC_Length (CHAR *s, LONGINT s__len);
-export LONGINT OPC_NofPtrs (OPT_Struct typ);
-static INTEGER OPC_PerfectHash (CHAR *s, LONGINT s__len);
+static 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, LONGINT s__len);
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len);
static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define);
-static void OPC_ProcPredefs (OPT_Object obj, SHORTINT vis);
+static void OPC_ProcPredefs (OPT_Object obj, INT8 vis);
static void OPC_PutBase (OPT_Struct typ);
-static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt);
+static void OPC_PutPtrOffsets (OPT_Struct typ, INT32 adr, INT32 *cnt);
static void OPC_RegCmds (OPT_Object obj);
export void OPC_SetInclude (BOOLEAN exclude);
-export LONGINT OPC_SizeAlignment (LONGINT size);
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause);
-static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x);
-static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT 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, INTEGER vis);
+export void OPC_TypeDefs (OPT_Object obj, INT16 vis);
export void OPC_TypeOf (OPT_Object ap);
static BOOLEAN OPC_Undefined (OPT_Object obj);
@@ -87,24 +91,17 @@ static BOOLEAN OPC_Undefined (OPT_Object obj);
void OPC_Init (void)
{
OPC_indentLevel = 0;
- OPC_ptrinit = __IN(5, OPM_opt);
- OPC_mainprog = OPM_mainProg || OPM_mainLinkStat;
- OPC_ansi = __IN(6, OPM_opt);
- if (OPC_ansi) {
- __MOVE("__init(void)", OPC_BodyNameExt, 13);
- } else {
- __MOVE("__init()", OPC_BodyNameExt, 9);
- }
+ __MOVE("__init(void)", OPC_BodyNameExt, 13);
}
-void OPC_Indent (INTEGER count)
+void OPC_Indent (INT16 count)
{
OPC_indentLevel += count;
}
void OPC_BegStat (void)
{
- INTEGER i;
+ INT16 i;
i = OPC_indentLevel;
while (i > 0) {
OPM_Write(0x09);
@@ -140,10 +137,10 @@ void OPC_EndBlk0 (void)
OPM_Write('}');
}
-static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x)
+static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x)
{
CHAR ch;
- INTEGER i;
+ INT16 i;
__DUP(s, s__len, CHAR);
ch = s[0];
i = 0;
@@ -159,79 +156,86 @@ static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x)
__DEL(s);
}
-static INTEGER OPC_Length (CHAR *s, LONGINT s__len)
+static INT16 OPC_Length (CHAR *s, LONGINT s__len)
{
- INTEGER _o_result;
- INTEGER i;
+ INT16 i;
i = 0;
while (s[__X(i, s__len)] != 0x00) {
i += 1;
}
- _o_result = i;
- return _o_result;
+ return i;
}
-static INTEGER OPC_PerfectHash (CHAR *s, LONGINT s__len)
+static INT16 OPC_PerfectHash (CHAR *s, LONGINT s__len)
{
- INTEGER _o_result;
- INTEGER i, h;
+ INT16 i, h;
i = 0;
h = 0;
while ((s[__X(i, s__len)] != 0x00 && i < 5)) {
- h = 3 * h + (int)s[__X(i, s__len)];
+ h = 3 * h + (INT16)s[__X(i, s__len)];
i += 1;
}
- _o_result = (int)__MOD(h, 105);
- return _o_result;
+ return (int)__MOD(h, 105);
}
void OPC_Ident (OPT_Object obj)
{
- INTEGER mode, level, h;
+ INT16 mode, level, h;
mode = obj->mode;
level = obj->mnolev;
- if ((__IN(mode, 0x62) && level > 0) || __IN(mode, 0x14)) {
- OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256)));
- h = OPC_PerfectHash((void*)obj->name, ((LONGINT)(256)));
- if (OPC_hashtab[__X(h, ((LONGINT)(105)))] >= 0) {
- if (__STRCMP(OPC_keytab[__X(OPC_hashtab[__X(h, ((LONGINT)(105)))], ((LONGINT)(36)))], obj->name) == 0) {
+ if ((__IN(mode, 0x62, 32) && level > 0) || __IN(mode, 0x14, 32)) {
+ OPM_WriteStringVar((void*)obj->name, 256);
+ h = OPC_PerfectHash((void*)obj->name, 256);
+ if (OPC_hashtab[__X(h, 105)] >= 0) {
+ if (__STRCMP(OPC_keytab[__X(OPC_hashtab[__X(h, 105)], 50)], obj->name) == 0) {
OPM_Write('_');
}
}
+ } else if ((mode == 5 && __IN(obj->typ->form, 0x90, 32))) {
+ if (obj->typ == OPT_adrtyp) {
+ OPM_WriteString((CHAR*)"ADDRESS", 8);
+ } else {
+ if (obj->typ->form == 4) {
+ OPM_WriteString((CHAR*)"INT", 4);
+ } else {
+ OPM_WriteString((CHAR*)"UINT", 5);
+ }
+ OPM_WriteInt(__ASHL(obj->typ->size, 3));
+ }
} else {
if (mode != 5 || obj->linkadr != 2) {
if (mode == 13) {
OPC_Ident(obj->link->typ->strobj);
} else if (level < 0) {
- OPM_WriteStringVar((void*)OPT_GlbMod[__X(-level, ((LONGINT)(64)))]->name, ((LONGINT)(256)));
+ OPM_WriteStringVar((void*)OPT_GlbMod[__X(-level, 64)]->name, 256);
if (OPM_currFile == 0) {
- OPT_GlbMod[__X(-level, ((LONGINT)(64)))]->vis = 1;
+ OPT_GlbMod[__X(-level, 64)]->vis = 1;
}
} else {
- OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32)));
+ OPM_WriteStringVar((void*)OPM_modName, 32);
}
OPM_Write('_');
} else if (obj == OPT_sysptrtyp->strobj || obj == OPT_bytetyp->strobj) {
- OPM_WriteString((CHAR*)"SYSTEM_", (LONGINT)8);
+ OPM_WriteString((CHAR*)"SYSTEM_", 8);
}
- OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256)));
+ OPM_WriteStringVar((void*)obj->name, 256);
}
}
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause)
{
- INTEGER pointers;
+ INT16 pointers;
*openClause = 0;
if (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->comp != 4)) {
- if (__IN(typ->comp, 0x0c)) {
+ if (__IN(typ->comp, 0x0c, 32)) {
OPC_Stars(typ->BaseTyp, &*openClause);
*openClause = typ->comp == 2;
- } else if (typ->form == 14) {
+ } else if (typ->form == 12) {
OPM_Write('(');
OPM_Write('*');
} else {
pointers = 0;
- while (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->form == 13)) {
+ while (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->form == 11)) {
pointers += 1;
typ = typ->BaseTyp;
}
@@ -256,7 +260,7 @@ static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef)
{
OPT_Struct typ = NIL;
BOOLEAN varPar, openClause;
- INTEGER form, comp;
+ INT16 form, comp;
typ = dcl->typ;
varPar = ((dcl->mode == 2 && typ->comp != 2) || typ->comp == 3) || scopeDef;
OPC_Stars(typ, &openClause);
@@ -276,22 +280,18 @@ static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef)
for (;;) {
form = typ->form;
comp = typ->comp;
- if (((typ->strobj != NIL && typ->strobj->name[0] != 0x00) || form == 12) || comp == 4) {
+ if (((typ->strobj != NIL && typ->strobj->name[0] != 0x00) || form == 10) || comp == 4) {
break;
- } else if ((form == 13 && typ->BaseTyp->comp != 3)) {
+ } else if ((form == 11 && typ->BaseTyp->comp != 3)) {
openClause = 1;
- } else if (form == 14 || __IN(comp, 0x0c)) {
+ } else if (form == 12 || __IN(comp, 0x0c, 32)) {
if (openClause) {
OPM_Write(')');
openClause = 0;
}
- if (form == 14) {
- if (OPC_ansi) {
- OPM_Write(')');
- OPC_AnsiParamList(typ->link, 0);
- } else {
- OPM_WriteString((CHAR*)")()", (LONGINT)4);
- }
+ if (form == 12) {
+ OPM_Write(')');
+ OPC_AnsiParamList(typ->link, 0);
break;
} else if (comp == 2) {
OPM_Write('[');
@@ -308,8 +308,8 @@ static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef)
void OPC_Andent (OPT_Struct typ)
{
if (typ->strobj == NIL || typ->align >= 65536) {
- OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32)));
- OPC_Str1((CHAR*)"__#", (LONGINT)4, __ASHR(typ->align, 16));
+ OPM_WriteStringVar((void*)OPM_modName, 32);
+ OPC_Str1((CHAR*)"__#", 4, __ASHR(typ->align, 16));
} else {
OPC_Ident(typ->strobj);
}
@@ -317,36 +317,34 @@ void OPC_Andent (OPT_Struct typ)
static BOOLEAN OPC_Undefined (OPT_Object obj)
{
- BOOLEAN _o_result;
- _o_result = obj->name[0] == 0x00 || (((obj->mnolev >= 0 && obj->linkadr != (int)(3 + OPM_currFile))) && obj->linkadr != 2);
- return _o_result;
+ return obj->name[0] == 0x00 || (((obj->mnolev >= 0 && obj->linkadr != (3 + OPM_currFile))) && obj->linkadr != 2);
}
static void OPC_DeclareBase (OPT_Object dcl)
{
OPT_Struct typ = NIL, prev = NIL;
OPT_Object obj = NIL;
- INTEGER nofdims;
- LONGINT off, n, dummy;
+ INT16 nofdims;
+ INT32 off, n, dummy;
typ = dcl->typ;
prev = typ;
- while ((((((((typ->strobj == NIL || typ->comp == 3) || OPC_Undefined(typ->strobj)) && typ->comp != 4)) && typ->form != 12)) && !((typ->form == 13 && typ->BaseTyp->comp == 3)))) {
+ while ((((((((typ->strobj == NIL || typ->comp == 3) || OPC_Undefined(typ->strobj)) && typ->comp != 4)) && typ->form != 10)) && !((typ->form == 11 && typ->BaseTyp->comp == 3)))) {
prev = typ;
typ = typ->BaseTyp;
}
obj = typ->strobj;
- if (typ->form == 12) {
- OPM_WriteString((CHAR*)"void", (LONGINT)5);
+ if (typ->form == 10) {
+ OPM_WriteString((CHAR*)"void", 5);
} else if ((obj != NIL && !OPC_Undefined(obj))) {
OPC_Ident(obj);
} else if (typ->comp == 4) {
- OPM_WriteString((CHAR*)"struct ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"struct ", 8);
OPC_Andent(typ);
- if ((prev->form != 13 && (obj != NIL || dcl->name[0] == 0x00))) {
+ if ((prev->form != 11 && (obj != NIL || dcl->name[0] == 0x00))) {
if ((typ->BaseTyp != NIL && typ->BaseTyp->strobj->vis != 0)) {
- OPM_WriteString((CHAR*)" { /* ", (LONGINT)7);
+ OPM_WriteString((CHAR*)" { /* ", 7);
OPC_Ident(typ->BaseTyp->strobj);
- OPM_WriteString((CHAR*)" */", (LONGINT)4);
+ OPM_WriteString((CHAR*)" */", 4);
OPM_WriteLn();
OPC_Indent(1);
} else {
@@ -356,22 +354,22 @@ static void OPC_DeclareBase (OPT_Object dcl)
OPC_FieldList(typ, 1, &off, &n, &dummy);
OPC_EndBlk0();
}
- } else if ((typ->form == 13 && typ->BaseTyp->comp == 3)) {
+ } else if ((typ->form == 11 && typ->BaseTyp->comp == 3)) {
typ = typ->BaseTyp->BaseTyp;
nofdims = 1;
while (typ->comp == 3) {
nofdims += 1;
typ = typ->BaseTyp;
}
- OPM_WriteString((CHAR*)"struct ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"struct ", 8);
OPC_BegBlk();
OPC_BegStat();
- OPC_Str1((CHAR*)"LONGINT len[#]", (LONGINT)15, nofdims);
+ OPC_Str1((CHAR*)"LONGINT len[#]", 15, nofdims);
OPC_EndStat();
OPC_BegStat();
__NEW(obj, OPT_ObjDesc);
__NEW(obj->typ, OPT_StrDesc);
- obj->typ->form = 15;
+ obj->typ->form = 13;
obj->typ->comp = 2;
obj->typ->n = 1;
obj->typ->BaseTyp = typ;
@@ -386,15 +384,13 @@ static void OPC_DeclareBase (OPT_Object dcl)
}
}
-LONGINT OPC_NofPtrs (OPT_Struct typ)
+INT32 OPC_NofPtrs (OPT_Struct typ)
{
- LONGINT _o_result;
OPT_Object fld = NIL;
OPT_Struct btyp = NIL;
- LONGINT n;
- if ((typ->form == 13 && typ->sysflag == 0)) {
- _o_result = 1;
- return _o_result;
+ INT32 n;
+ if ((typ->form == 11 && typ->sysflag == 0)) {
+ return 1;
} else if ((typ->comp == 4 && __MASK(typ->sysflag, -256) == 0)) {
btyp = typ->BaseTyp;
if (btyp != NIL) {
@@ -411,8 +407,7 @@ LONGINT OPC_NofPtrs (OPT_Struct typ)
}
fld = fld->link;
}
- _o_result = n;
- return _o_result;
+ return n;
} else if (typ->comp == 2) {
btyp = typ->BaseTyp;
n = typ->n;
@@ -420,23 +415,21 @@ LONGINT OPC_NofPtrs (OPT_Struct typ)
n = btyp->n * n;
btyp = btyp->BaseTyp;
}
- _o_result = OPC_NofPtrs(btyp) * n;
- return _o_result;
+ return OPC_NofPtrs(btyp) * n;
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt)
+static void OPC_PutPtrOffsets (OPT_Struct typ, INT32 adr, INT32 *cnt)
{
OPT_Object fld = NIL;
OPT_Struct btyp = NIL;
- LONGINT n, i;
- if ((typ->form == 13 && typ->sysflag == 0)) {
+ INT32 n, i;
+ if ((typ->form == 11 && typ->sysflag == 0)) {
OPM_WriteInt(adr);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
*cnt += 1;
if (__MASK(*cnt, -16) == 0) {
OPM_WriteLn();
@@ -453,7 +446,7 @@ static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt)
OPC_PutPtrOffsets(fld->typ, adr + fld->adr, &*cnt);
} else {
OPM_WriteInt(adr + fld->adr);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
*cnt += 1;
if (__MASK(*cnt, -16) == 0) {
OPM_WriteLn();
@@ -485,11 +478,11 @@ static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj)
OPC_InitTProcs(typ, obj->left);
if (obj->mode == 13) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"__INITBP(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__INITBP(", 10);
OPC_Ident(typ);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Ident(obj);
- OPC_Str1((CHAR*)", #)", (LONGINT)5, __ASHR(obj->adr, 16));
+ OPC_Str1((CHAR*)", #)", 5, __ASHR(obj->adr, 16));
OPC_EndStat();
}
OPC_InitTProcs(typ, obj->right);
@@ -501,30 +494,30 @@ static void OPC_PutBase (OPT_Struct typ)
if (typ != NIL) {
OPC_PutBase(typ->BaseTyp);
OPC_Ident(typ->strobj);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)"__typ", 6);
+ OPM_WriteString((CHAR*)", ", 3);
}
}
static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamName)
{
OPT_Struct typ = NIL;
- INTEGER dim;
+ INT16 dim;
if (showParamName) {
OPC_Ident(par);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
}
dim = 1;
typ = par->typ->BaseTyp;
while (typ->comp == 3) {
if (ansiDefine) {
- OPM_WriteString((CHAR*)", LONGINT ", (LONGINT)11);
+ OPM_WriteString((CHAR*)", LONGINT ", 11);
} else {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
}
if (showParamName) {
OPC_Ident(par);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
OPM_WriteInt(dim);
}
typ = typ->BaseTyp;
@@ -537,24 +530,24 @@ static void OPC_DeclareParams (OPT_Object par, BOOLEAN macro)
OPM_Write('(');
while (par != NIL) {
if (macro) {
- OPM_WriteStringVar((void*)par->name, ((LONGINT)(256)));
+ OPM_WriteStringVar((void*)par->name, 256);
} else {
- if ((par->mode == 1 && par->typ->form == 7)) {
+ if ((par->mode == 1 && par->typ->form == 5)) {
OPM_Write('_');
}
OPC_Ident(par);
}
if (par->typ->comp == 3) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_LenList(par, 0, 1);
} else if ((par->mode == 2 && par->typ->comp == 4)) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPM_WriteStringVar((void*)par->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPM_WriteStringVar((void*)par->name, 256);
+ OPM_WriteString((CHAR*)"__typ", 6);
}
par = par->link;
if (par != NIL) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
}
}
OPM_Write(')');
@@ -566,12 +559,10 @@ static void OPC_DefineTProcTypes (OPT_Object obj)
if (obj->typ != OPT_notyp) {
OPC_DefineType(obj->typ);
}
- if (OPC_ansi) {
- par = obj->link;
- while (par != NIL) {
- OPC_DefineType(par->typ);
- par = par->link;
- }
+ par = obj->link;
+ while (par != NIL) {
+ OPC_DefineType(par->typ);
+ par = par->link;
}
}
@@ -586,7 +577,7 @@ static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty)
if (OPM_currFile == 0) {
if (obj->vis == 1) {
OPC_DefineTProcTypes(obj);
- OPM_WriteString((CHAR*)"import ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"import ", 8);
*empty = 0;
OPC_ProcHeader(obj, 0);
}
@@ -594,9 +585,9 @@ static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty)
*empty = 0;
OPC_DefineTProcTypes(obj);
if (obj->vis == 0) {
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"static ", 8);
} else {
- OPM_WriteString((CHAR*)"export ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"export ", 8);
}
OPC_ProcHeader(obj, 0);
}
@@ -607,11 +598,10 @@ static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty)
OPT_Object OPC_BaseTProc (OPT_Object obj)
{
- OPT_Object _o_result;
OPT_Struct typ = NIL, base = NIL;
- LONGINT mno;
+ INT32 mno;
typ = obj->link->typ;
- if (typ->form == 13) {
+ if (typ->form == 11) {
typ = typ->BaseTyp;
}
base = typ->BaseTyp;
@@ -621,8 +611,7 @@ OPT_Object OPC_BaseTProc (OPT_Object obj)
base = typ->BaseTyp;
}
OPT_FindField(obj->name, typ, &obj);
- _o_result = obj;
- return _o_result;
+ return obj;
}
static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty)
@@ -630,31 +619,27 @@ static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty)
if (obj != NIL) {
OPC_DefineTProcMacros(obj->left, &*empty);
if ((((obj->mode == 13 && obj == OPC_BaseTProc(obj))) && (OPM_currFile != 0 || obj->vis == 1))) {
- OPM_WriteString((CHAR*)"#define __", (LONGINT)11);
+ OPM_WriteString((CHAR*)"#define __", 11);
OPC_Ident(obj);
OPC_DeclareParams(obj->link, 1);
- OPM_WriteString((CHAR*)" __SEND(", (LONGINT)9);
- if (obj->link->typ->form == 13) {
- OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10);
+ 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", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
}
- OPC_Str1((CHAR*)", #, ", (LONGINT)6, __ASHR(obj->adr, 16));
+ OPC_Str1((CHAR*)", #, ", 6, __ASHR(obj->adr, 16));
if (obj->typ == OPT_notyp) {
- OPM_WriteString((CHAR*)"void", (LONGINT)5);
+ OPM_WriteString((CHAR*)"void", 5);
} else {
OPC_Ident(obj->typ->strobj);
}
- OPM_WriteString((CHAR*)"(*)", (LONGINT)4);
- if (OPC_ansi) {
- OPC_AnsiParamList(obj->link, 0);
- } else {
- OPM_WriteString((CHAR*)"()", (LONGINT)3);
- }
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)"(*)", 4);
+ OPC_AnsiParamList(obj->link, 0);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_DeclareParams(obj->link, 1);
OPM_Write(')');
OPM_WriteLn();
@@ -672,7 +657,7 @@ static void OPC_DefineType (OPT_Struct str)
if (obj == NIL || OPC_Undefined(obj)) {
if (obj != NIL) {
if (obj->linkadr == 1) {
- if (str->form != 13) {
+ if (str->form != 11) {
OPM_Mark(244, str->txtpos);
obj->linkadr = 2;
}
@@ -691,13 +676,13 @@ static void OPC_DefineType (OPT_Struct str)
}
field = field->link;
}
- } else if (str->form == 13) {
+ } else if (str->form == 11) {
if (str->BaseTyp->comp != 4) {
OPC_DefineType(str->BaseTyp);
}
- } else if (__IN(str->comp, 0x0c)) {
+ } else if (__IN(str->comp, 0x0c, 32)) {
OPC_DefineType(str->BaseTyp);
- } else if (str->form == 14) {
+ } else if (str->form == 12) {
if (str->BaseTyp != OPT_notyp) {
OPC_DefineType(str->BaseTyp);
}
@@ -709,7 +694,7 @@ static void OPC_DefineType (OPT_Struct str)
}
}
if ((obj != NIL && OPC_Undefined(obj))) {
- OPM_WriteString((CHAR*)"typedef", (LONGINT)8);
+ OPM_WriteString((CHAR*)"typedef", 8);
OPM_WriteLn();
OPM_Write(0x09);
OPC_Indent(1);
@@ -737,40 +722,36 @@ static void OPC_DefineType (OPT_Struct str)
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len)
{
- BOOLEAN _o_result;
- INTEGER i;
- BOOLEAN r;
+ INT16 i;
__DUP(y, y__len, CHAR);
i = 0;
- while ((*x)[__X(i + 1, ((LONGINT)(256)))] == y[__X(i, y__len)]) {
+ while ((*x)[__X(i + 1, 256)] == y[__X(i, y__len)]) {
i += 1;
}
- r = y[__X(i, y__len)] == 0x00;
- _o_result = r;
__DEL(y);
- return _o_result;
+ return y[__X(i, y__len)] == 0x00;
}
-static void OPC_CProcDefs (OPT_Object obj, INTEGER vis)
+static void OPC_CProcDefs (OPT_Object obj, INT16 vis)
{
- INTEGER i;
+ INT16 i;
OPT_ConstExt ext = NIL;
- INTEGER _for__9;
+ INT16 _for__7;
if (obj != NIL) {
OPC_CProcDefs(obj->left, vis);
- if ((((obj->mode == 9 && (int)obj->vis >= vis)) && obj->adr == 1)) {
+ if ((((obj->mode == 9 && (INT16)obj->vis >= vis)) && obj->adr == 1)) {
ext = obj->conval->ext;
i = 1;
- if (((*ext)[1] != '#' && !(OPC_Prefixed(ext, (CHAR*)"extern ", (LONGINT)8) || OPC_Prefixed(ext, (CHAR*)"import ", (LONGINT)8)))) {
- OPM_WriteString((CHAR*)"#define ", (LONGINT)9);
+ if (((*ext)[1] != '#' && !(OPC_Prefixed(ext, (CHAR*)"extern ", 8) || OPC_Prefixed(ext, (CHAR*)"import ", 8)))) {
+ OPM_WriteString((CHAR*)"#define ", 9);
OPC_Ident(obj);
OPC_DeclareParams(obj->link, 1);
OPM_Write(0x09);
}
- _for__9 = (int)(*obj->conval->ext)[0];
+ _for__7 = (INT16)(*obj->conval->ext)[0];
i = i;
- while (i <= _for__9) {
- OPM_Write((*obj->conval->ext)[__X(i, ((LONGINT)(256)))]);
+ while (i <= _for__7) {
+ OPM_Write((*obj->conval->ext)[__X(i, 256)]);
i += 1;
}
OPM_WriteLn();
@@ -779,7 +760,7 @@ static void OPC_CProcDefs (OPT_Object obj, INTEGER vis)
}
}
-void OPC_TypeDefs (OPT_Object obj, INTEGER vis)
+void OPC_TypeDefs (OPT_Object obj, INT16 vis)
{
if (obj != NIL) {
OPC_TypeDefs(obj->left, vis);
@@ -811,130 +792,85 @@ static void OPC_DefAnonRecs (OPT_Node n)
void OPC_TDescDecl (OPT_Struct typ)
{
- LONGINT nofptrs;
+ INT32 nofptrs;
OPT_Object o = NIL;
OPC_BegStat();
- OPM_WriteString((CHAR*)"__TDESC(", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__TDESC(", 9);
OPC_Andent(typ);
- OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1);
- OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ));
+ OPC_Str1((CHAR*)", #", 4, typ->n + 1);
+ OPC_Str1((CHAR*)", #) = {__TDFLDS(", 18, OPC_NofPtrs(typ));
OPM_Write('"');
if (typ->strobj != NIL) {
- OPM_WriteStringVar((void*)typ->strobj->name, ((LONGINT)(256)));
+ OPM_WriteStringVar((void*)typ->strobj->name, 256);
}
OPM_Write('"');
- OPC_Str1((CHAR*)", #), {", (LONGINT)8, typ->size);
+ OPC_Str1((CHAR*)", #), {", 8, typ->size);
nofptrs = 0;
- OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs);
- OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (int)OPM_LIntSize));
+ OPC_PutPtrOffsets(typ, 0, &nofptrs);
+ OPC_Str1((CHAR*)"#}}", 4, -((nofptrs + 1) * OPM_AddressSize));
OPC_EndStat();
}
void OPC_InitTDesc (OPT_Struct typ)
{
OPC_BegStat();
- OPM_WriteString((CHAR*)"__INITYP(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__INITYP(", 10);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
if (typ->BaseTyp != NIL) {
OPC_Andent(typ->BaseTyp);
} else {
OPC_Andent(typ);
}
- OPC_Str1((CHAR*)", #)", (LONGINT)5, typ->extlev);
+ OPC_Str1((CHAR*)", #)", 5, typ->extlev);
OPC_EndStat();
if (typ->strobj != NIL) {
OPC_InitTProcs(typ->strobj, typ->link);
}
}
-void OPC_Align (LONGINT *adr, LONGINT base)
+static void OPC_FillGap (INT32 gap, INT32 off, INT32 align, INT32 *n, INT32 *curAlign)
{
- switch (base) {
- case 2:
- *adr += __MASK(*adr, -2);
- break;
- case 4:
- *adr += __MASK(-*adr, -4);
- break;
- case 8:
- *adr += __MASK(-*adr, -8);
- break;
- case 16:
- *adr += __MASK(-*adr, -16);
- break;
- default:
- break;
- }
-}
-
-LONGINT OPC_SizeAlignment (LONGINT size)
-{
- LONGINT _o_result;
- LONGINT alignment;
- if (size < (int)OPM_Alignment) {
- alignment = 1;
- while (alignment < size) {
- alignment = __ASHL(alignment, 1);
- }
- } else {
- alignment = OPM_Alignment;
- }
- _o_result = alignment;
- return _o_result;
-}
-
-LONGINT OPC_BaseAlignment (OPT_Struct typ)
-{
- LONGINT _o_result;
- LONGINT alignment;
- if (typ->form == 15) {
- if (typ->comp == 4) {
- alignment = __MASK(typ->align, -65536);
- } else {
- alignment = OPC_BaseAlignment(typ->BaseTyp);
- }
- } else {
- alignment = OPC_SizeAlignment(typ->size);
- }
- _o_result = alignment;
- return _o_result;
-}
-
-static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LONGINT *curAlign)
-{
- LONGINT adr;
+ INT32 adr;
adr = off;
- OPC_Align(&adr, align);
+ OPT_Align(&adr, align);
if ((*curAlign < align && gap - (adr - off) >= align)) {
gap -= (adr - off) + align;
OPC_BegStat();
- if (align == (int)OPM_IntSize) {
- OPM_WriteString((CHAR*)"INTEGER", (LONGINT)8);
- } else if (align == (int)OPM_LIntSize) {
- OPM_WriteString((CHAR*)"LONGINT", (LONGINT)8);
- } else if (align == (int)OPM_LRealSize) {
- OPM_WriteString((CHAR*)"LONGREAL", (LONGINT)9);
+ switch (align) {
+ case 2:
+ OPM_WriteString((CHAR*)"INT16", 6);
+ break;
+ case 4:
+ OPM_WriteString((CHAR*)"INT32", 6);
+ break;
+ case 8:
+ OPM_WriteString((CHAR*)"INT64", 6);
+ break;
+ default:
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Unexpected enclosing alignment in FillGap.", 43);
+ break;
}
- OPC_Str1((CHAR*)" _prvt#", (LONGINT)8, *n);
+ OPC_Str1((CHAR*)" _prvt#", 8, *n);
*n += 1;
OPC_EndStat();
*curAlign = align;
}
if (gap > 0) {
OPC_BegStat();
- OPC_Str1((CHAR*)"char _prvt#", (LONGINT)12, *n);
+ OPC_Str1((CHAR*)"char _prvt#", 12, *n);
*n += 1;
- OPC_Str1((CHAR*)"[#]", (LONGINT)4, gap);
+ OPC_Str1((CHAR*)"[#]", 4, gap);
OPC_EndStat();
}
}
-static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *n, LONGINT *curAlign)
+static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, INT32 *off, INT32 *n, INT32 *curAlign)
{
OPT_Object fld = NIL;
OPT_Struct base = NIL;
- LONGINT gap, adr, align, fldAlign;
+ INT32 gap, adr, align, fldAlign;
fld = typ->link;
align = __MASK(typ->align, -65536);
if (typ->BaseTyp != NIL) {
@@ -952,8 +888,8 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
}
} else {
adr = *off;
- fldAlign = OPC_BaseAlignment(fld->typ);
- OPC_Align(&adr, fldAlign);
+ fldAlign = OPT_BaseAlignment(fld->typ);
+ OPT_Align(&adr, fldAlign);
gap = fld->adr - adr;
if (fldAlign > *curAlign) {
*curAlign = fldAlign;
@@ -969,7 +905,7 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
base = fld->typ;
fld = fld->link;
while ((((((((fld != NIL && fld->mode == 4)) && fld->typ == base)) && fld->adr == *off)) && ((OPM_currFile == 1 || fld->vis != 0) || fld->typ->strobj == NIL))) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_DeclareObj(fld, 0);
*off = fld->adr + fld->typ->size;
fld = fld->link;
@@ -978,7 +914,7 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
}
}
if (last) {
- adr = typ->size - (int)__ASHR(typ->sysflag, 8);
+ adr = typ->size - __ASHR(typ->sysflag, 8);
if (adr == 0) {
gap = 1;
} else {
@@ -990,16 +926,16 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
}
}
-static void OPC_IdentList (OPT_Object obj, INTEGER vis)
+static void OPC_IdentList (OPT_Object obj, INT16 vis)
{
OPT_Struct base = NIL;
BOOLEAN first;
- INTEGER lastvis;
+ INT16 lastvis;
base = NIL;
first = 1;
while ((obj != NIL && obj->mode != 13)) {
- if ((__IN(vis, 0x05) || (vis == 1 && obj->vis != 0)) || (vis == 3 && !obj->leaf)) {
- if (obj->typ != base || (int)obj->vis != lastvis) {
+ if ((__IN(vis, 0x05, 32) || (vis == 1 && obj->vis != 0)) || (vis == 3 && !obj->leaf)) {
+ if (obj->typ != base || (INT16)obj->vis != lastvis) {
if (!first) {
OPC_EndStat();
}
@@ -1008,16 +944,16 @@ static void OPC_IdentList (OPT_Object obj, INTEGER vis)
lastvis = obj->vis;
OPC_BegStat();
if ((vis == 1 && obj->vis != 0)) {
- OPM_WriteString((CHAR*)"import ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"import ", 8);
} else if ((obj->mnolev == 0 && vis == 0)) {
if (obj->vis == 0) {
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"static ", 8);
} else {
- OPM_WriteString((CHAR*)"export ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"export ", 8);
}
}
- if ((((vis == 2 && obj->mode == 1)) && base->form == 7)) {
- OPM_WriteString((CHAR*)"double", (LONGINT)7);
+ if ((((vis == 2 && obj->mode == 1)) && base->form == 5)) {
+ OPM_WriteString((CHAR*)"double", 7);
} else {
OPC_DeclareBase(obj);
}
@@ -1025,7 +961,7 @@ static void OPC_IdentList (OPT_Object obj, INTEGER vis)
OPM_Write(',');
}
OPM_Write(' ');
- if ((((vis == 2 && obj->mode == 1)) && base->form == 7)) {
+ if ((((vis == 2 && obj->mode == 1)) && base->form == 5)) {
OPM_Write('_');
}
OPC_DeclareObj(obj, vis == 3);
@@ -1033,17 +969,17 @@ static void OPC_IdentList (OPT_Object obj, INTEGER vis)
OPC_EndStat();
OPC_BegStat();
base = OPT_linttyp;
- OPM_WriteString((CHAR*)"LONGINT ", (LONGINT)9);
+ OPM_WriteString((CHAR*)"LONGINT ", 9);
OPC_LenList(obj, 0, 1);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPC_EndStat();
OPC_BegStat();
- OPM_WriteString((CHAR*)"LONGINT *", (LONGINT)10);
+ OPM_WriteString((CHAR*)"ADDRESS *", 10);
OPC_Ident(obj);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
base = NIL;
- } else if ((((((OPC_ptrinit && vis == 0)) && obj->mnolev > 0)) && obj->typ->form == 13)) {
- OPM_WriteString((CHAR*)" = NIL", (LONGINT)7);
+ } else if ((((((__IN(5, OPM_Options, 32) && vis == 0)) && obj->mnolev > 0)) && obj->typ->form == 11)) {
+ OPM_WriteString((CHAR*)" = NIL", 7);
}
}
obj = obj->link;
@@ -1058,7 +994,7 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
CHAR name[32];
OPM_Write('(');
if (obj == NIL || obj->mode == 13) {
- OPM_WriteString((CHAR*)"void", (LONGINT)5);
+ OPM_WriteString((CHAR*)"void", 5);
} else {
for (;;) {
OPC_DeclareBase(obj);
@@ -1066,25 +1002,25 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
OPM_Write(' ');
OPC_DeclareObj(obj, 0);
} else {
- __COPY(obj->name, name, ((LONGINT)(32)));
+ __COPY(obj->name, name, 32);
obj->name[0] = 0x00;
OPC_DeclareObj(obj, 0);
- __COPY(name, obj->name, ((LONGINT)(256)));
+ __COPY(name, obj->name, 256);
}
if (obj->typ->comp == 3) {
- OPM_WriteString((CHAR*)", LONGINT ", (LONGINT)11);
+ OPM_WriteString((CHAR*)", LONGINT ", 11);
OPC_LenList(obj, 1, showParamNames);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
- OPM_WriteString((CHAR*)", LONGINT *", (LONGINT)12);
+ OPM_WriteString((CHAR*)", ADDRESS *", 12);
if (showParamNames) {
OPC_Ident(obj);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
}
}
if (obj->link == NIL || obj->link->mode == 13) {
break;
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
obj = obj->link;
}
}
@@ -1094,42 +1030,31 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define)
{
if (proc->typ == OPT_notyp) {
- OPM_WriteString((CHAR*)"void", (LONGINT)5);
+ OPM_WriteString((CHAR*)"void", 5);
} else {
OPC_Ident(proc->typ->strobj);
}
OPM_Write(' ');
OPC_Ident(proc);
OPM_Write(' ');
- if (OPC_ansi) {
- OPC_AnsiParamList(proc->link, 1);
- if (!define) {
- OPM_Write(';');
- }
- OPM_WriteLn();
- } else if (define) {
- OPC_DeclareParams(proc->link, 0);
- OPM_WriteLn();
- OPC_Indent(1);
- OPC_IdentList(proc->link, 2);
- OPC_Indent(-1);
- } else {
- OPM_WriteString((CHAR*)"();", (LONGINT)4);
- OPM_WriteLn();
+ OPC_AnsiParamList(proc->link, 1);
+ if (!define) {
+ OPM_Write(';');
}
+ OPM_WriteLn();
}
-static void OPC_ProcPredefs (OPT_Object obj, SHORTINT vis)
+static void OPC_ProcPredefs (OPT_Object obj, INT8 vis)
{
if (obj != NIL) {
OPC_ProcPredefs(obj->left, vis);
- if ((((__IN(obj->mode, 0xc0) && obj->vis >= vis)) && (obj->history != 4 || obj->mode == 6))) {
+ if ((((__IN(obj->mode, 0xc0, 32) && obj->vis >= vis)) && (obj->history != 4 || obj->mode == 6))) {
if (vis == 1) {
- OPM_WriteString((CHAR*)"import ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"import ", 8);
} else if (obj->vis == 0) {
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"static ", 8);
} else {
- OPM_WriteString((CHAR*)"export ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"export ", 8);
}
OPC_ProcHeader(obj, 0);
}
@@ -1140,27 +1065,27 @@ static void OPC_ProcPredefs (OPT_Object obj, SHORTINT vis)
static void OPC_Include (CHAR *name, LONGINT name__len)
{
__DUP(name, name__len, CHAR);
- OPM_WriteString((CHAR*)"#include ", (LONGINT)10);
+ OPM_WriteString((CHAR*)"#include ", 10);
OPM_Write('"');
OPM_WriteStringVar((void*)name, name__len);
- OPM_WriteString((CHAR*)".h", (LONGINT)3);
+ OPM_WriteString((CHAR*)".h", 3);
OPM_Write('"');
OPM_WriteLn();
__DEL(name);
}
-static void OPC_IncludeImports (OPT_Object obj, INTEGER vis)
+static void OPC_IncludeImports (OPT_Object obj, INT16 vis)
{
if (obj != NIL) {
OPC_IncludeImports(obj->left, vis);
- if ((((obj->mode == 11 && obj->mnolev != 0)) && (int)OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->vis >= vis)) {
- OPC_Include(OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, ((LONGINT)(256)));
+ if ((((obj->mode == 11 && obj->mnolev != 0)) && (INT16)OPT_GlbMod[__X(-obj->mnolev, 64)]->vis >= vis)) {
+ OPC_Include(OPT_GlbMod[__X(-obj->mnolev, 64)]->name, 256);
}
OPC_IncludeImports(obj->right, vis);
}
}
-static void OPC_GenDynTypes (OPT_Node n, INTEGER vis)
+static void OPC_GenDynTypes (OPT_Node n, INT16 vis)
{
OPT_Struct typ = NIL;
while ((n != NIL && n->class == 14)) {
@@ -1168,15 +1093,15 @@ static void OPC_GenDynTypes (OPT_Node n, INTEGER vis)
if (vis == 0 || typ->ref < 255) {
OPC_BegStat();
if (vis == 1) {
- OPM_WriteString((CHAR*)"import ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"import ", 8);
} else if ((typ->strobj != NIL && typ->strobj->mnolev > 0)) {
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"static ", 8);
} else {
- OPM_WriteString((CHAR*)"export ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"export ", 8);
}
- OPM_WriteString((CHAR*)"LONGINT *", (LONGINT)10);
+ OPM_WriteString((CHAR*)"ADDRESS *", 10);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
OPC_EndStat();
}
n = n->link;
@@ -1194,29 +1119,30 @@ void OPC_GenHdr (OPT_Node n)
OPC_GenDynTypes(n, 1);
OPM_WriteLn();
OPC_ProcPredefs(OPT_topScope->right, 1);
- OPM_WriteString((CHAR*)"import ", (LONGINT)8);
- OPM_WriteString((CHAR*)"void *", (LONGINT)7);
- OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32)));
- OPM_WriteString(OPC_BodyNameExt, ((LONGINT)(13)));
+ OPM_WriteString((CHAR*)"import ", 8);
+ OPM_WriteString((CHAR*)"void *", 7);
+ OPM_WriteStringVar((void*)OPM_modName, 32);
+ OPM_WriteString(OPC_BodyNameExt, 13);
OPC_EndStat();
OPM_WriteLn();
OPC_CProcDefs(OPT_topScope->right, 1);
OPM_WriteLn();
- OPM_WriteString((CHAR*)"#endif", (LONGINT)7);
+ OPM_WriteString((CHAR*)"#endif // ", 11);
+ OPM_WriteStringVar((void*)OPM_modName, 32);
OPM_WriteLn();
}
static void OPC_GenHeaderMsg (void)
{
- INTEGER i;
- OPM_WriteString((CHAR*)"/* ", (LONGINT)4);
- OPM_WriteString((CHAR*)"voc", (LONGINT)4);
+ INT16 i;
+ OPM_WriteString((CHAR*)"/* ", 4);
+ OPM_WriteString((CHAR*)"voc", 4);
OPM_Write(' ');
- OPM_WriteString(Configuration_versionLong, ((LONGINT)(41)));
+ OPM_WriteString(Configuration_versionLong, 75);
OPM_Write(' ');
i = 0;
while (i <= 31) {
- if (__IN(i, OPM_glbopt)) {
+ if (__IN(i, OPM_Options, 32)) {
switch (i) {
case 0:
OPM_Write('x');
@@ -1233,9 +1159,6 @@ static void OPC_GenHeaderMsg (void)
case 5:
OPM_Write('p');
break;
- case 6:
- OPM_Write('k');
- break;
case 7:
OPM_Write('a');
break;
@@ -1264,14 +1187,14 @@ static void OPC_GenHeaderMsg (void)
OPM_Write('v');
break;
default:
- OPM_LogWStr((CHAR*)"( more options defined in OPM than checked in OPC.GenHeaderMsg, if you are a compiler developer, add them to OPC.GenHeaderMsg", (LONGINT)126);
+ OPM_LogWStr((CHAR*)"( more options defined in OPM than checked in OPC.GenHeaderMsg, if you are a compiler developer, add them to OPC.GenHeaderMsg", 126);
OPM_LogWLn();
break;
}
}
i += 1;
}
- OPM_WriteString((CHAR*)" */", (LONGINT)4);
+ OPM_WriteString((CHAR*)" */", 4);
OPM_WriteLn();
}
@@ -1280,20 +1203,16 @@ void OPC_GenHdrIncludes (void)
OPM_currFile = 2;
OPC_GenHeaderMsg();
OPM_WriteLn();
- OPM_WriteString((CHAR*)"#ifndef ", (LONGINT)9);
- OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32)));
- OPM_WriteString((CHAR*)"__h", (LONGINT)4);
+ OPM_WriteString((CHAR*)"#ifndef ", 9);
+ OPM_WriteStringVar((void*)OPM_modName, 32);
+ OPM_WriteString((CHAR*)"__h", 4);
OPM_WriteLn();
- OPM_WriteString((CHAR*)"#define ", (LONGINT)9);
- OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32)));
- OPM_WriteString((CHAR*)"__h", (LONGINT)4);
+ OPM_WriteString((CHAR*)"#define ", 9);
+ OPM_WriteStringVar((void*)OPM_modName, 32);
+ OPM_WriteString((CHAR*)"__h", 4);
OPM_WriteLn();
OPM_WriteLn();
- if (OPM_LIntSize == 8) {
- OPM_WriteString((CHAR*)"#define LARGE", (LONGINT)14);
- OPM_WriteLn();
- }
- OPC_Include((CHAR*)"SYSTEM", (LONGINT)7);
+ OPC_Include((CHAR*)"SYSTEM", 7);
OPC_IncludeImports(OPT_topScope->right, 1);
OPM_WriteLn();
}
@@ -1302,11 +1221,21 @@ void OPC_GenBdy (OPT_Node n)
{
OPM_currFile = 1;
OPC_GenHeaderMsg();
- if (OPM_LIntSize == 8) {
- OPM_WriteString((CHAR*)"#define LARGE", (LONGINT)14);
- OPM_WriteLn();
- }
- OPC_Include((CHAR*)"SYSTEM", (LONGINT)7);
+ OPM_WriteLn();
+ OPM_WriteString((CHAR*)"#define SHORTINT INT", 21);
+ OPM_WriteInt(__ASHL(OPT_sinttyp->size, 3));
+ OPM_WriteLn();
+ OPM_WriteString((CHAR*)"#define INTEGER INT", 21);
+ OPM_WriteInt(__ASHL(OPT_inttyp->size, 3));
+ OPM_WriteLn();
+ OPM_WriteString((CHAR*)"#define LONGINT INT", 21);
+ OPM_WriteInt(__ASHL(OPT_linttyp->size, 3));
+ OPM_WriteLn();
+ OPM_WriteString((CHAR*)"#define SET UINT", 22);
+ OPM_WriteInt(__ASHL(OPT_settyp->size, 3));
+ OPM_WriteLn();
+ OPM_WriteLn();
+ OPC_Include((CHAR*)"SYSTEM", 7);
OPC_IncludeImports(OPT_topScope->right, 0);
OPM_WriteLn();
OPC_DefAnonRecs(n);
@@ -1329,9 +1258,9 @@ static void OPC_RegCmds (OPT_Object obj)
if ((obj->mode == 7 && obj->history != 4)) {
if ((((obj->vis != 0 && obj->link == NIL)) && obj->typ == OPT_notyp)) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"__REGCMD(\"", (LONGINT)11);
- OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"\", ", (LONGINT)4);
+ OPM_WriteString((CHAR*)"__REGCMD(\"", 11);
+ OPM_WriteStringVar((void*)obj->name, 256);
+ OPM_WriteString((CHAR*)"\", ", 4);
OPC_Ident(obj);
OPM_Write(')');
OPC_EndStat();
@@ -1347,8 +1276,8 @@ static void OPC_InitImports (OPT_Object obj)
OPC_InitImports(obj->left);
if ((obj->mode == 11 && obj->mnolev != 0)) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"__MODULE_IMPORT(", (LONGINT)17);
- OPM_WriteStringVar((void*)OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, ((LONGINT)(256)));
+ OPM_WriteString((CHAR*)"__MODULE_IMPORT(", 17);
+ OPM_WriteStringVar((void*)OPT_GlbMod[__X(-obj->mnolev, 64)]->name, 256);
OPM_Write(')');
OPC_EndStat();
}
@@ -1359,38 +1288,30 @@ static void OPC_InitImports (OPT_Object obj)
void OPC_GenEnumPtrs (OPT_Object var)
{
OPT_Struct typ = NIL;
- LONGINT n;
+ INT32 n;
OPC_GlbPtrs = 0;
while (var != NIL) {
typ = var->typ;
if (OPC_NofPtrs(typ) > 0) {
if (!OPC_GlbPtrs) {
OPC_GlbPtrs = 1;
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
- if (OPC_ansi) {
- OPM_WriteString((CHAR*)"void EnumPtrs(void (*P)(void*))", (LONGINT)32);
- } else {
- OPM_WriteString((CHAR*)"void EnumPtrs(P)", (LONGINT)17);
- OPM_WriteLn();
- OPM_Write(0x09);
- OPM_WriteString((CHAR*)"void (*P)();", (LONGINT)13);
- }
+ OPM_WriteString((CHAR*)"static void EnumPtrs(void (*P)(void*))", 39);
OPM_WriteLn();
OPC_BegBlk();
}
OPC_BegStat();
- if (typ->form == 13) {
- OPM_WriteString((CHAR*)"P(", (LONGINT)3);
+ if (typ->form == 11) {
+ OPM_WriteString((CHAR*)"P(", 3);
OPC_Ident(var);
OPM_Write(')');
} else if (typ->comp == 4) {
- OPM_WriteString((CHAR*)"__ENUMR(&", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__ENUMR(&", 10);
OPC_Ident(var);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
- OPC_Str1((CHAR*)", #", (LONGINT)4, typ->size);
- OPM_WriteString((CHAR*)", 1, P)", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__typ", 6);
+ OPC_Str1((CHAR*)", #", 4, typ->size);
+ OPM_WriteString((CHAR*)", 1, P)", 8);
} else if (typ->comp == 2) {
n = typ->n;
typ = typ->BaseTyp;
@@ -1398,18 +1319,18 @@ void OPC_GenEnumPtrs (OPT_Object var)
n = n * typ->n;
typ = typ->BaseTyp;
}
- if (typ->form == 13) {
- OPM_WriteString((CHAR*)"__ENUMP(", (LONGINT)9);
+ if (typ->form == 11) {
+ OPM_WriteString((CHAR*)"__ENUMP(", 9);
OPC_Ident(var);
- OPC_Str1((CHAR*)", #, P)", (LONGINT)8, n);
+ OPC_Str1((CHAR*)", #, P)", 8, n);
} else if (typ->comp == 4) {
- OPM_WriteString((CHAR*)"__ENUMR(", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__ENUMR(", 9);
OPC_Ident(var);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
- OPC_Str1((CHAR*)", #", (LONGINT)4, typ->size);
- OPC_Str1((CHAR*)", #, P)", (LONGINT)8, n);
+ OPM_WriteString((CHAR*)"__typ", 6);
+ OPC_Str1((CHAR*)", #", 4, typ->size);
+ OPC_Str1((CHAR*)", #, P)", 8, n);
}
}
OPC_EndStat();
@@ -1425,49 +1346,41 @@ void OPC_GenEnumPtrs (OPT_Object var)
void OPC_EnterBody (void)
{
OPM_WriteLn();
- OPM_WriteString((CHAR*)"export ", (LONGINT)8);
- if (OPC_mainprog) {
- if (OPC_ansi) {
- OPM_WriteString((CHAR*)"int main(int argc, char **argv)", (LONGINT)32);
- OPM_WriteLn();
- } else {
- OPM_WriteString((CHAR*)"main(argc, argv)", (LONGINT)17);
- OPM_WriteLn();
- OPM_Write(0x09);
- OPM_WriteString((CHAR*)"int argc; char **argv;", (LONGINT)23);
- OPM_WriteLn();
- }
+ OPM_WriteString((CHAR*)"export ", 8);
+ if (__IN(10, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"int main(int argc, char **argv)", 32);
+ OPM_WriteLn();
} else {
- OPM_WriteString((CHAR*)"void *", (LONGINT)7);
- OPM_WriteString(OPM_modName, ((LONGINT)(32)));
- OPM_WriteString(OPC_BodyNameExt, ((LONGINT)(13)));
+ OPM_WriteString((CHAR*)"void *", 7);
+ OPM_WriteString(OPM_modName, 32);
+ OPM_WriteString(OPC_BodyNameExt, 13);
OPM_WriteLn();
}
OPC_BegBlk();
OPC_BegStat();
- if (OPC_mainprog) {
- OPM_WriteString((CHAR*)"__INIT(argc, argv)", (LONGINT)19);
+ if (__IN(10, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__INIT(argc, argv)", 19);
} else {
- OPM_WriteString((CHAR*)"__DEFMOD", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__DEFMOD", 9);
}
OPC_EndStat();
- if ((OPC_mainprog && 0)) {
+ if ((__IN(10, OPM_Options, 32) && 0)) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"/*don`t do it!*/ printf(\"DEMO VERSION: DO NOT USE THIS PROGRAM FOR ANY COMMERCIAL PURPOSE\\n\")", (LONGINT)94);
+ OPM_WriteString((CHAR*)"/*don`t do it!*/ printf(\"DEMO VERSION: DO NOT USE THIS PROGRAM FOR ANY COMMERCIAL PURPOSE\\n\")", 94);
OPC_EndStat();
}
OPC_InitImports(OPT_topScope->right);
OPC_BegStat();
- if (OPC_mainprog) {
- OPM_WriteString((CHAR*)"__REGMAIN(\"", (LONGINT)12);
+ if (__IN(10, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__REGMAIN(\"", 12);
} else {
- OPM_WriteString((CHAR*)"__REGMOD(\"", (LONGINT)11);
+ OPM_WriteString((CHAR*)"__REGMOD(\"", 11);
}
- OPM_WriteString(OPM_modName, ((LONGINT)(32)));
+ OPM_WriteString(OPM_modName, 32);
if (OPC_GlbPtrs) {
- OPM_WriteString((CHAR*)"\", EnumPtrs)", (LONGINT)13);
+ OPM_WriteString((CHAR*)"\", EnumPtrs)", 13);
} else {
- OPM_WriteString((CHAR*)"\", 0)", (LONGINT)6);
+ OPM_WriteString((CHAR*)"\", 0)", 6);
}
OPC_EndStat();
if (__STRCMP(OPM_modName, "SYSTEM") != 0) {
@@ -1478,10 +1391,10 @@ void OPC_EnterBody (void)
void OPC_ExitBody (void)
{
OPC_BegStat();
- if (OPC_mainprog) {
- OPM_WriteString((CHAR*)"__FINI;", (LONGINT)8);
+ if (__IN(10, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__FINI;", 8);
} else {
- OPM_WriteString((CHAR*)"__ENDMOD;", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__ENDMOD;", 10);
}
OPM_WriteLn();
OPC_EndBlk();
@@ -1491,55 +1404,60 @@ void OPC_DefineInter (OPT_Object proc)
{
OPT_Object scope = NIL;
scope = proc->scope;
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
- OPM_WriteString((CHAR*)"struct ", (LONGINT)8);
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
+ OPM_WriteString((CHAR*)"static ", 8);
+ OPM_WriteString((CHAR*)"struct ", 8);
+ OPM_WriteStringVar((void*)scope->name, 256);
OPM_Write(' ');
OPC_BegBlk();
OPC_IdentList(proc->link, 3);
OPC_IdentList(scope->scope, 3);
OPC_BegStat();
- OPM_WriteString((CHAR*)"struct ", (LONGINT)8);
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
+ OPM_WriteString((CHAR*)"struct ", 8);
+ OPM_WriteStringVar((void*)scope->name, 256);
OPM_Write(' ');
OPM_Write('*');
- OPM_WriteString((CHAR*)"lnk", (LONGINT)4);
+ OPM_WriteString((CHAR*)"lnk", 4);
OPC_EndStat();
OPC_EndBlk0();
OPM_Write(' ');
OPM_Write('*');
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteStringVar((void*)scope->name, 256);
+ OPM_WriteString((CHAR*)"_s", 3);
OPC_EndStat();
OPM_WriteLn();
OPC_ProcPredefs(scope->right, 0);
OPM_WriteLn();
}
+BOOLEAN OPC_NeedsRetval (OPT_Object proc)
+{
+ return (proc->typ != OPT_notyp && !proc->scope->leaf);
+}
+
void OPC_EnterProc (OPT_Object proc)
{
OPT_Object var = NIL, scope = NIL;
OPT_Struct typ = NIL;
- INTEGER dim;
+ INT16 dim;
if (proc->vis != 1) {
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"static ", 8);
}
OPC_ProcHeader(proc, 1);
OPC_BegBlk();
- if (proc->typ != OPT_notyp) {
- OPC_BegStat();
- OPC_Ident(proc->typ->strobj);
- OPM_WriteString((CHAR*)" _o_result;", (LONGINT)12);
- OPM_WriteLn();
- }
scope = proc->scope;
OPC_IdentList(scope->scope, 0);
if (!scope->leaf) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"struct ", (LONGINT)8);
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
+ OPM_WriteString((CHAR*)"struct ", 8);
+ OPM_WriteStringVar((void*)scope->name, 256);
OPM_Write(' ');
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"_s", 3);
+ OPC_EndStat();
+ }
+ if (OPC_NeedsRetval(proc)) {
+ OPC_BegStat();
+ OPC_Ident(proc->typ->strobj);
+ OPM_WriteString((CHAR*)" __retval", 10);
OPC_EndStat();
}
var = proc->link;
@@ -1553,56 +1471,41 @@ void OPC_EnterProc (OPT_Object proc)
}
OPM_Write(' ');
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__copy", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__copy", 7);
OPC_EndStat();
}
var = var->link;
}
- if (!OPC_ansi) {
- var = proc->link;
- while (var != NIL) {
- if ((var->typ->form == 7 && var->mode == 1)) {
- OPC_BegStat();
- OPC_Ident(var->typ->strobj);
- OPM_Write(' ');
- OPC_Ident(var);
- OPM_WriteString((CHAR*)" = _", (LONGINT)5);
- OPC_Ident(var);
- OPC_EndStat();
- }
- var = var->link;
- }
- }
var = proc->link;
while (var != NIL) {
- if ((((__IN(var->typ->comp, 0x0c) && var->mode == 1)) && var->typ->sysflag == 0)) {
+ if ((((__IN(var->typ->comp, 0x0c, 32) && var->mode == 1)) && var->typ->sysflag == 0)) {
OPC_BegStat();
if (var->typ->comp == 2) {
- OPM_WriteString((CHAR*)"__DUPARR(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__DUPARR(", 10);
OPC_Ident(var);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
if (var->typ->strobj == NIL) {
OPM_Mark(200, var->typ->txtpos);
} else {
OPC_Ident(var->typ->strobj);
}
} else {
- OPM_WriteString((CHAR*)"__DUP(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__DUP(", 7);
OPC_Ident(var);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
typ = var->typ->BaseTyp;
dim = 1;
while (typ->comp == 3) {
- OPM_WriteString((CHAR*)" * ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" * ", 4);
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
OPM_WriteInt(dim);
typ = typ->BaseTyp;
dim += 1;
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
if (typ->strobj == NIL) {
OPM_Mark(200, typ->txtpos);
} else {
@@ -1619,12 +1522,12 @@ void OPC_EnterProc (OPT_Object proc)
while (var != NIL) {
if (!var->leaf) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
OPC_Ident(var);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
- if (__IN(var->typ->comp, 0x0c)) {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
+ OPM_WriteString((CHAR*)" = ", 4);
+ if (__IN(var->typ->comp, 0x0c, 32)) {
+ OPM_WriteString((CHAR*)"(void*)", 8);
} else if (var->mode != 2) {
OPM_Write('&');
}
@@ -1633,31 +1536,31 @@ void OPC_EnterProc (OPT_Object proc)
typ = var->typ;
dim = 0;
do {
- OPM_WriteString((CHAR*)"; ", (LONGINT)3);
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"; ", 3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
if (dim != 0) {
OPM_WriteInt(dim);
}
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" = ", 4);
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
if (dim != 0) {
OPM_WriteInt(dim);
}
typ = typ->BaseTyp;
} while (!(typ->comp != 3));
} else if ((var->mode == 2 && var->typ->comp == 4)) {
- OPM_WriteString((CHAR*)"; ", (LONGINT)3);
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"; ", 3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteString((CHAR*)"__typ", 6);
+ OPM_WriteString((CHAR*)" = ", 4);
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
}
OPC_EndStat();
}
@@ -1667,14 +1570,14 @@ void OPC_EnterProc (OPT_Object proc)
while (var != NIL) {
if (!var->leaf) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
OPC_Ident(var);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" = ", 4);
if (var->typ->comp != 2) {
OPM_Write('&');
} else {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
+ OPM_WriteString((CHAR*)"(void*)", 8);
}
OPC_Ident(var);
OPC_EndStat();
@@ -1682,19 +1585,19 @@ void OPC_EnterProc (OPT_Object proc)
var = var->link;
}
OPC_BegStat();
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
- OPM_WriteString((CHAR*)"lnk", (LONGINT)4);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"lnk", 4);
+ OPM_WriteString((CHAR*)" = ", 4);
+ OPM_WriteStringVar((void*)scope->name, 256);
+ OPM_WriteString((CHAR*)"_s", 3);
OPC_EndStat();
OPC_BegStat();
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteStringVar((void*)scope->name, 256);
+ OPM_WriteString((CHAR*)"_s", 3);
+ OPM_WriteString((CHAR*)" = ", 4);
OPM_Write('&');
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPC_EndStat();
}
}
@@ -1706,7 +1609,7 @@ void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet)
indent = eoBlock;
if ((implicitRet && proc->typ != OPT_notyp)) {
OPM_Write(0x09);
- OPM_WriteString((CHAR*)"__RETCHK;", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__RETCHK;", 10);
OPM_WriteLn();
} else if (!eoBlock || implicitRet) {
if (!proc->scope->leaf) {
@@ -1715,12 +1618,12 @@ void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet)
} else {
indent = 1;
}
- OPM_WriteStringVar((void*)proc->scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteStringVar((void*)proc->scope->name, 256);
+ OPM_WriteString((CHAR*)"_s", 3);
+ OPM_WriteString((CHAR*)" = ", 4);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
- OPM_WriteString((CHAR*)"lnk", (LONGINT)4);
+ OPM_WriteString((CHAR*)"lnk", 4);
OPC_EndStat();
}
var = proc->link;
@@ -1731,7 +1634,7 @@ void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet)
} else {
indent = 1;
}
- OPM_WriteString((CHAR*)"__DEL(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__DEL(", 7);
OPC_Ident(var);
OPM_Write(')');
OPC_EndStat();
@@ -1749,14 +1652,14 @@ void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet)
void OPC_CompleteIdent (OPT_Object obj)
{
- INTEGER comp, level;
+ INT16 comp, level;
level = obj->mnolev;
if (obj->adr == 1) {
if (obj->typ->comp == 4) {
OPC_Ident(obj);
- OPM_WriteString((CHAR*)"__", (LONGINT)3);
+ OPM_WriteString((CHAR*)"__", 3);
} else {
- OPM_WriteString((CHAR*)"((", (LONGINT)3);
+ OPM_WriteString((CHAR*)"((", 3);
OPC_Ident(obj->typ->strobj);
OPM_Write(')');
OPC_Ident(obj);
@@ -1767,9 +1670,9 @@ void OPC_CompleteIdent (OPT_Object obj)
if ((obj->mode != 2 && comp != 3)) {
OPM_Write('*');
}
- OPM_WriteStringVar((void*)obj->scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
- OPM_WriteString((CHAR*)"->", (LONGINT)3);
+ OPM_WriteStringVar((void*)obj->scope->name, 256);
+ OPM_WriteString((CHAR*)"_s", 3);
+ OPM_WriteString((CHAR*)"->", 3);
OPC_Ident(obj);
} else {
OPC_Ident(obj);
@@ -1778,58 +1681,58 @@ void OPC_CompleteIdent (OPT_Object obj)
void OPC_TypeOf (OPT_Object ap)
{
- INTEGER i;
+ INT16 i;
__ASSERT(ap->typ->comp == 4, 0);
if (ap->mode == 2) {
- if ((int)ap->mnolev != OPM_level) {
- OPM_WriteStringVar((void*)ap->scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s->", (LONGINT)5);
+ if ((INT16)ap->mnolev != OPM_level) {
+ OPM_WriteStringVar((void*)ap->scope->name, 256);
+ OPM_WriteString((CHAR*)"_s->", 5);
OPC_Ident(ap);
} else {
OPC_Ident(ap);
}
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
} else if (ap->typ->strobj != NIL) {
OPC_Ident(ap->typ->strobj);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
} else {
OPC_Andent(ap->typ);
}
}
-void OPC_Cmp (INTEGER rel)
+void OPC_Cmp (INT16 rel)
{
switch (rel) {
case 9:
- OPM_WriteString((CHAR*)" == ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" == ", 5);
break;
case 10:
- OPM_WriteString((CHAR*)" != ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" != ", 5);
break;
case 11:
- OPM_WriteString((CHAR*)" < ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" < ", 4);
break;
case 12:
- OPM_WriteString((CHAR*)" <= ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" <= ", 5);
break;
case 13:
- OPM_WriteString((CHAR*)" > ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" > ", 4);
break;
case 14:
- OPM_WriteString((CHAR*)" >= ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" >= ", 5);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPC.Cmp, rel = ", (LONGINT)34);
- OPM_LogWNum(rel, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPC.Cmp, rel = ", 34);
+ OPM_LogWNum(rel, 0);
OPM_LogWLn();
break;
}
}
-static void OPC_CharacterLiteral (LONGINT c)
+static void OPC_CharacterLiteral (INT64 c)
{
if (c < 32 || c > 126) {
- OPM_WriteString((CHAR*)"0x", (LONGINT)3);
+ OPM_WriteString((CHAR*)"0x", 3);
OPM_WriteHex(c);
} else {
OPM_Write('\'');
@@ -1841,15 +1744,15 @@ static void OPC_CharacterLiteral (LONGINT c)
}
}
-static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l)
+static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l)
{
- LONGINT i;
- INTEGER c;
+ INT32 i;
+ INT16 c;
__DUP(s, s__len, CHAR);
OPM_Write('"');
i = 0;
while (i < l) {
- c = (int)s[__X(i, s__len)];
+ c = (INT16)s[__X(i, s__len)];
if (c < 32 || c > 126) {
OPM_Write('\\');
OPM_Write((CHAR)(48 + __ASHR(c, 6)));
@@ -1869,54 +1772,67 @@ static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l)
__DEL(s);
}
-void OPC_Case (LONGINT caseVal, INTEGER form)
+void OPC_Case (INT64 caseVal, INT16 form)
{
CHAR ch;
- OPM_WriteString((CHAR*)"case ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"case ", 6);
switch (form) {
case 3:
OPC_CharacterLiteral(caseVal);
break;
- case 4: case 5: case 6:
+ case 4:
OPM_WriteInt(caseVal);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPC.Case, form = ", (LONGINT)36);
- OPM_LogWNum(form, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPC.Case, form = ", 36);
+ OPM_LogWNum(form, 0);
OPM_LogWLn();
break;
}
- OPM_WriteString((CHAR*)": ", (LONGINT)3);
+ OPM_WriteString((CHAR*)": ", 3);
}
void OPC_SetInclude (BOOLEAN exclude)
{
if (exclude) {
- OPM_WriteString((CHAR*)" &= ~", (LONGINT)6);
+ OPM_WriteString((CHAR*)" &= ~", 6);
} else {
- OPM_WriteString((CHAR*)" |= ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" |= ", 5);
}
}
void OPC_Increment (BOOLEAN decrement)
{
if (decrement) {
- OPM_WriteString((CHAR*)" -= ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" -= ", 5);
} else {
- OPM_WriteString((CHAR*)" += ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" += ", 5);
}
}
-void OPC_Halt (LONGINT n)
+void OPC_Halt (INT32 n)
{
- OPC_Str1((CHAR*)"__HALT(#)", (LONGINT)10, n);
+ OPC_Str1((CHAR*)"__HALT(#)", 10, n);
}
-void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim)
+void OPC_IntLiteral (INT64 n, INT32 size)
+{
+ if ((((size > 4 && n <= 2147483647)) && n > (-2147483647-1))) {
+ OPM_WriteString((CHAR*)"((INT", 6);
+ OPM_WriteInt(__ASHL(size, 3));
+ OPM_WriteString((CHAR*)")(", 3);
+ OPM_WriteInt(n);
+ OPM_WriteString((CHAR*)"))", 3);
+ } else {
+ OPM_WriteInt(n);
+ }
+}
+
+void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim)
{
if (array->comp == 3) {
OPC_CompleteIdent(obj);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
if (dim != 0) {
OPM_WriteInt(dim);
}
@@ -1925,17 +1841,15 @@ void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim)
array = array->BaseTyp;
dim -= 1;
}
- OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12);
OPM_WriteInt(array->n);
- OPM_WriteString((CHAR*)"))", (LONGINT)3);
}
}
-void OPC_Constant (OPT_Const con, INTEGER form)
+void OPC_Constant (OPT_Const con, INT16 form)
{
- INTEGER i;
- SET s;
- LONGINT hex;
+ INT16 i;
+ UINT64 s;
+ INT64 hex;
BOOLEAN skipLeading;
switch (form) {
case 1:
@@ -1947,26 +1861,26 @@ void OPC_Constant (OPT_Const con, INTEGER form)
case 3:
OPC_CharacterLiteral(con->intval);
break;
- case 4: case 5: case 6:
+ case 4:
OPM_WriteInt(con->intval);
break;
- case 7:
+ case 5:
OPM_WriteReal(con->realval, 'f');
break;
- case 8:
+ case 6:
OPM_WriteReal(con->realval, 0x00);
break;
- case 9:
- OPM_WriteString((CHAR*)"0x", (LONGINT)3);
+ case 7:
+ OPM_WriteString((CHAR*)"0x", 3);
skipLeading = 1;
s = con->setval;
- i = 32;
+ i = 64;
do {
hex = 0;
do {
i -= 1;
hex = __ASHL(hex, 1);
- if (__IN(i, s)) {
+ if (__IN(i, s, 64)) {
hex += 1;
}
} while (!(__MASK(i, -8) == 0));
@@ -1979,88 +1893,98 @@ void OPC_Constant (OPT_Const con, INTEGER form)
OPM_Write('0');
}
break;
- case 10:
- OPC_StringLiteral(*con->ext, ((LONGINT)(256)), con->intval2 - 1);
+ case 8:
+ OPC_StringLiteral(*con->ext, 256, con->intval2 - 1);
break;
- case 11:
- OPM_WriteString((CHAR*)"NIL", (LONGINT)4);
+ case 9:
+ OPM_WriteString((CHAR*)"NIL", 4);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPC.Constant, form = ", (LONGINT)40);
- OPM_LogWNum(form, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPC.Constant, form = ", 40);
+ OPM_LogWNum(form, 0);
OPM_LogWLn();
break;
}
}
-static struct InitKeywords__48 {
- SHORTINT *n;
- struct InitKeywords__48 *lnk;
-} *InitKeywords__48_s;
+static struct InitKeywords__46 {
+ INT8 *n;
+ struct InitKeywords__46 *lnk;
+} *InitKeywords__46_s;
-static void Enter__49 (CHAR *s, LONGINT s__len);
+static void Enter__47 (CHAR *s, LONGINT s__len);
-static void Enter__49 (CHAR *s, LONGINT s__len)
+static void Enter__47 (CHAR *s, LONGINT s__len)
{
- INTEGER h;
+ INT16 h;
__DUP(s, s__len, CHAR);
h = OPC_PerfectHash((void*)s, s__len);
- OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__48_s->n;
- __COPY(s, OPC_keytab[__X(*InitKeywords__48_s->n, ((LONGINT)(36)))], ((LONGINT)(9)));
- *InitKeywords__48_s->n += 1;
+ OPC_hashtab[__X(h, 105)] = *InitKeywords__46_s->n;
+ __COPY(s, OPC_keytab[__X(*InitKeywords__46_s->n, 50)], 9);
+ *InitKeywords__46_s->n += 1;
__DEL(s);
}
static void OPC_InitKeywords (void)
{
- SHORTINT n, i;
- struct InitKeywords__48 _s;
+ INT8 n, i;
+ struct InitKeywords__46 _s;
_s.n = &n;
- _s.lnk = InitKeywords__48_s;
- InitKeywords__48_s = &_s;
+ _s.lnk = InitKeywords__46_s;
+ InitKeywords__46_s = &_s;
n = 0;
i = 0;
while (i <= 104) {
- OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1;
+ OPC_hashtab[__X(i, 105)] = -1;
i += 1;
}
- Enter__49((CHAR*)"asm", (LONGINT)4);
- Enter__49((CHAR*)"auto", (LONGINT)5);
- Enter__49((CHAR*)"break", (LONGINT)6);
- Enter__49((CHAR*)"case", (LONGINT)5);
- Enter__49((CHAR*)"char", (LONGINT)5);
- Enter__49((CHAR*)"const", (LONGINT)6);
- Enter__49((CHAR*)"continue", (LONGINT)9);
- Enter__49((CHAR*)"default", (LONGINT)8);
- Enter__49((CHAR*)"do", (LONGINT)3);
- Enter__49((CHAR*)"double", (LONGINT)7);
- Enter__49((CHAR*)"else", (LONGINT)5);
- Enter__49((CHAR*)"enum", (LONGINT)5);
- Enter__49((CHAR*)"extern", (LONGINT)7);
- Enter__49((CHAR*)"export", (LONGINT)7);
- Enter__49((CHAR*)"float", (LONGINT)6);
- Enter__49((CHAR*)"for", (LONGINT)4);
- Enter__49((CHAR*)"fortran", (LONGINT)8);
- Enter__49((CHAR*)"goto", (LONGINT)5);
- Enter__49((CHAR*)"if", (LONGINT)3);
- Enter__49((CHAR*)"import", (LONGINT)7);
- Enter__49((CHAR*)"int", (LONGINT)4);
- Enter__49((CHAR*)"long", (LONGINT)5);
- Enter__49((CHAR*)"register", (LONGINT)9);
- Enter__49((CHAR*)"return", (LONGINT)7);
- Enter__49((CHAR*)"short", (LONGINT)6);
- Enter__49((CHAR*)"signed", (LONGINT)7);
- Enter__49((CHAR*)"sizeof", (LONGINT)7);
- Enter__49((CHAR*)"static", (LONGINT)7);
- Enter__49((CHAR*)"struct", (LONGINT)7);
- Enter__49((CHAR*)"switch", (LONGINT)7);
- Enter__49((CHAR*)"typedef", (LONGINT)8);
- Enter__49((CHAR*)"union", (LONGINT)6);
- Enter__49((CHAR*)"unsigned", (LONGINT)9);
- Enter__49((CHAR*)"void", (LONGINT)5);
- Enter__49((CHAR*)"volatile", (LONGINT)9);
- Enter__49((CHAR*)"while", (LONGINT)6);
- InitKeywords__48_s = _s.lnk;
+ Enter__47((CHAR*)"ADDRESS", 8);
+ Enter__47((CHAR*)"INT16", 6);
+ Enter__47((CHAR*)"INT32", 6);
+ Enter__47((CHAR*)"INT64", 6);
+ Enter__47((CHAR*)"INT8", 5);
+ Enter__47((CHAR*)"UINT16", 7);
+ Enter__47((CHAR*)"UINT32", 7);
+ Enter__47((CHAR*)"UINT64", 7);
+ Enter__47((CHAR*)"UINT8", 6);
+ Enter__47((CHAR*)"asm", 4);
+ Enter__47((CHAR*)"auto", 5);
+ Enter__47((CHAR*)"break", 6);
+ Enter__47((CHAR*)"case", 5);
+ Enter__47((CHAR*)"char", 5);
+ Enter__47((CHAR*)"const", 6);
+ Enter__47((CHAR*)"continue", 9);
+ Enter__47((CHAR*)"default", 8);
+ Enter__47((CHAR*)"do", 3);
+ Enter__47((CHAR*)"double", 7);
+ Enter__47((CHAR*)"else", 5);
+ Enter__47((CHAR*)"enum", 5);
+ Enter__47((CHAR*)"extern", 7);
+ Enter__47((CHAR*)"export", 7);
+ Enter__47((CHAR*)"float", 6);
+ Enter__47((CHAR*)"for", 4);
+ Enter__47((CHAR*)"fortran", 8);
+ Enter__47((CHAR*)"goto", 5);
+ Enter__47((CHAR*)"if", 3);
+ Enter__47((CHAR*)"import", 7);
+ Enter__47((CHAR*)"int", 4);
+ Enter__47((CHAR*)"long", 5);
+ Enter__47((CHAR*)"register", 9);
+ Enter__47((CHAR*)"return", 7);
+ Enter__47((CHAR*)"short", 6);
+ Enter__47((CHAR*)"signed", 7);
+ Enter__47((CHAR*)"sizeof", 7);
+ Enter__47((CHAR*)"size_t", 7);
+ Enter__47((CHAR*)"static", 7);
+ Enter__47((CHAR*)"struct", 7);
+ Enter__47((CHAR*)"switch", 7);
+ Enter__47((CHAR*)"typedef", 8);
+ Enter__47((CHAR*)"union", 6);
+ Enter__47((CHAR*)"unsigned", 9);
+ Enter__47((CHAR*)"void", 5);
+ Enter__47((CHAR*)"volatile", 9);
+ Enter__47((CHAR*)"while", 6);
+ InitKeywords__46_s = _s.lnk;
}
diff --git a/bootstrap/windows-48/OPC.h b/bootstrap/windows-48/OPC.h
index b7d34a07..842e7dec 100644
--- a/bootstrap/windows-48/OPC.h
+++ b/bootstrap/windows-48/OPC.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPC__h
#define OPC__h
@@ -9,16 +9,14 @@
-import void OPC_Align (LONGINT *adr, LONGINT base);
import void OPC_Andent (OPT_Struct typ);
-import LONGINT OPC_BaseAlignment (OPT_Struct typ);
import OPT_Object OPC_BaseTProc (OPT_Object obj);
import void OPC_BegBlk (void);
import void OPC_BegStat (void);
-import void OPC_Case (LONGINT caseVal, INTEGER form);
-import void OPC_Cmp (INTEGER rel);
+import void OPC_Case (INT64 caseVal, INT16 form);
+import void OPC_Cmp (INT16 rel);
import void OPC_CompleteIdent (OPT_Object obj);
-import void OPC_Constant (OPT_Const con, INTEGER form);
+import void OPC_Constant (OPT_Const con, INT16 form);
import void OPC_DefineInter (OPT_Object proc);
import void OPC_EndBlk (void);
import void OPC_EndBlk0 (void);
@@ -31,20 +29,21 @@ import void OPC_GenBdy (OPT_Node n);
import void OPC_GenEnumPtrs (OPT_Object var);
import void OPC_GenHdr (OPT_Node n);
import void OPC_GenHdrIncludes (void);
-import void OPC_Halt (LONGINT n);
+import void OPC_Halt (INT32 n);
import void OPC_Ident (OPT_Object obj);
import void OPC_Increment (BOOLEAN decrement);
-import void OPC_Indent (INTEGER count);
+import void OPC_Indent (INT16 count);
import void OPC_Init (void);
import void OPC_InitTDesc (OPT_Struct typ);
-import void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim);
-import LONGINT OPC_NofPtrs (OPT_Struct typ);
+import void OPC_IntLiteral (INT64 n, INT32 size);
+import void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim);
+import BOOLEAN OPC_NeedsRetval (OPT_Object proc);
+import INT32 OPC_NofPtrs (OPT_Struct typ);
import void OPC_SetInclude (BOOLEAN exclude);
-import LONGINT OPC_SizeAlignment (LONGINT size);
import void OPC_TDescDecl (OPT_Struct typ);
-import void OPC_TypeDefs (OPT_Object obj, INTEGER vis);
+import void OPC_TypeDefs (OPT_Object obj, INT16 vis);
import void OPC_TypeOf (OPT_Object ap);
import void *OPC__init(void);
-#endif
+#endif // OPC
diff --git a/bootstrap/windows-48/OPM.c b/bootstrap/windows-48/OPM.c
index bf683e41..e76d763e 100644
--- a/bootstrap/windows-48/OPM.c
+++ b/bootstrap/windows-48/OPM.c
@@ -1,305 +1,474 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "Configuration.h"
-#include "Console.h"
#include "Files.h"
+#include "Out.h"
#include "Platform.h"
#include "Strings.h"
#include "Texts.h"
-#include "errors.h"
-#include "vt100.h"
+#include "VT100.h"
typedef
CHAR OPM_FileName[32];
static CHAR OPM_SourceFileName[256];
-export INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_MaxSet;
-export LONGINT OPM_MaxIndex;
+static CHAR OPM_GlobalModel[10];
+export CHAR OPM_Model[10];
+static INT16 OPM_GlobalAddressSize;
+export INT16 OPM_AddressSize;
+static INT16 OPM_GlobalAlignment;
+export INT16 OPM_Alignment;
+export UINT32 OPM_GlobalOptions, OPM_Options;
+export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize;
+export INT64 OPM_MaxIndex;
export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
export BOOLEAN OPM_noerr;
-export LONGINT OPM_curpos, OPM_errpos, OPM_breakpc;
-export INTEGER OPM_currFile, OPM_level, OPM_pc, OPM_entno;
+export INT32 OPM_curpos, OPM_errpos, OPM_breakpc;
+export INT16 OPM_currFile, OPM_level, OPM_pc, OPM_entno;
export CHAR OPM_modName[32];
export CHAR OPM_objname[64];
-export SET OPM_opt, OPM_glbopt;
-static LONGINT OPM_ErrorLineStartPos, OPM_ErrorLineLimitPos, OPM_ErrorLineNumber, OPM_lasterrpos;
+static INT32 OPM_ErrorLineStartPos, OPM_ErrorLineLimitPos, OPM_ErrorLineNumber, OPM_lasterrpos;
static Texts_Reader OPM_inR;
-static Texts_Text OPM_Log;
-static Texts_Writer OPM_W;
+static Texts_Text OPM_Log, OPM_Errors;
static Files_Rider OPM_oldSF, OPM_newSF;
static Files_Rider OPM_R[3];
static Files_File OPM_oldSFile, OPM_newSFile, OPM_HFile, OPM_BFile, OPM_HIFile;
-static INTEGER OPM_S;
-export BOOLEAN OPM_dontAsm, OPM_dontLink, OPM_mainProg, OPM_mainLinkStat, OPM_notColorOutput, OPM_forceNewSym, OPM_Verbose;
-static CHAR OPM_OBERON[1024];
-static CHAR OPM_MODULES[1024];
+static INT16 OPM_S;
+export CHAR OPM_ResourceDir[1024];
-static void OPM_Append (Files_Rider *R, LONGINT *R__typ, Files_File F);
+static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F);
export void OPM_CloseFiles (void);
export void OPM_CloseOldSym (void);
export void OPM_DeleteNewSym (void);
-export void OPM_FPrint (LONGINT *fp, LONGINT val);
-export void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr);
-export void OPM_FPrintReal (LONGINT *fp, REAL real);
-export void OPM_FPrintSet (LONGINT *fp, SET set);
-static void OPM_FindLine (Files_File f, Files_Rider *r, LONGINT *r__typ, LONGINT pos);
+export void OPM_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_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos);
+static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len);
export void OPM_Get (CHAR *ch);
-static void OPM_GetProperties (void);
-static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align);
export void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
export void OPM_InitOptions (void);
-static void OPM_LogErrMsg (INTEGER n);
+export INT16 OPM_Integer (INT64 n);
+static void OPM_LogErrMsg (INT16 n);
+export void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
export void OPM_LogW (CHAR ch);
export void OPM_LogWLn (void);
-export void OPM_LogWNum (LONGINT i, LONGINT len);
+export void OPM_LogWNum (INT64 i, INT64 len);
export void OPM_LogWStr (CHAR *s, LONGINT s__len);
+export INT32 OPM_Longint (INT64 n);
static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len);
-export void OPM_Mark (INTEGER n, LONGINT pos);
+export void OPM_Mark (INT16 n, INT32 pos);
export void OPM_NewSym (CHAR *modName, LONGINT modName__len);
export void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
export void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
export BOOLEAN OPM_OpenPar (void);
export void OPM_RegisterNewSym (void);
-static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt);
-static void OPM_ShowLine (LONGINT pos);
-export LONGINT OPM_SignedMaximum (LONGINT bytecount);
-export LONGINT OPM_SignedMinimum (LONGINT bytecount);
+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_SymRCh (CHAR *ch);
-export LONGINT OPM_SymRInt (void);
+export INT32 OPM_SymRInt (void);
+export INT64 OPM_SymRInt64 (void);
export void OPM_SymRLReal (LONGREAL *lr);
export void OPM_SymRReal (REAL *r);
-export void OPM_SymRSet (SET *s);
+export void OPM_SymRSet (UINT64 *s);
export void OPM_SymWCh (CHAR ch);
-export void OPM_SymWInt (LONGINT i);
+export void OPM_SymWInt (INT64 i);
export void OPM_SymWLReal (LONGREAL lr);
export void OPM_SymWReal (REAL r);
-export void OPM_SymWSet (SET s);
+export void OPM_SymWSet (UINT64 s);
static void OPM_VerboseListSizes (void);
export void OPM_Write (CHAR ch);
-export void OPM_WriteHex (LONGINT i);
-export void OPM_WriteInt (LONGINT i);
+export void OPM_WriteHex (INT64 i);
+export void OPM_WriteInt (INT64 i);
export void OPM_WriteLn (void);
export void OPM_WriteReal (LONGREAL r, CHAR suffx);
export void OPM_WriteString (CHAR *s, LONGINT s__len);
export void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
export BOOLEAN OPM_eofSF (void);
-export void OPM_err (INTEGER n);
-static LONGINT OPM_minusop (LONGINT i);
-static LONGINT OPM_power0 (LONGINT i, LONGINT j);
+export void OPM_err (INT16 n);
+#define OPM_GetAlignment(a) struct {char c; long long l;} _s; *a = (char*)&_s.l - (char*)&_s
void OPM_LogW (CHAR ch)
{
- Console_Char(ch);
+ Out_Char(ch);
}
void OPM_LogWStr (CHAR *s, LONGINT s__len)
{
__DUP(s, s__len, CHAR);
- Console_String(s, s__len);
+ Out_String(s, s__len);
__DEL(s);
}
-void OPM_LogWNum (LONGINT i, LONGINT len)
+void OPM_LogWNum (INT64 i, INT64 len)
{
- Console_Int(i, len);
+ Out_Int(i, len);
}
void OPM_LogWLn (void)
{
- Console_Ln();
+ Out_Ln();
}
-static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt)
+void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len)
{
- INTEGER i;
+ __DUP(vt100code, vt100code__len, CHAR);
+ if ((Out_IsConsole && !__IN(16, OPM_Options, 32))) {
+ VT100_SetAttr(vt100code, vt100code__len);
+ }
+ __DEL(vt100code);
+}
+
+INT64 OPM_SignedMaximum (INT32 bytecount)
+{
+ INT64 result;
+ result = 1;
+ result = __LSH(result, __ASHL(bytecount, 3) - 1, 64);
+ return result - 1;
+}
+
+INT64 OPM_SignedMinimum (INT32 bytecount)
+{
+ return -OPM_SignedMaximum(bytecount) - 1;
+}
+
+INT32 OPM_Longint (INT64 n)
+{
+ return __VAL(INT32, n);
+}
+
+INT16 OPM_Integer (INT64 n)
+{
+ return __VAL(INT16, n);
+}
+
+static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
+{
+ INT16 i;
+ __DUP(s, s__len, CHAR);
i = 1;
while (s[__X(i, s__len)] != 0x00) {
switch (s[__X(i, s__len)]) {
- case 'a':
- *opt = *opt ^ 0x80;
- break;
- case 'c':
- *opt = *opt ^ 0x4000;
- break;
- case 'e':
- *opt = *opt ^ 0x0200;
- break;
- case 'f':
- *opt = *opt ^ 0x010000;
- break;
- case 'k':
- *opt = *opt ^ 0x40;
- break;
- case 'm':
- *opt = *opt ^ 0x0400;
- break;
case 'p':
- *opt = *opt ^ 0x20;
+ OPM_Options = OPM_Options ^ 0x20;
+ break;
+ case 'a':
+ OPM_Options = OPM_Options ^ 0x80;
break;
case 'r':
- *opt = *opt ^ 0x04;
- break;
- case 's':
- *opt = *opt ^ 0x10;
+ OPM_Options = OPM_Options ^ 0x04;
break;
case 't':
- *opt = *opt ^ 0x08;
+ OPM_Options = OPM_Options ^ 0x08;
break;
case 'x':
- *opt = *opt ^ 0x01;
+ OPM_Options = OPM_Options ^ 0x01;
+ break;
+ case 'e':
+ OPM_Options = OPM_Options ^ 0x0200;
+ break;
+ case 's':
+ OPM_Options = OPM_Options ^ 0x10;
+ break;
+ case 'F':
+ OPM_Options = OPM_Options ^ 0x020000;
+ break;
+ case 'm':
+ OPM_Options = OPM_Options ^ 0x0400;
+ break;
+ case 'M':
+ OPM_Options = OPM_Options ^ 0x8000;
+ break;
+ case 'S':
+ OPM_Options = OPM_Options ^ 0x2000;
+ break;
+ case 'c':
+ OPM_Options = OPM_Options ^ 0x4000;
+ break;
+ case 'f':
+ OPM_Options = OPM_Options ^ 0x010000;
+ break;
+ case 'V':
+ OPM_Options = OPM_Options ^ 0x040000;
+ break;
+ case 'O':
+ if (i + 1 >= Strings_Length(s, s__len)) {
+ OPM_LogWStr((CHAR*)"-O option requires following size model character.", 51);
+ OPM_LogWLn();
+ } else {
+ OPM_Model[0] = s[__X(i + 1, s__len)];
+ OPM_Model[1] = 0x00;
+ if ((((OPM_Model[0] != '2' && OPM_Model[0] != 'C')) && OPM_Model[0] != 'V')) {
+ OPM_LogWStr((CHAR*)"Unrecognised size model character following -O.", 48);
+ OPM_LogWLn();
+ }
+ i += 1;
+ }
+ break;
+ case 'A':
+ if (i + 2 >= Strings_Length(s, s__len)) {
+ OPM_LogWStr((CHAR*)"-M option requires two following digits.", 41);
+ OPM_LogWLn();
+ } else {
+ OPM_AddressSize = (INT16)s[__X(i + 1, s__len)] - 48;
+ OPM_Alignment = (INT16)s[__X(i + 2, s__len)] - 48;
+ i += 2;
+ }
break;
case 'B':
if (s[__X(i + 1, s__len)] != 0x00) {
i += 1;
- OPM_IntSize = (int)s[__X(i, s__len)] - 48;
+ OPM_IntegerSize = (INT16)s[__X(i, s__len)] - 48;
}
if (s[__X(i + 1, s__len)] != 0x00) {
i += 1;
- OPM_PointerSize = (int)s[__X(i, s__len)] - 48;
+ OPM_AddressSize = (INT16)s[__X(i, s__len)] - 48;
}
if (s[__X(i + 1, s__len)] != 0x00) {
i += 1;
- OPM_Alignment = (int)s[__X(i, s__len)] - 48;
+ OPM_Alignment = (INT16)s[__X(i, s__len)] - 48;
}
- __ASSERT(OPM_IntSize == 2 || OPM_IntSize == 4, 0);
- __ASSERT(OPM_PointerSize == 4 || OPM_PointerSize == 8, 0);
+ __ASSERT(OPM_IntegerSize == 2 || OPM_IntegerSize == 4, 0);
+ __ASSERT(OPM_AddressSize == 4 || OPM_AddressSize == 8, 0);
__ASSERT(OPM_Alignment == 4 || OPM_Alignment == 8, 0);
- Files_SetSearchPath((CHAR*)"", (LONGINT)1);
- break;
- case 'F':
- *opt = *opt ^ 0x020000;
- break;
- case 'M':
- *opt = *opt ^ 0x8000;
- break;
- case 'S':
- *opt = *opt ^ 0x2000;
- break;
- case 'V':
- *opt = *opt ^ 0x040000;
+ if (OPM_IntegerSize == 2) {
+ OPM_LongintSize = 4;
+ } else {
+ OPM_LongintSize = 8;
+ }
+ Files_SetSearchPath((CHAR*)"", 1);
break;
default:
- OPM_LogWStr((CHAR*)" warning: option ", (LONGINT)19);
+ OPM_LogWStr((CHAR*)" warning: option ", 19);
OPM_LogW('-');
OPM_LogW(s[__X(i, s__len)]);
- OPM_LogWStr((CHAR*)" ignored", (LONGINT)9);
+ OPM_LogWStr((CHAR*)" ignored", 9);
OPM_LogWLn();
break;
}
i += 1;
}
+ __DEL(s);
}
BOOLEAN OPM_OpenPar (void)
{
- BOOLEAN _o_result;
CHAR s[256];
if (Platform_ArgCount == 1) {
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Vishap Oberon-2 compiler v", (LONGINT)27);
- OPM_LogWStr(Configuration_versionLong, ((LONGINT)(41)));
+ OPM_LogWStr((CHAR*)"Oberon-2 compiler v", 20);
+ OPM_LogWStr(Configuration_versionLong, 75);
OPM_LogW('.');
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Based on Ofront by Software Templ OEG, continued by Norayr Chilingarian and others.", (LONGINT)84);
+ 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_LogWLn();
- OPM_LogWStr((CHAR*)"Usage:", (LONGINT)7);
+ OPM_LogWStr((CHAR*)"Usage:", 7);
OPM_LogWLn();
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" ", (LONGINT)3);
- OPM_LogWStr((CHAR*)"voc", (LONGINT)4);
- OPM_LogWStr((CHAR*)" options {files {options}}.", (LONGINT)28);
+ OPM_LogWStr((CHAR*)" ", 3);
+ OPM_LogWStr((CHAR*)"voc", 4);
+ OPM_LogWStr((CHAR*)" options {files {options}}.", 28);
OPM_LogWLn();
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Where options = [\"-\" {option} ].", (LONGINT)33);
+ OPM_LogWStr((CHAR*)"Options:", 9);
OPM_LogWLn();
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" m - generate code for main module", (LONGINT)36);
+ OPM_LogWStr((CHAR*)" Run time safety", 18);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" M - generate code for main module and link object statically", (LONGINT)63);
+ OPM_LogWStr((CHAR*)" -p Initialise pointers to NIL. On by default.", 52);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" s - generate new symbol file", (LONGINT)31);
+ OPM_LogWStr((CHAR*)" -a Halt on assertion failures. On by default.", 52);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" e - allow extending the module interface", (LONGINT)43);
+ OPM_LogWStr((CHAR*)" -r Halt on range check failures.", 39);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" r - check value ranges", (LONGINT)25);
+ OPM_LogWStr((CHAR*)" -t Halt on type guard failure. On by default.", 52);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" a - don't check ASSERTs at runtime, use this option in tested production code", (LONGINT)80);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" t - don't check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" S - don't call external assembler/compiler, only generate C code", (LONGINT)67);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" c - don't call linker", (LONGINT)24);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" f - don't use color output", (LONGINT)29);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" V - verbose output", (LONGINT)21);
+ OPM_LogWStr((CHAR*)" -x Halt on index out of range. On by default.", 52);
OPM_LogWLn();
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Initial options specify defaults for all files.", (LONGINT)48);
+ OPM_LogWStr((CHAR*)" Symbol file management", 25);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Options following a filename are specific to that file.", (LONGINT)56);
+ OPM_LogWStr((CHAR*)" -e Allow extension of old symbol file.", 45);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Repeating an option toggles its value.", (LONGINT)39);
+ OPM_LogWStr((CHAR*)" -s Allow generation of new symbol file.", 46);
OPM_LogWLn();
- _o_result = 0;
- return _o_result;
+ OPM_LogWStr((CHAR*)" -F Force generation of new symbol file.", 46);
+ OPM_LogWLn();
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" C compiler and linker control", 32);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -m This module is main. Link dynamically.", 48);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -M This module is main. Link statically.", 47);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -S Don't call C compiler", 31);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -c Don't link.", 21);
+ OPM_LogWLn();
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" Miscellaneous", 16);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -f Disable VT100 control characters in status output.", 60);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -V Display compiler debugging messages.", 46);
+ OPM_LogWLn();
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" Size model for elementary types (default O2)", 47);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
+ OPM_LogWLn();
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" Target machine address size and alignment (default is that of the running compiler binary)", 93);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -A44 32 bit addresses, 32 bit alignment (e.g. Unix/linux 32 bit on x86).", 79);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -A48 32 bit addresses, 64 bit alignment (e.g. Windows 32 bit on x86, linux 32 bit on arm).", 97);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -A88 64 bit addresses, 64 bit alignment (e.g. 64 bit platforms).", 71);
+ OPM_LogWLn();
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"All options are off by default, except where noted above.", 58);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Initial options specify defaults for all files.", 48);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Options following a filename are specific to that file.", 56);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Repeating an option toggles its value.", 39);
+ OPM_LogWLn();
+ return 0;
} else {
+ OPM_AddressSize = 4;
+ OPM_GetAlignment(&OPM_Alignment);
+ __MOVE("2", OPM_Model, 2);
+ OPM_Options = 0xa9;
OPM_S = 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256)));
- OPM_glbopt = 0xe9;
+ Platform_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
- OPM_ScanOptions((void*)s, ((LONGINT)(256)), &OPM_glbopt);
+ OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256)));
+ Platform_GetArg(OPM_S, (void*)s, 256);
}
- _o_result = 1;
- return _o_result;
+ OPM_GlobalAddressSize = OPM_AddressSize;
+ OPM_GlobalAlignment = OPM_Alignment;
+ __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];
- OPM_opt = OPM_glbopt;
+ CHAR searchpath[1024], modules[1024];
+ CHAR MODULES[1024];
+ OPM_Options = OPM_GlobalOptions;
+ __COPY(OPM_GlobalModel, OPM_Model, 10);
+ OPM_Alignment = OPM_GlobalAlignment;
+ OPM_AddressSize = OPM_GlobalAddressSize;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256)));
+ Platform_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
- OPM_ScanOptions((void*)s, ((LONGINT)(256)), &OPM_opt);
+ OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256)));
+ Platform_GetArg(OPM_S, (void*)s, 256);
}
- OPM_dontAsm = __IN(13, OPM_opt);
- OPM_dontLink = __IN(14, OPM_opt);
- OPM_mainProg = __IN(10, OPM_opt);
- OPM_mainLinkStat = __IN(15, OPM_opt);
- OPM_notColorOutput = __IN(16, OPM_opt);
- OPM_forceNewSym = __IN(17, OPM_opt);
- OPM_Verbose = __IN(18, OPM_opt);
- if (OPM_mainLinkStat) {
- OPM_glbopt |= __SETOF(10);
+ if (__IN(15, OPM_Options, 32)) {
+ OPM_Options |= __SETOF(10,32);
}
- OPM_GetProperties();
+ OPM_MaxIndex = OPM_SignedMaximum(OPM_AddressSize);
+ switch (OPM_Model[0]) {
+ case '2':
+ OPM_ShortintSize = 1;
+ OPM_IntegerSize = 2;
+ OPM_LongintSize = 4;
+ break;
+ case 'C':
+ OPM_ShortintSize = 2;
+ OPM_IntegerSize = 4;
+ OPM_LongintSize = 8;
+ break;
+ case 'V':
+ OPM_ShortintSize = 1;
+ OPM_IntegerSize = 4;
+ OPM_LongintSize = 8;
+ break;
+ default:
+ OPM_ShortintSize = 1;
+ OPM_IntegerSize = 2;
+ OPM_LongintSize = 4;
+ break;
+ }
+ 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);
+ Platform_GetEnv((CHAR*)"OBERON", 7, (void*)searchpath, 1024);
+ Strings_Append((CHAR*)";.;", 4, (void*)searchpath, 1024);
+ Strings_Append(modules, 1024, (void*)searchpath, 1024);
+ Strings_Append((CHAR*)";", 2, (void*)searchpath, 1024);
+ Strings_Append(OPM_ResourceDir, 1024, (void*)searchpath, 1024);
+ Strings_Append((CHAR*)"/sym;", 6, (void*)searchpath, 1024);
+ Files_SetSearchPath(searchpath, 1024);
}
void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
{
Texts_Text T = NIL;
- LONGINT beg, end, time;
+ INT32 beg, end, time;
CHAR s[256];
*done = 0;
OPM_curpos = 0;
@@ -307,19 +476,19 @@ void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
return;
}
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256)));
+ Platform_GetArg(OPM_S, (void*)s, 256);
__NEW(T, Texts_TextDesc);
- Texts_Open(T, s, ((LONGINT)(256)));
- OPM_LogWStr(s, ((LONGINT)(256)));
- OPM_LogWStr((CHAR*)" ", (LONGINT)3);
+ Texts_Open(T, s, 256);
+ OPM_LogWStr(s, 256);
+ OPM_LogWStr((CHAR*)" ", 3);
__COPY(s, mname, mname__len);
- __COPY(s, OPM_SourceFileName, ((LONGINT)(256)));
+ __COPY(s, OPM_SourceFileName, 256);
if (T->len == 0) {
- OPM_LogWStr(s, ((LONGINT)(256)));
- OPM_LogWStr((CHAR*)" not found.", (LONGINT)12);
+ OPM_LogWStr(s, 256);
+ OPM_LogWStr((CHAR*)" not found.", 12);
OPM_LogWLn();
} else {
- Texts_OpenReader(&OPM_inR, Texts_Reader__typ, T, ((LONGINT)(0)));
+ Texts_OpenReader(&OPM_inR, Texts_Reader__typ, T, 0);
*done = 1;
}
OPM_S += 1;
@@ -347,7 +516,7 @@ void OPM_Get (CHAR *ch)
static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len)
{
- INTEGER i, j;
+ INT16 i, j;
CHAR ch;
__DUP(ext, ext__len, CHAR);
i = 0;
@@ -369,51 +538,56 @@ static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGIN
__DEL(ext);
}
-static void OPM_LogErrMsg (INTEGER n)
+static void OPM_LogErrMsg (INT16 n)
{
+ INT16 l;
Texts_Scanner S;
- Texts_Text T = NIL;
- CHAR ch;
- INTEGER i;
- CHAR buf[1024];
+ CHAR c;
if (n >= 0) {
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"31m", (LONGINT)4);
- }
- OPM_LogWStr((CHAR*)" err ", (LONGINT)7);
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"0m", (LONGINT)3);
- }
+ OPM_LogVT100((CHAR*)"31m", 4);
+ OPM_LogWStr((CHAR*)" err ", 7);
+ OPM_LogVT100((CHAR*)"0m", 3);
} else {
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"35m", (LONGINT)4);
- }
- OPM_LogWStr((CHAR*)" warning ", (LONGINT)11);
+ OPM_LogVT100((CHAR*)"35m", 4);
+ OPM_LogWStr((CHAR*)" warning ", 11);
n = -n;
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"0m", (LONGINT)3);
+ OPM_LogVT100((CHAR*)"0m", 3);
+ }
+ OPM_LogWNum(n, 1);
+ OPM_LogWStr((CHAR*)" ", 3);
+ if (OPM_Errors == NIL) {
+ __NEW(OPM_Errors, Texts_TextDesc);
+ Texts_Open(OPM_Errors, (CHAR*)"Errors.Txt", 11);
+ }
+ Texts_OpenScanner(&S, Texts_Scanner__typ, OPM_Errors, 0);
+ do {
+ l = S.line;
+ Texts_Scan(&S, Texts_Scanner__typ);
+ } while (!((((l != S.line && S.class == 3)) && S.i == n) || S.eot));
+ if (!S.eot) {
+ Texts_Read((void*)&S, Texts_Scanner__typ, &c);
+ while ((!S.eot && c >= ' ')) {
+ Out_Char(c);
+ Texts_Read((void*)&S, Texts_Scanner__typ, &c);
}
}
- OPM_LogWNum(n, ((LONGINT)(1)));
- OPM_LogWStr((CHAR*)" ", (LONGINT)3);
- OPM_LogWStr(errors_errors[__X(n, ((LONGINT)(350)))], ((LONGINT)(128)));
}
-static void OPM_FindLine (Files_File f, Files_Rider *r, LONGINT *r__typ, LONGINT pos)
+static void OPM_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos)
{
CHAR ch, cheol;
- if (pos < OPM_ErrorLineStartPos) {
+ if (pos < (INT64)OPM_ErrorLineStartPos) {
OPM_ErrorLineStartPos = 0;
OPM_ErrorLineLimitPos = 0;
OPM_ErrorLineNumber = 0;
}
- if (pos < OPM_ErrorLineLimitPos) {
+ if (pos < (INT64)OPM_ErrorLineLimitPos) {
Files_Set(&*r, r__typ, f, OPM_ErrorLineStartPos);
return;
}
Files_Set(&*r, r__typ, f, OPM_ErrorLineLimitPos);
Files_Read(&*r, r__typ, (void*)&ch);
- while ((OPM_ErrorLineLimitPos < pos && !(*r).eof)) {
+ while (((INT64)OPM_ErrorLineLimitPos < pos && !(*r).eof)) {
OPM_ErrorLineStartPos = OPM_ErrorLineLimitPos;
OPM_ErrorLineNumber += 1;
while ((((ch != 0x00 && ch != 0x0d)) && ch != 0x0a)) {
@@ -431,49 +605,45 @@ static void OPM_FindLine (Files_File f, Files_Rider *r, LONGINT *r__typ, LONGINT
Files_Set(&*r, r__typ, f, OPM_ErrorLineStartPos);
}
-static void OPM_ShowLine (LONGINT pos)
+static void OPM_ShowLine (INT64 pos)
{
Files_File f = NIL;
Files_Rider r;
CHAR line[1023];
- INTEGER i;
+ INT16 i;
CHAR ch;
- f = Files_Old(OPM_SourceFileName, ((LONGINT)(256)));
+ f = Files_Old(OPM_SourceFileName, 256);
OPM_FindLine(f, &r, Files_Rider__typ, pos);
i = 0;
Files_Read(&r, Files_Rider__typ, (void*)&ch);
while ((((((ch != 0x00 && ch != 0x0d)) && ch != 0x0a)) && i < 1022)) {
- line[__X(i, ((LONGINT)(1023)))] = ch;
+ line[__X(i, 1023)] = ch;
i += 1;
Files_Read(&r, Files_Rider__typ, (void*)&ch);
}
- line[__X(i, ((LONGINT)(1023)))] = 0x00;
+ line[__X(i, 1023)] = 0x00;
OPM_LogWLn();
OPM_LogWLn();
- OPM_LogWNum(OPM_ErrorLineNumber, ((LONGINT)(4)));
- OPM_LogWStr((CHAR*)": ", (LONGINT)3);
- OPM_LogWStr(line, ((LONGINT)(1023)));
+ OPM_LogWNum(OPM_ErrorLineNumber, 4);
+ OPM_LogWStr((CHAR*)": ", 3);
+ OPM_LogWStr(line, 1023);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" ", (LONGINT)7);
- if (pos >= OPM_ErrorLineLimitPos) {
+ OPM_LogWStr((CHAR*)" ", 7);
+ if (pos >= (INT64)OPM_ErrorLineLimitPos) {
pos = OPM_ErrorLineLimitPos - 1;
}
- i = (int)(pos - OPM_ErrorLineStartPos);
+ i = (INT16)OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos);
while (i > 0) {
OPM_LogW(' ');
i -= 1;
}
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"32m", (LONGINT)4);
- }
+ OPM_LogVT100((CHAR*)"32m", 4);
OPM_LogW('^');
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"0m", (LONGINT)3);
- }
+ OPM_LogVT100((CHAR*)"0m", 3);
Files_Close(f);
}
-void OPM_Mark (INTEGER n, LONGINT pos)
+void OPM_Mark (INT16 n, INT32 pos)
{
if (pos == -1) {
pos = 0;
@@ -484,30 +654,30 @@ void OPM_Mark (INTEGER n, LONGINT pos)
OPM_lasterrpos = pos;
OPM_ShowLine(pos);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" ", (LONGINT)3);
+ OPM_LogWStr((CHAR*)" ", 3);
if (n < 249) {
- OPM_LogWStr((CHAR*)" pos", (LONGINT)6);
- OPM_LogWNum(pos, ((LONGINT)(6)));
+ OPM_LogWStr((CHAR*)" pos", 6);
+ OPM_LogWNum(pos, 6);
OPM_LogErrMsg(n);
} else if (n == 255) {
- OPM_LogWStr((CHAR*)"pos", (LONGINT)4);
- OPM_LogWNum(pos, ((LONGINT)(6)));
- OPM_LogWStr((CHAR*)" pc ", (LONGINT)6);
- OPM_LogWNum(OPM_breakpc, ((LONGINT)(1)));
+ OPM_LogWStr((CHAR*)"pos", 4);
+ OPM_LogWNum(pos, 6);
+ OPM_LogWStr((CHAR*)" pc ", 6);
+ OPM_LogWNum(OPM_breakpc, 1);
} else if (n == 254) {
- OPM_LogWStr((CHAR*)"pc not found", (LONGINT)13);
+ OPM_LogWStr((CHAR*)"pc not found", 13);
} else {
- OPM_LogWStr(OPM_objname, ((LONGINT)(64)));
+ OPM_LogWStr(OPM_objname, 64);
if (n == 253) {
- OPM_LogWStr((CHAR*)" is new, compile with option e", (LONGINT)31);
+ OPM_LogWStr((CHAR*)" is new, compile with option e", 31);
} else if (n == 252) {
- OPM_LogWStr((CHAR*)" is redefined, compile with option s", (LONGINT)37);
+ OPM_LogWStr((CHAR*)" is redefined, compile with option s", 37);
} else if (n == 251) {
- OPM_LogWStr((CHAR*)" is redefined (private part only), compile with option s", (LONGINT)57);
+ OPM_LogWStr((CHAR*)" is redefined (private part only), compile with option s", 57);
} else if (n == 250) {
- OPM_LogWStr((CHAR*)" is no longer visible, compile with option s", (LONGINT)45);
+ OPM_LogWStr((CHAR*)" is no longer visible, compile with option s", 45);
} else if (n == 249) {
- OPM_LogWStr((CHAR*)" is not consistently imported, recompile imports", (LONGINT)49);
+ OPM_LogWStr((CHAR*)" is not consistently imported, recompile imports", 49);
}
}
}
@@ -515,8 +685,8 @@ void OPM_Mark (INTEGER n, LONGINT pos)
if (pos >= 0) {
OPM_ShowLine(pos);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" pos", (LONGINT)6);
- OPM_LogWNum(pos, ((LONGINT)(6)));
+ OPM_LogWStr((CHAR*)" pos", 6);
+ OPM_LogWNum(pos, 6);
}
OPM_LogErrMsg(n);
if (pos < 0) {
@@ -525,162 +695,42 @@ void OPM_Mark (INTEGER n, LONGINT pos)
}
}
-void OPM_err (INTEGER n)
+void OPM_err (INT16 n)
{
OPM_Mark(n, OPM_errpos);
}
-void OPM_FPrint (LONGINT *fp, LONGINT val)
+static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len)
{
- *fp = __ROTL((LONGINT)((SET)*fp ^ (SET)val), 1, LONGINT);
-}
-
-void OPM_FPrintSet (LONGINT *fp, SET set)
-{
- OPM_FPrint(&*fp, (LONGINT)set);
-}
-
-void OPM_FPrintReal (LONGINT *fp, REAL real)
-{
- INTEGER i;
- LONGINT l;
- __GET((LONGINT)(SYSTEM_ADDRESS)&real, l, LONGINT);
- OPM_FPrint(&*fp, l);
-}
-
-void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr)
-{
- LONGINT l, h;
- __GET((LONGINT)(SYSTEM_ADDRESS)&lr, l, LONGINT);
- __GET((LONGINT)(SYSTEM_ADDRESS)&lr + 4, h, LONGINT);
- OPM_FPrint(&*fp, l);
- OPM_FPrint(&*fp, h);
-}
-
-static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align)
-{
- __DUP(name, name__len, CHAR);
- if (((*S).class == 1 && __STRCMP((*S).s, name) == 0)) {
- Texts_Scan(&*S, S__typ);
- if ((*S).class == 3) {
- *size = (int)(*S).i;
- Texts_Scan(&*S, S__typ);
- } else {
- OPM_Mark(-157, ((LONGINT)(-1)));
- }
- if ((*S).class == 3) {
- *align = (int)(*S).i;
- Texts_Scan(&*S, S__typ);
- } else {
- OPM_Mark(-157, ((LONGINT)(-1)));
- }
- } else {
- OPM_Mark(-157, ((LONGINT)(-1)));
+ INT16 i;
+ INT32 l;
+ __ASSERT(__MASK(bytes__len, -4) == 0, 0);
+ i = 0;
+ while (i < bytes__len) {
+ __GET((ADDRESS)&bytes[__X(i, bytes__len)], l, INT32);
+ *fp = __ROTL((INT32)((UINT32)*fp ^ (UINT32)l), 1, 32);
+ i += 4;
}
- __DEL(name);
}
-static LONGINT OPM_minusop (LONGINT i)
+void OPM_FPrint (INT32 *fp, INT64 val)
{
- LONGINT _o_result;
- _o_result = -i;
- return _o_result;
+ OPM_FingerprintBytes(&*fp, (void*)&val, 8);
}
-static LONGINT OPM_power0 (LONGINT i, LONGINT j)
+void OPM_FPrintSet (INT32 *fp, UINT64 val)
{
- LONGINT _o_result;
- LONGINT k, p;
- k = 1;
- p = i;
- do {
- p = p * i;
- k += 1;
- } while (!(k == j));
- _o_result = p;
- return _o_result;
+ OPM_FingerprintBytes(&*fp, (void*)&val, 8);
}
-static void OPM_VerboseListSizes (void)
+void OPM_FPrintReal (INT32 *fp, REAL val)
{
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Type Size Alignement", (LONGINT)29);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"CHAR ", (LONGINT)14);
- OPM_LogWNum(OPM_CharSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"BOOLEAN ", (LONGINT)14);
- OPM_LogWNum(OPM_BoolSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"SHORTINT ", (LONGINT)14);
- OPM_LogWNum(OPM_SIntSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"INTEGER ", (LONGINT)14);
- OPM_LogWNum(OPM_IntSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"LONGINT ", (LONGINT)14);
- OPM_LogWNum(OPM_LIntSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"SET ", (LONGINT)14);
- OPM_LogWNum(OPM_SetSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"REAL ", (LONGINT)14);
- OPM_LogWNum(OPM_RealSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"LONGREAL ", (LONGINT)14);
- OPM_LogWNum(OPM_LRealSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"PTR ", (LONGINT)14);
- OPM_LogWNum(OPM_PointerSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"PROC ", (LONGINT)14);
- OPM_LogWNum(OPM_ProcSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"RECORD ", (LONGINT)14);
- OPM_LogWNum(OPM_RecSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWLn();
+ OPM_FingerprintBytes(&*fp, (void*)&val, 4);
}
-LONGINT OPM_SignedMaximum (LONGINT bytecount)
+void OPM_FPrintLReal (INT32 *fp, LONGREAL val)
{
- LONGINT _o_result;
- LONGINT result;
- result = 1;
- result = __LSH(result, __ASHL(bytecount, 3) - 1, LONGINT);
- _o_result = result - 1;
- return _o_result;
-}
-
-LONGINT OPM_SignedMinimum (LONGINT bytecount)
-{
- LONGINT _o_result;
- _o_result = -OPM_SignedMaximum(bytecount) - 1;
- return _o_result;
-}
-
-static void OPM_GetProperties (void)
-{
- OPM_ProcSize = OPM_PointerSize;
- OPM_LIntSize = __ASHL(OPM_IntSize, 1);
- OPM_SetSize = OPM_LIntSize;
- if (OPM_RealSize == 4) {
- OPM_MaxReal = 3.40282346000000e+038;
- } else if (OPM_RealSize == 8) {
- OPM_MaxReal = 1.79769296342094e+308;
- }
- if (OPM_LRealSize == 4) {
- OPM_MaxLReal = 3.40282346000000e+038;
- } else if (OPM_LRealSize == 8) {
- OPM_MaxLReal = 1.79769296342094e+308;
- }
- OPM_MinReal = -OPM_MaxReal;
- OPM_MinLReal = -OPM_MaxLReal;
- OPM_MaxSet = __ASHL(OPM_SetSize, 3) - 1;
- OPM_MaxIndex = OPM_SignedMaximum(OPM_PointerSize);
- if (OPM_Verbose) {
- OPM_VerboseListSizes();
- }
+ OPM_FingerprintBytes(&*fp, (void*)&val, 8);
}
void OPM_SymRCh (CHAR *ch)
@@ -688,18 +738,23 @@ void OPM_SymRCh (CHAR *ch)
Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&*ch);
}
-LONGINT OPM_SymRInt (void)
+INT32 OPM_SymRInt (void)
{
- LONGINT _o_result;
- LONGINT k;
- Files_ReadNum(&OPM_oldSF, Files_Rider__typ, &k);
- _o_result = k;
- return _o_result;
+ INT32 k;
+ Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (void*)&k, 4);
+ return k;
}
-void OPM_SymRSet (SET *s)
+INT64 OPM_SymRInt64 (void)
{
- Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (LONGINT*)&*s);
+ INT64 k;
+ Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (void*)&k, 8);
+ return k;
+}
+
+void OPM_SymRSet (UINT64 *s)
+{
+ Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (void*)&*s, 8);
}
void OPM_SymRReal (REAL *r)
@@ -714,19 +769,21 @@ void OPM_SymRLReal (LONGREAL *lr)
void OPM_CloseOldSym (void)
{
+ Files_Close(Files_Base(&OPM_oldSF, Files_Rider__typ));
}
void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done)
{
- CHAR ch;
+ CHAR tag, ver;
OPM_FileName fileName;
- OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5);
- OPM_oldSFile = Files_Old(fileName, ((LONGINT)(32)));
+ OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
+ OPM_oldSFile = Files_Old(fileName, 32);
*done = OPM_oldSFile != NIL;
if (*done) {
- Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, ((LONGINT)(0)));
- Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ch);
- if (ch != 0xf7) {
+ Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, 0);
+ Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&tag);
+ Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ver);
+ if (tag != 0xf7 || ver != 0x82) {
OPM_err(-306);
OPM_CloseOldSym();
*done = 0;
@@ -736,9 +793,7 @@ void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done)
BOOLEAN OPM_eofSF (void)
{
- BOOLEAN _o_result;
- _o_result = OPM_oldSF.eof;
- return _o_result;
+ return OPM_oldSF.eof;
}
void OPM_SymWCh (CHAR ch)
@@ -746,14 +801,14 @@ void OPM_SymWCh (CHAR ch)
Files_Write(&OPM_newSF, Files_Rider__typ, ch);
}
-void OPM_SymWInt (LONGINT i)
+void OPM_SymWInt (INT64 i)
{
Files_WriteNum(&OPM_newSF, Files_Rider__typ, i);
}
-void OPM_SymWSet (SET s)
+void OPM_SymWSet (UINT64 s)
{
- Files_WriteNum(&OPM_newSF, Files_Rider__typ, (LONGINT)s);
+ Files_WriteNum(&OPM_newSF, Files_Rider__typ, (INT64)s);
}
void OPM_SymWReal (REAL r)
@@ -768,7 +823,7 @@ void OPM_SymWLReal (LONGREAL lr)
void OPM_RegisterNewSym (void)
{
- if (__STRCMP(OPM_modName, "SYSTEM") != 0 || __IN(10, OPM_opt)) {
+ if (__STRCMP(OPM_modName, "SYSTEM") != 0 || __IN(10, OPM_Options, 32)) {
Files_Register(OPM_newSFile);
}
}
@@ -780,11 +835,12 @@ void OPM_DeleteNewSym (void)
void OPM_NewSym (CHAR *modName, LONGINT modName__len)
{
OPM_FileName fileName;
- OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5);
- OPM_newSFile = Files_New(fileName, ((LONGINT)(32)));
+ OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
+ OPM_newSFile = Files_New(fileName, 32);
if (OPM_newSFile != NIL) {
- Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, ((LONGINT)(0)));
+ Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, 0);
Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7);
+ Files_Write(&OPM_newSF, Files_Rider__typ, 0x82);
} else {
OPM_err(153);
}
@@ -792,74 +848,74 @@ void OPM_NewSym (CHAR *modName, LONGINT modName__len)
void OPM_Write (CHAR ch)
{
- Files_Write(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, ch);
+ Files_Write(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, ch);
}
void OPM_WriteString (CHAR *s, LONGINT s__len)
{
- INTEGER i;
+ INT16 i;
i = 0;
while (s[__X(i, s__len)] != 0x00) {
i += 1;
}
- Files_WriteBytes(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, (void*)s, s__len * ((LONGINT)(1)), i);
+ Files_WriteBytes(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, (void*)s, s__len * 1, i);
}
void OPM_WriteStringVar (CHAR *s, LONGINT s__len)
{
- INTEGER i;
+ INT16 i;
i = 0;
while (s[__X(i, s__len)] != 0x00) {
i += 1;
}
- Files_WriteBytes(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, (void*)s, s__len * ((LONGINT)(1)), i);
+ Files_WriteBytes(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, (void*)s, s__len * 1, i);
}
-void OPM_WriteHex (LONGINT i)
+void OPM_WriteHex (INT64 i)
{
CHAR s[3];
- INTEGER digit;
- digit = __ASHR((int)i, 4);
+ INT32 digit;
+ digit = __ASHR((INT32)i, 4);
if (digit < 10) {
s[0] = (CHAR)(48 + digit);
} else {
s[0] = (CHAR)(87 + digit);
}
- digit = __MASK((int)i, -16);
+ digit = __MASK((INT32)i, -16);
if (digit < 10) {
s[1] = (CHAR)(48 + digit);
} else {
s[1] = (CHAR)(87 + digit);
}
s[2] = 0x00;
- OPM_WriteString(s, ((LONGINT)(3)));
+ OPM_WriteString(s, 3);
}
-void OPM_WriteInt (LONGINT i)
+void OPM_WriteInt (INT64 i)
{
- CHAR s[20];
- LONGINT i1, k;
- if (i == OPM_SignedMinimum(OPM_IntSize) || i == OPM_SignedMinimum(OPM_LIntSize)) {
+ CHAR s[24];
+ INT64 i1, k;
+ if ((i == OPM_SignedMinimum(2) || i == OPM_SignedMinimum(4)) || i == OPM_SignedMinimum(8)) {
OPM_Write('(');
OPM_WriteInt(i + 1);
- OPM_WriteString((CHAR*)"-1)", (LONGINT)4);
+ OPM_WriteString((CHAR*)"-1)", 4);
} else {
i1 = __ABS(i);
s[0] = (CHAR)(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k = 1;
while (i1 > 0) {
- s[__X(k, ((LONGINT)(20)))] = (CHAR)(__MOD(i1, 10) + 48);
+ s[__X(k, 24)] = (CHAR)(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k += 1;
}
if (i < 0) {
- s[__X(k, ((LONGINT)(20)))] = '-';
+ s[__X(k, 24)] = '-';
k += 1;
}
while (k > 0) {
k -= 1;
- OPM_Write(s[__X(k, ((LONGINT)(20)))]);
+ OPM_Write(s[__X(k, 24)]);
}
}
}
@@ -871,14 +927,14 @@ void OPM_WriteReal (LONGREAL r, CHAR suffx)
Texts_Reader R;
CHAR s[32];
CHAR ch;
- INTEGER i;
- if ((((r < OPM_SignedMaximum(OPM_LIntSize) && r > OPM_SignedMinimum(OPM_LIntSize))) && r == ((int)__ENTIER(r)))) {
+ INT16 i;
+ if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == ((INT32)__ENTIER(r)))) {
if (suffx == 'f') {
- OPM_WriteString((CHAR*)"(REAL)", (LONGINT)7);
+ OPM_WriteString((CHAR*)"(REAL)", 7);
} else {
- OPM_WriteString((CHAR*)"(LONGREAL)", (LONGINT)11);
+ OPM_WriteString((CHAR*)"(LONGREAL)", 11);
}
- OPM_WriteInt((int)__ENTIER(r));
+ OPM_WriteInt((INT32)__ENTIER(r));
} else {
Texts_OpenWriter(&W, Texts_Writer__typ);
if (suffx == 'f') {
@@ -887,45 +943,45 @@ void OPM_WriteReal (LONGREAL r, CHAR suffx)
Texts_WriteLongReal(&W, Texts_Writer__typ, r, 23);
}
__NEW(T, Texts_TextDesc);
- Texts_Open(T, (CHAR*)"", (LONGINT)1);
+ Texts_Open(T, (CHAR*)"", 1);
Texts_Append(T, W.buf);
- Texts_OpenReader(&R, Texts_Reader__typ, T, ((LONGINT)(0)));
+ Texts_OpenReader(&R, Texts_Reader__typ, T, 0);
i = 0;
Texts_Read(&R, Texts_Reader__typ, &ch);
while (ch != 0x00) {
- s[__X(i, ((LONGINT)(32)))] = ch;
+ s[__X(i, 32)] = ch;
i += 1;
Texts_Read(&R, Texts_Reader__typ, &ch);
}
- s[__X(i, ((LONGINT)(32)))] = 0x00;
+ s[__X(i, 32)] = 0x00;
i = 0;
ch = s[0];
while ((ch != 'D' && ch != 0x00)) {
i += 1;
- ch = s[__X(i, ((LONGINT)(32)))];
+ ch = s[__X(i, 32)];
}
if (ch == 'D') {
- s[__X(i, ((LONGINT)(32)))] = 'e';
+ s[__X(i, 32)] = 'e';
}
- OPM_WriteString(s, ((LONGINT)(32)));
+ OPM_WriteString(s, 32);
}
}
void OPM_WriteLn (void)
{
- Files_Write(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, 0x0a);
+ Files_Write(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, 0x0a);
}
-static void OPM_Append (Files_Rider *R, LONGINT *R__typ, Files_File F)
+static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F)
{
Files_Rider R1;
CHAR buffer[4096];
if (F != NIL) {
- Files_Set(&R1, Files_Rider__typ, F, ((LONGINT)(0)));
- Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, ((LONGINT)(4096)), ((LONGINT)(4096)));
+ Files_Set(&R1, Files_Rider__typ, F, 0);
+ Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, 4096, 4096);
while (4096 - R1.res > 0) {
- Files_WriteBytes(&*R, R__typ, (void*)buffer, ((LONGINT)(4096)), 4096 - R1.res);
- Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, ((LONGINT)(4096)), ((LONGINT)(4096)));
+ Files_WriteBytes(&*R, R__typ, (void*)buffer, 4096, 4096 - R1.res);
+ Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, 4096, 4096);
}
}
}
@@ -933,24 +989,24 @@ static void OPM_Append (Files_Rider *R, LONGINT *R__typ, Files_File F)
void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
{
CHAR FName[32];
- __COPY(moduleName, OPM_modName, ((LONGINT)(32)));
- OPM_HFile = Files_New((CHAR*)"", (LONGINT)1);
+ __COPY(moduleName, OPM_modName, 32);
+ OPM_HFile = Files_New((CHAR*)"", 1);
if (OPM_HFile != NIL) {
- Files_Set(&OPM_R[0], Files_Rider__typ, OPM_HFile, ((LONGINT)(0)));
+ Files_Set(&OPM_R[0], Files_Rider__typ, OPM_HFile, 0);
} else {
OPM_err(153);
}
- OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, ((LONGINT)(32)), (CHAR*)".c", (LONGINT)3);
- OPM_BFile = Files_New(FName, ((LONGINT)(32)));
+ OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, 32, (CHAR*)".c", 3);
+ OPM_BFile = Files_New(FName, 32);
if (OPM_BFile != NIL) {
- Files_Set(&OPM_R[1], Files_Rider__typ, OPM_BFile, ((LONGINT)(0)));
+ Files_Set(&OPM_R[1], Files_Rider__typ, OPM_BFile, 0);
} else {
OPM_err(153);
}
- OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, ((LONGINT)(32)), (CHAR*)".h", (LONGINT)3);
- OPM_HIFile = Files_New(FName, ((LONGINT)(32)));
+ OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, 32, (CHAR*)".h", 3);
+ OPM_HIFile = Files_New(FName, 32);
if (OPM_HIFile != NIL) {
- Files_Set(&OPM_R[2], Files_Rider__typ, OPM_HIFile, ((LONGINT)(0)));
+ Files_Set(&OPM_R[2], Files_Rider__typ, OPM_HIFile, 0);
} else {
OPM_err(153);
}
@@ -959,26 +1015,26 @@ void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
void OPM_CloseFiles (void)
{
CHAR FName[32];
- INTEGER res;
+ INT16 res;
if (OPM_noerr) {
- OPM_LogWStr((CHAR*)" ", (LONGINT)3);
- OPM_LogWNum(Files_Pos(&OPM_R[1], Files_Rider__typ), ((LONGINT)(0)));
- OPM_LogWStr((CHAR*)" chars.", (LONGINT)8);
+ OPM_LogWStr((CHAR*)" ", 3);
+ OPM_LogWNum(Files_Pos(&OPM_R[1], Files_Rider__typ), 0);
+ OPM_LogWStr((CHAR*)" chars.", 8);
}
if (OPM_noerr) {
if (__STRCMP(OPM_modName, "SYSTEM") == 0) {
- if (!__IN(10, OPM_opt)) {
+ if (!__IN(10, OPM_Options, 32)) {
Files_Register(OPM_BFile);
}
- } else if (!__IN(10, OPM_opt)) {
+ } else if (!__IN(10, OPM_Options, 32)) {
OPM_Append(&OPM_R[2], Files_Rider__typ, OPM_HFile);
Files_Register(OPM_HIFile);
Files_Register(OPM_BFile);
} else {
- OPM_MakeFileName((void*)OPM_modName, ((LONGINT)(32)), (void*)FName, ((LONGINT)(32)), (CHAR*)".h", (LONGINT)3);
- Files_Delete(FName, ((LONGINT)(32)), &res);
- OPM_MakeFileName((void*)OPM_modName, ((LONGINT)(32)), (void*)FName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5);
- Files_Delete(FName, ((LONGINT)(32)), &res);
+ OPM_MakeFileName((void*)OPM_modName, 32, (void*)FName, 32, (CHAR*)".h", 3);
+ Files_Delete(FName, 32, &res);
+ OPM_MakeFileName((void*)OPM_modName, 32, (void*)FName, 32, (CHAR*)".sym", 5);
+ Files_Delete(FName, 32, &res);
Files_Register(OPM_BFile);
}
}
@@ -987,18 +1043,18 @@ void OPM_CloseFiles (void)
OPM_HIFile = NIL;
OPM_newSFile = NIL;
OPM_oldSFile = NIL;
- Files_Set(&OPM_R[0], Files_Rider__typ, NIL, ((LONGINT)(0)));
- Files_Set(&OPM_R[1], Files_Rider__typ, NIL, ((LONGINT)(0)));
- Files_Set(&OPM_R[2], Files_Rider__typ, NIL, ((LONGINT)(0)));
- Files_Set(&OPM_newSF, Files_Rider__typ, NIL, ((LONGINT)(0)));
- Files_Set(&OPM_oldSF, Files_Rider__typ, NIL, ((LONGINT)(0)));
+ Files_Set(&OPM_R[0], Files_Rider__typ, NIL, 0);
+ Files_Set(&OPM_R[1], Files_Rider__typ, NIL, 0);
+ Files_Set(&OPM_R[2], Files_Rider__typ, NIL, 0);
+ Files_Set(&OPM_newSF, Files_Rider__typ, NIL, 0);
+ Files_Set(&OPM_oldSF, Files_Rider__typ, NIL, 0);
}
static void EnumPtrs(void (*P)(void*))
{
__ENUMR(&OPM_inR, Texts_Reader__typ, 48, 1, P);
P(OPM_Log);
- __ENUMR(&OPM_W, Texts_Writer__typ, 36, 1, P);
+ P(OPM_Errors);
__ENUMR(&OPM_oldSF, Files_Rider__typ, 20, 1, P);
__ENUMR(&OPM_newSF, Files_Rider__typ, 20, 1, P);
__ENUMR(OPM_R, Files_Rider__typ, 20, 3, P);
@@ -1014,13 +1070,12 @@ export void *OPM__init(void)
{
__DEFMOD;
__MODULE_IMPORT(Configuration);
- __MODULE_IMPORT(Console);
__MODULE_IMPORT(Files);
+ __MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
__MODULE_IMPORT(Texts);
- __MODULE_IMPORT(errors);
- __MODULE_IMPORT(vt100);
+ __MODULE_IMPORT(VT100);
__REGMOD("OPM", EnumPtrs);
__REGCMD("CloseFiles", OPM_CloseFiles);
__REGCMD("CloseOldSym", OPM_CloseOldSym);
@@ -1030,26 +1085,9 @@ export void *OPM__init(void)
__REGCMD("RegisterNewSym", OPM_RegisterNewSym);
__REGCMD("WriteLn", OPM_WriteLn);
/* BEGIN */
- Texts_OpenWriter(&OPM_W, Texts_Writer__typ);
- OPM_MODULES[0] = 0x00;
- Platform_GetEnv((CHAR*)"MODULES", (LONGINT)8, (void*)OPM_MODULES, ((LONGINT)(1024)));
- __MOVE(".", OPM_OBERON, 2);
- Platform_GetEnv((CHAR*)"OBERON", (LONGINT)7, (void*)OPM_OBERON, ((LONGINT)(1024)));
- Strings_Append((CHAR*)";.;", (LONGINT)4, (void*)OPM_OBERON, ((LONGINT)(1024)));
- Strings_Append(OPM_MODULES, ((LONGINT)(1024)), (void*)OPM_OBERON, ((LONGINT)(1024)));
- Strings_Append((CHAR*)";", (LONGINT)2, (void*)OPM_OBERON, ((LONGINT)(1024)));
- Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)OPM_OBERON, ((LONGINT)(1024)));
- Strings_Append((CHAR*)"/sym;", (LONGINT)6, (void*)OPM_OBERON, ((LONGINT)(1024)));
- Files_SetSearchPath(OPM_OBERON, ((LONGINT)(1024)));
- OPM_CharSize = 1;
- OPM_BoolSize = 1;
- OPM_SIntSize = 1;
- OPM_RecSize = 1;
- OPM_ByteSize = 1;
- OPM_RealSize = 4;
- OPM_LRealSize = 8;
- OPM_PointerSize = 8;
- OPM_Alignment = 8;
- OPM_IntSize = 4;
+ OPM_MaxReal = 3.40282346000000e+038;
+ OPM_MaxLReal = 1.79769296342094e+308;
+ OPM_MinReal = -OPM_MaxReal;
+ OPM_MinLReal = -OPM_MaxLReal;
__ENDMOD;
}
diff --git a/bootstrap/windows-48/OPM.h b/bootstrap/windows-48/OPM.h
index ed914bff..2d272feb 100644
--- a/bootstrap/windows-48/OPM.h
+++ b/bootstrap/windows-48/OPM.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPM__h
#define OPM__h
@@ -6,60 +6,66 @@
#include "SYSTEM.h"
-import INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_MaxSet;
-import LONGINT OPM_MaxIndex;
+import CHAR OPM_Model[10];
+import INT16 OPM_AddressSize, OPM_Alignment;
+import UINT32 OPM_GlobalOptions, OPM_Options;
+import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize;
+import INT64 OPM_MaxIndex;
import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
import BOOLEAN OPM_noerr;
-import LONGINT OPM_curpos, OPM_errpos, OPM_breakpc;
-import INTEGER OPM_currFile, OPM_level, OPM_pc, OPM_entno;
+import 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 SET OPM_opt, OPM_glbopt;
-import BOOLEAN OPM_dontAsm, OPM_dontLink, OPM_mainProg, OPM_mainLinkStat, OPM_notColorOutput, OPM_forceNewSym, OPM_Verbose;
+import CHAR OPM_ResourceDir[1024];
import void OPM_CloseFiles (void);
import void OPM_CloseOldSym (void);
import void OPM_DeleteNewSym (void);
-import void OPM_FPrint (LONGINT *fp, LONGINT val);
-import void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr);
-import void OPM_FPrintReal (LONGINT *fp, REAL real);
-import void OPM_FPrintSet (LONGINT *fp, SET set);
+import void OPM_FPrint (INT32 *fp, INT64 val);
+import void OPM_FPrintLReal (INT32 *fp, LONGREAL val);
+import void OPM_FPrintReal (INT32 *fp, REAL val);
+import void OPM_FPrintSet (INT32 *fp, UINT64 val);
import void OPM_Get (CHAR *ch);
import void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
import void OPM_InitOptions (void);
+import INT16 OPM_Integer (INT64 n);
+import void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
import void OPM_LogW (CHAR ch);
import void OPM_LogWLn (void);
-import void OPM_LogWNum (LONGINT i, LONGINT len);
+import void OPM_LogWNum (INT64 i, INT64 len);
import void OPM_LogWStr (CHAR *s, LONGINT s__len);
-import void OPM_Mark (INTEGER n, LONGINT pos);
+import INT32 OPM_Longint (INT64 n);
+import void OPM_Mark (INT16 n, INT32 pos);
import void OPM_NewSym (CHAR *modName, LONGINT modName__len);
import void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
import void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
import BOOLEAN OPM_OpenPar (void);
import void OPM_RegisterNewSym (void);
-import LONGINT OPM_SignedMaximum (LONGINT bytecount);
-import LONGINT OPM_SignedMinimum (LONGINT bytecount);
+import INT64 OPM_SignedMaximum (INT32 bytecount);
+import INT64 OPM_SignedMinimum (INT32 bytecount);
import void OPM_SymRCh (CHAR *ch);
-import LONGINT OPM_SymRInt (void);
+import INT32 OPM_SymRInt (void);
+import INT64 OPM_SymRInt64 (void);
import void OPM_SymRLReal (LONGREAL *lr);
import void OPM_SymRReal (REAL *r);
-import void OPM_SymRSet (SET *s);
+import void OPM_SymRSet (UINT64 *s);
import void OPM_SymWCh (CHAR ch);
-import void OPM_SymWInt (LONGINT i);
+import void OPM_SymWInt (INT64 i);
import void OPM_SymWLReal (LONGREAL lr);
import void OPM_SymWReal (REAL r);
-import void OPM_SymWSet (SET s);
+import void OPM_SymWSet (UINT64 s);
import void OPM_Write (CHAR ch);
-import void OPM_WriteHex (LONGINT i);
-import void OPM_WriteInt (LONGINT i);
+import void OPM_WriteHex (INT64 i);
+import void OPM_WriteInt (INT64 i);
import void OPM_WriteLn (void);
import void OPM_WriteReal (LONGREAL r, CHAR suffx);
import void OPM_WriteString (CHAR *s, LONGINT s__len);
import void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
import BOOLEAN OPM_eofSF (void);
-import void OPM_err (INTEGER n);
+import void OPM_err (INT16 n);
import void *OPM__init(void);
-#endif
+#endif // OPM
diff --git a/bootstrap/windows-48/OPP.c b/bootstrap/windows-48/OPP.c
index 01d2144d..3f360d00 100644
--- a/bootstrap/windows-48/OPP.c
+++ b/bootstrap/windows-48/OPP.c
@@ -1,4 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "OPB.h"
#include "OPM.h"
@@ -6,38 +12,38 @@
#include "OPT.h"
struct OPP__1 {
- LONGINT low, high;
+ INT32 low, high;
};
typedef
struct OPP__1 OPP_CaseTable[128];
-static SHORTINT OPP_sym, OPP_level;
-static INTEGER OPP_LoopLevel;
+static INT8 OPP_sym, OPP_level;
+static INT16 OPP_LoopLevel;
static OPT_Node OPP_TDinit, OPP_lastTDinit;
-static INTEGER OPP_nofFwdPtr;
+static INT16 OPP_nofFwdPtr;
static OPT_Struct OPP_FwdPtr[64];
-export LONGINT *OPP__1__typ;
+export ADDRESS *OPP__1__typ;
static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar);
static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned);
static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq);
-static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab);
-static void OPP_CheckMark (SHORTINT *vis);
-static void OPP_CheckSym (INTEGER s);
-static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_);
+static void OPP_CaseLabelList (OPT_Node *lab, OPT_Struct LabelTyp, INT16 *n, OPP_CaseTable tab);
+static void OPP_CheckMark (INT8 *vis);
+static void OPP_CheckSym (INT16 s);
+static void OPP_CheckSysFlag (INT16 *sysflag, INT16 default_);
static void OPP_ConstExpression (OPT_Node *x);
static void OPP_Element (OPT_Node *x);
static void OPP_Expression (OPT_Node *x);
static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b);
static void OPP_Factor (OPT_Node *x);
static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp);
-export void OPP_Module (OPT_Node *prog, SET opt);
+export void OPP_Module (OPT_Node *prog, UINT32 opt);
static void OPP_PointerType (OPT_Struct *typ);
static void OPP_ProcedureDeclaration (OPT_Node *x);
-static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec);
+static void OPP_Receiver (INT8 *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec);
static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned);
static void OPP_Sets (OPT_Node *x);
static void OPP_SimpleExpression (OPT_Node *x);
@@ -46,19 +52,19 @@ static void OPP_StatSeq (OPT_Node *stat);
static void OPP_Term (OPT_Node *x);
static void OPP_Type (OPT_Struct *typ, OPT_Struct *banned);
static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned);
-static void OPP_err (INTEGER n);
+static void OPP_err (INT16 n);
static void OPP_qualident (OPT_Object *id);
static void OPP_selector (OPT_Node *x);
-static void OPP_err (INTEGER n)
+static void OPP_err (INT16 n)
{
OPM_err(n);
}
-static void OPP_CheckSym (INTEGER s)
+static void OPP_CheckSym (INT16 s)
{
- if ((int)OPP_sym == s) {
+ if ((INT16)OPP_sym == s) {
OPS_Get(&OPP_sym);
} else {
OPM_err(s);
@@ -68,7 +74,7 @@ static void OPP_CheckSym (INTEGER s)
static void OPP_qualident (OPT_Object *id)
{
OPT_Object obj = NIL;
- SHORTINT lev;
+ INT8 lev;
OPT_Find(&obj);
OPS_Get(&OPP_sym);
if ((((OPP_sym == 18 && obj != NIL)) && obj->mode == 11)) {
@@ -89,7 +95,7 @@ static void OPP_qualident (OPT_Object *id)
obj->adr = 0;
} else {
lev = obj->mnolev;
- if ((__IN(obj->mode, 0x06) && lev != OPP_level)) {
+ if ((__IN(obj->mode, 0x06, 32) && lev != OPP_level)) {
obj->leaf = 0;
if (lev > 0) {
OPB_StaticLink(OPP_level - lev);
@@ -104,11 +110,11 @@ static void OPP_ConstExpression (OPT_Node *x)
OPP_Expression(&*x);
if ((*x)->class != 7) {
OPP_err(50);
- *x = OPB_NewIntConst(((LONGINT)(1)));
+ *x = OPB_NewIntConst(1);
}
}
-static void OPP_CheckMark (SHORTINT *vis)
+static void OPP_CheckMark (INT8 *vis)
{
OPS_Get(&OPP_sym);
if (OPP_sym == 1 || OPP_sym == 7) {
@@ -126,17 +132,17 @@ static void OPP_CheckMark (SHORTINT *vis)
}
}
-static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_)
+static void OPP_CheckSysFlag (INT16 *sysflag, INT16 default_)
{
OPT_Node x = NIL;
- LONGINT sf;
+ INT64 sf;
if (OPP_sym == 31) {
OPS_Get(&OPP_sym);
if (!OPT_SYSimported) {
OPP_err(135);
}
OPP_ConstExpression(&x);
- if (__IN(x->typ->form, 0x70)) {
+ if (x->typ->form == 4) {
sf = x->conval->intval;
if (sf < 0 || sf > 1) {
OPP_err(220);
@@ -146,7 +152,7 @@ static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_)
OPP_err(51);
sf = 0;
}
- *sysflag = (int)sf;
+ *sysflag = OPM_Integer(sf);
OPP_CheckSym(23);
} else {
*sysflag = default_;
@@ -157,8 +163,8 @@ static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned)
{
OPT_Object fld = NIL, first = NIL, last = NIL, base = NIL;
OPT_Struct ftyp = NIL;
- INTEGER sysflag;
- *typ = OPT_NewStr(15, 4);
+ INT16 sysflag;
+ *typ = OPT_NewStr(13, 4);
(*typ)->BaseTyp = NIL;
OPP_CheckSysFlag(&sysflag, -1);
if (OPP_sym == 30) {
@@ -249,11 +255,11 @@ static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned)
static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned)
{
OPT_Node x = NIL;
- LONGINT n;
- INTEGER sysflag;
+ INT64 n;
+ INT16 sysflag;
OPP_CheckSysFlag(&sysflag, 0);
if (OPP_sym == 25) {
- *typ = OPT_NewStr(15, 3);
+ *typ = OPT_NewStr(13, 3);
(*typ)->mno = 0;
(*typ)->sysflag = sysflag;
OPS_Get(&OPP_sym);
@@ -265,10 +271,10 @@ static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned)
(*typ)->n = 0;
}
} else {
- *typ = OPT_NewStr(15, 2);
+ *typ = OPT_NewStr(13, 2);
(*typ)->sysflag = sysflag;
OPP_ConstExpression(&x);
- if (__IN(x->typ->form, 0x70)) {
+ if (x->typ->form == 4) {
n = x->conval->intval;
if (n <= 0 || n > OPM_MaxIndex) {
OPP_err(63);
@@ -278,7 +284,7 @@ static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned)
OPP_err(51);
n = 1;
}
- (*typ)->n = n;
+ (*typ)->n = OPM_Longint(n);
if (OPP_sym == 25) {
OPS_Get(&OPP_sym);
OPP_Type(&(*typ)->BaseTyp, &*banned);
@@ -301,26 +307,26 @@ static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned)
static void OPP_PointerType (OPT_Struct *typ)
{
OPT_Object id = NIL;
- *typ = OPT_NewStr(13, 1);
+ *typ = OPT_NewStr(11, 1);
OPP_CheckSysFlag(&(*typ)->sysflag, 0);
OPP_CheckSym(28);
if (OPP_sym == 38) {
OPT_Find(&id);
if (id == NIL) {
if (OPP_nofFwdPtr < 64) {
- OPP_FwdPtr[__X(OPP_nofFwdPtr, ((LONGINT)(64)))] = *typ;
+ OPP_FwdPtr[__X(OPP_nofFwdPtr, 64)] = *typ;
OPP_nofFwdPtr += 1;
} else {
OPP_err(224);
}
(*typ)->link = OPT_NewObj();
- __COPY(OPS_name, (*typ)->link->name, ((LONGINT)(256)));
+ __COPY(OPS_name, (*typ)->link->name, 256);
(*typ)->BaseTyp = OPT_undftyp;
OPS_Get(&OPP_sym);
} else {
OPP_qualident(&id);
if (id->mode == 5) {
- if (__IN(id->typ->comp, 0x1c)) {
+ if (__IN(id->typ->comp, 0x1c, 32)) {
(*typ)->BaseTyp = id->typ;
} else {
(*typ)->BaseTyp = OPT_undftyp;
@@ -333,7 +339,7 @@ static void OPP_PointerType (OPT_Struct *typ)
}
} else {
OPP_Type(&(*typ)->BaseTyp, &OPT_notyp);
- if (!__IN((*typ)->BaseTyp->comp, 0x1c)) {
+ if (!__IN((*typ)->BaseTyp->comp, 0x1c, 32)) {
(*typ)->BaseTyp = OPT_undftyp;
OPP_err(57);
}
@@ -342,7 +348,7 @@ static void OPP_PointerType (OPT_Struct *typ)
static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp)
{
- SHORTINT mode;
+ INT8 mode;
OPT_Object par = NIL, first = NIL, last = NIL, res = NIL;
OPT_Struct typ = NIL;
first = NIL;
@@ -386,6 +392,9 @@ static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp)
}
OPP_CheckSym(20);
OPP_Type(&typ, &OPT_notyp);
+ if (((typ->comp == 2 || typ->comp == 4) && typ->strobj == NIL)) {
+ OPP_err(-309);
+ }
if (mode == 1) {
typ->pvused = 1;
}
@@ -409,7 +418,7 @@ static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp)
if (OPP_sym == 38) {
OPP_qualident(&res);
if (res->mode == 5) {
- if (res->typ->form < 15) {
+ if (res->typ->form < 13) {
*resTyp = res->typ;
} else {
OPP_err(54);
@@ -459,7 +468,7 @@ static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned)
OPP_PointerType(&*typ);
} else if (OPP_sym == 61) {
OPS_Get(&OPP_sym);
- *typ = OPT_NewStr(14, 1);
+ *typ = OPT_NewStr(12, 1);
OPP_CheckSysFlag(&(*typ)->sysflag, 0);
if (OPP_sym == 30) {
OPS_Get(&OPP_sym);
@@ -488,7 +497,7 @@ static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned)
static void OPP_Type (OPT_Struct *typ, OPT_Struct *banned)
{
OPP_TypeDecl(&*typ, &*banned);
- if (((((*typ)->form == 13 && (*typ)->BaseTyp == OPT_undftyp)) && (*typ)->strobj == NIL)) {
+ if (((((*typ)->form == 11 && (*typ)->BaseTyp == OPT_undftyp)) && (*typ)->strobj == NIL)) {
OPP_err(0);
}
}
@@ -503,7 +512,7 @@ static void OPP_selector (OPT_Node *x)
if (OPP_sym == 31) {
OPS_Get(&OPP_sym);
for (;;) {
- if (((*x)->typ != NIL && (*x)->typ->form == 13)) {
+ if (((*x)->typ != NIL && (*x)->typ->form == 11)) {
OPB_DeRef(&*x);
}
OPP_Expression(&y);
@@ -518,10 +527,10 @@ static void OPP_selector (OPT_Node *x)
} else if (OPP_sym == 18) {
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
- __COPY(OPS_name, name, ((LONGINT)(256)));
+ __COPY(OPS_name, name, 256);
OPS_Get(&OPP_sym);
if ((*x)->typ != NIL) {
- if ((*x)->typ->form == 13) {
+ if ((*x)->typ->form == 11) {
OPB_DeRef(&*x);
}
if ((*x)->typ->comp == 4) {
@@ -543,7 +552,7 @@ static void OPP_selector (OPT_Node *x)
OPP_err(75);
}
typ = y->obj->typ;
- if (typ->form == 13) {
+ if (typ->form == 11) {
typ = typ->BaseTyp;
}
OPT_FindField((*x)->obj->name, typ->BaseTyp, &proc);
@@ -572,7 +581,7 @@ static void OPP_selector (OPT_Node *x)
} else if (OPP_sym == 17) {
OPS_Get(&OPP_sym);
OPB_DeRef(&*x);
- } else if ((((((OPP_sym == 30 && (*x)->class < 7)) && (*x)->typ->form != 14)) && ((*x)->obj == NIL || (*x)->obj->mode != 13))) {
+ } else if ((((((OPP_sym == 30 && (*x)->class < 7)) && (*x)->typ->form != 12)) && ((*x)->obj == NIL || (*x)->obj->mode != 13))) {
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
OPP_qualident(&obj);
@@ -623,9 +632,9 @@ static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar)
static void OPP_StandProcCall (OPT_Node *x)
{
OPT_Node y = NIL;
- SHORTINT m;
- INTEGER n;
- m = (int)(*x)->obj->adr;
+ INT8 m;
+ INT16 n;
+ m = (INT8)((INT16)(*x)->obj->adr);
n = 0;
if (OPP_sym == 30) {
OPS_Get(&OPP_sym);
@@ -742,8 +751,8 @@ static void OPP_Factor (OPT_Node *x)
*x = OPB_NewRealConst(OPS_lrlval, OPT_lrltyp);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPP.Factor, OPS.numtyp = ", (LONGINT)44);
- OPM_LogWNum(OPS_numtyp, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPP.Factor, OPS.numtyp = ", 44);
+ OPM_LogWNum(OPS_numtyp, 0);
OPM_LogWLn();
break;
}
@@ -776,7 +785,7 @@ static void OPP_Factor (OPT_Node *x)
*x = NIL;
}
if (*x == NIL) {
- *x = OPB_NewIntConst(((LONGINT)(1)));
+ *x = OPB_NewIntConst(1);
(*x)->typ = OPT_undftyp;
}
}
@@ -784,7 +793,7 @@ static void OPP_Factor (OPT_Node *x)
static void OPP_Term (OPT_Node *x)
{
OPT_Node y = NIL;
- SHORTINT mulop;
+ INT8 mulop;
OPP_Factor(&*x);
while ((1 <= OPP_sym && OPP_sym <= 5)) {
mulop = OPP_sym;
@@ -797,7 +806,7 @@ static void OPP_Term (OPT_Node *x)
static void OPP_SimpleExpression (OPT_Node *x)
{
OPT_Node y = NIL;
- SHORTINT addop;
+ INT8 addop;
if (OPP_sym == 7) {
OPS_Get(&OPP_sym);
OPP_Term(&*x);
@@ -821,7 +830,7 @@ static void OPP_Expression (OPT_Node *x)
{
OPT_Node y = NIL;
OPT_Object obj = NIL;
- SHORTINT relation;
+ INT8 relation;
OPP_SimpleExpression(&*x);
if ((9 <= OPP_sym && OPP_sym <= 14)) {
relation = OPP_sym;
@@ -847,7 +856,7 @@ static void OPP_Expression (OPT_Node *x)
}
}
-static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec)
+static void OPP_Receiver (INT8 *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec)
{
OPT_Object obj = NIL;
*typ = OPT_undftyp;
@@ -858,7 +867,7 @@ static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_St
} else {
*mode = 1;
}
- __COPY(OPS_name, name, ((LONGINT)(256)));
+ __COPY(OPS_name, name, 256);
OPP_CheckSym(38);
OPP_CheckSym(20);
if (OPP_sym == 38) {
@@ -871,10 +880,10 @@ static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_St
} else {
*typ = obj->typ;
*rec = *typ;
- if ((*rec)->form == 13) {
+ if ((*rec)->form == 11) {
*rec = (*rec)->BaseTyp;
}
- if (!((((*mode == 1 && (*typ)->form == 13)) && (*rec)->comp == 4) || (*mode == 2 && (*typ)->comp == 4))) {
+ if (!((((*mode == 1 && (*typ)->form == 11)) && (*rec)->comp == 4) || (*mode == 2 && (*typ)->comp == 4))) {
OPP_err(70);
*rec = NIL;
}
@@ -888,15 +897,14 @@ static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_St
}
OPP_CheckSym(22);
if (*rec == NIL) {
- *rec = OPT_NewStr(15, 4);
+ *rec = OPT_NewStr(13, 4);
(*rec)->BaseTyp = NIL;
}
}
static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b)
{
- BOOLEAN _o_result;
- if ((b->form == 13 && x->form == 13)) {
+ if ((b->form == 11 && x->form == 11)) {
b = b->BaseTyp;
x = x->BaseTyp;
}
@@ -905,15 +913,14 @@ static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b)
x = x->BaseTyp;
} while (!(x == NIL || x == b));
}
- _o_result = x == b;
- return _o_result;
+ return x == b;
}
static struct ProcedureDeclaration__16 {
OPT_Node *x;
OPT_Object *proc, *fwd;
OPS_Name *name;
- SHORTINT *mode, *vis;
+ INT8 *mode, *vis;
BOOLEAN *forward;
struct ProcedureDeclaration__16 *lnk;
} *ProcedureDeclaration__16_s;
@@ -926,14 +933,14 @@ static void TProcDecl__23 (void);
static void GetCode__19 (void)
{
OPT_ConstExt ext = NIL;
- INTEGER n;
- LONGINT c;
+ INT16 n;
+ INT64 c;
ext = OPT_NewExt();
(*ProcedureDeclaration__16_s->proc)->conval->ext = ext;
n = 0;
if (OPP_sym == 37) {
- while (OPS_str[__X(n, ((LONGINT)(256)))] != 0x00) {
- (*ext)[__X(n + 1, ((LONGINT)(256)))] = OPS_str[__X(n, ((LONGINT)(256)))];
+ while (OPS_str[__X(n, 256)] != 0x00) {
+ (*ext)[__X(n + 1, 256)] = OPS_str[__X(n, 256)];
n += 1;
}
(*ext)[0] = (CHAR)n;
@@ -949,7 +956,7 @@ static void GetCode__19 (void)
n = 1;
}
OPS_Get(&OPP_sym);
- (*ext)[__X(n, ((LONGINT)(256)))] = (CHAR)c;
+ (*ext)[__X(n, 256)] = (CHAR)c;
}
if (OPP_sym == 19) {
OPS_Get(&OPP_sym);
@@ -961,7 +968,7 @@ static void GetCode__19 (void)
}
}
}
- (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1);
+ (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1,64);
}
static void GetParams__21 (void)
@@ -991,9 +998,9 @@ static void GetParams__21 (void)
static void Body__17 (void)
{
OPT_Node procdec = NIL, statseq = NIL;
- LONGINT c;
+ INT32 c;
c = OPM_errpos;
- (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1);
+ (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1,64);
OPP_CheckSym(39);
OPP_Block(&procdec, &statseq);
OPB_Enter(&procdec, statseq, *ProcedureDeclaration__16_s->proc);
@@ -1014,7 +1021,7 @@ static void TProcDecl__23 (void)
{
OPT_Object baseProc = NIL;
OPT_Struct objTyp = NIL, recTyp = NIL;
- SHORTINT objMode;
+ INT8 objMode;
OPS_Name objName;
OPS_Get(&OPP_sym);
*ProcedureDeclaration__16_s->mode = 13;
@@ -1023,7 +1030,7 @@ static void TProcDecl__23 (void)
}
OPP_Receiver(&objMode, objName, &objTyp, &recTyp);
if (OPP_sym == 38) {
- __COPY(OPS_name, *ProcedureDeclaration__16_s->name, ((LONGINT)(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);
@@ -1036,7 +1043,7 @@ static void TProcDecl__23 (void)
if ((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mnolev != OPP_level)) {
*ProcedureDeclaration__16_s->fwd = NIL;
}
- if ((((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mode == 13)) && !__IN(1, (*ProcedureDeclaration__16_s->fwd)->conval->setval))) {
+ if ((((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mode == 13)) && !__IN(1, (*ProcedureDeclaration__16_s->fwd)->conval->setval, 64))) {
*ProcedureDeclaration__16_s->proc = OPT_NewObj();
(*ProcedureDeclaration__16_s->proc)->leaf = 1;
if ((*ProcedureDeclaration__16_s->fwd)->vis != *ProcedureDeclaration__16_s->vis) {
@@ -1070,7 +1077,7 @@ static void TProcDecl__23 (void)
if ((((((baseProc->vis == 1 && (*ProcedureDeclaration__16_s->proc)->vis == 0)) && recTyp->strobj != NIL)) && recTyp->strobj->vis == 1)) {
OPP_err(109);
}
- (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(2);
+ (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(2,64);
}
if (!*ProcedureDeclaration__16_s->forward) {
Body__17();
@@ -1086,7 +1093,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
{
OPT_Object proc = NIL, fwd = NIL;
OPS_Name name;
- SHORTINT mode, vis;
+ INT8 mode, vis;
BOOLEAN forward;
struct ProcedureDeclaration__16 _s;
_s.x = x;
@@ -1113,7 +1120,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
} else {
OPP_err(38);
}
- if ((__IN(mode, 0x0600) && !OPT_SYSimported)) {
+ if ((__IN(mode, 0x0600, 32) && !OPT_SYSimported)) {
OPP_err(135);
}
OPS_Get(&OPP_sym);
@@ -1122,7 +1129,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
TProcDecl__23();
} else if (OPP_sym == 38) {
OPT_Find(&fwd);
- __COPY(OPS_name, name, ((LONGINT)(256)));
+ __COPY(OPS_name, name, 256);
OPP_CheckMark(&vis);
if ((vis != 0 && mode == 6)) {
mode = 7;
@@ -1130,7 +1137,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
if ((fwd != NIL && (fwd->mnolev != OPP_level || fwd->mode == 8))) {
fwd = NIL;
}
- if ((((fwd != NIL && __IN(fwd->mode, 0xc0))) && !__IN(1, fwd->conval->setval))) {
+ if ((((fwd != NIL && __IN(fwd->mode, 0xc0, 32))) && !__IN(1, fwd->conval->setval, 64))) {
proc = OPT_NewObj();
proc->leaf = 1;
if (fwd->vis != vis) {
@@ -1163,34 +1170,34 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
ProcedureDeclaration__16_s = _s.lnk;
}
-static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab)
+static void OPP_CaseLabelList (OPT_Node *lab, OPT_Struct LabelTyp, INT16 *n, OPP_CaseTable tab)
{
OPT_Node x = NIL, y = NIL, lastlab = NIL;
- INTEGER i, f;
- LONGINT xval, yval;
+ INT16 i, f;
+ INT32 xval, yval;
*lab = NIL;
lastlab = NIL;
for (;;) {
OPP_ConstExpression(&x);
f = x->typ->form;
- if (__IN(f, 0x78)) {
- xval = x->conval->intval;
+ if (__IN(f, 0x18, 32)) {
+ xval = OPM_Longint(x->conval->intval);
} else {
OPP_err(61);
xval = 1;
}
- if (__IN(f, 0x70)) {
- if (LabelForm < f) {
+ if (f == 4) {
+ if (!(LabelTyp->form == 4) || LabelTyp->size < x->typ->size) {
OPP_err(60);
}
- } else if (LabelForm != f) {
+ } else if ((INT16)LabelTyp->form != f) {
OPP_err(60);
}
if (OPP_sym == 21) {
OPS_Get(&OPP_sym);
OPP_ConstExpression(&y);
- yval = y->conval->intval;
- if (((int)y->typ->form != f && !((__IN(f, 0x70) && __IN(y->typ->form, 0x70))))) {
+ yval = OPM_Longint(y->conval->intval);
+ if (((INT16)y->typ->form != f && !((f == 4 && y->typ->form == 4)))) {
OPP_err(60);
}
if (yval < xval) {
@@ -1207,17 +1214,17 @@ static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP
if (i == 0) {
break;
}
- if (tab[__X(i - 1, ((LONGINT)(128)))].low <= yval) {
- if (tab[__X(i - 1, ((LONGINT)(128)))].high >= xval) {
+ if (tab[__X(i - 1, 128)].low <= yval) {
+ if (tab[__X(i - 1, 128)].high >= xval) {
OPP_err(62);
}
break;
}
- tab[__X(i, ((LONGINT)(128)))] = tab[__X(i - 1, ((LONGINT)(128)))];
+ tab[__X(i, 128)] = tab[__X(i - 1, 128)];
i -= 1;
}
- tab[__X(i, ((LONGINT)(128)))].low = xval;
- tab[__X(i, ((LONGINT)(128)))].high = yval;
+ tab[__X(i, 128)].low = xval;
+ tab[__X(i, 128)].high = yval;
*n += 1;
} else {
OPP_err(213);
@@ -1234,7 +1241,7 @@ static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP
}
static struct StatSeq__30 {
- LONGINT *pos;
+ INT32 *pos;
struct StatSeq__30 *lnk;
} *StatSeq__30_s;
@@ -1244,8 +1251,8 @@ static void SetPos__35 (OPT_Node x);
static void CasePart__31 (OPT_Node *x)
{
- INTEGER n;
- LONGINT low, high;
+ INT16 n;
+ INT32 low, high;
BOOLEAN e;
OPP_CaseTable tab;
OPT_Node cases = NIL, lab = NIL, y = NIL, lastcase = NIL;
@@ -1253,7 +1260,7 @@ static void CasePart__31 (OPT_Node *x)
*StatSeq__30_s->pos = OPM_errpos;
if ((*x)->class == 8 || (*x)->class == 9) {
OPP_err(126);
- } else if (!__IN((*x)->typ->form, 0x78)) {
+ } else if (!__IN((*x)->typ->form, 0x18, 32)) {
OPP_err(125);
}
OPP_CheckSym(25);
@@ -1262,7 +1269,7 @@ static void CasePart__31 (OPT_Node *x)
n = 0;
for (;;) {
if (OPP_sym < 40) {
- OPP_CaseLabelList(&lab, (*x)->typ->form, &n, tab);
+ OPP_CaseLabelList(&lab, (*x)->typ, &n, tab);
OPP_CheckSym(20);
OPP_StatSeq(&y);
OPB_Construct(17, &lab, y);
@@ -1276,7 +1283,7 @@ static void CasePart__31 (OPT_Node *x)
}
if (n > 0) {
low = tab[0].low;
- high = tab[__X(n - 1, ((LONGINT)(128)))].high;
+ high = tab[__X(n - 1, 128)].high;
if (high - low > 512) {
OPP_err(209);
}
@@ -1328,7 +1335,7 @@ static void OPP_StatSeq (OPT_Node *stat)
OPT_Struct idtyp = NIL;
BOOLEAN e;
OPT_Node s = NIL, x = NIL, y = NIL, z = NIL, apar = NIL, last = NIL, lastif = NIL;
- LONGINT pos;
+ INT32 pos;
OPS_Name name;
struct StatSeq__30 _s;
_s.pos = &pos;
@@ -1439,7 +1446,7 @@ static void OPP_StatSeq (OPT_Node *stat)
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
OPP_qualident(&id);
- if (!__IN(id->typ->form, 0x70)) {
+ if (!(id->typ->form == 4)) {
OPP_err(68);
}
OPP_CheckSym(34);
@@ -1471,7 +1478,7 @@ static void OPP_StatSeq (OPT_Node *stat)
SetPos__35(z);
OPB_Link(&*stat, &last, z);
y = OPB_NewLeaf(t);
- } else if (y->typ->form < 4 || y->typ->form > x->left->typ->form) {
+ } else if (!(y->typ->form == 4) || y->typ->size > x->left->typ->size) {
OPP_err(113);
}
OPB_Link(&*stat, &last, x);
@@ -1479,7 +1486,7 @@ static void OPP_StatSeq (OPT_Node *stat)
OPS_Get(&OPP_sym);
OPP_ConstExpression(&z);
} else {
- z = OPB_NewIntConst(((LONGINT)(1)));
+ z = OPB_NewIntConst(1);
}
pos = OPM_errpos;
x = OPB_NewLeaf(id);
@@ -1526,7 +1533,7 @@ static void OPP_StatSeq (OPT_Node *stat)
if (OPP_sym == 38) {
OPP_qualident(&id);
y = OPB_NewLeaf(id);
- if ((((id != NIL && id->typ->form == 13)) && (id->mode == 2 || !id->leaf))) {
+ if ((((id != NIL && id->typ->form == 11)) && (id->mode == 2 || !id->leaf))) {
OPP_err(245);
}
OPP_CheckSym(20);
@@ -1621,7 +1628,7 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
OPT_Struct typ = NIL;
OPT_Object obj = NIL, first = NIL, last = NIL;
OPT_Node x = NIL, lastdec = NIL;
- INTEGER i;
+ INT16 i;
first = NIL;
last = NIL;
OPP_nofFwdPtr = 0;
@@ -1642,7 +1649,7 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
OPP_ConstExpression(&x);
} else {
OPP_err(9);
- x = OPB_NewIntConst(((LONGINT)(1)));
+ x = OPB_NewIntConst(1);
}
obj->mode = 3;
obj->typ = x->typ;
@@ -1670,10 +1677,10 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
if (obj->typ->strobj == NIL) {
obj->typ->strobj = obj;
}
- if (__IN(obj->typ->comp, 0x1c)) {
+ if (__IN(obj->typ->comp, 0x1c, 32)) {
i = 0;
while (i < OPP_nofFwdPtr) {
- typ = OPP_FwdPtr[__X(i, ((LONGINT)(64)))];
+ typ = OPP_FwdPtr[__X(i, 64)];
i += 1;
if (__STRCMP(typ->link->name, obj->name) == 0) {
typ->BaseTyp = obj->typ;
@@ -1735,10 +1742,10 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
}
i = 0;
while (i < OPP_nofFwdPtr) {
- if (OPP_FwdPtr[__X(i, ((LONGINT)(64)))]->link->name[0] != 0x00) {
+ if (OPP_FwdPtr[__X(i, 64)]->link->name[0] != 0x00) {
OPP_err(128);
}
- OPP_FwdPtr[__X(i, ((LONGINT)(64)))] = NIL;
+ OPP_FwdPtr[__X(i, 64)] = NIL;
i += 1;
}
OPT_topScope->adr = OPM_errpos;
@@ -1770,11 +1777,11 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
OPP_CheckSym(41);
}
-void OPP_Module (OPT_Node *prog, SET opt)
+void OPP_Module (OPT_Node *prog, UINT32 opt)
{
OPS_Name impName, aliasName;
OPT_Node procdec = NIL, statseq = NIL;
- LONGINT c;
+ INT32 c;
BOOLEAN done;
OPS_Init();
OPP_LoopLevel = 0;
@@ -1784,28 +1791,28 @@ void OPP_Module (OPT_Node *prog, SET opt)
OPS_Get(&OPP_sym);
} else {
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Unexpected symbol found when MODULE expected:", (LONGINT)46);
+ OPM_LogWStr((CHAR*)"Unexpected symbol found when MODULE expected:", 46);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" sym: ", (LONGINT)15);
- OPM_LogWNum(OPP_sym, ((LONGINT)(1)));
+ OPM_LogWStr((CHAR*)" sym: ", 15);
+ OPM_LogWNum(OPP_sym, 1);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.name: ", (LONGINT)15);
- OPM_LogWStr(OPS_name, ((LONGINT)(256)));
+ OPM_LogWStr((CHAR*)" OPS.name: ", 15);
+ OPM_LogWStr(OPS_name, 256);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.str: ", (LONGINT)15);
- OPM_LogWStr(OPS_str, ((LONGINT)(256)));
+ OPM_LogWStr((CHAR*)" OPS.str: ", 15);
+ OPM_LogWStr(OPS_str, 256);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.numtyp: ", (LONGINT)15);
- OPM_LogWNum(OPS_numtyp, ((LONGINT)(1)));
+ OPM_LogWStr((CHAR*)" OPS.numtyp: ", 15);
+ OPM_LogWNum(OPS_numtyp, 1);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.intval: ", (LONGINT)15);
- OPM_LogWNum(OPS_intval, ((LONGINT)(1)));
+ OPM_LogWStr((CHAR*)" OPS.intval: ", 15);
+ OPM_LogWNum(OPS_intval, 1);
OPM_LogWLn();
OPP_err(16);
}
if (OPP_sym == 38) {
- OPM_LogWStr((CHAR*)"compiling ", (LONGINT)11);
- OPM_LogWStr(OPS_name, ((LONGINT)(256)));
+ OPM_LogWStr((CHAR*)"compiling ", 11);
+ OPM_LogWStr(OPS_name, 256);
OPM_LogW('.');
OPT_Init(OPS_name, opt);
OPS_Get(&OPP_sym);
@@ -1814,13 +1821,13 @@ void OPP_Module (OPT_Node *prog, SET opt)
OPS_Get(&OPP_sym);
for (;;) {
if (OPP_sym == 38) {
- __COPY(OPS_name, aliasName, ((LONGINT)(256)));
- __COPY(aliasName, impName, ((LONGINT)(256)));
+ __COPY(OPS_name, aliasName, 256);
+ __COPY(aliasName, impName, 256);
OPS_Get(&OPP_sym);
if (OPP_sym == 34) {
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
- __COPY(OPS_name, impName, ((LONGINT)(256)));
+ __COPY(OPS_name, impName, 256);
OPS_Get(&OPP_sym);
} else {
OPP_err(38);
diff --git a/bootstrap/windows-48/OPP.h b/bootstrap/windows-48/OPP.h
index bf56b7d7..5a71eb39 100644
--- a/bootstrap/windows-48/OPP.h
+++ b/bootstrap/windows-48/OPP.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPP__h
#define OPP__h
@@ -9,8 +9,8 @@
-import void OPP_Module (OPT_Node *prog, SET opt);
+import void OPP_Module (OPT_Node *prog, UINT32 opt);
import void *OPP__init(void);
-#endif
+#endif // OPP
diff --git a/bootstrap/windows-48/OPS.c b/bootstrap/windows-48/OPS.c
index cacf9256..6ee700e5 100644
--- a/bootstrap/windows-48/OPS.c
+++ b/bootstrap/windows-48/OPS.c
@@ -1,4 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "OPM.h"
@@ -11,29 +17,29 @@ typedef
export OPS_Name OPS_name;
export OPS_String OPS_str;
-export INTEGER OPS_numtyp;
-export LONGINT OPS_intval;
+export INT16 OPS_numtyp;
+export INT64 OPS_intval;
export REAL OPS_realval;
export LONGREAL OPS_lrlval;
static CHAR OPS_ch;
-export void OPS_Get (SHORTINT *sym);
-static void OPS_Identifier (SHORTINT *sym);
+export void OPS_Get (INT8 *sym);
+static void OPS_Identifier (INT8 *sym);
export void OPS_Init (void);
static void OPS_Number (void);
-static void OPS_Str (SHORTINT *sym);
-static void OPS_err (INTEGER n);
+static void OPS_Str (INT8 *sym);
+static void OPS_err (INT16 n);
-static void OPS_err (INTEGER n)
+static void OPS_err (INT16 n)
{
OPM_err(n);
}
-static void OPS_Str (SHORTINT *sym)
+static void OPS_Str (INT8 *sym)
{
- INTEGER i;
+ INT16 i;
CHAR och;
i = 0;
och = OPS_ch;
@@ -59,15 +65,15 @@ static void OPS_Str (SHORTINT *sym)
if (OPS_intval == 2) {
*sym = 35;
OPS_numtyp = 1;
- OPS_intval = (int)OPS_str[0];
+ OPS_intval = (INT16)OPS_str[0];
} else {
*sym = 37;
}
}
-static void OPS_Identifier (SHORTINT *sym)
+static void OPS_Identifier (INT8 *sym)
{
- INTEGER i;
+ INT16 i;
i = 0;
do {
OPS_name[i] = OPS_ch;
@@ -86,12 +92,11 @@ static struct Number__6 {
struct Number__6 *lnk;
} *Number__6_s;
-static INTEGER Ord__7 (CHAR ch, BOOLEAN hex);
-static LONGREAL Ten__9 (INTEGER e);
+static INT16 Ord__7 (CHAR ch, BOOLEAN hex);
+static LONGREAL Ten__9 (INT16 e);
-static LONGREAL Ten__9 (INTEGER e)
+static LONGREAL Ten__9 (INT16 e)
{
- LONGREAL _o_result;
LONGREAL x, p;
x = (LONGREAL)1;
p = (LONGREAL)10;
@@ -104,30 +109,25 @@ static LONGREAL Ten__9 (INTEGER e)
p = p * p;
}
}
- _o_result = x;
- return _o_result;
+ return x;
}
-static INTEGER Ord__7 (CHAR ch, BOOLEAN hex)
+static INT16 Ord__7 (CHAR ch, BOOLEAN hex)
{
- INTEGER _o_result;
if (ch <= '9') {
- _o_result = (int)ch - 48;
- return _o_result;
+ return (INT16)ch - 48;
} else if (hex) {
- _o_result = ((int)ch - 65) + 10;
- return _o_result;
+ return ((INT16)ch - 65) + 10;
} else {
OPS_err(2);
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
static void OPS_Number (void)
{
- INTEGER i, m, n, d, e, maxHdig;
+ INT16 i, m, n, d, e;
CHAR dig[24];
LONGREAL f;
CHAR expCh;
@@ -173,7 +173,7 @@ static void OPS_Number (void)
OPS_numtyp = 1;
if (n <= 2) {
while (i < n) {
- OPS_intval = __ASHL(OPS_intval, 4) + (int)Ord__7(dig[i], 1);
+ OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1);
i += 1;
}
} else {
@@ -182,13 +182,12 @@ static void OPS_Number (void)
} else if (OPS_ch == 'H') {
OPM_Get(&OPS_ch);
OPS_numtyp = 2;
- maxHdig = 8;
- if (n <= maxHdig) {
- if ((n == maxHdig && dig[0] > '7')) {
+ if (n <= 16) {
+ if ((n == 16 && dig[0] > '7')) {
OPS_intval = -1;
}
while (i < n) {
- OPS_intval = __ASHL(OPS_intval, 4) + (int)Ord__7(dig[i], 1);
+ OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1);
i += 1;
}
} else {
@@ -199,8 +198,8 @@ static void OPS_Number (void)
while (i < n) {
d = Ord__7(dig[i], 0);
i += 1;
- if (OPS_intval <= __DIV(2147483647 - (int)d, 10)) {
- OPS_intval = OPS_intval * 10 + (int)d;
+ if (OPS_intval <= __DIV(9223372036854775807 - (INT64)d, 10)) {
+ OPS_intval = OPS_intval * 10 + (INT64)d;
} else {
OPS_err(203);
}
@@ -309,9 +308,9 @@ static void Comment__2 (void)
}
}
-void OPS_Get (SHORTINT *sym)
+void OPS_Get (INT8 *sym)
{
- SHORTINT s;
+ INT8 s;
struct Get__1 _s;
_s.lnk = Get__1_s;
Get__1_s = &_s;
@@ -319,6 +318,7 @@ void OPS_Get (SHORTINT *sym)
while (OPS_ch <= ' ') {
if (OPS_ch == 0x00) {
*sym = 64;
+ Get__1_s = _s.lnk;
return;
} else {
OPM_Get(&OPS_ch);
diff --git a/bootstrap/windows-48/OPS.h b/bootstrap/windows-48/OPS.h
index e901bcfc..1f7a3e58 100644
--- a/bootstrap/windows-48/OPS.h
+++ b/bootstrap/windows-48/OPS.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
#ifndef OPS__h
#define OPS__h
@@ -14,15 +14,15 @@ typedef
import OPS_Name OPS_name;
import OPS_String OPS_str;
-import INTEGER OPS_numtyp;
-import LONGINT OPS_intval;
+import INT16 OPS_numtyp;
+import INT64 OPS_intval;
import REAL OPS_realval;
import LONGREAL OPS_lrlval;
-import void OPS_Get (SHORTINT *sym);
+import void OPS_Get (INT8 *sym);
import void OPS_Init (void);
import void *OPS__init(void);
-#endif
+#endif // OPS
diff --git a/bootstrap/windows-48/OPT.c b/bootstrap/windows-48/OPT.c
index b32d0ebd..75820a95 100644
--- a/bootstrap/windows-48/OPT.c
+++ b/bootstrap/windows-48/OPT.c
@@ -1,4 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "OPM.h"
#include "OPS.h"
@@ -12,17 +18,18 @@ typedef
typedef
struct OPT_ConstDesc {
OPT_ConstExt ext;
- LONGINT intval, intval2;
- SET setval;
+ INT64 intval;
+ INT32 intval2;
+ UINT64 setval;
LONGREAL realval;
} OPT_ConstDesc;
typedef
struct OPT_ExpCtxt {
- LONGINT reffp;
- INTEGER ref;
- SHORTINT nofm;
- SHORTINT locmno[64];
+ INT32 reffp;
+ INT16 ref;
+ INT8 nofm;
+ INT8 locmno[64];
} OPT_ExpCtxt;
typedef
@@ -33,13 +40,13 @@ typedef
typedef
struct OPT_ImpCtxt {
- LONGINT nextTag, reffp;
- INTEGER nofr, minr, nofm;
+ INT32 nextTag, reffp;
+ INT16 nofr, minr, nofm;
BOOLEAN self;
OPT_Struct ref[255];
OPT_Object old[255];
- LONGINT pvfp[255];
- SHORTINT glbmno[64];
+ INT32 pvfp[255];
+ INT8 glbmno[64];
} OPT_ImpCtxt;
typedef
@@ -48,7 +55,7 @@ typedef
typedef
struct OPT_NodeDesc {
OPT_Node left, right, link;
- SHORTINT class, subcl;
+ INT8 class, subcl;
BOOLEAN readonly;
OPT_Struct typ;
OPT_Object obj;
@@ -60,120 +67,319 @@ typedef
OPT_Object left, right, link, scope;
OPS_Name name;
BOOLEAN leaf;
- SHORTINT mode, mnolev, vis, history;
+ INT8 mode, mnolev, vis, history;
BOOLEAN used, fpdone;
- LONGINT fprint;
+ INT32 fprint;
OPT_Struct typ;
OPT_Const conval;
- LONGINT adr, linkadr;
- INTEGER x;
+ INT32 adr, linkadr;
+ INT16 x;
} OPT_ObjDesc;
typedef
struct OPT_StrDesc {
- SHORTINT form, comp, mno, extlev;
- INTEGER ref, sysflag;
- LONGINT n, size, align, txtpos;
+ INT8 form, comp, mno, extlev;
+ INT16 ref, sysflag;
+ INT32 n, size, align, txtpos;
BOOLEAN allocated, pbused, pvused, fpdone, idfpdone;
- LONGINT idfp, pbfp, pvfp;
+ INT32 idfp, pbfp, pvfp;
OPT_Struct BaseTyp;
OPT_Object link, strobj;
} OPT_StrDesc;
-export void (*OPT_typSize)(OPT_Struct);
export OPT_Object OPT_topScope;
-export OPT_Struct OPT_undftyp, OPT_bytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_realtyp, OPT_lrltyp, OPT_settyp, OPT_stringtyp, OPT_niltyp, OPT_notyp, OPT_sysptrtyp;
-export SHORTINT OPT_nofGmod;
+export OPT_Struct OPT_undftyp, OPT_niltyp, OPT_notyp, OPT_bytetyp, OPT_cpbytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_hinttyp, OPT_int8typ, OPT_int16typ, OPT_int32typ, OPT_int64typ, OPT_settyp, OPT_set32typ, OPT_set64typ, OPT_realtyp, OPT_lrltyp, OPT_stringtyp, OPT_adrtyp, OPT_sysptrtyp;
+export OPT_Object OPT_sintobj, OPT_intobj, OPT_lintobj, OPT_setobj;
+export INT8 OPT_nofGmod;
export OPT_Object OPT_GlbMod[64];
export OPS_Name OPT_SelfName;
export BOOLEAN OPT_SYSimported;
static OPT_Object OPT_universe, OPT_syslink;
static OPT_ImpCtxt OPT_impCtxt;
static OPT_ExpCtxt OPT_expCtxt;
-static LONGINT OPT_nofhdfld;
+static INT32 OPT_nofhdfld;
static BOOLEAN OPT_newsf, OPT_findpc, OPT_extsf, OPT_sfpresent, OPT_symExtended, OPT_symNew;
+static INT32 OPT_recno;
-export LONGINT *OPT_ConstDesc__typ;
-export LONGINT *OPT_ObjDesc__typ;
-export LONGINT *OPT_StrDesc__typ;
-export LONGINT *OPT_NodeDesc__typ;
-export LONGINT *OPT_ImpCtxt__typ;
-export LONGINT *OPT_ExpCtxt__typ;
+export ADDRESS *OPT_ConstDesc__typ;
+export ADDRESS *OPT_ObjDesc__typ;
+export ADDRESS *OPT_StrDesc__typ;
+export ADDRESS *OPT_NodeDesc__typ;
+export ADDRESS *OPT_ImpCtxt__typ;
+export ADDRESS *OPT_ExpCtxt__typ;
+export void OPT_Align (INT32 *adr, INT32 base);
+export INT32 OPT_BaseAlignment (OPT_Struct typ);
export void OPT_Close (void);
export void OPT_CloseScope (void);
static void OPT_DebugStruct (OPT_Struct btyp);
-static void OPT_EnterBoolConst (OPS_Name name, LONGINT value);
-static void OPT_EnterProc (OPS_Name name, INTEGER num);
-static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct *res);
+static void OPT_EnterBoolConst (OPS_Name name, INT32 value);
+static void OPT_EnterProc (OPS_Name name, INT16 num);
+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, INTEGER errcode);
-static void OPT_FPrintName (LONGINT *fp, CHAR *name, LONGINT name__len);
+export void OPT_FPrintErr (OPT_Object obj, INT16 errcode);
+static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len);
export void OPT_FPrintObj (OPT_Object obj);
-static void OPT_FPrintSign (LONGINT *fp, OPT_Struct result, OPT_Object par);
+static void OPT_FPrintSign (INT32 *fp, OPT_Struct result, OPT_Object par);
export void OPT_FPrintStr (OPT_Struct typ);
export void OPT_Find (OPT_Object *res);
export void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res);
export void OPT_FindImport (OPT_Object mod, OPT_Object *res);
export void OPT_IdFPrint (OPT_Struct typ);
export void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done);
-static void OPT_InConstant (LONGINT f, OPT_Const conval);
+static void OPT_InConstant (INT32 f, OPT_Const conval);
static OPT_Object OPT_InFld (void);
-static void OPT_InMod (SHORTINT *mno);
+static void OPT_InMod (INT8 *mno);
static void OPT_InName (CHAR *name, LONGINT name__len);
-static OPT_Object OPT_InObj (SHORTINT mno);
-static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par);
+static 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);
-static OPT_Object OPT_InTProc (SHORTINT mno);
-export void OPT_Init (OPS_Name name, SET opt);
-static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form);
+static OPT_Object OPT_InTProc (INT8 mno);
+static OPT_Struct OPT_InTyp (INT32 tag);
+export void OPT_Init (OPS_Name name, UINT32 opt);
+export void OPT_InitRecno (void);
+static void OPT_InitStruct (OPT_Struct *typ, INT8 form);
export void OPT_Insert (OPS_Name name, OPT_Object *obj);
export void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old);
+export INT16 OPT_IntSize (INT64 n);
+export OPT_Struct OPT_IntType (INT32 size);
export OPT_Const OPT_NewConst (void);
export OPT_ConstExt OPT_NewExt (void);
-export OPT_Node OPT_NewNode (SHORTINT class);
+export OPT_Node OPT_NewNode (INT8 class);
export OPT_Object OPT_NewObj (void);
-export OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp);
-export void OPT_OpenScope (SHORTINT level, OPT_Object owner);
+export OPT_Struct OPT_NewStr (INT8 form, INT8 comp);
+export void OPT_OpenScope (INT8 level, OPT_Object owner);
static void OPT_OutConstant (OPT_Object obj);
-static void OPT_OutFlds (OPT_Object fld, LONGINT adr, BOOLEAN visible);
-static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr);
-static void OPT_OutMod (INTEGER mno);
+static void OPT_OutFlds (OPT_Object fld, INT32 adr, BOOLEAN visible);
+static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr);
+static void OPT_OutMod (INT16 mno);
static void OPT_OutName (CHAR *name, LONGINT name__len);
static void OPT_OutObj (OPT_Object obj);
static void OPT_OutSign (OPT_Struct result, OPT_Object par);
static void OPT_OutStr (OPT_Struct typ);
static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj);
-static void OPT_err (INTEGER n);
+export OPT_Struct OPT_SetType (INT32 size);
+export OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir);
+export INT32 OPT_SizeAlignment (INT32 size);
+export void OPT_TypSize (OPT_Struct typ);
+static void OPT_err (INT16 n);
-static void OPT_err (INTEGER n)
+void OPT_InitRecno (void)
+{
+ OPT_recno = 0;
+}
+
+static void OPT_err (INT16 n)
{
OPM_err(n);
}
+INT16 OPT_IntSize (INT64 n)
+{
+ INT16 bytes;
+ if (n < 0) {
+ n = -(n + 1);
+ }
+ bytes = 1;
+ while ((bytes < 8 && __ASH(n, -(__ASHL(bytes, 3) - 1)) != 0)) {
+ bytes += 1;
+ }
+ return bytes;
+}
+
+OPT_Struct OPT_IntType (INT32 size)
+{
+ if (size <= OPT_int8typ->size) {
+ return OPT_int8typ;
+ }
+ if (size <= OPT_int16typ->size) {
+ return OPT_int16typ;
+ }
+ if (size <= OPT_int32typ->size) {
+ return OPT_int32typ;
+ }
+ return OPT_int64typ;
+}
+
+OPT_Struct OPT_SetType (INT32 size)
+{
+ if (size == OPT_set32typ->size) {
+ return OPT_set32typ;
+ }
+ return OPT_set64typ;
+}
+
+OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir)
+{
+ INT16 i;
+ __ASSERT(x->form == 4, 0);
+ __ASSERT(x->BaseTyp == OPT_undftyp, 0);
+ __ASSERT(dir == 1 || dir == -1, 0);
+ if (dir > 0) {
+ if (x->size < OPT_sinttyp->size) {
+ return OPT_sinttyp;
+ }
+ if (x->size < OPT_inttyp->size) {
+ return OPT_inttyp;
+ }
+ if (x->size < OPT_linttyp->size) {
+ return OPT_linttyp;
+ }
+ return OPT_int64typ;
+ } else {
+ if (x->size > OPT_linttyp->size) {
+ return OPT_linttyp;
+ }
+ if (x->size > OPT_inttyp->size) {
+ return OPT_inttyp;
+ }
+ if (x->size > OPT_sinttyp->size) {
+ return OPT_sinttyp;
+ }
+ return OPT_int8typ;
+ }
+ __RETCHK;
+}
+
+void OPT_Align (INT32 *adr, INT32 base)
+{
+ switch (base) {
+ case 2:
+ *adr += __MASK(*adr, -2);
+ break;
+ case 4:
+ *adr += __MASK(-*adr, -4);
+ break;
+ case 8:
+ *adr += __MASK(-*adr, -8);
+ break;
+ case 16:
+ *adr += __MASK(-*adr, -16);
+ break;
+ default:
+ break;
+ }
+}
+
+INT32 OPT_SizeAlignment (INT32 size)
+{
+ INT32 alignment;
+ if (size < OPM_Alignment) {
+ alignment = 1;
+ while (alignment < size) {
+ alignment = __ASHL(alignment, 1);
+ }
+ } else {
+ alignment = OPM_Alignment;
+ }
+ return alignment;
+}
+
+INT32 OPT_BaseAlignment (OPT_Struct typ)
+{
+ INT32 alignment;
+ if (typ->form == 13) {
+ if (typ->comp == 4) {
+ alignment = __MASK(typ->align, -65536);
+ } else {
+ alignment = OPT_BaseAlignment(typ->BaseTyp);
+ }
+ } else {
+ alignment = OPT_SizeAlignment(typ->size);
+ }
+ return alignment;
+}
+
+void OPT_TypSize (OPT_Struct typ)
+{
+ INT16 f, c;
+ INT32 offset, size, base, fbase, off0;
+ OPT_Object fld = NIL;
+ OPT_Struct btyp = NIL;
+ if (typ == OPT_undftyp) {
+ OPM_err(58);
+ } else if (typ->size == -1) {
+ f = typ->form;
+ c = typ->comp;
+ if (c == 4) {
+ btyp = typ->BaseTyp;
+ if (btyp == NIL) {
+ offset = 0;
+ base = 1;
+ } else {
+ OPT_TypSize(btyp);
+ offset = btyp->size - __ASHR(btyp->sysflag, 8);
+ base = btyp->align;
+ }
+ fld = typ->link;
+ while ((fld != NIL && fld->mode == 4)) {
+ btyp = fld->typ;
+ OPT_TypSize(btyp);
+ size = btyp->size;
+ fbase = OPT_BaseAlignment(btyp);
+ OPT_Align(&offset, fbase);
+ fld->adr = offset;
+ offset += size;
+ if (fbase > base) {
+ base = fbase;
+ }
+ fld = fld->link;
+ }
+ off0 = offset;
+ if (offset == 0) {
+ offset = 1;
+ }
+ OPT_Align(&offset, base);
+ if ((typ->strobj == NIL && __MASK(typ->align, -65536) == 0)) {
+ OPT_recno += 1;
+ base += __ASHL(OPT_recno, 16);
+ }
+ typ->size = offset;
+ typ->align = base;
+ 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;
+ } else if (f == 11) {
+ typ->size = OPM_AddressSize;
+ if (typ->BaseTyp == OPT_undftyp) {
+ OPM_Mark(128, typ->n);
+ } else {
+ OPT_TypSize(typ->BaseTyp);
+ }
+ } else if (f == 12) {
+ typ->size = OPM_AddressSize;
+ } else if (c == 3) {
+ btyp = typ->BaseTyp;
+ OPT_TypSize(btyp);
+ if (btyp->comp == 3) {
+ typ->size = btyp->size + 4;
+ } else {
+ typ->size = 8;
+ }
+ }
+ }
+}
+
OPT_Const OPT_NewConst (void)
{
- OPT_Const _o_result;
OPT_Const const_ = NIL;
__NEW(const_, OPT_ConstDesc);
- _o_result = const_;
- return _o_result;
+ return const_;
}
OPT_Object OPT_NewObj (void)
{
- OPT_Object _o_result;
OPT_Object obj = NIL;
__NEW(obj, OPT_ObjDesc);
- _o_result = obj;
- return _o_result;
+ return obj;
}
-OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp)
+OPT_Struct OPT_NewStr (INT8 form, INT8 comp)
{
- OPT_Struct _o_result;
OPT_Struct typ = NIL;
__NEW(typ, OPT_StrDesc);
typ->form = form;
@@ -184,30 +390,25 @@ OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp)
}
typ->size = -1;
typ->BaseTyp = OPT_undftyp;
- _o_result = typ;
- return _o_result;
+ return typ;
}
-OPT_Node OPT_NewNode (SHORTINT class)
+OPT_Node OPT_NewNode (INT8 class)
{
- OPT_Node _o_result;
OPT_Node node = NIL;
__NEW(node, OPT_NodeDesc);
node->class = class;
- _o_result = node;
- return _o_result;
+ return node;
}
OPT_ConstExt OPT_NewExt (void)
{
- OPT_ConstExt _o_result;
OPT_ConstExt ext = NIL;
- ext = __NEWARR(NIL, ((LONGINT)(1)), 1, 1, 0, (LONGINT)256);
- _o_result = ext;
- return _o_result;
+ ext = __NEWARR(NIL, 1, 1, 1, 0, 256);
+ return ext;
}
-void OPT_OpenScope (SHORTINT level, OPT_Object owner)
+void OPT_OpenScope (INT8 level, OPT_Object owner)
{
OPT_Object head = NIL;
head = OPT_NewObj();
@@ -228,34 +429,34 @@ void OPT_CloseScope (void)
OPT_topScope = OPT_topScope->left;
}
-void OPT_Init (OPS_Name name, SET opt)
+void OPT_Init (OPS_Name name, UINT32 opt)
{
OPT_topScope = OPT_universe;
OPT_OpenScope(0, NIL);
OPT_SYSimported = 0;
- __COPY(name, OPT_SelfName, ((LONGINT)(256)));
- __COPY(name, OPT_topScope->name, ((LONGINT)(256)));
+ __COPY(name, OPT_SelfName, 256);
+ __COPY(name, OPT_topScope->name, 256);
OPT_GlbMod[0] = OPT_topScope;
OPT_nofGmod = 1;
- OPT_newsf = __IN(4, opt);
- OPT_findpc = __IN(8, opt);
- OPT_extsf = OPT_newsf || __IN(9, opt);
+ OPT_newsf = __IN(4, opt, 32);
+ OPT_findpc = __IN(8, opt, 32);
+ OPT_extsf = OPT_newsf || __IN(9, opt, 32);
OPT_sfpresent = 1;
}
void OPT_Close (void)
{
- INTEGER i;
+ INT16 i;
OPT_CloseScope();
i = 0;
while (i < 64) {
- OPT_GlbMod[__X(i, ((LONGINT)(64)))] = NIL;
+ OPT_GlbMod[__X(i, 64)] = NIL;
i += 1;
}
- i = 16;
+ i = 14;
while (i < 255) {
- OPT_impCtxt.ref[__X(i, ((LONGINT)(255)))] = NIL;
- OPT_impCtxt.old[__X(i, ((LONGINT)(255)))] = NIL;
+ OPT_impCtxt.ref[__X(i, 255)] = NIL;
+ OPT_impCtxt.old[__X(i, 255)] = NIL;
i += 1;
}
}
@@ -337,7 +538,7 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
{
OPT_Object ob0 = NIL, ob1 = NIL;
BOOLEAN left;
- SHORTINT mnolev;
+ INT8 mnolev;
ob0 = OPT_topScope;
ob1 = ob0->right;
left = 0;
@@ -366,7 +567,7 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
}
ob1->left = NIL;
ob1->right = NIL;
- __COPY(name, ob1->name, ((LONGINT)(256)));
+ __COPY(name, ob1->name, 256);
mnolev = OPT_topScope->mnolev;
ob1->mnolev = mnolev;
break;
@@ -375,14 +576,14 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
*obj = ob1;
}
-static void OPT_FPrintName (LONGINT *fp, CHAR *name, LONGINT name__len)
+static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len)
{
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
do {
ch = name[__X(i, name__len)];
- OPM_FPrint(&*fp, (int)ch);
+ OPM_FPrint(&*fp, (INT16)ch);
i += 1;
} while (!(ch == 0x00));
}
@@ -391,36 +592,36 @@ static void OPT_DebugStruct (OPT_Struct btyp)
{
OPM_LogWLn();
if (btyp == NIL) {
- OPM_LogWStr((CHAR*)"btyp is nil", (LONGINT)12);
+ OPM_LogWStr((CHAR*)"btyp is nil", 12);
OPM_LogWLn();
}
- OPM_LogWStr((CHAR*)"btyp^.strobji^.name = ", (LONGINT)23);
- OPM_LogWStr(btyp->strobj->name, ((LONGINT)(256)));
+ OPM_LogWStr((CHAR*)"btyp^.strobji^.name = ", 23);
+ OPM_LogWStr(btyp->strobj->name, 256);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.form = ", (LONGINT)14);
- OPM_LogWNum(btyp->form, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.form = ", 14);
+ OPM_LogWNum(btyp->form, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.comp = ", (LONGINT)14);
- OPM_LogWNum(btyp->comp, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.comp = ", 14);
+ OPM_LogWNum(btyp->comp, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.mno = ", (LONGINT)13);
- OPM_LogWNum(btyp->mno, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.mno = ", 13);
+ OPM_LogWNum(btyp->mno, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.extlev = ", (LONGINT)16);
- OPM_LogWNum(btyp->extlev, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.extlev = ", 16);
+ OPM_LogWNum(btyp->extlev, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.size = ", (LONGINT)14);
- OPM_LogWNum(btyp->size, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.size = ", 14);
+ OPM_LogWNum(btyp->size, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.align = ", (LONGINT)15);
- OPM_LogWNum(btyp->align, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.align = ", 15);
+ OPM_LogWNum(btyp->align, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.txtpos = ", (LONGINT)16);
- OPM_LogWNum(btyp->txtpos, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.txtpos = ", 16);
+ OPM_LogWNum(btyp->txtpos, 0);
OPM_LogWLn();
}
-static void OPT_FPrintSign (LONGINT *fp, OPT_Struct result, OPT_Object par)
+static void OPT_FPrintSign (INT32 *fp, OPT_Struct result, OPT_Object par)
{
OPT_IdFPrint(result);
OPM_FPrint(&*fp, result->idfp);
@@ -436,50 +637,53 @@ void OPT_IdFPrint (OPT_Struct typ)
{
OPT_Struct btyp = NIL;
OPT_Object strobj = NIL;
- LONGINT idfp;
- INTEGER f, c;
+ INT32 idfp;
+ INT16 f, c;
if (!typ->idfpdone) {
typ->idfpdone = 1;
idfp = 0;
f = typ->form;
- c = typ->comp;
OPM_FPrint(&idfp, f);
+ if (__IN(f, 0x90, 32)) {
+ OPM_FPrint(&idfp, typ->size);
+ }
+ c = typ->comp;
OPM_FPrint(&idfp, c);
btyp = typ->BaseTyp;
strobj = typ->strobj;
if ((strobj != NIL && strobj->name[0] != 0x00)) {
- OPT_FPrintName(&idfp, (void*)OPT_GlbMod[__X(typ->mno, ((LONGINT)(64)))]->name, ((LONGINT)(256)));
- OPT_FPrintName(&idfp, (void*)strobj->name, ((LONGINT)(256)));
+ OPT_FPrintName(&idfp, (void*)OPT_GlbMod[__X(typ->mno, 64)]->name, 256);
+ OPT_FPrintName(&idfp, (void*)strobj->name, 256);
}
- if ((f == 13 || (c == 4 && btyp != NIL)) || c == 3) {
+ if ((f == 11 || (c == 4 && btyp != NIL)) || c == 3) {
OPT_IdFPrint(btyp);
OPM_FPrint(&idfp, btyp->idfp);
} else if (c == 2) {
OPT_IdFPrint(btyp);
OPM_FPrint(&idfp, btyp->idfp);
OPM_FPrint(&idfp, typ->n);
- } else if (f == 14) {
+ } else if (f == 12) {
OPT_FPrintSign(&idfp, btyp, typ->link);
}
typ->idfp = idfp;
}
}
-static struct FPrintStr__12 {
- LONGINT *pbfp, *pvfp;
- struct FPrintStr__12 *lnk;
-} *FPrintStr__12_s;
+static struct FPrintStr__15 {
+ INT32 *pbfp, *pvfp;
+ struct FPrintStr__15 *lnk;
+} *FPrintStr__15_s;
-static void FPrintFlds__13 (OPT_Object fld, LONGINT adr, BOOLEAN visible);
-static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr);
-static void FPrintTProcs__17 (OPT_Object obj);
+static void FPrintFlds__16 (OPT_Object fld, INT32 adr, BOOLEAN visible);
+static void FPrintHdFld__18 (OPT_Struct typ, OPT_Object fld, INT32 adr);
+static void FPrintTProcs__20 (OPT_Object obj);
-static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr)
+static void FPrintHdFld__18 (OPT_Struct typ, OPT_Object fld, INT32 adr)
{
- LONGINT i, j, n;
+ INT32 i, j, n;
OPT_Struct btyp = NIL;
if (typ->comp == 4) {
- FPrintFlds__13(typ->link, adr, 0);
+ FPrintFlds__16(typ->link, adr, 0);
} else if (typ->comp == 2) {
btyp = typ->BaseTyp;
n = typ->n;
@@ -487,69 +691,69 @@ static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr)
n = btyp->n * n;
btyp = btyp->BaseTyp;
}
- if (btyp->form == 13 || btyp->comp == 4) {
+ if (btyp->form == 11 || btyp->comp == 4) {
j = OPT_nofhdfld;
- FPrintHdFld__15(btyp, fld, adr);
+ FPrintHdFld__18(btyp, fld, adr);
if (j != OPT_nofhdfld) {
i = 1;
while ((i < n && OPT_nofhdfld <= 2048)) {
adr += btyp->size;
- FPrintHdFld__15(btyp, fld, adr);
+ FPrintHdFld__18(btyp, fld, adr);
i += 1;
}
}
}
- } else if (typ->form == 13 || __STRCMP(fld->name, "@ptr") == 0) {
- OPM_FPrint(&*FPrintStr__12_s->pvfp, ((LONGINT)(13)));
- OPM_FPrint(&*FPrintStr__12_s->pvfp, adr);
+ } else if (typ->form == 11 || __STRCMP(fld->name, "@ptr") == 0) {
+ OPM_FPrint(&*FPrintStr__15_s->pvfp, 11);
+ OPM_FPrint(&*FPrintStr__15_s->pvfp, adr);
OPT_nofhdfld += 1;
}
}
-static void FPrintFlds__13 (OPT_Object fld, LONGINT adr, BOOLEAN visible)
+static void FPrintFlds__16 (OPT_Object fld, INT32 adr, BOOLEAN visible)
{
while ((fld != NIL && fld->mode == 4)) {
if ((fld->vis != 0 && visible)) {
- OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->vis);
- OPT_FPrintName(&*FPrintStr__12_s->pbfp, (void*)fld->name, ((LONGINT)(256)));
- OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->adr);
+ OPM_FPrint(&*FPrintStr__15_s->pbfp, fld->vis);
+ OPT_FPrintName(&*FPrintStr__15_s->pbfp, (void*)fld->name, 256);
+ OPM_FPrint(&*FPrintStr__15_s->pbfp, fld->adr);
OPT_FPrintStr(fld->typ);
- OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->typ->pbfp);
- OPM_FPrint(&*FPrintStr__12_s->pvfp, fld->typ->pvfp);
+ OPM_FPrint(&*FPrintStr__15_s->pbfp, fld->typ->pbfp);
+ OPM_FPrint(&*FPrintStr__15_s->pvfp, fld->typ->pvfp);
} else {
- FPrintHdFld__15(fld->typ, fld, fld->adr + adr);
+ FPrintHdFld__18(fld->typ, fld, fld->adr + adr);
}
fld = fld->link;
}
}
-static void FPrintTProcs__17 (OPT_Object obj)
+static void FPrintTProcs__20 (OPT_Object obj)
{
if (obj != NIL) {
- FPrintTProcs__17(obj->left);
+ FPrintTProcs__20(obj->left);
if (obj->mode == 13) {
if (obj->vis != 0) {
- OPM_FPrint(&*FPrintStr__12_s->pbfp, ((LONGINT)(13)));
- OPM_FPrint(&*FPrintStr__12_s->pbfp, __ASHR(obj->adr, 16));
- OPT_FPrintSign(&*FPrintStr__12_s->pbfp, obj->typ, obj->link);
- OPT_FPrintName(&*FPrintStr__12_s->pbfp, (void*)obj->name, ((LONGINT)(256)));
+ OPM_FPrint(&*FPrintStr__15_s->pbfp, 13);
+ OPM_FPrint(&*FPrintStr__15_s->pbfp, __ASHR(obj->adr, 16));
+ OPT_FPrintSign(&*FPrintStr__15_s->pbfp, obj->typ, obj->link);
+ OPT_FPrintName(&*FPrintStr__15_s->pbfp, (void*)obj->name, 256);
}
}
- FPrintTProcs__17(obj->right);
+ FPrintTProcs__20(obj->right);
}
}
void OPT_FPrintStr (OPT_Struct typ)
{
- INTEGER f, c;
+ INT16 f, c;
OPT_Struct btyp = NIL;
OPT_Object strobj = NIL, bstrobj = NIL;
- LONGINT pbfp, pvfp;
- struct FPrintStr__12 _s;
+ INT32 pbfp, pvfp;
+ struct FPrintStr__15 _s;
_s.pbfp = &pbfp;
_s.pvfp = &pvfp;
- _s.lnk = FPrintStr__12_s;
- FPrintStr__12_s = &_s;
+ _s.lnk = FPrintStr__15_s;
+ FPrintStr__15_s = &_s;
if (!typ->fpdone) {
OPT_IdFPrint(typ);
pbfp = typ->idfp;
@@ -563,7 +767,7 @@ void OPT_FPrintStr (OPT_Struct typ)
f = typ->form;
c = typ->comp;
btyp = typ->BaseTyp;
- if (f == 13) {
+ if (f == 11) {
strobj = typ->strobj;
bstrobj = btyp->strobj;
if (((strobj == NIL || strobj->name[0] == 0x00) || bstrobj == NIL) || bstrobj->name[0] == 0x00) {
@@ -571,8 +775,8 @@ void OPT_FPrintStr (OPT_Struct typ)
OPM_FPrint(&pbfp, btyp->pbfp);
pvfp = pbfp;
}
- } else if (f == 14) {
- } else if (__IN(c, 0x0c)) {
+ } else if (f == 12) {
+ } else if (__IN(c, 0x0c, 32)) {
OPT_FPrintStr(btyp);
OPM_FPrint(&pbfp, btyp->pvfp);
pvfp = pbfp;
@@ -586,11 +790,11 @@ void OPT_FPrintStr (OPT_Struct typ)
OPM_FPrint(&pvfp, typ->align);
OPM_FPrint(&pvfp, typ->n);
OPT_nofhdfld = 0;
- FPrintFlds__13(typ->link, ((LONGINT)(0)), 1);
+ FPrintFlds__16(typ->link, 0, 1);
if (OPT_nofhdfld > 2048) {
OPM_Mark(225, typ->txtpos);
}
- FPrintTProcs__17(typ->link);
+ FPrintTProcs__20(typ->link);
OPM_FPrint(&pvfp, pbfp);
strobj = typ->strobj;
if (strobj == NIL || strobj->name[0] == 0x00) {
@@ -600,13 +804,13 @@ void OPT_FPrintStr (OPT_Struct typ)
typ->pbfp = pbfp;
typ->pvfp = pvfp;
}
- FPrintStr__12_s = _s.lnk;
+ FPrintStr__15_s = _s.lnk;
}
void OPT_FPrintObj (OPT_Object obj)
{
- LONGINT fprint;
- INTEGER f, m;
+ INT32 fprint;
+ INT16 f, m;
REAL rval;
OPT_ConstExt ext = NIL;
if (!obj->fpdone) {
@@ -617,23 +821,23 @@ void OPT_FPrintObj (OPT_Object obj)
f = obj->typ->form;
OPM_FPrint(&fprint, f);
switch (f) {
- case 2: case 3: case 4: case 5: case 6:
+ case 2: case 3: case 4:
OPM_FPrint(&fprint, obj->conval->intval);
break;
- case 9:
+ case 7:
OPM_FPrintSet(&fprint, obj->conval->setval);
break;
- case 7:
+ case 5:
rval = obj->conval->realval;
OPM_FPrintReal(&fprint, rval);
break;
- case 8:
+ case 6:
OPM_FPrintLReal(&fprint, obj->conval->realval);
break;
- case 10:
- OPT_FPrintName(&fprint, (void*)*obj->conval->ext, ((LONGINT)(256)));
+ case 8:
+ OPT_FPrintName(&fprint, (void*)*obj->conval->ext, 256);
break;
- case 11:
+ case 9:
break;
default:
OPT_err(127);
@@ -643,16 +847,16 @@ void OPT_FPrintObj (OPT_Object obj)
OPM_FPrint(&fprint, obj->vis);
OPT_FPrintStr(obj->typ);
OPM_FPrint(&fprint, obj->typ->pbfp);
- } else if (__IN(obj->mode, 0x0480)) {
+ } else if (__IN(obj->mode, 0x0480, 32)) {
OPT_FPrintSign(&fprint, obj->typ, obj->link);
} else if (obj->mode == 9) {
OPT_FPrintSign(&fprint, obj->typ, obj->link);
ext = obj->conval->ext;
- m = (int)(*ext)[0];
+ m = (INT16)(*ext)[0];
f = 1;
OPM_FPrint(&fprint, m);
while (f <= m) {
- OPM_FPrint(&fprint, (int)(*ext)[__X(f, ((LONGINT)(256)))]);
+ OPM_FPrint(&fprint, (INT16)(*ext)[__X(f, 256)]);
f += 1;
}
} else if (obj->mode == 5) {
@@ -663,27 +867,27 @@ void OPT_FPrintObj (OPT_Object obj)
}
}
-void OPT_FPrintErr (OPT_Object obj, INTEGER errcode)
+void OPT_FPrintErr (OPT_Object obj, INT16 errcode)
{
- INTEGER i, j;
+ INT16 i, j;
CHAR ch;
if (obj->mnolev != 0) {
- __COPY(OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, OPM_objname, ((LONGINT)(64)));
+ __COPY(OPT_GlbMod[__X(-obj->mnolev, 64)]->name, OPM_objname, 64);
i = 0;
- while (OPM_objname[__X(i, ((LONGINT)(64)))] != 0x00) {
+ while (OPM_objname[__X(i, 64)] != 0x00) {
i += 1;
}
- OPM_objname[__X(i, ((LONGINT)(64)))] = '.';
+ OPM_objname[__X(i, 64)] = '.';
j = 0;
i += 1;
do {
- ch = obj->name[__X(j, ((LONGINT)(256)))];
- OPM_objname[__X(i, ((LONGINT)(64)))] = ch;
+ ch = obj->name[__X(j, 256)];
+ OPM_objname[__X(i, 64)] = ch;
j += 1;
i += 1;
} while (!(ch == 0x00));
} else {
- __COPY(obj->name, OPM_objname, ((LONGINT)(64)));
+ __COPY(obj->name, OPM_objname, 64);
}
if (errcode == 249) {
if (OPM_noerr) {
@@ -755,7 +959,7 @@ void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old)
static void OPT_InName (CHAR *name, LONGINT name__len)
{
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
do {
@@ -765,23 +969,23 @@ static void OPT_InName (CHAR *name, LONGINT name__len)
} while (!(ch == 0x00));
}
-static void OPT_InMod (SHORTINT *mno)
+static void OPT_InMod (INT8 *mno)
{
OPT_Object head = NIL;
OPS_Name name;
- LONGINT mn;
- SHORTINT i;
+ INT32 mn;
+ INT8 i;
mn = OPM_SymRInt();
if (mn == 0) {
*mno = OPT_impCtxt.glbmno[0];
} else {
if (mn == 16) {
- OPT_InName((void*)name, ((LONGINT)(256)));
+ OPT_InName((void*)name, 256);
if ((__STRCMP(name, OPT_SelfName) == 0 && !OPT_impCtxt.self)) {
OPT_err(154);
}
i = 0;
- while ((i < OPT_nofGmod && __STRCMP(name, OPT_GlbMod[__X(i, ((LONGINT)(64)))]->name) != 0)) {
+ while ((i < OPT_nofGmod && __STRCMP(name, OPT_GlbMod[__X(i, 64)]->name) != 0)) {
i += 1;
}
if (i < OPT_nofGmod) {
@@ -789,77 +993,77 @@ static void OPT_InMod (SHORTINT *mno)
} else {
head = OPT_NewObj();
head->mode = 12;
- __COPY(name, head->name, ((LONGINT)(256)));
+ __COPY(name, head->name, 256);
*mno = OPT_nofGmod;
head->mnolev = -*mno;
if (OPT_nofGmod < 64) {
- OPT_GlbMod[__X(*mno, ((LONGINT)(64)))] = head;
+ OPT_GlbMod[__X(*mno, 64)] = head;
OPT_nofGmod += 1;
} else {
OPT_err(227);
}
}
- OPT_impCtxt.glbmno[__X(OPT_impCtxt.nofm, ((LONGINT)(64)))] = *mno;
+ OPT_impCtxt.glbmno[__X(OPT_impCtxt.nofm, 64)] = *mno;
OPT_impCtxt.nofm += 1;
} else {
- *mno = OPT_impCtxt.glbmno[__X(-mn, ((LONGINT)(64)))];
+ *mno = OPT_impCtxt.glbmno[__X(-mn, 64)];
}
}
}
-static void OPT_InConstant (LONGINT f, OPT_Const conval)
+static void OPT_InConstant (INT32 f, OPT_Const conval)
{
CHAR ch;
- INTEGER i;
+ INT16 i;
OPT_ConstExt ext = NIL;
REAL rval;
switch (f) {
case 1: case 3: case 2:
OPM_SymRCh(&ch);
- conval->intval = (int)ch;
+ conval->intval = (INT16)ch;
break;
- case 4: case 5: case 6:
+ case 4:
conval->intval = OPM_SymRInt();
break;
- case 9:
+ case 7:
OPM_SymRSet(&conval->setval);
break;
- case 7:
+ case 5:
OPM_SymRReal(&rval);
conval->realval = rval;
conval->intval = -1;
break;
- case 8:
+ case 6:
OPM_SymRLReal(&conval->realval);
conval->intval = -1;
break;
- case 10:
+ case 8:
ext = OPT_NewExt();
conval->ext = ext;
i = 0;
do {
OPM_SymRCh(&ch);
- (*ext)[__X(i, ((LONGINT)(256)))] = ch;
+ (*ext)[__X(i, 256)] = ch;
i += 1;
} while (!(ch == 0x00));
conval->intval2 = i;
conval->intval = -1;
break;
- case 11:
+ case 9:
conval->intval = 0;
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in InConstant(), f = ", (LONGINT)37);
- OPM_LogWNum(f, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in InConstant(), f = ", 37);
+ OPM_LogWNum(f, 0);
OPM_LogWLn();
break;
}
}
-static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par)
+static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par)
{
OPT_Object last = NIL, new = NIL;
- LONGINT tag;
+ INT32 tag;
OPT_InStruct(&*res);
tag = OPM_SymRInt();
last = NIL;
@@ -878,7 +1082,7 @@ static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par)
}
OPT_InStruct(&new->typ);
new->adr = OPM_SymRInt();
- OPT_InName((void*)new->name, ((LONGINT)(256)));
+ OPT_InName((void*)new->name, 256);
last = new;
tag = OPM_SymRInt();
}
@@ -886,8 +1090,7 @@ static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par)
static OPT_Object OPT_InFld (void)
{
- OPT_Object _o_result;
- LONGINT tag;
+ INT32 tag;
OPT_Object obj = NIL;
tag = OPT_impCtxt.nextTag;
obj = OPT_NewObj();
@@ -899,7 +1102,7 @@ static OPT_Object OPT_InFld (void)
obj->vis = 1;
}
OPT_InStruct(&obj->typ);
- OPT_InName((void*)obj->name, ((LONGINT)(256)));
+ OPT_InName((void*)obj->name, 256);
obj->adr = OPM_SymRInt();
} else {
obj->mode = 4;
@@ -912,14 +1115,12 @@ static OPT_Object OPT_InFld (void)
obj->vis = 0;
obj->adr = OPM_SymRInt();
}
- _o_result = obj;
- return _o_result;
+ return obj;
}
-static OPT_Object OPT_InTProc (SHORTINT mno)
+static OPT_Object OPT_InTProc (INT8 mno)
{
- OPT_Object _o_result;
- LONGINT tag;
+ INT32 tag;
OPT_Object obj = NIL;
tag = OPT_impCtxt.nextTag;
obj = OPT_NewObj();
@@ -930,7 +1131,7 @@ static OPT_Object OPT_InTProc (SHORTINT mno)
obj->conval->intval = -1;
OPT_InSign(mno, &obj->typ, &obj->link);
obj->vis = 1;
- OPT_InName((void*)obj->name, ((LONGINT)(256)));
+ OPT_InName((void*)obj->name, 256);
obj->adr = __ASHL(OPM_SymRInt(), 16);
} else {
obj->mode = 13;
@@ -940,21 +1141,32 @@ static OPT_Object OPT_InTProc (SHORTINT mno)
obj->vis = 0;
obj->adr = __ASHL(OPM_SymRInt(), 16);
}
- _o_result = obj;
- return _o_result;
+ return obj;
+}
+
+static OPT_Struct OPT_InTyp (INT32 tag)
+{
+ if (tag == 4) {
+ return OPT_IntType(OPM_SymRInt());
+ } else if (tag == 7) {
+ return OPT_SetType(OPM_SymRInt());
+ } else {
+ return OPT_impCtxt.ref[__X(tag, 255)];
+ }
+ __RETCHK;
}
static void OPT_InStruct (OPT_Struct *typ)
{
- SHORTINT mno;
- INTEGER ref;
- LONGINT tag;
+ INT8 mno;
+ INT16 ref;
+ INT32 tag;
OPS_Name name;
OPT_Struct t = NIL;
OPT_Object obj = NIL, last = NIL, fld = NIL, old = NIL, dummy = NIL;
tag = OPM_SymRInt();
if (tag != 34) {
- *typ = OPT_impCtxt.ref[__X(-tag, ((LONGINT)(255)))];
+ *typ = OPT_InTyp(-tag);
} else {
ref = OPT_impCtxt.nofr;
OPT_impCtxt.nofr += 1;
@@ -962,23 +1174,23 @@ static void OPT_InStruct (OPT_Struct *typ)
OPT_impCtxt.minr = ref;
}
OPT_InMod(&mno);
- OPT_InName((void*)name, ((LONGINT)(256)));
+ OPT_InName((void*)name, 256);
obj = OPT_NewObj();
if (name[0] == 0x00) {
if (OPT_impCtxt.self) {
old = NIL;
} else {
__MOVE("@", obj->name, 2);
- OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old);
+ OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
obj->name[0] = 0x00;
}
*typ = OPT_NewStr(0, 1);
} else {
- __COPY(name, obj->name, ((LONGINT)(256)));
- OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old);
+ __COPY(name, obj->name, 256);
+ OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
if (old != NIL) {
OPT_FPrintObj(old);
- OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] = old->typ->pvfp;
+ OPT_impCtxt.pvfp[__X(ref, 255)] = old->typ->pvfp;
if (OPT_impCtxt.self) {
*typ = OPT_NewStr(0, 1);
} else {
@@ -992,8 +1204,8 @@ static void OPT_InStruct (OPT_Struct *typ)
*typ = OPT_NewStr(0, 1);
}
}
- OPT_impCtxt.ref[__X(ref, ((LONGINT)(255)))] = *typ;
- OPT_impCtxt.old[__X(ref, ((LONGINT)(255)))] = old;
+ OPT_impCtxt.ref[__X(ref, 255)] = *typ;
+ OPT_impCtxt.old[__X(ref, 255)] = old;
(*typ)->ref = ref + 255;
(*typ)->mno = mno;
(*typ)->allocated = 1;
@@ -1004,25 +1216,25 @@ static void OPT_InStruct (OPT_Struct *typ)
obj->vis = 0;
tag = OPM_SymRInt();
if (tag == 35) {
- (*typ)->sysflag = (int)OPM_SymRInt();
+ (*typ)->sysflag = (INT16)OPM_SymRInt();
tag = OPM_SymRInt();
}
switch (tag) {
case 36:
- (*typ)->form = 13;
- (*typ)->size = OPM_PointerSize;
+ (*typ)->form = 11;
+ (*typ)->size = OPM_AddressSize;
(*typ)->n = 0;
OPT_InStruct(&(*typ)->BaseTyp);
break;
case 37:
- (*typ)->form = 15;
+ (*typ)->form = 13;
(*typ)->comp = 2;
OPT_InStruct(&(*typ)->BaseTyp);
(*typ)->n = OPM_SymRInt();
- (*OPT_typSize)(*typ);
+ OPT_TypSize(*typ);
break;
case 38:
- (*typ)->form = 15;
+ (*typ)->form = 13;
(*typ)->comp = 3;
OPT_InStruct(&(*typ)->BaseTyp);
if ((*typ)->BaseTyp->comp == 3) {
@@ -1030,10 +1242,10 @@ static void OPT_InStruct (OPT_Struct *typ)
} else {
(*typ)->n = 0;
}
- (*OPT_typSize)(*typ);
+ OPT_TypSize(*typ);
break;
case 39:
- (*typ)->form = 15;
+ (*typ)->form = 13;
(*typ)->comp = 4;
OPT_InStruct(&(*typ)->BaseTyp);
if ((*typ)->BaseTyp == OPT_notyp) {
@@ -1067,25 +1279,25 @@ static void OPT_InStruct (OPT_Struct *typ)
}
break;
case 40:
- (*typ)->form = 14;
- (*typ)->size = OPM_ProcSize;
+ (*typ)->form = 12;
+ (*typ)->size = OPM_AddressSize;
OPT_InSign(mno, &(*typ)->BaseTyp, &(*typ)->link);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at InStruct, tag = ", (LONGINT)35);
- OPM_LogWNum(tag, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at InStruct, tag = ", 35);
+ OPM_LogWNum(tag, 0);
OPM_LogWLn();
break;
}
if (ref == OPT_impCtxt.minr) {
while (ref < OPT_impCtxt.nofr) {
- t = OPT_impCtxt.ref[__X(ref, ((LONGINT)(255)))];
+ t = OPT_InTyp(ref);
OPT_FPrintStr(t);
obj = t->strobj;
if (obj->name[0] != 0x00) {
OPT_FPrintObj(obj);
}
- old = OPT_impCtxt.old[__X(ref, ((LONGINT)(255)))];
+ old = OPT_impCtxt.old[__X(ref, 255)];
if (old != NIL) {
t->strobj = old;
if (OPT_impCtxt.self) {
@@ -1093,13 +1305,13 @@ static void OPT_InStruct (OPT_Struct *typ)
if (old->history != 5) {
if (old->fprint != obj->fprint) {
old->history = 2;
- } else if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) {
+ } else if (OPT_impCtxt.pvfp[__X(ref, 255)] != t->pvfp) {
old->history = 3;
}
}
} else if (old->fprint != obj->fprint) {
old->history = 2;
- } else if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) {
+ } else if (OPT_impCtxt.pvfp[__X(ref, 255)] != t->pvfp) {
old->history = 3;
} else if (old->vis == 0) {
old->history = 1;
@@ -1107,7 +1319,7 @@ static void OPT_InStruct (OPT_Struct *typ)
old->history = 0;
}
} else {
- if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) {
+ if (OPT_impCtxt.pvfp[__X(ref, 255)] != t->pvfp) {
old->history = 5;
}
if (old->fprint != obj->fprint) {
@@ -1126,14 +1338,13 @@ static void OPT_InStruct (OPT_Struct *typ)
}
}
-static OPT_Object OPT_InObj (SHORTINT mno)
+static OPT_Object OPT_InObj (INT8 mno)
{
- OPT_Object _o_result;
- INTEGER i, s;
+ INT16 i, s;
CHAR ch;
OPT_Object obj = NIL, old = NIL;
OPT_Struct typ = NIL;
- LONGINT tag;
+ INT32 tag;
OPT_ConstExt ext = NIL;
tag = OPT_impCtxt.nextTag;
if (tag == 19) {
@@ -1146,11 +1357,11 @@ static OPT_Object OPT_InObj (SHORTINT mno)
obj = OPT_NewObj();
obj->mnolev = -mno;
obj->vis = 1;
- if (tag <= 13) {
+ if (tag <= 11) {
obj->mode = 3;
- obj->typ = OPT_impCtxt.ref[__X(tag, ((LONGINT)(255)))];
obj->conval = OPT_NewConst();
OPT_InConstant(tag, obj->conval);
+ obj->typ = OPT_InTyp(tag);
} else if (tag >= 31) {
obj->conval = OPT_NewConst();
obj->conval->intval = -1;
@@ -1166,17 +1377,17 @@ static OPT_Object OPT_InObj (SHORTINT mno)
obj->mode = 9;
ext = OPT_NewExt();
obj->conval->ext = ext;
- s = (int)OPM_SymRInt();
+ s = (INT16)OPM_SymRInt();
(*ext)[0] = (CHAR)s;
i = 1;
while (i <= s) {
- OPM_SymRCh(&(*ext)[__X(i, ((LONGINT)(256)))]);
+ OPM_SymRCh(&(*ext)[__X(i, 256)]);
i += 1;
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", (LONGINT)32);
- OPM_LogWNum(tag, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", 32);
+ OPM_LogWNum(tag, 0);
OPM_LogWLn();
break;
}
@@ -1190,14 +1401,14 @@ static OPT_Object OPT_InObj (SHORTINT mno)
}
OPT_InStruct(&obj->typ);
}
- OPT_InName((void*)obj->name, ((LONGINT)(256)));
+ OPT_InName((void*)obj->name, 256);
}
OPT_FPrintObj(obj);
if ((obj->mode == 1 && (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00))) {
OPM_FPrint(&OPT_impCtxt.reffp, obj->typ->ref - 255);
}
if (tag != 19) {
- OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old);
+ OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
if (OPT_impCtxt.self) {
if (old != NIL) {
if (old->vis == 0) {
@@ -1225,14 +1436,13 @@ static OPT_Object OPT_InObj (SHORTINT mno)
}
}
}
- _o_result = obj;
- return _o_result;
+ return obj;
}
void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
{
OPT_Object obj = NIL;
- SHORTINT mno;
+ INT8 mno;
OPS_Name aliasName__copy;
__DUPARR(aliasName, OPS_Name);
if (__STRCMP(name, "SYSTEM") == 0) {
@@ -1243,12 +1453,12 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
obj->scope = OPT_syslink;
obj->typ = OPT_notyp;
} else {
- OPT_impCtxt.nofr = 16;
+ OPT_impCtxt.nofr = 14;
OPT_impCtxt.minr = 255;
OPT_impCtxt.nofm = 0;
OPT_impCtxt.self = __STRCMP(aliasName, "@self") == 0;
OPT_impCtxt.reffp = 0;
- OPM_OldSym((void*)name, ((LONGINT)(256)), &*done);
+ OPM_OldSym((void*)name, 256, &*done);
if (*done) {
OPT_InMod(&mno);
OPT_impCtxt.nextTag = OPM_SymRInt();
@@ -1258,8 +1468,8 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
}
OPT_Insert(aliasName, &obj);
obj->mode = 11;
- obj->scope = OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right;
- OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->link = obj;
+ obj->scope = OPT_GlbMod[__X(mno, 64)]->right;
+ OPT_GlbMod[__X(mno, 64)]->link = obj;
obj->mnolev = -mno;
obj->typ = OPT_notyp;
OPM_CloseOldSym();
@@ -1275,7 +1485,7 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
static void OPT_OutName (CHAR *name, LONGINT name__len)
{
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
do {
@@ -1285,21 +1495,21 @@ static void OPT_OutName (CHAR *name, LONGINT name__len)
} while (!(ch == 0x00));
}
-static void OPT_OutMod (INTEGER mno)
+static void OPT_OutMod (INT16 mno)
{
- if (OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))] < 0) {
- OPM_SymWInt(((LONGINT)(16)));
- OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))] = OPT_expCtxt.nofm;
+ if (OPT_expCtxt.locmno[__X(mno, 64)] < 0) {
+ OPM_SymWInt(16);
+ OPT_expCtxt.locmno[__X(mno, 64)] = OPT_expCtxt.nofm;
OPT_expCtxt.nofm += 1;
- OPT_OutName((void*)OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->name, ((LONGINT)(256)));
+ OPT_OutName((void*)OPT_GlbMod[__X(mno, 64)]->name, 256);
} else {
- OPM_SymWInt(-OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))]);
+ OPM_SymWInt(-OPT_expCtxt.locmno[__X(mno, 64)]);
}
}
-static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr)
+static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr)
{
- LONGINT i, j, n;
+ INT32 i, j, n;
OPT_Struct btyp = NIL;
if (typ->comp == 4) {
OPT_OutFlds(typ->link, adr, 0);
@@ -1310,7 +1520,7 @@ static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr)
n = btyp->n * n;
btyp = btyp->BaseTyp;
}
- if (btyp->form == 13 || btyp->comp == 4) {
+ if (btyp->form == 11 || btyp->comp == 4) {
j = OPT_nofhdfld;
OPT_OutHdFld(btyp, fld, adr);
if (j != OPT_nofhdfld) {
@@ -1322,24 +1532,24 @@ static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr)
}
}
}
- } else if (typ->form == 13 || __STRCMP(fld->name, "@ptr") == 0) {
- OPM_SymWInt(((LONGINT)(27)));
+ } else if (typ->form == 11 || __STRCMP(fld->name, "@ptr") == 0) {
+ OPM_SymWInt(27);
OPM_SymWInt(adr);
OPT_nofhdfld += 1;
}
}
-static void OPT_OutFlds (OPT_Object fld, LONGINT adr, BOOLEAN visible)
+static void OPT_OutFlds (OPT_Object fld, INT32 adr, BOOLEAN visible)
{
while ((fld != NIL && fld->mode == 4)) {
if ((fld->vis != 0 && visible)) {
if (fld->vis == 2) {
- OPM_SymWInt(((LONGINT)(26)));
+ OPM_SymWInt(26);
} else {
- OPM_SymWInt(((LONGINT)(25)));
+ OPM_SymWInt(25);
}
OPT_OutStr(fld->typ);
- OPT_OutName((void*)fld->name, ((LONGINT)(256)));
+ OPT_OutName((void*)fld->name, 256);
OPM_SymWInt(fld->adr);
} else {
OPT_OutHdFld(fld->typ, fld, fld->adr + adr);
@@ -1353,16 +1563,16 @@ static void OPT_OutSign (OPT_Struct result, OPT_Object par)
OPT_OutStr(result);
while (par != NIL) {
if (par->mode == 1) {
- OPM_SymWInt(((LONGINT)(23)));
+ OPM_SymWInt(23);
} else {
- OPM_SymWInt(((LONGINT)(24)));
+ OPM_SymWInt(24);
}
OPT_OutStr(par->typ);
OPM_SymWInt(par->adr);
- OPT_OutName((void*)par->name, ((LONGINT)(256)));
+ OPT_OutName((void*)par->name, 256);
par = par->link;
}
- OPM_SymWInt(((LONGINT)(18)));
+ OPM_SymWInt(18);
}
static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj)
@@ -1375,12 +1585,12 @@ static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj)
}
if (obj->vis != 0) {
if (obj->vis != 0) {
- OPM_SymWInt(((LONGINT)(29)));
+ OPM_SymWInt(29);
OPT_OutSign(obj->typ, obj->link);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
OPM_SymWInt(__ASHR(obj->adr, 16));
} else {
- OPM_SymWInt(((LONGINT)(30)));
+ OPM_SymWInt(30);
OPM_SymWInt(__ASHR(obj->adr, 16));
}
}
@@ -1394,8 +1604,11 @@ static void OPT_OutStr (OPT_Struct typ)
OPT_Object strobj = NIL;
if (typ->ref < OPT_expCtxt.ref) {
OPM_SymWInt(-typ->ref);
+ if (__IN(typ->ref, 0x90, 32)) {
+ OPM_SymWInt(typ->size);
+ }
} else {
- OPM_SymWInt(((LONGINT)(34)));
+ OPM_SymWInt(34);
typ->ref = OPT_expCtxt.ref;
OPT_expCtxt.ref += 1;
if (OPT_expCtxt.ref >= 255) {
@@ -1404,7 +1617,7 @@ static void OPT_OutStr (OPT_Struct typ)
OPT_OutMod(typ->mno);
strobj = typ->strobj;
if ((strobj != NIL && strobj->name[0] != 0x00)) {
- OPT_OutName((void*)strobj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)strobj->name, 256);
switch (strobj->history) {
case 2:
OPT_FPrintErr(strobj, 252);
@@ -1422,31 +1635,31 @@ static void OPT_OutStr (OPT_Struct typ)
OPM_SymWCh(0x00);
}
if (typ->sysflag != 0) {
- OPM_SymWInt(((LONGINT)(35)));
+ OPM_SymWInt(35);
OPM_SymWInt(typ->sysflag);
}
switch (typ->form) {
- case 13:
- OPM_SymWInt(((LONGINT)(36)));
+ case 11:
+ OPM_SymWInt(36);
OPT_OutStr(typ->BaseTyp);
break;
- case 14:
- OPM_SymWInt(((LONGINT)(40)));
+ case 12:
+ OPM_SymWInt(40);
OPT_OutSign(typ->BaseTyp, typ->link);
break;
- case 15:
+ case 13:
switch (typ->comp) {
case 2:
- OPM_SymWInt(((LONGINT)(37)));
+ OPM_SymWInt(37);
OPT_OutStr(typ->BaseTyp);
OPM_SymWInt(typ->n);
break;
case 3:
- OPM_SymWInt(((LONGINT)(38)));
+ OPM_SymWInt(38);
OPT_OutStr(typ->BaseTyp);
break;
case 4:
- OPM_SymWInt(((LONGINT)(39)));
+ OPM_SymWInt(39);
if (typ->BaseTyp == NIL) {
OPT_OutStr(OPT_notyp);
} else {
@@ -1456,23 +1669,23 @@ static void OPT_OutStr (OPT_Struct typ)
OPM_SymWInt(typ->align);
OPM_SymWInt(typ->n);
OPT_nofhdfld = 0;
- OPT_OutFlds(typ->link, ((LONGINT)(0)), 1);
+ OPT_OutFlds(typ->link, 0, 1);
if (OPT_nofhdfld > 2048) {
OPM_Mark(223, typ->txtpos);
}
OPT_OutTProcs(typ, typ->link);
- OPM_SymWInt(((LONGINT)(18)));
+ OPM_SymWInt(18);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.comp = ", (LONGINT)39);
- OPM_LogWNum(typ->comp, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.comp = ", 39);
+ OPM_LogWNum(typ->comp, 0);
OPM_LogWLn();
break;
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.form = ", (LONGINT)39);
- OPM_LogWNum(typ->form, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.form = ", 39);
+ OPM_LogWNum(typ->form, 0);
OPM_LogWLn();
break;
}
@@ -1481,7 +1694,7 @@ static void OPT_OutStr (OPT_Struct typ)
static void OPT_OutConstant (OPT_Object obj)
{
- INTEGER f;
+ INT16 f;
REAL rval;
f = obj->typ->form;
OPM_SymWInt(f);
@@ -1489,23 +1702,25 @@ static void OPT_OutConstant (OPT_Object obj)
case 2: case 3:
OPM_SymWCh((CHAR)obj->conval->intval);
break;
- case 4: case 5: case 6:
+ case 4:
OPM_SymWInt(obj->conval->intval);
- break;
- case 9:
- OPM_SymWSet(obj->conval->setval);
+ OPM_SymWInt(obj->typ->size);
break;
case 7:
+ OPM_SymWSet(obj->conval->setval);
+ OPM_SymWInt(obj->typ->size);
+ break;
+ case 5:
rval = obj->conval->realval;
OPM_SymWReal(rval);
break;
- case 8:
+ case 6:
OPM_SymWLReal(obj->conval->realval);
break;
- case 10:
- OPT_OutName((void*)*obj->conval->ext, ((LONGINT)(256)));
+ case 8:
+ OPT_OutName((void*)*obj->conval->ext, 256);
break;
- case 11:
+ case 9:
break;
default:
OPT_err(127);
@@ -1515,11 +1730,11 @@ static void OPT_OutConstant (OPT_Object obj)
static void OPT_OutObj (OPT_Object obj)
{
- INTEGER i, j;
+ INT16 i, j;
OPT_ConstExt ext = NIL;
if (obj != NIL) {
OPT_OutObj(obj->left);
- if (__IN(obj->mode, 0x06ea)) {
+ if (__IN(obj->mode, 0x06ea, 32)) {
if (obj->history == 4) {
OPT_FPrintErr(obj, 250);
} else if (obj->vis != 0) {
@@ -1536,64 +1751,64 @@ static void OPT_OutObj (OPT_Object obj)
OPT_FPrintErr(obj, 251);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj^.history = ", (LONGINT)42);
- OPM_LogWNum(obj->history, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj^.history = ", 42);
+ OPM_LogWNum(obj->history, 0);
OPM_LogWLn();
break;
}
switch (obj->mode) {
case 3:
OPT_OutConstant(obj);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
break;
case 5:
if (obj->typ->strobj == obj) {
- OPM_SymWInt(((LONGINT)(19)));
+ OPM_SymWInt(19);
OPT_OutStr(obj->typ);
} else {
- OPM_SymWInt(((LONGINT)(20)));
+ OPM_SymWInt(20);
OPT_OutStr(obj->typ);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
}
break;
case 1:
if (obj->vis == 2) {
- OPM_SymWInt(((LONGINT)(22)));
+ OPM_SymWInt(22);
} else {
- OPM_SymWInt(((LONGINT)(21)));
+ OPM_SymWInt(21);
}
OPT_OutStr(obj->typ);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
if (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00) {
OPM_FPrint(&OPT_expCtxt.reffp, obj->typ->ref);
}
break;
case 7:
- OPM_SymWInt(((LONGINT)(31)));
+ OPM_SymWInt(31);
OPT_OutSign(obj->typ, obj->link);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
break;
case 10:
- OPM_SymWInt(((LONGINT)(32)));
+ OPM_SymWInt(32);
OPT_OutSign(obj->typ, obj->link);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
break;
case 9:
- OPM_SymWInt(((LONGINT)(33)));
+ OPM_SymWInt(33);
OPT_OutSign(obj->typ, obj->link);
ext = obj->conval->ext;
- j = (int)(*ext)[0];
+ j = (INT16)(*ext)[0];
i = 1;
OPM_SymWInt(j);
while (i <= j) {
- OPM_SymWCh((*ext)[__X(i, ((LONGINT)(256)))]);
+ OPM_SymWCh((*ext)[__X(i, 256)]);
i += 1;
}
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj.mode = ", (LONGINT)38);
- OPM_LogWNum(obj->mode, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj.mode = ", 38);
+ OPM_LogWNum(obj->mode, 0);
OPM_LogWLn();
break;
}
@@ -1605,8 +1820,8 @@ static void OPT_OutObj (OPT_Object obj)
void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
{
- INTEGER i;
- SHORTINT nofmod;
+ INT16 i;
+ INT8 nofmod;
BOOLEAN done;
OPT_symExtended = 0;
OPT_symNew = 0;
@@ -1614,25 +1829,22 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
OPT_Import((CHAR*)"@self", OPT_SelfName, &done);
OPT_nofGmod = nofmod;
if (OPM_noerr) {
- OPM_NewSym((void*)OPT_SelfName, ((LONGINT)(256)));
+ OPM_NewSym((void*)OPT_SelfName, 256);
if (OPM_noerr) {
- OPM_SymWInt(((LONGINT)(16)));
- OPT_OutName((void*)OPT_SelfName, ((LONGINT)(256)));
+ OPM_SymWInt(16);
+ OPT_OutName((void*)OPT_SelfName, 256);
OPT_expCtxt.reffp = 0;
- OPT_expCtxt.ref = 16;
+ OPT_expCtxt.ref = 14;
OPT_expCtxt.nofm = 1;
OPT_expCtxt.locmno[0] = 0;
i = 1;
while (i < 64) {
- OPT_expCtxt.locmno[__X(i, ((LONGINT)(64)))] = -1;
+ OPT_expCtxt.locmno[__X(i, 64)] = -1;
i += 1;
}
OPT_OutObj(OPT_topScope->right);
*ext = (OPT_sfpresent && OPT_symExtended);
- *new = !OPT_sfpresent || OPT_symNew;
- if (OPM_forceNewSym) {
- *new = 1;
- }
+ *new = (!OPT_sfpresent || OPT_symNew) || __IN(17, OPM_Options, 32);
if ((((OPM_noerr && OPT_sfpresent)) && OPT_impCtxt.reffp != OPT_expCtxt.reffp)) {
*new = 1;
if (!OPT_extsf) {
@@ -1648,11 +1860,11 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
}
}
-static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form)
+static void OPT_InitStruct (OPT_Struct *typ, INT8 form)
{
*typ = OPT_NewStr(form, 1);
(*typ)->ref = form;
- (*typ)->size = OPM_ByteSize;
+ (*typ)->size = 1;
(*typ)->allocated = 1;
(*typ)->strobj = OPT_NewObj();
(*typ)->pbfp = form;
@@ -1662,7 +1874,7 @@ static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form)
(*typ)->idfpdone = 1;
}
-static void OPT_EnterBoolConst (OPS_Name name, LONGINT value)
+static void OPT_EnterBoolConst (OPS_Name name, INT32 value)
{
OPT_Object obj = NIL;
OPS_Name name__copy;
@@ -1674,7 +1886,7 @@ static void OPT_EnterBoolConst (OPS_Name name, LONGINT value)
obj->conval->intval = value;
}
-static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct *res)
+static void OPT_EnterTyp (OPS_Name name, INT8 form, INT16 size, OPT_Struct *res)
{
OPT_Object obj = NIL;
OPT_Struct typ = NIL;
@@ -1694,10 +1906,25 @@ static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct
typ->fpdone = 1;
typ->idfp = form;
typ->idfpdone = 1;
+ if (__IN(form, 0x90, 32)) {
+ OPM_FPrint(&typ->idfp, typ->size);
+ }
*res = typ;
}
-static void OPT_EnterProc (OPS_Name name, INTEGER num)
+static void OPT_EnterTypeAlias (OPS_Name name, OPT_Object *res)
+{
+ OPT_Object obj = NIL;
+ OPS_Name name__copy;
+ __DUPARR(name, OPS_Name);
+ OPT_Insert(name, &obj);
+ obj->mode = 5;
+ obj->typ = NIL;
+ obj->vis = 1;
+ *res = obj;
+}
+
+static void OPT_EnterProc (OPS_Name name, INT16 num)
{
OPT_Object obj = NIL;
OPS_Name name__copy;
@@ -1712,26 +1939,39 @@ static void EnumPtrs(void (*P)(void*))
{
P(OPT_topScope);
P(OPT_undftyp);
+ P(OPT_niltyp);
+ P(OPT_notyp);
P(OPT_bytetyp);
+ P(OPT_cpbytetyp);
P(OPT_booltyp);
P(OPT_chartyp);
P(OPT_sinttyp);
P(OPT_inttyp);
P(OPT_linttyp);
+ P(OPT_hinttyp);
+ P(OPT_int8typ);
+ P(OPT_int16typ);
+ P(OPT_int32typ);
+ P(OPT_int64typ);
+ P(OPT_settyp);
+ P(OPT_set32typ);
+ P(OPT_set64typ);
P(OPT_realtyp);
P(OPT_lrltyp);
- P(OPT_settyp);
P(OPT_stringtyp);
- P(OPT_niltyp);
- P(OPT_notyp);
+ P(OPT_adrtyp);
P(OPT_sysptrtyp);
+ P(OPT_sintobj);
+ P(OPT_intobj);
+ P(OPT_lintobj);
+ P(OPT_setobj);
__ENUMP(OPT_GlbMod, 64, P);
P(OPT_universe);
P(OPT_syslink);
__ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 3140, 1, P);
}
-__TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 24), {0, -8}};
+__TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 40), {0, -8}};
__TDESC(OPT_ObjDesc, 1, 6) = {__TDFLDS("ObjDesc", 304), {0, 4, 8, 12, 284, 288, -28}};
__TDESC(OPT_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}};
@@ -1777,6 +2017,7 @@ export void *OPT__init(void)
__REGMOD("OPT", EnumPtrs);
__REGCMD("Close", OPT_Close);
__REGCMD("CloseScope", OPT_CloseScope);
+ __REGCMD("InitRecno", OPT_InitRecno);
__INITYP(OPT_ConstDesc, OPT_ConstDesc, 0);
__INITYP(OPT_ObjDesc, OPT_ObjDesc, 0);
__INITYP(OPT_StrDesc, OPT_StrDesc, 0);
@@ -1788,12 +2029,19 @@ export void *OPT__init(void)
OPT_OpenScope(0, NIL);
OPM_errpos = 0;
OPT_InitStruct(&OPT_undftyp, 0);
- OPT_InitStruct(&OPT_notyp, 12);
- OPT_InitStruct(&OPT_stringtyp, 10);
- OPT_InitStruct(&OPT_niltyp, 11);
OPT_undftyp->BaseTyp = OPT_undftyp;
- OPT_EnterTyp((CHAR*)"BYTE", 1, OPM_ByteSize, &OPT_bytetyp);
- OPT_EnterTyp((CHAR*)"PTR", 13, OPM_PointerSize, &OPT_sysptrtyp);
+ OPT_InitStruct(&OPT_notyp, 10);
+ OPT_InitStruct(&OPT_stringtyp, 8);
+ OPT_InitStruct(&OPT_niltyp, 9);
+ OPT_EnterTyp((CHAR*)"BYTE", 1, 1, &OPT_bytetyp);
+ OPT_EnterTyp((CHAR*)"PTR", 11, -1, &OPT_sysptrtyp);
+ OPT_EnterTyp((CHAR*)"ADDRESS", 4, -1, &OPT_adrtyp);
+ OPT_EnterTyp((CHAR*)"INT8", 4, 1, &OPT_int8typ);
+ OPT_EnterTyp((CHAR*)"INT16", 4, 2, &OPT_int16typ);
+ OPT_EnterTyp((CHAR*)"INT32", 4, 4, &OPT_int32typ);
+ OPT_EnterTyp((CHAR*)"INT64", 4, 8, &OPT_int64typ);
+ OPT_EnterTyp((CHAR*)"SET32", 7, 4, &OPT_set32typ);
+ OPT_EnterTyp((CHAR*)"SET64", 7, 8, &OPT_set64typ);
OPT_EnterProc((CHAR*)"ADR", 20);
OPT_EnterProc((CHAR*)"CC", 21);
OPT_EnterProc((CHAR*)"LSH", 22);
@@ -1809,16 +2057,18 @@ export void *OPT__init(void)
OPT_syslink = OPT_topScope->right;
OPT_universe = OPT_topScope;
OPT_topScope->right = NIL;
- OPT_EnterTyp((CHAR*)"BOOLEAN", 2, OPM_BoolSize, &OPT_booltyp);
- OPT_EnterTyp((CHAR*)"CHAR", 3, OPM_CharSize, &OPT_chartyp);
- OPT_EnterTyp((CHAR*)"SET", 9, OPM_SetSize, &OPT_settyp);
- OPT_EnterTyp((CHAR*)"REAL", 7, OPM_RealSize, &OPT_realtyp);
- OPT_EnterTyp((CHAR*)"INTEGER", 5, OPM_IntSize, &OPT_inttyp);
- OPT_EnterTyp((CHAR*)"LONGINT", 6, OPM_LIntSize, &OPT_linttyp);
- OPT_EnterTyp((CHAR*)"LONGREAL", 8, OPM_LRealSize, &OPT_lrltyp);
- OPT_EnterTyp((CHAR*)"SHORTINT", 4, OPM_SIntSize, &OPT_sinttyp);
- OPT_EnterBoolConst((CHAR*)"FALSE", ((LONGINT)(0)));
- OPT_EnterBoolConst((CHAR*)"TRUE", ((LONGINT)(1)));
+ OPT_EnterTyp((CHAR*)"BOOLEAN", 2, 1, &OPT_booltyp);
+ OPT_EnterTyp((CHAR*)"CHAR", 3, 1, &OPT_chartyp);
+ OPT_EnterTyp((CHAR*)"REAL", 5, 4, &OPT_realtyp);
+ OPT_EnterTyp((CHAR*)"LONGREAL", 6, 8, &OPT_lrltyp);
+ OPT_EnterTyp((CHAR*)"HUGEINT", 4, 8, &OPT_hinttyp);
+ OPT_EnterTyp((CHAR*)"BYTE@", 4, 1, &OPT_cpbytetyp);
+ OPT_EnterTypeAlias((CHAR*)"SHORTINT", &OPT_sintobj);
+ OPT_EnterTypeAlias((CHAR*)"INTEGER", &OPT_intobj);
+ OPT_EnterTypeAlias((CHAR*)"LONGINT", &OPT_lintobj);
+ OPT_EnterTypeAlias((CHAR*)"SET", &OPT_setobj);
+ OPT_EnterBoolConst((CHAR*)"FALSE", 0);
+ OPT_EnterBoolConst((CHAR*)"TRUE", 1);
OPT_EnterProc((CHAR*)"HALT", 0);
OPT_EnterProc((CHAR*)"NEW", 1);
OPT_EnterProc((CHAR*)"ABS", 2);
@@ -1844,15 +2094,13 @@ export void *OPT__init(void)
OPT_impCtxt.ref[1] = OPT_bytetyp;
OPT_impCtxt.ref[2] = OPT_booltyp;
OPT_impCtxt.ref[3] = OPT_chartyp;
- OPT_impCtxt.ref[4] = OPT_sinttyp;
- OPT_impCtxt.ref[5] = OPT_inttyp;
- OPT_impCtxt.ref[6] = OPT_linttyp;
- OPT_impCtxt.ref[7] = OPT_realtyp;
- OPT_impCtxt.ref[8] = OPT_lrltyp;
- OPT_impCtxt.ref[9] = OPT_settyp;
- OPT_impCtxt.ref[10] = OPT_stringtyp;
- OPT_impCtxt.ref[11] = OPT_niltyp;
- OPT_impCtxt.ref[12] = OPT_notyp;
- OPT_impCtxt.ref[13] = OPT_sysptrtyp;
+ OPT_impCtxt.ref[4] = OPT_int32typ;
+ OPT_impCtxt.ref[5] = OPT_realtyp;
+ OPT_impCtxt.ref[6] = OPT_lrltyp;
+ OPT_impCtxt.ref[7] = OPT_settyp;
+ OPT_impCtxt.ref[8] = OPT_stringtyp;
+ OPT_impCtxt.ref[9] = OPT_niltyp;
+ OPT_impCtxt.ref[10] = OPT_notyp;
+ OPT_impCtxt.ref[11] = OPT_sysptrtyp;
__ENDMOD;
}
diff --git a/bootstrap/windows-48/OPT.h b/bootstrap/windows-48/OPT.h
index 41b3e7ec..90fcacf5 100644
--- a/bootstrap/windows-48/OPT.h
+++ b/bootstrap/windows-48/OPT.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPT__h
#define OPT__h
@@ -15,8 +15,9 @@ typedef
typedef
struct OPT_ConstDesc {
OPT_ConstExt ext;
- LONGINT intval, intval2;
- SET setval;
+ INT64 intval;
+ INT32 intval2;
+ UINT64 setval;
LONGREAL realval;
} OPT_ConstDesc;
@@ -32,7 +33,7 @@ typedef
typedef
struct OPT_NodeDesc {
OPT_Node left, right, link;
- SHORTINT class, subcl;
+ INT8 class, subcl;
BOOLEAN readonly;
OPT_Struct typ;
OPT_Object obj;
@@ -44,44 +45,48 @@ typedef
OPT_Object left, right, link, scope;
OPS_Name name;
BOOLEAN leaf;
- SHORTINT mode, mnolev, vis, history;
+ INT8 mode, mnolev, vis, history;
BOOLEAN used, fpdone;
- LONGINT fprint;
+ INT32 fprint;
OPT_Struct typ;
OPT_Const conval;
- LONGINT adr, linkadr;
- INTEGER x;
+ INT32 adr, linkadr;
+ INT16 x;
} OPT_ObjDesc;
typedef
struct OPT_StrDesc {
- SHORTINT form, comp, mno, extlev;
- INTEGER ref, sysflag;
- LONGINT n, size, align, txtpos;
+ INT8 form, comp, mno, extlev;
+ INT16 ref, sysflag;
+ INT32 n, size, align, txtpos;
BOOLEAN allocated, pbused, pvused;
- char _prvt0[16];
+ char _prvt0[4];
+ INT32 idfp;
+ char _prvt1[8];
OPT_Struct BaseTyp;
OPT_Object link, strobj;
} OPT_StrDesc;
-import void (*OPT_typSize)(OPT_Struct);
import OPT_Object OPT_topScope;
-import OPT_Struct OPT_undftyp, OPT_bytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_realtyp, OPT_lrltyp, OPT_settyp, OPT_stringtyp, OPT_niltyp, OPT_notyp, OPT_sysptrtyp;
-import SHORTINT OPT_nofGmod;
+import OPT_Struct OPT_undftyp, OPT_niltyp, OPT_notyp, OPT_bytetyp, OPT_cpbytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_hinttyp, OPT_int8typ, OPT_int16typ, OPT_int32typ, OPT_int64typ, OPT_settyp, OPT_set32typ, OPT_set64typ, OPT_realtyp, OPT_lrltyp, OPT_stringtyp, OPT_adrtyp, OPT_sysptrtyp;
+import OPT_Object OPT_sintobj, OPT_intobj, OPT_lintobj, OPT_setobj;
+import INT8 OPT_nofGmod;
import OPT_Object OPT_GlbMod[64];
import OPS_Name OPT_SelfName;
import BOOLEAN OPT_SYSimported;
-import LONGINT *OPT_ConstDesc__typ;
-import LONGINT *OPT_ObjDesc__typ;
-import LONGINT *OPT_StrDesc__typ;
-import LONGINT *OPT_NodeDesc__typ;
+import ADDRESS *OPT_ConstDesc__typ;
+import ADDRESS *OPT_ObjDesc__typ;
+import ADDRESS *OPT_StrDesc__typ;
+import ADDRESS *OPT_NodeDesc__typ;
+import void OPT_Align (INT32 *adr, INT32 base);
+import INT32 OPT_BaseAlignment (OPT_Struct typ);
import void OPT_Close (void);
import void OPT_CloseScope (void);
import void OPT_Export (BOOLEAN *ext, BOOLEAN *new);
-import void OPT_FPrintErr (OPT_Object obj, INTEGER errcode);
+import void OPT_FPrintErr (OPT_Object obj, INT16 errcode);
import void OPT_FPrintObj (OPT_Object obj);
import void OPT_FPrintStr (OPT_Struct typ);
import void OPT_Find (OPT_Object *res);
@@ -89,16 +94,23 @@ import void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res);
import void OPT_FindImport (OPT_Object mod, OPT_Object *res);
import void OPT_IdFPrint (OPT_Struct typ);
import void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done);
-import void OPT_Init (OPS_Name name, SET opt);
+import void OPT_Init (OPS_Name name, UINT32 opt);
+import void OPT_InitRecno (void);
import void OPT_Insert (OPS_Name name, OPT_Object *obj);
import void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old);
+import INT16 OPT_IntSize (INT64 n);
+import OPT_Struct OPT_IntType (INT32 size);
import OPT_Const OPT_NewConst (void);
import OPT_ConstExt OPT_NewExt (void);
-import OPT_Node OPT_NewNode (SHORTINT class);
+import OPT_Node OPT_NewNode (INT8 class);
import OPT_Object OPT_NewObj (void);
-import OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp);
-import void OPT_OpenScope (SHORTINT level, OPT_Object owner);
+import OPT_Struct OPT_NewStr (INT8 form, INT8 comp);
+import void OPT_OpenScope (INT8 level, OPT_Object owner);
+import OPT_Struct OPT_SetType (INT32 size);
+import OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir);
+import INT32 OPT_SizeAlignment (INT32 size);
+import void OPT_TypSize (OPT_Struct typ);
import void *OPT__init(void);
-#endif
+#endif // OPT
diff --git a/bootstrap/windows-48/OPV.c b/bootstrap/windows-48/OPV.c
index cf646f5e..5c21cb97 100644
--- a/bootstrap/windows-48/OPV.c
+++ b/bootstrap/windows-48/OPV.c
@@ -1,4 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "OPC.h"
#include "OPM.h"
@@ -7,167 +13,66 @@
typedef
struct OPV_ExitInfo {
- INTEGER level, label;
+ INT16 level, label;
} OPV_ExitInfo;
-static BOOLEAN OPV_assert, OPV_inxchk, OPV_mainprog, OPV_ansi;
-static INTEGER OPV_stamp;
-static LONGINT OPV_recno;
+static INT16 OPV_stamp;
static OPV_ExitInfo OPV_exit;
-static INTEGER OPV_nofExitLabels;
-static BOOLEAN OPV_naturalAlignment;
+static INT16 OPV_nofExitLabels;
-export LONGINT *OPV_ExitInfo__typ;
+export ADDRESS *OPV_ExitInfo__typ;
static void OPV_ActualPar (OPT_Node n, OPT_Object fp);
export void OPV_AdrAndSize (OPT_Object topScope);
static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc);
-static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INTEGER prec);
+static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec);
static void OPV_DefineTDescs (OPT_Node n);
-static void OPV_Entier (OPT_Node n, INTEGER prec);
+static void OPV_Entier (OPT_Node n, INT16 prec);
static void OPV_GetTProcNum (OPT_Object obj);
static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc);
static BOOLEAN OPV_ImplicitReturn (OPT_Node n);
-static void OPV_Index (OPT_Node n, OPT_Node d, INTEGER prec, INTEGER dim);
+static void OPV_Index (OPT_Node n, OPT_Node d, INT16 prec, INT16 dim);
export void OPV_Init (void);
static void OPV_InitTDescs (OPT_Node n);
-static void OPV_Len (OPT_Node n, LONGINT dim);
+static void OPV_Len (OPT_Node n, INT64 dim);
export void OPV_Module (OPT_Node prog);
-static LONGINT OPV_NaturalAlignment (LONGINT size, LONGINT max);
static void OPV_NewArr (OPT_Node d, OPT_Node x);
-static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, INTEGER comp);
+static void OPV_ParIntLiteral (INT64 n, INT32 size);
+static INT16 OPV_Precedence (INT16 class, INT16 subclass, INT16 form, INT16 comp);
static BOOLEAN OPV_SideEffects (OPT_Node n);
-static void OPV_SizeCast (LONGINT size);
+static void OPV_SizeCast (OPT_Node n, INT32 to);
static void OPV_Stamp (OPS_Name s);
static OPT_Object OPV_SuperProc (OPT_Node n);
static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported);
static void OPV_TraverseRecord (OPT_Struct typ);
-export void OPV_TypSize (OPT_Struct typ);
static void OPV_TypeOf (OPT_Node n);
-static void OPV_design (OPT_Node n, INTEGER prec);
-static void OPV_expr (OPT_Node n, INTEGER prec);
+static void OPV_design (OPT_Node n, INT16 prec);
+static void OPV_expr (OPT_Node n, INT16 prec);
static void OPV_stat (OPT_Node n, OPT_Object outerProc);
-static LONGINT OPV_NaturalAlignment (LONGINT size, LONGINT max)
-{
- LONGINT _o_result;
- LONGINT i;
- if (size >= max) {
- _o_result = max;
- return _o_result;
- } else {
- i = 1;
- while (i < size) {
- i += i;
- }
- _o_result = i;
- return _o_result;
- }
- __RETCHK;
-}
-
-void OPV_TypSize (OPT_Struct typ)
-{
- INTEGER f, c;
- LONGINT offset, size, base, fbase, off0;
- OPT_Object fld = NIL;
- OPT_Struct btyp = NIL;
- if (typ == OPT_undftyp) {
- OPM_err(58);
- } else if (typ->size == -1) {
- f = typ->form;
- c = typ->comp;
- if (c == 4) {
- btyp = typ->BaseTyp;
- if (btyp == NIL) {
- offset = 0;
- base = OPC_SizeAlignment(OPM_RecSize);
- } else {
- OPV_TypSize(btyp);
- offset = btyp->size - (int)__ASHR(btyp->sysflag, 8);
- base = btyp->align;
- }
- fld = typ->link;
- while ((fld != NIL && fld->mode == 4)) {
- btyp = fld->typ;
- OPV_TypSize(btyp);
- size = btyp->size;
- fbase = OPC_BaseAlignment(btyp);
- OPC_Align(&offset, fbase);
- fld->adr = offset;
- offset += size;
- if (fbase > base) {
- base = fbase;
- }
- fld = fld->link;
- }
- off0 = offset;
- if (offset == 0) {
- offset = 1;
- }
- if (OPM_RecSize == 0) {
- base = OPV_NaturalAlignment(offset, OPC_SizeAlignment(OPM_RecSize));
- }
- OPC_Align(&offset, base);
- if ((typ->strobj == NIL && __MASK(typ->align, -65536) == 0)) {
- OPV_recno += 1;
- base += __ASHL(OPV_recno, 16);
- }
- typ->size = offset;
- typ->align = base;
- typ->sysflag = __MASK(typ->sysflag, -256) + (int)__ASHL(offset - off0, 8);
- } else if (c == 2) {
- OPV_TypSize(typ->BaseTyp);
- typ->size = typ->n * typ->BaseTyp->size;
- } else if (f == 13) {
- typ->size = OPM_PointerSize;
- if (typ->BaseTyp == OPT_undftyp) {
- OPM_Mark(128, typ->n);
- } else {
- OPV_TypSize(typ->BaseTyp);
- }
- } else if (f == 14) {
- typ->size = OPM_ProcSize;
- } else if (c == 3) {
- btyp = typ->BaseTyp;
- OPV_TypSize(btyp);
- if (btyp->comp == 3) {
- typ->size = btyp->size + 4;
- } else {
- typ->size = 8;
- }
- }
- }
-}
-
void OPV_Init (void)
{
OPV_stamp = 0;
- OPV_recno = 0;
OPV_nofExitLabels = 0;
- OPV_assert = __IN(7, OPM_opt);
- OPV_inxchk = __IN(0, OPM_opt);
- OPV_mainprog = __IN(10, OPM_opt);
- OPV_ansi = __IN(6, OPM_opt);
}
static void OPV_GetTProcNum (OPT_Object obj)
{
- LONGINT oldPos;
+ INT32 oldPos;
OPT_Struct typ = NIL;
OPT_Object redef = NIL;
oldPos = OPM_errpos;
OPM_errpos = obj->scope->adr;
typ = obj->link->typ;
- if (typ->form == 13) {
+ if (typ->form == 11) {
typ = typ->BaseTyp;
}
OPT_FindField(obj->name, typ->BaseTyp, &redef);
if (redef != NIL) {
obj->adr = __ASHL(__ASHR(redef->adr, 16), 16);
- if (!__IN(2, obj->conval->setval)) {
+ if (!__IN(2, obj->conval->setval, 64)) {
OPM_err(119);
}
} else {
@@ -191,37 +96,37 @@ static void OPV_TraverseRecord (OPT_Struct typ)
static void OPV_Stamp (OPS_Name s)
{
- INTEGER i, j, k;
+ INT16 i, j, k;
CHAR n[10];
OPV_stamp += 1;
i = 0;
j = OPV_stamp;
- while (s[__X(i, ((LONGINT)(256)))] != 0x00) {
+ while (s[__X(i, 256)] != 0x00) {
i += 1;
}
if (i > 25) {
i = 25;
}
- s[__X(i, ((LONGINT)(256)))] = '_';
- s[__X(i + 1, ((LONGINT)(256)))] = '_';
+ s[__X(i, 256)] = '_';
+ s[__X(i + 1, 256)] = '_';
i += 2;
k = 0;
do {
- n[__X(k, ((LONGINT)(10)))] = (CHAR)((int)__MOD(j, 10) + 48);
+ n[__X(k, 10)] = (CHAR)((int)__MOD(j, 10) + 48);
j = __DIV(j, 10);
k += 1;
} while (!(j == 0));
do {
k -= 1;
- s[__X(i, ((LONGINT)(256)))] = n[__X(k, ((LONGINT)(10)))];
+ s[__X(i, 256)] = n[__X(k, 10)];
i += 1;
} while (!(k == 0));
- s[__X(i, ((LONGINT)(256)))] = 0x00;
+ s[__X(i, 256)] = 0x00;
}
static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported)
{
- INTEGER mode;
+ INT16 mode;
OPT_Object scope = NIL;
OPT_Struct typ = NIL;
if (obj != NIL) {
@@ -234,8 +139,8 @@ static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exporte
mode = obj->mode;
if ((mode == 5 && (obj->vis != 0) == exported)) {
typ = obj->typ;
- OPV_TypSize(obj->typ);
- if (typ->form == 13) {
+ OPT_TypSize(obj->typ);
+ if (typ->form == 11) {
typ = typ->BaseTyp;
}
if (typ->comp == 4) {
@@ -244,21 +149,21 @@ static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exporte
} else if (mode == 13) {
OPV_GetTProcNum(obj);
} else if (mode == 1) {
- OPV_TypSize(obj->typ);
+ OPT_TypSize(obj->typ);
}
if (!exported) {
- if ((__IN(mode, 0x60) && obj->mnolev > 0)) {
+ if ((__IN(mode, 0x60, 32) && obj->mnolev > 0)) {
OPV_Stamp(obj->name);
}
- if (__IN(mode, 0x26)) {
+ if (__IN(mode, 0x26, 32)) {
obj->scope = outerScope;
- } else if (__IN(mode, 0x26c0)) {
+ } else if (__IN(mode, 0x26c0, 32)) {
if (obj->conval->setval == 0x0) {
OPM_err(129);
}
scope = obj->scope;
scope->leaf = 1;
- __COPY(obj->name, scope->name, ((LONGINT)(256)));
+ __COPY(obj->name, scope->name, 256);
OPV_Stamp(scope->name);
if (mode == 9) {
obj->adr = 1;
@@ -275,66 +180,66 @@ static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exporte
void OPV_AdrAndSize (OPT_Object topScope)
{
+ __ASSERT(OPT_sinttyp != NIL, 0);
+ __ASSERT(OPT_inttyp != NIL, 0);
+ __ASSERT(OPT_linttyp != NIL, 0);
OPM_errpos = topScope->adr;
topScope->leaf = 1;
OPV_Traverse(topScope->right, topScope, 1);
OPV_Traverse(topScope->right, topScope, 0);
OPT_chartyp->strobj->linkadr = 2;
+ OPT_cpbytetyp->strobj->linkadr = 2;
OPT_settyp->strobj->linkadr = 2;
OPT_realtyp->strobj->linkadr = 2;
- OPT_inttyp->strobj->linkadr = 2;
- OPT_linttyp->strobj->linkadr = 2;
+ OPT_adrtyp->strobj->linkadr = 2;
+ OPT_int8typ->strobj->linkadr = 2;
+ OPT_int16typ->strobj->linkadr = 2;
+ OPT_int32typ->strobj->linkadr = 2;
+ OPT_int64typ->strobj->linkadr = 2;
+ OPT_set32typ->strobj->linkadr = 2;
+ OPT_set64typ->strobj->linkadr = 2;
+ OPT_hinttyp->strobj->linkadr = 2;
OPT_lrltyp->strobj->linkadr = 2;
- OPT_sinttyp->strobj->linkadr = 2;
OPT_booltyp->strobj->linkadr = 2;
OPT_bytetyp->strobj->linkadr = 2;
OPT_sysptrtyp->strobj->linkadr = 2;
}
-static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, INTEGER comp)
+static INT16 OPV_Precedence (INT16 class, INT16 subclass, INT16 form, INT16 comp)
{
- INTEGER _o_result;
switch (class) {
case 7: case 0: case 2: case 4: case 9:
case 13:
- _o_result = 10;
- return _o_result;
+ return 10;
break;
case 5:
- if (__IN(3, OPM_opt)) {
- _o_result = 10;
- return _o_result;
+ if (__IN(3, OPM_Options, 32)) {
+ return 10;
} else {
- _o_result = 9;
- return _o_result;
+ return 9;
}
break;
case 1:
- if (__IN(comp, 0x0c)) {
- _o_result = 10;
- return _o_result;
+ if (__IN(comp, 0x0c, 32)) {
+ return 10;
} else {
- _o_result = 9;
- return _o_result;
+ return 9;
}
break;
case 3:
- _o_result = 9;
- return _o_result;
+ return 9;
break;
case 11:
switch (subclass) {
case 33: case 7: case 24: case 29: case 20:
- _o_result = 9;
- return _o_result;
+ return 9;
break;
case 16: case 21: case 22: case 23: case 25:
- _o_result = 10;
- return _o_result;
+ return 10;
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence OPT.Nmop, subclass = ", (LONGINT)55);
- OPM_LogWNum(subclass, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence OPT.Nmop, subclass = ", 55);
+ OPM_LogWNum(subclass, 0);
OPM_LogWLn();
break;
}
@@ -342,91 +247,75 @@ static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, IN
case 12:
switch (subclass) {
case 1:
- if (form == 9) {
- _o_result = 4;
- return _o_result;
+ if (form == 7) {
+ return 4;
} else {
- _o_result = 8;
- return _o_result;
+ return 8;
}
break;
case 2:
- if (form == 9) {
- _o_result = 3;
- return _o_result;
+ if (form == 7) {
+ return 3;
} else {
- _o_result = 8;
- return _o_result;
+ return 8;
}
break;
case 3: case 4:
- _o_result = 10;
- return _o_result;
+ return 10;
break;
case 6:
- if (form == 9) {
- _o_result = 2;
- return _o_result;
+ if (form == 7) {
+ return 2;
} else {
- _o_result = 7;
- return _o_result;
+ return 7;
}
break;
case 7:
- if (form == 9) {
- _o_result = 4;
- return _o_result;
+ if (form == 7) {
+ return 4;
} else {
- _o_result = 7;
- return _o_result;
+ return 7;
}
break;
case 11: case 12: case 13: case 14:
- _o_result = 6;
- return _o_result;
+ return 6;
break;
case 9: case 10:
- _o_result = 5;
- return _o_result;
+ return 5;
break;
case 5:
- _o_result = 1;
- return _o_result;
+ return 1;
break;
case 8:
- _o_result = 0;
- return _o_result;
+ return 0;
break;
case 19: case 15: case 17: case 18: case 26:
case 27: case 28:
- _o_result = 10;
- return _o_result;
+ return 10;
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence OPT.Ndop, subclass = ", (LONGINT)55);
- OPM_LogWNum(subclass, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence OPT.Ndop, subclass = ", 55);
+ OPM_LogWNum(subclass, 0);
OPM_LogWLn();
break;
}
break;
case 10:
- _o_result = 10;
- return _o_result;
+ return 10;
break;
case 8: case 6:
- _o_result = 12;
- return _o_result;
+ return 12;
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence, class = ", (LONGINT)43);
- OPM_LogWNum(class, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence, class = ", 43);
+ OPM_LogWNum(class, 0);
OPM_LogWLn();
break;
}
__RETCHK;
}
-static void OPV_Len (OPT_Node n, LONGINT dim)
+static void OPV_Len (OPT_Node n, INT64 dim)
{
while ((n->class == 4 && n->typ->comp == 3)) {
dim += 1;
@@ -434,7 +323,7 @@ static void OPV_Len (OPT_Node n, LONGINT dim)
}
if ((n->class == 3 && n->typ->comp == 3)) {
OPV_design(n->left, 10);
- OPM_WriteString((CHAR*)"->len[", (LONGINT)7);
+ OPM_WriteString((CHAR*)"->len[", 7);
OPM_WriteInt(dim);
OPM_Write(']');
} else {
@@ -444,21 +333,18 @@ static void OPV_Len (OPT_Node n, LONGINT dim)
static BOOLEAN OPV_SideEffects (OPT_Node n)
{
- BOOLEAN _o_result;
if (n != NIL) {
- _o_result = (n->class == 13 || OPV_SideEffects(n->left)) || OPV_SideEffects(n->right);
- return _o_result;
+ return (n->class == 13 || OPV_SideEffects(n->left)) || OPV_SideEffects(n->right);
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-static void OPV_Entier (OPT_Node n, INTEGER prec)
+static void OPV_Entier (OPT_Node n, INT16 prec)
{
- if (__IN(n->typ->form, 0x0180)) {
- OPM_WriteString((CHAR*)"__ENTIER(", (LONGINT)10);
+ if (__IN(n->typ->form, 0x60, 32)) {
+ OPM_WriteString((CHAR*)"__ENTIER(", 10);
OPV_expr(n, -1);
OPM_Write(')');
} else {
@@ -466,44 +352,49 @@ static void OPV_Entier (OPT_Node n, INTEGER prec)
}
}
-static void OPV_SizeCast (LONGINT size)
+static void OPV_SizeCast (OPT_Node n, INT32 to)
{
- if (size <= 4) {
- OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
+ if ((to < n->typ->size && __IN(2, OPM_Options, 32))) {
+ OPM_WriteString((CHAR*)"__SHORT", 8);
+ if (OPV_SideEffects(n)) {
+ OPM_Write('F');
+ }
+ OPM_Write('(');
+ OPV_Entier(n, -1);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPM_WriteInt(OPM_SignedMaximum(to) + 1);
+ OPM_Write(')');
} else {
- OPM_WriteString((CHAR*)"(SYSTEM_INT64)", (LONGINT)15);
+ if ((n->typ->size != to && (n->typ->size > 4 || to != 4))) {
+ OPM_WriteString((CHAR*)"(INT", 5);
+ OPM_WriteInt(__ASHL(to, 3));
+ OPM_WriteString((CHAR*)")", 2);
+ }
}
}
-static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INTEGER prec)
+static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec)
{
- INTEGER from, to;
+ INT16 from, to;
from = n->typ->form;
to = newtype->form;
- if (to == 9) {
- OPM_WriteString((CHAR*)"__SETOF(", (LONGINT)9);
- OPV_Entier(n, -1);
- OPM_Write(')');
- } else if (__IN(to, 0x70)) {
- if ((newtype->size < n->typ->size && __IN(2, OPM_opt))) {
- OPM_WriteString((CHAR*)"__SHORT", (LONGINT)8);
- if (OPV_SideEffects(n)) {
- OPM_Write('F');
- }
- OPM_Write('(');
- OPV_Entier(n, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPM_WriteInt(OPM_SignedMaximum(newtype->size) + 1);
- OPM_Write(')');
- } else {
- if (newtype->size != n->typ->size) {
- OPV_SizeCast(newtype->size);
- }
+ 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);
+ OPM_WriteString((CHAR*)",", 2);
+ OPM_WriteInt(__ASHL(newtype->size, 3));
+ OPM_Write(')');
}
+ } else if (to == 4) {
+ OPV_SizeCast(n, newtype->size);
+ OPV_Entier(n, 9);
} else if (to == 3) {
- if (__IN(2, OPM_opt)) {
- OPM_WriteString((CHAR*)"__CHR", (LONGINT)6);
+ if (__IN(2, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__CHR", 6);
if (OPV_SideEffects(n)) {
OPM_Write('F');
}
@@ -511,7 +402,7 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INTEGER prec)
OPV_Entier(n, -1);
OPM_Write(')');
} else {
- OPM_WriteString((CHAR*)"(CHAR)", (LONGINT)7);
+ OPM_WriteString((CHAR*)"(CHAR)", 7);
OPV_Entier(n, 9);
}
} else {
@@ -521,15 +412,15 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INTEGER prec)
static void OPV_TypeOf (OPT_Node n)
{
- if (n->typ->form == 13) {
- OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10);
+ if (n->typ->form == 11) {
+ OPM_WriteString((CHAR*)"__TYPEOF(", 10);
OPV_expr(n, -1);
OPM_Write(')');
- } else if (__IN(n->class, 0x15)) {
+ } else if (__IN(n->class, 0x15, 32)) {
OPC_Andent(n->typ);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
} else if (n->class == 3) {
- OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__TYPEOF(", 10);
OPV_expr(n->left, -1);
OPM_Write(')');
} else if (n->class == 5) {
@@ -541,35 +432,35 @@ static void OPV_TypeOf (OPT_Node n)
}
}
-static void OPV_Index (OPT_Node n, OPT_Node d, INTEGER prec, INTEGER dim)
+static void OPV_Index (OPT_Node n, OPT_Node d, INT16 prec, INT16 dim)
{
- if (!OPV_inxchk || (n->right->class == 7 && (n->right->conval->intval == 0 || n->left->typ->comp != 3))) {
+ if (!__IN(0, OPM_Options, 32) || (n->right->class == 7 && (n->right->conval->intval == 0 || n->left->typ->comp != 3))) {
OPV_expr(n->right, prec);
} else {
if (OPV_SideEffects(n->right)) {
- OPM_WriteString((CHAR*)"__XF(", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__XF(", 6);
} else {
- OPM_WriteString((CHAR*)"__X(", (LONGINT)5);
+ OPM_WriteString((CHAR*)"__X(", 5);
}
OPV_expr(n->right, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_Len(d, dim);
OPM_Write(')');
}
}
-static void OPV_design (OPT_Node n, INTEGER prec)
+static void OPV_design (OPT_Node n, INT16 prec)
{
OPT_Object obj = NIL;
OPT_Struct typ = NIL;
- INTEGER class, designPrec, comp;
+ INT16 class, designPrec, comp;
OPT_Node d = NIL, x = NIL;
- INTEGER dims, i, _for__27;
+ INT16 dims, i, _for__26;
comp = n->typ->comp;
obj = n->obj;
class = n->class;
designPrec = OPV_Precedence(class, n->subcl, n->typ->form, comp);
- if ((((((class == 0 && obj->mnolev > 0)) && (int)obj->mnolev != OPM_level)) && prec == 10)) {
+ if ((((((class == 0 && obj->mnolev > 0)) && (INT16)obj->mnolev != OPM_level)) && prec == 10)) {
designPrec = 9;
}
if (prec > designPrec) {
@@ -586,7 +477,7 @@ static void OPV_design (OPT_Node n, INTEGER prec)
OPC_CompleteIdent(n->obj);
break;
case 1:
- if (!__IN(comp, 0x0c)) {
+ if (!__IN(comp, 0x0c, 32)) {
OPM_Write('*');
}
OPC_CompleteIdent(n->obj);
@@ -594,7 +485,7 @@ static void OPV_design (OPT_Node n, INTEGER prec)
case 2:
if (n->left->class == 3) {
OPV_design(n->left->left, designPrec);
- OPM_WriteString((CHAR*)"->", (LONGINT)3);
+ OPM_WriteString((CHAR*)"->", 3);
} else {
OPV_design(n->left, designPrec);
OPM_Write('.');
@@ -604,7 +495,7 @@ static void OPV_design (OPT_Node n, INTEGER prec)
case 3:
if (n->typ->comp == 3) {
OPV_design(n->left, 10);
- OPM_WriteString((CHAR*)"->data", (LONGINT)7);
+ OPM_WriteString((CHAR*)"->data", 7);
} else {
OPM_Write('*');
OPV_design(n->left, designPrec);
@@ -631,25 +522,25 @@ static void OPV_design (OPT_Node n, INTEGER prec)
while (x != d) {
if (x->left != d) {
OPV_Index(x, d, 7, i);
- OPM_WriteString((CHAR*)" + ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" + ", 4);
OPV_Len(d, i);
- OPM_WriteString((CHAR*)" * (", (LONGINT)5);
+ OPM_WriteString((CHAR*)" * (", 5);
i -= 1;
} else {
OPV_Index(x, d, -1, i);
}
x = x->left;
}
- _for__27 = dims;
+ _for__26 = dims;
i = 1;
- while (i <= _for__27) {
+ while (i <= _for__26) {
OPM_Write(')');
i += 1;
}
if (n->typ->comp == 3) {
OPM_Write(')');
- while ((int)i < __ASHR(d->typ->size - 4, 2)) {
- OPM_WriteString((CHAR*)" * ", (LONGINT)4);
+ while (i < __ASHR(d->typ->size - 4, 2)) {
+ OPM_WriteString((CHAR*)" * ", 4);
OPV_Len(d, i);
i += 1;
}
@@ -665,35 +556,35 @@ static void OPV_design (OPT_Node n, INTEGER prec)
case 5:
typ = n->typ;
obj = n->left->obj;
- if (__IN(3, OPM_opt)) {
+ if (__IN(3, OPM_Options, 32)) {
if (typ->comp == 4) {
- OPM_WriteString((CHAR*)"__GUARDR(", (LONGINT)10);
- if ((int)obj->mnolev != OPM_level) {
- OPM_WriteStringVar((void*)obj->scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"__curr->", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__GUARDR(", 10);
+ if ((INT16)obj->mnolev != OPM_level) {
+ OPM_WriteStringVar((void*)obj->scope->name, 256);
+ OPM_WriteString((CHAR*)"__curr->", 9);
OPC_Ident(obj);
} else {
OPC_Ident(obj);
}
} else {
if (typ->BaseTyp->strobj == NIL) {
- OPM_WriteString((CHAR*)"__GUARDA(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__GUARDA(", 10);
} else {
- OPM_WriteString((CHAR*)"__GUARDP(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__GUARDP(", 10);
}
OPV_expr(n->left, -1);
typ = typ->BaseTyp;
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(typ->extlev);
OPM_Write(')');
} else {
if (typ->comp == 4) {
- OPM_WriteString((CHAR*)"*(", (LONGINT)3);
+ OPM_WriteString((CHAR*)"*(", 3);
OPC_Ident(typ->strobj);
- OPM_WriteString((CHAR*)"*)", (LONGINT)3);
+ OPM_WriteString((CHAR*)"*)", 3);
OPC_CompleteIdent(obj);
} else {
OPM_Write('(');
@@ -704,17 +595,17 @@ static void OPV_design (OPT_Node n, INTEGER prec)
}
break;
case 6:
- if (__IN(3, OPM_opt)) {
+ if (__IN(3, OPM_Options, 32)) {
if (n->left->class == 1) {
- OPM_WriteString((CHAR*)"__GUARDEQR(", (LONGINT)12);
+ OPM_WriteString((CHAR*)"__GUARDEQR(", 12);
OPC_CompleteIdent(n->left->obj);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_TypeOf(n->left);
} else {
- OPM_WriteString((CHAR*)"__GUARDEQP(", (LONGINT)12);
+ OPM_WriteString((CHAR*)"__GUARDEQP(", 12);
OPV_expr(n->left->left, -1);
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Ident(n->left->typ->strobj);
OPM_Write(')');
} else {
@@ -727,8 +618,8 @@ static void OPV_design (OPT_Node n, INTEGER prec)
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.design, class = ", (LONGINT)39);
- OPM_LogWNum(class, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.design, class = ", 39);
+ OPM_LogWNum(class, 0);
OPM_LogWLn();
break;
}
@@ -737,10 +628,15 @@ static void OPV_design (OPT_Node n, INTEGER prec)
}
}
+static void OPV_ParIntLiteral (INT64 n, INT32 size)
+{
+ OPM_WriteInt(n);
+}
+
static void OPV_ActualPar (OPT_Node n, OPT_Object fp)
{
OPT_Struct typ = NIL, aptyp = NIL;
- INTEGER comp, form, mode, prec, dim;
+ INT16 comp, form, mode, prec, dim;
OPM_Write('(');
while (n != NIL) {
typ = fp->typ;
@@ -751,81 +647,68 @@ static void OPV_ActualPar (OPT_Node n, OPT_Object fp)
if ((((mode == 2 && n->class == 11)) && n->subcl == 29)) {
OPM_Write('(');
OPC_Ident(n->typ->strobj);
- OPM_WriteString((CHAR*)"*)", (LONGINT)3);
+ OPM_WriteString((CHAR*)"*)", 3);
prec = 10;
}
- if (!__IN(n->typ->comp, 0x0c)) {
+ if (!__IN(n->typ->comp, 0x0c, 32)) {
if (mode == 2) {
- if ((OPV_ansi && typ != n->typ)) {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
+ if (typ != n->typ) {
+ OPM_WriteString((CHAR*)"(void*)", 8);
}
OPM_Write('&');
prec = 9;
- } else if (OPV_ansi) {
- if ((__IN(comp, 0x0c) && n->class == 7)) {
- OPM_WriteString((CHAR*)"(CHAR*)", (LONGINT)8);
- } else if ((((form == 13 && typ != n->typ)) && n->typ != OPT_niltyp)) {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
- }
} else {
- if ((__IN(form, 0x0180) && __IN(n->typ->form, 0x70))) {
- OPM_WriteString((CHAR*)"(double)", (LONGINT)9);
- prec = 9;
- } else if ((form == 6 && n->typ->form < 6)) {
- OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10);
- prec = 9;
+ if ((__IN(comp, 0x0c, 32) && n->class == 7)) {
+ OPM_WriteString((CHAR*)"(CHAR*)", 8);
+ } else if ((((form == 11 && typ != n->typ)) && n->typ != OPT_niltyp)) {
+ OPM_WriteString((CHAR*)"(void*)", 8);
}
}
- } else if (OPV_ansi) {
+ } else {
if ((((mode == 2 && typ != n->typ)) && prec == -1)) {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
+ OPM_WriteString((CHAR*)"(void*)", 8);
}
}
if ((((mode == 2 && n->class == 11)) && n->subcl == 29)) {
OPV_expr(n->left, prec);
- } else if ((((((form == 6 && n->class == 7)) && n->conval->intval <= OPM_SignedMaximum(OPM_IntSize))) && n->conval->intval >= OPM_SignedMinimum(OPM_IntSize))) {
- OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12);
- OPV_expr(n, prec);
- OPM_WriteString((CHAR*)"))", (LONGINT)3);
+ } else if ((form == 4 && n->class == 7)) {
+ OPV_ParIntLiteral(n->conval->intval, n->typ->size);
} else {
OPV_expr(n, prec);
}
if ((comp == 4 && mode == 2)) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_TypeOf(n);
} else if (comp == 3) {
if (n->class == 7) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10);
- OPM_WriteInt(n->conval->intval2);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPV_ParIntLiteral(n->conval->intval2, OPM_AddressSize);
} else {
aptyp = n->typ;
dim = 0;
while ((typ->comp == 3 && typ->BaseTyp->form != 1)) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_Len(n, dim);
typ = typ->BaseTyp;
aptyp = aptyp->BaseTyp;
dim += 1;
}
if ((typ->comp == 3 && typ->BaseTyp->form == 1)) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
while (aptyp->comp == 3) {
OPV_Len(n, dim);
- OPM_WriteString((CHAR*)" * ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" * ", 4);
dim += 1;
aptyp = aptyp->BaseTyp;
}
- OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12);
- OPM_WriteInt(aptyp->size);
- OPM_WriteString((CHAR*)"))", (LONGINT)3);
+ OPV_ParIntLiteral(aptyp->size, OPM_AddressSize);
}
}
}
n = n->link;
fp = fp->link;
if (n != NIL) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
}
}
OPM_Write(')');
@@ -833,21 +716,19 @@ static void OPV_ActualPar (OPT_Node n, OPT_Object fp)
static OPT_Object OPV_SuperProc (OPT_Node n)
{
- OPT_Object _o_result;
OPT_Object obj = NIL;
OPT_Struct typ = NIL;
typ = n->right->typ;
- if (typ->form == 13) {
+ if (typ->form == 11) {
typ = typ->BaseTyp;
}
OPT_FindField(n->left->obj->name, typ->BaseTyp, &obj);
- _o_result = obj;
- return _o_result;
+ return obj;
}
-static void OPV_expr (OPT_Node n, INTEGER prec)
+static void OPV_expr (OPT_Node n, INT16 prec)
{
- INTEGER class, subclass, form, exprPrec;
+ INT16 class, subclass, form, exprPrec;
OPT_Struct typ = NIL;
OPT_Node l = NIL, r = NIL;
OPT_Object proc = NIL;
@@ -857,7 +738,7 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
l = n->left;
r = n->right;
exprPrec = OPV_Precedence(class, subclass, form, n->typ->comp);
- if ((exprPrec <= prec && __IN(class, 0x3ce0))) {
+ if ((exprPrec <= prec && __IN(class, 0x3ce0, 32))) {
OPM_Write('(');
}
switch (class) {
@@ -865,10 +746,12 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPC_Constant(n->conval, form);
break;
case 10:
- OPM_WriteString((CHAR*)"__SETRNG(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__SETRNG(", 10);
OPV_expr(l, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(r, -1);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPM_WriteInt(__ASHL(n->typ->size, 3));
OPM_Write(')');
break;
case 11:
@@ -878,7 +761,7 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPV_expr(l, exprPrec);
break;
case 7:
- if (form == 9) {
+ if (form == 7) {
OPM_Write('~');
} else {
OPM_Write('-');
@@ -888,16 +771,16 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
case 16:
typ = n->obj->typ;
if (l->typ->comp == 4) {
- OPM_WriteString((CHAR*)"__IS(", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__IS(", 6);
OPC_TypeOf(l->obj);
} else {
- OPM_WriteString((CHAR*)"__ISP(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__ISP(", 7);
OPV_expr(l, -1);
typ = typ->BaseTyp;
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(typ->extlev);
OPM_Write(')');
break;
@@ -906,54 +789,54 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
break;
case 21:
if (OPV_SideEffects(l)) {
- if (l->typ->form < 7) {
- if (l->typ->form < 6) {
- OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
+ if (l->typ->form < 5) {
+ if (l->typ->size <= 4) {
+ OPM_WriteString((CHAR*)"(int)", 6);
}
- OPM_WriteString((CHAR*)"__ABSF(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ABSF(", 8);
} else {
- OPM_WriteString((CHAR*)"__ABSFD(", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__ABSFD(", 9);
}
} else {
- OPM_WriteString((CHAR*)"__ABS(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__ABS(", 7);
}
OPV_expr(l, -1);
OPM_Write(')');
break;
case 22:
- OPM_WriteString((CHAR*)"__CAP(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__CAP(", 7);
OPV_expr(l, -1);
OPM_Write(')');
break;
case 23:
- OPM_WriteString((CHAR*)"__ODD(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__ODD(", 7);
OPV_expr(l, -1);
OPM_Write(')');
break;
case 24:
- OPM_WriteString((CHAR*)"(LONGINT)(SYSTEM_ADDRESS)", (LONGINT)26);
+ OPM_WriteString((CHAR*)"(ADDRESS)", 10);
if (l->class == 1) {
OPC_CompleteIdent(l->obj);
} else {
- if ((l->typ->form != 10 && !__IN(l->typ->comp, 0x0c))) {
+ if ((l->typ->form != 8 && !__IN(l->typ->comp, 0x0c, 32))) {
OPM_Write('&');
}
OPV_expr(l, exprPrec);
}
break;
case 29:
- if (!__IN(l->class, 0x17) || (((__IN(n->typ->form, 0x6240) && __IN(l->typ->form, 0x6240))) && n->typ->size == l->typ->size)) {
+ if (!__IN(l->class, 0x17, 32) || (((__IN(n->typ->form, 0x1890, 32) && __IN(l->typ->form, 0x1890, 32))) && n->typ->size == l->typ->size)) {
OPM_Write('(');
OPC_Ident(n->typ->strobj);
OPM_Write(')');
- if (__IN(n->typ->form, 0x6000) || __IN(l->typ->form, 0x6000)) {
- OPM_WriteString((CHAR*)"(SYSTEM_ADDRESS)", (LONGINT)17);
+ if (__IN(n->typ->form, 0x1800, 32) || __IN(l->typ->form, 0x1800, 32)) {
+ OPM_WriteString((CHAR*)"(ADDRESS)", 10);
}
OPV_expr(l, exprPrec);
} else {
- OPM_WriteString((CHAR*)"__VAL(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__VAL(", 7);
OPC_Ident(n->typ->strobj);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(l, -1);
OPM_Write(')');
}
@@ -972,94 +855,98 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
case 28: case 3: case 4:
switch (subclass) {
case 15:
- OPM_WriteString((CHAR*)"__IN(", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__IN(", 6);
break;
case 17:
if (r->class == 7) {
if (r->conval->intval >= 0) {
- OPM_WriteString((CHAR*)"__ASHL(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ASHL(", 8);
} else {
- OPM_WriteString((CHAR*)"__ASHR(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ASHR(", 8);
}
} else if (OPV_SideEffects(r)) {
- OPM_WriteString((CHAR*)"__ASHF(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ASHF(", 8);
} else {
- OPM_WriteString((CHAR*)"__ASH(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__ASH(", 7);
}
break;
case 18:
- OPM_WriteString((CHAR*)"__MASK(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__MASK(", 8);
break;
case 26:
- OPM_WriteString((CHAR*)"__BIT(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__BIT(", 7);
break;
case 27:
if (r->class == 7) {
if (r->conval->intval >= 0) {
- OPM_WriteString((CHAR*)"__LSHL(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__LSHL(", 8);
} else {
- OPM_WriteString((CHAR*)"__LSHR(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__LSHR(", 8);
}
} else {
- OPM_WriteString((CHAR*)"__LSH(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__LSH(", 7);
}
break;
case 28:
if (r->class == 7) {
if (r->conval->intval >= 0) {
- OPM_WriteString((CHAR*)"__ROTL(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ROTL(", 8);
} else {
- OPM_WriteString((CHAR*)"__ROTR(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ROTR(", 8);
}
} else {
- OPM_WriteString((CHAR*)"__ROT(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__ROT(", 7);
}
break;
case 3:
if (OPV_SideEffects(n)) {
- if (form < 6) {
- OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
+ if (n->typ->size <= 4) {
+ OPM_WriteString((CHAR*)"(int)", 6);
}
- OPM_WriteString((CHAR*)"__DIVF(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__DIVF(", 8);
} else {
- OPM_WriteString((CHAR*)"__DIV(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__DIV(", 7);
}
break;
case 4:
- if (form < 6) {
- OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
+ if (n->typ->size <= 4) {
+ OPM_WriteString((CHAR*)"(int)", 6);
}
if (OPV_SideEffects(n)) {
- OPM_WriteString((CHAR*)"__MODF(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__MODF(", 8);
} else {
- OPM_WriteString((CHAR*)"__MOD(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__MOD(", 7);
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", (LONGINT)40);
- OPM_LogWNum(subclass, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", 40);
+ OPM_LogWNum(subclass, 0);
OPM_LogWLn();
break;
}
OPV_expr(l, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- if ((((__IN(subclass, 0x18020000) && r->class == 7)) && r->conval->intval < 0)) {
+ OPM_WriteString((CHAR*)", ", 3);
+ if ((((__IN(subclass, 0x18020000, 32) && r->class == 7)) && r->conval->intval < 0)) {
OPM_WriteInt(-r->conval->intval);
} else {
OPV_expr(r, -1);
}
- if (__IN(subclass, 0x18000000)) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPC_Ident(l->typ->strobj);
+ if (__IN(subclass, 0x18008000, 32)) {
+ OPM_WriteString((CHAR*)", ", 3);
+ if (subclass == 15) {
+ OPM_WriteInt(__ASHL(r->typ->size, 3));
+ } else {
+ OPM_WriteInt(__ASHL(l->typ->size, 3));
+ }
}
OPM_Write(')');
break;
case 9: case 10: case 11: case 12: case 13:
case 14:
- if (__IN(l->typ->form, 0x8400)) {
- OPM_WriteString((CHAR*)"__STRCMP(", (LONGINT)10);
+ if (__IN(l->typ->form, 0x2100, 32)) {
+ OPM_WriteString((CHAR*)"__STRCMP(", 10);
OPV_expr(l, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(r, -1);
OPM_Write(')');
OPC_Cmp(subclass);
@@ -1068,31 +955,31 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPV_expr(l, exprPrec);
OPC_Cmp(subclass);
typ = l->typ;
- if ((((((typ->form == 13 && r->typ->form != 11)) && r->typ != typ)) && r->typ != OPT_sysptrtyp)) {
- OPM_WriteString((CHAR*)"(void *) ", (LONGINT)10);
+ if ((((((typ->form == 11 && r->typ->form != 9)) && r->typ != typ)) && r->typ != OPT_sysptrtyp)) {
+ OPM_WriteString((CHAR*)"(void *) ", 10);
}
OPV_expr(r, exprPrec);
}
break;
default:
- if (subclass == 5 || (form == 9 && (subclass == 1 || subclass == 7))) {
+ if (subclass == 5 || (form == 7 && (subclass == 1 || subclass == 7))) {
OPM_Write('(');
}
OPV_expr(l, exprPrec);
switch (subclass) {
case 1:
- if (form == 9) {
- OPM_WriteString((CHAR*)" & ", (LONGINT)4);
+ if (form == 7) {
+ OPM_WriteString((CHAR*)" & ", 4);
} else {
- OPM_WriteString((CHAR*)" * ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" * ", 4);
}
break;
case 2:
- if (form == 9) {
- OPM_WriteString((CHAR*)" ^ ", (LONGINT)4);
+ if (form == 7) {
+ OPM_WriteString((CHAR*)" ^ ", 4);
} else {
- OPM_WriteString((CHAR*)" / ", (LONGINT)4);
- if (r->obj == NIL || __IN(r->obj->typ->form, 0x70)) {
+ OPM_WriteString((CHAR*)" / ", 4);
+ if (r->obj == NIL || r->obj->typ->form == 4) {
OPM_Write('(');
OPC_Ident(n->typ->strobj);
OPM_Write(')');
@@ -1100,33 +987,33 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
}
break;
case 5:
- OPM_WriteString((CHAR*)" && ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" && ", 5);
break;
case 6:
- if (form == 9) {
- OPM_WriteString((CHAR*)" | ", (LONGINT)4);
+ if (form == 7) {
+ OPM_WriteString((CHAR*)" | ", 4);
} else {
- OPM_WriteString((CHAR*)" + ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" + ", 4);
}
break;
case 7:
- if (form == 9) {
- OPM_WriteString((CHAR*)" & ~", (LONGINT)5);
+ if (form == 7) {
+ OPM_WriteString((CHAR*)" & ~", 5);
} else {
- OPM_WriteString((CHAR*)" - ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" - ", 4);
}
break;
case 8:
- OPM_WriteString((CHAR*)" || ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" || ", 5);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", (LONGINT)40);
- OPM_LogWNum(subclass, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", 40);
+ OPM_LogWNum(subclass, 0);
OPM_LogWLn();
break;
}
OPV_expr(r, exprPrec);
- if (subclass == 5 || (form == 9 && (subclass == 1 || subclass == 7))) {
+ if (subclass == 5 || (form == 7 && (subclass == 1 || subclass == 7))) {
OPM_Write(')');
}
break;
@@ -1137,7 +1024,7 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
if (l->subcl == 1) {
proc = OPV_SuperProc(n);
} else {
- OPM_WriteString((CHAR*)"__", (LONGINT)3);
+ OPM_WriteString((CHAR*)"__", 3);
proc = OPC_BaseTProc(l->obj);
}
OPC_Ident(proc);
@@ -1153,7 +1040,7 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPV_design(n, prec);
break;
}
- if ((exprPrec <= prec && __IN(class, 0x3ca0))) {
+ if ((exprPrec <= prec && __IN(class, 0x3ca0, 32))) {
OPM_Write(')');
}
}
@@ -1163,10 +1050,10 @@ static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc)
OPT_Node if_ = NIL;
OPT_Object obj = NIL;
OPT_Struct typ = NIL;
- LONGINT adr;
+ INT32 adr;
if_ = n->left;
while (if_ != NIL) {
- OPM_WriteString((CHAR*)"if ", (LONGINT)4);
+ OPM_WriteString((CHAR*)"if ", 4);
OPV_expr(if_->left, 12);
OPM_Write(' ');
OPC_BegBlk();
@@ -1177,9 +1064,9 @@ static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc)
if (typ->comp == 4) {
OPC_BegStat();
OPC_Ident(if_->left->obj);
- OPM_WriteString((CHAR*)" *", (LONGINT)3);
- OPM_WriteString(obj->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"__ = (void*)", (LONGINT)13);
+ OPM_WriteString((CHAR*)" *", 3);
+ OPM_WriteString(obj->name, 256);
+ OPM_WriteString((CHAR*)"__ = (void*)", 13);
obj->adr = 0;
OPC_CompleteIdent(obj);
OPC_EndStat();
@@ -1195,13 +1082,13 @@ static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc)
if_ = if_->link;
if ((if_ != NIL || n->right != NIL) || withtrap) {
OPC_EndBlk0();
- OPM_WriteString((CHAR*)" else ", (LONGINT)7);
+ OPM_WriteString((CHAR*)" else ", 7);
} else {
OPC_EndBlk();
}
}
if (withtrap) {
- OPM_WriteString((CHAR*)"__WITHCHK", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__WITHCHK", 10);
OPC_EndStat();
} else if (n->right != NIL) {
OPC_BegBlk();
@@ -1213,9 +1100,9 @@ static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc)
static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc)
{
OPT_Node switchCase = NIL, label = NIL;
- LONGINT low, high;
- INTEGER form, i;
- OPM_WriteString((CHAR*)"switch ", (LONGINT)8);
+ INT64 low, high;
+ INT16 form, i;
+ OPM_WriteString((CHAR*)"switch ", 8);
OPV_expr(n->left, 12);
OPM_Write(' ');
OPC_BegBlk();
@@ -1247,22 +1134,22 @@ static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc)
OPC_Indent(1);
OPV_stat(switchCase->right, outerProc);
OPC_BegStat();
- OPM_WriteString((CHAR*)"break", (LONGINT)6);
+ OPM_WriteString((CHAR*)"break", 6);
OPC_EndStat();
OPC_Indent(-1);
switchCase = switchCase->link;
}
OPC_BegStat();
- OPM_WriteString((CHAR*)"default: ", (LONGINT)10);
+ OPM_WriteString((CHAR*)"default: ", 10);
if (n->right->conval->setval != 0x0) {
OPC_Indent(1);
OPM_WriteLn();
OPV_stat(n->right->right, outerProc);
OPC_BegStat();
- OPM_WriteString((CHAR*)"break", (LONGINT)6);
+ OPM_WriteString((CHAR*)"break", 6);
OPC_Indent(-1);
} else {
- OPM_WriteString((CHAR*)"__CASECHK", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__CASECHK", 10);
}
OPC_EndStat();
OPC_EndBlk();
@@ -1270,18 +1157,16 @@ static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc)
static BOOLEAN OPV_ImplicitReturn (OPT_Node n)
{
- BOOLEAN _o_result;
while ((n != NIL && n->class != 26)) {
n = n->link;
}
- _o_result = n == NIL;
- return _o_result;
+ return n == NIL;
}
static void OPV_NewArr (OPT_Node d, OPT_Node x)
{
OPT_Struct typ = NIL, base = NIL;
- INTEGER nofdim, nofdyn;
+ INT16 nofdim, nofdyn;
typ = d->typ->BaseTyp;
base = typ;
nofdim = 0;
@@ -1292,44 +1177,40 @@ static void OPV_NewArr (OPT_Node d, OPT_Node x)
base = base->BaseTyp;
}
OPV_design(d, -1);
- OPM_WriteString((CHAR*)" = __NEWARR(", (LONGINT)13);
+ OPM_WriteString((CHAR*)" = __NEWARR(", 13);
while (base->comp == 2) {
nofdim += 1;
base = base->BaseTyp;
}
if ((base->comp == 4 && OPC_NofPtrs(base) != 0)) {
OPC_Ident(base->strobj);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
- } else if (base->form == 13) {
- OPM_WriteString((CHAR*)"POINTER__typ", (LONGINT)13);
+ OPM_WriteString((CHAR*)"__typ", 6);
+ } else if (base->form == 11) {
+ OPM_WriteString((CHAR*)"POINTER__typ", 13);
} else {
- OPM_WriteString((CHAR*)"NIL", (LONGINT)4);
+ OPM_WriteString((CHAR*)"NIL", 4);
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12);
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(base->size);
- OPM_WriteString((CHAR*)"))", (LONGINT)3);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPM_WriteInt(OPC_BaseAlignment(base));
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPM_WriteInt(OPT_BaseAlignment(base));
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(nofdim);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(nofdyn);
while (typ != base) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
if (typ->comp == 3) {
if (x->class == 7) {
- OPM_WriteString((CHAR*)"(LONGINT)(", (LONGINT)11);
- OPV_expr(x, -1);
- OPM_WriteString((CHAR*)")", (LONGINT)2);
+ OPC_IntLiteral(x->conval->intval, OPM_AddressSize);
} else {
- OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10);
+ OPM_WriteString((CHAR*)"((ADDRESS)(", 12);
OPV_expr(x, 10);
+ OPM_WriteString((CHAR*)"))", 3);
}
x = x->link;
} else {
- OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10);
- OPM_WriteInt(typ->n);
+ OPC_IntLiteral(typ->n, OPM_AddressSize);
}
typ = typ->BaseTyp;
}
@@ -1358,7 +1239,7 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPV_ExitInfo saved;
OPT_Node l = NIL, r = NIL;
while ((n != NIL && OPM_noerr)) {
- OPM_errpos = n->conval->intval;
+ OPM_errpos = OPM_Longint(n->conval->intval);
if (n->class != 14) {
OPC_BegStat();
}
@@ -1372,7 +1253,7 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPV_DefineTDescs(n->right);
OPC_EnterBody();
OPV_InitTDescs(n->right);
- OPM_WriteString((CHAR*)"/* BEGIN */", (LONGINT)12);
+ OPM_WriteString((CHAR*)"/* BEGIN */", 12);
OPM_WriteLn();
OPV_stat(n->right, outerProc);
OPC_ExitBody();
@@ -1398,11 +1279,11 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
l = n->left;
r = n->right;
if (l->typ->comp == 2) {
- OPM_WriteString((CHAR*)"__MOVE(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__MOVE(", 8);
OPV_expr(r, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(l, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
if (r->typ == OPT_stringtyp) {
OPM_WriteInt(r->conval->intval2);
} else {
@@ -1410,30 +1291,30 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
}
OPM_Write(')');
} else {
- if ((((((l->typ->form == 13 && l->obj != NIL)) && l->obj->adr == 1)) && l->obj->mode == 1)) {
+ if ((((((l->typ->form == 11 && l->obj != NIL)) && l->obj->adr == 1)) && l->obj->mode == 1)) {
l->obj->adr = 0;
OPV_design(l, -1);
l->obj->adr = 1;
- if (r->typ->form != 11) {
- OPM_WriteString((CHAR*)" = (void*)", (LONGINT)11);
+ if (r->typ->form != 9) {
+ OPM_WriteString((CHAR*)" = (void*)", 11);
} else {
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" = ", 4);
}
} else {
OPV_design(l, -1);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" = ", 4);
}
if (l->typ == r->typ) {
OPV_expr(r, -1);
- } else if ((((l->typ->form == 13 && r->typ->form != 11)) && l->typ->strobj != NIL)) {
+ } else if ((((l->typ->form == 11 && r->typ->form != 9)) && l->typ->strobj != NIL)) {
OPM_Write('(');
OPC_Ident(l->typ->strobj);
OPM_Write(')');
OPV_expr(r, -1);
} else if (l->typ->comp == 4) {
- OPM_WriteString((CHAR*)"*(", (LONGINT)3);
+ OPM_WriteString((CHAR*)"*(", 3);
OPC_Andent(l->typ);
- OPM_WriteString((CHAR*)"*)&", (LONGINT)4);
+ OPM_WriteString((CHAR*)"*)&", 4);
OPV_expr(r, 9);
} else {
OPV_expr(r, -1);
@@ -1442,12 +1323,12 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
break;
case 1:
if (n->left->typ->BaseTyp->comp == 4) {
- OPM_WriteString((CHAR*)"__NEW(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__NEW(", 7);
OPV_design(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Andent(n->left->typ->BaseTyp);
- OPM_WriteString((CHAR*)")", (LONGINT)2);
- } else if (__IN(n->left->typ->BaseTyp->comp, 0x0c)) {
+ OPM_WriteString((CHAR*)")", 2);
+ } else if (__IN(n->left->typ->BaseTyp->comp, 0x0c, 32)) {
OPV_NewArr(n->left, n->right);
}
break;
@@ -1459,43 +1340,45 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
case 15: case 16:
OPV_expr(n->left, -1);
OPC_SetInclude(n->subcl == 16);
- OPM_WriteString((CHAR*)"__SETOF(", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__SETOF(", 9);
OPV_expr(n->right, -1);
+ OPM_WriteString((CHAR*)",", 2);
+ OPM_WriteInt(__ASHL(n->left->typ->size, 3));
OPM_Write(')');
break;
case 18:
- OPM_WriteString((CHAR*)"__COPY(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__COPY(", 8);
OPV_expr(n->right, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPV_Len(n->left, ((LONGINT)(0)));
+ OPM_WriteString((CHAR*)", ", 3);
+ OPV_Len(n->left, 0);
OPM_Write(')');
break;
case 31:
- OPM_WriteString((CHAR*)"__MOVE(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__MOVE(", 8);
OPV_expr(n->right, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->right->link, -1);
OPM_Write(')');
break;
case 24:
- OPM_WriteString((CHAR*)"__GET(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__GET(", 7);
OPV_expr(n->right, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Ident(n->left->typ->strobj);
OPM_Write(')');
break;
case 25:
- OPM_WriteString((CHAR*)"__PUT(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__PUT(", 7);
OPV_expr(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->right, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Ident(n->right->typ->strobj);
OPM_Write(')');
break;
@@ -1503,15 +1386,15 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPM_err(200);
break;
case 30:
- OPM_WriteString((CHAR*)"__SYSNEW(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__SYSNEW(", 10);
OPV_design(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->right, -1);
OPM_Write(')');
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.subcl = ", (LONGINT)40);
- OPM_LogWNum(n->subcl, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.subcl = ", 40);
+ OPM_LogWNum(n->subcl, 0);
OPM_LogWLn();
break;
}
@@ -1521,7 +1404,7 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
if (n->left->subcl == 1) {
proc = OPV_SuperProc(n);
} else {
- OPM_WriteString((CHAR*)"__", (LONGINT)3);
+ OPM_WriteString((CHAR*)"__", 3);
proc = OPC_BaseTProc(n->left->obj);
}
OPC_Ident(proc);
@@ -1536,10 +1419,10 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
case 20:
if (n->subcl != 32) {
OPV_IfStat(n, 0, outerProc);
- } else if (OPV_assert) {
- OPM_WriteString((CHAR*)"__ASSERT(", (LONGINT)10);
+ } else if (__IN(7, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__ASSERT(", 10);
OPV_expr(n->left->left->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(n->left->right->right->conval->intval);
OPM_Write(')');
OPC_EndStat();
@@ -1552,7 +1435,7 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
break;
case 22:
OPV_exit.level += 1;
- OPM_WriteString((CHAR*)"while ", (LONGINT)7);
+ OPM_WriteString((CHAR*)"while ", 7);
OPV_expr(n->left, 12);
OPM_Write(' ');
OPC_BegBlk();
@@ -1562,11 +1445,11 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
break;
case 23:
OPV_exit.level += 1;
- OPM_WriteString((CHAR*)"do ", (LONGINT)4);
+ OPM_WriteString((CHAR*)"do ", 4);
OPC_BegBlk();
OPV_stat(n->left, outerProc);
OPC_EndBlk0();
- OPM_WriteString((CHAR*)" while (!", (LONGINT)10);
+ OPM_WriteString((CHAR*)" while (!", 10);
OPV_expr(n->right, 9);
OPM_Write(')');
OPV_exit.level -= 1;
@@ -1575,13 +1458,13 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
saved = OPV_exit;
OPV_exit.level = 0;
OPV_exit.label = -1;
- OPM_WriteString((CHAR*)"for (;;) ", (LONGINT)10);
+ OPM_WriteString((CHAR*)"for (;;) ", 10);
OPC_BegBlk();
OPV_stat(n->left, outerProc);
OPC_EndBlk();
if (OPV_exit.label != -1) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"exit__", (LONGINT)7);
+ OPM_WriteString((CHAR*)"exit__", 7);
OPM_WriteInt(OPV_exit.label);
OPM_Write(':');
OPC_EndStat();
@@ -1590,39 +1473,48 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
break;
case 25:
if (OPV_exit.level == 0) {
- OPM_WriteString((CHAR*)"break", (LONGINT)6);
+ OPM_WriteString((CHAR*)"break", 6);
} else {
if (OPV_exit.label == -1) {
OPV_exit.label = OPV_nofExitLabels;
OPV_nofExitLabels += 1;
}
- OPM_WriteString((CHAR*)"goto exit__", (LONGINT)12);
+ OPM_WriteString((CHAR*)"goto exit__", 12);
OPM_WriteInt(OPV_exit.label);
}
break;
case 26:
if (OPM_level == 0) {
- if (OPV_mainprog) {
- OPM_WriteString((CHAR*)"__FINI", (LONGINT)7);
+ if (__IN(10, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__FINI", 7);
} else {
- OPM_WriteString((CHAR*)"__ENDMOD", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__ENDMOD", 9);
}
+ } else if (OPC_NeedsRetval(outerProc)) {
+ OPM_WriteString((CHAR*)"__retval = ", 12);
+ if ((n->left->typ->form == 11 && n->obj->typ != n->left->typ)) {
+ OPM_WriteString((CHAR*)"(void*)", 8);
+ OPV_expr(n->left, 10);
+ } else {
+ OPV_expr(n->left, -1);
+ }
+ OPC_EndStat();
+ OPC_BegStat();
+ OPC_ExitProc(outerProc, 0, 0);
+ OPC_EndStat();
+ OPC_BegStat();
+ OPM_WriteString((CHAR*)"return __retval", 16);
} else {
+ OPC_ExitProc(outerProc, 0, 0);
+ OPM_WriteString((CHAR*)"return", 7);
if (n->left != NIL) {
- OPM_WriteString((CHAR*)"_o_result = ", (LONGINT)13);
- if ((n->left->typ->form == 13 && n->obj->typ != n->left->typ)) {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
+ OPM_Write(' ');
+ if ((n->left->typ->form == 11 && n->obj->typ != n->left->typ)) {
+ OPM_WriteString((CHAR*)"(void*)", 8);
OPV_expr(n->left, 10);
} else {
OPV_expr(n->left, -1);
}
- OPM_WriteString((CHAR*)";", (LONGINT)2);
- OPM_WriteLn();
- OPC_BegStat();
- OPC_ExitProc(outerProc, 0, 0);
- OPM_WriteString((CHAR*)"return _o_result", (LONGINT)17);
- } else {
- OPM_WriteString((CHAR*)"return", (LONGINT)7);
}
}
break;
@@ -1630,15 +1522,15 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPV_IfStat(n, n->subcl == 0, outerProc);
break;
case 28:
- OPC_Halt(n->right->conval->intval);
+ OPC_Halt(OPM_Longint(n->right->conval->intval));
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.class = ", (LONGINT)40);
- OPM_LogWNum(n->class, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.class = ", 40);
+ OPM_LogWNum(n->class, 0);
OPM_LogWLn();
break;
}
- if (!__IN(n->class, 0x09744000)) {
+ if (!__IN(n->class, 0x09744000, 32)) {
OPC_EndStat();
}
n = n->link;
@@ -1647,7 +1539,7 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
void OPV_Module (OPT_Node prog)
{
- if (!OPV_mainprog) {
+ if (!__IN(10, OPM_Options, 32)) {
OPC_GenHdr(prog->right);
OPC_GenHdrIncludes();
}
diff --git a/bootstrap/windows-48/OPV.h b/bootstrap/windows-48/OPV.h
index 04828b2f..c4a61586 100644
--- a/bootstrap/windows-48/OPV.h
+++ b/bootstrap/windows-48/OPV.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPV__h
#define OPV__h
@@ -12,8 +12,7 @@
import void OPV_AdrAndSize (OPT_Object topScope);
import void OPV_Init (void);
import void OPV_Module (OPT_Node prog);
-import void OPV_TypSize (OPT_Struct typ);
import void *OPV__init(void);
-#endif
+#endif // OPV
diff --git a/bootstrap/windows-48/Out.c b/bootstrap/windows-48/Out.c
new file mode 100644
index 00000000..720267fd
--- /dev/null
+++ b/bootstrap/windows-48/Out.c
@@ -0,0 +1,318 @@
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
+#include "SYSTEM.h"
+#include "Platform.h"
+
+
+export BOOLEAN Out_IsConsole;
+static CHAR Out_buf[128];
+static INT16 Out_in;
+
+
+export void Out_Char (CHAR ch);
+export void Out_Flush (void);
+export void Out_Int (INT64 x, INT64 n);
+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, LONGINT str__len);
+export LONGREAL Out_Ten (INT16 e);
+static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i);
+static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i);
+
+#define Out_Entier64(x) (INT64)(x)
+
+void Out_Flush (void)
+{
+ INT16 error;
+ if (Out_in > 0) {
+ error = Platform_Write(Platform_StdOut, (ADDRESS)Out_buf, Out_in);
+ }
+ Out_in = 0;
+}
+
+void Out_Open (void)
+{
+}
+
+void Out_Char (CHAR ch)
+{
+ if (Out_in >= 128) {
+ Out_Flush();
+ }
+ Out_buf[__X(Out_in, 128)] = ch;
+ Out_in += 1;
+ if (ch == 0x0a) {
+ Out_Flush();
+ }
+}
+
+static INT32 Out_Length (CHAR *s, LONGINT s__len)
+{
+ INT32 l;
+ l = 0;
+ while ((l < s__len && s[__X(l, s__len)] != 0x00)) {
+ l += 1;
+ }
+ return l;
+}
+
+void Out_String (CHAR *str, LONGINT str__len)
+{
+ INT32 l;
+ INT16 error;
+ __DUP(str, str__len, CHAR);
+ l = Out_Length((void*)str, str__len);
+ if (Out_in + l > 128) {
+ Out_Flush();
+ }
+ if (l > 128) {
+ error = Platform_Write(Platform_StdOut, (ADDRESS)str, l);
+ } else {
+ __MOVE((ADDRESS)str, (ADDRESS)&Out_buf[__X(Out_in, 128)], l);
+ Out_in += (INT16)l;
+ }
+ __DEL(str);
+}
+
+void Out_Int (INT64 x, INT64 n)
+{
+ CHAR s[22];
+ INT16 i;
+ BOOLEAN negative;
+ negative = x < 0;
+ if (x == (-9223372036854775807-1)) {
+ __MOVE("8085774586302733229", s, 20);
+ i = 19;
+ } else {
+ if (x < 0) {
+ x = -x;
+ }
+ s[0] = (CHAR)(48 + __MOD(x, 10));
+ x = __DIV(x, 10);
+ i = 1;
+ while (x != 0) {
+ s[__X(i, 22)] = (CHAR)(48 + __MOD(x, 10));
+ x = __DIV(x, 10);
+ i += 1;
+ }
+ }
+ if (negative) {
+ s[__X(i, 22)] = '-';
+ i += 1;
+ }
+ while (n > (INT64)i) {
+ Out_Char(' ');
+ n -= 1;
+ }
+ while (i > 0) {
+ i -= 1;
+ Out_Char(s[__X(i, 22)]);
+ }
+}
+
+void Out_Ln (void)
+{
+ Out_String(Platform_NL, 3);
+ Out_Flush();
+}
+
+static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i)
+{
+ *i -= 1;
+ s[__X(*i, s__len)] = (CHAR)(__MOD(n, 10) + 48);
+}
+
+static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i)
+{
+ INT16 j;
+ INT32 l;
+ __DUP(t, t__len, CHAR);
+ l = Out_Length((void*)t, t__len);
+ if (l > *i) {
+ l = *i;
+ }
+ *i -= (INT16)l;
+ j = 0;
+ while (j < l) {
+ s[__X(*i + j, s__len)] = t[__X(j, t__len)];
+ j += 1;
+ }
+ __DEL(t);
+}
+
+LONGREAL Out_Ten (INT16 e)
+{
+ LONGREAL r, power;
+ r = (LONGREAL)1;
+ power = (LONGREAL)10;
+ while (e > 0) {
+ if (__ODD(e)) {
+ r = r * power;
+ }
+ power = power * power;
+ e = __ASHR(e, 1);
+ }
+ return r;
+}
+
+static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_)
+{
+ INT16 e;
+ INT64 f;
+ CHAR s[30];
+ INT16 i, el;
+ LONGREAL x0;
+ BOOLEAN nn, en;
+ INT64 m;
+ INT16 d, dr;
+ e = (INT16)__MASK(__ASHR((__VAL(INT64, x)), 52), -2048);
+ f = __MASK((__VAL(INT64, x)), -4503599627370496);
+ nn = (__VAL(INT64, x) < 0 && !((e == 2047 && f != 0)));
+ if (nn) {
+ n -= 1;
+ }
+ i = 30;
+ if (e == 2047) {
+ if (f == 0) {
+ Out_prepend((CHAR*)"Infinity", 9, (void*)s, 30, &i);
+ } else {
+ Out_prepend((CHAR*)"NaN", 4, (void*)s, 30, &i);
+ }
+ } else {
+ if (long_) {
+ el = 3;
+ dr = n - 6;
+ if (dr > 17) {
+ dr = 17;
+ }
+ d = dr;
+ if (d < 15) {
+ d = 15;
+ }
+ } else {
+ el = 2;
+ dr = n - 5;
+ if (dr > 9) {
+ dr = 9;
+ }
+ d = dr;
+ if (d < 6) {
+ d = 6;
+ }
+ }
+ if (e == 0) {
+ while (el > 0) {
+ i -= 1;
+ s[__X(i, 30)] = '0';
+ el -= 1;
+ }
+ i -= 1;
+ s[__X(i, 30)] = '+';
+ m = 0;
+ } else {
+ if (nn) {
+ x = -x;
+ }
+ e = (INT16)__ASHR((e - 1023) * 77, 8);
+ if (e >= 0) {
+ x = x / (LONGREAL)Out_Ten(e);
+ } else {
+ x = Out_Ten(-e) * x;
+ }
+ if (x >= (LONGREAL)10) {
+ x = 1.00000000000000e-001 * x;
+ e += 1;
+ }
+ en = e < 0;
+ if (en) {
+ e = -e;
+ }
+ while (el > 0) {
+ Out_digit(e, (void*)s, 30, &i);
+ e = __DIV(e, 10);
+ el -= 1;
+ }
+ i -= 1;
+ if (en) {
+ s[__X(i, 30)] = '-';
+ } else {
+ s[__X(i, 30)] = '+';
+ }
+ x0 = Out_Ten(d - 1);
+ x = x0 * x;
+ x = x + 5.00000000000000e-001;
+ if (x >= (LONGREAL)10 * x0) {
+ x = 1.00000000000000e-001 * x;
+ e += 1;
+ }
+ m = Out_Entier64(x);
+ }
+ i -= 1;
+ if (long_) {
+ s[__X(i, 30)] = 'D';
+ } else {
+ s[__X(i, 30)] = 'E';
+ }
+ if (dr < 2) {
+ dr = 2;
+ }
+ while ((d > dr && __MOD(m, 10) == 0)) {
+ m = __DIV(m, 10);
+ d -= 1;
+ }
+ while (d > 1) {
+ Out_digit(m, (void*)s, 30, &i);
+ m = __DIV(m, 10);
+ d -= 1;
+ }
+ i -= 1;
+ s[__X(i, 30)] = '.';
+ Out_digit(m, (void*)s, 30, &i);
+ }
+ n -= 30 - i;
+ while (n > 0) {
+ Out_Char(' ');
+ n -= 1;
+ }
+ if (nn) {
+ Out_Char('-');
+ }
+ while (i < 30) {
+ Out_Char(s[__X(i, 30)]);
+ i += 1;
+ }
+}
+
+void Out_Real (REAL x, INT16 n)
+{
+ Out_RealP(x, n, 0);
+}
+
+void Out_LongReal (LONGREAL x, INT16 n)
+{
+ Out_RealP(x, n, 1);
+}
+
+
+export void *Out__init(void)
+{
+ __DEFMOD;
+ __MODULE_IMPORT(Platform);
+ __REGMOD("Out", 0);
+ __REGCMD("Flush", Out_Flush);
+ __REGCMD("Ln", Out_Ln);
+ __REGCMD("Open", Out_Open);
+/* BEGIN */
+ Out_IsConsole = Platform_IsConsole(Platform_StdOut);
+ Out_in = 0;
+ __ENDMOD;
+}
diff --git a/bootstrap/windows-48/Out.h b/bootstrap/windows-48/Out.h
new file mode 100644
index 00000000..0e66420d
--- /dev/null
+++ b/bootstrap/windows-48/Out.h
@@ -0,0 +1,24 @@
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#ifndef Out__h
+#define Out__h
+
+#include "SYSTEM.h"
+
+
+import BOOLEAN Out_IsConsole;
+
+
+import void Out_Char (CHAR ch);
+import void Out_Flush (void);
+import void Out_Int (INT64 x, INT64 n);
+import void Out_Ln (void);
+import void Out_LongReal (LONGREAL x, INT16 n);
+import void Out_Open (void);
+import void Out_Real (REAL x, INT16 n);
+import void Out_String (CHAR *str, LONGINT str__len);
+import LONGREAL Out_Ten (INT16 e);
+import void *Out__init(void);
+
+
+#endif // Out
diff --git a/bootstrap/windows-48/Platform.c b/bootstrap/windows-48/Platform.c
index 4e8b44c8..5a57f076 100644
--- a/bootstrap/windows-48/Platform.c
+++ b/bootstrap/windows-48/Platform.c
@@ -1,4 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
typedef
@@ -8,96 +14,93 @@ typedef
Platform_ArgPtr (*Platform_ArgVec)[1024];
typedef
- LONGINT (*Platform_ArgVecPtr)[1];
+ INT32 (*Platform_ArgVecPtr)[1];
typedef
CHAR (*Platform_EnvPtr)[1024];
typedef
struct Platform_FileIdentity {
- LONGINT volume, indexhigh, indexlow, mtimehigh, mtimelow;
+ INT32 volume, indexhigh, indexlow, mtimehigh, mtimelow;
} Platform_FileIdentity;
typedef
- void (*Platform_HaltProcedure)(LONGINT);
+ void (*Platform_HaltProcedure)(INT32);
typedef
- void (*Platform_SignalHandler)(INTEGER);
+ void (*Platform_SignalHandler)(INT32);
export BOOLEAN Platform_LittleEndian;
-export LONGINT Platform_MainStackFrame, Platform_HaltCode;
-export INTEGER Platform_PID;
+export INT32 Platform_MainStackFrame;
+export INT32 Platform_HaltCode;
+export INT16 Platform_PID;
export CHAR Platform_CWD[4096];
-export INTEGER Platform_ArgCount;
-export LONGINT Platform_ArgVector;
+export INT16 Platform_ArgCount;
+export INT32 Platform_ArgVector;
static Platform_HaltProcedure Platform_HaltHandler;
-static LONGINT Platform_TimeStart;
-export INTEGER Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
-export LONGINT Platform_StdIn, Platform_StdOut, Platform_StdErr;
+static INT32 Platform_TimeStart;
+export INT16 Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
+export INT32 Platform_StdIn, Platform_StdOut, Platform_StdErr;
static Platform_SignalHandler Platform_InterruptHandler;
-export CHAR Platform_nl[3];
+export CHAR Platform_NL[3];
-export LONGINT *Platform_FileIdentity__typ;
+export ADDRESS *Platform_FileIdentity__typ;
-export BOOLEAN Platform_Absent (INTEGER e);
-export INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len);
-export void Platform_AssertFail (LONGINT code);
-export INTEGER Platform_Chdir (CHAR *n, LONGINT n__len);
-export INTEGER Platform_Close (LONGINT h);
-export BOOLEAN Platform_ConnectionFailed (INTEGER e);
-export void Platform_Delay (LONGINT ms);
-export BOOLEAN Platform_DifferentFilesystems (INTEGER e);
-static void Platform_DisplayHaltCode (LONGINT code);
-export INTEGER Platform_Error (void);
-export void Platform_Exit (INTEGER code);
-export void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len);
-export void Platform_GetClock (LONGINT *t, LONGINT *d);
+export BOOLEAN Platform_Absent (INT16 e);
+export INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
+export INT16 Platform_Chdir (CHAR *n, LONGINT n__len);
+export INT16 Platform_Close (INT32 h);
+export BOOLEAN Platform_ConnectionFailed (INT16 e);
+export void Platform_Delay (INT32 ms);
+export BOOLEAN Platform_DifferentFilesystems (INT16 e);
+static void Platform_EnableVT100 (void);
+export INT16 Platform_Error (void);
+export void Platform_Exit (INT32 code);
+export void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len);
+export void Platform_GetClock (INT32 *t, INT32 *d);
export void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
-export void Platform_GetIntArg (INTEGER n, LONGINT *val);
-export void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec);
-export void Platform_Halt (LONGINT code);
-export INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ);
-export INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ);
-export BOOLEAN Platform_Inaccessible (INTEGER e);
-export void Platform_Init (INTEGER argc, LONGINT argvadr);
-export void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d);
-export INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h);
-export BOOLEAN Platform_NoSuchDirectory (INTEGER e);
-export LONGINT Platform_OSAllocate (LONGINT size);
-export void Platform_OSFree (LONGINT address);
-export INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h);
-export INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h);
-export INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n);
-export INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n);
-export INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
+export 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, 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_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, 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, 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 INTEGER Platform_Seek (LONGINT h, LONGINT o, INTEGER r);
+export INT16 Platform_Seek (INT32 h, INT32 o, INT16 r);
export void Platform_SetBadInstructionHandler (Platform_SignalHandler handler);
-export void Platform_SetHalt (Platform_HaltProcedure p);
-export void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source);
-export INTEGER Platform_Size (LONGINT h, LONGINT *l);
-export INTEGER Platform_Sync (LONGINT h);
-export INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len);
+export void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__typ, Platform_FileIdentity source);
+export INT16 Platform_Size (INT32 h, INT32 *l);
+export INT16 Platform_Sync (INT32 h);
+export INT16 Platform_System (CHAR *cmd, LONGINT cmd__len);
static void Platform_TestLittleEndian (void);
-export LONGINT Platform_Time (void);
-export BOOLEAN Platform_TimedOut (INTEGER e);
-export BOOLEAN Platform_TooManyFiles (INTEGER e);
-export INTEGER Platform_Truncate (LONGINT h, LONGINT limit);
-export INTEGER Platform_Unlink (CHAR *n, LONGINT n__len);
-export INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l);
-static void Platform_YMDHMStoClock (INTEGER ye, INTEGER mo, INTEGER da, INTEGER ho, INTEGER mi, INTEGER se, LONGINT *t, LONGINT *d);
-static void Platform_errch (CHAR c);
-static void Platform_errint (LONGINT l);
-static void Platform_errln (void);
-static void Platform_errposint (LONGINT l);
+export INT32 Platform_Time (void);
+export BOOLEAN Platform_TimedOut (INT16 e);
+export BOOLEAN Platform_TooManyFiles (INT16 e);
+export INT16 Platform_Truncate (INT32 h, INT32 limit);
+export INT16 Platform_Unlink (CHAR *n, LONGINT n__len);
+export INT16 Platform_Write (INT32 h, INT32 p, INT32 l);
+static void Platform_YMDHMStoClock (INT16 ye, INT16 mo, INT16 da, INT16 ho, INT16 mi, INT16 se, INT32 *t, INT32 *d);
export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
#include "WindowsWrapper.h"
#define Platform_ECONNABORTED() WSAECONNABORTED
#define Platform_ECONNREFUSED() WSAECONNREFUSED
#define Platform_EHOSTUNREACH() WSAEHOSTUNREACH
+#define Platform_EINTR() WSAEINTR
#define Platform_ENETUNREACH() WSAENETUNREACH
#define Platform_ERRORACCESSDENIED() ERROR_ACCESS_DENIED
#define Platform_ERRORFILENOTFOUND() ERROR_FILE_NOT_FOUND
@@ -109,11 +112,13 @@ export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT
#define Platform_ERRORWRITEPROTECT() ERROR_WRITE_PROTECT
#define Platform_ETIMEDOUT() WSAETIMEDOUT
extern void Heap_InitHeap();
-#define Platform_GetTickCount() (LONGINT)(SYSTEM_CARD32)GetTickCount()
+#define Platform_GetConsoleMode(h, m) GetConsoleMode((HANDLE)h, (DWORD*)m)
+#define Platform_GetTickCount() (LONGINT)(UINT32)GetTickCount()
#define Platform_HeapInitHeap() Heap_InitHeap()
-#define Platform_SetInterruptHandler(h) SystemSetInterruptHandler((SYSTEM_ADDRESS)h)
-#define Platform_SetQuitHandler(h) SystemSetQuitHandler((SYSTEM_ADDRESS)h)
-#define Platform_allocate(size) (LONGINT)(SYSTEM_ADDRESS)((void*)HeapAlloc(GetProcessHeap(), 0, (size_t)size))
+#define Platform_SetConsoleMode(h, m) SetConsoleMode((HANDLE)h, (DWORD)m)
+#define Platform_SetInterruptHandler(h) SystemSetInterruptHandler((ADDRESS)h)
+#define Platform_SetQuitHandler(h) SystemSetQuitHandler((ADDRESS)h)
+#define Platform_allocate(size) (ADDRESS)((void*)HeapAlloc(GetProcessHeap(), 0, (size_t)size))
#define Platform_bhfiIndexHigh() (LONGINT)bhfi.nFileIndexHigh
#define Platform_bhfiIndexLow() (LONGINT)bhfi.nFileIndexLow
#define Platform_bhfiMtimeHigh() (LONGINT)bhfi.ftLastWriteTime.dwHighDateTime
@@ -121,44 +126,42 @@ extern void Heap_InitHeap();
#define Platform_bhfiVsn() (LONGINT)bhfi.dwVolumeSerialNumber
#define Platform_byHandleFileInformation() BY_HANDLE_FILE_INFORMATION bhfi
#define Platform_cleanupProcess() CloseHandle(pi.hProcess); CloseHandle(pi.hThread);
-#define Platform_closeHandle(h) (INTEGER)CloseHandle((HANDLE)(SYSTEM_ADDRESS)h)
+#define Platform_closeHandle(h) (INTEGER)CloseHandle((HANDLE)h)
#define Platform_createProcess(str, str__len) (INTEGER)CreateProcess(0, (char*)str, 0,0,0,0,0,0,&si,&pi)
#define Platform_deleteFile(n, n__len) (INTEGER)DeleteFile((char*)n)
#define Platform_err() (INTEGER)GetLastError()
-#define Platform_errc(c) WriteFile((HANDLE)(SYSTEM_ADDRESS)Platform_StdOut, &c, 1, 0,0)
-#define Platform_errstring(s, s__len) WriteFile((HANDLE)(SYSTEM_ADDRESS)Platform_StdOut, s, s__len-1, 0,0)
#define Platform_exit(code) ExitProcess((UINT)code)
#define Platform_fileTimeToSysTime() SYSTEMTIME st; FileTimeToSystemTime(&ft, &st)
-#define Platform_flushFileBuffers(h) (INTEGER)FlushFileBuffers((HANDLE)(SYSTEM_ADDRESS)h)
-#define Platform_free(address) HeapFree(GetProcessHeap(), 0, (void*)(SYSTEM_ADDRESS)address)
+#define Platform_flushFileBuffers(h) (INTEGER)FlushFileBuffers((HANDLE)h)
+#define Platform_free(address) HeapFree(GetProcessHeap(), 0, (void*)address)
#define Platform_ftToUli() ULARGE_INTEGER ul; ul.LowPart=ft.dwLowDateTime; ul.HighPart=ft.dwHighDateTime
#define Platform_getCurrentDirectory(n, n__len) GetCurrentDirectory(n__len, (char*)n)
#define Platform_getExitCodeProcess(exitcode) GetExitCodeProcess(pi.hProcess, (DWORD*)exitcode);
-#define Platform_getFileInformationByHandle(h) (INTEGER)GetFileInformationByHandle((HANDLE)(SYSTEM_ADDRESS)h, &bhfi)
-#define Platform_getFilePos(h, r, rc) LARGE_INTEGER liz = {0}; *rc = (INTEGER)SetFilePointerEx((HANDLE)(SYSTEM_ADDRESS)h, liz, &li, FILE_CURRENT); *r = (LONGINT)li.QuadPart
-#define Platform_getFileSize(h) (INTEGER)GetFileSizeEx((HANDLE)(SYSTEM_ADDRESS)h, &li)
+#define Platform_getFileInformationByHandle(h) (INTEGER)GetFileInformationByHandle((HANDLE)h, &bhfi)
+#define Platform_getFilePos(h, r, rc) LARGE_INTEGER liz = {0}; *rc = (INTEGER)SetFilePointerEx((HANDLE)h, liz, &li, FILE_CURRENT); *r = (LONGINT)li.QuadPart
+#define Platform_getFileSize(h) (INTEGER)GetFileSizeEx((HANDLE)h, &li)
#define Platform_getLocalTime() SYSTEMTIME st; GetLocalTime(&st)
#define Platform_getenv(name, name__len, buf, buf__len) (INTEGER)GetEnvironmentVariable((char*)name, (char*)buf, buf__len)
#define Platform_getpid() (INTEGER)GetCurrentProcessId()
-#define Platform_getstderrhandle() (SYSTEM_ADDRESS)GetStdHandle(STD_ERROR_HANDLE)
-#define Platform_getstdinhandle() (SYSTEM_ADDRESS)GetStdHandle(STD_INPUT_HANDLE)
-#define Platform_getstdouthandle() (SYSTEM_ADDRESS)GetStdHandle(STD_OUTPUT_HANDLE)
+#define Platform_getstderrhandle() (ADDRESS)GetStdHandle(STD_ERROR_HANDLE)
+#define Platform_getstdinhandle() (ADDRESS)GetStdHandle(STD_INPUT_HANDLE)
+#define Platform_getstdouthandle() (ADDRESS)GetStdHandle(STD_OUTPUT_HANDLE)
#define Platform_identityToFileTime(i) FILETIME ft; ft.dwHighDateTime = i.mtimehigh; ft.dwLowDateTime = i.mtimelow
-#define Platform_invalidHandleValue() ((LONGINT)(SYSTEM_ADDRESS)INVALID_HANDLE_VALUE)
+#define Platform_invalidHandleValue() ((ADDRESS)INVALID_HANDLE_VALUE)
#define Platform_largeInteger() LARGE_INTEGER li
#define Platform_liLongint() (LONGINT)li.QuadPart
#define Platform_moveFile(o, o__len, n, n__len) (INTEGER)MoveFileEx((char*)o, (char*)n, MOVEFILE_REPLACE_EXISTING)
-#define Platform_opennew(n, n__len) (LONGINT)(SYSTEM_ADDRESS)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
-#define Platform_openro(n, n__len) (LONGINT)(SYSTEM_ADDRESS)CreateFile((char*)n, GENERIC_READ , FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
-#define Platform_openrw(n, n__len) (LONGINT)(SYSTEM_ADDRESS)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
+#define Platform_opennew(n, n__len) (ADDRESS)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
+#define Platform_openro(n, n__len) (ADDRESS)CreateFile((char*)n, GENERIC_READ , FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
+#define Platform_openrw(n, n__len) (ADDRESS)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
#define Platform_processInfo() PROCESS_INFORMATION pi = {0};
-#define Platform_readfile(fd, p, l, n) (INTEGER)ReadFile ((HANDLE)(SYSTEM_ADDRESS)fd, (void*)(SYSTEM_ADDRESS)(p), (DWORD)l, (DWORD*)n, 0)
+#define Platform_readfile(fd, p, l, n) (INTEGER)ReadFile((HANDLE)fd, (void*)p, (DWORD)l, (DWORD*)n, 0)
#define Platform_seekcur() FILE_CURRENT
#define Platform_seekend() FILE_END
#define Platform_seekset() FILE_BEGIN
#define Platform_setCurrentDirectory(n, n__len) (INTEGER)SetCurrentDirectory((char*)n)
-#define Platform_setEndOfFile(h) (INTEGER)SetEndOfFile((HANDLE)(SYSTEM_ADDRESS)h)
-#define Platform_setFilePointerEx(h, o, r, rc) li.QuadPart=o; *rc = (INTEGER)SetFilePointerEx((HANDLE)(SYSTEM_ADDRESS)h, li, 0, (DWORD)r)
+#define Platform_setEndOfFile(h) (INTEGER)SetEndOfFile((HANDLE)h)
+#define Platform_setFilePointerEx(h, o, r, rc) li.QuadPart=o; *rc = (INTEGER)SetFilePointerEx((HANDLE)h, li, 0, (DWORD)r)
#define Platform_sleep(ms) Sleep((DWORD)ms)
#define Platform_stToFt() FILETIME ft; SystemTimeToFileTime(&st, &ft)
#define Platform_startupInfo() STARTUPINFO si = {0}; si.cb = sizeof(si);
@@ -173,75 +176,64 @@ extern void Heap_InitHeap();
#define Platform_ulSec() (LONGINT)(ul.QuadPart / 1000000LL)
#define Platform_uluSec() (LONGINT)(ul.QuadPart % 1000000LL)
#define Platform_waitForProcess() (INTEGER)WaitForSingleObject(pi.hProcess, INFINITE)
-#define Platform_writefile(fd, p, l) (INTEGER)WriteFile((HANDLE)(SYSTEM_ADDRESS)fd, (void*)(SYSTEM_ADDRESS)(p), (DWORD)l, 0,0)
+#define Platform_writefile(fd, p, l, n) (INTEGER)WriteFile((HANDLE)fd, (void*)(p), (DWORD)l, (DWORD*)n, 0)
-BOOLEAN Platform_TooManyFiles (INTEGER e)
+BOOLEAN Platform_TooManyFiles (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = e == Platform_ERRORTOOMANYOPENFILES();
- return _o_result;
+ return e == Platform_ERRORTOOMANYOPENFILES();
}
-BOOLEAN Platform_NoSuchDirectory (INTEGER e)
+BOOLEAN Platform_NoSuchDirectory (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = e == Platform_ERRORPATHNOTFOUND();
- return _o_result;
+ return e == Platform_ERRORPATHNOTFOUND();
}
-BOOLEAN Platform_DifferentFilesystems (INTEGER e)
+BOOLEAN Platform_DifferentFilesystems (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = e == Platform_ERRORNOTSAMEDEVICE();
- return _o_result;
+ return e == Platform_ERRORNOTSAMEDEVICE();
}
-BOOLEAN Platform_Inaccessible (INTEGER e)
+BOOLEAN Platform_Inaccessible (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = ((e == Platform_ERRORACCESSDENIED() || e == Platform_ERRORWRITEPROTECT()) || e == Platform_ERRORNOTREADY()) || e == Platform_ERRORSHARINGVIOLATION();
- return _o_result;
+ return ((e == Platform_ERRORACCESSDENIED() || e == Platform_ERRORWRITEPROTECT()) || e == Platform_ERRORNOTREADY()) || e == Platform_ERRORSHARINGVIOLATION();
}
-BOOLEAN Platform_Absent (INTEGER e)
+BOOLEAN Platform_Absent (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = e == Platform_ERRORFILENOTFOUND() || e == Platform_ERRORPATHNOTFOUND();
- return _o_result;
+ return e == Platform_ERRORFILENOTFOUND() || e == Platform_ERRORPATHNOTFOUND();
}
-BOOLEAN Platform_TimedOut (INTEGER e)
+BOOLEAN Platform_TimedOut (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = e == Platform_ETIMEDOUT();
- return _o_result;
+ return e == Platform_ETIMEDOUT();
}
-BOOLEAN Platform_ConnectionFailed (INTEGER e)
+BOOLEAN Platform_ConnectionFailed (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = ((e == Platform_ECONNREFUSED() || e == Platform_ECONNABORTED()) || e == Platform_ENETUNREACH()) || e == Platform_EHOSTUNREACH();
- return _o_result;
+ return ((e == Platform_ECONNREFUSED() || e == Platform_ECONNABORTED()) || e == Platform_ENETUNREACH()) || e == Platform_EHOSTUNREACH();
}
-LONGINT Platform_OSAllocate (LONGINT size)
+BOOLEAN Platform_Interrupted (INT16 e)
{
- LONGINT _o_result;
- _o_result = Platform_allocate(size);
- return _o_result;
+ return e == Platform_EINTR();
}
-void Platform_OSFree (LONGINT address)
+INT32 Platform_OSAllocate (INT32 size)
+{
+ return Platform_allocate(size);
+}
+
+void Platform_OSFree (INT32 address)
{
Platform_free(address);
}
-void Platform_Init (INTEGER argc, LONGINT argvadr)
+void Platform_Init (INT32 argc, INT32 argvadr)
{
Platform_ArgVecPtr av = NIL;
Platform_MainStackFrame = argvadr;
- Platform_ArgCount = argc;
- av = (Platform_ArgVecPtr)(SYSTEM_ADDRESS)argvadr;
+ Platform_ArgCount = __VAL(INT16, argc);
+ av = (Platform_ArgVecPtr)(ADDRESS)argvadr;
Platform_ArgVector = (*av)[0];
Platform_HaltCode = -128;
Platform_HeapInitHeap();
@@ -249,20 +241,17 @@ void Platform_Init (INTEGER argc, LONGINT argvadr)
BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
{
- BOOLEAN _o_result;
CHAR buf[4096];
- INTEGER res;
+ INT16 res;
__DUP(var, var__len, CHAR);
- res = Platform_getenv(var, var__len, (void*)buf, ((LONGINT)(4096)));
+ res = Platform_getenv(var, var__len, (void*)buf, 4096);
if ((res > 0 && res < 4096)) {
__COPY(buf, val, val__len);
- _o_result = 1;
__DEL(var);
- return _o_result;
+ return 1;
} else {
- _o_result = 0;
__DEL(var);
- return _o_result;
+ return 0;
}
__RETCHK;
}
@@ -276,31 +265,31 @@ void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
__DEL(var);
}
-void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len)
+void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len)
{
Platform_ArgVec av = NIL;
if (n < Platform_ArgCount) {
- av = (Platform_ArgVec)(SYSTEM_ADDRESS)Platform_ArgVector;
- __COPY(*(*av)[__X(n, ((LONGINT)(1024)))], val, val__len);
+ av = (Platform_ArgVec)(ADDRESS)Platform_ArgVector;
+ __COPY(*(*av)[__X(n, 1024)], val, val__len);
}
}
-void Platform_GetIntArg (INTEGER n, LONGINT *val)
+void Platform_GetIntArg (INT16 n, INT32 *val)
{
CHAR s[64];
- LONGINT k, d, i;
+ INT32 k, d, i;
s[0] = 0x00;
- Platform_GetArg(n, (void*)s, ((LONGINT)(64)));
+ Platform_GetArg(n, (void*)s, 64);
i = 0;
if (s[0] == '-') {
i = 1;
}
k = 0;
- d = (int)s[__X(i, ((LONGINT)(64)))] - 48;
+ d = (INT16)s[__X(i, 64)] - 48;
while ((d >= 0 && d <= 9)) {
k = k * 10 + d;
i += 1;
- d = (int)s[__X(i, ((LONGINT)(64)))] - 48;
+ d = (INT16)s[__X(i, 64)] - 48;
}
if (s[0] == '-') {
k = -k;
@@ -311,52 +300,48 @@ void Platform_GetIntArg (INTEGER n, LONGINT *val)
}
}
-INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len)
+INT16 Platform_ArgPos (CHAR *s, LONGINT s__len)
{
- INTEGER _o_result;
- INTEGER i;
+ INT16 i;
CHAR arg[256];
__DUP(s, s__len, CHAR);
i = 0;
- Platform_GetArg(i, (void*)arg, ((LONGINT)(256)));
+ Platform_GetArg(i, (void*)arg, 256);
while ((i < Platform_ArgCount && __STRCMP(s, arg) != 0)) {
i += 1;
- Platform_GetArg(i, (void*)arg, ((LONGINT)(256)));
+ Platform_GetArg(i, (void*)arg, 256);
}
- _o_result = i;
__DEL(s);
- return _o_result;
+ return i;
}
void Platform_SetBadInstructionHandler (Platform_SignalHandler handler)
{
}
-static void Platform_YMDHMStoClock (INTEGER ye, INTEGER mo, INTEGER da, INTEGER ho, INTEGER mi, INTEGER se, LONGINT *t, LONGINT *d)
+static void Platform_YMDHMStoClock (INT16 ye, INT16 mo, INT16 da, INT16 ho, INT16 mi, INT16 se, INT32 *t, INT32 *d)
{
- *d = (__ASHL((int)(int)__MOD(ye, 100), 9) + __ASHL((int)(mo + 1), 5)) + (int)da;
- *t = (__ASHL((int)ho, 12) + __ASHL((int)mi, 6)) + (int)se;
+ *d = (__ASHL((int)__MOD(ye, 100), 9) + __ASHL((mo + 1), 5)) + da;
+ *t = (__ASHL(ho, 12) + __ASHL(mi, 6)) + se;
}
-void Platform_GetClock (LONGINT *t, LONGINT *d)
+void Platform_GetClock (INT32 *t, INT32 *d)
{
Platform_getLocalTime();
Platform_YMDHMStoClock(Platform_styear(), Platform_stmon(), Platform_stmday(), Platform_sthour(), Platform_stmin(), Platform_stsec(), &*t, &*d);
}
-LONGINT Platform_Time (void)
+INT32 Platform_Time (void)
{
- LONGINT _o_result;
- LONGINT ms;
+ INT32 ms;
ms = Platform_GetTickCount();
- _o_result = __MOD(ms - Platform_TimeStart, 2147483647);
- return _o_result;
+ return (int)__MOD(ms - Platform_TimeStart, 2147483647);
}
-void Platform_Delay (LONGINT ms)
+void Platform_Delay (INT32 ms)
{
while (ms > 30000) {
- Platform_sleep(((LONGINT)(30000)));
+ Platform_sleep(30000);
ms = ms - 30000;
}
if (ms > 0) {
@@ -364,7 +349,7 @@ void Platform_Delay (LONGINT ms)
}
}
-void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec)
+void Platform_GetTimeOfDay (INT32 *sec, INT32 *usec)
{
Platform_getLocalTime();
Platform_stToFt();
@@ -374,10 +359,9 @@ void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec)
*usec = Platform_uluSec();
}
-INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len)
+INT16 Platform_System (CHAR *cmd, LONGINT cmd__len)
{
- INTEGER _o_result;
- INTEGER result;
+ INT16 result;
__DUP(cmd, cmd__len, CHAR);
result = 127;
Platform_startupInfo();
@@ -388,414 +372,269 @@ INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len)
}
Platform_cleanupProcess();
}
- _o_result = __ASHL(result, 8);
__DEL(cmd);
- return _o_result;
+ return __ASHL(result, 8);
}
-INTEGER Platform_Error (void)
+INT16 Platform_Error (void)
{
- INTEGER _o_result;
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
}
-INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h)
+INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h)
{
- INTEGER _o_result;
- LONGINT fd;
+ INT32 fd;
fd = Platform_openro(n, n__len);
if (fd == Platform_invalidHandleValue()) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
*h = fd;
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h)
+INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h)
{
- INTEGER _o_result;
- LONGINT fd;
+ INT32 fd;
fd = Platform_openrw(n, n__len);
if (fd == Platform_invalidHandleValue()) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
*h = fd;
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h)
+INT16 Platform_New (CHAR *n, LONGINT n__len, INT32 *h)
{
- INTEGER _o_result;
- LONGINT fd;
+ INT32 fd;
fd = Platform_opennew(n, n__len);
if (fd == Platform_invalidHandleValue()) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
*h = fd;
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Close (LONGINT h)
+INT16 Platform_Close (INT32 h)
{
- INTEGER _o_result;
if (Platform_closeHandle(h) == 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ)
+INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *identity__typ)
{
- INTEGER _o_result;
Platform_byHandleFileInformation();
if (Platform_getFileInformationByHandle(h) == 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
}
(*identity).volume = Platform_bhfiVsn();
(*identity).indexhigh = Platform_bhfiIndexHigh();
(*identity).indexlow = Platform_bhfiIndexLow();
(*identity).mtimehigh = Platform_bhfiMtimeHigh();
(*identity).mtimelow = Platform_bhfiMtimeLow();
- _o_result = 0;
- return _o_result;
+ return 0;
}
-INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ)
+INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
{
- INTEGER _o_result;
- LONGINT h;
- INTEGER e, i;
+ INT32 h;
+ INT16 e, i;
__DUP(n, n__len, CHAR);
e = Platform_OldRO((void*)n, n__len, &h);
if (e != 0) {
- _o_result = e;
__DEL(n);
- return _o_result;
+ return e;
}
e = Platform_Identify(h, &*identity, identity__typ);
i = Platform_Close(h);
- _o_result = e;
__DEL(n);
- return _o_result;
+ return e;
}
BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2)
{
- BOOLEAN _o_result;
- _o_result = (((i1.indexhigh == i2.indexhigh && i1.indexlow == i2.indexlow)) && i1.volume == i2.volume);
- return _o_result;
+ return (((i1.indexhigh == i2.indexhigh && i1.indexlow == i2.indexlow)) && i1.volume == i2.volume);
}
BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2)
{
- BOOLEAN _o_result;
- _o_result = (i1.mtimehigh == i2.mtimehigh && i1.mtimelow == i2.mtimelow);
- return _o_result;
+ return (i1.mtimehigh == i2.mtimehigh && i1.mtimelow == i2.mtimelow);
}
-void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source)
+void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__typ, Platform_FileIdentity source)
{
(*target).mtimehigh = source.mtimehigh;
(*target).mtimelow = source.mtimelow;
}
-void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d)
+void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d)
{
Platform_identityToFileTime(i);
Platform_fileTimeToSysTime();
Platform_YMDHMStoClock(Platform_styear(), Platform_stmon(), Platform_stmday(), Platform_sthour(), Platform_stmin(), Platform_stsec(), &*t, &*d);
}
-INTEGER Platform_Size (LONGINT h, LONGINT *l)
+INT16 Platform_Size (INT32 h, INT32 *l)
{
- INTEGER _o_result;
Platform_largeInteger();
if (Platform_getFileSize(h) == 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
}
*l = Platform_liLongint();
- _o_result = 0;
- return _o_result;
+ return 0;
}
-INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n)
+INT16 Platform_Read (INT32 h, INT32 p, INT32 l, INT32 *n)
{
- INTEGER _o_result;
- INTEGER result;
- *n = 0;
- result = Platform_readfile(h, p, l, &*n);
+ INT16 result;
+ INT32 lengthread;
+ result = Platform_readfile(h, p, l, &lengthread);
if (result == 0) {
*n = 0;
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ *n = lengthread;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n)
+INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n)
{
- INTEGER _o_result;
- INTEGER result;
- *n = 0;
- result = Platform_readfile(h, (LONGINT)(SYSTEM_ADDRESS)b, b__len, &*n);
+ INT16 result;
+ INT32 lengthread;
+ result = Platform_readfile(h, (ADDRESS)b, b__len, &lengthread);
if (result == 0) {
*n = 0;
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ *n = lengthread;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l)
+INT16 Platform_Write (INT32 h, INT32 p, INT32 l)
{
- INTEGER _o_result;
- if (Platform_writefile(h, p, l) == 0) {
- _o_result = Platform_err();
- return _o_result;
+ INT32 n;
+ if (Platform_writefile(h, p, l, &n) == 0) {
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Sync (LONGINT h)
+INT16 Platform_Sync (INT32 h)
{
- INTEGER _o_result;
if (Platform_flushFileBuffers(h) == 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Seek (LONGINT h, LONGINT o, INTEGER r)
+INT16 Platform_Seek (INT32 h, INT32 o, INT16 r)
{
- INTEGER _o_result;
- INTEGER rc;
+ INT16 rc;
Platform_largeInteger();
Platform_setFilePointerEx(h, o, r, &rc);
if (rc == 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Truncate (LONGINT h, LONGINT limit)
+INT16 Platform_Truncate (INT32 h, INT32 limit)
{
- INTEGER _o_result;
- INTEGER rc;
- LONGINT oldpos;
+ INT16 rc;
+ INT32 oldpos;
Platform_largeInteger();
Platform_getFilePos(h, &oldpos, &rc);
if (rc == 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
}
Platform_setFilePointerEx(h, limit, Platform_seekset(), &rc);
if (rc == 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
}
if (Platform_setEndOfFile(h) == 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
}
Platform_setFilePointerEx(h, oldpos, Platform_seekset(), &rc);
if (rc == 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
}
- _o_result = 0;
- return _o_result;
+ return 0;
}
-INTEGER Platform_Unlink (CHAR *n, LONGINT n__len)
+INT16 Platform_Unlink (CHAR *n, LONGINT n__len)
{
- INTEGER _o_result;
if (Platform_deleteFile(n, n__len) == 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Chdir (CHAR *n, LONGINT n__len)
+INT16 Platform_Chdir (CHAR *n, LONGINT n__len)
{
- INTEGER _o_result;
- INTEGER r;
+ INT16 r;
r = Platform_setCurrentDirectory(n, n__len);
if (r == 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
}
- Platform_getCurrentDirectory((void*)Platform_CWD, ((LONGINT)(4096)));
- _o_result = 0;
- return _o_result;
+ Platform_getCurrentDirectory((void*)Platform_CWD, 4096);
+ return 0;
}
-INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len)
+INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len)
{
- INTEGER _o_result;
if (Platform_moveFile(o, o__len, n, n__len) == 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-void Platform_Exit (INTEGER code)
+void Platform_Exit (INT32 code)
{
Platform_exit(code);
}
-static void Platform_errch (CHAR c)
+static void Platform_EnableVT100 (void)
{
- Platform_errc(c);
-}
-
-static void Platform_errln (void)
-{
- Platform_errch(0x0d);
- Platform_errch(0x0a);
-}
-
-static void Platform_errposint (LONGINT l)
-{
- if (l > 10) {
- Platform_errposint(__DIV(l, 10));
- }
- Platform_errch((CHAR)(48 + __MOD(l, 10)));
-}
-
-static void Platform_errint (LONGINT l)
-{
- if (l < 0) {
- Platform_errch('-');
- l = -l;
- }
- Platform_errposint(l);
-}
-
-static void Platform_DisplayHaltCode (LONGINT code)
-{
- switch (code) {
- case -1:
- Platform_errstring((CHAR*)"Rider ReadBuf/WriteBuf transfer size longer than buffer.", (LONGINT)57);
- break;
- case -2:
- Platform_errstring((CHAR*)"Index out of range.", (LONGINT)20);
- break;
- case -3:
- Platform_errstring((CHAR*)"Reached end of function without reaching RETURN.", (LONGINT)49);
- break;
- case -4:
- Platform_errstring((CHAR*)"CASE statement: no matching label and no ELSE.", (LONGINT)47);
- break;
- case -5:
- Platform_errstring((CHAR*)"Type guard failed.", (LONGINT)19);
- break;
- case -6:
- Platform_errstring((CHAR*)"Type equality failed.", (LONGINT)22);
- break;
- case -7:
- Platform_errstring((CHAR*)"WITH statement type guard failed.", (LONGINT)34);
- break;
- case -8:
- Platform_errstring((CHAR*)"SHORT: Value too large for shorter type.", (LONGINT)41);
- break;
- case -9:
- Platform_errstring((CHAR*)"Heap interrupted while locked, but lockdepth = 0 at unlock.", (LONGINT)60);
- break;
- case -15:
- Platform_errstring((CHAR*)"Type descriptor size mismatch.", (LONGINT)31);
- break;
- case -20:
- Platform_errstring((CHAR*)"Too many, or negative number of, elements in dynamic array.", (LONGINT)60);
- break;
- default:
- break;
+ INT32 mode;
+ if (Platform_GetConsoleMode(Platform_StdOut, &mode)) {
+ Platform_SetConsoleMode(Platform_StdOut, mode + 4);
}
}
-void Platform_Halt (LONGINT code)
+BOOLEAN Platform_IsConsole (INT32 h)
{
- INTEGER e;
- Platform_HaltCode = code;
- if (Platform_HaltHandler != NIL) {
- (*Platform_HaltHandler)(code);
- }
- Platform_errstring((CHAR*)"Terminated by Halt(", (LONGINT)20);
- Platform_errint(code);
- Platform_errstring((CHAR*)"). ", (LONGINT)4);
- if (code < 0) {
- Platform_DisplayHaltCode(code);
- }
- Platform_errln();
- Platform_exit(__VAL(INTEGER, code));
-}
-
-void Platform_AssertFail (LONGINT code)
-{
- INTEGER e;
- Platform_errstring((CHAR*)"Assertion failure.", (LONGINT)19);
- if (code != 0) {
- Platform_errstring((CHAR*)" ASSERT code ", (LONGINT)14);
- Platform_errint(code);
- Platform_errstring((CHAR*)".", (LONGINT)2);
- }
- Platform_errln();
- Platform_exit(__VAL(INTEGER, code));
-}
-
-void Platform_SetHalt (Platform_HaltProcedure p)
-{
- Platform_HaltHandler = p;
+ INT32 mode;
+ return Platform_GetConsoleMode(Platform_StdOut, &mode);
}
static void Platform_TestLittleEndian (void)
{
- INTEGER i;
+ INT16 i;
i = 1;
- __GET((LONGINT)(SYSTEM_ADDRESS)&i, Platform_LittleEndian, BOOLEAN);
+ __GET((ADDRESS)&i, Platform_LittleEndian, BOOLEAN);
}
__TDESC(Platform_FileIdentity, 1, 0) = {__TDFLDS("FileIdentity", 20), {-4}};
@@ -812,7 +651,7 @@ export void *Platform__init(void)
Platform_TimeStart = 0;
Platform_TimeStart = Platform_Time();
Platform_CWD[0] = 0x00;
- Platform_getCurrentDirectory((void*)Platform_CWD, ((LONGINT)(4096)));
+ Platform_getCurrentDirectory((void*)Platform_CWD, 4096);
Platform_PID = Platform_getpid();
Platform_SeekSet = Platform_seekset();
Platform_SeekCur = Platform_seekcur();
@@ -820,8 +659,9 @@ export void *Platform__init(void)
Platform_StdIn = Platform_getstdinhandle();
Platform_StdOut = Platform_getstdouthandle();
Platform_StdErr = Platform_getstderrhandle();
- Platform_nl[0] = 0x0d;
- Platform_nl[1] = 0x0a;
- Platform_nl[2] = 0x00;
+ Platform_EnableVT100();
+ Platform_NL[0] = 0x0d;
+ Platform_NL[1] = 0x0a;
+ Platform_NL[2] = 0x00;
__ENDMOD;
}
diff --git a/bootstrap/windows-48/Platform.h b/bootstrap/windows-48/Platform.h
index 673b2b0b..f62a8ab8 100644
--- a/bootstrap/windows-48/Platform.h
+++ b/bootstrap/windows-48/Platform.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Platform__h
#define Platform__h
@@ -7,78 +7,75 @@
typedef
struct Platform_FileIdentity {
- LONGINT _prvt0;
+ INT32 _prvt0;
char _prvt1[16];
} Platform_FileIdentity;
typedef
- void (*Platform_HaltProcedure)(LONGINT);
-
-typedef
- void (*Platform_SignalHandler)(INTEGER);
+ void (*Platform_SignalHandler)(INT32);
import BOOLEAN Platform_LittleEndian;
-import LONGINT Platform_MainStackFrame, Platform_HaltCode;
-import INTEGER Platform_PID;
+import INT32 Platform_MainStackFrame;
+import INT32 Platform_HaltCode;
+import INT16 Platform_PID;
import CHAR Platform_CWD[4096];
-import INTEGER Platform_ArgCount;
-import LONGINT Platform_ArgVector;
-import INTEGER Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
-import LONGINT Platform_StdIn, Platform_StdOut, Platform_StdErr;
-import CHAR Platform_nl[3];
+import INT16 Platform_ArgCount;
+import INT32 Platform_ArgVector;
+import INT16 Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
+import INT32 Platform_StdIn, Platform_StdOut, Platform_StdErr;
+import CHAR Platform_NL[3];
-import LONGINT *Platform_FileIdentity__typ;
+import ADDRESS *Platform_FileIdentity__typ;
-import BOOLEAN Platform_Absent (INTEGER e);
-import INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len);
-import void Platform_AssertFail (LONGINT code);
-import INTEGER Platform_Chdir (CHAR *n, LONGINT n__len);
-import INTEGER Platform_Close (LONGINT h);
-import BOOLEAN Platform_ConnectionFailed (INTEGER e);
-import void Platform_Delay (LONGINT ms);
-import BOOLEAN Platform_DifferentFilesystems (INTEGER e);
-import INTEGER Platform_Error (void);
-import void Platform_Exit (INTEGER code);
-import void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len);
-import void Platform_GetClock (LONGINT *t, LONGINT *d);
+import BOOLEAN Platform_Absent (INT16 e);
+import INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
+import INT16 Platform_Chdir (CHAR *n, LONGINT n__len);
+import INT16 Platform_Close (INT32 h);
+import BOOLEAN Platform_ConnectionFailed (INT16 e);
+import void Platform_Delay (INT32 ms);
+import BOOLEAN Platform_DifferentFilesystems (INT16 e);
+import INT16 Platform_Error (void);
+import void Platform_Exit (INT32 code);
+import void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len);
+import void Platform_GetClock (INT32 *t, INT32 *d);
import void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
-import void Platform_GetIntArg (INTEGER n, LONGINT *val);
-import void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec);
-import void Platform_Halt (LONGINT code);
-import INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ);
-import INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ);
-import BOOLEAN Platform_Inaccessible (INTEGER e);
-import void Platform_Init (INTEGER argc, LONGINT argvadr);
-import void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d);
-import INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h);
-import BOOLEAN Platform_NoSuchDirectory (INTEGER e);
-import LONGINT Platform_OSAllocate (LONGINT size);
-import void Platform_OSFree (LONGINT address);
-import INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h);
-import INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h);
-import INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n);
-import INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n);
-import INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
+import 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, 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_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, 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, 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 INTEGER Platform_Seek (LONGINT h, LONGINT o, INTEGER r);
+import INT16 Platform_Seek (INT32 h, INT32 o, INT16 r);
import void Platform_SetBadInstructionHandler (Platform_SignalHandler handler);
-import void Platform_SetHalt (Platform_HaltProcedure p);
-import void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source);
-import INTEGER Platform_Size (LONGINT h, LONGINT *l);
-import INTEGER Platform_Sync (LONGINT h);
-import INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len);
-import LONGINT Platform_Time (void);
-import BOOLEAN Platform_TimedOut (INTEGER e);
-import BOOLEAN Platform_TooManyFiles (INTEGER e);
-import INTEGER Platform_Truncate (LONGINT h, LONGINT limit);
-import INTEGER Platform_Unlink (CHAR *n, LONGINT n__len);
-import INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l);
+import void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__typ, Platform_FileIdentity source);
+import INT16 Platform_Size (INT32 h, INT32 *l);
+import INT16 Platform_Sync (INT32 h);
+import INT16 Platform_System (CHAR *cmd, LONGINT cmd__len);
+import INT32 Platform_Time (void);
+import BOOLEAN Platform_TimedOut (INT16 e);
+import BOOLEAN Platform_TooManyFiles (INT16 e);
+import INT16 Platform_Truncate (INT32 h, INT32 limit);
+import INT16 Platform_Unlink (CHAR *n, LONGINT n__len);
+import INT16 Platform_Write (INT32 h, INT32 p, INT32 l);
import BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
import void *Platform__init(void);
-#define Platform_SetInterruptHandler(h) SystemSetInterruptHandler((SYSTEM_ADDRESS)h)
-#define Platform_SetQuitHandler(h) SystemSetQuitHandler((SYSTEM_ADDRESS)h)
+#define Platform_SetInterruptHandler(h) SystemSetInterruptHandler((ADDRESS)h)
+#define Platform_SetQuitHandler(h) SystemSetQuitHandler((ADDRESS)h)
-#endif
+#endif // Platform
diff --git a/bootstrap/windows-48/Reals.c b/bootstrap/windows-48/Reals.c
index 2323e34d..cd4c3c61 100644
--- a/bootstrap/windows-48/Reals.c
+++ b/bootstrap/windows-48/Reals.c
@@ -1,25 +1,30 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len);
-export void Reals_Convert (REAL x, INTEGER n, CHAR *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, INTEGER n, CHAR *d, LONGINT d__len);
-export INTEGER Reals_Expo (REAL x);
-export INTEGER Reals_ExpoL (LONGREAL x);
-export void Reals_SetExpo (REAL *x, INTEGER ex);
-export REAL Reals_Ten (INTEGER e);
-export LONGREAL Reals_TenL (INTEGER e);
-static CHAR Reals_ToHex (INTEGER i);
+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);
+export REAL Reals_Ten (INT16 e);
+export LONGREAL Reals_TenL (INT16 e);
+static CHAR Reals_ToHex (INT16 i);
-REAL Reals_Ten (INTEGER e)
+REAL Reals_Ten (INT16 e)
{
- REAL _o_result;
LONGREAL r, power;
r = (LONGREAL)1;
power = (LONGREAL)10;
@@ -30,13 +35,11 @@ REAL Reals_Ten (INTEGER e)
power = power * power;
e = __ASHR(e, 1);
}
- _o_result = r;
- return _o_result;
+ return r;
}
-LONGREAL Reals_TenL (INTEGER e)
+LONGREAL Reals_TenL (INT16 e)
{
- LONGREAL _o_result;
LONGREAL r, power;
r = (LONGREAL)1;
power = (LONGREAL)10;
@@ -46,110 +49,102 @@ LONGREAL Reals_TenL (INTEGER e)
}
e = __ASHR(e, 1);
if (e <= 0) {
- _o_result = r;
- return _o_result;
+ return r;
}
power = power * power;
}
__RETCHK;
}
-INTEGER Reals_Expo (REAL x)
+INT16 Reals_Expo (REAL x)
{
- INTEGER _o_result;
- INTEGER i;
- __GET((LONGINT)(SYSTEM_ADDRESS)&x + 2, i, INTEGER);
- _o_result = __MASK(__ASHR(i, 7), -256);
- return _o_result;
+ INT16 i;
+ __GET((ADDRESS)&x + 2, i, INT16);
+ return __MASK(__ASHR(i, 7), -256);
}
-void Reals_SetExpo (REAL *x, INTEGER ex)
+void Reals_SetExpo (REAL *x, INT16 ex)
{
CHAR c;
- __GET((LONGINT)(SYSTEM_ADDRESS)x + 3, c, CHAR);
- __PUT((LONGINT)(SYSTEM_ADDRESS)x + 3, (CHAR)(__ASHL(__ASHR((int)c, 7), 7) + __MASK(__ASHR(ex, 1), -128)), CHAR);
- __GET((LONGINT)(SYSTEM_ADDRESS)x + 2, c, CHAR);
- __PUT((LONGINT)(SYSTEM_ADDRESS)x + 2, (CHAR)(__MASK((int)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR);
+ __GET((ADDRESS)x + 3, c, 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, (CHAR)(__MASK((INT16)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR);
}
-INTEGER Reals_ExpoL (LONGREAL x)
+INT16 Reals_ExpoL (LONGREAL x)
{
- INTEGER _o_result;
- INTEGER i;
- __GET((LONGINT)(SYSTEM_ADDRESS)&x + 6, i, INTEGER);
- _o_result = __MASK(__ASHR(i, 4), -2048);
- return _o_result;
+ INT16 i;
+ __GET((ADDRESS)&x + 6, i, INT16);
+ return __MASK(__ASHR(i, 4), -2048);
}
-void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len)
+void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len)
{
- LONGINT i, j, k;
+ INT32 i, j, k;
if (x < (LONGREAL)0) {
x = -x;
}
k = 0;
if (n > 9) {
- i = (int)__ENTIER(x / (LONGREAL)(LONGREAL)1000000000);
- j = (int)__ENTIER(x - i * (LONGREAL)1000000000);
+ 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)] = (CHAR)(__MOD(j, 10) + 48);
+ d[__X(k, d__len)] = (CHAR)((int)__MOD(j, 10) + 48);
j = __DIV(j, 10);
k += 1;
}
} else {
- i = (int)__ENTIER(x);
+ i = (INT32)__ENTIER(x);
}
- while (k < (int)n) {
- d[__X(k, d__len)] = (CHAR)(__MOD(i, 10) + 48);
+ while (k < n) {
+ d[__X(k, d__len)] = (CHAR)((int)__MOD(i, 10) + 48);
i = __DIV(i, 10);
k += 1;
}
}
-void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len)
+void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len)
{
Reals_ConvertL(x, n, (void*)d, d__len);
}
-static CHAR Reals_ToHex (INTEGER i)
+static CHAR Reals_ToHex (INT16 i)
{
- CHAR _o_result;
if (i < 10) {
- _o_result = (CHAR)(i + 48);
- return _o_result;
+ return (CHAR)(i + 48);
} else {
- _o_result = (CHAR)(i + 55);
- return _o_result;
+ return (CHAR)(i + 55);
}
__RETCHK;
}
static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len)
{
- INTEGER i;
- LONGINT l;
+ INT16 i;
+ INT32 l;
CHAR by;
i = 0;
l = b__len;
- while ((int)i < l) {
+ while (i < l) {
by = __VAL(CHAR, b[__X(i, b__len)]);
- d[__X(__ASHL(i, 1), d__len)] = Reals_ToHex(__ASHR((int)by, 4));
- d[__X(__ASHL(i, 1) + 1, d__len)] = Reals_ToHex(__MASK((int)by, -16));
+ d[__X(__ASHL(i, 1), d__len)] = Reals_ToHex(__ASHR((INT16)by, 4));
+ d[__X(__ASHL(i, 1) + 1, d__len)] = Reals_ToHex(__MASK((INT16)by, -16));
i += 1;
}
}
void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len)
{
- Reals_BytesToHex((void*)&y, ((LONGINT)(4)), (void*)d, d__len * ((LONGINT)(1)));
+ Reals_BytesToHex((void*)&y, 4, (void*)d, d__len * 1);
}
void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len)
{
- Reals_BytesToHex((void*)&x, ((LONGINT)(8)), (void*)d, d__len * ((LONGINT)(1)));
+ Reals_BytesToHex((void*)&x, 8, (void*)d, d__len * 1);
}
diff --git a/bootstrap/windows-48/Reals.h b/bootstrap/windows-48/Reals.h
index 7e6b534c..f0c84ab1 100644
--- a/bootstrap/windows-48/Reals.h
+++ b/bootstrap/windows-48/Reals.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Reals__h
#define Reals__h
@@ -8,16 +8,16 @@
-import void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT 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, INTEGER n, CHAR *d, LONGINT d__len);
-import INTEGER Reals_Expo (REAL x);
-import INTEGER Reals_ExpoL (LONGREAL x);
-import void Reals_SetExpo (REAL *x, INTEGER ex);
-import REAL Reals_Ten (INTEGER e);
-import LONGREAL Reals_TenL (INTEGER e);
+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);
+import REAL Reals_Ten (INT16 e);
+import LONGREAL Reals_TenL (INT16 e);
import void *Reals__init(void);
-#endif
+#endif // Reals
diff --git a/bootstrap/windows-48/SYSTEM.h b/bootstrap/windows-48/SYSTEM.h
deleted file mode 100644
index 6377745e..00000000
--- a/bootstrap/windows-48/SYSTEM.h
+++ /dev/null
@@ -1,295 +0,0 @@
-#ifndef SYSTEM__h
-#define SYSTEM__h
-
-#if defined(_WIN64)
- typedef long long SYSTEM_INT64;
- typedef unsigned long long SYSTEM_CARD64;
-#else
- typedef long SYSTEM_INT64;
- typedef unsigned long SYSTEM_CARD64;
-#endif
-
-typedef int SYSTEM_INT32;
-typedef unsigned int SYSTEM_CARD32;
-typedef short int SYSTEM_INT16;
-typedef unsigned short int SYSTEM_CARD16;
-typedef signed char SYSTEM_INT8;
-typedef unsigned char SYSTEM_CARD8;
-
-#if (__SIZEOF_POINTER__ == 8) || defined(_WIN64) || defined(__LP64__)
- #if defined(_WIN64)
- typedef unsigned long long size_t;
- #else
- typedef unsigned long size_t;
- #endif
-#else
- typedef unsigned int size_t;
-#endif
-
-#define SYSTEM_ADDRESS size_t
-#define _SIZE_T_DECLARED // For FreeBSD
-#define _SIZE_T_DEFINED_ // For OpenBSD
-
-void *memcpy(void *dest, const void *source, SYSTEM_ADDRESS size);
-
-
-
-// The compiler uses 'import' and 'export' which translate to 'extern' and
-// nothing respectively.
-
-#define import extern
-#define export
-
-
-
-// Known constants
-
-#define NIL ((void*)0)
-#define __MAXEXT 16
-#define POINTER__typ ((LONGINT*)(1)) // not NIL and not a valid type
-
-
-// Oberon types
-
-typedef char BOOLEAN;
-typedef unsigned char SYSTEM_BYTE;
-typedef unsigned char CHAR;
-typedef signed char SHORTINT;
-typedef float REAL;
-typedef double LONGREAL;
-typedef void* SYSTEM_PTR;
-
-// Unsigned variants are for use by shift and rotate macros.
-
-typedef unsigned char U_SYSTEM_BYTE;
-typedef unsigned char U_CHAR;
-typedef unsigned char U_SHORTINT;
-
-// For 32 bit builds, the size of LONGINT depends on a make option:
-
-#if (__SIZEOF_POINTER__ == 8) || defined(LARGE) || defined(_WIN64)
- typedef int INTEGER; // INTEGER is 32 bit.
- typedef long long LONGINT; // LONGINT is 64 bit. (long long is always 64 bits, while long can be 32 bits e.g. under MSC/MingW)
- typedef unsigned int U_INTEGER;
- typedef unsigned long long U_LONGINT;
-#else
- typedef short int INTEGER; // INTEGER is 16 bit.
- typedef long LONGINT; // LONGINT is 32 bit.
- typedef unsigned short int U_INTEGER;
- typedef unsigned long U_LONGINT;
-#endif
-
-typedef U_LONGINT SET;
-typedef U_LONGINT U_SET;
-
-
-// OS Memory allocation interfaces are in PlatformXXX.Mod
-
-extern LONGINT Platform_OSAllocate (LONGINT size);
-extern void Platform_OSFree (LONGINT addr);
-
-
-// Run time system routines in SYSTEM.c
-
-extern LONGINT SYSTEM_XCHK (LONGINT i, LONGINT ub);
-extern LONGINT SYSTEM_RCHK (LONGINT i, LONGINT ub);
-extern LONGINT SYSTEM_ASH (LONGINT i, LONGINT n);
-extern LONGINT SYSTEM_ABS (LONGINT i);
-extern double SYSTEM_ABSD (double i);
-extern void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0);
-extern void SYSTEM_ENUMP (void *adr, LONGINT n, void (*P)());
-extern void SYSTEM_ENUMR (void *adr, LONGINT *typ, LONGINT size, LONGINT n, void (*P)());
-extern LONGINT SYSTEM_DIV (U_LONGINT x, U_LONGINT y);
-extern LONGINT SYSTEM_MOD (U_LONGINT x, U_LONGINT y);
-extern LONGINT SYSTEM_ENTIER (double x);
-
-
-// Signal handling in SYSTEM.c
-
-#ifndef _WIN32
- extern void SystemSetHandler(int s, SYSTEM_ADDRESS h);
-#else
- extern void SystemSetInterruptHandler(SYSTEM_ADDRESS h);
- extern void SystemSetQuitHandler (SYSTEM_ADDRESS h);
-#endif
-
-
-
-// String comparison
-
-static int __str_cmp(CHAR *x, CHAR *y){
- LONGINT i = 0;
- CHAR ch1, ch2;
- do {ch1 = x[i]; ch2 = y[i]; i++;
- if (!ch1) return -(int)ch2;
- } while (ch1==ch2);
- return (int)ch1 - (int)ch2;
-}
-#define __STRCMP(a,b) __str_cmp((CHAR*)(a), (CHAR*)(b))
-
-
-
-// Inline string, record and array copy
-
-#define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d; LONGINT _i=0,_t=n-1; \
- while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;}
-#define __DUP(x, l, t) x=(void*)memcpy((void*)(SYSTEM_ADDRESS)Platform_OSAllocate(l*sizeof(t)),x,l*sizeof(t))
-#define __DUPARR(v, t) v=(void*)memcpy(v##__copy,v,sizeof(t))
-#define __DEL(x) Platform_OSFree((LONGINT)(SYSTEM_ADDRESS)x)
-
-
-
-
-/* SYSTEM ops */
-
-#define __VAL(t, x) (*(t*)&(x))
-
-
-#define __GET(a, x, t) x= *(t*)(SYSTEM_ADDRESS)(a)
-#define __PUT(a, x, t) *(t*)(SYSTEM_ADDRESS)(a)=x
-
-#define __LSHL(x, n, t) ((t)((U_##t)(x)<<(n)))
-#define __LSHR(x, n, t) ((t)((U_##t)(x)>>(n)))
-#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t))
-
-#define __ASHL(x, n) ((LONGINT)(x)<<(n))
-#define __ASHR(x, n) ((LONGINT)(x)>>(n))
-#define __ASH(x, n) ((n)>=0?__ASHL(x,n):__ASHR(x,-(n)))
-
-#define __ROTL(x, n, t) ((t)((U_##t)(x)<<(n)|(U_##t)(x)>>(8*sizeof(t)-(n))))
-#define __ROTR(x, n, t) ((t)((U_##t)(x)>>(n)|(U_##t)(x)<<(8*sizeof(t)-(n))))
-#define __ROT(x, n, t) ((n)>=0? __ROTL(x, n, t): __ROTR(x, -(n), t))
-
-#define __BIT(x, n) (*(U_LONGINT*)(x)>>(n)&1)
-#define __MOVE(s, d, n) memcpy((char*)(SYSTEM_ADDRESS)(d),(char*)(SYSTEM_ADDRESS)(s),n)
-#define __ASHF(x, n) SYSTEM_ASH((LONGINT)(x), (LONGINT)(n))
-#define __SHORT(x, y) ((int)((U_LONGINT)(x)+(y)<(y)+(y)?(x):(__HALT(-8),0)))
-#define __SHORTF(x, y) ((int)(__RF((x)+(y),(y)+(y))-(y)))
-#define __CHR(x) ((CHAR)__R(x, 256))
-#define __CHRF(x) ((CHAR)__RF(x, 256))
-#define __DIV(x, y) ((x)>=0?(x)/(y):-(((y)-1-(x))/(y)))
-#define __DIVF(x, y) SYSTEM_DIV((LONGINT)(x),(LONGINT)(y))
-#define __MOD(x, y) ((x)>=0?(x)%(y):__MODF(x,y))
-#define __MODF(x, y) SYSTEM_MOD((LONGINT)(x),(LONGINT)(y))
-#define __ENTIER(x) SYSTEM_ENTIER(x)
-#define __ABS(x) (((x)<0)?-(x):(x))
-#define __ABSF(x) SYSTEM_ABS((LONGINT)(x))
-#define __ABSFD(x) SYSTEM_ABSD((double)(x))
-#define __CAP(ch) ((CHAR)((ch)&0x5f))
-#define __ODD(x) ((x)&1)
-#define __IN(x, s) (((s)>>(x))&1)
-#define __SETOF(x) ((SET)1<<(x))
-#define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h)))
-#define __MASK(x, m) ((x)&~(m))
-
-
-
-// Runtime checks
-
-#define __X(i, ub) (((U_LONGINT)(i)<(U_LONGINT)(ub))?i:(__HALT(-2),0))
-#define __XF(i, ub) SYSTEM_XCHK((LONGINT)(i), (LONGINT)(ub))
-#define __R(i, ub) (((U_LONGINT)(i)<(U_LONGINT)(ub))?i:(__HALT(-8),0))
-#define __RF(i, ub) SYSTEM_RCHK((LONGINT)(i),(LONGINT)(ub))
-#define __RETCHK __retchk: __HALT(-3); return 0;
-#define __CASECHK __HALT(-4)
-#define __WITHCHK __HALT(-7)
-
-#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p)))
-#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r))))
-#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p)))
-#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p)
-#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p)
-
-
-
-// Module entry/registration/exit
-
-extern void Heap_REGCMD();
-extern SYSTEM_PTR Heap_REGMOD();
-extern void Heap_REGTYP();
-extern void Heap_INCREF();
-
-#define __DEFMOD static void *m; if (m!=0) {return m;}
-#define __REGCMD(name, cmd) Heap_REGCMD(m, (CHAR*)name, cmd)
-#define __REGMOD(name, enum) if (m==0) {m = Heap_REGMOD((CHAR*)name,enum);}
-#define __ENDMOD return m
-#define __MODULE_IMPORT(name) Heap_INCREF(name##__init())
-
-
-
-// Main module initialisation, registration and finalisation
-
-extern void Platform_Init(INTEGER argc, LONGINT argv);
-extern void Heap_FINALL();
-
-#define __INIT(argc, argv) static void *m; Platform_Init((INTEGER)argc, (LONGINT)(SYSTEM_ADDRESS)&argv);
-#define __REGMAIN(name, enum) m = Heap_REGMOD((CHAR*)name,enum)
-#define __FINI Heap_FINALL(); return 0
-
-
-// Assertions and Halts
-
-extern void Platform_Halt(LONGINT x);
-extern void Platform_AssertFail(LONGINT x);
-
-#define __HALT(x) Platform_Halt(x)
-#define __ASSERT(cond, x) if (!(cond)) Platform_AssertFail((LONGINT)(x))
-
-
-// Memory allocation
-
-extern SYSTEM_PTR Heap_NEWBLK (LONGINT size);
-extern SYSTEM_PTR Heap_NEWREC (LONGINT tag);
-extern SYSTEM_PTR SYSTEM_NEWARR(LONGINT*, LONGINT, int, int, int, ...);
-
-#define __SYSNEW(p, len) p = Heap_NEWBLK((LONGINT)(len))
-#define __NEW(p, t) p = Heap_NEWREC((LONGINT)(SYSTEM_ADDRESS)t##__typ)
-#define __NEWARR SYSTEM_NEWARR
-
-
-
-/* Type handling */
-
-#define __TDESC(t, m, n) \
- static struct t##__desc { \
- LONGINT tproc[m]; /* Proc for each ptr field */ \
- LONGINT tag; \
- LONGINT next; /* Module table type list points here */ \
- LONGINT level; \
- LONGINT module; \
- char name[24]; \
- LONGINT basep[__MAXEXT]; /* List of bases this extends */ \
- LONGINT reserved; \
- LONGINT blksz; /* xxx_typ points here */ \
- LONGINT ptr[n+1]; /* Offsets of ptrs up to -ve sentinel */ \
- } t##__desc
-
-#define __BASEOFF (__MAXEXT+1) // blksz as index to base.
-#define __TPROC0OFF (__BASEOFF+24/sizeof(LONGINT)+5) // blksz as index to tproc IFF m=1.
-#define __EOM 1
-#define __TDFLDS(name, size) {__EOM}, 1, 0, 0, 0, name, {0}, 0, size
-#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (LONGINT)(n), P)
-#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (LONGINT)(size), (LONGINT)(n), P)
-
-#define __INITYP(t, t0, level) \
- t##__typ = (LONGINT*)&t##__desc.blksz; \
- memcpy(t##__desc.basep, t0##__typ - __BASEOFF, level*sizeof(LONGINT)); \
- t##__desc.basep[level] = (LONGINT)(SYSTEM_ADDRESS)t##__typ; \
- t##__desc.module = (LONGINT)(SYSTEM_ADDRESS)m; \
- if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \
- t##__desc.blksz = (t##__desc.blksz+5*sizeof(LONGINT)-1)/(4*sizeof(LONGINT))*(4*sizeof(LONGINT)); \
- Heap_REGTYP(m, (LONGINT)(SYSTEM_ADDRESS)&t##__desc.next); \
- SYSTEM_INHERIT(t##__typ, t0##__typ)
-
-#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(LONGINT)(SYSTEM_ADDRESS)typ##__typ)
-#define __TYPEOF(p) ((LONGINT*)(SYSTEM_ADDRESS)(*(((LONGINT*)(p))-1)))
-#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level)
-
-// Oberon-2 type bound procedures support
-#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(LONGINT)(SYSTEM_ADDRESS)proc
-#define __SEND(typ, num, funtyp, parlist) ((funtyp)((SYSTEM_ADDRESS)*(typ-(__TPROC0OFF+num))))parlist
-
-
-
-
-#endif
diff --git a/bootstrap/windows-48/Strings.c b/bootstrap/windows-48/Strings.c
index 115456ea..b5707327 100644
--- a/bootstrap/windows-48/Strings.c
+++ b/bootstrap/windows-48/Strings.c
@@ -1,4 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
@@ -6,49 +12,53 @@
export void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len);
export void Strings_Cap (CHAR *s, LONGINT s__len);
-export void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n);
-export void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len);
-export void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len);
-export INTEGER Strings_Length (CHAR *s, LONGINT s__len);
+export 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 INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos);
-export void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len);
+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);
-INTEGER Strings_Length (CHAR *s, LONGINT s__len)
+INT16 Strings_Length (CHAR *s, LONGINT s__len)
{
- INTEGER _o_result;
- INTEGER i;
+ INT32 i;
__DUP(s, s__len, CHAR);
i = 0;
- while (((int)i < s__len && s[__X(i, s__len)] != 0x00)) {
+ while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
i += 1;
}
- _o_result = i;
- __DEL(s);
- return _o_result;
+ if (i <= 32767) {
+ __DEL(s);
+ return (INT16)i;
+ } else {
+ __DEL(s);
+ return 32767;
+ }
+ __RETCHK;
}
void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len)
{
- INTEGER n1, n2, i;
+ INT16 n1, n2, i;
__DUP(extra, extra__len, CHAR);
n1 = Strings_Length(dest, dest__len);
n2 = Strings_Length(extra, extra__len);
i = 0;
- while ((i < n2 && (int)(i + n1) < dest__len)) {
+ while ((i < n2 && (i + n1) < dest__len)) {
dest[__X(i + n1, dest__len)] = extra[__X(i, extra__len)];
i += 1;
}
- if ((int)(i + n1) < dest__len) {
+ if ((i + n1) < dest__len) {
dest[__X(i + n1, dest__len)] = 0x00;
}
__DEL(extra);
}
-void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len)
+void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len)
{
- INTEGER n1, n2, i;
+ INT16 n1, n2, i;
__DUP(source, source__len, CHAR);
n1 = Strings_Length(dest, dest__len);
n2 = Strings_Length(source, source__len);
@@ -57,12 +67,13 @@ void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest,
}
if (pos > n1) {
Strings_Append(dest, dest__len, (void*)source, source__len);
+ __DEL(source);
return;
}
- if ((int)(pos + n2) < dest__len) {
+ if ((pos + n2) < dest__len) {
i = n1;
while (i >= pos) {
- if ((int)(i + n2) < dest__len) {
+ if ((i + n2) < dest__len) {
dest[__X(i + n2, dest__len)] = dest[__X(i, dest__len)];
}
i -= 1;
@@ -76,9 +87,9 @@ void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest,
__DEL(source);
}
-void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n)
+void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n)
{
- INTEGER len, i;
+ INT16 len, i;
len = Strings_Length(s, s__len);
if (pos < 0) {
pos = 0;
@@ -91,7 +102,7 @@ void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n)
s[__X(i - n, s__len)] = s[__X(i, s__len)];
i += 1;
}
- if ((int)(i - n) < s__len) {
+ if ((i - n) < s__len) {
s[__X(i - n, s__len)] = 0x00;
}
} else {
@@ -99,7 +110,7 @@ void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n)
}
}
-void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT 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));
@@ -107,21 +118,22 @@ void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest
__DEL(source);
}
-void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len)
+void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len)
{
- INTEGER len, destLen, i;
+ INT16 len, destLen, i;
__DUP(source, source__len, CHAR);
len = Strings_Length(source, source__len);
- destLen = (int)dest__len - 1;
+ destLen = (INT16)dest__len - 1;
if (pos < 0) {
pos = 0;
}
if (pos >= len) {
dest[0] = 0x00;
+ __DEL(source);
return;
}
i = 0;
- while (((((int)(pos + i) <= source__len && source[__X(pos + i, source__len)] != 0x00)) && i < n)) {
+ while (((((pos + i) <= source__len && source[__X(pos + i, source__len)] != 0x00)) && i < n)) {
if (i < destLen) {
dest[__X(i, dest__len)] = source[__X(pos + i, source__len)];
}
@@ -131,19 +143,17 @@ void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n,
__DEL(source);
}
-INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos)
+INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos)
{
- INTEGER _o_result;
- INTEGER n1, n2, i, j;
+ INT16 n1, n2, i, j;
__DUP(pattern, pattern__len, CHAR);
__DUP(s, s__len, CHAR);
n1 = Strings_Length(s, s__len);
n2 = Strings_Length(pattern, pattern__len);
if (n2 == 0) {
- _o_result = 0;
__DEL(pattern);
__DEL(s);
- return _o_result;
+ return 0;
}
i = pos;
while (i <= n1 - n2) {
@@ -153,23 +163,21 @@ INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__le
j += 1;
}
if (j == n2) {
- _o_result = i;
__DEL(pattern);
__DEL(s);
- return _o_result;
+ return i;
}
}
i += 1;
}
- _o_result = -1;
__DEL(pattern);
__DEL(s);
- return _o_result;
+ return -1;
}
void Strings_Cap (CHAR *s, LONGINT s__len)
{
- INTEGER i;
+ INT16 i;
i = 0;
while (s[__X(i, s__len)] != 0x00) {
if (('a' <= s[__X(i, s__len)] && s[__X(i, s__len)] <= 'z')) {
@@ -183,54 +191,49 @@ static struct Match__7 {
struct Match__7 *lnk;
} *Match__7_s;
-static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INTEGER n, INTEGER m);
+static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INT16 n, INT16 m);
-static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INTEGER n, INTEGER m)
+static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INT16 n, INT16 m)
{
- BOOLEAN _o_result;
while ((((n >= 0 && m >= 0)) && mask[__X(m, mask__len)] != '*')) {
if (name[__X(n, name__len)] != mask[__X(m, mask__len)]) {
- _o_result = 0;
- return _o_result;
+ return 0;
}
n -= 1;
m -= 1;
}
if (m < 0) {
- _o_result = n < 0;
- return _o_result;
+ return n < 0;
}
while ((m >= 0 && mask[__X(m, mask__len)] == '*')) {
m -= 1;
}
if (m < 0) {
- _o_result = 1;
- return _o_result;
+ return 1;
}
while (n >= 0) {
if (M__8(name, name__len, mask, mask__len, n, m)) {
- _o_result = 1;
- return _o_result;
+ return 1;
}
n -= 1;
}
- _o_result = 0;
- return _o_result;
+ return 0;
}
BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len)
{
- BOOLEAN _o_result;
struct Match__7 _s;
+ BOOLEAN __retval;
__DUP(string, string__len, CHAR);
__DUP(pattern, pattern__len, CHAR);
_s.lnk = Match__7_s;
Match__7_s = &_s;
- _o_result = M__8((void*)string, string__len, (void*)pattern, pattern__len, Strings_Length(string, string__len) - 1, Strings_Length(pattern, pattern__len) - 1);
+ __retval = M__8((void*)string, string__len, (void*)pattern, pattern__len, Strings_Length(string, string__len) - 1, Strings_Length(pattern, pattern__len) - 1);
Match__7_s = _s.lnk;
__DEL(string);
__DEL(pattern);
- return _o_result;
+ ;
+ return __retval;
}
diff --git a/bootstrap/windows-48/Strings.h b/bootstrap/windows-48/Strings.h
index 96dbb01d..c987af8d 100644
--- a/bootstrap/windows-48/Strings.h
+++ b/bootstrap/windows-48/Strings.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Strings__h
#define Strings__h
@@ -10,14 +10,14 @@
import void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len);
import void Strings_Cap (CHAR *s, LONGINT s__len);
-import void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n);
-import void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len);
-import void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len);
-import INTEGER Strings_Length (CHAR *s, LONGINT s__len);
+import 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 INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos);
-import void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len);
+import 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);
-#endif
+#endif // Strings
diff --git a/bootstrap/windows-48/Texts.c b/bootstrap/windows-48/Texts.c
index cfe34ca7..ad26b1cb 100644
--- a/bootstrap/windows-48/Texts.c
+++ b/bootstrap/windows-48/Texts.c
@@ -1,4 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "Files.h"
#include "Modules.h"
@@ -13,9 +19,9 @@ typedef
typedef
struct Texts_RunDesc {
Texts_Run prev, next;
- LONGINT len;
+ INT32 len;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
BOOLEAN ascii;
} Texts_RunDesc;
@@ -28,7 +34,7 @@ typedef
} Texts_ElemMsg;
typedef
- void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, LONGINT *);
+ void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, ADDRESS *);
typedef
struct Texts_TextDesc *Texts_Text;
@@ -36,26 +42,26 @@ typedef
typedef
struct Texts_ElemDesc {
Texts_Run prev, next;
- LONGINT len;
+ INT32 len;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
BOOLEAN ascii;
- LONGINT W, H;
+ INT32 W, H;
Texts_Handler handle;
Texts_Text base;
} Texts_ElemDesc;
struct Texts__1 { /* Texts_ElemDesc */
Texts_Run prev, next;
- LONGINT len;
+ INT32 len;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
BOOLEAN ascii;
- LONGINT W, H;
+ INT32 W, H;
Texts_Handler handle;
Texts_Text base;
Files_File file;
- LONGINT org, span;
+ INT32 org, span;
CHAR mod[32], proc[32];
};
@@ -64,7 +70,7 @@ typedef
typedef
struct Texts_BufDesc {
- LONGINT len;
+ INT32 len;
Texts_Run head;
} Texts_BufDesc;
@@ -78,8 +84,8 @@ typedef
typedef
struct Texts_FileMsg { /* Texts_ElemMsg */
- INTEGER id;
- LONGINT pos;
+ INT16 id;
+ INT32 pos;
Files_Rider r;
} Texts_FileMsg;
@@ -94,7 +100,7 @@ typedef
} Texts_IdentifyMsg;
typedef
- void (*Texts_Notifier)(Texts_Text, INTEGER, LONGINT, LONGINT);
+ void (*Texts_Notifier)(Texts_Text, INT16, INT32, INT32);
typedef
struct Texts_PieceDesc *Texts_Piece;
@@ -102,57 +108,57 @@ typedef
typedef
struct Texts_PieceDesc {
Texts_Run prev, next;
- LONGINT len;
+ INT32 len;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
BOOLEAN ascii;
Files_File file;
- LONGINT org;
+ INT32 org;
} Texts_PieceDesc;
typedef
struct Texts_Reader {
BOOLEAN eot;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
Texts_Elem elem;
Files_Rider rider;
Texts_Run run;
- LONGINT org, off;
+ INT32 org, off;
} Texts_Reader;
typedef
struct Texts_Scanner { /* Texts_Reader */
BOOLEAN eot;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
Texts_Elem elem;
Files_Rider rider;
Texts_Run run;
- LONGINT org, off;
+ INT32 org, off;
CHAR nextCh;
- INTEGER line, class;
- LONGINT i;
+ INT16 line, class;
+ INT32 i;
REAL x;
LONGREAL y;
CHAR c;
- SHORTINT len;
+ INT8 len;
CHAR s[64];
} Texts_Scanner;
typedef
struct Texts_TextDesc {
- LONGINT len;
+ INT32 len;
Texts_Notifier notify;
Texts_Run head, cache;
- LONGINT corg;
+ INT32 corg;
} Texts_TextDesc;
typedef
struct Texts_Writer {
Texts_Buffer buf;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
Files_Rider rider;
Files_File file;
} Texts_Writer;
@@ -162,84 +168,82 @@ export Texts_Elem Texts_new;
static Texts_Buffer Texts_del;
static Texts_FontsFont Texts_FontsDefault;
-export LONGINT *Texts_FontDesc__typ;
-export LONGINT *Texts_RunDesc__typ;
-export LONGINT *Texts_PieceDesc__typ;
-export LONGINT *Texts_ElemMsg__typ;
-export LONGINT *Texts_ElemDesc__typ;
-export LONGINT *Texts_FileMsg__typ;
-export LONGINT *Texts_CopyMsg__typ;
-export LONGINT *Texts_IdentifyMsg__typ;
-export LONGINT *Texts_BufDesc__typ;
-export LONGINT *Texts_TextDesc__typ;
-export LONGINT *Texts_Reader__typ;
-export LONGINT *Texts_Scanner__typ;
-export LONGINT *Texts_Writer__typ;
-export LONGINT *Texts__1__typ;
+export ADDRESS *Texts_FontDesc__typ;
+export ADDRESS *Texts_RunDesc__typ;
+export ADDRESS *Texts_PieceDesc__typ;
+export ADDRESS *Texts_ElemMsg__typ;
+export ADDRESS *Texts_ElemDesc__typ;
+export ADDRESS *Texts_FileMsg__typ;
+export ADDRESS *Texts_CopyMsg__typ;
+export ADDRESS *Texts_IdentifyMsg__typ;
+export ADDRESS *Texts_BufDesc__typ;
+export ADDRESS *Texts_TextDesc__typ;
+export ADDRESS *Texts_Reader__typ;
+export ADDRESS *Texts_Scanner__typ;
+export ADDRESS *Texts_Writer__typ;
+export ADDRESS *Texts__1__typ;
export void Texts_Append (Texts_Text T, Texts_Buffer B);
-export void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff);
+export void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff);
static Texts_Elem Texts_CloneElem (Texts_Elem e);
static Texts_Piece Texts_ClonePiece (Texts_Piece p);
export void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
export void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
export void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
-export void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end);
+export void Texts_Delete (Texts_Text T, INT32 beg, INT32 end);
export Texts_Text Texts_ElemBase (Texts_Elem E);
-export LONGINT Texts_ElemPos (Texts_Elem E);
-static void Texts_Find (Texts_Text T, LONGINT *pos, Texts_Run *u, LONGINT *org, LONGINT *off);
+export INT32 Texts_ElemPos (Texts_Elem E);
+static void Texts_Find (Texts_Text T, INT32 *pos, Texts_Run *u, INT32 *org, INT32 *off);
static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len);
-static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, LONGINT *msg__typ);
-export void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B);
-export void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T);
-static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T);
+static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, ADDRESS *msg__typ);
+export void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B);
+export void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
+static void Texts_Load0 (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
static void Texts_Merge (Texts_Text T, Texts_Run u, Texts_Run *v);
export void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
export void Texts_OpenBuf (Texts_Buffer B);
-export void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos);
-export void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos);
-export void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ);
-export LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ);
-export void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch);
-export void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ);
-export void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ);
+export void Texts_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);
+export void Texts_OpenWriter (Texts_Writer *W, ADDRESS *W__typ);
+export INT32 Texts_Pos (Texts_Reader *R, ADDRESS *R__typ);
+export void Texts_Read (Texts_Reader *R, ADDRESS *R__typ, CHAR *ch);
+export void Texts_ReadElem (Texts_Reader *R, ADDRESS *R__typ);
+export void Texts_ReadPrevElem (Texts_Reader *R, ADDRESS *R__typ);
export void Texts_Recall (Texts_Buffer *B);
-export void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B);
-export void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ);
-export void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col);
-export void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt);
-export void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff);
+export void Texts_Save (Texts_Text T, INT32 beg, INT32 end, Texts_Buffer B);
+export void Texts_Scan (Texts_Scanner *S, ADDRESS *S__typ);
+export void Texts_SetColor (Texts_Writer *W, ADDRESS *W__typ, INT8 col);
+export void Texts_SetFont (Texts_Writer *W, ADDRESS *W__typ, Texts_FontsFont fnt);
+export void Texts_SetOffset (Texts_Writer *W, ADDRESS *W__typ, INT8 voff);
static void Texts_Splice (Texts_Run un, Texts_Run v, Texts_Run w, Texts_Text base);
-static void Texts_Split (LONGINT off, Texts_Run *u, Texts_Run *un);
-export void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T);
-export void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch);
-export void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d);
-export void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e);
-export void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x);
-export void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n);
-export void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ);
-export void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n);
-export void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x);
-export void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n);
-export void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k);
-export void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x);
-export void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len);
+static void Texts_Split (INT32 off, Texts_Run *u, Texts_Run *un);
+export void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
+export void Texts_Write (Texts_Writer *W, ADDRESS *W__typ, CHAR ch);
+export void Texts_WriteDate (Texts_Writer *W, ADDRESS *W__typ, INT32 t, INT32 d);
+export void Texts_WriteElem (Texts_Writer *W, ADDRESS *W__typ, Texts_Elem e);
+export void Texts_WriteHex (Texts_Writer *W, ADDRESS *W__typ, INT32 x);
+export void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n);
+export void Texts_WriteLn (Texts_Writer *W, ADDRESS *W__typ);
+export void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n);
+export void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x);
+export void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n);
+export void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k);
+export void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x);
+export void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len)
{
- Texts_FontsFont _o_result;
Texts_FontsFont F = NIL;
__NEW(F, Texts_FontDesc);
- __COPY(name, F->name, ((LONGINT)(32)));
- _o_result = F;
- return _o_result;
+ __COPY(name, F->name, 32);
+ return F;
}
-static void Texts_Find (Texts_Text T, LONGINT *pos, Texts_Run *u, LONGINT *org, LONGINT *off)
+static void Texts_Find (Texts_Text T, INT32 *pos, Texts_Run *u, INT32 *org, INT32 *off)
{
Texts_Run v = NIL;
- LONGINT m;
+ INT32 m;
if (*pos >= T->len) {
*pos = T->len;
*u = T->head;
@@ -269,7 +273,7 @@ static void Texts_Find (Texts_Text T, LONGINT *pos, Texts_Run *u, LONGINT *org,
}
}
-static void Texts_Split (LONGINT off, Texts_Run *u, Texts_Run *un)
+static void Texts_Split (INT32 off, Texts_Run *u, Texts_Run *un)
{
Texts_Piece p = NIL, U = NIL;
if (off == 0) {
@@ -332,22 +336,18 @@ static void Texts_Splice (Texts_Run un, Texts_Run v, Texts_Run w, Texts_Text bas
static Texts_Piece Texts_ClonePiece (Texts_Piece p)
{
- Texts_Piece _o_result;
Texts_Piece q = NIL;
__NEW(q, Texts_PieceDesc);
__GUARDEQP(q, Texts_PieceDesc) = *p;
- _o_result = q;
- return _o_result;
+ return q;
}
static Texts_Elem Texts_CloneElem (Texts_Elem e)
{
- Texts_Elem _o_result;
Texts_CopyMsg msg;
msg.e = NIL;
(*e->handle)(e, (void*)&msg, Texts_CopyMsg__typ);
- _o_result = msg.e;
- return _o_result;
+ return msg.e;
}
void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE)
@@ -363,31 +363,27 @@ void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE)
Texts_Text Texts_ElemBase (Texts_Elem E)
{
- Texts_Text _o_result;
- _o_result = E->base;
- return _o_result;
+ return E->base;
}
-LONGINT Texts_ElemPos (Texts_Elem E)
+INT32 Texts_ElemPos (Texts_Elem E)
{
- LONGINT _o_result;
Texts_Run u = NIL;
- LONGINT pos;
+ INT32 pos;
u = E->base->head->next;
pos = 0;
while (u != (void *) E) {
pos = pos + u->len;
u = u->next;
}
- _o_result = pos;
- return _o_result;
+ return pos;
}
-static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, LONGINT *msg__typ)
+static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, ADDRESS *msg__typ)
{
Texts_Alien e = NIL;
Files_Rider r;
- LONGINT i;
+ INT32 i;
CHAR ch;
if (__ISP(E, Texts__1, 2)) {
if (__IS(msg__typ, Texts_CopyMsg, 1)) {
@@ -398,15 +394,15 @@ static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, LONGINT *msg__t
e->file = ((Texts_Alien)E)->file;
e->org = ((Texts_Alien)E)->org;
e->span = ((Texts_Alien)E)->span;
- __COPY(((Texts_Alien)E)->mod, e->mod, ((LONGINT)(32)));
- __COPY(((Texts_Alien)E)->proc, e->proc, ((LONGINT)(32)));
+ __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, ((LONGINT)(32)));
- __COPY(((Texts_Alien)E)->proc, (*msg__).proc, ((LONGINT)(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)) {
@@ -463,10 +459,10 @@ void Texts_Recall (Texts_Buffer *B)
Texts_del = NIL;
}
-void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B)
+void Texts_Save (Texts_Text T, INT32 beg, INT32 end, Texts_Buffer B)
{
Texts_Run u = NIL, v = NIL, w = NIL, wn = NIL;
- LONGINT uo, ud, vo, vd;
+ INT32 uo, ud, vo, vd;
Texts_Find(T, &beg, &u, &uo, &ud);
Texts_Find(T, &end, &v, &vo, &vd);
w = B->head->prev;
@@ -497,11 +493,11 @@ void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B)
B->len += end - beg;
}
-void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B)
+void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B)
{
Texts_Run u = NIL, un = NIL, v = NIL;
Texts_Piece p = NIL, q = NIL;
- LONGINT uo, ud, len;
+ INT32 uo, ud, len;
Texts_Find(T, &pos, &u, &uo, &ud);
Texts_Split(ud, &u, &un);
len = B->len;
@@ -520,7 +516,7 @@ void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B)
void Texts_Append (Texts_Text T, Texts_Buffer B)
{
Texts_Run v = NIL;
- LONGINT pos, len;
+ INT32 pos, len;
pos = T->len;
len = B->len;
v = B->head->next;
@@ -535,10 +531,10 @@ void Texts_Append (Texts_Text T, Texts_Buffer B)
}
}
-void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end)
+void Texts_Delete (Texts_Text T, INT32 beg, INT32 end)
{
Texts_Run c = NIL, u = NIL, un = NIL, v = NIL, vn = NIL;
- LONGINT co, uo, ud, vo, vd;
+ INT32 co, uo, ud, vo, vd;
Texts_Find(T, &beg, &u, &uo, &ud);
Texts_Split(ud, &u, &un);
c = T->cache;
@@ -560,10 +556,10 @@ void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end)
}
}
-void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff)
+void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff)
{
Texts_Run c = NIL, u = NIL, un = NIL, v = NIL, vn = NIL;
- LONGINT co, uo, ud, vo, vd;
+ INT32 co, uo, ud, vo, vd;
Texts_Find(T, &beg, &u, &uo, &ud);
Texts_Split(ud, &u, &un);
c = T->cache;
@@ -573,13 +569,13 @@ void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_F
T->cache = c;
T->corg = co;
while (un != vn) {
- if ((__IN(0, sel) && fnt != NIL)) {
+ if ((__IN(0, sel, 32) && fnt != NIL)) {
un->fnt = fnt;
}
- if (__IN(1, sel)) {
+ if (__IN(1, sel, 32)) {
un->col = col;
}
- if (__IN(2, sel)) {
+ if (__IN(2, sel, 32)) {
un->voff = voff;
}
Texts_Merge(T, u, &un);
@@ -599,7 +595,7 @@ void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_F
}
}
-void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos)
+void Texts_OpenReader (Texts_Reader *R, ADDRESS *R__typ, Texts_Text T, INT32 pos)
{
Texts_Run u = NIL;
if (pos >= T->len) {
@@ -613,10 +609,10 @@ void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT p
}
}
-void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch)
+void Texts_Read (Texts_Reader *R, ADDRESS *R__typ, CHAR *ch)
{
Texts_Run u = NIL;
- LONGINT pos;
+ INT32 pos;
CHAR nextch;
u = (*R).run;
(*R).fnt = u->fnt;
@@ -658,7 +654,7 @@ void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch)
}
}
-void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ)
+void Texts_ReadElem (Texts_Reader *R, ADDRESS *R__typ)
{
Texts_Run u = NIL, un = NIL;
u = (*R).run;
@@ -686,7 +682,7 @@ void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ)
}
}
-void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ)
+void Texts_ReadPrevElem (Texts_Reader *R, ADDRESS *R__typ)
{
Texts_Run u = NIL;
u = (*R).run->prev;
@@ -708,14 +704,12 @@ void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ)
}
}
-LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ)
+INT32 Texts_Pos (Texts_Reader *R, ADDRESS *R__typ)
{
- LONGINT _o_result;
- _o_result = (*R).org + (*R).off;
- return _o_result;
+ return (*R).org + (*R).off;
}
-void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos)
+void Texts_OpenScanner (Texts_Scanner *S, ADDRESS *S__typ, Texts_Text T, INT32 pos)
{
Texts_OpenReader((void*)&*S, S__typ, T, pos);
(*S).line = 0;
@@ -724,10 +718,10 @@ void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT
static struct Scan__31 {
Texts_Scanner *S;
- LONGINT *S__typ;
+ ADDRESS *S__typ;
CHAR *ch;
BOOLEAN *negE;
- INTEGER *e;
+ INT16 *e;
struct Scan__31 *lnk;
} *Scan__31_s;
@@ -746,18 +740,18 @@ static void ReadScaleFactor__32 (void)
}
}
while (('0' <= *Scan__31_s->ch && *Scan__31_s->ch <= '9')) {
- *Scan__31_s->e = (*Scan__31_s->e * 10 + (int)*Scan__31_s->ch) - 48;
+ *Scan__31_s->e = (*Scan__31_s->e * 10 + (INT16)*Scan__31_s->ch) - 48;
Texts_Read((void*)&*Scan__31_s->S, Scan__31_s->S__typ, &*Scan__31_s->ch);
}
}
-void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
+void Texts_Scan (Texts_Scanner *S, ADDRESS *S__typ)
{
CHAR ch, term;
BOOLEAN neg, negE, hex;
- SHORTINT i, j, h;
- INTEGER e;
- LONGINT k;
+ INT8 i, j, h;
+ INT16 e;
+ INT32 k;
REAL x, f;
LONGREAL y, g;
CHAR d[32];
@@ -780,21 +774,21 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
}
if ((('A' <= __CAP(ch) && __CAP(ch) <= 'Z') || ch == '/') || ch == '.') {
do {
- (*S).s[__X(i, ((LONGINT)(64)))] = ch;
+ (*S).s[__X(i, 64)] = ch;
i += 1;
Texts_Read((void*)&*S, S__typ, &ch);
} while (!((((__CAP(ch) > 'Z' && ch != '_') || ('A' > __CAP(ch) && ch > '9')) || ((('0' > ch && ch != '.')) && ch != '/')) || i == 63));
- (*S).s[__X(i, ((LONGINT)(64)))] = 0x00;
+ (*S).s[__X(i, 64)] = 0x00;
(*S).len = i;
(*S).class = 1;
} else if (ch == '"') {
Texts_Read((void*)&*S, S__typ, &ch);
while ((((ch != '"' && ch >= ' ')) && i != 63)) {
- (*S).s[__X(i, ((LONGINT)(64)))] = ch;
+ (*S).s[__X(i, 64)] = ch;
i += 1;
Texts_Read((void*)&*S, S__typ, &ch);
}
- (*S).s[__X(i, ((LONGINT)(64)))] = 0x00;
+ (*S).s[__X(i, 64)] = 0x00;
(*S).len = i + 1;
Texts_Read((void*)&*S, S__typ, &ch);
(*S).class = 2;
@@ -809,7 +803,7 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
hex = 0;
j = 0;
for (;;) {
- d[__X(i, ((LONGINT)(32)))] = ch;
+ d[__X(i, 32)] = ch;
i += 1;
Texts_Read((void*)&*S, S__typ, &ch);
if (ch < '0') {
@@ -818,10 +812,10 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
if ('9' < ch) {
if (('A' <= ch && ch <= 'F')) {
hex = 1;
- ch = (CHAR)((int)ch - 7);
+ ch = (CHAR)((INT16)ch - 7);
} else if (('a' <= ch && ch <= 'f')) {
hex = 1;
- ch = (CHAR)((int)ch - 39);
+ ch = (CHAR)((INT16)ch - 39);
} else {
break;
}
@@ -833,13 +827,13 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
if (i - j > 8) {
j = i - 8;
}
- k = (int)d[__X(j, ((LONGINT)(32)))] - 48;
+ k = (INT16)d[__X(j, 32)] - 48;
j += 1;
if ((i - j == 7 && k >= 8)) {
k -= 16;
}
while (j < i) {
- k = __ASHL(k, 4) + (int)((int)d[__X(j, ((LONGINT)(32)))] - 48);
+ k = __ASHL(k, 4) + ((INT16)d[__X(j, 32)] - 48);
j += 1;
}
if (neg) {
@@ -851,7 +845,7 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
Texts_Read((void*)&*S, S__typ, &ch);
h = i;
while (('0' <= ch && ch <= '9')) {
- d[__X(i, ((LONGINT)(32)))] = ch;
+ d[__X(i, 32)] = ch;
i += 1;
Texts_Read((void*)&*S, S__typ, &ch);
}
@@ -860,12 +854,12 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
y = (LONGREAL)0;
g = (LONGREAL)1;
do {
- y = y * (LONGREAL)10 + ((int)d[__X(j, ((LONGINT)(32)))] - 48);
+ y = y * (LONGREAL)10 + ((INT16)d[__X(j, 32)] - 48);
j += 1;
} while (!(j == h));
while (j < i) {
g = g / (LONGREAL)(LONGREAL)10;
- y = ((int)d[__X(j, ((LONGINT)(32)))] - 48) * g + y;
+ y = ((INT16)d[__X(j, 32)] - 48) * g + y;
j += 1;
}
ReadScaleFactor__32();
@@ -892,12 +886,12 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
x = (REAL)0;
f = (REAL)1;
do {
- x = x * (REAL)10 + ((int)d[__X(j, ((LONGINT)(32)))] - 48);
+ x = x * (REAL)10 + ((INT16)d[__X(j, 32)] - 48);
j += 1;
} while (!(j == h));
while (j < i) {
f = f / (REAL)(REAL)10;
- x = ((int)d[__X(j, ((LONGINT)(32)))] - 48) * f + x;
+ x = ((INT16)d[__X(j, 32)] - 48) * f + x;
j += 1;
}
if (ch == 'E') {
@@ -929,7 +923,7 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
(*S).class = 3;
k = 0;
do {
- k = k * 10 + (int)((int)d[__X(j, ((LONGINT)(32)))] - 48);
+ k = k * 10 + ((INT16)d[__X(j, 32)] - 48);
j += 1;
} while (!(j == i));
if (neg) {
@@ -957,33 +951,33 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
Scan__31_s = _s.lnk;
}
-void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ)
+void Texts_OpenWriter (Texts_Writer *W, ADDRESS *W__typ)
{
__NEW((*W).buf, Texts_BufDesc);
Texts_OpenBuf((*W).buf);
(*W).fnt = Texts_FontsDefault;
(*W).col = 15;
(*W).voff = 0;
- (*W).file = Files_New((CHAR*)"", (LONGINT)1);
- Files_Set(&(*W).rider, Files_Rider__typ, (*W).file, ((LONGINT)(0)));
+ (*W).file = Files_New((CHAR*)"", 1);
+ Files_Set(&(*W).rider, Files_Rider__typ, (*W).file, 0);
}
-void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt)
+void Texts_SetFont (Texts_Writer *W, ADDRESS *W__typ, Texts_FontsFont fnt)
{
(*W).fnt = fnt;
}
-void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col)
+void Texts_SetColor (Texts_Writer *W, ADDRESS *W__typ, INT8 col)
{
(*W).col = col;
}
-void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff)
+void Texts_SetOffset (Texts_Writer *W, ADDRESS *W__typ, INT8 voff)
{
(*W).voff = voff;
}
-void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch)
+void Texts_Write (Texts_Writer *W, ADDRESS *W__typ, CHAR ch)
{
Texts_Run u = NIL, un = NIL;
Texts_Piece p = NIL;
@@ -1009,7 +1003,7 @@ void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch)
}
}
-void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e)
+void Texts_WriteElem (Texts_Writer *W, ADDRESS *W__typ, Texts_Elem e)
{
Texts_Run u = NIL, un = NIL;
if (e->base != NIL) {
@@ -1028,14 +1022,14 @@ void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e)
un->prev = (Texts_Run)e;
}
-void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ)
+void Texts_WriteLn (Texts_Writer *W, ADDRESS *W__typ)
{
Texts_Write(&*W, W__typ, 0x0d);
}
-void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len)
+void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len)
{
- INTEGER i;
+ INT16 i;
__DUP(s, s__len, CHAR);
i = 0;
while (s[__X(i, s__len)] >= ' ') {
@@ -1045,15 +1039,15 @@ void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__le
__DEL(s);
}
-void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n)
+void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n)
{
- INTEGER i;
- LONGINT x0;
- CHAR a[22];
+ INT16 i;
+ INT64 x0;
+ CHAR a[24];
i = 0;
if (x < 0) {
- if (x == (-2147483647-1)) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" -2147483648", (LONGINT)13);
+ if (x == (-9223372036854775807-1)) {
+ Texts_WriteString(&*W, W__typ, (CHAR*)" -9223372036854775808", 22);
return;
} else {
n -= 1;
@@ -1063,11 +1057,11 @@ void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n)
x0 = x;
}
do {
- a[__X(i, ((LONGINT)(22)))] = (CHAR)(__MOD(x0, 10) + 48);
+ a[__X(i, 24)] = (CHAR)(__MOD(x0, 10) + 48);
x0 = __DIV(x0, 10);
i += 1;
} while (!(x0 == 0));
- while (n > (int)i) {
+ while (n > (INT64)i) {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
}
@@ -1076,47 +1070,47 @@ void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n)
}
do {
i -= 1;
- Texts_Write(&*W, W__typ, a[__X(i, ((LONGINT)(22)))]);
+ Texts_Write(&*W, W__typ, a[__X(i, 24)]);
} while (!(i == 0));
}
-void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x)
+void Texts_WriteHex (Texts_Writer *W, ADDRESS *W__typ, INT32 x)
{
- INTEGER i;
- LONGINT y;
+ INT16 i;
+ INT32 y;
CHAR a[20];
i = 0;
Texts_Write(&*W, W__typ, ' ');
do {
y = __MASK(x, -16);
if (y < 10) {
- a[__X(i, ((LONGINT)(20)))] = (CHAR)(y + 48);
+ a[__X(i, 20)] = (CHAR)(y + 48);
} else {
- a[__X(i, ((LONGINT)(20)))] = (CHAR)(y + 55);
+ a[__X(i, 20)] = (CHAR)(y + 55);
}
x = __ASHR(x, 4);
i += 1;
} while (!(i == 8));
do {
i -= 1;
- Texts_Write(&*W, W__typ, a[__X(i, ((LONGINT)(20)))]);
+ Texts_Write(&*W, W__typ, a[__X(i, 20)]);
} while (!(i == 0));
}
-void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n)
+void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n)
{
- INTEGER e;
+ INT16 e;
REAL x0;
CHAR d[9];
e = Reals_Expo(x);
if (e == 0) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" 0", (LONGINT)4);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" 0", 4);
do {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
} while (!(n <= 3));
} else if (e == 255) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", 5);
while (n > 4) {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
@@ -1153,13 +1147,13 @@ void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n)
x = x * 1.0000000e-001;
e += 1;
}
- Reals_Convert(x, n, (void*)d, ((LONGINT)(9)));
+ Reals_Convert(x, n, (void*)d, 9);
n -= 1;
- Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(9)))]);
+ Texts_Write(&*W, W__typ, d[__X(n, 9)]);
Texts_Write(&*W, W__typ, '.');
do {
n -= 1;
- Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(9)))]);
+ Texts_Write(&*W, W__typ, d[__X(n, 9)]);
} while (!(n == 0));
Texts_Write(&*W, W__typ, 'E');
if (e < 0) {
@@ -1175,16 +1169,16 @@ void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n)
static struct WriteRealFix__53 {
Texts_Writer *W;
- LONGINT *W__typ;
- INTEGER *i;
+ ADDRESS *W__typ;
+ INT16 *i;
CHAR (*d)[9];
struct WriteRealFix__53 *lnk;
} *WriteRealFix__53_s;
-static void dig__54 (INTEGER n);
-static void seq__56 (CHAR ch, INTEGER n);
+static void dig__54 (INT16 n);
+static void seq__56 (CHAR ch, INT16 n);
-static void seq__56 (CHAR ch, INTEGER n)
+static void seq__56 (CHAR ch, INT16 n)
{
while (n > 0) {
Texts_Write(&*WriteRealFix__53_s->W, WriteRealFix__53_s->W__typ, ch);
@@ -1192,18 +1186,18 @@ static void seq__56 (CHAR ch, INTEGER n)
}
}
-static void dig__54 (INTEGER n)
+static void dig__54 (INT16 n)
{
while (n > 0) {
*WriteRealFix__53_s->i -= 1;
- Texts_Write(&*WriteRealFix__53_s->W, WriteRealFix__53_s->W__typ, (*WriteRealFix__53_s->d)[__X(*WriteRealFix__53_s->i, ((LONGINT)(9)))]);
+ Texts_Write(&*WriteRealFix__53_s->W, WriteRealFix__53_s->W__typ, (*WriteRealFix__53_s->d)[__X(*WriteRealFix__53_s->i, 9)]);
n -= 1;
}
}
-void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k)
+void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k)
{
- INTEGER e, i;
+ INT16 e, i;
CHAR sign;
REAL x0;
CHAR d[9];
@@ -1222,7 +1216,7 @@ void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, IN
Texts_Write(&*W, W__typ, '0');
seq__56(' ', k + 1);
} else if (e == 255) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", 5);
seq__56(' ', n - 4);
} else {
e = __ASHR((e - 127) * 77, 8);
@@ -1254,7 +1248,7 @@ void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, IN
}
e += 1;
i = k + e;
- Reals_Convert(x, i, (void*)d, ((LONGINT)(9)));
+ Reals_Convert(x, i, (void*)d, 9);
if (e > 0) {
seq__56(' ', ((n - e) - k) - 2);
Texts_Write(&*W, W__typ, sign);
@@ -1273,32 +1267,32 @@ void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, IN
WriteRealFix__53_s = _s.lnk;
}
-void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x)
+void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x)
{
- INTEGER i;
+ INT16 i;
CHAR d[8];
- Reals_ConvertH(x, (void*)d, ((LONGINT)(8)));
+ Reals_ConvertH(x, (void*)d, 8);
i = 0;
do {
- Texts_Write(&*W, W__typ, d[__X(i, ((LONGINT)(8)))]);
+ Texts_Write(&*W, W__typ, d[__X(i, 8)]);
i += 1;
} while (!(i == 8));
}
-void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n)
+void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n)
{
- INTEGER e;
+ INT16 e;
LONGREAL x0;
CHAR d[16];
e = Reals_ExpoL(x);
if (e == 0) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" 0", (LONGINT)4);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" 0", 4);
do {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
} while (!(n <= 3));
} else if (e == 2047) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", 5);
while (n > 4) {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
@@ -1319,7 +1313,7 @@ void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER
} else {
Texts_Write(&*W, W__typ, ' ');
}
- e = (int)__ASHR((int)(e - 1023) * 77, 8);
+ e = (INT16)__ASHR((e - 1023) * 77, 8);
if (e >= 0) {
x = x / (LONGREAL)Reals_TenL(e);
} else {
@@ -1335,13 +1329,13 @@ void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER
x = 1.00000000000000e-001 * x;
e += 1;
}
- Reals_ConvertL(x, n, (void*)d, ((LONGINT)(16)));
+ Reals_ConvertL(x, n, (void*)d, 16);
n -= 1;
- Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(16)))]);
+ Texts_Write(&*W, W__typ, d[__X(n, 16)]);
Texts_Write(&*W, W__typ, '.');
do {
n -= 1;
- Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(16)))]);
+ Texts_Write(&*W, W__typ, d[__X(n, 16)]);
} while (!(n == 0));
Texts_Write(&*W, W__typ, 'D');
if (e < 0) {
@@ -1357,34 +1351,34 @@ void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER
}
}
-void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x)
+void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x)
{
- INTEGER i;
+ INT16 i;
CHAR d[16];
- Reals_ConvertHL(x, (void*)d, ((LONGINT)(16)));
+ Reals_ConvertHL(x, (void*)d, 16);
i = 0;
do {
- Texts_Write(&*W, W__typ, d[__X(i, ((LONGINT)(16)))]);
+ Texts_Write(&*W, W__typ, d[__X(i, 16)]);
i += 1;
} while (!(i == 16));
}
static struct WriteDate__43 {
Texts_Writer *W;
- LONGINT *W__typ;
+ ADDRESS *W__typ;
struct WriteDate__43 *lnk;
} *WriteDate__43_s;
-static void WritePair__44 (CHAR ch, LONGINT x);
+static void WritePair__44 (CHAR ch, INT32 x);
-static void WritePair__44 (CHAR ch, LONGINT x)
+static void WritePair__44 (CHAR ch, INT32 x)
{
Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, ch);
Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, (CHAR)(__DIV(x, 10) + 48));
- Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, (CHAR)(__MOD(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, LONGINT *W__typ, LONGINT t, LONGINT d)
+void Texts_WriteDate (Texts_Writer *W, ADDRESS *W__typ, INT32 t, INT32 d)
{
struct WriteDate__43 _s;
_s.W = W; _s.W__typ = W__typ;
@@ -1401,35 +1395,35 @@ void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d)
static struct Load0__16 {
Texts_Text *T;
- SHORTINT *ecnt;
+ INT8 *ecnt;
Files_File *f;
Texts_FileMsg *msg;
CHAR (*mods)[64][32], (*procs)[64][32];
struct Load0__16 *lnk;
} *Load0__16_s;
-static void LoadElem__17 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, LONGINT span, Texts_Elem *e);
+static void LoadElem__17 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, INT32 span, Texts_Elem *e);
-static void LoadElem__17 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, LONGINT span, Texts_Elem *e)
+static void LoadElem__17 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, INT32 span, Texts_Elem *e)
{
Modules_Module M = NIL;
Modules_Command Cmd;
Texts_Alien a = NIL;
- LONGINT org, ew, eh;
- SHORTINT eno;
+ INT32 org, ew, eh;
+ INT8 eno;
Texts_new = NIL;
Files_ReadLInt(&*r, r__typ, &ew);
Files_ReadLInt(&*r, r__typ, &eh);
Files_Read(&*r, r__typ, (void*)&eno);
if (eno > *Load0__16_s->ecnt) {
*Load0__16_s->ecnt = eno;
- Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32)));
- Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32)));
+ Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->mods)[__X(eno, 64)], 32);
+ Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->procs)[__X(eno, 64)], 32);
}
org = Files_Pos(&*r, r__typ);
- M = Modules_ThisMod((*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32)));
+ M = Modules_ThisMod((*Load0__16_s->mods)[__X(eno, 64)], 32);
if (M != NIL) {
- Cmd = Modules_ThisCommand(M, (*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32)));
+ Cmd = Modules_ThisCommand(M, (*Load0__16_s->procs)[__X(eno, 64)], 32);
if (Cmd != NIL) {
(*Cmd)();
}
@@ -1455,19 +1449,19 @@ static void LoadElem__17 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, LONGINT
a->file = *Load0__16_s->f;
a->org = org;
a->span = span;
- __COPY((*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], a->mod, ((LONGINT)(32)));
- __COPY((*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], a->proc, ((LONGINT)(32)));
+ __COPY((*Load0__16_s->mods)[__X(eno, 64)], a->mod, 32);
+ __COPY((*Load0__16_s->procs)[__X(eno, 64)], a->proc, 32);
*e = (Texts_Elem)a;
}
}
-static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
+static void Texts_Load0 (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
{
Texts_Run u = NIL, un = NIL;
Texts_Piece p = NIL;
Texts_Elem e = NIL;
- LONGINT org, pos, hlen, plen;
- SHORTINT ecnt, fno, fcnt, col, voff;
+ INT32 org, pos, hlen, plen;
+ INT8 ecnt, fcnt, fno, col, voff;
Files_File f = NIL;
Texts_FileMsg msg;
CHAR mods[64][32], procs[64][32];
@@ -1500,8 +1494,8 @@ static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
while (fno != 0) {
if (fno > fcnt) {
fcnt = fno;
- Files_ReadString(&msg.r, Files_Rider__typ, (void*)name, ((LONGINT)(32)));
- fnts[__X(fno, ((LONGINT)(32)))] = Texts_FontsThis((void*)name, ((LONGINT)(32)));
+ Files_ReadString(&msg.r, Files_Rider__typ, (void*)name, 32);
+ fnts[__X(fno, 32)] = Texts_FontsThis((void*)name, 32);
}
Files_Read(&msg.r, Files_Rider__typ, (void*)&col);
Files_Read(&msg.r, Files_Rider__typ, (void*)&voff);
@@ -1535,9 +1529,9 @@ static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
Load0__16_s = _s.lnk;
}
-void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
+void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
{
- INTEGER tag;
+ INT16 tag;
Files_ReadInt(&*r, r__typ, &tag);
if (tag != -4095) {
Files_Set(&*r, r__typ, Files_Base(&*r, r__typ), Files_Pos(&*r, r__typ) - 2);
@@ -1552,13 +1546,13 @@ void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len)
Texts_Run u = NIL;
Texts_Piece p = NIL;
CHAR tag, version;
- LONGINT hlen;
+ INT32 hlen;
__DUP(name, name__len, CHAR);
f = Files_Old(name, name__len);
if (f == NIL) {
- f = Files_New((CHAR*)"", (LONGINT)1);
+ f = Files_New((CHAR*)"", 1);
}
- Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(0)));
+ Files_Set(&r, Files_Rider__typ, f, 0);
Files_Read(&r, Files_Rider__typ, (void*)&tag);
Files_Read(&r, Files_Rider__typ, (void*)&version);
if (tag == 0xf0 || (tag == 0x01 && version == 0xf0)) {
@@ -1570,7 +1564,7 @@ void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len)
u->col = 15;
__NEW(p, Texts_PieceDesc);
if ((tag == 0xf7 && version == 0x07)) {
- Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(28)));
+ Files_Set(&r, Files_Rider__typ, f, 28);
Files_ReadLInt(&r, Files_Rider__typ, &hlen);
Files_Set(&r, Files_Rider__typ, f, 22 + hlen);
Files_ReadLInt(&r, Files_Rider__typ, &T->len);
@@ -1602,35 +1596,35 @@ void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len)
}
static struct Store__39 {
- SHORTINT *ecnt;
+ INT8 *ecnt;
Texts_FileMsg *msg;
Texts_IdentifyMsg *iden;
CHAR (*mods)[64][32], (*procs)[64][32];
struct Store__39 *lnk;
} *Store__39_s;
-static void StoreElem__40 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, Texts_Elem e);
+static void StoreElem__40 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, Texts_Elem e);
-static void StoreElem__40 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, Texts_Elem e)
+static void StoreElem__40 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, Texts_Elem e)
{
Files_Rider r1;
- LONGINT org, span;
- SHORTINT eno;
- __COPY((*Store__39_s->iden).mod, (*Store__39_s->mods)[__X(*Store__39_s->ecnt, ((LONGINT)(64)))], ((LONGINT)(32)));
- __COPY((*Store__39_s->iden).proc, (*Store__39_s->procs)[__X(*Store__39_s->ecnt, ((LONGINT)(64)))], ((LONGINT)(32)));
+ INT32 org, span;
+ INT8 eno;
+ __COPY((*Store__39_s->iden).mod, (*Store__39_s->mods)[__X(*Store__39_s->ecnt, 64)], 32);
+ __COPY((*Store__39_s->iden).proc, (*Store__39_s->procs)[__X(*Store__39_s->ecnt, 64)], 32);
eno = 1;
- while (__STRCMP((*Store__39_s->mods)[__X(eno, ((LONGINT)(64)))], (*Store__39_s->iden).mod) != 0 || __STRCMP((*Store__39_s->procs)[__X(eno, ((LONGINT)(64)))], (*Store__39_s->iden).proc) != 0) {
+ while (__STRCMP((*Store__39_s->mods)[__X(eno, 64)], (*Store__39_s->iden).mod) != 0 || __STRCMP((*Store__39_s->procs)[__X(eno, 64)], (*Store__39_s->iden).proc) != 0) {
eno += 1;
}
Files_Set(&r1, Files_Rider__typ, Files_Base(&*r, r__typ), Files_Pos(&*r, r__typ));
- Files_WriteLInt(&*r, r__typ, ((LONGINT)(0)));
- Files_WriteLInt(&*r, r__typ, ((LONGINT)(0)));
- Files_WriteLInt(&*r, r__typ, ((LONGINT)(0)));
+ Files_WriteLInt(&*r, r__typ, 0);
+ Files_WriteLInt(&*r, r__typ, 0);
+ Files_WriteLInt(&*r, r__typ, 0);
Files_Write(&*r, r__typ, eno);
if (eno == *Store__39_s->ecnt) {
*Store__39_s->ecnt += 1;
- Files_WriteString(&*r, r__typ, (*Store__39_s->iden).mod, ((LONGINT)(32)));
- Files_WriteString(&*r, r__typ, (*Store__39_s->iden).proc, ((LONGINT)(32)));
+ Files_WriteString(&*r, r__typ, (*Store__39_s->iden).mod, 32);
+ Files_WriteString(&*r, r__typ, (*Store__39_s->iden).proc, 32);
}
(*Store__39_s->msg).pos = pos;
org = Files_Pos(&*r, r__typ);
@@ -1641,14 +1635,15 @@ static void StoreElem__40 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, Texts_E
Files_WriteLInt(&r1, Files_Rider__typ, e->H);
}
-void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
+void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
{
Files_Rider r1;
Texts_Run u = NIL, un = NIL;
Texts_Elem e = NIL;
- LONGINT org, pos, delta, hlen, rlen;
- SHORTINT ecnt, fno, fcnt;
+ INT32 org, pos, delta, hlen, rlen;
+ INT8 ecnt, fcnt;
CHAR ch;
+ INT8 fno;
Texts_FileMsg msg;
Texts_IdentifyMsg iden;
CHAR mods[64][32], procs[64][32];
@@ -1665,7 +1660,7 @@ void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
org = Files_Pos(&*r, r__typ);
msg.id = 1;
msg.r = *r;
- Files_WriteLInt(&msg.r, Files_Rider__typ, ((LONGINT)(0)));
+ Files_WriteLInt(&msg.r, Files_Rider__typ, 0);
u = T->head->next;
pos = 0;
delta = 0;
@@ -1679,15 +1674,15 @@ void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
iden.mod[0] = 0x01;
}
if (iden.mod[0] != 0x00) {
- fnts[__X(fcnt, ((LONGINT)(32)))] = u->fnt;
+ fnts[__X(fcnt, 32)] = u->fnt;
fno = 1;
- while (__STRCMP(fnts[__X(fno, ((LONGINT)(32)))]->name, u->fnt->name) != 0) {
+ while (__STRCMP(fnts[__X(fno, 32)]->name, u->fnt->name) != 0) {
fno += 1;
}
Files_Write(&msg.r, Files_Rider__typ, fno);
if (fno == fcnt) {
fcnt += 1;
- Files_WriteString(&msg.r, Files_Rider__typ, u->fnt->name, ((LONGINT)(32)));
+ Files_WriteString(&msg.r, Files_Rider__typ, u->fnt->name, 32);
}
Files_Write(&msg.r, Files_Rider__typ, u->col);
Files_Write(&msg.r, Files_Rider__typ, u->voff);
@@ -1736,12 +1731,12 @@ void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
delta = ((Texts_Piece)u)->len;
while (delta > 1024) {
- Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), ((LONGINT)(1024)));
- Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), ((LONGINT)(1024)));
+ Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, 1024, 1024);
+ Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, 1024, 1024);
delta -= 1024;
}
- Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), delta);
- Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), delta);
+ Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, 1024, delta);
+ Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, 1024, delta);
}
} else __WITHCHK;
} else {
@@ -1755,7 +1750,7 @@ void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
}
__GUARDEQR(r, r__typ, Files_Rider) = msg.r;
if (T->notify != NIL) {
- (*T->notify)(T, 3, ((LONGINT)(0)), ((LONGINT)(0)));
+ (*T->notify)(T, 3, 0, 0);
}
Store__39_s = _s.lnk;
}
@@ -1764,11 +1759,11 @@ void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len)
{
Files_File f = NIL;
Files_Rider r;
- INTEGER i, res;
+ INT16 i, res;
CHAR bak[64];
__DUP(name, name__len, CHAR);
f = Files_New(name, name__len);
- Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(0)));
+ Files_Set(&r, Files_Rider__typ, f, 0);
Files_Write(&r, Files_Rider__typ, 0xf0);
Files_Write(&r, Files_Rider__typ, 0x01);
Texts_Store(&r, Files_Rider__typ, T);
@@ -1776,13 +1771,13 @@ void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len)
while (name[__X(i, name__len)] != 0x00) {
i += 1;
}
- __COPY(name, bak, ((LONGINT)(64)));
- bak[__X(i, ((LONGINT)(64)))] = '.';
- bak[__X(i + 1, ((LONGINT)(64)))] = 'B';
- bak[__X(i + 2, ((LONGINT)(64)))] = 'a';
- bak[__X(i + 3, ((LONGINT)(64)))] = 'k';
- bak[__X(i + 4, ((LONGINT)(64)))] = 0x00;
- Files_Rename(name, name__len, bak, ((LONGINT)(64)), &res);
+ __COPY(name, bak, 64);
+ bak[__X(i, 64)] = '.';
+ bak[__X(i + 1, 64)] = 'B';
+ bak[__X(i + 2, 64)] = 'a';
+ bak[__X(i + 3, 64)] = 'k';
+ bak[__X(i + 4, 64)] = 0x00;
+ Files_Rename(name, name__len, bak, 64, &res);
Files_Register(f);
__DEL(name);
}
diff --git a/bootstrap/windows-48/Texts.h b/bootstrap/windows-48/Texts.h
index 632b644a..e2c03958 100644
--- a/bootstrap/windows-48/Texts.h
+++ b/bootstrap/windows-48/Texts.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Texts__h
#define Texts__h
@@ -8,7 +8,7 @@
typedef
struct Texts_BufDesc {
- LONGINT len;
+ INT32 len;
char _prvt0[4];
} Texts_BufDesc;
@@ -30,25 +30,25 @@ typedef
typedef
struct Texts_RunDesc {
- LONGINT _prvt0;
+ INT32 _prvt0;
char _prvt1[15];
} Texts_RunDesc;
typedef
- void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, LONGINT *);
+ void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, ADDRESS *);
typedef
struct Texts_ElemDesc {
char _prvt0[20];
- LONGINT W, H;
+ INT32 W, H;
Texts_Handler handle;
char _prvt1[4];
} Texts_ElemDesc;
typedef
struct Texts_FileMsg { /* Texts_ElemMsg */
- INTEGER id;
- LONGINT pos;
+ INT16 id;
+ INT32 pos;
Files_Rider r;
} Texts_FileMsg;
@@ -69,13 +69,13 @@ typedef
struct Texts_TextDesc *Texts_Text;
typedef
- void (*Texts_Notifier)(Texts_Text, INTEGER, LONGINT, LONGINT);
+ void (*Texts_Notifier)(Texts_Text, INT16, INT32, INT32);
typedef
struct Texts_Reader {
BOOLEAN eot;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
Texts_Elem elem;
char _prvt0[32];
} Texts_Reader;
@@ -84,23 +84,23 @@ typedef
struct Texts_Scanner { /* Texts_Reader */
BOOLEAN eot;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
Texts_Elem elem;
- LONGREAL _prvt0;
+ INT64 _prvt0;
char _prvt1[24];
CHAR nextCh;
- INTEGER line, class;
- LONGINT i;
+ INT16 line, class;
+ INT32 i;
REAL x;
LONGREAL y;
CHAR c;
- SHORTINT len;
+ INT8 len;
CHAR s[64];
} Texts_Scanner;
typedef
struct Texts_TextDesc {
- LONGINT len;
+ INT32 len;
Texts_Notifier notify;
char _prvt0[12];
} Texts_TextDesc;
@@ -109,65 +109,65 @@ typedef
struct Texts_Writer {
Texts_Buffer buf;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
char _prvt0[26];
} Texts_Writer;
import Texts_Elem Texts_new;
-import LONGINT *Texts_FontDesc__typ;
-import LONGINT *Texts_RunDesc__typ;
-import LONGINT *Texts_ElemMsg__typ;
-import LONGINT *Texts_ElemDesc__typ;
-import LONGINT *Texts_FileMsg__typ;
-import LONGINT *Texts_CopyMsg__typ;
-import LONGINT *Texts_IdentifyMsg__typ;
-import LONGINT *Texts_BufDesc__typ;
-import LONGINT *Texts_TextDesc__typ;
-import LONGINT *Texts_Reader__typ;
-import LONGINT *Texts_Scanner__typ;
-import LONGINT *Texts_Writer__typ;
+import ADDRESS *Texts_FontDesc__typ;
+import ADDRESS *Texts_RunDesc__typ;
+import ADDRESS *Texts_ElemMsg__typ;
+import ADDRESS *Texts_ElemDesc__typ;
+import ADDRESS *Texts_FileMsg__typ;
+import ADDRESS *Texts_CopyMsg__typ;
+import ADDRESS *Texts_IdentifyMsg__typ;
+import ADDRESS *Texts_BufDesc__typ;
+import ADDRESS *Texts_TextDesc__typ;
+import ADDRESS *Texts_Reader__typ;
+import ADDRESS *Texts_Scanner__typ;
+import ADDRESS *Texts_Writer__typ;
import void Texts_Append (Texts_Text T, Texts_Buffer B);
-import void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff);
+import void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff);
import void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
import void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
import void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
-import void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end);
+import void Texts_Delete (Texts_Text T, INT32 beg, INT32 end);
import Texts_Text Texts_ElemBase (Texts_Elem E);
-import LONGINT Texts_ElemPos (Texts_Elem E);
-import void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B);
-import void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T);
+import INT32 Texts_ElemPos (Texts_Elem E);
+import void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B);
+import void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
import void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
import void Texts_OpenBuf (Texts_Buffer B);
-import void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos);
-import void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos);
-import void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ);
-import LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ);
-import void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch);
-import void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ);
-import void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ);
+import void Texts_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);
+import void Texts_OpenWriter (Texts_Writer *W, ADDRESS *W__typ);
+import INT32 Texts_Pos (Texts_Reader *R, ADDRESS *R__typ);
+import void Texts_Read (Texts_Reader *R, ADDRESS *R__typ, CHAR *ch);
+import void Texts_ReadElem (Texts_Reader *R, ADDRESS *R__typ);
+import void Texts_ReadPrevElem (Texts_Reader *R, ADDRESS *R__typ);
import void Texts_Recall (Texts_Buffer *B);
-import void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B);
-import void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ);
-import void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col);
-import void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt);
-import void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff);
-import void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T);
-import void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch);
-import void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d);
-import void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e);
-import void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x);
-import void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n);
-import void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ);
-import void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n);
-import void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x);
-import void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n);
-import void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k);
-import void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x);
-import void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len);
+import void Texts_Save (Texts_Text T, INT32 beg, INT32 end, Texts_Buffer B);
+import void Texts_Scan (Texts_Scanner *S, ADDRESS *S__typ);
+import void Texts_SetColor (Texts_Writer *W, ADDRESS *W__typ, INT8 col);
+import void Texts_SetFont (Texts_Writer *W, ADDRESS *W__typ, Texts_FontsFont fnt);
+import void Texts_SetOffset (Texts_Writer *W, ADDRESS *W__typ, INT8 voff);
+import void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
+import void Texts_Write (Texts_Writer *W, ADDRESS *W__typ, CHAR ch);
+import void Texts_WriteDate (Texts_Writer *W, ADDRESS *W__typ, INT32 t, INT32 d);
+import void Texts_WriteElem (Texts_Writer *W, ADDRESS *W__typ, Texts_Elem e);
+import void Texts_WriteHex (Texts_Writer *W, ADDRESS *W__typ, INT32 x);
+import void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n);
+import void Texts_WriteLn (Texts_Writer *W, ADDRESS *W__typ);
+import void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n);
+import void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x);
+import void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n);
+import void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k);
+import void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x);
+import void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
import void *Texts__init(void);
-#endif
+#endif // Texts
diff --git a/bootstrap/windows-48/VT100.c b/bootstrap/windows-48/VT100.c
new file mode 100644
index 00000000..f69fd90e
--- /dev/null
+++ b/bootstrap/windows-48/VT100.c
@@ -0,0 +1,264 @@
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
+#include "SYSTEM.h"
+#include "Out.h"
+#include "Strings.h"
+
+
+export CHAR VT100_CSI[5];
+static CHAR VT100_tmpstr[32];
+
+
+export void VT100_CHA (INT16 n);
+export void VT100_CNL (INT16 n);
+export void VT100_CPL (INT16 n);
+export void VT100_CUB (INT16 n);
+export void VT100_CUD (INT16 n);
+export void VT100_CUF (INT16 n);
+export void VT100_CUP (INT16 n, INT16 m);
+export void VT100_CUU (INT16 n);
+export void VT100_DECTCEMh (void);
+export void VT100_DECTCEMl (void);
+export void VT100_DSR (INT16 n);
+export void VT100_ED (INT16 n);
+export void VT100_EL (INT16 n);
+static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len);
+static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len);
+static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len);
+static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len);
+export void VT100_HVP (INT16 n, INT16 m);
+export void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len);
+export void VT100_RCP (void);
+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, LONGINT attr__len);
+
+
+static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end)
+{
+ CHAR h;
+ while (start < end) {
+ h = str[__X(start, str__len)];
+ str[__X(start, str__len)] = str[__X(end, str__len)];
+ str[__X(end, str__len)] = h;
+ start += 1;
+ end -= 1;
+ }
+}
+
+void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len)
+{
+ CHAR b[21];
+ INT16 s, e;
+ INT8 maxLength;
+ maxLength = 11;
+ if (int_ == (-2147483647-1)) {
+ __MOVE("-2147483648", b, 12);
+ e = 11;
+ } else {
+ if (int_ < 0) {
+ b[0] = '-';
+ int_ = -int_;
+ s = 1;
+ } else {
+ s = 0;
+ }
+ e = s;
+ do {
+ b[__X(e, 21)] = (CHAR)((int)__MOD(int_, 10) + 48);
+ int_ = __DIV(int_, 10);
+ e += 1;
+ } while (!(int_ == 0));
+ b[__X(e, 21)] = 0x00;
+ VT100_Reverse0((void*)b, 21, s, e - 1);
+ }
+ __COPY(b, str, str__len);
+}
+
+static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len)
+{
+ CHAR cmd[9];
+ __DUP(letter, letter__len, CHAR);
+ __COPY(VT100_CSI, cmd, 9);
+ Strings_Append(letter, letter__len, (void*)cmd, 9);
+ Out_String(cmd, 9);
+ __DEL(letter);
+}
+
+static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len)
+{
+ CHAR nstr[2];
+ CHAR cmd[7];
+ __DUP(letter, letter__len, CHAR);
+ VT100_IntToStr(n, (void*)nstr, 2);
+ __COPY(VT100_CSI, cmd, 7);
+ Strings_Append(nstr, 2, (void*)cmd, 7);
+ Strings_Append(letter, letter__len, (void*)cmd, 7);
+ Out_String(cmd, 7);
+ __DEL(letter);
+}
+
+static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len)
+{
+ CHAR nstr[2];
+ CHAR cmd[7];
+ __DUP(letter, letter__len, CHAR);
+ VT100_IntToStr(n, (void*)nstr, 2);
+ __COPY(VT100_CSI, cmd, 7);
+ Strings_Append(letter, letter__len, (void*)cmd, 7);
+ Strings_Append(nstr, 2, (void*)cmd, 7);
+ Out_String(cmd, 7);
+ __DEL(letter);
+}
+
+static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len)
+{
+ CHAR nstr[5], mstr[5];
+ CHAR cmd[12];
+ __DUP(letter, letter__len, CHAR);
+ VT100_IntToStr(n, (void*)nstr, 5);
+ VT100_IntToStr(m, (void*)mstr, 5);
+ __COPY(VT100_CSI, cmd, 12);
+ Strings_Append(nstr, 5, (void*)cmd, 12);
+ Strings_Append((CHAR*)";", 2, (void*)cmd, 12);
+ Strings_Append(mstr, 5, (void*)cmd, 12);
+ Strings_Append(letter, letter__len, (void*)cmd, 12);
+ Out_String(cmd, 12);
+ __DEL(letter);
+}
+
+void VT100_CUU (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"A", 2);
+}
+
+void VT100_CUD (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"B", 2);
+}
+
+void VT100_CUF (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"C", 2);
+}
+
+void VT100_CUB (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"D", 2);
+}
+
+void VT100_CNL (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"E", 2);
+}
+
+void VT100_CPL (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"F", 2);
+}
+
+void VT100_CHA (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"G", 2);
+}
+
+void VT100_CUP (INT16 n, INT16 m)
+{
+ VT100_EscSeq2(n, m, (CHAR*)"H", 2);
+}
+
+void VT100_ED (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"J", 2);
+}
+
+void VT100_EL (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"K", 2);
+}
+
+void VT100_SU (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"S", 2);
+}
+
+void VT100_SD (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"T", 2);
+}
+
+void VT100_HVP (INT16 n, INT16 m)
+{
+ VT100_EscSeq2(n, m, (CHAR*)"f", 2);
+}
+
+void VT100_SGR (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"m", 2);
+}
+
+void VT100_SGR2 (INT16 n, INT16 m)
+{
+ VT100_EscSeq2(n, m, (CHAR*)"m", 2);
+}
+
+void VT100_DSR (INT16 n)
+{
+ VT100_EscSeq(6, (CHAR*)"n", 2);
+}
+
+void VT100_SCP (void)
+{
+ VT100_EscSeq0((CHAR*)"s", 2);
+}
+
+void VT100_RCP (void)
+{
+ VT100_EscSeq0((CHAR*)"u", 2);
+}
+
+void VT100_DECTCEMl (void)
+{
+ VT100_EscSeq0((CHAR*)"\?25l", 5);
+}
+
+void VT100_DECTCEMh (void)
+{
+ VT100_EscSeq0((CHAR*)"\?25h", 5);
+}
+
+void VT100_SetAttr (CHAR *attr, LONGINT attr__len)
+{
+ CHAR tmpstr[16];
+ __DUP(attr, attr__len, CHAR);
+ __COPY(VT100_CSI, tmpstr, 16);
+ Strings_Append(attr, attr__len, (void*)tmpstr, 16);
+ Out_String(tmpstr, 16);
+ __DEL(attr);
+}
+
+
+export void *VT100__init(void)
+{
+ __DEFMOD;
+ __MODULE_IMPORT(Out);
+ __MODULE_IMPORT(Strings);
+ __REGMOD("VT100", 0);
+ __REGCMD("DECTCEMh", VT100_DECTCEMh);
+ __REGCMD("DECTCEMl", VT100_DECTCEMl);
+ __REGCMD("RCP", VT100_RCP);
+ __REGCMD("SCP", VT100_SCP);
+/* BEGIN */
+ __COPY("\033", VT100_CSI, 5);
+ Strings_Append((CHAR*)"[", 2, (void*)VT100_CSI, 5);
+ __ENDMOD;
+}
diff --git a/bootstrap/windows-48/VT100.h b/bootstrap/windows-48/VT100.h
new file mode 100644
index 00000000..d99406ec
--- /dev/null
+++ b/bootstrap/windows-48/VT100.h
@@ -0,0 +1,37 @@
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#ifndef VT100__h
+#define VT100__h
+
+#include "SYSTEM.h"
+
+
+import CHAR VT100_CSI[5];
+
+
+import void VT100_CHA (INT16 n);
+import void VT100_CNL (INT16 n);
+import void VT100_CPL (INT16 n);
+import void VT100_CUB (INT16 n);
+import void VT100_CUD (INT16 n);
+import void VT100_CUF (INT16 n);
+import void VT100_CUP (INT16 n, INT16 m);
+import void VT100_CUU (INT16 n);
+import void VT100_DECTCEMh (void);
+import void VT100_DECTCEMl (void);
+import void VT100_DSR (INT16 n);
+import void VT100_ED (INT16 n);
+import void VT100_EL (INT16 n);
+import void VT100_HVP (INT16 n, INT16 m);
+import void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len);
+import void VT100_RCP (void);
+import void VT100_SCP (void);
+import void VT100_SD (INT16 n);
+import void VT100_SGR (INT16 n);
+import void VT100_SGR2 (INT16 n, INT16 m);
+import void VT100_SU (INT16 n);
+import void VT100_SetAttr (CHAR *attr, LONGINT attr__len);
+import void *VT100__init(void);
+
+
+#endif // VT100
diff --git a/bootstrap/windows-48/Vishap.c b/bootstrap/windows-48/Vishap.c
deleted file mode 100644
index 4c9e3b45..00000000
--- a/bootstrap/windows-48/Vishap.c
+++ /dev/null
@@ -1,168 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkamSf */
-#include "SYSTEM.h"
-#include "Configuration.h"
-#include "Heap.h"
-#include "OPB.h"
-#include "OPC.h"
-#include "OPM.h"
-#include "OPP.h"
-#include "OPT.h"
-#include "OPV.h"
-#include "Platform.h"
-#include "Strings.h"
-#include "extTools.h"
-#include "vt100.h"
-
-
-static CHAR Vishap_mname[256];
-
-
-export void Vishap_Module (BOOLEAN *done);
-static void Vishap_PropagateElementaryTypeSizes (void);
-export void Vishap_Translate (void);
-static void Vishap_Trap (INTEGER sig);
-
-
-void Vishap_Module (BOOLEAN *done)
-{
- BOOLEAN ext, new;
- OPT_Node p = NIL;
- OPP_Module(&p, OPM_opt);
- if (OPM_noerr) {
- OPV_Init();
- OPV_AdrAndSize(OPT_topScope);
- OPT_Export(&ext, &new);
- if (OPM_noerr) {
- OPM_OpenFiles((void*)OPT_SelfName, ((LONGINT)(256)));
- OPC_Init();
- OPV_Module(p);
- if (OPM_noerr) {
- if (((OPM_mainProg || OPM_mainLinkStat) && __STRCMP(OPM_modName, "SYSTEM") != 0)) {
- OPM_DeleteNewSym();
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"32m", (LONGINT)4);
- }
- OPM_LogWStr((CHAR*)" Main program.", (LONGINT)16);
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"0m", (LONGINT)3);
- }
- } else {
- if (new) {
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"32m", (LONGINT)4);
- }
- OPM_LogWStr((CHAR*)" New symbol file.", (LONGINT)19);
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"0m", (LONGINT)3);
- }
- OPM_RegisterNewSym();
- } else if (ext) {
- OPM_LogWStr((CHAR*)" Extended symbol file.", (LONGINT)24);
- OPM_RegisterNewSym();
- }
- }
- } else {
- OPM_DeleteNewSym();
- }
- }
- }
- OPM_CloseFiles();
- OPT_Close();
- OPM_LogWLn();
- *done = OPM_noerr;
-}
-
-static void Vishap_PropagateElementaryTypeSizes (void)
-{
- OPT_bytetyp->size = OPM_ByteSize;
- OPT_sysptrtyp->size = OPM_PointerSize;
- OPT_chartyp->size = OPM_CharSize;
- OPT_settyp->size = OPM_SetSize;
- OPT_realtyp->size = OPM_RealSize;
- OPT_inttyp->size = OPM_IntSize;
- OPT_linttyp->size = OPM_LIntSize;
- OPT_lrltyp->size = OPM_LRealSize;
- OPT_sinttyp->size = OPM_SIntSize;
- OPT_booltyp->size = OPM_BoolSize;
-}
-
-void Vishap_Translate (void)
-{
- BOOLEAN done;
- CHAR modulesobj[2048];
- modulesobj[0] = 0x00;
- if (OPM_OpenPar()) {
- for (;;) {
- OPM_Init(&done, (void*)Vishap_mname, ((LONGINT)(256)));
- if (!done) {
- return;
- }
- OPM_InitOptions();
- Vishap_PropagateElementaryTypeSizes();
- Heap_GC(0);
- Vishap_Module(&done);
- if (!done) {
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Module compilation failed.", (LONGINT)27);
- OPM_LogWLn();
- Platform_Exit(1);
- }
- if (!OPM_dontAsm) {
- if (OPM_dontLink) {
- extTools_Assemble(OPM_modName, ((LONGINT)(32)));
- } else {
- if (!(OPM_mainProg || OPM_mainLinkStat)) {
- extTools_Assemble(OPM_modName, ((LONGINT)(32)));
- Strings_Append((CHAR*)" ", (LONGINT)2, (void*)modulesobj, ((LONGINT)(2048)));
- Strings_Append(OPM_modName, ((LONGINT)(32)), (void*)modulesobj, ((LONGINT)(2048)));
- Strings_Append((CHAR*)".o", (LONGINT)3, (void*)modulesobj, ((LONGINT)(2048)));
- } else {
- extTools_LinkMain((void*)OPM_modName, ((LONGINT)(32)), OPM_mainLinkStat, modulesobj, ((LONGINT)(2048)));
- }
- }
- }
- }
- }
-}
-
-static void Vishap_Trap (INTEGER sig)
-{
- Heap_FINALL();
- if (sig == 3) {
- Platform_Exit(0);
- } else {
- if ((sig == 4 && Platform_HaltCode == -15)) {
- OPM_LogWStr((CHAR*)" --- Vishap Oberon: internal error", (LONGINT)35);
- OPM_LogWLn();
- }
- Platform_Exit(2);
- }
-}
-
-
-export int main(int argc, char **argv)
-{
- __INIT(argc, argv);
- __MODULE_IMPORT(Configuration);
- __MODULE_IMPORT(Heap);
- __MODULE_IMPORT(OPB);
- __MODULE_IMPORT(OPC);
- __MODULE_IMPORT(OPM);
- __MODULE_IMPORT(OPP);
- __MODULE_IMPORT(OPT);
- __MODULE_IMPORT(OPV);
- __MODULE_IMPORT(Platform);
- __MODULE_IMPORT(Strings);
- __MODULE_IMPORT(extTools);
- __MODULE_IMPORT(vt100);
- __REGMAIN("Vishap", 0);
- __REGCMD("Translate", Vishap_Translate);
-/* BEGIN */
- Platform_SetInterruptHandler(Vishap_Trap);
- Platform_SetQuitHandler(Vishap_Trap);
- Platform_SetBadInstructionHandler(Vishap_Trap);
- OPB_typSize = OPV_TypSize;
- OPT_typSize = OPV_TypSize;
- Vishap_Translate();
- __FINI;
-}
diff --git a/bootstrap/windows-48/WindowsWrapper.h b/bootstrap/windows-48/WindowsWrapper.h
deleted file mode 100644
index b72c815a..00000000
--- a/bootstrap/windows-48/WindowsWrapper.h
+++ /dev/null
@@ -1,10 +0,0 @@
-// WindowsWrapper.h
-//
-// Includes Windows.h while avoiding conflicts with Oberon types.
-
-
-#define BOOLEAN _BOOLEAN
-#define CHAR _CHAR
-#include
-#undef BOOLEAN
-#undef CHAR
diff --git a/bootstrap/windows-48/errors.c b/bootstrap/windows-48/errors.c
deleted file mode 100644
index 68e433df..00000000
--- a/bootstrap/windows-48/errors.c
+++ /dev/null
@@ -1,199 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#include "SYSTEM.h"
-
-typedef
- CHAR errors_string[128];
-
-
-export errors_string errors_errors[350];
-
-
-
-
-
-export void *errors__init(void)
-{
- __DEFMOD;
- __REGMOD("errors", 0);
-/* BEGIN */
- __MOVE("undeclared identifier", errors_errors[0], 22);
- __MOVE("multiply defined identifier", errors_errors[1], 28);
- __MOVE("illegal character in number", errors_errors[2], 28);
- __MOVE("illegal character in string", errors_errors[3], 28);
- __MOVE("identifier does not match procedure name", errors_errors[4], 41);
- __MOVE("comment not closed", errors_errors[5], 19);
- errors_errors[6][0] = 0x00;
- errors_errors[7][0] = 0x00;
- errors_errors[8][0] = 0x00;
- __MOVE("'=' expected", errors_errors[9], 13);
- errors_errors[10][0] = 0x00;
- errors_errors[11][0] = 0x00;
- __MOVE("type definition starts with incorrect symbol", errors_errors[12], 45);
- __MOVE("factor starts with incorrect symbol", errors_errors[13], 36);
- __MOVE("statement starts with incorrect symbol", errors_errors[14], 39);
- __MOVE("declaration followed by incorrect symbol", errors_errors[15], 41);
- __MOVE("MODULE expected", errors_errors[16], 16);
- errors_errors[17][0] = 0x00;
- __MOVE("'.' missing", errors_errors[18], 12);
- __MOVE("',' missing", errors_errors[19], 12);
- __MOVE("':' missing", errors_errors[20], 12);
- errors_errors[21][0] = 0x00;
- __MOVE("')' missing", errors_errors[22], 12);
- __MOVE("']' missing", errors_errors[23], 12);
- __MOVE("'}' missing", errors_errors[24], 12);
- __MOVE("OF missing", errors_errors[25], 11);
- __MOVE("THEN missing", errors_errors[26], 13);
- __MOVE("DO missing", errors_errors[27], 11);
- __MOVE("TO missing", errors_errors[28], 11);
- errors_errors[29][0] = 0x00;
- __MOVE("'(' missing", errors_errors[30], 12);
- errors_errors[31][0] = 0x00;
- errors_errors[32][0] = 0x00;
- errors_errors[33][0] = 0x00;
- __MOVE("':=' missing", errors_errors[34], 13);
- __MOVE("',' or OF expected", errors_errors[35], 19);
- errors_errors[36][0] = 0x00;
- errors_errors[37][0] = 0x00;
- __MOVE("identifier expected", errors_errors[38], 20);
- __MOVE("';' missing", errors_errors[39], 12);
- errors_errors[40][0] = 0x00;
- __MOVE("END missing", errors_errors[41], 12);
- errors_errors[42][0] = 0x00;
- errors_errors[43][0] = 0x00;
- __MOVE("UNTIL missing", errors_errors[44], 14);
- errors_errors[45][0] = 0x00;
- __MOVE("EXIT not within loop statement", errors_errors[46], 31);
- __MOVE("illegally marked identifier", errors_errors[47], 28);
- errors_errors[48][0] = 0x00;
- errors_errors[49][0] = 0x00;
- __MOVE("expression should be constant", errors_errors[50], 30);
- __MOVE("constant not an integer", errors_errors[51], 24);
- __MOVE("identifier does not denote a type", errors_errors[52], 34);
- __MOVE("identifier does not denote a record type", errors_errors[53], 41);
- __MOVE("result type of procedure is not a basic type", errors_errors[54], 45);
- __MOVE("procedure call of a function", errors_errors[55], 29);
- __MOVE("assignment to non-variable", errors_errors[56], 27);
- __MOVE("pointer not bound to record or array type", errors_errors[57], 42);
- __MOVE("recursive type definition", errors_errors[58], 26);
- __MOVE("illegal open array parameter", errors_errors[59], 29);
- __MOVE("wrong type of case label", errors_errors[60], 25);
- __MOVE("inadmissible type of case label", errors_errors[61], 32);
- __MOVE("case label defined more than once", errors_errors[62], 34);
- __MOVE("illegal value of constant", errors_errors[63], 26);
- __MOVE("more actual than formal parameters", errors_errors[64], 35);
- __MOVE("fewer actual than formal parameters", errors_errors[65], 36);
- __MOVE("element types of actual array and formal open array differ", errors_errors[66], 59);
- __MOVE("actual parameter corresponding to open array is not an array", errors_errors[67], 61);
- __MOVE("control variable must be integer", errors_errors[68], 33);
- __MOVE("parameter must be an integer constant", errors_errors[69], 38);
- __MOVE("pointer or VAR record required as formal receiver", errors_errors[70], 50);
- __MOVE("pointer expected as actual receiver", errors_errors[71], 36);
- __MOVE("procedure must be bound to a record of the same scope", errors_errors[72], 54);
- __MOVE("procedure must have level 0", errors_errors[73], 28);
- __MOVE("procedure unknown in base type", errors_errors[74], 31);
- __MOVE("invalid call of base procedure", errors_errors[75], 31);
- __MOVE("this variable (field) is read only", errors_errors[76], 35);
- __MOVE("object is not a record", errors_errors[77], 23);
- __MOVE("dereferenced object is not a variable", errors_errors[78], 38);
- __MOVE("indexed object is not a variable", errors_errors[79], 33);
- __MOVE("index expression is not an integer", errors_errors[80], 35);
- __MOVE("index out of specified bounds", errors_errors[81], 30);
- __MOVE("indexed variable is not an array", errors_errors[82], 33);
- __MOVE("undefined record field", errors_errors[83], 23);
- __MOVE("dereferenced variable is not a pointer", errors_errors[84], 39);
- __MOVE("guard or test type is not an extension of variable type", errors_errors[85], 56);
- __MOVE("guard or testtype is not a pointer", errors_errors[86], 35);
- __MOVE("guarded or tested variable is neither a pointer nor a VAR-parameter record", errors_errors[87], 75);
- __MOVE("open array not allowed as variable, record field or array element", errors_errors[88], 66);
- errors_errors[89][0] = 0x00;
- errors_errors[90][0] = 0x00;
- errors_errors[91][0] = 0x00;
- __MOVE("operand of IN not an integer, or not a set", errors_errors[92], 43);
- __MOVE("set element type is not an integer", errors_errors[93], 35);
- __MOVE("operand of & is not of type BOOLEAN", errors_errors[94], 36);
- __MOVE("operand of OR is not of type BOOLEAN", errors_errors[95], 37);
- __MOVE("operand not applicable to (unary) +", errors_errors[96], 36);
- __MOVE("operand not applicable to (unary) -", errors_errors[97], 36);
- __MOVE("operand of ~ is not of type BOOLEAN", errors_errors[98], 36);
- __MOVE("ASSERT fault", errors_errors[99], 13);
- __MOVE("incompatible operands of dyadic operator", errors_errors[100], 41);
- __MOVE("operand type inapplicable to *", errors_errors[101], 31);
- __MOVE("operand type inapplicable to /", errors_errors[102], 31);
- __MOVE("operand type inapplicable to DIV", errors_errors[103], 33);
- __MOVE("operand type inapplicable to MOD", errors_errors[104], 33);
- __MOVE("operand type inapplicable to +", errors_errors[105], 31);
- __MOVE("operand type inapplicable to -", errors_errors[106], 31);
- __MOVE("operand type inapplicable to = or #", errors_errors[107], 36);
- __MOVE("operand type inapplicable to relation", errors_errors[108], 38);
- __MOVE("overriding method must be exported", errors_errors[109], 35);
- __MOVE("operand is not a type", errors_errors[110], 22);
- __MOVE("operand inapplicable to (this) function", errors_errors[111], 40);
- __MOVE("operand is not a variable", errors_errors[112], 26);
- __MOVE("incompatible assignment", errors_errors[113], 24);
- __MOVE("string too long to be assigned", errors_errors[114], 31);
- __MOVE("parameter doesn't match", errors_errors[115], 24);
- __MOVE("number of parameters doesn't match", errors_errors[116], 35);
- __MOVE("result type doesn't match", errors_errors[117], 26);
- __MOVE("export mark doesn't match with forward declaration", errors_errors[118], 51);
- __MOVE("redefinition textually precedes procedure bound to base type", errors_errors[119], 61);
- __MOVE("type of expression following IF, WHILE, UNTIL or ASSERT is not BOOLEAN", errors_errors[120], 71);
- __MOVE("called object is not a procedure (or is an interrupt procedure)", errors_errors[121], 64);
- __MOVE("actual VAR-parameter is not a variable", errors_errors[122], 39);
- __MOVE("type of actual parameter is not identical with that of formal VAR-parameter", errors_errors[123], 76);
- __MOVE("type of result expression differs from that of procedure", errors_errors[124], 57);
- __MOVE("type of case expression is neither INTEGER nor CHAR", errors_errors[125], 52);
- __MOVE("this expression cannot be a type or a procedure", errors_errors[126], 48);
- __MOVE("illegal use of object", errors_errors[127], 22);
- __MOVE("unsatisfied forward reference", errors_errors[128], 30);
- __MOVE("unsatisfied forward procedure", errors_errors[129], 30);
- __MOVE("WITH clause does not specify a variable", errors_errors[130], 40);
- __MOVE("LEN not applied to array", errors_errors[131], 25);
- __MOVE("dimension in LEN too large or negative", errors_errors[132], 39);
- __MOVE("SYSTEM not imported", errors_errors[135], 20);
- __MOVE("key inconsistency of imported module", errors_errors[150], 37);
- __MOVE("incorrect symbol file", errors_errors[151], 22);
- __MOVE("symbol file of imported module not found", errors_errors[152], 41);
- __MOVE("object or symbol file not opened (disk full\?)", errors_errors[153], 46);
- __MOVE("recursive import not allowed", errors_errors[154], 29);
- __MOVE("generation of new symbol file not allowed", errors_errors[155], 42);
- __MOVE("parameter file not found", errors_errors[156], 25);
- __MOVE("syntax error in parameter file", errors_errors[157], 31);
- __MOVE("not yet implemented", errors_errors[200], 20);
- __MOVE("lower bound of set range greater than higher bound", errors_errors[201], 51);
- __MOVE("set element greater than MAX(SET) or less than 0", errors_errors[202], 49);
- __MOVE("number too large", errors_errors[203], 17);
- __MOVE("product too large", errors_errors[204], 18);
- __MOVE("division by zero", errors_errors[205], 17);
- __MOVE("sum too large", errors_errors[206], 14);
- __MOVE("difference too large", errors_errors[207], 21);
- __MOVE("overflow in arithmetic shift", errors_errors[208], 29);
- __MOVE("case range too large", errors_errors[209], 21);
- __MOVE("too many cases in case statement", errors_errors[213], 33);
- __MOVE("illegal value of parameter (0 <= p < 256)", errors_errors[218], 42);
- __MOVE("machine registers cannot be accessed", errors_errors[219], 37);
- __MOVE("illegal value of parameter", errors_errors[220], 27);
- __MOVE("too many pointers in a record", errors_errors[221], 30);
- __MOVE("too many global pointers", errors_errors[222], 25);
- __MOVE("too many record types", errors_errors[223], 22);
- __MOVE("too many pointer types", errors_errors[224], 23);
- __MOVE("address of pointer variable too large (move forward in text)", errors_errors[225], 61);
- __MOVE("too many exported procedures", errors_errors[226], 29);
- __MOVE("too many imported modules", errors_errors[227], 26);
- __MOVE("too many exported structures", errors_errors[228], 29);
- __MOVE("too many nested records for import", errors_errors[229], 35);
- __MOVE("too many constants (strings) in module", errors_errors[230], 39);
- __MOVE("too many link table entries (external procedures)", errors_errors[231], 50);
- __MOVE("too many commands in module", errors_errors[232], 28);
- __MOVE("record extension hierarchy too high", errors_errors[233], 36);
- __MOVE("export of recursive type not allowed", errors_errors[234], 37);
- __MOVE("identifier too long", errors_errors[240], 20);
- __MOVE("string too long", errors_errors[241], 16);
- __MOVE("address overflow", errors_errors[242], 17);
- __MOVE("cyclic type definition not allowed", errors_errors[244], 35);
- __MOVE("guarded pointer variable may be manipulated by non-local operations; use auxiliary pointer variable", errors_errors[245], 100);
- __MOVE("implicit type cast", errors_errors[301], 19);
- __MOVE("inappropriate symbol file ignored", errors_errors[306], 34);
- __MOVE("no ELSE symbol after CASE statement sequence may lead to trap", errors_errors[307], 62);
- __MOVE("SYSTEM.VAL result includes memory past end of source variable", errors_errors[308], 62);
- __ENDMOD;
-}
diff --git a/bootstrap/windows-48/errors.h b/bootstrap/windows-48/errors.h
deleted file mode 100644
index 41d399ad..00000000
--- a/bootstrap/windows-48/errors.h
+++ /dev/null
@@ -1,18 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-
-#ifndef errors__h
-#define errors__h
-
-#include "SYSTEM.h"
-
-typedef
- CHAR errors_string[128];
-
-
-import errors_string errors_errors[350];
-
-
-import void *errors__init(void);
-
-
-#endif
diff --git a/bootstrap/windows-48/extTools.c b/bootstrap/windows-48/extTools.c
index 4efd107a..37630d23 100644
--- a/bootstrap/windows-48/extTools.c
+++ b/bootstrap/windows-48/extTools.c
@@ -1,29 +1,37 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "Configuration.h"
-#include "Console.h"
+#include "Modules.h"
#include "OPM.h"
+#include "Out.h"
#include "Platform.h"
#include "Strings.h"
-static CHAR extTools_compilationOptions[1023], extTools_CFLAGS[1023];
+static CHAR extTools_CFLAGS[1023];
export void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len);
+static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT s__len);
export void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len);
static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len);
static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len)
{
- INTEGER r, status, exitcode;
+ INT16 r, status, exitcode;
__DUP(title, title__len, CHAR);
__DUP(cmd, cmd__len, CHAR);
- if (OPM_Verbose) {
- Console_String(title, title__len);
- Console_String(cmd, cmd__len);
- Console_Ln();
+ if (__IN(18, OPM_Options, 32)) {
+ Out_String(title, title__len);
+ Out_String(cmd, cmd__len);
+ Out_Ln();
}
r = Platform_System(cmd, cmd__len);
status = __MASK(r, -128);
@@ -32,39 +40,49 @@ static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGIN
exitcode = exitcode - 256;
}
if (r != 0) {
- Console_String(title, title__len);
- Console_String(cmd, cmd__len);
- Console_Ln();
- Console_String((CHAR*)"-- failed: status ", (LONGINT)19);
- Console_Int(status, ((LONGINT)(1)));
- Console_String((CHAR*)", exitcode ", (LONGINT)12);
- Console_Int(exitcode, ((LONGINT)(1)));
- Console_String((CHAR*)".", (LONGINT)2);
- Console_Ln();
+ Out_String(title, title__len);
+ Out_String(cmd, cmd__len);
+ Out_Ln();
+ Out_String((CHAR*)"-- failed: status ", 19);
+ Out_Int(status, 1);
+ Out_String((CHAR*)", exitcode ", 12);
+ Out_Int(exitcode, 1);
+ Out_String((CHAR*)".", 2);
+ Out_Ln();
if ((status == 0 && exitcode == 127)) {
- Console_String((CHAR*)"Is the C compiler in the current command path\?", (LONGINT)47);
- Console_Ln();
+ Out_String((CHAR*)"Is the C compiler in the current command path\?", 47);
+ Out_Ln();
}
if (status != 0) {
- Platform_Halt(status);
+ Modules_Halt(status);
} else {
- Platform_Halt(exitcode);
+ Modules_Halt(exitcode);
}
}
__DEL(title);
__DEL(cmd);
}
+static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT 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);
+ 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);
+}
+
void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len)
{
CHAR cmd[1023];
__DUP(moduleName, moduleName__len, CHAR);
- __MOVE("gcc -g", cmd, 7);
- Strings_Append(extTools_compilationOptions, ((LONGINT)(1023)), (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)"-c ", (LONGINT)4, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)".c", (LONGINT)3, (void*)cmd, ((LONGINT)(1023)));
- extTools_execute((CHAR*)"Assemble: ", (LONGINT)11, cmd, ((LONGINT)(1023)));
+ 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);
}
@@ -72,22 +90,23 @@ void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN stati
{
CHAR cmd[1023];
__DUP(additionalopts, additionalopts__len, CHAR);
- __MOVE("gcc -g", cmd, 7);
- Strings_Append((CHAR*)" ", (LONGINT)2, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append(extTools_compilationOptions, ((LONGINT)(1023)), (void*)cmd, ((LONGINT)(1023)));
- Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)".c ", (LONGINT)4, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append(additionalopts, additionalopts__len, (void*)cmd, ((LONGINT)(1023)));
+ 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", (LONGINT)8, (void*)cmd, ((LONGINT)(1023)));
+ Strings_Append((CHAR*)"-static", 8, (void*)cmd, 1023);
}
- Strings_Append((CHAR*)" -o ", (LONGINT)5, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)" -L\"", (LONGINT)5, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)"/lib\"", (LONGINT)6, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)" -l voc", (LONGINT)8, (void*)cmd, ((LONGINT)(1023)));
- extTools_execute((CHAR*)"Assemble and link: ", (LONGINT)20, cmd, ((LONGINT)(1023)));
+ 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);
}
@@ -96,17 +115,12 @@ export void *extTools__init(void)
{
__DEFMOD;
__MODULE_IMPORT(Configuration);
- __MODULE_IMPORT(Console);
+ __MODULE_IMPORT(Modules);
__MODULE_IMPORT(OPM);
+ __MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
__REGMOD("extTools", 0);
/* BEGIN */
- Strings_Append((CHAR*)" -I \"", (LONGINT)6, (void*)extTools_compilationOptions, ((LONGINT)(1023)));
- Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)extTools_compilationOptions, ((LONGINT)(1023)));
- Strings_Append((CHAR*)"/include\" ", (LONGINT)11, (void*)extTools_compilationOptions, ((LONGINT)(1023)));
- Platform_GetEnv((CHAR*)"CFLAGS", (LONGINT)7, (void*)extTools_CFLAGS, ((LONGINT)(1023)));
- Strings_Append(extTools_CFLAGS, ((LONGINT)(1023)), (void*)extTools_compilationOptions, ((LONGINT)(1023)));
- Strings_Append((CHAR*)" ", (LONGINT)2, (void*)extTools_compilationOptions, ((LONGINT)(1023)));
__ENDMOD;
}
diff --git a/bootstrap/windows-48/extTools.h b/bootstrap/windows-48/extTools.h
index fc4f0da1..63e5df15 100644
--- a/bootstrap/windows-48/extTools.h
+++ b/bootstrap/windows-48/extTools.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef extTools__h
#define extTools__h
@@ -13,4 +13,4 @@ import void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEA
import void *extTools__init(void);
-#endif
+#endif // extTools
diff --git a/bootstrap/windows-48/vt100.c b/bootstrap/windows-48/vt100.c
deleted file mode 100644
index d77b0b84..00000000
--- a/bootstrap/windows-48/vt100.c
+++ /dev/null
@@ -1,258 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#include "SYSTEM.h"
-#include "Console.h"
-#include "Strings.h"
-
-
-export CHAR vt100_CSI[5];
-static CHAR vt100_tmpstr[32];
-
-
-export void vt100_CHA (INTEGER n);
-export void vt100_CNL (INTEGER n);
-export void vt100_CPL (INTEGER n);
-export void vt100_CUB (INTEGER n);
-export void vt100_CUD (INTEGER n);
-export void vt100_CUF (INTEGER n);
-export void vt100_CUP (INTEGER n, INTEGER m);
-export void vt100_CUU (INTEGER n);
-export void vt100_DECTCEMh (void);
-export void vt100_DECTCEMl (void);
-export void vt100_DSR (INTEGER n);
-export void vt100_ED (INTEGER n);
-export void vt100_EL (INTEGER n);
-static void vt100_EscSeq (INTEGER n, CHAR *letter, LONGINT letter__len);
-static void vt100_EscSeq0 (CHAR *letter, LONGINT letter__len);
-static void vt100_EscSeq2 (INTEGER n, INTEGER m, CHAR *letter, LONGINT letter__len);
-static void vt100_EscSeqSwapped (INTEGER n, CHAR *letter, LONGINT letter__len);
-export void vt100_HVP (INTEGER n, INTEGER m);
-export void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len);
-export void vt100_RCP (void);
-static void vt100_Reverse0 (CHAR *str, LONGINT str__len, INTEGER start, INTEGER end);
-export void vt100_SCP (void);
-export void vt100_SD (INTEGER n);
-export void vt100_SGR (INTEGER n);
-export void vt100_SGR2 (INTEGER n, INTEGER m);
-export void vt100_SU (INTEGER n);
-export void vt100_SetAttr (CHAR *attr, LONGINT attr__len);
-
-
-static void vt100_Reverse0 (CHAR *str, LONGINT str__len, INTEGER start, INTEGER end)
-{
- CHAR h;
- while (start < end) {
- h = str[__X(start, str__len)];
- str[__X(start, str__len)] = str[__X(end, str__len)];
- str[__X(end, str__len)] = h;
- start += 1;
- end -= 1;
- }
-}
-
-void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len)
-{
- CHAR b[21];
- INTEGER s, e;
- SHORTINT maxLength;
- maxLength = 11;
- if (int_ == (-2147483647-1)) {
- __MOVE("-2147483648", b, 12);
- e = 11;
- } else {
- if (int_ < 0) {
- b[0] = '-';
- int_ = -int_;
- s = 1;
- } else {
- s = 0;
- }
- e = s;
- do {
- b[__X(e, ((LONGINT)(21)))] = (CHAR)(__MOD(int_, 10) + 48);
- int_ = __DIV(int_, 10);
- e += 1;
- } while (!(int_ == 0));
- b[__X(e, ((LONGINT)(21)))] = 0x00;
- vt100_Reverse0((void*)b, ((LONGINT)(21)), s, e - 1);
- }
- __COPY(b, str, str__len);
-}
-
-static void vt100_EscSeq0 (CHAR *letter, LONGINT letter__len)
-{
- CHAR cmd[9];
- __DUP(letter, letter__len, CHAR);
- __COPY(vt100_CSI, cmd, ((LONGINT)(9)));
- Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(9)));
- Console_String(cmd, ((LONGINT)(9)));
- __DEL(letter);
-}
-
-static void vt100_EscSeq (INTEGER n, CHAR *letter, LONGINT letter__len)
-{
- CHAR nstr[2];
- CHAR cmd[7];
- __DUP(letter, letter__len, CHAR);
- vt100_IntToStr(n, (void*)nstr, ((LONGINT)(2)));
- __COPY(vt100_CSI, cmd, ((LONGINT)(7)));
- Strings_Append(nstr, ((LONGINT)(2)), (void*)cmd, ((LONGINT)(7)));
- Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(7)));
- Console_String(cmd, ((LONGINT)(7)));
- __DEL(letter);
-}
-
-static void vt100_EscSeqSwapped (INTEGER n, CHAR *letter, LONGINT letter__len)
-{
- CHAR nstr[2];
- CHAR cmd[7];
- __DUP(letter, letter__len, CHAR);
- vt100_IntToStr(n, (void*)nstr, ((LONGINT)(2)));
- __COPY(vt100_CSI, cmd, ((LONGINT)(7)));
- Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(7)));
- Strings_Append(nstr, ((LONGINT)(2)), (void*)cmd, ((LONGINT)(7)));
- Console_String(cmd, ((LONGINT)(7)));
- __DEL(letter);
-}
-
-static void vt100_EscSeq2 (INTEGER n, INTEGER m, CHAR *letter, LONGINT letter__len)
-{
- CHAR nstr[5], mstr[5];
- CHAR cmd[12];
- __DUP(letter, letter__len, CHAR);
- vt100_IntToStr(n, (void*)nstr, ((LONGINT)(5)));
- vt100_IntToStr(m, (void*)mstr, ((LONGINT)(5)));
- __COPY(vt100_CSI, cmd, ((LONGINT)(12)));
- Strings_Append(nstr, ((LONGINT)(5)), (void*)cmd, ((LONGINT)(12)));
- Strings_Append((CHAR*)";", (LONGINT)2, (void*)cmd, ((LONGINT)(12)));
- Strings_Append(mstr, ((LONGINT)(5)), (void*)cmd, ((LONGINT)(12)));
- Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(12)));
- Console_String(cmd, ((LONGINT)(12)));
- __DEL(letter);
-}
-
-void vt100_CUU (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"A", (LONGINT)2);
-}
-
-void vt100_CUD (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"B", (LONGINT)2);
-}
-
-void vt100_CUF (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"C", (LONGINT)2);
-}
-
-void vt100_CUB (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"D", (LONGINT)2);
-}
-
-void vt100_CNL (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"E", (LONGINT)2);
-}
-
-void vt100_CPL (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"F", (LONGINT)2);
-}
-
-void vt100_CHA (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"G", (LONGINT)2);
-}
-
-void vt100_CUP (INTEGER n, INTEGER m)
-{
- vt100_EscSeq2(n, m, (CHAR*)"H", (LONGINT)2);
-}
-
-void vt100_ED (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"J", (LONGINT)2);
-}
-
-void vt100_EL (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"K", (LONGINT)2);
-}
-
-void vt100_SU (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"S", (LONGINT)2);
-}
-
-void vt100_SD (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"T", (LONGINT)2);
-}
-
-void vt100_HVP (INTEGER n, INTEGER m)
-{
- vt100_EscSeq2(n, m, (CHAR*)"f", (LONGINT)2);
-}
-
-void vt100_SGR (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"m", (LONGINT)2);
-}
-
-void vt100_SGR2 (INTEGER n, INTEGER m)
-{
- vt100_EscSeq2(n, m, (CHAR*)"m", (LONGINT)2);
-}
-
-void vt100_DSR (INTEGER n)
-{
- vt100_EscSeq(6, (CHAR*)"n", (LONGINT)2);
-}
-
-void vt100_SCP (void)
-{
- vt100_EscSeq0((CHAR*)"s", (LONGINT)2);
-}
-
-void vt100_RCP (void)
-{
- vt100_EscSeq0((CHAR*)"u", (LONGINT)2);
-}
-
-void vt100_DECTCEMl (void)
-{
- vt100_EscSeq0((CHAR*)"\?25l", (LONGINT)5);
-}
-
-void vt100_DECTCEMh (void)
-{
- vt100_EscSeq0((CHAR*)"\?25h", (LONGINT)5);
-}
-
-void vt100_SetAttr (CHAR *attr, LONGINT attr__len)
-{
- CHAR tmpstr[16];
- __DUP(attr, attr__len, CHAR);
- __COPY(vt100_CSI, tmpstr, ((LONGINT)(16)));
- Strings_Append(attr, attr__len, (void*)tmpstr, ((LONGINT)(16)));
- Console_String(tmpstr, ((LONGINT)(16)));
- __DEL(attr);
-}
-
-
-export void *vt100__init(void)
-{
- __DEFMOD;
- __MODULE_IMPORT(Console);
- __MODULE_IMPORT(Strings);
- __REGMOD("vt100", 0);
- __REGCMD("DECTCEMh", vt100_DECTCEMh);
- __REGCMD("DECTCEMl", vt100_DECTCEMl);
- __REGCMD("RCP", vt100_RCP);
- __REGCMD("SCP", vt100_SCP);
-/* BEGIN */
- __COPY("\033", vt100_CSI, ((LONGINT)(5)));
- Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5)));
- __ENDMOD;
-}
diff --git a/bootstrap/windows-48/vt100.h b/bootstrap/windows-48/vt100.h
deleted file mode 100644
index 4af04d6e..00000000
--- a/bootstrap/windows-48/vt100.h
+++ /dev/null
@@ -1,37 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-
-#ifndef vt100__h
-#define vt100__h
-
-#include "SYSTEM.h"
-
-
-import CHAR vt100_CSI[5];
-
-
-import void vt100_CHA (INTEGER n);
-import void vt100_CNL (INTEGER n);
-import void vt100_CPL (INTEGER n);
-import void vt100_CUB (INTEGER n);
-import void vt100_CUD (INTEGER n);
-import void vt100_CUF (INTEGER n);
-import void vt100_CUP (INTEGER n, INTEGER m);
-import void vt100_CUU (INTEGER n);
-import void vt100_DECTCEMh (void);
-import void vt100_DECTCEMl (void);
-import void vt100_DSR (INTEGER n);
-import void vt100_ED (INTEGER n);
-import void vt100_EL (INTEGER n);
-import void vt100_HVP (INTEGER n, INTEGER m);
-import void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len);
-import void vt100_RCP (void);
-import void vt100_SCP (void);
-import void vt100_SD (INTEGER n);
-import void vt100_SGR (INTEGER n);
-import void vt100_SGR2 (INTEGER n, INTEGER m);
-import void vt100_SU (INTEGER n);
-import void vt100_SetAttr (CHAR *attr, LONGINT attr__len);
-import void *vt100__init(void);
-
-
-#endif
diff --git a/bootstrap/windows-88/Compiler.c b/bootstrap/windows-88/Compiler.c
new file mode 100644
index 00000000..dc4bb660
--- /dev/null
+++ b/bootstrap/windows-88/Compiler.c
@@ -0,0 +1,184 @@
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspamS */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
+#include "SYSTEM.h"
+#include "Configuration.h"
+#include "Heap.h"
+#include "OPB.h"
+#include "OPC.h"
+#include "OPM.h"
+#include "OPP.h"
+#include "OPT.h"
+#include "OPV.h"
+#include "Platform.h"
+#include "Strings.h"
+#include "VT100.h"
+#include "extTools.h"
+
+
+static CHAR Compiler_mname[256];
+
+
+export void Compiler_Module (BOOLEAN *done);
+static void Compiler_PropagateElementaryTypeSizes (void);
+export void Compiler_Translate (void);
+static void Compiler_Trap (INT32 sig);
+
+
+void Compiler_Module (BOOLEAN *done)
+{
+ BOOLEAN ext, new;
+ OPT_Node p = NIL;
+ OPP_Module(&p, OPM_Options);
+ if (OPM_noerr) {
+ OPV_Init();
+ OPT_InitRecno();
+ OPV_AdrAndSize(OPT_topScope);
+ OPT_Export(&ext, &new);
+ if (OPM_noerr) {
+ OPM_OpenFiles((void*)OPT_SelfName, 256);
+ OPC_Init();
+ OPV_Module(p);
+ if (OPM_noerr) {
+ if ((__IN(10, OPM_Options, 32) && __STRCMP(OPM_modName, "SYSTEM") != 0)) {
+ OPM_DeleteNewSym();
+ OPM_LogVT100((CHAR*)"32m", 4);
+ OPM_LogWStr((CHAR*)" Main program.", 16);
+ OPM_LogVT100((CHAR*)"0m", 3);
+ } else {
+ if (new) {
+ OPM_LogVT100((CHAR*)"32m", 4);
+ OPM_LogWStr((CHAR*)" New symbol file.", 19);
+ OPM_LogVT100((CHAR*)"0m", 3);
+ OPM_RegisterNewSym();
+ } else if (ext) {
+ OPM_LogWStr((CHAR*)" Extended symbol file.", 24);
+ OPM_RegisterNewSym();
+ }
+ }
+ } else {
+ OPM_DeleteNewSym();
+ }
+ }
+ }
+ OPM_CloseFiles();
+ OPT_Close();
+ OPM_LogWLn();
+ *done = OPM_noerr;
+}
+
+static void Compiler_PropagateElementaryTypeSizes (void)
+{
+ OPT_Struct adrinttyp = NIL;
+ OPT_sysptrtyp->size = OPM_AddressSize;
+ OPT_sysptrtyp->idfp = OPT_sysptrtyp->form;
+ OPM_FPrint(&OPT_sysptrtyp->idfp, OPT_sysptrtyp->size);
+ OPT_adrtyp->size = OPM_AddressSize;
+ OPT_adrtyp->idfp = OPT_adrtyp->form;
+ OPM_FPrint(&OPT_adrtyp->idfp, OPT_adrtyp->size);
+ adrinttyp = OPT_IntType(OPM_AddressSize);
+ OPT_adrtyp->strobj = adrinttyp->strobj;
+ OPT_sinttyp = OPT_IntType(OPM_ShortintSize);
+ OPT_inttyp = OPT_IntType(OPM_IntegerSize);
+ OPT_linttyp = OPT_IntType(OPM_LongintSize);
+ OPT_sintobj->typ = OPT_sinttyp;
+ OPT_intobj->typ = OPT_inttyp;
+ OPT_lintobj->typ = OPT_linttyp;
+ switch (OPM_LongintSize) {
+ case 4:
+ OPT_settyp = OPT_set32typ;
+ break;
+ default:
+ OPT_settyp = OPT_set64typ;
+ break;
+ }
+ OPT_setobj->typ = OPT_settyp;
+ if (__STRCMP(OPM_Model, "C") == 0) {
+ OPT_cpbytetyp->strobj->name[4] = 0x00;
+ } else {
+ OPT_cpbytetyp->strobj->name[4] = '@';
+ }
+}
+
+void Compiler_Translate (void)
+{
+ BOOLEAN done;
+ CHAR modulesobj[2048];
+ modulesobj[0] = 0x00;
+ if (OPM_OpenPar()) {
+ for (;;) {
+ OPM_Init(&done, (void*)Compiler_mname, 256);
+ if (!done) {
+ return;
+ }
+ OPM_InitOptions();
+ Compiler_PropagateElementaryTypeSizes();
+ Heap_GC(0);
+ Compiler_Module(&done);
+ if (!done) {
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Module compilation failed.", 27);
+ OPM_LogWLn();
+ Platform_Exit(1);
+ }
+ if (!__IN(13, OPM_Options, 32)) {
+ if (__IN(14, OPM_Options, 32)) {
+ extTools_Assemble(OPM_modName, 32);
+ } else {
+ if (!__IN(10, OPM_Options, 32)) {
+ extTools_Assemble(OPM_modName, 32);
+ Strings_Append((CHAR*)" ", 2, (void*)modulesobj, 2048);
+ Strings_Append(OPM_modName, 32, (void*)modulesobj, 2048);
+ Strings_Append((CHAR*)".o", 3, (void*)modulesobj, 2048);
+ } else {
+ extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), modulesobj, 2048);
+ }
+ }
+ }
+ }
+ }
+}
+
+static void Compiler_Trap (INT32 sig)
+{
+ Heap_FINALL();
+ if (sig == 3) {
+ Platform_Exit(0);
+ } else {
+ if (sig == 4) {
+ OPM_LogWStr((CHAR*)" --- Oberon compiler internal error", 36);
+ OPM_LogWLn();
+ }
+ Platform_Exit(2);
+ }
+}
+
+
+export int main(int argc, char **argv)
+{
+ __INIT(argc, argv);
+ __MODULE_IMPORT(Configuration);
+ __MODULE_IMPORT(Heap);
+ __MODULE_IMPORT(OPB);
+ __MODULE_IMPORT(OPC);
+ __MODULE_IMPORT(OPM);
+ __MODULE_IMPORT(OPP);
+ __MODULE_IMPORT(OPT);
+ __MODULE_IMPORT(OPV);
+ __MODULE_IMPORT(Platform);
+ __MODULE_IMPORT(Strings);
+ __MODULE_IMPORT(VT100);
+ __MODULE_IMPORT(extTools);
+ __REGMAIN("Compiler", 0);
+ __REGCMD("Translate", Compiler_Translate);
+/* BEGIN */
+ Platform_SetInterruptHandler(Compiler_Trap);
+ Platform_SetQuitHandler(Compiler_Trap);
+ Platform_SetBadInstructionHandler(Compiler_Trap);
+ Compiler_Translate();
+ __FINI;
+}
diff --git a/bootstrap/windows-88/Configuration.c b/bootstrap/windows-88/Configuration.c
index 47f1ffc7..2d0061df 100644
--- a/bootstrap/windows-88/Configuration.c
+++ b/bootstrap/windows-88/Configuration.c
@@ -1,9 +1,14 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
-export CHAR Configuration_versionLong[41];
+export CHAR Configuration_versionLong[75];
@@ -14,6 +19,6 @@ export void *Configuration__init(void)
__DEFMOD;
__REGMOD("Configuration", 0);
/* BEGIN */
- __MOVE("1.95 [2016/08/23] for gcc LP64 on cygwin", Configuration_versionLong, 41);
+ __MOVE("1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75);
__ENDMOD;
}
diff --git a/bootstrap/windows-88/Configuration.h b/bootstrap/windows-88/Configuration.h
index ba0bbd99..b28e0caa 100644
--- a/bootstrap/windows-88/Configuration.h
+++ b/bootstrap/windows-88/Configuration.h
@@ -1,16 +1,15 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Configuration__h
#define Configuration__h
-#define LARGE
#include "SYSTEM.h"
-import CHAR Configuration_versionLong[41];
+import CHAR Configuration_versionLong[75];
import void *Configuration__init(void);
-#endif
+#endif // Configuration
diff --git a/bootstrap/windows-88/Console.c b/bootstrap/windows-88/Console.c
deleted file mode 100644
index 5a9998a9..00000000
--- a/bootstrap/windows-88/Console.c
+++ /dev/null
@@ -1,151 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
-#include "SYSTEM.h"
-#include "Platform.h"
-
-
-static CHAR Console_line[128];
-static INTEGER Console_pos;
-
-
-export void Console_Bool (BOOLEAN b);
-export void Console_Char (CHAR ch);
-export void Console_Flush (void);
-export void Console_Hex (LONGINT i);
-export void Console_Int (LONGINT i, LONGINT n);
-export void Console_Ln (void);
-export void Console_Read (CHAR *ch);
-export void Console_ReadLine (CHAR *line, LONGINT line__len);
-export void Console_String (CHAR *s, LONGINT s__len);
-
-
-void Console_Flush (void)
-{
- INTEGER error;
- error = Platform_Write(Platform_StdOut, (LONGINT)(SYSTEM_ADDRESS)Console_line, Console_pos);
- Console_pos = 0;
-}
-
-void Console_Char (CHAR ch)
-{
- if (Console_pos == 128) {
- Console_Flush();
- }
- Console_line[__X(Console_pos, ((LONGINT)(128)))] = ch;
- Console_pos += 1;
- if (ch == 0x0a) {
- Console_Flush();
- }
-}
-
-void Console_String (CHAR *s, LONGINT s__len)
-{
- INTEGER i;
- __DUP(s, s__len, CHAR);
- i = 0;
- while (s[__X(i, s__len)] != 0x00) {
- Console_Char(s[__X(i, s__len)]);
- i += 1;
- }
- __DEL(s);
-}
-
-void Console_Int (LONGINT i, LONGINT n)
-{
- CHAR s[32];
- LONGINT i1, k;
- if (i == __LSHL(1, 63, LONGINT)) {
- __MOVE("8085774586302733229", s, 20);
- k = 19;
- } else {
- i1 = __ABS(i);
- s[0] = (CHAR)(__MOD(i1, 10) + 48);
- i1 = __DIV(i1, 10);
- k = 1;
- while (i1 > 0) {
- s[__X(k, ((LONGINT)(32)))] = (CHAR)(__MOD(i1, 10) + 48);
- i1 = __DIV(i1, 10);
- k += 1;
- }
- }
- if (i < 0) {
- s[__X(k, ((LONGINT)(32)))] = '-';
- k += 1;
- }
- while (n > k) {
- Console_Char(' ');
- n -= 1;
- }
- while (k > 0) {
- k -= 1;
- Console_Char(s[__X(k, ((LONGINT)(32)))]);
- }
-}
-
-void Console_Ln (void)
-{
- Console_Char(0x0a);
-}
-
-void Console_Bool (BOOLEAN b)
-{
- if (b) {
- Console_String((CHAR*)"TRUE", (LONGINT)5);
- } else {
- Console_String((CHAR*)"FALSE", (LONGINT)6);
- }
-}
-
-void Console_Hex (LONGINT i)
-{
- LONGINT k, n;
- k = -28;
- while (k <= 0) {
- n = __MASK(__ASH(i, k), -16);
- if (n <= 9) {
- Console_Char((CHAR)(48 + n));
- } else {
- Console_Char((CHAR)(55 + n));
- }
- k += 4;
- }
-}
-
-void Console_Read (CHAR *ch)
-{
- LONGINT n;
- INTEGER error;
- Console_Flush();
- error = Platform_ReadBuf(Platform_StdIn, (void*)&*ch, ((LONGINT)(1)), &n);
- if (n != 1) {
- *ch = 0x00;
- }
-}
-
-void Console_ReadLine (CHAR *line, LONGINT line__len)
-{
- LONGINT i;
- CHAR ch;
- Console_Flush();
- i = 0;
- Console_Read(&ch);
- while ((((i < line__len - 1 && ch != 0x0a)) && ch != 0x00)) {
- line[__X(i, line__len)] = ch;
- i += 1;
- Console_Read(&ch);
- }
- line[__X(i, line__len)] = 0x00;
-}
-
-
-export void *Console__init(void)
-{
- __DEFMOD;
- __MODULE_IMPORT(Platform);
- __REGMOD("Console", 0);
- __REGCMD("Flush", Console_Flush);
- __REGCMD("Ln", Console_Ln);
-/* BEGIN */
- Console_pos = 0;
- __ENDMOD;
-}
diff --git a/bootstrap/windows-88/Console.h b/bootstrap/windows-88/Console.h
deleted file mode 100644
index 4606384c..00000000
--- a/bootstrap/windows-88/Console.h
+++ /dev/null
@@ -1,24 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-
-#ifndef Console__h
-#define Console__h
-
-#define LARGE
-#include "SYSTEM.h"
-
-
-
-
-import void Console_Bool (BOOLEAN b);
-import void Console_Char (CHAR ch);
-import void Console_Flush (void);
-import void Console_Hex (LONGINT i);
-import void Console_Int (LONGINT i, LONGINT n);
-import void Console_Ln (void);
-import void Console_Read (CHAR *ch);
-import void Console_ReadLine (CHAR *line, LONGINT line__len);
-import void Console_String (CHAR *s, LONGINT s__len);
-import void *Console__init(void);
-
-
-#endif
diff --git a/bootstrap/windows-88/Files.c b/bootstrap/windows-88/Files.c
index c46ffdd2..c3ea44cf 100644
--- a/bootstrap/windows-88/Files.c
+++ b/bootstrap/windows-88/Files.c
@@ -1,9 +1,13 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
-#include "Configuration.h"
-#include "Console.h"
#include "Heap.h"
+#include "Out.h"
#include "Platform.h"
#include "Strings.h"
@@ -14,7 +18,7 @@ typedef
struct Files_BufDesc {
Files_File f;
BOOLEAN chg;
- LONGINT org, size;
+ INT32 org, size;
SYSTEM_BYTE data[4096];
} Files_BufDesc;
@@ -29,114 +33,115 @@ typedef
Files_FileName workName, registerName;
BOOLEAN tempFile;
Platform_FileIdentity identity;
- LONGINT fd, len, pos;
+ INT64 fd;
+ INT32 len, pos;
Files_Buffer bufs[4];
- INTEGER swapper, state;
+ INT16 swapper, state;
Files_File next;
} Files_FileDesc;
typedef
struct Files_Rider {
- LONGINT res;
+ INT32 res;
BOOLEAN eof;
Files_Buffer buf;
- LONGINT org, offset;
+ INT32 org, offset;
} Files_Rider;
static Files_File Files_files;
-static INTEGER Files_tempno;
+static INT16 Files_tempno;
static CHAR Files_HOME[1024];
static struct {
LONGINT len[1];
CHAR data[1];
} *Files_SearchPath;
-export LONGINT *Files_FileDesc__typ;
-export LONGINT *Files_BufDesc__typ;
-export LONGINT *Files_Rider__typ;
+export ADDRESS *Files_FileDesc__typ;
+export ADDRESS *Files_BufDesc__typ;
+export ADDRESS *Files_Rider__typ;
-export Files_File Files_Base (Files_Rider *r, LONGINT *r__typ);
+export Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
static Files_File Files_CacheEntry (Platform_FileIdentity identity);
-export void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *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, LONGINT name__len, INTEGER *res);
-static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INTEGER 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, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len);
static void Files_Flush (Files_Buffer buf);
-export void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d);
+export void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
export void Files_GetName (Files_File f, CHAR *name, LONGINT name__len);
static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len);
static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len);
-export LONGINT Files_Length (Files_File f);
+export INT32 Files_Length (Files_File f);
static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len);
export Files_File Files_New (CHAR *name, LONGINT name__len);
export Files_File Files_Old (CHAR *name, LONGINT name__len);
-export LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ);
+export INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ);
export void Files_Purge (Files_File f);
-export void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x);
-export void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x);
-export void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len);
-export void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n);
-export void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x);
-export void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x);
-export void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x);
-export void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
-export void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x);
-export void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x);
-export void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x);
-export void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
+export void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
+export void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x);
+export void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+export void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x);
+export void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x);
+export void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
+export void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+export void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
+export void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
+export void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
+export void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
export void Files_Register (Files_File f);
-export void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res);
-static void Files_ScanPath (INTEGER *pos, CHAR *dir, LONGINT dir__len);
-export void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos);
+export void Files_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, LONGINT path__len);
-export void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x);
-export void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x);
-export void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n);
-export void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x);
-export void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x);
-export void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x);
-export void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x);
-export void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x);
-export void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x);
-export void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
+export void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
+export void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
+export void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+export void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
+export void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
+export void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
+export void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
+export void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
+export void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
+export void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
#define Files_IdxTrap() __HALT(-1)
+#define Files_ToAdr(x) (ADDRESS)x
-static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INTEGER errcode)
+static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
{
__DUP(s, s__len, CHAR);
- Console_Ln();
- Console_String((CHAR*)"-- ", (LONGINT)4);
- Console_String(s, s__len);
- Console_String((CHAR*)": ", (LONGINT)3);
+ Out_Ln();
+ Out_String((CHAR*)"-- ", 4);
+ Out_String(s, s__len);
+ Out_String((CHAR*)": ", 3);
if (f != NIL) {
if (f->registerName[0] != 0x00) {
- Console_String(f->registerName, ((LONGINT)(101)));
+ Out_String(f->registerName, 101);
} else {
- Console_String(f->workName, ((LONGINT)(101)));
+ Out_String(f->workName, 101);
}
if (f->fd != 0) {
- Console_String((CHAR*)"f.fd = ", (LONGINT)8);
- Console_Int(f->fd, ((LONGINT)(1)));
+ Out_String((CHAR*)"f.fd = ", 8);
+ Out_Int(f->fd, 1);
}
}
if (errcode != 0) {
- Console_String((CHAR*)" errcode = ", (LONGINT)12);
- Console_Int(errcode, ((LONGINT)(1)));
+ Out_String((CHAR*)" errcode = ", 12);
+ Out_Int(errcode, 1);
}
- Console_Ln();
+ Out_Ln();
__HALT(99);
__DEL(s);
}
static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len)
{
- INTEGER i, j;
+ INT16 i, j;
__DUP(dir, dir__len, CHAR);
__DUP(name, name__len, CHAR);
i = 0;
@@ -161,7 +166,7 @@ static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT
static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len)
{
- LONGINT n, i, j;
+ INT32 n, i, j;
__DUP(finalName, finalName__len, CHAR);
Files_tempno += 1;
n = Files_tempno;
@@ -193,7 +198,7 @@ static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *na
name[i + 5] = '.';
i += 6;
while (n > 0) {
- name[i] = (CHAR)(__MOD(n, 10) + 48);
+ name[i] = (CHAR)((int)__MOD(n, 10) + 48);
n = __DIV(n, 10);
i += 1;
}
@@ -201,7 +206,7 @@ static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *na
i += 1;
n = Platform_PID;
while (n > 0) {
- name[i] = (CHAR)(__MOD(n, 10) + 48);
+ name[i] = (CHAR)((int)__MOD(n, 10) + 48);
n = __DIV(n, 10);
i += 1;
}
@@ -213,19 +218,19 @@ static void Files_Create (Files_File f)
{
Platform_FileIdentity identity;
BOOLEAN done;
- INTEGER error;
+ INT16 error;
CHAR err[32];
if (f->fd == -1) {
if (f->state == 1) {
- Files_GetTempName(f->registerName, ((LONGINT)(101)), (void*)f->workName, ((LONGINT)(101)));
+ Files_GetTempName(f->registerName, 101, (void*)f->workName, 101);
f->tempFile = 1;
} else if (f->state == 2) {
- __COPY(f->registerName, f->workName, ((LONGINT)(101)));
+ __COPY(f->registerName, f->workName, 101);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
- error = Platform_Unlink((void*)f->workName, ((LONGINT)(101)));
- error = Platform_New((void*)f->workName, ((LONGINT)(101)), &f->fd);
+ 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;
@@ -243,14 +248,14 @@ static void Files_Create (Files_File f)
} else {
__MOVE("file not created", err, 17);
}
- Files_Err(err, ((LONGINT)(32)), f, error);
+ Files_Err(err, 32, f, error);
}
}
}
static void Files_Flush (Files_Buffer buf)
{
- INTEGER error;
+ INT16 error;
Files_File f = NIL;
if (buf->chg) {
f = buf->f;
@@ -258,15 +263,15 @@ static void Files_Flush (Files_Buffer buf)
if (buf->org != f->pos) {
error = Platform_Seek(f->fd, buf->org, Platform_SeekSet);
}
- error = Platform_Write(f->fd, (LONGINT)(SYSTEM_ADDRESS)buf->data, buf->size);
+ error = Platform_Write(f->fd, (ADDRESS)buf->data, buf->size);
if (error != 0) {
- Files_Err((CHAR*)"error writing file", (LONGINT)19, f, error);
+ Files_Err((CHAR*)"error writing file", 19, f, error);
}
f->pos = buf->org + buf->size;
buf->chg = 0;
error = Platform_Identify(f->fd, &f->identity, Platform_FileIdentity__typ);
if (error != 0) {
- Files_Err((CHAR*)"error identifying file", (LONGINT)23, f, error);
+ Files_Err((CHAR*)"error identifying file", 23, f, error);
}
}
}
@@ -274,7 +279,7 @@ static void Files_Flush (Files_Buffer buf)
static void Files_CloseOSFile (Files_File f)
{
Files_File prev = NIL;
- INTEGER error;
+ INT16 error;
if (Files_files == f) {
Files_files = f->next;
} else {
@@ -294,8 +299,8 @@ static void Files_CloseOSFile (Files_File f)
void Files_Close (Files_File f)
{
- LONGINT i;
- INTEGER error;
+ INT32 i;
+ INT16 error;
if (f->state != 1 || f->registerName[0] != 0x00) {
Files_Create(f);
i = 0;
@@ -303,42 +308,34 @@ void Files_Close (Files_File f)
Files_Flush(f->bufs[i]);
i += 1;
}
- error = Platform_Sync(f->fd);
- if (error != 0) {
- Files_Err((CHAR*)"error writing file", (LONGINT)19, f, error);
- }
Files_CloseOSFile(f);
}
}
-LONGINT Files_Length (Files_File f)
+INT32 Files_Length (Files_File f)
{
- LONGINT _o_result;
- _o_result = f->len;
- return _o_result;
+ return f->len;
}
Files_File Files_New (CHAR *name, LONGINT name__len)
{
- Files_File _o_result;
Files_File f = NIL;
__DUP(name, name__len, CHAR);
__NEW(f, Files_FileDesc);
f->workName[0] = 0x00;
- __COPY(name, f->registerName, ((LONGINT)(101)));
+ __COPY(name, f->registerName, 101);
f->fd = -1;
f->state = 1;
f->len = 0;
f->pos = 0;
f->swapper = -1;
- _o_result = f;
__DEL(name);
- return _o_result;
+ return f;
}
-static void Files_ScanPath (INTEGER *pos, CHAR *dir, LONGINT dir__len)
+static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len)
{
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
if (Files_SearchPath == NIL) {
@@ -381,8 +378,7 @@ static void Files_ScanPath (INTEGER *pos, CHAR *dir, LONGINT dir__len)
static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len)
{
- BOOLEAN _o_result;
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
ch = name[0];
@@ -390,15 +386,13 @@ static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len)
i += 1;
ch = name[i];
}
- _o_result = ch == '/';
- return _o_result;
+ return ch == '/';
}
static Files_File Files_CacheEntry (Platform_FileIdentity identity)
{
- Files_File _o_result;
Files_File f = NIL;
- INTEGER i, error;
+ INT16 i, error;
f = Files_files;
while (f != NIL) {
if (Platform_SameFile(identity, f->identity)) {
@@ -415,60 +409,56 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
f->identity = identity;
error = Platform_Size(f->fd, &f->len);
}
- _o_result = f;
- return _o_result;
+ return f;
}
f = f->next;
}
- _o_result = NIL;
- return _o_result;
+ return NIL;
}
Files_File Files_Old (CHAR *name, LONGINT name__len)
{
- Files_File _o_result;
Files_File f = NIL;
- LONGINT fd;
- INTEGER pos;
+ INT64 fd;
+ INT16 pos;
BOOLEAN done;
CHAR dir[256], path[256];
- INTEGER error;
+ INT16 error;
Platform_FileIdentity identity;
__DUP(name, name__len, CHAR);
if (name[0] != 0x00) {
if (Files_HasDir((void*)name, name__len)) {
dir[0] = 0x00;
- __COPY(name, path, ((LONGINT)(256)));
+ __COPY(name, path, 256);
} else {
pos = 0;
- Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256)));
- Files_MakeFileName(dir, ((LONGINT)(256)), name, name__len, (void*)path, ((LONGINT)(256)));
- Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256)));
+ Files_ScanPath(&pos, (void*)dir, 256);
+ Files_MakeFileName(dir, 256, name, name__len, (void*)path, 256);
+ Files_ScanPath(&pos, (void*)dir, 256);
}
for (;;) {
- error = Platform_OldRW((void*)path, ((LONGINT)(256)), &fd);
+ error = Platform_OldRW((void*)path, 256, &fd);
done = error == 0;
if ((!done && Platform_TooManyFiles(error))) {
- Files_Err((CHAR*)"too many files open", (LONGINT)20, f, error);
+ Files_Err((CHAR*)"too many files open", 20, f, error);
}
if ((!done && Platform_Inaccessible(error))) {
- error = Platform_OldRO((void*)path, ((LONGINT)(256)), &fd);
+ error = Platform_OldRO((void*)path, 256, &fd);
done = error == 0;
}
if ((!done && !Platform_Absent(error))) {
- Console_String((CHAR*)"Warning: Files.Old ", (LONGINT)20);
- Console_String(name, name__len);
- Console_String((CHAR*)" error = ", (LONGINT)10);
- Console_Int(error, ((LONGINT)(0)));
- Console_Ln();
+ Out_String((CHAR*)"Warning: Files.Old ", 20);
+ Out_String(name, name__len);
+ Out_String((CHAR*)" error = ", 10);
+ Out_Int(error, 0);
+ Out_Ln();
}
if (done) {
error = Platform_Identify(fd, &identity, Platform_FileIdentity__typ);
f = Files_CacheEntry(identity);
if (f != NIL) {
- _o_result = f;
__DEL(name);
- return _o_result;
+ return f;
} else {
__NEW(f, Files_FileDesc);
Heap_RegisterFinalizer((void*)f, Files_Finalize);
@@ -477,39 +467,36 @@ Files_File Files_Old (CHAR *name, LONGINT name__len)
f->pos = 0;
f->swapper = -1;
error = Platform_Size(fd, &f->len);
- __COPY(name, f->workName, ((LONGINT)(101)));
+ __COPY(name, f->workName, 101);
f->registerName[0] = 0x00;
f->tempFile = 0;
f->identity = identity;
f->next = Files_files;
Files_files = f;
Heap_FileCount += 1;
- _o_result = f;
__DEL(name);
- return _o_result;
+ return f;
}
} else if (dir[0] == 0x00) {
- _o_result = NIL;
__DEL(name);
- return _o_result;
+ return NIL;
} else {
- Files_MakeFileName(dir, ((LONGINT)(256)), name, name__len, (void*)path, ((LONGINT)(256)));
- Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256)));
+ Files_MakeFileName(dir, 256, name, name__len, (void*)path, 256);
+ Files_ScanPath(&pos, (void*)dir, 256);
}
}
} else {
- _o_result = NIL;
__DEL(name);
- return _o_result;
+ return NIL;
}
__RETCHK;
}
void Files_Purge (Files_File f)
{
- INTEGER i;
+ INT16 i;
Platform_FileIdentity identity;
- INTEGER error;
+ INT16 error;
i = 0;
while (i < 4) {
if (f->bufs[i] != NIL) {
@@ -519,8 +506,8 @@ void Files_Purge (Files_File f)
i += 1;
}
if (f->fd != -1) {
- error = Platform_Truncate(f->fd, ((LONGINT)(0)));
- error = Platform_Seek(f->fd, ((LONGINT)(0)), Platform_SeekSet);
+ error = Platform_Truncate(f->fd, 0);
+ error = Platform_Seek(f->fd, 0, Platform_SeekSet);
}
f->pos = 0;
f->len = 0;
@@ -529,27 +516,26 @@ void Files_Purge (Files_File f)
Platform_SetMTime(&f->identity, Platform_FileIdentity__typ, identity);
}
-void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d)
+void Files_GetDate (Files_File f, INT32 *t, INT32 *d)
{
Platform_FileIdentity identity;
- INTEGER error;
+ INT16 error;
Files_Create(f);
error = Platform_Identify(f->fd, &identity, Platform_FileIdentity__typ);
Platform_MTimeAsClock(identity, &*t, &*d);
}
-LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ)
+INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ)
{
- LONGINT _o_result;
- _o_result = (*r).org + (*r).offset;
- return _o_result;
+ __ASSERT((*r).offset <= 4096, 0);
+ return (*r).org + (*r).offset;
}
-void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos)
+void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos)
{
- LONGINT org, offset, i, n;
+ INT32 org, offset, i, n;
Files_Buffer buf = NIL;
- INTEGER error;
+ INT16 error;
if (f != NIL) {
if (pos > f->len) {
pos = f->len;
@@ -585,9 +571,9 @@ void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos)
if (f->pos != org) {
error = Platform_Seek(f->fd, org, Platform_SeekSet);
}
- error = Platform_ReadBuf(f->fd, (void*)buf->data, ((LONGINT)(4096)), &n);
+ error = Platform_ReadBuf(f->fd, (void*)buf->data, 4096, &n);
if (error != 0) {
- Files_Err((CHAR*)"read from file not done", (LONGINT)24, f, error);
+ Files_Err((CHAR*)"read from file not done", 24, f, error);
}
f->pos = org + n;
buf->size = n;
@@ -600,6 +586,7 @@ void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos)
org = 0;
offset = 0;
}
+ __ASSERT(offset <= 4096, 0);
(*r).buf = buf;
(*r).org = org;
(*r).offset = offset;
@@ -607,9 +594,9 @@ void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos)
(*r).res = 0;
}
-void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x)
+void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
{
- LONGINT offset;
+ INT32 offset;
Files_Buffer buf = NIL;
buf = (*r).buf;
offset = (*r).offset;
@@ -618,6 +605,7 @@ void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x)
buf = (*r).buf;
offset = (*r).offset;
}
+ __ASSERT(offset <= buf->size, 0);
if (offset < buf->size) {
*x = buf->data[offset];
(*r).offset = offset + 1;
@@ -631,9 +619,9 @@ void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x)
}
}
-void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n)
+void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
{
- LONGINT xpos, min, restInBuf, offset;
+ INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
if (n > x__len) {
Files_IdxTrap();
@@ -657,39 +645,35 @@ void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x
} else {
min = n;
}
- __MOVE((LONGINT)(SYSTEM_ADDRESS)buf->data + offset, (LONGINT)(SYSTEM_ADDRESS)x + xpos, min);
+ __MOVE((ADDRESS)buf->data + Files_ToAdr(offset), (ADDRESS)x + Files_ToAdr(xpos), min);
offset += min;
(*r).offset = offset;
xpos += min;
n -= min;
+ __ASSERT(offset <= 4096, 0);
}
(*r).res = 0;
(*r).eof = 0;
}
-void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len)
+Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ)
{
- Files_ReadBytes(&*r, r__typ, (void*)x, x__len * ((LONGINT)(1)), ((LONGINT)(1)));
+ return (*r).buf->f;
}
-Files_File Files_Base (Files_Rider *r, LONGINT *r__typ)
-{
- Files_File _o_result;
- _o_result = (*r).buf->f;
- return _o_result;
-}
-
-void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x)
+void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
{
Files_Buffer buf = NIL;
- LONGINT offset;
+ INT32 offset;
buf = (*r).buf;
offset = (*r).offset;
+ __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;
}
+ __ASSERT(offset < 4096, 0);
buf->data[offset] = x;
buf->chg = 1;
if (offset == buf->size) {
@@ -700,9 +684,9 @@ void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x)
(*r).res = 0;
}
-void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n)
+void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
{
- LONGINT xpos, min, restInBuf, offset;
+ INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
if (n > x__len) {
Files_IdxTrap();
@@ -711,20 +695,23 @@ void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT
buf = (*r).buf;
offset = (*r).offset;
while (n > 0) {
+ __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;
}
+ __ASSERT(offset <= 4096, 0);
restInBuf = 4096 - offset;
if (n > restInBuf) {
min = restInBuf;
} else {
min = n;
}
- __MOVE((LONGINT)(SYSTEM_ADDRESS)x + xpos, (LONGINT)(SYSTEM_ADDRESS)buf->data + offset, min);
+ __MOVE((ADDRESS)x + Files_ToAdr(xpos), (ADDRESS)buf->data + Files_ToAdr(offset), min);
offset += min;
(*r).offset = offset;
+ __ASSERT(offset <= 4096, 0);
if (offset > buf->size) {
buf->f->len += offset - buf->size;
buf->size = offset;
@@ -736,17 +723,18 @@ void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT
(*r).res = 0;
}
-void Files_Delete (CHAR *name, LONGINT name__len, INTEGER *res)
+void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res)
{
__DUP(name, name__len, CHAR);
*res = Platform_Unlink((void*)name, name__len);
__DEL(name);
}
-void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res)
+void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res)
{
- LONGINT fdold, fdnew, n;
- INTEGER error, ignore;
+ INT64 fdold, fdnew;
+ INT32 n;
+ INT16 error, ignore;
Platform_FileIdentity oldidentity, newidentity;
CHAR buf[4096];
__DUP(old, old__len, CHAR);
@@ -760,28 +748,34 @@ void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT
error = Platform_Rename((void*)old, old__len, (void*)new, new__len);
if (!Platform_DifferentFilesystems(error)) {
*res = error;
+ __DEL(old);
+ __DEL(new);
return;
} else {
error = Platform_OldRO((void*)old, old__len, &fdold);
if (error != 0) {
*res = 2;
+ __DEL(old);
+ __DEL(new);
return;
}
error = Platform_New((void*)new, new__len, &fdnew);
if (error != 0) {
error = Platform_Close(fdold);
*res = 3;
+ __DEL(old);
+ __DEL(new);
return;
}
- error = Platform_Read(fdold, (LONGINT)(SYSTEM_ADDRESS)buf, ((LONGINT)(4096)), &n);
+ error = Platform_Read(fdold, (ADDRESS)buf, 4096, &n);
while (n > 0) {
- error = Platform_Write(fdnew, (LONGINT)(SYSTEM_ADDRESS)buf, n);
+ error = Platform_Write(fdnew, (ADDRESS)buf, n);
if (error != 0) {
ignore = Platform_Close(fdold);
ignore = Platform_Close(fdnew);
- Files_Err((CHAR*)"cannot move file", (LONGINT)17, NIL, error);
+ Files_Err((CHAR*)"cannot move file", 17, NIL, error);
}
- error = Platform_Read(fdold, (LONGINT)(SYSTEM_ADDRESS)buf, ((LONGINT)(4096)), &n);
+ error = Platform_Read(fdold, (ADDRESS)buf, 4096, &n);
}
ignore = Platform_Close(fdold);
ignore = Platform_Close(fdnew);
@@ -789,7 +783,7 @@ void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT
error = Platform_Unlink((void*)old, old__len);
*res = 0;
} else {
- Files_Err((CHAR*)"cannot move file", (LONGINT)17, NIL, error);
+ Files_Err((CHAR*)"cannot move file", 17, NIL, error);
}
}
} else {
@@ -801,7 +795,7 @@ void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT
void Files_Register (Files_File f)
{
- INTEGER idx, errcode;
+ INT16 idx, errcode;
Files_File f1 = NIL;
CHAR file[104];
if ((f->state == 1 && f->registerName[0] != 0x00)) {
@@ -809,18 +803,18 @@ void Files_Register (Files_File f)
}
Files_Close(f);
if (f->registerName[0] != 0x00) {
- Files_Rename(f->workName, ((LONGINT)(101)), f->registerName, ((LONGINT)(101)), &errcode);
+ Files_Rename(f->workName, 101, f->registerName, 101, &errcode);
if (errcode != 0) {
- __COPY(f->registerName, file, ((LONGINT)(104)));
+ __COPY(f->registerName, file, 104);
__HALT(99);
}
- __COPY(f->registerName, f->workName, ((LONGINT)(101)));
+ __COPY(f->registerName, f->workName, 101);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
}
-void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res)
+void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res)
{
__DUP(path, path__len, CHAR);
*res = Platform_Chdir((void*)path, path__len);
@@ -829,7 +823,7 @@ void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res)
static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len)
{
- LONGINT i, j;
+ INT32 i, j;
if (!Platform_LittleEndian) {
i = src__len;
j = 0;
@@ -839,55 +833,55 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *de
j += 1;
}
} else {
- __MOVE((LONGINT)(SYSTEM_ADDRESS)src, (LONGINT)(SYSTEM_ADDRESS)dest, src__len);
+ __MOVE((ADDRESS)src, (ADDRESS)dest, src__len);
}
}
-void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x)
+void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x)
{
Files_Read(&*R, R__typ, (CHAR*)(void*)&*x);
}
-void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x)
+void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x)
{
CHAR b[2];
- Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(2)), ((LONGINT)(2)));
- *x = (int)b[0] + __ASHL((int)b[1], 8);
+ Files_ReadBytes(&*R, R__typ, (void*)b, 2, 2);
+ *x = (INT16)b[0] + __ASHL((INT16)b[1], 8);
}
-void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x)
+void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x)
{
CHAR b[4];
- Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
- *x = (((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((int)b[2], 16)) + __ASHL((int)b[3], 24);
+ Files_ReadBytes(&*R, R__typ, (void*)b, 4, 4);
+ *x = (((INT16)b[0] + __ASHL((INT16)b[1], 8)) + __ASHL(b[2], 16)) + __ASHL(b[3], 24);
}
-void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x)
+void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x)
{
CHAR b[4];
- LONGINT l;
- Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
- l = (((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((int)b[2], 16)) + __ASHL((int)b[3], 24);
- *x = (SET)l;
+ INT32 l;
+ Files_ReadBytes(&*R, R__typ, (void*)b, 4, 4);
+ l = (((INT16)b[0] + __ASHL((INT16)b[1], 8)) + __ASHL(b[2], 16)) + __ASHL(b[3], 24);
+ *x = (UINT32)l;
}
-void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x)
+void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x)
{
CHAR b[4];
- Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
- Files_FlipBytes((void*)b, ((LONGINT)(4)), (void*)&*x, ((LONGINT)(4)));
+ Files_ReadBytes(&*R, R__typ, (void*)b, 4, 4);
+ Files_FlipBytes((void*)b, 4, (void*)&*x, 4);
}
-void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x)
+void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x)
{
CHAR b[8];
- Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(8)), ((LONGINT)(8)));
- Files_FlipBytes((void*)b, ((LONGINT)(8)), (void*)&*x, ((LONGINT)(8)));
+ Files_ReadBytes(&*R, R__typ, (void*)b, 8, 8);
+ Files_FlipBytes((void*)b, 8, (void*)&*x, 8);
}
-void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len)
+void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
{
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
do {
@@ -897,101 +891,100 @@ void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len)
} while (!(ch == 0x00));
}
-void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len)
+void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
{
- INTEGER i;
- CHAR ch;
- BOOLEAN b;
+ INT16 i;
i = 0;
- b = 0;
do {
- Files_Read(&*R, R__typ, (void*)&ch);
- if ((ch == 0x00 || ch == 0x0a) || ch == 0x0d) {
- b = 1;
- } else {
- x[i] = ch;
- i += 1;
- }
- } while (!b);
-}
-
-void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x)
-{
- SHORTINT s;
- CHAR ch;
- LONGINT n;
- s = 0;
- n = 0;
- Files_Read(&*R, R__typ, (void*)&ch);
- while ((int)ch >= 128) {
- n += __ASH((SYSTEM_INT64)((int)ch - 128), s);
- s += 7;
- Files_Read(&*R, R__typ, (void*)&ch);
+ Files_Read(&*R, R__typ, (void*)&x[i]);
+ i += 1;
+ } while (!(x[i - 1] == 0x00 || x[i - 1] == 0x0a));
+ if (x[i - 1] == 0x0a) {
+ i -= 1;
}
- n += __ASH((SYSTEM_INT64)(__MASK((int)ch, -64) - __ASHL(__ASHR((int)ch, 6), 6)), s);
- *x = n;
+ if ((i > 0 && x[i - 1] == 0x0d)) {
+ i -= 1;
+ }
+ x[i] = 0x00;
}
-void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x)
+void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len)
+{
+ INT8 s, b;
+ INT64 q;
+ s = 0;
+ q = 0;
+ Files_Read(&*R, R__typ, (void*)&b);
+ while (b < 0) {
+ q += (INT64)__ASH(((INT16)b + 128), s);
+ s += 7;
+ Files_Read(&*R, R__typ, (void*)&b);
+ }
+ q += (INT64)__ASH((__MASK(b, -64) - __ASHL(__ASHR(b, 6), 6)), s);
+ __ASSERT(x__len <= 8, 0);
+ __MOVE((ADDRESS)&q, (ADDRESS)x, x__len);
+}
+
+void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x)
{
Files_Write(&*R, R__typ, __VAL(CHAR, x));
}
-void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x)
+void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x)
{
CHAR b[2];
b[0] = (CHAR)x;
b[1] = (CHAR)__ASHR(x, 8);
- Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(2)), ((LONGINT)(2)));
+ Files_WriteBytes(&*R, R__typ, (void*)b, 2, 2);
}
-void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x)
+void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x)
{
CHAR b[4];
b[0] = (CHAR)x;
b[1] = (CHAR)__ASHR(x, 8);
b[2] = (CHAR)__ASHR(x, 16);
b[3] = (CHAR)__ASHR(x, 24);
- Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
+ Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
}
-void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x)
+void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x)
{
CHAR b[4];
- LONGINT i;
- i = (LONGINT)x;
+ INT32 i;
+ i = (INT32)x;
b[0] = (CHAR)i;
b[1] = (CHAR)__ASHR(i, 8);
b[2] = (CHAR)__ASHR(i, 16);
b[3] = (CHAR)__ASHR(i, 24);
- Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
+ Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
}
-void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x)
+void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x)
{
CHAR b[4];
- Files_FlipBytes((void*)&x, ((LONGINT)(4)), (void*)b, ((LONGINT)(4)));
- Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
+ Files_FlipBytes((void*)&x, 4, (void*)b, 4);
+ Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
}
-void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x)
+void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x)
{
CHAR b[8];
- Files_FlipBytes((void*)&x, ((LONGINT)(8)), (void*)b, ((LONGINT)(8)));
- Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(8)), ((LONGINT)(8)));
+ Files_FlipBytes((void*)&x, 8, (void*)b, 8);
+ Files_WriteBytes(&*R, R__typ, (void*)b, 8, 8);
}
-void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len)
+void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
{
- INTEGER i;
+ INT16 i;
i = 0;
while (x[i] != 0x00) {
i += 1;
}
- Files_WriteBytes(&*R, R__typ, (void*)x, x__len * ((LONGINT)(1)), i + 1);
+ Files_WriteBytes(&*R, R__typ, (void*)x, x__len * 1, i + 1);
}
-void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x)
+void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x)
{
while (x < -64 || x > 63) {
Files_Write(&*R, R__typ, (CHAR)(__MASK(x, -128) + 128));
@@ -1008,12 +1001,12 @@ void Files_GetName (Files_File f, CHAR *name, LONGINT name__len)
static void Files_Finalize (SYSTEM_PTR o)
{
Files_File f = NIL;
- LONGINT res;
- f = (Files_File)(SYSTEM_ADDRESS)o;
+ INT32 res;
+ f = (Files_File)(ADDRESS)o;
if (f->fd >= 0) {
Files_CloseOSFile(f);
if (f->tempFile) {
- res = Platform_Unlink((void*)f->workName, ((LONGINT)(101)));
+ res = Platform_Unlink((void*)f->workName, 101);
}
}
}
@@ -1022,7 +1015,7 @@ void Files_SetSearchPath (CHAR *path, LONGINT path__len)
{
__DUP(path, path__len, CHAR);
if (Strings_Length(path, path__len) != 0) {
- Files_SearchPath = __NEWARR(NIL, ((LONGINT)(1)), 1, 1, 1, (LONGINT)(Strings_Length(path, path__len) + 1));
+ Files_SearchPath = __NEWARR(NIL, 1, 1, 1, 1, ((ADDRESS)((Strings_Length(path, path__len) + 1))));
__COPY(path, Files_SearchPath->data, Files_SearchPath->len[0]);
} else {
Files_SearchPath = NIL;
@@ -1036,16 +1029,15 @@ static void EnumPtrs(void (*P)(void*))
P(Files_SearchPath);
}
-__TDESC(Files_FileDesc, 1, 5) = {__TDFLDS("FileDesc", 320), {272, 280, 288, 296, 312, -48}};
-__TDESC(Files_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 4128), {0, -16}};
-__TDESC(Files_Rider, 1, 1) = {__TDFLDS("Rider", 40), {16, -16}};
+__TDESC(Files_FileDesc, 1, 5) = {__TDFLDS("FileDesc", 288), {240, 248, 256, 264, 280, -48}};
+__TDESC(Files_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 4120), {0, -16}};
+__TDESC(Files_Rider, 1, 1) = {__TDFLDS("Rider", 24), {8, -16}};
export void *Files__init(void)
{
__DEFMOD;
- __MODULE_IMPORT(Configuration);
- __MODULE_IMPORT(Console);
__MODULE_IMPORT(Heap);
+ __MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
__REGMOD("Files", EnumPtrs);
@@ -1056,6 +1048,6 @@ export void *Files__init(void)
Files_tempno = -1;
Heap_FileCount = 0;
Files_HOME[0] = 0x00;
- Platform_GetEnv((CHAR*)"HOME", (LONGINT)5, (void*)Files_HOME, ((LONGINT)(1024)));
+ Platform_GetEnv((CHAR*)"HOME", 5, (void*)Files_HOME, 1024);
__ENDMOD;
}
diff --git a/bootstrap/windows-88/Files.h b/bootstrap/windows-88/Files.h
index eb946544..5c402312 100644
--- a/bootstrap/windows-88/Files.h
+++ b/bootstrap/windows-88/Files.h
@@ -1,9 +1,8 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
#ifndef Files__h
#define Files__h
-#define LARGE
#include "SYSTEM.h"
typedef
@@ -11,61 +10,61 @@ typedef
typedef
struct Files_FileDesc {
- char _prvt0[248];
- LONGINT fd;
- char _prvt1[64];
+ char _prvt0[224];
+ INT64 fd;
+ char _prvt1[56];
} Files_FileDesc;
typedef
struct Files_Rider {
- LONGINT res;
+ INT32 res;
BOOLEAN eof;
- char _prvt0[31];
+ INT64 _prvt0;
+ char _prvt1[8];
} Files_Rider;
-import LONGINT *Files_FileDesc__typ;
-import LONGINT *Files_Rider__typ;
+import ADDRESS *Files_FileDesc__typ;
+import ADDRESS *Files_Rider__typ;
-import Files_File Files_Base (Files_Rider *r, LONGINT *r__typ);
-import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res);
+import Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
+import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res);
import void Files_Close (Files_File f);
-import void Files_Delete (CHAR *name, LONGINT name__len, INTEGER *res);
-import void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d);
+import void Files_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, LONGINT name__len);
-import LONGINT Files_Length (Files_File f);
+import INT32 Files_Length (Files_File f);
import Files_File Files_New (CHAR *name, LONGINT name__len);
import Files_File Files_Old (CHAR *name, LONGINT name__len);
-import LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ);
+import INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ);
import void Files_Purge (Files_File f);
-import void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x);
-import void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x);
-import void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len);
-import void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n);
-import void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x);
-import void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x);
-import void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x);
-import void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
-import void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x);
-import void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x);
-import void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x);
-import void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
+import void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
+import void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x);
+import void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+import void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x);
+import void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x);
+import void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
+import void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+import void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
+import void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
+import void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
+import void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
import void Files_Register (Files_File f);
-import void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res);
-import void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos);
+import void Files_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, LONGINT path__len);
-import void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x);
-import void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x);
-import void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n);
-import void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x);
-import void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x);
-import void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x);
-import void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x);
-import void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x);
-import void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x);
-import void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len);
+import void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
+import void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
+import void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+import void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
+import void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
+import void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
+import void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
+import void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
+import void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
+import void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
import void *Files__init(void);
-#endif
+#endif // Files
diff --git a/bootstrap/windows-88/Heap.c b/bootstrap/windows-88/Heap.c
index 9873a734..a2bb8f2f 100644
--- a/bootstrap/windows-88/Heap.c
+++ b/bootstrap/windows-88/Heap.c
@@ -1,5 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tskSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tsSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
struct Heap__1 {
@@ -35,7 +40,7 @@ typedef
typedef
struct Heap_FinDesc {
Heap_FinNode next;
- LONGINT obj;
+ INT64 obj;
BOOLEAN marked;
Heap_Finalizer finalize;
} Heap_FinDesc;
@@ -50,62 +55,61 @@ typedef
struct Heap_ModuleDesc {
Heap_Module next;
Heap_ModuleName name;
- LONGINT refcnt;
+ INT32 refcnt;
Heap_Cmd cmds;
- LONGINT types;
+ INT64 types;
Heap_EnumProc enumPtrs;
- LONGINT reserved1, reserved2;
+ INT32 reserved1, reserved2;
} Heap_ModuleDesc;
export SYSTEM_PTR Heap_modules;
-static LONGINT Heap_freeList[10];
-static LONGINT Heap_bigBlocks;
-export LONGINT Heap_allocated;
+static INT64 Heap_freeList[10];
+static INT64 Heap_bigBlocks;
+export INT64 Heap_allocated;
static BOOLEAN Heap_firstTry;
-static LONGINT Heap_heap, Heap_heapend;
-export LONGINT Heap_heapsize;
+static INT64 Heap_heap, Heap_heapend;
+export INT64 Heap_heapsize;
static Heap_FinNode Heap_fin;
-static INTEGER Heap_lockdepth;
+static INT16 Heap_lockdepth;
static BOOLEAN Heap_interrupted;
-export INTEGER Heap_FileCount;
+export INT16 Heap_FileCount;
-export LONGINT *Heap_ModuleDesc__typ;
-export LONGINT *Heap_CmdDesc__typ;
-export LONGINT *Heap_FinDesc__typ;
-export LONGINT *Heap__1__typ;
+export ADDRESS *Heap_ModuleDesc__typ;
+export ADDRESS *Heap_CmdDesc__typ;
+export ADDRESS *Heap_FinDesc__typ;
+export ADDRESS *Heap__1__typ;
static void Heap_CheckFin (void);
-static void Heap_ExtendHeap (LONGINT blksz);
+static void Heap_ExtendHeap (INT64 blksz);
export void Heap_FINALL (void);
static void Heap_Finalize (void);
export void Heap_GC (BOOLEAN markStack);
-static void Heap_HeapSort (LONGINT n, LONGINT *a, LONGINT a__len);
+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 (LONGINT q);
-static void Heap_MarkCandidates (LONGINT n, LONGINT *cand, LONGINT cand__len);
+static void Heap_Mark (INT64 q);
+static void Heap_MarkCandidates (INT64 n, INT64 *cand, LONGINT cand__len);
static void Heap_MarkP (SYSTEM_PTR p);
-static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len);
-export SYSTEM_PTR Heap_NEWBLK (LONGINT size);
-export SYSTEM_PTR Heap_NEWREC (LONGINT tag);
-static LONGINT Heap_NewChunk (LONGINT blksz);
+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);
export void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd);
export SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs);
-export void Heap_REGTYP (Heap_Module m, LONGINT typ);
+export void Heap_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 (LONGINT l, LONGINT r, LONGINT *a, LONGINT 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 LONGINT Platform_MainStackFrame;
-extern LONGINT Platform_OSAllocate(LONGINT size);
-#define Heap_FetchAddress(pointer) (LONGINT)(SYSTEM_ADDRESS)(*((void**)((SYSTEM_ADDRESS)pointer)))
+extern ADDRESS Platform_MainStackFrame;
+extern ADDRESS Platform_OSAllocate(ADDRESS size);
#define Heap_HeapModuleInit() Heap__init()
+#define Heap_ModulesHalt(code) Modules_Halt(code)
#define Heap_OSAllocate(size) Platform_OSAllocate(size)
-#define Heap_PlatformHalt(code) Platform_Halt(code)
#define Heap_PlatformMainStackFrame() Platform_MainStackFrame
void Heap_Lock (void)
@@ -117,28 +121,26 @@ void Heap_Unlock (void)
{
Heap_lockdepth -= 1;
if ((Heap_interrupted && Heap_lockdepth == 0)) {
- Heap_PlatformHalt(((LONGINT)(-9)));
+ Heap_ModulesHalt(-9);
}
}
SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs)
{
- SYSTEM_PTR _o_result;
Heap_Module m;
if (__STRCMP(name, "Heap") == 0) {
- __SYSNEW(m, 80);
+ __SYSNEW(m, 64);
} else {
__NEW(m, Heap_ModuleDesc);
}
m->types = 0;
m->cmds = NIL;
- __COPY(name, m->name, ((LONGINT)(20)));
+ __COPY(name, m->name, 20);
m->refcnt = 0;
m->enumPtrs = enumPtrs;
- m->next = (Heap_Module)(SYSTEM_ADDRESS)Heap_modules;
+ m->next = (Heap_Module)(ADDRESS)Heap_modules;
Heap_modules = (SYSTEM_PTR)m;
- _o_result = (void*)m;
- return _o_result;
+ return (void*)m;
}
void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd)
@@ -149,15 +151,15 @@ void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd)
} else {
__NEW(c, Heap_CmdDesc);
}
- __COPY(name, c->name, ((LONGINT)(24)));
+ __COPY(name, c->name, 24);
c->cmd = cmd;
c->next = m->cmds;
m->cmds = c;
}
-void Heap_REGTYP (Heap_Module m, LONGINT typ)
+void Heap_REGTYP (Heap_Module m, INT64 typ)
{
- __PUT(typ, m->types, LONGINT);
+ __PUT(typ, m->types, INT64);
m->types = typ;
}
@@ -166,27 +168,25 @@ void Heap_INCREF (Heap_Module m)
m->refcnt += 1;
}
-static LONGINT Heap_NewChunk (LONGINT blksz)
+static INT64 Heap_NewChunk (INT64 blksz)
{
- LONGINT _o_result;
- LONGINT chnk;
+ INT64 chnk;
chnk = Heap_OSAllocate(blksz + 24);
if (chnk != 0) {
- __PUT(chnk + 8, chnk + (24 + blksz), LONGINT);
- __PUT(chnk + 24, chnk + 32, LONGINT);
- __PUT(chnk + 32, blksz, LONGINT);
- __PUT(chnk + 40, -8, LONGINT);
- __PUT(chnk + 48, Heap_bigBlocks, LONGINT);
+ __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;
}
- _o_result = chnk;
- return _o_result;
+ return chnk;
}
-static void Heap_ExtendHeap (LONGINT blksz)
+static void Heap_ExtendHeap (INT64 blksz)
{
- LONGINT size, chnk, j, next;
+ INT64 size, chnk, j, next;
if (blksz > 320000) {
size = blksz;
} else {
@@ -195,31 +195,30 @@ static void Heap_ExtendHeap (LONGINT blksz)
chnk = Heap_NewChunk(size);
if (chnk != 0) {
if (chnk < Heap_heap) {
- __PUT(chnk, Heap_heap, LONGINT);
+ __PUT(chnk, Heap_heap, INT64);
Heap_heap = chnk;
} else {
j = Heap_heap;
- next = Heap_FetchAddress(j);
+ __GET(j, next, INT64);
while ((next != 0 && chnk > next)) {
j = next;
- next = Heap_FetchAddress(j);
+ __GET(j, next, INT64);
}
- __PUT(chnk, next, LONGINT);
- __PUT(j, chnk, LONGINT);
+ __PUT(chnk, next, INT64);
+ __PUT(j, chnk, INT64);
}
if (next == 0) {
- Heap_heapend = Heap_FetchAddress(chnk + 8);
+ __GET(chnk + 8, Heap_heapend, INT64);
}
}
}
-SYSTEM_PTR Heap_NEWREC (LONGINT tag)
+SYSTEM_PTR Heap_NEWREC (INT64 tag)
{
- SYSTEM_PTR _o_result;
- LONGINT i, i0, di, blksz, restsize, t, adr, end, next, prev;
+ INT64 i, i0, di, blksz, restsize, t, adr, end, next, prev;
SYSTEM_PTR new;
Heap_Lock();
- blksz = Heap_FetchAddress(tag);
+ __GET(tag, blksz, INT64);
i0 = __ASHR(blksz, 5);
i = i0;
if (i < 9) {
@@ -230,17 +229,17 @@ SYSTEM_PTR Heap_NEWREC (LONGINT tag)
}
}
if (i < 9) {
- next = Heap_FetchAddress(adr + 24);
+ __GET(adr + 24, next, INT64);
Heap_freeList[i] = next;
if (i != i0) {
di = i - i0;
restsize = __ASHL(di, 5);
end = adr + restsize;
- __PUT(end + 8, blksz, LONGINT);
- __PUT(end + 16, -8, LONGINT);
- __PUT(end, end + 8, LONGINT);
- __PUT(adr + 8, restsize, LONGINT);
- __PUT(adr + 24, Heap_freeList[di], LONGINT);
+ __PUT(end + 8, blksz, INT64);
+ __PUT(end + 16, -8, INT64);
+ __PUT(end, end + 8, INT64);
+ __PUT(adr + 8, restsize, INT64);
+ __PUT(adr + 24, Heap_freeList[di], INT64);
Heap_freeList[di] = adr;
adr += restsize;
}
@@ -263,39 +262,37 @@ SYSTEM_PTR Heap_NEWREC (LONGINT tag)
new = Heap_NEWREC(tag);
}
Heap_Unlock();
- _o_result = new;
- return _o_result;
+ return new;
} else {
Heap_Unlock();
- _o_result = NIL;
- return _o_result;
+ return NIL;
}
}
- t = Heap_FetchAddress(adr + 8);
+ __GET(adr + 8, t, INT64);
if (t >= blksz) {
break;
}
prev = adr;
- adr = Heap_FetchAddress(adr + 24);
+ __GET(adr + 24, adr, INT64);
}
restsize = t - blksz;
end = adr + restsize;
- __PUT(end + 8, blksz, LONGINT);
- __PUT(end + 16, -8, LONGINT);
- __PUT(end, end + 8, LONGINT);
+ __PUT(end + 8, blksz, INT64);
+ __PUT(end + 16, -8, INT64);
+ __PUT(end, end + 8, INT64);
if (restsize > 288) {
- __PUT(adr + 8, restsize, LONGINT);
+ __PUT(adr + 8, restsize, INT64);
} else {
- next = Heap_FetchAddress(adr + 24);
+ __GET(adr + 24, next, INT64);
if (prev == 0) {
Heap_bigBlocks = next;
} else {
- __PUT(prev + 24, next, LONGINT);
+ __PUT(prev + 24, next, INT64);
}
if (restsize > 0) {
di = __ASHR(restsize, 5);
- __PUT(adr + 8, restsize, LONGINT);
- __PUT(adr + 24, Heap_freeList[di], LONGINT);
+ __PUT(adr + 8, restsize, INT64);
+ __PUT(adr + 24, Heap_freeList[di], INT64);
Heap_freeList[di] = adr;
}
}
@@ -304,73 +301,70 @@ SYSTEM_PTR Heap_NEWREC (LONGINT tag)
i = adr + 32;
end = adr + blksz;
while (i < end) {
- __PUT(i, 0, LONGINT);
- __PUT(i + 8, 0, LONGINT);
- __PUT(i + 16, 0, LONGINT);
- __PUT(i + 24, 0, LONGINT);
+ __PUT(i, 0, INT64);
+ __PUT(i + 8, 0, INT64);
+ __PUT(i + 16, 0, INT64);
+ __PUT(i + 24, 0, INT64);
i += 32;
}
- __PUT(adr + 24, 0, LONGINT);
- __PUT(adr, tag, LONGINT);
- __PUT(adr + 8, 0, LONGINT);
- __PUT(adr + 16, 0, LONGINT);
+ __PUT(adr + 24, 0, INT64);
+ __PUT(adr, tag, INT64);
+ __PUT(adr + 8, 0, INT64);
+ __PUT(adr + 16, 0, INT64);
Heap_allocated += blksz;
Heap_Unlock();
- _o_result = (SYSTEM_PTR)(SYSTEM_ADDRESS)(adr + 8);
- return _o_result;
+ return (SYSTEM_PTR)(ADDRESS)(adr + 8);
}
-SYSTEM_PTR Heap_NEWBLK (LONGINT size)
+SYSTEM_PTR Heap_NEWBLK (INT64 size)
{
- SYSTEM_PTR _o_result;
- LONGINT blksz, tag;
+ INT64 blksz, tag;
SYSTEM_PTR new;
Heap_Lock();
blksz = __ASHL(__ASHR(size + 63, 5), 5);
- new = Heap_NEWREC((LONGINT)(SYSTEM_ADDRESS)&blksz);
- tag = ((LONGINT)(SYSTEM_ADDRESS)new + blksz) - 24;
- __PUT(tag - 8, 0, LONGINT);
- __PUT(tag, blksz, LONGINT);
- __PUT(tag + 8, -8, LONGINT);
- __PUT((LONGINT)(SYSTEM_ADDRESS)new - 8, tag, LONGINT);
+ new = Heap_NEWREC((ADDRESS)&blksz);
+ tag = ((INT64)(ADDRESS)new + blksz) - 24;
+ __PUT(tag - 8, 0, INT64);
+ __PUT(tag, blksz, INT64);
+ __PUT(tag + 8, -8, INT64);
+ __PUT((INT64)(ADDRESS)new - 8, tag, INT64);
Heap_Unlock();
- _o_result = new;
- return _o_result;
+ return new;
}
-static void Heap_Mark (LONGINT q)
+static void Heap_Mark (INT64 q)
{
- LONGINT p, tag, fld, n, offset, tagbits;
+ INT64 p, tag, offset, fld, n, tagbits;
if (q != 0) {
- tagbits = Heap_FetchAddress(q - 8);
+ __GET(q - 8, tagbits, INT64);
if (!__ODD(tagbits)) {
- __PUT(q - 8, tagbits + 1, LONGINT);
+ __PUT(q - 8, tagbits + 1, INT64);
p = 0;
tag = tagbits + 8;
for (;;) {
- __GET(tag, offset, LONGINT);
+ __GET(tag, offset, INT64);
if (offset < 0) {
- __PUT(q - 8, (tag + offset) + 1, LONGINT);
+ __PUT(q - 8, (tag + offset) + 1, INT64);
if (p == 0) {
break;
}
n = q;
q = p;
- tag = Heap_FetchAddress(q - 8);
+ __GET(q - 8, tag, INT64);
tag -= 1;
- __GET(tag, offset, LONGINT);
+ __GET(tag, offset, INT64);
fld = q + offset;
- p = Heap_FetchAddress(fld);
- __PUT(fld, (SYSTEM_PTR)(SYSTEM_ADDRESS)n, SYSTEM_PTR);
+ __GET(fld, p, INT64);
+ __PUT(fld, (SYSTEM_PTR)(ADDRESS)n, SYSTEM_PTR);
} else {
fld = q + offset;
- n = Heap_FetchAddress(fld);
+ __GET(fld, n, INT64);
if (n != 0) {
- tagbits = Heap_FetchAddress(n - 8);
+ __GET(n - 8, tagbits, INT64);
if (!__ODD(tagbits)) {
- __PUT(n - 8, tagbits + 1, LONGINT);
- __PUT(q - 8, tag + 1, LONGINT);
- __PUT(fld, (SYSTEM_PTR)(SYSTEM_ADDRESS)p, SYSTEM_PTR);
+ __PUT(n - 8, tagbits + 1, INT64);
+ __PUT(q - 8, tag + 1, INT64);
+ __PUT(fld, (SYSTEM_PTR)(ADDRESS)p, SYSTEM_PTR);
p = q;
q = n;
tag = tagbits;
@@ -385,12 +379,12 @@ static void Heap_Mark (LONGINT q)
static void Heap_MarkP (SYSTEM_PTR p)
{
- Heap_Mark((LONGINT)(SYSTEM_ADDRESS)p);
+ Heap_Mark((INT64)(ADDRESS)p);
}
static void Heap_Scan (void)
{
- LONGINT chnk, adr, end, start, tag, i, size, freesize;
+ INT64 chnk, adr, end, start, tag, i, size, freesize;
Heap_bigBlocks = 0;
i = 1;
while (i < 9) {
@@ -402,58 +396,58 @@ static void Heap_Scan (void)
chnk = Heap_heap;
while (chnk != 0) {
adr = chnk + 24;
- end = Heap_FetchAddress(chnk + 8);
+ __GET(chnk + 8, end, INT64);
while (adr < end) {
- tag = Heap_FetchAddress(adr);
+ __GET(adr, tag, INT64);
if (__ODD(tag)) {
if (freesize > 0) {
start = adr - freesize;
- __PUT(start, start + 8, LONGINT);
- __PUT(start + 8, freesize, LONGINT);
- __PUT(start + 16, -8, LONGINT);
+ __PUT(start, start + 8, INT64);
+ __PUT(start + 8, freesize, INT64);
+ __PUT(start + 16, -8, INT64);
i = __ASHR(freesize, 5);
freesize = 0;
if (i < 9) {
- __PUT(start + 24, Heap_freeList[i], LONGINT);
+ __PUT(start + 24, Heap_freeList[i], INT64);
Heap_freeList[i] = start;
} else {
- __PUT(start + 24, Heap_bigBlocks, LONGINT);
+ __PUT(start + 24, Heap_bigBlocks, INT64);
Heap_bigBlocks = start;
}
}
tag -= 1;
- __PUT(adr, tag, LONGINT);
- size = Heap_FetchAddress(tag);
+ __PUT(adr, tag, INT64);
+ __GET(tag, size, INT64);
Heap_allocated += size;
adr += size;
} else {
- size = Heap_FetchAddress(tag);
+ __GET(tag, size, INT64);
freesize += size;
adr += size;
}
}
if (freesize > 0) {
start = adr - freesize;
- __PUT(start, start + 8, LONGINT);
- __PUT(start + 8, freesize, LONGINT);
- __PUT(start + 16, -8, LONGINT);
+ __PUT(start, start + 8, INT64);
+ __PUT(start + 8, freesize, INT64);
+ __PUT(start + 16, -8, INT64);
i = __ASHR(freesize, 5);
freesize = 0;
if (i < 9) {
- __PUT(start + 24, Heap_freeList[i], LONGINT);
+ __PUT(start + 24, Heap_freeList[i], INT64);
Heap_freeList[i] = start;
} else {
- __PUT(start + 24, Heap_bigBlocks, LONGINT);
+ __PUT(start + 24, Heap_bigBlocks, INT64);
Heap_bigBlocks = start;
}
}
- chnk = Heap_FetchAddress(chnk);
+ __GET(chnk, chnk, INT64);
}
}
-static void Heap_Sift (LONGINT l, LONGINT r, LONGINT *a, LONGINT a__len)
+static void Heap_Sift (INT64 l, INT64 r, INT64 *a, LONGINT a__len)
{
- LONGINT i, j, x;
+ INT64 i, j, x;
j = l;
x = a[j];
for (;;) {
@@ -470,9 +464,9 @@ static void Heap_Sift (LONGINT l, LONGINT r, LONGINT *a, LONGINT a__len)
a[i] = x;
}
-static void Heap_HeapSort (LONGINT n, LONGINT *a, LONGINT a__len)
+static void Heap_HeapSort (INT64 n, INT64 *a, LONGINT a__len)
{
- LONGINT l, r, x;
+ INT64 l, r, x;
l = __ASHR(n, 1);
r = n - 1;
while (l > 0) {
@@ -488,25 +482,25 @@ static void Heap_HeapSort (LONGINT n, LONGINT *a, LONGINT a__len)
}
}
-static void Heap_MarkCandidates (LONGINT n, LONGINT *cand, LONGINT cand__len)
+static void Heap_MarkCandidates (INT64 n, INT64 *cand, LONGINT cand__len)
{
- LONGINT chnk, adr, tag, next, lim, lim1, i, ptr, size;
+ INT64 chnk, adr, tag, next, lim, lim1, i, ptr, size;
chnk = Heap_heap;
i = 0;
lim = cand[n - 1];
while ((chnk != 0 && chnk < lim)) {
adr = chnk + 24;
- lim1 = Heap_FetchAddress(chnk + 8);
+ __GET(chnk + 8, lim1, INT64);
if (lim < lim1) {
lim1 = lim;
}
while (adr < lim1) {
- tag = Heap_FetchAddress(adr);
+ __GET(adr, tag, INT64);
if (__ODD(tag)) {
- size = Heap_FetchAddress(tag - 1);
+ __GET(tag - 1, size, INT64);
adr += size;
} else {
- size = Heap_FetchAddress(tag);
+ __GET(tag, size, INT64);
ptr = adr + 8;
while (cand[i] < ptr) {
i += 1;
@@ -521,17 +515,17 @@ static void Heap_MarkCandidates (LONGINT n, LONGINT *cand, LONGINT cand__len)
adr = next;
}
}
- chnk = Heap_FetchAddress(chnk);
+ __GET(chnk, chnk, INT64);
}
}
static void Heap_CheckFin (void)
{
Heap_FinNode n;
- LONGINT tag;
+ INT64 tag;
n = Heap_fin;
while (n != NIL) {
- tag = Heap_FetchAddress(n->obj - 8);
+ __GET(n->obj - 8, tag, INT64);
if (!__ODD(tag)) {
n->marked = 0;
Heap_Mark(n->obj);
@@ -554,7 +548,7 @@ static void Heap_Finalize (void)
} else {
prev->next = n->next;
}
- (*n->finalize)((SYSTEM_PTR)(SYSTEM_ADDRESS)n->obj);
+ (*n->finalize)((SYSTEM_PTR)(ADDRESS)n->obj);
if (prev == NIL) {
n = Heap_fin;
} else {
@@ -573,14 +567,14 @@ void Heap_FINALL (void)
while (Heap_fin != NIL) {
n = Heap_fin;
Heap_fin = Heap_fin->next;
- (*n->finalize)((SYSTEM_PTR)(SYSTEM_ADDRESS)n->obj);
+ (*n->finalize)((SYSTEM_PTR)(ADDRESS)n->obj);
}
}
-static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len)
+static void Heap_MarkStack (INT64 n, INT64 *cand, LONGINT cand__len)
{
SYSTEM_PTR frame;
- LONGINT inc, nofcand, sp, p, stack0;
+ INT64 inc, nofcand, sp, p, stack0;
struct Heap__1 align;
if (n > 0) {
Heap_MarkStack(n - 1, cand, cand__len);
@@ -590,16 +584,16 @@ static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len)
}
if (n == 0) {
nofcand = 0;
- sp = (LONGINT)(SYSTEM_ADDRESS)&frame;
+ sp = (ADDRESS)&frame;
stack0 = Heap_PlatformMainStackFrame();
- inc = (LONGINT)(SYSTEM_ADDRESS)&align.p - (LONGINT)(SYSTEM_ADDRESS)&align;
+ inc = (ADDRESS)&align.p - (ADDRESS)&align;
if (sp > stack0) {
inc = -inc;
}
while (sp != stack0) {
- __GET(sp, p, LONGINT);
+ __GET(sp, p, INT64);
if ((p > Heap_heap && p < Heap_heapend)) {
- if (nofcand == cand__len) {
+ if (nofcand == (INT64)cand__len) {
Heap_HeapSort(nofcand, (void*)cand, cand__len);
Heap_MarkCandidates(nofcand, (void*)cand, cand__len);
nofcand = 0;
@@ -619,11 +613,11 @@ static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len)
void Heap_GC (BOOLEAN markStack)
{
Heap_Module m;
- LONGINT i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23;
- LONGINT cand[10000];
+ INT64 i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23;
+ INT64 cand[10000];
if (Heap_lockdepth == 0 || (Heap_lockdepth == 1 && !markStack)) {
Heap_Lock();
- m = (Heap_Module)(SYSTEM_ADDRESS)Heap_modules;
+ m = (Heap_Module)(ADDRESS)Heap_modules;
while (m != NIL) {
if (m->enumPtrs != NIL) {
(*m->enumPtrs)(Heap_MarkP);
@@ -681,7 +675,7 @@ void Heap_GC (BOOLEAN markStack)
i22 += 23;
i23 += 24;
if ((i0 == -99 && i15 == 24)) {
- Heap_MarkStack(((LONGINT)(32)), (void*)cand, ((LONGINT)(10000)));
+ Heap_MarkStack(32, (void*)cand, 10000);
break;
}
}
@@ -700,7 +694,7 @@ void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
{
Heap_FinNode f;
__NEW(f, Heap_FinDesc);
- f->obj = (LONGINT)(SYSTEM_ADDRESS)obj;
+ f->obj = (INT64)(ADDRESS)obj;
f->finalize = finalize;
f->marked = 1;
f->next = Heap_fin;
@@ -709,9 +703,9 @@ void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
void Heap_InitHeap (void)
{
- Heap_heap = Heap_NewChunk(((LONGINT)(256000)));
- Heap_heapend = Heap_FetchAddress(Heap_heap + 8);
- __PUT(Heap_heap, 0, LONGINT);
+ 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;
@@ -731,7 +725,7 @@ static void EnumPtrs(void (*P)(void*))
P(Heap_fin);
}
-__TDESC(Heap_ModuleDesc, 1, 2) = {__TDFLDS("ModuleDesc", 80), {0, 40, -24}};
+__TDESC(Heap_ModuleDesc, 1, 2) = {__TDFLDS("ModuleDesc", 64), {0, 32, -24}};
__TDESC(Heap_CmdDesc, 1, 1) = {__TDFLDS("CmdDesc", 40), {0, -16}};
__TDESC(Heap_FinDesc, 1, 1) = {__TDFLDS("FinDesc", 32), {0, -16}};
__TDESC(Heap__1, 1, 1) = {__TDFLDS("", 16), {8, -16}};
diff --git a/bootstrap/windows-88/Heap.h b/bootstrap/windows-88/Heap.h
index b1ff5968..163cad8c 100644
--- a/bootstrap/windows-88/Heap.h
+++ b/bootstrap/windows-88/Heap.h
@@ -1,9 +1,8 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tskSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tsSF */
#ifndef Heap__h
#define Heap__h
-#define LARGE
#include "SYSTEM.h"
typedef
@@ -23,8 +22,8 @@ typedef
typedef
struct Heap_ModuleDesc {
- LONGINT _prvt0;
- char _prvt1[72];
+ INT64 _prvt0;
+ char _prvt1[56];
} Heap_ModuleDesc;
typedef
@@ -32,24 +31,24 @@ typedef
import SYSTEM_PTR Heap_modules;
-import LONGINT Heap_allocated, Heap_heapsize;
-import INTEGER Heap_FileCount;
+import INT64 Heap_allocated, Heap_heapsize;
+import INT16 Heap_FileCount;
-import LONGINT *Heap_ModuleDesc__typ;
+import ADDRESS *Heap_ModuleDesc__typ;
import void Heap_FINALL (void);
import void Heap_GC (BOOLEAN markStack);
import void Heap_INCREF (Heap_Module m);
import void Heap_InitHeap (void);
import void Heap_Lock (void);
-import SYSTEM_PTR Heap_NEWBLK (LONGINT size);
-import SYSTEM_PTR Heap_NEWREC (LONGINT tag);
+import SYSTEM_PTR Heap_NEWBLK (INT64 size);
+import SYSTEM_PTR Heap_NEWREC (INT64 tag);
import void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd);
import SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs);
-import void Heap_REGTYP (Heap_Module m, LONGINT typ);
+import void Heap_REGTYP (Heap_Module m, INT64 typ);
import void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize);
import void Heap_Unlock (void);
import void *Heap__init(void);
-#endif
+#endif // Heap
diff --git a/bootstrap/windows-88/Modules.c b/bootstrap/windows-88/Modules.c
index 0c836ead..4e4d62e7 100644
--- a/bootstrap/windows-88/Modules.c
+++ b/bootstrap/windows-88/Modules.c
@@ -1,8 +1,13 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
-#include "Console.h"
#include "Heap.h"
+#include "Platform.h"
typedef
struct Modules_CmdDesc *Modules_Cmd;
@@ -27,32 +32,38 @@ typedef
struct Modules_ModuleDesc {
Modules_Module next;
Modules_ModuleName name;
- LONGINT refcnt;
+ INT32 refcnt;
Modules_Cmd cmds;
- LONGINT types;
- void (*enumPtrs)(void(*)(LONGINT));
- LONGINT reserved1, reserved2;
+ INT32 types;
+ void (*enumPtrs)(void(*)(INT32));
+ INT32 reserved1, reserved2;
} Modules_ModuleDesc;
-export INTEGER Modules_res;
+export INT16 Modules_res;
export CHAR Modules_resMsg[256];
export Modules_ModuleName Modules_imported, Modules_importing;
-export LONGINT *Modules_ModuleDesc__typ;
-export LONGINT *Modules_CmdDesc__typ;
+export ADDRESS *Modules_ModuleDesc__typ;
+export ADDRESS *Modules_CmdDesc__typ;
static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len);
+export void Modules_AssertFail (INT32 code);
+static void Modules_DisplayHaltCode (INT32 code);
export void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
+export void Modules_Halt (INT32 code);
export Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
export Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
+static void Modules_errch (CHAR c);
+static void Modules_errint (INT32 l);
+static void Modules_errstring (CHAR *s, LONGINT s__len);
#define Modules_modules() (Modules_Module)Heap_modules
#define Modules_setmodules(m) Heap_modules = m
static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len)
{
- INTEGER i, j;
+ INT16 i, j;
__DUP(b, b__len, CHAR);
i = 0;
while (a[__X(i, a__len)] != 0x00) {
@@ -70,7 +81,6 @@ static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len)
Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
{
- Modules_Module _o_result;
Modules_Module m = NIL;
CHAR bodyname[64];
Modules_Command body;
@@ -84,19 +94,17 @@ Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
Modules_resMsg[0] = 0x00;
} else {
Modules_res = 1;
- __COPY(name, Modules_importing, ((LONGINT)(20)));
+ __COPY(name, Modules_importing, 20);
__MOVE(" module \"", Modules_resMsg, 10);
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), name, name__len);
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)"\" not found", (LONGINT)12);
+ Modules_Append((void*)Modules_resMsg, 256, name, name__len);
+ Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
}
- _o_result = m;
__DEL(name);
- return _o_result;
+ return m;
}
Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len)
{
- Modules_Command _o_result;
Modules_Cmd c = NIL;
__DUP(name, name__len, CHAR);
c = mod->cmds;
@@ -106,20 +114,18 @@ Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT nam
if (c != NIL) {
Modules_res = 0;
Modules_resMsg[0] = 0x00;
- _o_result = c->cmd;
__DEL(name);
- return _o_result;
+ return c->cmd;
} else {
Modules_res = 2;
__MOVE(" command \"", Modules_resMsg, 11);
- __COPY(name, Modules_importing, ((LONGINT)(20)));
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), mod->name, ((LONGINT)(20)));
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)".", (LONGINT)2);
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), name, name__len);
- Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)"\" not found", (LONGINT)12);
- _o_result = NIL;
+ __COPY(name, Modules_importing, 20);
+ Modules_Append((void*)Modules_resMsg, 256, mod->name, 20);
+ Modules_Append((void*)Modules_resMsg, 256, (CHAR*)".", 2);
+ Modules_Append((void*)Modules_resMsg, 256, name, name__len);
+ Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
__DEL(name);
- return _o_result;
+ return NIL;
}
__RETCHK;
}
@@ -156,14 +162,124 @@ void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all)
__DEL(name);
}
-__TDESC(Modules_ModuleDesc, 1, 2) = {__TDFLDS("ModuleDesc", 80), {0, 40, -24}};
+static void Modules_errch (CHAR c)
+{
+ INT16 e;
+ e = Platform_Write(1, (ADDRESS)&c, 1);
+}
+
+static void Modules_errstring (CHAR *s, LONGINT s__len)
+{
+ INT32 i;
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
+ Modules_errch(s[__X(i, s__len)]);
+ i += 1;
+ }
+ __DEL(s);
+}
+
+static void Modules_errint (INT32 l)
+{
+ if (l < 0) {
+ Modules_errch('-');
+ l = -l;
+ }
+ if (l >= 10) {
+ Modules_errint(__DIV(l, 10));
+ }
+ Modules_errch((CHAR)((int)__MOD(l, 10) + 48));
+}
+
+static void Modules_DisplayHaltCode (INT32 code)
+{
+ switch (code) {
+ case -1:
+ Modules_errstring((CHAR*)"Assertion failure.", 19);
+ break;
+ case -2:
+ Modules_errstring((CHAR*)"Index out of range.", 20);
+ break;
+ case -3:
+ Modules_errstring((CHAR*)"Reached end of function without reaching RETURN.", 49);
+ break;
+ case -4:
+ Modules_errstring((CHAR*)"CASE statement: no matching label and no ELSE.", 47);
+ break;
+ case -5:
+ Modules_errstring((CHAR*)"Type guard failed.", 19);
+ break;
+ case -6:
+ Modules_errstring((CHAR*)"Implicit type guard in record assignment failed.", 49);
+ break;
+ case -7:
+ Modules_errstring((CHAR*)"Invalid case in WITH statement.", 32);
+ break;
+ case -8:
+ Modules_errstring((CHAR*)"Value out of range.", 20);
+ break;
+ case -9:
+ Modules_errstring((CHAR*)"Heap interrupted while locked, but lockdepth = 0 at unlock.", 60);
+ break;
+ case -10:
+ Modules_errstring((CHAR*)"NIL access.", 12);
+ break;
+ case -11:
+ Modules_errstring((CHAR*)"Alignment error.", 17);
+ break;
+ case -12:
+ Modules_errstring((CHAR*)"Divide by zero.", 16);
+ break;
+ case -13:
+ Modules_errstring((CHAR*)"Arithmetic overflow/underflow.", 31);
+ break;
+ case -14:
+ Modules_errstring((CHAR*)"Invalid function argument.", 27);
+ break;
+ case -15:
+ Modules_errstring((CHAR*)"Internal error, e.g. Type descriptor size mismatch.", 52);
+ break;
+ case -20:
+ Modules_errstring((CHAR*)"Too many, or negative number of, elements in dynamic array.", 60);
+ break;
+ default:
+ break;
+ }
+}
+
+void Modules_Halt (INT32 code)
+{
+ Modules_errstring((CHAR*)"Terminated by Halt(", 20);
+ Modules_errint(code);
+ Modules_errstring((CHAR*)"). ", 4);
+ if (code < 0) {
+ Modules_DisplayHaltCode(code);
+ }
+ Modules_errstring(Platform_NL, 3);
+ Platform_Exit(code);
+}
+
+void Modules_AssertFail (INT32 code)
+{
+ Modules_errstring((CHAR*)"Assertion failure.", 19);
+ if (code != 0) {
+ Modules_errstring((CHAR*)" ASSERT code ", 14);
+ Modules_errint(code);
+ Modules_errstring((CHAR*)".", 2);
+ }
+ Modules_errstring(Platform_NL, 3);
+ 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)
{
__DEFMOD;
- __MODULE_IMPORT(Console);
__MODULE_IMPORT(Heap);
+ __MODULE_IMPORT(Platform);
__REGMOD("Modules", 0);
__INITYP(Modules_ModuleDesc, Modules_ModuleDesc, 0);
__INITYP(Modules_CmdDesc, Modules_CmdDesc, 0);
diff --git a/bootstrap/windows-88/Modules.h b/bootstrap/windows-88/Modules.h
index 6e6ded2e..8bb89fe5 100644
--- a/bootstrap/windows-88/Modules.h
+++ b/bootstrap/windows-88/Modules.h
@@ -1,9 +1,8 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Modules__h
#define Modules__h
-#define LARGE
#include "SYSTEM.h"
typedef
@@ -29,27 +28,27 @@ typedef
struct Modules_ModuleDesc {
Modules_Module next;
Modules_ModuleName name;
- LONGINT refcnt;
+ INT32 refcnt;
Modules_Cmd cmds;
- LONGINT types;
- void (*enumPtrs)(void(*)(LONGINT));
- char _prvt0[16];
+ INT32 types;
+ void (*enumPtrs)(void(*)(INT32));
+ char _prvt0[8];
} Modules_ModuleDesc;
-import INTEGER Modules_res;
+import INT16 Modules_res;
import CHAR Modules_resMsg[256];
import Modules_ModuleName Modules_imported, Modules_importing;
-import LONGINT *Modules_ModuleDesc__typ;
-import LONGINT *Modules_CmdDesc__typ;
+import ADDRESS *Modules_ModuleDesc__typ;
+import ADDRESS *Modules_CmdDesc__typ;
+import void Modules_AssertFail (INT32 code);
import void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
+import void Modules_Halt (INT32 code);
import Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
import Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
import void *Modules__init(void);
-#define Modules_modules() (Modules_Module)Heap_modules
-#define Modules_setmodules(m) Heap_modules = m
-#endif
+#endif // Modules
diff --git a/bootstrap/windows-88/OPB.c b/bootstrap/windows-88/OPB.c
index f4bdb1a8..3ef8e2f9 100644
--- a/bootstrap/windows-88/OPB.c
+++ b/bootstrap/windows-88/OPB.c
@@ -1,19 +1,23 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "OPM.h"
#include "OPS.h"
#include "OPT.h"
-export void (*OPB_typSize)(OPT_Struct);
-static INTEGER OPB_exp;
-static LONGINT OPB_maxExp;
+static INT16 OPB_exp;
+static INT64 OPB_maxExp;
export void OPB_Assign (OPT_Node *x, OPT_Node y);
-static void OPB_BindNodes (SHORTINT class, OPT_Struct typ, OPT_Node *x, OPT_Node y);
-static LONGINT OPB_BoolToInt (BOOLEAN b);
+static void OPB_BindNodes (INT8 class, OPT_Struct typ, OPT_Node *x, OPT_Node y);
+static INT16 OPB_BoolToInt (BOOLEAN b);
export void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp);
static void OPB_CharToString (OPT_Node n);
static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode);
@@ -21,10 +25,10 @@ static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo);
export void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames);
static void OPB_CheckProc (OPT_Struct x, OPT_Object y);
static void OPB_CheckPtr (OPT_Node x, OPT_Node y);
-static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x);
+static void OPB_CheckRealType (INT16 f, INT16 nr, OPT_Const x);
static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp);
-static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y);
-export void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y);
+static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y);
+export void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y);
static void OPB_Convert (OPT_Node *x, OPT_Struct typ);
export void OPB_DeRef (OPT_Node *x);
static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar);
@@ -34,19 +38,17 @@ export void OPB_Field (OPT_Node *x, OPT_Object y);
export void OPB_In (OPT_Node *x, OPT_Node y);
export void OPB_Index (OPT_Node *x, OPT_Node y);
export void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ);
-static BOOLEAN OPB_IntToBool (LONGINT i);
-static OPT_Struct OPB_IntType (LONGINT size);
+static BOOLEAN OPB_IntToBool (INT64 i);
export void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y);
-static LONGINT OPB_LongerSize (LONGINT i);
-export void OPB_MOp (SHORTINT op, OPT_Node *x);
+export void OPB_MOp (INT8 op, OPT_Node *x);
export OPT_Node OPB_NewBoolConst (BOOLEAN boolval);
-export OPT_Node OPB_NewIntConst (LONGINT intval);
+export OPT_Node OPB_NewIntConst (INT64 intval);
export OPT_Node OPB_NewLeaf (OPT_Object obj);
export OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ);
-export OPT_Node OPB_NewString (OPS_String str, LONGINT len);
+export OPT_Node OPB_NewString (OPS_String str, INT64 len);
export OPT_Node OPB_Nil (void);
static BOOLEAN OPB_NotVar (OPT_Node x);
-export void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y);
+export void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y);
export void OPB_OptIf (OPT_Node *x);
export void OPB_Param (OPT_Node ap, OPT_Object fp);
export void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar);
@@ -54,26 +56,24 @@ export void OPB_Return (OPT_Node *x, OPT_Object proc);
export void OPB_SetElem (OPT_Node *x);
static void OPB_SetIntType (OPT_Node node);
export void OPB_SetRange (OPT_Node *x, OPT_Node y);
-static LONGINT OPB_ShorterSize (LONGINT i);
-static INTEGER OPB_SignedByteSize (LONGINT n);
-export void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno);
-export void OPB_StPar0 (OPT_Node *par0, INTEGER fctno);
-export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno);
-export void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n);
-export void OPB_StaticLink (SHORTINT dlev);
+static void OPB_SetSetType (OPT_Node node);
+export void OPB_StFct (OPT_Node *par0, INT8 fctno, INT16 parno);
+export void OPB_StPar0 (OPT_Node *par0, INT16 fctno);
+export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno);
+export void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n);
+export void OPB_StaticLink (INT8 dlev);
export void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard);
-static void OPB_err (INTEGER n);
-static LONGINT OPB_log (LONGINT x);
+static void OPB_err (INT16 n);
+static INT64 OPB_log (INT64 x);
-static void OPB_err (INTEGER n)
+static void OPB_err (INT16 n)
{
OPM_err(n);
}
OPT_Node OPB_NewLeaf (OPT_Object obj)
{
- OPT_Node _o_result;
OPT_Node node = NIL;
switch (obj->mode) {
case 1:
@@ -101,11 +101,10 @@ OPT_Node OPB_NewLeaf (OPT_Object obj)
}
node->obj = obj;
node->typ = obj->typ;
- _o_result = node;
- return _o_result;
+ return node;
}
-void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y)
+void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y)
{
OPT_Node node = NIL;
node = OPT_NewNode(class);
@@ -128,42 +127,29 @@ void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y)
*last = y;
}
-static LONGINT OPB_BoolToInt (BOOLEAN b)
+static INT16 OPB_BoolToInt (BOOLEAN b)
{
- LONGINT _o_result;
if (b) {
- _o_result = 1;
- return _o_result;
+ return 1;
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-static BOOLEAN OPB_IntToBool (LONGINT i)
+static BOOLEAN OPB_IntToBool (INT64 i)
{
- BOOLEAN _o_result;
- if (i == 0) {
- _o_result = 0;
- return _o_result;
- } else {
- _o_result = 1;
- return _o_result;
- }
- __RETCHK;
+ return i != 0;
}
OPT_Node OPB_NewBoolConst (BOOLEAN boolval)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->typ = OPT_booltyp;
x->conval = OPT_NewConst();
x->conval->intval = OPB_BoolToInt(boolval);
- _o_result = x;
- return _o_result;
+ return x;
}
void OPB_OptIf (OPT_Node *x)
@@ -203,130 +189,72 @@ void OPB_OptIf (OPT_Node *x)
OPT_Node OPB_Nil (void)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->typ = OPT_niltyp;
x->conval = OPT_NewConst();
x->conval->intval = 0;
- _o_result = x;
- return _o_result;
+ return x;
}
OPT_Node OPB_EmptySet (void)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->typ = OPT_settyp;
x->conval = OPT_NewConst();
x->conval->setval = 0x0;
- _o_result = x;
- return _o_result;
-}
-
-static INTEGER OPB_SignedByteSize (LONGINT n)
-{
- INTEGER _o_result;
- INTEGER b;
- if (n < 0) {
- n = -(n + 1);
- }
- b = 1;
- while ((b < 8 && __ASH(n, -(__ASHL(b, 3) - 1)) != 0)) {
- b += 1;
- }
- _o_result = b;
- return _o_result;
-}
-
-static LONGINT OPB_ShorterSize (LONGINT i)
-{
- LONGINT _o_result;
- if (i >= (SYSTEM_INT64)OPM_LIntSize) {
- _o_result = OPM_IntSize;
- return _o_result;
- } else {
- _o_result = OPM_SIntSize;
- return _o_result;
- }
- __RETCHK;
-}
-
-static LONGINT OPB_LongerSize (LONGINT i)
-{
- LONGINT _o_result;
- if (i <= (SYSTEM_INT64)OPM_SIntSize) {
- _o_result = OPM_IntSize;
- return _o_result;
- } else {
- _o_result = OPM_LIntSize;
- return _o_result;
- }
- __RETCHK;
-}
-
-static OPT_Struct OPB_IntType (LONGINT size)
-{
- OPT_Struct _o_result;
- OPT_Struct result = NIL;
- if (size <= OPT_sinttyp->size) {
- result = OPT_sinttyp;
- } else if (size <= OPT_inttyp->size) {
- result = OPT_inttyp;
- } else {
- result = OPT_linttyp;
- }
- if (size > OPT_linttyp->size) {
- OPB_err(203);
- }
- _o_result = result;
- return _o_result;
+ return x;
}
static void OPB_SetIntType (OPT_Node node)
{
- node->typ = OPB_IntType(OPB_SignedByteSize(node->conval->intval));
+ node->typ = OPT_IntType(OPT_IntSize(node->conval->intval));
}
-OPT_Node OPB_NewIntConst (LONGINT intval)
+static void OPB_SetSetType (OPT_Node node)
+{
+ INT32 i32;
+ __GET((ADDRESS)&node->conval->setval + 4, i32, INT32);
+ if (i32 == 0) {
+ node->typ = OPT_set32typ;
+ } else {
+ node->typ = OPT_set64typ;
+ }
+}
+
+OPT_Node OPB_NewIntConst (INT64 intval)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->conval = OPT_NewConst();
x->conval->intval = intval;
OPB_SetIntType(x);
- _o_result = x;
- return _o_result;
+ return x;
}
OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->conval = OPT_NewConst();
x->conval->realval = realval;
x->typ = typ;
x->conval->intval = -1;
- _o_result = x;
- return _o_result;
+ return x;
}
-OPT_Node OPB_NewString (OPS_String str, LONGINT len)
+OPT_Node OPB_NewString (OPS_String str, INT64 len)
{
- OPT_Node _o_result;
OPT_Node x = NIL;
x = OPT_NewNode(7);
x->conval = OPT_NewConst();
x->typ = OPT_stringtyp;
x->conval->intval = -1;
- x->conval->intval2 = len;
+ x->conval->intval2 = OPM_Longint(len);
x->conval->ext = OPT_NewExt();
- __COPY(str, *x->conval->ext, ((LONGINT)(256)));
- _o_result = x;
- return _o_result;
+ __COPY(str, *x->conval->ext, 256);
+ return x;
}
static void OPB_CharToString (OPT_Node n)
@@ -346,7 +274,7 @@ static void OPB_CharToString (OPT_Node n)
n->obj = NIL;
}
-static void OPB_BindNodes (SHORTINT class, OPT_Struct typ, OPT_Node *x, OPT_Node y)
+static void OPB_BindNodes (INT8 class, OPT_Struct typ, OPT_Node *x, OPT_Node y)
{
OPT_Node node = NIL;
node = OPT_NewNode(class);
@@ -358,9 +286,7 @@ static void OPB_BindNodes (SHORTINT class, OPT_Struct typ, OPT_Node *x, OPT_Node
static BOOLEAN OPB_NotVar (OPT_Node x)
{
- BOOLEAN _o_result;
- _o_result = (x->class >= 7 && ((x->class != 11 || x->subcl != 29) || x->left->class >= 7));
- return _o_result;
+ return (x->class >= 7 && ((x->class != 11 || x->subcl != 29) || x->left->class >= 7));
}
void OPB_DeRef (OPT_Node *x)
@@ -370,7 +296,7 @@ void OPB_DeRef (OPT_Node *x)
typ = (*x)->typ;
if ((*x)->class >= 7) {
OPB_err(78);
- } else if (typ->form == 13) {
+ } else if (typ->form == 11) {
if (typ == OPT_sysptrtyp) {
OPB_err(57);
}
@@ -388,18 +314,18 @@ void OPB_DeRef (OPT_Node *x)
void OPB_Index (OPT_Node *x, OPT_Node y)
{
- INTEGER f;
+ INT16 f;
OPT_Struct typ = NIL;
f = y->typ->form;
if ((*x)->class >= 7) {
OPB_err(79);
- } else if (!__IN(f, 0x70) || __IN(y->class, 0x0300)) {
+ } else if (f != 4 || __IN(y->class, 0x0300, 32)) {
OPB_err(80);
y->typ = OPT_inttyp;
}
if ((*x)->typ->comp == 2) {
typ = (*x)->typ->BaseTyp;
- if ((y->class == 7 && (y->conval->intval < 0 || y->conval->intval >= (*x)->typ->n))) {
+ if ((y->class == 7 && (y->conval->intval < 0 || y->conval->intval >= (INT64)(*x)->typ->n))) {
OPB_err(81);
}
} else if ((*x)->typ->comp == 3) {
@@ -420,7 +346,7 @@ void OPB_Field (OPT_Node *x, OPT_Object y)
if ((*x)->class >= 7) {
OPB_err(77);
}
- if ((y != NIL && __IN(y->mode, 0x2010))) {
+ if ((y != NIL && __IN(y->mode, 0x2010, 32))) {
OPB_BindNodes(2, y->typ, &*x, NIL);
(*x)->obj = y;
(*x)->readonly = (*x)->left->readonly || (y->vis == 2 && y->mnolev < 0);
@@ -430,16 +356,16 @@ void OPB_Field (OPT_Node *x, OPT_Object y)
}
}
-static struct TypTest__61 {
+static struct TypTest__58 {
OPT_Node *x;
OPT_Object *obj;
BOOLEAN *guard;
- struct TypTest__61 *lnk;
-} *TypTest__61_s;
+ struct TypTest__58 *lnk;
+} *TypTest__58_s;
-static void GTT__62 (OPT_Struct t0, OPT_Struct t1);
+static void GTT__59 (OPT_Struct t0, OPT_Struct t1);
-static void GTT__62 (OPT_Struct t0, OPT_Struct t1)
+static void GTT__59 (OPT_Struct t0, OPT_Struct t1)
{
OPT_Node node = NIL;
OPT_Struct t = NIL;
@@ -452,54 +378,54 @@ static void GTT__62 (OPT_Struct t0, OPT_Struct t1)
t1 = t1->BaseTyp;
}
if (t1 == t0 || t0->form == 0) {
- if (*TypTest__61_s->guard) {
- OPB_BindNodes(5, NIL, &*TypTest__61_s->x, NIL);
- (*TypTest__61_s->x)->readonly = (*TypTest__61_s->x)->left->readonly;
+ if (*TypTest__58_s->guard) {
+ OPB_BindNodes(5, NIL, &*TypTest__58_s->x, NIL);
+ (*TypTest__58_s->x)->readonly = (*TypTest__58_s->x)->left->readonly;
} else {
node = OPT_NewNode(11);
node->subcl = 16;
- node->left = *TypTest__61_s->x;
- node->obj = *TypTest__61_s->obj;
- *TypTest__61_s->x = node;
+ node->left = *TypTest__58_s->x;
+ node->obj = *TypTest__58_s->obj;
+ *TypTest__58_s->x = node;
}
} else {
OPB_err(85);
}
} else if (t0 != t1) {
OPB_err(85);
- } else if (!*TypTest__61_s->guard) {
- if ((*TypTest__61_s->x)->class == 5) {
+ } else if (!*TypTest__58_s->guard) {
+ if ((*TypTest__58_s->x)->class == 5) {
node = OPT_NewNode(11);
node->subcl = 16;
- node->left = *TypTest__61_s->x;
- node->obj = *TypTest__61_s->obj;
- *TypTest__61_s->x = node;
+ node->left = *TypTest__58_s->x;
+ node->obj = *TypTest__58_s->obj;
+ *TypTest__58_s->x = node;
} else {
- *TypTest__61_s->x = OPB_NewBoolConst(1);
+ *TypTest__58_s->x = OPB_NewBoolConst(1);
}
}
}
void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
{
- struct TypTest__61 _s;
+ struct TypTest__58 _s;
_s.x = x;
_s.obj = &obj;
_s.guard = &guard;
- _s.lnk = TypTest__61_s;
- TypTest__61_s = &_s;
+ _s.lnk = TypTest__58_s;
+ TypTest__58_s = &_s;
if (OPB_NotVar(*x)) {
OPB_err(112);
- } else if ((*x)->typ->form == 13) {
+ } else if ((*x)->typ->form == 11) {
if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) {
OPB_err(85);
- } else if (obj->typ->form == 13) {
- GTT__62((*x)->typ->BaseTyp, obj->typ->BaseTyp);
+ } else if (obj->typ->form == 11) {
+ GTT__59((*x)->typ->BaseTyp, obj->typ->BaseTyp);
} else {
OPB_err(86);
}
} else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) {
- GTT__62((*x)->typ, obj->typ);
+ GTT__59((*x)->typ, obj->typ);
} else {
OPB_err(87);
}
@@ -508,23 +434,23 @@ void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
} else {
(*x)->typ = OPT_booltyp;
}
- TypTest__61_s = _s.lnk;
+ TypTest__58_s = _s.lnk;
}
void OPB_In (OPT_Node *x, OPT_Node y)
{
- INTEGER f;
- LONGINT k;
+ INT16 f;
+ INT64 k;
f = (*x)->typ->form;
if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) {
OPB_err(126);
- } else if ((__IN(f, 0x70) && y->typ->form == 9)) {
+ } else if ((f == 4 && y->typ->form == 7)) {
if ((*x)->class == 7) {
k = (*x)->conval->intval;
- if (k < 0 || k > (SYSTEM_INT64)OPM_MaxSet) {
+ if (k < 0 || k >= (INT64)__ASHL(y->typ->size, 3)) {
OPB_err(202);
} else if (y->class == 7) {
- (*x)->conval->intval = OPB_BoolToInt(__IN(k, y->conval->setval));
+ (*x)->conval->intval = OPB_BoolToInt(__IN(k, y->conval->setval, 64));
(*x)->obj = NIL;
} else {
OPB_BindNodes(12, OPT_booltyp, &*x, y);
@@ -540,9 +466,8 @@ void OPB_In (OPT_Node *x, OPT_Node y)
(*x)->typ = OPT_booltyp;
}
-static LONGINT OPB_log (LONGINT x)
+static INT64 OPB_log (INT64 x)
{
- LONGINT _o_result;
OPB_exp = 0;
if (x > 0) {
while (!__ODD(x)) {
@@ -550,14 +475,13 @@ static LONGINT OPB_log (LONGINT x)
OPB_exp += 1;
}
}
- _o_result = x;
- return _o_result;
+ return x;
}
-static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x)
+static void OPB_CheckRealType (INT16 f, INT16 nr, OPT_Const x)
{
LONGREAL min, max, r;
- if (f == 7) {
+ if (f == 5) {
min = OPM_MinReal;
max = OPM_MaxReal;
} else {
@@ -568,38 +492,36 @@ static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x)
if (r > max || r < min) {
OPB_err(nr);
x->realval = (LONGREAL)1;
- } else if (f == 7) {
+ } else if (f == 5) {
x->realval = x->realval;
}
x->intval = -1;
}
-static struct MOp__30 {
- struct MOp__30 *lnk;
-} *MOp__30_s;
+static struct MOp__28 {
+ struct MOp__28 *lnk;
+} *MOp__28_s;
-static OPT_Node NewOp__31 (SHORTINT op, OPT_Struct typ, OPT_Node z);
+static OPT_Node NewOp__29 (INT8 op, OPT_Struct typ, OPT_Node z);
-static OPT_Node NewOp__31 (SHORTINT op, OPT_Struct typ, OPT_Node z)
+static OPT_Node NewOp__29 (INT8 op, OPT_Struct typ, OPT_Node z)
{
- OPT_Node _o_result;
OPT_Node node = NIL;
node = OPT_NewNode(11);
node->subcl = op;
node->typ = typ;
node->left = z;
- _o_result = node;
- return _o_result;
+ return node;
}
-void OPB_MOp (SHORTINT op, OPT_Node *x)
+void OPB_MOp (INT8 op, OPT_Node *x)
{
- INTEGER f;
+ INT16 f;
OPT_Struct typ = NIL;
OPT_Node z = NIL;
- struct MOp__30 _s;
- _s.lnk = MOp__30_s;
- MOp__30_s = &_s;
+ struct MOp__28 _s;
+ _s.lnk = MOp__28_s;
+ MOp__28_s = &_s;
z = *x;
if (z->class == 8 || z->class == 9) {
OPB_err(126);
@@ -613,44 +535,48 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval));
z->obj = NIL;
} else {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
}
} else {
OPB_err(98);
}
break;
case 6:
- if (!__IN(f, 0x01f0)) {
+ if (!__IN(f, 0x70, 32)) {
OPB_err(96);
}
break;
case 7:
- if (__IN(f, 0x03f0)) {
+ if (__IN(f, 0xf0, 32)) {
if (z->class == 7) {
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (z->conval->intval == (-9223372036854775807-1)) {
OPB_err(203);
} else {
z->conval->intval = -z->conval->intval;
OPB_SetIntType(z);
}
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
z->conval->realval = -z->conval->realval;
} else {
- z->conval->setval = ~z->conval->setval;
+ if (z->typ->size == 8) {
+ z->conval->setval = ~z->conval->setval;
+ } else {
+ z->conval->setval = z->conval->setval ^ 0xffffffff;
+ }
}
z->obj = NIL;
} else {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
}
} else {
OPB_err(97);
}
break;
case 21:
- if (__IN(f, 0x01f0)) {
+ if (__IN(f, 0x70, 32)) {
if (z->class == 7) {
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (z->conval->intval == (-9223372036854775807-1)) {
OPB_err(203);
} else {
@@ -662,7 +588,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
}
z->obj = NIL;
} else {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
}
} else {
OPB_err(111);
@@ -671,10 +597,10 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
case 22:
if (f == 3) {
if (z->class == 7) {
- z->conval->intval = (int)__CAP((CHAR)z->conval->intval);
+ z->conval->intval = (INT16)__CAP((CHAR)z->conval->intval);
z->obj = NIL;
} else {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
}
} else {
OPB_err(111);
@@ -682,12 +608,12 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
}
break;
case 23:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (z->class == 7) {
z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval));
z->obj = NIL;
} else {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
}
} else {
OPB_err(111);
@@ -697,19 +623,19 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
case 24:
if ((((z->class == 7 && f == 3)) && z->conval->intval >= 32)) {
OPB_CharToString(z);
- f = 10;
+ f = 8;
}
- if (z->class < 7 || f == 10) {
- z = NewOp__31(op, typ, z);
+ if (z->class < 7 || f == 8) {
+ z = NewOp__29(op, typ, z);
} else {
OPB_err(127);
}
- z->typ = OPT_linttyp;
+ z->typ = OPT_adrtyp;
break;
case 25:
- if ((__IN(f, 0x70) && z->class == 7)) {
+ if ((f == 4 && z->class == 7)) {
if ((0 <= z->conval->intval && z->conval->intval <= -1)) {
- z = NewOp__31(op, typ, z);
+ z = NewOp__29(op, typ, z);
} else {
OPB_err(219);
}
@@ -719,22 +645,22 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->typ = OPT_booltyp;
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.MOp, op = ", (LONGINT)33);
- OPM_LogWNum(op, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.MOp, op = ", 33);
+ OPM_LogWNum(op, 0);
OPM_LogWLn();
break;
}
}
*x = z;
- MOp__30_s = _s.lnk;
+ MOp__28_s = _s.lnk;
}
static void OPB_CheckPtr (OPT_Node x, OPT_Node y)
{
- INTEGER g;
+ INT16 g;
OPT_Struct p = NIL, q = NIL, t = NIL;
g = y->typ->form;
- if (g == 13) {
+ if (g == 11) {
p = x->typ->BaseTyp;
q = y->typ->BaseTyp;
if ((p->comp == 4 && q->comp == 4)) {
@@ -752,7 +678,7 @@ static void OPB_CheckPtr (OPT_Node x, OPT_Node y)
} else {
OPB_err(100);
}
- } else if (g != 11) {
+ } else if (g != 9) {
OPB_err(100);
}
}
@@ -769,7 +695,7 @@ void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames)
at = at->BaseTyp;
}
if (ft != at) {
- if ((ft->form == 14 && at->form == 14)) {
+ if ((ft->form == 12 && at->form == 12)) {
if (ft->BaseTyp == at->BaseTyp) {
OPB_CheckParameters(ft->link, at->link, 0);
} else {
@@ -795,7 +721,7 @@ void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames)
static void OPB_CheckProc (OPT_Struct x, OPT_Object y)
{
- if (__IN(y->mode, 0x04c0)) {
+ if (__IN(y->mode, 0x04c0, 32)) {
if (y->mode == 6) {
if (y->mnolev == 0) {
y->mode = 7;
@@ -815,22 +741,21 @@ static void OPB_CheckProc (OPT_Struct x, OPT_Object y)
static struct ConstOp__13 {
OPT_Node *x;
- INTEGER *f;
+ INT16 *f;
OPT_Const *xval, *yval;
struct ConstOp__13 *lnk;
} *ConstOp__13_s;
-static INTEGER ConstCmp__14 (void);
+static INT16 ConstCmp__14 (void);
-static INTEGER ConstCmp__14 (void)
+static INT16 ConstCmp__14 (void)
{
- INTEGER _o_result;
- INTEGER res;
+ INT16 res;
switch (*ConstOp__13_s->f) {
case 0:
res = 9;
break;
- case 1: case 3: case 4: case 5: case 6:
+ case 1: case 3: case 4:
if ((*ConstOp__13_s->xval)->intval < (*ConstOp__13_s->yval)->intval) {
res = 11;
} else if ((*ConstOp__13_s->xval)->intval > (*ConstOp__13_s->yval)->intval) {
@@ -839,7 +764,7 @@ static INTEGER ConstCmp__14 (void)
res = 9;
}
break;
- case 7: case 8:
+ case 5: case 6:
if ((*ConstOp__13_s->xval)->realval < (*ConstOp__13_s->yval)->realval) {
res = 11;
} else if ((*ConstOp__13_s->xval)->realval > (*ConstOp__13_s->yval)->realval) {
@@ -855,14 +780,14 @@ static INTEGER ConstCmp__14 (void)
res = 9;
}
break;
- case 9:
+ case 7:
if ((*ConstOp__13_s->xval)->setval != (*ConstOp__13_s->yval)->setval) {
res = 10;
} else {
res = 9;
}
break;
- case 10:
+ case 8:
if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) < 0) {
res = 11;
} else if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) > 0) {
@@ -871,7 +796,7 @@ static INTEGER ConstCmp__14 (void)
res = 9;
}
break;
- case 11: case 13: case 14:
+ case 9: case 11: case 12:
if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) {
res = 10;
} else {
@@ -879,21 +804,20 @@ static INTEGER ConstCmp__14 (void)
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstCmp, f = ", (LONGINT)37);
- OPM_LogWNum(*ConstOp__13_s->f, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstCmp, f = ", 37);
+ OPM_LogWNum(*ConstOp__13_s->f, 0);
OPM_LogWLn();
break;
}
(*ConstOp__13_s->x)->typ = OPT_booltyp;
- _o_result = res;
- return _o_result;
+ return res;
}
-static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
+static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
{
- INTEGER f, g;
+ INT16 f, g;
OPT_Const xval = NIL, yval = NIL;
- LONGINT xv, yv;
+ INT64 xv, yv;
BOOLEAN temp;
struct ConstOp__13 _s;
_s.x = &x;
@@ -909,7 +833,7 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
if (f != g) {
switch (f) {
case 3:
- if (g == 10) {
+ if (g == 8) {
OPB_CharToString(x);
} else {
OPB_err(100);
@@ -917,17 +841,17 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
- case 4: case 5: case 6:
- if (__IN(g, 0x70)) {
+ case 4:
+ if (g == 4) {
if (x->typ->size <= y->typ->size) {
x->typ = y->typ;
} else {
- x->typ = OPB_IntType(x->typ->size);
+ x->typ = OPT_IntType(x->typ->size);
}
- } else if (g == 7) {
+ } else if (g == 5) {
x->typ = OPT_realtyp;
xval->realval = xval->intval;
- } else if (g == 8) {
+ } else if (g == 6) {
x->typ = OPT_lrltyp;
xval->realval = xval->intval;
} else {
@@ -936,11 +860,11 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
- case 7:
- if (__IN(g, 0x70)) {
+ case 5:
+ if (g == 4) {
y->typ = x->typ;
yval->realval = yval->intval;
- } else if (g == 8) {
+ } else if (g == 6) {
x->typ = OPT_lrltyp;
} else {
OPB_err(100);
@@ -948,11 +872,11 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
- case 8:
- if (__IN(g, 0x70)) {
+ case 6:
+ if (g == 4) {
y->typ = x->typ;
yval->realval = yval->intval;
- } else if (g == 7) {
+ } else if (g == 5) {
y->typ = OPT_lrltyp;
} else {
OPB_err(100);
@@ -960,26 +884,26 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
- case 10:
+ case 8:
if (g == 3) {
OPB_CharToString(y);
- g = 10;
+ g = 8;
} else {
OPB_err(100);
y->typ = x->typ;
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
- case 11:
- if (!__IN(g, 0x6000)) {
+ case 9:
+ if (!__IN(g, 0x1800, 32)) {
OPB_err(100);
}
break;
- case 13:
+ case 11:
OPB_CheckPtr(x, y);
break;
- case 14:
- if (g != 11) {
+ case 12:
+ if (g != 9) {
OPB_err(100);
}
break;
@@ -993,7 +917,7 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
}
switch (op) {
case 1:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
xv = xval->intval;
yv = yval->intval;
if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807-1))) && yv != (-9223372036854775807-1))) && -xv <= __DIV(9223372036854775807, -yv))) {
@@ -1002,7 +926,7 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
} else {
OPB_err(204);
}
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
temp = __ABS(yval->realval) <= (LONGREAL)1;
if (temp || __ABS(xval->realval) <= 1.79769296342094e+308 / (LONGREAL)__ABS(yval->realval)) {
xval->realval = xval->realval * yval->realval;
@@ -1010,23 +934,24 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
} else {
OPB_err(204);
}
- } else if (f == 9) {
+ } else if (f == 7) {
xval->setval = (xval->setval & yval->setval);
+ OPB_SetSetType(x);
} else if (f != 0) {
OPB_err(101);
}
break;
case 2:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (yval->intval != 0) {
xval->realval = xval->intval / (REAL)yval->intval;
- OPB_CheckRealType(7, 205, xval);
+ OPB_CheckRealType(5, 205, xval);
} else {
OPB_err(205);
xval->realval = (LONGREAL)1;
}
x->typ = OPT_realtyp;
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
temp = __ABS(yval->realval) >= (LONGREAL)1;
if (temp || __ABS(xval->realval) <= 1.79769296342094e+308 * __ABS(yval->realval)) {
xval->realval = xval->realval / yval->realval;
@@ -1034,14 +959,15 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
} else {
OPB_err(205);
}
- } else if (f == 9) {
+ } else if (f == 7) {
xval->setval = xval->setval ^ yval->setval;
+ OPB_SetSetType(x);
} else if (f != 0) {
OPB_err(102);
}
break;
case 3:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (yval->intval != 0) {
xval->intval = __DIV(xval->intval, yval->intval);
OPB_SetIntType(x);
@@ -1053,7 +979,7 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
}
break;
case 4:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (yval->intval != 0) {
xval->intval = __MOD(xval->intval, yval->intval);
OPB_SetIntType(x);
@@ -1072,7 +998,7 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
}
break;
case 6:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807 - yval->intval);
if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807-1) - yval->intval)) {
xval->intval += yval->intval;
@@ -1080,7 +1006,7 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
} else {
OPB_err(206);
}
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
temp = (yval->realval >= (LONGREAL)0 && xval->realval <= 1.79769296342094e+308 - yval->realval);
if (temp || (yval->realval < (LONGREAL)0 && xval->realval >= -1.79769296342094e+308 - yval->realval)) {
xval->realval = xval->realval + yval->realval;
@@ -1088,21 +1014,22 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
} else {
OPB_err(206);
}
- } else if (f == 9) {
+ } else if (f == 7) {
xval->setval = xval->setval | yval->setval;
+ OPB_SetSetType(x);
} else if (f != 0) {
OPB_err(105);
}
break;
case 7:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807 + yval->intval)) {
xval->intval -= yval->intval;
OPB_SetIntType(x);
} else {
OPB_err(207);
}
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
temp = (yval->realval >= (LONGREAL)0 && xval->realval >= -1.79769296342094e+308 + yval->realval);
if (temp || (yval->realval < (LONGREAL)0 && xval->realval <= 1.79769296342094e+308 + yval->realval)) {
xval->realval = xval->realval - yval->realval;
@@ -1110,8 +1037,9 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
} else {
OPB_err(207);
}
- } else if (f == 9) {
+ } else if (f == 7) {
xval->setval = (xval->setval & ~yval->setval);
+ OPB_SetSetType(x);
} else if (f != 0) {
OPB_err(106);
}
@@ -1130,36 +1058,36 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
xval->intval = OPB_BoolToInt(ConstCmp__14() != 9);
break;
case 11:
- if (__IN(f, 0x2a04)) {
+ if (__IN(f, 0x0a84, 32)) {
OPB_err(108);
} else {
xval->intval = OPB_BoolToInt(ConstCmp__14() == 11);
}
break;
case 12:
- if (__IN(f, 0x2a04)) {
+ if (__IN(f, 0x0a84, 32)) {
OPB_err(108);
} else {
xval->intval = OPB_BoolToInt(ConstCmp__14() != 13);
}
break;
case 13:
- if (__IN(f, 0x2a04)) {
+ if (__IN(f, 0x0a84, 32)) {
OPB_err(108);
} else {
xval->intval = OPB_BoolToInt(ConstCmp__14() == 13);
}
break;
case 14:
- if (__IN(f, 0x2a04)) {
+ if (__IN(f, 0x0a84, 32)) {
OPB_err(108);
} else {
xval->intval = OPB_BoolToInt(ConstCmp__14() != 11);
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstOp, op = ", (LONGINT)37);
- OPM_LogWNum(op, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstOp, op = ", 37);
+ OPM_LogWNum(op, 0);
OPM_LogWLn();
break;
}
@@ -1169,22 +1097,28 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
{
OPT_Node node = NIL;
- INTEGER f, g;
- LONGINT k;
+ INT16 f, g;
+ INT64 k;
LONGREAL r;
f = (*x)->typ->form;
g = typ->form;
if ((*x)->class == 7) {
- if (__IN(f, 0x70)) {
- if (__IN(g, 0x70)) {
- if (f > g) {
+ if ((((f == 7 && g == 7)) && (*x)->typ->size > typ->size)) {
+ OPB_SetSetType(*x);
+ if ((*x)->typ->size > typ->size) {
+ OPB_err(203);
+ (*x)->conval->setval = 0x0;
+ }
+ } else if (f == 4) {
+ if (g == 4) {
+ if ((*x)->typ->size > typ->size) {
OPB_SetIntType(*x);
- if ((int)(*x)->typ->form > g) {
+ if ((*x)->typ->size > typ->size) {
OPB_err(203);
(*x)->conval->intval = 1;
}
}
- } else if (__IN(g, 0x0180)) {
+ } else if (__IN(g, 0x60, 32)) {
(*x)->conval->realval = (*x)->conval->intval;
(*x)->conval->intval = -1;
} else {
@@ -1193,8 +1127,8 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
OPB_err(220);
}
}
- } else if (__IN(f, 0x0180)) {
- if (__IN(g, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
+ if (__IN(g, 0x60, 32)) {
OPB_CheckRealType(g, 203, (*x)->conval);
} else {
r = (*x)->conval->realval;
@@ -1202,12 +1136,12 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
OPB_err(203);
r = (LONGREAL)1;
}
- (*x)->conval->intval = __ENTIER(r);
+ (*x)->conval->intval = (INT32)__ENTIER(r);
OPB_SetIntType(*x);
}
}
(*x)->obj = NIL;
- } else if (((((*x)->class == 11 && (*x)->subcl == 20)) && ((int)(*x)->left->typ->form < f || f > g))) {
+ } else if (((((*x)->class == 11 && (*x)->subcl == 20)) && ((INT16)(*x)->left->typ->form < f || f > g))) {
if ((*x)->left->typ == typ) {
*x = (*x)->left;
}
@@ -1220,15 +1154,15 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
(*x)->typ = typ;
}
-static struct Op__40 {
- INTEGER *f, *g;
- struct Op__40 *lnk;
-} *Op__40_s;
+static struct Op__38 {
+ INT16 *f, *g;
+ struct Op__38 *lnk;
+} *Op__38_s;
-static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y);
-static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y);
+static void NewOp__39 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y);
+static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y);
-static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
+static void NewOp__39 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
{
OPT_Node node = NIL;
node = OPT_NewNode(12);
@@ -1239,50 +1173,48 @@ static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
*x = node;
}
-static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y)
+static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y)
{
- BOOLEAN _o_result;
BOOLEAN ok, xCharArr, yCharArr;
- xCharArr = (__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp->form == 3) || *Op__40_s->f == 10;
- yCharArr = (__IN((*y)->typ->comp, 0x0c) && (*y)->typ->BaseTyp->form == 3) || *Op__40_s->g == 10;
- if ((((xCharArr && *Op__40_s->g == 3)) && (*y)->class == 7)) {
+ xCharArr = (__IN((*x)->typ->comp, 0x0c, 32) && (*x)->typ->BaseTyp->form == 3) || *Op__38_s->f == 8;
+ yCharArr = (__IN((*y)->typ->comp, 0x0c, 32) && (*y)->typ->BaseTyp->form == 3) || *Op__38_s->g == 8;
+ if ((((xCharArr && *Op__38_s->g == 3)) && (*y)->class == 7)) {
OPB_CharToString(*y);
- *Op__40_s->g = 10;
+ *Op__38_s->g = 8;
yCharArr = 1;
}
- if ((((yCharArr && *Op__40_s->f == 3)) && (*x)->class == 7)) {
+ if ((((yCharArr && *Op__38_s->f == 3)) && (*x)->class == 7)) {
OPB_CharToString(*x);
- *Op__40_s->f = 10;
+ *Op__38_s->f = 8;
xCharArr = 1;
}
ok = (xCharArr && yCharArr);
if (ok) {
- if ((*Op__40_s->f == 10 && (*x)->conval->intval2 == 1)) {
+ if ((*Op__38_s->f == 8 && (*x)->conval->intval2 == 1)) {
(*x)->typ = OPT_chartyp;
(*x)->conval->intval = 0;
- OPB_Index(&*y, OPB_NewIntConst(((LONGINT)(0))));
- } else if ((*Op__40_s->g == 10 && (*y)->conval->intval2 == 1)) {
+ OPB_Index(&*y, OPB_NewIntConst(0));
+ } else if ((*Op__38_s->g == 8 && (*y)->conval->intval2 == 1)) {
(*y)->typ = OPT_chartyp;
(*y)->conval->intval = 0;
- OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0))));
+ OPB_Index(&*x, OPB_NewIntConst(0));
}
}
- _o_result = ok;
- return _o_result;
+ return ok;
}
-void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
+void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
{
- INTEGER f, g;
+ INT16 f, g;
OPT_Node t = NIL, z = NIL;
OPT_Struct typ = NIL;
BOOLEAN do_;
- LONGINT val;
- struct Op__40 _s;
+ INT64 val;
+ struct Op__38 _s;
_s.f = &f;
_s.g = &g;
- _s.lnk = Op__40_s;
- Op__40_s = &_s;
+ _s.lnk = Op__38_s;
+ Op__38_s = &_s;
z = *x;
if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) {
OPB_err(126);
@@ -1300,49 +1232,58 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(100);
}
break;
- case 4: case 5: case 6:
- if ((__IN(g, 0x70) && y->typ->size < z->typ->size)) {
+ case 4:
+ if ((g == 4 && y->typ->size < z->typ->size)) {
OPB_Convert(&y, z->typ);
- } else if (__IN(g, 0x01f0)) {
+ } else if (__IN(g, 0x70, 32)) {
OPB_Convert(&z, y->typ);
} else {
OPB_err(100);
}
break;
case 7:
- if (__IN(g, 0x70)) {
+ if ((g == 7 && y->typ->size < z->typ->size)) {
OPB_Convert(&y, z->typ);
- } else if (__IN(g, 0x0180)) {
+ } else if (g == 7) {
OPB_Convert(&z, y->typ);
} else {
OPB_err(100);
}
break;
- case 8:
- if (__IN(g, 0x01f0)) {
+ case 5:
+ if (g == 4) {
OPB_Convert(&y, z->typ);
- } else if (__IN(g, 0x0180)) {
+ } else if (__IN(g, 0x60, 32)) {
+ OPB_Convert(&z, y->typ);
+ } else {
+ OPB_err(100);
+ }
+ break;
+ case 6:
+ if (__IN(g, 0x70, 32)) {
+ OPB_Convert(&y, z->typ);
+ } else if (__IN(g, 0x60, 32)) {
OPB_Convert(&y, z->typ);
} else {
OPB_err(100);
}
break;
- case 11:
- if (!__IN(g, 0x6000)) {
+ case 9:
+ if (!__IN(g, 0x1800, 32)) {
OPB_err(100);
}
break;
- case 13:
+ case 11:
OPB_CheckPtr(z, y);
break;
- case 14:
- if (g != 11) {
+ case 12:
+ if (g != 9) {
OPB_err(100);
}
break;
- case 10:
+ case 8:
break;
- case 15:
+ case 13:
if (z->typ->comp == 4) {
OPB_err(100);
}
@@ -1358,7 +1299,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
switch (op) {
case 1:
do_ = 1;
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (z->class == 7) {
val = z->conval->intval;
if (val == 1) {
@@ -1389,35 +1330,35 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
y->obj = NIL;
}
}
- } else if (!__IN(f, 0x0381)) {
+ } else if (!__IN(f, 0xe1, 32)) {
OPB_err(105);
typ = OPT_undftyp;
}
if (do_) {
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
}
break;
case 2:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if ((y->class == 7 && y->conval->intval == 0)) {
OPB_err(205);
}
OPB_Convert(&z, OPT_realtyp);
OPB_Convert(&y, OPT_realtyp);
typ = OPT_realtyp;
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
if ((y->class == 7 && y->conval->realval == (LONGREAL)0)) {
OPB_err(205);
}
- } else if ((f != 9 && f != 0)) {
+ } else if ((f != 7 && f != 0)) {
OPB_err(102);
typ = OPT_undftyp;
}
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
break;
case 3:
do_ = 1;
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (y->class == 7) {
val = y->conval->intval;
if (val == 0) {
@@ -1436,11 +1377,11 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp;
}
if (do_) {
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
}
break;
case 4:
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if (y->class == 7) {
if (y->conval->intval == 0) {
OPB_err(205);
@@ -1454,7 +1395,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(104);
typ = OPT_undftyp;
}
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
break;
case 5:
if (f == 2) {
@@ -1464,7 +1405,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
} else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) {
} else {
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
}
} else if (f != 0) {
OPB_err(94);
@@ -1472,12 +1413,12 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
break;
case 6:
- if (!__IN(f, 0x03f1)) {
+ if (!__IN(f, 0xf1, 32)) {
OPB_err(105);
typ = OPT_undftyp;
}
do_ = 1;
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if ((z->class == 7 && z->conval->intval == 0)) {
do_ = 0;
z = y;
@@ -1487,16 +1428,16 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
}
if (do_) {
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
}
break;
case 7:
- if (!__IN(f, 0x03f1)) {
+ if (!__IN(f, 0xf1, 32)) {
OPB_err(106);
typ = OPT_undftyp;
}
- if ((!__IN(f, 0x70) || y->class != 7) || y->conval->intval != 0) {
- NewOp__41(op, typ, &z, y);
+ if ((f != 4 || y->class != 7) || y->conval->intval != 0) {
+ NewOp__39(op, typ, &z, y);
}
break;
case 8:
@@ -1507,7 +1448,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
} else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) {
} else {
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
}
} else if (f != 0) {
OPB_err(95);
@@ -1515,61 +1456,62 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
break;
case 9: case 10:
- if (__IN(f, 0x6bff) || strings__43(&z, &y)) {
+ if (__IN(f, 0x1aff, 32) || strings__41(&z, &y)) {
typ = OPT_booltyp;
} else {
OPB_err(107);
typ = OPT_undftyp;
}
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
break;
case 11: case 12: case 13: case 14:
- if (__IN(f, 0x01f9) || strings__43(&z, &y)) {
+ if (__IN(f, 0x79, 32) || strings__41(&z, &y)) {
typ = OPT_booltyp;
} else {
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"ELSE in Op()", (LONGINT)13);
+ OPM_LogWStr((CHAR*)"ELSE in Op()", 13);
OPM_LogWLn();
OPB_err(108);
typ = OPT_undftyp;
}
- NewOp__41(op, typ, &z, y);
+ NewOp__39(op, typ, &z, y);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", (LONGINT)32);
- OPM_LogWNum(op, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", 32);
+ OPM_LogWNum(op, 0);
OPM_LogWLn();
break;
}
}
*x = z;
- Op__40_s = _s.lnk;
+ Op__38_s = _s.lnk;
}
void OPB_SetRange (OPT_Node *x, OPT_Node y)
{
- LONGINT k, l;
+ INT64 k, l;
if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) {
OPB_err(126);
- } else if ((__IN((*x)->typ->form, 0x70) && __IN(y->typ->form, 0x70))) {
+ } else if (((*x)->typ->form == 4 && y->typ->form == 4)) {
if ((*x)->class == 7) {
k = (*x)->conval->intval;
- if (0 > k || k > (SYSTEM_INT64)OPM_MaxSet) {
+ if (0 > k || k > 63) {
OPB_err(202);
}
}
if (y->class == 7) {
l = y->conval->intval;
- if (0 > l || l > (SYSTEM_INT64)OPM_MaxSet) {
+ if (0 > l || l > 63) {
OPB_err(202);
}
}
if (((*x)->class == 7 && y->class == 7)) {
if (k <= l) {
- (*x)->conval->setval = __SETRNG(k, l);
+ (*x)->conval->setval = __SETRNG(k, l, 32);
+ OPB_SetSetType(*x);
} else {
OPB_err(201);
- (*x)->conval->setval = __SETRNG(l, k);
+ (*x)->conval->setval = __SETRNG(l, k, 32);
}
(*x)->obj = NIL;
} else {
@@ -1583,86 +1525,69 @@ void OPB_SetRange (OPT_Node *x, OPT_Node y)
void OPB_SetElem (OPT_Node *x)
{
- LONGINT k;
+ INT64 k;
if ((*x)->class == 8 || (*x)->class == 9) {
OPB_err(126);
- } else if (!__IN((*x)->typ->form, 0x70)) {
+ } else if ((*x)->typ->form != 4) {
OPB_err(93);
} else if ((*x)->class == 7) {
k = (*x)->conval->intval;
- if ((0 <= k && k <= (SYSTEM_INT64)OPM_MaxSet)) {
- (*x)->conval->setval = __SETOF(k);
+ if ((0 <= k && k <= 63)) {
+ (*x)->conval->setval = 0x0;
+ (*x)->conval->setval |= __SETOF(k,64);
} else {
OPB_err(202);
}
+ OPB_SetSetType(*x);
(*x)->obj = NIL;
} else {
OPB_Convert(&*x, OPT_settyp);
+ (*x)->typ = OPT_settyp;
}
- (*x)->typ = OPT_settyp;
}
static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
{
OPT_Struct y = NIL;
- INTEGER f, g;
+ INT16 f, g;
OPT_Struct p = NIL, q = NIL;
- if (OPM_Verbose) {
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"PROCEDURE CheckAssign", (LONGINT)22);
- OPM_LogWLn();
- }
y = ynode->typ;
f = x->form;
g = y->form;
- if (OPM_Verbose) {
- OPM_LogWStr((CHAR*)"y.form = ", (LONGINT)10);
- OPM_LogWNum(y->form, ((LONGINT)(0)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"f = ", (LONGINT)5);
- OPM_LogWNum(f, ((LONGINT)(0)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"g = ", (LONGINT)5);
- OPM_LogWNum(g, ((LONGINT)(0)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"ynode.typ.syze = ", (LONGINT)18);
- OPM_LogWNum(ynode->typ->size, ((LONGINT)(0)));
- OPM_LogWLn();
- }
- if (ynode->class == 8 || (ynode->class == 9 && f != 14)) {
+ if (ynode->class == 8 || (ynode->class == 9 && f != 12)) {
OPB_err(126);
}
switch (f) {
- case 0: case 10:
+ case 0: case 8:
break;
case 1:
- if (!((__IN(g, 0x7a) && y->size == 1))) {
+ if (!((__IN(g, 0x1a, 32) && y->size == 1))) {
OPB_err(113);
}
break;
- case 2: case 3: case 9:
+ case 2: case 3:
if (g != f) {
OPB_err(113);
}
break;
- case 4: case 5: case 6:
- if (!__IN(g, 0x70) || x->size < y->size) {
+ case 4: case 7:
+ if (g != f || x->size < y->size) {
OPB_err(113);
}
break;
- case 7:
- if (!__IN(g, 0xf0)) {
+ case 5:
+ if (!__IN(g, 0x30, 32)) {
OPB_err(113);
}
break;
- case 8:
- if (!__IN(g, 0x01f0)) {
+ case 6:
+ if (!__IN(g, 0x70, 32)) {
OPB_err(113);
}
break;
- case 13:
- if ((x == y || g == 11) || (x == OPT_sysptrtyp && g == 13)) {
- } else if (g == 13) {
+ case 11:
+ if ((x == y || g == 9) || (x == OPT_sysptrtyp && g == 11)) {
+ } else if (g == 11) {
p = x->BaseTyp;
q = y->BaseTyp;
if ((p->comp == 4 && q->comp == 4)) {
@@ -1679,32 +1604,32 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
OPB_err(113);
}
break;
- case 14:
+ case 12:
if (ynode->class == 9) {
OPB_CheckProc(x, ynode->obj);
- } else if (x == y || g == 11) {
+ } else if (x == y || g == 9) {
} else {
OPB_err(113);
}
break;
- case 12: case 11:
+ case 10: case 9:
OPB_err(113);
break;
- case 15:
+ case 13:
x->pvused = 1;
if (x->comp == 2) {
if ((ynode->class == 7 && g == 3)) {
OPB_CharToString(ynode);
y = ynode->typ;
- g = 10;
+ g = 8;
}
if (x == y) {
} else if (x->BaseTyp == OPT_chartyp) {
- if (g == 10) {
+ if (g == 8) {
if (ynode->conval->intval2 > x->n) {
OPB_err(114);
}
- } else if ((__IN(y->comp, 0x0c) && y->BaseTyp == OPT_chartyp)) {
+ } else if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
} else {
OPB_err(113);
}
@@ -1712,7 +1637,7 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
OPB_err(113);
}
} else if ((x->comp == 3 && x->BaseTyp == OPT_chartyp)) {
- if ((__IN(y->comp, 0x0c) && y->BaseTyp == OPT_chartyp)) {
+ if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
} else {
OPB_err(113);
}
@@ -1734,12 +1659,12 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.CheckAssign, f = ", (LONGINT)40);
- OPM_LogWNum(f, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.CheckAssign, f = ", 40);
+ OPM_LogWNum(f, 0);
OPM_LogWLn();
break;
}
- if ((((((ynode->class == 7 && g < f)) && __IN(g, 0xf0))) && __IN(f, 0x01e0))) {
+ if ((((((ynode->class == 7 && g < f)) && __IN(g, 0x30, 32))) && __IN(f, 0x70, 32))) {
OPB_Convert(&ynode, x);
}
}
@@ -1748,16 +1673,16 @@ static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo)
{
}
-void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
+void OPB_StPar0 (OPT_Node *par0, INT16 fctno)
{
- INTEGER f;
+ INT16 f;
OPT_Struct typ = NIL;
OPT_Node x = NIL;
x = *par0;
f = x->typ->form;
switch (fctno) {
case 0:
- if ((__IN(f, 0x70) && x->class == 7)) {
+ if ((f == 4 && x->class == 7)) {
if ((0 <= x->conval->intval && x->conval->intval <= 255)) {
OPB_BindNodes(28, OPT_notyp, &x, x);
} else {
@@ -1772,12 +1697,12 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
typ = OPT_notyp;
if (OPB_NotVar(x)) {
OPB_err(112);
- } else if (f == 13) {
+ } else if (f == 11) {
if (x->readonly) {
OPB_err(76);
}
f = x->typ->BaseTyp->comp;
- if (__IN(f, 0x1c)) {
+ if (__IN(f, 0x1c, 32)) {
if (f == 3) {
typ = x->typ->BaseTyp;
}
@@ -1810,7 +1735,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 5:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x0180)) {
+ } else if (__IN(f, 0x60, 32)) {
OPB_Convert(&x, OPT_linttyp);
} else {
OPB_err(111);
@@ -1827,20 +1752,20 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
x = OPB_NewBoolConst(0);
break;
case 3:
- x = OPB_NewIntConst(((LONGINT)(0)));
+ x = OPB_NewIntConst(0);
x->typ = OPT_chartyp;
break;
- case 4: case 5: case 6:
+ case 4:
x = OPB_NewIntConst(OPM_SignedMinimum(x->typ->size));
break;
- case 9:
- x = OPB_NewIntConst(((LONGINT)(0)));
+ case 7:
+ x = OPB_NewIntConst(0);
x->typ = OPT_inttyp;
break;
- case 7:
+ case 5:
x = OPB_NewRealConst(OPM_MinReal, OPT_realtyp);
break;
- case 8:
+ case 6:
x = OPB_NewRealConst(OPM_MinLReal, OPT_lrltyp);
break;
default:
@@ -1858,20 +1783,20 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
x = OPB_NewBoolConst(1);
break;
case 3:
- x = OPB_NewIntConst(((LONGINT)(255)));
+ x = OPB_NewIntConst(255);
x->typ = OPT_chartyp;
break;
- case 4: case 5: case 6:
+ case 4:
x = OPB_NewIntConst(OPM_SignedMaximum(x->typ->size));
break;
- case 9:
- x = OPB_NewIntConst(OPM_MaxSet);
+ case 7:
+ x = OPB_NewIntConst(__ASHL(x->typ->size, 3) - 1);
x->typ = OPT_inttyp;
break;
- case 7:
+ case 5:
x = OPB_NewRealConst(OPM_MaxReal, OPT_realtyp);
break;
- case 8:
+ case 6:
x = OPB_NewRealConst(OPM_MaxLReal, OPT_lrltyp);
break;
default:
@@ -1885,7 +1810,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 9:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x71)) {
+ } else if (__IN(f, 0x11, 32)) {
OPB_Convert(&x, OPT_chartyp);
} else {
OPB_err(111);
@@ -1895,9 +1820,14 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 10:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if ((__IN(f, 0x70) && x->typ->size > (SYSTEM_INT64)OPM_SIntSize)) {
- OPB_Convert(&x, OPB_IntType(OPB_ShorterSize(x->typ->size)));
- } else if (f == 8) {
+ } else if (f == 4) {
+ typ = OPT_ShorterOrLongerType(x->typ, -1);
+ if (typ == NIL) {
+ OPB_err(111);
+ } else {
+ OPB_Convert(&x, typ);
+ }
+ } else if (f == 6) {
OPB_Convert(&x, OPT_realtyp);
} else {
OPB_err(111);
@@ -1906,9 +1836,14 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 11:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if ((__IN(f, 0x70) && x->typ->size < (SYSTEM_INT64)OPM_LIntSize)) {
- OPB_Convert(&x, OPB_IntType(OPB_LongerSize(x->typ->size)));
- } else if (f == 7) {
+ } else if (f == 4) {
+ typ = OPT_ShorterOrLongerType(x->typ, 1);
+ if (typ == NIL) {
+ OPB_err(111);
+ } else {
+ OPB_Convert(&x, typ);
+ }
+ } else if (f == 5) {
OPB_Convert(&x, OPT_lrltyp);
} else if (f == 3) {
OPB_Convert(&x, OPT_linttyp);
@@ -1919,7 +1854,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 13: case 14:
if (OPB_NotVar(x)) {
OPB_err(112);
- } else if (!__IN(f, 0x70)) {
+ } else if (f != 4) {
OPB_err(111);
} else if (x->readonly) {
OPB_err(76);
@@ -1928,7 +1863,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 15: case 16:
if (OPB_NotVar(x)) {
OPB_err(112);
- } else if (x->typ != OPT_settyp) {
+ } else if (x->typ->form != 7) {
OPB_err(111);
x->typ = OPT_settyp;
} else if (x->readonly) {
@@ -1936,26 +1871,26 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
}
break;
case 17:
- if (!__IN(x->typ->comp, 0x0c)) {
+ if (!__IN(x->typ->comp, 0x0c, 32)) {
OPB_err(131);
}
break;
case 18:
if ((x->class == 7 && f == 3)) {
OPB_CharToString(x);
- f = 10;
+ f = 8;
}
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (((!__IN(x->typ->comp, 0x0c) || x->typ->BaseTyp->form != 3) && f != 10)) {
+ } else if (((!__IN(x->typ->comp, 0x0c, 32) || x->typ->BaseTyp->form != 3) && f != 8)) {
OPB_err(111);
}
break;
case 19:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
- if (x->typ->size != (SYSTEM_INT64)OPM_LIntSize) {
+ } else if (f == 4) {
+ if (x->typ->size < OPT_linttyp->size) {
OPB_Convert(&x, OPT_linttyp);
}
} else {
@@ -1970,14 +1905,14 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 12:
if (x->class != 8) {
OPB_err(110);
- x = OPB_NewIntConst(((LONGINT)(1)));
- } else if (__IN(f, 0x63fe) || __IN(x->typ->comp, 0x14)) {
- (*OPB_typSize)(x->typ);
+ x = OPB_NewIntConst(1);
+ } else if (__IN(f, 0x18fe, 32) || __IN(x->typ->comp, 0x14, 32)) {
+ OPT_TypSize(x->typ);
x->typ->pvused = 1;
x = OPB_NewIntConst(x->typ->size);
} else {
OPB_err(111);
- x = OPB_NewIntConst(((LONGINT)(1)));
+ x = OPB_NewIntConst(1);
}
break;
case 21:
@@ -1986,22 +1921,22 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 22: case 23:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (!__IN(f, 0x027a)) {
+ } else if (!__IN(f, 0x9a, 32)) {
OPB_err(111);
}
break;
case 24: case 25: case 28: case 31:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if ((((x->class == 7 && __IN(f, 0x70))) && x->typ->size < OPT_linttyp->size)) {
- OPB_Convert(&x, OPT_linttyp);
- } else if (!((__IN(x->typ->form, 0x2070) && x->typ->size == (SYSTEM_INT64)OPM_PointerSize))) {
+ } else if ((((x->class == 7 && f == 4)) && x->typ->size < OPT_adrtyp->size)) {
+ OPB_Convert(&x, OPT_adrtyp);
+ } else if (!((__IN(x->typ->form, 0x0810, 32) && x->typ->size == OPM_AddressSize))) {
OPB_err(111);
- x->typ = OPT_linttyp;
+ x->typ = OPT_adrtyp;
}
break;
case 26: case 27:
- if ((__IN(f, 0x70) && x->class == 7)) {
+ if ((f == 4 && x->class == 7)) {
if (x->conval->intval < 0 || x->conval->intval > -1) {
OPB_err(220);
}
@@ -2012,14 +1947,14 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 29:
if (x->class != 8) {
OPB_err(110);
- } else if (__IN(f, 0x1401) || x->typ->comp == 3) {
+ } else if (__IN(f, 0x0501, 32) || x->typ->comp == 3) {
OPB_err(111);
}
break;
case 30:
if (OPB_NotVar(x)) {
OPB_err(112);
- } else if (f == 13) {
+ } else if (f == 11) {
} else {
OPB_err(111);
}
@@ -2036,40 +1971,38 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.StPar0, fctno = ", (LONGINT)39);
- OPM_LogWNum(fctno, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPB.StPar0, fctno = ", 39);
+ OPM_LogWNum(fctno, 0);
OPM_LogWLn();
break;
}
*par0 = x;
}
-static struct StPar1__56 {
- struct StPar1__56 *lnk;
-} *StPar1__56_s;
+static struct StPar1__53 {
+ struct StPar1__53 *lnk;
+} *StPar1__53_s;
-static OPT_Node NewOp__57 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right);
+static OPT_Node NewOp__54 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right);
-static OPT_Node NewOp__57 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right)
+static OPT_Node NewOp__54 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right)
{
- OPT_Node _o_result;
OPT_Node node = NIL;
node = OPT_NewNode(class);
node->subcl = subcl;
node->left = left;
node->right = right;
- _o_result = node;
- return _o_result;
+ return node;
}
-void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
+void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
{
- INTEGER f, L;
+ INT16 f, L;
OPT_Struct typ = NIL;
OPT_Node p = NIL, t = NIL;
- struct StPar1__56 _s;
- _s.lnk = StPar1__56_s;
- StPar1__56_s = &_s;
+ struct StPar1__53 _s;
+ _s.lnk = StPar1__53_s;
+ StPar1__53_s = &_s;
p = *par0;
f = x->typ->form;
switch (fctno) {
@@ -2079,40 +2012,40 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
p->typ = OPT_notyp;
} else {
if (x->typ != p->typ) {
- if ((x->class == 7 && __IN(f, 0x70))) {
+ if ((f == 4 && (x->class == 7 || (p->typ->form == 4 && x->typ->size <= p->typ->size)))) {
OPB_Convert(&x, p->typ);
} else {
OPB_err(111);
}
}
- p = NewOp__57(19, fctno, p, x);
+ p = NewOp__54(19, fctno, p, x);
p->typ = OPT_notyp;
}
break;
case 15: case 16:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
- if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval > (SYSTEM_INT64)OPM_MaxSet))) {
+ } else if (f == 4) {
+ if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval >= (INT64)__ASHL(p->typ->size, 3)))) {
OPB_err(202);
}
- p = NewOp__57(19, fctno, p, x);
+ p = NewOp__54(19, fctno, p, x);
} else {
OPB_err(111);
}
p->typ = OPT_notyp;
break;
case 17:
- if (!__IN(f, 0x70) || x->class != 7) {
+ if (!(f == 4) || x->class != 7) {
OPB_err(69);
} else if (x->typ->size == 1) {
- L = (int)x->conval->intval;
+ L = OPM_Integer(x->conval->intval);
typ = p->typ;
- while ((L > 0 && __IN(typ->comp, 0x0c))) {
+ while ((L > 0 && __IN(typ->comp, 0x0c, 32))) {
typ = typ->BaseTyp;
L -= 1;
}
- if (L != 0 || !__IN(typ->comp, 0x0c)) {
+ if (L != 0 || !__IN(typ->comp, 0x0c, 32)) {
OPB_err(132);
} else {
x->obj = NIL;
@@ -2121,7 +2054,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
p = p->left;
x->conval->intval += 1;
}
- p = NewOp__57(12, 19, p, x);
+ p = NewOp__54(12, 19, p, x);
p->typ = OPT_linttyp;
} else {
p = x;
@@ -2136,14 +2069,14 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 18:
if (OPB_NotVar(x)) {
OPB_err(112);
- } else if ((__IN(x->typ->comp, 0x0c) && x->typ->BaseTyp->form == 3)) {
+ } else if ((__IN(x->typ->comp, 0x0c, 32) && x->typ->BaseTyp->form == 3)) {
if (x->readonly) {
OPB_err(76);
}
t = x;
x = p;
p = t;
- p = NewOp__57(19, 18, p, x);
+ p = NewOp__54(19, 18, p, x);
} else {
OPB_err(111);
}
@@ -2152,14 +2085,14 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 19:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
+ } else if (f == 4) {
if ((p->class == 7 && x->class == 7)) {
if (-OPB_maxExp > x->conval->intval || x->conval->intval > OPB_maxExp) {
OPB_err(208);
p->conval->intval = 1;
} else if (x->conval->intval >= 0) {
- if (__ABS(p->conval->intval) <= __DIV(9223372036854775807, __ASH(1, x->conval->intval))) {
- p->conval->intval = p->conval->intval * __ASH(1, x->conval->intval);
+ 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);
p->conval->intval = 1;
@@ -2169,8 +2102,8 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
}
p->obj = NIL;
} else {
- p = NewOp__57(12, 17, p, x);
- p->typ = OPT_linttyp;
+ p = NewOp__54(12, 17, p, x);
+ p->typ = p->left->typ;
}
} else {
OPB_err(111);
@@ -2180,7 +2113,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if (p->typ->comp == 3) {
- if (__IN(f, 0x70)) {
+ if (f == 4) {
if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) {
OPB_err(63);
}
@@ -2196,13 +2129,13 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 22: case 23:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (!__IN(f, 0x70)) {
+ } else if (f != 4) {
OPB_err(111);
} else {
if (fctno == 22) {
- p = NewOp__57(12, 27, p, x);
+ p = NewOp__54(12, 27, p, x);
} else {
- p = NewOp__57(12, 28, p, x);
+ p = NewOp__54(12, 28, p, x);
}
p->typ = p->left->typ;
}
@@ -2210,7 +2143,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 24: case 25: case 26: case 27:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x63ff)) {
+ } else if (__IN(f, 0x18ff, 32)) {
if (fctno == 24 || fctno == 26) {
if (OPB_NotVar(x)) {
OPB_err(112);
@@ -2219,7 +2152,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
x = p;
p = t;
}
- p = NewOp__57(19, fctno, p, x);
+ p = NewOp__54(19, fctno, p, x);
} else {
OPB_err(111);
}
@@ -2228,32 +2161,38 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 28:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
- p = NewOp__57(12, 26, p, x);
+ } else if (f == 4) {
+ p = NewOp__54(12, 26, p, x);
} else {
OPB_err(111);
}
p->typ = OPT_booltyp;
break;
case 29:
- if (((x->class == 8 || x->class == 9) || __IN(f, 0x1401)) || x->typ->comp == 3) {
+ if (((x->class == 8 || x->class == 9) || __IN(f, 0x0501, 32)) || x->typ->comp == 3) {
OPB_err(126);
}
- if (x->typ->size < p->typ->size) {
+ OPT_TypSize(x->typ);
+ OPT_TypSize(p->typ);
+ if ((x->class != 7 && x->typ->size < p->typ->size)) {
OPB_err(-308);
}
- t = OPT_NewNode(11);
- t->subcl = 29;
- t->left = x;
- x = t;
- x->typ = p->typ;
+ if ((((x->class == 7 && x->typ->form == 4)) && p->typ->form == 4)) {
+ OPB_Convert(&x, p->typ);
+ } else {
+ t = OPT_NewNode(11);
+ t->subcl = 29;
+ t->left = x;
+ x = t;
+ x->typ = p->typ;
+ }
p = x;
break;
case 30:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
- p = NewOp__57(19, 30, p, x);
+ } else if (f == 4) {
+ p = NewOp__54(19, 30, p, x);
} else {
OPB_err(111);
}
@@ -2262,16 +2201,16 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 31:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if ((((x->class == 7 && __IN(f, 0x70))) && x->typ->size < OPT_linttyp->size)) {
- OPB_Convert(&x, OPT_linttyp);
- } else if (!((__IN(x->typ->form, 0x2070) && x->typ->size == (SYSTEM_INT64)OPM_PointerSize))) {
+ } else if ((((x->class == 7 && f == 4)) && x->typ->size < OPT_adrtyp->size)) {
+ OPB_Convert(&x, OPT_adrtyp);
+ } else if (!((__IN(x->typ->form, 0x0810, 32) && x->typ->size == OPM_AddressSize))) {
OPB_err(111);
- x->typ = OPT_linttyp;
+ x->typ = OPT_adrtyp;
}
p->link = x;
break;
case 32:
- if ((__IN(f, 0x70) && x->class == 7)) {
+ if ((f == 4 && x->class == 7)) {
if ((0 <= x->conval->intval && x->conval->intval <= 255)) {
OPB_BindNodes(28, OPT_notyp, &x, x);
x->conval = OPT_NewConst();
@@ -2299,13 +2238,13 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
break;
}
*par0 = p;
- StPar1__56_s = _s.lnk;
+ StPar1__53_s = _s.lnk;
}
-void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
+void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n)
{
OPT_Node node = NIL;
- INTEGER f;
+ INT16 f;
OPT_Node p = NIL;
p = *par0;
f = x->typ->form;
@@ -2314,7 +2253,7 @@ void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
OPB_err(126);
} else if (p->typ->comp != 3) {
OPB_err(64);
- } else if (__IN(f, 0x70)) {
+ } else if (f == 4) {
if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) {
OPB_err(63);
}
@@ -2330,7 +2269,7 @@ void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
} else if ((fctno == 31 && n == 2)) {
if (x->class == 8 || x->class == 9) {
OPB_err(126);
- } else if (__IN(f, 0x70)) {
+ } else if (f == 4) {
node = OPT_NewNode(19);
node->subcl = 31;
node->right = p;
@@ -2347,9 +2286,9 @@ void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
*par0 = p;
}
-void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno)
+void OPB_StFct (OPT_Node *par0, INT8 fctno, INT16 parno)
{
- INTEGER dim;
+ INT16 dim;
OPT_Node x = NIL, p = NIL;
p = *par0;
if (fctno <= 19) {
@@ -2364,7 +2303,7 @@ void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno)
}
} else {
if (((fctno == 13 || fctno == 14) && parno == 1)) {
- OPB_BindNodes(19, OPT_notyp, &p, OPB_NewIntConst(((LONGINT)(1))));
+ OPB_BindNodes(19, OPT_notyp, &p, OPB_NewIntConst(1));
p->subcl = fctno;
p->right->typ = p->left->typ;
} else if ((fctno == 17 && parno == 1)) {
@@ -2386,7 +2325,7 @@ void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno)
} else if (fctno == 32) {
if (parno == 1) {
x = NIL;
- OPB_BindNodes(28, OPT_notyp, &x, OPB_NewIntConst(((LONGINT)(0))));
+ OPB_BindNodes(28, OPT_notyp, &x, OPB_NewIntConst(0));
x->conval = OPT_NewConst();
x->conval->intval = OPM_errpos;
OPB_Construct(15, &p, x);
@@ -2413,21 +2352,21 @@ void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno)
static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar)
{
- INTEGER f;
+ INT16 f;
f = atyp->comp;
ftyp = ftyp->BaseTyp;
atyp = atyp->BaseTyp;
if ((fvarpar && ftyp == OPT_bytetyp)) {
- if (!__IN(f, 0x0c) || !((__IN(atyp->form, 0x7e) && atyp->size == 1))) {
- if (__IN(18, OPM_opt)) {
+ if (!__IN(f, 0x0c, 32) || !((__IN(atyp->form, 0x1e, 32) && atyp->size == 1))) {
+ if (__IN(18, OPM_Options, 32)) {
OPB_err(-301);
}
}
- } else if (__IN(f, 0x0c)) {
+ } else if (__IN(f, 0x0c, 32)) {
if (ftyp->comp == 3) {
OPB_DynArrParCheck(ftyp, atyp, fvarpar);
} else if (ftyp != atyp) {
- if ((((!fvarpar && ftyp->form == 13)) && atyp->form == 13)) {
+ if ((((!fvarpar && ftyp->form == 11)) && atyp->form == 11)) {
ftyp = ftyp->BaseTyp;
atyp = atyp->BaseTyp;
if ((ftyp->comp == 4 && atyp->comp == 4)) {
@@ -2451,7 +2390,7 @@ static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpa
static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp)
{
- if (fp->typ->form == 13) {
+ if (fp->typ->form == 11) {
if ((*x)->class == 3) {
*x = (*x)->left;
} else {
@@ -2462,13 +2401,13 @@ static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp)
void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar)
{
- if (((*x)->obj != NIL && __IN((*x)->obj->mode, 0x22c0))) {
+ if (((*x)->obj != NIL && __IN((*x)->obj->mode, 0x22c0, 32))) {
*fpar = (*x)->obj->link;
if ((*x)->obj->mode == 13) {
OPB_CheckReceiver(&(*x)->left, *fpar);
*fpar = (*fpar)->link;
}
- } else if (((((*x)->class != 8 && (*x)->typ != NIL)) && (*x)->typ->form == 14)) {
+ } else if (((((*x)->class != 8 && (*x)->typ != NIL)) && (*x)->typ->form == 12)) {
*fpar = (*x)->typ->link;
} else {
OPB_err(121);
@@ -2500,17 +2439,17 @@ void OPB_Param (OPT_Node ap, OPT_Object fp)
if (q == NIL) {
OPB_err(111);
}
- } else if ((fp->typ == OPT_sysptrtyp && ap->typ->form == 13)) {
- } else if ((ap->typ != fp->typ && !((fp->typ->form == 1 && ((__IN(ap->typ->form, 0x7e) && ap->typ->size == 1)))))) {
+ } else if ((fp->typ == OPT_sysptrtyp && ap->typ->form == 11)) {
+ } else if ((ap->typ != fp->typ && !((((fp->typ->form == 1 && __IN(ap->typ->form, 0x1e, 32))) && ap->typ->size == 1)))) {
OPB_err(123);
- } else if ((fp->typ->form == 13 && ap->class == 5)) {
+ } else if ((fp->typ->form == 11 && ap->class == 5)) {
OPB_err(123);
}
} else if (fp->typ->comp == 3) {
if ((ap->class == 7 && ap->typ->form == 3)) {
OPB_CharToString(ap);
}
- if ((ap->typ->form == 10 && fp->typ->BaseTyp->form == 3)) {
+ if ((ap->typ->form == 8 && fp->typ->BaseTyp->form == 3)) {
} else if (ap->class >= 7) {
OPB_err(59);
} else {
@@ -2522,13 +2461,13 @@ void OPB_Param (OPT_Node ap, OPT_Object fp)
}
}
-void OPB_StaticLink (SHORTINT dlev)
+void OPB_StaticLink (INT8 dlev)
{
OPT_Object scope = NIL;
scope = OPT_topScope;
while (dlev > 0) {
dlev -= 1;
- scope->link->conval->setval |= __SETOF(3);
+ scope->link->conval->setval |= __SETOF(3,64);
scope = scope->left;
}
}
@@ -2537,7 +2476,7 @@ void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp)
{
OPT_Struct typ = NIL;
OPT_Node p = NIL;
- SHORTINT lev;
+ INT8 lev;
if ((*x)->class == 9) {
typ = (*x)->typ;
lev = (*x)->obj->mnolev;
@@ -2597,7 +2536,7 @@ void OPB_Return (OPT_Node *x, OPT_Object proc)
void OPB_Assign (OPT_Node *x, OPT_Node y)
{
OPT_Node z = NIL;
- SHORTINT subcl;
+ INT8 subcl;
if ((*x)->class >= 7) {
OPB_err(56);
}
@@ -2618,12 +2557,12 @@ void OPB_Assign (OPT_Node *x, OPT_Node y)
OPB_BindNodes(6, (*x)->typ, &z, NIL);
*x = z;
}
- } else if (((((((*x)->typ->comp == 2 && (*x)->typ->BaseTyp == OPT_chartyp)) && y->typ->form == 10)) && y->conval->intval2 == 1)) {
+ } else if (((((((*x)->typ->comp == 2 && (*x)->typ->BaseTyp == OPT_chartyp)) && y->typ->form == 8)) && y->conval->intval2 == 1)) {
y->typ = OPT_chartyp;
y->conval->intval = 0;
- OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0))));
+ OPB_Index(&*x, OPB_NewIntConst(0));
}
- if ((((((__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp == OPT_chartyp)) && __IN(y->typ->comp, 0x0c))) && y->typ->BaseTyp == OPT_chartyp)) {
+ 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;
diff --git a/bootstrap/windows-88/OPB.h b/bootstrap/windows-88/OPB.h
index af419f75..0be714e8 100644
--- a/bootstrap/windows-88/OPB.h
+++ b/bootstrap/windows-88/OPB.h
@@ -1,21 +1,19 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPB__h
#define OPB__h
-#define LARGE
#include "SYSTEM.h"
#include "OPS.h"
#include "OPT.h"
-import void (*OPB_typSize)(OPT_Struct);
import void OPB_Assign (OPT_Node *x, OPT_Node y);
import void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp);
import void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames);
-import void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y);
+import void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y);
import void OPB_DeRef (OPT_Node *x);
import OPT_Node OPB_EmptySet (void);
import void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc);
@@ -24,27 +22,27 @@ import void OPB_In (OPT_Node *x, OPT_Node y);
import void OPB_Index (OPT_Node *x, OPT_Node y);
import void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ);
import void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y);
-import void OPB_MOp (SHORTINT op, OPT_Node *x);
+import void OPB_MOp (INT8 op, OPT_Node *x);
import OPT_Node OPB_NewBoolConst (BOOLEAN boolval);
-import OPT_Node OPB_NewIntConst (LONGINT intval);
+import OPT_Node OPB_NewIntConst (INT64 intval);
import OPT_Node OPB_NewLeaf (OPT_Object obj);
import OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ);
-import OPT_Node OPB_NewString (OPS_String str, LONGINT len);
+import OPT_Node OPB_NewString (OPS_String str, INT64 len);
import OPT_Node OPB_Nil (void);
-import void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y);
+import void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y);
import void OPB_OptIf (OPT_Node *x);
import void OPB_Param (OPT_Node ap, OPT_Object fp);
import void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar);
import void OPB_Return (OPT_Node *x, OPT_Object proc);
import void OPB_SetElem (OPT_Node *x);
import void OPB_SetRange (OPT_Node *x, OPT_Node y);
-import void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno);
-import void OPB_StPar0 (OPT_Node *par0, INTEGER fctno);
-import void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno);
-import void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n);
-import void OPB_StaticLink (SHORTINT dlev);
+import void OPB_StFct (OPT_Node *par0, INT8 fctno, INT16 parno);
+import void OPB_StPar0 (OPT_Node *par0, INT16 fctno);
+import void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno);
+import void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n);
+import void OPB_StaticLink (INT8 dlev);
import void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard);
import void *OPB__init(void);
-#endif
+#endif // OPB
diff --git a/bootstrap/windows-88/OPC.c b/bootstrap/windows-88/OPC.c
index bb9b75e6..ef4b429f 100644
--- a/bootstrap/windows-88/OPC.c
+++ b/bootstrap/windows-88/OPC.c
@@ -1,32 +1,34 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "Configuration.h"
#include "OPM.h"
#include "OPT.h"
-static INTEGER OPC_indentLevel;
-static BOOLEAN OPC_ptrinit, OPC_mainprog, OPC_ansi;
-static SHORTINT OPC_hashtab[105];
-static CHAR OPC_keytab[36][9];
+static INT16 OPC_indentLevel;
+static INT8 OPC_hashtab[105];
+static CHAR OPC_keytab[50][9];
static BOOLEAN OPC_GlbPtrs;
static CHAR OPC_BodyNameExt[13];
-export void OPC_Align (LONGINT *adr, LONGINT base);
export void OPC_Andent (OPT_Struct typ);
static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames);
-export LONGINT OPC_BaseAlignment (OPT_Struct typ);
export OPT_Object OPC_BaseTProc (OPT_Object obj);
export void OPC_BegBlk (void);
export void OPC_BegStat (void);
-static void OPC_CProcDefs (OPT_Object obj, INTEGER vis);
-export void OPC_Case (LONGINT caseVal, INTEGER form);
-static void OPC_CharacterLiteral (LONGINT c);
-export void OPC_Cmp (INTEGER rel);
+static void OPC_CProcDefs (OPT_Object obj, INT16 vis);
+export void OPC_Case (INT64 caseVal, INT16 form);
+static void OPC_CharacterLiteral (INT64 c);
+export void OPC_Cmp (INT16 rel);
export void OPC_CompleteIdent (OPT_Object obj);
-export void OPC_Constant (OPT_Const con, INTEGER form);
+export void OPC_Constant (OPT_Const con, INT16 form);
static void OPC_DeclareBase (OPT_Object dcl);
static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef);
static void OPC_DeclareParams (OPT_Object par, BOOLEAN macro);
@@ -43,44 +45,45 @@ export void OPC_EnterBody (void);
export void OPC_EnterProc (OPT_Object proc);
export void OPC_ExitBody (void);
export void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet);
-static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *n, LONGINT *curAlign);
-static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LONGINT *curAlign);
+static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, INT32 *off, INT32 *n, INT32 *curAlign);
+static void OPC_FillGap (INT32 gap, INT32 off, INT32 align, INT32 *n, INT32 *curAlign);
export void OPC_GenBdy (OPT_Node n);
-static void OPC_GenDynTypes (OPT_Node n, INTEGER vis);
+static void OPC_GenDynTypes (OPT_Node n, INT16 vis);
export void OPC_GenEnumPtrs (OPT_Object var);
export void OPC_GenHdr (OPT_Node n);
export void OPC_GenHdrIncludes (void);
static void OPC_GenHeaderMsg (void);
-export void OPC_Halt (LONGINT n);
+export void OPC_Halt (INT32 n);
export void OPC_Ident (OPT_Object obj);
-static void OPC_IdentList (OPT_Object obj, INTEGER vis);
+static void OPC_IdentList (OPT_Object obj, INT16 vis);
static void OPC_Include (CHAR *name, LONGINT name__len);
-static void OPC_IncludeImports (OPT_Object obj, INTEGER vis);
+static void OPC_IncludeImports (OPT_Object obj, INT16 vis);
export void OPC_Increment (BOOLEAN decrement);
-export void OPC_Indent (INTEGER count);
+export void OPC_Indent (INT16 count);
export void OPC_Init (void);
static void OPC_InitImports (OPT_Object obj);
static void OPC_InitKeywords (void);
export void OPC_InitTDesc (OPT_Struct typ);
static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj);
-export void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim);
+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 INTEGER OPC_Length (CHAR *s, LONGINT s__len);
-export LONGINT OPC_NofPtrs (OPT_Struct typ);
-static INTEGER OPC_PerfectHash (CHAR *s, LONGINT s__len);
+static 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, LONGINT s__len);
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len);
static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define);
-static void OPC_ProcPredefs (OPT_Object obj, SHORTINT vis);
+static void OPC_ProcPredefs (OPT_Object obj, INT8 vis);
static void OPC_PutBase (OPT_Struct typ);
-static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt);
+static void OPC_PutPtrOffsets (OPT_Struct typ, INT32 adr, INT32 *cnt);
static void OPC_RegCmds (OPT_Object obj);
export void OPC_SetInclude (BOOLEAN exclude);
-export LONGINT OPC_SizeAlignment (LONGINT size);
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause);
-static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x);
-static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT 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, INTEGER vis);
+export void OPC_TypeDefs (OPT_Object obj, INT16 vis);
export void OPC_TypeOf (OPT_Object ap);
static BOOLEAN OPC_Undefined (OPT_Object obj);
@@ -88,24 +91,17 @@ static BOOLEAN OPC_Undefined (OPT_Object obj);
void OPC_Init (void)
{
OPC_indentLevel = 0;
- OPC_ptrinit = __IN(5, OPM_opt);
- OPC_mainprog = OPM_mainProg || OPM_mainLinkStat;
- OPC_ansi = __IN(6, OPM_opt);
- if (OPC_ansi) {
- __MOVE("__init(void)", OPC_BodyNameExt, 13);
- } else {
- __MOVE("__init()", OPC_BodyNameExt, 9);
- }
+ __MOVE("__init(void)", OPC_BodyNameExt, 13);
}
-void OPC_Indent (INTEGER count)
+void OPC_Indent (INT16 count)
{
OPC_indentLevel += count;
}
void OPC_BegStat (void)
{
- INTEGER i;
+ INT16 i;
i = OPC_indentLevel;
while (i > 0) {
OPM_Write(0x09);
@@ -141,10 +137,10 @@ void OPC_EndBlk0 (void)
OPM_Write('}');
}
-static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x)
+static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x)
{
CHAR ch;
- INTEGER i;
+ INT16 i;
__DUP(s, s__len, CHAR);
ch = s[0];
i = 0;
@@ -160,79 +156,86 @@ static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x)
__DEL(s);
}
-static INTEGER OPC_Length (CHAR *s, LONGINT s__len)
+static INT16 OPC_Length (CHAR *s, LONGINT s__len)
{
- INTEGER _o_result;
- INTEGER i;
+ INT16 i;
i = 0;
while (s[__X(i, s__len)] != 0x00) {
i += 1;
}
- _o_result = i;
- return _o_result;
+ return i;
}
-static INTEGER OPC_PerfectHash (CHAR *s, LONGINT s__len)
+static INT16 OPC_PerfectHash (CHAR *s, LONGINT s__len)
{
- INTEGER _o_result;
- INTEGER i, h;
+ INT16 i, h;
i = 0;
h = 0;
while ((s[__X(i, s__len)] != 0x00 && i < 5)) {
- h = 3 * h + (int)s[__X(i, s__len)];
+ h = 3 * h + (INT16)s[__X(i, s__len)];
i += 1;
}
- _o_result = (int)__MOD(h, 105);
- return _o_result;
+ return (int)__MOD(h, 105);
}
void OPC_Ident (OPT_Object obj)
{
- INTEGER mode, level, h;
+ INT16 mode, level, h;
mode = obj->mode;
level = obj->mnolev;
- if ((__IN(mode, 0x62) && level > 0) || __IN(mode, 0x14)) {
- OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256)));
- h = OPC_PerfectHash((void*)obj->name, ((LONGINT)(256)));
- if (OPC_hashtab[__X(h, ((LONGINT)(105)))] >= 0) {
- if (__STRCMP(OPC_keytab[__X(OPC_hashtab[__X(h, ((LONGINT)(105)))], ((LONGINT)(36)))], obj->name) == 0) {
+ if ((__IN(mode, 0x62, 32) && level > 0) || __IN(mode, 0x14, 32)) {
+ OPM_WriteStringVar((void*)obj->name, 256);
+ h = OPC_PerfectHash((void*)obj->name, 256);
+ if (OPC_hashtab[__X(h, 105)] >= 0) {
+ if (__STRCMP(OPC_keytab[__X(OPC_hashtab[__X(h, 105)], 50)], obj->name) == 0) {
OPM_Write('_');
}
}
+ } else if ((mode == 5 && __IN(obj->typ->form, 0x90, 32))) {
+ if (obj->typ == OPT_adrtyp) {
+ OPM_WriteString((CHAR*)"ADDRESS", 8);
+ } else {
+ if (obj->typ->form == 4) {
+ OPM_WriteString((CHAR*)"INT", 4);
+ } else {
+ OPM_WriteString((CHAR*)"UINT", 5);
+ }
+ OPM_WriteInt(__ASHL(obj->typ->size, 3));
+ }
} else {
if (mode != 5 || obj->linkadr != 2) {
if (mode == 13) {
OPC_Ident(obj->link->typ->strobj);
} else if (level < 0) {
- OPM_WriteStringVar((void*)OPT_GlbMod[__X(-level, ((LONGINT)(64)))]->name, ((LONGINT)(256)));
+ OPM_WriteStringVar((void*)OPT_GlbMod[__X(-level, 64)]->name, 256);
if (OPM_currFile == 0) {
- OPT_GlbMod[__X(-level, ((LONGINT)(64)))]->vis = 1;
+ OPT_GlbMod[__X(-level, 64)]->vis = 1;
}
} else {
- OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32)));
+ OPM_WriteStringVar((void*)OPM_modName, 32);
}
OPM_Write('_');
} else if (obj == OPT_sysptrtyp->strobj || obj == OPT_bytetyp->strobj) {
- OPM_WriteString((CHAR*)"SYSTEM_", (LONGINT)8);
+ OPM_WriteString((CHAR*)"SYSTEM_", 8);
}
- OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256)));
+ OPM_WriteStringVar((void*)obj->name, 256);
}
}
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause)
{
- INTEGER pointers;
+ INT16 pointers;
*openClause = 0;
if (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->comp != 4)) {
- if (__IN(typ->comp, 0x0c)) {
+ if (__IN(typ->comp, 0x0c, 32)) {
OPC_Stars(typ->BaseTyp, &*openClause);
*openClause = typ->comp == 2;
- } else if (typ->form == 14) {
+ } else if (typ->form == 12) {
OPM_Write('(');
OPM_Write('*');
} else {
pointers = 0;
- while (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->form == 13)) {
+ while (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->form == 11)) {
pointers += 1;
typ = typ->BaseTyp;
}
@@ -257,7 +260,7 @@ static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef)
{
OPT_Struct typ = NIL;
BOOLEAN varPar, openClause;
- INTEGER form, comp;
+ INT16 form, comp;
typ = dcl->typ;
varPar = ((dcl->mode == 2 && typ->comp != 2) || typ->comp == 3) || scopeDef;
OPC_Stars(typ, &openClause);
@@ -277,22 +280,18 @@ static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef)
for (;;) {
form = typ->form;
comp = typ->comp;
- if (((typ->strobj != NIL && typ->strobj->name[0] != 0x00) || form == 12) || comp == 4) {
+ if (((typ->strobj != NIL && typ->strobj->name[0] != 0x00) || form == 10) || comp == 4) {
break;
- } else if ((form == 13 && typ->BaseTyp->comp != 3)) {
+ } else if ((form == 11 && typ->BaseTyp->comp != 3)) {
openClause = 1;
- } else if (form == 14 || __IN(comp, 0x0c)) {
+ } else if (form == 12 || __IN(comp, 0x0c, 32)) {
if (openClause) {
OPM_Write(')');
openClause = 0;
}
- if (form == 14) {
- if (OPC_ansi) {
- OPM_Write(')');
- OPC_AnsiParamList(typ->link, 0);
- } else {
- OPM_WriteString((CHAR*)")()", (LONGINT)4);
- }
+ if (form == 12) {
+ OPM_Write(')');
+ OPC_AnsiParamList(typ->link, 0);
break;
} else if (comp == 2) {
OPM_Write('[');
@@ -309,8 +308,8 @@ static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef)
void OPC_Andent (OPT_Struct typ)
{
if (typ->strobj == NIL || typ->align >= 65536) {
- OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32)));
- OPC_Str1((CHAR*)"__#", (LONGINT)4, __ASHR(typ->align, 16));
+ OPM_WriteStringVar((void*)OPM_modName, 32);
+ OPC_Str1((CHAR*)"__#", 4, __ASHR(typ->align, 16));
} else {
OPC_Ident(typ->strobj);
}
@@ -318,36 +317,34 @@ void OPC_Andent (OPT_Struct typ)
static BOOLEAN OPC_Undefined (OPT_Object obj)
{
- BOOLEAN _o_result;
- _o_result = obj->name[0] == 0x00 || (((obj->mnolev >= 0 && obj->linkadr != (SYSTEM_INT64)(3 + OPM_currFile))) && obj->linkadr != 2);
- return _o_result;
+ return obj->name[0] == 0x00 || (((obj->mnolev >= 0 && obj->linkadr != (3 + OPM_currFile))) && obj->linkadr != 2);
}
static void OPC_DeclareBase (OPT_Object dcl)
{
OPT_Struct typ = NIL, prev = NIL;
OPT_Object obj = NIL;
- INTEGER nofdims;
- LONGINT off, n, dummy;
+ INT16 nofdims;
+ INT32 off, n, dummy;
typ = dcl->typ;
prev = typ;
- while ((((((((typ->strobj == NIL || typ->comp == 3) || OPC_Undefined(typ->strobj)) && typ->comp != 4)) && typ->form != 12)) && !((typ->form == 13 && typ->BaseTyp->comp == 3)))) {
+ while ((((((((typ->strobj == NIL || typ->comp == 3) || OPC_Undefined(typ->strobj)) && typ->comp != 4)) && typ->form != 10)) && !((typ->form == 11 && typ->BaseTyp->comp == 3)))) {
prev = typ;
typ = typ->BaseTyp;
}
obj = typ->strobj;
- if (typ->form == 12) {
- OPM_WriteString((CHAR*)"void", (LONGINT)5);
+ if (typ->form == 10) {
+ OPM_WriteString((CHAR*)"void", 5);
} else if ((obj != NIL && !OPC_Undefined(obj))) {
OPC_Ident(obj);
} else if (typ->comp == 4) {
- OPM_WriteString((CHAR*)"struct ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"struct ", 8);
OPC_Andent(typ);
- if ((prev->form != 13 && (obj != NIL || dcl->name[0] == 0x00))) {
+ if ((prev->form != 11 && (obj != NIL || dcl->name[0] == 0x00))) {
if ((typ->BaseTyp != NIL && typ->BaseTyp->strobj->vis != 0)) {
- OPM_WriteString((CHAR*)" { /* ", (LONGINT)7);
+ OPM_WriteString((CHAR*)" { /* ", 7);
OPC_Ident(typ->BaseTyp->strobj);
- OPM_WriteString((CHAR*)" */", (LONGINT)4);
+ OPM_WriteString((CHAR*)" */", 4);
OPM_WriteLn();
OPC_Indent(1);
} else {
@@ -357,22 +354,22 @@ static void OPC_DeclareBase (OPT_Object dcl)
OPC_FieldList(typ, 1, &off, &n, &dummy);
OPC_EndBlk0();
}
- } else if ((typ->form == 13 && typ->BaseTyp->comp == 3)) {
+ } else if ((typ->form == 11 && typ->BaseTyp->comp == 3)) {
typ = typ->BaseTyp->BaseTyp;
nofdims = 1;
while (typ->comp == 3) {
nofdims += 1;
typ = typ->BaseTyp;
}
- OPM_WriteString((CHAR*)"struct ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"struct ", 8);
OPC_BegBlk();
OPC_BegStat();
- OPC_Str1((CHAR*)"LONGINT len[#]", (LONGINT)15, nofdims);
+ OPC_Str1((CHAR*)"LONGINT len[#]", 15, nofdims);
OPC_EndStat();
OPC_BegStat();
__NEW(obj, OPT_ObjDesc);
__NEW(obj->typ, OPT_StrDesc);
- obj->typ->form = 15;
+ obj->typ->form = 13;
obj->typ->comp = 2;
obj->typ->n = 1;
obj->typ->BaseTyp = typ;
@@ -387,15 +384,13 @@ static void OPC_DeclareBase (OPT_Object dcl)
}
}
-LONGINT OPC_NofPtrs (OPT_Struct typ)
+INT32 OPC_NofPtrs (OPT_Struct typ)
{
- LONGINT _o_result;
OPT_Object fld = NIL;
OPT_Struct btyp = NIL;
- LONGINT n;
- if ((typ->form == 13 && typ->sysflag == 0)) {
- _o_result = 1;
- return _o_result;
+ INT32 n;
+ if ((typ->form == 11 && typ->sysflag == 0)) {
+ return 1;
} else if ((typ->comp == 4 && __MASK(typ->sysflag, -256) == 0)) {
btyp = typ->BaseTyp;
if (btyp != NIL) {
@@ -412,8 +407,7 @@ LONGINT OPC_NofPtrs (OPT_Struct typ)
}
fld = fld->link;
}
- _o_result = n;
- return _o_result;
+ return n;
} else if (typ->comp == 2) {
btyp = typ->BaseTyp;
n = typ->n;
@@ -421,23 +415,21 @@ LONGINT OPC_NofPtrs (OPT_Struct typ)
n = btyp->n * n;
btyp = btyp->BaseTyp;
}
- _o_result = OPC_NofPtrs(btyp) * n;
- return _o_result;
+ return OPC_NofPtrs(btyp) * n;
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt)
+static void OPC_PutPtrOffsets (OPT_Struct typ, INT32 adr, INT32 *cnt)
{
OPT_Object fld = NIL;
OPT_Struct btyp = NIL;
- LONGINT n, i;
- if ((typ->form == 13 && typ->sysflag == 0)) {
+ INT32 n, i;
+ if ((typ->form == 11 && typ->sysflag == 0)) {
OPM_WriteInt(adr);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
*cnt += 1;
if (__MASK(*cnt, -16) == 0) {
OPM_WriteLn();
@@ -454,7 +446,7 @@ static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt)
OPC_PutPtrOffsets(fld->typ, adr + fld->adr, &*cnt);
} else {
OPM_WriteInt(adr + fld->adr);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
*cnt += 1;
if (__MASK(*cnt, -16) == 0) {
OPM_WriteLn();
@@ -486,11 +478,11 @@ static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj)
OPC_InitTProcs(typ, obj->left);
if (obj->mode == 13) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"__INITBP(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__INITBP(", 10);
OPC_Ident(typ);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Ident(obj);
- OPC_Str1((CHAR*)", #)", (LONGINT)5, __ASHR(obj->adr, 16));
+ OPC_Str1((CHAR*)", #)", 5, __ASHR(obj->adr, 16));
OPC_EndStat();
}
OPC_InitTProcs(typ, obj->right);
@@ -502,30 +494,30 @@ static void OPC_PutBase (OPT_Struct typ)
if (typ != NIL) {
OPC_PutBase(typ->BaseTyp);
OPC_Ident(typ->strobj);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)"__typ", 6);
+ OPM_WriteString((CHAR*)", ", 3);
}
}
static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamName)
{
OPT_Struct typ = NIL;
- INTEGER dim;
+ INT16 dim;
if (showParamName) {
OPC_Ident(par);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
}
dim = 1;
typ = par->typ->BaseTyp;
while (typ->comp == 3) {
if (ansiDefine) {
- OPM_WriteString((CHAR*)", LONGINT ", (LONGINT)11);
+ OPM_WriteString((CHAR*)", LONGINT ", 11);
} else {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
}
if (showParamName) {
OPC_Ident(par);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
OPM_WriteInt(dim);
}
typ = typ->BaseTyp;
@@ -538,24 +530,24 @@ static void OPC_DeclareParams (OPT_Object par, BOOLEAN macro)
OPM_Write('(');
while (par != NIL) {
if (macro) {
- OPM_WriteStringVar((void*)par->name, ((LONGINT)(256)));
+ OPM_WriteStringVar((void*)par->name, 256);
} else {
- if ((par->mode == 1 && par->typ->form == 7)) {
+ if ((par->mode == 1 && par->typ->form == 5)) {
OPM_Write('_');
}
OPC_Ident(par);
}
if (par->typ->comp == 3) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_LenList(par, 0, 1);
} else if ((par->mode == 2 && par->typ->comp == 4)) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPM_WriteStringVar((void*)par->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPM_WriteStringVar((void*)par->name, 256);
+ OPM_WriteString((CHAR*)"__typ", 6);
}
par = par->link;
if (par != NIL) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
}
}
OPM_Write(')');
@@ -567,12 +559,10 @@ static void OPC_DefineTProcTypes (OPT_Object obj)
if (obj->typ != OPT_notyp) {
OPC_DefineType(obj->typ);
}
- if (OPC_ansi) {
- par = obj->link;
- while (par != NIL) {
- OPC_DefineType(par->typ);
- par = par->link;
- }
+ par = obj->link;
+ while (par != NIL) {
+ OPC_DefineType(par->typ);
+ par = par->link;
}
}
@@ -587,7 +577,7 @@ static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty)
if (OPM_currFile == 0) {
if (obj->vis == 1) {
OPC_DefineTProcTypes(obj);
- OPM_WriteString((CHAR*)"import ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"import ", 8);
*empty = 0;
OPC_ProcHeader(obj, 0);
}
@@ -595,9 +585,9 @@ static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty)
*empty = 0;
OPC_DefineTProcTypes(obj);
if (obj->vis == 0) {
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"static ", 8);
} else {
- OPM_WriteString((CHAR*)"export ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"export ", 8);
}
OPC_ProcHeader(obj, 0);
}
@@ -608,11 +598,10 @@ static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty)
OPT_Object OPC_BaseTProc (OPT_Object obj)
{
- OPT_Object _o_result;
OPT_Struct typ = NIL, base = NIL;
- LONGINT mno;
+ INT32 mno;
typ = obj->link->typ;
- if (typ->form == 13) {
+ if (typ->form == 11) {
typ = typ->BaseTyp;
}
base = typ->BaseTyp;
@@ -622,8 +611,7 @@ OPT_Object OPC_BaseTProc (OPT_Object obj)
base = typ->BaseTyp;
}
OPT_FindField(obj->name, typ, &obj);
- _o_result = obj;
- return _o_result;
+ return obj;
}
static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty)
@@ -631,31 +619,27 @@ static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty)
if (obj != NIL) {
OPC_DefineTProcMacros(obj->left, &*empty);
if ((((obj->mode == 13 && obj == OPC_BaseTProc(obj))) && (OPM_currFile != 0 || obj->vis == 1))) {
- OPM_WriteString((CHAR*)"#define __", (LONGINT)11);
+ OPM_WriteString((CHAR*)"#define __", 11);
OPC_Ident(obj);
OPC_DeclareParams(obj->link, 1);
- OPM_WriteString((CHAR*)" __SEND(", (LONGINT)9);
- if (obj->link->typ->form == 13) {
- OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10);
+ 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", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
}
- OPC_Str1((CHAR*)", #, ", (LONGINT)6, __ASHR(obj->adr, 16));
+ OPC_Str1((CHAR*)", #, ", 6, __ASHR(obj->adr, 16));
if (obj->typ == OPT_notyp) {
- OPM_WriteString((CHAR*)"void", (LONGINT)5);
+ OPM_WriteString((CHAR*)"void", 5);
} else {
OPC_Ident(obj->typ->strobj);
}
- OPM_WriteString((CHAR*)"(*)", (LONGINT)4);
- if (OPC_ansi) {
- OPC_AnsiParamList(obj->link, 0);
- } else {
- OPM_WriteString((CHAR*)"()", (LONGINT)3);
- }
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)"(*)", 4);
+ OPC_AnsiParamList(obj->link, 0);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_DeclareParams(obj->link, 1);
OPM_Write(')');
OPM_WriteLn();
@@ -673,7 +657,7 @@ static void OPC_DefineType (OPT_Struct str)
if (obj == NIL || OPC_Undefined(obj)) {
if (obj != NIL) {
if (obj->linkadr == 1) {
- if (str->form != 13) {
+ if (str->form != 11) {
OPM_Mark(244, str->txtpos);
obj->linkadr = 2;
}
@@ -692,13 +676,13 @@ static void OPC_DefineType (OPT_Struct str)
}
field = field->link;
}
- } else if (str->form == 13) {
+ } else if (str->form == 11) {
if (str->BaseTyp->comp != 4) {
OPC_DefineType(str->BaseTyp);
}
- } else if (__IN(str->comp, 0x0c)) {
+ } else if (__IN(str->comp, 0x0c, 32)) {
OPC_DefineType(str->BaseTyp);
- } else if (str->form == 14) {
+ } else if (str->form == 12) {
if (str->BaseTyp != OPT_notyp) {
OPC_DefineType(str->BaseTyp);
}
@@ -710,7 +694,7 @@ static void OPC_DefineType (OPT_Struct str)
}
}
if ((obj != NIL && OPC_Undefined(obj))) {
- OPM_WriteString((CHAR*)"typedef", (LONGINT)8);
+ OPM_WriteString((CHAR*)"typedef", 8);
OPM_WriteLn();
OPM_Write(0x09);
OPC_Indent(1);
@@ -738,40 +722,36 @@ static void OPC_DefineType (OPT_Struct str)
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len)
{
- BOOLEAN _o_result;
- INTEGER i;
- BOOLEAN r;
+ INT16 i;
__DUP(y, y__len, CHAR);
i = 0;
- while ((*x)[__X(i + 1, ((LONGINT)(256)))] == y[__X(i, y__len)]) {
+ while ((*x)[__X(i + 1, 256)] == y[__X(i, y__len)]) {
i += 1;
}
- r = y[__X(i, y__len)] == 0x00;
- _o_result = r;
__DEL(y);
- return _o_result;
+ return y[__X(i, y__len)] == 0x00;
}
-static void OPC_CProcDefs (OPT_Object obj, INTEGER vis)
+static void OPC_CProcDefs (OPT_Object obj, INT16 vis)
{
- INTEGER i;
+ INT16 i;
OPT_ConstExt ext = NIL;
- INTEGER _for__9;
+ INT16 _for__7;
if (obj != NIL) {
OPC_CProcDefs(obj->left, vis);
- if ((((obj->mode == 9 && (int)obj->vis >= vis)) && obj->adr == 1)) {
+ if ((((obj->mode == 9 && (INT16)obj->vis >= vis)) && obj->adr == 1)) {
ext = obj->conval->ext;
i = 1;
- if (((*ext)[1] != '#' && !(OPC_Prefixed(ext, (CHAR*)"extern ", (LONGINT)8) || OPC_Prefixed(ext, (CHAR*)"import ", (LONGINT)8)))) {
- OPM_WriteString((CHAR*)"#define ", (LONGINT)9);
+ if (((*ext)[1] != '#' && !(OPC_Prefixed(ext, (CHAR*)"extern ", 8) || OPC_Prefixed(ext, (CHAR*)"import ", 8)))) {
+ OPM_WriteString((CHAR*)"#define ", 9);
OPC_Ident(obj);
OPC_DeclareParams(obj->link, 1);
OPM_Write(0x09);
}
- _for__9 = (int)(*obj->conval->ext)[0];
+ _for__7 = (INT16)(*obj->conval->ext)[0];
i = i;
- while (i <= _for__9) {
- OPM_Write((*obj->conval->ext)[__X(i, ((LONGINT)(256)))]);
+ while (i <= _for__7) {
+ OPM_Write((*obj->conval->ext)[__X(i, 256)]);
i += 1;
}
OPM_WriteLn();
@@ -780,7 +760,7 @@ static void OPC_CProcDefs (OPT_Object obj, INTEGER vis)
}
}
-void OPC_TypeDefs (OPT_Object obj, INTEGER vis)
+void OPC_TypeDefs (OPT_Object obj, INT16 vis)
{
if (obj != NIL) {
OPC_TypeDefs(obj->left, vis);
@@ -812,130 +792,85 @@ static void OPC_DefAnonRecs (OPT_Node n)
void OPC_TDescDecl (OPT_Struct typ)
{
- LONGINT nofptrs;
+ INT32 nofptrs;
OPT_Object o = NIL;
OPC_BegStat();
- OPM_WriteString((CHAR*)"__TDESC(", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__TDESC(", 9);
OPC_Andent(typ);
- OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1);
- OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ));
+ OPC_Str1((CHAR*)", #", 4, typ->n + 1);
+ OPC_Str1((CHAR*)", #) = {__TDFLDS(", 18, OPC_NofPtrs(typ));
OPM_Write('"');
if (typ->strobj != NIL) {
- OPM_WriteStringVar((void*)typ->strobj->name, ((LONGINT)(256)));
+ OPM_WriteStringVar((void*)typ->strobj->name, 256);
}
OPM_Write('"');
- OPC_Str1((CHAR*)", #), {", (LONGINT)8, typ->size);
+ OPC_Str1((CHAR*)", #), {", 8, typ->size);
nofptrs = 0;
- OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs);
- OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (SYSTEM_INT64)OPM_LIntSize));
+ OPC_PutPtrOffsets(typ, 0, &nofptrs);
+ OPC_Str1((CHAR*)"#}}", 4, -((nofptrs + 1) * OPM_AddressSize));
OPC_EndStat();
}
void OPC_InitTDesc (OPT_Struct typ)
{
OPC_BegStat();
- OPM_WriteString((CHAR*)"__INITYP(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__INITYP(", 10);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
if (typ->BaseTyp != NIL) {
OPC_Andent(typ->BaseTyp);
} else {
OPC_Andent(typ);
}
- OPC_Str1((CHAR*)", #)", (LONGINT)5, typ->extlev);
+ OPC_Str1((CHAR*)", #)", 5, typ->extlev);
OPC_EndStat();
if (typ->strobj != NIL) {
OPC_InitTProcs(typ->strobj, typ->link);
}
}
-void OPC_Align (LONGINT *adr, LONGINT base)
+static void OPC_FillGap (INT32 gap, INT32 off, INT32 align, INT32 *n, INT32 *curAlign)
{
- switch (base) {
- case 2:
- *adr += __MASK(*adr, -2);
- break;
- case 4:
- *adr += __MASK(-*adr, -4);
- break;
- case 8:
- *adr += __MASK(-*adr, -8);
- break;
- case 16:
- *adr += __MASK(-*adr, -16);
- break;
- default:
- break;
- }
-}
-
-LONGINT OPC_SizeAlignment (LONGINT size)
-{
- LONGINT _o_result;
- LONGINT alignment;
- if (size < (SYSTEM_INT64)OPM_Alignment) {
- alignment = 1;
- while (alignment < size) {
- alignment = __ASHL(alignment, 1);
- }
- } else {
- alignment = OPM_Alignment;
- }
- _o_result = alignment;
- return _o_result;
-}
-
-LONGINT OPC_BaseAlignment (OPT_Struct typ)
-{
- LONGINT _o_result;
- LONGINT alignment;
- if (typ->form == 15) {
- if (typ->comp == 4) {
- alignment = __MASK(typ->align, -65536);
- } else {
- alignment = OPC_BaseAlignment(typ->BaseTyp);
- }
- } else {
- alignment = OPC_SizeAlignment(typ->size);
- }
- _o_result = alignment;
- return _o_result;
-}
-
-static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LONGINT *curAlign)
-{
- LONGINT adr;
+ INT32 adr;
adr = off;
- OPC_Align(&adr, align);
+ OPT_Align(&adr, align);
if ((*curAlign < align && gap - (adr - off) >= align)) {
gap -= (adr - off) + align;
OPC_BegStat();
- if (align == (SYSTEM_INT64)OPM_IntSize) {
- OPM_WriteString((CHAR*)"INTEGER", (LONGINT)8);
- } else if (align == (SYSTEM_INT64)OPM_LIntSize) {
- OPM_WriteString((CHAR*)"LONGINT", (LONGINT)8);
- } else if (align == (SYSTEM_INT64)OPM_LRealSize) {
- OPM_WriteString((CHAR*)"LONGREAL", (LONGINT)9);
+ switch (align) {
+ case 2:
+ OPM_WriteString((CHAR*)"INT16", 6);
+ break;
+ case 4:
+ OPM_WriteString((CHAR*)"INT32", 6);
+ break;
+ case 8:
+ OPM_WriteString((CHAR*)"INT64", 6);
+ break;
+ default:
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Unexpected enclosing alignment in FillGap.", 43);
+ break;
}
- OPC_Str1((CHAR*)" _prvt#", (LONGINT)8, *n);
+ OPC_Str1((CHAR*)" _prvt#", 8, *n);
*n += 1;
OPC_EndStat();
*curAlign = align;
}
if (gap > 0) {
OPC_BegStat();
- OPC_Str1((CHAR*)"char _prvt#", (LONGINT)12, *n);
+ OPC_Str1((CHAR*)"char _prvt#", 12, *n);
*n += 1;
- OPC_Str1((CHAR*)"[#]", (LONGINT)4, gap);
+ OPC_Str1((CHAR*)"[#]", 4, gap);
OPC_EndStat();
}
}
-static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *n, LONGINT *curAlign)
+static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, INT32 *off, INT32 *n, INT32 *curAlign)
{
OPT_Object fld = NIL;
OPT_Struct base = NIL;
- LONGINT gap, adr, align, fldAlign;
+ INT32 gap, adr, align, fldAlign;
fld = typ->link;
align = __MASK(typ->align, -65536);
if (typ->BaseTyp != NIL) {
@@ -953,8 +888,8 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
}
} else {
adr = *off;
- fldAlign = OPC_BaseAlignment(fld->typ);
- OPC_Align(&adr, fldAlign);
+ fldAlign = OPT_BaseAlignment(fld->typ);
+ OPT_Align(&adr, fldAlign);
gap = fld->adr - adr;
if (fldAlign > *curAlign) {
*curAlign = fldAlign;
@@ -970,7 +905,7 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
base = fld->typ;
fld = fld->link;
while ((((((((fld != NIL && fld->mode == 4)) && fld->typ == base)) && fld->adr == *off)) && ((OPM_currFile == 1 || fld->vis != 0) || fld->typ->strobj == NIL))) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_DeclareObj(fld, 0);
*off = fld->adr + fld->typ->size;
fld = fld->link;
@@ -979,7 +914,7 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
}
}
if (last) {
- adr = typ->size - (SYSTEM_INT64)__ASHR(typ->sysflag, 8);
+ adr = typ->size - __ASHR(typ->sysflag, 8);
if (adr == 0) {
gap = 1;
} else {
@@ -991,16 +926,16 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
}
}
-static void OPC_IdentList (OPT_Object obj, INTEGER vis)
+static void OPC_IdentList (OPT_Object obj, INT16 vis)
{
OPT_Struct base = NIL;
BOOLEAN first;
- INTEGER lastvis;
+ INT16 lastvis;
base = NIL;
first = 1;
while ((obj != NIL && obj->mode != 13)) {
- if ((__IN(vis, 0x05) || (vis == 1 && obj->vis != 0)) || (vis == 3 && !obj->leaf)) {
- if (obj->typ != base || (int)obj->vis != lastvis) {
+ if ((__IN(vis, 0x05, 32) || (vis == 1 && obj->vis != 0)) || (vis == 3 && !obj->leaf)) {
+ if (obj->typ != base || (INT16)obj->vis != lastvis) {
if (!first) {
OPC_EndStat();
}
@@ -1009,16 +944,16 @@ static void OPC_IdentList (OPT_Object obj, INTEGER vis)
lastvis = obj->vis;
OPC_BegStat();
if ((vis == 1 && obj->vis != 0)) {
- OPM_WriteString((CHAR*)"import ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"import ", 8);
} else if ((obj->mnolev == 0 && vis == 0)) {
if (obj->vis == 0) {
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"static ", 8);
} else {
- OPM_WriteString((CHAR*)"export ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"export ", 8);
}
}
- if ((((vis == 2 && obj->mode == 1)) && base->form == 7)) {
- OPM_WriteString((CHAR*)"double", (LONGINT)7);
+ if ((((vis == 2 && obj->mode == 1)) && base->form == 5)) {
+ OPM_WriteString((CHAR*)"double", 7);
} else {
OPC_DeclareBase(obj);
}
@@ -1026,7 +961,7 @@ static void OPC_IdentList (OPT_Object obj, INTEGER vis)
OPM_Write(',');
}
OPM_Write(' ');
- if ((((vis == 2 && obj->mode == 1)) && base->form == 7)) {
+ if ((((vis == 2 && obj->mode == 1)) && base->form == 5)) {
OPM_Write('_');
}
OPC_DeclareObj(obj, vis == 3);
@@ -1034,17 +969,17 @@ static void OPC_IdentList (OPT_Object obj, INTEGER vis)
OPC_EndStat();
OPC_BegStat();
base = OPT_linttyp;
- OPM_WriteString((CHAR*)"LONGINT ", (LONGINT)9);
+ OPM_WriteString((CHAR*)"LONGINT ", 9);
OPC_LenList(obj, 0, 1);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPC_EndStat();
OPC_BegStat();
- OPM_WriteString((CHAR*)"LONGINT *", (LONGINT)10);
+ OPM_WriteString((CHAR*)"ADDRESS *", 10);
OPC_Ident(obj);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
base = NIL;
- } else if ((((((OPC_ptrinit && vis == 0)) && obj->mnolev > 0)) && obj->typ->form == 13)) {
- OPM_WriteString((CHAR*)" = NIL", (LONGINT)7);
+ } else if ((((((__IN(5, OPM_Options, 32) && vis == 0)) && obj->mnolev > 0)) && obj->typ->form == 11)) {
+ OPM_WriteString((CHAR*)" = NIL", 7);
}
}
obj = obj->link;
@@ -1059,7 +994,7 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
CHAR name[32];
OPM_Write('(');
if (obj == NIL || obj->mode == 13) {
- OPM_WriteString((CHAR*)"void", (LONGINT)5);
+ OPM_WriteString((CHAR*)"void", 5);
} else {
for (;;) {
OPC_DeclareBase(obj);
@@ -1067,25 +1002,25 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
OPM_Write(' ');
OPC_DeclareObj(obj, 0);
} else {
- __COPY(obj->name, name, ((LONGINT)(32)));
+ __COPY(obj->name, name, 32);
obj->name[0] = 0x00;
OPC_DeclareObj(obj, 0);
- __COPY(name, obj->name, ((LONGINT)(256)));
+ __COPY(name, obj->name, 256);
}
if (obj->typ->comp == 3) {
- OPM_WriteString((CHAR*)", LONGINT ", (LONGINT)11);
+ OPM_WriteString((CHAR*)", LONGINT ", 11);
OPC_LenList(obj, 1, showParamNames);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
- OPM_WriteString((CHAR*)", LONGINT *", (LONGINT)12);
+ OPM_WriteString((CHAR*)", ADDRESS *", 12);
if (showParamNames) {
OPC_Ident(obj);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
}
}
if (obj->link == NIL || obj->link->mode == 13) {
break;
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
obj = obj->link;
}
}
@@ -1095,42 +1030,31 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define)
{
if (proc->typ == OPT_notyp) {
- OPM_WriteString((CHAR*)"void", (LONGINT)5);
+ OPM_WriteString((CHAR*)"void", 5);
} else {
OPC_Ident(proc->typ->strobj);
}
OPM_Write(' ');
OPC_Ident(proc);
OPM_Write(' ');
- if (OPC_ansi) {
- OPC_AnsiParamList(proc->link, 1);
- if (!define) {
- OPM_Write(';');
- }
- OPM_WriteLn();
- } else if (define) {
- OPC_DeclareParams(proc->link, 0);
- OPM_WriteLn();
- OPC_Indent(1);
- OPC_IdentList(proc->link, 2);
- OPC_Indent(-1);
- } else {
- OPM_WriteString((CHAR*)"();", (LONGINT)4);
- OPM_WriteLn();
+ OPC_AnsiParamList(proc->link, 1);
+ if (!define) {
+ OPM_Write(';');
}
+ OPM_WriteLn();
}
-static void OPC_ProcPredefs (OPT_Object obj, SHORTINT vis)
+static void OPC_ProcPredefs (OPT_Object obj, INT8 vis)
{
if (obj != NIL) {
OPC_ProcPredefs(obj->left, vis);
- if ((((__IN(obj->mode, 0xc0) && obj->vis >= vis)) && (obj->history != 4 || obj->mode == 6))) {
+ if ((((__IN(obj->mode, 0xc0, 32) && obj->vis >= vis)) && (obj->history != 4 || obj->mode == 6))) {
if (vis == 1) {
- OPM_WriteString((CHAR*)"import ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"import ", 8);
} else if (obj->vis == 0) {
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"static ", 8);
} else {
- OPM_WriteString((CHAR*)"export ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"export ", 8);
}
OPC_ProcHeader(obj, 0);
}
@@ -1141,27 +1065,27 @@ static void OPC_ProcPredefs (OPT_Object obj, SHORTINT vis)
static void OPC_Include (CHAR *name, LONGINT name__len)
{
__DUP(name, name__len, CHAR);
- OPM_WriteString((CHAR*)"#include ", (LONGINT)10);
+ OPM_WriteString((CHAR*)"#include ", 10);
OPM_Write('"');
OPM_WriteStringVar((void*)name, name__len);
- OPM_WriteString((CHAR*)".h", (LONGINT)3);
+ OPM_WriteString((CHAR*)".h", 3);
OPM_Write('"');
OPM_WriteLn();
__DEL(name);
}
-static void OPC_IncludeImports (OPT_Object obj, INTEGER vis)
+static void OPC_IncludeImports (OPT_Object obj, INT16 vis)
{
if (obj != NIL) {
OPC_IncludeImports(obj->left, vis);
- if ((((obj->mode == 11 && obj->mnolev != 0)) && (int)OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->vis >= vis)) {
- OPC_Include(OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, ((LONGINT)(256)));
+ if ((((obj->mode == 11 && obj->mnolev != 0)) && (INT16)OPT_GlbMod[__X(-obj->mnolev, 64)]->vis >= vis)) {
+ OPC_Include(OPT_GlbMod[__X(-obj->mnolev, 64)]->name, 256);
}
OPC_IncludeImports(obj->right, vis);
}
}
-static void OPC_GenDynTypes (OPT_Node n, INTEGER vis)
+static void OPC_GenDynTypes (OPT_Node n, INT16 vis)
{
OPT_Struct typ = NIL;
while ((n != NIL && n->class == 14)) {
@@ -1169,15 +1093,15 @@ static void OPC_GenDynTypes (OPT_Node n, INTEGER vis)
if (vis == 0 || typ->ref < 255) {
OPC_BegStat();
if (vis == 1) {
- OPM_WriteString((CHAR*)"import ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"import ", 8);
} else if ((typ->strobj != NIL && typ->strobj->mnolev > 0)) {
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"static ", 8);
} else {
- OPM_WriteString((CHAR*)"export ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"export ", 8);
}
- OPM_WriteString((CHAR*)"LONGINT *", (LONGINT)10);
+ OPM_WriteString((CHAR*)"ADDRESS *", 10);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
OPC_EndStat();
}
n = n->link;
@@ -1195,29 +1119,30 @@ void OPC_GenHdr (OPT_Node n)
OPC_GenDynTypes(n, 1);
OPM_WriteLn();
OPC_ProcPredefs(OPT_topScope->right, 1);
- OPM_WriteString((CHAR*)"import ", (LONGINT)8);
- OPM_WriteString((CHAR*)"void *", (LONGINT)7);
- OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32)));
- OPM_WriteString(OPC_BodyNameExt, ((LONGINT)(13)));
+ OPM_WriteString((CHAR*)"import ", 8);
+ OPM_WriteString((CHAR*)"void *", 7);
+ OPM_WriteStringVar((void*)OPM_modName, 32);
+ OPM_WriteString(OPC_BodyNameExt, 13);
OPC_EndStat();
OPM_WriteLn();
OPC_CProcDefs(OPT_topScope->right, 1);
OPM_WriteLn();
- OPM_WriteString((CHAR*)"#endif", (LONGINT)7);
+ OPM_WriteString((CHAR*)"#endif // ", 11);
+ OPM_WriteStringVar((void*)OPM_modName, 32);
OPM_WriteLn();
}
static void OPC_GenHeaderMsg (void)
{
- INTEGER i;
- OPM_WriteString((CHAR*)"/* ", (LONGINT)4);
- OPM_WriteString((CHAR*)"voc", (LONGINT)4);
+ INT16 i;
+ OPM_WriteString((CHAR*)"/* ", 4);
+ OPM_WriteString((CHAR*)"voc", 4);
OPM_Write(' ');
- OPM_WriteString(Configuration_versionLong, ((LONGINT)(41)));
+ OPM_WriteString(Configuration_versionLong, 75);
OPM_Write(' ');
i = 0;
- while (i <= 63) {
- if (__IN(i, OPM_glbopt)) {
+ while (i <= 31) {
+ if (__IN(i, OPM_Options, 32)) {
switch (i) {
case 0:
OPM_Write('x');
@@ -1234,9 +1159,6 @@ static void OPC_GenHeaderMsg (void)
case 5:
OPM_Write('p');
break;
- case 6:
- OPM_Write('k');
- break;
case 7:
OPM_Write('a');
break;
@@ -1265,14 +1187,14 @@ static void OPC_GenHeaderMsg (void)
OPM_Write('v');
break;
default:
- OPM_LogWStr((CHAR*)"( more options defined in OPM than checked in OPC.GenHeaderMsg, if you are a compiler developer, add them to OPC.GenHeaderMsg", (LONGINT)126);
+ OPM_LogWStr((CHAR*)"( more options defined in OPM than checked in OPC.GenHeaderMsg, if you are a compiler developer, add them to OPC.GenHeaderMsg", 126);
OPM_LogWLn();
break;
}
}
i += 1;
}
- OPM_WriteString((CHAR*)" */", (LONGINT)4);
+ OPM_WriteString((CHAR*)" */", 4);
OPM_WriteLn();
}
@@ -1281,20 +1203,16 @@ void OPC_GenHdrIncludes (void)
OPM_currFile = 2;
OPC_GenHeaderMsg();
OPM_WriteLn();
- OPM_WriteString((CHAR*)"#ifndef ", (LONGINT)9);
- OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32)));
- OPM_WriteString((CHAR*)"__h", (LONGINT)4);
+ OPM_WriteString((CHAR*)"#ifndef ", 9);
+ OPM_WriteStringVar((void*)OPM_modName, 32);
+ OPM_WriteString((CHAR*)"__h", 4);
OPM_WriteLn();
- OPM_WriteString((CHAR*)"#define ", (LONGINT)9);
- OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32)));
- OPM_WriteString((CHAR*)"__h", (LONGINT)4);
+ OPM_WriteString((CHAR*)"#define ", 9);
+ OPM_WriteStringVar((void*)OPM_modName, 32);
+ OPM_WriteString((CHAR*)"__h", 4);
OPM_WriteLn();
OPM_WriteLn();
- if (OPM_LIntSize == 8) {
- OPM_WriteString((CHAR*)"#define LARGE", (LONGINT)14);
- OPM_WriteLn();
- }
- OPC_Include((CHAR*)"SYSTEM", (LONGINT)7);
+ OPC_Include((CHAR*)"SYSTEM", 7);
OPC_IncludeImports(OPT_topScope->right, 1);
OPM_WriteLn();
}
@@ -1303,11 +1221,21 @@ void OPC_GenBdy (OPT_Node n)
{
OPM_currFile = 1;
OPC_GenHeaderMsg();
- if (OPM_LIntSize == 8) {
- OPM_WriteString((CHAR*)"#define LARGE", (LONGINT)14);
- OPM_WriteLn();
- }
- OPC_Include((CHAR*)"SYSTEM", (LONGINT)7);
+ OPM_WriteLn();
+ OPM_WriteString((CHAR*)"#define SHORTINT INT", 21);
+ OPM_WriteInt(__ASHL(OPT_sinttyp->size, 3));
+ OPM_WriteLn();
+ OPM_WriteString((CHAR*)"#define INTEGER INT", 21);
+ OPM_WriteInt(__ASHL(OPT_inttyp->size, 3));
+ OPM_WriteLn();
+ OPM_WriteString((CHAR*)"#define LONGINT INT", 21);
+ OPM_WriteInt(__ASHL(OPT_linttyp->size, 3));
+ OPM_WriteLn();
+ OPM_WriteString((CHAR*)"#define SET UINT", 22);
+ OPM_WriteInt(__ASHL(OPT_settyp->size, 3));
+ OPM_WriteLn();
+ OPM_WriteLn();
+ OPC_Include((CHAR*)"SYSTEM", 7);
OPC_IncludeImports(OPT_topScope->right, 0);
OPM_WriteLn();
OPC_DefAnonRecs(n);
@@ -1330,9 +1258,9 @@ static void OPC_RegCmds (OPT_Object obj)
if ((obj->mode == 7 && obj->history != 4)) {
if ((((obj->vis != 0 && obj->link == NIL)) && obj->typ == OPT_notyp)) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"__REGCMD(\"", (LONGINT)11);
- OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"\", ", (LONGINT)4);
+ OPM_WriteString((CHAR*)"__REGCMD(\"", 11);
+ OPM_WriteStringVar((void*)obj->name, 256);
+ OPM_WriteString((CHAR*)"\", ", 4);
OPC_Ident(obj);
OPM_Write(')');
OPC_EndStat();
@@ -1348,8 +1276,8 @@ static void OPC_InitImports (OPT_Object obj)
OPC_InitImports(obj->left);
if ((obj->mode == 11 && obj->mnolev != 0)) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"__MODULE_IMPORT(", (LONGINT)17);
- OPM_WriteStringVar((void*)OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, ((LONGINT)(256)));
+ OPM_WriteString((CHAR*)"__MODULE_IMPORT(", 17);
+ OPM_WriteStringVar((void*)OPT_GlbMod[__X(-obj->mnolev, 64)]->name, 256);
OPM_Write(')');
OPC_EndStat();
}
@@ -1360,38 +1288,30 @@ static void OPC_InitImports (OPT_Object obj)
void OPC_GenEnumPtrs (OPT_Object var)
{
OPT_Struct typ = NIL;
- LONGINT n;
+ INT32 n;
OPC_GlbPtrs = 0;
while (var != NIL) {
typ = var->typ;
if (OPC_NofPtrs(typ) > 0) {
if (!OPC_GlbPtrs) {
OPC_GlbPtrs = 1;
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
- if (OPC_ansi) {
- OPM_WriteString((CHAR*)"void EnumPtrs(void (*P)(void*))", (LONGINT)32);
- } else {
- OPM_WriteString((CHAR*)"void EnumPtrs(P)", (LONGINT)17);
- OPM_WriteLn();
- OPM_Write(0x09);
- OPM_WriteString((CHAR*)"void (*P)();", (LONGINT)13);
- }
+ OPM_WriteString((CHAR*)"static void EnumPtrs(void (*P)(void*))", 39);
OPM_WriteLn();
OPC_BegBlk();
}
OPC_BegStat();
- if (typ->form == 13) {
- OPM_WriteString((CHAR*)"P(", (LONGINT)3);
+ if (typ->form == 11) {
+ OPM_WriteString((CHAR*)"P(", 3);
OPC_Ident(var);
OPM_Write(')');
} else if (typ->comp == 4) {
- OPM_WriteString((CHAR*)"__ENUMR(&", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__ENUMR(&", 10);
OPC_Ident(var);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
- OPC_Str1((CHAR*)", #", (LONGINT)4, typ->size);
- OPM_WriteString((CHAR*)", 1, P)", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__typ", 6);
+ OPC_Str1((CHAR*)", #", 4, typ->size);
+ OPM_WriteString((CHAR*)", 1, P)", 8);
} else if (typ->comp == 2) {
n = typ->n;
typ = typ->BaseTyp;
@@ -1399,18 +1319,18 @@ void OPC_GenEnumPtrs (OPT_Object var)
n = n * typ->n;
typ = typ->BaseTyp;
}
- if (typ->form == 13) {
- OPM_WriteString((CHAR*)"__ENUMP(", (LONGINT)9);
+ if (typ->form == 11) {
+ OPM_WriteString((CHAR*)"__ENUMP(", 9);
OPC_Ident(var);
- OPC_Str1((CHAR*)", #, P)", (LONGINT)8, n);
+ OPC_Str1((CHAR*)", #, P)", 8, n);
} else if (typ->comp == 4) {
- OPM_WriteString((CHAR*)"__ENUMR(", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__ENUMR(", 9);
OPC_Ident(var);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
- OPC_Str1((CHAR*)", #", (LONGINT)4, typ->size);
- OPC_Str1((CHAR*)", #, P)", (LONGINT)8, n);
+ OPM_WriteString((CHAR*)"__typ", 6);
+ OPC_Str1((CHAR*)", #", 4, typ->size);
+ OPC_Str1((CHAR*)", #, P)", 8, n);
}
}
OPC_EndStat();
@@ -1426,49 +1346,41 @@ void OPC_GenEnumPtrs (OPT_Object var)
void OPC_EnterBody (void)
{
OPM_WriteLn();
- OPM_WriteString((CHAR*)"export ", (LONGINT)8);
- if (OPC_mainprog) {
- if (OPC_ansi) {
- OPM_WriteString((CHAR*)"int main(int argc, char **argv)", (LONGINT)32);
- OPM_WriteLn();
- } else {
- OPM_WriteString((CHAR*)"main(argc, argv)", (LONGINT)17);
- OPM_WriteLn();
- OPM_Write(0x09);
- OPM_WriteString((CHAR*)"int argc; char **argv;", (LONGINT)23);
- OPM_WriteLn();
- }
+ OPM_WriteString((CHAR*)"export ", 8);
+ if (__IN(10, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"int main(int argc, char **argv)", 32);
+ OPM_WriteLn();
} else {
- OPM_WriteString((CHAR*)"void *", (LONGINT)7);
- OPM_WriteString(OPM_modName, ((LONGINT)(32)));
- OPM_WriteString(OPC_BodyNameExt, ((LONGINT)(13)));
+ OPM_WriteString((CHAR*)"void *", 7);
+ OPM_WriteString(OPM_modName, 32);
+ OPM_WriteString(OPC_BodyNameExt, 13);
OPM_WriteLn();
}
OPC_BegBlk();
OPC_BegStat();
- if (OPC_mainprog) {
- OPM_WriteString((CHAR*)"__INIT(argc, argv)", (LONGINT)19);
+ if (__IN(10, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__INIT(argc, argv)", 19);
} else {
- OPM_WriteString((CHAR*)"__DEFMOD", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__DEFMOD", 9);
}
OPC_EndStat();
- if ((OPC_mainprog && 0)) {
+ if ((__IN(10, OPM_Options, 32) && 0)) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"/*don`t do it!*/ printf(\"DEMO VERSION: DO NOT USE THIS PROGRAM FOR ANY COMMERCIAL PURPOSE\\n\")", (LONGINT)94);
+ OPM_WriteString((CHAR*)"/*don`t do it!*/ printf(\"DEMO VERSION: DO NOT USE THIS PROGRAM FOR ANY COMMERCIAL PURPOSE\\n\")", 94);
OPC_EndStat();
}
OPC_InitImports(OPT_topScope->right);
OPC_BegStat();
- if (OPC_mainprog) {
- OPM_WriteString((CHAR*)"__REGMAIN(\"", (LONGINT)12);
+ if (__IN(10, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__REGMAIN(\"", 12);
} else {
- OPM_WriteString((CHAR*)"__REGMOD(\"", (LONGINT)11);
+ OPM_WriteString((CHAR*)"__REGMOD(\"", 11);
}
- OPM_WriteString(OPM_modName, ((LONGINT)(32)));
+ OPM_WriteString(OPM_modName, 32);
if (OPC_GlbPtrs) {
- OPM_WriteString((CHAR*)"\", EnumPtrs)", (LONGINT)13);
+ OPM_WriteString((CHAR*)"\", EnumPtrs)", 13);
} else {
- OPM_WriteString((CHAR*)"\", 0)", (LONGINT)6);
+ OPM_WriteString((CHAR*)"\", 0)", 6);
}
OPC_EndStat();
if (__STRCMP(OPM_modName, "SYSTEM") != 0) {
@@ -1479,10 +1391,10 @@ void OPC_EnterBody (void)
void OPC_ExitBody (void)
{
OPC_BegStat();
- if (OPC_mainprog) {
- OPM_WriteString((CHAR*)"__FINI;", (LONGINT)8);
+ if (__IN(10, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__FINI;", 8);
} else {
- OPM_WriteString((CHAR*)"__ENDMOD;", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__ENDMOD;", 10);
}
OPM_WriteLn();
OPC_EndBlk();
@@ -1492,55 +1404,60 @@ void OPC_DefineInter (OPT_Object proc)
{
OPT_Object scope = NIL;
scope = proc->scope;
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
- OPM_WriteString((CHAR*)"struct ", (LONGINT)8);
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
+ OPM_WriteString((CHAR*)"static ", 8);
+ OPM_WriteString((CHAR*)"struct ", 8);
+ OPM_WriteStringVar((void*)scope->name, 256);
OPM_Write(' ');
OPC_BegBlk();
OPC_IdentList(proc->link, 3);
OPC_IdentList(scope->scope, 3);
OPC_BegStat();
- OPM_WriteString((CHAR*)"struct ", (LONGINT)8);
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
+ OPM_WriteString((CHAR*)"struct ", 8);
+ OPM_WriteStringVar((void*)scope->name, 256);
OPM_Write(' ');
OPM_Write('*');
- OPM_WriteString((CHAR*)"lnk", (LONGINT)4);
+ OPM_WriteString((CHAR*)"lnk", 4);
OPC_EndStat();
OPC_EndBlk0();
OPM_Write(' ');
OPM_Write('*');
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteStringVar((void*)scope->name, 256);
+ OPM_WriteString((CHAR*)"_s", 3);
OPC_EndStat();
OPM_WriteLn();
OPC_ProcPredefs(scope->right, 0);
OPM_WriteLn();
}
+BOOLEAN OPC_NeedsRetval (OPT_Object proc)
+{
+ return (proc->typ != OPT_notyp && !proc->scope->leaf);
+}
+
void OPC_EnterProc (OPT_Object proc)
{
OPT_Object var = NIL, scope = NIL;
OPT_Struct typ = NIL;
- INTEGER dim;
+ INT16 dim;
if (proc->vis != 1) {
- OPM_WriteString((CHAR*)"static ", (LONGINT)8);
+ OPM_WriteString((CHAR*)"static ", 8);
}
OPC_ProcHeader(proc, 1);
OPC_BegBlk();
- if (proc->typ != OPT_notyp) {
- OPC_BegStat();
- OPC_Ident(proc->typ->strobj);
- OPM_WriteString((CHAR*)" _o_result;", (LONGINT)12);
- OPM_WriteLn();
- }
scope = proc->scope;
OPC_IdentList(scope->scope, 0);
if (!scope->leaf) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"struct ", (LONGINT)8);
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
+ OPM_WriteString((CHAR*)"struct ", 8);
+ OPM_WriteStringVar((void*)scope->name, 256);
OPM_Write(' ');
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"_s", 3);
+ OPC_EndStat();
+ }
+ if (OPC_NeedsRetval(proc)) {
+ OPC_BegStat();
+ OPC_Ident(proc->typ->strobj);
+ OPM_WriteString((CHAR*)" __retval", 10);
OPC_EndStat();
}
var = proc->link;
@@ -1554,56 +1471,41 @@ void OPC_EnterProc (OPT_Object proc)
}
OPM_Write(' ');
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__copy", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__copy", 7);
OPC_EndStat();
}
var = var->link;
}
- if (!OPC_ansi) {
- var = proc->link;
- while (var != NIL) {
- if ((var->typ->form == 7 && var->mode == 1)) {
- OPC_BegStat();
- OPC_Ident(var->typ->strobj);
- OPM_Write(' ');
- OPC_Ident(var);
- OPM_WriteString((CHAR*)" = _", (LONGINT)5);
- OPC_Ident(var);
- OPC_EndStat();
- }
- var = var->link;
- }
- }
var = proc->link;
while (var != NIL) {
- if ((((__IN(var->typ->comp, 0x0c) && var->mode == 1)) && var->typ->sysflag == 0)) {
+ if ((((__IN(var->typ->comp, 0x0c, 32) && var->mode == 1)) && var->typ->sysflag == 0)) {
OPC_BegStat();
if (var->typ->comp == 2) {
- OPM_WriteString((CHAR*)"__DUPARR(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__DUPARR(", 10);
OPC_Ident(var);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
if (var->typ->strobj == NIL) {
OPM_Mark(200, var->typ->txtpos);
} else {
OPC_Ident(var->typ->strobj);
}
} else {
- OPM_WriteString((CHAR*)"__DUP(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__DUP(", 7);
OPC_Ident(var);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
typ = var->typ->BaseTyp;
dim = 1;
while (typ->comp == 3) {
- OPM_WriteString((CHAR*)" * ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" * ", 4);
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
OPM_WriteInt(dim);
typ = typ->BaseTyp;
dim += 1;
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
if (typ->strobj == NIL) {
OPM_Mark(200, typ->txtpos);
} else {
@@ -1620,12 +1522,12 @@ void OPC_EnterProc (OPT_Object proc)
while (var != NIL) {
if (!var->leaf) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
OPC_Ident(var);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
- if (__IN(var->typ->comp, 0x0c)) {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
+ OPM_WriteString((CHAR*)" = ", 4);
+ if (__IN(var->typ->comp, 0x0c, 32)) {
+ OPM_WriteString((CHAR*)"(void*)", 8);
} else if (var->mode != 2) {
OPM_Write('&');
}
@@ -1634,31 +1536,31 @@ void OPC_EnterProc (OPT_Object proc)
typ = var->typ;
dim = 0;
do {
- OPM_WriteString((CHAR*)"; ", (LONGINT)3);
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"; ", 3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
if (dim != 0) {
OPM_WriteInt(dim);
}
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" = ", 4);
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
if (dim != 0) {
OPM_WriteInt(dim);
}
typ = typ->BaseTyp;
} while (!(typ->comp != 3));
} else if ((var->mode == 2 && var->typ->comp == 4)) {
- OPM_WriteString((CHAR*)"; ", (LONGINT)3);
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"; ", 3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteString((CHAR*)"__typ", 6);
+ OPM_WriteString((CHAR*)" = ", 4);
OPC_Ident(var);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
}
OPC_EndStat();
}
@@ -1668,14 +1570,14 @@ void OPC_EnterProc (OPT_Object proc)
while (var != NIL) {
if (!var->leaf) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
OPC_Ident(var);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" = ", 4);
if (var->typ->comp != 2) {
OPM_Write('&');
} else {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
+ OPM_WriteString((CHAR*)"(void*)", 8);
}
OPC_Ident(var);
OPC_EndStat();
@@ -1683,19 +1585,19 @@ void OPC_EnterProc (OPT_Object proc)
var = var->link;
}
OPC_BegStat();
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
- OPM_WriteString((CHAR*)"lnk", (LONGINT)4);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"lnk", 4);
+ OPM_WriteString((CHAR*)" = ", 4);
+ OPM_WriteStringVar((void*)scope->name, 256);
+ OPM_WriteString((CHAR*)"_s", 3);
OPC_EndStat();
OPC_BegStat();
- OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteStringVar((void*)scope->name, 256);
+ OPM_WriteString((CHAR*)"_s", 3);
+ OPM_WriteString((CHAR*)" = ", 4);
OPM_Write('&');
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteString((CHAR*)"_s", 3);
OPC_EndStat();
}
}
@@ -1707,7 +1609,7 @@ void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet)
indent = eoBlock;
if ((implicitRet && proc->typ != OPT_notyp)) {
OPM_Write(0x09);
- OPM_WriteString((CHAR*)"__RETCHK;", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__RETCHK;", 10);
OPM_WriteLn();
} else if (!eoBlock || implicitRet) {
if (!proc->scope->leaf) {
@@ -1716,12 +1618,12 @@ void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet)
} else {
indent = 1;
}
- OPM_WriteStringVar((void*)proc->scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
+ OPM_WriteStringVar((void*)proc->scope->name, 256);
+ OPM_WriteString((CHAR*)"_s", 3);
+ OPM_WriteString((CHAR*)" = ", 4);
+ OPM_WriteString((CHAR*)"_s", 3);
OPM_Write('.');
- OPM_WriteString((CHAR*)"lnk", (LONGINT)4);
+ OPM_WriteString((CHAR*)"lnk", 4);
OPC_EndStat();
}
var = proc->link;
@@ -1732,7 +1634,7 @@ void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet)
} else {
indent = 1;
}
- OPM_WriteString((CHAR*)"__DEL(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__DEL(", 7);
OPC_Ident(var);
OPM_Write(')');
OPC_EndStat();
@@ -1750,14 +1652,14 @@ void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet)
void OPC_CompleteIdent (OPT_Object obj)
{
- INTEGER comp, level;
+ INT16 comp, level;
level = obj->mnolev;
if (obj->adr == 1) {
if (obj->typ->comp == 4) {
OPC_Ident(obj);
- OPM_WriteString((CHAR*)"__", (LONGINT)3);
+ OPM_WriteString((CHAR*)"__", 3);
} else {
- OPM_WriteString((CHAR*)"((", (LONGINT)3);
+ OPM_WriteString((CHAR*)"((", 3);
OPC_Ident(obj->typ->strobj);
OPM_Write(')');
OPC_Ident(obj);
@@ -1768,9 +1670,9 @@ void OPC_CompleteIdent (OPT_Object obj)
if ((obj->mode != 2 && comp != 3)) {
OPM_Write('*');
}
- OPM_WriteStringVar((void*)obj->scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s", (LONGINT)3);
- OPM_WriteString((CHAR*)"->", (LONGINT)3);
+ OPM_WriteStringVar((void*)obj->scope->name, 256);
+ OPM_WriteString((CHAR*)"_s", 3);
+ OPM_WriteString((CHAR*)"->", 3);
OPC_Ident(obj);
} else {
OPC_Ident(obj);
@@ -1779,58 +1681,58 @@ void OPC_CompleteIdent (OPT_Object obj)
void OPC_TypeOf (OPT_Object ap)
{
- INTEGER i;
+ INT16 i;
__ASSERT(ap->typ->comp == 4, 0);
if (ap->mode == 2) {
- if ((int)ap->mnolev != OPM_level) {
- OPM_WriteStringVar((void*)ap->scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"_s->", (LONGINT)5);
+ if ((INT16)ap->mnolev != OPM_level) {
+ OPM_WriteStringVar((void*)ap->scope->name, 256);
+ OPM_WriteString((CHAR*)"_s->", 5);
OPC_Ident(ap);
} else {
OPC_Ident(ap);
}
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
} else if (ap->typ->strobj != NIL) {
OPC_Ident(ap->typ->strobj);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
} else {
OPC_Andent(ap->typ);
}
}
-void OPC_Cmp (INTEGER rel)
+void OPC_Cmp (INT16 rel)
{
switch (rel) {
case 9:
- OPM_WriteString((CHAR*)" == ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" == ", 5);
break;
case 10:
- OPM_WriteString((CHAR*)" != ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" != ", 5);
break;
case 11:
- OPM_WriteString((CHAR*)" < ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" < ", 4);
break;
case 12:
- OPM_WriteString((CHAR*)" <= ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" <= ", 5);
break;
case 13:
- OPM_WriteString((CHAR*)" > ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" > ", 4);
break;
case 14:
- OPM_WriteString((CHAR*)" >= ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" >= ", 5);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPC.Cmp, rel = ", (LONGINT)34);
- OPM_LogWNum(rel, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPC.Cmp, rel = ", 34);
+ OPM_LogWNum(rel, 0);
OPM_LogWLn();
break;
}
}
-static void OPC_CharacterLiteral (LONGINT c)
+static void OPC_CharacterLiteral (INT64 c)
{
if (c < 32 || c > 126) {
- OPM_WriteString((CHAR*)"0x", (LONGINT)3);
+ OPM_WriteString((CHAR*)"0x", 3);
OPM_WriteHex(c);
} else {
OPM_Write('\'');
@@ -1842,15 +1744,15 @@ static void OPC_CharacterLiteral (LONGINT c)
}
}
-static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l)
+static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l)
{
- LONGINT i;
- INTEGER c;
+ INT32 i;
+ INT16 c;
__DUP(s, s__len, CHAR);
OPM_Write('"');
i = 0;
while (i < l) {
- c = (int)s[__X(i, s__len)];
+ c = (INT16)s[__X(i, s__len)];
if (c < 32 || c > 126) {
OPM_Write('\\');
OPM_Write((CHAR)(48 + __ASHR(c, 6)));
@@ -1870,54 +1772,67 @@ static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l)
__DEL(s);
}
-void OPC_Case (LONGINT caseVal, INTEGER form)
+void OPC_Case (INT64 caseVal, INT16 form)
{
CHAR ch;
- OPM_WriteString((CHAR*)"case ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"case ", 6);
switch (form) {
case 3:
OPC_CharacterLiteral(caseVal);
break;
- case 4: case 5: case 6:
+ case 4:
OPM_WriteInt(caseVal);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPC.Case, form = ", (LONGINT)36);
- OPM_LogWNum(form, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPC.Case, form = ", 36);
+ OPM_LogWNum(form, 0);
OPM_LogWLn();
break;
}
- OPM_WriteString((CHAR*)": ", (LONGINT)3);
+ OPM_WriteString((CHAR*)": ", 3);
}
void OPC_SetInclude (BOOLEAN exclude)
{
if (exclude) {
- OPM_WriteString((CHAR*)" &= ~", (LONGINT)6);
+ OPM_WriteString((CHAR*)" &= ~", 6);
} else {
- OPM_WriteString((CHAR*)" |= ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" |= ", 5);
}
}
void OPC_Increment (BOOLEAN decrement)
{
if (decrement) {
- OPM_WriteString((CHAR*)" -= ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" -= ", 5);
} else {
- OPM_WriteString((CHAR*)" += ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" += ", 5);
}
}
-void OPC_Halt (LONGINT n)
+void OPC_Halt (INT32 n)
{
- OPC_Str1((CHAR*)"__HALT(#)", (LONGINT)10, n);
+ OPC_Str1((CHAR*)"__HALT(#)", 10, n);
}
-void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim)
+void OPC_IntLiteral (INT64 n, INT32 size)
+{
+ if ((((size > 4 && n <= 2147483647)) && n > (-2147483647-1))) {
+ OPM_WriteString((CHAR*)"((INT", 6);
+ OPM_WriteInt(__ASHL(size, 3));
+ OPM_WriteString((CHAR*)")(", 3);
+ OPM_WriteInt(n);
+ OPM_WriteString((CHAR*)"))", 3);
+ } else {
+ OPM_WriteInt(n);
+ }
+}
+
+void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim)
{
if (array->comp == 3) {
OPC_CompleteIdent(obj);
- OPM_WriteString((CHAR*)"__len", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__len", 6);
if (dim != 0) {
OPM_WriteInt(dim);
}
@@ -1926,17 +1841,15 @@ void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim)
array = array->BaseTyp;
dim -= 1;
}
- OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12);
OPM_WriteInt(array->n);
- OPM_WriteString((CHAR*)"))", (LONGINT)3);
}
}
-void OPC_Constant (OPT_Const con, INTEGER form)
+void OPC_Constant (OPT_Const con, INT16 form)
{
- INTEGER i;
- SET s;
- LONGINT hex;
+ INT16 i;
+ UINT64 s;
+ INT64 hex;
BOOLEAN skipLeading;
switch (form) {
case 1:
@@ -1948,17 +1861,17 @@ void OPC_Constant (OPT_Const con, INTEGER form)
case 3:
OPC_CharacterLiteral(con->intval);
break;
- case 4: case 5: case 6:
+ case 4:
OPM_WriteInt(con->intval);
break;
- case 7:
+ case 5:
OPM_WriteReal(con->realval, 'f');
break;
- case 8:
+ case 6:
OPM_WriteReal(con->realval, 0x00);
break;
- case 9:
- OPM_WriteString((CHAR*)"0x", (LONGINT)3);
+ case 7:
+ OPM_WriteString((CHAR*)"0x", 3);
skipLeading = 1;
s = con->setval;
i = 64;
@@ -1967,7 +1880,7 @@ void OPC_Constant (OPT_Const con, INTEGER form)
do {
i -= 1;
hex = __ASHL(hex, 1);
- if (__IN(i, s)) {
+ if (__IN(i, s, 64)) {
hex += 1;
}
} while (!(__MASK(i, -8) == 0));
@@ -1980,88 +1893,98 @@ void OPC_Constant (OPT_Const con, INTEGER form)
OPM_Write('0');
}
break;
- case 10:
- OPC_StringLiteral(*con->ext, ((LONGINT)(256)), con->intval2 - 1);
+ case 8:
+ OPC_StringLiteral(*con->ext, 256, con->intval2 - 1);
break;
- case 11:
- OPM_WriteString((CHAR*)"NIL", (LONGINT)4);
+ case 9:
+ OPM_WriteString((CHAR*)"NIL", 4);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPC.Constant, form = ", (LONGINT)40);
- OPM_LogWNum(form, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPC.Constant, form = ", 40);
+ OPM_LogWNum(form, 0);
OPM_LogWLn();
break;
}
}
-static struct InitKeywords__48 {
- SHORTINT *n;
- struct InitKeywords__48 *lnk;
-} *InitKeywords__48_s;
+static struct InitKeywords__46 {
+ INT8 *n;
+ struct InitKeywords__46 *lnk;
+} *InitKeywords__46_s;
-static void Enter__49 (CHAR *s, LONGINT s__len);
+static void Enter__47 (CHAR *s, LONGINT s__len);
-static void Enter__49 (CHAR *s, LONGINT s__len)
+static void Enter__47 (CHAR *s, LONGINT s__len)
{
- INTEGER h;
+ INT16 h;
__DUP(s, s__len, CHAR);
h = OPC_PerfectHash((void*)s, s__len);
- OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__48_s->n;
- __COPY(s, OPC_keytab[__X(*InitKeywords__48_s->n, ((LONGINT)(36)))], ((LONGINT)(9)));
- *InitKeywords__48_s->n += 1;
+ OPC_hashtab[__X(h, 105)] = *InitKeywords__46_s->n;
+ __COPY(s, OPC_keytab[__X(*InitKeywords__46_s->n, 50)], 9);
+ *InitKeywords__46_s->n += 1;
__DEL(s);
}
static void OPC_InitKeywords (void)
{
- SHORTINT n, i;
- struct InitKeywords__48 _s;
+ INT8 n, i;
+ struct InitKeywords__46 _s;
_s.n = &n;
- _s.lnk = InitKeywords__48_s;
- InitKeywords__48_s = &_s;
+ _s.lnk = InitKeywords__46_s;
+ InitKeywords__46_s = &_s;
n = 0;
i = 0;
while (i <= 104) {
- OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1;
+ OPC_hashtab[__X(i, 105)] = -1;
i += 1;
}
- Enter__49((CHAR*)"asm", (LONGINT)4);
- Enter__49((CHAR*)"auto", (LONGINT)5);
- Enter__49((CHAR*)"break", (LONGINT)6);
- Enter__49((CHAR*)"case", (LONGINT)5);
- Enter__49((CHAR*)"char", (LONGINT)5);
- Enter__49((CHAR*)"const", (LONGINT)6);
- Enter__49((CHAR*)"continue", (LONGINT)9);
- Enter__49((CHAR*)"default", (LONGINT)8);
- Enter__49((CHAR*)"do", (LONGINT)3);
- Enter__49((CHAR*)"double", (LONGINT)7);
- Enter__49((CHAR*)"else", (LONGINT)5);
- Enter__49((CHAR*)"enum", (LONGINT)5);
- Enter__49((CHAR*)"extern", (LONGINT)7);
- Enter__49((CHAR*)"export", (LONGINT)7);
- Enter__49((CHAR*)"float", (LONGINT)6);
- Enter__49((CHAR*)"for", (LONGINT)4);
- Enter__49((CHAR*)"fortran", (LONGINT)8);
- Enter__49((CHAR*)"goto", (LONGINT)5);
- Enter__49((CHAR*)"if", (LONGINT)3);
- Enter__49((CHAR*)"import", (LONGINT)7);
- Enter__49((CHAR*)"int", (LONGINT)4);
- Enter__49((CHAR*)"long", (LONGINT)5);
- Enter__49((CHAR*)"register", (LONGINT)9);
- Enter__49((CHAR*)"return", (LONGINT)7);
- Enter__49((CHAR*)"short", (LONGINT)6);
- Enter__49((CHAR*)"signed", (LONGINT)7);
- Enter__49((CHAR*)"sizeof", (LONGINT)7);
- Enter__49((CHAR*)"static", (LONGINT)7);
- Enter__49((CHAR*)"struct", (LONGINT)7);
- Enter__49((CHAR*)"switch", (LONGINT)7);
- Enter__49((CHAR*)"typedef", (LONGINT)8);
- Enter__49((CHAR*)"union", (LONGINT)6);
- Enter__49((CHAR*)"unsigned", (LONGINT)9);
- Enter__49((CHAR*)"void", (LONGINT)5);
- Enter__49((CHAR*)"volatile", (LONGINT)9);
- Enter__49((CHAR*)"while", (LONGINT)6);
- InitKeywords__48_s = _s.lnk;
+ Enter__47((CHAR*)"ADDRESS", 8);
+ Enter__47((CHAR*)"INT16", 6);
+ Enter__47((CHAR*)"INT32", 6);
+ Enter__47((CHAR*)"INT64", 6);
+ Enter__47((CHAR*)"INT8", 5);
+ Enter__47((CHAR*)"UINT16", 7);
+ Enter__47((CHAR*)"UINT32", 7);
+ Enter__47((CHAR*)"UINT64", 7);
+ Enter__47((CHAR*)"UINT8", 6);
+ Enter__47((CHAR*)"asm", 4);
+ Enter__47((CHAR*)"auto", 5);
+ Enter__47((CHAR*)"break", 6);
+ Enter__47((CHAR*)"case", 5);
+ Enter__47((CHAR*)"char", 5);
+ Enter__47((CHAR*)"const", 6);
+ Enter__47((CHAR*)"continue", 9);
+ Enter__47((CHAR*)"default", 8);
+ Enter__47((CHAR*)"do", 3);
+ Enter__47((CHAR*)"double", 7);
+ Enter__47((CHAR*)"else", 5);
+ Enter__47((CHAR*)"enum", 5);
+ Enter__47((CHAR*)"extern", 7);
+ Enter__47((CHAR*)"export", 7);
+ Enter__47((CHAR*)"float", 6);
+ Enter__47((CHAR*)"for", 4);
+ Enter__47((CHAR*)"fortran", 8);
+ Enter__47((CHAR*)"goto", 5);
+ Enter__47((CHAR*)"if", 3);
+ Enter__47((CHAR*)"import", 7);
+ Enter__47((CHAR*)"int", 4);
+ Enter__47((CHAR*)"long", 5);
+ Enter__47((CHAR*)"register", 9);
+ Enter__47((CHAR*)"return", 7);
+ Enter__47((CHAR*)"short", 6);
+ Enter__47((CHAR*)"signed", 7);
+ Enter__47((CHAR*)"sizeof", 7);
+ Enter__47((CHAR*)"size_t", 7);
+ Enter__47((CHAR*)"static", 7);
+ Enter__47((CHAR*)"struct", 7);
+ Enter__47((CHAR*)"switch", 7);
+ Enter__47((CHAR*)"typedef", 8);
+ Enter__47((CHAR*)"union", 6);
+ Enter__47((CHAR*)"unsigned", 9);
+ Enter__47((CHAR*)"void", 5);
+ Enter__47((CHAR*)"volatile", 9);
+ Enter__47((CHAR*)"while", 6);
+ InitKeywords__46_s = _s.lnk;
}
diff --git a/bootstrap/windows-88/OPC.h b/bootstrap/windows-88/OPC.h
index 37a86252..842e7dec 100644
--- a/bootstrap/windows-88/OPC.h
+++ b/bootstrap/windows-88/OPC.h
@@ -1,25 +1,22 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPC__h
#define OPC__h
-#define LARGE
#include "SYSTEM.h"
#include "OPT.h"
-import void OPC_Align (LONGINT *adr, LONGINT base);
import void OPC_Andent (OPT_Struct typ);
-import LONGINT OPC_BaseAlignment (OPT_Struct typ);
import OPT_Object OPC_BaseTProc (OPT_Object obj);
import void OPC_BegBlk (void);
import void OPC_BegStat (void);
-import void OPC_Case (LONGINT caseVal, INTEGER form);
-import void OPC_Cmp (INTEGER rel);
+import void OPC_Case (INT64 caseVal, INT16 form);
+import void OPC_Cmp (INT16 rel);
import void OPC_CompleteIdent (OPT_Object obj);
-import void OPC_Constant (OPT_Const con, INTEGER form);
+import void OPC_Constant (OPT_Const con, INT16 form);
import void OPC_DefineInter (OPT_Object proc);
import void OPC_EndBlk (void);
import void OPC_EndBlk0 (void);
@@ -32,20 +29,21 @@ import void OPC_GenBdy (OPT_Node n);
import void OPC_GenEnumPtrs (OPT_Object var);
import void OPC_GenHdr (OPT_Node n);
import void OPC_GenHdrIncludes (void);
-import void OPC_Halt (LONGINT n);
+import void OPC_Halt (INT32 n);
import void OPC_Ident (OPT_Object obj);
import void OPC_Increment (BOOLEAN decrement);
-import void OPC_Indent (INTEGER count);
+import void OPC_Indent (INT16 count);
import void OPC_Init (void);
import void OPC_InitTDesc (OPT_Struct typ);
-import void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim);
-import LONGINT OPC_NofPtrs (OPT_Struct typ);
+import void OPC_IntLiteral (INT64 n, INT32 size);
+import void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim);
+import BOOLEAN OPC_NeedsRetval (OPT_Object proc);
+import INT32 OPC_NofPtrs (OPT_Struct typ);
import void OPC_SetInclude (BOOLEAN exclude);
-import LONGINT OPC_SizeAlignment (LONGINT size);
import void OPC_TDescDecl (OPT_Struct typ);
-import void OPC_TypeDefs (OPT_Object obj, INTEGER vis);
+import void OPC_TypeDefs (OPT_Object obj, INT16 vis);
import void OPC_TypeOf (OPT_Object ap);
import void *OPC__init(void);
-#endif
+#endif // OPC
diff --git a/bootstrap/windows-88/OPM.c b/bootstrap/windows-88/OPM.c
index 50047c9e..60ab38c7 100644
--- a/bootstrap/windows-88/OPM.c
+++ b/bootstrap/windows-88/OPM.c
@@ -1,306 +1,474 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "Configuration.h"
-#include "Console.h"
#include "Files.h"
+#include "Out.h"
#include "Platform.h"
#include "Strings.h"
#include "Texts.h"
-#include "errors.h"
-#include "vt100.h"
+#include "VT100.h"
typedef
CHAR OPM_FileName[32];
static CHAR OPM_SourceFileName[256];
-export INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_MaxSet;
-export LONGINT OPM_MaxIndex;
+static CHAR OPM_GlobalModel[10];
+export CHAR OPM_Model[10];
+static INT16 OPM_GlobalAddressSize;
+export INT16 OPM_AddressSize;
+static INT16 OPM_GlobalAlignment;
+export INT16 OPM_Alignment;
+export UINT32 OPM_GlobalOptions, OPM_Options;
+export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize;
+export INT64 OPM_MaxIndex;
export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
export BOOLEAN OPM_noerr;
-export LONGINT OPM_curpos, OPM_errpos, OPM_breakpc;
-export INTEGER OPM_currFile, OPM_level, OPM_pc, OPM_entno;
+export INT32 OPM_curpos, OPM_errpos, OPM_breakpc;
+export INT16 OPM_currFile, OPM_level, OPM_pc, OPM_entno;
export CHAR OPM_modName[32];
export CHAR OPM_objname[64];
-export SET OPM_opt, OPM_glbopt;
-static LONGINT OPM_ErrorLineStartPos, OPM_ErrorLineLimitPos, OPM_ErrorLineNumber, OPM_lasterrpos;
+static INT32 OPM_ErrorLineStartPos, OPM_ErrorLineLimitPos, OPM_ErrorLineNumber, OPM_lasterrpos;
static Texts_Reader OPM_inR;
-static Texts_Text OPM_Log;
-static Texts_Writer OPM_W;
+static Texts_Text OPM_Log, OPM_Errors;
static Files_Rider OPM_oldSF, OPM_newSF;
static Files_Rider OPM_R[3];
static Files_File OPM_oldSFile, OPM_newSFile, OPM_HFile, OPM_BFile, OPM_HIFile;
-static INTEGER OPM_S;
-export BOOLEAN OPM_dontAsm, OPM_dontLink, OPM_mainProg, OPM_mainLinkStat, OPM_notColorOutput, OPM_forceNewSym, OPM_Verbose;
-static CHAR OPM_OBERON[1024];
-static CHAR OPM_MODULES[1024];
+static INT16 OPM_S;
+export CHAR OPM_ResourceDir[1024];
-static void OPM_Append (Files_Rider *R, LONGINT *R__typ, Files_File F);
+static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F);
export void OPM_CloseFiles (void);
export void OPM_CloseOldSym (void);
export void OPM_DeleteNewSym (void);
-export void OPM_FPrint (LONGINT *fp, LONGINT val);
-export void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr);
-export void OPM_FPrintReal (LONGINT *fp, REAL real);
-export void OPM_FPrintSet (LONGINT *fp, SET set);
-static void OPM_FindLine (Files_File f, Files_Rider *r, LONGINT *r__typ, LONGINT pos);
+export void OPM_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_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos);
+static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len);
export void OPM_Get (CHAR *ch);
-static void OPM_GetProperties (void);
-static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align);
export void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
export void OPM_InitOptions (void);
-static void OPM_LogErrMsg (INTEGER n);
+export INT16 OPM_Integer (INT64 n);
+static void OPM_LogErrMsg (INT16 n);
+export void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
export void OPM_LogW (CHAR ch);
export void OPM_LogWLn (void);
-export void OPM_LogWNum (LONGINT i, LONGINT len);
+export void OPM_LogWNum (INT64 i, INT64 len);
export void OPM_LogWStr (CHAR *s, LONGINT s__len);
+export INT32 OPM_Longint (INT64 n);
static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len);
-export void OPM_Mark (INTEGER n, LONGINT pos);
+export void OPM_Mark (INT16 n, INT32 pos);
export void OPM_NewSym (CHAR *modName, LONGINT modName__len);
export void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
export void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
export BOOLEAN OPM_OpenPar (void);
export void OPM_RegisterNewSym (void);
-static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt);
-static void OPM_ShowLine (LONGINT pos);
-export LONGINT OPM_SignedMaximum (LONGINT bytecount);
-export LONGINT OPM_SignedMinimum (LONGINT bytecount);
+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_SymRCh (CHAR *ch);
-export LONGINT OPM_SymRInt (void);
+export INT32 OPM_SymRInt (void);
+export INT64 OPM_SymRInt64 (void);
export void OPM_SymRLReal (LONGREAL *lr);
export void OPM_SymRReal (REAL *r);
-export void OPM_SymRSet (SET *s);
+export void OPM_SymRSet (UINT64 *s);
export void OPM_SymWCh (CHAR ch);
-export void OPM_SymWInt (LONGINT i);
+export void OPM_SymWInt (INT64 i);
export void OPM_SymWLReal (LONGREAL lr);
export void OPM_SymWReal (REAL r);
-export void OPM_SymWSet (SET s);
+export void OPM_SymWSet (UINT64 s);
static void OPM_VerboseListSizes (void);
export void OPM_Write (CHAR ch);
-export void OPM_WriteHex (LONGINT i);
-export void OPM_WriteInt (LONGINT i);
+export void OPM_WriteHex (INT64 i);
+export void OPM_WriteInt (INT64 i);
export void OPM_WriteLn (void);
export void OPM_WriteReal (LONGREAL r, CHAR suffx);
export void OPM_WriteString (CHAR *s, LONGINT s__len);
export void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
export BOOLEAN OPM_eofSF (void);
-export void OPM_err (INTEGER n);
-static LONGINT OPM_minusop (LONGINT i);
-static LONGINT OPM_power0 (LONGINT i, LONGINT j);
+export void OPM_err (INT16 n);
+#define OPM_GetAlignment(a) struct {char c; long long l;} _s; *a = (char*)&_s.l - (char*)&_s
void OPM_LogW (CHAR ch)
{
- Console_Char(ch);
+ Out_Char(ch);
}
void OPM_LogWStr (CHAR *s, LONGINT s__len)
{
__DUP(s, s__len, CHAR);
- Console_String(s, s__len);
+ Out_String(s, s__len);
__DEL(s);
}
-void OPM_LogWNum (LONGINT i, LONGINT len)
+void OPM_LogWNum (INT64 i, INT64 len)
{
- Console_Int(i, len);
+ Out_Int(i, len);
}
void OPM_LogWLn (void)
{
- Console_Ln();
+ Out_Ln();
}
-static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt)
+void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len)
{
- INTEGER i;
+ __DUP(vt100code, vt100code__len, CHAR);
+ if ((Out_IsConsole && !__IN(16, OPM_Options, 32))) {
+ VT100_SetAttr(vt100code, vt100code__len);
+ }
+ __DEL(vt100code);
+}
+
+INT64 OPM_SignedMaximum (INT32 bytecount)
+{
+ INT64 result;
+ result = 1;
+ result = __LSH(result, __ASHL(bytecount, 3) - 1, 64);
+ return result - 1;
+}
+
+INT64 OPM_SignedMinimum (INT32 bytecount)
+{
+ return -OPM_SignedMaximum(bytecount) - 1;
+}
+
+INT32 OPM_Longint (INT64 n)
+{
+ return __VAL(INT32, n);
+}
+
+INT16 OPM_Integer (INT64 n)
+{
+ return __VAL(INT16, n);
+}
+
+static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
+{
+ INT16 i;
+ __DUP(s, s__len, CHAR);
i = 1;
while (s[__X(i, s__len)] != 0x00) {
switch (s[__X(i, s__len)]) {
- case 'a':
- *opt = *opt ^ 0x80;
- break;
- case 'c':
- *opt = *opt ^ 0x4000;
- break;
- case 'e':
- *opt = *opt ^ 0x0200;
- break;
- case 'f':
- *opt = *opt ^ 0x010000;
- break;
- case 'k':
- *opt = *opt ^ 0x40;
- break;
- case 'm':
- *opt = *opt ^ 0x0400;
- break;
case 'p':
- *opt = *opt ^ 0x20;
+ OPM_Options = OPM_Options ^ 0x20;
+ break;
+ case 'a':
+ OPM_Options = OPM_Options ^ 0x80;
break;
case 'r':
- *opt = *opt ^ 0x04;
- break;
- case 's':
- *opt = *opt ^ 0x10;
+ OPM_Options = OPM_Options ^ 0x04;
break;
case 't':
- *opt = *opt ^ 0x08;
+ OPM_Options = OPM_Options ^ 0x08;
break;
case 'x':
- *opt = *opt ^ 0x01;
+ OPM_Options = OPM_Options ^ 0x01;
+ break;
+ case 'e':
+ OPM_Options = OPM_Options ^ 0x0200;
+ break;
+ case 's':
+ OPM_Options = OPM_Options ^ 0x10;
+ break;
+ case 'F':
+ OPM_Options = OPM_Options ^ 0x020000;
+ break;
+ case 'm':
+ OPM_Options = OPM_Options ^ 0x0400;
+ break;
+ case 'M':
+ OPM_Options = OPM_Options ^ 0x8000;
+ break;
+ case 'S':
+ OPM_Options = OPM_Options ^ 0x2000;
+ break;
+ case 'c':
+ OPM_Options = OPM_Options ^ 0x4000;
+ break;
+ case 'f':
+ OPM_Options = OPM_Options ^ 0x010000;
+ break;
+ case 'V':
+ OPM_Options = OPM_Options ^ 0x040000;
+ break;
+ case 'O':
+ if (i + 1 >= Strings_Length(s, s__len)) {
+ OPM_LogWStr((CHAR*)"-O option requires following size model character.", 51);
+ OPM_LogWLn();
+ } else {
+ OPM_Model[0] = s[__X(i + 1, s__len)];
+ OPM_Model[1] = 0x00;
+ if ((((OPM_Model[0] != '2' && OPM_Model[0] != 'C')) && OPM_Model[0] != 'V')) {
+ OPM_LogWStr((CHAR*)"Unrecognised size model character following -O.", 48);
+ OPM_LogWLn();
+ }
+ i += 1;
+ }
+ break;
+ case 'A':
+ if (i + 2 >= Strings_Length(s, s__len)) {
+ OPM_LogWStr((CHAR*)"-M option requires two following digits.", 41);
+ OPM_LogWLn();
+ } else {
+ OPM_AddressSize = (INT16)s[__X(i + 1, s__len)] - 48;
+ OPM_Alignment = (INT16)s[__X(i + 2, s__len)] - 48;
+ i += 2;
+ }
break;
case 'B':
if (s[__X(i + 1, s__len)] != 0x00) {
i += 1;
- OPM_IntSize = (int)s[__X(i, s__len)] - 48;
+ OPM_IntegerSize = (INT16)s[__X(i, s__len)] - 48;
}
if (s[__X(i + 1, s__len)] != 0x00) {
i += 1;
- OPM_PointerSize = (int)s[__X(i, s__len)] - 48;
+ OPM_AddressSize = (INT16)s[__X(i, s__len)] - 48;
}
if (s[__X(i + 1, s__len)] != 0x00) {
i += 1;
- OPM_Alignment = (int)s[__X(i, s__len)] - 48;
+ OPM_Alignment = (INT16)s[__X(i, s__len)] - 48;
}
- __ASSERT(OPM_IntSize == 2 || OPM_IntSize == 4, 0);
- __ASSERT(OPM_PointerSize == 4 || OPM_PointerSize == 8, 0);
+ __ASSERT(OPM_IntegerSize == 2 || OPM_IntegerSize == 4, 0);
+ __ASSERT(OPM_AddressSize == 4 || OPM_AddressSize == 8, 0);
__ASSERT(OPM_Alignment == 4 || OPM_Alignment == 8, 0);
- Files_SetSearchPath((CHAR*)"", (LONGINT)1);
- break;
- case 'F':
- *opt = *opt ^ 0x020000;
- break;
- case 'M':
- *opt = *opt ^ 0x8000;
- break;
- case 'S':
- *opt = *opt ^ 0x2000;
- break;
- case 'V':
- *opt = *opt ^ 0x040000;
+ if (OPM_IntegerSize == 2) {
+ OPM_LongintSize = 4;
+ } else {
+ OPM_LongintSize = 8;
+ }
+ Files_SetSearchPath((CHAR*)"", 1);
break;
default:
- OPM_LogWStr((CHAR*)" warning: option ", (LONGINT)19);
+ OPM_LogWStr((CHAR*)" warning: option ", 19);
OPM_LogW('-');
OPM_LogW(s[__X(i, s__len)]);
- OPM_LogWStr((CHAR*)" ignored", (LONGINT)9);
+ OPM_LogWStr((CHAR*)" ignored", 9);
OPM_LogWLn();
break;
}
i += 1;
}
+ __DEL(s);
}
BOOLEAN OPM_OpenPar (void)
{
- BOOLEAN _o_result;
CHAR s[256];
if (Platform_ArgCount == 1) {
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Vishap Oberon-2 compiler v", (LONGINT)27);
- OPM_LogWStr(Configuration_versionLong, ((LONGINT)(41)));
+ OPM_LogWStr((CHAR*)"Oberon-2 compiler v", 20);
+ OPM_LogWStr(Configuration_versionLong, 75);
OPM_LogW('.');
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Based on Ofront by Software Templ OEG, continued by Norayr Chilingarian and others.", (LONGINT)84);
+ 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_LogWLn();
- OPM_LogWStr((CHAR*)"Usage:", (LONGINT)7);
+ OPM_LogWStr((CHAR*)"Usage:", 7);
OPM_LogWLn();
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" ", (LONGINT)3);
- OPM_LogWStr((CHAR*)"voc", (LONGINT)4);
- OPM_LogWStr((CHAR*)" options {files {options}}.", (LONGINT)28);
+ OPM_LogWStr((CHAR*)" ", 3);
+ OPM_LogWStr((CHAR*)"voc", 4);
+ OPM_LogWStr((CHAR*)" options {files {options}}.", 28);
OPM_LogWLn();
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Where options = [\"-\" {option} ].", (LONGINT)33);
+ OPM_LogWStr((CHAR*)"Options:", 9);
OPM_LogWLn();
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" m - generate code for main module", (LONGINT)36);
+ OPM_LogWStr((CHAR*)" Run time safety", 18);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" M - generate code for main module and link object statically", (LONGINT)63);
+ OPM_LogWStr((CHAR*)" -p Initialise pointers to NIL. On by default.", 52);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" s - generate new symbol file", (LONGINT)31);
+ OPM_LogWStr((CHAR*)" -a Halt on assertion failures. On by default.", 52);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" e - allow extending the module interface", (LONGINT)43);
+ OPM_LogWStr((CHAR*)" -r Halt on range check failures.", 39);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" r - check value ranges", (LONGINT)25);
+ OPM_LogWStr((CHAR*)" -t Halt on type guard failure. On by default.", 52);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" a - don't check ASSERTs at runtime, use this option in tested production code", (LONGINT)80);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" t - don't check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" S - don't call external assembler/compiler, only generate C code", (LONGINT)67);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" c - don't call linker", (LONGINT)24);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" f - don't use color output", (LONGINT)29);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" V - verbose output", (LONGINT)21);
+ OPM_LogWStr((CHAR*)" -x Halt on index out of range. On by default.", 52);
OPM_LogWLn();
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Initial options specify defaults for all files.", (LONGINT)48);
+ OPM_LogWStr((CHAR*)" Symbol file management", 25);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Options following a filename are specific to that file.", (LONGINT)56);
+ OPM_LogWStr((CHAR*)" -e Allow extension of old symbol file.", 45);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Repeating an option toggles its value.", (LONGINT)39);
+ OPM_LogWStr((CHAR*)" -s Allow generation of new symbol file.", 46);
OPM_LogWLn();
- _o_result = 0;
- return _o_result;
+ OPM_LogWStr((CHAR*)" -F Force generation of new symbol file.", 46);
+ OPM_LogWLn();
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" C compiler and linker control", 32);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -m This module is main. Link dynamically.", 48);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -M This module is main. Link statically.", 47);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -S Don't call C compiler", 31);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -c Don't link.", 21);
+ OPM_LogWLn();
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" Miscellaneous", 16);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -f Disable VT100 control characters in status output.", 60);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -V Display compiler debugging messages.", 46);
+ OPM_LogWLn();
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" Size model for elementary types (default O2)", 47);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
+ OPM_LogWLn();
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" Target machine address size and alignment (default is that of the running compiler binary)", 93);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -A44 32 bit addresses, 32 bit alignment (e.g. Unix/linux 32 bit on x86).", 79);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -A48 32 bit addresses, 64 bit alignment (e.g. Windows 32 bit on x86, linux 32 bit on arm).", 97);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)" -A88 64 bit addresses, 64 bit alignment (e.g. 64 bit platforms).", 71);
+ OPM_LogWLn();
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"All options are off by default, except where noted above.", 58);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Initial options specify defaults for all files.", 48);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Options following a filename are specific to that file.", 56);
+ OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Repeating an option toggles its value.", 39);
+ OPM_LogWLn();
+ return 0;
} else {
+ OPM_AddressSize = 8;
+ OPM_GetAlignment(&OPM_Alignment);
+ __MOVE("2", OPM_Model, 2);
+ OPM_Options = 0xa9;
OPM_S = 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256)));
- OPM_glbopt = 0xe9;
+ Platform_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
- OPM_ScanOptions((void*)s, ((LONGINT)(256)), &OPM_glbopt);
+ OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256)));
+ Platform_GetArg(OPM_S, (void*)s, 256);
}
- _o_result = 1;
- return _o_result;
+ OPM_GlobalAddressSize = OPM_AddressSize;
+ OPM_GlobalAlignment = OPM_Alignment;
+ __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];
- OPM_opt = OPM_glbopt;
+ CHAR searchpath[1024], modules[1024];
+ CHAR MODULES[1024];
+ OPM_Options = OPM_GlobalOptions;
+ __COPY(OPM_GlobalModel, OPM_Model, 10);
+ OPM_Alignment = OPM_GlobalAlignment;
+ OPM_AddressSize = OPM_GlobalAddressSize;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256)));
+ Platform_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
- OPM_ScanOptions((void*)s, ((LONGINT)(256)), &OPM_opt);
+ OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256)));
+ Platform_GetArg(OPM_S, (void*)s, 256);
}
- OPM_dontAsm = __IN(13, OPM_opt);
- OPM_dontLink = __IN(14, OPM_opt);
- OPM_mainProg = __IN(10, OPM_opt);
- OPM_mainLinkStat = __IN(15, OPM_opt);
- OPM_notColorOutput = __IN(16, OPM_opt);
- OPM_forceNewSym = __IN(17, OPM_opt);
- OPM_Verbose = __IN(18, OPM_opt);
- if (OPM_mainLinkStat) {
- OPM_glbopt |= __SETOF(10);
+ if (__IN(15, OPM_Options, 32)) {
+ OPM_Options |= __SETOF(10,32);
}
- OPM_GetProperties();
+ OPM_MaxIndex = OPM_SignedMaximum(OPM_AddressSize);
+ switch (OPM_Model[0]) {
+ case '2':
+ OPM_ShortintSize = 1;
+ OPM_IntegerSize = 2;
+ OPM_LongintSize = 4;
+ break;
+ case 'C':
+ OPM_ShortintSize = 2;
+ OPM_IntegerSize = 4;
+ OPM_LongintSize = 8;
+ break;
+ case 'V':
+ OPM_ShortintSize = 1;
+ OPM_IntegerSize = 4;
+ OPM_LongintSize = 8;
+ break;
+ default:
+ OPM_ShortintSize = 1;
+ OPM_IntegerSize = 2;
+ OPM_LongintSize = 4;
+ break;
+ }
+ 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);
+ Platform_GetEnv((CHAR*)"OBERON", 7, (void*)searchpath, 1024);
+ Strings_Append((CHAR*)";.;", 4, (void*)searchpath, 1024);
+ Strings_Append(modules, 1024, (void*)searchpath, 1024);
+ Strings_Append((CHAR*)";", 2, (void*)searchpath, 1024);
+ Strings_Append(OPM_ResourceDir, 1024, (void*)searchpath, 1024);
+ Strings_Append((CHAR*)"/sym;", 6, (void*)searchpath, 1024);
+ Files_SetSearchPath(searchpath, 1024);
}
void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
{
Texts_Text T = NIL;
- LONGINT beg, end, time;
+ INT32 beg, end, time;
CHAR s[256];
*done = 0;
OPM_curpos = 0;
@@ -308,19 +476,19 @@ void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
return;
}
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256)));
+ Platform_GetArg(OPM_S, (void*)s, 256);
__NEW(T, Texts_TextDesc);
- Texts_Open(T, s, ((LONGINT)(256)));
- OPM_LogWStr(s, ((LONGINT)(256)));
- OPM_LogWStr((CHAR*)" ", (LONGINT)3);
+ Texts_Open(T, s, 256);
+ OPM_LogWStr(s, 256);
+ OPM_LogWStr((CHAR*)" ", 3);
__COPY(s, mname, mname__len);
- __COPY(s, OPM_SourceFileName, ((LONGINT)(256)));
+ __COPY(s, OPM_SourceFileName, 256);
if (T->len == 0) {
- OPM_LogWStr(s, ((LONGINT)(256)));
- OPM_LogWStr((CHAR*)" not found.", (LONGINT)12);
+ OPM_LogWStr(s, 256);
+ OPM_LogWStr((CHAR*)" not found.", 12);
OPM_LogWLn();
} else {
- Texts_OpenReader(&OPM_inR, Texts_Reader__typ, T, ((LONGINT)(0)));
+ Texts_OpenReader(&OPM_inR, Texts_Reader__typ, T, 0);
*done = 1;
}
OPM_S += 1;
@@ -348,7 +516,7 @@ void OPM_Get (CHAR *ch)
static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len)
{
- INTEGER i, j;
+ INT16 i, j;
CHAR ch;
__DUP(ext, ext__len, CHAR);
i = 0;
@@ -370,51 +538,56 @@ static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGIN
__DEL(ext);
}
-static void OPM_LogErrMsg (INTEGER n)
+static void OPM_LogErrMsg (INT16 n)
{
+ INT16 l;
Texts_Scanner S;
- Texts_Text T = NIL;
- CHAR ch;
- INTEGER i;
- CHAR buf[1024];
+ CHAR c;
if (n >= 0) {
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"31m", (LONGINT)4);
- }
- OPM_LogWStr((CHAR*)" err ", (LONGINT)7);
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"0m", (LONGINT)3);
- }
+ OPM_LogVT100((CHAR*)"31m", 4);
+ OPM_LogWStr((CHAR*)" err ", 7);
+ OPM_LogVT100((CHAR*)"0m", 3);
} else {
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"35m", (LONGINT)4);
- }
- OPM_LogWStr((CHAR*)" warning ", (LONGINT)11);
+ OPM_LogVT100((CHAR*)"35m", 4);
+ OPM_LogWStr((CHAR*)" warning ", 11);
n = -n;
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"0m", (LONGINT)3);
+ OPM_LogVT100((CHAR*)"0m", 3);
+ }
+ OPM_LogWNum(n, 1);
+ OPM_LogWStr((CHAR*)" ", 3);
+ if (OPM_Errors == NIL) {
+ __NEW(OPM_Errors, Texts_TextDesc);
+ Texts_Open(OPM_Errors, (CHAR*)"Errors.Txt", 11);
+ }
+ Texts_OpenScanner(&S, Texts_Scanner__typ, OPM_Errors, 0);
+ do {
+ l = S.line;
+ Texts_Scan(&S, Texts_Scanner__typ);
+ } while (!((((l != S.line && S.class == 3)) && S.i == n) || S.eot));
+ if (!S.eot) {
+ Texts_Read((void*)&S, Texts_Scanner__typ, &c);
+ while ((!S.eot && c >= ' ')) {
+ Out_Char(c);
+ Texts_Read((void*)&S, Texts_Scanner__typ, &c);
}
}
- OPM_LogWNum(n, ((LONGINT)(1)));
- OPM_LogWStr((CHAR*)" ", (LONGINT)3);
- OPM_LogWStr(errors_errors[__X(n, ((LONGINT)(350)))], ((LONGINT)(128)));
}
-static void OPM_FindLine (Files_File f, Files_Rider *r, LONGINT *r__typ, LONGINT pos)
+static void OPM_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos)
{
CHAR ch, cheol;
- if (pos < OPM_ErrorLineStartPos) {
+ if (pos < (INT64)OPM_ErrorLineStartPos) {
OPM_ErrorLineStartPos = 0;
OPM_ErrorLineLimitPos = 0;
OPM_ErrorLineNumber = 0;
}
- if (pos < OPM_ErrorLineLimitPos) {
+ if (pos < (INT64)OPM_ErrorLineLimitPos) {
Files_Set(&*r, r__typ, f, OPM_ErrorLineStartPos);
return;
}
Files_Set(&*r, r__typ, f, OPM_ErrorLineLimitPos);
Files_Read(&*r, r__typ, (void*)&ch);
- while ((OPM_ErrorLineLimitPos < pos && !(*r).eof)) {
+ while (((INT64)OPM_ErrorLineLimitPos < pos && !(*r).eof)) {
OPM_ErrorLineStartPos = OPM_ErrorLineLimitPos;
OPM_ErrorLineNumber += 1;
while ((((ch != 0x00 && ch != 0x0d)) && ch != 0x0a)) {
@@ -432,49 +605,45 @@ static void OPM_FindLine (Files_File f, Files_Rider *r, LONGINT *r__typ, LONGINT
Files_Set(&*r, r__typ, f, OPM_ErrorLineStartPos);
}
-static void OPM_ShowLine (LONGINT pos)
+static void OPM_ShowLine (INT64 pos)
{
Files_File f = NIL;
Files_Rider r;
CHAR line[1023];
- INTEGER i;
+ INT16 i;
CHAR ch;
- f = Files_Old(OPM_SourceFileName, ((LONGINT)(256)));
+ f = Files_Old(OPM_SourceFileName, 256);
OPM_FindLine(f, &r, Files_Rider__typ, pos);
i = 0;
Files_Read(&r, Files_Rider__typ, (void*)&ch);
while ((((((ch != 0x00 && ch != 0x0d)) && ch != 0x0a)) && i < 1022)) {
- line[__X(i, ((LONGINT)(1023)))] = ch;
+ line[__X(i, 1023)] = ch;
i += 1;
Files_Read(&r, Files_Rider__typ, (void*)&ch);
}
- line[__X(i, ((LONGINT)(1023)))] = 0x00;
+ line[__X(i, 1023)] = 0x00;
OPM_LogWLn();
OPM_LogWLn();
- OPM_LogWNum(OPM_ErrorLineNumber, ((LONGINT)(4)));
- OPM_LogWStr((CHAR*)": ", (LONGINT)3);
- OPM_LogWStr(line, ((LONGINT)(1023)));
+ OPM_LogWNum(OPM_ErrorLineNumber, 4);
+ OPM_LogWStr((CHAR*)": ", 3);
+ OPM_LogWStr(line, 1023);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" ", (LONGINT)7);
- if (pos >= OPM_ErrorLineLimitPos) {
+ OPM_LogWStr((CHAR*)" ", 7);
+ if (pos >= (INT64)OPM_ErrorLineLimitPos) {
pos = OPM_ErrorLineLimitPos - 1;
}
- i = (int)(pos - OPM_ErrorLineStartPos);
+ i = (INT16)OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos);
while (i > 0) {
OPM_LogW(' ');
i -= 1;
}
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"32m", (LONGINT)4);
- }
+ OPM_LogVT100((CHAR*)"32m", 4);
OPM_LogW('^');
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"0m", (LONGINT)3);
- }
+ OPM_LogVT100((CHAR*)"0m", 3);
Files_Close(f);
}
-void OPM_Mark (INTEGER n, LONGINT pos)
+void OPM_Mark (INT16 n, INT32 pos)
{
if (pos == -1) {
pos = 0;
@@ -485,30 +654,30 @@ void OPM_Mark (INTEGER n, LONGINT pos)
OPM_lasterrpos = pos;
OPM_ShowLine(pos);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" ", (LONGINT)3);
+ OPM_LogWStr((CHAR*)" ", 3);
if (n < 249) {
- OPM_LogWStr((CHAR*)" pos", (LONGINT)6);
- OPM_LogWNum(pos, ((LONGINT)(6)));
+ OPM_LogWStr((CHAR*)" pos", 6);
+ OPM_LogWNum(pos, 6);
OPM_LogErrMsg(n);
} else if (n == 255) {
- OPM_LogWStr((CHAR*)"pos", (LONGINT)4);
- OPM_LogWNum(pos, ((LONGINT)(6)));
- OPM_LogWStr((CHAR*)" pc ", (LONGINT)6);
- OPM_LogWNum(OPM_breakpc, ((LONGINT)(1)));
+ OPM_LogWStr((CHAR*)"pos", 4);
+ OPM_LogWNum(pos, 6);
+ OPM_LogWStr((CHAR*)" pc ", 6);
+ OPM_LogWNum(OPM_breakpc, 1);
} else if (n == 254) {
- OPM_LogWStr((CHAR*)"pc not found", (LONGINT)13);
+ OPM_LogWStr((CHAR*)"pc not found", 13);
} else {
- OPM_LogWStr(OPM_objname, ((LONGINT)(64)));
+ OPM_LogWStr(OPM_objname, 64);
if (n == 253) {
- OPM_LogWStr((CHAR*)" is new, compile with option e", (LONGINT)31);
+ OPM_LogWStr((CHAR*)" is new, compile with option e", 31);
} else if (n == 252) {
- OPM_LogWStr((CHAR*)" is redefined, compile with option s", (LONGINT)37);
+ OPM_LogWStr((CHAR*)" is redefined, compile with option s", 37);
} else if (n == 251) {
- OPM_LogWStr((CHAR*)" is redefined (private part only), compile with option s", (LONGINT)57);
+ OPM_LogWStr((CHAR*)" is redefined (private part only), compile with option s", 57);
} else if (n == 250) {
- OPM_LogWStr((CHAR*)" is no longer visible, compile with option s", (LONGINT)45);
+ OPM_LogWStr((CHAR*)" is no longer visible, compile with option s", 45);
} else if (n == 249) {
- OPM_LogWStr((CHAR*)" is not consistently imported, recompile imports", (LONGINT)49);
+ OPM_LogWStr((CHAR*)" is not consistently imported, recompile imports", 49);
}
}
}
@@ -516,8 +685,8 @@ void OPM_Mark (INTEGER n, LONGINT pos)
if (pos >= 0) {
OPM_ShowLine(pos);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" pos", (LONGINT)6);
- OPM_LogWNum(pos, ((LONGINT)(6)));
+ OPM_LogWStr((CHAR*)" pos", 6);
+ OPM_LogWNum(pos, 6);
}
OPM_LogErrMsg(n);
if (pos < 0) {
@@ -526,160 +695,42 @@ void OPM_Mark (INTEGER n, LONGINT pos)
}
}
-void OPM_err (INTEGER n)
+void OPM_err (INT16 n)
{
OPM_Mark(n, OPM_errpos);
}
-void OPM_FPrint (LONGINT *fp, LONGINT val)
+static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len)
{
- *fp = __ROTL((LONGINT)((SET)*fp ^ (SET)val), 1, LONGINT);
-}
-
-void OPM_FPrintSet (LONGINT *fp, SET set)
-{
- OPM_FPrint(&*fp, (LONGINT)set);
-}
-
-void OPM_FPrintReal (LONGINT *fp, REAL real)
-{
- INTEGER i;
- LONGINT l;
- __GET((LONGINT)(SYSTEM_ADDRESS)&real, i, INTEGER);
- l = i;
- OPM_FPrint(&*fp, l);
-}
-
-void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr)
-{
- LONGINT l, h;
- OPM_FPrint(&*fp, __VAL(LONGINT, lr));
-}
-
-static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align)
-{
- __DUP(name, name__len, CHAR);
- if (((*S).class == 1 && __STRCMP((*S).s, name) == 0)) {
- Texts_Scan(&*S, S__typ);
- if ((*S).class == 3) {
- *size = (int)(*S).i;
- Texts_Scan(&*S, S__typ);
- } else {
- OPM_Mark(-157, ((LONGINT)(-1)));
- }
- if ((*S).class == 3) {
- *align = (int)(*S).i;
- Texts_Scan(&*S, S__typ);
- } else {
- OPM_Mark(-157, ((LONGINT)(-1)));
- }
- } else {
- OPM_Mark(-157, ((LONGINT)(-1)));
+ INT16 i;
+ INT32 l;
+ __ASSERT(__MASK(bytes__len, -4) == 0, 0);
+ i = 0;
+ while (i < bytes__len) {
+ __GET((ADDRESS)&bytes[__X(i, bytes__len)], l, INT32);
+ *fp = __ROTL((INT32)((UINT32)*fp ^ (UINT32)l), 1, 32);
+ i += 4;
}
- __DEL(name);
}
-static LONGINT OPM_minusop (LONGINT i)
+void OPM_FPrint (INT32 *fp, INT64 val)
{
- LONGINT _o_result;
- _o_result = -i;
- return _o_result;
+ OPM_FingerprintBytes(&*fp, (void*)&val, 8);
}
-static LONGINT OPM_power0 (LONGINT i, LONGINT j)
+void OPM_FPrintSet (INT32 *fp, UINT64 val)
{
- LONGINT _o_result;
- LONGINT k, p;
- k = 1;
- p = i;
- do {
- p = p * i;
- k += 1;
- } while (!(k == j));
- _o_result = p;
- return _o_result;
+ OPM_FingerprintBytes(&*fp, (void*)&val, 8);
}
-static void OPM_VerboseListSizes (void)
+void OPM_FPrintReal (INT32 *fp, REAL val)
{
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Type Size Alignement", (LONGINT)29);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"CHAR ", (LONGINT)14);
- OPM_LogWNum(OPM_CharSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"BOOLEAN ", (LONGINT)14);
- OPM_LogWNum(OPM_BoolSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"SHORTINT ", (LONGINT)14);
- OPM_LogWNum(OPM_SIntSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"INTEGER ", (LONGINT)14);
- OPM_LogWNum(OPM_IntSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"LONGINT ", (LONGINT)14);
- OPM_LogWNum(OPM_LIntSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"SET ", (LONGINT)14);
- OPM_LogWNum(OPM_SetSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"REAL ", (LONGINT)14);
- OPM_LogWNum(OPM_RealSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"LONGREAL ", (LONGINT)14);
- OPM_LogWNum(OPM_LRealSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"PTR ", (LONGINT)14);
- OPM_LogWNum(OPM_PointerSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"PROC ", (LONGINT)14);
- OPM_LogWNum(OPM_ProcSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"RECORD ", (LONGINT)14);
- OPM_LogWNum(OPM_RecSize, ((LONGINT)(4)));
- OPM_LogWLn();
- OPM_LogWLn();
+ OPM_FingerprintBytes(&*fp, (void*)&val, 4);
}
-LONGINT OPM_SignedMaximum (LONGINT bytecount)
+void OPM_FPrintLReal (INT32 *fp, LONGREAL val)
{
- LONGINT _o_result;
- LONGINT result;
- result = 1;
- result = __LSH(result, __ASHL(bytecount, 3) - 1, LONGINT);
- _o_result = result - 1;
- return _o_result;
-}
-
-LONGINT OPM_SignedMinimum (LONGINT bytecount)
-{
- LONGINT _o_result;
- _o_result = -OPM_SignedMaximum(bytecount) - 1;
- return _o_result;
-}
-
-static void OPM_GetProperties (void)
-{
- OPM_ProcSize = OPM_PointerSize;
- OPM_LIntSize = __ASHL(OPM_IntSize, 1);
- OPM_SetSize = OPM_LIntSize;
- if (OPM_RealSize == 4) {
- OPM_MaxReal = 3.40282346000000e+038;
- } else if (OPM_RealSize == 8) {
- OPM_MaxReal = 1.79769296342094e+308;
- }
- if (OPM_LRealSize == 4) {
- OPM_MaxLReal = 3.40282346000000e+038;
- } else if (OPM_LRealSize == 8) {
- OPM_MaxLReal = 1.79769296342094e+308;
- }
- OPM_MinReal = -OPM_MaxReal;
- OPM_MinLReal = -OPM_MaxLReal;
- OPM_MaxSet = __ASHL(OPM_SetSize, 3) - 1;
- OPM_MaxIndex = OPM_SignedMaximum(OPM_PointerSize);
- if (OPM_Verbose) {
- OPM_VerboseListSizes();
- }
+ OPM_FingerprintBytes(&*fp, (void*)&val, 8);
}
void OPM_SymRCh (CHAR *ch)
@@ -687,18 +738,23 @@ void OPM_SymRCh (CHAR *ch)
Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&*ch);
}
-LONGINT OPM_SymRInt (void)
+INT32 OPM_SymRInt (void)
{
- LONGINT _o_result;
- LONGINT k;
- Files_ReadNum(&OPM_oldSF, Files_Rider__typ, &k);
- _o_result = k;
- return _o_result;
+ INT32 k;
+ Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (void*)&k, 4);
+ return k;
}
-void OPM_SymRSet (SET *s)
+INT64 OPM_SymRInt64 (void)
{
- Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (LONGINT*)&*s);
+ INT64 k;
+ Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (void*)&k, 8);
+ return k;
+}
+
+void OPM_SymRSet (UINT64 *s)
+{
+ Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (void*)&*s, 8);
}
void OPM_SymRReal (REAL *r)
@@ -713,19 +769,21 @@ void OPM_SymRLReal (LONGREAL *lr)
void OPM_CloseOldSym (void)
{
+ Files_Close(Files_Base(&OPM_oldSF, Files_Rider__typ));
}
void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done)
{
- CHAR ch;
+ CHAR tag, ver;
OPM_FileName fileName;
- OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5);
- OPM_oldSFile = Files_Old(fileName, ((LONGINT)(32)));
+ OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
+ OPM_oldSFile = Files_Old(fileName, 32);
*done = OPM_oldSFile != NIL;
if (*done) {
- Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, ((LONGINT)(0)));
- Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ch);
- if (ch != 0xf7) {
+ Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, 0);
+ Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&tag);
+ Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ver);
+ if (tag != 0xf7 || ver != 0x82) {
OPM_err(-306);
OPM_CloseOldSym();
*done = 0;
@@ -735,9 +793,7 @@ void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done)
BOOLEAN OPM_eofSF (void)
{
- BOOLEAN _o_result;
- _o_result = OPM_oldSF.eof;
- return _o_result;
+ return OPM_oldSF.eof;
}
void OPM_SymWCh (CHAR ch)
@@ -745,14 +801,14 @@ void OPM_SymWCh (CHAR ch)
Files_Write(&OPM_newSF, Files_Rider__typ, ch);
}
-void OPM_SymWInt (LONGINT i)
+void OPM_SymWInt (INT64 i)
{
Files_WriteNum(&OPM_newSF, Files_Rider__typ, i);
}
-void OPM_SymWSet (SET s)
+void OPM_SymWSet (UINT64 s)
{
- Files_WriteNum(&OPM_newSF, Files_Rider__typ, (LONGINT)s);
+ Files_WriteNum(&OPM_newSF, Files_Rider__typ, (INT64)s);
}
void OPM_SymWReal (REAL r)
@@ -767,7 +823,7 @@ void OPM_SymWLReal (LONGREAL lr)
void OPM_RegisterNewSym (void)
{
- if (__STRCMP(OPM_modName, "SYSTEM") != 0 || __IN(10, OPM_opt)) {
+ if (__STRCMP(OPM_modName, "SYSTEM") != 0 || __IN(10, OPM_Options, 32)) {
Files_Register(OPM_newSFile);
}
}
@@ -779,11 +835,12 @@ void OPM_DeleteNewSym (void)
void OPM_NewSym (CHAR *modName, LONGINT modName__len)
{
OPM_FileName fileName;
- OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5);
- OPM_newSFile = Files_New(fileName, ((LONGINT)(32)));
+ OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
+ OPM_newSFile = Files_New(fileName, 32);
if (OPM_newSFile != NIL) {
- Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, ((LONGINT)(0)));
+ Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, 0);
Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7);
+ Files_Write(&OPM_newSF, Files_Rider__typ, 0x82);
} else {
OPM_err(153);
}
@@ -791,74 +848,74 @@ void OPM_NewSym (CHAR *modName, LONGINT modName__len)
void OPM_Write (CHAR ch)
{
- Files_Write(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, ch);
+ Files_Write(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, ch);
}
void OPM_WriteString (CHAR *s, LONGINT s__len)
{
- INTEGER i;
+ INT16 i;
i = 0;
while (s[__X(i, s__len)] != 0x00) {
i += 1;
}
- Files_WriteBytes(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, (void*)s, s__len * ((LONGINT)(1)), i);
+ Files_WriteBytes(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, (void*)s, s__len * 1, i);
}
void OPM_WriteStringVar (CHAR *s, LONGINT s__len)
{
- INTEGER i;
+ INT16 i;
i = 0;
while (s[__X(i, s__len)] != 0x00) {
i += 1;
}
- Files_WriteBytes(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, (void*)s, s__len * ((LONGINT)(1)), i);
+ Files_WriteBytes(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, (void*)s, s__len * 1, i);
}
-void OPM_WriteHex (LONGINT i)
+void OPM_WriteHex (INT64 i)
{
CHAR s[3];
- INTEGER digit;
- digit = __ASHR((int)i, 4);
+ INT32 digit;
+ digit = __ASHR((INT32)i, 4);
if (digit < 10) {
s[0] = (CHAR)(48 + digit);
} else {
s[0] = (CHAR)(87 + digit);
}
- digit = __MASK((int)i, -16);
+ digit = __MASK((INT32)i, -16);
if (digit < 10) {
s[1] = (CHAR)(48 + digit);
} else {
s[1] = (CHAR)(87 + digit);
}
s[2] = 0x00;
- OPM_WriteString(s, ((LONGINT)(3)));
+ OPM_WriteString(s, 3);
}
-void OPM_WriteInt (LONGINT i)
+void OPM_WriteInt (INT64 i)
{
- CHAR s[20];
- LONGINT i1, k;
- if (i == OPM_SignedMinimum(OPM_IntSize) || i == OPM_SignedMinimum(OPM_LIntSize)) {
+ CHAR s[24];
+ INT64 i1, k;
+ if ((i == OPM_SignedMinimum(2) || i == OPM_SignedMinimum(4)) || i == OPM_SignedMinimum(8)) {
OPM_Write('(');
OPM_WriteInt(i + 1);
- OPM_WriteString((CHAR*)"-1)", (LONGINT)4);
+ OPM_WriteString((CHAR*)"-1)", 4);
} else {
i1 = __ABS(i);
s[0] = (CHAR)(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k = 1;
while (i1 > 0) {
- s[__X(k, ((LONGINT)(20)))] = (CHAR)(__MOD(i1, 10) + 48);
+ s[__X(k, 24)] = (CHAR)(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k += 1;
}
if (i < 0) {
- s[__X(k, ((LONGINT)(20)))] = '-';
+ s[__X(k, 24)] = '-';
k += 1;
}
while (k > 0) {
k -= 1;
- OPM_Write(s[__X(k, ((LONGINT)(20)))]);
+ OPM_Write(s[__X(k, 24)]);
}
}
}
@@ -870,14 +927,14 @@ void OPM_WriteReal (LONGREAL r, CHAR suffx)
Texts_Reader R;
CHAR s[32];
CHAR ch;
- INTEGER i;
- if ((((r < OPM_SignedMaximum(OPM_LIntSize) && r > OPM_SignedMinimum(OPM_LIntSize))) && r == (__ENTIER(r)))) {
+ INT16 i;
+ if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == ((INT32)__ENTIER(r)))) {
if (suffx == 'f') {
- OPM_WriteString((CHAR*)"(REAL)", (LONGINT)7);
+ OPM_WriteString((CHAR*)"(REAL)", 7);
} else {
- OPM_WriteString((CHAR*)"(LONGREAL)", (LONGINT)11);
+ OPM_WriteString((CHAR*)"(LONGREAL)", 11);
}
- OPM_WriteInt(__ENTIER(r));
+ OPM_WriteInt((INT32)__ENTIER(r));
} else {
Texts_OpenWriter(&W, Texts_Writer__typ);
if (suffx == 'f') {
@@ -886,45 +943,45 @@ void OPM_WriteReal (LONGREAL r, CHAR suffx)
Texts_WriteLongReal(&W, Texts_Writer__typ, r, 23);
}
__NEW(T, Texts_TextDesc);
- Texts_Open(T, (CHAR*)"", (LONGINT)1);
+ Texts_Open(T, (CHAR*)"", 1);
Texts_Append(T, W.buf);
- Texts_OpenReader(&R, Texts_Reader__typ, T, ((LONGINT)(0)));
+ Texts_OpenReader(&R, Texts_Reader__typ, T, 0);
i = 0;
Texts_Read(&R, Texts_Reader__typ, &ch);
while (ch != 0x00) {
- s[__X(i, ((LONGINT)(32)))] = ch;
+ s[__X(i, 32)] = ch;
i += 1;
Texts_Read(&R, Texts_Reader__typ, &ch);
}
- s[__X(i, ((LONGINT)(32)))] = 0x00;
+ s[__X(i, 32)] = 0x00;
i = 0;
ch = s[0];
while ((ch != 'D' && ch != 0x00)) {
i += 1;
- ch = s[__X(i, ((LONGINT)(32)))];
+ ch = s[__X(i, 32)];
}
if (ch == 'D') {
- s[__X(i, ((LONGINT)(32)))] = 'e';
+ s[__X(i, 32)] = 'e';
}
- OPM_WriteString(s, ((LONGINT)(32)));
+ OPM_WriteString(s, 32);
}
}
void OPM_WriteLn (void)
{
- Files_Write(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, 0x0a);
+ Files_Write(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, 0x0a);
}
-static void OPM_Append (Files_Rider *R, LONGINT *R__typ, Files_File F)
+static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F)
{
Files_Rider R1;
CHAR buffer[4096];
if (F != NIL) {
- Files_Set(&R1, Files_Rider__typ, F, ((LONGINT)(0)));
- Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, ((LONGINT)(4096)), ((LONGINT)(4096)));
+ Files_Set(&R1, Files_Rider__typ, F, 0);
+ Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, 4096, 4096);
while (4096 - R1.res > 0) {
- Files_WriteBytes(&*R, R__typ, (void*)buffer, ((LONGINT)(4096)), 4096 - R1.res);
- Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, ((LONGINT)(4096)), ((LONGINT)(4096)));
+ Files_WriteBytes(&*R, R__typ, (void*)buffer, 4096, 4096 - R1.res);
+ Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, 4096, 4096);
}
}
}
@@ -932,24 +989,24 @@ static void OPM_Append (Files_Rider *R, LONGINT *R__typ, Files_File F)
void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
{
CHAR FName[32];
- __COPY(moduleName, OPM_modName, ((LONGINT)(32)));
- OPM_HFile = Files_New((CHAR*)"", (LONGINT)1);
+ __COPY(moduleName, OPM_modName, 32);
+ OPM_HFile = Files_New((CHAR*)"", 1);
if (OPM_HFile != NIL) {
- Files_Set(&OPM_R[0], Files_Rider__typ, OPM_HFile, ((LONGINT)(0)));
+ Files_Set(&OPM_R[0], Files_Rider__typ, OPM_HFile, 0);
} else {
OPM_err(153);
}
- OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, ((LONGINT)(32)), (CHAR*)".c", (LONGINT)3);
- OPM_BFile = Files_New(FName, ((LONGINT)(32)));
+ OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, 32, (CHAR*)".c", 3);
+ OPM_BFile = Files_New(FName, 32);
if (OPM_BFile != NIL) {
- Files_Set(&OPM_R[1], Files_Rider__typ, OPM_BFile, ((LONGINT)(0)));
+ Files_Set(&OPM_R[1], Files_Rider__typ, OPM_BFile, 0);
} else {
OPM_err(153);
}
- OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, ((LONGINT)(32)), (CHAR*)".h", (LONGINT)3);
- OPM_HIFile = Files_New(FName, ((LONGINT)(32)));
+ OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, 32, (CHAR*)".h", 3);
+ OPM_HIFile = Files_New(FName, 32);
if (OPM_HIFile != NIL) {
- Files_Set(&OPM_R[2], Files_Rider__typ, OPM_HIFile, ((LONGINT)(0)));
+ Files_Set(&OPM_R[2], Files_Rider__typ, OPM_HIFile, 0);
} else {
OPM_err(153);
}
@@ -958,26 +1015,26 @@ void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
void OPM_CloseFiles (void)
{
CHAR FName[32];
- INTEGER res;
+ INT16 res;
if (OPM_noerr) {
- OPM_LogWStr((CHAR*)" ", (LONGINT)3);
- OPM_LogWNum(Files_Pos(&OPM_R[1], Files_Rider__typ), ((LONGINT)(0)));
- OPM_LogWStr((CHAR*)" chars.", (LONGINT)8);
+ OPM_LogWStr((CHAR*)" ", 3);
+ OPM_LogWNum(Files_Pos(&OPM_R[1], Files_Rider__typ), 0);
+ OPM_LogWStr((CHAR*)" chars.", 8);
}
if (OPM_noerr) {
if (__STRCMP(OPM_modName, "SYSTEM") == 0) {
- if (!__IN(10, OPM_opt)) {
+ if (!__IN(10, OPM_Options, 32)) {
Files_Register(OPM_BFile);
}
- } else if (!__IN(10, OPM_opt)) {
+ } else if (!__IN(10, OPM_Options, 32)) {
OPM_Append(&OPM_R[2], Files_Rider__typ, OPM_HFile);
Files_Register(OPM_HIFile);
Files_Register(OPM_BFile);
} else {
- OPM_MakeFileName((void*)OPM_modName, ((LONGINT)(32)), (void*)FName, ((LONGINT)(32)), (CHAR*)".h", (LONGINT)3);
- Files_Delete(FName, ((LONGINT)(32)), &res);
- OPM_MakeFileName((void*)OPM_modName, ((LONGINT)(32)), (void*)FName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5);
- Files_Delete(FName, ((LONGINT)(32)), &res);
+ OPM_MakeFileName((void*)OPM_modName, 32, (void*)FName, 32, (CHAR*)".h", 3);
+ Files_Delete(FName, 32, &res);
+ OPM_MakeFileName((void*)OPM_modName, 32, (void*)FName, 32, (CHAR*)".sym", 5);
+ Files_Delete(FName, 32, &res);
Files_Register(OPM_BFile);
}
}
@@ -986,21 +1043,21 @@ void OPM_CloseFiles (void)
OPM_HIFile = NIL;
OPM_newSFile = NIL;
OPM_oldSFile = NIL;
- Files_Set(&OPM_R[0], Files_Rider__typ, NIL, ((LONGINT)(0)));
- Files_Set(&OPM_R[1], Files_Rider__typ, NIL, ((LONGINT)(0)));
- Files_Set(&OPM_R[2], Files_Rider__typ, NIL, ((LONGINT)(0)));
- Files_Set(&OPM_newSF, Files_Rider__typ, NIL, ((LONGINT)(0)));
- Files_Set(&OPM_oldSF, Files_Rider__typ, NIL, ((LONGINT)(0)));
+ Files_Set(&OPM_R[0], Files_Rider__typ, NIL, 0);
+ Files_Set(&OPM_R[1], Files_Rider__typ, NIL, 0);
+ Files_Set(&OPM_R[2], Files_Rider__typ, NIL, 0);
+ Files_Set(&OPM_newSF, Files_Rider__typ, NIL, 0);
+ Files_Set(&OPM_oldSF, Files_Rider__typ, NIL, 0);
}
static void EnumPtrs(void (*P)(void*))
{
- __ENUMR(&OPM_inR, Texts_Reader__typ, 96, 1, P);
+ __ENUMR(&OPM_inR, Texts_Reader__typ, 72, 1, P);
P(OPM_Log);
- __ENUMR(&OPM_W, Texts_Writer__typ, 72, 1, P);
- __ENUMR(&OPM_oldSF, Files_Rider__typ, 40, 1, P);
- __ENUMR(&OPM_newSF, Files_Rider__typ, 40, 1, P);
- __ENUMR(OPM_R, Files_Rider__typ, 40, 3, P);
+ P(OPM_Errors);
+ __ENUMR(&OPM_oldSF, Files_Rider__typ, 24, 1, P);
+ __ENUMR(&OPM_newSF, Files_Rider__typ, 24, 1, P);
+ __ENUMR(OPM_R, Files_Rider__typ, 24, 3, P);
P(OPM_oldSFile);
P(OPM_newSFile);
P(OPM_HFile);
@@ -1013,13 +1070,12 @@ export void *OPM__init(void)
{
__DEFMOD;
__MODULE_IMPORT(Configuration);
- __MODULE_IMPORT(Console);
__MODULE_IMPORT(Files);
+ __MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
__MODULE_IMPORT(Texts);
- __MODULE_IMPORT(errors);
- __MODULE_IMPORT(vt100);
+ __MODULE_IMPORT(VT100);
__REGMOD("OPM", EnumPtrs);
__REGCMD("CloseFiles", OPM_CloseFiles);
__REGCMD("CloseOldSym", OPM_CloseOldSym);
@@ -1029,26 +1085,9 @@ export void *OPM__init(void)
__REGCMD("RegisterNewSym", OPM_RegisterNewSym);
__REGCMD("WriteLn", OPM_WriteLn);
/* BEGIN */
- Texts_OpenWriter(&OPM_W, Texts_Writer__typ);
- OPM_MODULES[0] = 0x00;
- Platform_GetEnv((CHAR*)"MODULES", (LONGINT)8, (void*)OPM_MODULES, ((LONGINT)(1024)));
- __MOVE(".", OPM_OBERON, 2);
- Platform_GetEnv((CHAR*)"OBERON", (LONGINT)7, (void*)OPM_OBERON, ((LONGINT)(1024)));
- Strings_Append((CHAR*)";.;", (LONGINT)4, (void*)OPM_OBERON, ((LONGINT)(1024)));
- Strings_Append(OPM_MODULES, ((LONGINT)(1024)), (void*)OPM_OBERON, ((LONGINT)(1024)));
- Strings_Append((CHAR*)";", (LONGINT)2, (void*)OPM_OBERON, ((LONGINT)(1024)));
- Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)OPM_OBERON, ((LONGINT)(1024)));
- Strings_Append((CHAR*)"/sym;", (LONGINT)6, (void*)OPM_OBERON, ((LONGINT)(1024)));
- Files_SetSearchPath(OPM_OBERON, ((LONGINT)(1024)));
- OPM_CharSize = 1;
- OPM_BoolSize = 1;
- OPM_SIntSize = 1;
- OPM_RecSize = 1;
- OPM_ByteSize = 1;
- OPM_RealSize = 4;
- OPM_LRealSize = 8;
- OPM_PointerSize = 8;
- OPM_Alignment = 8;
- OPM_IntSize = 4;
+ OPM_MaxReal = 3.40282346000000e+038;
+ OPM_MaxLReal = 1.79769296342094e+308;
+ OPM_MinReal = -OPM_MaxReal;
+ OPM_MinLReal = -OPM_MaxLReal;
__ENDMOD;
}
diff --git a/bootstrap/windows-88/OPM.h b/bootstrap/windows-88/OPM.h
index 1706f8f1..2d272feb 100644
--- a/bootstrap/windows-88/OPM.h
+++ b/bootstrap/windows-88/OPM.h
@@ -1,66 +1,71 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPM__h
#define OPM__h
-#define LARGE
#include "SYSTEM.h"
-import INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_MaxSet;
-import LONGINT OPM_MaxIndex;
+import CHAR OPM_Model[10];
+import INT16 OPM_AddressSize, OPM_Alignment;
+import UINT32 OPM_GlobalOptions, OPM_Options;
+import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize;
+import INT64 OPM_MaxIndex;
import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
import BOOLEAN OPM_noerr;
-import LONGINT OPM_curpos, OPM_errpos, OPM_breakpc;
-import INTEGER OPM_currFile, OPM_level, OPM_pc, OPM_entno;
+import 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 SET OPM_opt, OPM_glbopt;
-import BOOLEAN OPM_dontAsm, OPM_dontLink, OPM_mainProg, OPM_mainLinkStat, OPM_notColorOutput, OPM_forceNewSym, OPM_Verbose;
+import CHAR OPM_ResourceDir[1024];
import void OPM_CloseFiles (void);
import void OPM_CloseOldSym (void);
import void OPM_DeleteNewSym (void);
-import void OPM_FPrint (LONGINT *fp, LONGINT val);
-import void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr);
-import void OPM_FPrintReal (LONGINT *fp, REAL real);
-import void OPM_FPrintSet (LONGINT *fp, SET set);
+import void OPM_FPrint (INT32 *fp, INT64 val);
+import void OPM_FPrintLReal (INT32 *fp, LONGREAL val);
+import void OPM_FPrintReal (INT32 *fp, REAL val);
+import void OPM_FPrintSet (INT32 *fp, UINT64 val);
import void OPM_Get (CHAR *ch);
import void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
import void OPM_InitOptions (void);
+import INT16 OPM_Integer (INT64 n);
+import void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
import void OPM_LogW (CHAR ch);
import void OPM_LogWLn (void);
-import void OPM_LogWNum (LONGINT i, LONGINT len);
+import void OPM_LogWNum (INT64 i, INT64 len);
import void OPM_LogWStr (CHAR *s, LONGINT s__len);
-import void OPM_Mark (INTEGER n, LONGINT pos);
+import INT32 OPM_Longint (INT64 n);
+import void OPM_Mark (INT16 n, INT32 pos);
import void OPM_NewSym (CHAR *modName, LONGINT modName__len);
import void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
import void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
import BOOLEAN OPM_OpenPar (void);
import void OPM_RegisterNewSym (void);
-import LONGINT OPM_SignedMaximum (LONGINT bytecount);
-import LONGINT OPM_SignedMinimum (LONGINT bytecount);
+import INT64 OPM_SignedMaximum (INT32 bytecount);
+import INT64 OPM_SignedMinimum (INT32 bytecount);
import void OPM_SymRCh (CHAR *ch);
-import LONGINT OPM_SymRInt (void);
+import INT32 OPM_SymRInt (void);
+import INT64 OPM_SymRInt64 (void);
import void OPM_SymRLReal (LONGREAL *lr);
import void OPM_SymRReal (REAL *r);
-import void OPM_SymRSet (SET *s);
+import void OPM_SymRSet (UINT64 *s);
import void OPM_SymWCh (CHAR ch);
-import void OPM_SymWInt (LONGINT i);
+import void OPM_SymWInt (INT64 i);
import void OPM_SymWLReal (LONGREAL lr);
import void OPM_SymWReal (REAL r);
-import void OPM_SymWSet (SET s);
+import void OPM_SymWSet (UINT64 s);
import void OPM_Write (CHAR ch);
-import void OPM_WriteHex (LONGINT i);
-import void OPM_WriteInt (LONGINT i);
+import void OPM_WriteHex (INT64 i);
+import void OPM_WriteInt (INT64 i);
import void OPM_WriteLn (void);
import void OPM_WriteReal (LONGREAL r, CHAR suffx);
import void OPM_WriteString (CHAR *s, LONGINT s__len);
import void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
import BOOLEAN OPM_eofSF (void);
-import void OPM_err (INTEGER n);
+import void OPM_err (INT16 n);
import void *OPM__init(void);
-#endif
+#endif // OPM
diff --git a/bootstrap/windows-88/OPP.c b/bootstrap/windows-88/OPP.c
index be7c13b5..df908a43 100644
--- a/bootstrap/windows-88/OPP.c
+++ b/bootstrap/windows-88/OPP.c
@@ -1,5 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "OPB.h"
#include "OPM.h"
@@ -7,38 +12,38 @@
#include "OPT.h"
struct OPP__1 {
- LONGINT low, high;
+ INT32 low, high;
};
typedef
struct OPP__1 OPP_CaseTable[128];
-static SHORTINT OPP_sym, OPP_level;
-static INTEGER OPP_LoopLevel;
+static INT8 OPP_sym, OPP_level;
+static INT16 OPP_LoopLevel;
static OPT_Node OPP_TDinit, OPP_lastTDinit;
-static INTEGER OPP_nofFwdPtr;
+static INT16 OPP_nofFwdPtr;
static OPT_Struct OPP_FwdPtr[64];
-export LONGINT *OPP__1__typ;
+export ADDRESS *OPP__1__typ;
static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar);
static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned);
static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq);
-static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab);
-static void OPP_CheckMark (SHORTINT *vis);
-static void OPP_CheckSym (INTEGER s);
-static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_);
+static void OPP_CaseLabelList (OPT_Node *lab, OPT_Struct LabelTyp, INT16 *n, OPP_CaseTable tab);
+static void OPP_CheckMark (INT8 *vis);
+static void OPP_CheckSym (INT16 s);
+static void OPP_CheckSysFlag (INT16 *sysflag, INT16 default_);
static void OPP_ConstExpression (OPT_Node *x);
static void OPP_Element (OPT_Node *x);
static void OPP_Expression (OPT_Node *x);
static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b);
static void OPP_Factor (OPT_Node *x);
static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp);
-export void OPP_Module (OPT_Node *prog, SET opt);
+export void OPP_Module (OPT_Node *prog, UINT32 opt);
static void OPP_PointerType (OPT_Struct *typ);
static void OPP_ProcedureDeclaration (OPT_Node *x);
-static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec);
+static void OPP_Receiver (INT8 *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec);
static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned);
static void OPP_Sets (OPT_Node *x);
static void OPP_SimpleExpression (OPT_Node *x);
@@ -47,19 +52,19 @@ static void OPP_StatSeq (OPT_Node *stat);
static void OPP_Term (OPT_Node *x);
static void OPP_Type (OPT_Struct *typ, OPT_Struct *banned);
static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned);
-static void OPP_err (INTEGER n);
+static void OPP_err (INT16 n);
static void OPP_qualident (OPT_Object *id);
static void OPP_selector (OPT_Node *x);
-static void OPP_err (INTEGER n)
+static void OPP_err (INT16 n)
{
OPM_err(n);
}
-static void OPP_CheckSym (INTEGER s)
+static void OPP_CheckSym (INT16 s)
{
- if ((int)OPP_sym == s) {
+ if ((INT16)OPP_sym == s) {
OPS_Get(&OPP_sym);
} else {
OPM_err(s);
@@ -69,7 +74,7 @@ static void OPP_CheckSym (INTEGER s)
static void OPP_qualident (OPT_Object *id)
{
OPT_Object obj = NIL;
- SHORTINT lev;
+ INT8 lev;
OPT_Find(&obj);
OPS_Get(&OPP_sym);
if ((((OPP_sym == 18 && obj != NIL)) && obj->mode == 11)) {
@@ -90,7 +95,7 @@ static void OPP_qualident (OPT_Object *id)
obj->adr = 0;
} else {
lev = obj->mnolev;
- if ((__IN(obj->mode, 0x06) && lev != OPP_level)) {
+ if ((__IN(obj->mode, 0x06, 32) && lev != OPP_level)) {
obj->leaf = 0;
if (lev > 0) {
OPB_StaticLink(OPP_level - lev);
@@ -105,11 +110,11 @@ static void OPP_ConstExpression (OPT_Node *x)
OPP_Expression(&*x);
if ((*x)->class != 7) {
OPP_err(50);
- *x = OPB_NewIntConst(((LONGINT)(1)));
+ *x = OPB_NewIntConst(1);
}
}
-static void OPP_CheckMark (SHORTINT *vis)
+static void OPP_CheckMark (INT8 *vis)
{
OPS_Get(&OPP_sym);
if (OPP_sym == 1 || OPP_sym == 7) {
@@ -127,17 +132,17 @@ static void OPP_CheckMark (SHORTINT *vis)
}
}
-static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_)
+static void OPP_CheckSysFlag (INT16 *sysflag, INT16 default_)
{
OPT_Node x = NIL;
- LONGINT sf;
+ INT64 sf;
if (OPP_sym == 31) {
OPS_Get(&OPP_sym);
if (!OPT_SYSimported) {
OPP_err(135);
}
OPP_ConstExpression(&x);
- if (__IN(x->typ->form, 0x70)) {
+ if (x->typ->form == 4) {
sf = x->conval->intval;
if (sf < 0 || sf > 1) {
OPP_err(220);
@@ -147,7 +152,7 @@ static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_)
OPP_err(51);
sf = 0;
}
- *sysflag = (int)sf;
+ *sysflag = OPM_Integer(sf);
OPP_CheckSym(23);
} else {
*sysflag = default_;
@@ -158,8 +163,8 @@ static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned)
{
OPT_Object fld = NIL, first = NIL, last = NIL, base = NIL;
OPT_Struct ftyp = NIL;
- INTEGER sysflag;
- *typ = OPT_NewStr(15, 4);
+ INT16 sysflag;
+ *typ = OPT_NewStr(13, 4);
(*typ)->BaseTyp = NIL;
OPP_CheckSysFlag(&sysflag, -1);
if (OPP_sym == 30) {
@@ -250,11 +255,11 @@ static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned)
static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned)
{
OPT_Node x = NIL;
- LONGINT n;
- INTEGER sysflag;
+ INT64 n;
+ INT16 sysflag;
OPP_CheckSysFlag(&sysflag, 0);
if (OPP_sym == 25) {
- *typ = OPT_NewStr(15, 3);
+ *typ = OPT_NewStr(13, 3);
(*typ)->mno = 0;
(*typ)->sysflag = sysflag;
OPS_Get(&OPP_sym);
@@ -266,10 +271,10 @@ static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned)
(*typ)->n = 0;
}
} else {
- *typ = OPT_NewStr(15, 2);
+ *typ = OPT_NewStr(13, 2);
(*typ)->sysflag = sysflag;
OPP_ConstExpression(&x);
- if (__IN(x->typ->form, 0x70)) {
+ if (x->typ->form == 4) {
n = x->conval->intval;
if (n <= 0 || n > OPM_MaxIndex) {
OPP_err(63);
@@ -279,7 +284,7 @@ static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned)
OPP_err(51);
n = 1;
}
- (*typ)->n = n;
+ (*typ)->n = OPM_Longint(n);
if (OPP_sym == 25) {
OPS_Get(&OPP_sym);
OPP_Type(&(*typ)->BaseTyp, &*banned);
@@ -302,26 +307,26 @@ static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned)
static void OPP_PointerType (OPT_Struct *typ)
{
OPT_Object id = NIL;
- *typ = OPT_NewStr(13, 1);
+ *typ = OPT_NewStr(11, 1);
OPP_CheckSysFlag(&(*typ)->sysflag, 0);
OPP_CheckSym(28);
if (OPP_sym == 38) {
OPT_Find(&id);
if (id == NIL) {
if (OPP_nofFwdPtr < 64) {
- OPP_FwdPtr[__X(OPP_nofFwdPtr, ((LONGINT)(64)))] = *typ;
+ OPP_FwdPtr[__X(OPP_nofFwdPtr, 64)] = *typ;
OPP_nofFwdPtr += 1;
} else {
OPP_err(224);
}
(*typ)->link = OPT_NewObj();
- __COPY(OPS_name, (*typ)->link->name, ((LONGINT)(256)));
+ __COPY(OPS_name, (*typ)->link->name, 256);
(*typ)->BaseTyp = OPT_undftyp;
OPS_Get(&OPP_sym);
} else {
OPP_qualident(&id);
if (id->mode == 5) {
- if (__IN(id->typ->comp, 0x1c)) {
+ if (__IN(id->typ->comp, 0x1c, 32)) {
(*typ)->BaseTyp = id->typ;
} else {
(*typ)->BaseTyp = OPT_undftyp;
@@ -334,7 +339,7 @@ static void OPP_PointerType (OPT_Struct *typ)
}
} else {
OPP_Type(&(*typ)->BaseTyp, &OPT_notyp);
- if (!__IN((*typ)->BaseTyp->comp, 0x1c)) {
+ if (!__IN((*typ)->BaseTyp->comp, 0x1c, 32)) {
(*typ)->BaseTyp = OPT_undftyp;
OPP_err(57);
}
@@ -343,7 +348,7 @@ static void OPP_PointerType (OPT_Struct *typ)
static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp)
{
- SHORTINT mode;
+ INT8 mode;
OPT_Object par = NIL, first = NIL, last = NIL, res = NIL;
OPT_Struct typ = NIL;
first = NIL;
@@ -387,6 +392,9 @@ static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp)
}
OPP_CheckSym(20);
OPP_Type(&typ, &OPT_notyp);
+ if (((typ->comp == 2 || typ->comp == 4) && typ->strobj == NIL)) {
+ OPP_err(-309);
+ }
if (mode == 1) {
typ->pvused = 1;
}
@@ -410,7 +418,7 @@ static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp)
if (OPP_sym == 38) {
OPP_qualident(&res);
if (res->mode == 5) {
- if (res->typ->form < 15) {
+ if (res->typ->form < 13) {
*resTyp = res->typ;
} else {
OPP_err(54);
@@ -460,7 +468,7 @@ static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned)
OPP_PointerType(&*typ);
} else if (OPP_sym == 61) {
OPS_Get(&OPP_sym);
- *typ = OPT_NewStr(14, 1);
+ *typ = OPT_NewStr(12, 1);
OPP_CheckSysFlag(&(*typ)->sysflag, 0);
if (OPP_sym == 30) {
OPS_Get(&OPP_sym);
@@ -489,7 +497,7 @@ static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned)
static void OPP_Type (OPT_Struct *typ, OPT_Struct *banned)
{
OPP_TypeDecl(&*typ, &*banned);
- if (((((*typ)->form == 13 && (*typ)->BaseTyp == OPT_undftyp)) && (*typ)->strobj == NIL)) {
+ if (((((*typ)->form == 11 && (*typ)->BaseTyp == OPT_undftyp)) && (*typ)->strobj == NIL)) {
OPP_err(0);
}
}
@@ -504,7 +512,7 @@ static void OPP_selector (OPT_Node *x)
if (OPP_sym == 31) {
OPS_Get(&OPP_sym);
for (;;) {
- if (((*x)->typ != NIL && (*x)->typ->form == 13)) {
+ if (((*x)->typ != NIL && (*x)->typ->form == 11)) {
OPB_DeRef(&*x);
}
OPP_Expression(&y);
@@ -519,10 +527,10 @@ static void OPP_selector (OPT_Node *x)
} else if (OPP_sym == 18) {
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
- __COPY(OPS_name, name, ((LONGINT)(256)));
+ __COPY(OPS_name, name, 256);
OPS_Get(&OPP_sym);
if ((*x)->typ != NIL) {
- if ((*x)->typ->form == 13) {
+ if ((*x)->typ->form == 11) {
OPB_DeRef(&*x);
}
if ((*x)->typ->comp == 4) {
@@ -544,7 +552,7 @@ static void OPP_selector (OPT_Node *x)
OPP_err(75);
}
typ = y->obj->typ;
- if (typ->form == 13) {
+ if (typ->form == 11) {
typ = typ->BaseTyp;
}
OPT_FindField((*x)->obj->name, typ->BaseTyp, &proc);
@@ -573,7 +581,7 @@ static void OPP_selector (OPT_Node *x)
} else if (OPP_sym == 17) {
OPS_Get(&OPP_sym);
OPB_DeRef(&*x);
- } else if ((((((OPP_sym == 30 && (*x)->class < 7)) && (*x)->typ->form != 14)) && ((*x)->obj == NIL || (*x)->obj->mode != 13))) {
+ } else if ((((((OPP_sym == 30 && (*x)->class < 7)) && (*x)->typ->form != 12)) && ((*x)->obj == NIL || (*x)->obj->mode != 13))) {
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
OPP_qualident(&obj);
@@ -624,9 +632,9 @@ static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar)
static void OPP_StandProcCall (OPT_Node *x)
{
OPT_Node y = NIL;
- SHORTINT m;
- INTEGER n;
- m = (int)(*x)->obj->adr;
+ INT8 m;
+ INT16 n;
+ m = (INT8)((INT16)(*x)->obj->adr);
n = 0;
if (OPP_sym == 30) {
OPS_Get(&OPP_sym);
@@ -743,8 +751,8 @@ static void OPP_Factor (OPT_Node *x)
*x = OPB_NewRealConst(OPS_lrlval, OPT_lrltyp);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPP.Factor, OPS.numtyp = ", (LONGINT)44);
- OPM_LogWNum(OPS_numtyp, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPP.Factor, OPS.numtyp = ", 44);
+ OPM_LogWNum(OPS_numtyp, 0);
OPM_LogWLn();
break;
}
@@ -777,7 +785,7 @@ static void OPP_Factor (OPT_Node *x)
*x = NIL;
}
if (*x == NIL) {
- *x = OPB_NewIntConst(((LONGINT)(1)));
+ *x = OPB_NewIntConst(1);
(*x)->typ = OPT_undftyp;
}
}
@@ -785,7 +793,7 @@ static void OPP_Factor (OPT_Node *x)
static void OPP_Term (OPT_Node *x)
{
OPT_Node y = NIL;
- SHORTINT mulop;
+ INT8 mulop;
OPP_Factor(&*x);
while ((1 <= OPP_sym && OPP_sym <= 5)) {
mulop = OPP_sym;
@@ -798,7 +806,7 @@ static void OPP_Term (OPT_Node *x)
static void OPP_SimpleExpression (OPT_Node *x)
{
OPT_Node y = NIL;
- SHORTINT addop;
+ INT8 addop;
if (OPP_sym == 7) {
OPS_Get(&OPP_sym);
OPP_Term(&*x);
@@ -822,7 +830,7 @@ static void OPP_Expression (OPT_Node *x)
{
OPT_Node y = NIL;
OPT_Object obj = NIL;
- SHORTINT relation;
+ INT8 relation;
OPP_SimpleExpression(&*x);
if ((9 <= OPP_sym && OPP_sym <= 14)) {
relation = OPP_sym;
@@ -848,7 +856,7 @@ static void OPP_Expression (OPT_Node *x)
}
}
-static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec)
+static void OPP_Receiver (INT8 *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec)
{
OPT_Object obj = NIL;
*typ = OPT_undftyp;
@@ -859,7 +867,7 @@ static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_St
} else {
*mode = 1;
}
- __COPY(OPS_name, name, ((LONGINT)(256)));
+ __COPY(OPS_name, name, 256);
OPP_CheckSym(38);
OPP_CheckSym(20);
if (OPP_sym == 38) {
@@ -872,10 +880,10 @@ static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_St
} else {
*typ = obj->typ;
*rec = *typ;
- if ((*rec)->form == 13) {
+ if ((*rec)->form == 11) {
*rec = (*rec)->BaseTyp;
}
- if (!((((*mode == 1 && (*typ)->form == 13)) && (*rec)->comp == 4) || (*mode == 2 && (*typ)->comp == 4))) {
+ if (!((((*mode == 1 && (*typ)->form == 11)) && (*rec)->comp == 4) || (*mode == 2 && (*typ)->comp == 4))) {
OPP_err(70);
*rec = NIL;
}
@@ -889,15 +897,14 @@ static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_St
}
OPP_CheckSym(22);
if (*rec == NIL) {
- *rec = OPT_NewStr(15, 4);
+ *rec = OPT_NewStr(13, 4);
(*rec)->BaseTyp = NIL;
}
}
static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b)
{
- BOOLEAN _o_result;
- if ((b->form == 13 && x->form == 13)) {
+ if ((b->form == 11 && x->form == 11)) {
b = b->BaseTyp;
x = x->BaseTyp;
}
@@ -906,15 +913,14 @@ static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b)
x = x->BaseTyp;
} while (!(x == NIL || x == b));
}
- _o_result = x == b;
- return _o_result;
+ return x == b;
}
static struct ProcedureDeclaration__16 {
OPT_Node *x;
OPT_Object *proc, *fwd;
OPS_Name *name;
- SHORTINT *mode, *vis;
+ INT8 *mode, *vis;
BOOLEAN *forward;
struct ProcedureDeclaration__16 *lnk;
} *ProcedureDeclaration__16_s;
@@ -927,14 +933,14 @@ static void TProcDecl__23 (void);
static void GetCode__19 (void)
{
OPT_ConstExt ext = NIL;
- INTEGER n;
- LONGINT c;
+ INT16 n;
+ INT64 c;
ext = OPT_NewExt();
(*ProcedureDeclaration__16_s->proc)->conval->ext = ext;
n = 0;
if (OPP_sym == 37) {
- while (OPS_str[__X(n, ((LONGINT)(256)))] != 0x00) {
- (*ext)[__X(n + 1, ((LONGINT)(256)))] = OPS_str[__X(n, ((LONGINT)(256)))];
+ while (OPS_str[__X(n, 256)] != 0x00) {
+ (*ext)[__X(n + 1, 256)] = OPS_str[__X(n, 256)];
n += 1;
}
(*ext)[0] = (CHAR)n;
@@ -950,7 +956,7 @@ static void GetCode__19 (void)
n = 1;
}
OPS_Get(&OPP_sym);
- (*ext)[__X(n, ((LONGINT)(256)))] = (CHAR)c;
+ (*ext)[__X(n, 256)] = (CHAR)c;
}
if (OPP_sym == 19) {
OPS_Get(&OPP_sym);
@@ -962,7 +968,7 @@ static void GetCode__19 (void)
}
}
}
- (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1);
+ (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1,64);
}
static void GetParams__21 (void)
@@ -992,9 +998,9 @@ static void GetParams__21 (void)
static void Body__17 (void)
{
OPT_Node procdec = NIL, statseq = NIL;
- LONGINT c;
+ INT32 c;
c = OPM_errpos;
- (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1);
+ (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1,64);
OPP_CheckSym(39);
OPP_Block(&procdec, &statseq);
OPB_Enter(&procdec, statseq, *ProcedureDeclaration__16_s->proc);
@@ -1015,7 +1021,7 @@ static void TProcDecl__23 (void)
{
OPT_Object baseProc = NIL;
OPT_Struct objTyp = NIL, recTyp = NIL;
- SHORTINT objMode;
+ INT8 objMode;
OPS_Name objName;
OPS_Get(&OPP_sym);
*ProcedureDeclaration__16_s->mode = 13;
@@ -1024,7 +1030,7 @@ static void TProcDecl__23 (void)
}
OPP_Receiver(&objMode, objName, &objTyp, &recTyp);
if (OPP_sym == 38) {
- __COPY(OPS_name, *ProcedureDeclaration__16_s->name, ((LONGINT)(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);
@@ -1037,7 +1043,7 @@ static void TProcDecl__23 (void)
if ((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mnolev != OPP_level)) {
*ProcedureDeclaration__16_s->fwd = NIL;
}
- if ((((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mode == 13)) && !__IN(1, (*ProcedureDeclaration__16_s->fwd)->conval->setval))) {
+ if ((((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mode == 13)) && !__IN(1, (*ProcedureDeclaration__16_s->fwd)->conval->setval, 64))) {
*ProcedureDeclaration__16_s->proc = OPT_NewObj();
(*ProcedureDeclaration__16_s->proc)->leaf = 1;
if ((*ProcedureDeclaration__16_s->fwd)->vis != *ProcedureDeclaration__16_s->vis) {
@@ -1071,7 +1077,7 @@ static void TProcDecl__23 (void)
if ((((((baseProc->vis == 1 && (*ProcedureDeclaration__16_s->proc)->vis == 0)) && recTyp->strobj != NIL)) && recTyp->strobj->vis == 1)) {
OPP_err(109);
}
- (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(2);
+ (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(2,64);
}
if (!*ProcedureDeclaration__16_s->forward) {
Body__17();
@@ -1087,7 +1093,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
{
OPT_Object proc = NIL, fwd = NIL;
OPS_Name name;
- SHORTINT mode, vis;
+ INT8 mode, vis;
BOOLEAN forward;
struct ProcedureDeclaration__16 _s;
_s.x = x;
@@ -1114,7 +1120,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
} else {
OPP_err(38);
}
- if ((__IN(mode, 0x0600) && !OPT_SYSimported)) {
+ if ((__IN(mode, 0x0600, 32) && !OPT_SYSimported)) {
OPP_err(135);
}
OPS_Get(&OPP_sym);
@@ -1123,7 +1129,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
TProcDecl__23();
} else if (OPP_sym == 38) {
OPT_Find(&fwd);
- __COPY(OPS_name, name, ((LONGINT)(256)));
+ __COPY(OPS_name, name, 256);
OPP_CheckMark(&vis);
if ((vis != 0 && mode == 6)) {
mode = 7;
@@ -1131,7 +1137,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
if ((fwd != NIL && (fwd->mnolev != OPP_level || fwd->mode == 8))) {
fwd = NIL;
}
- if ((((fwd != NIL && __IN(fwd->mode, 0xc0))) && !__IN(1, fwd->conval->setval))) {
+ if ((((fwd != NIL && __IN(fwd->mode, 0xc0, 32))) && !__IN(1, fwd->conval->setval, 64))) {
proc = OPT_NewObj();
proc->leaf = 1;
if (fwd->vis != vis) {
@@ -1164,34 +1170,34 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
ProcedureDeclaration__16_s = _s.lnk;
}
-static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab)
+static void OPP_CaseLabelList (OPT_Node *lab, OPT_Struct LabelTyp, INT16 *n, OPP_CaseTable tab)
{
OPT_Node x = NIL, y = NIL, lastlab = NIL;
- INTEGER i, f;
- LONGINT xval, yval;
+ INT16 i, f;
+ INT32 xval, yval;
*lab = NIL;
lastlab = NIL;
for (;;) {
OPP_ConstExpression(&x);
f = x->typ->form;
- if (__IN(f, 0x78)) {
- xval = x->conval->intval;
+ if (__IN(f, 0x18, 32)) {
+ xval = OPM_Longint(x->conval->intval);
} else {
OPP_err(61);
xval = 1;
}
- if (__IN(f, 0x70)) {
- if (LabelForm < f) {
+ if (f == 4) {
+ if (!(LabelTyp->form == 4) || LabelTyp->size < x->typ->size) {
OPP_err(60);
}
- } else if (LabelForm != f) {
+ } else if ((INT16)LabelTyp->form != f) {
OPP_err(60);
}
if (OPP_sym == 21) {
OPS_Get(&OPP_sym);
OPP_ConstExpression(&y);
- yval = y->conval->intval;
- if (((int)y->typ->form != f && !((__IN(f, 0x70) && __IN(y->typ->form, 0x70))))) {
+ yval = OPM_Longint(y->conval->intval);
+ if (((INT16)y->typ->form != f && !((f == 4 && y->typ->form == 4)))) {
OPP_err(60);
}
if (yval < xval) {
@@ -1208,17 +1214,17 @@ static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP
if (i == 0) {
break;
}
- if (tab[__X(i - 1, ((LONGINT)(128)))].low <= yval) {
- if (tab[__X(i - 1, ((LONGINT)(128)))].high >= xval) {
+ if (tab[__X(i - 1, 128)].low <= yval) {
+ if (tab[__X(i - 1, 128)].high >= xval) {
OPP_err(62);
}
break;
}
- tab[__X(i, ((LONGINT)(128)))] = tab[__X(i - 1, ((LONGINT)(128)))];
+ tab[__X(i, 128)] = tab[__X(i - 1, 128)];
i -= 1;
}
- tab[__X(i, ((LONGINT)(128)))].low = xval;
- tab[__X(i, ((LONGINT)(128)))].high = yval;
+ tab[__X(i, 128)].low = xval;
+ tab[__X(i, 128)].high = yval;
*n += 1;
} else {
OPP_err(213);
@@ -1235,7 +1241,7 @@ static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP
}
static struct StatSeq__30 {
- LONGINT *pos;
+ INT32 *pos;
struct StatSeq__30 *lnk;
} *StatSeq__30_s;
@@ -1245,8 +1251,8 @@ static void SetPos__35 (OPT_Node x);
static void CasePart__31 (OPT_Node *x)
{
- INTEGER n;
- LONGINT low, high;
+ INT16 n;
+ INT32 low, high;
BOOLEAN e;
OPP_CaseTable tab;
OPT_Node cases = NIL, lab = NIL, y = NIL, lastcase = NIL;
@@ -1254,7 +1260,7 @@ static void CasePart__31 (OPT_Node *x)
*StatSeq__30_s->pos = OPM_errpos;
if ((*x)->class == 8 || (*x)->class == 9) {
OPP_err(126);
- } else if (!__IN((*x)->typ->form, 0x78)) {
+ } else if (!__IN((*x)->typ->form, 0x18, 32)) {
OPP_err(125);
}
OPP_CheckSym(25);
@@ -1263,7 +1269,7 @@ static void CasePart__31 (OPT_Node *x)
n = 0;
for (;;) {
if (OPP_sym < 40) {
- OPP_CaseLabelList(&lab, (*x)->typ->form, &n, tab);
+ OPP_CaseLabelList(&lab, (*x)->typ, &n, tab);
OPP_CheckSym(20);
OPP_StatSeq(&y);
OPB_Construct(17, &lab, y);
@@ -1277,7 +1283,7 @@ static void CasePart__31 (OPT_Node *x)
}
if (n > 0) {
low = tab[0].low;
- high = tab[__X(n - 1, ((LONGINT)(128)))].high;
+ high = tab[__X(n - 1, 128)].high;
if (high - low > 512) {
OPP_err(209);
}
@@ -1329,7 +1335,7 @@ static void OPP_StatSeq (OPT_Node *stat)
OPT_Struct idtyp = NIL;
BOOLEAN e;
OPT_Node s = NIL, x = NIL, y = NIL, z = NIL, apar = NIL, last = NIL, lastif = NIL;
- LONGINT pos;
+ INT32 pos;
OPS_Name name;
struct StatSeq__30 _s;
_s.pos = &pos;
@@ -1440,7 +1446,7 @@ static void OPP_StatSeq (OPT_Node *stat)
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
OPP_qualident(&id);
- if (!__IN(id->typ->form, 0x70)) {
+ if (!(id->typ->form == 4)) {
OPP_err(68);
}
OPP_CheckSym(34);
@@ -1472,7 +1478,7 @@ static void OPP_StatSeq (OPT_Node *stat)
SetPos__35(z);
OPB_Link(&*stat, &last, z);
y = OPB_NewLeaf(t);
- } else if (y->typ->form < 4 || y->typ->form > x->left->typ->form) {
+ } else if (!(y->typ->form == 4) || y->typ->size > x->left->typ->size) {
OPP_err(113);
}
OPB_Link(&*stat, &last, x);
@@ -1480,7 +1486,7 @@ static void OPP_StatSeq (OPT_Node *stat)
OPS_Get(&OPP_sym);
OPP_ConstExpression(&z);
} else {
- z = OPB_NewIntConst(((LONGINT)(1)));
+ z = OPB_NewIntConst(1);
}
pos = OPM_errpos;
x = OPB_NewLeaf(id);
@@ -1527,7 +1533,7 @@ static void OPP_StatSeq (OPT_Node *stat)
if (OPP_sym == 38) {
OPP_qualident(&id);
y = OPB_NewLeaf(id);
- if ((((id != NIL && id->typ->form == 13)) && (id->mode == 2 || !id->leaf))) {
+ if ((((id != NIL && id->typ->form == 11)) && (id->mode == 2 || !id->leaf))) {
OPP_err(245);
}
OPP_CheckSym(20);
@@ -1622,7 +1628,7 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
OPT_Struct typ = NIL;
OPT_Object obj = NIL, first = NIL, last = NIL;
OPT_Node x = NIL, lastdec = NIL;
- INTEGER i;
+ INT16 i;
first = NIL;
last = NIL;
OPP_nofFwdPtr = 0;
@@ -1643,7 +1649,7 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
OPP_ConstExpression(&x);
} else {
OPP_err(9);
- x = OPB_NewIntConst(((LONGINT)(1)));
+ x = OPB_NewIntConst(1);
}
obj->mode = 3;
obj->typ = x->typ;
@@ -1671,10 +1677,10 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
if (obj->typ->strobj == NIL) {
obj->typ->strobj = obj;
}
- if (__IN(obj->typ->comp, 0x1c)) {
+ if (__IN(obj->typ->comp, 0x1c, 32)) {
i = 0;
while (i < OPP_nofFwdPtr) {
- typ = OPP_FwdPtr[__X(i, ((LONGINT)(64)))];
+ typ = OPP_FwdPtr[__X(i, 64)];
i += 1;
if (__STRCMP(typ->link->name, obj->name) == 0) {
typ->BaseTyp = obj->typ;
@@ -1736,10 +1742,10 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
}
i = 0;
while (i < OPP_nofFwdPtr) {
- if (OPP_FwdPtr[__X(i, ((LONGINT)(64)))]->link->name[0] != 0x00) {
+ if (OPP_FwdPtr[__X(i, 64)]->link->name[0] != 0x00) {
OPP_err(128);
}
- OPP_FwdPtr[__X(i, ((LONGINT)(64)))] = NIL;
+ OPP_FwdPtr[__X(i, 64)] = NIL;
i += 1;
}
OPT_topScope->adr = OPM_errpos;
@@ -1771,11 +1777,11 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
OPP_CheckSym(41);
}
-void OPP_Module (OPT_Node *prog, SET opt)
+void OPP_Module (OPT_Node *prog, UINT32 opt)
{
OPS_Name impName, aliasName;
OPT_Node procdec = NIL, statseq = NIL;
- LONGINT c;
+ INT32 c;
BOOLEAN done;
OPS_Init();
OPP_LoopLevel = 0;
@@ -1785,28 +1791,28 @@ void OPP_Module (OPT_Node *prog, SET opt)
OPS_Get(&OPP_sym);
} else {
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Unexpected symbol found when MODULE expected:", (LONGINT)46);
+ OPM_LogWStr((CHAR*)"Unexpected symbol found when MODULE expected:", 46);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" sym: ", (LONGINT)15);
- OPM_LogWNum(OPP_sym, ((LONGINT)(1)));
+ OPM_LogWStr((CHAR*)" sym: ", 15);
+ OPM_LogWNum(OPP_sym, 1);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.name: ", (LONGINT)15);
- OPM_LogWStr(OPS_name, ((LONGINT)(256)));
+ OPM_LogWStr((CHAR*)" OPS.name: ", 15);
+ OPM_LogWStr(OPS_name, 256);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.str: ", (LONGINT)15);
- OPM_LogWStr(OPS_str, ((LONGINT)(256)));
+ OPM_LogWStr((CHAR*)" OPS.str: ", 15);
+ OPM_LogWStr(OPS_str, 256);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.numtyp: ", (LONGINT)15);
- OPM_LogWNum(OPS_numtyp, ((LONGINT)(1)));
+ OPM_LogWStr((CHAR*)" OPS.numtyp: ", 15);
+ OPM_LogWNum(OPS_numtyp, 1);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.intval: ", (LONGINT)15);
- OPM_LogWNum(OPS_intval, ((LONGINT)(1)));
+ OPM_LogWStr((CHAR*)" OPS.intval: ", 15);
+ OPM_LogWNum(OPS_intval, 1);
OPM_LogWLn();
OPP_err(16);
}
if (OPP_sym == 38) {
- OPM_LogWStr((CHAR*)"compiling ", (LONGINT)11);
- OPM_LogWStr(OPS_name, ((LONGINT)(256)));
+ OPM_LogWStr((CHAR*)"compiling ", 11);
+ OPM_LogWStr(OPS_name, 256);
OPM_LogW('.');
OPT_Init(OPS_name, opt);
OPS_Get(&OPP_sym);
@@ -1815,13 +1821,13 @@ void OPP_Module (OPT_Node *prog, SET opt)
OPS_Get(&OPP_sym);
for (;;) {
if (OPP_sym == 38) {
- __COPY(OPS_name, aliasName, ((LONGINT)(256)));
- __COPY(aliasName, impName, ((LONGINT)(256)));
+ __COPY(OPS_name, aliasName, 256);
+ __COPY(aliasName, impName, 256);
OPS_Get(&OPP_sym);
if (OPP_sym == 34) {
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
- __COPY(OPS_name, impName, ((LONGINT)(256)));
+ __COPY(OPS_name, impName, 256);
OPS_Get(&OPP_sym);
} else {
OPP_err(38);
@@ -1876,7 +1882,7 @@ static void EnumPtrs(void (*P)(void*))
__ENUMP(OPP_FwdPtr, 64, P);
}
-__TDESC(OPP__1, 1, 0) = {__TDFLDS("", 16), {-8}};
+__TDESC(OPP__1, 1, 0) = {__TDFLDS("", 8), {-8}};
export void *OPP__init(void)
{
diff --git a/bootstrap/windows-88/OPP.h b/bootstrap/windows-88/OPP.h
index 0b3b1b2c..5a71eb39 100644
--- a/bootstrap/windows-88/OPP.h
+++ b/bootstrap/windows-88/OPP.h
@@ -1,17 +1,16 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPP__h
#define OPP__h
-#define LARGE
#include "SYSTEM.h"
#include "OPT.h"
-import void OPP_Module (OPT_Node *prog, SET opt);
+import void OPP_Module (OPT_Node *prog, UINT32 opt);
import void *OPP__init(void);
-#endif
+#endif // OPP
diff --git a/bootstrap/windows-88/OPS.c b/bootstrap/windows-88/OPS.c
index cc04e014..6ee700e5 100644
--- a/bootstrap/windows-88/OPS.c
+++ b/bootstrap/windows-88/OPS.c
@@ -1,5 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "OPM.h"
@@ -12,29 +17,29 @@ typedef
export OPS_Name OPS_name;
export OPS_String OPS_str;
-export INTEGER OPS_numtyp;
-export LONGINT OPS_intval;
+export INT16 OPS_numtyp;
+export INT64 OPS_intval;
export REAL OPS_realval;
export LONGREAL OPS_lrlval;
static CHAR OPS_ch;
-export void OPS_Get (SHORTINT *sym);
-static void OPS_Identifier (SHORTINT *sym);
+export void OPS_Get (INT8 *sym);
+static void OPS_Identifier (INT8 *sym);
export void OPS_Init (void);
static void OPS_Number (void);
-static void OPS_Str (SHORTINT *sym);
-static void OPS_err (INTEGER n);
+static void OPS_Str (INT8 *sym);
+static void OPS_err (INT16 n);
-static void OPS_err (INTEGER n)
+static void OPS_err (INT16 n)
{
OPM_err(n);
}
-static void OPS_Str (SHORTINT *sym)
+static void OPS_Str (INT8 *sym)
{
- INTEGER i;
+ INT16 i;
CHAR och;
i = 0;
och = OPS_ch;
@@ -60,15 +65,15 @@ static void OPS_Str (SHORTINT *sym)
if (OPS_intval == 2) {
*sym = 35;
OPS_numtyp = 1;
- OPS_intval = (int)OPS_str[0];
+ OPS_intval = (INT16)OPS_str[0];
} else {
*sym = 37;
}
}
-static void OPS_Identifier (SHORTINT *sym)
+static void OPS_Identifier (INT8 *sym)
{
- INTEGER i;
+ INT16 i;
i = 0;
do {
OPS_name[i] = OPS_ch;
@@ -87,12 +92,11 @@ static struct Number__6 {
struct Number__6 *lnk;
} *Number__6_s;
-static INTEGER Ord__7 (CHAR ch, BOOLEAN hex);
-static LONGREAL Ten__9 (INTEGER e);
+static INT16 Ord__7 (CHAR ch, BOOLEAN hex);
+static LONGREAL Ten__9 (INT16 e);
-static LONGREAL Ten__9 (INTEGER e)
+static LONGREAL Ten__9 (INT16 e)
{
- LONGREAL _o_result;
LONGREAL x, p;
x = (LONGREAL)1;
p = (LONGREAL)10;
@@ -105,30 +109,25 @@ static LONGREAL Ten__9 (INTEGER e)
p = p * p;
}
}
- _o_result = x;
- return _o_result;
+ return x;
}
-static INTEGER Ord__7 (CHAR ch, BOOLEAN hex)
+static INT16 Ord__7 (CHAR ch, BOOLEAN hex)
{
- INTEGER _o_result;
if (ch <= '9') {
- _o_result = (int)ch - 48;
- return _o_result;
+ return (INT16)ch - 48;
} else if (hex) {
- _o_result = ((int)ch - 65) + 10;
- return _o_result;
+ return ((INT16)ch - 65) + 10;
} else {
OPS_err(2);
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
static void OPS_Number (void)
{
- INTEGER i, m, n, d, e, maxHdig;
+ INT16 i, m, n, d, e;
CHAR dig[24];
LONGREAL f;
CHAR expCh;
@@ -174,7 +173,7 @@ static void OPS_Number (void)
OPS_numtyp = 1;
if (n <= 2) {
while (i < n) {
- OPS_intval = __ASHL(OPS_intval, 4) + (SYSTEM_INT64)Ord__7(dig[i], 1);
+ OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1);
i += 1;
}
} else {
@@ -183,13 +182,12 @@ static void OPS_Number (void)
} else if (OPS_ch == 'H') {
OPM_Get(&OPS_ch);
OPS_numtyp = 2;
- maxHdig = 16;
- if (n <= maxHdig) {
- if ((n == maxHdig && dig[0] > '7')) {
+ if (n <= 16) {
+ if ((n == 16 && dig[0] > '7')) {
OPS_intval = -1;
}
while (i < n) {
- OPS_intval = __ASHL(OPS_intval, 4) + (SYSTEM_INT64)Ord__7(dig[i], 1);
+ OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1);
i += 1;
}
} else {
@@ -200,8 +198,8 @@ static void OPS_Number (void)
while (i < n) {
d = Ord__7(dig[i], 0);
i += 1;
- if (OPS_intval <= __DIV(9223372036854775807 - (SYSTEM_INT64)d, 10)) {
- OPS_intval = OPS_intval * 10 + (SYSTEM_INT64)d;
+ if (OPS_intval <= __DIV(9223372036854775807 - (INT64)d, 10)) {
+ OPS_intval = OPS_intval * 10 + (INT64)d;
} else {
OPS_err(203);
}
@@ -232,7 +230,7 @@ static void OPS_Number (void)
do {
n = Ord__7(OPS_ch, 0);
OPM_Get(&OPS_ch);
- if (e <= __DIV(2147483647 - n, 10)) {
+ if (e <= __DIV(32767 - n, 10)) {
e = e * 10 + n;
} else {
OPS_err(203);
@@ -310,9 +308,9 @@ static void Comment__2 (void)
}
}
-void OPS_Get (SHORTINT *sym)
+void OPS_Get (INT8 *sym)
{
- SHORTINT s;
+ INT8 s;
struct Get__1 _s;
_s.lnk = Get__1_s;
Get__1_s = &_s;
@@ -320,6 +318,7 @@ void OPS_Get (SHORTINT *sym)
while (OPS_ch <= ' ') {
if (OPS_ch == 0x00) {
*sym = 64;
+ Get__1_s = _s.lnk;
return;
} else {
OPM_Get(&OPS_ch);
diff --git a/bootstrap/windows-88/OPS.h b/bootstrap/windows-88/OPS.h
index 32148c49..1f7a3e58 100644
--- a/bootstrap/windows-88/OPS.h
+++ b/bootstrap/windows-88/OPS.h
@@ -1,9 +1,8 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
#ifndef OPS__h
#define OPS__h
-#define LARGE
#include "SYSTEM.h"
typedef
@@ -15,15 +14,15 @@ typedef
import OPS_Name OPS_name;
import OPS_String OPS_str;
-import INTEGER OPS_numtyp;
-import LONGINT OPS_intval;
+import INT16 OPS_numtyp;
+import INT64 OPS_intval;
import REAL OPS_realval;
import LONGREAL OPS_lrlval;
-import void OPS_Get (SHORTINT *sym);
+import void OPS_Get (INT8 *sym);
import void OPS_Init (void);
import void *OPS__init(void);
-#endif
+#endif // OPS
diff --git a/bootstrap/windows-88/OPT.c b/bootstrap/windows-88/OPT.c
index a0d41c71..a8d42b40 100644
--- a/bootstrap/windows-88/OPT.c
+++ b/bootstrap/windows-88/OPT.c
@@ -1,5 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "OPM.h"
#include "OPS.h"
@@ -13,17 +18,18 @@ typedef
typedef
struct OPT_ConstDesc {
OPT_ConstExt ext;
- LONGINT intval, intval2;
- SET setval;
+ INT64 intval;
+ INT32 intval2;
+ UINT64 setval;
LONGREAL realval;
} OPT_ConstDesc;
typedef
struct OPT_ExpCtxt {
- LONGINT reffp;
- INTEGER ref;
- SHORTINT nofm;
- SHORTINT locmno[64];
+ INT32 reffp;
+ INT16 ref;
+ INT8 nofm;
+ INT8 locmno[64];
} OPT_ExpCtxt;
typedef
@@ -34,13 +40,13 @@ typedef
typedef
struct OPT_ImpCtxt {
- LONGINT nextTag, reffp;
- INTEGER nofr, minr, nofm;
+ INT32 nextTag, reffp;
+ INT16 nofr, minr, nofm;
BOOLEAN self;
OPT_Struct ref[255];
OPT_Object old[255];
- LONGINT pvfp[255];
- SHORTINT glbmno[64];
+ INT32 pvfp[255];
+ INT8 glbmno[64];
} OPT_ImpCtxt;
typedef
@@ -49,7 +55,7 @@ typedef
typedef
struct OPT_NodeDesc {
OPT_Node left, right, link;
- SHORTINT class, subcl;
+ INT8 class, subcl;
BOOLEAN readonly;
OPT_Struct typ;
OPT_Object obj;
@@ -61,120 +67,319 @@ typedef
OPT_Object left, right, link, scope;
OPS_Name name;
BOOLEAN leaf;
- SHORTINT mode, mnolev, vis, history;
+ INT8 mode, mnolev, vis, history;
BOOLEAN used, fpdone;
- LONGINT fprint;
+ INT32 fprint;
OPT_Struct typ;
OPT_Const conval;
- LONGINT adr, linkadr;
- INTEGER x;
+ INT32 adr, linkadr;
+ INT16 x;
} OPT_ObjDesc;
typedef
struct OPT_StrDesc {
- SHORTINT form, comp, mno, extlev;
- INTEGER ref, sysflag;
- LONGINT n, size, align, txtpos;
+ INT8 form, comp, mno, extlev;
+ INT16 ref, sysflag;
+ INT32 n, size, align, txtpos;
BOOLEAN allocated, pbused, pvused, fpdone, idfpdone;
- LONGINT idfp, pbfp, pvfp;
+ INT32 idfp, pbfp, pvfp;
OPT_Struct BaseTyp;
OPT_Object link, strobj;
} OPT_StrDesc;
-export void (*OPT_typSize)(OPT_Struct);
export OPT_Object OPT_topScope;
-export OPT_Struct OPT_undftyp, OPT_bytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_realtyp, OPT_lrltyp, OPT_settyp, OPT_stringtyp, OPT_niltyp, OPT_notyp, OPT_sysptrtyp;
-export SHORTINT OPT_nofGmod;
+export OPT_Struct OPT_undftyp, OPT_niltyp, OPT_notyp, OPT_bytetyp, OPT_cpbytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_hinttyp, OPT_int8typ, OPT_int16typ, OPT_int32typ, OPT_int64typ, OPT_settyp, OPT_set32typ, OPT_set64typ, OPT_realtyp, OPT_lrltyp, OPT_stringtyp, OPT_adrtyp, OPT_sysptrtyp;
+export OPT_Object OPT_sintobj, OPT_intobj, OPT_lintobj, OPT_setobj;
+export INT8 OPT_nofGmod;
export OPT_Object OPT_GlbMod[64];
export OPS_Name OPT_SelfName;
export BOOLEAN OPT_SYSimported;
static OPT_Object OPT_universe, OPT_syslink;
static OPT_ImpCtxt OPT_impCtxt;
static OPT_ExpCtxt OPT_expCtxt;
-static LONGINT OPT_nofhdfld;
+static INT32 OPT_nofhdfld;
static BOOLEAN OPT_newsf, OPT_findpc, OPT_extsf, OPT_sfpresent, OPT_symExtended, OPT_symNew;
+static INT32 OPT_recno;
-export LONGINT *OPT_ConstDesc__typ;
-export LONGINT *OPT_ObjDesc__typ;
-export LONGINT *OPT_StrDesc__typ;
-export LONGINT *OPT_NodeDesc__typ;
-export LONGINT *OPT_ImpCtxt__typ;
-export LONGINT *OPT_ExpCtxt__typ;
+export ADDRESS *OPT_ConstDesc__typ;
+export ADDRESS *OPT_ObjDesc__typ;
+export ADDRESS *OPT_StrDesc__typ;
+export ADDRESS *OPT_NodeDesc__typ;
+export ADDRESS *OPT_ImpCtxt__typ;
+export ADDRESS *OPT_ExpCtxt__typ;
+export void OPT_Align (INT32 *adr, INT32 base);
+export INT32 OPT_BaseAlignment (OPT_Struct typ);
export void OPT_Close (void);
export void OPT_CloseScope (void);
static void OPT_DebugStruct (OPT_Struct btyp);
-static void OPT_EnterBoolConst (OPS_Name name, LONGINT value);
-static void OPT_EnterProc (OPS_Name name, INTEGER num);
-static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct *res);
+static void OPT_EnterBoolConst (OPS_Name name, INT32 value);
+static void OPT_EnterProc (OPS_Name name, INT16 num);
+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, INTEGER errcode);
-static void OPT_FPrintName (LONGINT *fp, CHAR *name, LONGINT name__len);
+export void OPT_FPrintErr (OPT_Object obj, INT16 errcode);
+static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len);
export void OPT_FPrintObj (OPT_Object obj);
-static void OPT_FPrintSign (LONGINT *fp, OPT_Struct result, OPT_Object par);
+static void OPT_FPrintSign (INT32 *fp, OPT_Struct result, OPT_Object par);
export void OPT_FPrintStr (OPT_Struct typ);
export void OPT_Find (OPT_Object *res);
export void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res);
export void OPT_FindImport (OPT_Object mod, OPT_Object *res);
export void OPT_IdFPrint (OPT_Struct typ);
export void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done);
-static void OPT_InConstant (LONGINT f, OPT_Const conval);
+static void OPT_InConstant (INT32 f, OPT_Const conval);
static OPT_Object OPT_InFld (void);
-static void OPT_InMod (SHORTINT *mno);
+static void OPT_InMod (INT8 *mno);
static void OPT_InName (CHAR *name, LONGINT name__len);
-static OPT_Object OPT_InObj (SHORTINT mno);
-static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par);
+static 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);
-static OPT_Object OPT_InTProc (SHORTINT mno);
-export void OPT_Init (OPS_Name name, SET opt);
-static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form);
+static OPT_Object OPT_InTProc (INT8 mno);
+static OPT_Struct OPT_InTyp (INT32 tag);
+export void OPT_Init (OPS_Name name, UINT32 opt);
+export void OPT_InitRecno (void);
+static void OPT_InitStruct (OPT_Struct *typ, INT8 form);
export void OPT_Insert (OPS_Name name, OPT_Object *obj);
export void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old);
+export INT16 OPT_IntSize (INT64 n);
+export OPT_Struct OPT_IntType (INT32 size);
export OPT_Const OPT_NewConst (void);
export OPT_ConstExt OPT_NewExt (void);
-export OPT_Node OPT_NewNode (SHORTINT class);
+export OPT_Node OPT_NewNode (INT8 class);
export OPT_Object OPT_NewObj (void);
-export OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp);
-export void OPT_OpenScope (SHORTINT level, OPT_Object owner);
+export OPT_Struct OPT_NewStr (INT8 form, INT8 comp);
+export void OPT_OpenScope (INT8 level, OPT_Object owner);
static void OPT_OutConstant (OPT_Object obj);
-static void OPT_OutFlds (OPT_Object fld, LONGINT adr, BOOLEAN visible);
-static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr);
-static void OPT_OutMod (INTEGER mno);
+static void OPT_OutFlds (OPT_Object fld, INT32 adr, BOOLEAN visible);
+static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr);
+static void OPT_OutMod (INT16 mno);
static void OPT_OutName (CHAR *name, LONGINT name__len);
static void OPT_OutObj (OPT_Object obj);
static void OPT_OutSign (OPT_Struct result, OPT_Object par);
static void OPT_OutStr (OPT_Struct typ);
static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj);
-static void OPT_err (INTEGER n);
+export OPT_Struct OPT_SetType (INT32 size);
+export OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir);
+export INT32 OPT_SizeAlignment (INT32 size);
+export void OPT_TypSize (OPT_Struct typ);
+static void OPT_err (INT16 n);
-static void OPT_err (INTEGER n)
+void OPT_InitRecno (void)
+{
+ OPT_recno = 0;
+}
+
+static void OPT_err (INT16 n)
{
OPM_err(n);
}
+INT16 OPT_IntSize (INT64 n)
+{
+ INT16 bytes;
+ if (n < 0) {
+ n = -(n + 1);
+ }
+ bytes = 1;
+ while ((bytes < 8 && __ASH(n, -(__ASHL(bytes, 3) - 1)) != 0)) {
+ bytes += 1;
+ }
+ return bytes;
+}
+
+OPT_Struct OPT_IntType (INT32 size)
+{
+ if (size <= OPT_int8typ->size) {
+ return OPT_int8typ;
+ }
+ if (size <= OPT_int16typ->size) {
+ return OPT_int16typ;
+ }
+ if (size <= OPT_int32typ->size) {
+ return OPT_int32typ;
+ }
+ return OPT_int64typ;
+}
+
+OPT_Struct OPT_SetType (INT32 size)
+{
+ if (size == OPT_set32typ->size) {
+ return OPT_set32typ;
+ }
+ return OPT_set64typ;
+}
+
+OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir)
+{
+ INT16 i;
+ __ASSERT(x->form == 4, 0);
+ __ASSERT(x->BaseTyp == OPT_undftyp, 0);
+ __ASSERT(dir == 1 || dir == -1, 0);
+ if (dir > 0) {
+ if (x->size < OPT_sinttyp->size) {
+ return OPT_sinttyp;
+ }
+ if (x->size < OPT_inttyp->size) {
+ return OPT_inttyp;
+ }
+ if (x->size < OPT_linttyp->size) {
+ return OPT_linttyp;
+ }
+ return OPT_int64typ;
+ } else {
+ if (x->size > OPT_linttyp->size) {
+ return OPT_linttyp;
+ }
+ if (x->size > OPT_inttyp->size) {
+ return OPT_inttyp;
+ }
+ if (x->size > OPT_sinttyp->size) {
+ return OPT_sinttyp;
+ }
+ return OPT_int8typ;
+ }
+ __RETCHK;
+}
+
+void OPT_Align (INT32 *adr, INT32 base)
+{
+ switch (base) {
+ case 2:
+ *adr += __MASK(*adr, -2);
+ break;
+ case 4:
+ *adr += __MASK(-*adr, -4);
+ break;
+ case 8:
+ *adr += __MASK(-*adr, -8);
+ break;
+ case 16:
+ *adr += __MASK(-*adr, -16);
+ break;
+ default:
+ break;
+ }
+}
+
+INT32 OPT_SizeAlignment (INT32 size)
+{
+ INT32 alignment;
+ if (size < OPM_Alignment) {
+ alignment = 1;
+ while (alignment < size) {
+ alignment = __ASHL(alignment, 1);
+ }
+ } else {
+ alignment = OPM_Alignment;
+ }
+ return alignment;
+}
+
+INT32 OPT_BaseAlignment (OPT_Struct typ)
+{
+ INT32 alignment;
+ if (typ->form == 13) {
+ if (typ->comp == 4) {
+ alignment = __MASK(typ->align, -65536);
+ } else {
+ alignment = OPT_BaseAlignment(typ->BaseTyp);
+ }
+ } else {
+ alignment = OPT_SizeAlignment(typ->size);
+ }
+ return alignment;
+}
+
+void OPT_TypSize (OPT_Struct typ)
+{
+ INT16 f, c;
+ INT32 offset, size, base, fbase, off0;
+ OPT_Object fld = NIL;
+ OPT_Struct btyp = NIL;
+ if (typ == OPT_undftyp) {
+ OPM_err(58);
+ } else if (typ->size == -1) {
+ f = typ->form;
+ c = typ->comp;
+ if (c == 4) {
+ btyp = typ->BaseTyp;
+ if (btyp == NIL) {
+ offset = 0;
+ base = 1;
+ } else {
+ OPT_TypSize(btyp);
+ offset = btyp->size - __ASHR(btyp->sysflag, 8);
+ base = btyp->align;
+ }
+ fld = typ->link;
+ while ((fld != NIL && fld->mode == 4)) {
+ btyp = fld->typ;
+ OPT_TypSize(btyp);
+ size = btyp->size;
+ fbase = OPT_BaseAlignment(btyp);
+ OPT_Align(&offset, fbase);
+ fld->adr = offset;
+ offset += size;
+ if (fbase > base) {
+ base = fbase;
+ }
+ fld = fld->link;
+ }
+ off0 = offset;
+ if (offset == 0) {
+ offset = 1;
+ }
+ OPT_Align(&offset, base);
+ if ((typ->strobj == NIL && __MASK(typ->align, -65536) == 0)) {
+ OPT_recno += 1;
+ base += __ASHL(OPT_recno, 16);
+ }
+ typ->size = offset;
+ typ->align = base;
+ 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;
+ } else if (f == 11) {
+ typ->size = OPM_AddressSize;
+ if (typ->BaseTyp == OPT_undftyp) {
+ OPM_Mark(128, typ->n);
+ } else {
+ OPT_TypSize(typ->BaseTyp);
+ }
+ } else if (f == 12) {
+ typ->size = OPM_AddressSize;
+ } else if (c == 3) {
+ btyp = typ->BaseTyp;
+ OPT_TypSize(btyp);
+ if (btyp->comp == 3) {
+ typ->size = btyp->size + 4;
+ } else {
+ typ->size = 8;
+ }
+ }
+ }
+}
+
OPT_Const OPT_NewConst (void)
{
- OPT_Const _o_result;
OPT_Const const_ = NIL;
__NEW(const_, OPT_ConstDesc);
- _o_result = const_;
- return _o_result;
+ return const_;
}
OPT_Object OPT_NewObj (void)
{
- OPT_Object _o_result;
OPT_Object obj = NIL;
__NEW(obj, OPT_ObjDesc);
- _o_result = obj;
- return _o_result;
+ return obj;
}
-OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp)
+OPT_Struct OPT_NewStr (INT8 form, INT8 comp)
{
- OPT_Struct _o_result;
OPT_Struct typ = NIL;
__NEW(typ, OPT_StrDesc);
typ->form = form;
@@ -185,30 +390,25 @@ OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp)
}
typ->size = -1;
typ->BaseTyp = OPT_undftyp;
- _o_result = typ;
- return _o_result;
+ return typ;
}
-OPT_Node OPT_NewNode (SHORTINT class)
+OPT_Node OPT_NewNode (INT8 class)
{
- OPT_Node _o_result;
OPT_Node node = NIL;
__NEW(node, OPT_NodeDesc);
node->class = class;
- _o_result = node;
- return _o_result;
+ return node;
}
OPT_ConstExt OPT_NewExt (void)
{
- OPT_ConstExt _o_result;
OPT_ConstExt ext = NIL;
- ext = __NEWARR(NIL, ((LONGINT)(1)), 1, 1, 0, (LONGINT)256);
- _o_result = ext;
- return _o_result;
+ ext = __NEWARR(NIL, 1, 1, 1, 0, ((INT64)(256)));
+ return ext;
}
-void OPT_OpenScope (SHORTINT level, OPT_Object owner)
+void OPT_OpenScope (INT8 level, OPT_Object owner)
{
OPT_Object head = NIL;
head = OPT_NewObj();
@@ -229,34 +429,34 @@ void OPT_CloseScope (void)
OPT_topScope = OPT_topScope->left;
}
-void OPT_Init (OPS_Name name, SET opt)
+void OPT_Init (OPS_Name name, UINT32 opt)
{
OPT_topScope = OPT_universe;
OPT_OpenScope(0, NIL);
OPT_SYSimported = 0;
- __COPY(name, OPT_SelfName, ((LONGINT)(256)));
- __COPY(name, OPT_topScope->name, ((LONGINT)(256)));
+ __COPY(name, OPT_SelfName, 256);
+ __COPY(name, OPT_topScope->name, 256);
OPT_GlbMod[0] = OPT_topScope;
OPT_nofGmod = 1;
- OPT_newsf = __IN(4, opt);
- OPT_findpc = __IN(8, opt);
- OPT_extsf = OPT_newsf || __IN(9, opt);
+ OPT_newsf = __IN(4, opt, 32);
+ OPT_findpc = __IN(8, opt, 32);
+ OPT_extsf = OPT_newsf || __IN(9, opt, 32);
OPT_sfpresent = 1;
}
void OPT_Close (void)
{
- INTEGER i;
+ INT16 i;
OPT_CloseScope();
i = 0;
while (i < 64) {
- OPT_GlbMod[__X(i, ((LONGINT)(64)))] = NIL;
+ OPT_GlbMod[__X(i, 64)] = NIL;
i += 1;
}
- i = 16;
+ i = 14;
while (i < 255) {
- OPT_impCtxt.ref[__X(i, ((LONGINT)(255)))] = NIL;
- OPT_impCtxt.old[__X(i, ((LONGINT)(255)))] = NIL;
+ OPT_impCtxt.ref[__X(i, 255)] = NIL;
+ OPT_impCtxt.old[__X(i, 255)] = NIL;
i += 1;
}
}
@@ -338,7 +538,7 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
{
OPT_Object ob0 = NIL, ob1 = NIL;
BOOLEAN left;
- SHORTINT mnolev;
+ INT8 mnolev;
ob0 = OPT_topScope;
ob1 = ob0->right;
left = 0;
@@ -367,7 +567,7 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
}
ob1->left = NIL;
ob1->right = NIL;
- __COPY(name, ob1->name, ((LONGINT)(256)));
+ __COPY(name, ob1->name, 256);
mnolev = OPT_topScope->mnolev;
ob1->mnolev = mnolev;
break;
@@ -376,14 +576,14 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
*obj = ob1;
}
-static void OPT_FPrintName (LONGINT *fp, CHAR *name, LONGINT name__len)
+static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len)
{
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
do {
ch = name[__X(i, name__len)];
- OPM_FPrint(&*fp, (int)ch);
+ OPM_FPrint(&*fp, (INT16)ch);
i += 1;
} while (!(ch == 0x00));
}
@@ -392,36 +592,36 @@ static void OPT_DebugStruct (OPT_Struct btyp)
{
OPM_LogWLn();
if (btyp == NIL) {
- OPM_LogWStr((CHAR*)"btyp is nil", (LONGINT)12);
+ OPM_LogWStr((CHAR*)"btyp is nil", 12);
OPM_LogWLn();
}
- OPM_LogWStr((CHAR*)"btyp^.strobji^.name = ", (LONGINT)23);
- OPM_LogWStr(btyp->strobj->name, ((LONGINT)(256)));
+ OPM_LogWStr((CHAR*)"btyp^.strobji^.name = ", 23);
+ OPM_LogWStr(btyp->strobj->name, 256);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.form = ", (LONGINT)14);
- OPM_LogWNum(btyp->form, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.form = ", 14);
+ OPM_LogWNum(btyp->form, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.comp = ", (LONGINT)14);
- OPM_LogWNum(btyp->comp, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.comp = ", 14);
+ OPM_LogWNum(btyp->comp, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.mno = ", (LONGINT)13);
- OPM_LogWNum(btyp->mno, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.mno = ", 13);
+ OPM_LogWNum(btyp->mno, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.extlev = ", (LONGINT)16);
- OPM_LogWNum(btyp->extlev, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.extlev = ", 16);
+ OPM_LogWNum(btyp->extlev, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.size = ", (LONGINT)14);
- OPM_LogWNum(btyp->size, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.size = ", 14);
+ OPM_LogWNum(btyp->size, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.align = ", (LONGINT)15);
- OPM_LogWNum(btyp->align, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.align = ", 15);
+ OPM_LogWNum(btyp->align, 0);
OPM_LogWLn();
- OPM_LogWStr((CHAR*)"btyp^.txtpos = ", (LONGINT)16);
- OPM_LogWNum(btyp->txtpos, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"btyp^.txtpos = ", 16);
+ OPM_LogWNum(btyp->txtpos, 0);
OPM_LogWLn();
}
-static void OPT_FPrintSign (LONGINT *fp, OPT_Struct result, OPT_Object par)
+static void OPT_FPrintSign (INT32 *fp, OPT_Struct result, OPT_Object par)
{
OPT_IdFPrint(result);
OPM_FPrint(&*fp, result->idfp);
@@ -437,50 +637,53 @@ void OPT_IdFPrint (OPT_Struct typ)
{
OPT_Struct btyp = NIL;
OPT_Object strobj = NIL;
- LONGINT idfp;
- INTEGER f, c;
+ INT32 idfp;
+ INT16 f, c;
if (!typ->idfpdone) {
typ->idfpdone = 1;
idfp = 0;
f = typ->form;
- c = typ->comp;
OPM_FPrint(&idfp, f);
+ if (__IN(f, 0x90, 32)) {
+ OPM_FPrint(&idfp, typ->size);
+ }
+ c = typ->comp;
OPM_FPrint(&idfp, c);
btyp = typ->BaseTyp;
strobj = typ->strobj;
if ((strobj != NIL && strobj->name[0] != 0x00)) {
- OPT_FPrintName(&idfp, (void*)OPT_GlbMod[__X(typ->mno, ((LONGINT)(64)))]->name, ((LONGINT)(256)));
- OPT_FPrintName(&idfp, (void*)strobj->name, ((LONGINT)(256)));
+ OPT_FPrintName(&idfp, (void*)OPT_GlbMod[__X(typ->mno, 64)]->name, 256);
+ OPT_FPrintName(&idfp, (void*)strobj->name, 256);
}
- if ((f == 13 || (c == 4 && btyp != NIL)) || c == 3) {
+ if ((f == 11 || (c == 4 && btyp != NIL)) || c == 3) {
OPT_IdFPrint(btyp);
OPM_FPrint(&idfp, btyp->idfp);
} else if (c == 2) {
OPT_IdFPrint(btyp);
OPM_FPrint(&idfp, btyp->idfp);
OPM_FPrint(&idfp, typ->n);
- } else if (f == 14) {
+ } else if (f == 12) {
OPT_FPrintSign(&idfp, btyp, typ->link);
}
typ->idfp = idfp;
}
}
-static struct FPrintStr__12 {
- LONGINT *pbfp, *pvfp;
- struct FPrintStr__12 *lnk;
-} *FPrintStr__12_s;
+static struct FPrintStr__15 {
+ INT32 *pbfp, *pvfp;
+ struct FPrintStr__15 *lnk;
+} *FPrintStr__15_s;
-static void FPrintFlds__13 (OPT_Object fld, LONGINT adr, BOOLEAN visible);
-static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr);
-static void FPrintTProcs__17 (OPT_Object obj);
+static void FPrintFlds__16 (OPT_Object fld, INT32 adr, BOOLEAN visible);
+static void FPrintHdFld__18 (OPT_Struct typ, OPT_Object fld, INT32 adr);
+static void FPrintTProcs__20 (OPT_Object obj);
-static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr)
+static void FPrintHdFld__18 (OPT_Struct typ, OPT_Object fld, INT32 adr)
{
- LONGINT i, j, n;
+ INT32 i, j, n;
OPT_Struct btyp = NIL;
if (typ->comp == 4) {
- FPrintFlds__13(typ->link, adr, 0);
+ FPrintFlds__16(typ->link, adr, 0);
} else if (typ->comp == 2) {
btyp = typ->BaseTyp;
n = typ->n;
@@ -488,69 +691,69 @@ static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr)
n = btyp->n * n;
btyp = btyp->BaseTyp;
}
- if (btyp->form == 13 || btyp->comp == 4) {
+ if (btyp->form == 11 || btyp->comp == 4) {
j = OPT_nofhdfld;
- FPrintHdFld__15(btyp, fld, adr);
+ FPrintHdFld__18(btyp, fld, adr);
if (j != OPT_nofhdfld) {
i = 1;
while ((i < n && OPT_nofhdfld <= 2048)) {
adr += btyp->size;
- FPrintHdFld__15(btyp, fld, adr);
+ FPrintHdFld__18(btyp, fld, adr);
i += 1;
}
}
}
- } else if (typ->form == 13 || __STRCMP(fld->name, "@ptr") == 0) {
- OPM_FPrint(&*FPrintStr__12_s->pvfp, ((LONGINT)(13)));
- OPM_FPrint(&*FPrintStr__12_s->pvfp, adr);
+ } else if (typ->form == 11 || __STRCMP(fld->name, "@ptr") == 0) {
+ OPM_FPrint(&*FPrintStr__15_s->pvfp, 11);
+ OPM_FPrint(&*FPrintStr__15_s->pvfp, adr);
OPT_nofhdfld += 1;
}
}
-static void FPrintFlds__13 (OPT_Object fld, LONGINT adr, BOOLEAN visible)
+static void FPrintFlds__16 (OPT_Object fld, INT32 adr, BOOLEAN visible)
{
while ((fld != NIL && fld->mode == 4)) {
if ((fld->vis != 0 && visible)) {
- OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->vis);
- OPT_FPrintName(&*FPrintStr__12_s->pbfp, (void*)fld->name, ((LONGINT)(256)));
- OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->adr);
+ OPM_FPrint(&*FPrintStr__15_s->pbfp, fld->vis);
+ OPT_FPrintName(&*FPrintStr__15_s->pbfp, (void*)fld->name, 256);
+ OPM_FPrint(&*FPrintStr__15_s->pbfp, fld->adr);
OPT_FPrintStr(fld->typ);
- OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->typ->pbfp);
- OPM_FPrint(&*FPrintStr__12_s->pvfp, fld->typ->pvfp);
+ OPM_FPrint(&*FPrintStr__15_s->pbfp, fld->typ->pbfp);
+ OPM_FPrint(&*FPrintStr__15_s->pvfp, fld->typ->pvfp);
} else {
- FPrintHdFld__15(fld->typ, fld, fld->adr + adr);
+ FPrintHdFld__18(fld->typ, fld, fld->adr + adr);
}
fld = fld->link;
}
}
-static void FPrintTProcs__17 (OPT_Object obj)
+static void FPrintTProcs__20 (OPT_Object obj)
{
if (obj != NIL) {
- FPrintTProcs__17(obj->left);
+ FPrintTProcs__20(obj->left);
if (obj->mode == 13) {
if (obj->vis != 0) {
- OPM_FPrint(&*FPrintStr__12_s->pbfp, ((LONGINT)(13)));
- OPM_FPrint(&*FPrintStr__12_s->pbfp, __ASHR(obj->adr, 16));
- OPT_FPrintSign(&*FPrintStr__12_s->pbfp, obj->typ, obj->link);
- OPT_FPrintName(&*FPrintStr__12_s->pbfp, (void*)obj->name, ((LONGINT)(256)));
+ OPM_FPrint(&*FPrintStr__15_s->pbfp, 13);
+ OPM_FPrint(&*FPrintStr__15_s->pbfp, __ASHR(obj->adr, 16));
+ OPT_FPrintSign(&*FPrintStr__15_s->pbfp, obj->typ, obj->link);
+ OPT_FPrintName(&*FPrintStr__15_s->pbfp, (void*)obj->name, 256);
}
}
- FPrintTProcs__17(obj->right);
+ FPrintTProcs__20(obj->right);
}
}
void OPT_FPrintStr (OPT_Struct typ)
{
- INTEGER f, c;
+ INT16 f, c;
OPT_Struct btyp = NIL;
OPT_Object strobj = NIL, bstrobj = NIL;
- LONGINT pbfp, pvfp;
- struct FPrintStr__12 _s;
+ INT32 pbfp, pvfp;
+ struct FPrintStr__15 _s;
_s.pbfp = &pbfp;
_s.pvfp = &pvfp;
- _s.lnk = FPrintStr__12_s;
- FPrintStr__12_s = &_s;
+ _s.lnk = FPrintStr__15_s;
+ FPrintStr__15_s = &_s;
if (!typ->fpdone) {
OPT_IdFPrint(typ);
pbfp = typ->idfp;
@@ -564,7 +767,7 @@ void OPT_FPrintStr (OPT_Struct typ)
f = typ->form;
c = typ->comp;
btyp = typ->BaseTyp;
- if (f == 13) {
+ if (f == 11) {
strobj = typ->strobj;
bstrobj = btyp->strobj;
if (((strobj == NIL || strobj->name[0] == 0x00) || bstrobj == NIL) || bstrobj->name[0] == 0x00) {
@@ -572,8 +775,8 @@ void OPT_FPrintStr (OPT_Struct typ)
OPM_FPrint(&pbfp, btyp->pbfp);
pvfp = pbfp;
}
- } else if (f == 14) {
- } else if (__IN(c, 0x0c)) {
+ } else if (f == 12) {
+ } else if (__IN(c, 0x0c, 32)) {
OPT_FPrintStr(btyp);
OPM_FPrint(&pbfp, btyp->pvfp);
pvfp = pbfp;
@@ -587,11 +790,11 @@ void OPT_FPrintStr (OPT_Struct typ)
OPM_FPrint(&pvfp, typ->align);
OPM_FPrint(&pvfp, typ->n);
OPT_nofhdfld = 0;
- FPrintFlds__13(typ->link, ((LONGINT)(0)), 1);
+ FPrintFlds__16(typ->link, 0, 1);
if (OPT_nofhdfld > 2048) {
OPM_Mark(225, typ->txtpos);
}
- FPrintTProcs__17(typ->link);
+ FPrintTProcs__20(typ->link);
OPM_FPrint(&pvfp, pbfp);
strobj = typ->strobj;
if (strobj == NIL || strobj->name[0] == 0x00) {
@@ -601,13 +804,13 @@ void OPT_FPrintStr (OPT_Struct typ)
typ->pbfp = pbfp;
typ->pvfp = pvfp;
}
- FPrintStr__12_s = _s.lnk;
+ FPrintStr__15_s = _s.lnk;
}
void OPT_FPrintObj (OPT_Object obj)
{
- LONGINT fprint;
- INTEGER f, m;
+ INT32 fprint;
+ INT16 f, m;
REAL rval;
OPT_ConstExt ext = NIL;
if (!obj->fpdone) {
@@ -618,23 +821,23 @@ void OPT_FPrintObj (OPT_Object obj)
f = obj->typ->form;
OPM_FPrint(&fprint, f);
switch (f) {
- case 2: case 3: case 4: case 5: case 6:
+ case 2: case 3: case 4:
OPM_FPrint(&fprint, obj->conval->intval);
break;
- case 9:
+ case 7:
OPM_FPrintSet(&fprint, obj->conval->setval);
break;
- case 7:
+ case 5:
rval = obj->conval->realval;
OPM_FPrintReal(&fprint, rval);
break;
- case 8:
+ case 6:
OPM_FPrintLReal(&fprint, obj->conval->realval);
break;
- case 10:
- OPT_FPrintName(&fprint, (void*)*obj->conval->ext, ((LONGINT)(256)));
+ case 8:
+ OPT_FPrintName(&fprint, (void*)*obj->conval->ext, 256);
break;
- case 11:
+ case 9:
break;
default:
OPT_err(127);
@@ -644,16 +847,16 @@ void OPT_FPrintObj (OPT_Object obj)
OPM_FPrint(&fprint, obj->vis);
OPT_FPrintStr(obj->typ);
OPM_FPrint(&fprint, obj->typ->pbfp);
- } else if (__IN(obj->mode, 0x0480)) {
+ } else if (__IN(obj->mode, 0x0480, 32)) {
OPT_FPrintSign(&fprint, obj->typ, obj->link);
} else if (obj->mode == 9) {
OPT_FPrintSign(&fprint, obj->typ, obj->link);
ext = obj->conval->ext;
- m = (int)(*ext)[0];
+ m = (INT16)(*ext)[0];
f = 1;
OPM_FPrint(&fprint, m);
while (f <= m) {
- OPM_FPrint(&fprint, (int)(*ext)[__X(f, ((LONGINT)(256)))]);
+ OPM_FPrint(&fprint, (INT16)(*ext)[__X(f, 256)]);
f += 1;
}
} else if (obj->mode == 5) {
@@ -664,27 +867,27 @@ void OPT_FPrintObj (OPT_Object obj)
}
}
-void OPT_FPrintErr (OPT_Object obj, INTEGER errcode)
+void OPT_FPrintErr (OPT_Object obj, INT16 errcode)
{
- INTEGER i, j;
+ INT16 i, j;
CHAR ch;
if (obj->mnolev != 0) {
- __COPY(OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, OPM_objname, ((LONGINT)(64)));
+ __COPY(OPT_GlbMod[__X(-obj->mnolev, 64)]->name, OPM_objname, 64);
i = 0;
- while (OPM_objname[__X(i, ((LONGINT)(64)))] != 0x00) {
+ while (OPM_objname[__X(i, 64)] != 0x00) {
i += 1;
}
- OPM_objname[__X(i, ((LONGINT)(64)))] = '.';
+ OPM_objname[__X(i, 64)] = '.';
j = 0;
i += 1;
do {
- ch = obj->name[__X(j, ((LONGINT)(256)))];
- OPM_objname[__X(i, ((LONGINT)(64)))] = ch;
+ ch = obj->name[__X(j, 256)];
+ OPM_objname[__X(i, 64)] = ch;
j += 1;
i += 1;
} while (!(ch == 0x00));
} else {
- __COPY(obj->name, OPM_objname, ((LONGINT)(64)));
+ __COPY(obj->name, OPM_objname, 64);
}
if (errcode == 249) {
if (OPM_noerr) {
@@ -756,7 +959,7 @@ void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old)
static void OPT_InName (CHAR *name, LONGINT name__len)
{
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
do {
@@ -766,23 +969,23 @@ static void OPT_InName (CHAR *name, LONGINT name__len)
} while (!(ch == 0x00));
}
-static void OPT_InMod (SHORTINT *mno)
+static void OPT_InMod (INT8 *mno)
{
OPT_Object head = NIL;
OPS_Name name;
- LONGINT mn;
- SHORTINT i;
+ INT32 mn;
+ INT8 i;
mn = OPM_SymRInt();
if (mn == 0) {
*mno = OPT_impCtxt.glbmno[0];
} else {
if (mn == 16) {
- OPT_InName((void*)name, ((LONGINT)(256)));
+ OPT_InName((void*)name, 256);
if ((__STRCMP(name, OPT_SelfName) == 0 && !OPT_impCtxt.self)) {
OPT_err(154);
}
i = 0;
- while ((i < OPT_nofGmod && __STRCMP(name, OPT_GlbMod[__X(i, ((LONGINT)(64)))]->name) != 0)) {
+ while ((i < OPT_nofGmod && __STRCMP(name, OPT_GlbMod[__X(i, 64)]->name) != 0)) {
i += 1;
}
if (i < OPT_nofGmod) {
@@ -790,77 +993,77 @@ static void OPT_InMod (SHORTINT *mno)
} else {
head = OPT_NewObj();
head->mode = 12;
- __COPY(name, head->name, ((LONGINT)(256)));
+ __COPY(name, head->name, 256);
*mno = OPT_nofGmod;
head->mnolev = -*mno;
if (OPT_nofGmod < 64) {
- OPT_GlbMod[__X(*mno, ((LONGINT)(64)))] = head;
+ OPT_GlbMod[__X(*mno, 64)] = head;
OPT_nofGmod += 1;
} else {
OPT_err(227);
}
}
- OPT_impCtxt.glbmno[__X(OPT_impCtxt.nofm, ((LONGINT)(64)))] = *mno;
+ OPT_impCtxt.glbmno[__X(OPT_impCtxt.nofm, 64)] = *mno;
OPT_impCtxt.nofm += 1;
} else {
- *mno = OPT_impCtxt.glbmno[__X(-mn, ((LONGINT)(64)))];
+ *mno = OPT_impCtxt.glbmno[__X(-mn, 64)];
}
}
}
-static void OPT_InConstant (LONGINT f, OPT_Const conval)
+static void OPT_InConstant (INT32 f, OPT_Const conval)
{
CHAR ch;
- INTEGER i;
+ INT16 i;
OPT_ConstExt ext = NIL;
REAL rval;
switch (f) {
case 1: case 3: case 2:
OPM_SymRCh(&ch);
- conval->intval = (int)ch;
+ conval->intval = (INT16)ch;
break;
- case 4: case 5: case 6:
+ case 4:
conval->intval = OPM_SymRInt();
break;
- case 9:
+ case 7:
OPM_SymRSet(&conval->setval);
break;
- case 7:
+ case 5:
OPM_SymRReal(&rval);
conval->realval = rval;
conval->intval = -1;
break;
- case 8:
+ case 6:
OPM_SymRLReal(&conval->realval);
conval->intval = -1;
break;
- case 10:
+ case 8:
ext = OPT_NewExt();
conval->ext = ext;
i = 0;
do {
OPM_SymRCh(&ch);
- (*ext)[__X(i, ((LONGINT)(256)))] = ch;
+ (*ext)[__X(i, 256)] = ch;
i += 1;
} while (!(ch == 0x00));
conval->intval2 = i;
conval->intval = -1;
break;
- case 11:
+ case 9:
conval->intval = 0;
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in InConstant(), f = ", (LONGINT)37);
- OPM_LogWNum(f, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in InConstant(), f = ", 37);
+ OPM_LogWNum(f, 0);
OPM_LogWLn();
break;
}
}
-static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par)
+static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par)
{
OPT_Object last = NIL, new = NIL;
- LONGINT tag;
+ INT32 tag;
OPT_InStruct(&*res);
tag = OPM_SymRInt();
last = NIL;
@@ -879,7 +1082,7 @@ static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par)
}
OPT_InStruct(&new->typ);
new->adr = OPM_SymRInt();
- OPT_InName((void*)new->name, ((LONGINT)(256)));
+ OPT_InName((void*)new->name, 256);
last = new;
tag = OPM_SymRInt();
}
@@ -887,8 +1090,7 @@ static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par)
static OPT_Object OPT_InFld (void)
{
- OPT_Object _o_result;
- LONGINT tag;
+ INT32 tag;
OPT_Object obj = NIL;
tag = OPT_impCtxt.nextTag;
obj = OPT_NewObj();
@@ -900,7 +1102,7 @@ static OPT_Object OPT_InFld (void)
obj->vis = 1;
}
OPT_InStruct(&obj->typ);
- OPT_InName((void*)obj->name, ((LONGINT)(256)));
+ OPT_InName((void*)obj->name, 256);
obj->adr = OPM_SymRInt();
} else {
obj->mode = 4;
@@ -913,14 +1115,12 @@ static OPT_Object OPT_InFld (void)
obj->vis = 0;
obj->adr = OPM_SymRInt();
}
- _o_result = obj;
- return _o_result;
+ return obj;
}
-static OPT_Object OPT_InTProc (SHORTINT mno)
+static OPT_Object OPT_InTProc (INT8 mno)
{
- OPT_Object _o_result;
- LONGINT tag;
+ INT32 tag;
OPT_Object obj = NIL;
tag = OPT_impCtxt.nextTag;
obj = OPT_NewObj();
@@ -931,7 +1131,7 @@ static OPT_Object OPT_InTProc (SHORTINT mno)
obj->conval->intval = -1;
OPT_InSign(mno, &obj->typ, &obj->link);
obj->vis = 1;
- OPT_InName((void*)obj->name, ((LONGINT)(256)));
+ OPT_InName((void*)obj->name, 256);
obj->adr = __ASHL(OPM_SymRInt(), 16);
} else {
obj->mode = 13;
@@ -941,21 +1141,32 @@ static OPT_Object OPT_InTProc (SHORTINT mno)
obj->vis = 0;
obj->adr = __ASHL(OPM_SymRInt(), 16);
}
- _o_result = obj;
- return _o_result;
+ return obj;
+}
+
+static OPT_Struct OPT_InTyp (INT32 tag)
+{
+ if (tag == 4) {
+ return OPT_IntType(OPM_SymRInt());
+ } else if (tag == 7) {
+ return OPT_SetType(OPM_SymRInt());
+ } else {
+ return OPT_impCtxt.ref[__X(tag, 255)];
+ }
+ __RETCHK;
}
static void OPT_InStruct (OPT_Struct *typ)
{
- SHORTINT mno;
- INTEGER ref;
- LONGINT tag;
+ INT8 mno;
+ INT16 ref;
+ INT32 tag;
OPS_Name name;
OPT_Struct t = NIL;
OPT_Object obj = NIL, last = NIL, fld = NIL, old = NIL, dummy = NIL;
tag = OPM_SymRInt();
if (tag != 34) {
- *typ = OPT_impCtxt.ref[__X(-tag, ((LONGINT)(255)))];
+ *typ = OPT_InTyp(-tag);
} else {
ref = OPT_impCtxt.nofr;
OPT_impCtxt.nofr += 1;
@@ -963,23 +1174,23 @@ static void OPT_InStruct (OPT_Struct *typ)
OPT_impCtxt.minr = ref;
}
OPT_InMod(&mno);
- OPT_InName((void*)name, ((LONGINT)(256)));
+ OPT_InName((void*)name, 256);
obj = OPT_NewObj();
if (name[0] == 0x00) {
if (OPT_impCtxt.self) {
old = NIL;
} else {
__MOVE("@", obj->name, 2);
- OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old);
+ OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
obj->name[0] = 0x00;
}
*typ = OPT_NewStr(0, 1);
} else {
- __COPY(name, obj->name, ((LONGINT)(256)));
- OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old);
+ __COPY(name, obj->name, 256);
+ OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
if (old != NIL) {
OPT_FPrintObj(old);
- OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] = old->typ->pvfp;
+ OPT_impCtxt.pvfp[__X(ref, 255)] = old->typ->pvfp;
if (OPT_impCtxt.self) {
*typ = OPT_NewStr(0, 1);
} else {
@@ -993,8 +1204,8 @@ static void OPT_InStruct (OPT_Struct *typ)
*typ = OPT_NewStr(0, 1);
}
}
- OPT_impCtxt.ref[__X(ref, ((LONGINT)(255)))] = *typ;
- OPT_impCtxt.old[__X(ref, ((LONGINT)(255)))] = old;
+ OPT_impCtxt.ref[__X(ref, 255)] = *typ;
+ OPT_impCtxt.old[__X(ref, 255)] = old;
(*typ)->ref = ref + 255;
(*typ)->mno = mno;
(*typ)->allocated = 1;
@@ -1005,25 +1216,25 @@ static void OPT_InStruct (OPT_Struct *typ)
obj->vis = 0;
tag = OPM_SymRInt();
if (tag == 35) {
- (*typ)->sysflag = (int)OPM_SymRInt();
+ (*typ)->sysflag = (INT16)OPM_SymRInt();
tag = OPM_SymRInt();
}
switch (tag) {
case 36:
- (*typ)->form = 13;
- (*typ)->size = OPM_PointerSize;
+ (*typ)->form = 11;
+ (*typ)->size = OPM_AddressSize;
(*typ)->n = 0;
OPT_InStruct(&(*typ)->BaseTyp);
break;
case 37:
- (*typ)->form = 15;
+ (*typ)->form = 13;
(*typ)->comp = 2;
OPT_InStruct(&(*typ)->BaseTyp);
(*typ)->n = OPM_SymRInt();
- (*OPT_typSize)(*typ);
+ OPT_TypSize(*typ);
break;
case 38:
- (*typ)->form = 15;
+ (*typ)->form = 13;
(*typ)->comp = 3;
OPT_InStruct(&(*typ)->BaseTyp);
if ((*typ)->BaseTyp->comp == 3) {
@@ -1031,10 +1242,10 @@ static void OPT_InStruct (OPT_Struct *typ)
} else {
(*typ)->n = 0;
}
- (*OPT_typSize)(*typ);
+ OPT_TypSize(*typ);
break;
case 39:
- (*typ)->form = 15;
+ (*typ)->form = 13;
(*typ)->comp = 4;
OPT_InStruct(&(*typ)->BaseTyp);
if ((*typ)->BaseTyp == OPT_notyp) {
@@ -1068,25 +1279,25 @@ static void OPT_InStruct (OPT_Struct *typ)
}
break;
case 40:
- (*typ)->form = 14;
- (*typ)->size = OPM_ProcSize;
+ (*typ)->form = 12;
+ (*typ)->size = OPM_AddressSize;
OPT_InSign(mno, &(*typ)->BaseTyp, &(*typ)->link);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at InStruct, tag = ", (LONGINT)35);
- OPM_LogWNum(tag, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at InStruct, tag = ", 35);
+ OPM_LogWNum(tag, 0);
OPM_LogWLn();
break;
}
if (ref == OPT_impCtxt.minr) {
while (ref < OPT_impCtxt.nofr) {
- t = OPT_impCtxt.ref[__X(ref, ((LONGINT)(255)))];
+ t = OPT_InTyp(ref);
OPT_FPrintStr(t);
obj = t->strobj;
if (obj->name[0] != 0x00) {
OPT_FPrintObj(obj);
}
- old = OPT_impCtxt.old[__X(ref, ((LONGINT)(255)))];
+ old = OPT_impCtxt.old[__X(ref, 255)];
if (old != NIL) {
t->strobj = old;
if (OPT_impCtxt.self) {
@@ -1094,13 +1305,13 @@ static void OPT_InStruct (OPT_Struct *typ)
if (old->history != 5) {
if (old->fprint != obj->fprint) {
old->history = 2;
- } else if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) {
+ } else if (OPT_impCtxt.pvfp[__X(ref, 255)] != t->pvfp) {
old->history = 3;
}
}
} else if (old->fprint != obj->fprint) {
old->history = 2;
- } else if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) {
+ } else if (OPT_impCtxt.pvfp[__X(ref, 255)] != t->pvfp) {
old->history = 3;
} else if (old->vis == 0) {
old->history = 1;
@@ -1108,7 +1319,7 @@ static void OPT_InStruct (OPT_Struct *typ)
old->history = 0;
}
} else {
- if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) {
+ if (OPT_impCtxt.pvfp[__X(ref, 255)] != t->pvfp) {
old->history = 5;
}
if (old->fprint != obj->fprint) {
@@ -1127,14 +1338,13 @@ static void OPT_InStruct (OPT_Struct *typ)
}
}
-static OPT_Object OPT_InObj (SHORTINT mno)
+static OPT_Object OPT_InObj (INT8 mno)
{
- OPT_Object _o_result;
- INTEGER i, s;
+ INT16 i, s;
CHAR ch;
OPT_Object obj = NIL, old = NIL;
OPT_Struct typ = NIL;
- LONGINT tag;
+ INT32 tag;
OPT_ConstExt ext = NIL;
tag = OPT_impCtxt.nextTag;
if (tag == 19) {
@@ -1147,11 +1357,11 @@ static OPT_Object OPT_InObj (SHORTINT mno)
obj = OPT_NewObj();
obj->mnolev = -mno;
obj->vis = 1;
- if (tag <= 13) {
+ if (tag <= 11) {
obj->mode = 3;
- obj->typ = OPT_impCtxt.ref[__X(tag, ((LONGINT)(255)))];
obj->conval = OPT_NewConst();
OPT_InConstant(tag, obj->conval);
+ obj->typ = OPT_InTyp(tag);
} else if (tag >= 31) {
obj->conval = OPT_NewConst();
obj->conval->intval = -1;
@@ -1167,17 +1377,17 @@ static OPT_Object OPT_InObj (SHORTINT mno)
obj->mode = 9;
ext = OPT_NewExt();
obj->conval->ext = ext;
- s = (int)OPM_SymRInt();
+ s = (INT16)OPM_SymRInt();
(*ext)[0] = (CHAR)s;
i = 1;
while (i <= s) {
- OPM_SymRCh(&(*ext)[__X(i, ((LONGINT)(256)))]);
+ OPM_SymRCh(&(*ext)[__X(i, 256)]);
i += 1;
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", (LONGINT)32);
- OPM_LogWNum(tag, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", 32);
+ OPM_LogWNum(tag, 0);
OPM_LogWLn();
break;
}
@@ -1191,14 +1401,14 @@ static OPT_Object OPT_InObj (SHORTINT mno)
}
OPT_InStruct(&obj->typ);
}
- OPT_InName((void*)obj->name, ((LONGINT)(256)));
+ OPT_InName((void*)obj->name, 256);
}
OPT_FPrintObj(obj);
if ((obj->mode == 1 && (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00))) {
OPM_FPrint(&OPT_impCtxt.reffp, obj->typ->ref - 255);
}
if (tag != 19) {
- OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old);
+ OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
if (OPT_impCtxt.self) {
if (old != NIL) {
if (old->vis == 0) {
@@ -1226,14 +1436,13 @@ static OPT_Object OPT_InObj (SHORTINT mno)
}
}
}
- _o_result = obj;
- return _o_result;
+ return obj;
}
void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
{
OPT_Object obj = NIL;
- SHORTINT mno;
+ INT8 mno;
OPS_Name aliasName__copy;
__DUPARR(aliasName, OPS_Name);
if (__STRCMP(name, "SYSTEM") == 0) {
@@ -1244,12 +1453,12 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
obj->scope = OPT_syslink;
obj->typ = OPT_notyp;
} else {
- OPT_impCtxt.nofr = 16;
+ OPT_impCtxt.nofr = 14;
OPT_impCtxt.minr = 255;
OPT_impCtxt.nofm = 0;
OPT_impCtxt.self = __STRCMP(aliasName, "@self") == 0;
OPT_impCtxt.reffp = 0;
- OPM_OldSym((void*)name, ((LONGINT)(256)), &*done);
+ OPM_OldSym((void*)name, 256, &*done);
if (*done) {
OPT_InMod(&mno);
OPT_impCtxt.nextTag = OPM_SymRInt();
@@ -1259,8 +1468,8 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
}
OPT_Insert(aliasName, &obj);
obj->mode = 11;
- obj->scope = OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right;
- OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->link = obj;
+ obj->scope = OPT_GlbMod[__X(mno, 64)]->right;
+ OPT_GlbMod[__X(mno, 64)]->link = obj;
obj->mnolev = -mno;
obj->typ = OPT_notyp;
OPM_CloseOldSym();
@@ -1276,7 +1485,7 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
static void OPT_OutName (CHAR *name, LONGINT name__len)
{
- INTEGER i;
+ INT16 i;
CHAR ch;
i = 0;
do {
@@ -1286,21 +1495,21 @@ static void OPT_OutName (CHAR *name, LONGINT name__len)
} while (!(ch == 0x00));
}
-static void OPT_OutMod (INTEGER mno)
+static void OPT_OutMod (INT16 mno)
{
- if (OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))] < 0) {
- OPM_SymWInt(((LONGINT)(16)));
- OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))] = OPT_expCtxt.nofm;
+ if (OPT_expCtxt.locmno[__X(mno, 64)] < 0) {
+ OPM_SymWInt(16);
+ OPT_expCtxt.locmno[__X(mno, 64)] = OPT_expCtxt.nofm;
OPT_expCtxt.nofm += 1;
- OPT_OutName((void*)OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->name, ((LONGINT)(256)));
+ OPT_OutName((void*)OPT_GlbMod[__X(mno, 64)]->name, 256);
} else {
- OPM_SymWInt(-OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))]);
+ OPM_SymWInt(-OPT_expCtxt.locmno[__X(mno, 64)]);
}
}
-static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr)
+static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr)
{
- LONGINT i, j, n;
+ INT32 i, j, n;
OPT_Struct btyp = NIL;
if (typ->comp == 4) {
OPT_OutFlds(typ->link, adr, 0);
@@ -1311,7 +1520,7 @@ static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr)
n = btyp->n * n;
btyp = btyp->BaseTyp;
}
- if (btyp->form == 13 || btyp->comp == 4) {
+ if (btyp->form == 11 || btyp->comp == 4) {
j = OPT_nofhdfld;
OPT_OutHdFld(btyp, fld, adr);
if (j != OPT_nofhdfld) {
@@ -1323,24 +1532,24 @@ static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr)
}
}
}
- } else if (typ->form == 13 || __STRCMP(fld->name, "@ptr") == 0) {
- OPM_SymWInt(((LONGINT)(27)));
+ } else if (typ->form == 11 || __STRCMP(fld->name, "@ptr") == 0) {
+ OPM_SymWInt(27);
OPM_SymWInt(adr);
OPT_nofhdfld += 1;
}
}
-static void OPT_OutFlds (OPT_Object fld, LONGINT adr, BOOLEAN visible)
+static void OPT_OutFlds (OPT_Object fld, INT32 adr, BOOLEAN visible)
{
while ((fld != NIL && fld->mode == 4)) {
if ((fld->vis != 0 && visible)) {
if (fld->vis == 2) {
- OPM_SymWInt(((LONGINT)(26)));
+ OPM_SymWInt(26);
} else {
- OPM_SymWInt(((LONGINT)(25)));
+ OPM_SymWInt(25);
}
OPT_OutStr(fld->typ);
- OPT_OutName((void*)fld->name, ((LONGINT)(256)));
+ OPT_OutName((void*)fld->name, 256);
OPM_SymWInt(fld->adr);
} else {
OPT_OutHdFld(fld->typ, fld, fld->adr + adr);
@@ -1354,16 +1563,16 @@ static void OPT_OutSign (OPT_Struct result, OPT_Object par)
OPT_OutStr(result);
while (par != NIL) {
if (par->mode == 1) {
- OPM_SymWInt(((LONGINT)(23)));
+ OPM_SymWInt(23);
} else {
- OPM_SymWInt(((LONGINT)(24)));
+ OPM_SymWInt(24);
}
OPT_OutStr(par->typ);
OPM_SymWInt(par->adr);
- OPT_OutName((void*)par->name, ((LONGINT)(256)));
+ OPT_OutName((void*)par->name, 256);
par = par->link;
}
- OPM_SymWInt(((LONGINT)(18)));
+ OPM_SymWInt(18);
}
static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj)
@@ -1376,12 +1585,12 @@ static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj)
}
if (obj->vis != 0) {
if (obj->vis != 0) {
- OPM_SymWInt(((LONGINT)(29)));
+ OPM_SymWInt(29);
OPT_OutSign(obj->typ, obj->link);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
OPM_SymWInt(__ASHR(obj->adr, 16));
} else {
- OPM_SymWInt(((LONGINT)(30)));
+ OPM_SymWInt(30);
OPM_SymWInt(__ASHR(obj->adr, 16));
}
}
@@ -1395,8 +1604,11 @@ static void OPT_OutStr (OPT_Struct typ)
OPT_Object strobj = NIL;
if (typ->ref < OPT_expCtxt.ref) {
OPM_SymWInt(-typ->ref);
+ if (__IN(typ->ref, 0x90, 32)) {
+ OPM_SymWInt(typ->size);
+ }
} else {
- OPM_SymWInt(((LONGINT)(34)));
+ OPM_SymWInt(34);
typ->ref = OPT_expCtxt.ref;
OPT_expCtxt.ref += 1;
if (OPT_expCtxt.ref >= 255) {
@@ -1405,7 +1617,7 @@ static void OPT_OutStr (OPT_Struct typ)
OPT_OutMod(typ->mno);
strobj = typ->strobj;
if ((strobj != NIL && strobj->name[0] != 0x00)) {
- OPT_OutName((void*)strobj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)strobj->name, 256);
switch (strobj->history) {
case 2:
OPT_FPrintErr(strobj, 252);
@@ -1423,31 +1635,31 @@ static void OPT_OutStr (OPT_Struct typ)
OPM_SymWCh(0x00);
}
if (typ->sysflag != 0) {
- OPM_SymWInt(((LONGINT)(35)));
+ OPM_SymWInt(35);
OPM_SymWInt(typ->sysflag);
}
switch (typ->form) {
- case 13:
- OPM_SymWInt(((LONGINT)(36)));
+ case 11:
+ OPM_SymWInt(36);
OPT_OutStr(typ->BaseTyp);
break;
- case 14:
- OPM_SymWInt(((LONGINT)(40)));
+ case 12:
+ OPM_SymWInt(40);
OPT_OutSign(typ->BaseTyp, typ->link);
break;
- case 15:
+ case 13:
switch (typ->comp) {
case 2:
- OPM_SymWInt(((LONGINT)(37)));
+ OPM_SymWInt(37);
OPT_OutStr(typ->BaseTyp);
OPM_SymWInt(typ->n);
break;
case 3:
- OPM_SymWInt(((LONGINT)(38)));
+ OPM_SymWInt(38);
OPT_OutStr(typ->BaseTyp);
break;
case 4:
- OPM_SymWInt(((LONGINT)(39)));
+ OPM_SymWInt(39);
if (typ->BaseTyp == NIL) {
OPT_OutStr(OPT_notyp);
} else {
@@ -1457,23 +1669,23 @@ static void OPT_OutStr (OPT_Struct typ)
OPM_SymWInt(typ->align);
OPM_SymWInt(typ->n);
OPT_nofhdfld = 0;
- OPT_OutFlds(typ->link, ((LONGINT)(0)), 1);
+ OPT_OutFlds(typ->link, 0, 1);
if (OPT_nofhdfld > 2048) {
OPM_Mark(223, typ->txtpos);
}
OPT_OutTProcs(typ, typ->link);
- OPM_SymWInt(((LONGINT)(18)));
+ OPM_SymWInt(18);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.comp = ", (LONGINT)39);
- OPM_LogWNum(typ->comp, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.comp = ", 39);
+ OPM_LogWNum(typ->comp, 0);
OPM_LogWLn();
break;
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.form = ", (LONGINT)39);
- OPM_LogWNum(typ->form, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.form = ", 39);
+ OPM_LogWNum(typ->form, 0);
OPM_LogWLn();
break;
}
@@ -1482,7 +1694,7 @@ static void OPT_OutStr (OPT_Struct typ)
static void OPT_OutConstant (OPT_Object obj)
{
- INTEGER f;
+ INT16 f;
REAL rval;
f = obj->typ->form;
OPM_SymWInt(f);
@@ -1490,23 +1702,25 @@ static void OPT_OutConstant (OPT_Object obj)
case 2: case 3:
OPM_SymWCh((CHAR)obj->conval->intval);
break;
- case 4: case 5: case 6:
+ case 4:
OPM_SymWInt(obj->conval->intval);
- break;
- case 9:
- OPM_SymWSet(obj->conval->setval);
+ OPM_SymWInt(obj->typ->size);
break;
case 7:
+ OPM_SymWSet(obj->conval->setval);
+ OPM_SymWInt(obj->typ->size);
+ break;
+ case 5:
rval = obj->conval->realval;
OPM_SymWReal(rval);
break;
- case 8:
+ case 6:
OPM_SymWLReal(obj->conval->realval);
break;
- case 10:
- OPT_OutName((void*)*obj->conval->ext, ((LONGINT)(256)));
+ case 8:
+ OPT_OutName((void*)*obj->conval->ext, 256);
break;
- case 11:
+ case 9:
break;
default:
OPT_err(127);
@@ -1516,11 +1730,11 @@ static void OPT_OutConstant (OPT_Object obj)
static void OPT_OutObj (OPT_Object obj)
{
- INTEGER i, j;
+ INT16 i, j;
OPT_ConstExt ext = NIL;
if (obj != NIL) {
OPT_OutObj(obj->left);
- if (__IN(obj->mode, 0x06ea)) {
+ if (__IN(obj->mode, 0x06ea, 32)) {
if (obj->history == 4) {
OPT_FPrintErr(obj, 250);
} else if (obj->vis != 0) {
@@ -1537,64 +1751,64 @@ static void OPT_OutObj (OPT_Object obj)
OPT_FPrintErr(obj, 251);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj^.history = ", (LONGINT)42);
- OPM_LogWNum(obj->history, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj^.history = ", 42);
+ OPM_LogWNum(obj->history, 0);
OPM_LogWLn();
break;
}
switch (obj->mode) {
case 3:
OPT_OutConstant(obj);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
break;
case 5:
if (obj->typ->strobj == obj) {
- OPM_SymWInt(((LONGINT)(19)));
+ OPM_SymWInt(19);
OPT_OutStr(obj->typ);
} else {
- OPM_SymWInt(((LONGINT)(20)));
+ OPM_SymWInt(20);
OPT_OutStr(obj->typ);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
}
break;
case 1:
if (obj->vis == 2) {
- OPM_SymWInt(((LONGINT)(22)));
+ OPM_SymWInt(22);
} else {
- OPM_SymWInt(((LONGINT)(21)));
+ OPM_SymWInt(21);
}
OPT_OutStr(obj->typ);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
if (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00) {
OPM_FPrint(&OPT_expCtxt.reffp, obj->typ->ref);
}
break;
case 7:
- OPM_SymWInt(((LONGINT)(31)));
+ OPM_SymWInt(31);
OPT_OutSign(obj->typ, obj->link);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
break;
case 10:
- OPM_SymWInt(((LONGINT)(32)));
+ OPM_SymWInt(32);
OPT_OutSign(obj->typ, obj->link);
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
break;
case 9:
- OPM_SymWInt(((LONGINT)(33)));
+ OPM_SymWInt(33);
OPT_OutSign(obj->typ, obj->link);
ext = obj->conval->ext;
- j = (int)(*ext)[0];
+ j = (INT16)(*ext)[0];
i = 1;
OPM_SymWInt(j);
while (i <= j) {
- OPM_SymWCh((*ext)[__X(i, ((LONGINT)(256)))]);
+ OPM_SymWCh((*ext)[__X(i, 256)]);
i += 1;
}
- OPT_OutName((void*)obj->name, ((LONGINT)(256)));
+ OPT_OutName((void*)obj->name, 256);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj.mode = ", (LONGINT)38);
- OPM_LogWNum(obj->mode, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj.mode = ", 38);
+ OPM_LogWNum(obj->mode, 0);
OPM_LogWLn();
break;
}
@@ -1606,8 +1820,8 @@ static void OPT_OutObj (OPT_Object obj)
void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
{
- INTEGER i;
- SHORTINT nofmod;
+ INT16 i;
+ INT8 nofmod;
BOOLEAN done;
OPT_symExtended = 0;
OPT_symNew = 0;
@@ -1615,25 +1829,22 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
OPT_Import((CHAR*)"@self", OPT_SelfName, &done);
OPT_nofGmod = nofmod;
if (OPM_noerr) {
- OPM_NewSym((void*)OPT_SelfName, ((LONGINT)(256)));
+ OPM_NewSym((void*)OPT_SelfName, 256);
if (OPM_noerr) {
- OPM_SymWInt(((LONGINT)(16)));
- OPT_OutName((void*)OPT_SelfName, ((LONGINT)(256)));
+ OPM_SymWInt(16);
+ OPT_OutName((void*)OPT_SelfName, 256);
OPT_expCtxt.reffp = 0;
- OPT_expCtxt.ref = 16;
+ OPT_expCtxt.ref = 14;
OPT_expCtxt.nofm = 1;
OPT_expCtxt.locmno[0] = 0;
i = 1;
while (i < 64) {
- OPT_expCtxt.locmno[__X(i, ((LONGINT)(64)))] = -1;
+ OPT_expCtxt.locmno[__X(i, 64)] = -1;
i += 1;
}
OPT_OutObj(OPT_topScope->right);
*ext = (OPT_sfpresent && OPT_symExtended);
- *new = !OPT_sfpresent || OPT_symNew;
- if (OPM_forceNewSym) {
- *new = 1;
- }
+ *new = (!OPT_sfpresent || OPT_symNew) || __IN(17, OPM_Options, 32);
if ((((OPM_noerr && OPT_sfpresent)) && OPT_impCtxt.reffp != OPT_expCtxt.reffp)) {
*new = 1;
if (!OPT_extsf) {
@@ -1649,11 +1860,11 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
}
}
-static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form)
+static void OPT_InitStruct (OPT_Struct *typ, INT8 form)
{
*typ = OPT_NewStr(form, 1);
(*typ)->ref = form;
- (*typ)->size = OPM_ByteSize;
+ (*typ)->size = 1;
(*typ)->allocated = 1;
(*typ)->strobj = OPT_NewObj();
(*typ)->pbfp = form;
@@ -1663,7 +1874,7 @@ static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form)
(*typ)->idfpdone = 1;
}
-static void OPT_EnterBoolConst (OPS_Name name, LONGINT value)
+static void OPT_EnterBoolConst (OPS_Name name, INT32 value)
{
OPT_Object obj = NIL;
OPS_Name name__copy;
@@ -1675,7 +1886,7 @@ static void OPT_EnterBoolConst (OPS_Name name, LONGINT value)
obj->conval->intval = value;
}
-static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct *res)
+static void OPT_EnterTyp (OPS_Name name, INT8 form, INT16 size, OPT_Struct *res)
{
OPT_Object obj = NIL;
OPT_Struct typ = NIL;
@@ -1695,10 +1906,25 @@ static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct
typ->fpdone = 1;
typ->idfp = form;
typ->idfpdone = 1;
+ if (__IN(form, 0x90, 32)) {
+ OPM_FPrint(&typ->idfp, typ->size);
+ }
*res = typ;
}
-static void OPT_EnterProc (OPS_Name name, INTEGER num)
+static void OPT_EnterTypeAlias (OPS_Name name, OPT_Object *res)
+{
+ OPT_Object obj = NIL;
+ OPS_Name name__copy;
+ __DUPARR(name, OPS_Name);
+ OPT_Insert(name, &obj);
+ obj->mode = 5;
+ obj->typ = NIL;
+ obj->vis = 1;
+ *res = obj;
+}
+
+static void OPT_EnterProc (OPS_Name name, INT16 num)
{
OPT_Object obj = NIL;
OPS_Name name__copy;
@@ -1713,62 +1939,75 @@ static void EnumPtrs(void (*P)(void*))
{
P(OPT_topScope);
P(OPT_undftyp);
+ P(OPT_niltyp);
+ P(OPT_notyp);
P(OPT_bytetyp);
+ P(OPT_cpbytetyp);
P(OPT_booltyp);
P(OPT_chartyp);
P(OPT_sinttyp);
P(OPT_inttyp);
P(OPT_linttyp);
+ P(OPT_hinttyp);
+ P(OPT_int8typ);
+ P(OPT_int16typ);
+ P(OPT_int32typ);
+ P(OPT_int64typ);
+ P(OPT_settyp);
+ P(OPT_set32typ);
+ P(OPT_set64typ);
P(OPT_realtyp);
P(OPT_lrltyp);
- P(OPT_settyp);
P(OPT_stringtyp);
- P(OPT_niltyp);
- P(OPT_notyp);
+ P(OPT_adrtyp);
P(OPT_sysptrtyp);
+ P(OPT_sintobj);
+ P(OPT_intobj);
+ P(OPT_lintobj);
+ P(OPT_setobj);
__ENUMP(OPT_GlbMod, 64, P);
P(OPT_universe);
P(OPT_syslink);
- __ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 6216, 1, P);
+ __ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 5184, 1, P);
}
__TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 40), {0, -16}};
-__TDESC(OPT_ObjDesc, 1, 6) = {__TDFLDS("ObjDesc", 344), {0, 8, 16, 24, 304, 312, -56}};
-__TDESC(OPT_StrDesc, 1, 3) = {__TDFLDS("StrDesc", 104), {80, 88, 96, -32}};
+__TDESC(OPT_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", 6216), {32, 40, 48, 56, 64, 72, 80, 88, 96, 104, 112, 120, 128, 136, 144, 152,
- 160, 168, 176, 184, 192, 200, 208, 216, 224, 232, 240, 248, 256, 264, 272, 280,
- 288, 296, 304, 312, 320, 328, 336, 344, 352, 360, 368, 376, 384, 392, 400, 408,
- 416, 424, 432, 440, 448, 456, 464, 472, 480, 488, 496, 504, 512, 520, 528, 536,
- 544, 552, 560, 568, 576, 584, 592, 600, 608, 616, 624, 632, 640, 648, 656, 664,
- 672, 680, 688, 696, 704, 712, 720, 728, 736, 744, 752, 760, 768, 776, 784, 792,
- 800, 808, 816, 824, 832, 840, 848, 856, 864, 872, 880, 888, 896, 904, 912, 920,
- 928, 936, 944, 952, 960, 968, 976, 984, 992, 1000, 1008, 1016, 1024, 1032, 1040, 1048,
- 1056, 1064, 1072, 1080, 1088, 1096, 1104, 1112, 1120, 1128, 1136, 1144, 1152, 1160, 1168, 1176,
- 1184, 1192, 1200, 1208, 1216, 1224, 1232, 1240, 1248, 1256, 1264, 1272, 1280, 1288, 1296, 1304,
- 1312, 1320, 1328, 1336, 1344, 1352, 1360, 1368, 1376, 1384, 1392, 1400, 1408, 1416, 1424, 1432,
- 1440, 1448, 1456, 1464, 1472, 1480, 1488, 1496, 1504, 1512, 1520, 1528, 1536, 1544, 1552, 1560,
- 1568, 1576, 1584, 1592, 1600, 1608, 1616, 1624, 1632, 1640, 1648, 1656, 1664, 1672, 1680, 1688,
- 1696, 1704, 1712, 1720, 1728, 1736, 1744, 1752, 1760, 1768, 1776, 1784, 1792, 1800, 1808, 1816,
- 1824, 1832, 1840, 1848, 1856, 1864, 1872, 1880, 1888, 1896, 1904, 1912, 1920, 1928, 1936, 1944,
- 1952, 1960, 1968, 1976, 1984, 1992, 2000, 2008, 2016, 2024, 2032, 2040, 2048, 2056, 2064, 2072,
- 2080, 2088, 2096, 2104, 2112, 2120, 2128, 2136, 2144, 2152, 2160, 2168, 2176, 2184, 2192, 2200,
- 2208, 2216, 2224, 2232, 2240, 2248, 2256, 2264, 2272, 2280, 2288, 2296, 2304, 2312, 2320, 2328,
- 2336, 2344, 2352, 2360, 2368, 2376, 2384, 2392, 2400, 2408, 2416, 2424, 2432, 2440, 2448, 2456,
- 2464, 2472, 2480, 2488, 2496, 2504, 2512, 2520, 2528, 2536, 2544, 2552, 2560, 2568, 2576, 2584,
- 2592, 2600, 2608, 2616, 2624, 2632, 2640, 2648, 2656, 2664, 2672, 2680, 2688, 2696, 2704, 2712,
- 2720, 2728, 2736, 2744, 2752, 2760, 2768, 2776, 2784, 2792, 2800, 2808, 2816, 2824, 2832, 2840,
- 2848, 2856, 2864, 2872, 2880, 2888, 2896, 2904, 2912, 2920, 2928, 2936, 2944, 2952, 2960, 2968,
- 2976, 2984, 2992, 3000, 3008, 3016, 3024, 3032, 3040, 3048, 3056, 3064, 3072, 3080, 3088, 3096,
- 3104, 3112, 3120, 3128, 3136, 3144, 3152, 3160, 3168, 3176, 3184, 3192, 3200, 3208, 3216, 3224,
- 3232, 3240, 3248, 3256, 3264, 3272, 3280, 3288, 3296, 3304, 3312, 3320, 3328, 3336, 3344, 3352,
- 3360, 3368, 3376, 3384, 3392, 3400, 3408, 3416, 3424, 3432, 3440, 3448, 3456, 3464, 3472, 3480,
- 3488, 3496, 3504, 3512, 3520, 3528, 3536, 3544, 3552, 3560, 3568, 3576, 3584, 3592, 3600, 3608,
- 3616, 3624, 3632, 3640, 3648, 3656, 3664, 3672, 3680, 3688, 3696, 3704, 3712, 3720, 3728, 3736,
- 3744, 3752, 3760, 3768, 3776, 3784, 3792, 3800, 3808, 3816, 3824, 3832, 3840, 3848, 3856, 3864,
- 3872, 3880, 3888, 3896, 3904, 3912, 3920, 3928, 3936, 3944, 3952, 3960, 3968, 3976, 3984, 3992,
- 4000, 4008, 4016, 4024, 4032, 4040, 4048, 4056, 4064, 4072, 4080, 4088, 4096, 4104, -4088}};
-__TDESC(OPT_ExpCtxt, 1, 0) = {__TDFLDS("ExpCtxt", 80), {-8}};
+__TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 5184), {16, 24, 32, 40, 48, 56, 64, 72, 80, 88, 96, 104, 112, 120, 128, 136,
+ 144, 152, 160, 168, 176, 184, 192, 200, 208, 216, 224, 232, 240, 248, 256, 264,
+ 272, 280, 288, 296, 304, 312, 320, 328, 336, 344, 352, 360, 368, 376, 384, 392,
+ 400, 408, 416, 424, 432, 440, 448, 456, 464, 472, 480, 488, 496, 504, 512, 520,
+ 528, 536, 544, 552, 560, 568, 576, 584, 592, 600, 608, 616, 624, 632, 640, 648,
+ 656, 664, 672, 680, 688, 696, 704, 712, 720, 728, 736, 744, 752, 760, 768, 776,
+ 784, 792, 800, 808, 816, 824, 832, 840, 848, 856, 864, 872, 880, 888, 896, 904,
+ 912, 920, 928, 936, 944, 952, 960, 968, 976, 984, 992, 1000, 1008, 1016, 1024, 1032,
+ 1040, 1048, 1056, 1064, 1072, 1080, 1088, 1096, 1104, 1112, 1120, 1128, 1136, 1144, 1152, 1160,
+ 1168, 1176, 1184, 1192, 1200, 1208, 1216, 1224, 1232, 1240, 1248, 1256, 1264, 1272, 1280, 1288,
+ 1296, 1304, 1312, 1320, 1328, 1336, 1344, 1352, 1360, 1368, 1376, 1384, 1392, 1400, 1408, 1416,
+ 1424, 1432, 1440, 1448, 1456, 1464, 1472, 1480, 1488, 1496, 1504, 1512, 1520, 1528, 1536, 1544,
+ 1552, 1560, 1568, 1576, 1584, 1592, 1600, 1608, 1616, 1624, 1632, 1640, 1648, 1656, 1664, 1672,
+ 1680, 1688, 1696, 1704, 1712, 1720, 1728, 1736, 1744, 1752, 1760, 1768, 1776, 1784, 1792, 1800,
+ 1808, 1816, 1824, 1832, 1840, 1848, 1856, 1864, 1872, 1880, 1888, 1896, 1904, 1912, 1920, 1928,
+ 1936, 1944, 1952, 1960, 1968, 1976, 1984, 1992, 2000, 2008, 2016, 2024, 2032, 2040, 2048, 2056,
+ 2064, 2072, 2080, 2088, 2096, 2104, 2112, 2120, 2128, 2136, 2144, 2152, 2160, 2168, 2176, 2184,
+ 2192, 2200, 2208, 2216, 2224, 2232, 2240, 2248, 2256, 2264, 2272, 2280, 2288, 2296, 2304, 2312,
+ 2320, 2328, 2336, 2344, 2352, 2360, 2368, 2376, 2384, 2392, 2400, 2408, 2416, 2424, 2432, 2440,
+ 2448, 2456, 2464, 2472, 2480, 2488, 2496, 2504, 2512, 2520, 2528, 2536, 2544, 2552, 2560, 2568,
+ 2576, 2584, 2592, 2600, 2608, 2616, 2624, 2632, 2640, 2648, 2656, 2664, 2672, 2680, 2688, 2696,
+ 2704, 2712, 2720, 2728, 2736, 2744, 2752, 2760, 2768, 2776, 2784, 2792, 2800, 2808, 2816, 2824,
+ 2832, 2840, 2848, 2856, 2864, 2872, 2880, 2888, 2896, 2904, 2912, 2920, 2928, 2936, 2944, 2952,
+ 2960, 2968, 2976, 2984, 2992, 3000, 3008, 3016, 3024, 3032, 3040, 3048, 3056, 3064, 3072, 3080,
+ 3088, 3096, 3104, 3112, 3120, 3128, 3136, 3144, 3152, 3160, 3168, 3176, 3184, 3192, 3200, 3208,
+ 3216, 3224, 3232, 3240, 3248, 3256, 3264, 3272, 3280, 3288, 3296, 3304, 3312, 3320, 3328, 3336,
+ 3344, 3352, 3360, 3368, 3376, 3384, 3392, 3400, 3408, 3416, 3424, 3432, 3440, 3448, 3456, 3464,
+ 3472, 3480, 3488, 3496, 3504, 3512, 3520, 3528, 3536, 3544, 3552, 3560, 3568, 3576, 3584, 3592,
+ 3600, 3608, 3616, 3624, 3632, 3640, 3648, 3656, 3664, 3672, 3680, 3688, 3696, 3704, 3712, 3720,
+ 3728, 3736, 3744, 3752, 3760, 3768, 3776, 3784, 3792, 3800, 3808, 3816, 3824, 3832, 3840, 3848,
+ 3856, 3864, 3872, 3880, 3888, 3896, 3904, 3912, 3920, 3928, 3936, 3944, 3952, 3960, 3968, 3976,
+ 3984, 3992, 4000, 4008, 4016, 4024, 4032, 4040, 4048, 4056, 4064, 4072, 4080, 4088, -4088}};
+__TDESC(OPT_ExpCtxt, 1, 0) = {__TDFLDS("ExpCtxt", 72), {-8}};
export void *OPT__init(void)
{
@@ -1778,6 +2017,7 @@ export void *OPT__init(void)
__REGMOD("OPT", EnumPtrs);
__REGCMD("Close", OPT_Close);
__REGCMD("CloseScope", OPT_CloseScope);
+ __REGCMD("InitRecno", OPT_InitRecno);
__INITYP(OPT_ConstDesc, OPT_ConstDesc, 0);
__INITYP(OPT_ObjDesc, OPT_ObjDesc, 0);
__INITYP(OPT_StrDesc, OPT_StrDesc, 0);
@@ -1789,12 +2029,19 @@ export void *OPT__init(void)
OPT_OpenScope(0, NIL);
OPM_errpos = 0;
OPT_InitStruct(&OPT_undftyp, 0);
- OPT_InitStruct(&OPT_notyp, 12);
- OPT_InitStruct(&OPT_stringtyp, 10);
- OPT_InitStruct(&OPT_niltyp, 11);
OPT_undftyp->BaseTyp = OPT_undftyp;
- OPT_EnterTyp((CHAR*)"BYTE", 1, OPM_ByteSize, &OPT_bytetyp);
- OPT_EnterTyp((CHAR*)"PTR", 13, OPM_PointerSize, &OPT_sysptrtyp);
+ OPT_InitStruct(&OPT_notyp, 10);
+ OPT_InitStruct(&OPT_stringtyp, 8);
+ OPT_InitStruct(&OPT_niltyp, 9);
+ OPT_EnterTyp((CHAR*)"BYTE", 1, 1, &OPT_bytetyp);
+ OPT_EnterTyp((CHAR*)"PTR", 11, -1, &OPT_sysptrtyp);
+ OPT_EnterTyp((CHAR*)"ADDRESS", 4, -1, &OPT_adrtyp);
+ OPT_EnterTyp((CHAR*)"INT8", 4, 1, &OPT_int8typ);
+ OPT_EnterTyp((CHAR*)"INT16", 4, 2, &OPT_int16typ);
+ OPT_EnterTyp((CHAR*)"INT32", 4, 4, &OPT_int32typ);
+ OPT_EnterTyp((CHAR*)"INT64", 4, 8, &OPT_int64typ);
+ OPT_EnterTyp((CHAR*)"SET32", 7, 4, &OPT_set32typ);
+ OPT_EnterTyp((CHAR*)"SET64", 7, 8, &OPT_set64typ);
OPT_EnterProc((CHAR*)"ADR", 20);
OPT_EnterProc((CHAR*)"CC", 21);
OPT_EnterProc((CHAR*)"LSH", 22);
@@ -1810,16 +2057,18 @@ export void *OPT__init(void)
OPT_syslink = OPT_topScope->right;
OPT_universe = OPT_topScope;
OPT_topScope->right = NIL;
- OPT_EnterTyp((CHAR*)"BOOLEAN", 2, OPM_BoolSize, &OPT_booltyp);
- OPT_EnterTyp((CHAR*)"CHAR", 3, OPM_CharSize, &OPT_chartyp);
- OPT_EnterTyp((CHAR*)"SET", 9, OPM_SetSize, &OPT_settyp);
- OPT_EnterTyp((CHAR*)"REAL", 7, OPM_RealSize, &OPT_realtyp);
- OPT_EnterTyp((CHAR*)"INTEGER", 5, OPM_IntSize, &OPT_inttyp);
- OPT_EnterTyp((CHAR*)"LONGINT", 6, OPM_LIntSize, &OPT_linttyp);
- OPT_EnterTyp((CHAR*)"LONGREAL", 8, OPM_LRealSize, &OPT_lrltyp);
- OPT_EnterTyp((CHAR*)"SHORTINT", 4, OPM_SIntSize, &OPT_sinttyp);
- OPT_EnterBoolConst((CHAR*)"FALSE", ((LONGINT)(0)));
- OPT_EnterBoolConst((CHAR*)"TRUE", ((LONGINT)(1)));
+ OPT_EnterTyp((CHAR*)"BOOLEAN", 2, 1, &OPT_booltyp);
+ OPT_EnterTyp((CHAR*)"CHAR", 3, 1, &OPT_chartyp);
+ OPT_EnterTyp((CHAR*)"REAL", 5, 4, &OPT_realtyp);
+ OPT_EnterTyp((CHAR*)"LONGREAL", 6, 8, &OPT_lrltyp);
+ OPT_EnterTyp((CHAR*)"HUGEINT", 4, 8, &OPT_hinttyp);
+ OPT_EnterTyp((CHAR*)"BYTE@", 4, 1, &OPT_cpbytetyp);
+ OPT_EnterTypeAlias((CHAR*)"SHORTINT", &OPT_sintobj);
+ OPT_EnterTypeAlias((CHAR*)"INTEGER", &OPT_intobj);
+ OPT_EnterTypeAlias((CHAR*)"LONGINT", &OPT_lintobj);
+ OPT_EnterTypeAlias((CHAR*)"SET", &OPT_setobj);
+ OPT_EnterBoolConst((CHAR*)"FALSE", 0);
+ OPT_EnterBoolConst((CHAR*)"TRUE", 1);
OPT_EnterProc((CHAR*)"HALT", 0);
OPT_EnterProc((CHAR*)"NEW", 1);
OPT_EnterProc((CHAR*)"ABS", 2);
@@ -1845,15 +2094,13 @@ export void *OPT__init(void)
OPT_impCtxt.ref[1] = OPT_bytetyp;
OPT_impCtxt.ref[2] = OPT_booltyp;
OPT_impCtxt.ref[3] = OPT_chartyp;
- OPT_impCtxt.ref[4] = OPT_sinttyp;
- OPT_impCtxt.ref[5] = OPT_inttyp;
- OPT_impCtxt.ref[6] = OPT_linttyp;
- OPT_impCtxt.ref[7] = OPT_realtyp;
- OPT_impCtxt.ref[8] = OPT_lrltyp;
- OPT_impCtxt.ref[9] = OPT_settyp;
- OPT_impCtxt.ref[10] = OPT_stringtyp;
- OPT_impCtxt.ref[11] = OPT_niltyp;
- OPT_impCtxt.ref[12] = OPT_notyp;
- OPT_impCtxt.ref[13] = OPT_sysptrtyp;
+ OPT_impCtxt.ref[4] = OPT_int32typ;
+ OPT_impCtxt.ref[5] = OPT_realtyp;
+ OPT_impCtxt.ref[6] = OPT_lrltyp;
+ OPT_impCtxt.ref[7] = OPT_settyp;
+ OPT_impCtxt.ref[8] = OPT_stringtyp;
+ OPT_impCtxt.ref[9] = OPT_niltyp;
+ OPT_impCtxt.ref[10] = OPT_notyp;
+ OPT_impCtxt.ref[11] = OPT_sysptrtyp;
__ENDMOD;
}
diff --git a/bootstrap/windows-88/OPT.h b/bootstrap/windows-88/OPT.h
index ab2c4684..90fcacf5 100644
--- a/bootstrap/windows-88/OPT.h
+++ b/bootstrap/windows-88/OPT.h
@@ -1,9 +1,8 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPT__h
#define OPT__h
-#define LARGE
#include "SYSTEM.h"
#include "OPS.h"
@@ -16,8 +15,9 @@ typedef
typedef
struct OPT_ConstDesc {
OPT_ConstExt ext;
- LONGINT intval, intval2;
- SET setval;
+ INT64 intval;
+ INT32 intval2;
+ UINT64 setval;
LONGREAL realval;
} OPT_ConstDesc;
@@ -33,7 +33,7 @@ typedef
typedef
struct OPT_NodeDesc {
OPT_Node left, right, link;
- SHORTINT class, subcl;
+ INT8 class, subcl;
BOOLEAN readonly;
OPT_Struct typ;
OPT_Object obj;
@@ -45,44 +45,48 @@ typedef
OPT_Object left, right, link, scope;
OPS_Name name;
BOOLEAN leaf;
- SHORTINT mode, mnolev, vis, history;
+ INT8 mode, mnolev, vis, history;
BOOLEAN used, fpdone;
- LONGINT fprint;
+ INT32 fprint;
OPT_Struct typ;
OPT_Const conval;
- LONGINT adr, linkadr;
- INTEGER x;
+ INT32 adr, linkadr;
+ INT16 x;
} OPT_ObjDesc;
typedef
struct OPT_StrDesc {
- SHORTINT form, comp, mno, extlev;
- INTEGER ref, sysflag;
- LONGINT n, size, align, txtpos;
+ INT8 form, comp, mno, extlev;
+ INT16 ref, sysflag;
+ INT32 n, size, align, txtpos;
BOOLEAN allocated, pbused, pvused;
- char _prvt0[24];
+ char _prvt0[4];
+ INT32 idfp;
+ char _prvt1[8];
OPT_Struct BaseTyp;
OPT_Object link, strobj;
} OPT_StrDesc;
-import void (*OPT_typSize)(OPT_Struct);
import OPT_Object OPT_topScope;
-import OPT_Struct OPT_undftyp, OPT_bytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_realtyp, OPT_lrltyp, OPT_settyp, OPT_stringtyp, OPT_niltyp, OPT_notyp, OPT_sysptrtyp;
-import SHORTINT OPT_nofGmod;
+import OPT_Struct OPT_undftyp, OPT_niltyp, OPT_notyp, OPT_bytetyp, OPT_cpbytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_hinttyp, OPT_int8typ, OPT_int16typ, OPT_int32typ, OPT_int64typ, OPT_settyp, OPT_set32typ, OPT_set64typ, OPT_realtyp, OPT_lrltyp, OPT_stringtyp, OPT_adrtyp, OPT_sysptrtyp;
+import OPT_Object OPT_sintobj, OPT_intobj, OPT_lintobj, OPT_setobj;
+import INT8 OPT_nofGmod;
import OPT_Object OPT_GlbMod[64];
import OPS_Name OPT_SelfName;
import BOOLEAN OPT_SYSimported;
-import LONGINT *OPT_ConstDesc__typ;
-import LONGINT *OPT_ObjDesc__typ;
-import LONGINT *OPT_StrDesc__typ;
-import LONGINT *OPT_NodeDesc__typ;
+import ADDRESS *OPT_ConstDesc__typ;
+import ADDRESS *OPT_ObjDesc__typ;
+import ADDRESS *OPT_StrDesc__typ;
+import ADDRESS *OPT_NodeDesc__typ;
+import void OPT_Align (INT32 *adr, INT32 base);
+import INT32 OPT_BaseAlignment (OPT_Struct typ);
import void OPT_Close (void);
import void OPT_CloseScope (void);
import void OPT_Export (BOOLEAN *ext, BOOLEAN *new);
-import void OPT_FPrintErr (OPT_Object obj, INTEGER errcode);
+import void OPT_FPrintErr (OPT_Object obj, INT16 errcode);
import void OPT_FPrintObj (OPT_Object obj);
import void OPT_FPrintStr (OPT_Struct typ);
import void OPT_Find (OPT_Object *res);
@@ -90,16 +94,23 @@ import void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res);
import void OPT_FindImport (OPT_Object mod, OPT_Object *res);
import void OPT_IdFPrint (OPT_Struct typ);
import void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done);
-import void OPT_Init (OPS_Name name, SET opt);
+import void OPT_Init (OPS_Name name, UINT32 opt);
+import void OPT_InitRecno (void);
import void OPT_Insert (OPS_Name name, OPT_Object *obj);
import void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old);
+import INT16 OPT_IntSize (INT64 n);
+import OPT_Struct OPT_IntType (INT32 size);
import OPT_Const OPT_NewConst (void);
import OPT_ConstExt OPT_NewExt (void);
-import OPT_Node OPT_NewNode (SHORTINT class);
+import OPT_Node OPT_NewNode (INT8 class);
import OPT_Object OPT_NewObj (void);
-import OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp);
-import void OPT_OpenScope (SHORTINT level, OPT_Object owner);
+import OPT_Struct OPT_NewStr (INT8 form, INT8 comp);
+import void OPT_OpenScope (INT8 level, OPT_Object owner);
+import OPT_Struct OPT_SetType (INT32 size);
+import OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir);
+import INT32 OPT_SizeAlignment (INT32 size);
+import void OPT_TypSize (OPT_Struct typ);
import void *OPT__init(void);
-#endif
+#endif // OPT
diff --git a/bootstrap/windows-88/OPV.c b/bootstrap/windows-88/OPV.c
index ae14f629..4bd6b3fb 100644
--- a/bootstrap/windows-88/OPV.c
+++ b/bootstrap/windows-88/OPV.c
@@ -1,5 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "OPC.h"
#include "OPM.h"
@@ -8,167 +13,66 @@
typedef
struct OPV_ExitInfo {
- INTEGER level, label;
+ INT16 level, label;
} OPV_ExitInfo;
-static BOOLEAN OPV_assert, OPV_inxchk, OPV_mainprog, OPV_ansi;
-static INTEGER OPV_stamp;
-static LONGINT OPV_recno;
+static INT16 OPV_stamp;
static OPV_ExitInfo OPV_exit;
-static INTEGER OPV_nofExitLabels;
-static BOOLEAN OPV_naturalAlignment;
+static INT16 OPV_nofExitLabels;
-export LONGINT *OPV_ExitInfo__typ;
+export ADDRESS *OPV_ExitInfo__typ;
static void OPV_ActualPar (OPT_Node n, OPT_Object fp);
export void OPV_AdrAndSize (OPT_Object topScope);
static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc);
-static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INTEGER prec);
+static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec);
static void OPV_DefineTDescs (OPT_Node n);
-static void OPV_Entier (OPT_Node n, INTEGER prec);
+static void OPV_Entier (OPT_Node n, INT16 prec);
static void OPV_GetTProcNum (OPT_Object obj);
static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc);
static BOOLEAN OPV_ImplicitReturn (OPT_Node n);
-static void OPV_Index (OPT_Node n, OPT_Node d, INTEGER prec, INTEGER dim);
+static void OPV_Index (OPT_Node n, OPT_Node d, INT16 prec, INT16 dim);
export void OPV_Init (void);
static void OPV_InitTDescs (OPT_Node n);
-static void OPV_Len (OPT_Node n, LONGINT dim);
+static void OPV_Len (OPT_Node n, INT64 dim);
export void OPV_Module (OPT_Node prog);
-static LONGINT OPV_NaturalAlignment (LONGINT size, LONGINT max);
static void OPV_NewArr (OPT_Node d, OPT_Node x);
-static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, INTEGER comp);
+static void OPV_ParIntLiteral (INT64 n, INT32 size);
+static INT16 OPV_Precedence (INT16 class, INT16 subclass, INT16 form, INT16 comp);
static BOOLEAN OPV_SideEffects (OPT_Node n);
-static void OPV_SizeCast (LONGINT size);
+static void OPV_SizeCast (OPT_Node n, INT32 to);
static void OPV_Stamp (OPS_Name s);
static OPT_Object OPV_SuperProc (OPT_Node n);
static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported);
static void OPV_TraverseRecord (OPT_Struct typ);
-export void OPV_TypSize (OPT_Struct typ);
static void OPV_TypeOf (OPT_Node n);
-static void OPV_design (OPT_Node n, INTEGER prec);
-static void OPV_expr (OPT_Node n, INTEGER prec);
+static void OPV_design (OPT_Node n, INT16 prec);
+static void OPV_expr (OPT_Node n, INT16 prec);
static void OPV_stat (OPT_Node n, OPT_Object outerProc);
-static LONGINT OPV_NaturalAlignment (LONGINT size, LONGINT max)
-{
- LONGINT _o_result;
- LONGINT i;
- if (size >= max) {
- _o_result = max;
- return _o_result;
- } else {
- i = 1;
- while (i < size) {
- i += i;
- }
- _o_result = i;
- return _o_result;
- }
- __RETCHK;
-}
-
-void OPV_TypSize (OPT_Struct typ)
-{
- INTEGER f, c;
- LONGINT offset, size, base, fbase, off0;
- OPT_Object fld = NIL;
- OPT_Struct btyp = NIL;
- if (typ == OPT_undftyp) {
- OPM_err(58);
- } else if (typ->size == -1) {
- f = typ->form;
- c = typ->comp;
- if (c == 4) {
- btyp = typ->BaseTyp;
- if (btyp == NIL) {
- offset = 0;
- base = OPC_SizeAlignment(OPM_RecSize);
- } else {
- OPV_TypSize(btyp);
- offset = btyp->size - (SYSTEM_INT64)__ASHR(btyp->sysflag, 8);
- base = btyp->align;
- }
- fld = typ->link;
- while ((fld != NIL && fld->mode == 4)) {
- btyp = fld->typ;
- OPV_TypSize(btyp);
- size = btyp->size;
- fbase = OPC_BaseAlignment(btyp);
- OPC_Align(&offset, fbase);
- fld->adr = offset;
- offset += size;
- if (fbase > base) {
- base = fbase;
- }
- fld = fld->link;
- }
- off0 = offset;
- if (offset == 0) {
- offset = 1;
- }
- if (OPM_RecSize == 0) {
- base = OPV_NaturalAlignment(offset, OPC_SizeAlignment(OPM_RecSize));
- }
- OPC_Align(&offset, base);
- if ((typ->strobj == NIL && __MASK(typ->align, -65536) == 0)) {
- OPV_recno += 1;
- base += __ASHL(OPV_recno, 16);
- }
- typ->size = offset;
- typ->align = base;
- typ->sysflag = __MASK(typ->sysflag, -256) + (int)__ASHL(offset - off0, 8);
- } else if (c == 2) {
- OPV_TypSize(typ->BaseTyp);
- typ->size = typ->n * typ->BaseTyp->size;
- } else if (f == 13) {
- typ->size = OPM_PointerSize;
- if (typ->BaseTyp == OPT_undftyp) {
- OPM_Mark(128, typ->n);
- } else {
- OPV_TypSize(typ->BaseTyp);
- }
- } else if (f == 14) {
- typ->size = OPM_ProcSize;
- } else if (c == 3) {
- btyp = typ->BaseTyp;
- OPV_TypSize(btyp);
- if (btyp->comp == 3) {
- typ->size = btyp->size + 4;
- } else {
- typ->size = 8;
- }
- }
- }
-}
-
void OPV_Init (void)
{
OPV_stamp = 0;
- OPV_recno = 0;
OPV_nofExitLabels = 0;
- OPV_assert = __IN(7, OPM_opt);
- OPV_inxchk = __IN(0, OPM_opt);
- OPV_mainprog = __IN(10, OPM_opt);
- OPV_ansi = __IN(6, OPM_opt);
}
static void OPV_GetTProcNum (OPT_Object obj)
{
- LONGINT oldPos;
+ INT32 oldPos;
OPT_Struct typ = NIL;
OPT_Object redef = NIL;
oldPos = OPM_errpos;
OPM_errpos = obj->scope->adr;
typ = obj->link->typ;
- if (typ->form == 13) {
+ if (typ->form == 11) {
typ = typ->BaseTyp;
}
OPT_FindField(obj->name, typ->BaseTyp, &redef);
if (redef != NIL) {
obj->adr = __ASHL(__ASHR(redef->adr, 16), 16);
- if (!__IN(2, obj->conval->setval)) {
+ if (!__IN(2, obj->conval->setval, 64)) {
OPM_err(119);
}
} else {
@@ -192,37 +96,37 @@ static void OPV_TraverseRecord (OPT_Struct typ)
static void OPV_Stamp (OPS_Name s)
{
- INTEGER i, j, k;
+ INT16 i, j, k;
CHAR n[10];
OPV_stamp += 1;
i = 0;
j = OPV_stamp;
- while (s[__X(i, ((LONGINT)(256)))] != 0x00) {
+ while (s[__X(i, 256)] != 0x00) {
i += 1;
}
if (i > 25) {
i = 25;
}
- s[__X(i, ((LONGINT)(256)))] = '_';
- s[__X(i + 1, ((LONGINT)(256)))] = '_';
+ s[__X(i, 256)] = '_';
+ s[__X(i + 1, 256)] = '_';
i += 2;
k = 0;
do {
- n[__X(k, ((LONGINT)(10)))] = (CHAR)((int)__MOD(j, 10) + 48);
+ n[__X(k, 10)] = (CHAR)((int)__MOD(j, 10) + 48);
j = __DIV(j, 10);
k += 1;
} while (!(j == 0));
do {
k -= 1;
- s[__X(i, ((LONGINT)(256)))] = n[__X(k, ((LONGINT)(10)))];
+ s[__X(i, 256)] = n[__X(k, 10)];
i += 1;
} while (!(k == 0));
- s[__X(i, ((LONGINT)(256)))] = 0x00;
+ s[__X(i, 256)] = 0x00;
}
static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported)
{
- INTEGER mode;
+ INT16 mode;
OPT_Object scope = NIL;
OPT_Struct typ = NIL;
if (obj != NIL) {
@@ -235,8 +139,8 @@ static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exporte
mode = obj->mode;
if ((mode == 5 && (obj->vis != 0) == exported)) {
typ = obj->typ;
- OPV_TypSize(obj->typ);
- if (typ->form == 13) {
+ OPT_TypSize(obj->typ);
+ if (typ->form == 11) {
typ = typ->BaseTyp;
}
if (typ->comp == 4) {
@@ -245,21 +149,21 @@ static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exporte
} else if (mode == 13) {
OPV_GetTProcNum(obj);
} else if (mode == 1) {
- OPV_TypSize(obj->typ);
+ OPT_TypSize(obj->typ);
}
if (!exported) {
- if ((__IN(mode, 0x60) && obj->mnolev > 0)) {
+ if ((__IN(mode, 0x60, 32) && obj->mnolev > 0)) {
OPV_Stamp(obj->name);
}
- if (__IN(mode, 0x26)) {
+ if (__IN(mode, 0x26, 32)) {
obj->scope = outerScope;
- } else if (__IN(mode, 0x26c0)) {
+ } else if (__IN(mode, 0x26c0, 32)) {
if (obj->conval->setval == 0x0) {
OPM_err(129);
}
scope = obj->scope;
scope->leaf = 1;
- __COPY(obj->name, scope->name, ((LONGINT)(256)));
+ __COPY(obj->name, scope->name, 256);
OPV_Stamp(scope->name);
if (mode == 9) {
obj->adr = 1;
@@ -276,66 +180,66 @@ static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exporte
void OPV_AdrAndSize (OPT_Object topScope)
{
+ __ASSERT(OPT_sinttyp != NIL, 0);
+ __ASSERT(OPT_inttyp != NIL, 0);
+ __ASSERT(OPT_linttyp != NIL, 0);
OPM_errpos = topScope->adr;
topScope->leaf = 1;
OPV_Traverse(topScope->right, topScope, 1);
OPV_Traverse(topScope->right, topScope, 0);
OPT_chartyp->strobj->linkadr = 2;
+ OPT_cpbytetyp->strobj->linkadr = 2;
OPT_settyp->strobj->linkadr = 2;
OPT_realtyp->strobj->linkadr = 2;
- OPT_inttyp->strobj->linkadr = 2;
- OPT_linttyp->strobj->linkadr = 2;
+ OPT_adrtyp->strobj->linkadr = 2;
+ OPT_int8typ->strobj->linkadr = 2;
+ OPT_int16typ->strobj->linkadr = 2;
+ OPT_int32typ->strobj->linkadr = 2;
+ OPT_int64typ->strobj->linkadr = 2;
+ OPT_set32typ->strobj->linkadr = 2;
+ OPT_set64typ->strobj->linkadr = 2;
+ OPT_hinttyp->strobj->linkadr = 2;
OPT_lrltyp->strobj->linkadr = 2;
- OPT_sinttyp->strobj->linkadr = 2;
OPT_booltyp->strobj->linkadr = 2;
OPT_bytetyp->strobj->linkadr = 2;
OPT_sysptrtyp->strobj->linkadr = 2;
}
-static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, INTEGER comp)
+static INT16 OPV_Precedence (INT16 class, INT16 subclass, INT16 form, INT16 comp)
{
- INTEGER _o_result;
switch (class) {
case 7: case 0: case 2: case 4: case 9:
case 13:
- _o_result = 10;
- return _o_result;
+ return 10;
break;
case 5:
- if (__IN(3, OPM_opt)) {
- _o_result = 10;
- return _o_result;
+ if (__IN(3, OPM_Options, 32)) {
+ return 10;
} else {
- _o_result = 9;
- return _o_result;
+ return 9;
}
break;
case 1:
- if (__IN(comp, 0x0c)) {
- _o_result = 10;
- return _o_result;
+ if (__IN(comp, 0x0c, 32)) {
+ return 10;
} else {
- _o_result = 9;
- return _o_result;
+ return 9;
}
break;
case 3:
- _o_result = 9;
- return _o_result;
+ return 9;
break;
case 11:
switch (subclass) {
case 33: case 7: case 24: case 29: case 20:
- _o_result = 9;
- return _o_result;
+ return 9;
break;
case 16: case 21: case 22: case 23: case 25:
- _o_result = 10;
- return _o_result;
+ return 10;
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence OPT.Nmop, subclass = ", (LONGINT)55);
- OPM_LogWNum(subclass, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence OPT.Nmop, subclass = ", 55);
+ OPM_LogWNum(subclass, 0);
OPM_LogWLn();
break;
}
@@ -343,91 +247,75 @@ static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, IN
case 12:
switch (subclass) {
case 1:
- if (form == 9) {
- _o_result = 4;
- return _o_result;
+ if (form == 7) {
+ return 4;
} else {
- _o_result = 8;
- return _o_result;
+ return 8;
}
break;
case 2:
- if (form == 9) {
- _o_result = 3;
- return _o_result;
+ if (form == 7) {
+ return 3;
} else {
- _o_result = 8;
- return _o_result;
+ return 8;
}
break;
case 3: case 4:
- _o_result = 10;
- return _o_result;
+ return 10;
break;
case 6:
- if (form == 9) {
- _o_result = 2;
- return _o_result;
+ if (form == 7) {
+ return 2;
} else {
- _o_result = 7;
- return _o_result;
+ return 7;
}
break;
case 7:
- if (form == 9) {
- _o_result = 4;
- return _o_result;
+ if (form == 7) {
+ return 4;
} else {
- _o_result = 7;
- return _o_result;
+ return 7;
}
break;
case 11: case 12: case 13: case 14:
- _o_result = 6;
- return _o_result;
+ return 6;
break;
case 9: case 10:
- _o_result = 5;
- return _o_result;
+ return 5;
break;
case 5:
- _o_result = 1;
- return _o_result;
+ return 1;
break;
case 8:
- _o_result = 0;
- return _o_result;
+ return 0;
break;
case 19: case 15: case 17: case 18: case 26:
case 27: case 28:
- _o_result = 10;
- return _o_result;
+ return 10;
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence OPT.Ndop, subclass = ", (LONGINT)55);
- OPM_LogWNum(subclass, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence OPT.Ndop, subclass = ", 55);
+ OPM_LogWNum(subclass, 0);
OPM_LogWLn();
break;
}
break;
case 10:
- _o_result = 10;
- return _o_result;
+ return 10;
break;
case 8: case 6:
- _o_result = 12;
- return _o_result;
+ return 12;
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence, class = ", (LONGINT)43);
- OPM_LogWNum(class, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence, class = ", 43);
+ OPM_LogWNum(class, 0);
OPM_LogWLn();
break;
}
__RETCHK;
}
-static void OPV_Len (OPT_Node n, LONGINT dim)
+static void OPV_Len (OPT_Node n, INT64 dim)
{
while ((n->class == 4 && n->typ->comp == 3)) {
dim += 1;
@@ -435,7 +323,7 @@ static void OPV_Len (OPT_Node n, LONGINT dim)
}
if ((n->class == 3 && n->typ->comp == 3)) {
OPV_design(n->left, 10);
- OPM_WriteString((CHAR*)"->len[", (LONGINT)7);
+ OPM_WriteString((CHAR*)"->len[", 7);
OPM_WriteInt(dim);
OPM_Write(']');
} else {
@@ -445,21 +333,18 @@ static void OPV_Len (OPT_Node n, LONGINT dim)
static BOOLEAN OPV_SideEffects (OPT_Node n)
{
- BOOLEAN _o_result;
if (n != NIL) {
- _o_result = (n->class == 13 || OPV_SideEffects(n->left)) || OPV_SideEffects(n->right);
- return _o_result;
+ return (n->class == 13 || OPV_SideEffects(n->left)) || OPV_SideEffects(n->right);
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-static void OPV_Entier (OPT_Node n, INTEGER prec)
+static void OPV_Entier (OPT_Node n, INT16 prec)
{
- if (__IN(n->typ->form, 0x0180)) {
- OPM_WriteString((CHAR*)"__ENTIER(", (LONGINT)10);
+ if (__IN(n->typ->form, 0x60, 32)) {
+ OPM_WriteString((CHAR*)"__ENTIER(", 10);
OPV_expr(n, -1);
OPM_Write(')');
} else {
@@ -467,44 +352,49 @@ static void OPV_Entier (OPT_Node n, INTEGER prec)
}
}
-static void OPV_SizeCast (LONGINT size)
+static void OPV_SizeCast (OPT_Node n, INT32 to)
{
- if (size <= 4) {
- OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
+ if ((to < n->typ->size && __IN(2, OPM_Options, 32))) {
+ OPM_WriteString((CHAR*)"__SHORT", 8);
+ if (OPV_SideEffects(n)) {
+ OPM_Write('F');
+ }
+ OPM_Write('(');
+ OPV_Entier(n, -1);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPM_WriteInt(OPM_SignedMaximum(to) + 1);
+ OPM_Write(')');
} else {
- OPM_WriteString((CHAR*)"(SYSTEM_INT64)", (LONGINT)15);
+ if ((n->typ->size != to && (n->typ->size > 4 || to != 4))) {
+ OPM_WriteString((CHAR*)"(INT", 5);
+ OPM_WriteInt(__ASHL(to, 3));
+ OPM_WriteString((CHAR*)")", 2);
+ }
}
}
-static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INTEGER prec)
+static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec)
{
- INTEGER from, to;
+ INT16 from, to;
from = n->typ->form;
to = newtype->form;
- if (to == 9) {
- OPM_WriteString((CHAR*)"__SETOF(", (LONGINT)9);
- OPV_Entier(n, -1);
- OPM_Write(')');
- } else if (__IN(to, 0x70)) {
- if ((newtype->size < n->typ->size && __IN(2, OPM_opt))) {
- OPM_WriteString((CHAR*)"__SHORT", (LONGINT)8);
- if (OPV_SideEffects(n)) {
- OPM_Write('F');
- }
- OPM_Write('(');
- OPV_Entier(n, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPM_WriteInt(OPM_SignedMaximum(newtype->size) + 1);
- OPM_Write(')');
- } else {
- if (newtype->size != n->typ->size) {
- OPV_SizeCast(newtype->size);
- }
+ 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);
+ OPM_WriteString((CHAR*)",", 2);
+ OPM_WriteInt(__ASHL(newtype->size, 3));
+ OPM_Write(')');
}
+ } else if (to == 4) {
+ OPV_SizeCast(n, newtype->size);
+ OPV_Entier(n, 9);
} else if (to == 3) {
- if (__IN(2, OPM_opt)) {
- OPM_WriteString((CHAR*)"__CHR", (LONGINT)6);
+ if (__IN(2, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__CHR", 6);
if (OPV_SideEffects(n)) {
OPM_Write('F');
}
@@ -512,7 +402,7 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INTEGER prec)
OPV_Entier(n, -1);
OPM_Write(')');
} else {
- OPM_WriteString((CHAR*)"(CHAR)", (LONGINT)7);
+ OPM_WriteString((CHAR*)"(CHAR)", 7);
OPV_Entier(n, 9);
}
} else {
@@ -522,15 +412,15 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INTEGER prec)
static void OPV_TypeOf (OPT_Node n)
{
- if (n->typ->form == 13) {
- OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10);
+ if (n->typ->form == 11) {
+ OPM_WriteString((CHAR*)"__TYPEOF(", 10);
OPV_expr(n, -1);
OPM_Write(')');
- } else if (__IN(n->class, 0x15)) {
+ } else if (__IN(n->class, 0x15, 32)) {
OPC_Andent(n->typ);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__typ", 6);
} else if (n->class == 3) {
- OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__TYPEOF(", 10);
OPV_expr(n->left, -1);
OPM_Write(')');
} else if (n->class == 5) {
@@ -542,35 +432,35 @@ static void OPV_TypeOf (OPT_Node n)
}
}
-static void OPV_Index (OPT_Node n, OPT_Node d, INTEGER prec, INTEGER dim)
+static void OPV_Index (OPT_Node n, OPT_Node d, INT16 prec, INT16 dim)
{
- if (!OPV_inxchk || (n->right->class == 7 && (n->right->conval->intval == 0 || n->left->typ->comp != 3))) {
+ if (!__IN(0, OPM_Options, 32) || (n->right->class == 7 && (n->right->conval->intval == 0 || n->left->typ->comp != 3))) {
OPV_expr(n->right, prec);
} else {
if (OPV_SideEffects(n->right)) {
- OPM_WriteString((CHAR*)"__XF(", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__XF(", 6);
} else {
- OPM_WriteString((CHAR*)"__X(", (LONGINT)5);
+ OPM_WriteString((CHAR*)"__X(", 5);
}
OPV_expr(n->right, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_Len(d, dim);
OPM_Write(')');
}
}
-static void OPV_design (OPT_Node n, INTEGER prec)
+static void OPV_design (OPT_Node n, INT16 prec)
{
OPT_Object obj = NIL;
OPT_Struct typ = NIL;
- INTEGER class, designPrec, comp;
+ INT16 class, designPrec, comp;
OPT_Node d = NIL, x = NIL;
- INTEGER dims, i, _for__27;
+ INT16 dims, i, _for__26;
comp = n->typ->comp;
obj = n->obj;
class = n->class;
designPrec = OPV_Precedence(class, n->subcl, n->typ->form, comp);
- if ((((((class == 0 && obj->mnolev > 0)) && (int)obj->mnolev != OPM_level)) && prec == 10)) {
+ if ((((((class == 0 && obj->mnolev > 0)) && (INT16)obj->mnolev != OPM_level)) && prec == 10)) {
designPrec = 9;
}
if (prec > designPrec) {
@@ -587,7 +477,7 @@ static void OPV_design (OPT_Node n, INTEGER prec)
OPC_CompleteIdent(n->obj);
break;
case 1:
- if (!__IN(comp, 0x0c)) {
+ if (!__IN(comp, 0x0c, 32)) {
OPM_Write('*');
}
OPC_CompleteIdent(n->obj);
@@ -595,7 +485,7 @@ static void OPV_design (OPT_Node n, INTEGER prec)
case 2:
if (n->left->class == 3) {
OPV_design(n->left->left, designPrec);
- OPM_WriteString((CHAR*)"->", (LONGINT)3);
+ OPM_WriteString((CHAR*)"->", 3);
} else {
OPV_design(n->left, designPrec);
OPM_Write('.');
@@ -605,7 +495,7 @@ static void OPV_design (OPT_Node n, INTEGER prec)
case 3:
if (n->typ->comp == 3) {
OPV_design(n->left, 10);
- OPM_WriteString((CHAR*)"->data", (LONGINT)7);
+ OPM_WriteString((CHAR*)"->data", 7);
} else {
OPM_Write('*');
OPV_design(n->left, designPrec);
@@ -632,25 +522,25 @@ static void OPV_design (OPT_Node n, INTEGER prec)
while (x != d) {
if (x->left != d) {
OPV_Index(x, d, 7, i);
- OPM_WriteString((CHAR*)" + ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" + ", 4);
OPV_Len(d, i);
- OPM_WriteString((CHAR*)" * (", (LONGINT)5);
+ OPM_WriteString((CHAR*)" * (", 5);
i -= 1;
} else {
OPV_Index(x, d, -1, i);
}
x = x->left;
}
- _for__27 = dims;
+ _for__26 = dims;
i = 1;
- while (i <= _for__27) {
+ while (i <= _for__26) {
OPM_Write(')');
i += 1;
}
if (n->typ->comp == 3) {
OPM_Write(')');
- while ((SYSTEM_INT64)i < __ASHR(d->typ->size - 4, 2)) {
- OPM_WriteString((CHAR*)" * ", (LONGINT)4);
+ while (i < __ASHR(d->typ->size - 4, 2)) {
+ OPM_WriteString((CHAR*)" * ", 4);
OPV_Len(d, i);
i += 1;
}
@@ -666,35 +556,35 @@ static void OPV_design (OPT_Node n, INTEGER prec)
case 5:
typ = n->typ;
obj = n->left->obj;
- if (__IN(3, OPM_opt)) {
+ if (__IN(3, OPM_Options, 32)) {
if (typ->comp == 4) {
- OPM_WriteString((CHAR*)"__GUARDR(", (LONGINT)10);
- if ((int)obj->mnolev != OPM_level) {
- OPM_WriteStringVar((void*)obj->scope->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"__curr->", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__GUARDR(", 10);
+ if ((INT16)obj->mnolev != OPM_level) {
+ OPM_WriteStringVar((void*)obj->scope->name, 256);
+ OPM_WriteString((CHAR*)"__curr->", 9);
OPC_Ident(obj);
} else {
OPC_Ident(obj);
}
} else {
if (typ->BaseTyp->strobj == NIL) {
- OPM_WriteString((CHAR*)"__GUARDA(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__GUARDA(", 10);
} else {
- OPM_WriteString((CHAR*)"__GUARDP(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__GUARDP(", 10);
}
OPV_expr(n->left, -1);
typ = typ->BaseTyp;
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(typ->extlev);
OPM_Write(')');
} else {
if (typ->comp == 4) {
- OPM_WriteString((CHAR*)"*(", (LONGINT)3);
+ OPM_WriteString((CHAR*)"*(", 3);
OPC_Ident(typ->strobj);
- OPM_WriteString((CHAR*)"*)", (LONGINT)3);
+ OPM_WriteString((CHAR*)"*)", 3);
OPC_CompleteIdent(obj);
} else {
OPM_Write('(');
@@ -705,17 +595,17 @@ static void OPV_design (OPT_Node n, INTEGER prec)
}
break;
case 6:
- if (__IN(3, OPM_opt)) {
+ if (__IN(3, OPM_Options, 32)) {
if (n->left->class == 1) {
- OPM_WriteString((CHAR*)"__GUARDEQR(", (LONGINT)12);
+ OPM_WriteString((CHAR*)"__GUARDEQR(", 12);
OPC_CompleteIdent(n->left->obj);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_TypeOf(n->left);
} else {
- OPM_WriteString((CHAR*)"__GUARDEQP(", (LONGINT)12);
+ OPM_WriteString((CHAR*)"__GUARDEQP(", 12);
OPV_expr(n->left->left, -1);
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Ident(n->left->typ->strobj);
OPM_Write(')');
} else {
@@ -728,8 +618,8 @@ static void OPV_design (OPT_Node n, INTEGER prec)
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.design, class = ", (LONGINT)39);
- OPM_LogWNum(class, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.design, class = ", 39);
+ OPM_LogWNum(class, 0);
OPM_LogWLn();
break;
}
@@ -738,10 +628,15 @@ static void OPV_design (OPT_Node n, INTEGER prec)
}
}
+static void OPV_ParIntLiteral (INT64 n, INT32 size)
+{
+ OPM_WriteInt(n);
+}
+
static void OPV_ActualPar (OPT_Node n, OPT_Object fp)
{
OPT_Struct typ = NIL, aptyp = NIL;
- INTEGER comp, form, mode, prec, dim;
+ INT16 comp, form, mode, prec, dim;
OPM_Write('(');
while (n != NIL) {
typ = fp->typ;
@@ -752,81 +647,68 @@ static void OPV_ActualPar (OPT_Node n, OPT_Object fp)
if ((((mode == 2 && n->class == 11)) && n->subcl == 29)) {
OPM_Write('(');
OPC_Ident(n->typ->strobj);
- OPM_WriteString((CHAR*)"*)", (LONGINT)3);
+ OPM_WriteString((CHAR*)"*)", 3);
prec = 10;
}
- if (!__IN(n->typ->comp, 0x0c)) {
+ if (!__IN(n->typ->comp, 0x0c, 32)) {
if (mode == 2) {
- if ((OPV_ansi && typ != n->typ)) {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
+ if (typ != n->typ) {
+ OPM_WriteString((CHAR*)"(void*)", 8);
}
OPM_Write('&');
prec = 9;
- } else if (OPV_ansi) {
- if ((__IN(comp, 0x0c) && n->class == 7)) {
- OPM_WriteString((CHAR*)"(CHAR*)", (LONGINT)8);
- } else if ((((form == 13 && typ != n->typ)) && n->typ != OPT_niltyp)) {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
- }
} else {
- if ((__IN(form, 0x0180) && __IN(n->typ->form, 0x70))) {
- OPM_WriteString((CHAR*)"(double)", (LONGINT)9);
- prec = 9;
- } else if ((form == 6 && n->typ->form < 6)) {
- OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10);
- prec = 9;
+ if ((__IN(comp, 0x0c, 32) && n->class == 7)) {
+ OPM_WriteString((CHAR*)"(CHAR*)", 8);
+ } else if ((((form == 11 && typ != n->typ)) && n->typ != OPT_niltyp)) {
+ OPM_WriteString((CHAR*)"(void*)", 8);
}
}
- } else if (OPV_ansi) {
+ } else {
if ((((mode == 2 && typ != n->typ)) && prec == -1)) {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
+ OPM_WriteString((CHAR*)"(void*)", 8);
}
}
if ((((mode == 2 && n->class == 11)) && n->subcl == 29)) {
OPV_expr(n->left, prec);
- } else if ((((((form == 6 && n->class == 7)) && n->conval->intval <= OPM_SignedMaximum(OPM_IntSize))) && n->conval->intval >= OPM_SignedMinimum(OPM_IntSize))) {
- OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12);
- OPV_expr(n, prec);
- OPM_WriteString((CHAR*)"))", (LONGINT)3);
+ } else if ((form == 4 && n->class == 7)) {
+ OPV_ParIntLiteral(n->conval->intval, n->typ->size);
} else {
OPV_expr(n, prec);
}
if ((comp == 4 && mode == 2)) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_TypeOf(n);
} else if (comp == 3) {
if (n->class == 7) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10);
- OPM_WriteInt(n->conval->intval2);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPV_ParIntLiteral(n->conval->intval2, OPM_AddressSize);
} else {
aptyp = n->typ;
dim = 0;
while ((typ->comp == 3 && typ->BaseTyp->form != 1)) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_Len(n, dim);
typ = typ->BaseTyp;
aptyp = aptyp->BaseTyp;
dim += 1;
}
if ((typ->comp == 3 && typ->BaseTyp->form == 1)) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
while (aptyp->comp == 3) {
OPV_Len(n, dim);
- OPM_WriteString((CHAR*)" * ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" * ", 4);
dim += 1;
aptyp = aptyp->BaseTyp;
}
- OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12);
- OPM_WriteInt(aptyp->size);
- OPM_WriteString((CHAR*)"))", (LONGINT)3);
+ OPV_ParIntLiteral(aptyp->size, OPM_AddressSize);
}
}
}
n = n->link;
fp = fp->link;
if (n != NIL) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
}
}
OPM_Write(')');
@@ -834,21 +716,19 @@ static void OPV_ActualPar (OPT_Node n, OPT_Object fp)
static OPT_Object OPV_SuperProc (OPT_Node n)
{
- OPT_Object _o_result;
OPT_Object obj = NIL;
OPT_Struct typ = NIL;
typ = n->right->typ;
- if (typ->form == 13) {
+ if (typ->form == 11) {
typ = typ->BaseTyp;
}
OPT_FindField(n->left->obj->name, typ->BaseTyp, &obj);
- _o_result = obj;
- return _o_result;
+ return obj;
}
-static void OPV_expr (OPT_Node n, INTEGER prec)
+static void OPV_expr (OPT_Node n, INT16 prec)
{
- INTEGER class, subclass, form, exprPrec;
+ INT16 class, subclass, form, exprPrec;
OPT_Struct typ = NIL;
OPT_Node l = NIL, r = NIL;
OPT_Object proc = NIL;
@@ -858,7 +738,7 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
l = n->left;
r = n->right;
exprPrec = OPV_Precedence(class, subclass, form, n->typ->comp);
- if ((exprPrec <= prec && __IN(class, 0x3ce0))) {
+ if ((exprPrec <= prec && __IN(class, 0x3ce0, 32))) {
OPM_Write('(');
}
switch (class) {
@@ -866,10 +746,12 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPC_Constant(n->conval, form);
break;
case 10:
- OPM_WriteString((CHAR*)"__SETRNG(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__SETRNG(", 10);
OPV_expr(l, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(r, -1);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPM_WriteInt(__ASHL(n->typ->size, 3));
OPM_Write(')');
break;
case 11:
@@ -879,7 +761,7 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPV_expr(l, exprPrec);
break;
case 7:
- if (form == 9) {
+ if (form == 7) {
OPM_Write('~');
} else {
OPM_Write('-');
@@ -889,16 +771,16 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
case 16:
typ = n->obj->typ;
if (l->typ->comp == 4) {
- OPM_WriteString((CHAR*)"__IS(", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__IS(", 6);
OPC_TypeOf(l->obj);
} else {
- OPM_WriteString((CHAR*)"__ISP(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__ISP(", 7);
OPV_expr(l, -1);
typ = typ->BaseTyp;
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Andent(typ);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(typ->extlev);
OPM_Write(')');
break;
@@ -907,54 +789,54 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
break;
case 21:
if (OPV_SideEffects(l)) {
- if (l->typ->form < 7) {
- if (l->typ->form < 6) {
- OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
+ if (l->typ->form < 5) {
+ if (l->typ->size <= 4) {
+ OPM_WriteString((CHAR*)"(int)", 6);
}
- OPM_WriteString((CHAR*)"__ABSF(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ABSF(", 8);
} else {
- OPM_WriteString((CHAR*)"__ABSFD(", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__ABSFD(", 9);
}
} else {
- OPM_WriteString((CHAR*)"__ABS(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__ABS(", 7);
}
OPV_expr(l, -1);
OPM_Write(')');
break;
case 22:
- OPM_WriteString((CHAR*)"__CAP(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__CAP(", 7);
OPV_expr(l, -1);
OPM_Write(')');
break;
case 23:
- OPM_WriteString((CHAR*)"__ODD(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__ODD(", 7);
OPV_expr(l, -1);
OPM_Write(')');
break;
case 24:
- OPM_WriteString((CHAR*)"(LONGINT)(SYSTEM_ADDRESS)", (LONGINT)26);
+ OPM_WriteString((CHAR*)"(ADDRESS)", 10);
if (l->class == 1) {
OPC_CompleteIdent(l->obj);
} else {
- if ((l->typ->form != 10 && !__IN(l->typ->comp, 0x0c))) {
+ if ((l->typ->form != 8 && !__IN(l->typ->comp, 0x0c, 32))) {
OPM_Write('&');
}
OPV_expr(l, exprPrec);
}
break;
case 29:
- if (!__IN(l->class, 0x17) || (((__IN(n->typ->form, 0x6240) && __IN(l->typ->form, 0x6240))) && n->typ->size == l->typ->size)) {
+ if (!__IN(l->class, 0x17, 32) || (((__IN(n->typ->form, 0x1890, 32) && __IN(l->typ->form, 0x1890, 32))) && n->typ->size == l->typ->size)) {
OPM_Write('(');
OPC_Ident(n->typ->strobj);
OPM_Write(')');
- if (__IN(n->typ->form, 0x6000) || __IN(l->typ->form, 0x6000)) {
- OPM_WriteString((CHAR*)"(SYSTEM_ADDRESS)", (LONGINT)17);
+ if (__IN(n->typ->form, 0x1800, 32) || __IN(l->typ->form, 0x1800, 32)) {
+ OPM_WriteString((CHAR*)"(ADDRESS)", 10);
}
OPV_expr(l, exprPrec);
} else {
- OPM_WriteString((CHAR*)"__VAL(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__VAL(", 7);
OPC_Ident(n->typ->strobj);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(l, -1);
OPM_Write(')');
}
@@ -973,94 +855,98 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
case 28: case 3: case 4:
switch (subclass) {
case 15:
- OPM_WriteString((CHAR*)"__IN(", (LONGINT)6);
+ OPM_WriteString((CHAR*)"__IN(", 6);
break;
case 17:
if (r->class == 7) {
if (r->conval->intval >= 0) {
- OPM_WriteString((CHAR*)"__ASHL(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ASHL(", 8);
} else {
- OPM_WriteString((CHAR*)"__ASHR(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ASHR(", 8);
}
} else if (OPV_SideEffects(r)) {
- OPM_WriteString((CHAR*)"__ASHF(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ASHF(", 8);
} else {
- OPM_WriteString((CHAR*)"__ASH(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__ASH(", 7);
}
break;
case 18:
- OPM_WriteString((CHAR*)"__MASK(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__MASK(", 8);
break;
case 26:
- OPM_WriteString((CHAR*)"__BIT(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__BIT(", 7);
break;
case 27:
if (r->class == 7) {
if (r->conval->intval >= 0) {
- OPM_WriteString((CHAR*)"__LSHL(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__LSHL(", 8);
} else {
- OPM_WriteString((CHAR*)"__LSHR(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__LSHR(", 8);
}
} else {
- OPM_WriteString((CHAR*)"__LSH(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__LSH(", 7);
}
break;
case 28:
if (r->class == 7) {
if (r->conval->intval >= 0) {
- OPM_WriteString((CHAR*)"__ROTL(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ROTL(", 8);
} else {
- OPM_WriteString((CHAR*)"__ROTR(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__ROTR(", 8);
}
} else {
- OPM_WriteString((CHAR*)"__ROT(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__ROT(", 7);
}
break;
case 3:
if (OPV_SideEffects(n)) {
- if (form < 6) {
- OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
+ if (n->typ->size <= 4) {
+ OPM_WriteString((CHAR*)"(int)", 6);
}
- OPM_WriteString((CHAR*)"__DIVF(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__DIVF(", 8);
} else {
- OPM_WriteString((CHAR*)"__DIV(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__DIV(", 7);
}
break;
case 4:
- if (form < 6) {
- OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
+ if (n->typ->size <= 4) {
+ OPM_WriteString((CHAR*)"(int)", 6);
}
if (OPV_SideEffects(n)) {
- OPM_WriteString((CHAR*)"__MODF(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__MODF(", 8);
} else {
- OPM_WriteString((CHAR*)"__MOD(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__MOD(", 7);
}
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", (LONGINT)40);
- OPM_LogWNum(subclass, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", 40);
+ OPM_LogWNum(subclass, 0);
OPM_LogWLn();
break;
}
OPV_expr(l, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- if ((((__IN(subclass, 0x18020000) && r->class == 7)) && r->conval->intval < 0)) {
+ OPM_WriteString((CHAR*)", ", 3);
+ if ((((__IN(subclass, 0x18020000, 32) && r->class == 7)) && r->conval->intval < 0)) {
OPM_WriteInt(-r->conval->intval);
} else {
OPV_expr(r, -1);
}
- if (__IN(subclass, 0x18000000)) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPC_Ident(l->typ->strobj);
+ if (__IN(subclass, 0x18008000, 32)) {
+ OPM_WriteString((CHAR*)", ", 3);
+ if (subclass == 15) {
+ OPM_WriteInt(__ASHL(r->typ->size, 3));
+ } else {
+ OPM_WriteInt(__ASHL(l->typ->size, 3));
+ }
}
OPM_Write(')');
break;
case 9: case 10: case 11: case 12: case 13:
case 14:
- if (__IN(l->typ->form, 0x8400)) {
- OPM_WriteString((CHAR*)"__STRCMP(", (LONGINT)10);
+ if (__IN(l->typ->form, 0x2100, 32)) {
+ OPM_WriteString((CHAR*)"__STRCMP(", 10);
OPV_expr(l, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(r, -1);
OPM_Write(')');
OPC_Cmp(subclass);
@@ -1069,31 +955,31 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPV_expr(l, exprPrec);
OPC_Cmp(subclass);
typ = l->typ;
- if ((((((typ->form == 13 && r->typ->form != 11)) && r->typ != typ)) && r->typ != OPT_sysptrtyp)) {
- OPM_WriteString((CHAR*)"(void *) ", (LONGINT)10);
+ if ((((((typ->form == 11 && r->typ->form != 9)) && r->typ != typ)) && r->typ != OPT_sysptrtyp)) {
+ OPM_WriteString((CHAR*)"(void *) ", 10);
}
OPV_expr(r, exprPrec);
}
break;
default:
- if (subclass == 5 || (form == 9 && (subclass == 1 || subclass == 7))) {
+ if (subclass == 5 || (form == 7 && (subclass == 1 || subclass == 7))) {
OPM_Write('(');
}
OPV_expr(l, exprPrec);
switch (subclass) {
case 1:
- if (form == 9) {
- OPM_WriteString((CHAR*)" & ", (LONGINT)4);
+ if (form == 7) {
+ OPM_WriteString((CHAR*)" & ", 4);
} else {
- OPM_WriteString((CHAR*)" * ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" * ", 4);
}
break;
case 2:
- if (form == 9) {
- OPM_WriteString((CHAR*)" ^ ", (LONGINT)4);
+ if (form == 7) {
+ OPM_WriteString((CHAR*)" ^ ", 4);
} else {
- OPM_WriteString((CHAR*)" / ", (LONGINT)4);
- if (r->obj == NIL || __IN(r->obj->typ->form, 0x70)) {
+ OPM_WriteString((CHAR*)" / ", 4);
+ if (r->obj == NIL || r->obj->typ->form == 4) {
OPM_Write('(');
OPC_Ident(n->typ->strobj);
OPM_Write(')');
@@ -1101,33 +987,33 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
}
break;
case 5:
- OPM_WriteString((CHAR*)" && ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" && ", 5);
break;
case 6:
- if (form == 9) {
- OPM_WriteString((CHAR*)" | ", (LONGINT)4);
+ if (form == 7) {
+ OPM_WriteString((CHAR*)" | ", 4);
} else {
- OPM_WriteString((CHAR*)" + ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" + ", 4);
}
break;
case 7:
- if (form == 9) {
- OPM_WriteString((CHAR*)" & ~", (LONGINT)5);
+ if (form == 7) {
+ OPM_WriteString((CHAR*)" & ~", 5);
} else {
- OPM_WriteString((CHAR*)" - ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" - ", 4);
}
break;
case 8:
- OPM_WriteString((CHAR*)" || ", (LONGINT)5);
+ OPM_WriteString((CHAR*)" || ", 5);
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", (LONGINT)40);
- OPM_LogWNum(subclass, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", 40);
+ OPM_LogWNum(subclass, 0);
OPM_LogWLn();
break;
}
OPV_expr(r, exprPrec);
- if (subclass == 5 || (form == 9 && (subclass == 1 || subclass == 7))) {
+ if (subclass == 5 || (form == 7 && (subclass == 1 || subclass == 7))) {
OPM_Write(')');
}
break;
@@ -1138,7 +1024,7 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
if (l->subcl == 1) {
proc = OPV_SuperProc(n);
} else {
- OPM_WriteString((CHAR*)"__", (LONGINT)3);
+ OPM_WriteString((CHAR*)"__", 3);
proc = OPC_BaseTProc(l->obj);
}
OPC_Ident(proc);
@@ -1154,7 +1040,7 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPV_design(n, prec);
break;
}
- if ((exprPrec <= prec && __IN(class, 0x3ca0))) {
+ if ((exprPrec <= prec && __IN(class, 0x3ca0, 32))) {
OPM_Write(')');
}
}
@@ -1164,10 +1050,10 @@ static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc)
OPT_Node if_ = NIL;
OPT_Object obj = NIL;
OPT_Struct typ = NIL;
- LONGINT adr;
+ INT32 adr;
if_ = n->left;
while (if_ != NIL) {
- OPM_WriteString((CHAR*)"if ", (LONGINT)4);
+ OPM_WriteString((CHAR*)"if ", 4);
OPV_expr(if_->left, 12);
OPM_Write(' ');
OPC_BegBlk();
@@ -1178,9 +1064,9 @@ static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc)
if (typ->comp == 4) {
OPC_BegStat();
OPC_Ident(if_->left->obj);
- OPM_WriteString((CHAR*)" *", (LONGINT)3);
- OPM_WriteString(obj->name, ((LONGINT)(256)));
- OPM_WriteString((CHAR*)"__ = (void*)", (LONGINT)13);
+ OPM_WriteString((CHAR*)" *", 3);
+ OPM_WriteString(obj->name, 256);
+ OPM_WriteString((CHAR*)"__ = (void*)", 13);
obj->adr = 0;
OPC_CompleteIdent(obj);
OPC_EndStat();
@@ -1196,13 +1082,13 @@ static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc)
if_ = if_->link;
if ((if_ != NIL || n->right != NIL) || withtrap) {
OPC_EndBlk0();
- OPM_WriteString((CHAR*)" else ", (LONGINT)7);
+ OPM_WriteString((CHAR*)" else ", 7);
} else {
OPC_EndBlk();
}
}
if (withtrap) {
- OPM_WriteString((CHAR*)"__WITHCHK", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__WITHCHK", 10);
OPC_EndStat();
} else if (n->right != NIL) {
OPC_BegBlk();
@@ -1214,9 +1100,9 @@ static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc)
static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc)
{
OPT_Node switchCase = NIL, label = NIL;
- LONGINT low, high;
- INTEGER form, i;
- OPM_WriteString((CHAR*)"switch ", (LONGINT)8);
+ INT64 low, high;
+ INT16 form, i;
+ OPM_WriteString((CHAR*)"switch ", 8);
OPV_expr(n->left, 12);
OPM_Write(' ');
OPC_BegBlk();
@@ -1248,22 +1134,22 @@ static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc)
OPC_Indent(1);
OPV_stat(switchCase->right, outerProc);
OPC_BegStat();
- OPM_WriteString((CHAR*)"break", (LONGINT)6);
+ OPM_WriteString((CHAR*)"break", 6);
OPC_EndStat();
OPC_Indent(-1);
switchCase = switchCase->link;
}
OPC_BegStat();
- OPM_WriteString((CHAR*)"default: ", (LONGINT)10);
+ OPM_WriteString((CHAR*)"default: ", 10);
if (n->right->conval->setval != 0x0) {
OPC_Indent(1);
OPM_WriteLn();
OPV_stat(n->right->right, outerProc);
OPC_BegStat();
- OPM_WriteString((CHAR*)"break", (LONGINT)6);
+ OPM_WriteString((CHAR*)"break", 6);
OPC_Indent(-1);
} else {
- OPM_WriteString((CHAR*)"__CASECHK", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__CASECHK", 10);
}
OPC_EndStat();
OPC_EndBlk();
@@ -1271,18 +1157,16 @@ static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc)
static BOOLEAN OPV_ImplicitReturn (OPT_Node n)
{
- BOOLEAN _o_result;
while ((n != NIL && n->class != 26)) {
n = n->link;
}
- _o_result = n == NIL;
- return _o_result;
+ return n == NIL;
}
static void OPV_NewArr (OPT_Node d, OPT_Node x)
{
OPT_Struct typ = NIL, base = NIL;
- INTEGER nofdim, nofdyn;
+ INT16 nofdim, nofdyn;
typ = d->typ->BaseTyp;
base = typ;
nofdim = 0;
@@ -1293,44 +1177,40 @@ static void OPV_NewArr (OPT_Node d, OPT_Node x)
base = base->BaseTyp;
}
OPV_design(d, -1);
- OPM_WriteString((CHAR*)" = __NEWARR(", (LONGINT)13);
+ OPM_WriteString((CHAR*)" = __NEWARR(", 13);
while (base->comp == 2) {
nofdim += 1;
base = base->BaseTyp;
}
if ((base->comp == 4 && OPC_NofPtrs(base) != 0)) {
OPC_Ident(base->strobj);
- OPM_WriteString((CHAR*)"__typ", (LONGINT)6);
- } else if (base->form == 13) {
- OPM_WriteString((CHAR*)"POINTER__typ", (LONGINT)13);
+ OPM_WriteString((CHAR*)"__typ", 6);
+ } else if (base->form == 11) {
+ OPM_WriteString((CHAR*)"POINTER__typ", 13);
} else {
- OPM_WriteString((CHAR*)"NIL", (LONGINT)4);
+ OPM_WriteString((CHAR*)"NIL", 4);
}
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12);
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(base->size);
- OPM_WriteString((CHAR*)"))", (LONGINT)3);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPM_WriteInt(OPC_BaseAlignment(base));
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPM_WriteInt(OPT_BaseAlignment(base));
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(nofdim);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(nofdyn);
while (typ != base) {
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
if (typ->comp == 3) {
if (x->class == 7) {
- OPM_WriteString((CHAR*)"(LONGINT)(", (LONGINT)11);
- OPV_expr(x, -1);
- OPM_WriteString((CHAR*)")", (LONGINT)2);
+ OPC_IntLiteral(x->conval->intval, OPM_AddressSize);
} else {
- OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10);
+ OPM_WriteString((CHAR*)"((ADDRESS)(", 12);
OPV_expr(x, 10);
+ OPM_WriteString((CHAR*)"))", 3);
}
x = x->link;
} else {
- OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10);
- OPM_WriteInt(typ->n);
+ OPC_IntLiteral(typ->n, OPM_AddressSize);
}
typ = typ->BaseTyp;
}
@@ -1359,7 +1239,7 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPV_ExitInfo saved;
OPT_Node l = NIL, r = NIL;
while ((n != NIL && OPM_noerr)) {
- OPM_errpos = n->conval->intval;
+ OPM_errpos = OPM_Longint(n->conval->intval);
if (n->class != 14) {
OPC_BegStat();
}
@@ -1373,7 +1253,7 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPV_DefineTDescs(n->right);
OPC_EnterBody();
OPV_InitTDescs(n->right);
- OPM_WriteString((CHAR*)"/* BEGIN */", (LONGINT)12);
+ OPM_WriteString((CHAR*)"/* BEGIN */", 12);
OPM_WriteLn();
OPV_stat(n->right, outerProc);
OPC_ExitBody();
@@ -1399,11 +1279,11 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
l = n->left;
r = n->right;
if (l->typ->comp == 2) {
- OPM_WriteString((CHAR*)"__MOVE(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__MOVE(", 8);
OPV_expr(r, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(l, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
if (r->typ == OPT_stringtyp) {
OPM_WriteInt(r->conval->intval2);
} else {
@@ -1411,30 +1291,30 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
}
OPM_Write(')');
} else {
- if ((((((l->typ->form == 13 && l->obj != NIL)) && l->obj->adr == 1)) && l->obj->mode == 1)) {
+ if ((((((l->typ->form == 11 && l->obj != NIL)) && l->obj->adr == 1)) && l->obj->mode == 1)) {
l->obj->adr = 0;
OPV_design(l, -1);
l->obj->adr = 1;
- if (r->typ->form != 11) {
- OPM_WriteString((CHAR*)" = (void*)", (LONGINT)11);
+ if (r->typ->form != 9) {
+ OPM_WriteString((CHAR*)" = (void*)", 11);
} else {
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" = ", 4);
}
} else {
OPV_design(l, -1);
- OPM_WriteString((CHAR*)" = ", (LONGINT)4);
+ OPM_WriteString((CHAR*)" = ", 4);
}
if (l->typ == r->typ) {
OPV_expr(r, -1);
- } else if ((((l->typ->form == 13 && r->typ->form != 11)) && l->typ->strobj != NIL)) {
+ } else if ((((l->typ->form == 11 && r->typ->form != 9)) && l->typ->strobj != NIL)) {
OPM_Write('(');
OPC_Ident(l->typ->strobj);
OPM_Write(')');
OPV_expr(r, -1);
} else if (l->typ->comp == 4) {
- OPM_WriteString((CHAR*)"*(", (LONGINT)3);
+ OPM_WriteString((CHAR*)"*(", 3);
OPC_Andent(l->typ);
- OPM_WriteString((CHAR*)"*)&", (LONGINT)4);
+ OPM_WriteString((CHAR*)"*)&", 4);
OPV_expr(r, 9);
} else {
OPV_expr(r, -1);
@@ -1443,12 +1323,12 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
break;
case 1:
if (n->left->typ->BaseTyp->comp == 4) {
- OPM_WriteString((CHAR*)"__NEW(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__NEW(", 7);
OPV_design(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Andent(n->left->typ->BaseTyp);
- OPM_WriteString((CHAR*)")", (LONGINT)2);
- } else if (__IN(n->left->typ->BaseTyp->comp, 0x0c)) {
+ OPM_WriteString((CHAR*)")", 2);
+ } else if (__IN(n->left->typ->BaseTyp->comp, 0x0c, 32)) {
OPV_NewArr(n->left, n->right);
}
break;
@@ -1460,43 +1340,45 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
case 15: case 16:
OPV_expr(n->left, -1);
OPC_SetInclude(n->subcl == 16);
- OPM_WriteString((CHAR*)"__SETOF(", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__SETOF(", 9);
OPV_expr(n->right, -1);
+ OPM_WriteString((CHAR*)",", 2);
+ OPM_WriteInt(__ASHL(n->left->typ->size, 3));
OPM_Write(')');
break;
case 18:
- OPM_WriteString((CHAR*)"__COPY(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__COPY(", 8);
OPV_expr(n->right, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
- OPV_Len(n->left, ((LONGINT)(0)));
+ OPM_WriteString((CHAR*)", ", 3);
+ OPV_Len(n->left, 0);
OPM_Write(')');
break;
case 31:
- OPM_WriteString((CHAR*)"__MOVE(", (LONGINT)8);
+ OPM_WriteString((CHAR*)"__MOVE(", 8);
OPV_expr(n->right, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->right->link, -1);
OPM_Write(')');
break;
case 24:
- OPM_WriteString((CHAR*)"__GET(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__GET(", 7);
OPV_expr(n->right, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Ident(n->left->typ->strobj);
OPM_Write(')');
break;
case 25:
- OPM_WriteString((CHAR*)"__PUT(", (LONGINT)7);
+ OPM_WriteString((CHAR*)"__PUT(", 7);
OPV_expr(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->right, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPC_Ident(n->right->typ->strobj);
OPM_Write(')');
break;
@@ -1504,15 +1386,15 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPM_err(200);
break;
case 30:
- OPM_WriteString((CHAR*)"__SYSNEW(", (LONGINT)10);
+ OPM_WriteString((CHAR*)"__SYSNEW(", 10);
OPV_design(n->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPV_expr(n->right, -1);
OPM_Write(')');
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.subcl = ", (LONGINT)40);
- OPM_LogWNum(n->subcl, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.subcl = ", 40);
+ OPM_LogWNum(n->subcl, 0);
OPM_LogWLn();
break;
}
@@ -1522,7 +1404,7 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
if (n->left->subcl == 1) {
proc = OPV_SuperProc(n);
} else {
- OPM_WriteString((CHAR*)"__", (LONGINT)3);
+ OPM_WriteString((CHAR*)"__", 3);
proc = OPC_BaseTProc(n->left->obj);
}
OPC_Ident(proc);
@@ -1537,10 +1419,10 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
case 20:
if (n->subcl != 32) {
OPV_IfStat(n, 0, outerProc);
- } else if (OPV_assert) {
- OPM_WriteString((CHAR*)"__ASSERT(", (LONGINT)10);
+ } else if (__IN(7, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__ASSERT(", 10);
OPV_expr(n->left->left->left, -1);
- OPM_WriteString((CHAR*)", ", (LONGINT)3);
+ OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(n->left->right->right->conval->intval);
OPM_Write(')');
OPC_EndStat();
@@ -1553,7 +1435,7 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
break;
case 22:
OPV_exit.level += 1;
- OPM_WriteString((CHAR*)"while ", (LONGINT)7);
+ OPM_WriteString((CHAR*)"while ", 7);
OPV_expr(n->left, 12);
OPM_Write(' ');
OPC_BegBlk();
@@ -1563,11 +1445,11 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
break;
case 23:
OPV_exit.level += 1;
- OPM_WriteString((CHAR*)"do ", (LONGINT)4);
+ OPM_WriteString((CHAR*)"do ", 4);
OPC_BegBlk();
OPV_stat(n->left, outerProc);
OPC_EndBlk0();
- OPM_WriteString((CHAR*)" while (!", (LONGINT)10);
+ OPM_WriteString((CHAR*)" while (!", 10);
OPV_expr(n->right, 9);
OPM_Write(')');
OPV_exit.level -= 1;
@@ -1576,13 +1458,13 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
saved = OPV_exit;
OPV_exit.level = 0;
OPV_exit.label = -1;
- OPM_WriteString((CHAR*)"for (;;) ", (LONGINT)10);
+ OPM_WriteString((CHAR*)"for (;;) ", 10);
OPC_BegBlk();
OPV_stat(n->left, outerProc);
OPC_EndBlk();
if (OPV_exit.label != -1) {
OPC_BegStat();
- OPM_WriteString((CHAR*)"exit__", (LONGINT)7);
+ OPM_WriteString((CHAR*)"exit__", 7);
OPM_WriteInt(OPV_exit.label);
OPM_Write(':');
OPC_EndStat();
@@ -1591,39 +1473,48 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
break;
case 25:
if (OPV_exit.level == 0) {
- OPM_WriteString((CHAR*)"break", (LONGINT)6);
+ OPM_WriteString((CHAR*)"break", 6);
} else {
if (OPV_exit.label == -1) {
OPV_exit.label = OPV_nofExitLabels;
OPV_nofExitLabels += 1;
}
- OPM_WriteString((CHAR*)"goto exit__", (LONGINT)12);
+ OPM_WriteString((CHAR*)"goto exit__", 12);
OPM_WriteInt(OPV_exit.label);
}
break;
case 26:
if (OPM_level == 0) {
- if (OPV_mainprog) {
- OPM_WriteString((CHAR*)"__FINI", (LONGINT)7);
+ if (__IN(10, OPM_Options, 32)) {
+ OPM_WriteString((CHAR*)"__FINI", 7);
} else {
- OPM_WriteString((CHAR*)"__ENDMOD", (LONGINT)9);
+ OPM_WriteString((CHAR*)"__ENDMOD", 9);
}
+ } else if (OPC_NeedsRetval(outerProc)) {
+ OPM_WriteString((CHAR*)"__retval = ", 12);
+ if ((n->left->typ->form == 11 && n->obj->typ != n->left->typ)) {
+ OPM_WriteString((CHAR*)"(void*)", 8);
+ OPV_expr(n->left, 10);
+ } else {
+ OPV_expr(n->left, -1);
+ }
+ OPC_EndStat();
+ OPC_BegStat();
+ OPC_ExitProc(outerProc, 0, 0);
+ OPC_EndStat();
+ OPC_BegStat();
+ OPM_WriteString((CHAR*)"return __retval", 16);
} else {
+ OPC_ExitProc(outerProc, 0, 0);
+ OPM_WriteString((CHAR*)"return", 7);
if (n->left != NIL) {
- OPM_WriteString((CHAR*)"_o_result = ", (LONGINT)13);
- if ((n->left->typ->form == 13 && n->obj->typ != n->left->typ)) {
- OPM_WriteString((CHAR*)"(void*)", (LONGINT)8);
+ OPM_Write(' ');
+ if ((n->left->typ->form == 11 && n->obj->typ != n->left->typ)) {
+ OPM_WriteString((CHAR*)"(void*)", 8);
OPV_expr(n->left, 10);
} else {
OPV_expr(n->left, -1);
}
- OPM_WriteString((CHAR*)";", (LONGINT)2);
- OPM_WriteLn();
- OPC_BegStat();
- OPC_ExitProc(outerProc, 0, 0);
- OPM_WriteString((CHAR*)"return _o_result", (LONGINT)17);
- } else {
- OPM_WriteString((CHAR*)"return", (LONGINT)7);
}
}
break;
@@ -1631,15 +1522,15 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPV_IfStat(n, n->subcl == 0, outerProc);
break;
case 28:
- OPC_Halt(n->right->conval->intval);
+ OPC_Halt(OPM_Longint(n->right->conval->intval));
break;
default:
- OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.class = ", (LONGINT)40);
- OPM_LogWNum(n->class, ((LONGINT)(0)));
+ OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.class = ", 40);
+ OPM_LogWNum(n->class, 0);
OPM_LogWLn();
break;
}
- if (!__IN(n->class, 0x09744000)) {
+ if (!__IN(n->class, 0x09744000, 32)) {
OPC_EndStat();
}
n = n->link;
@@ -1648,7 +1539,7 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
void OPV_Module (OPT_Node prog)
{
- if (!OPV_mainprog) {
+ if (!__IN(10, OPM_Options, 32)) {
OPC_GenHdr(prog->right);
OPC_GenHdrIncludes();
}
@@ -1656,7 +1547,7 @@ void OPV_Module (OPT_Node prog)
OPV_stat(prog, NIL);
}
-__TDESC(OPV_ExitInfo, 1, 0) = {__TDFLDS("ExitInfo", 8), {-8}};
+__TDESC(OPV_ExitInfo, 1, 0) = {__TDFLDS("ExitInfo", 4), {-8}};
export void *OPV__init(void)
{
diff --git a/bootstrap/windows-88/OPV.h b/bootstrap/windows-88/OPV.h
index 4eba5b89..c4a61586 100644
--- a/bootstrap/windows-88/OPV.h
+++ b/bootstrap/windows-88/OPV.h
@@ -1,9 +1,8 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPV__h
#define OPV__h
-#define LARGE
#include "SYSTEM.h"
#include "OPT.h"
@@ -13,8 +12,7 @@
import void OPV_AdrAndSize (OPT_Object topScope);
import void OPV_Init (void);
import void OPV_Module (OPT_Node prog);
-import void OPV_TypSize (OPT_Struct typ);
import void *OPV__init(void);
-#endif
+#endif // OPV
diff --git a/bootstrap/windows-88/Out.c b/bootstrap/windows-88/Out.c
new file mode 100644
index 00000000..720267fd
--- /dev/null
+++ b/bootstrap/windows-88/Out.c
@@ -0,0 +1,318 @@
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
+#include "SYSTEM.h"
+#include "Platform.h"
+
+
+export BOOLEAN Out_IsConsole;
+static CHAR Out_buf[128];
+static INT16 Out_in;
+
+
+export void Out_Char (CHAR ch);
+export void Out_Flush (void);
+export void Out_Int (INT64 x, INT64 n);
+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, LONGINT str__len);
+export LONGREAL Out_Ten (INT16 e);
+static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i);
+static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i);
+
+#define Out_Entier64(x) (INT64)(x)
+
+void Out_Flush (void)
+{
+ INT16 error;
+ if (Out_in > 0) {
+ error = Platform_Write(Platform_StdOut, (ADDRESS)Out_buf, Out_in);
+ }
+ Out_in = 0;
+}
+
+void Out_Open (void)
+{
+}
+
+void Out_Char (CHAR ch)
+{
+ if (Out_in >= 128) {
+ Out_Flush();
+ }
+ Out_buf[__X(Out_in, 128)] = ch;
+ Out_in += 1;
+ if (ch == 0x0a) {
+ Out_Flush();
+ }
+}
+
+static INT32 Out_Length (CHAR *s, LONGINT s__len)
+{
+ INT32 l;
+ l = 0;
+ while ((l < s__len && s[__X(l, s__len)] != 0x00)) {
+ l += 1;
+ }
+ return l;
+}
+
+void Out_String (CHAR *str, LONGINT str__len)
+{
+ INT32 l;
+ INT16 error;
+ __DUP(str, str__len, CHAR);
+ l = Out_Length((void*)str, str__len);
+ if (Out_in + l > 128) {
+ Out_Flush();
+ }
+ if (l > 128) {
+ error = Platform_Write(Platform_StdOut, (ADDRESS)str, l);
+ } else {
+ __MOVE((ADDRESS)str, (ADDRESS)&Out_buf[__X(Out_in, 128)], l);
+ Out_in += (INT16)l;
+ }
+ __DEL(str);
+}
+
+void Out_Int (INT64 x, INT64 n)
+{
+ CHAR s[22];
+ INT16 i;
+ BOOLEAN negative;
+ negative = x < 0;
+ if (x == (-9223372036854775807-1)) {
+ __MOVE("8085774586302733229", s, 20);
+ i = 19;
+ } else {
+ if (x < 0) {
+ x = -x;
+ }
+ s[0] = (CHAR)(48 + __MOD(x, 10));
+ x = __DIV(x, 10);
+ i = 1;
+ while (x != 0) {
+ s[__X(i, 22)] = (CHAR)(48 + __MOD(x, 10));
+ x = __DIV(x, 10);
+ i += 1;
+ }
+ }
+ if (negative) {
+ s[__X(i, 22)] = '-';
+ i += 1;
+ }
+ while (n > (INT64)i) {
+ Out_Char(' ');
+ n -= 1;
+ }
+ while (i > 0) {
+ i -= 1;
+ Out_Char(s[__X(i, 22)]);
+ }
+}
+
+void Out_Ln (void)
+{
+ Out_String(Platform_NL, 3);
+ Out_Flush();
+}
+
+static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i)
+{
+ *i -= 1;
+ s[__X(*i, s__len)] = (CHAR)(__MOD(n, 10) + 48);
+}
+
+static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i)
+{
+ INT16 j;
+ INT32 l;
+ __DUP(t, t__len, CHAR);
+ l = Out_Length((void*)t, t__len);
+ if (l > *i) {
+ l = *i;
+ }
+ *i -= (INT16)l;
+ j = 0;
+ while (j < l) {
+ s[__X(*i + j, s__len)] = t[__X(j, t__len)];
+ j += 1;
+ }
+ __DEL(t);
+}
+
+LONGREAL Out_Ten (INT16 e)
+{
+ LONGREAL r, power;
+ r = (LONGREAL)1;
+ power = (LONGREAL)10;
+ while (e > 0) {
+ if (__ODD(e)) {
+ r = r * power;
+ }
+ power = power * power;
+ e = __ASHR(e, 1);
+ }
+ return r;
+}
+
+static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_)
+{
+ INT16 e;
+ INT64 f;
+ CHAR s[30];
+ INT16 i, el;
+ LONGREAL x0;
+ BOOLEAN nn, en;
+ INT64 m;
+ INT16 d, dr;
+ e = (INT16)__MASK(__ASHR((__VAL(INT64, x)), 52), -2048);
+ f = __MASK((__VAL(INT64, x)), -4503599627370496);
+ nn = (__VAL(INT64, x) < 0 && !((e == 2047 && f != 0)));
+ if (nn) {
+ n -= 1;
+ }
+ i = 30;
+ if (e == 2047) {
+ if (f == 0) {
+ Out_prepend((CHAR*)"Infinity", 9, (void*)s, 30, &i);
+ } else {
+ Out_prepend((CHAR*)"NaN", 4, (void*)s, 30, &i);
+ }
+ } else {
+ if (long_) {
+ el = 3;
+ dr = n - 6;
+ if (dr > 17) {
+ dr = 17;
+ }
+ d = dr;
+ if (d < 15) {
+ d = 15;
+ }
+ } else {
+ el = 2;
+ dr = n - 5;
+ if (dr > 9) {
+ dr = 9;
+ }
+ d = dr;
+ if (d < 6) {
+ d = 6;
+ }
+ }
+ if (e == 0) {
+ while (el > 0) {
+ i -= 1;
+ s[__X(i, 30)] = '0';
+ el -= 1;
+ }
+ i -= 1;
+ s[__X(i, 30)] = '+';
+ m = 0;
+ } else {
+ if (nn) {
+ x = -x;
+ }
+ e = (INT16)__ASHR((e - 1023) * 77, 8);
+ if (e >= 0) {
+ x = x / (LONGREAL)Out_Ten(e);
+ } else {
+ x = Out_Ten(-e) * x;
+ }
+ if (x >= (LONGREAL)10) {
+ x = 1.00000000000000e-001 * x;
+ e += 1;
+ }
+ en = e < 0;
+ if (en) {
+ e = -e;
+ }
+ while (el > 0) {
+ Out_digit(e, (void*)s, 30, &i);
+ e = __DIV(e, 10);
+ el -= 1;
+ }
+ i -= 1;
+ if (en) {
+ s[__X(i, 30)] = '-';
+ } else {
+ s[__X(i, 30)] = '+';
+ }
+ x0 = Out_Ten(d - 1);
+ x = x0 * x;
+ x = x + 5.00000000000000e-001;
+ if (x >= (LONGREAL)10 * x0) {
+ x = 1.00000000000000e-001 * x;
+ e += 1;
+ }
+ m = Out_Entier64(x);
+ }
+ i -= 1;
+ if (long_) {
+ s[__X(i, 30)] = 'D';
+ } else {
+ s[__X(i, 30)] = 'E';
+ }
+ if (dr < 2) {
+ dr = 2;
+ }
+ while ((d > dr && __MOD(m, 10) == 0)) {
+ m = __DIV(m, 10);
+ d -= 1;
+ }
+ while (d > 1) {
+ Out_digit(m, (void*)s, 30, &i);
+ m = __DIV(m, 10);
+ d -= 1;
+ }
+ i -= 1;
+ s[__X(i, 30)] = '.';
+ Out_digit(m, (void*)s, 30, &i);
+ }
+ n -= 30 - i;
+ while (n > 0) {
+ Out_Char(' ');
+ n -= 1;
+ }
+ if (nn) {
+ Out_Char('-');
+ }
+ while (i < 30) {
+ Out_Char(s[__X(i, 30)]);
+ i += 1;
+ }
+}
+
+void Out_Real (REAL x, INT16 n)
+{
+ Out_RealP(x, n, 0);
+}
+
+void Out_LongReal (LONGREAL x, INT16 n)
+{
+ Out_RealP(x, n, 1);
+}
+
+
+export void *Out__init(void)
+{
+ __DEFMOD;
+ __MODULE_IMPORT(Platform);
+ __REGMOD("Out", 0);
+ __REGCMD("Flush", Out_Flush);
+ __REGCMD("Ln", Out_Ln);
+ __REGCMD("Open", Out_Open);
+/* BEGIN */
+ Out_IsConsole = Platform_IsConsole(Platform_StdOut);
+ Out_in = 0;
+ __ENDMOD;
+}
diff --git a/bootstrap/windows-88/Out.h b/bootstrap/windows-88/Out.h
new file mode 100644
index 00000000..0e66420d
--- /dev/null
+++ b/bootstrap/windows-88/Out.h
@@ -0,0 +1,24 @@
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#ifndef Out__h
+#define Out__h
+
+#include "SYSTEM.h"
+
+
+import BOOLEAN Out_IsConsole;
+
+
+import void Out_Char (CHAR ch);
+import void Out_Flush (void);
+import void Out_Int (INT64 x, INT64 n);
+import void Out_Ln (void);
+import void Out_LongReal (LONGREAL x, INT16 n);
+import void Out_Open (void);
+import void Out_Real (REAL x, INT16 n);
+import void Out_String (CHAR *str, LONGINT str__len);
+import LONGREAL Out_Ten (INT16 e);
+import void *Out__init(void);
+
+
+#endif // Out
diff --git a/bootstrap/windows-88/Platform.c b/bootstrap/windows-88/Platform.c
index 4281164c..1e93deb2 100644
--- a/bootstrap/windows-88/Platform.c
+++ b/bootstrap/windows-88/Platform.c
@@ -1,5 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
typedef
@@ -9,96 +14,93 @@ typedef
Platform_ArgPtr (*Platform_ArgVec)[1024];
typedef
- LONGINT (*Platform_ArgVecPtr)[1];
+ INT64 (*Platform_ArgVecPtr)[1];
typedef
CHAR (*Platform_EnvPtr)[1024];
typedef
struct Platform_FileIdentity {
- LONGINT volume, indexhigh, indexlow, mtimehigh, mtimelow;
+ INT32 volume, indexhigh, indexlow, mtimehigh, mtimelow;
} Platform_FileIdentity;
typedef
- void (*Platform_HaltProcedure)(LONGINT);
+ void (*Platform_HaltProcedure)(INT32);
typedef
- void (*Platform_SignalHandler)(INTEGER);
+ void (*Platform_SignalHandler)(INT32);
export BOOLEAN Platform_LittleEndian;
-export LONGINT Platform_MainStackFrame, Platform_HaltCode;
-export INTEGER Platform_PID;
+export INT64 Platform_MainStackFrame;
+export INT32 Platform_HaltCode;
+export INT16 Platform_PID;
export CHAR Platform_CWD[4096];
-export INTEGER Platform_ArgCount;
-export LONGINT Platform_ArgVector;
+export INT16 Platform_ArgCount;
+export INT64 Platform_ArgVector;
static Platform_HaltProcedure Platform_HaltHandler;
-static LONGINT Platform_TimeStart;
-export INTEGER Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
-export LONGINT Platform_StdIn, Platform_StdOut, Platform_StdErr;
+static INT32 Platform_TimeStart;
+export INT16 Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
+export INT64 Platform_StdIn, Platform_StdOut, Platform_StdErr;
static Platform_SignalHandler Platform_InterruptHandler;
-export CHAR Platform_nl[3];
+export CHAR Platform_NL[3];
-export LONGINT *Platform_FileIdentity__typ;
+export ADDRESS *Platform_FileIdentity__typ;
-export BOOLEAN Platform_Absent (INTEGER e);
-export INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len);
-export void Platform_AssertFail (LONGINT code);
-export INTEGER Platform_Chdir (CHAR *n, LONGINT n__len);
-export INTEGER Platform_Close (LONGINT h);
-export BOOLEAN Platform_ConnectionFailed (INTEGER e);
-export void Platform_Delay (LONGINT ms);
-export BOOLEAN Platform_DifferentFilesystems (INTEGER e);
-static void Platform_DisplayHaltCode (LONGINT code);
-export INTEGER Platform_Error (void);
-export void Platform_Exit (INTEGER code);
-export void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len);
-export void Platform_GetClock (LONGINT *t, LONGINT *d);
+export BOOLEAN Platform_Absent (INT16 e);
+export INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
+export INT16 Platform_Chdir (CHAR *n, LONGINT n__len);
+export INT16 Platform_Close (INT64 h);
+export BOOLEAN Platform_ConnectionFailed (INT16 e);
+export void Platform_Delay (INT32 ms);
+export BOOLEAN Platform_DifferentFilesystems (INT16 e);
+static void Platform_EnableVT100 (void);
+export INT16 Platform_Error (void);
+export void Platform_Exit (INT32 code);
+export void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len);
+export void Platform_GetClock (INT32 *t, INT32 *d);
export void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
-export void Platform_GetIntArg (INTEGER n, LONGINT *val);
-export void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec);
-export void Platform_Halt (LONGINT code);
-export INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ);
-export INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ);
-export BOOLEAN Platform_Inaccessible (INTEGER e);
-export void Platform_Init (INTEGER argc, LONGINT argvadr);
-export void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d);
-export INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h);
-export BOOLEAN Platform_NoSuchDirectory (INTEGER e);
-export LONGINT Platform_OSAllocate (LONGINT size);
-export void Platform_OSFree (LONGINT address);
-export INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h);
-export INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h);
-export INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n);
-export INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n);
-export INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
+export void Platform_GetIntArg (INT16 n, INT32 *val);
+export void Platform_GetTimeOfDay (INT32 *sec, INT32 *usec);
+export INT16 Platform_Identify (INT64 h, Platform_FileIdentity *identity, ADDRESS *identity__typ);
+export INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
+export BOOLEAN Platform_Inaccessible (INT16 e);
+export void Platform_Init (INT32 argc, INT64 argvadr);
+export BOOLEAN Platform_Interrupted (INT16 e);
+export BOOLEAN Platform_IsConsole (INT64 h);
+export void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d);
+export INT16 Platform_New (CHAR *n, LONGINT n__len, INT64 *h);
+export BOOLEAN Platform_NoSuchDirectory (INT16 e);
+export INT64 Platform_OSAllocate (INT64 size);
+export void Platform_OSFree (INT64 address);
+export INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT64 *h);
+export INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT64 *h);
+export INT16 Platform_Read (INT64 h, INT64 p, INT32 l, INT32 *n);
+export INT16 Platform_ReadBuf (INT64 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n);
+export INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
export BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2);
export BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2);
-export INTEGER Platform_Seek (LONGINT h, LONGINT o, INTEGER r);
+export INT16 Platform_Seek (INT64 h, INT32 o, INT16 r);
export void Platform_SetBadInstructionHandler (Platform_SignalHandler handler);
-export void Platform_SetHalt (Platform_HaltProcedure p);
-export void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source);
-export INTEGER Platform_Size (LONGINT h, LONGINT *l);
-export INTEGER Platform_Sync (LONGINT h);
-export INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len);
+export void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__typ, Platform_FileIdentity source);
+export INT16 Platform_Size (INT64 h, INT32 *l);
+export INT16 Platform_Sync (INT64 h);
+export INT16 Platform_System (CHAR *cmd, LONGINT cmd__len);
static void Platform_TestLittleEndian (void);
-export LONGINT Platform_Time (void);
-export BOOLEAN Platform_TimedOut (INTEGER e);
-export BOOLEAN Platform_TooManyFiles (INTEGER e);
-export INTEGER Platform_Truncate (LONGINT h, LONGINT limit);
-export INTEGER Platform_Unlink (CHAR *n, LONGINT n__len);
-export INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l);
-static void Platform_YMDHMStoClock (INTEGER ye, INTEGER mo, INTEGER da, INTEGER ho, INTEGER mi, INTEGER se, LONGINT *t, LONGINT *d);
-static void Platform_errch (CHAR c);
-static void Platform_errint (LONGINT l);
-static void Platform_errln (void);
-static void Platform_errposint (LONGINT l);
+export INT32 Platform_Time (void);
+export BOOLEAN Platform_TimedOut (INT16 e);
+export BOOLEAN Platform_TooManyFiles (INT16 e);
+export INT16 Platform_Truncate (INT64 h, INT32 limit);
+export INT16 Platform_Unlink (CHAR *n, LONGINT n__len);
+export INT16 Platform_Write (INT64 h, INT64 p, INT32 l);
+static void Platform_YMDHMStoClock (INT16 ye, INT16 mo, INT16 da, INT16 ho, INT16 mi, INT16 se, INT32 *t, INT32 *d);
export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
#include "WindowsWrapper.h"
#define Platform_ECONNABORTED() WSAECONNABORTED
#define Platform_ECONNREFUSED() WSAECONNREFUSED
#define Platform_EHOSTUNREACH() WSAEHOSTUNREACH
+#define Platform_EINTR() WSAEINTR
#define Platform_ENETUNREACH() WSAENETUNREACH
#define Platform_ERRORACCESSDENIED() ERROR_ACCESS_DENIED
#define Platform_ERRORFILENOTFOUND() ERROR_FILE_NOT_FOUND
@@ -110,11 +112,13 @@ export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT
#define Platform_ERRORWRITEPROTECT() ERROR_WRITE_PROTECT
#define Platform_ETIMEDOUT() WSAETIMEDOUT
extern void Heap_InitHeap();
-#define Platform_GetTickCount() (LONGINT)(SYSTEM_CARD32)GetTickCount()
+#define Platform_GetConsoleMode(h, m) GetConsoleMode((HANDLE)h, (DWORD*)m)
+#define Platform_GetTickCount() (LONGINT)(UINT32)GetTickCount()
#define Platform_HeapInitHeap() Heap_InitHeap()
-#define Platform_SetInterruptHandler(h) SystemSetInterruptHandler((SYSTEM_ADDRESS)h)
-#define Platform_SetQuitHandler(h) SystemSetQuitHandler((SYSTEM_ADDRESS)h)
-#define Platform_allocate(size) (LONGINT)(SYSTEM_ADDRESS)((void*)HeapAlloc(GetProcessHeap(), 0, (size_t)size))
+#define Platform_SetConsoleMode(h, m) SetConsoleMode((HANDLE)h, (DWORD)m)
+#define Platform_SetInterruptHandler(h) SystemSetInterruptHandler((ADDRESS)h)
+#define Platform_SetQuitHandler(h) SystemSetQuitHandler((ADDRESS)h)
+#define Platform_allocate(size) (ADDRESS)((void*)HeapAlloc(GetProcessHeap(), 0, (size_t)size))
#define Platform_bhfiIndexHigh() (LONGINT)bhfi.nFileIndexHigh
#define Platform_bhfiIndexLow() (LONGINT)bhfi.nFileIndexLow
#define Platform_bhfiMtimeHigh() (LONGINT)bhfi.ftLastWriteTime.dwHighDateTime
@@ -122,44 +126,42 @@ extern void Heap_InitHeap();
#define Platform_bhfiVsn() (LONGINT)bhfi.dwVolumeSerialNumber
#define Platform_byHandleFileInformation() BY_HANDLE_FILE_INFORMATION bhfi
#define Platform_cleanupProcess() CloseHandle(pi.hProcess); CloseHandle(pi.hThread);
-#define Platform_closeHandle(h) (INTEGER)CloseHandle((HANDLE)(SYSTEM_ADDRESS)h)
+#define Platform_closeHandle(h) (INTEGER)CloseHandle((HANDLE)h)
#define Platform_createProcess(str, str__len) (INTEGER)CreateProcess(0, (char*)str, 0,0,0,0,0,0,&si,&pi)
#define Platform_deleteFile(n, n__len) (INTEGER)DeleteFile((char*)n)
#define Platform_err() (INTEGER)GetLastError()
-#define Platform_errc(c) WriteFile((HANDLE)(SYSTEM_ADDRESS)Platform_StdOut, &c, 1, 0,0)
-#define Platform_errstring(s, s__len) WriteFile((HANDLE)(SYSTEM_ADDRESS)Platform_StdOut, s, s__len-1, 0,0)
#define Platform_exit(code) ExitProcess((UINT)code)
#define Platform_fileTimeToSysTime() SYSTEMTIME st; FileTimeToSystemTime(&ft, &st)
-#define Platform_flushFileBuffers(h) (INTEGER)FlushFileBuffers((HANDLE)(SYSTEM_ADDRESS)h)
-#define Platform_free(address) HeapFree(GetProcessHeap(), 0, (void*)(SYSTEM_ADDRESS)address)
+#define Platform_flushFileBuffers(h) (INTEGER)FlushFileBuffers((HANDLE)h)
+#define Platform_free(address) HeapFree(GetProcessHeap(), 0, (void*)address)
#define Platform_ftToUli() ULARGE_INTEGER ul; ul.LowPart=ft.dwLowDateTime; ul.HighPart=ft.dwHighDateTime
#define Platform_getCurrentDirectory(n, n__len) GetCurrentDirectory(n__len, (char*)n)
#define Platform_getExitCodeProcess(exitcode) GetExitCodeProcess(pi.hProcess, (DWORD*)exitcode);
-#define Platform_getFileInformationByHandle(h) (INTEGER)GetFileInformationByHandle((HANDLE)(SYSTEM_ADDRESS)h, &bhfi)
-#define Platform_getFilePos(h, r, rc) LARGE_INTEGER liz = {0}; *rc = (INTEGER)SetFilePointerEx((HANDLE)(SYSTEM_ADDRESS)h, liz, &li, FILE_CURRENT); *r = (LONGINT)li.QuadPart
-#define Platform_getFileSize(h) (INTEGER)GetFileSizeEx((HANDLE)(SYSTEM_ADDRESS)h, &li)
+#define Platform_getFileInformationByHandle(h) (INTEGER)GetFileInformationByHandle((HANDLE)h, &bhfi)
+#define Platform_getFilePos(h, r, rc) LARGE_INTEGER liz = {0}; *rc = (INTEGER)SetFilePointerEx((HANDLE)h, liz, &li, FILE_CURRENT); *r = (LONGINT)li.QuadPart
+#define Platform_getFileSize(h) (INTEGER)GetFileSizeEx((HANDLE)h, &li)
#define Platform_getLocalTime() SYSTEMTIME st; GetLocalTime(&st)
#define Platform_getenv(name, name__len, buf, buf__len) (INTEGER)GetEnvironmentVariable((char*)name, (char*)buf, buf__len)
#define Platform_getpid() (INTEGER)GetCurrentProcessId()
-#define Platform_getstderrhandle() (SYSTEM_ADDRESS)GetStdHandle(STD_ERROR_HANDLE)
-#define Platform_getstdinhandle() (SYSTEM_ADDRESS)GetStdHandle(STD_INPUT_HANDLE)
-#define Platform_getstdouthandle() (SYSTEM_ADDRESS)GetStdHandle(STD_OUTPUT_HANDLE)
+#define Platform_getstderrhandle() (ADDRESS)GetStdHandle(STD_ERROR_HANDLE)
+#define Platform_getstdinhandle() (ADDRESS)GetStdHandle(STD_INPUT_HANDLE)
+#define Platform_getstdouthandle() (ADDRESS)GetStdHandle(STD_OUTPUT_HANDLE)
#define Platform_identityToFileTime(i) FILETIME ft; ft.dwHighDateTime = i.mtimehigh; ft.dwLowDateTime = i.mtimelow
-#define Platform_invalidHandleValue() ((LONGINT)(SYSTEM_ADDRESS)INVALID_HANDLE_VALUE)
+#define Platform_invalidHandleValue() ((ADDRESS)INVALID_HANDLE_VALUE)
#define Platform_largeInteger() LARGE_INTEGER li
#define Platform_liLongint() (LONGINT)li.QuadPart
#define Platform_moveFile(o, o__len, n, n__len) (INTEGER)MoveFileEx((char*)o, (char*)n, MOVEFILE_REPLACE_EXISTING)
-#define Platform_opennew(n, n__len) (LONGINT)(SYSTEM_ADDRESS)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
-#define Platform_openro(n, n__len) (LONGINT)(SYSTEM_ADDRESS)CreateFile((char*)n, GENERIC_READ , FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
-#define Platform_openrw(n, n__len) (LONGINT)(SYSTEM_ADDRESS)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
+#define Platform_opennew(n, n__len) (ADDRESS)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
+#define Platform_openro(n, n__len) (ADDRESS)CreateFile((char*)n, GENERIC_READ , FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
+#define Platform_openrw(n, n__len) (ADDRESS)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
#define Platform_processInfo() PROCESS_INFORMATION pi = {0};
-#define Platform_readfile(fd, p, l, n) (INTEGER)ReadFile ((HANDLE)(SYSTEM_ADDRESS)fd, (void*)(SYSTEM_ADDRESS)(p), (DWORD)l, (DWORD*)n, 0)
+#define Platform_readfile(fd, p, l, n) (INTEGER)ReadFile((HANDLE)fd, (void*)p, (DWORD)l, (DWORD*)n, 0)
#define Platform_seekcur() FILE_CURRENT
#define Platform_seekend() FILE_END
#define Platform_seekset() FILE_BEGIN
#define Platform_setCurrentDirectory(n, n__len) (INTEGER)SetCurrentDirectory((char*)n)
-#define Platform_setEndOfFile(h) (INTEGER)SetEndOfFile((HANDLE)(SYSTEM_ADDRESS)h)
-#define Platform_setFilePointerEx(h, o, r, rc) li.QuadPart=o; *rc = (INTEGER)SetFilePointerEx((HANDLE)(SYSTEM_ADDRESS)h, li, 0, (DWORD)r)
+#define Platform_setEndOfFile(h) (INTEGER)SetEndOfFile((HANDLE)h)
+#define Platform_setFilePointerEx(h, o, r, rc) li.QuadPart=o; *rc = (INTEGER)SetFilePointerEx((HANDLE)h, li, 0, (DWORD)r)
#define Platform_sleep(ms) Sleep((DWORD)ms)
#define Platform_stToFt() FILETIME ft; SystemTimeToFileTime(&st, &ft)
#define Platform_startupInfo() STARTUPINFO si = {0}; si.cb = sizeof(si);
@@ -174,75 +176,64 @@ extern void Heap_InitHeap();
#define Platform_ulSec() (LONGINT)(ul.QuadPart / 1000000LL)
#define Platform_uluSec() (LONGINT)(ul.QuadPart % 1000000LL)
#define Platform_waitForProcess() (INTEGER)WaitForSingleObject(pi.hProcess, INFINITE)
-#define Platform_writefile(fd, p, l) (INTEGER)WriteFile((HANDLE)(SYSTEM_ADDRESS)fd, (void*)(SYSTEM_ADDRESS)(p), (DWORD)l, 0,0)
+#define Platform_writefile(fd, p, l, n) (INTEGER)WriteFile((HANDLE)fd, (void*)(p), (DWORD)l, (DWORD*)n, 0)
-BOOLEAN Platform_TooManyFiles (INTEGER e)
+BOOLEAN Platform_TooManyFiles (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = e == Platform_ERRORTOOMANYOPENFILES();
- return _o_result;
+ return e == Platform_ERRORTOOMANYOPENFILES();
}
-BOOLEAN Platform_NoSuchDirectory (INTEGER e)
+BOOLEAN Platform_NoSuchDirectory (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = e == Platform_ERRORPATHNOTFOUND();
- return _o_result;
+ return e == Platform_ERRORPATHNOTFOUND();
}
-BOOLEAN Platform_DifferentFilesystems (INTEGER e)
+BOOLEAN Platform_DifferentFilesystems (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = e == Platform_ERRORNOTSAMEDEVICE();
- return _o_result;
+ return e == Platform_ERRORNOTSAMEDEVICE();
}
-BOOLEAN Platform_Inaccessible (INTEGER e)
+BOOLEAN Platform_Inaccessible (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = ((e == Platform_ERRORACCESSDENIED() || e == Platform_ERRORWRITEPROTECT()) || e == Platform_ERRORNOTREADY()) || e == Platform_ERRORSHARINGVIOLATION();
- return _o_result;
+ return ((e == Platform_ERRORACCESSDENIED() || e == Platform_ERRORWRITEPROTECT()) || e == Platform_ERRORNOTREADY()) || e == Platform_ERRORSHARINGVIOLATION();
}
-BOOLEAN Platform_Absent (INTEGER e)
+BOOLEAN Platform_Absent (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = e == Platform_ERRORFILENOTFOUND() || e == Platform_ERRORPATHNOTFOUND();
- return _o_result;
+ return e == Platform_ERRORFILENOTFOUND() || e == Platform_ERRORPATHNOTFOUND();
}
-BOOLEAN Platform_TimedOut (INTEGER e)
+BOOLEAN Platform_TimedOut (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = e == Platform_ETIMEDOUT();
- return _o_result;
+ return e == Platform_ETIMEDOUT();
}
-BOOLEAN Platform_ConnectionFailed (INTEGER e)
+BOOLEAN Platform_ConnectionFailed (INT16 e)
{
- BOOLEAN _o_result;
- _o_result = ((e == Platform_ECONNREFUSED() || e == Platform_ECONNABORTED()) || e == Platform_ENETUNREACH()) || e == Platform_EHOSTUNREACH();
- return _o_result;
+ return ((e == Platform_ECONNREFUSED() || e == Platform_ECONNABORTED()) || e == Platform_ENETUNREACH()) || e == Platform_EHOSTUNREACH();
}
-LONGINT Platform_OSAllocate (LONGINT size)
+BOOLEAN Platform_Interrupted (INT16 e)
{
- LONGINT _o_result;
- _o_result = Platform_allocate(size);
- return _o_result;
+ return e == Platform_EINTR();
}
-void Platform_OSFree (LONGINT address)
+INT64 Platform_OSAllocate (INT64 size)
+{
+ return Platform_allocate(size);
+}
+
+void Platform_OSFree (INT64 address)
{
Platform_free(address);
}
-void Platform_Init (INTEGER argc, LONGINT argvadr)
+void Platform_Init (INT32 argc, INT64 argvadr)
{
Platform_ArgVecPtr av = NIL;
Platform_MainStackFrame = argvadr;
- Platform_ArgCount = argc;
- av = (Platform_ArgVecPtr)(SYSTEM_ADDRESS)argvadr;
+ Platform_ArgCount = __VAL(INT16, argc);
+ av = (Platform_ArgVecPtr)(ADDRESS)argvadr;
Platform_ArgVector = (*av)[0];
Platform_HaltCode = -128;
Platform_HeapInitHeap();
@@ -250,20 +241,17 @@ void Platform_Init (INTEGER argc, LONGINT argvadr)
BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
{
- BOOLEAN _o_result;
CHAR buf[4096];
- INTEGER res;
+ INT16 res;
__DUP(var, var__len, CHAR);
- res = Platform_getenv(var, var__len, (void*)buf, ((LONGINT)(4096)));
+ res = Platform_getenv(var, var__len, (void*)buf, 4096);
if ((res > 0 && res < 4096)) {
__COPY(buf, val, val__len);
- _o_result = 1;
__DEL(var);
- return _o_result;
+ return 1;
} else {
- _o_result = 0;
__DEL(var);
- return _o_result;
+ return 0;
}
__RETCHK;
}
@@ -277,31 +265,31 @@ void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
__DEL(var);
}
-void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len)
+void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len)
{
Platform_ArgVec av = NIL;
if (n < Platform_ArgCount) {
- av = (Platform_ArgVec)(SYSTEM_ADDRESS)Platform_ArgVector;
- __COPY(*(*av)[__X(n, ((LONGINT)(1024)))], val, val__len);
+ av = (Platform_ArgVec)(ADDRESS)Platform_ArgVector;
+ __COPY(*(*av)[__X(n, 1024)], val, val__len);
}
}
-void Platform_GetIntArg (INTEGER n, LONGINT *val)
+void Platform_GetIntArg (INT16 n, INT32 *val)
{
CHAR s[64];
- LONGINT k, d, i;
+ INT32 k, d, i;
s[0] = 0x00;
- Platform_GetArg(n, (void*)s, ((LONGINT)(64)));
+ Platform_GetArg(n, (void*)s, 64);
i = 0;
if (s[0] == '-') {
i = 1;
}
k = 0;
- d = (int)s[__X(i, ((LONGINT)(64)))] - 48;
+ d = (INT16)s[__X(i, 64)] - 48;
while ((d >= 0 && d <= 9)) {
k = k * 10 + d;
i += 1;
- d = (int)s[__X(i, ((LONGINT)(64)))] - 48;
+ d = (INT16)s[__X(i, 64)] - 48;
}
if (s[0] == '-') {
k = -k;
@@ -312,52 +300,48 @@ void Platform_GetIntArg (INTEGER n, LONGINT *val)
}
}
-INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len)
+INT16 Platform_ArgPos (CHAR *s, LONGINT s__len)
{
- INTEGER _o_result;
- INTEGER i;
+ INT16 i;
CHAR arg[256];
__DUP(s, s__len, CHAR);
i = 0;
- Platform_GetArg(i, (void*)arg, ((LONGINT)(256)));
+ Platform_GetArg(i, (void*)arg, 256);
while ((i < Platform_ArgCount && __STRCMP(s, arg) != 0)) {
i += 1;
- Platform_GetArg(i, (void*)arg, ((LONGINT)(256)));
+ Platform_GetArg(i, (void*)arg, 256);
}
- _o_result = i;
__DEL(s);
- return _o_result;
+ return i;
}
void Platform_SetBadInstructionHandler (Platform_SignalHandler handler)
{
}
-static void Platform_YMDHMStoClock (INTEGER ye, INTEGER mo, INTEGER da, INTEGER ho, INTEGER mi, INTEGER se, LONGINT *t, LONGINT *d)
+static void Platform_YMDHMStoClock (INT16 ye, INT16 mo, INT16 da, INT16 ho, INT16 mi, INT16 se, INT32 *t, INT32 *d)
{
- *d = (__ASHL((SYSTEM_INT64)(int)__MOD(ye, 100), 9) + __ASHL((SYSTEM_INT64)(mo + 1), 5)) + (SYSTEM_INT64)da;
- *t = (__ASHL((SYSTEM_INT64)ho, 12) + __ASHL((SYSTEM_INT64)mi, 6)) + (SYSTEM_INT64)se;
+ *d = (__ASHL((int)__MOD(ye, 100), 9) + __ASHL((mo + 1), 5)) + da;
+ *t = (__ASHL(ho, 12) + __ASHL(mi, 6)) + se;
}
-void Platform_GetClock (LONGINT *t, LONGINT *d)
+void Platform_GetClock (INT32 *t, INT32 *d)
{
Platform_getLocalTime();
Platform_YMDHMStoClock(Platform_styear(), Platform_stmon(), Platform_stmday(), Platform_sthour(), Platform_stmin(), Platform_stsec(), &*t, &*d);
}
-LONGINT Platform_Time (void)
+INT32 Platform_Time (void)
{
- LONGINT _o_result;
- LONGINT ms;
+ INT32 ms;
ms = Platform_GetTickCount();
- _o_result = __MOD(ms - Platform_TimeStart, 2147483647);
- return _o_result;
+ return (int)__MOD(ms - Platform_TimeStart, 2147483647);
}
-void Platform_Delay (LONGINT ms)
+void Platform_Delay (INT32 ms)
{
while (ms > 30000) {
- Platform_sleep(((LONGINT)(30000)));
+ Platform_sleep(30000);
ms = ms - 30000;
}
if (ms > 0) {
@@ -365,7 +349,7 @@ void Platform_Delay (LONGINT ms)
}
}
-void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec)
+void Platform_GetTimeOfDay (INT32 *sec, INT32 *usec)
{
Platform_getLocalTime();
Platform_stToFt();
@@ -375,10 +359,9 @@ void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec)
*usec = Platform_uluSec();
}
-INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len)
+INT16 Platform_System (CHAR *cmd, LONGINT cmd__len)
{
- INTEGER _o_result;
- INTEGER result;
+ INT16 result;
__DUP(cmd, cmd__len, CHAR);
result = 127;
Platform_startupInfo();
@@ -389,417 +372,272 @@ INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len)
}
Platform_cleanupProcess();
}
- _o_result = __ASHL(result, 8);
__DEL(cmd);
- return _o_result;
+ return __ASHL(result, 8);
}
-INTEGER Platform_Error (void)
+INT16 Platform_Error (void)
{
- INTEGER _o_result;
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
}
-INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h)
+INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT64 *h)
{
- INTEGER _o_result;
- LONGINT fd;
+ INT64 fd;
fd = Platform_openro(n, n__len);
if (fd == Platform_invalidHandleValue()) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
*h = fd;
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h)
+INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT64 *h)
{
- INTEGER _o_result;
- LONGINT fd;
+ INT64 fd;
fd = Platform_openrw(n, n__len);
if (fd == Platform_invalidHandleValue()) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
*h = fd;
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h)
+INT16 Platform_New (CHAR *n, LONGINT n__len, INT64 *h)
{
- INTEGER _o_result;
- LONGINT fd;
+ INT64 fd;
fd = Platform_opennew(n, n__len);
if (fd == Platform_invalidHandleValue()) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
*h = fd;
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Close (LONGINT h)
+INT16 Platform_Close (INT64 h)
{
- INTEGER _o_result;
if (Platform_closeHandle(h) == 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ)
+INT16 Platform_Identify (INT64 h, Platform_FileIdentity *identity, ADDRESS *identity__typ)
{
- INTEGER _o_result;
Platform_byHandleFileInformation();
if (Platform_getFileInformationByHandle(h) == 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
}
(*identity).volume = Platform_bhfiVsn();
(*identity).indexhigh = Platform_bhfiIndexHigh();
(*identity).indexlow = Platform_bhfiIndexLow();
(*identity).mtimehigh = Platform_bhfiMtimeHigh();
(*identity).mtimelow = Platform_bhfiMtimeLow();
- _o_result = 0;
- return _o_result;
+ return 0;
}
-INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ)
+INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
{
- INTEGER _o_result;
- LONGINT h;
- INTEGER e, i;
+ INT64 h;
+ INT16 e, i;
__DUP(n, n__len, CHAR);
e = Platform_OldRO((void*)n, n__len, &h);
if (e != 0) {
- _o_result = e;
__DEL(n);
- return _o_result;
+ return e;
}
e = Platform_Identify(h, &*identity, identity__typ);
i = Platform_Close(h);
- _o_result = e;
__DEL(n);
- return _o_result;
+ return e;
}
BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2)
{
- BOOLEAN _o_result;
- _o_result = (((i1.indexhigh == i2.indexhigh && i1.indexlow == i2.indexlow)) && i1.volume == i2.volume);
- return _o_result;
+ return (((i1.indexhigh == i2.indexhigh && i1.indexlow == i2.indexlow)) && i1.volume == i2.volume);
}
BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2)
{
- BOOLEAN _o_result;
- _o_result = (i1.mtimehigh == i2.mtimehigh && i1.mtimelow == i2.mtimelow);
- return _o_result;
+ return (i1.mtimehigh == i2.mtimehigh && i1.mtimelow == i2.mtimelow);
}
-void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source)
+void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__typ, Platform_FileIdentity source)
{
(*target).mtimehigh = source.mtimehigh;
(*target).mtimelow = source.mtimelow;
}
-void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d)
+void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d)
{
Platform_identityToFileTime(i);
Platform_fileTimeToSysTime();
Platform_YMDHMStoClock(Platform_styear(), Platform_stmon(), Platform_stmday(), Platform_sthour(), Platform_stmin(), Platform_stsec(), &*t, &*d);
}
-INTEGER Platform_Size (LONGINT h, LONGINT *l)
+INT16 Platform_Size (INT64 h, INT32 *l)
{
- INTEGER _o_result;
Platform_largeInteger();
if (Platform_getFileSize(h) == 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
}
*l = Platform_liLongint();
- _o_result = 0;
- return _o_result;
+ return 0;
}
-INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n)
+INT16 Platform_Read (INT64 h, INT64 p, INT32 l, INT32 *n)
{
- INTEGER _o_result;
- INTEGER result;
- *n = 0;
- result = Platform_readfile(h, p, l, &*n);
+ INT16 result;
+ INT32 lengthread;
+ result = Platform_readfile(h, p, l, &lengthread);
if (result == 0) {
*n = 0;
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ *n = lengthread;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n)
+INT16 Platform_ReadBuf (INT64 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n)
{
- INTEGER _o_result;
- INTEGER result;
- *n = 0;
- result = Platform_readfile(h, (LONGINT)(SYSTEM_ADDRESS)b, b__len, &*n);
+ INT16 result;
+ INT32 lengthread;
+ result = Platform_readfile(h, (ADDRESS)b, b__len, &lengthread);
if (result == 0) {
*n = 0;
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ *n = lengthread;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l)
+INT16 Platform_Write (INT64 h, INT64 p, INT32 l)
{
- INTEGER _o_result;
- if (Platform_writefile(h, p, l) == 0) {
- _o_result = Platform_err();
- return _o_result;
+ INT32 n;
+ if (Platform_writefile(h, p, l, &n) == 0) {
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Sync (LONGINT h)
+INT16 Platform_Sync (INT64 h)
{
- INTEGER _o_result;
if (Platform_flushFileBuffers(h) == 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Seek (LONGINT h, LONGINT o, INTEGER r)
+INT16 Platform_Seek (INT64 h, INT32 o, INT16 r)
{
- INTEGER _o_result;
- INTEGER rc;
+ INT16 rc;
Platform_largeInteger();
Platform_setFilePointerEx(h, o, r, &rc);
if (rc == 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Truncate (LONGINT h, LONGINT limit)
+INT16 Platform_Truncate (INT64 h, INT32 limit)
{
- INTEGER _o_result;
- INTEGER rc;
- LONGINT oldpos;
+ INT16 rc;
+ INT32 oldpos;
Platform_largeInteger();
Platform_getFilePos(h, &oldpos, &rc);
if (rc == 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
}
Platform_setFilePointerEx(h, limit, Platform_seekset(), &rc);
if (rc == 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
}
if (Platform_setEndOfFile(h) == 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
}
Platform_setFilePointerEx(h, oldpos, Platform_seekset(), &rc);
if (rc == 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
}
- _o_result = 0;
- return _o_result;
+ return 0;
}
-INTEGER Platform_Unlink (CHAR *n, LONGINT n__len)
+INT16 Platform_Unlink (CHAR *n, LONGINT n__len)
{
- INTEGER _o_result;
if (Platform_deleteFile(n, n__len) == 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-INTEGER Platform_Chdir (CHAR *n, LONGINT n__len)
+INT16 Platform_Chdir (CHAR *n, LONGINT n__len)
{
- INTEGER _o_result;
- INTEGER r;
+ INT16 r;
r = Platform_setCurrentDirectory(n, n__len);
if (r == 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
}
- Platform_getCurrentDirectory((void*)Platform_CWD, ((LONGINT)(4096)));
- _o_result = 0;
- return _o_result;
+ Platform_getCurrentDirectory((void*)Platform_CWD, 4096);
+ return 0;
}
-INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len)
+INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len)
{
- INTEGER _o_result;
if (Platform_moveFile(o, o__len, n, n__len) == 0) {
- _o_result = Platform_err();
- return _o_result;
+ return Platform_err();
} else {
- _o_result = 0;
- return _o_result;
+ return 0;
}
__RETCHK;
}
-void Platform_Exit (INTEGER code)
+void Platform_Exit (INT32 code)
{
Platform_exit(code);
}
-static void Platform_errch (CHAR c)
+static void Platform_EnableVT100 (void)
{
- Platform_errc(c);
-}
-
-static void Platform_errln (void)
-{
- Platform_errch(0x0d);
- Platform_errch(0x0a);
-}
-
-static void Platform_errposint (LONGINT l)
-{
- if (l > 10) {
- Platform_errposint(__DIV(l, 10));
- }
- Platform_errch((CHAR)(48 + __MOD(l, 10)));
-}
-
-static void Platform_errint (LONGINT l)
-{
- if (l < 0) {
- Platform_errch('-');
- l = -l;
- }
- Platform_errposint(l);
-}
-
-static void Platform_DisplayHaltCode (LONGINT code)
-{
- switch (code) {
- case -1:
- Platform_errstring((CHAR*)"Rider ReadBuf/WriteBuf transfer size longer than buffer.", (LONGINT)57);
- break;
- case -2:
- Platform_errstring((CHAR*)"Index out of range.", (LONGINT)20);
- break;
- case -3:
- Platform_errstring((CHAR*)"Reached end of function without reaching RETURN.", (LONGINT)49);
- break;
- case -4:
- Platform_errstring((CHAR*)"CASE statement: no matching label and no ELSE.", (LONGINT)47);
- break;
- case -5:
- Platform_errstring((CHAR*)"Type guard failed.", (LONGINT)19);
- break;
- case -6:
- Platform_errstring((CHAR*)"Type equality failed.", (LONGINT)22);
- break;
- case -7:
- Platform_errstring((CHAR*)"WITH statement type guard failed.", (LONGINT)34);
- break;
- case -8:
- Platform_errstring((CHAR*)"SHORT: Value too large for shorter type.", (LONGINT)41);
- break;
- case -9:
- Platform_errstring((CHAR*)"Heap interrupted while locked, but lockdepth = 0 at unlock.", (LONGINT)60);
- break;
- case -15:
- Platform_errstring((CHAR*)"Type descriptor size mismatch.", (LONGINT)31);
- break;
- case -20:
- Platform_errstring((CHAR*)"Too many, or negative number of, elements in dynamic array.", (LONGINT)60);
- break;
- default:
- break;
+ INT32 mode;
+ if (Platform_GetConsoleMode(Platform_StdOut, &mode)) {
+ Platform_SetConsoleMode(Platform_StdOut, mode + 4);
}
}
-void Platform_Halt (LONGINT code)
+BOOLEAN Platform_IsConsole (INT64 h)
{
- INTEGER e;
- Platform_HaltCode = code;
- if (Platform_HaltHandler != NIL) {
- (*Platform_HaltHandler)(code);
- }
- Platform_errstring((CHAR*)"Terminated by Halt(", (LONGINT)20);
- Platform_errint(code);
- Platform_errstring((CHAR*)"). ", (LONGINT)4);
- if (code < 0) {
- Platform_DisplayHaltCode(code);
- }
- Platform_errln();
- Platform_exit(__VAL(INTEGER, code));
-}
-
-void Platform_AssertFail (LONGINT code)
-{
- INTEGER e;
- Platform_errstring((CHAR*)"Assertion failure.", (LONGINT)19);
- if (code != 0) {
- Platform_errstring((CHAR*)" ASSERT code ", (LONGINT)14);
- Platform_errint(code);
- Platform_errstring((CHAR*)".", (LONGINT)2);
- }
- Platform_errln();
- Platform_exit(__VAL(INTEGER, code));
-}
-
-void Platform_SetHalt (Platform_HaltProcedure p)
-{
- Platform_HaltHandler = p;
+ INT32 mode;
+ return Platform_GetConsoleMode(Platform_StdOut, &mode);
}
static void Platform_TestLittleEndian (void)
{
- INTEGER i;
+ INT16 i;
i = 1;
- __GET((LONGINT)(SYSTEM_ADDRESS)&i, Platform_LittleEndian, BOOLEAN);
+ __GET((ADDRESS)&i, Platform_LittleEndian, BOOLEAN);
}
-__TDESC(Platform_FileIdentity, 1, 0) = {__TDFLDS("FileIdentity", 40), {-8}};
+__TDESC(Platform_FileIdentity, 1, 0) = {__TDFLDS("FileIdentity", 20), {-8}};
export void *Platform__init(void)
{
@@ -813,7 +651,7 @@ export void *Platform__init(void)
Platform_TimeStart = 0;
Platform_TimeStart = Platform_Time();
Platform_CWD[0] = 0x00;
- Platform_getCurrentDirectory((void*)Platform_CWD, ((LONGINT)(4096)));
+ Platform_getCurrentDirectory((void*)Platform_CWD, 4096);
Platform_PID = Platform_getpid();
Platform_SeekSet = Platform_seekset();
Platform_SeekCur = Platform_seekcur();
@@ -821,8 +659,9 @@ export void *Platform__init(void)
Platform_StdIn = Platform_getstdinhandle();
Platform_StdOut = Platform_getstdouthandle();
Platform_StdErr = Platform_getstderrhandle();
- Platform_nl[0] = 0x0d;
- Platform_nl[1] = 0x0a;
- Platform_nl[2] = 0x00;
+ Platform_EnableVT100();
+ Platform_NL[0] = 0x0d;
+ Platform_NL[1] = 0x0a;
+ Platform_NL[2] = 0x00;
__ENDMOD;
}
diff --git a/bootstrap/windows-88/Platform.h b/bootstrap/windows-88/Platform.h
index 374b6842..f6a5d008 100644
--- a/bootstrap/windows-88/Platform.h
+++ b/bootstrap/windows-88/Platform.h
@@ -1,85 +1,81 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Platform__h
#define Platform__h
-#define LARGE
#include "SYSTEM.h"
typedef
struct Platform_FileIdentity {
- LONGINT _prvt0;
- char _prvt1[32];
+ INT32 _prvt0;
+ char _prvt1[16];
} Platform_FileIdentity;
typedef
- void (*Platform_HaltProcedure)(LONGINT);
-
-typedef
- void (*Platform_SignalHandler)(INTEGER);
+ void (*Platform_SignalHandler)(INT32);
import BOOLEAN Platform_LittleEndian;
-import LONGINT Platform_MainStackFrame, Platform_HaltCode;
-import INTEGER Platform_PID;
+import INT64 Platform_MainStackFrame;
+import INT32 Platform_HaltCode;
+import INT16 Platform_PID;
import CHAR Platform_CWD[4096];
-import INTEGER Platform_ArgCount;
-import LONGINT Platform_ArgVector;
-import INTEGER Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
-import LONGINT Platform_StdIn, Platform_StdOut, Platform_StdErr;
-import CHAR Platform_nl[3];
+import INT16 Platform_ArgCount;
+import INT64 Platform_ArgVector;
+import INT16 Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
+import INT64 Platform_StdIn, Platform_StdOut, Platform_StdErr;
+import CHAR Platform_NL[3];
-import LONGINT *Platform_FileIdentity__typ;
+import ADDRESS *Platform_FileIdentity__typ;
-import BOOLEAN Platform_Absent (INTEGER e);
-import INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len);
-import void Platform_AssertFail (LONGINT code);
-import INTEGER Platform_Chdir (CHAR *n, LONGINT n__len);
-import INTEGER Platform_Close (LONGINT h);
-import BOOLEAN Platform_ConnectionFailed (INTEGER e);
-import void Platform_Delay (LONGINT ms);
-import BOOLEAN Platform_DifferentFilesystems (INTEGER e);
-import INTEGER Platform_Error (void);
-import void Platform_Exit (INTEGER code);
-import void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len);
-import void Platform_GetClock (LONGINT *t, LONGINT *d);
+import BOOLEAN Platform_Absent (INT16 e);
+import INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
+import INT16 Platform_Chdir (CHAR *n, LONGINT n__len);
+import INT16 Platform_Close (INT64 h);
+import BOOLEAN Platform_ConnectionFailed (INT16 e);
+import void Platform_Delay (INT32 ms);
+import BOOLEAN Platform_DifferentFilesystems (INT16 e);
+import INT16 Platform_Error (void);
+import void Platform_Exit (INT32 code);
+import void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len);
+import void Platform_GetClock (INT32 *t, INT32 *d);
import void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
-import void Platform_GetIntArg (INTEGER n, LONGINT *val);
-import void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec);
-import void Platform_Halt (LONGINT code);
-import INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ);
-import INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ);
-import BOOLEAN Platform_Inaccessible (INTEGER e);
-import void Platform_Init (INTEGER argc, LONGINT argvadr);
-import void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d);
-import INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h);
-import BOOLEAN Platform_NoSuchDirectory (INTEGER e);
-import LONGINT Platform_OSAllocate (LONGINT size);
-import void Platform_OSFree (LONGINT address);
-import INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h);
-import INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h);
-import INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n);
-import INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n);
-import INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
+import void Platform_GetIntArg (INT16 n, INT32 *val);
+import void Platform_GetTimeOfDay (INT32 *sec, INT32 *usec);
+import INT16 Platform_Identify (INT64 h, Platform_FileIdentity *identity, ADDRESS *identity__typ);
+import INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
+import BOOLEAN Platform_Inaccessible (INT16 e);
+import void Platform_Init (INT32 argc, INT64 argvadr);
+import BOOLEAN Platform_Interrupted (INT16 e);
+import BOOLEAN Platform_IsConsole (INT64 h);
+import void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d);
+import INT16 Platform_New (CHAR *n, LONGINT n__len, INT64 *h);
+import BOOLEAN Platform_NoSuchDirectory (INT16 e);
+import INT64 Platform_OSAllocate (INT64 size);
+import void Platform_OSFree (INT64 address);
+import INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT64 *h);
+import INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT64 *h);
+import INT16 Platform_Read (INT64 h, INT64 p, INT32 l, INT32 *n);
+import INT16 Platform_ReadBuf (INT64 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n);
+import INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
import BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2);
import BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2);
-import INTEGER Platform_Seek (LONGINT h, LONGINT o, INTEGER r);
+import INT16 Platform_Seek (INT64 h, INT32 o, INT16 r);
import void Platform_SetBadInstructionHandler (Platform_SignalHandler handler);
-import void Platform_SetHalt (Platform_HaltProcedure p);
-import void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source);
-import INTEGER Platform_Size (LONGINT h, LONGINT *l);
-import INTEGER Platform_Sync (LONGINT h);
-import INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len);
-import LONGINT Platform_Time (void);
-import BOOLEAN Platform_TimedOut (INTEGER e);
-import BOOLEAN Platform_TooManyFiles (INTEGER e);
-import INTEGER Platform_Truncate (LONGINT h, LONGINT limit);
-import INTEGER Platform_Unlink (CHAR *n, LONGINT n__len);
-import INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l);
+import void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__typ, Platform_FileIdentity source);
+import INT16 Platform_Size (INT64 h, INT32 *l);
+import INT16 Platform_Sync (INT64 h);
+import INT16 Platform_System (CHAR *cmd, LONGINT cmd__len);
+import INT32 Platform_Time (void);
+import BOOLEAN Platform_TimedOut (INT16 e);
+import BOOLEAN Platform_TooManyFiles (INT16 e);
+import INT16 Platform_Truncate (INT64 h, INT32 limit);
+import INT16 Platform_Unlink (CHAR *n, LONGINT n__len);
+import INT16 Platform_Write (INT64 h, INT64 p, INT32 l);
import BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
import void *Platform__init(void);
-#define Platform_SetInterruptHandler(h) SystemSetInterruptHandler((SYSTEM_ADDRESS)h)
-#define Platform_SetQuitHandler(h) SystemSetQuitHandler((SYSTEM_ADDRESS)h)
+#define Platform_SetInterruptHandler(h) SystemSetInterruptHandler((ADDRESS)h)
+#define Platform_SetQuitHandler(h) SystemSetQuitHandler((ADDRESS)h)
-#endif
+#endif // Platform
diff --git a/bootstrap/windows-88/Reals.c b/bootstrap/windows-88/Reals.c
index 8b61d8cd..cd4c3c61 100644
--- a/bootstrap/windows-88/Reals.c
+++ b/bootstrap/windows-88/Reals.c
@@ -1,26 +1,30 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len);
-export void Reals_Convert (REAL x, INTEGER n, CHAR *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, INTEGER n, CHAR *d, LONGINT d__len);
-export INTEGER Reals_Expo (REAL x);
-export INTEGER Reals_ExpoL (LONGREAL x);
-export void Reals_SetExpo (REAL *x, INTEGER ex);
-export REAL Reals_Ten (INTEGER e);
-export LONGREAL Reals_TenL (INTEGER e);
-static CHAR Reals_ToHex (INTEGER i);
+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);
+export REAL Reals_Ten (INT16 e);
+export LONGREAL Reals_TenL (INT16 e);
+static CHAR Reals_ToHex (INT16 i);
-REAL Reals_Ten (INTEGER e)
+REAL Reals_Ten (INT16 e)
{
- REAL _o_result;
LONGREAL r, power;
r = (LONGREAL)1;
power = (LONGREAL)10;
@@ -31,13 +35,11 @@ REAL Reals_Ten (INTEGER e)
power = power * power;
e = __ASHR(e, 1);
}
- _o_result = r;
- return _o_result;
+ return r;
}
-LONGREAL Reals_TenL (INTEGER e)
+LONGREAL Reals_TenL (INT16 e)
{
- LONGREAL _o_result;
LONGREAL r, power;
r = (LONGREAL)1;
power = (LONGREAL)10;
@@ -47,97 +49,102 @@ LONGREAL Reals_TenL (INTEGER e)
}
e = __ASHR(e, 1);
if (e <= 0) {
- _o_result = r;
- return _o_result;
+ return r;
}
power = power * power;
}
__RETCHK;
}
-INTEGER Reals_Expo (REAL x)
+INT16 Reals_Expo (REAL x)
{
- INTEGER _o_result;
- INTEGER i;
- __GET((LONGINT)(SYSTEM_ADDRESS)&x + 2, i, INTEGER);
- _o_result = __MASK(__ASHR(i, 7), -256);
- return _o_result;
+ INT16 i;
+ __GET((ADDRESS)&x + 2, i, INT16);
+ return __MASK(__ASHR(i, 7), -256);
}
-void Reals_SetExpo (REAL *x, INTEGER ex)
+void Reals_SetExpo (REAL *x, INT16 ex)
{
CHAR c;
- __GET((LONGINT)(SYSTEM_ADDRESS)x + 3, c, CHAR);
- __PUT((LONGINT)(SYSTEM_ADDRESS)x + 3, (CHAR)(__ASHL(__ASHR((int)c, 7), 7) + __MASK(__ASHR(ex, 1), -128)), CHAR);
- __GET((LONGINT)(SYSTEM_ADDRESS)x + 2, c, CHAR);
- __PUT((LONGINT)(SYSTEM_ADDRESS)x + 2, (CHAR)(__MASK((int)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR);
+ __GET((ADDRESS)x + 3, c, 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, (CHAR)(__MASK((INT16)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR);
}
-INTEGER Reals_ExpoL (LONGREAL x)
+INT16 Reals_ExpoL (LONGREAL x)
{
- INTEGER _o_result;
- INTEGER i;
- __GET((LONGINT)(SYSTEM_ADDRESS)&x + 6, i, INTEGER);
- _o_result = __MASK(__ASHR(i, 4), -2048);
- return _o_result;
+ INT16 i;
+ __GET((ADDRESS)&x + 6, i, INT16);
+ return __MASK(__ASHR(i, 4), -2048);
}
-void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len)
+void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len)
{
- LONGINT i, j, k;
+ INT32 i, j, k;
if (x < (LONGREAL)0) {
x = -x;
}
k = 0;
- i = __ENTIER(x);
- while (k < (SYSTEM_INT64)n) {
- d[__X(k, d__len)] = (CHAR)(__MOD(i, 10) + 48);
+ if (n > 9) {
+ 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)] = (CHAR)((int)__MOD(j, 10) + 48);
+ j = __DIV(j, 10);
+ k += 1;
+ }
+ } else {
+ i = (INT32)__ENTIER(x);
+ }
+ while (k < n) {
+ d[__X(k, d__len)] = (CHAR)((int)__MOD(i, 10) + 48);
i = __DIV(i, 10);
k += 1;
}
}
-void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len)
+void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len)
{
Reals_ConvertL(x, n, (void*)d, d__len);
}
-static CHAR Reals_ToHex (INTEGER i)
+static CHAR Reals_ToHex (INT16 i)
{
- CHAR _o_result;
if (i < 10) {
- _o_result = (CHAR)(i + 48);
- return _o_result;
+ return (CHAR)(i + 48);
} else {
- _o_result = (CHAR)(i + 55);
- return _o_result;
+ return (CHAR)(i + 55);
}
__RETCHK;
}
static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len)
{
- INTEGER i;
- LONGINT l;
+ INT16 i;
+ INT32 l;
CHAR by;
i = 0;
l = b__len;
- while ((SYSTEM_INT64)i < l) {
+ while (i < l) {
by = __VAL(CHAR, b[__X(i, b__len)]);
- d[__X(__ASHL(i, 1), d__len)] = Reals_ToHex(__ASHR((int)by, 4));
- d[__X(__ASHL(i, 1) + 1, d__len)] = Reals_ToHex(__MASK((int)by, -16));
+ d[__X(__ASHL(i, 1), d__len)] = Reals_ToHex(__ASHR((INT16)by, 4));
+ d[__X(__ASHL(i, 1) + 1, d__len)] = Reals_ToHex(__MASK((INT16)by, -16));
i += 1;
}
}
void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len)
{
- Reals_BytesToHex((void*)&y, ((LONGINT)(4)), (void*)d, d__len * ((LONGINT)(1)));
+ Reals_BytesToHex((void*)&y, 4, (void*)d, d__len * 1);
}
void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len)
{
- Reals_BytesToHex((void*)&x, ((LONGINT)(8)), (void*)d, d__len * ((LONGINT)(1)));
+ Reals_BytesToHex((void*)&x, 8, (void*)d, d__len * 1);
}
diff --git a/bootstrap/windows-88/Reals.h b/bootstrap/windows-88/Reals.h
index ff21c192..f0c84ab1 100644
--- a/bootstrap/windows-88/Reals.h
+++ b/bootstrap/windows-88/Reals.h
@@ -1,24 +1,23 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Reals__h
#define Reals__h
-#define LARGE
#include "SYSTEM.h"
-import void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len);
+import void Reals_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, INTEGER n, CHAR *d, LONGINT d__len);
-import INTEGER Reals_Expo (REAL x);
-import INTEGER Reals_ExpoL (LONGREAL x);
-import void Reals_SetExpo (REAL *x, INTEGER ex);
-import REAL Reals_Ten (INTEGER e);
-import LONGREAL Reals_TenL (INTEGER e);
+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);
+import REAL Reals_Ten (INT16 e);
+import LONGREAL Reals_TenL (INT16 e);
import void *Reals__init(void);
-#endif
+#endif // Reals
diff --git a/bootstrap/windows-88/SYSTEM.c b/bootstrap/windows-88/SYSTEM.c
deleted file mode 100644
index 33511a70..00000000
--- a/bootstrap/windows-88/SYSTEM.c
+++ /dev/null
@@ -1,207 +0,0 @@
-/*
-* The body prefix file of the voc(jet backend) runtime system, Version 1.0
-*
-* Copyright (c) Software Templ, 1994, 1995
-*
-* Module SYSTEM is subject to change any time without prior notification.
-* Software Templ disclaims all warranties with regard to module SYSTEM,
-* in particular shall Software Templ not be liable for any damage resulting
-* from inappropriate use or modification of module SYSTEM.
-*
-* Version 1.1 jt, 24.11.95 fixes for correct pointer arithmetic on Cray computers
-* jt 31.1.2007 ANSI prototypes for malloc and exit in order to avoid cc warnings
-*
-*/
-
-#include "SYSTEM.h"
-#include "stdarg.h"
-#include
-
-
-LONGINT SYSTEM_XCHK(LONGINT i, LONGINT ub) {return __X(i, ub);}
-LONGINT SYSTEM_RCHK(LONGINT i, LONGINT ub) {return __R(i, ub);}
-LONGINT SYSTEM_ASH (LONGINT i, LONGINT n) {return __ASH(i, n);}
-LONGINT SYSTEM_ABS (LONGINT i) {return __ABS(i);}
-double SYSTEM_ABSD(double i) {return __ABS(i);}
-
-void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0)
-{
- t -= __TPROC0OFF;
- t0 -= __TPROC0OFF;
- while (*t0 != __EOM) {*t = *t0; t--; t0--;}
-}
-
-
-void SYSTEM_ENUMP(void *adr, LONGINT n, void (*P)())
-{
- while (n > 0) {
- P((LONGINT)(SYSTEM_ADDRESS)(*((void**)(adr))));
- adr = ((void**)adr) + 1;
- n--;
- }
-}
-
-void SYSTEM_ENUMR(void *adr, LONGINT *typ, LONGINT size, LONGINT n, void (*P)())
-{
- LONGINT *t, off;
- typ++;
- while (n > 0) {
- t = typ;
- off = *t;
- while (off >= 0) {P(*(LONGINT*)((char*)adr+off)); t++; off = *t;}
- adr = ((char*)adr) + size;
- n--;
- }
-}
-
-LONGINT SYSTEM_DIV(U_LONGINT x, U_LONGINT y)
-{ if ((LONGINT) x >= 0) return (x / y);
- else return -((y - 1 - x) / y);
-}
-
-LONGINT SYSTEM_MOD(U_LONGINT x, U_LONGINT y)
-{ U_LONGINT m;
- if ((LONGINT) x >= 0) return (x % y);
- else { m = (-x) % y;
- if (m != 0) return (y - m); else return 0;
- }
-}
-
-LONGINT SYSTEM_ENTIER(double x)
-{
- LONGINT y;
- if (x >= 0)
- return (LONGINT)x;
- else {
- y = (LONGINT)x;
- if (y <= x) return y; else return y - 1;
- }
-}
-
-extern void Heap_Lock();
-extern void Heap_Unlock();
-
-SYSTEM_PTR SYSTEM_NEWARR(LONGINT *typ, LONGINT elemsz, int elemalgn, int nofdim, int nofdyn, ...)
-{
- LONGINT nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off;
- va_list ap;
- va_start(ap, nofdyn);
- nofelems = 1;
- while (nofdim > 0) {
- nofelems = nofelems * va_arg(ap, LONGINT); nofdim--;
- if (nofelems <= 0) __HALT(-20);
- }
- va_end(ap);
- dataoff = nofdyn * sizeof(LONGINT);
- if (elemalgn > sizeof(LONGINT)) {
- n = dataoff % elemalgn;
- if (n != 0) dataoff += elemalgn - n;
- }
- size = dataoff + nofelems * elemsz;
- Heap_Lock();
- if (typ == NIL) {
- /* element typ does not contain pointers */
- x = Heap_NEWBLK(size);
- }
- else if (typ == (LONGINT*)POINTER__typ) {
- /* element type is a pointer */
- x = Heap_NEWBLK(size + nofelems * sizeof(LONGINT));
- p = (LONGINT*)(SYSTEM_ADDRESS)x[-1];
- p[-nofelems] = *p; /* build new type desc in situ: 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */
- p -= nofelems - 1; n = 1; /* n =1 for skipping the size field */
- while (n <= nofelems) {*p = n*sizeof(LONGINT); p++; n++;}
- *p = - (nofelems + 1) * sizeof(LONGINT); /* sentinel */
- x[-1] -= nofelems * sizeof(LONGINT);
- }
- else {
- /* element type is a record that contains pointers */
- ptab = typ + 1; nofptrs = 0;
- while (ptab[nofptrs] >= 0) {nofptrs++;} /* number of pointers per element */
- nptr = nofelems * nofptrs; /* total number of pointers */
- x = Heap_NEWBLK(size + nptr * sizeof(LONGINT));
- p = (LONGINT*)(SYSTEM_ADDRESS)x[- 1];
- p[-nptr] = *p; /* build new type desc in situ; 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */
- p -= nptr - 1; n = 0; off = dataoff;
- while (n < nofelems) {i = 0;
- while (i < nofptrs) {*p = off + ptab[i]; p++; i++;}
- off += elemsz; n++;
- }
- *p = - (nptr + 1) * sizeof(LONGINT); /* sentinel */
- x[-1] -= nptr * sizeof(LONGINT);
- }
- if (nofdyn != 0) {
- /* setup len vector for index checks */
- va_start(ap, nofdyn);
- p = x;
- while (nofdyn > 0) {*p = va_arg(ap, LONGINT); p++, nofdyn--;}
- va_end(ap);
- }
- Heap_Unlock();
- return x;
-}
-
-
-
-
-typedef void (*SystemSignalHandler)(INTEGER); // = Platform_SignalHandler
-
-#ifndef _WIN32
-
- SystemSignalHandler handler[3] = {0};
-
- // Provide signal handling for Unix based systems
- void signalHandler(int s) {
- if (s >= 2 && s <= 4) handler[s-2](s);
- // (Ignore other signals)
- }
-
- void SystemSetHandler(int s, SYSTEM_ADDRESS h) {
- if (s >= 2 && s <= 4) {
- int needtosetsystemhandler = handler[s-2] == 0;
- handler[s-2] = (SystemSignalHandler)h;
- if (needtosetsystemhandler) {signal(s, signalHandler);}
- }
- }
-
-#else
-
- // Provides Windows callback handlers for signal-like scenarios
- #include "WindowsWrapper.h"
-
- SystemSignalHandler SystemInterruptHandler = 0;
- SystemSignalHandler SystemQuitHandler = 0;
- BOOL ConsoleCtrlHandlerSet = FALSE;
-
- BOOL WINAPI SystemConsoleCtrlHandler(DWORD ctrlType) {
- if ((ctrlType == CTRL_C_EVENT) || (ctrlType == CTRL_BREAK_EVENT)) {
- if (SystemInterruptHandler) {
- SystemInterruptHandler(2); // SIGINT
- return TRUE;
- }
- } else { // Close, logoff or shutdown
- if (SystemQuitHandler) {
- SystemQuitHandler(3); // SIGQUIT
- return TRUE;
- }
- }
- return FALSE;
- }
-
- void EnsureConsoleCtrlHandler() {
- if (!ConsoleCtrlHandlerSet) {
- SetConsoleCtrlHandler(SystemConsoleCtrlHandler, TRUE);
- ConsoleCtrlHandlerSet = TRUE;
- }
- }
-
- void SystemSetInterruptHandler(SYSTEM_ADDRESS h) {
- EnsureConsoleCtrlHandler();
- SystemInterruptHandler = (SystemSignalHandler)h;
- }
-
- void SystemSetQuitHandler(SYSTEM_ADDRESS h) {
- EnsureConsoleCtrlHandler();
- SystemQuitHandler = (SystemSignalHandler)h;
- }
-
-#endif
diff --git a/bootstrap/windows-88/SYSTEM.h b/bootstrap/windows-88/SYSTEM.h
deleted file mode 100644
index 6377745e..00000000
--- a/bootstrap/windows-88/SYSTEM.h
+++ /dev/null
@@ -1,295 +0,0 @@
-#ifndef SYSTEM__h
-#define SYSTEM__h
-
-#if defined(_WIN64)
- typedef long long SYSTEM_INT64;
- typedef unsigned long long SYSTEM_CARD64;
-#else
- typedef long SYSTEM_INT64;
- typedef unsigned long SYSTEM_CARD64;
-#endif
-
-typedef int SYSTEM_INT32;
-typedef unsigned int SYSTEM_CARD32;
-typedef short int SYSTEM_INT16;
-typedef unsigned short int SYSTEM_CARD16;
-typedef signed char SYSTEM_INT8;
-typedef unsigned char SYSTEM_CARD8;
-
-#if (__SIZEOF_POINTER__ == 8) || defined(_WIN64) || defined(__LP64__)
- #if defined(_WIN64)
- typedef unsigned long long size_t;
- #else
- typedef unsigned long size_t;
- #endif
-#else
- typedef unsigned int size_t;
-#endif
-
-#define SYSTEM_ADDRESS size_t
-#define _SIZE_T_DECLARED // For FreeBSD
-#define _SIZE_T_DEFINED_ // For OpenBSD
-
-void *memcpy(void *dest, const void *source, SYSTEM_ADDRESS size);
-
-
-
-// The compiler uses 'import' and 'export' which translate to 'extern' and
-// nothing respectively.
-
-#define import extern
-#define export
-
-
-
-// Known constants
-
-#define NIL ((void*)0)
-#define __MAXEXT 16
-#define POINTER__typ ((LONGINT*)(1)) // not NIL and not a valid type
-
-
-// Oberon types
-
-typedef char BOOLEAN;
-typedef unsigned char SYSTEM_BYTE;
-typedef unsigned char CHAR;
-typedef signed char SHORTINT;
-typedef float REAL;
-typedef double LONGREAL;
-typedef void* SYSTEM_PTR;
-
-// Unsigned variants are for use by shift and rotate macros.
-
-typedef unsigned char U_SYSTEM_BYTE;
-typedef unsigned char U_CHAR;
-typedef unsigned char U_SHORTINT;
-
-// For 32 bit builds, the size of LONGINT depends on a make option:
-
-#if (__SIZEOF_POINTER__ == 8) || defined(LARGE) || defined(_WIN64)
- typedef int INTEGER; // INTEGER is 32 bit.
- typedef long long LONGINT; // LONGINT is 64 bit. (long long is always 64 bits, while long can be 32 bits e.g. under MSC/MingW)
- typedef unsigned int U_INTEGER;
- typedef unsigned long long U_LONGINT;
-#else
- typedef short int INTEGER; // INTEGER is 16 bit.
- typedef long LONGINT; // LONGINT is 32 bit.
- typedef unsigned short int U_INTEGER;
- typedef unsigned long U_LONGINT;
-#endif
-
-typedef U_LONGINT SET;
-typedef U_LONGINT U_SET;
-
-
-// OS Memory allocation interfaces are in PlatformXXX.Mod
-
-extern LONGINT Platform_OSAllocate (LONGINT size);
-extern void Platform_OSFree (LONGINT addr);
-
-
-// Run time system routines in SYSTEM.c
-
-extern LONGINT SYSTEM_XCHK (LONGINT i, LONGINT ub);
-extern LONGINT SYSTEM_RCHK (LONGINT i, LONGINT ub);
-extern LONGINT SYSTEM_ASH (LONGINT i, LONGINT n);
-extern LONGINT SYSTEM_ABS (LONGINT i);
-extern double SYSTEM_ABSD (double i);
-extern void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0);
-extern void SYSTEM_ENUMP (void *adr, LONGINT n, void (*P)());
-extern void SYSTEM_ENUMR (void *adr, LONGINT *typ, LONGINT size, LONGINT n, void (*P)());
-extern LONGINT SYSTEM_DIV (U_LONGINT x, U_LONGINT y);
-extern LONGINT SYSTEM_MOD (U_LONGINT x, U_LONGINT y);
-extern LONGINT SYSTEM_ENTIER (double x);
-
-
-// Signal handling in SYSTEM.c
-
-#ifndef _WIN32
- extern void SystemSetHandler(int s, SYSTEM_ADDRESS h);
-#else
- extern void SystemSetInterruptHandler(SYSTEM_ADDRESS h);
- extern void SystemSetQuitHandler (SYSTEM_ADDRESS h);
-#endif
-
-
-
-// String comparison
-
-static int __str_cmp(CHAR *x, CHAR *y){
- LONGINT i = 0;
- CHAR ch1, ch2;
- do {ch1 = x[i]; ch2 = y[i]; i++;
- if (!ch1) return -(int)ch2;
- } while (ch1==ch2);
- return (int)ch1 - (int)ch2;
-}
-#define __STRCMP(a,b) __str_cmp((CHAR*)(a), (CHAR*)(b))
-
-
-
-// Inline string, record and array copy
-
-#define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d; LONGINT _i=0,_t=n-1; \
- while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;}
-#define __DUP(x, l, t) x=(void*)memcpy((void*)(SYSTEM_ADDRESS)Platform_OSAllocate(l*sizeof(t)),x,l*sizeof(t))
-#define __DUPARR(v, t) v=(void*)memcpy(v##__copy,v,sizeof(t))
-#define __DEL(x) Platform_OSFree((LONGINT)(SYSTEM_ADDRESS)x)
-
-
-
-
-/* SYSTEM ops */
-
-#define __VAL(t, x) (*(t*)&(x))
-
-
-#define __GET(a, x, t) x= *(t*)(SYSTEM_ADDRESS)(a)
-#define __PUT(a, x, t) *(t*)(SYSTEM_ADDRESS)(a)=x
-
-#define __LSHL(x, n, t) ((t)((U_##t)(x)<<(n)))
-#define __LSHR(x, n, t) ((t)((U_##t)(x)>>(n)))
-#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t))
-
-#define __ASHL(x, n) ((LONGINT)(x)<<(n))
-#define __ASHR(x, n) ((LONGINT)(x)>>(n))
-#define __ASH(x, n) ((n)>=0?__ASHL(x,n):__ASHR(x,-(n)))
-
-#define __ROTL(x, n, t) ((t)((U_##t)(x)<<(n)|(U_##t)(x)>>(8*sizeof(t)-(n))))
-#define __ROTR(x, n, t) ((t)((U_##t)(x)>>(n)|(U_##t)(x)<<(8*sizeof(t)-(n))))
-#define __ROT(x, n, t) ((n)>=0? __ROTL(x, n, t): __ROTR(x, -(n), t))
-
-#define __BIT(x, n) (*(U_LONGINT*)(x)>>(n)&1)
-#define __MOVE(s, d, n) memcpy((char*)(SYSTEM_ADDRESS)(d),(char*)(SYSTEM_ADDRESS)(s),n)
-#define __ASHF(x, n) SYSTEM_ASH((LONGINT)(x), (LONGINT)(n))
-#define __SHORT(x, y) ((int)((U_LONGINT)(x)+(y)<(y)+(y)?(x):(__HALT(-8),0)))
-#define __SHORTF(x, y) ((int)(__RF((x)+(y),(y)+(y))-(y)))
-#define __CHR(x) ((CHAR)__R(x, 256))
-#define __CHRF(x) ((CHAR)__RF(x, 256))
-#define __DIV(x, y) ((x)>=0?(x)/(y):-(((y)-1-(x))/(y)))
-#define __DIVF(x, y) SYSTEM_DIV((LONGINT)(x),(LONGINT)(y))
-#define __MOD(x, y) ((x)>=0?(x)%(y):__MODF(x,y))
-#define __MODF(x, y) SYSTEM_MOD((LONGINT)(x),(LONGINT)(y))
-#define __ENTIER(x) SYSTEM_ENTIER(x)
-#define __ABS(x) (((x)<0)?-(x):(x))
-#define __ABSF(x) SYSTEM_ABS((LONGINT)(x))
-#define __ABSFD(x) SYSTEM_ABSD((double)(x))
-#define __CAP(ch) ((CHAR)((ch)&0x5f))
-#define __ODD(x) ((x)&1)
-#define __IN(x, s) (((s)>>(x))&1)
-#define __SETOF(x) ((SET)1<<(x))
-#define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h)))
-#define __MASK(x, m) ((x)&~(m))
-
-
-
-// Runtime checks
-
-#define __X(i, ub) (((U_LONGINT)(i)<(U_LONGINT)(ub))?i:(__HALT(-2),0))
-#define __XF(i, ub) SYSTEM_XCHK((LONGINT)(i), (LONGINT)(ub))
-#define __R(i, ub) (((U_LONGINT)(i)<(U_LONGINT)(ub))?i:(__HALT(-8),0))
-#define __RF(i, ub) SYSTEM_RCHK((LONGINT)(i),(LONGINT)(ub))
-#define __RETCHK __retchk: __HALT(-3); return 0;
-#define __CASECHK __HALT(-4)
-#define __WITHCHK __HALT(-7)
-
-#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p)))
-#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r))))
-#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p)))
-#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p)
-#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p)
-
-
-
-// Module entry/registration/exit
-
-extern void Heap_REGCMD();
-extern SYSTEM_PTR Heap_REGMOD();
-extern void Heap_REGTYP();
-extern void Heap_INCREF();
-
-#define __DEFMOD static void *m; if (m!=0) {return m;}
-#define __REGCMD(name, cmd) Heap_REGCMD(m, (CHAR*)name, cmd)
-#define __REGMOD(name, enum) if (m==0) {m = Heap_REGMOD((CHAR*)name,enum);}
-#define __ENDMOD return m
-#define __MODULE_IMPORT(name) Heap_INCREF(name##__init())
-
-
-
-// Main module initialisation, registration and finalisation
-
-extern void Platform_Init(INTEGER argc, LONGINT argv);
-extern void Heap_FINALL();
-
-#define __INIT(argc, argv) static void *m; Platform_Init((INTEGER)argc, (LONGINT)(SYSTEM_ADDRESS)&argv);
-#define __REGMAIN(name, enum) m = Heap_REGMOD((CHAR*)name,enum)
-#define __FINI Heap_FINALL(); return 0
-
-
-// Assertions and Halts
-
-extern void Platform_Halt(LONGINT x);
-extern void Platform_AssertFail(LONGINT x);
-
-#define __HALT(x) Platform_Halt(x)
-#define __ASSERT(cond, x) if (!(cond)) Platform_AssertFail((LONGINT)(x))
-
-
-// Memory allocation
-
-extern SYSTEM_PTR Heap_NEWBLK (LONGINT size);
-extern SYSTEM_PTR Heap_NEWREC (LONGINT tag);
-extern SYSTEM_PTR SYSTEM_NEWARR(LONGINT*, LONGINT, int, int, int, ...);
-
-#define __SYSNEW(p, len) p = Heap_NEWBLK((LONGINT)(len))
-#define __NEW(p, t) p = Heap_NEWREC((LONGINT)(SYSTEM_ADDRESS)t##__typ)
-#define __NEWARR SYSTEM_NEWARR
-
-
-
-/* Type handling */
-
-#define __TDESC(t, m, n) \
- static struct t##__desc { \
- LONGINT tproc[m]; /* Proc for each ptr field */ \
- LONGINT tag; \
- LONGINT next; /* Module table type list points here */ \
- LONGINT level; \
- LONGINT module; \
- char name[24]; \
- LONGINT basep[__MAXEXT]; /* List of bases this extends */ \
- LONGINT reserved; \
- LONGINT blksz; /* xxx_typ points here */ \
- LONGINT ptr[n+1]; /* Offsets of ptrs up to -ve sentinel */ \
- } t##__desc
-
-#define __BASEOFF (__MAXEXT+1) // blksz as index to base.
-#define __TPROC0OFF (__BASEOFF+24/sizeof(LONGINT)+5) // blksz as index to tproc IFF m=1.
-#define __EOM 1
-#define __TDFLDS(name, size) {__EOM}, 1, 0, 0, 0, name, {0}, 0, size
-#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (LONGINT)(n), P)
-#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (LONGINT)(size), (LONGINT)(n), P)
-
-#define __INITYP(t, t0, level) \
- t##__typ = (LONGINT*)&t##__desc.blksz; \
- memcpy(t##__desc.basep, t0##__typ - __BASEOFF, level*sizeof(LONGINT)); \
- t##__desc.basep[level] = (LONGINT)(SYSTEM_ADDRESS)t##__typ; \
- t##__desc.module = (LONGINT)(SYSTEM_ADDRESS)m; \
- if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \
- t##__desc.blksz = (t##__desc.blksz+5*sizeof(LONGINT)-1)/(4*sizeof(LONGINT))*(4*sizeof(LONGINT)); \
- Heap_REGTYP(m, (LONGINT)(SYSTEM_ADDRESS)&t##__desc.next); \
- SYSTEM_INHERIT(t##__typ, t0##__typ)
-
-#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(LONGINT)(SYSTEM_ADDRESS)typ##__typ)
-#define __TYPEOF(p) ((LONGINT*)(SYSTEM_ADDRESS)(*(((LONGINT*)(p))-1)))
-#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level)
-
-// Oberon-2 type bound procedures support
-#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(LONGINT)(SYSTEM_ADDRESS)proc
-#define __SEND(typ, num, funtyp, parlist) ((funtyp)((SYSTEM_ADDRESS)*(typ-(__TPROC0OFF+num))))parlist
-
-
-
-
-#endif
diff --git a/bootstrap/windows-88/Strings.c b/bootstrap/windows-88/Strings.c
index 20a14540..b5707327 100644
--- a/bootstrap/windows-88/Strings.c
+++ b/bootstrap/windows-88/Strings.c
@@ -1,5 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
@@ -7,49 +12,53 @@
export void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len);
export void Strings_Cap (CHAR *s, LONGINT s__len);
-export void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n);
-export void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len);
-export void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len);
-export INTEGER Strings_Length (CHAR *s, LONGINT s__len);
+export 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 INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos);
-export void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len);
+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);
-INTEGER Strings_Length (CHAR *s, LONGINT s__len)
+INT16 Strings_Length (CHAR *s, LONGINT s__len)
{
- INTEGER _o_result;
- INTEGER i;
+ INT32 i;
__DUP(s, s__len, CHAR);
i = 0;
- while (((SYSTEM_INT64)i < s__len && s[__X(i, s__len)] != 0x00)) {
+ while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
i += 1;
}
- _o_result = i;
- __DEL(s);
- return _o_result;
+ if (i <= 32767) {
+ __DEL(s);
+ return (INT16)i;
+ } else {
+ __DEL(s);
+ return 32767;
+ }
+ __RETCHK;
}
void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len)
{
- INTEGER n1, n2, i;
+ INT16 n1, n2, i;
__DUP(extra, extra__len, CHAR);
n1 = Strings_Length(dest, dest__len);
n2 = Strings_Length(extra, extra__len);
i = 0;
- while ((i < n2 && (SYSTEM_INT64)(i + n1) < dest__len)) {
+ while ((i < n2 && (i + n1) < dest__len)) {
dest[__X(i + n1, dest__len)] = extra[__X(i, extra__len)];
i += 1;
}
- if ((SYSTEM_INT64)(i + n1) < dest__len) {
+ if ((i + n1) < dest__len) {
dest[__X(i + n1, dest__len)] = 0x00;
}
__DEL(extra);
}
-void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len)
+void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len)
{
- INTEGER n1, n2, i;
+ INT16 n1, n2, i;
__DUP(source, source__len, CHAR);
n1 = Strings_Length(dest, dest__len);
n2 = Strings_Length(source, source__len);
@@ -58,12 +67,13 @@ void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest,
}
if (pos > n1) {
Strings_Append(dest, dest__len, (void*)source, source__len);
+ __DEL(source);
return;
}
- if ((SYSTEM_INT64)(pos + n2) < dest__len) {
+ if ((pos + n2) < dest__len) {
i = n1;
while (i >= pos) {
- if ((SYSTEM_INT64)(i + n2) < dest__len) {
+ if ((i + n2) < dest__len) {
dest[__X(i + n2, dest__len)] = dest[__X(i, dest__len)];
}
i -= 1;
@@ -77,9 +87,9 @@ void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest,
__DEL(source);
}
-void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n)
+void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n)
{
- INTEGER len, i;
+ INT16 len, i;
len = Strings_Length(s, s__len);
if (pos < 0) {
pos = 0;
@@ -92,7 +102,7 @@ void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n)
s[__X(i - n, s__len)] = s[__X(i, s__len)];
i += 1;
}
- if ((SYSTEM_INT64)(i - n) < s__len) {
+ if ((i - n) < s__len) {
s[__X(i - n, s__len)] = 0x00;
}
} else {
@@ -100,7 +110,7 @@ void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n)
}
}
-void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT 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));
@@ -108,21 +118,22 @@ void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest
__DEL(source);
}
-void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len)
+void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len)
{
- INTEGER len, destLen, i;
+ INT16 len, destLen, i;
__DUP(source, source__len, CHAR);
len = Strings_Length(source, source__len);
- destLen = (int)dest__len - 1;
+ destLen = (INT16)dest__len - 1;
if (pos < 0) {
pos = 0;
}
if (pos >= len) {
dest[0] = 0x00;
+ __DEL(source);
return;
}
i = 0;
- while (((((SYSTEM_INT64)(pos + i) <= source__len && source[__X(pos + i, source__len)] != 0x00)) && i < n)) {
+ while (((((pos + i) <= source__len && source[__X(pos + i, source__len)] != 0x00)) && i < n)) {
if (i < destLen) {
dest[__X(i, dest__len)] = source[__X(pos + i, source__len)];
}
@@ -132,19 +143,17 @@ void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n,
__DEL(source);
}
-INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos)
+INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos)
{
- INTEGER _o_result;
- INTEGER n1, n2, i, j;
+ INT16 n1, n2, i, j;
__DUP(pattern, pattern__len, CHAR);
__DUP(s, s__len, CHAR);
n1 = Strings_Length(s, s__len);
n2 = Strings_Length(pattern, pattern__len);
if (n2 == 0) {
- _o_result = 0;
__DEL(pattern);
__DEL(s);
- return _o_result;
+ return 0;
}
i = pos;
while (i <= n1 - n2) {
@@ -154,23 +163,21 @@ INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__le
j += 1;
}
if (j == n2) {
- _o_result = i;
__DEL(pattern);
__DEL(s);
- return _o_result;
+ return i;
}
}
i += 1;
}
- _o_result = -1;
__DEL(pattern);
__DEL(s);
- return _o_result;
+ return -1;
}
void Strings_Cap (CHAR *s, LONGINT s__len)
{
- INTEGER i;
+ INT16 i;
i = 0;
while (s[__X(i, s__len)] != 0x00) {
if (('a' <= s[__X(i, s__len)] && s[__X(i, s__len)] <= 'z')) {
@@ -184,54 +191,49 @@ static struct Match__7 {
struct Match__7 *lnk;
} *Match__7_s;
-static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INTEGER n, INTEGER m);
+static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INT16 n, INT16 m);
-static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INTEGER n, INTEGER m)
+static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INT16 n, INT16 m)
{
- BOOLEAN _o_result;
while ((((n >= 0 && m >= 0)) && mask[__X(m, mask__len)] != '*')) {
if (name[__X(n, name__len)] != mask[__X(m, mask__len)]) {
- _o_result = 0;
- return _o_result;
+ return 0;
}
n -= 1;
m -= 1;
}
if (m < 0) {
- _o_result = n < 0;
- return _o_result;
+ return n < 0;
}
while ((m >= 0 && mask[__X(m, mask__len)] == '*')) {
m -= 1;
}
if (m < 0) {
- _o_result = 1;
- return _o_result;
+ return 1;
}
while (n >= 0) {
if (M__8(name, name__len, mask, mask__len, n, m)) {
- _o_result = 1;
- return _o_result;
+ return 1;
}
n -= 1;
}
- _o_result = 0;
- return _o_result;
+ return 0;
}
BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len)
{
- BOOLEAN _o_result;
struct Match__7 _s;
+ BOOLEAN __retval;
__DUP(string, string__len, CHAR);
__DUP(pattern, pattern__len, CHAR);
_s.lnk = Match__7_s;
Match__7_s = &_s;
- _o_result = M__8((void*)string, string__len, (void*)pattern, pattern__len, Strings_Length(string, string__len) - 1, Strings_Length(pattern, pattern__len) - 1);
+ __retval = M__8((void*)string, string__len, (void*)pattern, pattern__len, Strings_Length(string, string__len) - 1, Strings_Length(pattern, pattern__len) - 1);
Match__7_s = _s.lnk;
__DEL(string);
__DEL(pattern);
- return _o_result;
+ ;
+ return __retval;
}
diff --git a/bootstrap/windows-88/Strings.h b/bootstrap/windows-88/Strings.h
index d64d3478..c987af8d 100644
--- a/bootstrap/windows-88/Strings.h
+++ b/bootstrap/windows-88/Strings.h
@@ -1,9 +1,8 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Strings__h
#define Strings__h
-#define LARGE
#include "SYSTEM.h"
@@ -11,14 +10,14 @@
import void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len);
import void Strings_Cap (CHAR *s, LONGINT s__len);
-import void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n);
-import void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len);
-import void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len);
-import INTEGER Strings_Length (CHAR *s, LONGINT s__len);
+import 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 INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos);
-import void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len);
+import 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);
-#endif
+#endif // Strings
diff --git a/bootstrap/windows-88/Texts.c b/bootstrap/windows-88/Texts.c
index a1fb81c0..ae12961b 100644
--- a/bootstrap/windows-88/Texts.c
+++ b/bootstrap/windows-88/Texts.c
@@ -1,5 +1,10 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "Files.h"
#include "Modules.h"
@@ -14,9 +19,9 @@ typedef
typedef
struct Texts_RunDesc {
Texts_Run prev, next;
- LONGINT len;
+ INT32 len;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
BOOLEAN ascii;
} Texts_RunDesc;
@@ -29,7 +34,7 @@ typedef
} Texts_ElemMsg;
typedef
- void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, LONGINT *);
+ void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, ADDRESS *);
typedef
struct Texts_TextDesc *Texts_Text;
@@ -37,26 +42,26 @@ typedef
typedef
struct Texts_ElemDesc {
Texts_Run prev, next;
- LONGINT len;
+ INT32 len;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
BOOLEAN ascii;
- LONGINT W, H;
+ INT32 W, H;
Texts_Handler handle;
Texts_Text base;
} Texts_ElemDesc;
struct Texts__1 { /* Texts_ElemDesc */
Texts_Run prev, next;
- LONGINT len;
+ INT32 len;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
BOOLEAN ascii;
- LONGINT W, H;
+ INT32 W, H;
Texts_Handler handle;
Texts_Text base;
Files_File file;
- LONGINT org, span;
+ INT32 org, span;
CHAR mod[32], proc[32];
};
@@ -65,7 +70,7 @@ typedef
typedef
struct Texts_BufDesc {
- LONGINT len;
+ INT32 len;
Texts_Run head;
} Texts_BufDesc;
@@ -79,8 +84,8 @@ typedef
typedef
struct Texts_FileMsg { /* Texts_ElemMsg */
- INTEGER id;
- LONGINT pos;
+ INT16 id;
+ INT32 pos;
Files_Rider r;
} Texts_FileMsg;
@@ -95,7 +100,7 @@ typedef
} Texts_IdentifyMsg;
typedef
- void (*Texts_Notifier)(Texts_Text, INTEGER, LONGINT, LONGINT);
+ void (*Texts_Notifier)(Texts_Text, INT16, INT32, INT32);
typedef
struct Texts_PieceDesc *Texts_Piece;
@@ -103,57 +108,57 @@ typedef
typedef
struct Texts_PieceDesc {
Texts_Run prev, next;
- LONGINT len;
+ INT32 len;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
BOOLEAN ascii;
Files_File file;
- LONGINT org;
+ INT32 org;
} Texts_PieceDesc;
typedef
struct Texts_Reader {
BOOLEAN eot;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
Texts_Elem elem;
Files_Rider rider;
Texts_Run run;
- LONGINT org, off;
+ INT32 org, off;
} Texts_Reader;
typedef
struct Texts_Scanner { /* Texts_Reader */
BOOLEAN eot;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
Texts_Elem elem;
Files_Rider rider;
Texts_Run run;
- LONGINT org, off;
+ INT32 org, off;
CHAR nextCh;
- INTEGER line, class;
- LONGINT i;
+ INT16 line, class;
+ INT32 i;
REAL x;
LONGREAL y;
CHAR c;
- SHORTINT len;
+ INT8 len;
CHAR s[64];
} Texts_Scanner;
typedef
struct Texts_TextDesc {
- LONGINT len;
+ INT32 len;
Texts_Notifier notify;
Texts_Run head, cache;
- LONGINT corg;
+ INT32 corg;
} Texts_TextDesc;
typedef
struct Texts_Writer {
Texts_Buffer buf;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
Files_Rider rider;
Files_File file;
} Texts_Writer;
@@ -163,84 +168,82 @@ export Texts_Elem Texts_new;
static Texts_Buffer Texts_del;
static Texts_FontsFont Texts_FontsDefault;
-export LONGINT *Texts_FontDesc__typ;
-export LONGINT *Texts_RunDesc__typ;
-export LONGINT *Texts_PieceDesc__typ;
-export LONGINT *Texts_ElemMsg__typ;
-export LONGINT *Texts_ElemDesc__typ;
-export LONGINT *Texts_FileMsg__typ;
-export LONGINT *Texts_CopyMsg__typ;
-export LONGINT *Texts_IdentifyMsg__typ;
-export LONGINT *Texts_BufDesc__typ;
-export LONGINT *Texts_TextDesc__typ;
-export LONGINT *Texts_Reader__typ;
-export LONGINT *Texts_Scanner__typ;
-export LONGINT *Texts_Writer__typ;
-export LONGINT *Texts__1__typ;
+export ADDRESS *Texts_FontDesc__typ;
+export ADDRESS *Texts_RunDesc__typ;
+export ADDRESS *Texts_PieceDesc__typ;
+export ADDRESS *Texts_ElemMsg__typ;
+export ADDRESS *Texts_ElemDesc__typ;
+export ADDRESS *Texts_FileMsg__typ;
+export ADDRESS *Texts_CopyMsg__typ;
+export ADDRESS *Texts_IdentifyMsg__typ;
+export ADDRESS *Texts_BufDesc__typ;
+export ADDRESS *Texts_TextDesc__typ;
+export ADDRESS *Texts_Reader__typ;
+export ADDRESS *Texts_Scanner__typ;
+export ADDRESS *Texts_Writer__typ;
+export ADDRESS *Texts__1__typ;
export void Texts_Append (Texts_Text T, Texts_Buffer B);
-export void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff);
+export void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff);
static Texts_Elem Texts_CloneElem (Texts_Elem e);
static Texts_Piece Texts_ClonePiece (Texts_Piece p);
export void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
export void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
export void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
-export void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end);
+export void Texts_Delete (Texts_Text T, INT32 beg, INT32 end);
export Texts_Text Texts_ElemBase (Texts_Elem E);
-export LONGINT Texts_ElemPos (Texts_Elem E);
-static void Texts_Find (Texts_Text T, LONGINT *pos, Texts_Run *u, LONGINT *org, LONGINT *off);
+export INT32 Texts_ElemPos (Texts_Elem E);
+static void Texts_Find (Texts_Text T, INT32 *pos, Texts_Run *u, INT32 *org, INT32 *off);
static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len);
-static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, LONGINT *msg__typ);
-export void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B);
-export void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T);
-static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T);
+static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, ADDRESS *msg__typ);
+export void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B);
+export void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
+static void Texts_Load0 (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
static void Texts_Merge (Texts_Text T, Texts_Run u, Texts_Run *v);
export void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
export void Texts_OpenBuf (Texts_Buffer B);
-export void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos);
-export void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos);
-export void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ);
-export LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ);
-export void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch);
-export void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ);
-export void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ);
+export void Texts_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);
+export void Texts_OpenWriter (Texts_Writer *W, ADDRESS *W__typ);
+export INT32 Texts_Pos (Texts_Reader *R, ADDRESS *R__typ);
+export void Texts_Read (Texts_Reader *R, ADDRESS *R__typ, CHAR *ch);
+export void Texts_ReadElem (Texts_Reader *R, ADDRESS *R__typ);
+export void Texts_ReadPrevElem (Texts_Reader *R, ADDRESS *R__typ);
export void Texts_Recall (Texts_Buffer *B);
-export void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B);
-export void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ);
-export void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col);
-export void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt);
-export void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff);
+export void Texts_Save (Texts_Text T, INT32 beg, INT32 end, Texts_Buffer B);
+export void Texts_Scan (Texts_Scanner *S, ADDRESS *S__typ);
+export void Texts_SetColor (Texts_Writer *W, ADDRESS *W__typ, INT8 col);
+export void Texts_SetFont (Texts_Writer *W, ADDRESS *W__typ, Texts_FontsFont fnt);
+export void Texts_SetOffset (Texts_Writer *W, ADDRESS *W__typ, INT8 voff);
static void Texts_Splice (Texts_Run un, Texts_Run v, Texts_Run w, Texts_Text base);
-static void Texts_Split (LONGINT off, Texts_Run *u, Texts_Run *un);
-export void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T);
-export void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch);
-export void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d);
-export void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e);
-export void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x);
-export void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n);
-export void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ);
-export void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n);
-export void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x);
-export void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n);
-export void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k);
-export void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x);
-export void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len);
+static void Texts_Split (INT32 off, Texts_Run *u, Texts_Run *un);
+export void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
+export void Texts_Write (Texts_Writer *W, ADDRESS *W__typ, CHAR ch);
+export void Texts_WriteDate (Texts_Writer *W, ADDRESS *W__typ, INT32 t, INT32 d);
+export void Texts_WriteElem (Texts_Writer *W, ADDRESS *W__typ, Texts_Elem e);
+export void Texts_WriteHex (Texts_Writer *W, ADDRESS *W__typ, INT32 x);
+export void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n);
+export void Texts_WriteLn (Texts_Writer *W, ADDRESS *W__typ);
+export void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n);
+export void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x);
+export void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n);
+export void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k);
+export void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x);
+export void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len)
{
- Texts_FontsFont _o_result;
Texts_FontsFont F = NIL;
__NEW(F, Texts_FontDesc);
- __COPY(name, F->name, ((LONGINT)(32)));
- _o_result = F;
- return _o_result;
+ __COPY(name, F->name, 32);
+ return F;
}
-static void Texts_Find (Texts_Text T, LONGINT *pos, Texts_Run *u, LONGINT *org, LONGINT *off)
+static void Texts_Find (Texts_Text T, INT32 *pos, Texts_Run *u, INT32 *org, INT32 *off)
{
Texts_Run v = NIL;
- LONGINT m;
+ INT32 m;
if (*pos >= T->len) {
*pos = T->len;
*u = T->head;
@@ -270,7 +273,7 @@ static void Texts_Find (Texts_Text T, LONGINT *pos, Texts_Run *u, LONGINT *org,
}
}
-static void Texts_Split (LONGINT off, Texts_Run *u, Texts_Run *un)
+static void Texts_Split (INT32 off, Texts_Run *u, Texts_Run *un)
{
Texts_Piece p = NIL, U = NIL;
if (off == 0) {
@@ -333,22 +336,18 @@ static void Texts_Splice (Texts_Run un, Texts_Run v, Texts_Run w, Texts_Text bas
static Texts_Piece Texts_ClonePiece (Texts_Piece p)
{
- Texts_Piece _o_result;
Texts_Piece q = NIL;
__NEW(q, Texts_PieceDesc);
__GUARDEQP(q, Texts_PieceDesc) = *p;
- _o_result = q;
- return _o_result;
+ return q;
}
static Texts_Elem Texts_CloneElem (Texts_Elem e)
{
- Texts_Elem _o_result;
Texts_CopyMsg msg;
msg.e = NIL;
(*e->handle)(e, (void*)&msg, Texts_CopyMsg__typ);
- _o_result = msg.e;
- return _o_result;
+ return msg.e;
}
void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE)
@@ -364,31 +363,27 @@ void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE)
Texts_Text Texts_ElemBase (Texts_Elem E)
{
- Texts_Text _o_result;
- _o_result = E->base;
- return _o_result;
+ return E->base;
}
-LONGINT Texts_ElemPos (Texts_Elem E)
+INT32 Texts_ElemPos (Texts_Elem E)
{
- LONGINT _o_result;
Texts_Run u = NIL;
- LONGINT pos;
+ INT32 pos;
u = E->base->head->next;
pos = 0;
while (u != (void *) E) {
pos = pos + u->len;
u = u->next;
}
- _o_result = pos;
- return _o_result;
+ return pos;
}
-static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, LONGINT *msg__typ)
+static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, ADDRESS *msg__typ)
{
Texts_Alien e = NIL;
Files_Rider r;
- LONGINT i;
+ INT32 i;
CHAR ch;
if (__ISP(E, Texts__1, 2)) {
if (__IS(msg__typ, Texts_CopyMsg, 1)) {
@@ -399,15 +394,15 @@ static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, LONGINT *msg__t
e->file = ((Texts_Alien)E)->file;
e->org = ((Texts_Alien)E)->org;
e->span = ((Texts_Alien)E)->span;
- __COPY(((Texts_Alien)E)->mod, e->mod, ((LONGINT)(32)));
- __COPY(((Texts_Alien)E)->proc, e->proc, ((LONGINT)(32)));
+ __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, ((LONGINT)(32)));
- __COPY(((Texts_Alien)E)->proc, (*msg__).proc, ((LONGINT)(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)) {
@@ -464,10 +459,10 @@ void Texts_Recall (Texts_Buffer *B)
Texts_del = NIL;
}
-void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B)
+void Texts_Save (Texts_Text T, INT32 beg, INT32 end, Texts_Buffer B)
{
Texts_Run u = NIL, v = NIL, w = NIL, wn = NIL;
- LONGINT uo, ud, vo, vd;
+ INT32 uo, ud, vo, vd;
Texts_Find(T, &beg, &u, &uo, &ud);
Texts_Find(T, &end, &v, &vo, &vd);
w = B->head->prev;
@@ -498,11 +493,11 @@ void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B)
B->len += end - beg;
}
-void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B)
+void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B)
{
Texts_Run u = NIL, un = NIL, v = NIL;
Texts_Piece p = NIL, q = NIL;
- LONGINT uo, ud, len;
+ INT32 uo, ud, len;
Texts_Find(T, &pos, &u, &uo, &ud);
Texts_Split(ud, &u, &un);
len = B->len;
@@ -521,7 +516,7 @@ void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B)
void Texts_Append (Texts_Text T, Texts_Buffer B)
{
Texts_Run v = NIL;
- LONGINT pos, len;
+ INT32 pos, len;
pos = T->len;
len = B->len;
v = B->head->next;
@@ -536,10 +531,10 @@ void Texts_Append (Texts_Text T, Texts_Buffer B)
}
}
-void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end)
+void Texts_Delete (Texts_Text T, INT32 beg, INT32 end)
{
Texts_Run c = NIL, u = NIL, un = NIL, v = NIL, vn = NIL;
- LONGINT co, uo, ud, vo, vd;
+ INT32 co, uo, ud, vo, vd;
Texts_Find(T, &beg, &u, &uo, &ud);
Texts_Split(ud, &u, &un);
c = T->cache;
@@ -561,10 +556,10 @@ void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end)
}
}
-void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff)
+void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff)
{
Texts_Run c = NIL, u = NIL, un = NIL, v = NIL, vn = NIL;
- LONGINT co, uo, ud, vo, vd;
+ INT32 co, uo, ud, vo, vd;
Texts_Find(T, &beg, &u, &uo, &ud);
Texts_Split(ud, &u, &un);
c = T->cache;
@@ -574,13 +569,13 @@ void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_F
T->cache = c;
T->corg = co;
while (un != vn) {
- if ((__IN(0, sel) && fnt != NIL)) {
+ if ((__IN(0, sel, 32) && fnt != NIL)) {
un->fnt = fnt;
}
- if (__IN(1, sel)) {
+ if (__IN(1, sel, 32)) {
un->col = col;
}
- if (__IN(2, sel)) {
+ if (__IN(2, sel, 32)) {
un->voff = voff;
}
Texts_Merge(T, u, &un);
@@ -600,7 +595,7 @@ void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_F
}
}
-void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos)
+void Texts_OpenReader (Texts_Reader *R, ADDRESS *R__typ, Texts_Text T, INT32 pos)
{
Texts_Run u = NIL;
if (pos >= T->len) {
@@ -614,10 +609,10 @@ void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT p
}
}
-void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch)
+void Texts_Read (Texts_Reader *R, ADDRESS *R__typ, CHAR *ch)
{
Texts_Run u = NIL;
- LONGINT pos;
+ INT32 pos;
CHAR nextch;
u = (*R).run;
(*R).fnt = u->fnt;
@@ -659,7 +654,7 @@ void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch)
}
}
-void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ)
+void Texts_ReadElem (Texts_Reader *R, ADDRESS *R__typ)
{
Texts_Run u = NIL, un = NIL;
u = (*R).run;
@@ -687,7 +682,7 @@ void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ)
}
}
-void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ)
+void Texts_ReadPrevElem (Texts_Reader *R, ADDRESS *R__typ)
{
Texts_Run u = NIL;
u = (*R).run->prev;
@@ -709,14 +704,12 @@ void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ)
}
}
-LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ)
+INT32 Texts_Pos (Texts_Reader *R, ADDRESS *R__typ)
{
- LONGINT _o_result;
- _o_result = (*R).org + (*R).off;
- return _o_result;
+ return (*R).org + (*R).off;
}
-void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos)
+void Texts_OpenScanner (Texts_Scanner *S, ADDRESS *S__typ, Texts_Text T, INT32 pos)
{
Texts_OpenReader((void*)&*S, S__typ, T, pos);
(*S).line = 0;
@@ -725,10 +718,10 @@ void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT
static struct Scan__31 {
Texts_Scanner *S;
- LONGINT *S__typ;
+ ADDRESS *S__typ;
CHAR *ch;
BOOLEAN *negE;
- INTEGER *e;
+ INT16 *e;
struct Scan__31 *lnk;
} *Scan__31_s;
@@ -747,18 +740,18 @@ static void ReadScaleFactor__32 (void)
}
}
while (('0' <= *Scan__31_s->ch && *Scan__31_s->ch <= '9')) {
- *Scan__31_s->e = (*Scan__31_s->e * 10 + (int)*Scan__31_s->ch) - 48;
+ *Scan__31_s->e = (*Scan__31_s->e * 10 + (INT16)*Scan__31_s->ch) - 48;
Texts_Read((void*)&*Scan__31_s->S, Scan__31_s->S__typ, &*Scan__31_s->ch);
}
}
-void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
+void Texts_Scan (Texts_Scanner *S, ADDRESS *S__typ)
{
CHAR ch, term;
BOOLEAN neg, negE, hex;
- SHORTINT i, j, h;
- INTEGER e;
- LONGINT k;
+ INT8 i, j, h;
+ INT16 e;
+ INT32 k;
REAL x, f;
LONGREAL y, g;
CHAR d[32];
@@ -781,21 +774,21 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
}
if ((('A' <= __CAP(ch) && __CAP(ch) <= 'Z') || ch == '/') || ch == '.') {
do {
- (*S).s[__X(i, ((LONGINT)(64)))] = ch;
+ (*S).s[__X(i, 64)] = ch;
i += 1;
Texts_Read((void*)&*S, S__typ, &ch);
} while (!((((__CAP(ch) > 'Z' && ch != '_') || ('A' > __CAP(ch) && ch > '9')) || ((('0' > ch && ch != '.')) && ch != '/')) || i == 63));
- (*S).s[__X(i, ((LONGINT)(64)))] = 0x00;
+ (*S).s[__X(i, 64)] = 0x00;
(*S).len = i;
(*S).class = 1;
} else if (ch == '"') {
Texts_Read((void*)&*S, S__typ, &ch);
while ((((ch != '"' && ch >= ' ')) && i != 63)) {
- (*S).s[__X(i, ((LONGINT)(64)))] = ch;
+ (*S).s[__X(i, 64)] = ch;
i += 1;
Texts_Read((void*)&*S, S__typ, &ch);
}
- (*S).s[__X(i, ((LONGINT)(64)))] = 0x00;
+ (*S).s[__X(i, 64)] = 0x00;
(*S).len = i + 1;
Texts_Read((void*)&*S, S__typ, &ch);
(*S).class = 2;
@@ -810,7 +803,7 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
hex = 0;
j = 0;
for (;;) {
- d[__X(i, ((LONGINT)(32)))] = ch;
+ d[__X(i, 32)] = ch;
i += 1;
Texts_Read((void*)&*S, S__typ, &ch);
if (ch < '0') {
@@ -819,10 +812,10 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
if ('9' < ch) {
if (('A' <= ch && ch <= 'F')) {
hex = 1;
- ch = (CHAR)((int)ch - 7);
+ ch = (CHAR)((INT16)ch - 7);
} else if (('a' <= ch && ch <= 'f')) {
hex = 1;
- ch = (CHAR)((int)ch - 39);
+ ch = (CHAR)((INT16)ch - 39);
} else {
break;
}
@@ -834,13 +827,13 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
if (i - j > 8) {
j = i - 8;
}
- k = (int)d[__X(j, ((LONGINT)(32)))] - 48;
+ k = (INT16)d[__X(j, 32)] - 48;
j += 1;
if ((i - j == 7 && k >= 8)) {
k -= 16;
}
while (j < i) {
- k = __ASHL(k, 4) + (SYSTEM_INT64)((int)d[__X(j, ((LONGINT)(32)))] - 48);
+ k = __ASHL(k, 4) + ((INT16)d[__X(j, 32)] - 48);
j += 1;
}
if (neg) {
@@ -852,7 +845,7 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
Texts_Read((void*)&*S, S__typ, &ch);
h = i;
while (('0' <= ch && ch <= '9')) {
- d[__X(i, ((LONGINT)(32)))] = ch;
+ d[__X(i, 32)] = ch;
i += 1;
Texts_Read((void*)&*S, S__typ, &ch);
}
@@ -861,12 +854,12 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
y = (LONGREAL)0;
g = (LONGREAL)1;
do {
- y = y * (LONGREAL)10 + ((int)d[__X(j, ((LONGINT)(32)))] - 48);
+ y = y * (LONGREAL)10 + ((INT16)d[__X(j, 32)] - 48);
j += 1;
} while (!(j == h));
while (j < i) {
g = g / (LONGREAL)(LONGREAL)10;
- y = ((int)d[__X(j, ((LONGINT)(32)))] - 48) * g + y;
+ y = ((INT16)d[__X(j, 32)] - 48) * g + y;
j += 1;
}
ReadScaleFactor__32();
@@ -893,12 +886,12 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
x = (REAL)0;
f = (REAL)1;
do {
- x = x * (REAL)10 + ((int)d[__X(j, ((LONGINT)(32)))] - 48);
+ x = x * (REAL)10 + ((INT16)d[__X(j, 32)] - 48);
j += 1;
} while (!(j == h));
while (j < i) {
f = f / (REAL)(REAL)10;
- x = ((int)d[__X(j, ((LONGINT)(32)))] - 48) * f + x;
+ x = ((INT16)d[__X(j, 32)] - 48) * f + x;
j += 1;
}
if (ch == 'E') {
@@ -930,7 +923,7 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
(*S).class = 3;
k = 0;
do {
- k = k * 10 + (SYSTEM_INT64)((int)d[__X(j, ((LONGINT)(32)))] - 48);
+ k = k * 10 + ((INT16)d[__X(j, 32)] - 48);
j += 1;
} while (!(j == i));
if (neg) {
@@ -958,33 +951,33 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
Scan__31_s = _s.lnk;
}
-void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ)
+void Texts_OpenWriter (Texts_Writer *W, ADDRESS *W__typ)
{
__NEW((*W).buf, Texts_BufDesc);
Texts_OpenBuf((*W).buf);
(*W).fnt = Texts_FontsDefault;
(*W).col = 15;
(*W).voff = 0;
- (*W).file = Files_New((CHAR*)"", (LONGINT)1);
- Files_Set(&(*W).rider, Files_Rider__typ, (*W).file, ((LONGINT)(0)));
+ (*W).file = Files_New((CHAR*)"", 1);
+ Files_Set(&(*W).rider, Files_Rider__typ, (*W).file, 0);
}
-void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt)
+void Texts_SetFont (Texts_Writer *W, ADDRESS *W__typ, Texts_FontsFont fnt)
{
(*W).fnt = fnt;
}
-void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col)
+void Texts_SetColor (Texts_Writer *W, ADDRESS *W__typ, INT8 col)
{
(*W).col = col;
}
-void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff)
+void Texts_SetOffset (Texts_Writer *W, ADDRESS *W__typ, INT8 voff)
{
(*W).voff = voff;
}
-void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch)
+void Texts_Write (Texts_Writer *W, ADDRESS *W__typ, CHAR ch)
{
Texts_Run u = NIL, un = NIL;
Texts_Piece p = NIL;
@@ -1010,7 +1003,7 @@ void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch)
}
}
-void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e)
+void Texts_WriteElem (Texts_Writer *W, ADDRESS *W__typ, Texts_Elem e)
{
Texts_Run u = NIL, un = NIL;
if (e->base != NIL) {
@@ -1029,14 +1022,14 @@ void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e)
un->prev = (Texts_Run)e;
}
-void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ)
+void Texts_WriteLn (Texts_Writer *W, ADDRESS *W__typ)
{
Texts_Write(&*W, W__typ, 0x0d);
}
-void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len)
+void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len)
{
- INTEGER i;
+ INT16 i;
__DUP(s, s__len, CHAR);
i = 0;
while (s[__X(i, s__len)] >= ' ') {
@@ -1046,15 +1039,15 @@ void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__le
__DEL(s);
}
-void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n)
+void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n)
{
- INTEGER i;
- LONGINT x0;
- CHAR a[22];
+ INT16 i;
+ INT64 x0;
+ CHAR a[24];
i = 0;
if (x < 0) {
if (x == (-9223372036854775807-1)) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" -9223372036854775808", (LONGINT)22);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" -9223372036854775808", 22);
return;
} else {
n -= 1;
@@ -1064,11 +1057,11 @@ void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n)
x0 = x;
}
do {
- a[__X(i, ((LONGINT)(22)))] = (CHAR)(__MOD(x0, 10) + 48);
+ a[__X(i, 24)] = (CHAR)(__MOD(x0, 10) + 48);
x0 = __DIV(x0, 10);
i += 1;
} while (!(x0 == 0));
- while (n > (SYSTEM_INT64)i) {
+ while (n > (INT64)i) {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
}
@@ -1077,47 +1070,47 @@ void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n)
}
do {
i -= 1;
- Texts_Write(&*W, W__typ, a[__X(i, ((LONGINT)(22)))]);
+ Texts_Write(&*W, W__typ, a[__X(i, 24)]);
} while (!(i == 0));
}
-void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x)
+void Texts_WriteHex (Texts_Writer *W, ADDRESS *W__typ, INT32 x)
{
- INTEGER i;
- LONGINT y;
+ INT16 i;
+ INT32 y;
CHAR a[20];
i = 0;
Texts_Write(&*W, W__typ, ' ');
do {
y = __MASK(x, -16);
if (y < 10) {
- a[__X(i, ((LONGINT)(20)))] = (CHAR)(y + 48);
+ a[__X(i, 20)] = (CHAR)(y + 48);
} else {
- a[__X(i, ((LONGINT)(20)))] = (CHAR)(y + 55);
+ a[__X(i, 20)] = (CHAR)(y + 55);
}
x = __ASHR(x, 4);
i += 1;
} while (!(i == 8));
do {
i -= 1;
- Texts_Write(&*W, W__typ, a[__X(i, ((LONGINT)(20)))]);
+ Texts_Write(&*W, W__typ, a[__X(i, 20)]);
} while (!(i == 0));
}
-void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n)
+void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n)
{
- INTEGER e;
+ INT16 e;
REAL x0;
CHAR d[9];
e = Reals_Expo(x);
if (e == 0) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" 0", (LONGINT)4);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" 0", 4);
do {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
} while (!(n <= 3));
} else if (e == 255) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", 5);
while (n > 4) {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
@@ -1154,13 +1147,13 @@ void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n)
x = x * 1.0000000e-001;
e += 1;
}
- Reals_Convert(x, n, (void*)d, ((LONGINT)(9)));
+ Reals_Convert(x, n, (void*)d, 9);
n -= 1;
- Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(9)))]);
+ Texts_Write(&*W, W__typ, d[__X(n, 9)]);
Texts_Write(&*W, W__typ, '.');
do {
n -= 1;
- Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(9)))]);
+ Texts_Write(&*W, W__typ, d[__X(n, 9)]);
} while (!(n == 0));
Texts_Write(&*W, W__typ, 'E');
if (e < 0) {
@@ -1176,16 +1169,16 @@ void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n)
static struct WriteRealFix__53 {
Texts_Writer *W;
- LONGINT *W__typ;
- INTEGER *i;
+ ADDRESS *W__typ;
+ INT16 *i;
CHAR (*d)[9];
struct WriteRealFix__53 *lnk;
} *WriteRealFix__53_s;
-static void dig__54 (INTEGER n);
-static void seq__56 (CHAR ch, INTEGER n);
+static void dig__54 (INT16 n);
+static void seq__56 (CHAR ch, INT16 n);
-static void seq__56 (CHAR ch, INTEGER n)
+static void seq__56 (CHAR ch, INT16 n)
{
while (n > 0) {
Texts_Write(&*WriteRealFix__53_s->W, WriteRealFix__53_s->W__typ, ch);
@@ -1193,18 +1186,18 @@ static void seq__56 (CHAR ch, INTEGER n)
}
}
-static void dig__54 (INTEGER n)
+static void dig__54 (INT16 n)
{
while (n > 0) {
*WriteRealFix__53_s->i -= 1;
- Texts_Write(&*WriteRealFix__53_s->W, WriteRealFix__53_s->W__typ, (*WriteRealFix__53_s->d)[__X(*WriteRealFix__53_s->i, ((LONGINT)(9)))]);
+ Texts_Write(&*WriteRealFix__53_s->W, WriteRealFix__53_s->W__typ, (*WriteRealFix__53_s->d)[__X(*WriteRealFix__53_s->i, 9)]);
n -= 1;
}
}
-void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k)
+void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k)
{
- INTEGER e, i;
+ INT16 e, i;
CHAR sign;
REAL x0;
CHAR d[9];
@@ -1223,7 +1216,7 @@ void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, IN
Texts_Write(&*W, W__typ, '0');
seq__56(' ', k + 1);
} else if (e == 255) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", 5);
seq__56(' ', n - 4);
} else {
e = __ASHR((e - 127) * 77, 8);
@@ -1255,7 +1248,7 @@ void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, IN
}
e += 1;
i = k + e;
- Reals_Convert(x, i, (void*)d, ((LONGINT)(9)));
+ Reals_Convert(x, i, (void*)d, 9);
if (e > 0) {
seq__56(' ', ((n - e) - k) - 2);
Texts_Write(&*W, W__typ, sign);
@@ -1274,32 +1267,32 @@ void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, IN
WriteRealFix__53_s = _s.lnk;
}
-void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x)
+void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x)
{
- INTEGER i;
+ INT16 i;
CHAR d[8];
- Reals_ConvertH(x, (void*)d, ((LONGINT)(8)));
+ Reals_ConvertH(x, (void*)d, 8);
i = 0;
do {
- Texts_Write(&*W, W__typ, d[__X(i, ((LONGINT)(8)))]);
+ Texts_Write(&*W, W__typ, d[__X(i, 8)]);
i += 1;
} while (!(i == 8));
}
-void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n)
+void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n)
{
- INTEGER e;
+ INT16 e;
LONGREAL x0;
CHAR d[16];
e = Reals_ExpoL(x);
if (e == 0) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" 0", (LONGINT)4);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" 0", 4);
do {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
} while (!(n <= 3));
} else if (e == 2047) {
- Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5);
+ Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", 5);
while (n > 4) {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
@@ -1320,7 +1313,7 @@ void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER
} else {
Texts_Write(&*W, W__typ, ' ');
}
- e = (int)__ASHR((SYSTEM_INT64)(e - 1023) * 77, 8);
+ e = (INT16)__ASHR((e - 1023) * 77, 8);
if (e >= 0) {
x = x / (LONGREAL)Reals_TenL(e);
} else {
@@ -1336,13 +1329,13 @@ void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER
x = 1.00000000000000e-001 * x;
e += 1;
}
- Reals_ConvertL(x, n, (void*)d, ((LONGINT)(16)));
+ Reals_ConvertL(x, n, (void*)d, 16);
n -= 1;
- Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(16)))]);
+ Texts_Write(&*W, W__typ, d[__X(n, 16)]);
Texts_Write(&*W, W__typ, '.');
do {
n -= 1;
- Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(16)))]);
+ Texts_Write(&*W, W__typ, d[__X(n, 16)]);
} while (!(n == 0));
Texts_Write(&*W, W__typ, 'D');
if (e < 0) {
@@ -1358,34 +1351,34 @@ void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER
}
}
-void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x)
+void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x)
{
- INTEGER i;
+ INT16 i;
CHAR d[16];
- Reals_ConvertHL(x, (void*)d, ((LONGINT)(16)));
+ Reals_ConvertHL(x, (void*)d, 16);
i = 0;
do {
- Texts_Write(&*W, W__typ, d[__X(i, ((LONGINT)(16)))]);
+ Texts_Write(&*W, W__typ, d[__X(i, 16)]);
i += 1;
} while (!(i == 16));
}
static struct WriteDate__43 {
Texts_Writer *W;
- LONGINT *W__typ;
+ ADDRESS *W__typ;
struct WriteDate__43 *lnk;
} *WriteDate__43_s;
-static void WritePair__44 (CHAR ch, LONGINT x);
+static void WritePair__44 (CHAR ch, INT32 x);
-static void WritePair__44 (CHAR ch, LONGINT x)
+static void WritePair__44 (CHAR ch, INT32 x)
{
Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, ch);
Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, (CHAR)(__DIV(x, 10) + 48));
- Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, (CHAR)(__MOD(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, LONGINT *W__typ, LONGINT t, LONGINT d)
+void Texts_WriteDate (Texts_Writer *W, ADDRESS *W__typ, INT32 t, INT32 d)
{
struct WriteDate__43 _s;
_s.W = W; _s.W__typ = W__typ;
@@ -1402,35 +1395,35 @@ void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d)
static struct Load0__16 {
Texts_Text *T;
- SHORTINT *ecnt;
+ INT8 *ecnt;
Files_File *f;
Texts_FileMsg *msg;
CHAR (*mods)[64][32], (*procs)[64][32];
struct Load0__16 *lnk;
} *Load0__16_s;
-static void LoadElem__17 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, LONGINT span, Texts_Elem *e);
+static void LoadElem__17 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, INT32 span, Texts_Elem *e);
-static void LoadElem__17 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, LONGINT span, Texts_Elem *e)
+static void LoadElem__17 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, INT32 span, Texts_Elem *e)
{
Modules_Module M = NIL;
Modules_Command Cmd;
Texts_Alien a = NIL;
- LONGINT org, ew, eh;
- SHORTINT eno;
+ INT32 org, ew, eh;
+ INT8 eno;
Texts_new = NIL;
Files_ReadLInt(&*r, r__typ, &ew);
Files_ReadLInt(&*r, r__typ, &eh);
Files_Read(&*r, r__typ, (void*)&eno);
if (eno > *Load0__16_s->ecnt) {
*Load0__16_s->ecnt = eno;
- Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32)));
- Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32)));
+ Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->mods)[__X(eno, 64)], 32);
+ Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->procs)[__X(eno, 64)], 32);
}
org = Files_Pos(&*r, r__typ);
- M = Modules_ThisMod((*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32)));
+ M = Modules_ThisMod((*Load0__16_s->mods)[__X(eno, 64)], 32);
if (M != NIL) {
- Cmd = Modules_ThisCommand(M, (*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32)));
+ Cmd = Modules_ThisCommand(M, (*Load0__16_s->procs)[__X(eno, 64)], 32);
if (Cmd != NIL) {
(*Cmd)();
}
@@ -1456,19 +1449,19 @@ static void LoadElem__17 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, LONGINT
a->file = *Load0__16_s->f;
a->org = org;
a->span = span;
- __COPY((*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], a->mod, ((LONGINT)(32)));
- __COPY((*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], a->proc, ((LONGINT)(32)));
+ __COPY((*Load0__16_s->mods)[__X(eno, 64)], a->mod, 32);
+ __COPY((*Load0__16_s->procs)[__X(eno, 64)], a->proc, 32);
*e = (Texts_Elem)a;
}
}
-static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
+static void Texts_Load0 (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
{
Texts_Run u = NIL, un = NIL;
Texts_Piece p = NIL;
Texts_Elem e = NIL;
- LONGINT org, pos, hlen, plen;
- SHORTINT ecnt, fno, fcnt, col, voff;
+ INT32 org, pos, hlen, plen;
+ INT8 ecnt, fcnt, fno, col, voff;
Files_File f = NIL;
Texts_FileMsg msg;
CHAR mods[64][32], procs[64][32];
@@ -1486,7 +1479,7 @@ static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
pos = Files_Pos(&*r, r__typ);
f = Files_Base(&*r, r__typ);
__NEW(u, Texts_RunDesc);
- u->len = 9223372036854775807;
+ u->len = 2147483647;
u->fnt = NIL;
u->col = 15;
T->head = u;
@@ -1501,8 +1494,8 @@ static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
while (fno != 0) {
if (fno > fcnt) {
fcnt = fno;
- Files_ReadString(&msg.r, Files_Rider__typ, (void*)name, ((LONGINT)(32)));
- fnts[__X(fno, ((LONGINT)(32)))] = Texts_FontsThis((void*)name, ((LONGINT)(32)));
+ Files_ReadString(&msg.r, Files_Rider__typ, (void*)name, 32);
+ fnts[__X(fno, 32)] = Texts_FontsThis((void*)name, 32);
}
Files_Read(&msg.r, Files_Rider__typ, (void*)&col);
Files_Read(&msg.r, Files_Rider__typ, (void*)&voff);
@@ -1536,9 +1529,9 @@ static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
Load0__16_s = _s.lnk;
}
-void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
+void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
{
- INTEGER tag;
+ INT16 tag;
Files_ReadInt(&*r, r__typ, &tag);
if (tag != -4095) {
Files_Set(&*r, r__typ, Files_Base(&*r, r__typ), Files_Pos(&*r, r__typ) - 2);
@@ -1553,25 +1546,25 @@ void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len)
Texts_Run u = NIL;
Texts_Piece p = NIL;
CHAR tag, version;
- LONGINT hlen;
+ INT32 hlen;
__DUP(name, name__len, CHAR);
f = Files_Old(name, name__len);
if (f == NIL) {
- f = Files_New((CHAR*)"", (LONGINT)1);
+ f = Files_New((CHAR*)"", 1);
}
- Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(0)));
+ Files_Set(&r, Files_Rider__typ, f, 0);
Files_Read(&r, Files_Rider__typ, (void*)&tag);
Files_Read(&r, Files_Rider__typ, (void*)&version);
if (tag == 0xf0 || (tag == 0x01 && version == 0xf0)) {
Texts_Load0(&r, Files_Rider__typ, T);
} else {
__NEW(u, Texts_RunDesc);
- u->len = 9223372036854775807;
+ u->len = 2147483647;
u->fnt = NIL;
u->col = 15;
__NEW(p, Texts_PieceDesc);
if ((tag == 0xf7 && version == 0x07)) {
- Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(28)));
+ Files_Set(&r, Files_Rider__typ, f, 28);
Files_ReadLInt(&r, Files_Rider__typ, &hlen);
Files_Set(&r, Files_Rider__typ, f, 22 + hlen);
Files_ReadLInt(&r, Files_Rider__typ, &T->len);
@@ -1603,35 +1596,35 @@ void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len)
}
static struct Store__39 {
- SHORTINT *ecnt;
+ INT8 *ecnt;
Texts_FileMsg *msg;
Texts_IdentifyMsg *iden;
CHAR (*mods)[64][32], (*procs)[64][32];
struct Store__39 *lnk;
} *Store__39_s;
-static void StoreElem__40 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, Texts_Elem e);
+static void StoreElem__40 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, Texts_Elem e);
-static void StoreElem__40 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, Texts_Elem e)
+static void StoreElem__40 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, Texts_Elem e)
{
Files_Rider r1;
- LONGINT org, span;
- SHORTINT eno;
- __COPY((*Store__39_s->iden).mod, (*Store__39_s->mods)[__X(*Store__39_s->ecnt, ((LONGINT)(64)))], ((LONGINT)(32)));
- __COPY((*Store__39_s->iden).proc, (*Store__39_s->procs)[__X(*Store__39_s->ecnt, ((LONGINT)(64)))], ((LONGINT)(32)));
+ INT32 org, span;
+ INT8 eno;
+ __COPY((*Store__39_s->iden).mod, (*Store__39_s->mods)[__X(*Store__39_s->ecnt, 64)], 32);
+ __COPY((*Store__39_s->iden).proc, (*Store__39_s->procs)[__X(*Store__39_s->ecnt, 64)], 32);
eno = 1;
- while (__STRCMP((*Store__39_s->mods)[__X(eno, ((LONGINT)(64)))], (*Store__39_s->iden).mod) != 0 || __STRCMP((*Store__39_s->procs)[__X(eno, ((LONGINT)(64)))], (*Store__39_s->iden).proc) != 0) {
+ while (__STRCMP((*Store__39_s->mods)[__X(eno, 64)], (*Store__39_s->iden).mod) != 0 || __STRCMP((*Store__39_s->procs)[__X(eno, 64)], (*Store__39_s->iden).proc) != 0) {
eno += 1;
}
Files_Set(&r1, Files_Rider__typ, Files_Base(&*r, r__typ), Files_Pos(&*r, r__typ));
- Files_WriteLInt(&*r, r__typ, ((LONGINT)(0)));
- Files_WriteLInt(&*r, r__typ, ((LONGINT)(0)));
- Files_WriteLInt(&*r, r__typ, ((LONGINT)(0)));
+ Files_WriteLInt(&*r, r__typ, 0);
+ Files_WriteLInt(&*r, r__typ, 0);
+ Files_WriteLInt(&*r, r__typ, 0);
Files_Write(&*r, r__typ, eno);
if (eno == *Store__39_s->ecnt) {
*Store__39_s->ecnt += 1;
- Files_WriteString(&*r, r__typ, (*Store__39_s->iden).mod, ((LONGINT)(32)));
- Files_WriteString(&*r, r__typ, (*Store__39_s->iden).proc, ((LONGINT)(32)));
+ Files_WriteString(&*r, r__typ, (*Store__39_s->iden).mod, 32);
+ Files_WriteString(&*r, r__typ, (*Store__39_s->iden).proc, 32);
}
(*Store__39_s->msg).pos = pos;
org = Files_Pos(&*r, r__typ);
@@ -1642,14 +1635,15 @@ static void StoreElem__40 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, Texts_E
Files_WriteLInt(&r1, Files_Rider__typ, e->H);
}
-void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
+void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
{
Files_Rider r1;
Texts_Run u = NIL, un = NIL;
Texts_Elem e = NIL;
- LONGINT org, pos, delta, hlen, rlen;
- SHORTINT ecnt, fno, fcnt;
+ INT32 org, pos, delta, hlen, rlen;
+ INT8 ecnt, fcnt;
CHAR ch;
+ INT8 fno;
Texts_FileMsg msg;
Texts_IdentifyMsg iden;
CHAR mods[64][32], procs[64][32];
@@ -1666,7 +1660,7 @@ void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
org = Files_Pos(&*r, r__typ);
msg.id = 1;
msg.r = *r;
- Files_WriteLInt(&msg.r, Files_Rider__typ, ((LONGINT)(0)));
+ Files_WriteLInt(&msg.r, Files_Rider__typ, 0);
u = T->head->next;
pos = 0;
delta = 0;
@@ -1680,15 +1674,15 @@ void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
iden.mod[0] = 0x01;
}
if (iden.mod[0] != 0x00) {
- fnts[__X(fcnt, ((LONGINT)(32)))] = u->fnt;
+ fnts[__X(fcnt, 32)] = u->fnt;
fno = 1;
- while (__STRCMP(fnts[__X(fno, ((LONGINT)(32)))]->name, u->fnt->name) != 0) {
+ while (__STRCMP(fnts[__X(fno, 32)]->name, u->fnt->name) != 0) {
fno += 1;
}
Files_Write(&msg.r, Files_Rider__typ, fno);
if (fno == fcnt) {
fcnt += 1;
- Files_WriteString(&msg.r, Files_Rider__typ, u->fnt->name, ((LONGINT)(32)));
+ Files_WriteString(&msg.r, Files_Rider__typ, u->fnt->name, 32);
}
Files_Write(&msg.r, Files_Rider__typ, u->col);
Files_Write(&msg.r, Files_Rider__typ, u->voff);
@@ -1737,12 +1731,12 @@ void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
delta = ((Texts_Piece)u)->len;
while (delta > 1024) {
- Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), ((LONGINT)(1024)));
- Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), ((LONGINT)(1024)));
+ Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, 1024, 1024);
+ Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, 1024, 1024);
delta -= 1024;
}
- Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), delta);
- Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), delta);
+ Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, 1024, delta);
+ Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, 1024, delta);
}
} else __WITHCHK;
} else {
@@ -1756,7 +1750,7 @@ void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T)
}
__GUARDEQR(r, r__typ, Files_Rider) = msg.r;
if (T->notify != NIL) {
- (*T->notify)(T, 3, ((LONGINT)(0)), ((LONGINT)(0)));
+ (*T->notify)(T, 3, 0, 0);
}
Store__39_s = _s.lnk;
}
@@ -1765,11 +1759,11 @@ void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len)
{
Files_File f = NIL;
Files_Rider r;
- INTEGER i, res;
+ INT16 i, res;
CHAR bak[64];
__DUP(name, name__len, CHAR);
f = Files_New(name, name__len);
- Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(0)));
+ Files_Set(&r, Files_Rider__typ, f, 0);
Files_Write(&r, Files_Rider__typ, 0xf0);
Files_Write(&r, Files_Rider__typ, 0x01);
Texts_Store(&r, Files_Rider__typ, T);
@@ -1777,13 +1771,13 @@ void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len)
while (name[__X(i, name__len)] != 0x00) {
i += 1;
}
- __COPY(name, bak, ((LONGINT)(64)));
- bak[__X(i, ((LONGINT)(64)))] = '.';
- bak[__X(i + 1, ((LONGINT)(64)))] = 'B';
- bak[__X(i + 2, ((LONGINT)(64)))] = 'a';
- bak[__X(i + 3, ((LONGINT)(64)))] = 'k';
- bak[__X(i + 4, ((LONGINT)(64)))] = 0x00;
- Files_Rename(name, name__len, bak, ((LONGINT)(64)), &res);
+ __COPY(name, bak, 64);
+ bak[__X(i, 64)] = '.';
+ bak[__X(i + 1, 64)] = 'B';
+ bak[__X(i + 2, 64)] = 'a';
+ bak[__X(i + 3, 64)] = 'k';
+ bak[__X(i + 4, 64)] = 0x00;
+ Files_Rename(name, name__len, bak, 64, &res);
Files_Register(f);
__DEL(name);
}
@@ -1799,16 +1793,16 @@ __TDESC(Texts_FontDesc, 1, 0) = {__TDFLDS("FontDesc", 32), {-8}};
__TDESC(Texts_RunDesc, 1, 3) = {__TDFLDS("RunDesc", 40), {0, 8, 24, -32}};
__TDESC(Texts_PieceDesc, 1, 4) = {__TDFLDS("PieceDesc", 56), {0, 8, 24, 40, -40}};
__TDESC(Texts_ElemMsg, 1, 0) = {__TDFLDS("ElemMsg", 1), {-8}};
-__TDESC(Texts_ElemDesc, 1, 4) = {__TDFLDS("ElemDesc", 72), {0, 8, 24, 64, -40}};
-__TDESC(Texts_FileMsg, 1, 1) = {__TDFLDS("FileMsg", 56), {32, -16}};
+__TDESC(Texts_ElemDesc, 1, 4) = {__TDFLDS("ElemDesc", 64), {0, 8, 24, 56, -40}};
+__TDESC(Texts_FileMsg, 1, 1) = {__TDFLDS("FileMsg", 32), {16, -16}};
__TDESC(Texts_CopyMsg, 1, 1) = {__TDFLDS("CopyMsg", 8), {0, -16}};
__TDESC(Texts_IdentifyMsg, 1, 0) = {__TDFLDS("IdentifyMsg", 64), {-8}};
__TDESC(Texts_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 16), {8, -16}};
__TDESC(Texts_TextDesc, 1, 2) = {__TDFLDS("TextDesc", 40), {16, 24, -24}};
-__TDESC(Texts_Reader, 1, 4) = {__TDFLDS("Reader", 96), {8, 24, 48, 72, -40}};
-__TDESC(Texts_Scanner, 1, 4) = {__TDFLDS("Scanner", 208), {8, 24, 48, 72, -40}};
-__TDESC(Texts_Writer, 1, 4) = {__TDFLDS("Writer", 72), {0, 8, 40, 64, -40}};
-__TDESC(Texts__1, 1, 5) = {__TDFLDS("", 160), {0, 8, 24, 64, 72, -48}};
+__TDESC(Texts_Reader, 1, 4) = {__TDFLDS("Reader", 72), {8, 24, 40, 56, -40}};
+__TDESC(Texts_Scanner, 1, 4) = {__TDFLDS("Scanner", 168), {8, 24, 40, 56, -40}};
+__TDESC(Texts_Writer, 1, 4) = {__TDFLDS("Writer", 56), {0, 8, 32, 48, -40}};
+__TDESC(Texts__1, 1, 5) = {__TDFLDS("", 144), {0, 8, 24, 56, 64, -48}};
export void *Texts__init(void)
{
diff --git a/bootstrap/windows-88/Texts.h b/bootstrap/windows-88/Texts.h
index bca5665d..61a97dda 100644
--- a/bootstrap/windows-88/Texts.h
+++ b/bootstrap/windows-88/Texts.h
@@ -1,16 +1,15 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Texts__h
#define Texts__h
-#define LARGE
#include "SYSTEM.h"
#include "Files.h"
typedef
struct Texts_BufDesc {
- LONGINT len;
- char _prvt0[8];
+ INT32 len;
+ INT64 _prvt0;
} Texts_BufDesc;
typedef
@@ -31,25 +30,26 @@ typedef
typedef
struct Texts_RunDesc {
- LONGINT _prvt0;
+ INT64 _prvt0;
char _prvt1[27];
} Texts_RunDesc;
typedef
- void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, LONGINT *);
+ void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, ADDRESS *);
typedef
struct Texts_ElemDesc {
- char _prvt0[40];
- LONGINT W, H;
+ INT64 _prvt0;
+ char _prvt1[28];
+ INT32 W, H;
Texts_Handler handle;
- char _prvt1[8];
+ char _prvt2[8];
} Texts_ElemDesc;
typedef
struct Texts_FileMsg { /* Texts_ElemMsg */
- INTEGER id;
- LONGINT pos;
+ INT16 id;
+ INT32 pos;
Files_Rider r;
} Texts_FileMsg;
@@ -70,104 +70,104 @@ typedef
struct Texts_TextDesc *Texts_Text;
typedef
- void (*Texts_Notifier)(Texts_Text, INTEGER, LONGINT, LONGINT);
+ void (*Texts_Notifier)(Texts_Text, INT16, INT32, INT32);
typedef
struct Texts_Reader {
BOOLEAN eot;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
Texts_Elem elem;
- char _prvt0[64];
+ char _prvt0[40];
} Texts_Reader;
typedef
struct Texts_Scanner { /* Texts_Reader */
BOOLEAN eot;
Texts_FontsFont fnt;
- SHORTINT col, voff;
+ INT8 col, voff;
Texts_Elem elem;
- char _prvt0[64];
+ char _prvt0[40];
CHAR nextCh;
- INTEGER line, class;
- LONGINT i;
+ INT16 line, class;
+ INT32 i;
REAL x;
LONGREAL y;
CHAR c;
- SHORTINT len;
+ INT8 len;
CHAR s[64];
} Texts_Scanner;
typedef
struct Texts_TextDesc {
- LONGINT len;
+ INT32 len;
Texts_Notifier notify;
- char _prvt0[24];
+ char _prvt0[20];
} Texts_TextDesc;
typedef
struct Texts_Writer {
Texts_Buffer buf;
Texts_FontsFont fnt;
- SHORTINT col, voff;
- char _prvt0[54];
+ INT8 col, voff;
+ char _prvt0[38];
} Texts_Writer;
import Texts_Elem Texts_new;
-import LONGINT *Texts_FontDesc__typ;
-import LONGINT *Texts_RunDesc__typ;
-import LONGINT *Texts_ElemMsg__typ;
-import LONGINT *Texts_ElemDesc__typ;
-import LONGINT *Texts_FileMsg__typ;
-import LONGINT *Texts_CopyMsg__typ;
-import LONGINT *Texts_IdentifyMsg__typ;
-import LONGINT *Texts_BufDesc__typ;
-import LONGINT *Texts_TextDesc__typ;
-import LONGINT *Texts_Reader__typ;
-import LONGINT *Texts_Scanner__typ;
-import LONGINT *Texts_Writer__typ;
+import ADDRESS *Texts_FontDesc__typ;
+import ADDRESS *Texts_RunDesc__typ;
+import ADDRESS *Texts_ElemMsg__typ;
+import ADDRESS *Texts_ElemDesc__typ;
+import ADDRESS *Texts_FileMsg__typ;
+import ADDRESS *Texts_CopyMsg__typ;
+import ADDRESS *Texts_IdentifyMsg__typ;
+import ADDRESS *Texts_BufDesc__typ;
+import ADDRESS *Texts_TextDesc__typ;
+import ADDRESS *Texts_Reader__typ;
+import ADDRESS *Texts_Scanner__typ;
+import ADDRESS *Texts_Writer__typ;
import void Texts_Append (Texts_Text T, Texts_Buffer B);
-import void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff);
+import void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff);
import void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
import void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
import void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
-import void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end);
+import void Texts_Delete (Texts_Text T, INT32 beg, INT32 end);
import Texts_Text Texts_ElemBase (Texts_Elem E);
-import LONGINT Texts_ElemPos (Texts_Elem E);
-import void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B);
-import void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T);
+import INT32 Texts_ElemPos (Texts_Elem E);
+import void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B);
+import void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
import void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
import void Texts_OpenBuf (Texts_Buffer B);
-import void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos);
-import void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos);
-import void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ);
-import LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ);
-import void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch);
-import void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ);
-import void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ);
+import void Texts_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);
+import void Texts_OpenWriter (Texts_Writer *W, ADDRESS *W__typ);
+import INT32 Texts_Pos (Texts_Reader *R, ADDRESS *R__typ);
+import void Texts_Read (Texts_Reader *R, ADDRESS *R__typ, CHAR *ch);
+import void Texts_ReadElem (Texts_Reader *R, ADDRESS *R__typ);
+import void Texts_ReadPrevElem (Texts_Reader *R, ADDRESS *R__typ);
import void Texts_Recall (Texts_Buffer *B);
-import void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B);
-import void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ);
-import void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col);
-import void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt);
-import void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff);
-import void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T);
-import void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch);
-import void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d);
-import void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e);
-import void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x);
-import void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n);
-import void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ);
-import void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n);
-import void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x);
-import void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n);
-import void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k);
-import void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x);
-import void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len);
+import void Texts_Save (Texts_Text T, INT32 beg, INT32 end, Texts_Buffer B);
+import void Texts_Scan (Texts_Scanner *S, ADDRESS *S__typ);
+import void Texts_SetColor (Texts_Writer *W, ADDRESS *W__typ, INT8 col);
+import void Texts_SetFont (Texts_Writer *W, ADDRESS *W__typ, Texts_FontsFont fnt);
+import void Texts_SetOffset (Texts_Writer *W, ADDRESS *W__typ, INT8 voff);
+import void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
+import void Texts_Write (Texts_Writer *W, ADDRESS *W__typ, CHAR ch);
+import void Texts_WriteDate (Texts_Writer *W, ADDRESS *W__typ, INT32 t, INT32 d);
+import void Texts_WriteElem (Texts_Writer *W, ADDRESS *W__typ, Texts_Elem e);
+import void Texts_WriteHex (Texts_Writer *W, ADDRESS *W__typ, INT32 x);
+import void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n);
+import void Texts_WriteLn (Texts_Writer *W, ADDRESS *W__typ);
+import void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n);
+import void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x);
+import void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n);
+import void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k);
+import void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x);
+import void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
import void *Texts__init(void);
-#endif
+#endif // Texts
diff --git a/bootstrap/windows-88/VT100.c b/bootstrap/windows-88/VT100.c
new file mode 100644
index 00000000..f69fd90e
--- /dev/null
+++ b/bootstrap/windows-88/VT100.c
@@ -0,0 +1,264 @@
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
+#include "SYSTEM.h"
+#include "Out.h"
+#include "Strings.h"
+
+
+export CHAR VT100_CSI[5];
+static CHAR VT100_tmpstr[32];
+
+
+export void VT100_CHA (INT16 n);
+export void VT100_CNL (INT16 n);
+export void VT100_CPL (INT16 n);
+export void VT100_CUB (INT16 n);
+export void VT100_CUD (INT16 n);
+export void VT100_CUF (INT16 n);
+export void VT100_CUP (INT16 n, INT16 m);
+export void VT100_CUU (INT16 n);
+export void VT100_DECTCEMh (void);
+export void VT100_DECTCEMl (void);
+export void VT100_DSR (INT16 n);
+export void VT100_ED (INT16 n);
+export void VT100_EL (INT16 n);
+static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len);
+static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len);
+static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len);
+static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len);
+export void VT100_HVP (INT16 n, INT16 m);
+export void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len);
+export void VT100_RCP (void);
+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, LONGINT attr__len);
+
+
+static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end)
+{
+ CHAR h;
+ while (start < end) {
+ h = str[__X(start, str__len)];
+ str[__X(start, str__len)] = str[__X(end, str__len)];
+ str[__X(end, str__len)] = h;
+ start += 1;
+ end -= 1;
+ }
+}
+
+void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len)
+{
+ CHAR b[21];
+ INT16 s, e;
+ INT8 maxLength;
+ maxLength = 11;
+ if (int_ == (-2147483647-1)) {
+ __MOVE("-2147483648", b, 12);
+ e = 11;
+ } else {
+ if (int_ < 0) {
+ b[0] = '-';
+ int_ = -int_;
+ s = 1;
+ } else {
+ s = 0;
+ }
+ e = s;
+ do {
+ b[__X(e, 21)] = (CHAR)((int)__MOD(int_, 10) + 48);
+ int_ = __DIV(int_, 10);
+ e += 1;
+ } while (!(int_ == 0));
+ b[__X(e, 21)] = 0x00;
+ VT100_Reverse0((void*)b, 21, s, e - 1);
+ }
+ __COPY(b, str, str__len);
+}
+
+static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len)
+{
+ CHAR cmd[9];
+ __DUP(letter, letter__len, CHAR);
+ __COPY(VT100_CSI, cmd, 9);
+ Strings_Append(letter, letter__len, (void*)cmd, 9);
+ Out_String(cmd, 9);
+ __DEL(letter);
+}
+
+static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len)
+{
+ CHAR nstr[2];
+ CHAR cmd[7];
+ __DUP(letter, letter__len, CHAR);
+ VT100_IntToStr(n, (void*)nstr, 2);
+ __COPY(VT100_CSI, cmd, 7);
+ Strings_Append(nstr, 2, (void*)cmd, 7);
+ Strings_Append(letter, letter__len, (void*)cmd, 7);
+ Out_String(cmd, 7);
+ __DEL(letter);
+}
+
+static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len)
+{
+ CHAR nstr[2];
+ CHAR cmd[7];
+ __DUP(letter, letter__len, CHAR);
+ VT100_IntToStr(n, (void*)nstr, 2);
+ __COPY(VT100_CSI, cmd, 7);
+ Strings_Append(letter, letter__len, (void*)cmd, 7);
+ Strings_Append(nstr, 2, (void*)cmd, 7);
+ Out_String(cmd, 7);
+ __DEL(letter);
+}
+
+static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len)
+{
+ CHAR nstr[5], mstr[5];
+ CHAR cmd[12];
+ __DUP(letter, letter__len, CHAR);
+ VT100_IntToStr(n, (void*)nstr, 5);
+ VT100_IntToStr(m, (void*)mstr, 5);
+ __COPY(VT100_CSI, cmd, 12);
+ Strings_Append(nstr, 5, (void*)cmd, 12);
+ Strings_Append((CHAR*)";", 2, (void*)cmd, 12);
+ Strings_Append(mstr, 5, (void*)cmd, 12);
+ Strings_Append(letter, letter__len, (void*)cmd, 12);
+ Out_String(cmd, 12);
+ __DEL(letter);
+}
+
+void VT100_CUU (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"A", 2);
+}
+
+void VT100_CUD (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"B", 2);
+}
+
+void VT100_CUF (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"C", 2);
+}
+
+void VT100_CUB (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"D", 2);
+}
+
+void VT100_CNL (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"E", 2);
+}
+
+void VT100_CPL (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"F", 2);
+}
+
+void VT100_CHA (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"G", 2);
+}
+
+void VT100_CUP (INT16 n, INT16 m)
+{
+ VT100_EscSeq2(n, m, (CHAR*)"H", 2);
+}
+
+void VT100_ED (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"J", 2);
+}
+
+void VT100_EL (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"K", 2);
+}
+
+void VT100_SU (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"S", 2);
+}
+
+void VT100_SD (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"T", 2);
+}
+
+void VT100_HVP (INT16 n, INT16 m)
+{
+ VT100_EscSeq2(n, m, (CHAR*)"f", 2);
+}
+
+void VT100_SGR (INT16 n)
+{
+ VT100_EscSeq(n, (CHAR*)"m", 2);
+}
+
+void VT100_SGR2 (INT16 n, INT16 m)
+{
+ VT100_EscSeq2(n, m, (CHAR*)"m", 2);
+}
+
+void VT100_DSR (INT16 n)
+{
+ VT100_EscSeq(6, (CHAR*)"n", 2);
+}
+
+void VT100_SCP (void)
+{
+ VT100_EscSeq0((CHAR*)"s", 2);
+}
+
+void VT100_RCP (void)
+{
+ VT100_EscSeq0((CHAR*)"u", 2);
+}
+
+void VT100_DECTCEMl (void)
+{
+ VT100_EscSeq0((CHAR*)"\?25l", 5);
+}
+
+void VT100_DECTCEMh (void)
+{
+ VT100_EscSeq0((CHAR*)"\?25h", 5);
+}
+
+void VT100_SetAttr (CHAR *attr, LONGINT attr__len)
+{
+ CHAR tmpstr[16];
+ __DUP(attr, attr__len, CHAR);
+ __COPY(VT100_CSI, tmpstr, 16);
+ Strings_Append(attr, attr__len, (void*)tmpstr, 16);
+ Out_String(tmpstr, 16);
+ __DEL(attr);
+}
+
+
+export void *VT100__init(void)
+{
+ __DEFMOD;
+ __MODULE_IMPORT(Out);
+ __MODULE_IMPORT(Strings);
+ __REGMOD("VT100", 0);
+ __REGCMD("DECTCEMh", VT100_DECTCEMh);
+ __REGCMD("DECTCEMl", VT100_DECTCEMl);
+ __REGCMD("RCP", VT100_RCP);
+ __REGCMD("SCP", VT100_SCP);
+/* BEGIN */
+ __COPY("\033", VT100_CSI, 5);
+ Strings_Append((CHAR*)"[", 2, (void*)VT100_CSI, 5);
+ __ENDMOD;
+}
diff --git a/bootstrap/windows-88/VT100.h b/bootstrap/windows-88/VT100.h
new file mode 100644
index 00000000..d99406ec
--- /dev/null
+++ b/bootstrap/windows-88/VT100.h
@@ -0,0 +1,37 @@
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#ifndef VT100__h
+#define VT100__h
+
+#include "SYSTEM.h"
+
+
+import CHAR VT100_CSI[5];
+
+
+import void VT100_CHA (INT16 n);
+import void VT100_CNL (INT16 n);
+import void VT100_CPL (INT16 n);
+import void VT100_CUB (INT16 n);
+import void VT100_CUD (INT16 n);
+import void VT100_CUF (INT16 n);
+import void VT100_CUP (INT16 n, INT16 m);
+import void VT100_CUU (INT16 n);
+import void VT100_DECTCEMh (void);
+import void VT100_DECTCEMl (void);
+import void VT100_DSR (INT16 n);
+import void VT100_ED (INT16 n);
+import void VT100_EL (INT16 n);
+import void VT100_HVP (INT16 n, INT16 m);
+import void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len);
+import void VT100_RCP (void);
+import void VT100_SCP (void);
+import void VT100_SD (INT16 n);
+import void VT100_SGR (INT16 n);
+import void VT100_SGR2 (INT16 n, INT16 m);
+import void VT100_SU (INT16 n);
+import void VT100_SetAttr (CHAR *attr, LONGINT attr__len);
+import void *VT100__init(void);
+
+
+#endif // VT100
diff --git a/bootstrap/windows-88/Vishap.c b/bootstrap/windows-88/Vishap.c
deleted file mode 100644
index 6eda4f2c..00000000
--- a/bootstrap/windows-88/Vishap.c
+++ /dev/null
@@ -1,169 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkamSf */
-#define LARGE
-#include "SYSTEM.h"
-#include "Configuration.h"
-#include "Heap.h"
-#include "OPB.h"
-#include "OPC.h"
-#include "OPM.h"
-#include "OPP.h"
-#include "OPT.h"
-#include "OPV.h"
-#include "Platform.h"
-#include "Strings.h"
-#include "extTools.h"
-#include "vt100.h"
-
-
-static CHAR Vishap_mname[256];
-
-
-export void Vishap_Module (BOOLEAN *done);
-static void Vishap_PropagateElementaryTypeSizes (void);
-export void Vishap_Translate (void);
-static void Vishap_Trap (INTEGER sig);
-
-
-void Vishap_Module (BOOLEAN *done)
-{
- BOOLEAN ext, new;
- OPT_Node p = NIL;
- OPP_Module(&p, OPM_opt);
- if (OPM_noerr) {
- OPV_Init();
- OPV_AdrAndSize(OPT_topScope);
- OPT_Export(&ext, &new);
- if (OPM_noerr) {
- OPM_OpenFiles((void*)OPT_SelfName, ((LONGINT)(256)));
- OPC_Init();
- OPV_Module(p);
- if (OPM_noerr) {
- if (((OPM_mainProg || OPM_mainLinkStat) && __STRCMP(OPM_modName, "SYSTEM") != 0)) {
- OPM_DeleteNewSym();
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"32m", (LONGINT)4);
- }
- OPM_LogWStr((CHAR*)" Main program.", (LONGINT)16);
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"0m", (LONGINT)3);
- }
- } else {
- if (new) {
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"32m", (LONGINT)4);
- }
- OPM_LogWStr((CHAR*)" New symbol file.", (LONGINT)19);
- if (!OPM_notColorOutput) {
- vt100_SetAttr((CHAR*)"0m", (LONGINT)3);
- }
- OPM_RegisterNewSym();
- } else if (ext) {
- OPM_LogWStr((CHAR*)" Extended symbol file.", (LONGINT)24);
- OPM_RegisterNewSym();
- }
- }
- } else {
- OPM_DeleteNewSym();
- }
- }
- }
- OPM_CloseFiles();
- OPT_Close();
- OPM_LogWLn();
- *done = OPM_noerr;
-}
-
-static void Vishap_PropagateElementaryTypeSizes (void)
-{
- OPT_bytetyp->size = OPM_ByteSize;
- OPT_sysptrtyp->size = OPM_PointerSize;
- OPT_chartyp->size = OPM_CharSize;
- OPT_settyp->size = OPM_SetSize;
- OPT_realtyp->size = OPM_RealSize;
- OPT_inttyp->size = OPM_IntSize;
- OPT_linttyp->size = OPM_LIntSize;
- OPT_lrltyp->size = OPM_LRealSize;
- OPT_sinttyp->size = OPM_SIntSize;
- OPT_booltyp->size = OPM_BoolSize;
-}
-
-void Vishap_Translate (void)
-{
- BOOLEAN done;
- CHAR modulesobj[2048];
- modulesobj[0] = 0x00;
- if (OPM_OpenPar()) {
- for (;;) {
- OPM_Init(&done, (void*)Vishap_mname, ((LONGINT)(256)));
- if (!done) {
- return;
- }
- OPM_InitOptions();
- Vishap_PropagateElementaryTypeSizes();
- Heap_GC(0);
- Vishap_Module(&done);
- if (!done) {
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Module compilation failed.", (LONGINT)27);
- OPM_LogWLn();
- Platform_Exit(1);
- }
- if (!OPM_dontAsm) {
- if (OPM_dontLink) {
- extTools_Assemble(OPM_modName, ((LONGINT)(32)));
- } else {
- if (!(OPM_mainProg || OPM_mainLinkStat)) {
- extTools_Assemble(OPM_modName, ((LONGINT)(32)));
- Strings_Append((CHAR*)" ", (LONGINT)2, (void*)modulesobj, ((LONGINT)(2048)));
- Strings_Append(OPM_modName, ((LONGINT)(32)), (void*)modulesobj, ((LONGINT)(2048)));
- Strings_Append((CHAR*)".o", (LONGINT)3, (void*)modulesobj, ((LONGINT)(2048)));
- } else {
- extTools_LinkMain((void*)OPM_modName, ((LONGINT)(32)), OPM_mainLinkStat, modulesobj, ((LONGINT)(2048)));
- }
- }
- }
- }
- }
-}
-
-static void Vishap_Trap (INTEGER sig)
-{
- Heap_FINALL();
- if (sig == 3) {
- Platform_Exit(0);
- } else {
- if ((sig == 4 && Platform_HaltCode == -15)) {
- OPM_LogWStr((CHAR*)" --- Vishap Oberon: internal error", (LONGINT)35);
- OPM_LogWLn();
- }
- Platform_Exit(2);
- }
-}
-
-
-export int main(int argc, char **argv)
-{
- __INIT(argc, argv);
- __MODULE_IMPORT(Configuration);
- __MODULE_IMPORT(Heap);
- __MODULE_IMPORT(OPB);
- __MODULE_IMPORT(OPC);
- __MODULE_IMPORT(OPM);
- __MODULE_IMPORT(OPP);
- __MODULE_IMPORT(OPT);
- __MODULE_IMPORT(OPV);
- __MODULE_IMPORT(Platform);
- __MODULE_IMPORT(Strings);
- __MODULE_IMPORT(extTools);
- __MODULE_IMPORT(vt100);
- __REGMAIN("Vishap", 0);
- __REGCMD("Translate", Vishap_Translate);
-/* BEGIN */
- Platform_SetInterruptHandler(Vishap_Trap);
- Platform_SetQuitHandler(Vishap_Trap);
- Platform_SetBadInstructionHandler(Vishap_Trap);
- OPB_typSize = OPV_TypSize;
- OPT_typSize = OPV_TypSize;
- Vishap_Translate();
- __FINI;
-}
diff --git a/bootstrap/windows-88/WindowsWrapper.h b/bootstrap/windows-88/WindowsWrapper.h
deleted file mode 100644
index b72c815a..00000000
--- a/bootstrap/windows-88/WindowsWrapper.h
+++ /dev/null
@@ -1,10 +0,0 @@
-// WindowsWrapper.h
-//
-// Includes Windows.h while avoiding conflicts with Oberon types.
-
-
-#define BOOLEAN _BOOLEAN
-#define CHAR _CHAR
-#include
-#undef BOOLEAN
-#undef CHAR
diff --git a/bootstrap/windows-88/errors.c b/bootstrap/windows-88/errors.c
deleted file mode 100644
index 48246ffa..00000000
--- a/bootstrap/windows-88/errors.c
+++ /dev/null
@@ -1,200 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
-#include "SYSTEM.h"
-
-typedef
- CHAR errors_string[128];
-
-
-export errors_string errors_errors[350];
-
-
-
-
-
-export void *errors__init(void)
-{
- __DEFMOD;
- __REGMOD("errors", 0);
-/* BEGIN */
- __MOVE("undeclared identifier", errors_errors[0], 22);
- __MOVE("multiply defined identifier", errors_errors[1], 28);
- __MOVE("illegal character in number", errors_errors[2], 28);
- __MOVE("illegal character in string", errors_errors[3], 28);
- __MOVE("identifier does not match procedure name", errors_errors[4], 41);
- __MOVE("comment not closed", errors_errors[5], 19);
- errors_errors[6][0] = 0x00;
- errors_errors[7][0] = 0x00;
- errors_errors[8][0] = 0x00;
- __MOVE("'=' expected", errors_errors[9], 13);
- errors_errors[10][0] = 0x00;
- errors_errors[11][0] = 0x00;
- __MOVE("type definition starts with incorrect symbol", errors_errors[12], 45);
- __MOVE("factor starts with incorrect symbol", errors_errors[13], 36);
- __MOVE("statement starts with incorrect symbol", errors_errors[14], 39);
- __MOVE("declaration followed by incorrect symbol", errors_errors[15], 41);
- __MOVE("MODULE expected", errors_errors[16], 16);
- errors_errors[17][0] = 0x00;
- __MOVE("'.' missing", errors_errors[18], 12);
- __MOVE("',' missing", errors_errors[19], 12);
- __MOVE("':' missing", errors_errors[20], 12);
- errors_errors[21][0] = 0x00;
- __MOVE("')' missing", errors_errors[22], 12);
- __MOVE("']' missing", errors_errors[23], 12);
- __MOVE("'}' missing", errors_errors[24], 12);
- __MOVE("OF missing", errors_errors[25], 11);
- __MOVE("THEN missing", errors_errors[26], 13);
- __MOVE("DO missing", errors_errors[27], 11);
- __MOVE("TO missing", errors_errors[28], 11);
- errors_errors[29][0] = 0x00;
- __MOVE("'(' missing", errors_errors[30], 12);
- errors_errors[31][0] = 0x00;
- errors_errors[32][0] = 0x00;
- errors_errors[33][0] = 0x00;
- __MOVE("':=' missing", errors_errors[34], 13);
- __MOVE("',' or OF expected", errors_errors[35], 19);
- errors_errors[36][0] = 0x00;
- errors_errors[37][0] = 0x00;
- __MOVE("identifier expected", errors_errors[38], 20);
- __MOVE("';' missing", errors_errors[39], 12);
- errors_errors[40][0] = 0x00;
- __MOVE("END missing", errors_errors[41], 12);
- errors_errors[42][0] = 0x00;
- errors_errors[43][0] = 0x00;
- __MOVE("UNTIL missing", errors_errors[44], 14);
- errors_errors[45][0] = 0x00;
- __MOVE("EXIT not within loop statement", errors_errors[46], 31);
- __MOVE("illegally marked identifier", errors_errors[47], 28);
- errors_errors[48][0] = 0x00;
- errors_errors[49][0] = 0x00;
- __MOVE("expression should be constant", errors_errors[50], 30);
- __MOVE("constant not an integer", errors_errors[51], 24);
- __MOVE("identifier does not denote a type", errors_errors[52], 34);
- __MOVE("identifier does not denote a record type", errors_errors[53], 41);
- __MOVE("result type of procedure is not a basic type", errors_errors[54], 45);
- __MOVE("procedure call of a function", errors_errors[55], 29);
- __MOVE("assignment to non-variable", errors_errors[56], 27);
- __MOVE("pointer not bound to record or array type", errors_errors[57], 42);
- __MOVE("recursive type definition", errors_errors[58], 26);
- __MOVE("illegal open array parameter", errors_errors[59], 29);
- __MOVE("wrong type of case label", errors_errors[60], 25);
- __MOVE("inadmissible type of case label", errors_errors[61], 32);
- __MOVE("case label defined more than once", errors_errors[62], 34);
- __MOVE("illegal value of constant", errors_errors[63], 26);
- __MOVE("more actual than formal parameters", errors_errors[64], 35);
- __MOVE("fewer actual than formal parameters", errors_errors[65], 36);
- __MOVE("element types of actual array and formal open array differ", errors_errors[66], 59);
- __MOVE("actual parameter corresponding to open array is not an array", errors_errors[67], 61);
- __MOVE("control variable must be integer", errors_errors[68], 33);
- __MOVE("parameter must be an integer constant", errors_errors[69], 38);
- __MOVE("pointer or VAR record required as formal receiver", errors_errors[70], 50);
- __MOVE("pointer expected as actual receiver", errors_errors[71], 36);
- __MOVE("procedure must be bound to a record of the same scope", errors_errors[72], 54);
- __MOVE("procedure must have level 0", errors_errors[73], 28);
- __MOVE("procedure unknown in base type", errors_errors[74], 31);
- __MOVE("invalid call of base procedure", errors_errors[75], 31);
- __MOVE("this variable (field) is read only", errors_errors[76], 35);
- __MOVE("object is not a record", errors_errors[77], 23);
- __MOVE("dereferenced object is not a variable", errors_errors[78], 38);
- __MOVE("indexed object is not a variable", errors_errors[79], 33);
- __MOVE("index expression is not an integer", errors_errors[80], 35);
- __MOVE("index out of specified bounds", errors_errors[81], 30);
- __MOVE("indexed variable is not an array", errors_errors[82], 33);
- __MOVE("undefined record field", errors_errors[83], 23);
- __MOVE("dereferenced variable is not a pointer", errors_errors[84], 39);
- __MOVE("guard or test type is not an extension of variable type", errors_errors[85], 56);
- __MOVE("guard or testtype is not a pointer", errors_errors[86], 35);
- __MOVE("guarded or tested variable is neither a pointer nor a VAR-parameter record", errors_errors[87], 75);
- __MOVE("open array not allowed as variable, record field or array element", errors_errors[88], 66);
- errors_errors[89][0] = 0x00;
- errors_errors[90][0] = 0x00;
- errors_errors[91][0] = 0x00;
- __MOVE("operand of IN not an integer, or not a set", errors_errors[92], 43);
- __MOVE("set element type is not an integer", errors_errors[93], 35);
- __MOVE("operand of & is not of type BOOLEAN", errors_errors[94], 36);
- __MOVE("operand of OR is not of type BOOLEAN", errors_errors[95], 37);
- __MOVE("operand not applicable to (unary) +", errors_errors[96], 36);
- __MOVE("operand not applicable to (unary) -", errors_errors[97], 36);
- __MOVE("operand of ~ is not of type BOOLEAN", errors_errors[98], 36);
- __MOVE("ASSERT fault", errors_errors[99], 13);
- __MOVE("incompatible operands of dyadic operator", errors_errors[100], 41);
- __MOVE("operand type inapplicable to *", errors_errors[101], 31);
- __MOVE("operand type inapplicable to /", errors_errors[102], 31);
- __MOVE("operand type inapplicable to DIV", errors_errors[103], 33);
- __MOVE("operand type inapplicable to MOD", errors_errors[104], 33);
- __MOVE("operand type inapplicable to +", errors_errors[105], 31);
- __MOVE("operand type inapplicable to -", errors_errors[106], 31);
- __MOVE("operand type inapplicable to = or #", errors_errors[107], 36);
- __MOVE("operand type inapplicable to relation", errors_errors[108], 38);
- __MOVE("overriding method must be exported", errors_errors[109], 35);
- __MOVE("operand is not a type", errors_errors[110], 22);
- __MOVE("operand inapplicable to (this) function", errors_errors[111], 40);
- __MOVE("operand is not a variable", errors_errors[112], 26);
- __MOVE("incompatible assignment", errors_errors[113], 24);
- __MOVE("string too long to be assigned", errors_errors[114], 31);
- __MOVE("parameter doesn't match", errors_errors[115], 24);
- __MOVE("number of parameters doesn't match", errors_errors[116], 35);
- __MOVE("result type doesn't match", errors_errors[117], 26);
- __MOVE("export mark doesn't match with forward declaration", errors_errors[118], 51);
- __MOVE("redefinition textually precedes procedure bound to base type", errors_errors[119], 61);
- __MOVE("type of expression following IF, WHILE, UNTIL or ASSERT is not BOOLEAN", errors_errors[120], 71);
- __MOVE("called object is not a procedure (or is an interrupt procedure)", errors_errors[121], 64);
- __MOVE("actual VAR-parameter is not a variable", errors_errors[122], 39);
- __MOVE("type of actual parameter is not identical with that of formal VAR-parameter", errors_errors[123], 76);
- __MOVE("type of result expression differs from that of procedure", errors_errors[124], 57);
- __MOVE("type of case expression is neither INTEGER nor CHAR", errors_errors[125], 52);
- __MOVE("this expression cannot be a type or a procedure", errors_errors[126], 48);
- __MOVE("illegal use of object", errors_errors[127], 22);
- __MOVE("unsatisfied forward reference", errors_errors[128], 30);
- __MOVE("unsatisfied forward procedure", errors_errors[129], 30);
- __MOVE("WITH clause does not specify a variable", errors_errors[130], 40);
- __MOVE("LEN not applied to array", errors_errors[131], 25);
- __MOVE("dimension in LEN too large or negative", errors_errors[132], 39);
- __MOVE("SYSTEM not imported", errors_errors[135], 20);
- __MOVE("key inconsistency of imported module", errors_errors[150], 37);
- __MOVE("incorrect symbol file", errors_errors[151], 22);
- __MOVE("symbol file of imported module not found", errors_errors[152], 41);
- __MOVE("object or symbol file not opened (disk full\?)", errors_errors[153], 46);
- __MOVE("recursive import not allowed", errors_errors[154], 29);
- __MOVE("generation of new symbol file not allowed", errors_errors[155], 42);
- __MOVE("parameter file not found", errors_errors[156], 25);
- __MOVE("syntax error in parameter file", errors_errors[157], 31);
- __MOVE("not yet implemented", errors_errors[200], 20);
- __MOVE("lower bound of set range greater than higher bound", errors_errors[201], 51);
- __MOVE("set element greater than MAX(SET) or less than 0", errors_errors[202], 49);
- __MOVE("number too large", errors_errors[203], 17);
- __MOVE("product too large", errors_errors[204], 18);
- __MOVE("division by zero", errors_errors[205], 17);
- __MOVE("sum too large", errors_errors[206], 14);
- __MOVE("difference too large", errors_errors[207], 21);
- __MOVE("overflow in arithmetic shift", errors_errors[208], 29);
- __MOVE("case range too large", errors_errors[209], 21);
- __MOVE("too many cases in case statement", errors_errors[213], 33);
- __MOVE("illegal value of parameter (0 <= p < 256)", errors_errors[218], 42);
- __MOVE("machine registers cannot be accessed", errors_errors[219], 37);
- __MOVE("illegal value of parameter", errors_errors[220], 27);
- __MOVE("too many pointers in a record", errors_errors[221], 30);
- __MOVE("too many global pointers", errors_errors[222], 25);
- __MOVE("too many record types", errors_errors[223], 22);
- __MOVE("too many pointer types", errors_errors[224], 23);
- __MOVE("address of pointer variable too large (move forward in text)", errors_errors[225], 61);
- __MOVE("too many exported procedures", errors_errors[226], 29);
- __MOVE("too many imported modules", errors_errors[227], 26);
- __MOVE("too many exported structures", errors_errors[228], 29);
- __MOVE("too many nested records for import", errors_errors[229], 35);
- __MOVE("too many constants (strings) in module", errors_errors[230], 39);
- __MOVE("too many link table entries (external procedures)", errors_errors[231], 50);
- __MOVE("too many commands in module", errors_errors[232], 28);
- __MOVE("record extension hierarchy too high", errors_errors[233], 36);
- __MOVE("export of recursive type not allowed", errors_errors[234], 37);
- __MOVE("identifier too long", errors_errors[240], 20);
- __MOVE("string too long", errors_errors[241], 16);
- __MOVE("address overflow", errors_errors[242], 17);
- __MOVE("cyclic type definition not allowed", errors_errors[244], 35);
- __MOVE("guarded pointer variable may be manipulated by non-local operations; use auxiliary pointer variable", errors_errors[245], 100);
- __MOVE("implicit type cast", errors_errors[301], 19);
- __MOVE("inappropriate symbol file ignored", errors_errors[306], 34);
- __MOVE("no ELSE symbol after CASE statement sequence may lead to trap", errors_errors[307], 62);
- __MOVE("SYSTEM.VAL result includes memory past end of source variable", errors_errors[308], 62);
- __ENDMOD;
-}
diff --git a/bootstrap/windows-88/errors.h b/bootstrap/windows-88/errors.h
deleted file mode 100644
index 9081238a..00000000
--- a/bootstrap/windows-88/errors.h
+++ /dev/null
@@ -1,19 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-
-#ifndef errors__h
-#define errors__h
-
-#define LARGE
-#include "SYSTEM.h"
-
-typedef
- CHAR errors_string[128];
-
-
-import errors_string errors_errors[350];
-
-
-import void *errors__init(void);
-
-
-#endif
diff --git a/bootstrap/windows-88/extTools.c b/bootstrap/windows-88/extTools.c
index 4005b0a6..37630d23 100644
--- a/bootstrap/windows-88/extTools.c
+++ b/bootstrap/windows-88/extTools.c
@@ -1,30 +1,37 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
+
+#define SHORTINT INT8
+#define INTEGER INT16
+#define LONGINT INT32
+#define SET UINT32
+
#include "SYSTEM.h"
#include "Configuration.h"
-#include "Console.h"
+#include "Modules.h"
#include "OPM.h"
+#include "Out.h"
#include "Platform.h"
#include "Strings.h"
-static CHAR extTools_compilationOptions[1023], extTools_CFLAGS[1023];
+static CHAR extTools_CFLAGS[1023];
export void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len);
+static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT s__len);
export void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len);
static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len);
static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len)
{
- INTEGER r, status, exitcode;
+ INT16 r, status, exitcode;
__DUP(title, title__len, CHAR);
__DUP(cmd, cmd__len, CHAR);
- if (OPM_Verbose) {
- Console_String(title, title__len);
- Console_String(cmd, cmd__len);
- Console_Ln();
+ if (__IN(18, OPM_Options, 32)) {
+ Out_String(title, title__len);
+ Out_String(cmd, cmd__len);
+ Out_Ln();
}
r = Platform_System(cmd, cmd__len);
status = __MASK(r, -128);
@@ -33,39 +40,49 @@ static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGIN
exitcode = exitcode - 256;
}
if (r != 0) {
- Console_String(title, title__len);
- Console_String(cmd, cmd__len);
- Console_Ln();
- Console_String((CHAR*)"-- failed: status ", (LONGINT)19);
- Console_Int(status, ((LONGINT)(1)));
- Console_String((CHAR*)", exitcode ", (LONGINT)12);
- Console_Int(exitcode, ((LONGINT)(1)));
- Console_String((CHAR*)".", (LONGINT)2);
- Console_Ln();
+ Out_String(title, title__len);
+ Out_String(cmd, cmd__len);
+ Out_Ln();
+ Out_String((CHAR*)"-- failed: status ", 19);
+ Out_Int(status, 1);
+ Out_String((CHAR*)", exitcode ", 12);
+ Out_Int(exitcode, 1);
+ Out_String((CHAR*)".", 2);
+ Out_Ln();
if ((status == 0 && exitcode == 127)) {
- Console_String((CHAR*)"Is the C compiler in the current command path\?", (LONGINT)47);
- Console_Ln();
+ Out_String((CHAR*)"Is the C compiler in the current command path\?", 47);
+ Out_Ln();
}
if (status != 0) {
- Platform_Halt(status);
+ Modules_Halt(status);
} else {
- Platform_Halt(exitcode);
+ Modules_Halt(exitcode);
}
}
__DEL(title);
__DEL(cmd);
}
+static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT 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);
+ 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);
+}
+
void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len)
{
CHAR cmd[1023];
__DUP(moduleName, moduleName__len, CHAR);
- __MOVE("gcc -g", cmd, 7);
- Strings_Append(extTools_compilationOptions, ((LONGINT)(1023)), (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)"-c ", (LONGINT)4, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)".c", (LONGINT)3, (void*)cmd, ((LONGINT)(1023)));
- extTools_execute((CHAR*)"Assemble: ", (LONGINT)11, cmd, ((LONGINT)(1023)));
+ 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);
}
@@ -73,22 +90,23 @@ void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN stati
{
CHAR cmd[1023];
__DUP(additionalopts, additionalopts__len, CHAR);
- __MOVE("gcc -g", cmd, 7);
- Strings_Append((CHAR*)" ", (LONGINT)2, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append(extTools_compilationOptions, ((LONGINT)(1023)), (void*)cmd, ((LONGINT)(1023)));
- Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)".c ", (LONGINT)4, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append(additionalopts, additionalopts__len, (void*)cmd, ((LONGINT)(1023)));
+ 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", (LONGINT)8, (void*)cmd, ((LONGINT)(1023)));
+ Strings_Append((CHAR*)"-static", 8, (void*)cmd, 1023);
}
- Strings_Append((CHAR*)" -o ", (LONGINT)5, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)" -L\"", (LONGINT)5, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)"/lib\"", (LONGINT)6, (void*)cmd, ((LONGINT)(1023)));
- Strings_Append((CHAR*)" -l voc", (LONGINT)8, (void*)cmd, ((LONGINT)(1023)));
- extTools_execute((CHAR*)"Assemble and link: ", (LONGINT)20, cmd, ((LONGINT)(1023)));
+ 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);
}
@@ -97,17 +115,12 @@ export void *extTools__init(void)
{
__DEFMOD;
__MODULE_IMPORT(Configuration);
- __MODULE_IMPORT(Console);
+ __MODULE_IMPORT(Modules);
__MODULE_IMPORT(OPM);
+ __MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
__REGMOD("extTools", 0);
/* BEGIN */
- Strings_Append((CHAR*)" -I \"", (LONGINT)6, (void*)extTools_compilationOptions, ((LONGINT)(1023)));
- Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)extTools_compilationOptions, ((LONGINT)(1023)));
- Strings_Append((CHAR*)"/include\" ", (LONGINT)11, (void*)extTools_compilationOptions, ((LONGINT)(1023)));
- Platform_GetEnv((CHAR*)"CFLAGS", (LONGINT)7, (void*)extTools_CFLAGS, ((LONGINT)(1023)));
- Strings_Append(extTools_CFLAGS, ((LONGINT)(1023)), (void*)extTools_compilationOptions, ((LONGINT)(1023)));
- Strings_Append((CHAR*)" ", (LONGINT)2, (void*)extTools_compilationOptions, ((LONGINT)(1023)));
__ENDMOD;
}
diff --git a/bootstrap/windows-88/extTools.h b/bootstrap/windows-88/extTools.h
index 6ac1ab91..63e5df15 100644
--- a/bootstrap/windows-88/extTools.h
+++ b/bootstrap/windows-88/extTools.h
@@ -1,9 +1,8 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
+/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef extTools__h
#define extTools__h
-#define LARGE
#include "SYSTEM.h"
@@ -14,4 +13,4 @@ import void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEA
import void *extTools__init(void);
-#endif
+#endif // extTools
diff --git a/bootstrap/windows-88/vt100.c b/bootstrap/windows-88/vt100.c
deleted file mode 100644
index a9110e8a..00000000
--- a/bootstrap/windows-88/vt100.c
+++ /dev/null
@@ -1,259 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-#define LARGE
-#include "SYSTEM.h"
-#include "Console.h"
-#include "Strings.h"
-
-
-export CHAR vt100_CSI[5];
-static CHAR vt100_tmpstr[32];
-
-
-export void vt100_CHA (INTEGER n);
-export void vt100_CNL (INTEGER n);
-export void vt100_CPL (INTEGER n);
-export void vt100_CUB (INTEGER n);
-export void vt100_CUD (INTEGER n);
-export void vt100_CUF (INTEGER n);
-export void vt100_CUP (INTEGER n, INTEGER m);
-export void vt100_CUU (INTEGER n);
-export void vt100_DECTCEMh (void);
-export void vt100_DECTCEMl (void);
-export void vt100_DSR (INTEGER n);
-export void vt100_ED (INTEGER n);
-export void vt100_EL (INTEGER n);
-static void vt100_EscSeq (INTEGER n, CHAR *letter, LONGINT letter__len);
-static void vt100_EscSeq0 (CHAR *letter, LONGINT letter__len);
-static void vt100_EscSeq2 (INTEGER n, INTEGER m, CHAR *letter, LONGINT letter__len);
-static void vt100_EscSeqSwapped (INTEGER n, CHAR *letter, LONGINT letter__len);
-export void vt100_HVP (INTEGER n, INTEGER m);
-export void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len);
-export void vt100_RCP (void);
-static void vt100_Reverse0 (CHAR *str, LONGINT str__len, INTEGER start, INTEGER end);
-export void vt100_SCP (void);
-export void vt100_SD (INTEGER n);
-export void vt100_SGR (INTEGER n);
-export void vt100_SGR2 (INTEGER n, INTEGER m);
-export void vt100_SU (INTEGER n);
-export void vt100_SetAttr (CHAR *attr, LONGINT attr__len);
-
-
-static void vt100_Reverse0 (CHAR *str, LONGINT str__len, INTEGER start, INTEGER end)
-{
- CHAR h;
- while (start < end) {
- h = str[__X(start, str__len)];
- str[__X(start, str__len)] = str[__X(end, str__len)];
- str[__X(end, str__len)] = h;
- start += 1;
- end -= 1;
- }
-}
-
-void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len)
-{
- CHAR b[21];
- INTEGER s, e;
- SHORTINT maxLength;
- maxLength = 20;
- if (int_ == (-9223372036854775807-1)) {
- __MOVE("-9223372036854775808", b, 21);
- e = 20;
- } else {
- if (int_ < 0) {
- b[0] = '-';
- int_ = -int_;
- s = 1;
- } else {
- s = 0;
- }
- e = s;
- do {
- b[__X(e, ((LONGINT)(21)))] = (CHAR)(__MOD(int_, 10) + 48);
- int_ = __DIV(int_, 10);
- e += 1;
- } while (!(int_ == 0));
- b[__X(e, ((LONGINT)(21)))] = 0x00;
- vt100_Reverse0((void*)b, ((LONGINT)(21)), s, e - 1);
- }
- __COPY(b, str, str__len);
-}
-
-static void vt100_EscSeq0 (CHAR *letter, LONGINT letter__len)
-{
- CHAR cmd[9];
- __DUP(letter, letter__len, CHAR);
- __COPY(vt100_CSI, cmd, ((LONGINT)(9)));
- Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(9)));
- Console_String(cmd, ((LONGINT)(9)));
- __DEL(letter);
-}
-
-static void vt100_EscSeq (INTEGER n, CHAR *letter, LONGINT letter__len)
-{
- CHAR nstr[2];
- CHAR cmd[7];
- __DUP(letter, letter__len, CHAR);
- vt100_IntToStr(n, (void*)nstr, ((LONGINT)(2)));
- __COPY(vt100_CSI, cmd, ((LONGINT)(7)));
- Strings_Append(nstr, ((LONGINT)(2)), (void*)cmd, ((LONGINT)(7)));
- Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(7)));
- Console_String(cmd, ((LONGINT)(7)));
- __DEL(letter);
-}
-
-static void vt100_EscSeqSwapped (INTEGER n, CHAR *letter, LONGINT letter__len)
-{
- CHAR nstr[2];
- CHAR cmd[7];
- __DUP(letter, letter__len, CHAR);
- vt100_IntToStr(n, (void*)nstr, ((LONGINT)(2)));
- __COPY(vt100_CSI, cmd, ((LONGINT)(7)));
- Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(7)));
- Strings_Append(nstr, ((LONGINT)(2)), (void*)cmd, ((LONGINT)(7)));
- Console_String(cmd, ((LONGINT)(7)));
- __DEL(letter);
-}
-
-static void vt100_EscSeq2 (INTEGER n, INTEGER m, CHAR *letter, LONGINT letter__len)
-{
- CHAR nstr[5], mstr[5];
- CHAR cmd[12];
- __DUP(letter, letter__len, CHAR);
- vt100_IntToStr(n, (void*)nstr, ((LONGINT)(5)));
- vt100_IntToStr(m, (void*)mstr, ((LONGINT)(5)));
- __COPY(vt100_CSI, cmd, ((LONGINT)(12)));
- Strings_Append(nstr, ((LONGINT)(5)), (void*)cmd, ((LONGINT)(12)));
- Strings_Append((CHAR*)";", (LONGINT)2, (void*)cmd, ((LONGINT)(12)));
- Strings_Append(mstr, ((LONGINT)(5)), (void*)cmd, ((LONGINT)(12)));
- Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(12)));
- Console_String(cmd, ((LONGINT)(12)));
- __DEL(letter);
-}
-
-void vt100_CUU (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"A", (LONGINT)2);
-}
-
-void vt100_CUD (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"B", (LONGINT)2);
-}
-
-void vt100_CUF (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"C", (LONGINT)2);
-}
-
-void vt100_CUB (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"D", (LONGINT)2);
-}
-
-void vt100_CNL (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"E", (LONGINT)2);
-}
-
-void vt100_CPL (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"F", (LONGINT)2);
-}
-
-void vt100_CHA (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"G", (LONGINT)2);
-}
-
-void vt100_CUP (INTEGER n, INTEGER m)
-{
- vt100_EscSeq2(n, m, (CHAR*)"H", (LONGINT)2);
-}
-
-void vt100_ED (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"J", (LONGINT)2);
-}
-
-void vt100_EL (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"K", (LONGINT)2);
-}
-
-void vt100_SU (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"S", (LONGINT)2);
-}
-
-void vt100_SD (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"T", (LONGINT)2);
-}
-
-void vt100_HVP (INTEGER n, INTEGER m)
-{
- vt100_EscSeq2(n, m, (CHAR*)"f", (LONGINT)2);
-}
-
-void vt100_SGR (INTEGER n)
-{
- vt100_EscSeq(n, (CHAR*)"m", (LONGINT)2);
-}
-
-void vt100_SGR2 (INTEGER n, INTEGER m)
-{
- vt100_EscSeq2(n, m, (CHAR*)"m", (LONGINT)2);
-}
-
-void vt100_DSR (INTEGER n)
-{
- vt100_EscSeq(6, (CHAR*)"n", (LONGINT)2);
-}
-
-void vt100_SCP (void)
-{
- vt100_EscSeq0((CHAR*)"s", (LONGINT)2);
-}
-
-void vt100_RCP (void)
-{
- vt100_EscSeq0((CHAR*)"u", (LONGINT)2);
-}
-
-void vt100_DECTCEMl (void)
-{
- vt100_EscSeq0((CHAR*)"\?25l", (LONGINT)5);
-}
-
-void vt100_DECTCEMh (void)
-{
- vt100_EscSeq0((CHAR*)"\?25h", (LONGINT)5);
-}
-
-void vt100_SetAttr (CHAR *attr, LONGINT attr__len)
-{
- CHAR tmpstr[16];
- __DUP(attr, attr__len, CHAR);
- __COPY(vt100_CSI, tmpstr, ((LONGINT)(16)));
- Strings_Append(attr, attr__len, (void*)tmpstr, ((LONGINT)(16)));
- Console_String(tmpstr, ((LONGINT)(16)));
- __DEL(attr);
-}
-
-
-export void *vt100__init(void)
-{
- __DEFMOD;
- __MODULE_IMPORT(Console);
- __MODULE_IMPORT(Strings);
- __REGMOD("vt100", 0);
- __REGCMD("DECTCEMh", vt100_DECTCEMh);
- __REGCMD("DECTCEMl", vt100_DECTCEMl);
- __REGCMD("RCP", vt100_RCP);
- __REGCMD("SCP", vt100_SCP);
-/* BEGIN */
- __COPY("\033", vt100_CSI, ((LONGINT)(5)));
- Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5)));
- __ENDMOD;
-}
diff --git a/bootstrap/windows-88/vt100.h b/bootstrap/windows-88/vt100.h
deleted file mode 100644
index 801bc8f9..00000000
--- a/bootstrap/windows-88/vt100.h
+++ /dev/null
@@ -1,38 +0,0 @@
-/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
-
-#ifndef vt100__h
-#define vt100__h
-
-#define LARGE
-#include "SYSTEM.h"
-
-
-import CHAR vt100_CSI[5];
-
-
-import void vt100_CHA (INTEGER n);
-import void vt100_CNL (INTEGER n);
-import void vt100_CPL (INTEGER n);
-import void vt100_CUB (INTEGER n);
-import void vt100_CUD (INTEGER n);
-import void vt100_CUF (INTEGER n);
-import void vt100_CUP (INTEGER n, INTEGER m);
-import void vt100_CUU (INTEGER n);
-import void vt100_DECTCEMh (void);
-import void vt100_DECTCEMl (void);
-import void vt100_DSR (INTEGER n);
-import void vt100_ED (INTEGER n);
-import void vt100_EL (INTEGER n);
-import void vt100_HVP (INTEGER n, INTEGER m);
-import void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len);
-import void vt100_RCP (void);
-import void vt100_SCP (void);
-import void vt100_SD (INTEGER n);
-import void vt100_SGR (INTEGER n);
-import void vt100_SGR2 (INTEGER n, INTEGER m);
-import void vt100_SU (INTEGER n);
-import void vt100_SetAttr (CHAR *attr, LONGINT attr__len);
-import void *vt100__init(void);
-
-
-#endif
diff --git a/doc/BasicTypeSize.md b/doc/BasicTypeSize.md
deleted file mode 100644
index a6dc52ef..00000000
--- a/doc/BasicTypeSize.md
+++ /dev/null
@@ -1,172 +0,0 @@
-## Cross Platform Compatibility and Basic Type Sizes in Vishap Oberon
-
-###### Abstract
-
-Vishap Oberon needs to support 32 and 64 bit machine architectures. 16 and
-possibly 8 bits would be good too.
-
-Currently Vishap Oberon has different INTEGER, LONGINT and SET sizes on 16
-and 32 bit architectures. While this enables memory management code to use
-LONGINT on all architectures, it breaks library and user code which makes
-assumptions about type sizes.
-
-The goal is to specify changes to the Vishap compiler and library to allow C
-code generation for multiple machine architectures without breaking existing
-code, and to allow serialized data to be interchangeable between machine
-architectures.
-
-###### Motivation
-
-Current type sizes are loosely specified and vary between implementations. There
-are conflicting general assumptions, for example: that LONGINT is large enough
-to contain any machine address; but also that LONGINT always take 32 bits when
-serialised to files. (See Oakwood guidelines appendix A 1.2.5.4.)
-
-The compiler has ended up with a number of INTEGER types, each with its own
-set of code to handle declaration, access, storage etc. There is a good
-opportunity to refactor and simplify the current duplicated code.
-
-Neither C's basic types, nor Oberon's are fixed in size. Yet for cross platform
-compatability we need fixed size types.
-
-###### Basis of implementation - integers and sets
-
-In the generated C code we use these types for all integer and set variables:
-
-| Unsigned | Signed | Sets |
-| ----------- | ----------- | ------ |
-| INTEGER_U8 | INTEGER_S8 | SET_8 |
-| INTEGER_U16 | INTEGER_S16 | SET_16 |
-| INTEGER_U32 | INTEGER_S32 | SET_32 |
-| INTEGER_U64 | INTEGER_S64 | SET_64 |
-
-SYSTEM.H uses conditional compilation to derive these types from the types
-available in the C compiler we are building on.
-
-Then, with suitable compiler options we control the mapping of compiler types
-to these C types.
-
-There are three strategies that clients may wish to use:
-
-1) Emphasizing compatability with serialised data and existing code. Here
- we fix Oberon type sizes across platforms, and introduce a new LONG64 type
- as follows:
-
-| Oberon type | Size |
-| ----------- | ---------------- |
-| BOOLEAN | 8 bits |
-| BYTE | 8 bits unsigned |
-| SHORTINT | 8 bits signed |
-| INTEGER | 16 bits signed |
-| LONGINT | 32 bits signed |
-| SET | 32 flag bits |
-| LONG64 | 64 bits signed |
-
- This gives a set of sizes that are available on all platforms (even SDCC
- supports 64 bit ints), and which have fixed characteristics (e.g. the size of
- character array sufficient to support any LONGINT values is fixed.)
-
- Note that these sizes match current Vishap Oberon behaviour on x86.
-
-2) Emphasizing performant maxima. Here we make e.g. LONGINT the largest
- efficient size available. On x86 we stick with the sizes as above, but for
- x64 we make changes to INTEGER, LONGINT and SET as follows:
-
-| Oberon type | Size on x64 |
-| ----------- | ---------------- |
-| INTEGER | 32 bits signed |
-| LONGINT | 64 bits signed |
-| SET | 64 flag bits |
-
-3) Supporting system code, especially memory management.
-
- With SYSTEM imported, we extend the parsing of type INTEGER to accept a
- subsequent qualifier which may be U8, S8, U16, S16, U32, S32, U64, S64 or
- ADDRESS.
-
- Thus the type `INTEGER ADDRESS` takes over the role of `LONGINT` in existing
- memory management code. The compiler will map `INTEGER ADDRESS` to the
- relevant `INTEGER_U32` or `INTEGER_U64` in generated C code.
-
- Additionally the fixed size qualifiers U8, S8, U16, etc. allow the writing of
- Oberon source code that generates the same C code regardless of compilation
- options used.
-
-###### Cross platform libraries
-
-Many integral input parameters are currently coded as LONGINT with the intention
-of accepting any size of integer. E.g. Texts.WriteInt. All such code needs
-upgrading to accept LONG64 with implementation changes where necessary to
-account for the larger values. Boring, but straightforward.
-
-Some integral output parameter are currently coded as `VAR LONGINT`, for example
-the integer value field `i` in RECORD type `Scanner`. This is a problem:
-
-Assuming scenario 1 - LONGINT is always 32 bits.
-
- - If retained as LONGINT, Scanner won't be able to handle 64 bit integers.
- - If changed to LONG64, existing code will compile with type compatibility
- errors.
-
-So neither option is possible on its own.
-
-The simplest workaround is to add a new field `l` and a new scanner class
-Long64 (similar to the pair of REAL and LONGREAL values already in Scanner).
-
-Existing code will continue to work with values in the 32 bit range (which is
-OK, because that's all the existing code can generate). New code can allow for
-thye LongReal case.
-
-(Ugly but workable).
-
-Oakwood says that INTEGER must be stored as 2 bytes little endian, so Files.Mod
-must use 16 bits on file for Files.ReadInt and Files.WriteInt. So what happens
-in scenario 2 above? Since INTEGER is 32 bits in scenario 2, it would be
-necessary to call Files.WriteLInt Files.ReadLInt. This is not obvious, and will
-need the coder to work around the apparent type incompatibility.
-
-If only the type compatibility of passing a smaller integer variable to a larger
-value parameter also worked for a larger var parameter.
-
-Would this be possible?
-
-e.g.
-
-```Modula-2
- PROCEDURE p(VAR x: LONGINT); BEGIN ... END p;
-
- PROCEDURE q;
- VAR r: INTEGER;
- BEGIN p(r) END q;
-```
-
-q passes an `INTEGER` to the `VAR x: LONGINT` parameter of p. Normally this
-would be a type compatability error.
-
-If we want to defer value range checking until runtime, the compiler would have
-to behave as if q was written with a temp LONGINT variable like this:
-
-```Modula-2
- PROCEDURE q;
- VAR r: INTEGER; temp: LONGINT;
- BEGIN p(temp); r := SHORT(temp) END q;
-```
-
-Not simple enough.
-
-
-###### IMPORT SYSTEM
-
-With SYSTEM imported, we allow the type INTEGER to be followed by a size and
-sign specification consiting of a letter (U for unsigned or S for signed)
-followed by a numeric bit count which may be 8, 16, 32 or 64. Additionally
-INTEGER may be followed by the word ADDRESS to request an unsigned integer type
-of the same size as a machine address.
-
-Thus we could define
-
-###### Not supported
-
-This solution does not seek to handle architectures such as the 8086/80286 where
-a generalised address is not a single numeric value. TopSpeed Modula handled
-this nicely, but we don't go that far.
diff --git a/doc/Features.md b/doc/Features.md
index e7e8a39d..e597732c 100644
--- a/doc/Features.md
+++ b/doc/Features.md
@@ -1,25 +1,148 @@
-#### (Work in progress)
+### Features
+
+#### 32 bit and 64 bit systems vs integer, set and address size.
+
+The Oberon language specification sets explicit lower bounds on the maximum and minimum
+values supported by SHORTINT, INTEGER and LONGINT, and the maximum number of items supported
+by SET.
+
+Most Oberon systems implemented these lower bounds, however a few more recent systems allow
+wider ranges of values.
+
+While it may seem safe to compile code developed on earlier systems with the newer, larger
+integer and set types, it is not. Some examples:
+
+ - Code that uses MIN(INTEGER), MAX(INTEGER) etc. as a flag values will run into problems if
+ it tries to store the flag value to a file using standard library functions. The Oakwood
+ guidelines specify that INTEGER be stored in 16 bits on file regardless of it's size in
+ memory*.
+
+ - Code that assumes that INTEGER values wrap around at known values will fail. For example
+ i: SHORTINT; ... i := 127; INC(i); will produce -128 on original systems, but +128 on
+ systems with a larger SHORTINT representation.
+
+ - Bit manipulation code that uses SYSTEM.VAL to access parts of values will access the
+ wrong number of bits. For example, the implementation of REAL and LONGREAL library functions
+ use SYSTEM.VAL(SET, realvalue) to access and change the sign, mantissa and exponent of REALs.
+
+Therefore we provide compilation options to select the representation of SHORTINT, INTEGER, LONGINT and SET.
+
+\* It makes sense for Oakwood to insist on fixed sizes for the standard types as this is a pre-requisite
+for stable file exchange between different builds of applications, and between different applications following a standard file format.
+
+
+#### Compiler options for integer and set sizes.
+
+The -O2 and -OC compiler options select between the two most commonly used integer and set
+type implementations.
+
+| Type | -O2 option (default) | -OC option |
+| --- | --- | --- |
+| SHORTINT | 8 bit | 16 bit |
+| INTEGER | 16 bit | 32 bit |
+| LONGINT | 32 bit | 64 bit |
+| SET | 32 bit | 64 bit |
+
The following Oberon types are independent of compiler size:
-| Types | Size |
-| ----- | -------|
-| CHAR, SHORTINT | 8 bit |
-| REAL | 32 bit |
-| LONGREAL | 64 bit |
+| Types | Size |
+| ----- | ------- |
+| REAL | 32 bit floating point |
+| LONGREAL | 64 bit floating point |
+| HUGEINT* | 64 bit signed integer |
+| BYTE** | 8 bit signed integer (-OC model only) |
+| CHAR*** | 8 bit character |
-The following type sizes follow the built compiler size:
+\* The additional type HUGEINT is predefined as a 64 bit integer, providing 64 bit support even
+in -O2 compilations.
-| Types | 32 bit builds | 64 bit builds |
-| ----- | ------------- | ------------- |
-| INTEGER | 16 bit | 32 bit |
-| LONGINT, SET | 32 bit | 16 bit |
+\** The additional type BYTE is defined for -OC (Component Pascal) model only and is a *signed*
+8 bit integer.
-HALT/exit code has been simplified. Exit now just calls the system exit API rather than calling the kill API and passing our own process ID. For runtime errors it now displayes the appropriate error message (e.g. Index out of range).
+\*** No built-in support is provided for the UTF-16 or UCS-2 Unicode encodings. UTF-8 is the recommended Unicode encoding for text.
+ - 16 bits has been insufficient for the Unicode character repetoire for at least 15 years.
+ - Writing systems often require more than one unicode codepoint to represent a single character (and what constitutes a character can vary according to context).
+ - UTF-8 is now widely used.
-Compilation errors now include the line number at the start of the displayed source line. The pos (character offset) is still displayed on the error message line. The error handling code was already doing some walking of the source file to find start and end of line - I changed this to walk through the source file from the start identifying line end positions, counting lines and caching the position at the start of the last error line. The resultant code is simpler, and displays the line number without losing the pos. The performance cost of walking the source file is not an issue.
+See [UTF-8 Everywhere](http://utf8everywhere.org/) for much more background on this recommendation.
- - In his latest specs (around 2013) Wirth removed the 'COPY(a, b)' character array copy procedure, replacing it with 'b := a'. I have accordingly enabled 'b := a' in voc as an alternative to 'COPY(a, b)' (COPY is still supported.).
+#### SYSTEM.Mod support for fixed size integers and sets.
+
+SYSTEM.Mod includes the following additional types:
+
+| Type | Size | Range |
+| --- | --- | --- |
+| SYSTEM.INT8 | 8 bit | -128 .. 127 |
+| SYSTEM.INT16 | 16 bit | -32,768 .. 32,767 |
+| SYSTEM.INT32 | 32 bit | -2,147,483,6478 .. 2,147,483,647 |
+| SYSTEM.INT64 | 64 bit | -9,223,372,036,854,775,808 .. 9,223,372,036,854,775,807 |
+| SYSTEM.SET32 | 32 bit | 0 .. 31 |
+| SYSTEM.SET64 | 64 bit | 0 .. 63 |
+
+Integer literals are recognised within the full signed 64 bit integer range MIN(SYSTEM.INT64) to MAX(SYSTEM.INT64). Additionally the parsing of hex notation allows negative values to be entered as a full 16 hex digits with top bit set. For example, -1 may be represented in Oberon source as 0FFFFFFFFFFFFFFFFH.
+
+
+#### The SHORT and LONG functions
+
+SHORT() of LONGINT and INTEGER values, and LONG() of SHORTINT and INTEGER values behave as
+originally specified by Oberon-2.
+
+In -O2, where LONGINT is 32 bits, LONG() now accepts a LONGINT value returning a HUGEINT value.
+
+In -OC, where SHORTINT is 16 bits, SHORT() now accepts a SHORTINT value returning a SYSTEM.INT8 value.
+
+#### ASH()
+
+The Arithmetic shift function is defined by Oberon-2 as follows:
+
+| Name | Argument types | Result Type | Function |
+| ---- | --- | --- | --- |
+| ASH(*x*, *n*) | *x*, *n*: integer type | LONGINT | arithmetic shift (*x* * 2^*n*) |
+
+For compatability this definition is retained for all integer types up to LONGINT in size.
+Additionally, when *x* is the new HUGEINT type, the result is HUGEINT.
+
+
+#### Pointers and Addresses
+
+Most Oberon systems have implicitly or explicitly assumed that LONGINT is large enough to hold
+machine addresses. With the requirement to support 32 bit LONGINT on 64 bit systems, this is no
+longer possible.
+
+The type SYSTEM.ADDRESS is added, a signed integer type equivalent to either SYSTEM.INT32 or SYSTEM.INT64
+according to the system address size. As a general purpose integer type it can be used not just to
+store machine addresses, but also for any arithmetic purpose related to machine addresses, such as
+lengths of memory objects or offsets into memory objects.
+
+The following SYSTEM module predefined functions and procedures now use SYSTEM.ADDRESS instead of LONGINT.
+
+*Function procedures*
+
+| Name | Argument types | Result Type | Function |
+| ---- | --- | --- | --- |
+| SYSTEM.ADR(*v*) | any | SYSTEM.ADDRESS | Address of argument |
+| SYSTEM.BIT(*a*, *n*) | *a*: SYSTEM.ADDESS; *n*: integer | BOOLEAN | bit *n* of Mem[*a*] |
+
+*Proper procedures*
+
+| Name | Argument types | Function |
+| ---- | --- | --- |
+| SYSTEM.GET(*a*, *v*) | *a*: SYSTEM.ADDRESS; *v*: any basic type, pointer, procedure type | *v* := Mem[*a*] |
+| SYSTEM.PUT(*a*, *x*) | *a*: SYSTEM.ADDRESS; *x*: any basic type, pointer, procedure type | Mem[*a*] := *v* |
+| SYSTEM.MOVE(*a0*, *a1*, *n*) | *a0*, *a1*: SYSTEM.ADDRESS; *n*: integer | Mem[*a1*..*a1*+*n*-1] := Mem[*a0*..*a0*+*n*-1] |
+
+Note that the standard function LEN() still returns LONGINT.
+
+
+#### Runtime error and exit handling
+
+When passed FALSE, ASSERT displays the message 'Assertion failure.'. If a second, nonzero value is passed to ASSERT it will also be displayed. ASSERT then exits to the OS passing the assert value or zero.
+
+HALT displays the message 'Terminated by Halt(n)'. For negative values that correspond to a standard runtime error a descriptive string is also printed. Finally Halt exits to the oprerating system passing the error code.
+
+Bear in mind that both Linux and Windows generally treat the return code as a signed 8 bit value, ignoring higher order bits. Therefore it is best to restrict HALT and ASSERT codes to the range -128 .. 127.
+
+A client application may register a halt handler by calling Platform.SetHalt(p) where p: PROCEDURE(n: SYSTEM.INT32). This procedure will be called before Halt displays it's message. The procedure may suppress the Halt message by calling Platform.Exit(code: INTEGER) directly.
- - Oberon code often writes to Oberon.Log expecting the text to appear on the screen. While voc has an Oberon.DumpLog procedure, I looked into making the behaviour automatic. Interestingly the voc source declares the Text notifier constants replace, insert and delete, but omits implementation of the notifier calls. The implementation turned out to be very little code, and I have used it to echo all text written to Oberon.Log to the console. This has the advantage over DumpLog that text is written immediately rather than only when DumpLog is called, and allows existing program source to work unchanged.
diff --git a/doc/Installation.md b/doc/Installation.md
index 64c50555..7c131005 100644
--- a/doc/Installation.md
+++ b/doc/Installation.md
@@ -1,152 +1,154 @@
-#### (Work in progress)
+## Building and installation summary
+
+The Oberon compiler and libraries may be built and installed on Linux based, BSD based or Windows based systems.
+
+Building on Linux and BSD based systems is reasonably straightforward. First make sure you have the right pre-requites like a C compiler and static libraries installed, then clone the repository and run `make full`.
+
+Full instructions for a Linux/BSD based build follow in the next section.
-## TODO
- - Organise into summary and per-platfrom sections
- - with subsections for linux and BSD variants
- - Add pre-requisites. E.g. static library support.
+Bulding on Windows is not so simple largely because there is more than one way to do it:
-#### Building and installation summary
+ - Install the cygwin project and use Windows from the cygwin bash shell rather like Linux.
+ With the pre-requisites installed using the cygwin setup.exe gui tool, clone and run make
+ as on Linux.
+ This builds a compiler that is dependent on the cygwin environment, and which compiles
+ Oberon programs to binaries that are themselves dependent on the cygwin environment.
-1. git clone https://github.com/vishaps/voc
-2. cd voc
-3. [sudo] make full
+ - Install the cygwin project and the mingw compiler. The Oberon compiler this builds is
+ still dependent on the cygwin environment, but programs built with this compiler are
+ Windows binaries dependent only on standard Microsoft APIs and libraries.
-Since 'make full' will install the compiler and libraries, it needs root (unix) or administrator (windows) privileges.
+ - Use the Windows 10 Bash on Ubuntu on Windows (aka WSL - Windows Subsystem for Linux).
+ The Oberon compiler can be built in the WSL using exactly the same procedure
+ as on a normal Ubuntu environment, and the resulting compiler and user programs will run
+ within the Windows subsystem for Linux.
-| System | Install dir | Access required |
-| ----------------------- | -------------------------------------- | ------------------------------ |
-| Linux | /opt/voc | Needs root except under cygwin |
-| BSD | /usr/local/share/voc | Needs root |
-| Windows (mingw or Visual C) | %ProgramFiles[(X86)]% | Needs administrator |
-| Termux (android) | /data/data/com.termux/files/opt/voc | |
+ - Build with the Microsoft C compiler generating native windows binaries. A make.cmd script
+ is provided which has been developed for and tested with the free 'Visual C++ build tools'
+ available at http://landinghub.visualstudio.com/visual-cpp-build-tools.
+
+For full details about building with Cygwin or native Microsoft C environments see [**Cygwin and MSC Installation**](/doc/Winstallation.md)
+
+The following sections provide more details for Linux based builds.
-#### 32 and 64 bit
+### Building the Oberon compiler and libraries on a Linux or BSD based system
-The size of compiler built is determined by the C compiler that runs, which is in turn determined by
-the shell or command prompt configuration you are running under.
+This approach is for
+ - All Linux based systems
+ - includes Android (specifically termux on Android)
+ - includes Windows subsystem for Linux (aka Bash on Ubuntu on Windows)
+ - All BSD based systems
+ - includes macOS (Darwin)
-The following type sizes follow the built compiler size:
+#### 1. Install pre-requisites
-| Types | 32 bit builds | 64 bit builds |
-| ----- | ------------- | ------------- |
-| INTEGER | 16 bit | 32 bit |
-| LONGINT, SET | 32 bit | 64 bit |
+The build process has the following pre-requisites:
-Note that many library modules have been written with the assumption that INTEGER
-is 16 bit and LONGINT 32 bit, therefore they will only work in 32 bit builds.
+ - gcc (or clang) compiler
+ - static libraries for the chosen compiler
+ - git
+ - make
+ - diff
-#### Which compiler? (gcc vs clang)
+Example pre-requisite installation commands:
-By default make uses the compiler defined in variable CC. This can be overriden by running 'export CC=gcc' or 'export CC=clang' from the command line before running make.
+| Platform | Pre-requisite installation |
+| --------- | ------------ |
+| Debian/Ubuntu/Mint ... | `apt-get install git` |
+| Fedora/RHEL/CentOS ... | `yum install git gcc glibc-static` (`dnf` instead of `yum` on recent Fedoras) |
+| FreeBSD/OpenBSD/NetBSD | `pkg install git` |
+| OpenSUSE | `zypper install gcc git-core make glibc-devel-static` |
-*Note*: be sure to run 'make clean' any time you change the value of CC. Otherwise directories will be mixed up.
+On Mac OS (Darwin) just type the git command. OS/X will tell you that it is not installed and ask if you want to install it (say yes). Note that Darwin builds always use clang, the OS will redirect attempts to use gcc to clang.
-*Note*: Darwin (MAC OS/X) redirects gcc to clang, so specifying CC=gcc still builds clang binaries under Darwin.
+#### 2. Clone the Oberon compiler repository
+
+Create and change to a directory in which to make the compiler and clone with this command:
+
+`git clone https://github.com/vishaps/voc`
+
+This will create a subdirectory 'voc' which includes the following files and directories:
+
+| Name | Content |
+| --- | --- |
+| src/ | Compiler and library source, build tools and tests. |
+| bootstrap/ | Pre-generated C source for the compiler targetting the 5 distinct build models needed. |
+| doc/ | Documents (including this one). |
+| makefile | Makefile for all BSD- and Linux- like environments. Includes tests. |
+| make.cmd | Makefile specifically for native Microsoft C builds. No tests. |
+
+#### 3. Build and install the Oberon compiler and library
-#### Building on Windows
+```
+cd voc
+[sudo] make full
+```
-There are three ways to build on Windows:
+The makefile will:
-| Type | How to build | Compiled binary uses: |
-| ----------- | ------- | --------------------- |
-| cygwin | Use 'make' from cygwin bash shell. | cygwin.dll |
-| mingw under cygwin | Set CC for mingw then use 'make' from cygwin bash shell. | Win32 API |
-| Visual C | Use 'make.cmd' from Visual C command prompt. | Win32 API |
+ - Compile and run a C program that determines your C compiler and OS's configuration and creates
+ the files Configuration.Make and Configuration.Mod.
+ - C Compile the bootstrap C sources to generate an interim Oberon compiler for your configuration.
+ - Use the interim compiler to compile the src/compiler and src/runtime directories and statically
+ link the final Oberon compiler. This compiler is then used for the remaining steps.
+ - Build the .sym file browser command `showdef`.
+ - Build all the libraries in -O2 mode, and a subset in -OC mode.
+ - Install the compiler and libraries by copying them to an appropriate location for your OS.
+ - Run a set of confidence tests.
-##### mingw on cygwin
+Since installation directories are not generally write accessible to normal users, is is necessary to run
+the `make full` command from a root shell, or by using `sudo`.
-To use mingw, install the correct sized package and export CC= the compiler name:
+The makefile will use either gcc or clang, whichever is installed. If you have both installed you can specify which to use by running either `export CC=gcc` or `export CC=clang` before the `make full` command.
- - For 32 bit cygwin
- - use setup-x86.exe to add the package mingw64-i686-gcc-core.
- - run 'export CC=i686-w64-mingw32-gcc' then 'make full'
+#### Installation directories:
- - For 64 bit cygwin
+If the makefile succeeds it will end with instructions on how to set your path variable so that the
+compiler (voc) is found.
- - use setup-x86\_64.exe to add the package mingw64-x86\_64-gcc-core.
- - run 'export CC=x86_64-w64-mingw32-gcc' then 'make full'
+The installation will be found at:
-(*Note*: Don't be put off by the name 'mingw64' in the 32 bit package.)
+| System | Install dir |
+| ----------------------- | -------------------------------------- |
+| All types of Linux | /opt/voc |
+| BSD (including Darwin) | /usr/local/share/voc |
+| Termux (android) | /data/data/com.termux/files/opt/voc | |
-##### Microsoft Visual C compiler
+The installation directory contains:
-Use the free command line Visual C++ compiler. At the time of writing it can be
-downloaded here:
+| Directory | Content |
+| --- | --- |
+| bin/ | Compiler and symbol file browser command binaries. |
+| lib/ | Static and dynamic link libraries for all (-O2 and -OC) type models. |
+| 2/include/ | C compiler header files for -O2 modules |
+| 2/sym/ | .sym files for -O2 modules |
+| C/include/ | C compiler header files for -OC modules |
+| C/sym/ | .sym files for -OC modules |
- http://landinghub.visualstudio.com/visual-cpp-build-tools
-For example (Windows 10):
-Start an adminstrator command prompt from the start button as follows:
+### 32 and 64 bit
- Start / All apps / Visual C++ Build Tools
+The compiler may be built on both 32 bit and 64 bit systems.
-Right click on
+Oberon programs may be compiled using the -O2 (default) or -OC elementary type models. The elementary
+types are as follows:
- Visual C++ 2015 x86 Native Build Tools Command Prompt
+| Model | 8 bit | 16 bit | 32 bit | 64 bit |
+| --- | ---- | --- | --- | --- |
+| -O2 (default) | `SHORTINT` | `INTEGER` | `LONGINT` and `SET` | `HUGEINT` |
+| -OC | `BYTE` | `SHORTINT` | `INTEGER` | `LONGINT` and `SET` |
-or
+A convention of many Oberon compilers has been that LONGINT is a suitable integer type for
+manipulating addresses. However since the size of pointer types is fixed by the OS and we
+support both 32 and 64 bit operating systems, LONGINT is not always sufficient for us.
- Visual C++ 2015 x64 Native Build Tools Command Prompt
+Accordingly, the SYSTEM module has been updated to ease the development of platform independent
+code, with new types such as `SYSTEM.INT8`, `SYSTEM.INT16`, `SYSTEM.INT32`, `SYSTEM.INT64`
+and `SYSTEM.ADDRESS`.
-And select
-
- More / Administrative Command Prompt
-
-#### How make adapts to each platform
-
-On all platforms other than Visual C on Windows, make runs from a bash shell,
-using makefile in the enlistment root, and vishap.make in the src/tools/make
-directory.
-
-For Visual C only, there is a slightly cut down implementation of the same
-functionality in the file 'make.cmd' in the enlistment root.
-
-In all cases src/tools/make/configure.c is executed to determine all
-platform dependent parameters: it generates two files:
-
- - Configuration.Make: a set of environment variables included by the makefile
- - Configuration.Mod: An Oberon MODULE containing just configuraton constants.
-
-The following examples correspond to a 32 bit Ubuntu build using GCC:
-
-Configuration.Make:
-
- OLANGDIR=/home/dave/projects/oberon/olang
- COMPILER=gcc
- OS=ubuntu
- VERSION=1.2
- ONAME=voc
- DATAMODEL=ILP32
- INTSIZE=2
- ADRSIZE=4
- ALIGNMENT=4
- INSTALLDIR=/opt/voc
- PLATFORM=unix
- BINEXT=
- COMPILE=gcc -fPIC -g
- STATICLINK=-static
- LDCONFIG=if echo "/opt/voc/lib" >/etc/ld.so.conf.d/libvoc.conf; then ldconfig; fi
-
-Configuration.Mod:
-
- MODULE Configuration;
- CONST
- name* = 'voc';
- versionLong* = '1.2 [2016/06/11] for gcc ILP32 on ubuntu';
- intsize* = 2;
- addressSize* = 4;
- alignment* = 4;
- objext* = '.o';
- objflag* = ' -o ';
- linkflags* = ' -L"';
- libspec* = ' -l voc';
- compile* = 'gcc -fPIC -g';
- dataModel* = 'ILP32';
- installdir* = '/opt/voc';
- staticLink* = '-static';
- END Configuration.
+For details, see [**Features**](/doc/Features.md).
diff --git a/doc/Porting.md b/doc/Porting.md
index 94707e04..8bb2e74e 100644
--- a/doc/Porting.md
+++ b/doc/Porting.md
@@ -1,8 +1,6 @@
-#### (Work in progress)
-
### Porting to a new platform
-Porting to a new 32 or 64 bits platform is usually automatically handled
+Porting to a new 32 or 64 bit platform is usually automatically handled
by `make full`:
- The makefile compiles `src/tools/make/configure.c` with the
@@ -13,7 +11,7 @@ by `make full`:
operating system it is running on and what the appropriate
installation directory will be.
- `configure.c` sets makefile variables that are used to select
- which of 5 sets of preprepared C source files to build to create
+ which of 5 sets of pre-prepared C source files to build to create
the bootstrap compiler.
On most systems this will be sufficient for `make full` to build
@@ -23,10 +21,11 @@ and install the compiler and libraries.
`--- Branch v2docs freebsd gcc LP64 confidence tests passed ---`
+
#### Updating configure.c
-It should only be necessary to change `configure.c` if it
-cannot determine the correct install directory.
+Most likely you will only need to change `configure.c` if it cannot determine
+the correct install directory.
In this case add code to `src/tools/make/configure.c`'s
function `determineOS()` to set the `os` variable to the name
@@ -41,7 +40,7 @@ variable | set to | example
`binext` | Binary file extension | `""`
`staticlink` | Static linking option | `"-static"`
-If your new platform does not support static removing, set the
+If your new platform does not support static linking, set the
`staticlink` variable to `""`.
Then modify `determineInstallDirectory()` to select the correct
@@ -53,28 +52,7 @@ to the Windows API (`Platformwindows.Mod`), and one suitable for
Unix-like systems including Linux, BSD, Android and cygwin
(`Platformunix.Mod`).
+If you are porting to a system that does not provide a Unix style API, it will
+be necessary to implement a new variant of Platform.Mod providing the same
+interface as Platformunix.Mod and Platform Windows.Mod.
-#### How to add a new compiler option
-
- - Define it in OPM as a constant before defopt is defined.
- - Define a BOOLEAN variable in OPM which will describe if setting is set.
- - Add handling of a new option in OPM.ScanOptions
- - Set your BOOLEAN value in OPM.OpenPari (or in ScanOptions, after the
- CASE) so you can check it later.
- - Check your boolean when necessary, (see useParFile in OPM.GetOptions)
- - Add it in OPC.GenHeaderMsg function.
-
-#### Known bugs
-
-When using SYSTEM.LSH(s, n) where s is SET,
-the C compiler generates an error like
-`error: duplicate 'unsigned'`,
-that's because SET is defined as unsigned in SYSTEM.h,
-while LSH is defined in SYSTEM.h as ((t)((unsigned t)(x)<<(n))),
-and it makes not possible to make SYSTEM.LSH with type SET.
-
-I don't want to prohibit it at the parser level
-because C backend is only one of possible backends.
-
-The solution currently is to cast set type to longint before lsh-ing it.
-And then casting it back to set if necessary.
diff --git a/doc/Roadmap.md b/doc/Roadmap.md
deleted file mode 100644
index 5fac7121..00000000
--- a/doc/Roadmap.md
+++ /dev/null
@@ -1,150 +0,0 @@
-
-#### (Work in progress)
-
-#### Machine size issues
-
-I don't see any really good solutions to different machine sizes. Existing code,
-such as the libraries, assumes that INTEGER is 16 bit and LONGINT is 32 bit and
-so is broken on 64 bit builds of voc.
-
-Could the implementation of INTnn types help? It would not solve (for example)
-the need for a type that always matches address size. Nor would it provide
-unsigned types. Implementation of low level memory management needs both.
-
-Wirth's latest spec includes a BYTE type (not SYSTEM.BYTE, just BYTE) that
-behaves as an unsigned 8 bit integer, for use in low level code. BYTE thus
-avoids the need for SYSTEM.VAL when manipulating 8 bit unsigned numeric values,
-making code easier to write and, more importantly, easier to read. A BYTE type
-would be useful for microcontroller C support. So I believe it makes sense to
-add Wirths's BYTE to voc.
-
-Linux/Unix specifies many API datatypes and structure fields in terms of named C
-numeric types, with the result that they vary in size between implementations.
-This is perhaps the strongest driving force for adding support for various
-numeric types to voc - but they would better match the C types than be of fixed
-size.
-
-So maybe one could provide Platform.int, Platform.long, Platform.longlong,
-Platform.unsignedint, Platform.unsignedlong, Platform.unsignedlonglong and,
-importantly for memory management, Platform.uintptr.
-
-Personally I miss Pascal and Modula's subrange variables. As well as being great
-for error detection (assuming value checking code is generated), they can also
-be used to imply variables of arbitrary sizes (e.g. 'VAR mybyte = 0..255;').
-With these one could remove the Platform.int* types and replace them with
-constants Platform.MaxInt, Platform.MaxLong etc. I think this would be a cleaner
-more generalised option - but maybe, probably, it is a step too far. Always
-beware of over-generalising. Wirth found that most programmers did not use, or
-very rarely used, subrange types.
-
-#### More thoughts about 64 bit support and what INTEGER and LONGINT mean
-
-Arguably, because Oberon says LONGINT is big enough for addresses,
-it seems that LONGINT has to be 64 bits on a 64 bit system.
-
-But I'm having second thoughts.
-
-There's a lot of code out there that assumes the size of INTEGER and LONGINT
-and is broken if they are not 16 and 32 bits respectively. Frustratingly a
-lot of the broken code doesn't go wrong until it encounters values outside the
-16 and 32 bit ranges - like Texts.WriteInt which handles values up 2**32 fine,
-and then aborts the program with an index out of range error when the number
-is more than 11 characters long.
-
-I suggest use of LONGINT for addresses is a small subset of use cases of LONGINT.
-
-Instead I propose we
- - keep INTEGER at 16 bits and LONGINT at 32 bits.
- - Add LONG64 for 64 bit signed integers, to be available on both 32 and 64
- bit systems, (quite possible as C has an int64_t on both systems).
- - add a SYSTEM.ADDRESS type for address manipulation
- - an unsigned type that always matches the machine address size (32, 64 or even 16 bit).
- - is compatible with SHORTINT, INTEGER, LONGINT and LONG64.
-
-It means changing the memory management and platform interface code, but it
-means client code does not need changing.
-
-This fixes the current 16 bit hole in the range of INTEGER types on 64 bit systems.
-
-#### Oakwood Guidelines on type sizes
-
-The Oakwood guidelines are interesting.
-
- - 5.2 requires that e.g. LONGINT is 32 bits *or more*,
-
-but
- - Appendix A 1.2.5.4 requires that MODULE Files *always* reads and writes
- LONGINT as 4 bytes.
-
-The restriction for the Files module makes sense as it is intended to produce
-and consume files in a compatible way between platforms. Thus if a system uses
-64 bit LONGINT, it is an error (detected or not) to write
-to MODULE Files any LONGINT values outside the 32 bit range.
-
-To put it shockingly, it is an error to write the vast majority of possible
-LONGINT values - specifically over 99.998% of LONGINT values are invalid for
-MODULE Files.
-
-I see this as another argument in favour of locking LONGINT down as 32 bits.
-
-#### It's all the same to C
-
-It should be possible to make the 32/64 bit compilation a compiler option
-available whether the compiler binary itself was built with 32 or 64 bit C.
-
-Indeed - is there any benefit in a 64 bit compiler binary? A 32 bit compiler
-binary will be smaller and faster. The memory requirements of the compiler are
-orders of magnitude less than those that would need a 64 bit implementation.
-
-The only need for a 64 bit compiler binary is for systems that can only run
-64 bit binaries.
-
-Point being - the bit size of the compiler binary should be independent of the
-bit size of the target machine of the C code being generated.
-
-So the compiler options could be:
-
- 1. Generated binary bit size - 32 or 64 bit. Determines bit size of
- SYSTEM.ADDRESS. Add 16 bit option for controllers.
- 2. Size of INTEGER, SET and LONGINT. Defaulting to 16,32,32 the parameter would
- also allow 32/64/64.
-
-The libraries would be written and compiled to handle all cases. e.g.
- - A WriteInt routine needs it's value parameter to accept integers of all
- sizes and would be coded as LONG64.
- - ReadInt is slightly more difficult because the parameter is VAR. Make the
- parameter ARRAY OF BYTE and process according to SIZE(param).
-
-#### A feature I'd really like to see
-
-We should report .Mod file name and line number at fault when exiting abnormally,
-e.g. due to index out of range. Followed by a stack trace.
-
-Wirth's original Pascal (Pascal 6000 on the CDC mainframe at ETHZ) had this at
-least by 1975. This could be achieved by including a table of .Mod file line
-number vs code address, and having the runtime seach this table for the failure
-address. It would be quite a lot of work!
-
-The current position tracking code in the compiler is buggy - for example the
-position at the end of the `expr` in `WHILE expr DO stmt END` is recorded as
-the position of the END when it should be of the 'DO'. This makes compiler error
-reporting a bit unhelpful, but it's worse for runtime error reporting as we end
-up with duplicate entries in the line number table. The position handling code
-is somewhat obscure as it uses a convenient but misnamed spare integer field in
-the symbol record and it's difficult to follow just when it patches it.
-
-#### Oberon 07/15 mode
-
- - Add standard BYTE type being an unsigned integer between 0 and 255.
- - Structured value parameters become read-only and get passed the same way as
- VAR parameters - i.e. no copying.
- - CASE statements only support INTEGER (with low positive values) and CHAR.
- - Reject LOOP statements.
- - All imported variables are read-only.
-
-See [Difference between Oberon-07 and Oberon](https://www.inf.ethz.ch/personal/wirth/Oberon/Oberon07.pdf).
-
-#### To be left out?
-
-Work on other compatibility layers is in progress.
-voc team also works on bindings to existing C/Pascal libraries.
diff --git a/doc/Winstallation.md b/doc/Winstallation.md
new file mode 100644
index 00000000..74eb3c97
--- /dev/null
+++ b/doc/Winstallation.md
@@ -0,0 +1,256 @@
+### Building the Oberon compiler and libraries on a Windows system
+
+This approach is for Windows systems using
+ - Cygwin (with or without mingw)
+ - Microsoft Visual C
+
+Building on Bash on Ubuntu on Windows (aka Windows Subsystem for Linux) is the same as building on Ubuntu,
+for which see [**Installation**](/doc/Installation.md).
+
+### Building and installing with Cygwin
+
+Cygwin comes in 32 bit and 64 bit flavours, and both may be installed on a 64 bit system. On such a dual system, Oberon may be built and installed in both Cygwins.
+
+
+#### 1. Install pre-requisites
+
+The build process has the following pre-requisites:
+
+ - gcc (or clang) compiler
+ - static libraries for the chosen compiler
+ - git
+ - make
+ - diff
+
+To install these, run the Cygwin setup program (setup-x86.exe or setup-x86_64.exe as appropriate), work
+your way through the initaial questions until you reach the 'Select packages' page, and make sure the
+following packages are selected:
+
+| Section | Package |
+| --- | --- |
+| devel | binutils |
+| devel | git |
+| devel | gcc-core |
+| devel | make |
+| utils | diffutils |
+
+Click next and continue to the end of setup.
+
+#### 2. Clone the Oberon compiler repository
+
+Create and change to a directory in which to make the compiler and clone with this command:
+
+`git clone https://github.com/vishaps/voc`
+
+This will create a subdirectory 'voc' including the following files and directories:
+
+| Name | Content |
+| --- | --- |
+| src/ | Compiler and library source, build tools and tests. |
+| bootstrap/ | Pre-generated C source for the compiler targetting the 5 distinct build models needed. |
+| doc/ | Documents (including this one). |
+| makefile | Makefile for all BSD- and Linux- like environments. Includes tests. |
+| make.cmd | Makefile specifically for native Microsoft C builds. No tests. |
+
+#### 3. Build and install the Oberon compiler and library
+
+
+```
+cd voc
+[sudo] make full
+```
+
+The makefile will:
+
+ - Compile and run a C program that determines your C compiler and OS's configuration and creates
+ the files Configuration.Make and Configuration.Mod.
+ - C Compile the bootstrap C sources to generate an interim Oberon compiler for your configuration.
+ - Use the interim compiler to compile the src/compiler and src/runtime directories and statically
+ link the final Oberon compiler. This compiler is then used for the remaining steps.
+ - Build the .sym file browser command `showdef`.
+ - Build all the libraries in -O2 mode, and a subset in -OC mode.
+ - Install the compiler and libraries by copying them to an appropriate location for your OS.
+ - Run a set of confidence tests.
+
+
+### Build using mingw under cygwin
+
+### Build using Microsft C
+
+
+
+#### Installation directories:
+
+If it succeeds the makefile will end with instructions on how to set your path variable so that the
+compiler (voc) is found.
+
+The installation will be found at:
+
+| Built with | Install dir |
+| --------------- | -------------------------------------- |
+| cygwin | /opt/voc |
+| cygwin + mingw | %PROGRAMFILES%/voc |
+| MSC | %PROGRAMFILES%/voc |
+
+The installation directory contains:
+
+| Directory | Content |
+| --- | --- |
+| bin/ | Compiler and symbol file browser command binaries. |
+| lib/ | Static and dynamic link libraries for all (-O2 and -OC) type models. |
+| 2/include/ | C compiler header files for -O2 modules |
+| 2/sym/ | .sym files for -O2 modules |
+| C/include/ | C compiler header files for -OC modules |
+| C/sym/ | .sym files for -OC modules |
+
+
+
+### 32 and 64 bit
+
+The compiler may be built on both 32 bit and 64 bit systems.
+
+User Oberon programs may be compiled using the -O2 (default) or -OC elementary type models. The elementary
+types are as follows:
+
+| Model | 8 bit types | 16 bit types | 32 bit types | 64 bit types |
+| --- | ---- | --- | --- | --- |
+| -O2 (default) | `SHORTINT` | `INTEGER` | `LONGINT` and `SET` | `HUGEINT` |
+| -OC | `BYTE` | `SHORTINT` | `INTEGER` | `LONGINT` and `SET` |
+
+Of course the size of pointer types is fixed by the OS.
+
+The SYSTEM module has been updated to ease the development of platform independent code, with new
+types such as `SYSTEM.INT8`, `SYSTEM.INT16`, `SYSTEM.INT32`, `SYSTEM.INT64` and `SYSTEM.ADDRESS`.
+
+For more details, see [**Features**](doc/Features.md).
+
+----
+
+----
+
+The size of compiler built is determined by the C compiler that runs, which is in turn determined by
+the shell or command prompt configuration you are running under.
+
+The following type sizes follow the built compiler size:
+
+| Types | 32 bit builds | 64 bit builds |
+| ----- | ------------- | ------------- |
+| INTEGER | 16 bit | 32 bit |
+| LONGINT, SET | 32 bit | 64 bit |
+
+Note that many library modules have been written with the assumption that INTEGER
+is 16 bit and LONGINT 32 bit, therefore they will only work in 32 bit builds.
+
+#### Which compiler? (gcc vs clang)
+
+By default make uses the compiler defined in variable CC. This can be overriden by running 'export CC=gcc' or 'export CC=clang' from the command line before running make.
+
+*Note*: be sure to run 'make clean' any time you change the value of CC. Otherwise directories will be mixed up.
+
+*Note*: Darwin (MAC OS/X) redirects gcc to clang, so specifying CC=gcc still builds clang binaries under Darwin.
+
+
+#### Building on Windows
+
+There are three ways to build on Windows:
+
+| Type | How to build | Compiled binary uses: |
+| ----------- | ------- | --------------------- |
+| cygwin | Use 'make' from cygwin bash shell. | cygwin.dll |
+| mingw under cygwin | Set CC for mingw then use 'make' from cygwin bash shell. | Win32 API |
+| Visual C | Use 'make.cmd' from Visual C command prompt. | Win32 API |
+
+##### mingw on cygwin
+
+To use mingw, install the correct sized package and export CC= the compiler name:
+
+ - For 32 bit cygwin
+
+ - use setup-x86.exe to add the package mingw64-i686-gcc-core.
+ - run 'export CC=i686-w64-mingw32-gcc' then 'make full'
+
+ - For 64 bit cygwin
+
+ - use setup-x86\_64.exe to add the package mingw64-x86\_64-gcc-core.
+ - run 'export CC=x86_64-w64-mingw32-gcc' then 'make full'
+
+(*Note*: Don't be put off by the name 'mingw64' in the 32 bit package.)
+
+##### Microsoft Visual C compiler
+
+Use the free command line Visual C++ compiler. At the time of writing it can be
+downloaded here:
+
+ http://landinghub.visualstudio.com/visual-cpp-build-tools
+
+For example (Windows 10):
+
+Start an adminstrator command prompt from the start button as follows:
+
+ Start / All apps / Visual C++ Build Tools
+
+Right click on
+
+ Visual C++ 2015 x86 Native Build Tools Command Prompt
+
+or
+
+ Visual C++ 2015 x64 Native Build Tools Command Prompt
+
+And select
+
+ More / Administrative Command Prompt
+
+#### How make adapts to each platform
+
+On all platforms other than Visual C on Windows, make runs from a bash shell,
+using makefile in the enlistment root, and vishap.make in the src/tools/make
+directory.
+
+For Visual C only, there is a slightly cut down implementation of the same
+functionality in the file 'make.cmd' in the enlistment root.
+
+In all cases src/tools/make/configure.c is executed to determine all
+platform dependent parameters: it generates two files:
+
+ - Configuration.Make: a set of environment variables included by the makefile
+ - Configuration.Mod: An Oberon MODULE containing just configuraton constants.
+
+The following examples correspond to a 32 bit Ubuntu build using GCC:
+
+Configuration.Make:
+
+ OLANGDIR=/home/dave/projects/oberon/olang
+ COMPILER=gcc
+ OS=ubuntu
+ VERSION=1.2
+ ONAME=voc
+ DATAMODEL=ILP32
+ INTSIZE=2
+ ADRSIZE=4
+ ALIGNMENT=4
+ INSTALLDIR=/opt/voc
+ PLATFORM=unix
+ BINEXT=
+ COMPILE=gcc -fPIC -g
+ STATICLINK=-static
+ LDCONFIG=if echo "/opt/voc/lib" >/etc/ld.so.conf.d/libvoc.conf; then ldconfig; fi
+
+Configuration.Mod:
+
+ MODULE Configuration;
+ CONST
+ name* = 'voc';
+ versionLong* = '1.2 [2016/06/11] for gcc ILP32 on ubuntu';
+ intsize* = 2;
+ addressSize* = 4;
+ alignment* = 4;
+ objext* = '.o';
+ objflag* = ' -o ';
+ linkflags* = ' -L"';
+ libspec* = ' -l voc';
+ compile* = 'gcc -fPIC -g';
+ dataModel* = 'ILP32';
+ installdir* = '/opt/voc';
+ staticLink* = '-static';
+ END Configuration.
diff --git a/make.cmd b/make.cmd
index 5ff269df..6eb498e5 100644
--- a/make.cmd
+++ b/make.cmd
@@ -16,7 +16,7 @@
:: Create configuration and parameter files.
-cl -nologo -Isrc\system src\tools\make\configure.c >nul
+cl -nologo -Isrc\runtime src\tools\make\configure.c >nul
setlocal
configure.exe >nul
del configure.obj configure.exe 2>nul
@@ -27,7 +27,8 @@ for /F "delims='=' tokens=1,2" %%a in (Configuration.make) do set %%a=%%b
set FLAVOUR=%OS%.%DATAMODEL%.%COMPILER%
set BUILDDIR=build\%FLAVOUR%
-set VISHAP=%ONAME%%BINEXT%
+set OBECOMP=%ONAME%%BINEXT%
+set MODEL=2
for /F %%d in ('cd');do set ROOTDIR=%%d
@@ -62,11 +63,18 @@ goto :eof
:full
+whoami /groups | find "12288" >nul
+if errorlevel 1 (
+echo make full - administrator rights required. Please run under an administrator command prompt.
+goto :eof
+)
+call :uninstall || exit /b
call :clean || exit /b
call :compiler || exit /b
call :browsercmd || exit /b
call :library || exit /b
call :install || exit /b
+call :showpath || exit /b
goto :eof
@@ -80,23 +88,9 @@ goto :eof
-:library
-call :v4 || exit /b
-call :ooc2 || exit /b
-call :ooc || exit /b
-call :ulm || exit /b
-call :pow32 || exit /b
-call :misc || exit /b
-call :s3 || exit /b
-call :librarybinary || exit /b
-goto :eof
-
-
-
-
:clean
rd /s /q %BUILDDIR% 2>nul
-del /q %VISHAP% 2>nul
+del /q %OBECOMP% 2>nul
goto :eof
@@ -111,7 +105,7 @@ echo. PLATFORM: %PLATFORM%
echo. OS: %OS%
echo. BUILDDIR: %BUILDDIR%
echo. Oberon characteristics:
-echo. INTSIZE: %INTSIZE%
+echo. MODEL: %MODEL%
echo. ADRSIZE: %ADRSIZE%
echo. ALIGNMENT: %ALIGNMENT%
echo. C compiler:
@@ -122,19 +116,21 @@ echo. DATAMODEL: %DATAMODEL%
cd %BUILDDIR%
cl -nologo /Zi -c SYSTEM.c Configuration.c Platform.c Heap.c || exit /b
-cl -nologo /Zi -c Console.c Strings.c Modules.c Files.c || exit /b
+cl -nologo /Zi -c Out.c Strings.c Modules.c Files.c || exit /b
cl -nologo /Zi -c Reals.c Texts.c vt100.c errors.c || exit /b
cl -nologo /Zi -c OPM.c extTools.c OPS.c OPT.c || exit /b
cl -nologo /Zi -c OPC.c OPV.c OPB.c OPP.c || exit /b
-cl -nologo /Zi Vishap.c /Fe%ROOTDIR%\%VISHAP% ^
+cl -nologo /Zi Compiler.c /Fe%ROOTDIR%\%OBECOMP% /link /INCREMENTAL:NO ^
SYSTEM.obj Configuration.obj Platform.obj Heap.obj ^
-Console.obj Strings.obj Modules.obj Files.obj ^
-Reals.obj Texts.obj vt100.obj errors.obj ^
+Out.obj Strings.obj Modules.obj Files.obj ^
+Reals.obj Texts.obj VT100.obj errors.obj ^
OPM.obj extTools.obj OPS.obj OPT.obj ^
OPC.obj OPV.obj OPB.obj OPP.obj || exit /b
-echo.%VISHAP% created.
+copy src\runtime\*.c %BUILDDIR% >nul
+copy src\runtime\*.h %BUILDDIR% >nul
+echo.%OBECOMP% created.
cd %ROOTDIR%
goto :eof
@@ -145,7 +141,11 @@ goto :eof
echo.Populating clean build directory from bootstrap C sources.
mkdir %BUILDDIR% >nul 2>nul
copy bootstrap\%PLATFORM%-%ADRSIZE%%ALIGNMENT%\*.* %BUILDDIR% >nul
+copy bootstrap\*.c %BUILDDIR% >nul
+copy bootstrap\*.h %BUILDDIR% >nul
call :assemble || exit /b
+copy bootstrap\*.c %BUILDDIR% >nul
+copy bootstrap\*.h %BUILDDIR% >nul
goto :eof
@@ -154,40 +154,39 @@ goto :eof
:translate
:: Make sure we have an oberon compiler binary: if we built one earlier we'll use it,
:: otherwise use one of the saved sets of C sources in the bootstrap directory.
-if not exist %VISHAP% call :compilefromsavedsource
+if not exist %OBECOMP% call :compilefromsavedsource
echo.
echo.make translate - translating compiler source:
echo. PLATFORM: %PLATFORM%
-echo. INTSIZE: %INTSIZE%
+echo. MODEL: %MODEL%
echo. ADRSIZE: %ADRSIZE%
echo. ALIGNMENT: %ALIGNMENT%
md %BUILDDIR% 2>nul
cd %BUILDDIR%
-%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../Configuration.Mod || exit /b
-%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/system/Platform%PLATFORM%.Mod || exit /b
-%ROOTDIR%\%VISHAP% -SFsapx -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/system/Heap.Mod || exit /b
-%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/system/Console.Mod || exit /b
-%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/library/v4/Strings.Mod || exit /b
-%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/library/v4/Modules.Mod || exit /b
-%ROOTDIR%\%VISHAP% -SFsx -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/system/Files.Mod || exit /b
-%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/library/v4/Reals.Mod || exit /b
-%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/library/v4/Texts.Mod || exit /b
-%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/library/misc/vt100.Mod || exit /b
-%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/compiler/errors.Mod || exit /b
-%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/compiler/OPM.cmdln.Mod || exit /b
-%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/compiler/extTools.Mod || exit /b
-%ROOTDIR%\%VISHAP% -SFsx -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/compiler/OPS.Mod || exit /b
-%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/compiler/OPT.Mod || exit /b
-%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/compiler/OPC.Mod || exit /b
-%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/compiler/OPV.Mod || exit /b
-%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/compiler/OPB.Mod || exit /b
-%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/compiler/OPP.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Ssm -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/compiler/Vishap.Mod || exit /b
+del *.sym >nul 2>nul
+%ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../Configuration.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/runtime/Platform%PLATFORM%.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -SsfFapx -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/runtime/Heap.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/runtime/Strings.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/runtime/Out.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/runtime/Modules.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -SsfFx -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/runtime/Files.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/runtime/Reals.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/runtime/Texts.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/runtime/VT100.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/compiler/errors.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/compiler/OPM.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/compiler/extTools.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -SsfFx -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/compiler/OPS.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/compiler/OPT.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/compiler/OPC.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/compiler/OPV.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/compiler/OPB.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/compiler/OPP.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ssfm -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/compiler/Compiler.Mod || exit /b
cd %ROOTDIR%
-copy src\system\*.c %BUILDDIR% >nul
-copy src\system\*.h %BUILDDIR% >nul
echo.%BUILDDIR% filled with compiler C source.
goto :eof
@@ -198,10 +197,10 @@ goto :eof
echo.
echo.Making symbol browser
cd %BUILDDIR%
-%ROOTDIR%/%VISHAP% -Sm ../../src/tools/browser/BrowserCmd.Mod
+%ROOTDIR%/%OBECOMP% -fSm ../../src/tools/browser/BrowserCmd.Mod
cl -nologo BrowserCmd.c /Feshowdef.exe ^
- Platform.obj Texts.obj OPT.obj Heap.obj Console.obj SYSTEM.obj OPM.obj OPS.obj OPV.obj ^
- Files.obj Reals.obj Modules.obj vt100.obj errors.obj Configuration.obj Strings.obj ^
+ Platform.obj Texts.obj OPT.obj Heap.obj Out.obj SYSTEM.obj OPM.obj OPS.obj OPV.obj ^
+ Files.obj Reals.obj Modules.obj VT100.obj errors.obj Configuration.obj Strings.obj ^
OPC.obj
cd %ROOTDIR%
goto :eof
@@ -215,19 +214,28 @@ if errorlevel 1 (
echo make install - administrator rights required. Please run under an administrator command prompt.
goto :eof
)
-rmdir /s /q "%INSTALLDIR%" >nul 2>&1
-mkdir "%INSTALLDIR%" >nul 2>&1
-mkdir "%INSTALLDIR%\bin" >nul 2>&1
-mkdir "%INSTALLDIR%\include" >nul 2>&1
-mkdir "%INSTALLDIR%\sym" >nul 2>&1
-mkdir "%INSTALLDIR%\lib" >nul 2>&1
-copy %BUILDDIR%\*.h "%INSTALLDIR%\include" >nul
-copy %BUILDDIR%\*.sym "%INSTALLDIR%\sym" >nul
-copy %VISHAP% "%INSTALLDIR%\bin" >nul
-copy %BUILDDIR%\showdef.exe "%INSTALLDIR%\bin" >nul
-copy %BUILDDIR%\lib%ONAME%.lib "%INSTALLDIR%\lib" >nul
-echo.
-echo.Now add "%INSTALLDIR%\bin" to your path.
+rmdir /s /q "%INSTALLDIR%" >nul 2>&1
+mkdir "%INSTALLDIR%" >nul 2>&1
+
+mkdir "%INSTALLDIR%\bin" >nul 2>&1
+copy %OBECOMP% "%INSTALLDIR%\bin" >nul
+copy %BUILDDIR%\showdef.exe "%INSTALLDIR%\bin" >nul
+
+mkdir "%INSTALLDIR%\2" >nul 2>&1
+mkdir "%INSTALLDIR%\2\include" >nul 2>&1
+mkdir "%INSTALLDIR%\2\sym" >nul 2>&1
+copy %BUILDDIR%\2\*.h "%INSTALLDIR%\2\include" >nul
+copy %BUILDDIR%\2\*.sym "%INSTALLDIR%\2\sym" >nul
+
+mkdir "%INSTALLDIR%\C" >nul 2>&1
+mkdir "%INSTALLDIR%\C\include" >nul 2>&1
+mkdir "%INSTALLDIR%\C\sym" >nul 2>&1
+copy %BUILDDIR%\C\*.h "%INSTALLDIR%\C\include" >nul
+copy %BUILDDIR%\C\*.sym "%INSTALLDIR%\C\sym" >nul
+
+mkdir "%INSTALLDIR%\lib" >nul 2>&1
+copy %BUILDDIR%\2\lib%ONAME%* "%INSTALLDIR%\lib" >nul
+copy %BUILDDIR%\C\lib%ONAME%* "%INSTALLDIR%\lib" >nul
goto :eof
@@ -241,65 +249,93 @@ rmdir /s /q "%INSTALLDIR%" >nul 2>&1
goto :eof
+:showpath
+echo.
+echo Now add %INSTALLDIR%\bin to your path, for example with the command:
+echo PATH %INSTALLDIR%\bin;%%PATH%%
+echo.
+goto :eof
+
+
+:runtime
+echo.
+echo.Making runtime library for -O%MODEL%
+cd %BUILDDIR%\%MODEL%
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/Platform%PLATFORM%.Mod
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/Heap.Mod
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/Modules.Mod
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/Strings.Mod
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/Out.Mod
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/In.Mod
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/VT100.Mod
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/Files.Mod
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/Math.Mod
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/MathL.Mod
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/Reals.Mod
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/Texts.Mod
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/Oberon.Mod
+cd %ROOTDIR%
+goto :eof
:v4
echo.
-echo.Making V4 library
-cd %BUILDDIR%
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/v4/Args.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/v4/Printer.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/v4/Sets.Mod || exit /b
+echo.Making V4 library for -O%MODEL%
+cd %BUILDDIR%\%MODEL%
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/v4/Args.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/v4/Console.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/v4/Printer.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/v4/Sets.Mod || exit /b
cd %ROOTDIR%
goto :eof
:ooc2
-echo.Making ooc2 library
-cd %BUILDDIR%
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc2/ooc2Strings.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc2/ooc2Ascii.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc2/ooc2CharClass.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc2/ooc2ConvTypes.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc2/ooc2IntConv.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc2/ooc2IntStr.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc2/ooc2Real0.Mod || exit /b
+echo.Making ooc2 library for -O%MODEL%
+cd %BUILDDIR%\%MODEL%
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc2/ooc2Strings.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc2/ooc2Ascii.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc2/ooc2CharClass.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc2/ooc2ConvTypes.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc2/ooc2IntConv.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc2/ooc2IntStr.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc2/ooc2Real0.Mod || exit /b
cd %ROOTDIR%
goto :eof
:ooc
-echo.Making ooc library
-cd %BUILDDIR%
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocLowReal.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocLowLReal.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocRealMath.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocOakMath.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocLRealMath.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocLongInts.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocComplexMath.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocLComplexMath.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocAscii.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocCharClass.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocStrings.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocConvTypes.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocLRealConv.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocLRealStr.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocRealConv.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocRealStr.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocIntConv.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocIntStr.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocMsg.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocSysClock.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocTime.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocChannel.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocStrings2.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocRts.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocFilenames.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocTextRider.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocBinaryRider.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocJulianDay.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocFilenames.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocwrapperlibc.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocC%DATAMODEL%.Mod || exit /b
+echo.Making ooc library for -O%MODEL%
+cd %BUILDDIR%\%MODEL%
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocLowReal.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocLowLReal.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocRealMath.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocOakMath.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocLRealMath.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocLongInts.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocComplexMath.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocLComplexMath.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocAscii.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocCharClass.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocStrings.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocConvTypes.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocLRealConv.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocLRealStr.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocRealConv.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocRealStr.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocIntConv.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocIntStr.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocMsg.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocSysClock.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocTime.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocChannel.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocStrings2.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocRts.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocFilenames.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocTextRider.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocBinaryRider.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocJulianDay.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocFilenames.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocwrapperlibc.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ooc/oocC%DATAMODEL%.Mod || exit /b
cd %ROOTDIR%
goto :eof
@@ -308,117 +344,138 @@ echo No X11 support on plain Windows - use cygwin and build with cygwin make.
goto :eof
:ulm
-echo.Making ulm library
-cd %BUILDDIR%
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmObjects.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmPriorities.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmDisciplines.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmServices.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmSys.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmSYSTEM.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmEvents.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmProcess.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmResources.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmForwarders.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmRelatedEvents.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmTypes.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmStreams.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmStrings.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmSysTypes.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmTexts.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmSysConversions.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmErrors.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmSysErrors.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmSysStat.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmASCII.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmSets.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmIO.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmAssertions.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmIndirectDisciplines.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmStreamDisciplines.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmIEEE.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmMC68881.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmReals.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmPrint.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmWrite.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmConstStrings.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmPlotters.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmSysIO.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmLoader.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmNetIO.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmPersistentObjects.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmPersistentDisciplines.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmOperations.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmScales.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmTimes.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmClocks.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmTimers.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmConditions.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmStreamConditions.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmTimeConditions.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmCiphers.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmCipherOps.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmBlockCiphers.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmAsymmetricCiphers.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmConclusions.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmRandomGenerators.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmTCrypt.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmIntOperations.Mod || exit /b
+echo.Making ulm library for -O%MODEL%
+cd %BUILDDIR%\%MODEL%
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmObjects.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmPriorities.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmDisciplines.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmServices.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmSys.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmSYSTEM.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmEvents.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmProcess.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmResources.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmForwarders.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmRelatedEvents.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmTypes.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmStreams.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmStrings.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmSysTypes.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmTexts.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmSysConversions.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmErrors.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmSysErrors.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmSysStat.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmASCII.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmSets.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmIO.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmAssertions.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmIndirectDisciplines.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmStreamDisciplines.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmIEEE.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmMC68881.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmReals.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmPrint.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmWrite.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmConstStrings.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmPlotters.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmSysIO.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmLoader.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmNetIO.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmPersistentObjects.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmPersistentDisciplines.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmOperations.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmScales.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmTimes.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmClocks.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmTimers.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmConditions.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmStreamConditions.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmTimeConditions.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmCiphers.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmCipherOps.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmBlockCiphers.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmAsymmetricCiphers.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmConclusions.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmRandomGenerators.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmTCrypt.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmIntOperations.Mod || exit /b
cd %ROOTDIR%
goto :eof
:pow32
-echo.Making pow32 library
-cd %BUILDDIR%
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/pow/powStrings.Mod || exit /b
+echo.Making pow32 library for -O%MODEL%
+cd %BUILDDIR%\%MODEL%
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/pow/powStrings.Mod || exit /b
cd %ROOTDIR%
goto :eof
:misc
-echo.Making misc library
-cd %BUILDDIR%
-%ROOTDIR%\%VISHAP% -Fs ../../src/system/Oberon.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/misc/crt.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/misc/Listen.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/misc/MersenneTwister.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/misc/MultiArrays.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/misc/MultiArrayRiders.Mod || exit /b
+echo.Making misc library for -O%MODEL%
+cd %BUILDDIR%\%MODEL%
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/misc/crt.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/misc/Listen.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/misc/MersenneTwister.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/misc/MultiArrays.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/misc/MultiArrayRiders.Mod || exit /b
cd %ROOTDIR%
goto :eof
:s3
-echo.Making s3 library
-cd %BUILDDIR%
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethBTrees.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethMD5.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethSets.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethZlib.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethZlibBuffers.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethZlibInflate.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethZlibDeflate.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethZlibReaders.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethZlibWriters.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethZip.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethRandomNumbers.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethGZReaders.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethGZWriters.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethUnicode.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethDates.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethReals.Mod || exit /b
-%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethStrings.Mod || exit /b
+echo.Making s3 library for -O%MODEL%
+cd %BUILDDIR%\%MODEL%
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/s3/ethBTrees.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/s3/ethMD5.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/s3/ethSets.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/s3/ethZlib.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/s3/ethZlibBuffers.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/s3/ethZlibInflate.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/s3/ethZlibDeflate.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/s3/ethZlibReaders.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/s3/ethZlibWriters.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/s3/ethZip.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/s3/ethRandomNumbers.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/s3/ethGZReaders.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/s3/ethGZWriters.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/s3/ethUnicode.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/s3/ethDates.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/s3/ethReals.Mod || exit /b
+%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/s3/ethStrings.Mod || exit /b
cd %ROOTDIR%
goto :eof
-:librarybinary
-echo.
-echo.Making lib%ONAME%
-:: Remove objects that should not be part of the library
-del /q %BUILDDIR%\Vishap.obj
-:: Make static library
-lib -nologo %BUILDDIR%\*.obj -out:%BUILDDIR%\lib%ONAME%.lib || exit /b
+:initlibrary
+rd /s /q %BUILDDIR%\%MODEL% >nul 2>nul
+mkdir %BUILDDIR% >nul 2>nul
+mkdir %BUILDDIR%\%MODEL% >nul 2>nul
+copy src\runtime\*.c %BUILDDIR%\%MODEL% >nul
+copy src\runtime\*.h %BUILDDIR%\%MODEL% >nul
+cd %BUILDDIR%\%MODEL%
+cl -nologo -c SYSTEM.c
+cd %ROOTDIR%
+goto :eof
+
+
+:library
+SET MODEL=2
+call :initlibrary || exit /b
+call :runtime || exit /b
+call :v4 || exit /b
+call :ooc2 || exit /b
+call :ooc || exit /b
+call :ulm || exit /b
+call :pow32 || exit /b
+call :misc || exit /b
+call :s3 || exit /b
+lib -nologo %BUILDDIR%\%MODEL%\*.obj -out:%BUILDDIR%\%MODEL%\lib%ONAME%-O%MODEL%.lib || exit /b
+
+SET MODEL=C
+call :initlibrary || exit /b
+call :runtime || exit /b
+lib -nologo %BUILDDIR%\%MODEL%\*.obj -out:%BUILDDIR%\%MODEL%\lib%ONAME%-O%MODEL%.lib || exit /b
goto :eof
@@ -427,3 +484,4 @@ goto :eof
+
diff --git a/makefile b/makefile
index eee8238a..12924600 100644
--- a/makefile
+++ b/makefile
@@ -1,7 +1,7 @@
# Vishap Oberon master makefile.
#
# Makes sure configuration parameters are up to date and then hands off
-# to src/tools/make/vishap.make.
+# to src/tools/make/oberon.mk.
@@ -85,15 +85,8 @@ usage:
@echo " (Needs root access)"
@echo ""
@echo "Targets for (re)creating and reverting bootstrap C sources:"
- @echo " make bootstrap - Uddate bootstrap C source directories. Always run on 64 bit."
+ @echo " make bootstrap - Update bootstrap C source directories."
@echo " make revertbootstrap - Use git checkout to restore bootstrap C source directories"
- @echo ""
- @echo ""
- @echo "Multi-platform coordinated network build:"
- @echo " make coordinator - Start central task to trigger builds and collect logs"
- @echo " make auto - Start machine specific build server"
- @echo " make autobuild - Trigger all machines running 'make auto' to start a build"
- @echo " make autobuild - Terminate 'make auto' on all machines"
@@ -102,17 +95,25 @@ usage:
FORCE:
configuration: FORCE
- @$(CC) -I src/system -o a.o src/tools/make/configure.c
+ @$(CC) -I src/runtime -o a.o src/tools/make/configure.c
@./a.o
@rm a.o
@echo BRANCH=$$(git rev-parse --abbrev-ref HEAD)>>Configuration.Make
@echo Branch: $$(git rev-parse --abbrev-ref HEAD).
+bootstrapconfiguration: FORCE
+ @$(CC) -I src/runtime -o a.o src/tools/make/configure.c
+ @./a.o bootstrap
+ @rm a.o
+ @echo BRANCH=$$(git rev-parse --abbrev-ref HEAD)>>Configuration.Make
+ @echo Branch: $$(git rev-parse --abbrev-ref HEAD).
+
+
reportsizes: FORCE
- @$(CC) -I src/system -o a.o src/tools/make/configure.c
+ @$(CC) -I src/runtime -o a.o src/tools/make/configure.c
@./a.o report
@rm a.o
@@ -126,102 +127,119 @@ reportsizes: FORCE
# clean - clean out the bulid directory
clean: configuration
- @make -f src/tools/make/vishap.make -s clean
+ @make -f src/tools/make/oberon.mk -s clean
# full: Full build of compiler and libarary.
full: configuration
- @make -f src/tools/make/vishap.make -s installable
- @-make -f src/tools/make/vishap.make -s uninstall
- @make -f src/tools/make/vishap.make -s clean
+ @make -f src/tools/make/oberon.mk -s installable
+ @-make -f src/tools/make/oberon.mk -s uninstall
+ @make -f src/tools/make/oberon.mk -s clean
# Make bootstrap compiler from source suitable for current data model
@printf "\n\n--- Compiler build started ---\n\n"
- @make -f src/tools/make/vishap.make -s compilerfromsavedsource
+ @make -f src/tools/make/oberon.mk -s compilerfromsavedsource MODEL=2
# Use bootstrap compiler to make compiler binary from latest compiler sources
- @make -f src/tools/make/vishap.make -s translate
- @make -f src/tools/make/vishap.make -s assemble
+ @make -f src/tools/make/oberon.mk -s translate MODEL=2
+ @make -f src/tools/make/oberon.mk -s assemble MODEL=2
# Use latest compiler to make compiler binary from latest compiler sources
- @make -f src/tools/make/vishap.make -s translate
- @make -f src/tools/make/vishap.make -s assemble
+ @make -f src/tools/make/oberon.mk -s translate MODEL=2
+ @make -f src/tools/make/oberon.mk -s assemble MODEL=2
@printf "\n\n--- Compiler build successfull ---\n\n"
- @make -f src/tools/make/vishap.make -s browsercmd
+ @make -f src/tools/make/oberon.mk -s browsercmd MODEL=2
@printf "\n\n--- Library build started ---\n\n"
- @make -f src/tools/make/vishap.make -s library
+ @make -f src/tools/make/oberon.mk -s library MODEL=2
+ @make -f src/tools/make/oberon.mk -s library MODEL=C
@printf "\n\n--- Library build successfull ---\n\n"
- @make -f src/tools/make/vishap.make -s sourcechanges
- @make -f src/tools/make/vishap.make -s install
+ @make -f src/tools/make/oberon.mk -s sourcechanges
+ @make -f src/tools/make/oberon.mk -s install
@printf "\n\n--- Confidence tests started ---\n\n"
- @make -f src/tools/make/vishap.make -s confidence
- @make -f src/tools/make/vishap.make -s showpath
+ @make -f src/tools/make/oberon.mk -s confidence MODEL=2
+ @make -f src/tools/make/oberon.mk -s showpath
+assemble:
+ @make -f src/tools/make/oberon.mk -s assemble MODEL=2
+
+
+compilerfromsavedsource:
+ @make -f src/tools/make/oberon.mk -s compilerfromsavedsource
+
# compile: compiler only, without cleaning
compiler: configuration
- @make -f src/tools/make/vishap.make -s translate
- @make -f src/tools/make/vishap.make -s assemble
+ @make -f src/tools/make/oberon.mk -s translate MODEL=2
+ @make -f src/tools/make/oberon.mk -s assemble MODEL=2
# Report changes to compiler source relative to bootstrap compiler
sourcechanges:
- @make -f src/tools/make/vishap.make -s sourcechanges
+ @make -f src/tools/make/oberon.mk -s sourcechanges
# browsercmd: build the 'showdef' command
browsercmd: configuration
- @make -f src/tools/make/vishap.make -s browsercmd
+ @make -f src/tools/make/oberon.mk -s browsercmd MODEL=2
# library: build all directories under src/library
-library: configuration
- @make -f src/tools/make/vishap.make -s library
+O2library: configuration
+ @make -f src/tools/make/oberon.mk -s library MODEL=2
+
+OClibrary: configuration
+ @make -f src/tools/make/oberon.mk -s library MODEL=C
+
+
+
# Individual library components
v4: configuration
- @make -f src/tools/make/vishap.make -s v4
+ @make -f src/tools/make/oberon.mk -s v4 MODEL=2
ooc2: configuration
- @make -f src/tools/make/vishap.make -s ooc2
+ @make -f src/tools/make/oberon.mk -s ooc2 MODEL=2
ooc: configuration
- @make -f src/tools/make/vishap.make -s ooc
+ @make -f src/tools/make/oberon.mk -s ooc MODEL=2
ulm: configuration
- @make -f src/tools/make/vishap.make -s ulm
+ @make -f src/tools/make/oberon.mk -s ulm MODEL=2
pow32: configuration
- @make -f src/tools/make/vishap.make -s pow32
+ @make -f src/tools/make/oberon.mk -s pow32 MODEL=2
misc: configuration
- @make -f src/tools/make/vishap.make -s misc
+ @make -f src/tools/make/oberon.mk -s misc MODEL=2
s3: configuration
- @make -f src/tools/make/vishap.make -s s3
+ @make -f src/tools/make/oberon.mk -s s3 MODEL=2
# install: Copy built files to install directory
install: configuration
- @make -f src/tools/make/vishap.make -s installable
- @make -f src/tools/make/vishap.make -s install
- @make -f src/tools/make/vishap.make -s showpath
+ @make -f src/tools/make/oberon.mk -s installable
+ @make -f src/tools/make/oberon.mk -s install MODEL=2
+ @make -f src/tools/make/oberon.mk -s showpath MODEL=2
uninstall: configuration
- @make -f src/tools/make/vishap.make -s installable
- @make -f src/tools/make/vishap.make -s uninstall
+ @make -f src/tools/make/oberon.mk -s installable
+ @make -f src/tools/make/oberon.mk -s uninstall
# confidence: Run a set of confidence tests
confidence: configuration
- @make -f src/tools/make/vishap.make -s confidence
+ @make -f src/tools/make/oberon.mk -s confidence MODEL=2
+
+planned-binary-change:
+ @date >src/test/confidence/planned-binary-change
@@ -232,18 +250,28 @@ confidence: configuration
# bootstrap: Rebuild the bootstrap directories
# If the bootstrap directories are broken or only partially
# built then run 'make revertbootstrap' first.
-bootstrap: configuration
- @make -f src/tools/make/vishap.make -s clean
- @make -f src/tools/make/vishap.make -s translate
- @make -f src/tools/make/vishap.make -s assemble
+bootstrap: bootstrapconfiguration
+ @make -f src/tools/make/oberon.mk -s clean
+ @make -f src/tools/make/oberon.mk -s translate MODEL=2
+ @make -f src/tools/make/oberon.mk -s assemble MODEL=2
rm -rf bootstrap/*
- make -f src/tools/make/vishap.make -s translate INTSIZE=2 ADRSIZE=4 ALIGNMENT=4 PLATFORM=unix BUILDDIR=bootstrap/unix-44 && rm bootstrap/unix-44/*.sym
- make -f src/tools/make/vishap.make -s translate INTSIZE=2 ADRSIZE=4 ALIGNMENT=8 PLATFORM=unix BUILDDIR=bootstrap/unix-48 && rm bootstrap/unix-48/*.sym
- make -f src/tools/make/vishap.make -s translate INTSIZE=4 ADRSIZE=8 ALIGNMENT=8 PLATFORM=unix BUILDDIR=bootstrap/unix-88 && rm bootstrap/unix-88/*.sym
- make -f src/tools/make/vishap.make -s translate INTSIZE=2 ADRSIZE=4 ALIGNMENT=8 PLATFORM=windows BUILDDIR=bootstrap/windows-48 && rm bootstrap/windows-48/*.sym
- make -f src/tools/make/vishap.make -s translate INTSIZE=4 ADRSIZE=8 ALIGNMENT=8 PLATFORM=windows BUILDDIR=bootstrap/windows-88 && rm bootstrap/windows-88/*.sym
+ make -f src/tools/make/oberon.mk -s translate MODEL=2 INTSIZE=2 ADRSIZE=4 ALIGNMENT=4 PLATFORM=unix BUILDDIR=bootstrap/unix-44 && rm bootstrap/unix-44/*.sym
+ make -f src/tools/make/oberon.mk -s translate MODEL=2 INTSIZE=2 ADRSIZE=4 ALIGNMENT=8 PLATFORM=unix BUILDDIR=bootstrap/unix-48 && rm bootstrap/unix-48/*.sym
+ make -f src/tools/make/oberon.mk -s translate MODEL=2 INTSIZE=4 ADRSIZE=8 ALIGNMENT=8 PLATFORM=unix BUILDDIR=bootstrap/unix-88 && rm bootstrap/unix-88/*.sym
+ make -f src/tools/make/oberon.mk -s translate MODEL=2 INTSIZE=2 ADRSIZE=4 ALIGNMENT=8 PLATFORM=windows BUILDDIR=bootstrap/windows-48 && rm bootstrap/windows-48/*.sym
+ make -f src/tools/make/oberon.mk -s translate MODEL=2 INTSIZE=4 ADRSIZE=8 ALIGNMENT=8 PLATFORM=windows BUILDDIR=bootstrap/windows-88 && rm bootstrap/windows-88/*.sym
+ cp src/runtime/*.[ch] bootstrap
+bootstrapunclean: bootstrapconfiguration
+ rm -rf bootstrap/*
+ make -f src/tools/make/oberon.mk -s translate MODEL=2 INTSIZE=2 ADRSIZE=4 ALIGNMENT=4 PLATFORM=unix BUILDDIR=bootstrap/unix-44 && rm bootstrap/unix-44/*.sym
+ make -f src/tools/make/oberon.mk -s translate MODEL=2 INTSIZE=2 ADRSIZE=4 ALIGNMENT=8 PLATFORM=unix BUILDDIR=bootstrap/unix-48 && rm bootstrap/unix-48/*.sym
+ make -f src/tools/make/oberon.mk -s translate MODEL=2 INTSIZE=4 ADRSIZE=8 ALIGNMENT=8 PLATFORM=unix BUILDDIR=bootstrap/unix-88 && rm bootstrap/unix-88/*.sym
+ make -f src/tools/make/oberon.mk -s translate MODEL=2 INTSIZE=2 ADRSIZE=4 ALIGNMENT=8 PLATFORM=windows BUILDDIR=bootstrap/windows-48 && rm bootstrap/windows-48/*.sym
+ make -f src/tools/make/oberon.mk -s translate MODEL=2 INTSIZE=4 ADRSIZE=8 ALIGNMENT=8 PLATFORM=windows BUILDDIR=bootstrap/windows-88 && rm bootstrap/windows-88/*.sym
+ cp src/runtime/*.[ch] bootstrap
+
revertbootstrap:
@@ -261,10 +289,10 @@ revertbootstrap:
# coordinator: Start the test machine coordinator
coordinator: configuration
- @make -f src/tools/make/vishap.make -s clean
- @make -f src/tools/make/vishap.make -s translate
- @make -f src/tools/make/vishap.make -s assemble
- @make -f src/tools/make/vishap.make -s testtools
+ @make -f src/tools/make/oberon.mk -s clean
+ @make -f src/tools/make/oberon.mk -s translate
+ @make -f src/tools/make/oberon.mk -s assemble
+ @make -f src/tools/make/oberon.mk -s testtools
@rm -f "build/*.log"
cd build && ../testcoordinator.exe
@@ -273,7 +301,7 @@ coordinator: configuration
# auto: machine specific build server
auto: configuration
- @make -f src/tools/make/vishap.make -s auto
+ @make -f src/tools/make/oberon.mk -s auto
diff --git a/src/compiler/Vishap.Mod b/src/compiler/Compiler.Mod
similarity index 56%
rename from src/compiler/Vishap.Mod
rename to src/compiler/Compiler.Mod
index 63cc4260..0a373e7a 100644
--- a/src/compiler/Vishap.Mod
+++ b/src/compiler/Compiler.Mod
@@ -1,20 +1,21 @@
-MODULE Vishap; (* J. Templ 3.2.95 *)
+MODULE Compiler; (* J. Templ 3.2.95 *)
IMPORT
SYSTEM, Heap, Platform, Configuration,
OPP, OPB, OPT,
OPV, OPC, OPM,
- extTools, Strings, vt100;
+ extTools, Strings, VT100;
- VAR mname : ARRAY 256 OF CHAR; (* noch *)
+ VAR mname: ARRAY 256 OF CHAR; (* noch *)
PROCEDURE Module*(VAR done: BOOLEAN);
VAR ext, new: BOOLEAN; p: OPT.Node;
BEGIN
- OPP.Module(p, OPM.opt);
+ OPP.Module(p, OPM.Options);
IF OPM.noerr THEN
OPV.Init;
+ OPT.InitRecno;
OPV.AdrAndSize(OPT.topScope);
OPT.Export(ext, new);
IF OPM.noerr THEN
@@ -22,16 +23,12 @@ MODULE Vishap; (* J. Templ 3.2.95 *)
OPC.Init;
OPV.Module(p);
IF OPM.noerr THEN
- IF (OPM.mainProg OR OPM.mainLinkStat) & (OPM.modName # "SYSTEM") THEN
+ IF (OPM.mainprog IN OPM.Options) & (OPM.modName # "SYSTEM") THEN
OPM.DeleteNewSym;
- IF ~OPM.notColorOutput THEN vt100.SetAttr(vt100.Green) END;
- OPM.LogWStr(" Main program.");
- IF ~OPM.notColorOutput THEN vt100.SetAttr(vt100.ResetAll) END;
+ OPM.LogVT100(VT100.Green); OPM.LogWStr(" Main program."); OPM.LogVT100(VT100.ResetAll);
ELSE
IF new THEN
- IF ~OPM.notColorOutput THEN vt100.SetAttr(vt100.Green) END;
- OPM.LogWStr(" New symbol file.");
- IF ~OPM.notColorOutput THEN vt100.SetAttr(vt100.ResetAll) END;
+ OPM.LogVT100(VT100.Green); OPM.LogWStr(" New symbol file."); OPM.LogVT100(VT100.ResetAll);
OPM.RegisterNewSym
ELSIF ext THEN
OPM.LogWStr(" Extended symbol file.");
@@ -50,17 +47,39 @@ MODULE Vishap; (* J. Templ 3.2.95 *)
PROCEDURE PropagateElementaryTypeSizes;
+ VAR adrinttyp: OPT.Struct;
BEGIN
- OPT.bytetyp.size := OPM.ByteSize;
- OPT.sysptrtyp.size := OPM.PointerSize;
- OPT.chartyp.size := OPM.CharSize;
- OPT.settyp.size := OPM.SetSize;
- OPT.realtyp.size := OPM.RealSize;
- OPT.inttyp.size := OPM.IntSize;
- OPT.linttyp.size := OPM.LIntSize;
- OPT.lrltyp.size := OPM.LRealSize;
- OPT.sinttyp.size := OPM.SIntSize;
- OPT.booltyp.size := OPM.BoolSize;
+ OPT.sysptrtyp.size := OPM.AddressSize;
+ OPT.sysptrtyp.idfp := OPT.sysptrtyp.form;
+ OPM.FPrint(OPT.sysptrtyp.idfp, OPT.sysptrtyp.size);
+
+ OPT.adrtyp.size := OPM.AddressSize;
+ OPT.adrtyp.idfp := OPT.adrtyp.form;
+ OPM.FPrint(OPT.adrtyp.idfp, OPT.adrtyp.size);
+
+ adrinttyp := OPT.IntType(OPM.AddressSize);
+ OPT.adrtyp.strobj := adrinttyp.strobj;
+
+ OPT.sinttyp := OPT.IntType(OPM.ShortintSize);
+ OPT.inttyp := OPT.IntType(OPM.IntegerSize);
+ OPT.linttyp := OPT.IntType(OPM.LongintSize);
+
+ OPT.sintobj.typ := OPT.sinttyp;
+ OPT.intobj.typ := OPT.inttyp;
+ OPT.lintobj.typ := OPT.linttyp;
+
+ CASE OPM.LongintSize OF
+ |4: OPT.settyp := OPT.set32typ
+ ELSE OPT.settyp := OPT.set64typ
+ END;
+ OPT.setobj.typ := OPT.settyp;
+
+ (* Enable or disable (non-system) BYTE type *)
+ IF OPM.Model = "C" THEN
+ OPT.cpbytetyp.strobj.name[4] := 0X (* Enable Component Pascal non-system BYTE type *)
+ ELSE
+ OPT.cpbytetyp.strobj.name[4] := '@' (* Disable Component Pascal non-system BYTE type *)
+ END
END PropagateElementaryTypeSizes;
@@ -89,20 +108,20 @@ MODULE Vishap; (* J. Templ 3.2.95 *)
END;
(* 'assemble' (i.e. c compile) .c to object or executable. *)
- IF ~OPM.dontAsm THEN
- IF OPM.dontLink THEN
+ IF ~(OPM.dontasm IN OPM.Options) THEN
+ IF OPM.dontlink IN OPM.Options THEN
(* If not linking, just assemble each module. *)
extTools.Assemble(OPM.modName)
ELSE
- IF ~(OPM.mainProg OR OPM.mainLinkStat) THEN
- (* Assemble non main rogram and add object name to link list *)
+ IF ~(OPM.mainprog IN OPM.Options) THEN
+ (* Assemble non main program and add object name to link list *)
extTools.Assemble(OPM.modName);
Strings.Append(" ", modulesobj);
Strings.Append(OPM.modName, modulesobj);
Strings.Append(Configuration.objext, modulesobj)
ELSE
(* Assemble and link main program *)
- extTools.LinkMain (OPM.modName, OPM.mainLinkStat, modulesobj)
+ extTools.LinkMain(OPM.modName, OPM.mainlinkstat IN OPM.Options, modulesobj)
END
END
END
@@ -110,15 +129,14 @@ MODULE Vishap; (* J. Templ 3.2.95 *)
END
END Translate;
- PROCEDURE Trap(sig: INTEGER);
+ PROCEDURE Trap(sig: SYSTEM.INT32);
BEGIN
Heap.FINALL();
IF sig = 3 THEN
Platform.Exit(0)
ELSE
- IF (sig = 4) & (Platform.HaltCode = -15) THEN
- OPM.LogWStr(" --- Vishap Oberon: internal error");
- OPM.LogWLn
+ IF sig = 4 THEN
+ OPM.LogWStr(" --- Oberon compiler internal error"); OPM.LogWLn
END ;
Platform.Exit(2)
END
@@ -128,5 +146,5 @@ BEGIN
Platform.SetInterruptHandler(Trap);
Platform.SetQuitHandler(Trap);
Platform.SetBadInstructionHandler(Trap);
- OPB.typSize := OPV.TypSize; OPT.typSize := OPV.TypSize; Translate
-END Vishap.
+ Translate
+END Compiler.
diff --git a/src/compiler/OPB.Mod b/src/compiler/OPB.Mod
index 6da12c5e..91576fd3 100644
--- a/src/compiler/OPB.Mod
+++ b/src/compiler/OPB.Mod
@@ -9,9 +9,8 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
VAR
- typSize*: PROCEDURE(typ: OPT.Struct);
- exp: INTEGER; (*side effect of log*)
- maxExp: LONGINT; (* max n in ASH(1, n) on this machine *)
+ exp: INTEGER; (* side effect of log*)
+ maxExp: SYSTEM.INT64; (* max n in ASH(1, n) on this machine *)
PROCEDURE err(n: INTEGER);
@@ -52,14 +51,13 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
last := y
END Link;
- PROCEDURE BoolToInt(b: BOOLEAN): LONGINT;
+ PROCEDURE BoolToInt(b: BOOLEAN): INTEGER;
BEGIN
IF b THEN RETURN 1 ELSE RETURN 0 END
END BoolToInt;
- PROCEDURE IntToBool(i: LONGINT): BOOLEAN;
- BEGIN
- IF i = 0 THEN RETURN FALSE ELSE RETURN TRUE END
+ PROCEDURE IntToBool(i: SYSTEM.INT64): BOOLEAN;
+ BEGIN RETURN i # 0
END IntToBool;
PROCEDURE NewBoolConst*(boolval: BOOLEAN): OPT.Node;
@@ -105,44 +103,17 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
x^.conval := OPT.NewConst(); x^.conval^.setval := {}; RETURN x
END EmptySet;
-
- (* Integer size support *)
-
- PROCEDURE SignedByteSize(n: LONGINT): INTEGER;
- (* Returns number of bytes required to represent signed value n *)
- VAR b: INTEGER;
- BEGIN
- IF n < 0 THEN n := -(n+1) END; (* Positive value in the range 0 - 7F.. *)
- b := 1; WHILE (b < 8) & (ASH(n, -(8*b-1)) # 0) DO INC(b) END;
- RETURN b
- END SignedByteSize;
-
- PROCEDURE ShorterSize(i: LONGINT): LONGINT;
- BEGIN IF i >= OPM.LIntSize THEN RETURN OPM.IntSize ELSE RETURN OPM.SIntSize END
- END ShorterSize;
-
- PROCEDURE LongerSize(i: LONGINT): LONGINT;
- BEGIN IF i <= OPM.SIntSize THEN RETURN OPM.IntSize ELSE RETURN OPM.LIntSize END
- END LongerSize;
-
- PROCEDURE IntType(size: LONGINT): OPT.Struct;
- (* Selects smallest standard integer type for given size in bytes *)
- VAR result: OPT.Struct;
- BEGIN
- IF size <= OPT.sinttyp.size THEN result := OPT.sinttyp
- ELSIF size <= OPT.inttyp.size THEN result := OPT.inttyp
- ELSE
- result := OPT.linttyp
- END;
- IF size > OPT.linttyp.size THEN err(203) END; (* Number too large *)
- RETURN result
- END IntType;
-
PROCEDURE SetIntType(node: OPT.Node);
- BEGIN node.typ := IntType(SignedByteSize(node.conval.intval))
+ BEGIN node.typ := OPT.IntType(OPT.IntSize(node.conval.intval))
END SetIntType;
- PROCEDURE NewIntConst*(intval: LONGINT): OPT.Node;
+ PROCEDURE SetSetType(node: OPT.Node);
+ VAR i32: SYSTEM.INT32;
+ BEGIN SYSTEM.GET(SYSTEM.ADR(node.conval.setval)+4, i32); (* See if upper 32 bits are zero *)
+ IF i32 = 0 THEN node.typ := OPT.set32typ ELSE node.typ := OPT.set64typ END
+ END SetSetType;
+
+ PROCEDURE NewIntConst*(intval: SYSTEM.INT64): OPT.Node;
VAR x: OPT.Node;
BEGIN
x := OPT.NewNode(OPT.Nconst); x^.conval := OPT.NewConst();
@@ -157,11 +128,11 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
RETURN x
END NewRealConst;
- PROCEDURE NewString*(VAR str: OPS.String; len: LONGINT): OPT.Node;
+ PROCEDURE NewString*(VAR str: OPS.String; len: SYSTEM.INT64): OPT.Node;
VAR x: OPT.Node;
BEGIN
x := OPT.NewNode(OPT.Nconst); x^.conval := OPT.NewConst(); x^.typ := OPT.stringtyp;
- x^.conval^.intval := OPM.ConstNotAlloc; x^.conval^.intval2 := len;
+ x^.conval^.intval := OPM.ConstNotAlloc; x^.conval^.intval2 := OPM.Longint(len);
x^.conval^.ext := OPT.NewExt(); x^.conval^.ext^ := str;
RETURN x
END NewString;
@@ -206,7 +177,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
BEGIN
f := y^.typ^.form;
IF x^.class >= OPT.Nconst THEN err(79)
- ELSIF ~(f IN OPT.intSet) OR (y^.class IN {OPT.Nproc, OPT.Ntype}) THEN err(80); y^.typ := OPT.inttyp END ;
+ ELSIF (f # OPT.Int) OR (y^.class IN {OPT.Nproc, OPT.Ntype}) THEN err(80); y^.typ := OPT.inttyp END ;
IF x^.typ^.comp = OPT.Array THEN typ := x^.typ^.BaseTyp;
IF (y^.class = OPT.Nconst) & ((y^.conval^.intval < 0) OR (y^.conval^.intval >= x^.typ^.n)) THEN err(81) END
ELSIF x^.typ^.comp = OPT.DynArr THEN typ := x^.typ^.BaseTyp;
@@ -266,13 +237,13 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END TypTest;
PROCEDURE In*(VAR x: OPT.Node; y: OPT.Node);
- VAR f: INTEGER; k: LONGINT;
+ VAR f: INTEGER; k: SYSTEM.INT64;
BEGIN f := x^.typ^.form;
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) OR (y^.class = OPT.Ntype) OR (y^.class = OPT.Nproc) THEN err(126)
- ELSIF (f IN OPT.intSet) & (y^.typ^.form = OPT.Set) THEN
+ ELSIF (f = OPT.Int) & (y^.typ^.form = OPT.Set) THEN
IF x^.class = OPT.Nconst THEN
k := x^.conval^.intval;
- IF (k < 0) OR (k > OPM.MaxSet) THEN err(202)
+ IF (k < 0) OR (k >= y.typ.size*8) THEN err(202)
ELSIF y^.class = OPT.Nconst THEN x^.conval^.intval := BoolToInt(k IN y^.conval^.setval); x^.obj := NIL
ELSE BindNodes(OPT.Ndop, OPT.booltyp, x, y); x^.subcl := OPS.in
END
@@ -283,7 +254,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
x^.typ := OPT.booltyp
END In;
- PROCEDURE log(x: LONGINT): LONGINT;
+ PROCEDURE log(x: SYSTEM.INT64): SYSTEM.INT64;
BEGIN exp := 0;
IF x > 0 THEN
WHILE ~ODD(x) DO x := x DIV 2; INC(exp) END
@@ -326,25 +297,30 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END
ELSE err(98)
END
- |OPS.plus: IF ~(f IN OPT.intSet + OPT.realSet) THEN err(96) END
- |OPS.minus: IF f IN OPT.intSet + OPT.realSet +{OPT.Set}THEN
+ |OPS.plus: IF ~(f IN {OPT.Int} + OPT.realSet) THEN err(96) END
+ |OPS.minus: IF f IN {OPT.Int, OPT.Set} + OPT.realSet THEN
IF z^.class = OPT.Nconst THEN
- IF f IN OPT.intSet THEN
- IF z^.conval^.intval = MIN(LONGINT) THEN err(203)
+ IF f = OPT.Int THEN
+ IF z^.conval^.intval = MIN(SYSTEM.INT64) THEN err(203)
ELSE z^.conval^.intval := -z^.conval^.intval; SetIntType(z)
END
ELSIF f IN OPT.realSet THEN z^.conval^.realval := -z^.conval^.realval
- ELSE z^.conval^.setval := -z^.conval^.setval
- END ;
+ ELSE
+ IF z.typ.size = 8 THEN
+ z^.conval^.setval := -z^.conval^.setval
+ ELSE
+ z.conval.setval := z.conval.setval / {0..31}
+ END
+ END;
z^.obj := NIL
ELSE z := NewOp(op, typ, z)
END
ELSE err(97)
END
- |OPT.abs: IF f IN OPT.intSet + OPT.realSet THEN
+ |OPT.abs: IF f IN {OPT.Int} + OPT.realSet THEN
IF z^.class = OPT.Nconst THEN
- IF f IN OPT.intSet THEN
- IF z^.conval^.intval = MIN(LONGINT) THEN err(203)
+ IF f = OPT.Int THEN
+ IF z^.conval^.intval = MIN(SYSTEM.INT64) THEN err(203)
ELSE z^.conval^.intval := ABS(z^.conval^.intval); SetIntType(z)
END
ELSE z^.conval^.realval := ABS(z^.conval^.realval)
@@ -361,7 +337,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END
ELSE err(111); z^.typ := OPT.chartyp
END
- |OPT.odd: IF f IN OPT.intSet THEN
+ |OPT.odd: IF f = OPT.Int THEN
IF z^.class = OPT.Nconst THEN
z^.conval^.intval := BoolToInt(ODD(z^.conval^.intval)); z^.obj := NIL
ELSE z := NewOp(op, typ, z)
@@ -375,8 +351,8 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
IF (z^.class < OPT.Nconst) OR (f = OPT.String) THEN z := NewOp(op, typ, z)
ELSE err(127)
END ;
- z^.typ := OPT.linttyp
- |OPT.cc: IF (f IN OPT.intSet) & (z^.class = OPT.Nconst) THEN (*SYSTEM.CC*)
+ z^.typ := OPT.adrtyp
+ |OPT.cc: IF (f = OPT.Int) & (z^.class = OPT.Nconst) THEN (*SYSTEM.CC*)
IF (0 <= z^.conval^.intval) & (z^.conval^.intval <= OPM.MaxCC) THEN z := NewOp(op, typ, z) ELSE err(219) END
ELSE err(69)
END ;
@@ -444,7 +420,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END CheckProc;
PROCEDURE ConstOp(op: INTEGER; x, y: OPT.Node);
- VAR f, g: INTEGER; xval, yval: OPT.Const; xv, yv: LONGINT;
+ VAR f, g: INTEGER; xval, yval: OPT.Const; xv, yv: SYSTEM.INT64;
temp: BOOLEAN; (* temp avoids err 215 *)
PROCEDURE ConstCmp(): INTEGER;
@@ -454,7 +430,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
|OPT.Undef: res := OPS.eql
|OPT.Byte,
OPT.Char
- ..OPT.LInt: IF xval^.intval < yval^.intval THEN res := OPS.lss
+ ..OPT.Int: IF xval^.intval < yval^.intval THEN res := OPS.lss
ELSIF xval^.intval > yval^.intval THEN res := OPS.gtr
ELSE res := OPS.eql
END
@@ -491,19 +467,17 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
|OPT.Char: IF g = OPT.String THEN CharToString(x)
ELSE err(100); y^.typ := x^.typ; yval^ := xval^
END ;
- |OPT.SInt,
- OPT.Int,
- OPT.LInt: IF g IN OPT.intSet THEN
- IF x.typ.size <= y.typ.size THEN x.typ := y.typ ELSE x.typ := IntType(x.typ.size) END
+ |OPT.Int: IF g = OPT.Int THEN
+ IF x.typ.size <= y.typ.size THEN x.typ := y.typ ELSE x.typ := OPT.IntType(x.typ.size) END
ELSIF g = OPT.Real THEN x^.typ := OPT.realtyp; xval^.realval := xval^.intval
ELSIF g = OPT.LReal THEN x^.typ := OPT.lrltyp; xval^.realval := xval^.intval
ELSE err(100); y^.typ := x^.typ; yval^ := xval^
END
- |OPT.Real: IF g IN OPT.intSet THEN y^.typ := x^.typ; yval^.realval := yval^.intval
+ |OPT.Real: IF g = OPT.Int THEN y^.typ := x^.typ; yval^.realval := yval^.intval
ELSIF g = OPT.LReal THEN x^.typ := OPT.lrltyp
ELSE err(100); y^.typ := x^.typ; yval^ := xval^
END
- |OPT.LReal: IF g IN OPT.intSet THEN y^.typ := x^.typ; yval^.realval := yval^.intval
+ |OPT.LReal: IF g = OPT.Int THEN y^.typ := x^.typ; yval^.realval := yval^.intval
ELSIF g = OPT.Real THEN y^.typ := OPT.lrltyp
ELSE err(100); y^.typ := x^.typ; yval^ := xval^
END
@@ -518,12 +492,12 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
f := x^.typ^.form
END ; (* {x^.typ = y^.typ} *)
CASE op OF
- |OPS.times: IF f IN OPT.intSet THEN xv := xval^.intval; yv := yval^.intval;
+ |OPS.times: IF f = OPT.Int THEN xv := xval^.intval; yv := yval^.intval;
IF (xv = 0) OR (yv = 0) OR (* division with negative numbers is not defined *)
- (xv > 0) & (yv > 0) & (yv <= MAX(LONGINT) DIV xv) OR
- (xv > 0) & (yv < 0) & (yv >= MIN(LONGINT) DIV xv) OR
- (xv < 0) & (yv > 0) & (xv >= MIN(LONGINT) DIV yv) OR
- (xv < 0) & (yv < 0) & (xv # MIN(LONGINT)) & (yv # MIN(LONGINT)) & (-xv <= MAX(LONGINT) DIV (-yv)) THEN
+ (xv > 0) & (yv > 0) & (yv <= MAX(SYSTEM.INT64) DIV xv) OR
+ (xv > 0) & (yv < 0) & (yv >= MIN(SYSTEM.INT64) DIV xv) OR
+ (xv < 0) & (yv > 0) & (xv >= MIN(SYSTEM.INT64) DIV yv) OR
+ (xv < 0) & (yv < 0) & (xv # MIN(SYSTEM.INT64)) & (yv # MIN(SYSTEM.INT64)) & (-xv <= MAX(SYSTEM.INT64) DIV (-yv)) THEN
xval^.intval := xv * yv; SetIntType(x)
ELSE err(204)
END
@@ -534,10 +508,10 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
ELSE err(204)
END
ELSIF f = OPT.Set THEN
- xval^.setval := xval^.setval * yval^.setval
+ xval^.setval := xval^.setval * yval^.setval; SetSetType(x)
ELSIF f # OPT.Undef THEN err(101)
END
- |OPS.slash: IF f IN OPT.intSet THEN
+ |OPS.slash: IF f = OPT.Int THEN
IF yval^.intval # 0 THEN
xval^.realval := xval^.intval / yval^.intval; CheckRealType(OPT.Real, 205, xval)
ELSE err(205); xval^.realval := 1.0
@@ -550,17 +524,17 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
ELSE err(205)
END
ELSIF f = OPT.Set THEN
- xval^.setval := xval^.setval / yval^.setval
+ xval^.setval := xval^.setval / yval^.setval; SetSetType(x)
ELSIF f # OPT.Undef THEN err(102)
END
- |OPS.div: IF f IN OPT.intSet THEN
+ |OPS.div: IF f = OPT.Int THEN
IF yval^.intval # 0 THEN
xval^.intval := xval^.intval DIV yval^.intval; SetIntType(x)
ELSE err(205)
END
ELSIF f # OPT.Undef THEN err(103)
END
- |OPS.mod: IF f IN OPT.intSet THEN
+ |OPS.mod: IF f = OPT.Int THEN
IF yval^.intval # 0 THEN
xval^.intval := xval^.intval MOD yval^.intval; SetIntType(x)
ELSE err(205)
@@ -571,9 +545,9 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
xval^.intval := BoolToInt(IntToBool(xval^.intval) & IntToBool(yval^.intval))
ELSE err(94)
END
- |OPS.plus: IF f IN OPT.intSet THEN
- temp := (yval^.intval >= 0) & (xval^.intval <= MAX(LONGINT) - yval^.intval);
- IF temp OR (yval^.intval < 0) & (xval^.intval >= MIN(LONGINT) - yval^.intval) THEN
+ |OPS.plus: IF f = OPT.Int THEN
+ temp := (yval^.intval >= 0) & (xval^.intval <= MAX(SYSTEM.INT64) - yval^.intval);
+ IF temp OR (yval^.intval < 0) & (xval^.intval >= MIN(SYSTEM.INT64) - yval^.intval) THEN
INC(xval^.intval, yval^.intval); SetIntType(x)
ELSE err(206)
END
@@ -584,12 +558,12 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
ELSE err(206)
END
ELSIF f = OPT.Set THEN
- xval^.setval := xval^.setval + yval^.setval
+ xval^.setval := xval^.setval + yval^.setval; SetSetType(x)
ELSIF f # OPT.Undef THEN err(105)
END
- |OPS.minus: IF f IN OPT.intSet THEN
- IF (yval^.intval >= 0) & (xval^.intval >= MIN(LONGINT) + yval^.intval) OR
- (yval^.intval < 0) & (xval^.intval <= MAX(LONGINT) + yval^.intval) THEN
+ |OPS.minus: IF f = OPT.Int THEN
+ IF (yval^.intval >= 0) & (xval^.intval >= MIN(SYSTEM.INT64) + yval^.intval) OR
+ (yval^.intval < 0) & (xval^.intval <= MAX(SYSTEM.INT64) + yval^.intval) THEN
DEC(xval^.intval, yval^.intval); SetIntType(x)
ELSE err(207)
END
@@ -600,7 +574,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
ELSE err(207)
END
ELSIF f = OPT.Set THEN
- xval^.setval := xval^.setval - yval^.setval
+ xval^.setval := xval^.setval - yval^.setval; SetSetType(x)
ELSIF f # OPT.Undef THEN err(106)
END
|OPS.or: IF f = OPT.Bool THEN
@@ -626,14 +600,17 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END
END ConstOp;
- PROCEDURE Convert(VAR x: OPT.Node; typ: OPT.Struct);
- VAR node: OPT.Node; f, g: INTEGER; k: LONGINT; r: LONGREAL;
- BEGIN f := x^.typ^.form; g := typ^.form;
+ PROCEDURE Convert(VAR x: OPT.Node; typ: OPT.Struct); (* Convert node x to new type typ *)
+ VAR node: OPT.Node; f, g: INTEGER; k: SYSTEM.INT64; r: LONGREAL;
+ BEGIN f := x^.typ^.form; g := typ^.form; (* f: old form, g: new form *)
IF x^.class = OPT.Nconst THEN
- IF f IN OPT.intSet THEN
- IF g IN OPT.intSet THEN
- IF f > g THEN SetIntType(x);
- IF x^.typ^.form > g THEN err(203); x^.conval^.intval := 1 END
+ IF (f = OPT.Set) & (g = OPT.Set) & (x.typ.size > typ.size) THEN
+ SetSetType(x);
+ IF x.typ.size > typ.size THEN err(203); x^.conval^.setval := {} END
+ ELSIF f = OPT.Int THEN
+ IF g = OPT.Int THEN
+ IF x.typ.size > typ.size THEN SetIntType(x);
+ IF x.typ.size > typ.size THEN err(203); x^.conval^.intval := 1 END
END
ELSIF g IN OPT.realSet THEN x^.conval^.realval := x^.conval^.intval; x^.conval^.intval := OPM.ConstNotAlloc
ELSE (*g = OPT.Char*) k := x^.conval^.intval;
@@ -641,9 +618,9 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END
ELSIF f IN OPT.realSet THEN
IF g IN OPT.realSet THEN CheckRealType(g, 203, x^.conval)
- ELSE (*g = OPT.LInt*)
+ ELSE (* g = OPT.Int *)
r := x^.conval^.realval;
- IF (r < MIN(LONGINT)) OR (r > MAX(LONGINT)) THEN err(203); r := 1 END ;
+ IF (r < MIN(SYSTEM.INT64)) OR (r > MAX(SYSTEM.INT64)) THEN err(203); r := 1 END ;
x^.conval^.intval := ENTIER(r); SetIntType(x)
END
ELSE (* (f IN {OPT.Char, OPT.Byte}) & (g IN {OPT.Byte} + OPT.intSet) OR (f = OPT.Undef) *)
@@ -658,7 +635,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END Convert;
PROCEDURE Op*(op: SHORTINT; VAR x: OPT.Node; y: OPT.Node);
- VAR f, g: INTEGER; t, z: OPT.Node; typ: OPT.Struct; do: BOOLEAN; val: LONGINT;
+ VAR f, g: INTEGER; t, z: OPT.Node; typ: OPT.Struct; do: BOOLEAN; val: SYSTEM.INT64;
PROCEDURE NewOp(op: SHORTINT; typ: OPT.Struct; VAR x: OPT.Node; y: OPT.Node);
VAR node: OPT.Node;
@@ -696,17 +673,19 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
g := y^.typ^.form;
CASE z^.typ^.form OF
|OPT.Char: IF z^.class = OPT.Nconst THEN CharToString(z) ELSE err(100) END
- |OPT.SInt,
- OPT.Int,
- OPT.LInt: IF (g IN OPT.intSet) & (y.typ.size < z.typ.size) THEN Convert(y, z.typ)
- ELSIF g IN OPT.intSet + OPT.realSet THEN Convert(z, y.typ)
+ |OPT.Int: IF (g = OPT.Int) & (y.typ.size < z.typ.size) THEN Convert(y, z.typ)
+ ELSIF g IN {OPT.Int} + OPT.realSet THEN Convert(z, y.typ)
ELSE err(100)
END
- |OPT.Real: IF g IN OPT.intSet THEN Convert(y, z^.typ)
+ |OPT.Set: IF (g = OPT.Set) & (y.typ.size < z.typ.size) THEN Convert(y, z.typ)
+ ELSIF (g = OPT.Set) THEN Convert(z, y.typ)
+ ELSE err(100)
+ END
+ |OPT.Real: IF g = OPT.Int THEN Convert(y, z^.typ)
ELSIF g IN OPT.realSet THEN Convert(z, y^.typ)
ELSE err(100)
END
- |OPT.LReal: IF g IN OPT.intSet + OPT.realSet THEN Convert(y, z^.typ)
+ |OPT.LReal: IF g IN {OPT.Int} + OPT.realSet THEN Convert(y, z^.typ)
ELSIF g IN OPT.realSet THEN Convert(y, z^.typ) (* DCWB: Surely this line does nothing. *)
ELSE err(100)
END
@@ -721,7 +700,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
typ := z^.typ; f := typ^.form; g := y^.typ^.form;
CASE op OF
|OPS.times: do := TRUE;
- IF f IN OPT.intSet THEN
+ IF f = OPT.Int THEN
IF z^.class = OPT.Nconst THEN val := z^.conval^.intval;
IF val = 1 THEN do := FALSE; z := y
ELSIF val = 0 THEN do := FALSE
@@ -739,7 +718,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
ELSIF ~(f IN {OPT.Undef, OPT.Real..OPT.Set}) THEN err(105); typ := OPT.undftyp
END ;
IF do THEN NewOp(op, typ, z, y) END
- |OPS.slash: IF f IN OPT.intSet THEN
+ |OPS.slash: IF f = OPT.Int THEN
IF (y^.class = OPT.Nconst) & (y^.conval^.intval = 0) THEN err(205) END ;
Convert(z, OPT.realtyp); Convert(y, OPT.realtyp);
typ := OPT.realtyp
@@ -749,7 +728,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END ;
NewOp(op, typ, z, y)
|OPS.div: do := TRUE;
- IF f IN OPT.intSet THEN
+ IF f = OPT.Int THEN
IF y^.class = OPT.Nconst THEN val := y^.conval^.intval;
IF val = 0 THEN err(205)
ELSIF val = 1 THEN do := FALSE
@@ -760,7 +739,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
ELSIF f # OPT.Undef THEN err(103); typ := OPT.undftyp
END ;
IF do THEN NewOp(op, typ, z, y) END
- |OPS.mod: IF f IN OPT.intSet THEN
+ |OPS.mod: IF f = OPT.Int THEN
IF y^.class = OPT.Nconst THEN
IF y^.conval^.intval = 0 THEN err(205)
ELSIF log(y^.conval^.intval) = 1 THEN
@@ -780,15 +759,15 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END
ELSIF f # OPT.Undef THEN err(94); z^.typ := OPT.undftyp
END
- |OPS.plus: IF ~(f IN {OPT.Undef, OPT.SInt..OPT.Set}) THEN err(105); typ := OPT.undftyp END ;
+ |OPS.plus: IF ~(f IN {OPT.Undef, OPT.Int..OPT.Set}) THEN err(105); typ := OPT.undftyp END ;
do := TRUE;
- IF f IN OPT.intSet THEN
+ IF f = OPT.Int THEN
IF (z^.class = OPT.Nconst) & (z^.conval^.intval = 0) THEN do := FALSE; z := y END ;
IF (y^.class = OPT.Nconst) & (y^.conval^.intval = 0) THEN do := FALSE END
END ;
IF do THEN NewOp(op, typ, z, y) END
- |OPS.minus: IF ~(f IN {OPT.Undef, OPT.SInt..OPT.Set}) THEN err(106); typ := OPT.undftyp END ;
- IF ~(f IN OPT.intSet) OR (y^.class # OPT.Nconst) OR (y^.conval^.intval # 0) THEN NewOp(op, typ, z, y) END
+ |OPS.minus: IF ~(f IN {OPT.Undef, OPT.Int..OPT.Set}) THEN err(106); typ := OPT.undftyp END ;
+ IF (f # OPT.Int) OR (y^.class # OPT.Nconst) OR (y^.conval^.intval # 0) THEN NewOp(op, typ, z, y) END
|OPS.or: IF f = OPT.Bool THEN
IF z^.class = OPT.Nconst THEN
IF ~IntToBool(z^.conval^.intval) THEN z := y END
@@ -820,21 +799,21 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END Op;
PROCEDURE SetRange*(VAR x: OPT.Node; y: OPT.Node);
- VAR k, l: LONGINT;
+ VAR k, l: SYSTEM.INT64;
BEGIN
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) OR (y^.class = OPT.Ntype) OR (y^.class = OPT.Nproc) THEN err(126)
- ELSIF (x^.typ^.form IN OPT.intSet) & (y^.typ^.form IN OPT.intSet) THEN
+ ELSIF (x^.typ^.form = OPT.Int) & (y^.typ^.form = OPT.Int) THEN
IF x^.class = OPT.Nconst THEN
k := x^.conval^.intval;
- IF (0 > k) OR (k > OPM.MaxSet) THEN err(202) END
+ IF (0 > k) OR (k > MAX(SYSTEM.SET64)) THEN err(202) END
END ;
IF y^.class = OPT.Nconst THEN
l := y^.conval^.intval;
- IF (0 > l) OR (l > OPM.MaxSet) THEN err(202) END
+ IF (0 > l) OR (l > MAX(SYSTEM.SET64)) THEN err(202) END
END ;
IF (x^.class = OPT.Nconst) & (y^.class = OPT.Nconst) THEN
IF k <= l THEN
- x^.conval^.setval := {k..l}
+ x^.conval^.setval := {k..l}; SetSetType(x)
ELSE err(201); x^.conval^.setval := {l..k}
END ;
x^.obj := NIL
@@ -842,23 +821,24 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END
ELSE err(93)
END ;
- x^.typ := OPT.settyp
+ x^.typ := OPT.settyp (* todo: syntax for specifying set type e.g. SYSTEM.SET64{n1..n2} *)
END SetRange;
PROCEDURE SetElem*(VAR x: OPT.Node);
- VAR k: LONGINT;
+ VAR k: SYSTEM.INT64;
BEGIN
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126)
- ELSIF ~(x^.typ^.form IN OPT.intSet) THEN err(93)
+ ELSIF x^.typ^.form # OPT.Int THEN err(93)
ELSIF x^.class = OPT.Nconst THEN
k := x^.conval^.intval;
- IF (0 <= k) & (k <= OPM.MaxSet) THEN x^.conval^.setval := {k}
+ IF (0 <= k) & (k <= MAX(SYSTEM.SET64)) THEN
+ x^.conval^.setval := {}; INCL(x.conval.setval, k);
ELSE err(202)
- END ;
- x^.obj := NIL
- ELSE Convert(x, OPT.settyp)
- END ;
- x^.typ := OPT.settyp
+ END;
+ SetSetType(x); x^.obj := NIL
+ ELSE
+ Convert(x, OPT.settyp); x^.typ := OPT.settyp
+ END;
END SetElem;
PROCEDURE CheckAssign(x: OPT.Struct; ynode: OPT.Node); (* x := y *)
@@ -868,29 +848,29 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
g: INTEGER; (* expression (source) form *)
p, q: OPT.Struct;
BEGIN
- IF OPM.Verbose THEN
+ y := ynode^.typ; f := x^.form; g := y^.form;
+ (*
+ IF OPM.verbose IN OPM.Options THEN
OPM.LogWLn; OPM.LogWStr("PROCEDURE CheckAssign"); OPM.LogWLn;
END;
- y := ynode^.typ; f := x^.form; g := y^.form;
- IF OPM.Verbose THEN
+ IF OPM.verbose IN OPM.Options THEN
OPM.LogWStr("y.form = "); OPM.LogWNum(y.form, 0); OPM.LogWLn;
OPM.LogWStr("f = "); OPM.LogWNum(f, 0); OPM.LogWLn;
OPM.LogWStr("g = "); OPM.LogWNum(g, 0); OPM.LogWLn;
OPM.LogWStr("ynode.typ.syze = "); OPM.LogWNum(ynode.typ.size, 0); OPM.LogWLn;
END;
+ *)
IF (ynode^.class = OPT.Ntype) OR (ynode^.class = OPT.Nproc) & (f # OPT.ProcTyp) THEN err(126) END ;
CASE f OF
OPT.Undef,
OPT.String:
- | OPT.Byte: IF ~((g IN ({OPT.Byte, OPT.Char} + OPT.intSet)) & (y.size = 1)) THEN err(113) END
+ | OPT.Byte: IF ~((g IN {OPT.Byte, OPT.Char, OPT.Int}) & (y.size = 1)) THEN err(113) END
| OPT.Bool,
- OPT.Char,
- OPT.Set: IF g # f THEN err(113) END
- | OPT.SInt,
- OPT.Int,
- OPT.LInt: IF ~(g IN OPT.intSet) OR (x.size < y.size) THEN err(113) END
- | OPT.Real: IF ~(g IN {OPT.SInt..OPT.Real}) THEN err(113) END
- | OPT.LReal: IF ~(g IN {OPT.SInt..OPT.LReal}) THEN err(113) END
+ OPT.Char: IF g # f THEN err(113) END
+ | OPT.Int,
+ OPT.Set: IF (g # f) OR (x.size < y.size) THEN err(113) END
+ | OPT.Real: IF ~(g IN {OPT.Int..OPT.Real}) THEN err(113) END
+ | OPT.LReal: IF ~(g IN {OPT.Int..OPT.LReal}) THEN err(113) END
| OPT.Pointer: IF (x = y) OR (g = OPT.NilTyp) OR (x = OPT.sysptrtyp) & (g = OPT.Pointer) THEN (* ok *)
ELSIF g = OPT.Pointer THEN
p := x^.BaseTyp; q := y^.BaseTyp;
@@ -937,7 +917,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END
ELSE OPM.LogWStr("unhandled case in OPB.CheckAssign, f = "); OPM.LogWNum(f, 0); OPM.LogWLn;
END ;
- IF (ynode^.class = OPT.Nconst) & (g < f) & (g IN {OPT.SInt..OPT.Real}) & (f IN {OPT.Int..OPT.LReal}) THEN
+ IF (ynode^.class = OPT.Nconst) & (g < f) & (g IN {OPT.Int..OPT.Real}) & (f IN {OPT.Int..OPT.LReal}) THEN
Convert(ynode, x)
END
END CheckAssign;
@@ -956,7 +936,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
BEGIN x := par0; f := x^.typ^.form;
CASE fctno OF
|OPT.haltfn: (*HALT*)
- IF (f IN OPT.intSet) & (x^.class = OPT.Nconst) THEN
+ IF (f = OPT.Int) & (x^.class = OPT.Nconst) THEN
IF (OPM.MinHaltNr <= x^.conval^.intval) & (x^.conval^.intval <= OPM.MaxHaltNr) THEN
BindNodes(OPT.Ntrap, OPT.notyp, x, x)
ELSE err(218)
@@ -1002,9 +982,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
CASE f OF
OPT.Bool: x := NewBoolConst(FALSE)
| OPT.Char: x := NewIntConst(0); x^.typ := OPT.chartyp
- | OPT.SInt,
- OPT.Int,
- OPT.LInt: x := NewIntConst(OPM.SignedMinimum(x.typ.size))
+ | OPT.Int: x := NewIntConst(OPM.SignedMinimum(x.typ.size))
| OPT.Set: x := NewIntConst(0); x^.typ := OPT.inttyp
| OPT.Real: x := NewRealConst(OPM.MinReal, OPT.realtyp)
| OPT.LReal: x := NewRealConst(OPM.MinLReal, OPT.lrltyp)
@@ -1017,10 +995,8 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
CASE f OF
OPT.Bool: x := NewBoolConst(TRUE)
| OPT.Char: x := NewIntConst(0FFH); x^.typ := OPT.chartyp
- | OPT.SInt,
- OPT.Int,
- OPT.LInt: x := NewIntConst(OPM.SignedMaximum(x.typ.size))
- | OPT.Set: x := NewIntConst(OPM.MaxSet); x^.typ := OPT.inttyp
+ | OPT.Int: x := NewIntConst(OPM.SignedMaximum(x.typ.size))
+ | OPT.Set: x := NewIntConst(x.typ.size*8-1); x^.typ := OPT.inttyp
| OPT.Real: x := NewRealConst(OPM.MaxReal, OPT.realtyp)
| OPT.LReal: x := NewRealConst(OPM.MaxLReal, OPT.lrltyp)
ELSE err(111)
@@ -1029,18 +1005,22 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END
|OPT.chrfn: (*CHR*)
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126)
- ELSIF f IN {OPT.Undef} + OPT.intSet THEN Convert(x, OPT.chartyp)
+ ELSIF f IN {OPT.Undef, OPT.Int} THEN Convert(x, OPT.chartyp)
ELSE err(111); x^.typ := OPT.chartyp
END
|OPT.shortfn: (*SHORT*)
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126)
- ELSIF (f IN OPT.intSet) & (x.typ.size > OPM.SIntSize) THEN Convert(x, IntType(ShorterSize(x.typ.size)))
+ ELSIF f = OPT.Int THEN
+ typ := OPT.ShorterOrLongerType(x.typ, -1);
+ IF typ = NIL THEN err(111) ELSE Convert(x, typ) END
ELSIF f = OPT.LReal THEN Convert(x, OPT.realtyp)
ELSE err(111)
END
|OPT.longfn: (*LONG*)
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126)
- ELSIF (f IN OPT.intSet) & (x.typ.size < OPM.LIntSize) THEN Convert(x, IntType(LongerSize(x.typ.size)))
+ ELSIF f = OPT.Int THEN
+ typ := OPT.ShorterOrLongerType(x.typ, 1);
+ IF typ = NIL THEN err(111) ELSE Convert(x, typ) END
ELSIF f = OPT.Real THEN Convert(x, OPT.lrltyp)
ELSIF f = OPT.Char THEN Convert(x, OPT.linttyp)
ELSE err(111)
@@ -1048,13 +1028,13 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
|OPT.incfn,
OPT.decfn: (*INC, DEC*)
IF NotVar(x) THEN err(112)
- ELSIF ~(f IN OPT.intSet) THEN err(111)
+ ELSIF f # OPT.Int THEN err(111)
ELSIF x^.readonly THEN err(76)
END
|OPT.inclfn,
OPT.exclfn: (*INCL, EXCL*)
IF NotVar(x) THEN err(112)
- ELSIF x^.typ # OPT.settyp THEN err(111); x^.typ := OPT.settyp
+ ELSIF x.typ.form # OPT.Set THEN err(111); x^.typ := OPT.settyp
ELSIF x^.readonly THEN err(76)
END
|OPT.lenfn: (*LEN*)
@@ -1067,8 +1047,8 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END
|OPT.ashfn: (*ASH*)
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126)
- ELSIF f IN OPT.intSet THEN
- IF x.typ.size # OPM.LIntSize THEN Convert(x, OPT.linttyp) END
+ ELSIF f = OPT.Int THEN
+ IF x.typ.size < OPT.linttyp.size THEN Convert(x, OPT.linttyp) END
ELSE err(111); x^.typ := OPT.linttyp
END
|OPT.adrfn: (*SYSTEM.ADR*)
@@ -1077,7 +1057,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
IF x^.class # OPT.Ntype THEN err(110); x := NewIntConst(1)
ELSIF (f IN {OPT.Byte..OPT.Set, OPT.Pointer, OPT.ProcTyp})
OR (x^.typ^.comp IN {OPT.Array, OPT.Record}) THEN
- typSize(x^.typ); x^.typ^.pvused := TRUE; x := NewIntConst(x^.typ^.size)
+ OPT.TypSize(x^.typ); x^.typ^.pvused := TRUE; x := NewIntConst(x^.typ^.size)
ELSE err(111); x := NewIntConst(1)
END
|OPT.ccfn: (*SYSTEM.CC*)
@@ -1085,19 +1065,19 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
|OPT.lshfn,
OPT.rotfn: (*SYSTEM.LSH, SYSTEM.ROT*)
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126)
- ELSIF ~(f IN OPT.intSet + {OPT.Byte, OPT.Char, OPT.Set}) THEN err(111)
+ ELSIF ~(f IN {OPT.Int, OPT.Byte, OPT.Char, OPT.Set}) THEN err(111)
END
|OPT.getfn,
OPT.putfn,
OPT.bitfn,
OPT.movefn: (*SYSTEM.GET, SYSTEM.PUT, SYSTEM.BIT, SYSTEM.MOVE*)
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126)
- ELSIF (x^.class = OPT.Nconst) & (f IN OPT.intSet) & (x.typ.size < OPT.linttyp.size) THEN Convert(x, OPT.linttyp)
- ELSIF ~((x.typ.form IN {OPT.Pointer} + OPT.intSet) & (x.typ.size = OPM.PointerSize)) THEN err(111); x^.typ := OPT.linttyp
+ ELSIF (x^.class = OPT.Nconst) & (f = OPT.Int) & (x.typ.size < OPT.adrtyp.size) THEN Convert(x, OPT.adrtyp)
+ ELSIF ~((x.typ.form IN {OPT.Pointer, OPT.Int}) & (x.typ.size = OPM.AddressSize)) THEN err(111); x^.typ := OPT.adrtyp
END
|OPT.getrfn,
OPT.putrfn: (*SYSTEM.GETREG, SYSTEM.PUTREG*)
- IF (f IN OPT.intSet) & (x^.class = OPT.Nconst) THEN
+ IF (f = OPT.Int) & (x^.class = OPT.Nconst) THEN
IF (x^.conval^.intval < OPM.MinRegNr) OR (x^.conval^.intval > OPM.MaxRegNr) THEN err(220) END
ELSE err(69)
END
@@ -1138,7 +1118,9 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126); p^.typ := OPT.notyp
ELSE
IF x^.typ # p^.typ THEN
- IF (x^.class = OPT.Nconst) & (f IN OPT.intSet) THEN Convert(x, p^.typ)
+ IF (f = OPT.Int)
+ & ( (x^.class = OPT.Nconst)
+ OR (p.typ.form = OPT.Int) & (x.typ.size <= p.typ.size)) THEN Convert(x, p^.typ)
ELSE err(111)
END
END ;
@@ -1148,17 +1130,17 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
|OPT.inclfn,
OPT.exclfn: (*INCL, EXCL*)
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126)
- ELSIF f IN OPT.intSet THEN
- IF (x^.class = OPT.Nconst) & ((0 > x^.conval^.intval) OR (x^.conval^.intval > OPM.MaxSet)) THEN err(202)
- END ;
+ ELSIF f = OPT.Int THEN
+ IF (x^.class = OPT.Nconst) & ((0 > x^.conval^.intval) OR (x^.conval^.intval >= p.typ.size*8)) THEN err(202)
+ END;
p := NewOp(OPT.Nassign, fctno, p, x)
ELSE err(111)
END ;
p^.typ := OPT.notyp
|OPT.lenfn: (*LEN*)
- IF ~(f IN OPT.intSet) OR (x^.class # OPT.Nconst) THEN err(69)
+ IF ~(f = OPT.Int) OR (x^.class # OPT.Nconst) THEN err(69)
ELSIF x.typ.size = 1 THEN (* Hard limit of 127 dimensions *)
- L := SHORT(x^.conval^.intval); typ := p^.typ;
+ L := OPM.Integer(x^.conval^.intval); typ := p^.typ;
WHILE (L > 0) & (typ^.comp IN {OPT.DynArr, OPT.Array}) DO typ := typ^.BaseTyp; DEC(L) END ;
IF (L # 0) OR ~(typ^.comp IN {OPT.DynArr, OPT.Array}) THEN err(132)
ELSE x^.obj := NIL;
@@ -1180,25 +1162,25 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
p^.typ := OPT.notyp
|OPT.ashfn: (*ASH*)
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126)
- ELSIF f IN OPT.intSet THEN
+ ELSIF f = OPT.Int THEN
IF (p^.class = OPT.Nconst) & (x^.class = OPT.Nconst) THEN
IF (-maxExp > x^.conval^.intval) OR (x^.conval^.intval > maxExp) THEN err(208); p^.conval^.intval := 1
ELSIF x^.conval^.intval >= 0 THEN
- IF ABS(p^.conval^.intval) <= MAX(LONGINT) DIV ASH(1, x^.conval^.intval) THEN
+ IF ABS(p^.conval^.intval) <= MAX(SYSTEM.INT64) DIV ASH(1, x^.conval^.intval) THEN
p^.conval^.intval := p^.conval^.intval * ASH(1, x^.conval^.intval)
ELSE err(208); p^.conval^.intval := 1
END
ELSE p^.conval^.intval := ASH(p^.conval^.intval, x^.conval^.intval)
END ;
p^.obj := NIL
- ELSE p := NewOp(OPT.Ndop, OPT.ash, p, x); p^.typ := OPT.linttyp
+ ELSE p := NewOp(OPT.Ndop, OPT.ash, p, x); p^.typ := p.left.typ (* LONGINT, or INT64 if larger *)
END
ELSE err(111)
END
|OPT.newfn: (*NEW(p, x...)*)
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126)
ELSIF p^.typ^.comp = OPT.DynArr THEN
- IF f IN OPT.intSet THEN
+ IF f = OPT.Int THEN
IF (x^.class = OPT.Nconst) & ((x^.conval^.intval <= 0) OR (x^.conval^.intval > OPM.MaxIndex)) THEN err(63) END
ELSE err(111)
END ;
@@ -1208,7 +1190,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
|OPT.lshfn,
OPT.rotfn: (*SYSTEM.LSH, SYSTEM.ROT*)
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126)
- ELSIF ~(f IN OPT.intSet) THEN err(111)
+ ELSIF f # OPT.Int THEN err(111)
ELSE
IF fctno = OPT.lshfn THEN p := NewOp(OPT.Ndop, OPT.lsh, p, x) ELSE p := NewOp(OPT.Ndop, OPT.rot, p, x) END ;
p^.typ := p^.left^.typ
@@ -1229,12 +1211,14 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
p^.typ := OPT.notyp
|OPT.bitfn: (*SYSTEM.BIT*)
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126)
- ELSIF f IN OPT.intSet THEN
+ ELSIF f = OPT.Int THEN
p := NewOp(OPT.Ndop, OPT.bit, p, x)
ELSE err(111)
END ;
p^.typ := OPT.booltyp
|OPT.valfn: (*SYSTEM.VAL*) (* type is changed without considering the byte ordering on the target machine *)
+ (* p (1st param): desired type *)
+ (* x (2nd param): constant or value to be converted to p *)
IF (x^.class = OPT.Ntype)
OR (x^.class = OPT.Nproc)
OR (f IN {OPT.Undef, OPT.String, OPT.NoTyp})
@@ -1242,30 +1226,38 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
err(126)
END;
(* Warn if the result type includes memory past the end of the source variable *)
- IF x.typ.size < p.typ.size THEN err(-308) END;
- t := OPT.NewNode(OPT.Nmop); t^.subcl := OPT.val; t^.left := x; x := t;
- (*
- IF (x^.class >= OPT.Nconst) OR ((f IN OPT.realSet) # (p^.typ^.form IN OPT.realSet)) THEN
- t := OPT.NewNode(OPT.Nmop); t^.subcl := val; t^.left := x; x := t
- ELSE x^.readonly := FALSE
- END ;
- *)
- x^.typ := p^.typ; p := x
+ OPT.TypSize(x.typ); OPT.TypSize(p.typ);
+ IF (x.class # OPT.Nconst) & (x.typ.size < p.typ.size) THEN err(-308) END;
+
+ IF (x.class = OPT.Nconst) & (x.typ.form = OPT.Int) & (p.typ.form = OPT.Int) THEN
+ (* Convert integer constants in place allowing usage in CONST section. *)
+ Convert(x, p.typ)
+ ELSE
+ t := OPT.NewNode(OPT.Nmop); t^.subcl := OPT.val; t^.left := x; x := t;
+ (*
+ IF (x^.class >= OPT.Nconst) OR ((f IN OPT.realSet) # (p^.typ^.form IN OPT.realSet)) THEN
+ t := OPT.NewNode(OPT.Nmop); t^.subcl := val; t^.left := x; x := t
+ ELSE x^.readonly := FALSE
+ END ;
+ *)
+ x^.typ := p^.typ;
+ END;
+ p := x
|OPT.sysnewfn: (*SYSTEM.NEW*)
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126)
- ELSIF f IN OPT.intSet THEN
+ ELSIF f = OPT.Int THEN
p := NewOp(OPT.Nassign, OPT.sysnewfn, p, x)
ELSE err(111)
END ;
p^.typ := OPT.notyp
|OPT.movefn: (*SYSTEM.MOVE*)
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126)
- ELSIF (x^.class = OPT.Nconst) & (f IN OPT.intSet) & (x.typ.size < OPT.linttyp.size) THEN Convert(x, OPT.linttyp)
- ELSIF ~((x.typ.form IN {OPT.Pointer} + OPT.intSet) & (x.typ.size = OPM.PointerSize)) THEN err(111); x^.typ := OPT.linttyp
+ ELSIF (x^.class = OPT.Nconst) & (f = OPT.Int) & (x.typ.size < OPT.adrtyp.size) THEN Convert(x, OPT.adrtyp)
+ ELSIF ~((x.typ.form IN {OPT.Pointer, OPT.Int}) & (x.typ.size = OPM.AddressSize)) THEN err(111); x^.typ := OPT.adrtyp
END;
p^.link := x
|OPT.assertfn: (*ASSERT*)
- IF (f IN OPT.intSet) & (x^.class = OPT.Nconst) THEN
+ IF (f = OPT.Int) & (x^.class = OPT.Nconst) THEN
IF (OPM.MinHaltNr <= x^.conval^.intval) & (x^.conval^.intval <= OPM.MaxHaltNr) THEN
BindNodes(OPT.Ntrap, OPT.notyp, x, x);
x^.conval := OPT.NewConst(); x^.conval^.intval := OPM.errpos;
@@ -1290,7 +1282,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
IF fctno = OPT.newfn THEN (*NEW(p, ..., x...*)
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126)
ELSIF p^.typ^.comp # OPT.DynArr THEN err(64)
- ELSIF f IN OPT.intSet THEN
+ ELSIF f = OPT.Int THEN
IF (x^.class = OPT.Nconst) & ((x^.conval^.intval <= 0) OR (x^.conval^.intval > OPM.MaxIndex)) THEN err(63) END ;
node := p^.right; WHILE node^.link # NIL DO node := node^.link END;
node^.link := x; p^.typ := p^.typ^.BaseTyp
@@ -1298,7 +1290,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END
ELSIF (fctno = OPT.movefn) & (n = 2) THEN (*SYSTEM.MOVE*)
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126)
- ELSIF f IN OPT.intSet THEN
+ ELSIF f = OPT.Int THEN
node := OPT.NewNode(OPT.Nassign); node^.subcl := OPT.movefn; node^.right := p;
node^.left := p^.link; p^.link := x; p := node
ELSE err(111)
@@ -1357,8 +1349,8 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
BEGIN (* ftyp^.comp = OPT.DynArr *)
f := atyp^.comp; ftyp := ftyp^.BaseTyp; atyp := atyp^.BaseTyp;
IF fvarpar & (ftyp = OPT.bytetyp) THEN (* ok, but ... *)
- IF ~(f IN {OPT.Array, OPT.DynArr}) OR ~((atyp.form IN {OPT.Byte..OPT.Char} + OPT.intSet) & (atyp.size = 1)) THEN
- IF OPM.verbose IN OPM.opt THEN err(-301) END
+ IF ~(f IN {OPT.Array, OPT.DynArr}) OR ~((atyp.form IN {OPT.Byte..OPT.Char, OPT.Int}) & (atyp.size = 1)) THEN
+ IF OPM.verbose IN OPM.Options THEN err(-301) END
END
ELSIF f IN {OPT.Array, OPT.DynArr} THEN
IF ftyp^.comp = OPT.DynArr THEN DynArrParCheck(ftyp, atyp, fvarpar)
@@ -1410,7 +1402,10 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
WHILE (q # fp^.typ) & (q # NIL) & (q # OPT.undftyp) DO q := q^.BaseTyp END ;
IF q = NIL THEN err(111) END
ELSIF (fp^.typ = OPT.sysptrtyp) & (ap^.typ^.form = OPT.Pointer) THEN (* ok *)
- ELSIF (ap^.typ # fp^.typ) & ~((fp^.typ^.form = OPT.Byte) & ((ap.typ.form IN {OPT.Byte..OPT.Char} + OPT.intSet) & (ap.typ.size = 1))) THEN err(123)
+ ELSIF (ap^.typ # fp^.typ)
+ & ~( (fp^.typ^.form = OPT.Byte)
+ & (ap.typ.form IN {OPT.Byte..OPT.Char, OPT.Int})
+ & (ap.typ.size = 1)) THEN err(123)
ELSIF (fp^.typ^.form = OPT.Pointer) & (ap^.class = OPT.Nguard) THEN err(123)
END
ELSIF fp^.typ^.comp = OPT.DynArr THEN
@@ -1507,5 +1502,5 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END Inittd;
BEGIN
- maxExp := log(MAX(LONGINT) DIV 2 + 1); maxExp := exp
+ maxExp := log(MAX(SYSTEM.INT64) DIV 2 + 1); maxExp := exp
END OPB.
diff --git a/src/compiler/OPC.Mod b/src/compiler/OPC.Mod
index 1076a289..a8681e32 100644
--- a/src/compiler/OPC.Mod
+++ b/src/compiler/OPC.Mod
@@ -7,7 +7,6 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
IMPORT OPT, OPM, Configuration, SYSTEM;
-
CONST demoVersion = FALSE;
@@ -39,9 +38,8 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
VAR
indentLevel: INTEGER;
- ptrinit, mainprog, ansi: BOOLEAN;
hashtab: ARRAY 105 OF SHORTINT;
- keytab: ARRAY 36, 9 OF CHAR;
+ keytab: ARRAY 50, 9 OF CHAR;
GlbPtrs: BOOLEAN;
BodyNameExt: ARRAY 13 OF CHAR;
@@ -49,11 +47,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
PROCEDURE Init*;
BEGIN
indentLevel := 0;
- ptrinit := OPM.ptrinit IN OPM.opt;
- (*mainprog := OPM.mainprog IN OPM.opt;*)
- mainprog := OPM.mainProg OR OPM.mainLinkStat;
- ansi := OPM.ansi IN OPM.opt;
- IF ansi THEN BodyNameExt := "__init(void)" ELSE BodyNameExt := "__init()" END
+ BodyNameExt := "__init(void)"
END Init;
PROCEDURE Indent* (count: INTEGER);
@@ -117,6 +111,12 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
IF hashtab[h] >= 0 THEN
IF keytab[hashtab[h]] = obj^.name THEN OPM.Write('_') END
END
+ ELSIF (mode = OPT.Typ) & (obj.typ.form IN {OPT.Int, OPT.Set}) THEN
+ IF obj.typ = OPT.adrtyp THEN OPM.WriteString("ADDRESS")
+ ELSE
+ IF obj.typ.form = OPT.Int THEN OPM.WriteString("INT") ELSE OPM.WriteString("UINT") END;
+ OPM.WriteInt(obj.typ.size*8)
+ END
ELSE
IF (mode # OPT.Typ) OR (obj^.linkadr # PredefinedType) THEN
IF mode = OPT.TProc THEN Ident(obj^.link^.typ^.strobj)
@@ -186,9 +186,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
ELSIF (form = OPT.ProcTyp) OR (comp IN {OPT.Array, OPT.DynArr}) THEN
IF openClause THEN OPM.Write(')'); openClause := FALSE END ;
IF form = OPT.ProcTyp THEN
- IF ansi THEN OPM.Write(")"); AnsiParamList(typ^.link, FALSE)
- ELSE OPM.WriteString(")()")
- END ;
+ OPM.Write(")"); AnsiParamList(typ^.link, FALSE);
EXIT
ELSIF comp = OPT.Array THEN
OPM.Write('['); OPM.WriteInt(typ^.n); OPM.Write(']')
@@ -370,9 +368,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
VAR par: OPT.Object;
BEGIN
IF obj^.typ # OPT.notyp THEN DefineType(obj^.typ) END ;
- IF ansi THEN par := obj^.link;
- WHILE par # NIL DO DefineType(par^.typ); par := par^.link END
- END
+ par := obj^.link; WHILE par # NIL DO DefineType(par^.typ); par := par^.link END
END DefineTProcTypes;
PROCEDURE DeclareTProcs(obj: OPT.Object; VAR empty: BOOLEAN);
@@ -425,11 +421,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
Str1(", #, ", obj^.adr DIV 10000H);
IF obj^.typ = OPT.notyp THEN OPM.WriteString('void') ELSE Ident(obj^.typ^.strobj) END ;
OPM.WriteString("(*)");
- IF ansi THEN
- AnsiParamList(obj^.link, FALSE);
- ELSE
- OPM.WriteString("()");
- END ;
+ AnsiParamList(obj^.link, FALSE);
OPM.WriteString(", ");
DeclareParams(obj^.link, TRUE);
OPM.Write(")"); OPM.WriteLn
@@ -486,11 +478,10 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
END DefineType;
PROCEDURE Prefixed(x: OPT.ConstExt; y: ARRAY OF CHAR): BOOLEAN;
- VAR i: INTEGER; r: BOOLEAN;
+ VAR i: INTEGER;
BEGIN i := 0;
- WHILE x[i+1] = y[i] DO INC(i) END ;
- r := y[i] = 0X;
- RETURN r;
+ WHILE x[i+1] = y[i] DO INC(i) END;
+ RETURN y[i] = 0X;
END Prefixed;
PROCEDURE CProcDefs(obj: OPT.Object; vis: INTEGER);
@@ -549,7 +540,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
IF typ^.strobj # NIL THEN OPM.WriteStringVar(typ^.strobj^.name) END ;
OPM.Write(DoubleQuote);
Str1(', #), {', typ^.size);
- nofptrs := 0; PutPtrOffsets(typ, 0, nofptrs); Str1("#}}", -(nofptrs + 1) * OPM.LIntSize);
+ nofptrs := 0; PutPtrOffsets(typ, 0, nofptrs); Str1("#}}", -(nofptrs + 1) * OPM.AddressSize);
EndStat
END TDescDecl;
@@ -563,56 +554,25 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
IF typ^.strobj # NIL THEN InitTProcs(typ^.strobj, typ^.link) END
END InitTDesc;
- PROCEDURE Align*(VAR adr: LONGINT; base: LONGINT);
- BEGIN
- CASE base OF
- | 2: INC(adr, adr MOD 2)
- | 4: INC(adr, (-adr) MOD 4)
- | 8: INC(adr, (-adr) MOD 8)
- | 16: INC(adr, (-adr) MOD 16)
- ELSE (*1*) (*OPM.LogWStr("unhandled case at OPC.Align, base = "); OPM.LogWNum(base, 0); OPM.LogWLn;*)
- END
- END Align;
-
- PROCEDURE SizeAlignment*(size: LONGINT): LONGINT;
- VAR alignment: LONGINT;
- BEGIN
- IF size < OPM.Alignment THEN
- (* Round up to next power of 2 *)
- alignment := 1; WHILE alignment < size DO alignment := alignment * 2 END;
- ELSE
- alignment := OPM.Alignment
- END;
- RETURN alignment
- END SizeAlignment;
-
- PROCEDURE BaseAlignment*(typ: OPT.Struct): LONGINT;
- VAR alignment: LONGINT;
- BEGIN
- IF typ.form = OPT.Comp THEN
- IF typ.comp = OPT.Record THEN
- alignment := typ.align MOD 10000H
- ELSE
- alignment := BaseAlignment(typ.BaseTyp)
- END
- ELSE
- alignment := SizeAlignment(typ.size)
- END;
- RETURN alignment
- END BaseAlignment;
-
-
PROCEDURE FillGap(gap, off, align: LONGINT; VAR n, curAlign: LONGINT);
+ (* gap: Required gap - already calculated based on alignment requirements
+ off: Current offset - where gap begins
+ align: Containing record type alignment
+ n: Next ordinal to use for private field names
+ curAlign: Largest alignment of any field so far
+ *)
VAR adr: LONGINT;
BEGIN
- adr := off; Align(adr, align);
+ adr := off; OPT.Align(adr, align);
IF (curAlign < align) & (gap - (adr - off) >= align) THEN (* preserve alignment of the enclosing struct! *)
DEC(gap, (adr - off) + align);
BegStat;
- IF align = OPM.IntSize THEN OPM.WriteString("INTEGER")
- ELSIF align = OPM.LIntSize THEN OPM.WriteString("LONGINT")
- ELSIF align = OPM.LRealSize THEN OPM.WriteString("LONGREAL")
- END ;
+ CASE align OF
+ |2: OPM.WriteString("INT16")
+ |4: OPM.WriteString("INT32")
+ |8: OPM.WriteString("INT64")
+ ELSE OPM.LogWLn; OPM.LogWStr("Unexpected enclosing alignment in FillGap.")
+ END;
Str1(" _prvt#", n); INC(n); EndStat;
curAlign := align
END ;
@@ -622,30 +582,44 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
PROCEDURE FieldList (typ: OPT.Struct; last: BOOLEAN; VAR off, n, curAlign: LONGINT);
VAR fld: OPT.Object; base: OPT.Struct; gap, adr, align, fldAlign: LONGINT;
BEGIN
- fld := typ.link; align := typ^.align MOD 10000H;
+ fld := typ.link;
+ align := typ^.align MOD 10000H;
IF typ.BaseTyp # NIL THEN FieldList(typ.BaseTyp, FALSE, off, n, curAlign)
ELSE off := 0; n := 0; curAlign := 1
- END ;
+ END;
+ (* off: Current offset into record
+ align: Overall (RECORD) alignment
+ curAlign: Current alignment - largest alignment of any field so far
+ n: Next ordinal to use for private field names
+ *)
WHILE (fld # NIL) & (fld.mode = OPT.Fld) DO
- IF (OPM.currFile = OPM.HeaderFile) & (fld.vis = OPT.internal) OR
- (OPM.currFile = OPM.BodyFile) & (fld.vis = OPT.internal) & (typ^.mno # 0) THEN
+ IF (OPM.currFile = OPM.HeaderFile) & (fld.vis = OPT.internal)
+ OR (OPM.currFile = OPM.BodyFile) & (fld.vis = OPT.internal) & (typ^.mno # 0) THEN
+ (* Skip private fields *)
fld := fld.link;
- WHILE (fld # NIL) & (fld.mode = OPT.Fld) & (fld.vis = OPT.internal) DO fld := fld.link END ;
+ WHILE (fld # NIL) & (fld.mode = OPT.Fld) & (fld.vis = OPT.internal) DO fld := fld.link END;
ELSE
(* mimic OPV.TypSize to detect gaps caused by private fields *)
- adr := off; fldAlign := BaseAlignment(fld^.typ); Align(adr, fldAlign);
+ adr := off;
+ fldAlign := OPT.BaseAlignment(fld^.typ);
+ OPT.Align(adr, fldAlign);
gap := fld.adr - adr;
- IF fldAlign > curAlign THEN curAlign := fldAlign END ;
- IF gap > 0 THEN FillGap(gap, off, align, n, curAlign) END ;
+ IF fldAlign > curAlign THEN curAlign := fldAlign END;
+ IF gap > 0 THEN
+ FillGap(gap, off, align, n, curAlign)
+ END;
BegStat; DeclareBase(fld); OPM.Write(' '); DeclareObj(fld, FALSE);
off := fld.adr + fld.typ.size; base := fld.typ; fld := fld.link;
- WHILE (fld # NIL) & (fld.mode = OPT.Fld) & (fld.typ = base) & (fld.adr = off)
+ WHILE (fld # NIL)
+ & (fld.mode = OPT.Fld)
+ & (fld.typ = base)
+ & (fld.adr = off)
(* ?? *) & ((OPM.currFile = OPM.BodyFile) OR (fld.vis # OPT.internal) OR (fld.typ.strobj = NIL)) DO
OPM.WriteString(", "); DeclareObj(fld, FALSE); off := fld.adr + fld.typ.size; fld := fld.link
- END ;
+ END;
EndStat
END
- END ;
+ END;
IF last THEN
adr := typ.size - typ^.sysflag DIV 100H;
IF adr = 0 THEN gap := 1 (* avoid empty struct *) ELSE gap := adr - off END ;
@@ -685,9 +659,9 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
OPM.WriteString("LONGINT "); LenList(obj, FALSE, TRUE)
ELSIF (obj^.mode = OPT.VarPar) & (obj^.typ^.comp = OPT.Record) THEN
EndStat; BegStat;
- OPM.WriteString("LONGINT *"); Ident(obj); OPM.WriteString(TagExt);
+ OPM.WriteString("ADDRESS *"); Ident(obj); OPM.WriteString(TagExt);
base := NIL
- ELSIF ptrinit & (vis = 0) & (obj^.mnolev > 0) & (obj^.typ^.form = OPT.Pointer) THEN
+ ELSIF (OPM.ptrinit IN OPM.Options) & (vis = 0) & (obj^.mnolev > 0) & (obj^.typ^.form = OPT.Pointer) THEN
OPM.WriteString(" = NIL")
END
END ;
@@ -713,7 +687,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
OPM.WriteString(", LONGINT ");
LenList(obj, TRUE, showParamNames)
ELSIF (obj^.mode = OPT.VarPar) & (obj^.typ^.comp = OPT.Record) THEN
- OPM.WriteString(", LONGINT *");
+ OPM.WriteString(", ADDRESS *");
IF showParamNames THEN Ident(obj); OPM.WriteString(TagExt) END
END ;
IF (obj^.link = NIL) OR (obj^.link.mode = OPT.TProc) THEN EXIT END ;
@@ -728,16 +702,9 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
BEGIN
IF proc^.typ = OPT.notyp THEN OPM.WriteString('void') ELSE Ident(proc^.typ^.strobj) END ;
OPM.Write(' '); Ident(proc); OPM.Write(' ');
- IF ansi THEN
- AnsiParamList(proc^.link, TRUE);
- IF ~define THEN OPM.Write(";") END ;
- OPM.WriteLn;
- ELSIF define THEN
- DeclareParams(proc^.link, FALSE);
- OPM.WriteLn;
- Indent(1); IdentList(proc^.link, 2(* map REAL to double *)); Indent(-1)
- ELSE OPM.WriteString("();"); OPM.WriteLn
- END
+ AnsiParamList(proc^.link, TRUE);
+ IF ~define THEN OPM.Write(";") END ;
+ OPM.WriteLn
END ProcHeader;
PROCEDURE ProcPredefs (obj: OPT.Object; vis: SHORTINT); (* forward declaration of procedures *)
@@ -784,7 +751,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
ELSIF (typ^.strobj # NIL) & (typ^.strobj^.mnolev > 0) THEN OPM.WriteString('static ')
ELSE OPM.WriteString(Export)
END ;
- OPM.WriteString("LONGINT *"); Andent(typ); OPM.WriteString(DynTypExt);
+ OPM.WriteString("ADDRESS *"); Andent(typ); OPM.WriteString(DynTypExt);
EndStat
END ;
n := n^.link
@@ -804,7 +771,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
OPM.WriteStringVar(OPM.modName); OPM.WriteString(BodyNameExt);
EndStat; OPM.WriteLn;
CProcDefs(OPT.topScope^.right, 1); OPM.WriteLn;
- OPM.WriteString("#endif"); OPM.WriteLn
+ OPM.WriteString("#endif // "); OPM.WriteStringVar(OPM.modName); OPM.WriteLn
END GenHdr;
PROCEDURE GenHeaderMsg;
@@ -813,14 +780,13 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
OPM.WriteString("/* "); OPM.WriteString(Configuration.name);
OPM.Write(" "); OPM.WriteString(Configuration.versionLong); OPM.Write (" "); (* noch *)
FOR i := 0 TO MAX(SET) DO
- IF i IN OPM.glbopt THEN
+ IF i IN OPM.Options THEN
CASE i OF (* c.f. ScanOptions in OPM *)
| OPM.inxchk: OPM.Write("x")
| OPM.ranchk: OPM.Write("r")
| OPM.typchk: OPM.Write("t")
| OPM.newsf: OPM.Write("s")
| OPM.ptrinit: OPM.Write("p")
- | OPM.ansi: OPM.Write("k")
| OPM.assert: OPM.Write("a")
| OPM.extsf: OPM.Write("e")
| OPM.mainprog: OPM.Write("m")
@@ -845,7 +811,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
OPM.WriteString("#ifndef "); OPM.WriteStringVar(OPM.modName); OPM.WriteString(FlagExt); OPM.WriteLn;
OPM.WriteString("#define "); OPM.WriteStringVar(OPM.modName); OPM.WriteString(FlagExt); OPM.WriteLn;
OPM.WriteLn;
- IF OPM.LIntSize = 8 THEN OPM.WriteString("#define LARGE"); OPM.WriteLn END;
+
Include(BasicIncludeFile);
IncludeImports(OPT.topScope^.right, 1); OPM.WriteLn
END GenHdrIncludes;
@@ -854,7 +820,15 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
BEGIN
OPM.currFile := OPM.BodyFile;
GenHeaderMsg;
- IF OPM.LIntSize = 8 THEN OPM.WriteString("#define LARGE"); OPM.WriteLn END;
+ OPM.WriteLn;
+
+ (* Define model dependent type sizes *)
+ OPM.WriteString("#define SHORTINT INT"); OPM.WriteInt(OPT.sinttyp.size*8); OPM.WriteLn;
+ OPM.WriteString("#define INTEGER INT"); OPM.WriteInt(OPT.inttyp.size*8); OPM.WriteLn;
+ OPM.WriteString("#define LONGINT INT"); OPM.WriteInt(OPT.linttyp.size*8); OPM.WriteLn;
+ OPM.WriteString("#define SET UINT"); OPM.WriteInt(OPT.settyp.size*8); OPM.WriteLn;
+ OPM.WriteLn;
+
Include(BasicIncludeFile);
IncludeImports(OPT.topScope^.right, 0); OPM.WriteLn;
DefAnonRecs(n);
@@ -899,14 +873,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
typ := var^.typ;
IF NofPtrs(typ) > 0 THEN
IF ~GlbPtrs THEN GlbPtrs := TRUE;
- OPM.WriteString('static ');
- IF ansi THEN
- OPM.WriteString("void EnumPtrs(void (*P)(void*))")
- ELSE
- OPM.WriteString("void EnumPtrs(P)"); OPM.WriteLn;
- OPM.Write(Tab); OPM.WriteString("void (*P)();");
- END ;
- OPM.WriteLn;
+ OPM.WriteString("static void EnumPtrs(void (*P)(void*))"); OPM.WriteLn;
BegBlk
END ;
BegStat;
@@ -937,27 +904,22 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
PROCEDURE EnterBody*;
BEGIN
OPM.WriteLn; OPM.WriteString(Export);
- IF mainprog THEN
- IF ansi THEN
- OPM.WriteString("int main(int argc, char **argv)"); OPM.WriteLn;
- ELSE
- OPM.WriteString("main(argc, argv)"); OPM.WriteLn;
- OPM.Write(Tab); OPM.WriteString("int argc; char **argv;"); OPM.WriteLn
- END
+ IF OPM.mainprog IN OPM.Options THEN
+ OPM.WriteString("int main(int argc, char **argv)"); OPM.WriteLn;
ELSE
OPM.WriteString("void *");
OPM.WriteString(OPM.modName); OPM.WriteString(BodyNameExt); OPM.WriteLn;
END ;
BegBlk; BegStat;
- IF mainprog THEN OPM.WriteString("__INIT(argc, argv)") ELSE OPM.WriteString("__DEFMOD") END ;
+ IF OPM.mainprog IN OPM.Options THEN OPM.WriteString("__INIT(argc, argv)") ELSE OPM.WriteString("__DEFMOD") END ;
EndStat;
- IF mainprog & demoVersion THEN BegStat;
+ IF (OPM.mainprog IN OPM.Options) & demoVersion THEN BegStat;
OPM.WriteString('/*don`t do it!*/ printf("DEMO VERSION: DO NOT USE THIS PROGRAM FOR ANY COMMERCIAL PURPOSE\n")');
EndStat
END ;
InitImports(OPT.topScope^.right);
BegStat;
- IF mainprog THEN OPM.WriteString('__REGMAIN("') ELSE OPM.WriteString('__REGMOD("') END ;
+ IF OPM.mainprog IN OPM.Options THEN OPM.WriteString('__REGMAIN("') ELSE OPM.WriteString('__REGMOD("') END ;
OPM.WriteString(OPM.modName);
IF GlbPtrs THEN OPM.WriteString('", EnumPtrs)') ELSE OPM.WriteString('", 0)') END ;
EndStat;
@@ -967,7 +929,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
PROCEDURE ExitBody*;
BEGIN
BegStat;
- IF mainprog THEN OPM.WriteString("__FINI;") ELSE OPM.WriteString("__ENDMOD;") END ;
+ IF OPM.mainprog IN OPM.Options THEN OPM.WriteString("__FINI;") ELSE OPM.WriteString("__ENDMOD;") END ;
OPM.WriteLn; EndBlk
END ExitBody;
@@ -988,27 +950,24 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
OPM.WriteLn;
END DefineInter;
+ PROCEDURE NeedsRetval*(proc: OPT.Object): BOOLEAN; (* aux. variable __retval needed for return *)
+ BEGIN (* simple rule; ignores DUPlicated value arrays because they use alloca. *)
+ RETURN (proc^.typ # OPT.notyp) & ~proc^.scope^.leaf
+ END NeedsRetval;
+
PROCEDURE EnterProc* (proc: OPT.Object);
VAR var, scope: OPT.Object; typ: OPT.Struct; dim: INTEGER;
BEGIN
IF proc^.vis # OPT.external THEN OPM.WriteString('static ') END ;
ProcHeader(proc, TRUE);
BegBlk;
-
- (* If there will be a result, provide a result variable. *)
- IF proc^.typ # OPT.notyp THEN
- BegStat;
- Ident(proc^.typ^.strobj);
- OPM.WriteString(" _o_result;");
- OPM.WriteLn;
- END;
-
scope := proc^.scope;
IdentList(scope^.scope, 0);
IF ~scope^.leaf THEN (* declare intermediate procedure scope record variable*)
BegStat; OPM.WriteString('struct '); OPM.WriteStringVar (scope^.name);
OPM.Write(' '); OPM.WriteString(LocalScope); EndStat
END ;
+ IF NeedsRetval(proc) THEN BegStat; Ident(proc^.typ^.strobj); OPM.WriteString(" __retval"); EndStat END;
var := proc^.link;
WHILE var # NIL DO (* declare copy of fixed size value array parameters *)
IF (var^.typ^.comp = OPT.Array) & (var^.mode = OPT.Var) THEN
@@ -1019,17 +978,6 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
END ;
var := var^.link
END ;
- IF ~ansi THEN
- var := proc^.link;
- WHILE var # NIL DO (* "unpromote" value real parameters *)
- IF (var^.typ^.form = OPT.Real) & (var^.mode = OPT.Var) THEN
- BegStat;
- Ident(var^.typ^.strobj); OPM.Write(' '); Ident(var); OPM.WriteString(" = _"); Ident(var);
- EndStat
- END ;
- var := var^.link
- END
- END ;
var := proc^.link;
WHILE var # NIL DO (* copy value array parameters *)
IF (var^.typ^.comp IN {OPT.Array, OPT.DynArr}) & (var^.mode = OPT.Var) & (var^.typ^.sysflag = 0) THEN
@@ -1185,7 +1133,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
END;
END Cmp;
- PROCEDURE CharacterLiteral(c: LONGINT);
+ PROCEDURE CharacterLiteral(c: SYSTEM.INT64);
BEGIN
IF (c < 32) OR (c > 126) THEN
OPM.WriteString("0x"); OPM.WriteHex(c)
@@ -1225,16 +1173,14 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
OPM.Write(DoubleQuote)
END StringLiteral;
- PROCEDURE Case*(caseVal: LONGINT; form: INTEGER);
+ PROCEDURE Case*(caseVal: SYSTEM.INT64; form: INTEGER);
VAR
ch: CHAR;
BEGIN
OPM.WriteString('case ');
CASE form OF
| OPT.Char: CharacterLiteral(caseVal)
- | OPT.SInt,
- OPT.Int,
- OPT.LInt: OPM.WriteInt(caseVal);
+ | OPT.Int: OPM.WriteInt(caseVal);
ELSE OPM.LogWStr("unhandled case in OPC.Case, form = "); OPM.LogWNum(form, 0); OPM.LogWLn;
END;
OPM.WriteString(': ');
@@ -1255,33 +1201,41 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
Str1("__HALT(#)", n)
END Halt;
- PROCEDURE Len* (obj: OPT.Object; array: OPT.Struct; dim: LONGINT);
+ PROCEDURE IntLiteral*(n: SYSTEM.INT64; size: LONGINT);
+ BEGIN
+ IF (size > OPM.CIntSize) & (n <= OPM.CIntMax) & (n > OPM.CIntMin) THEN
+ OPM.WriteString("((INT"); OPM.WriteInt(size*8); OPM.WriteString(")(");
+ OPM.WriteInt(n); OPM.WriteString("))")
+ ELSE
+ OPM.WriteInt(n)
+ END
+ END IntLiteral;
+
+ PROCEDURE Len* (obj: OPT.Object; array: OPT.Struct; dim: SYSTEM.INT64);
BEGIN
IF array^.comp = OPT.DynArr THEN
CompleteIdent(obj); OPM.WriteString(LenExt);
IF dim # 0 THEN OPM.WriteInt(dim) END
ELSE (* array *)
- WHILE dim > 0 DO array := array^.BaseTyp; DEC(dim) END ;
- OPM.WriteString("((LONGINT)("); OPM.WriteInt(array^.n); OPM.WriteString("))");
+ WHILE dim > 0 DO array := array^.BaseTyp; DEC(dim) END;
+ OPM.WriteInt(array.n)
END
END Len;
PROCEDURE Constant* (con: OPT.Const; form: INTEGER);
- VAR i: INTEGER; s: SET;
- hex: LONGINT; skipLeading: BOOLEAN;
+ VAR i: INTEGER; s: SYSTEM.SET64;
+ hex: SYSTEM.INT64; skipLeading: BOOLEAN;
BEGIN
CASE form OF
| OPT.Byte: OPM.WriteInt(con^.intval)
| OPT.Bool: OPM.WriteInt(con^.intval)
| OPT.Char: CharacterLiteral(con.intval)
- | OPT.SInt,
- OPT.Int,
- OPT.LInt: OPM.WriteInt(con^.intval)
+ | OPT.Int: OPM.WriteInt(con^.intval)
| OPT.Real: OPM.WriteReal(con^.realval, "f")
| OPT.LReal: OPM.WriteReal(con^.realval, 0X)
| OPT.Set: OPM.WriteString("0x");
skipLeading := TRUE;
- s := con^.setval; i := MAX(SET) + 1;
+ s := con^.setval; i := MAX(SYSTEM.SET64) + 1;
REPEAT
hex := 0;
REPEAT
@@ -1310,7 +1264,17 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
END Enter;
BEGIN n := 0;
- FOR i := 0 TO 104 DO hashtab[i] := -1 END ;
+ FOR i := 0 TO LEN(hashtab)-1 DO hashtab[i] := -1 END ;
+ Enter("ADDRESS"); (* pseudo keyword used by voc *)
+ Enter("INT16"); (* pseudo keyword used by voc *)
+ Enter("INT32"); (* pseudo keyword used by voc *)
+ Enter("INT64"); (* pseudo keyword used by voc *)
+ Enter("INT8"); (* pseudo keyword used by voc *)
+ Enter("UINT16"); (* pseudo keyword used by voc *)
+ Enter("UINT32"); (* pseudo keyword used by voc *)
+ Enter("UINT64"); (* pseudo keyword used by voc *)
+ Enter("UINT8"); (* pseudo keyword used by voc *)
+
Enter("asm");
Enter("auto");
Enter("break");
@@ -1324,13 +1288,13 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
Enter("else");
Enter("enum");
Enter("extern");
- Enter("export"); (* pseudo keyword used by voc *)
+ Enter("export"); (* pseudo keyword used by voc *)
Enter("float");
Enter("for");
Enter("fortran");
Enter("goto");
Enter("if");
- Enter("import"); (* pseudo keyword used by voc *)
+ Enter("import"); (* pseudo keyword used by voc *)
Enter("int");
Enter("long");
Enter("register");
@@ -1338,6 +1302,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
Enter("short");
Enter("signed");
Enter("sizeof");
+ Enter("size_t");
Enter("static");
Enter("struct");
Enter("switch");
diff --git a/src/compiler/OPM.cmdln.Mod b/src/compiler/OPM.Mod
similarity index 51%
rename from src/compiler/OPM.cmdln.Mod
rename to src/compiler/OPM.Mod
index 74c0f5dc..fe43393b 100644
--- a/src/compiler/OPM.cmdln.Mod
+++ b/src/compiler/OPM.Mod
@@ -4,18 +4,17 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
31.1.2007 jt synchronized with BlackBox version, in particular PromoteIntConstToLInt added
*)
- IMPORT SYSTEM, Texts, Files, Platform, Console, errors, Configuration, vt100, Strings;
+ IMPORT SYSTEM, Texts, Files, Platform, Out, Configuration, VT100, Strings;
CONST
OptionChar* = "-";
- (* compiler options; don't change the encoding *)
+ (* compiler option flag bits; don't change the encoding *)
inxchk* = 0; (* index check on *)
ranchk* = 2; (* range check on *)
typchk* = 3; (* type check on *)
newsf* = 4; (* generation of new symbol file allowed *)
ptrinit* = 5; (* pointer initialization *)
- ansi* = 6; (* ANSI or K&R style prototypes *)
assert* = 7; (* assert evaluation *)
extsf* = 9; (* extension of old symbol file allowed *)
mainprog* = 10; (* translate module body into C main function *)
@@ -25,7 +24,6 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
notcoloroutput* = 16; (* turn off color output *)
forcenewsym* = 17; (* force new symbol file *)
verbose* = 18; (* verbose *)
- defopt* = {inxchk, typchk, ptrinit, ansi, assert}; (* default options *)
nilval* = 0;
@@ -49,12 +47,6 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
MaxStruct* = 255;
- (* maximal number of pointer fields in a record: *)
- MaxPtr* = MAX(LONGINT);
-
- (* maximal number of global pointers per module: *)
- MaxGPtr* = MAX(LONGINT);
-
(* maximal number of hidden fields in an exported record: *)
MaxHdFld* = 2048;
@@ -74,10 +66,17 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
BodyFile* = 1;
HeaderInclude* = 2;
+ (* C default expression integral size details. Const for now, should be var for avr_gcc/sdcc support *)
+ CIntSize* = 4;
+ CIntMax* = 7FFFFFFFH;
+ CIntMin* = -CIntMax - 1;
+
+
SFext = ".sym"; (* symbol file extension *)
BFext = ".c"; (* body file extension *)
HFext = ".h"; (* header file extension *)
SFtag = 0F7X; (* symbol file tag *)
+ SFver = 082X; (* symbol file version. Increment if symbol file format is changed. *)
@@ -88,13 +87,14 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
VAR
SourceFileName : ARRAY 256 OF CHAR;
- Alignment*: INTEGER;
+ GlobalModel, Model*: ARRAY 10 OF CHAR; (* 2: S8/I16/L32, C: S16/I32/L64, V:S8/I32/L64 *)
+ GlobalAddressSize, AddressSize*: INTEGER;
+ GlobalAlignment, Alignment*: INTEGER;
+ GlobalOptions*, Options*: SET;
- ByteSize*, CharSize*, BoolSize*, SIntSize*, IntSize*,
- LIntSize*, SetSize*, RealSize*, LRealSize*, PointerSize*, ProcSize*, RecSize*,
- MaxSet*: INTEGER;
+ ShortintSize*, IntegerSize*, LongintSize*: INTEGER;
- MaxIndex*: LONGINT;
+ MaxIndex*: SYSTEM.INT64;
MinReal*, MaxReal*, MinLReal*, MaxLReal*: LONGREAL;
@@ -106,14 +106,12 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
pc*, entno*: INTEGER; (* entry number *)
modName*: ARRAY 32 OF CHAR;
objname*: ARRAY 64 OF CHAR;
- opt*, glbopt*: SET;
ErrorLineStartPos, ErrorLineLimitPos, ErrorLineNumber: LONGINT; (* Limit = start of next line *)
lasterrpos: LONGINT;
inR: Texts.Reader;
- Log: Texts.Text;
- W: Texts.Writer;
+ Log, Errors: Texts.Text;
oldSF, newSF: Files.Rider;
R: ARRAY 3 OF Files.Rider;
@@ -121,52 +119,103 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
S: INTEGER;
- dontAsm-, dontLink-, mainProg-, mainLinkStat-, notColorOutput-, forceNewSym-, Verbose-: BOOLEAN;
-
- OBERON: ARRAY 1024 OF CHAR;
- MODULES: ARRAY 1024 OF CHAR;
+ ResourceDir*: ARRAY 1024 OF CHAR;
(* ------------------------- Log Output ------------------------- *)
- PROCEDURE LogW*(ch: CHAR); BEGIN Console.Char(ch) END LogW;
- PROCEDURE LogWStr*(s: ARRAY OF CHAR); BEGIN Console.String(s) END LogWStr;
- PROCEDURE LogWNum*(i, len: LONGINT); BEGIN Console.Int(i, len) END LogWNum;
- PROCEDURE LogWLn*; BEGIN Console.Ln END LogWLn;
+ PROCEDURE LogW*(ch: CHAR); BEGIN Out.Char(ch) END LogW;
+ PROCEDURE LogWStr*(s: ARRAY OF CHAR); BEGIN Out.String(s) END LogWStr;
+ PROCEDURE LogWNum*(i, len: SYSTEM.INT64); BEGIN Out.Int(i, len) END LogWNum;
+ PROCEDURE LogWLn*; BEGIN Out.Ln END LogWLn;
+
+ PROCEDURE LogVT100*(vt100code: ARRAY OF CHAR);
+ BEGIN
+ IF Out.IsConsole & ~(notcoloroutput IN Options) THEN
+ VT100.SetAttr(vt100code)
+ END
+ END LogVT100;
- (* ------------------------- parameter handling -------------------------*)
- PROCEDURE ScanOptions(VAR s: ARRAY OF CHAR; VAR opt: SET);
+ (* Integer size support *)
+
+ PROCEDURE SignedMaximum*(bytecount: LONGINT): SYSTEM.INT64;
+ VAR result: SYSTEM.INT64;
+ BEGIN
+ result := 1;
+ result := SYSTEM.LSH(result, bytecount*8-1);
+ RETURN result - 1;
+ END SignedMaximum;
+
+ PROCEDURE SignedMinimum*(bytecount: LONGINT): SYSTEM.INT64;
+ BEGIN RETURN -SignedMaximum(bytecount) - 1
+ END SignedMinimum;
+
+
+ (* Unchecked conversion of any size integer to INTEGER or LONGINT *)
+
+ PROCEDURE Longint* (n: SYSTEM.INT64): LONGINT; BEGIN RETURN SYSTEM.VAL(LONGINT, n) END Longint;
+ PROCEDURE Integer* (n: SYSTEM.INT64): INTEGER; BEGIN RETURN SYSTEM.VAL(INTEGER, n) END Integer;
+
+
+
+
+ (* --------------- Initialisation and parameter handling ---------------*)
+
+ PROCEDURE ScanOptions(s: ARRAY OF CHAR);
VAR i: INTEGER;
BEGIN
i := 1; (* skip - *)
WHILE s[i] # 0X DO
CASE s[i] OF
- | "a": opt := opt / {assert}
- | "c": opt := opt / {dontlink}
- | "e": opt := opt / {extsf}
- | "f": opt := opt / {notcoloroutput}
- | "k": opt := opt / {ansi} (* undocumented *)
- | "m": opt := opt / {mainprog}
- | "p": opt := opt / {ptrinit}
- | "r": opt := opt / {ranchk}
- | "s": opt := opt / {newsf}
- | "t": opt := opt / {typchk}
- | "x": opt := opt / {inxchk}
+ (* Run time safety *)
+ | "p": Options := Options / {ptrinit} (* Initialise pointers to NIL. *)
+ | "a": Options := Options / {assert} (* Halt on assertion failures. *)
+ | "r": Options := Options / {ranchk} (* Halt on range check failures. *)
+ | "t": Options := Options / {typchk} (* Halt on type guad failure. *)
+ | "x": Options := Options / {inxchk} (* Halt on index out of range. *)
- | "B": IF s[i+1] # 0X THEN INC(i); IntSize := ORD(s[i]) - ORD('0') END;
- IF s[i+1] # 0X THEN INC(i); PointerSize := ORD(s[i]) - ORD('0') END;
+ (* Symbol file management *)
+ | "e": Options := Options / {extsf} (* Allow extension of old symbol file. *)
+ | "s": Options := Options / {newsf} (* Allow generation of new symbol file. *)
+ | "F": Options := Options / {forcenewsym} (* Force generation of new symbol file. *)
+
+ (* C compiler and linker control *)
+ | "m": Options := Options / {mainprog} (* This module is main. Link dynamically. *)
+ | "M": Options := Options / {mainlinkstat} (* This module is main. Link statically. *)
+ | "S": Options := Options / {dontasm} (* Don't call C compiler *)
+ | "c": Options := Options / {dontlink} (* Don't link. *)
+
+ (* Miscellaneous *)
+ | "f": Options := Options / {notcoloroutput} (* Disable VT100 control characters in status output. *)
+ | "V": Options := Options / {verbose}
+
+ (* Elementary type size model *)
+ | "O": IF i+1 >= Strings.Length(s) THEN LogWStr("-O option requires following size model character."); LogWLn ELSE
+ Model[0] := s[i+1]; Model[1] := 0X;
+ IF (Model[0] # '2') & (Model[0] # 'C') & (Model[0] # 'V') THEN
+ LogWStr("Unrecognised size model character following -O."); LogWLn
+ END;
+ INC(i)
+ END
+
+ (* Target machine address size and alignment *)
+ | "A": IF i+2 >= Strings.Length(s) THEN LogWStr("-M option requires two following digits."); LogWLn ELSE
+ AddressSize := ORD(s[i+1]) - ORD('0'); Alignment := ORD(s[i+2]) - ORD('0');
+ INC(i, 2)
+ END
+
+ (* Temporary build control option - remove when makefile updated to new options. *)
+ | "B": IF s[i+1] # 0X THEN INC(i); IntegerSize := ORD(s[i]) - ORD('0') END;
+ IF s[i+1] # 0X THEN INC(i); AddressSize := ORD(s[i]) - ORD('0') END;
IF s[i+1] # 0X THEN INC(i); Alignment := ORD(s[i]) - ORD('0') END;
- ASSERT((IntSize = 2) OR (IntSize = 4));
- ASSERT((PointerSize = 4) OR (PointerSize = 8));
+ ASSERT((IntegerSize = 2) OR (IntegerSize = 4));
+ ASSERT((AddressSize = 4) OR (AddressSize = 8));
ASSERT((Alignment = 4) OR (Alignment = 8));
+ IF IntegerSize = 2 THEN LongintSize := 4 ELSE LongintSize := 8 END;
Files.SetSearchPath("")
- | "F": opt := opt / {forcenewsym}
- | "M": opt := opt / {mainlinkstat}
- | "S": opt := opt / {dontasm}
- | "V": opt := opt / {verbose}
ELSE
LogWStr(" warning: option ");
LogW(OptionChar);
@@ -179,91 +228,136 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
END ScanOptions;
- PROCEDURE ^GetProperties;
-
-
- (* Undocumented options used by the build system:
-
- The following parameter overrides the integer size, pointer size and alignment
- settings compiled into the binary. They are used when bootstrapping to generate
- the C source for a compiler with different sizes to the current compiler.
-
- -Bnnn Where each n is a single digit specifying the integer size, pointer size
- and alignment in bytes.
-
- An alignment of n means that types smaller than n align to their
- own size, types larger than n align to n bytes.
-
- LONGINT size will be set to twice the integer size.
- *)
+ PROCEDURE -GetAlignment(VAR a: INTEGER) "struct {char c; long long l;} _s; *a = (char*)&_s.l - (char*)&_s";
PROCEDURE OpenPar*(): BOOLEAN; (* prepare for a sequence of translations *)
VAR s: ARRAY 256 OF CHAR;
BEGIN
IF Platform.ArgCount = 1 THEN
LogWLn;
- LogWStr("Vishap Oberon-2 compiler v"); LogWStr(Configuration.versionLong); LogW("."); LogWLn;
- LogWStr("Based on Ofront by Software Templ OEG, continued by Norayr Chilingarian and others."); LogWLn;
+ LogWStr("Oberon-2 compiler v"); LogWStr(Configuration.versionLong); LogW("."); LogWLn;
+ LogWStr("Based on Ofront by J. Templ and Software Templ OEG."); LogWLn;
+ LogWStr("Further development by Norayr Chilingarian, David Brown and others."); LogWLn;
LogWLn;
- LogWStr('Usage:'); LogWLn; LogWLn;
- LogWStr(' '); LogWStr(Configuration.name); LogWStr(' options {files {options}}.'); LogWLn; LogWLn;
- LogWStr('Where options = ["-" {option} ].'); LogWLn;
+ LogWStr("Usage:"); LogWLn;
LogWLn;
- LogWStr(" m - generate code for main module"); LogWLn;
- LogWStr(" M - generate code for main module and link object statically"); LogWLn;
- LogWStr(" s - generate new symbol file"); LogWLn;
- LogWStr(" e - allow extending the module interface"); LogWLn;
- LogWStr(" r - check value ranges"); LogWLn;
- LogWStr(" x - turn off array indices check"); LogWLn;
- LogWStr(" a - don't check ASSERTs at runtime, use this option in tested production code"); LogWLn;
- LogWStr(" p - turn off automatic pointer initialization"); LogWLn;
- LogWStr(" t - don't check type guards (use in rare cases such as low-level modules where every cycle counts)"); LogWLn;
- LogWStr(" S - don't call external assembler/compiler, only generate C code"); LogWLn;
- LogWStr(" c - don't call linker"); LogWLn;
- LogWStr(" f - don't use color output"); LogWLn;
- LogWStr(" F - force writing new symbol file in current directory"); LogWLn;
- LogWStr(" V - verbose output"); LogWLn;
+ LogWStr(" "); LogWStr(Configuration.name); LogWStr(" options {files {options}}."); LogWLn;
LogWLn;
- LogWStr('Initial options specify defaults for all files.'); LogWLn;
- LogWStr('Options following a filename are specific to that file.'); LogWLn;
- LogWStr('Repeating an option toggles its value.'); LogWLn;
+ LogWStr('Options:'); LogWLn;
+ LogWLn;
+ LogWStr(" Run time safety"); LogWLn;
+ LogWStr(" -p Initialise pointers to NIL. On by default."); LogWLn;
+ LogWStr(" -a Halt on assertion failures. On by default."); LogWLn;
+ LogWStr(" -r Halt on range check failures."); LogWLn;
+ LogWStr(" -t Halt on type guard failure. On by default."); LogWLn;
+ LogWStr(" -x Halt on index out of range. On by default."); LogWLn;
+ LogWLn;
+ LogWStr(" Symbol file management"); LogWLn;
+ LogWStr(" -e Allow extension of old symbol file."); LogWLn;
+ LogWStr(" -s Allow generation of new symbol file."); LogWLn;
+ LogWStr(" -F Force generation of new symbol file."); LogWLn;
+ LogWLn;
+ LogWStr(" C compiler and linker control"); LogWLn;
+ LogWStr(" -m This module is main. Link dynamically."); LogWLn;
+ LogWStr(" -M This module is main. Link statically."); LogWLn;
+ LogWStr(" -S Don't call C compiler"); LogWLn;
+ LogWStr(" -c Don't link."); LogWLn;
+ LogWLn;
+ LogWStr(" Miscellaneous"); LogWLn;
+ LogWStr(" -f Disable VT100 control characters in status output."); LogWLn;
+ LogWStr(" -V Display compiler debugging messages."); LogWLn;
+ LogWLn;
+ LogWStr(" Size model for elementary types (default O2)"); LogWLn;
+ LogWStr(" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET."); LogWLn;
+ LogWStr(" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET."); LogWLn;
+ LogWStr(" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET."); LogWLn;
+ LogWLn;
+ LogWStr(" Target machine address size and alignment (default is that of the running compiler binary)"); LogWLn;
+ LogWStr(" -A44 32 bit addresses, 32 bit alignment (e.g. Unix/linux 32 bit on x86)."); LogWLn;
+ LogWStr(" -A48 32 bit addresses, 64 bit alignment (e.g. Windows 32 bit on x86, linux 32 bit on arm)."); LogWLn;
+ LogWStr(" -A88 64 bit addresses, 64 bit alignment (e.g. 64 bit platforms)."); LogWLn;
+ LogWLn;
+ LogWStr("All options are off by default, except where noted above."); LogWLn;
+ LogWStr("Initial options specify defaults for all files."); LogWLn;
+ LogWStr("Options following a filename are specific to that file."); LogWLn;
+ LogWStr("Repeating an option toggles its value."); LogWLn;
RETURN FALSE
ELSE
+ (* Set options to initial defaults *)
+ AddressSize := SIZE(SYSTEM.ADDRESS); (* This compilers address size *)
+ GetAlignment(Alignment); (* This compilers alignment *)
+ Model := "2"; (* Size model of common Oberon-2 implementations: S8/I16/L32 *)
+ Options := {inxchk, typchk, ptrinit, assert}; (* Default options *)
+
+ (* Pick up global option changes from start of command line *)
S:=1; s:=""; Platform.GetArg(S, s);
-
- glbopt := defopt;
-
WHILE s[0] = OptionChar DO
- ScanOptions(s, glbopt);
+ ScanOptions(s);
INC(S); s:=""; Platform.GetArg(S, s)
END;
+ (* Record global option settings for this command line *)
+ GlobalAddressSize := AddressSize;
+ GlobalAlignment := Alignment;
+ GlobalModel := Model;
+ GlobalOptions := Options;
+
RETURN TRUE
END;
END OpenPar;
- PROCEDURE InitOptions*; (* get the options for one translation *)
- VAR s: ARRAY 256 OF CHAR;
+ PROCEDURE VerboseListSizes;
BEGIN
- opt := glbopt;
+ LogWLn;
+ LogWStr("Type Size"); LogWLn;
+ LogWStr("SHORTINT "); LogWNum(ShortintSize, 4); LogWLn;
+ LogWStr("INTEGER "); LogWNum(IntegerSize, 4); LogWLn;
+ LogWStr("LONGINT "); LogWNum(LongintSize, 4); LogWLn;
+ LogWStr("SET "); LogWNum(LongintSize, 4); LogWLn;
+ LogWStr("ADDRESS "); LogWNum(AddressSize, 4); LogWLn;
+ LogWLn;
+ LogWStr("Alignment: "); LogWNum(Alignment, 4); LogWLn;
+ END VerboseListSizes;
+
+
+ PROCEDURE InitOptions*; (* get the options for one translation *)
+ VAR s: ARRAY 256 OF CHAR; searchpath, modules: ARRAY 1024 OF CHAR;
+ MODULES: ARRAY 1024 OF CHAR;
+
+ BEGIN
+ Options := GlobalOptions; Model:=GlobalModel; Alignment := GlobalAlignment; AddressSize := GlobalAddressSize;
+
s:=""; Platform.GetArg(S, s);
WHILE s[0] = OptionChar DO
- ScanOptions(s, opt);
+ ScanOptions(s);
INC(S); s:=""; Platform.GetArg(S, s)
END;
- dontAsm := dontasm IN opt;
- dontLink := dontlink IN opt;
- mainProg := mainprog IN opt;
- mainLinkStat := mainlinkstat IN opt;
- notColorOutput := notcoloroutput IN opt;
- forceNewSym := forcenewsym IN opt;
- Verbose := verbose IN opt;
+ IF mainlinkstat IN Options THEN INCL(Options, mainprog) END;
- IF mainLinkStat THEN INCL(glbopt, mainprog) END; (* sic *)
+ MaxIndex := SignedMaximum(AddressSize);
+ CASE Model[0] OF
+ |'2': ShortintSize := 1; IntegerSize := 2; LongintSize := 4
+ |'C': ShortintSize := 2; IntegerSize := 4; LongintSize := 8
+ |'V': ShortintSize := 1; IntegerSize := 4; LongintSize := 8
+ ELSE ShortintSize := 1; IntegerSize := 2; LongintSize := 4
+ END;
- GetProperties;
+ IF verbose IN Options THEN VerboseListSizes END;
+
+ ResourceDir := Configuration.installdir;
+ Strings.Append("/", ResourceDir);
+ Strings.Append(Model, ResourceDir);
+
+ modules := ""; Platform.GetEnv("MODULES", modules);
+ searchpath := "."; Platform.GetEnv("OBERON", searchpath);
+ Strings.Append(";.;", searchpath);
+ Strings.Append(modules, searchpath);
+ Strings.Append(";", searchpath);
+ Strings.Append(ResourceDir, searchpath);
+ Strings.Append("/sym;", searchpath);
+ Files.SetSearchPath(searchpath);
END InitOptions;
@@ -326,35 +420,29 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
PROCEDURE LogErrMsg(n: INTEGER);
- VAR
- S: Texts.Scanner; T: Texts.Text;
- ch: CHAR; i: INTEGER;
- buf: ARRAY 1024 OF CHAR;
+ VAR l: INTEGER; S: Texts.Scanner; c: CHAR;
BEGIN
IF n >= 0 THEN
- IF ~notColorOutput THEN vt100.SetAttr(vt100.Red) END;
- LogWStr(" err ");
- IF ~notColorOutput THEN vt100.SetAttr(vt100.ResetAll) END;
+ LogVT100(VT100.Red); LogWStr(" err "); LogVT100(VT100.ResetAll)
ELSE
- IF ~notColorOutput THEN vt100.SetAttr(vt100.Magenta) END;
- LogWStr(" warning "); n := -n;
- IF ~notColorOutput THEN vt100.SetAttr(vt100.ResetAll) END;
- END ;
+ LogVT100(VT100.Magenta); LogWStr(" warning "); n := -n; LogVT100(VT100.ResetAll)
+ END;
LogWNum(n, 1);
LogWStr(" ");
- (*NEW(T); Texts.Open(T, "vocErrors.Text"); Texts.OpenScanner(S, T, 0);
- REPEAT S.line := 0;
- REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0)
- UNTIL S.eot OR (S.class = Texts.Int) & (S.i = n);
- IF ~S.eot THEN Texts.Read(S, ch); i := 0;
- WHILE ~S.eot & (ch # 0DX) DO buf[i] := ch; INC(i); Texts.Read(S, ch) END ;
- buf[i] := 0X; LogWStr(buf);
- END*)
- LogWStr(errors.errors[n]);
+
+ IF Errors = NIL THEN NEW(Errors); Texts.Open(Errors, "Errors.Txt") END;
+
+ Texts.OpenScanner(S, Errors, 0);
+ REPEAT l := S.line; Texts.Scan(S)
+ UNTIL (l # S.line) & (S.class = Texts.Int) & (S.i = n) OR S.eot;
+ IF ~S.eot THEN
+ Texts.Read(S, c);
+ WHILE ~S.eot & (c >= ' ') DO Out.Char(c); Texts.Read(S, c) END
+ END
END LogErrMsg;
- PROCEDURE FindLine(f: Files.File; VAR r: Files.Rider; pos: LONGINT);
+ PROCEDURE FindLine(f: Files.File; VAR r: Files.Rider; pos: SYSTEM.INT64);
(* Updates ErrorLineStartPos, ErrorLineLimitPos, ErrorLineNumber to
describe the line containing pos.
Exits with the rider set to the start of the line conaining pos. *)
@@ -386,7 +474,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
END FindLine;
- PROCEDURE ShowLine(pos: LONGINT);
+ PROCEDURE ShowLine(pos: SYSTEM.INT64);
VAR
f: Files.File;
r: Files.Rider;
@@ -408,12 +496,10 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
LogWStr(" ");
IF pos >= ErrorLineLimitPos THEN pos := ErrorLineLimitPos-1 END;
- i := SHORT(pos - ErrorLineStartPos);
+ i := SHORT(Longint(pos - ErrorLineStartPos));
WHILE i > 0 DO LogW(" "); DEC(i) END;
- IF ~notColorOutput THEN vt100.SetAttr(vt100.Green) END;
- LogW("^");
- IF ~notColorOutput THEN vt100.SetAttr(vt100.ResetAll) END;
+ LogVT100(VT100.Green); LogW("^"); LogVT100(VT100.ResetAll);
Files.Close(f);
END ShowLine;
@@ -450,180 +536,46 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
END err;
- PROCEDURE FPrint*(VAR fp: LONGINT; val: LONGINT);
+ (* ------------------------ Fingerprint hashing ----------------------- *)
+
+ PROCEDURE FingerprintBytes(VAR fp: LONGINT; VAR bytes: ARRAY OF SYSTEM.BYTE);
+ VAR i: INTEGER; l: LONGINT;
BEGIN
- fp := SYSTEM.ROT(SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, fp) / SYSTEM.VAL(SET, val)), 1)
- END FPrint;
-
-
- PROCEDURE FPrintSet*(VAR fp: LONGINT; set: SET);
- BEGIN FPrint(fp, SYSTEM.VAL(LONGINT, set))
- END FPrintSet;
-
-
- PROCEDURE FPrintReal*(VAR fp: LONGINT; real: REAL);
- VAR i: INTEGER; l: LONGINT;
- BEGIN
- IF SIZE(REAL) = SIZE(INTEGER) THEN
- SYSTEM.GET(SYSTEM.ADR(real), i); l := i;
- ELSE
- SYSTEM.GET(SYSTEM.ADR(real), l);
- END;
- FPrint(fp, l)
- END FPrintReal;
-
-
- PROCEDURE FPrintLReal*(VAR fp: LONGINT; lr: LONGREAL);
- VAR l, h: LONGINT;
- BEGIN
- IF SIZE(LONGREAL) = SIZE(LONGINT) THEN
- (* 64 bit LONGINT *)
- FPrint(fp, SYSTEM.VAL(LONGINT, lr))
- ELSE
- (* 32 bit LONGINT *)
- SYSTEM.GET(SYSTEM.ADR(lr), l); SYSTEM.GET(SYSTEM.ADR(lr)+4, h);
- FPrint(fp, l); FPrint(fp, h)
+ ASSERT(LEN(bytes) MOD SIZE(LONGINT) = 0);
+ i := 0; WHILE i < LEN(bytes) DO
+ SYSTEM.GET(SYSTEM.ADR(bytes[i]), l);
+ fp := SYSTEM.ROT(SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, fp) / SYSTEM.VAL(SET, l)), 1);
+ INC(i, SIZE(LONGINT))
END
- END FPrintLReal;
+ END FingerprintBytes;
+
+ PROCEDURE FPrint* (VAR fp: LONGINT; val: HUGEINT); BEGIN FingerprintBytes(fp, val) END FPrint;
+ PROCEDURE FPrintSet* (VAR fp: LONGINT; val: SYSTEM.SET64); BEGIN FingerprintBytes(fp, val) END FPrintSet;
+ PROCEDURE FPrintReal* (VAR fp: LONGINT; val: REAL); BEGIN FingerprintBytes(fp, val) END FPrintReal;
+ PROCEDURE FPrintLReal*(VAR fp: LONGINT; val: LONGREAL); BEGIN FingerprintBytes(fp, val) END FPrintLReal;
- (* ------------------------- initialization ------------------------- *)
-
- PROCEDURE GetProperty(VAR S: Texts.Scanner; name: ARRAY OF CHAR; VAR size, align: INTEGER);
- BEGIN
- IF (S.class = Texts.Name) & (S.s = name) THEN Texts.Scan(S);
- IF S.class = Texts.Int THEN size := SHORT(S.i); Texts.Scan(S) ELSE Mark(-157, -1) END ;
- IF S.class = Texts.Int THEN align := SHORT(S.i); Texts.Scan(S) ELSE Mark(-157, -1) END
- ELSE Mark(-157, -1)
- END
- END GetProperty;
-
-
- PROCEDURE minusop(i: LONGINT): LONGINT;
- BEGIN
- RETURN -i;
- END minusop;
-
-
- PROCEDURE power0(i, j : LONGINT) : LONGINT; (* we would like to calculate exact Min Max values in GetProperties, not hardcode em, noch *)
- VAR k : LONGINT;
- p : LONGINT;
- BEGIN
- k := 1;
- p := i;
- REPEAT
- p := p * i;
- INC(k);
- UNTIL k=j;
- RETURN p;
- END power0;
-
-
- PROCEDURE VerboseListSizes;
- BEGIN
- LogWLn;
- LogWStr("Type Size Alignement"); LogWLn;
- LogWStr("CHAR "); LogWNum(CharSize, 4); (* LogWNum(CharAlign, 5); *) LogWLn;
- LogWStr("BOOLEAN "); LogWNum(BoolSize, 4); (* LogWNum(BoolAlign, 5); *) LogWLn;
- LogWStr("SHORTINT "); LogWNum(SIntSize, 4); (* LogWNum(SIntAlign, 5); *) LogWLn;
- LogWStr("INTEGER "); LogWNum(IntSize, 4); (* LogWNum(IntAlign, 5); *) LogWLn;
- LogWStr("LONGINT "); LogWNum(LIntSize, 4); (* LogWNum(LIntAlign, 5); *) LogWLn;
- LogWStr("SET "); LogWNum(SetSize, 4); (* LogWNum(SetAlign, 5); *) LogWLn;
- LogWStr("REAL "); LogWNum(RealSize, 4); (* LogWNum(RealAlign, 5); *) LogWLn;
- LogWStr("LONGREAL "); LogWNum(LRealSize, 4); (* LogWNum(LRealAlign, 5); *) LogWLn;
- LogWStr("PTR "); LogWNum(PointerSize, 4); (* LogWNum(PointerAlign, 5); *) LogWLn;
- LogWStr("PROC "); LogWNum(ProcSize, 4); (* LogWNum(ProcAlign, 5); *) LogWLn;
- LogWStr("RECORD "); LogWNum(RecSize, 4); (* LogWNum(RecAlign, 5); *) LogWLn;
- (*LogWStr("ENDIAN "); LogWNum(ByteOrder, 4); LogWNum(BitOrder, 5); LogWLn;*)
- LogWLn;
- (*
- LogWStr("Min shortint "); LogWNum(MinSInt, 4); LogWLn;
- LogWStr("Max shortint "); LogWNum(MaxSInt, 4); LogWLn;
- LogWStr("Min integer "); LogWNum(MinInt, 4); LogWLn;
- LogWStr("Max integer "); LogWNum(MaxInt, 4); LogWLn;
- LogWStr("Min longint "); LogWNum(MinLInt, 4); LogWLn;
- *)
- END VerboseListSizes;
-
-
- (*
- PROCEDURE AlignSize*(size: LONGINT): INTEGER;
- VAR align: INTEGER;
- BEGIN
- IF size < Alignment THEN
- IF size > 8 THEN align := 16
- ELSIF size > 4 THEN align := 8
- ELSIF size > 2 THEN align := 4
- ELSE align := SHORT(size)
- END
- ELSE
- align := Alignment
- END;
- RETURN align
- END AlignSize;
- *)
-
- PROCEDURE SignedMaximum*(bytecount: LONGINT): LONGINT;
- VAR result: LONGINT;
- BEGIN
- result := 1;
- result := SYSTEM.LSH(result, bytecount*8-1);
- RETURN result - 1;
- END SignedMaximum;
-
- PROCEDURE SignedMinimum*(bytecount: LONGINT): LONGINT;
- BEGIN RETURN -SignedMaximum(bytecount) - 1
- END SignedMinimum;
-
-
-
-
- PROCEDURE GetProperties();
- (* VAR base: LONGINT; *)
- BEGIN
- (* Fixed and Configuration.Mod based sizes have been initialised in
- the module startup code, and maybe overridden by the -Bnnn bootstrap
- parameter *)
-
- (* Derived sizes *)
- ProcSize := PointerSize;
- LIntSize := IntSize * 2;
- SetSize := LIntSize;
-
- IF RealSize = 4 THEN MaxReal := 3.40282346D38
- ELSIF RealSize = 8 THEN MaxReal := 1.7976931348623157D307 * 9.999999
- (*should be 1.7976931348623157D308 *)
- END ;
-
- IF LRealSize = 4 THEN MaxLReal := 3.40282346D38
- ELSIF LRealSize = 8 THEN MaxLReal := 1.7976931348623157D307 * 9.999999
- (*should be 1.7976931348623157D308 *)
- END ;
-
- MinReal := -MaxReal;
- MinLReal := -MaxLReal;
- MaxSet := SetSize * 8 - 1;
- MaxIndex := SignedMaximum(PointerSize);
-
- IF Verbose THEN VerboseListSizes END;
- END GetProperties;
-
(* ------------------------- Read Symbol File ------------------------- *)
-
PROCEDURE SymRCh*(VAR ch: CHAR);
BEGIN Files.Read(oldSF, ch)
END SymRCh;
+ (* todo - combine RInt64 and RInt *)
PROCEDURE SymRInt*(): LONGINT;
VAR k: LONGINT;
BEGIN Files.ReadNum(oldSF, k); RETURN k
END SymRInt;
- PROCEDURE SymRSet*(VAR s: SET);
- BEGIN Files.ReadNum(oldSF, SYSTEM.VAL(LONGINT, s))
+ PROCEDURE SymRInt64*(): SYSTEM.INT64;
+ VAR k: SYSTEM.INT64;
+ BEGIN Files.ReadNum(oldSF, k); RETURN k
+ END SymRInt64;
+
+ PROCEDURE SymRSet*(VAR s: SYSTEM.SET64);
+ BEGIN Files.ReadNum(oldSF, s)
END SymRSet;
PROCEDURE SymRReal*(VAR r: REAL);
@@ -635,16 +587,17 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
END SymRLReal;
PROCEDURE CloseOldSym*;
+ BEGIN Files.Close(Files.Base(oldSF))
END CloseOldSym;
PROCEDURE OldSym*(VAR modName: ARRAY OF CHAR; VAR done: BOOLEAN);
- VAR ch: CHAR; fileName: FileName;
+ VAR tag, ver: CHAR; fileName: FileName;
BEGIN
MakeFileName(modName, fileName, SFext);
oldSFile := Files.Old(fileName); done := oldSFile # NIL;
IF done THEN
- Files.Set(oldSF, oldSFile, 0); Files.Read(oldSF, ch);
- IF ch # SFtag THEN err(-306); (*possibly a symbol file from another Oberon implementation, e.g. HP-Oberon*)
+ Files.Set(oldSF, oldSFile, 0); Files.Read(oldSF, tag); Files.Read(oldSF, ver);
+ IF (tag # SFtag) OR (ver # SFver) THEN err(-306); (*possibly a symbol file from another Oberon implementation, e.g. HP-Oberon*)
CloseOldSym; done := FALSE
END
END
@@ -663,12 +616,12 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
BEGIN Files.Write(newSF, ch)
END SymWCh;
- PROCEDURE SymWInt*(i: LONGINT);
+ PROCEDURE SymWInt*(i: SYSTEM.INT64);
BEGIN Files.WriteNum(newSF, i)
END SymWInt;
- PROCEDURE SymWSet*(s: SET);
- BEGIN Files.WriteNum(newSF, SYSTEM.VAL(LONGINT, s))
+ PROCEDURE SymWSet*(s: SYSTEM.SET64);
+ BEGIN Files.WriteNum(newSF, SYSTEM.VAL(SYSTEM.INT64, s))
END SymWSet;
PROCEDURE SymWReal*(r: REAL);
@@ -681,7 +634,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
PROCEDURE RegisterNewSym*;
BEGIN
- IF (modName # "SYSTEM") OR (mainprog IN opt) THEN Files.Register(newSFile) END
+ IF (modName # "SYSTEM") OR (mainprog IN Options) THEN Files.Register(newSFile) END
END RegisterNewSym;
PROCEDURE DeleteNewSym*;
@@ -691,7 +644,8 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
VAR fileName: FileName;
BEGIN MakeFileName(modName, fileName, SFext);
newSFile := Files.New(fileName);
- IF newSFile # NIL THEN Files.Set(newSF, newSFile, 0); Files.Write(newSF, SFtag)
+ IF newSFile # NIL THEN Files.Set(newSF, newSFile, 0);
+ Files.Write(newSF, SFtag); Files.Write(newSF, SFver)
ELSE err(153)
END
END NewSym;
@@ -719,9 +673,9 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
Files.WriteBytes(R[currFile], s, i)
END WriteStringVar;
- PROCEDURE WriteHex* (i: LONGINT);
+ PROCEDURE WriteHex* (i: SYSTEM.INT64);
VAR s: ARRAY 3 OF CHAR;
- digit : INTEGER;
+ digit : SYSTEM.INT32;
BEGIN
digit := SHORT(i) DIV 16;
IF digit < 10 THEN s[0] := CHR (ORD ("0") + digit); ELSE s[0] := CHR (ORD ("a") - 10 + digit ); END;
@@ -731,10 +685,10 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
WriteString(s)
END WriteHex;
- PROCEDURE WriteInt* (i: LONGINT);
- VAR s: ARRAY 20 OF CHAR; i1, k: LONGINT;
+ PROCEDURE WriteInt* (i: SYSTEM.INT64);
+ VAR s: ARRAY 24 OF CHAR; i1, k: SYSTEM.INT64;
BEGIN
- IF (i = SignedMinimum(IntSize)) OR (i = SignedMinimum(LIntSize)) THEN
+ IF (i = SignedMinimum(2)) OR (i = SignedMinimum(4)) OR (i = SignedMinimum(8)) THEN
(* abs(minint) is one more than maxint, causing problems representing the value as a minus sign
followed by absoute value. Therefore represent as -maxint - 1. For INTEGER this avoids a
compiler warning 'this decimal constant is unsigned only in ISO C90', for LONGINT it is the
@@ -752,7 +706,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
VAR W: Texts.Writer; T: Texts.Text; R: Texts.Reader; s: ARRAY 32 OF CHAR; ch: CHAR; i: INTEGER;
BEGIN
(*should be improved *)
- IF (r < SignedMaximum(LIntSize)) & (r > SignedMinimum(LIntSize)) & (r = ENTIER(r)) THEN
+ IF (r < SignedMaximum(LongintSize)) & (r > SignedMinimum(LongintSize)) & (r = ENTIER(r)) THEN
IF suffx = "f" THEN WriteString("(REAL)") ELSE WriteString("(LONGREAL)") END ;
WriteInt(ENTIER(r))
ELSE
@@ -807,8 +761,8 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
IF noerr THEN LogWStr(" "); LogWNum(Files.Pos(R[BodyFile]), 0); LogWStr(" chars.") END;
IF noerr THEN
IF modName = "SYSTEM" THEN
- IF ~(mainprog IN opt) THEN Files.Register(BFile) END
- ELSIF ~(mainprog IN opt) THEN
+ IF ~(mainprog IN Options) THEN Files.Register(BFile) END
+ ELSIF ~(mainprog IN Options) THEN
Append(R[HeaderInclude], HFile);
Files.Register(HIFile); Files.Register(BFile)
ELSE
@@ -822,28 +776,11 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
END CloseFiles;
+
+
BEGIN
-
- Texts.OpenWriter(W);
-
- MODULES := ""; Platform.GetEnv("MODULES", MODULES);
-
- OBERON := "."; Platform.GetEnv("OBERON", OBERON);
- Strings.Append(";.;", OBERON);
- Strings.Append(MODULES, OBERON);
- Strings.Append(";", OBERON);
- Strings.Append(Configuration.installdir, OBERON);
- Strings.Append("/sym;", OBERON);
-
- Files.SetSearchPath(OBERON);
-
- (* Fixed type sizes *)
- CharSize := 1; BoolSize := 1; SIntSize := 1; RecSize := 1; ByteSize := 1;
- RealSize := 4; LRealSize := 8;
-
- (* type sizes with configuration based defaults *)
- PointerSize := Configuration.addressSize;
- Alignment := Configuration.alignment;
- IntSize := Configuration.intsize;
-
+ MaxReal := 3.40282346D38; (* REAL is 4 bytes *)
+ MaxLReal := 1.7976931348623157D307 * 9.999999; (* LONGREAL is 8 bytes, should be 1.7976931348623157D308 *)
+ MinReal := -MaxReal;
+ MinLReal := -MaxLReal;
END OPM.
diff --git a/src/compiler/OPP.Mod b/src/compiler/OPP.Mod
index 56f2a3d0..329d52b4 100644
--- a/src/compiler/OPP.Mod
+++ b/src/compiler/OPP.Mod
@@ -1,7 +1,7 @@
MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
IMPORT
- OPB, OPT, OPS, OPM;
+ OPB, OPT, OPS, OPM, SYSTEM;
TYPE
CaseTable = ARRAY OPM.MaxCases OF
@@ -69,16 +69,16 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
END CheckMark;
PROCEDURE CheckSysFlag(VAR sysflag: INTEGER; default: INTEGER);
- VAR x: OPT.Node; sf: LONGINT;
+ VAR x: OPT.Node; sf: SYSTEM.INT64;
BEGIN
IF sym = OPS.lbrak THEN OPS.Get(sym);
IF ~OPT.SYSimported THEN err(135) END;
ConstExpression(x);
- IF x^.typ^.form IN OPT.intSet THEN sf := x^.conval^.intval;
+ IF x^.typ^.form = OPT.Int THEN sf := x^.conval^.intval;
IF (sf < 0) OR (sf > OPM.MaxSysFlag) THEN err(220); sf := 0 END
ELSE err(51); sf := 0
END ;
- sysflag := SHORT(sf); CheckSym(OPS.rbrak)
+ sysflag := OPM.Integer(sf); CheckSym(OPS.rbrak)
ELSE sysflag := default
END
END CheckSysFlag;
@@ -141,7 +141,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
END RecordType;
PROCEDURE ArrayType(VAR typ, banned: OPT.Struct);
- VAR x: OPT.Node; n: LONGINT; sysflag: INTEGER;
+ VAR x: OPT.Node; n: SYSTEM.INT64; sysflag: INTEGER;
BEGIN CheckSysFlag(sysflag, 0);
IF sym = OPS.of THEN (*dynamic array*)
typ := OPT.NewStr(OPT.Comp, OPT.DynArr); typ^.mno := 0; typ^.sysflag := sysflag;
@@ -152,11 +152,11 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
END
ELSE
typ := OPT.NewStr(OPT.Comp, OPT.Array); typ^.sysflag := sysflag; ConstExpression(x);
- IF x^.typ^.form IN OPT.intSet THEN n := x^.conval^.intval;
+ IF x^.typ^.form = OPT.Int THEN n := x^.conval^.intval;
IF (n <= 0) OR (n > OPM.MaxIndex) THEN err(63); n := 1 END
ELSE err(51); n := 1
END ;
- typ^.n := n;
+ typ^.n := OPM.Longint(n);
IF sym = OPS.of THEN
OPS.Get(sym); Type(typ^.BaseTyp, banned);
typ^.BaseTyp^.pvused := TRUE
@@ -218,6 +218,12 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
END
END ;
CheckSym(OPS.colon); Type(typ, OPT.notyp);
+
+ IF ((typ.comp = OPT.Array) OR (typ.comp = OPT.Record))
+ & (typ.strobj = NIL) THEN
+ err(-309)
+ END;
+
IF mode = OPT.Var THEN typ^.pvused := TRUE END ;
(* typ^.pbused is set when parameter type name is parsed *)
WHILE first # NIL DO first^.typ := typ; first := first^.link END ;
@@ -530,7 +536,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
forward: BOOLEAN;
PROCEDURE GetCode;
- VAR ext: OPT.ConstExt; n: INTEGER; c: LONGINT;
+ VAR ext: OPT.ConstExt; n: INTEGER; c: SYSTEM.INT64;
BEGIN
ext := OPT.NewExt(); proc^.conval^.ext := ext; n := 0;
IF sym = OPS.string THEN
@@ -665,20 +671,20 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
END
END ProcedureDeclaration;
- PROCEDURE CaseLabelList(VAR lab: OPT.Node; LabelForm: INTEGER; VAR n: INTEGER; VAR tab: CaseTable);
+ PROCEDURE CaseLabelList(VAR lab: OPT.Node; LabelTyp: OPT.Struct; VAR n: INTEGER; VAR tab: CaseTable);
VAR x, y, lastlab: OPT.Node; i, f: INTEGER; xval, yval: LONGINT;
BEGIN lab := NIL; lastlab := NIL;
LOOP ConstExpression(x); f := x^.typ^.form;
- IF f IN OPT.intSet + {OPT.Char} THEN xval := x^.conval^.intval
+ IF f IN {OPT.Int, OPT.Char} THEN xval := OPM.Longint(x^.conval^.intval)
ELSE err(61); xval := 1
- END ;
- IF f IN OPT.intSet THEN
- IF LabelForm < f THEN err(60) END
- ELSIF LabelForm # f THEN err(60)
+ END;
+ IF f = OPT.Int THEN
+ IF ~(LabelTyp.form = OPT.Int) OR (LabelTyp.size < x.typ.size) THEN err(60) END
+ ELSIF LabelTyp.form # f THEN err(60)
END ;
IF sym = OPS.upto THEN
- OPS.Get(sym); ConstExpression(y); yval := y^.conval^.intval;
- IF (y^.typ^.form # f) & ~((f IN OPT.intSet) & (y^.typ^.form IN OPT.intSet)) THEN err(60) END ;
+ OPS.Get(sym); ConstExpression(y); yval := OPM.Longint(y^.conval^.intval);
+ IF (y^.typ^.form # f) & ~((f = OPT.Int) & (y^.typ^.form = OPT.Int)) THEN err(60) END ;
IF yval < xval THEN err(63); yval := xval END
ELSE yval := xval
END ;
@@ -714,12 +720,12 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
BEGIN
Expression(x); pos := OPM.errpos;
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126)
- ELSIF ~(x^.typ^.form IN {OPT.Char..OPT.LInt}) THEN err(125)
+ ELSIF ~(x^.typ^.form IN {OPT.Char..OPT.Int}) THEN err(125)
END ;
CheckSym(OPS.of); cases := NIL; lastcase := NIL; n := 0;
LOOP
IF sym < OPS.bar THEN
- CaseLabelList(lab, x^.typ^.form, n, tab);
+ CaseLabelList(lab, x^.typ, n, tab);
CheckSym(OPS.colon); StatSeq(y);
OPB.Construct(OPT.Ncasedo, lab, y); OPB.Link(cases, lastcase, lab)
END ;
@@ -802,7 +808,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
ELSIF sym = OPS.for THEN
OPS.Get(sym);
IF sym = OPS.ident THEN qualident(id);
- IF ~(id^.typ^.form IN OPT.intSet) THEN err(68) END ;
+ IF ~(id^.typ^.form = OPT.Int) THEN err(68) END ;
CheckSym(OPS.becomes); Expression(y); pos := OPM.errpos;
x := OPB.NewLeaf(id); OPB.Assign(x, y); SetPos(x);
CheckSym(OPS.to); Expression(y); pos := OPM.errpos;
@@ -817,7 +823,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
END ;
z := OPB.NewLeaf(t); OPB.Assign(z, y); SetPos(z); OPB.Link(stat, last, z);
y := OPB.NewLeaf(t)
- ELSIF (y^.typ^.form < OPT.SInt) OR (y^.typ^.form > x^.left^.typ^.form) THEN err(113)
+ ELSIF ~(y^.typ^.form = OPT.Int) OR (y.typ.size > x.left.typ.size) THEN err(113)
END ;
OPB.Link(stat, last, x);
IF sym = OPS.by THEN OPS.Get(sym); ConstExpression(z) ELSE z := OPB.NewIntConst(1) END ;
diff --git a/src/compiler/OPS.Mod b/src/compiler/OPS.Mod
index 33b325d8..909cdee2 100644
--- a/src/compiler/OPS.Mod
+++ b/src/compiler/OPS.Mod
@@ -1,6 +1,6 @@
MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *)
- IMPORT OPM;
+ IMPORT OPM, SYSTEM;
CONST
MaxStrLen* = 256;
@@ -51,8 +51,8 @@ MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *)
(* name, str, numtyp, intval, realval, lrlval are implicit results of Get *)
name*: Name;
str*: String;
- numtyp*: INTEGER; (* 1 = char, 2 = integer, 3 = real, 4 = longreal *)
- intval*: LONGINT; (* integer value or string length *)
+ numtyp*: INTEGER; (* 1 = char, 2 = integer, 3 = real, 4 = longreal *)
+ intval*: SYSTEM.INT64; (* integer value or string length *)
realval*: REAL;
lrlval*: LONGREAL;
@@ -89,7 +89,8 @@ MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *)
END Identifier;
PROCEDURE Number;
- VAR i, m, n, d, e, maxHdig: INTEGER; dig: ARRAY 24 OF CHAR; f: LONGREAL; expCh: CHAR; neg: BOOLEAN;
+ CONST maxhexdigits = 16;
+ VAR i, m, n, d, e: INTEGER; dig: ARRAY 24 OF CHAR; f: LONGREAL; expCh: CHAR; neg: BOOLEAN;
PROCEDURE Ten(e: INTEGER): LONGREAL;
VAR x, p: LONGREAL;
@@ -135,15 +136,14 @@ MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *)
ELSE err(203)
END
ELSIF ch = "H" THEN (* hexadecimal *) OPM.Get(ch); numtyp := integer;
- IF MAX(LONGINT) > 2147483647 THEN maxHdig := 16 ELSE maxHdig := 8 END;
- IF n <= maxHdig THEN
- IF (n = maxHdig) & (dig[0] > "7") THEN (* prevent overflow *) intval := -1 END;
+ IF n <= maxhexdigits THEN
+ IF (n = maxhexdigits) & (dig[0] > "7") THEN (* prevent overflow *) intval := -1 END;
WHILE i < n DO intval := intval*10H + Ord(dig[i], TRUE); INC(i) END
ELSE err(203)
END
ELSE (* decimal *) numtyp := integer;
WHILE i < n DO d := Ord(dig[i], FALSE); INC(i);
- IF intval <= (MAX(LONGINT) - d) DIV 10 THEN intval := intval*10 + d
+ IF intval <= (MAX(SYSTEM.INT64) - d) DIV 10 THEN intval := intval*10 + d
ELSE err(203)
END
END
diff --git a/src/compiler/OPT.Mod b/src/compiler/OPT.Mod
index fb77b0ea..54975745 100644
--- a/src/compiler/OPT.Mod
+++ b/src/compiler/OPT.Mod
@@ -4,7 +4,7 @@ MODULE OPT; (* NW, RC 6.3.89 / 23.1.92 *) (* object model 24.2.94 *)
2002-08-20 jt: NewStr: txtpos remains 0 for structs read from symbol file
*)
-IMPORT OPS, OPM;
+IMPORT OPS, OPM, SYSTEM;
(* Constants - value of literals *)
@@ -12,11 +12,11 @@ TYPE
Const* = POINTER TO ConstDesc;
ConstExt* = POINTER TO OPS.String;
ConstDesc* = RECORD
- ext*: ConstExt; (* string or code for code proc *)
- intval*: LONGINT; (* constant value or adr, proc par size, text position or least case label *)
- intval2*: LONGINT; (* string length, proc var size or larger case label *)
- setval*: SET; (* constant value, procedure body present or "ELSE" present in case *)
- realval*: LONGREAL (* real or longreal constant value *)
+ ext*: ConstExt; (* string or code for code proc *)
+ intval*: SYSTEM.INT64; (* constant value or adr, proc par size, text position or least case label *)
+ intval2*: LONGINT; (* string length, proc var size or larger case label *)
+ setval*: SYSTEM.SET64; (* constant value, procedure body present or "ELSE" present in case *)
+ realval*: LONGREAL (* real or longreal constant value *)
END;
CONST
@@ -83,7 +83,7 @@ TYPE
allocated*: BOOLEAN;
pbused*, pvused*: BOOLEAN;
fpdone, idfpdone: BOOLEAN;
- idfp, pbfp, pvfp: LONGINT;
+ idfp*, pbfp, pvfp: LONGINT;
BaseTyp*: Struct;
link*, strobj*: Object
END;
@@ -91,12 +91,12 @@ TYPE
CONST
(* Struct.form values *)
Undef* = 0; Byte* = 1; Bool* = 2; Char* = 3;
- SInt* = 4; Int* = 5; LInt* = 6;
- Real* = 7; LReal* = 8; Set* = 9; String* = 10;
- NilTyp* = 11; NoTyp* = 12; Pointer* = 13; ProcTyp* = 14;
- Comp* = 15;
+ Int* = 4;
+ Real* = 5; LReal* = 6; Set* = 7; String* = 8;
+ NilTyp* = 9; NoTyp* = 10; Pointer* = 11; ProcTyp* = 12;
+ Comp* = 13;
- intSet* = {SInt..LInt}; realSet* = {Real, LReal};
+ realSet* = {Real, LReal};
(* Struct.comp - Composite structure forms *)
Basic* = 1; Array* = 2; DynArr* = 3; Record* = 4;
@@ -149,14 +149,17 @@ CONST
FirstRef = Comp + 1;
VAR
- typSize*: PROCEDURE(typ: Struct);
topScope*: Object;
- undftyp*,
- bytetyp*, booltyp*, chartyp*,
- sinttyp*, inttyp*, linttyp*,
- realtyp*, lrltyp*, settyp*, stringtyp*,
- niltyp*, notyp*, sysptrtyp*: Struct;
+ undftyp*, niltyp*, notyp*,
+ bytetyp*, cpbytetyp*, booltyp*, chartyp*,
+ sinttyp*, inttyp*, linttyp*, hinttyp*,
+ int8typ*, int16typ*, int32typ*, int64typ*,
+ settyp*, set32typ*, set64typ*,
+ realtyp*, lrltyp*, stringtyp*,
+ adrtyp*, sysptrtyp*: Struct;
+
+ sintobj*, intobj*, lintobj*, setobj*: Object;
nofGmod*: SHORTINT; (*nof imports*)
GlbMod*: ARRAY maxImps OF Object; (* ^.right = first object, ^.name = module import name (not alias) *)
@@ -164,10 +167,10 @@ VAR
SelfName*: OPS.Name; (* name of module being compiled *)
SYSimported*: BOOLEAN;
+
+
CONST
-
-
(* Symbol file items *)
Smname* = 16; Send* = 18; Stype* = 19; Salias* = 20; Svar* = 21;
Srvar* = 22; Svalpar* = 23; Svarpar* = 24; Sfld* = 25; Srfld* = 26;
@@ -201,10 +204,148 @@ VAR
newsf, findpc: BOOLEAN;
extsf, sfpresent: BOOLEAN;
symExtended, symNew: BOOLEAN;
+ recno: LONGINT; (* number of anonymous record types *)
+
+
+
+PROCEDURE InitRecno*; BEGIN recno := 0 END InitRecno;
+PROCEDURE err(n: INTEGER); BEGIN OPM.err(n) END err;
+
+
+PROCEDURE IntSize*(n: SYSTEM.INT64):INTEGER;
+(* Determines number of bytes required to store signed value n. *)
+ VAR bytes: INTEGER;
+BEGIN
+ IF n < 0 THEN n := -(n+1) END;
+ bytes := 1; WHILE (bytes < 8) & (ASH(n, -(8*bytes-1)) # 0) DO INC(bytes) END;
+ RETURN bytes
+END IntSize;
+
+PROCEDURE IntType*(size: LONGINT): Struct;
+(* Selects smallest standard integer type for given size in bytes *)
+BEGIN
+ IF size <= int8typ.size THEN RETURN int8typ END;
+ IF size <= int16typ.size THEN RETURN int16typ END;
+ IF size <= int32typ.size THEN RETURN int32typ END;
+ RETURN int64typ
+END IntType;
+
+PROCEDURE SetType*(size: LONGINT): Struct;
+BEGIN
+ IF size = set32typ.size THEN RETURN set32typ END;
+ RETURN set64typ
+END SetType;
+
+PROCEDURE ShorterOrLongerType*(x: Struct; dir: INTEGER): Struct;
+ VAR i: INTEGER;
+BEGIN
+ ASSERT(x.form = Int);
+ ASSERT(x.BaseTyp = undftyp);
+ ASSERT((dir = 1) OR (dir = -1));
+ IF dir > 0 THEN
+ IF x.size < sinttyp.size THEN RETURN sinttyp END;
+ IF x.size < inttyp.size THEN RETURN inttyp END;
+ IF x.size < linttyp.size THEN RETURN linttyp END;
+ RETURN int64typ
+ ELSE
+ IF x.size > linttyp.size THEN RETURN linttyp END;
+ IF x.size > inttyp.size THEN RETURN inttyp END;
+ IF x.size > sinttyp.size THEN RETURN sinttyp END;
+ RETURN int8typ
+ END
+END ShorterOrLongerType;
+
+
+PROCEDURE Align*(VAR adr: LONGINT; base: LONGINT);
+BEGIN
+ CASE base OF
+ | 2: INC(adr, adr MOD 2)
+ | 4: INC(adr, (-adr) MOD 4)
+ | 8: INC(adr, (-adr) MOD 8)
+ | 16: INC(adr, (-adr) MOD 16)
+ ELSE (*1*) (*OPM.LogWStr("unhandled case at OPC.Align, base = "); OPM.LogWNum(base, 0); OPM.LogWLn;*)
+ END
+END Align;
+
+PROCEDURE SizeAlignment*(size: LONGINT): LONGINT;
+ VAR alignment: LONGINT;
+BEGIN
+ IF size < OPM.Alignment THEN
+ (* Round up to next power of 2 *)
+ alignment := 1; WHILE alignment < size DO alignment := alignment * 2 END;
+ ELSE
+ alignment := OPM.Alignment
+ END;
+ RETURN alignment
+END SizeAlignment;
+
+PROCEDURE BaseAlignment*(typ: Struct): LONGINT;
+ VAR alignment: LONGINT;
+BEGIN
+ IF typ.form = Comp THEN
+ IF typ.comp = Record THEN
+ alignment := typ.align MOD 10000H
+ ELSE
+ alignment := BaseAlignment(typ.BaseTyp)
+ END
+ ELSE
+ alignment := SizeAlignment(typ.size)
+ END;
+ RETURN alignment
+END BaseAlignment;
+
+PROCEDURE TypSize*(typ: Struct);
+ VAR
+ f, c: INTEGER;
+ offset, size, base, fbase, off0: LONGINT;
+ fld: Object; btyp: Struct;
+BEGIN
+ IF typ = undftyp THEN OPM.err(58)
+ ELSIF typ.size = -1 THEN
+ f := typ.form;
+ c := typ.comp;
+ IF c = Record THEN btyp := typ.BaseTyp;
+ IF btyp = NIL THEN offset := 0; base := 1;
+ ELSE TypSize(btyp); offset := btyp.size - btyp.sysflag DIV 100H; base := btyp.align;
+ END;
+ fld := typ.link;
+ WHILE (fld # NIL) & (fld.mode = Fld) DO
+ btyp := fld.typ; TypSize(btyp);
+ size := btyp.size;
+ fbase := BaseAlignment(btyp);
+ Align(offset, fbase);
+ fld.adr := offset; INC(offset, size);
+ IF fbase > base THEN base := fbase END;
+ fld := fld.link
+ END;
+ (* base is now the largest alignment of any field *)
+ off0 := offset;
+ IF offset = 0 THEN offset := 1 END; (* 1 byte filler to avoid empty struct *)
+ Align(offset, base);
+ IF (typ^.strobj = NIL) & (typ^.align MOD 10000H = 0) THEN INC(recno); INC(base, recno * 10000H) END;
+ typ.size := offset;
+ typ.align := base;
+ (* encode the trailing gap into the symbol table to allow dense packing of extended records *)
+ typ^.sysflag := typ^.sysflag MOD 100H + SHORT((offset - off0)*100H)
+ ELSIF c = Array THEN
+ TypSize(typ.BaseTyp);
+ typ.size := typ.n * typ.BaseTyp.size;
+ ELSIF f = Pointer THEN
+ typ.size := OPM.AddressSize;
+ IF typ.BaseTyp = undftyp THEN OPM.Mark(128, typ.n)
+ ELSE TypSize(typ.BaseTyp)
+ END
+ ELSIF f = ProcTyp THEN
+ typ.size := OPM.AddressSize;
+ ELSIF c = DynArr THEN
+ btyp := typ.BaseTyp; TypSize(btyp);
+ IF btyp.comp = DynArr THEN typ.size := btyp.size + 4 (* describes dim not size *)
+ ELSE typ.size := 8
+ END
+ END
+ END
+END TypSize;
-PROCEDURE err(n: INTEGER);
-BEGIN OPM.err(n)
-END err;
PROCEDURE NewConst*(): Const;
VAR const: Const;
@@ -374,21 +515,23 @@ END FPrintSign;
PROCEDURE IdFPrint*(typ: Struct); (* idfp codifies assignment compatibility *)
VAR btyp: Struct; strobj: Object; idfp: LONGINT; f, c: INTEGER;
BEGIN
- IF ~typ^.idfpdone THEN
- typ^.idfpdone := TRUE; (* may be recursive, temporary idfp is 0 in that case *)
- idfp := 0; f := typ^.form; c := typ^.comp; OPM.FPrint(idfp, f); OPM.FPrint(idfp, c);
- btyp := typ^.BaseTyp; strobj := typ^.strobj;
- IF (strobj # NIL) & (strobj^.name # "") THEN
- FPrintName(idfp, GlbMod[typ^.mno]^.name); FPrintName(idfp, strobj^.name)
- END;
- IF (f = Pointer) OR (c = Record) & (btyp # NIL) OR (c = DynArr) THEN
- IdFPrint(btyp); OPM.FPrint(idfp, btyp^.idfp)
- ELSIF c = Array THEN
- IdFPrint(btyp); OPM.FPrint(idfp, btyp^.idfp); OPM.FPrint(idfp, typ^.n)
- ELSIF f = ProcTyp THEN FPrintSign(idfp, btyp, typ^.link)
- END;
- typ^.idfp := idfp
- END
+ IF ~typ^.idfpdone THEN
+ typ^.idfpdone := TRUE; (* may be recursive, temporary idfp is 0 in that case *)
+ idfp := 0;
+ f := typ^.form; OPM.FPrint(idfp, f); IF f IN {Int, Set} THEN OPM.FPrint(idfp, typ.size) END;
+ c := typ^.comp; OPM.FPrint(idfp, c);
+ btyp := typ^.BaseTyp; strobj := typ^.strobj;
+ IF (strobj # NIL) & (strobj^.name # "") THEN
+ FPrintName(idfp, GlbMod[typ^.mno]^.name); FPrintName(idfp, strobj^.name)
+ END;
+ IF (f = Pointer) OR (c = Record) & (btyp # NIL) OR (c = DynArr) THEN
+ IdFPrint(btyp); OPM.FPrint(idfp, btyp^.idfp)
+ ELSIF c = Array THEN
+ IdFPrint(btyp); OPM.FPrint(idfp, btyp^.idfp); OPM.FPrint(idfp, typ^.n)
+ ELSIF f = ProcTyp THEN FPrintSign(idfp, btyp, typ^.link)
+ END;
+ typ^.idfp := idfp
+ END
END IdFPrint;
PROCEDURE FPrintStr*(typ: Struct);
@@ -484,9 +627,7 @@ BEGIN
CASE f OF
| Bool,
Char,
- SInt,
- Int,
- LInt: OPM.FPrint(fprint, obj^.conval^.intval)
+ Int: OPM.FPrint(fprint, obj^.conval^.intval)
| Set: OPM.FPrintSet(fprint, obj^.conval^.setval)
| Real: rval := SHORT(obj^.conval^.realval); OPM.FPrintReal(fprint, rval)
| LReal: OPM.FPrintLReal(fprint, obj^.conval^.realval)
@@ -599,9 +740,7 @@ BEGIN
| Byte,
Char,
Bool: OPM.SymRCh(ch); conval^.intval := ORD(ch)
- | SInt,
- Int,
- LInt: conval^.intval := OPM.SymRInt()
+ | Int: conval^.intval := OPM.SymRInt()
| Set: OPM.SymRSet(conval^.setval)
| Real: OPM.SymRReal(rval); conval^.realval := rval;
conval^.intval := OPM.ConstNotAlloc
@@ -670,13 +809,22 @@ BEGIN
RETURN obj
END InTProc;
+
+PROCEDURE InTyp(tag: LONGINT): Struct;
+BEGIN
+ IF tag = Int THEN RETURN IntType(OPM.SymRInt())
+ ELSIF tag = Set THEN RETURN SetType(OPM.SymRInt())
+ ELSE RETURN impCtxt.ref[tag]
+ END
+END InTyp;
+
+
PROCEDURE InStruct(VAR typ: Struct);
VAR mno: SHORTINT; ref: INTEGER; tag: LONGINT; name: OPS.Name;
t: Struct; obj, last, fld, old, dummy: Object;
BEGIN
tag := OPM.SymRInt();
- IF tag # Sstruct THEN
- typ := impCtxt.ref[-tag]
+ IF tag # Sstruct THEN typ := InTyp(-tag)
ELSE
ref := impCtxt.nofr; INC(impCtxt.nofr);
IF ref < impCtxt.minr THEN impCtxt.minr := ref END;
@@ -711,18 +859,18 @@ BEGIN
tag := OPM.SymRInt();
IF tag = Ssys THEN typ^.sysflag := SHORT(OPM.SymRInt()); tag := OPM.SymRInt() END;
CASE tag OF
- | Sptr: typ^.form := Pointer; typ^.size := OPM.PointerSize;
+ | Sptr: typ^.form := Pointer; typ^.size := OPM.AddressSize;
typ^.n := 0; InStruct(typ^.BaseTyp)
| Sarr: typ^.form := Comp; typ^.comp := Array;
InStruct(typ^.BaseTyp); typ^.n := OPM.SymRInt();
- typSize(typ) (* no bounds address !! *)
+ TypSize(typ) (* no bounds address !! *)
| Sdarr: typ^.form := Comp; typ^.comp := DynArr; InStruct(typ^.BaseTyp);
IF typ^.BaseTyp^.comp = DynArr THEN
typ^.n := typ^.BaseTyp^.n + 1
ELSE
typ^.n := 0
END;
- typSize(typ)
+ TypSize(typ)
| Srec: typ^.form := Comp; typ^.comp := Record;
InStruct(typ^.BaseTyp);
IF typ^.BaseTyp = notyp THEN typ^.BaseTyp := NIL END;
@@ -745,13 +893,13 @@ BEGIN
InsertImport(fld, typ^.link, dummy);
impCtxt.nextTag := OPM.SymRInt()
END
- | Spro: typ^.form := ProcTyp; typ^.size := OPM.ProcSize;
+ | Spro: typ^.form := ProcTyp; typ^.size := OPM.AddressSize;
InSign(mno, typ^.BaseTyp, typ^.link)
ELSE OPM.LogWStr("unhandled case at InStruct, tag = "); OPM.LogWNum(tag, 0); OPM.LogWLn;
END;
IF ref = impCtxt.minr THEN
- WHILE (ref < impCtxt.nofr) (*OR ((ref >= Int8) & (ref <= Int64))*) DO
- t := impCtxt.ref[ref]; FPrintStr(t);
+ WHILE (ref < impCtxt.nofr) DO
+ t := InTyp(ref); FPrintStr(t);
obj := t^.strobj; (* obj^.typ^.strobj = obj, else obj^.fprint differs (alias) *)
IF obj^.name # "" THEN FPrintObj(obj) END;
old := impCtxt.old[ref];
@@ -808,7 +956,8 @@ BEGIN
ELSE
obj := NewObj(); obj^.mnolev := -mno; obj^.vis := external;
IF tag <= Pointer THEN (* Constant *)
- obj^.mode := Con; obj^.typ := impCtxt.ref[tag]; obj^.conval := NewConst(); InConstant(tag, obj^.conval)
+ obj^.mode := Con; obj^.conval := NewConst(); InConstant(tag, obj^.conval);
+ obj^.typ := InTyp(tag)
ELSIF tag >= Sxpro THEN
obj^.conval := NewConst();
obj^.conval^.intval := -1;
@@ -944,7 +1093,7 @@ END Import;
END
END OutFlds;
- PROCEDURE OutSign(result: Struct; par: Object);
+ PROCEDURE OutSign(result: Struct; par: Object); (* Procedure signature *)
BEGIN
OutStr(result);
WHILE par # NIL DO
@@ -956,7 +1105,7 @@ END Import;
OPM.SymWInt(Send)
END OutSign;
- PROCEDURE OutTProcs(typ: Struct; obj: Object);
+ PROCEDURE OutTProcs(typ: Struct; obj: Object); (* Type bound procedures *)
BEGIN
IF obj # NIL THEN
OutTProcs(typ, obj^.left);
@@ -982,7 +1131,8 @@ END Import;
PROCEDURE OutStr(typ: Struct); (* OPV.TypeAlloc already applied *)
VAR strobj: Object;
BEGIN
- IF (typ^.ref < expCtxt.ref) (*OR (typ^.ref >= Int8) & (typ^.ref <= Int64)*) THEN OPM.SymWInt(-typ^.ref)
+ IF (typ^.ref < expCtxt.ref) THEN OPM.SymWInt(-typ^.ref);
+ IF typ.ref IN {Int, Set} THEN OPM.SymWInt(typ.size) END
ELSE
OPM.SymWInt(Sstruct);
typ^.ref := expCtxt.ref; INC(expCtxt.ref);
@@ -1027,10 +1177,8 @@ END Import;
CASE f OF
| Bool,
Char: OPM.SymWCh(CHR(obj^.conval^.intval))
- | SInt,
- Int,
- LInt: OPM.SymWInt(obj^.conval^.intval)
- | Set: OPM.SymWSet(obj^.conval^.setval)
+ | Int: OPM.SymWInt(obj^.conval^.intval); OPM.SymWInt(obj.typ.size)
+ | Set: OPM.SymWSet(obj^.conval^.setval); OPM.SymWInt(obj.typ.size)
| Real: rval := SHORT(obj^.conval^.realval); OPM.SymWReal(rval)
| LReal: OPM.SymWLReal(obj^.conval^.realval)
| String: OutName(obj^.conval^.ext^)
@@ -1092,10 +1240,8 @@ END Import;
expCtxt.nofm := 1; expCtxt.locmno[0] := 0;
i := 1; WHILE i < maxImps DO expCtxt.locmno[i] := -1; INC(i) END;
OutObj(topScope^.right);
- ext := sfpresent & symExtended; new := ~sfpresent OR symNew;
- IF OPM.forceNewSym THEN
- new := TRUE
- END; (* for bootstrapping -- noch *)
+ ext := sfpresent & symExtended;
+ new := ~sfpresent OR symNew OR (OPM.forcenewsym IN OPM.Options);
IF OPM.noerr & sfpresent & (impCtxt.reffp # expCtxt.reffp) THEN
new := TRUE;
IF ~extsf THEN err(155) END
@@ -1112,7 +1258,7 @@ END Import;
PROCEDURE InitStruct(VAR typ: Struct; form: SHORTINT);
BEGIN
- typ := NewStr(form, Basic); typ^.ref := form; typ^.size := OPM.ByteSize; typ^.allocated := TRUE;
+ typ := NewStr(form, Basic); typ^.ref := form; typ^.size := 1; typ^.allocated := TRUE;
typ^.strobj := NewObj(); typ^.pbfp := form; typ^.pvfp := form; typ^.fpdone := TRUE;
typ^.idfp := form; typ^.idfpdone := TRUE
END InitStruct;
@@ -1131,46 +1277,73 @@ END Import;
typ := NewStr(form, Basic); obj^.mode := Typ; obj^.typ := typ; obj^.vis := external;
typ^.strobj := obj; typ^.size := size; typ^.ref := form; typ^.allocated := TRUE;
typ^.pbfp := form; typ^.pvfp := form; typ^.fpdone := TRUE;
- typ^.idfp := form; typ^.idfpdone := TRUE; res := typ
+ typ^.idfp := form; typ^.idfpdone := TRUE;
+ IF form IN {Int, Set} THEN OPM.FPrint(typ.idfp, typ.size) END;
+ res := typ
END EnterTyp;
+ PROCEDURE EnterTypeAlias(name: OPS.Name; VAR res: Object);
+ VAR obj: Object;
+ BEGIN
+ Insert(name, obj); obj^.mode := Typ; obj^.typ := NIL; obj^.vis := external;
+ res := obj
+ END EnterTypeAlias;
+
PROCEDURE EnterProc(name: OPS.Name; num: INTEGER);
VAR obj: Object;
BEGIN Insert(name, obj);
obj^.mode := SProc; obj^.typ := notyp; obj^.adr := num
END EnterProc;
+
+
BEGIN topScope := NIL; OpenScope(0, NIL); OPM.errpos := 0;
- InitStruct(undftyp, Undef); InitStruct(notyp, NoTyp);
- InitStruct(stringtyp, String); InitStruct(niltyp, NilTyp);
- undftyp^.BaseTyp := undftyp;
+ InitStruct(undftyp, Undef); undftyp^.BaseTyp := undftyp;
+ InitStruct(notyp, NoTyp);
+ InitStruct(stringtyp, String);
+ InitStruct(niltyp, NilTyp);
(*initialization of module SYSTEM*)
- EnterTyp("BYTE", Byte, OPM.ByteSize, bytetyp);
- EnterTyp("PTR", Pointer, OPM.PointerSize, sysptrtyp);
- EnterProc("ADR", adrfn);
- EnterProc("CC", ccfn);
- EnterProc("LSH", lshfn);
- EnterProc("ROT", rotfn);
- EnterProc("GET", getfn);
- EnterProc("PUT", putfn);
+ EnterTyp("BYTE", Byte, 1, bytetyp);
+ EnterTyp("PTR", Pointer, -1, sysptrtyp); (* Size set in Compiler.PropagateElementaryTypeSize *)
+ EnterTyp("ADDRESS", Int, -1, adrtyp); (* Size set in Compiler.PropagateElementaryTypeSize *)
+ EnterTyp("INT8", Int, 1, int8typ);
+ EnterTyp("INT16", Int, 2, int16typ);
+ EnterTyp("INT32", Int, 4, int32typ);
+ EnterTyp("INT64", Int, 8, int64typ);
+ EnterTyp("SET32", Set, 4, set32typ);
+ EnterTyp("SET64", Set, 8, set64typ);
+
+ EnterProc("ADR", adrfn);
+ EnterProc("CC", ccfn);
+ EnterProc("LSH", lshfn);
+ EnterProc("ROT", rotfn);
+ EnterProc("GET", getfn);
+ EnterProc("PUT", putfn);
EnterProc("GETREG", getrfn);
EnterProc("PUTREG", putrfn);
- EnterProc("BIT", bitfn);
- EnterProc("VAL", valfn);
- EnterProc("NEW", sysnewfn);
- EnterProc("MOVE", movefn);
- syslink := topScope^.right;
+ EnterProc("BIT", bitfn);
+ EnterProc("VAL", valfn);
+ EnterProc("NEW", sysnewfn);
+ EnterProc("MOVE", movefn);
+
+
+ syslink := topScope^.right;
universe := topScope; topScope^.right := NIL;
- EnterTyp("BOOLEAN", Bool, OPM.BoolSize, booltyp);
- EnterTyp("CHAR", Char, OPM.CharSize, chartyp);
- EnterTyp("SET", Set, OPM.SetSize, settyp);
- EnterTyp("REAL", Real, OPM.RealSize, realtyp);
- EnterTyp("INTEGER", Int, OPM.IntSize, inttyp);
- EnterTyp("LONGINT", LInt, OPM.LIntSize, linttyp);
- EnterTyp("LONGREAL", LReal, OPM.LRealSize, lrltyp);
- EnterTyp("SHORTINT", SInt, OPM.SIntSize, sinttyp);
+ EnterTyp("BOOLEAN", Bool, 1, booltyp);
+ EnterTyp("CHAR", Char, 1, chartyp);
+ EnterTyp("REAL", Real, 4, realtyp);
+ EnterTyp("LONGREAL", LReal, 8, lrltyp);
+ EnterTyp("HUGEINT", Int, 8, hinttyp);
+ EnterTyp("BYTE@", Int, 1, cpbytetyp); (* Component Pascal byte type, enabled in Compiler.PropagateElementaryTypeSize *)
+
+ (* Type aliases for standard integer and set types are linked to real types in Compiler.PropagateElementaryTypeSize *)
+ EnterTypeAlias("SHORTINT", sintobj);
+ EnterTypeAlias("INTEGER", intobj);
+ EnterTypeAlias("LONGINT", lintobj);
+ EnterTypeAlias("SET", setobj);
+
EnterBoolConst("FALSE", 0); (* 0 and 1 are compiler internal representation only *)
EnterBoolConst("TRUE", 1);
@@ -1201,16 +1374,15 @@ BEGIN topScope := NIL; OpenScope(0, NIL); OPM.errpos := 0;
impCtxt.ref[Byte] := bytetyp;
impCtxt.ref[Bool] := booltyp;
impCtxt.ref[Char] := chartyp;
- impCtxt.ref[SInt] := sinttyp;
- impCtxt.ref[Int] := inttyp;
- impCtxt.ref[LInt] := linttyp;
+ impCtxt.ref[Int] := int32typ;
impCtxt.ref[Real] := realtyp;
impCtxt.ref[LReal] := lrltyp;
impCtxt.ref[Set] := settyp;
impCtxt.ref[String] := stringtyp;
impCtxt.ref[NilTyp] := niltyp;
impCtxt.ref[NoTyp] := notyp;
- impCtxt.ref[Pointer] := sysptrtyp
+ impCtxt.ref[Pointer] := sysptrtyp;
+
END OPT.
Objects:
@@ -1240,9 +1412,7 @@ Objects:
Byte Basic |
Bool Basic |
Char Basic |
- SInt Basic |
- Int Basic |
- LInt Basic |
+ Int Basic | size determine SHORT vs LONG
XInt Basic | bits
Real Basic |
LReal Basic |
diff --git a/src/compiler/OPV.Mod b/src/compiler/OPV.Mod
index 7a59c1d3..cd3c649c 100644
--- a/src/compiler/OPV.Mod
+++ b/src/compiler/OPV.Mod
@@ -5,7 +5,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
various promotion rules changed (long) => (LONGINT), xxxL avoided
*)
- IMPORT OPT, OPC, OPM, OPS;
+ IMPORT OPT, OPC, OPM, OPS, SYSTEM;
CONST
UndefinedType = 0; (* named type not yet defined *)
@@ -27,8 +27,6 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
GuardPtrFunc = "__GUARDP(";
GuardRecFunc = "__GUARDR(";
TypeFunc = "__TYPEOF(";
- SetOfFunc = "__SETOF(";
- SetRangeFunc = "__SETRNG(";
CopyFunc = "__COPY(";
MoveFunc = "__MOVE(";
GetFunc = "__GET(";
@@ -48,80 +46,15 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
VAR
- assert, inxchk, mainprog, ansi: BOOLEAN;
stamp: INTEGER; (* unique number for nested objects *)
- (*recno: INTEGER;*) (* number of anonymous record types *)
- recno: LONGINT; (* number of anonymous record types *)
exit: ExitInfo; (* to check if EXIT is simply a break *)
nofExitLabels: INTEGER;
- naturalAlignment: BOOLEAN;
- PROCEDURE NaturalAlignment(size, max: LONGINT): LONGINT;
- VAR i: LONGINT;
- BEGIN
- IF size >= max THEN RETURN max
- ELSE i := 1;
- WHILE i < size DO INC(i, i) END ;
- RETURN i
- END
- END NaturalAlignment;
-
- PROCEDURE TypSize*(typ: OPT.Struct);
- VAR f, c: INTEGER; offset, size, base, fbase, off0: LONGINT;
- fld: OPT.Object; btyp: OPT.Struct;
- BEGIN
- IF typ = OPT.undftyp THEN OPM.err(58)
- ELSIF typ^.size = -1 THEN
- f := typ^.form; c := typ^.comp;
- IF c = OPT.Record THEN btyp := typ^.BaseTyp;
- IF btyp = NIL THEN offset := 0; base := (*OPM.RecAlign*)OPC.SizeAlignment(OPM.RecSize);
- ELSE TypSize(btyp); offset := btyp^.size - btyp^.sysflag DIV 100H; base := btyp^.align;
- END;
- fld := typ^.link;
- WHILE (fld # NIL) & (fld^.mode = OPT.Fld) DO
- btyp := fld^.typ; TypSize(btyp);
- size := btyp^.size; fbase := OPC.BaseAlignment(btyp);
- OPC.Align(offset, fbase);
- fld^.adr := offset; INC(offset, size);
- IF fbase > base THEN base := fbase END ;
- fld := fld^.link
- END ;
- off0 := offset;
- IF offset = 0 THEN offset := 1 END ; (* 1 byte filler to avoid empty struct *)
- IF OPM.RecSize = 0 THEN base := NaturalAlignment(offset, (*OPM.RecAlign*)OPC.SizeAlignment(OPM.RecSize)) END ;
- OPC.Align(offset, base);
- IF (typ^.strobj = NIL) & (typ^.align MOD 10000H = 0) THEN INC(recno); INC(base, recno * 10000H) END ;
- typ^.size := offset; typ^.align := base;
- (* encode the trailing gap into the symbol table to allow dense packing of extended records *)
- typ^.sysflag := typ^.sysflag MOD 100H + SHORT((offset - off0)*100H)
- ELSIF c = OPT.Array THEN
- TypSize(typ^.BaseTyp);
- typ^.size := typ^.n * typ^.BaseTyp^.size;
- ELSIF f = OPT.Pointer THEN
- typ^.size := OPM.PointerSize;
- IF typ^.BaseTyp = OPT.undftyp THEN OPM.Mark(128, typ^.n)
- ELSE TypSize(typ^.BaseTyp)
- END
- ELSIF f = OPT.ProcTyp THEN
- typ^.size := OPM.ProcSize;
- ELSIF c = OPT.DynArr THEN
- btyp := typ^.BaseTyp; TypSize(btyp);
- IF btyp^.comp = OPT.DynArr THEN typ^.size := btyp^.size + 4 (* describes dim not size *)
- ELSE typ^.size := 8
- END
- END
- END
- END TypSize;
-
PROCEDURE Init*;
BEGIN
- stamp := 0; recno := 0; nofExitLabels := 0;
- assert := OPM.assert IN OPM.opt;
- inxchk := OPM.inxchk IN OPM.opt;
- mainprog := OPM.mainprog IN OPM.opt;
- ansi := OPM.ansi IN OPM.opt
+ stamp := 0; nofExitLabels := 0;
END Init;
PROCEDURE ^Traverse (obj, outerScope: OPT.Object; exported: BOOLEAN);
@@ -169,11 +102,11 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
obj^.linkadr := UndefinedType;
mode := obj^.mode;
IF (mode = OPT.Typ) & ((obj^.vis # OPT.internal) = exported) THEN
- typ := obj^.typ; TypSize(obj^.typ);
+ typ := obj^.typ; OPT.TypSize(obj^.typ);
IF typ^.form = OPT.Pointer THEN typ := typ^.BaseTyp END ;
IF typ^.comp = OPT.Record THEN TraverseRecord(typ) END
ELSIF mode = OPT.TProc THEN GetTProcNum(obj)
- ELSIF mode = OPT.Var THEN TypSize(obj^.typ)
+ ELSIF mode = OPT.Var THEN OPT.TypSize(obj^.typ)
END ;
IF ~exported THEN (* do this only once *)
IF (mode IN {OPT.LProc, OPT.Typ}) & (obj^.mnolev > 0) THEN Stamp(obj^.name) END ;
@@ -195,18 +128,27 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
PROCEDURE AdrAndSize* (topScope: OPT.Object);
BEGIN
+ ASSERT(OPT.sinttyp # NIL); ASSERT(OPT.inttyp # NIL); ASSERT(OPT.linttyp # NIL);
+
OPM.errpos := topScope^.adr; (* text position of scope used if error *)
topScope^.leaf := TRUE;
Traverse(topScope^.right, topScope, TRUE); (* first pass only on exported types and procedures *)
Traverse(topScope^.right, topScope, FALSE); (* second pass *)
+
(* mark basic types as predefined, OPC.Ident can avoid qualification*)
OPT.chartyp^.strobj^.linkadr := PredefinedType;
+ OPT.cpbytetyp^.strobj^.linkadr := PredefinedType;
OPT.settyp^.strobj^.linkadr := PredefinedType;
OPT.realtyp^.strobj^.linkadr := PredefinedType;
- OPT.inttyp^.strobj^.linkadr := PredefinedType;
- OPT.linttyp^.strobj^.linkadr := PredefinedType;
+ OPT.adrtyp^.strobj^.linkadr := PredefinedType;
+ OPT.int8typ^.strobj^.linkadr := PredefinedType;
+ OPT.int16typ^.strobj^.linkadr := PredefinedType;
+ OPT.int32typ^.strobj^.linkadr := PredefinedType;
+ OPT.int64typ^.strobj^.linkadr := PredefinedType;
+ OPT.set32typ^.strobj^.linkadr := PredefinedType;
+ OPT.set64typ^.strobj^.linkadr := PredefinedType;
+ OPT.hinttyp.strobj.linkadr := PredefinedType;
OPT.lrltyp^.strobj^.linkadr := PredefinedType;
- OPT.sinttyp^.strobj^.linkadr := PredefinedType;
OPT.booltyp^.strobj^.linkadr := PredefinedType;
OPT.bytetyp^.strobj^.linkadr := PredefinedType;
OPT.sysptrtyp^.strobj^.linkadr := PredefinedType;
@@ -223,7 +165,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
OPT.Nindex,
OPT.Nproc,
OPT.Ncall: RETURN 10
- | OPT.Nguard: IF OPM.typchk IN OPM.opt THEN RETURN 10 ELSE RETURN 9 (*cast*) END
+ | OPT.Nguard: IF OPM.typchk IN OPM.Options THEN RETURN 10 ELSE RETURN 9 (*cast*) END
| OPT.Nvarpar: IF comp IN {OPT.Array, OPT.DynArr} THEN RETURN 10 ELSE RETURN 9 END (* arrays don't need deref *)
| OPT.Nderef: RETURN 9
| OPT.Nmop: CASE subclass OF
@@ -265,7 +207,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
PROCEDURE^ expr (n: OPT.Node; prec: INTEGER);
PROCEDURE^ design(n: OPT.Node; prec: INTEGER);
- PROCEDURE Len(n: OPT.Node; dim: LONGINT);
+ PROCEDURE Len(n: OPT.Node; dim: SYSTEM.INT64);
BEGIN
WHILE (n^.class = OPT.Nindex) & (n^.typ^.comp = OPT.DynArr(*26.7.2002*)) DO INC(dim); n := n^.left END ;
IF (n^.class = OPT.Nderef) & (n^.typ^.comp = OPT.DynArr) THEN
@@ -290,28 +232,33 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
END
END Entier;
- PROCEDURE SizeCast(size: LONGINT);
+ PROCEDURE SizeCast(n: OPT.Node; to: LONGINT);
BEGIN
- IF size <= 4 THEN OPM.WriteString("(int)")
- ELSE OPM.WriteString("(SYSTEM_INT64)")
+ IF (to < n.typ.size) & (OPM.ranchk IN OPM.Options) THEN
+ OPM.WriteString("__SHORT"); IF SideEffects(n) THEN OPM.Write("F") END;
+ OPM.Write(OpenParen); Entier(n, MinPrec); OPM.WriteString(Comma);
+ OPM.WriteInt(OPM.SignedMaximum(to) + 1); OPM.Write(CloseParen)
+ ELSE
+ IF (n.typ.size # to) & ((n.typ.size > OPM.CIntSize) OR (to # OPM.CIntSize)) THEN
+ OPM.WriteString("(INT"); OPM.WriteInt(to*8); OPM.WriteString(")")
+ END
END
END SizeCast;
PROCEDURE Convert(n: OPT.Node; newtype: OPT.Struct; prec: INTEGER);
VAR from, to: INTEGER;
BEGIN from := n^.typ^.form; to := newtype.form;
- IF to = OPT.Set THEN OPM.WriteString(SetOfFunc); Entier(n, MinPrec); OPM.Write(CloseParen)
- ELSIF to IN OPT.intSet THEN
- IF (newtype.size < n.typ.size) & (OPM.ranchk IN OPM.opt) THEN
- OPM.WriteString("__SHORT"); IF SideEffects(n) THEN OPM.Write("F") END;
- OPM.Write(OpenParen); Entier(n, MinPrec); OPM.WriteString(Comma);
- OPM.WriteInt(OPM.SignedMaximum(newtype.size) + 1); OPM.Write(CloseParen)
- ELSE
- IF newtype.size # n.typ.size THEN SizeCast(newtype.size) END;
- Entier(n, 9)
+ IF to = OPT.Set THEN
+ IF from = OPT.Set THEN (* Sets of different size *)
+ SizeCast(n, newtype.size); Entier(n, 9)
+ ELSE (* Set from integer *)
+ OPM.WriteString("__SETOF("); Entier(n, MinPrec);
+ OPM.WriteString(","); OPM.WriteInt(newtype.size*8); OPM.Write(CloseParen)
END
+ ELSIF to = OPT.Int THEN (* integers of different size *)
+ SizeCast(n, newtype.size); Entier(n, 9)
ELSIF to = OPT.Char THEN
- IF OPM.ranchk IN OPM.opt THEN OPM.WriteString("__CHR");
+ IF OPM.ranchk IN OPM.Options THEN OPM.WriteString("__CHR");
IF SideEffects(n) THEN OPM.Write("F") END ;
OPM.Write(OpenParen); Entier(n, MinPrec); OPM.Write(CloseParen)
ELSE OPM.WriteString("(CHAR)"); Entier(n, 9)
@@ -340,7 +287,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
PROCEDURE Index(n, d: OPT.Node; prec, dim: INTEGER);
BEGIN
- IF ~inxchk
+ IF ~(OPM.inxchk IN OPM.Options)
OR (n^.right^.class = OPT.Nconst) & ((n^.right^.conval^.intval = 0) OR (n^.left^.typ^.comp # OPT.DynArr)) THEN
expr(n^.right, prec)
ELSE
@@ -402,7 +349,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
OPM.Write(CloseBracket)
END
| OPT.Nguard: typ := n^.typ; obj := n^.left^.obj;
- IF OPM.typchk IN OPM.opt THEN
+ IF OPM.typchk IN OPM.Options THEN
IF typ^.comp = OPT.Record THEN OPM.WriteString(GuardRecFunc);
IF obj^.mnolev # OPM.level THEN (*intermediate level var-par record*)
OPM.WriteStringVar(obj^.scope^.name); OPM.WriteString("__curr->"); OPC.Ident(obj)
@@ -423,7 +370,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
OPM.Write("("); OPC.Ident(typ^.strobj); OPM.Write(")"); expr(n^.left, designPrec)
END
END
- | OPT.Neguard: IF OPM.typchk IN OPM.opt THEN
+ | OPT.Neguard: IF OPM.typchk IN OPM.Options THEN
IF n^.left^.class = OPT.Nvarpar THEN OPM.WriteString("__GUARDEQR(");
OPC.CompleteIdent(n^.left^.obj); OPM.WriteString(Comma); TypeOf(n^.left);
ELSE OPM.WriteString("__GUARDEQP("); expr(n^.left^.left, MinPrec)
@@ -438,6 +385,12 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
IF prec > designPrec THEN OPM.Write(CloseParen) END
END design;
+ PROCEDURE ParIntLiteral(n: SYSTEM.INT64; size: LONGINT);
+ BEGIN
+ (* Literal parameters (other than varargs) do not need an explicit size cast on ansi C compilers. *)
+ OPM.WriteInt(n)
+ END ParIntLiteral;
+
PROCEDURE ActualPar(n: OPT.Node; fp: OPT.Object);
VAR typ, aptyp: OPT.Struct; comp, form, mode, prec, dim: INTEGER;
BEGIN
@@ -449,30 +402,23 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
END ;
IF ~(n^.typ^.comp IN {OPT.Array, OPT.DynArr}) THEN
IF mode = OPT.VarPar THEN
- IF ansi & (typ # n^.typ) THEN OPM.WriteString("(void*)") END ;
+ IF typ # n^.typ THEN OPM.WriteString("(void*)") END;
OPM.Write("&"); prec := 9
- ELSIF ansi THEN
+ ELSE
IF (comp IN {OPT.Array, OPT.DynArr}) & (n^.class = OPT.Nconst) THEN
OPM.WriteString("(CHAR*)") (* force to unsigned char *)
ELSIF (form = OPT.Pointer) & (typ # n^.typ) & (n^.typ # OPT.niltyp) THEN
OPM.WriteString("(void*)") (* type extension *)
END
- ELSE
- IF (form IN {OPT.Real, OPT.LReal}) & (n^.typ^.form IN OPT.intSet) THEN (* real promotion *)
- OPM.WriteString("(double)"); prec := 9
- ELSIF (form = OPT.LInt) & (n^.typ^.form < OPT.LInt) THEN (* integral promotion *)
- OPM.WriteString("(LONGINT)"); prec := 9
- END
END
- ELSIF ansi THEN
+ ELSE
(* casting of params should be simplified eventually *)
IF (mode = OPT.VarPar) & (typ # n^.typ) & (prec = MinPrec) THEN OPM.WriteString("(void*)") END
END;
IF (mode = OPT.VarPar) & (n^.class = OPT.Nmop) & (n^.subcl = OPT.val) THEN
expr(n^.left, prec) (* avoid cast in lvalue *)
- ELSIF (form = OPT.LInt) & (n^.class = OPT.Nconst)
- & (n^.conval^.intval <= OPM.SignedMaximum(OPM.IntSize)) & (n^.conval^.intval >= OPM.SignedMinimum(OPM.IntSize)) THEN
- OPM.WriteString("((LONGINT)("); expr(n, prec); OPM.WriteString("))");
+ ELSIF (form = OPT.Int) & (n^.class = OPT.Nconst) THEN
+ ParIntLiteral(n.conval.intval, n.typ.size)
ELSE
expr(n, prec)
END;
@@ -480,7 +426,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
OPM.WriteString(", "); TypeOf(n)
ELSIF comp = OPT.DynArr THEN
IF n^.class = OPT.Nconst THEN (* ap is string constant *)
- OPM.WriteString(Comma); OPM.WriteString("(LONGINT)"); OPM.WriteInt(n^.conval^.intval2)
+ OPM.WriteString(Comma); ParIntLiteral(n.conval.intval2, OPM.AddressSize)
ELSE
aptyp := n^.typ; dim := 0;
WHILE (typ^.comp = OPT.DynArr) & (typ^.BaseTyp^.form # OPT.Byte) DO
@@ -492,7 +438,8 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
WHILE aptyp^.comp = OPT.DynArr DO
Len(n, dim); OPM.WriteString(" * "); INC(dim); aptyp := aptyp^.BaseTyp
END ;
- OPM.WriteString("((LONGINT)("); OPM.WriteInt(aptyp^.size); OPM.WriteString("))");
+ (*OPM.WriteString("((LONGINT)("); OPM.WriteInt(aptyp^.size); OPM.WriteString("))");*)
+ ParIntLiteral(aptyp.size, OPM.AddressSize)
END
END
END ;
@@ -529,8 +476,8 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
CASE class OF
| OPT.Nconst: OPC.Constant(n^.conval, form)
| OPT.Nupto: (* n^.typ = OPT.settyp *)
- OPM.WriteString(SetRangeFunc); expr(l, MinPrec); OPM.WriteString(Comma); expr (r, MinPrec);
- OPM.Write(CloseParen)
+ OPM.WriteString("__SETRNG("); expr(l, MinPrec); OPM.WriteString(Comma); expr(r, MinPrec);
+ OPM.WriteString(Comma); OPM.WriteInt(n.typ.size*8); OPM.Write(CloseParen)
| OPT.Nmop:
CASE subclass OF
| OPS.not: OPM.Write("!"); expr(l, exprPrec)
@@ -546,7 +493,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
| OPT.conv: Convert(l, n.typ, exprPrec)
| OPT.abs: IF SideEffects(l) THEN
IF l^.typ^.form < OPT.Real THEN
- IF l^.typ^.form < OPT.LInt THEN OPM.WriteString("(int)") END ;
+ IF l.typ.size <= OPM.CIntSize THEN OPM.WriteString("(int)") END ;
OPM.WriteString("__ABSF(")
ELSE OPM.WriteString("__ABSFD(")
END
@@ -555,20 +502,20 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
expr(l, MinPrec); OPM.Write(CloseParen)
| OPT.cap: OPM.WriteString("__CAP("); expr(l, MinPrec); OPM.Write(CloseParen)
| OPT.odd: OPM.WriteString("__ODD("); expr(l, MinPrec); OPM.Write(CloseParen)
- | OPT.adr: OPM.WriteString("(LONGINT)(SYSTEM_ADDRESS)"); (*SYSTEM*)
+ | OPT.adr: OPM.WriteString("(ADDRESS)"); (*SYSTEM*)
IF l^.class = OPT.Nvarpar THEN OPC.CompleteIdent(l^.obj)
ELSE
IF (l^.typ^.form # OPT.String) & ~(l^.typ^.comp IN {OPT.Array, OPT.DynArr}) THEN OPM.Write("&") END ;
expr(l, exprPrec)
END
| OPT.val: IF ~(l^.class IN {OPT.Nvar, OPT.Nvarpar, OPT.Nfield, OPT.Nindex}) (*SYSTEM*)
- OR (n^.typ^.form IN {OPT.LInt, OPT.Pointer, OPT.Set, OPT.ProcTyp})
- & (l^.typ^.form IN {OPT.LInt, OPT.Pointer, OPT.Set, OPT.ProcTyp})
+ OR (n^.typ^.form IN {OPT.Int, OPT.Pointer, OPT.Set, OPT.ProcTyp})
+ & (l^.typ^.form IN {OPT.Int, OPT.Pointer, OPT.Set, OPT.ProcTyp})
& (n^.typ^.size = l^.typ^.size)
THEN
OPM.Write(OpenParen); OPC.Ident(n^.typ^.strobj); OPM.Write(CloseParen);
IF (n^.typ^.form IN {OPT.Pointer, OPT.ProcTyp}) OR (l^.typ^.form IN {OPT.Pointer, OPT.ProcTyp}) THEN
- OPM.WriteString("(SYSTEM_ADDRESS)")
+ OPM.WriteString("(ADDRESS)")
END;
expr(l, exprPrec)
ELSE
@@ -611,23 +558,26 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
ELSE OPM.WriteString("__ROT(")
END
| OPS.div: IF SideEffects(n) THEN
- IF form < OPT.LInt THEN OPM.WriteString("(int)") END ;
+ IF n.typ.size <= OPM.CIntSize THEN OPM.WriteString("(int)") END;
OPM.WriteString("__DIVF(")
ELSE OPM.WriteString("__DIV(")
END
- | OPS.mod: IF form < OPT.LInt THEN OPM.WriteString("(int)") END ;
+ | OPS.mod: IF n.typ.size <= OPM.CIntSize THEN OPM.WriteString("(int)") END;
IF SideEffects(n) THEN OPM.WriteString("__MODF(")
ELSE OPM.WriteString("__MOD(")
END;
- ELSE OPM.LogWStr("unhandled case in OPV.expr, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn;
+ ELSE OPM.LogWStr("unhandled case in OPV.expr, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn;
END ;
expr(l, MinPrec);
OPM.WriteString(Comma);
IF (subclass IN {OPT.ash, OPT.lsh, OPT.rot}) & (r^.class = OPT.Nconst) & (r^.conval^.intval < 0) THEN
OPM.WriteInt(-r^.conval^.intval)
ELSE expr(r, MinPrec)
- END ;
- IF subclass IN {OPT.lsh, OPT.rot} THEN OPM.WriteString(Comma); OPC.Ident(l^.typ^.strobj) END ;
+ END;
+ IF subclass IN {OPS.in, OPT.lsh, OPT.rot} THEN
+ OPM.WriteString(Comma);
+ IF subclass = OPS.in THEN OPM.WriteInt(r.typ.size*8) ELSE OPM.WriteInt(l.typ.size*8) END
+ END;
OPM.Write(CloseParen)
| OPS.eql
.. OPS.geq: IF l^.typ^.form IN {OPT.String, OPT.Comp} THEN
@@ -650,7 +600,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
END
| OPS.slash: IF form = OPT.Set THEN OPM.WriteString(" ^ ")
ELSE OPM.WriteString(" / ");
- IF (r^.obj = NIL) OR (r^.obj^.typ^.form IN OPT.intSet) THEN
+ IF (r^.obj = NIL) OR (r^.obj^.typ^.form = OPT.Int) THEN
OPM.Write(OpenParen); OPC.Ident(n^.typ^.strobj); OPM.Write(CloseParen)
END
END
@@ -722,7 +672,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
PROCEDURE CaseStat(n: OPT.Node; outerProc: OPT.Object);
VAR switchCase, label: OPT.Node;
- low, high: LONGINT; form, i: INTEGER;
+ low, high: SYSTEM.INT64; form, i: INTEGER;
BEGIN
OPM.WriteString("switch "); expr(n^.left, MaxPrec);
OPM.Write(Blank); OPC.BegBlk;
@@ -777,18 +727,20 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
ELSIF base^.form = OPT.Pointer THEN OPM.WriteString("POINTER__typ")
ELSE OPM.WriteString("NIL")
END ;
- OPM.WriteString(", "); OPM.WriteString("((LONGINT)("); OPM.WriteInt(base^.size); OPM.WriteString("))");
- OPM.WriteString(", "); OPM.WriteInt(OPC.BaseAlignment(base)); (* element alignment *)
+ OPM.WriteString(", "); OPM.WriteInt(base.size);
+ OPM.WriteString(", "); OPM.WriteInt(OPT.BaseAlignment(base)); (* element alignment *)
OPM.WriteString(", "); OPM.WriteInt(nofdim); (* total number of dimensions = number of additional parameters *)
OPM.WriteString(", "); OPM.WriteInt(nofdyn); (* number of dynamic dimensions *)
WHILE typ # base DO
OPM.WriteString(", ");
IF typ^.comp = OPT.DynArr THEN
- IF x^.class = OPT.Nconst THEN OPM.WriteString("(LONGINT)("); expr(x, MinPrec); OPM.WriteString(")")
- ELSE OPM.WriteString("(LONGINT)"); expr(x, 10)
+ IF x^.class = OPT.Nconst THEN
+ OPC.IntLiteral(x.conval.intval, OPM.AddressSize)
+ ELSE OPM.WriteString("((ADDRESS)("); expr(x, 10); OPM.WriteString("))")
END ;
x := x^.link
- ELSE OPM.WriteString("(LONGINT)"); OPM.WriteInt(typ^.n)
+ ELSE
+ OPC.IntLiteral(typ.n, OPM.AddressSize)
END ;
typ := typ^.BaseTyp
END ;
@@ -809,7 +761,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
VAR proc: OPT.Object; saved: ExitInfo; l, r: OPT.Node;
BEGIN
WHILE (n # NIL) & OPM.noerr DO
- OPM.errpos := n^.conval^.intval;
+ OPM.errpos := OPM.Longint(n^.conval^.intval);
IF n^.class # OPT.Ninittd THEN OPC.BegStat END;
CASE n^.class OF
| OPT.Nenter: IF n^.obj = NIL THEN (* enter module *)
@@ -862,8 +814,9 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
| OPT.incfn,
OPT.decfn: expr(n^.left, MinPrec); OPC.Increment(n^.subcl = OPT.decfn); expr(n^.right, MinPrec)
| OPT.inclfn,
- OPT.exclfn: expr(n^.left, MinPrec); OPC.SetInclude(n^.subcl = OPT.exclfn); OPM.WriteString(SetOfFunc); expr(n^.right, MinPrec);
- OPM.Write(CloseParen)
+ OPT.exclfn: expr(n^.left, MinPrec); OPC.SetInclude(n^.subcl = OPT.exclfn);
+ OPM.WriteString("__SETOF("); expr(n^.right, MinPrec);
+ OPM.WriteString(","); OPM.WriteInt(n.left.typ.size*8); OPM.Write(CloseParen)
| OPT.copyfn: OPM.WriteString(CopyFunc);
expr(n^.right, MinPrec); OPM.WriteString(Comma); expr(n^.left, MinPrec); OPM.WriteString(Comma);
Len(n^.left, 0); OPM.Write(CloseParen)
@@ -898,7 +851,8 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
END ;
ActualPar(n^.right, n^.obj)
| OPT.Nifelse: IF n^.subcl # OPT.assertfn THEN IfStat(n, FALSE, outerProc)
- ELSIF assert THEN OPM.WriteString("__ASSERT("); expr(n^.left^.left^.left, MinPrec); OPM.WriteString(Comma);
+ ELSIF OPM.assert IN OPM.Options THEN
+ OPM.WriteString("__ASSERT("); expr(n^.left^.left^.left, MinPrec); OPM.WriteString(Comma);
OPM.WriteInt(n^.left^.right^.right^.conval^.intval); OPM.Write(CloseParen); OPC.EndStat
END
| OPT.Ncase: INC(exit.level); CaseStat(n, outerProc); DEC(exit.level)
@@ -920,25 +874,31 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
OPM.WriteString("goto exit__"); OPM.WriteInt(exit.label)
END
| OPT.Nreturn: IF OPM.level = 0 THEN
- IF mainprog THEN OPM.WriteString("__FINI") ELSE OPM.WriteString("__ENDMOD") END
+ IF OPM.mainprog IN OPM.Options THEN OPM.WriteString("__FINI") ELSE OPM.WriteString("__ENDMOD") END
+ ELSIF OPC.NeedsRetval(outerProc) THEN
+ OPM.WriteString("__retval = ");
+ IF (n^.left^.typ^.form = OPT.Pointer) & (n^.obj^.typ # n^.left^.typ) THEN
+ OPM.WriteString("(void*)"); expr(n^.left, 10)
+ ELSE
+ expr(n^.left, MinPrec)
+ END ;
+ OPC.EndStat;
+ OPC.BegStat; OPC.ExitProc(outerProc, FALSE, FALSE); OPC.EndStat;
+ OPC.BegStat; OPM.WriteString("return __retval");
ELSE
+ OPC.ExitProc(outerProc, FALSE, FALSE);
+ OPM.WriteString("return");
IF n^.left # NIL THEN
- (* Make local copy of result before ExitProc deletes dynamic vars *)
- OPM.WriteString("_o_result = ");
+ OPM.Write(Blank);
IF (n^.left^.typ^.form = OPT.Pointer) & (n^.obj^.typ # n^.left^.typ) THEN
OPM.WriteString("(void*)"); expr(n^.left, 10)
ELSE
expr(n^.left, MinPrec)
- END;
- OPM.WriteString(";"); OPM.WriteLn; OPC.BegStat;
- OPC.ExitProc(outerProc, FALSE, FALSE);
- OPM.WriteString("return _o_result");
- ELSE
- OPM.WriteString("return");
+ END
END
END
| OPT.Nwith: IfStat(n, n^.subcl = 0, outerProc)
- | OPT.Ntrap: OPC.Halt(n^.right^.conval^.intval)
+ | OPT.Ntrap: OPC.Halt(OPM.Longint(n^.right^.conval^.intval))
ELSE OPM.LogWStr("unhandled case in OPV.expr, n^.class = "); OPM.LogWNum(n^.class, 0); OPM.LogWLn;
END;
IF ~(n^.class IN {OPT.Nenter, OPT.Ninittd, OPT.Nifelse, OPT.Nwith, OPT.Ncase, OPT.Nwhile, OPT.Nloop}) THEN OPC.EndStat END ;
@@ -948,7 +908,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
PROCEDURE Module*(prog: OPT.Node);
BEGIN
- IF ~mainprog THEN OPC.GenHdr(prog^.right); OPC.GenHdrIncludes END ;
+ IF ~(OPM.mainprog IN OPM.Options) THEN OPC.GenHdr(prog^.right); OPC.GenHdrIncludes END ;
OPC.GenBdy(prog^.right); stat(prog, NIL)
END Module;
diff --git a/src/compiler/errors.Mod b/src/compiler/errors.Mod
deleted file mode 100644
index 1546aa8c..00000000
--- a/src/compiler/errors.Mod
+++ /dev/null
@@ -1,215 +0,0 @@
-MODULE errors;
-
-TYPE string* = ARRAY 128 OF CHAR;
-
-VAR errors- : ARRAY 350 OF string;
-
-
-BEGIN
-(* Incorrect use of the language Oberon *)
-errors[0] := "undeclared identifier";
-errors[1] := "multiply defined identifier";
-errors[2] := "illegal character in number";
-errors[3] := "illegal character in string";
-errors[4] := "identifier does not match procedure name";
-errors[5] := "comment not closed";
-errors[6] := "";
-errors[7] := "";
-errors[8] := "";
-errors[9] := "'=' expected";
-errors[10] :="";
-errors[11] :="";
-errors[12] := "type definition starts with incorrect symbol";
-errors[13] := "factor starts with incorrect symbol";
-errors[14] := "statement starts with incorrect symbol";
-errors[15] := "declaration followed by incorrect symbol";
-errors[16] := "MODULE expected";
-errors[17] := "";
-errors[18] := "'.' missing";
-errors[19] := "',' missing";
-errors[20] := "':' missing";
-errors[21] := "";
-errors[22] := "')' missing";
-errors[23] := "']' missing";
-errors[24] := "'}' missing";
-errors[25] := "OF missing";
-errors[26] := "THEN missing";
-errors[27] := "DO missing";
-errors[28] := "TO missing";
-errors[29] := "";
-errors[30] := "'(' missing";
-errors[31] := "";
-errors[32] := "";
-errors[33] := "";
-errors[34] := "':=' missing";
-errors[35] := "',' or OF expected";
-errors[36] := "";
-errors[37] := "";
-errors[38] := "identifier expected";
-errors[39] := "';' missing";
-errors[40] := "";
-errors[41] := "END missing";
-errors[42] := "";
-errors[43] := "";
-errors[44] := "UNTIL missing";
-errors[45] := "";
-errors[46] := "EXIT not within loop statement";
-errors[47] := "illegally marked identifier";
-errors[48] := "";
-errors[49] := "";
-errors[50] := "expression should be constant";
-errors[51] := "constant not an integer";
-errors[52] := "identifier does not denote a type";
-errors[53] := "identifier does not denote a record type";
-errors[54] := "result type of procedure is not a basic type";
-errors[55] := "procedure call of a function";
-errors[56] := "assignment to non-variable";
-errors[57] := "pointer not bound to record or array type";
-errors[58] := "recursive type definition";
-errors[59] := "illegal open array parameter";
-errors[60] := "wrong type of case label";
-errors[61] := "inadmissible type of case label";
-errors[62] := "case label defined more than once";
-errors[63] := "illegal value of constant";
-errors[64] := "more actual than formal parameters";
-errors[65] := "fewer actual than formal parameters";
-errors[66] := "element types of actual array and formal open array differ";
-errors[67] := "actual parameter corresponding to open array is not an array";
-errors[68] := "control variable must be integer";
-errors[69] := "parameter must be an integer constant";
-errors[70] := "pointer or VAR record required as formal receiver";
-errors[71] := "pointer expected as actual receiver";
-errors[72] := "procedure must be bound to a record of the same scope";
-errors[73] := "procedure must have level 0";
-errors[74] := "procedure unknown in base type";
-errors[75] := "invalid call of base procedure";
-errors[76] := "this variable (field) is read only";
-errors[77] := "object is not a record";
-errors[78] := "dereferenced object is not a variable";
-errors[79] := "indexed object is not a variable";
-errors[80] := "index expression is not an integer";
-errors[81] := "index out of specified bounds";
-errors[82] := "indexed variable is not an array";
-errors[83] := "undefined record field";
-errors[84] := "dereferenced variable is not a pointer";
-errors[85] := "guard or test type is not an extension of variable type";
-errors[86] := "guard or testtype is not a pointer";
-errors[87] := "guarded or tested variable is neither a pointer nor a VAR-parameter record";
-errors[88] := "open array not allowed as variable, record field or array element";
-errors[89] := "";
-errors[90] := "";
-errors[91] := "";
-errors[92] := "operand of IN not an integer, or not a set";
-errors[93] := "set element type is not an integer";
-errors[94] := "operand of & is not of type BOOLEAN";
-errors[95] := "operand of OR is not of type BOOLEAN";
-errors[96] := "operand not applicable to (unary) +";
-errors[97] := "operand not applicable to (unary) -";
-errors[98] := "operand of ~ is not of type BOOLEAN";
-errors[99] := "ASSERT fault";
-errors[100] := "incompatible operands of dyadic operator";
-errors[101] := "operand type inapplicable to *";
-errors[102] := "operand type inapplicable to /";
-errors[103] := "operand type inapplicable to DIV";
-errors[104] := "operand type inapplicable to MOD";
-errors[105] := "operand type inapplicable to +";
-errors[106] := "operand type inapplicable to -";
-errors[107] := "operand type inapplicable to = or #";
-errors[108] := "operand type inapplicable to relation";
-errors[109] := "overriding method must be exported";
-errors[110] := "operand is not a type";
-errors[111] := "operand inapplicable to (this) function";
-errors[112] := "operand is not a variable";
-errors[113] := "incompatible assignment";
-errors[114] := "string too long to be assigned";
-errors[115] := "parameter doesn't match";
-errors[116] := "number of parameters doesn't match";
-errors[117] := "result type doesn't match";
-errors[118] := "export mark doesn't match with forward declaration";
-errors[119] := "redefinition textually precedes procedure bound to base type";
-errors[120] := "type of expression following IF, WHILE, UNTIL or ASSERT is not BOOLEAN";
-errors[121] := "called object is not a procedure (or is an interrupt procedure)";
-errors[122] := "actual VAR-parameter is not a variable";
-errors[123] := "type of actual parameter is not identical with that of formal VAR-parameter";
-errors[124] := "type of result expression differs from that of procedure";
-errors[125] := "type of case expression is neither INTEGER nor CHAR";
-errors[126] := "this expression cannot be a type or a procedure";
-errors[127] := "illegal use of object";
-errors[128] := "unsatisfied forward reference";
-errors[129] := "unsatisfied forward procedure";
-errors[130] := "WITH clause does not specify a variable";
-errors[131] := "LEN not applied to array";
-errors[132] := "dimension in LEN too large or negative";
-errors[135] := "SYSTEM not imported";
-errors[150] := "key inconsistency of imported module";
-errors[151] := "incorrect symbol file";
-errors[152] := "symbol file of imported module not found";
-errors[153] := "object or symbol file not opened (disk full?)";
-errors[154] := "recursive import not allowed";
-errors[155] := "generation of new symbol file not allowed";
-errors[156] := "parameter file not found";
-errors[157] := "syntax error in parameter file";
-(* Limitations of implementation*)
-errors[200] := "not yet implemented";
-errors[201] := "lower bound of set range greater than higher bound";
-errors[202] := "set element greater than MAX(SET) or less than 0";
-errors[203] := "number too large";
-errors[204] := "product too large";
-errors[205] := "division by zero";
-errors[206] := "sum too large";
-errors[207] := "difference too large";
-errors[208] := "overflow in arithmetic shift";
-errors[209] := "case range too large";
-errors[213] := "too many cases in case statement";
-errors[218] := "illegal value of parameter (0 <= p < 256)";
-errors[219] := "machine registers cannot be accessed";
-errors[220] := "illegal value of parameter";
-errors[221] := "too many pointers in a record";
-errors[222] := "too many global pointers";
-errors[223] := "too many record types";
-errors[224] := "too many pointer types";
-errors[225] := "address of pointer variable too large (move forward in text)";
-errors[226] := "too many exported procedures";
-errors[227] := "too many imported modules";
-errors[228] := "too many exported structures";
-errors[229] := "too many nested records for import";
-errors[230] := "too many constants (strings) in module";
-errors[231] := "too many link table entries (external procedures)";
-errors[232] := "too many commands in module";
-errors[233] := "record extension hierarchy too high";
-errors[234] := "export of recursive type not allowed";
-errors[240] := "identifier too long";
-errors[241] := "string too long";
-errors[242] := "address overflow";
-errors[244] := "cyclic type definition not allowed";
-errors[245] := "guarded pointer variable may be manipulated by non-local operations; use auxiliary pointer variable";
-(* Compiler Warnings *)
-
-errors[301] := "implicit type cast";
-errors[306] := "inappropriate symbol file ignored";
-errors[307] := "no ELSE symbol after CASE statement sequence may lead to trap"; (* new warning, -- noch *)
-errors[308] := "SYSTEM.VAL result includes memory past end of source variable"; (* DCWB *)
-
-END errors.
-(*
-Run-time Error Messages
- SYSTEM_halt
- 0 silent HALT(0)
- 1..255 HALT(n), cf. SYSTEM_halt
- -1 assertion failed, cf. SYSTEM_assert
- -2 invalid array index
- -3 function procedure without RETURN statement
- -4 invalid case in CASE statement
- -5 type guard failed
- -6 implicit type guard in record assignment failed
- -7 invalid case in WITH statement
- -8 value out of range
- -9 (delayed) interrupt
- -10 NIL access
- -11 alignment error
- -12 zero divide
- -13 arithmetic overflow/underflow
- -14 invalid function argument
- -15 internal error
-*)
-
diff --git a/src/compiler/extTools.Mod b/src/compiler/extTools.Mod
index 515c13e4..2847768e 100644
--- a/src/compiler/extTools.Mod
+++ b/src/compiler/extTools.Mod
@@ -1,42 +1,55 @@
MODULE extTools;
-IMPORT Strings, Console, Configuration, Platform, OPM;
+IMPORT Strings, Out, Configuration, Platform, Modules, OPM;
-VAR compilationOptions, CFLAGS: ARRAY 1023 OF CHAR;
+VAR CFLAGS: ARRAY 1023 OF CHAR;
PROCEDURE execute(title: ARRAY OF CHAR; cmd: ARRAY OF CHAR);
VAR r, status, exitcode: INTEGER;
BEGIN
- IF OPM.Verbose THEN Console.String(title); Console.String(cmd); Console.Ln END;
+ IF OPM.verbose IN OPM.Options THEN
+ Out.String(title); Out.String(cmd); Out.Ln
+ END;
r := Platform.System(cmd);
status := r MOD 128;
exitcode := r DIV 256;
IF exitcode > 127 THEN exitcode := exitcode - 256 END; (* Handle signed exit code *)
IF r # 0 THEN
- Console.String(title); Console.String(cmd); Console.Ln;
- Console.String("-- failed: status "); Console.Int(status,1);
- Console.String(", exitcode "); Console.Int(exitcode,1);
- Console.String("."); Console.Ln;
+ Out.String(title); Out.String(cmd); Out.Ln;
+ Out.String("-- failed: status "); Out.Int(status,1);
+ Out.String(", exitcode "); Out.Int(exitcode,1);
+ Out.String("."); Out.Ln;
IF (status = 0) & (exitcode = 127) THEN
- Console.String("Is the C compiler in the current command path?"); Console.Ln
+ Out.String("Is the C compiler in the current command path?"); Out.Ln
END;
- IF status # 0 THEN Platform.Halt(status) ELSE Platform.Halt(exitcode) END
+ IF status # 0 THEN Modules.Halt(status) ELSE Modules.Halt(exitcode) END
END;
END execute;
+PROCEDURE InitialiseCompilerCommand(VAR s: ARRAY OF CHAR);
+BEGIN
+ COPY(Configuration.compile, s);
+ Strings.Append(' -I "', s);
+ Strings.Append(OPM.ResourceDir, s);
+ Strings.Append('/include" ', s);
+ Platform.GetEnv("CFLAGS", CFLAGS);
+ Strings.Append (CFLAGS, s);
+ Strings.Append (" ", s);
+END InitialiseCompilerCommand;
+
+
PROCEDURE Assemble*(moduleName: ARRAY OF CHAR);
VAR
cmd: ARRAY 1023 OF CHAR;
BEGIN
- cmd := Configuration.compile;
- Strings.Append(compilationOptions, cmd);
- Strings.Append("-c ", cmd);
- Strings.Append(moduleName, cmd);
- Strings.Append(".c", cmd);
- execute("Assemble: ", cmd);
+ InitialiseCompilerCommand(cmd);
+ Strings.Append("-c ", cmd);
+ Strings.Append(moduleName, cmd);
+ Strings.Append(".c", cmd);
+ execute("Assemble: ", cmd);
END Assemble;
@@ -44,9 +57,7 @@ PROCEDURE LinkMain*(VAR moduleName: ARRAY OF CHAR; statically: BOOLEAN; addition
VAR
cmd: ARRAY 1023 OF CHAR;
BEGIN
- cmd := Configuration.compile;
- Strings.Append(" ", cmd);
- Strings.Append(compilationOptions, cmd);
+ InitialiseCompilerCommand(cmd);
Strings.Append(moduleName, cmd);
Strings.Append(".c ", cmd);
Strings.Append(additionalopts, cmd);
@@ -59,16 +70,11 @@ PROCEDURE LinkMain*(VAR moduleName: ARRAY OF CHAR; statically: BOOLEAN; addition
Strings.Append(Configuration.installdir, cmd);
Strings.Append('/lib"', cmd);
Strings.Append(Configuration.libspec, cmd);
-
+ Strings.Append('-O', cmd);
+ Strings.Append(OPM.Model, cmd);
+ Strings.Append(Configuration.libext, cmd);
execute("Assemble and link: ", cmd);
END LinkMain;
-BEGIN
- Strings.Append(' -I "', compilationOptions);
- Strings.Append(Configuration.installdir, compilationOptions);
- Strings.Append('/include" ', compilationOptions);
- Platform.GetEnv("CFLAGS", CFLAGS);
- Strings.Append (CFLAGS, compilationOptions);
- Strings.Append (" ", compilationOptions);
END extTools.
diff --git a/src/library/misc/crt.Mod b/src/library/misc/crt.Mod
index ab6e36b9..eebc5678 100644
--- a/src/library/misc/crt.Mod
+++ b/src/library/misc/crt.Mod
@@ -1,7 +1,6 @@
MODULE crt;
-IMPORT vt100, Platform, Console,
- Strings; (* strings to remove later ? *)
+IMPORT VT100, Platform, Out, Strings;
CONST
@@ -30,27 +29,27 @@ CONST
PROCEDURE EraseDisplay*;
BEGIN
- vt100.ED(2);
+ VT100.ED(2);
END EraseDisplay;
PROCEDURE ClrScr*;
BEGIN
- vt100.ED(2);
+ VT100.ED(2);
END ClrScr;
PROCEDURE ClrEol*;
BEGIN
- vt100.EL(0);
+ VT100.EL(0);
END ClrEol;
PROCEDURE cursoroff*;
BEGIN
- vt100.DECTCEMl;
+ VT100.DECTCEMl;
END cursoroff;
PROCEDURE cursoron*;
BEGIN
- vt100.DECTCEMh;
+ VT100.DECTCEMh;
END cursoron;
PROCEDURE Delay*(ms: INTEGER);
@@ -58,116 +57,116 @@ CONST
PROCEDURE GotoXY* (x, y: INTEGER);
BEGIN
- vt100.CUP (y, x);
+ VT100.CUP (y, x);
END GotoXY;
PROCEDURE HighVideo*;
VAR tmpstr: ARRAY 5 OF CHAR;
BEGIN
- COPY (vt100.CSI, tmpstr);
- Strings.Append(vt100.Bold, tmpstr);
- Console.String(tmpstr);
+ COPY (VT100.CSI, tmpstr);
+ Strings.Append(VT100.Bold, tmpstr);
+ Out.String(tmpstr);
END HighVideo;
-
+
PROCEDURE DelLine*;
BEGIN
- vt100.EL(2);
+ VT100.EL(2);
END DelLine;
PROCEDURE InsLine*;
BEGIN
- vt100.SCP;
- Console.Ln;
- vt100.RCP;
+ VT100.SCP;
+ Out.Ln;
+ VT100.RCP;
END InsLine;
PROCEDURE LowVideo*;
VAR tmpstr : ARRAY 7 OF CHAR;
BEGIN
- COPY (vt100.CSI, tmpstr);
- Strings.Append(vt100.ResetBold, tmpstr);
- Console.String(tmpstr);
+ COPY (VT100.CSI, tmpstr);
+ Strings.Append(VT100.ResetBold, tmpstr);
+ Out.String(tmpstr);
END LowVideo;
PROCEDURE NormVideo*;
VAR tmpstr : ARRAY 7 OF CHAR;
BEGIN
- COPY(vt100.CSI, tmpstr);
- Strings.Append(vt100.ResetAll, tmpstr);
- Console.String(tmpstr);
+ COPY(VT100.CSI, tmpstr);
+ Strings.Append(VT100.ResetAll, tmpstr);
+ Out.String(tmpstr);
END NormVideo;
PROCEDURE TextBackground*(color : SHORTINT);
BEGIN
IF color = Black THEN
- vt100.SetAttr(vt100.BBlack)
+ VT100.SetAttr(VT100.BBlack)
ELSIF color = Blue THEN
- vt100.SetAttr(vt100.BBlue)
+ VT100.SetAttr(VT100.BBlue)
ELSIF color = Green THEN
- vt100.SetAttr(vt100.BGreen)
+ VT100.SetAttr(VT100.BGreen)
ELSIF color = Cyan THEN
- vt100.SetAttr(vt100.BCyan)
+ VT100.SetAttr(VT100.BCyan)
ELSIF color = Red THEN
- vt100.SetAttr(vt100.BRed)
+ VT100.SetAttr(VT100.BRed)
ELSIF color = Magenta THEN
- vt100.SetAttr(vt100.BMagenta)
+ VT100.SetAttr(VT100.BMagenta)
ELSIF color = Brown THEN
- vt100.SetAttr(vt100.BYellow)
+ VT100.SetAttr(VT100.BYellow)
ELSIF color = LightGray THEN
- vt100.SetAttr(vt100.BLightGray)
+ VT100.SetAttr(VT100.BLightGray)
ELSIF color = DarkGray THEN
- vt100.SetAttr(vt100.BDarkGray)
+ VT100.SetAttr(VT100.BDarkGray)
ELSIF color = LightBlue THEN
- vt100.SetAttr(vt100.BLightBlue)
+ VT100.SetAttr(VT100.BLightBlue)
ELSIF color = LightGreen THEN
- vt100.SetAttr(vt100.BLightBlue)
+ VT100.SetAttr(VT100.BLightBlue)
ELSIF color = LightCyan THEN
- vt100.SetAttr(vt100.BLightCyan)
+ VT100.SetAttr(VT100.BLightCyan)
ELSIF color = LightRed THEN
- vt100.SetAttr(vt100.BLightRed)
+ VT100.SetAttr(VT100.BLightRed)
ELSIF color = LightMagenta THEN
- vt100.SetAttr(vt100.BLightMagenta)
+ VT100.SetAttr(VT100.BLightMagenta)
ELSIF color = Yellow THEN
- vt100.SetAttr(vt100.BLightYellow)
+ VT100.SetAttr(VT100.BLightYellow)
ELSIF color = White THEN
- vt100.SetAttr(vt100.BWhite)
+ VT100.SetAttr(VT100.BWhite)
END;
END TextBackground;
PROCEDURE TextColor*(color : SHORTINT);
BEGIN
IF color = Black THEN
- vt100.SetAttr(vt100.Black)
+ VT100.SetAttr(VT100.Black)
ELSIF color = Blue THEN
- vt100.SetAttr(vt100.Blue)
+ VT100.SetAttr(VT100.Blue)
ELSIF color = Green THEN
- vt100.SetAttr(vt100.Green)
+ VT100.SetAttr(VT100.Green)
ELSIF color = Cyan THEN
- vt100.SetAttr(vt100.Cyan)
+ VT100.SetAttr(VT100.Cyan)
ELSIF color = Red THEN
- vt100.SetAttr(vt100.Red)
+ VT100.SetAttr(VT100.Red)
ELSIF color = Magenta THEN
- vt100.SetAttr(vt100.Magenta)
+ VT100.SetAttr(VT100.Magenta)
ELSIF color = Brown THEN
- vt100.SetAttr(vt100.Yellow)
+ VT100.SetAttr(VT100.Yellow)
ELSIF color = LightGray THEN
- vt100.SetAttr(vt100.LightGray)
+ VT100.SetAttr(VT100.LightGray)
ELSIF color = DarkGray THEN
- vt100.SetAttr(vt100.DarkGray)
+ VT100.SetAttr(VT100.DarkGray)
ELSIF color = LightBlue THEN
- vt100.SetAttr(vt100.LightBlue)
+ VT100.SetAttr(VT100.LightBlue)
ELSIF color = LightGreen THEN
- vt100.SetAttr(vt100.LightBlue)
+ VT100.SetAttr(VT100.LightBlue)
ELSIF color = LightCyan THEN
- vt100.SetAttr(vt100.LightCyan)
+ VT100.SetAttr(VT100.LightCyan)
ELSIF color = LightRed THEN
- vt100.SetAttr(vt100.LightRed)
+ VT100.SetAttr(VT100.LightRed)
ELSIF color = LightMagenta THEN
- vt100.SetAttr(vt100.LightMagenta)
+ VT100.SetAttr(VT100.LightMagenta)
ELSIF color = Yellow THEN
- vt100.SetAttr(vt100.LightYellow)
+ VT100.SetAttr(VT100.LightYellow)
ELSIF color = White THEN
- vt100.SetAttr(vt100.White)
+ VT100.SetAttr(VT100.White)
END;
END TextColor;
diff --git a/src/library/ooc/oocLRealMath.Mod b/src/library/ooc/oocLRealMath.Mod
index 3da0cf96..552f8c20 100644
--- a/src/library/ooc/oocLRealMath.Mod
+++ b/src/library/ooc/oocLRealMath.Mod
@@ -1,42 +1,42 @@
MODULE oocLRealMath;
(*
- LRealMath - Target independent mathematical functions for LONGREAL
+ LRealMath - Target independent mathematical functions for LONGREAL
(IEEE double-precision) numbers.
-
+
Numerical approximations are taken from "Software Manual for the
Elementary Functions" by Cody & Waite and "Computer Approximations"
- by Hart et al.
-
+ by Hart et al.
+
Copyright (C) 1996-1998 Michael Griebling
-
+
This module is free software; you can redistribute it and/or modify
- it under the terms of the GNU Lesser General Public License as
+ it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
-
+
This module is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Lesser General Public License for more details.
-
+
You should have received a copy of the GNU Lesser General Public
License along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
-IMPORT l := oocLowLReal, m := oocRealMath;
-
+IMPORT l := oocLowLReal, m := oocRealMath, SYSTEM;
+
CONST
pi* = 3.1415926535897932384626433832795028841972D0;
exp1* = 2.7182818284590452353602874713526624977572D0;
- ZERO=0.0D0; ONE=1.0D0; HALF=0.5D0; TWO=2.0D0; (* local constants *)
-
+ ZERO=0.0D0; ONE=1.0D0; HALF=0.5D0; TWO=2.0D0; (* local constants *)
+
(* internally-used constants *)
huge=l.large; (* largest number this package accepts *)
- miny=l.small; (* smallest number this package accepts *)
+ miny=l.small; (* smallest number this package accepts *)
sqrtHalf=0.70710678118654752440D0;
Limit=1.0536712D-8; (* 2**(-MantBits/2) *)
eps=5.5511151D-17; (* 2**(-MantBits-1) *)
@@ -44,30 +44,30 @@ CONST
piByTwo=1.57079632679489661923D0;
lnv=0.6931610107421875D0; (* should be exact *)
vbytwo=0.13830277879601902638D-4; (* used in sinh/cosh *)
- ln2Inv=1.44269504088896340735992468100189213D0;
-
+ ln2Inv=1.44269504088896340735992468100189213D0;
+
(* error/exception codes *)
- NoError*=m.NoError; IllegalRoot*=m.IllegalRoot; IllegalLog*=m.IllegalLog; Overflow*=m.Overflow;
- IllegalPower*=m.IllegalPower; IllegalLogBase*=m.IllegalLogBase; IllegalTrig*=m.IllegalTrig;
- IllegalInvTrig*=m.IllegalInvTrig; HypInvTrigClipped*=m.HypInvTrigClipped;
+ NoError*=m.NoError; IllegalRoot*=m.IllegalRoot; IllegalLog*=m.IllegalLog; Overflow*=m.Overflow;
+ IllegalPower*=m.IllegalPower; IllegalLogBase*=m.IllegalLogBase; IllegalTrig*=m.IllegalTrig;
+ IllegalInvTrig*=m.IllegalInvTrig; HypInvTrigClipped*=m.HypInvTrigClipped;
IllegalHypInvTrig*=m.IllegalHypInvTrig; LossOfAccuracy*=m.LossOfAccuracy;
-
+
VAR
a1: ARRAY 18 OF LONGREAL; (* lookup table for power function *)
- a2: ARRAY 9 OF LONGREAL; (* lookup table for power function *)
- em: LONGREAL; (* largest number such that 1+epsilon > 1.0 *)
+ a2: ARRAY 9 OF LONGREAL; (* lookup table for power function *)
+ em: LONGREAL; (* largest number such that 1+epsilon > 1.0 *)
LnInfinity: LONGREAL; (* natural log of infinity *)
LnSmall: LONGREAL; (* natural log of very small number *)
SqrtInfinity: LONGREAL; (* square root of infinity *)
TanhMax: LONGREAL; (* maximum Tanh value *)
t: LONGREAL; (* internal variables *)
-
+
(* internally used support routines *)
PROCEDURE SinCos (x, y, sign: LONGREAL): LONGREAL;
CONST
ymax=210828714; (* ENTIER(pi*2**(MantBits/2)) *)
- c1=3.1416015625D0;
+ c1=3.1416015625D0;
c2=-8.908910206761537356617D-6;
r1=-0.16666666666666665052D+0;
r2= 0.83333333333331650314D-2;
@@ -77,24 +77,24 @@ PROCEDURE SinCos (x, y, sign: LONGREAL): LONGREAL;
r6= 0.16058936490371589114D-9;
r7=-0.76429178068910467734D-12;
r8= 0.27204790957888846175D-14;
- VAR
- n: LONGINT; xn, f, x1, g: LONGREAL;
+ VAR
+ n: LONGINT; xn, f, x1, g: LONGREAL;
BEGIN
IF y>=ymax THEN l.ErrorHandler(LossOfAccuracy); RETURN ZERO END;
-
+
(* determine the reduced number *)
n:=ENTIER(y*piInv+HALF); xn:=n;
IF ODD(n) THEN sign:=-sign END;
x:=ABS(x);
IF x#y THEN xn:=xn-HALF END;
-
+
(* fractional part of reduced number *)
x1:=ENTIER(x);
f:=((x1-xn*c1)+(x-x1))-xn*c2;
-
+
(* Pre: |f| <= pi/2 *)
IF ABS(f)= 0 *)
- CONST
+ CONST
P0=0.41731; P1=0.59016;
- VAR
- xMant, yEst, z: LONGREAL; xExp: INTEGER;
+ VAR
+ xMant, yEst, z: LONGREAL; xExp: INTEGER;
BEGIN
(* optimize zeros and check for illegal negative roots *)
IF x=ZERO THEN RETURN ZERO END;
IF x=ZERO THEN n:=SHORT(ENTIER(ln2Inv*x+HALF))
ELSE n:=SHORT(ENTIER(ln2Inv*x-HALF))
END;
xn:=n; g:=(x-xn*c1)-xn*c2;
-
+
(* Calculate exp(g)/2 from "Software Manual for the Elementary Functions" *)
z:=g*g; p:=((P2*z+P1)*z+P0)*g; q:=(Q2*z+Q1)*z+HALF;
RETURN l.scale(HALF+p/(q-p), n+1)
END exp;
-
+
PROCEDURE ln*(x: LONGREAL): LONGREAL;
(* Returns the natural logarithm of x for x > 0 *)
CONST
@@ -175,27 +175,27 @@ PROCEDURE ln*(x: LONGREAL): LONGREAL;
BEGIN
(* ensure illegal inputs are trapped and handled *)
IF x<=ZERO THEN l.ErrorHandler(IllegalLog); RETURN -huge END;
-
+
(* reduce the range of the input *)
f:=l.fraction(x)*HALF; n:=l.exponent(x)+1;
IF f>sqrtHalf THEN zn:=(f-HALF)-HALF; zd:=f*HALF+HALF
- ELSE zn:=f-HALF; zd:=zn*HALF+HALF; DEC(n)
+ ELSE zn:=f-HALF; zd:=zn*HALF+HALF; DEC(n)
END;
-
+
(* evaluate rational approximation from "Software Manual for the Elementary Functions" *)
z:=zn/zd; w:=z*z; q:=((w+Q2)*w+Q1)*w+Q0; p:=w*((P2*w+P1)*w+P0); r:=z+z*(p/q);
-
+
(* scale the output *)
- xn:=n;
+ xn:=n;
RETURN (xn*c2+r)+xn*c1
END ln;
-
+
(* The angle in all trigonometric functions is measured in radians *)
-
+
PROCEDURE sin* (x: LONGREAL): LONGREAL;
BEGIN
- IF x 0 *)
- CONST
- P1=0.83333333333333211405D-1; P2=0.12500000000503799174D-1;
- P3=0.22321421285924258967D-2; P4=0.43445775672163119635D-3;
- K=0.44269504088896340736D0;
- Q1=0.69314718055994529629D+0; Q2=0.24022650695909537056D+0;
+ CONST
+ P1=0.83333333333333211405D-1; P2=0.12500000000503799174D-1;
+ P3=0.22321421285924258967D-2; P4=0.43445775672163119635D-3;
+ K=0.44269504088896340736D0;
+ Q1=0.69314718055994529629D+0; Q2=0.24022650695909537056D+0;
Q3=0.55504108664085595326D-1; Q4=0.96181290595172416964D-2;
Q5=0.13333541313585784703D-2; Q6=0.15400290440989764601D-3;
Q7=0.14928852680595608186D-4;
OneOver16=0.0625D0; XMAX=16*l.expoMax-1; (*XMIN=16*l.expoMin+1;*) XMIN=-16351; (* noch *)
- VAR z, g, R, v, u2, u1, w1, w2, y1, y2, w: LONGREAL; m, p, i: INTEGER; mp, pp, iw1: LONGINT;
+ VAR z, g, R, v, u2, u1, w1, w2, y1, y2, w: LONGREAL; m, p, i: INTEGER; mp, pp, iw1: LONGINT;
BEGIN
(* handle all possible error conditions *)
IF ABS(exponent)ZERO THEN RETURN ZERO ELSE l.ErrorHandler(Overflow); RETURN -huge END
END;
-
+
(* extract the exponent of base to m and clear exponent of base in g *)
g:=l.fraction(base)*HALF; m:=l.exponent(base)+1;
-
+
(* determine p table offset with an unrolled binary search *)
p:=1;
IF g<=a1[9] THEN p:=9 END;
IF g<=a1[p+4] THEN INC(p, 4) END;
IF g<=a1[p+2] THEN INC(p, 2) END;
-
+
(* compute scaled z so that |z| <= 0.044 *)
z:=((g-a1[p+1])-a2[(p+1) DIV 2])/(g+a1[p+1]); z:=z+z;
(* approximation for log2(z) from "Software Manual for the Elementary Functions" *)
- v:=z*z; R:=(((P4*v+P3)*v+P2)*v+P1)*v*z; R:=R+K*R; u2:=(R+z*K)+z; u1:=(m*16-p)*OneOver16;
-
+ v:=z*z; R:=(((P4*v+P3)*v+P2)*v+P1)*v*z; R:=R+K*R; u2:=(R+z*K)+z; u1:=(m*16-p)*OneOver16;
+
(* generate w with extra precision calculations *)
y1:=ENTIER(16*exponent)*OneOver16; y2:=exponent-y1; w:=u2*exponent+u1*y2;
w1:=ENTIER(16*w)*OneOver16; w2:=w-w1; w:=w1+u1*y1;
@@ -283,14 +283,14 @@ BEGIN
IF iw1>XMAX THEN l.ErrorHandler(Overflow); RETURN huge
ELSIF iw1ZERO THEN INC(iw1); w2:=w2-OneOver16 END; IF iw1<0 THEN i:=0 ELSE i:=1 END;
- mp:=div(iw1, 16)+i; pp:=16*mp-iw1;
- z:=((((((Q7*w2+Q6)*w2+Q5)*w2+Q4)*w2+Q3)*w2+Q2)*w2+Q1)*w2; z:=a1[pp+1]+a1[pp+1]*z;
+ mp:=div(iw1, 16)+i; pp:=16*mp-iw1;
+ z:=((((((Q7*w2+Q6)*w2+Q5)*w2+Q4)*w2+Q3)*w2+Q2)*w2+Q1)*w2; z:=a1[pp+1]+a1[pp+1]*z;
RETURN l.scale(z, SHORT(mp))
END power;
-
+
PROCEDURE round*(x: LONGREAL): LONGINT;
(* Returns the value of x rounded to the nearest integer *)
BEGIN
@@ -298,7 +298,7 @@ BEGIN
ELSE RETURN ENTIER(x+HALF)
END
END round;
-
+
PROCEDURE IsRMathException*(): BOOLEAN;
(* Returns TRUE if the current coroutine is in the exceptional execution state
because of the raising of the RealMath exception; otherwise returns FALSE.
@@ -307,15 +307,15 @@ BEGIN
RETURN FALSE
END IsRMathException;
-
-(*
+
+(*
Following routines are provided as extensions to the ISO standard.
They are either used as the basis of other functions or provide
- useful functions which are not part of the ISO standard.
+ useful functions which are not part of the ISO standard.
*)
PROCEDURE log* (x, base: LONGREAL): LONGREAL;
-(* log(x,base) is the logarithm of x base b. All positive arguments are
+(* log(x,base) is the logarithm of x base b. All positive arguments are
allowed but base > 0 and base # 1. *)
BEGIN
(* log(x, base) = log2(x) / log2(base) *)
@@ -324,9 +324,9 @@ BEGIN
END
END log;
-PROCEDURE ipower* (x: LONGREAL; base: INTEGER): LONGREAL;
+PROCEDURE ipower* (x: LONGREAL; base: INTEGER): LONGREAL;
(* ipower(x, base) returns the x to the integer power base where base*Log2(x) < Log2(Max) *)
- VAR y: LONGREAL; neg: BOOLEAN; Exp: LONGINT;
+ VAR y: LONGREAL; neg: BOOLEAN; Exp: LONGINT;
PROCEDURE Adjust(xadj: LONGREAL): LONGREAL;
BEGIN
@@ -336,17 +336,17 @@ PROCEDURE ipower* (x: LONGREAL; base: INTEGER): LONGREAL;
BEGIN
(* handle all possible error conditions *)
IF base=0 THEN RETURN ONE (* x**0 = 1 *)
- ELSIF ABS(x)0 THEN RETURN ZERO ELSE l.ErrorHandler(Overflow); RETURN Adjust(huge) END
END;
(* trap potential overflows and underflows *)
- Exp:=(l.exponent(x)+1)*base; y:=LnInfinity*ln2Inv;
+ Exp:=(l.exponent(x)+1)*base; y:=LnInfinity*ln2Inv;
IF Exp>y THEN l.ErrorHandler(Overflow); RETURN Adjust(huge)
ELSIF Exp<-y THEN RETURN ZERO
- END;
-
- (* compute x**base using an optimised algorithm from Knuth, slightly
+ END;
+
+ (* compute x**base using an optimised algorithm from Knuth, slightly
altered : p442, The Art Of Computer Programming, Vol 2 *)
y:=ONE; IF base<0 THEN neg:=TRUE; base := -base ELSE neg:= FALSE END;
LOOP
@@ -355,19 +355,19 @@ BEGIN
x:=x*x;
END;
IF neg THEN RETURN ONE/y ELSE RETURN y END
-END ipower;
+END ipower;
PROCEDURE sincos* (x: LONGREAL; VAR Sin, Cos: LONGREAL);
(* More efficient sin/cos implementation if both values are needed. *)
BEGIN
Sin:=sin(x); Cos:=sqrt(ONE-Sin*Sin)
-END sincos;
+END sincos;
PROCEDURE arctan2* (xn, xd: LONGREAL): LONGREAL;
-(* arctan2(xn,xd) is the quadrant-correct arc tangent atan(xn/xd). If the
+(* arctan2(xn,xd) is the quadrant-correct arc tangent atan(xn/xd). If the
denominator xd is zero, then the numerator xn must not be zero. All
arguments are legal except xn = xd = 0. *)
- CONST
+ CONST
P0=0.216062307897242551884D+3; P1=0.3226620700132512059245D+3;
P2=0.13270239816397674701D+3; P3=0.1288838303415727934D+2;
Q0=0.2160623078972426128957D+3; Q1=0.3946828393122829592162D+3;
@@ -387,15 +387,15 @@ BEGIN
IF ABS(xn)>ABS(xd) THEN z:=ABS(xd/xn); Quadrant:=2
ELSE z:=ABS(xn/xd); Quadrant:=0
END;
-
+
(* further reduce range to within 0 to 2-sqrt(3) *)
IF z>TWO-Sqrt3 THEN z:=(z*Sqrt3-ONE)/(Sqrt3+z); INC(Quadrant) END;
-
+
(* approximation from "Computer Approximations" table ARCTN 5075 *)
IF ABS(z)1 THEN atan:=-atan END;
CASE Quadrant OF
@@ -405,20 +405,20 @@ BEGIN
| ELSE (* angle is correct *)
END
END;
-
+
(* map negative xds into the correct quadrant *)
IF xdLnInfinity THEN (* handle exp overflows *)
y:=y-lnv;
- IF y>LnInfinity-lnv+0.69 THEN l.ErrorHandler(Overflow);
+ IF y>LnInfinity-lnv+0.69 THEN l.ErrorHandler(Overflow);
IF x>ZERO THEN RETURN huge ELSE RETURN -huge END
ELSE f:=exp(y); f:=f+f*vbytwo (* don't change to f(1+vbytwo) *)
END
ELSE f:=exp(y); f:=(f-ONE/f)*HALF
END;
-
- (* reach here when 1 < ABS(x) < LnInfinity-lnv+0.69 *)
- IF x>ZERO THEN RETURN f ELSE RETURN -f END
+
+ (* reach here when 1 < ABS(x) < LnInfinity-lnv+0.69 *)
+ IF x>ZERO THEN RETURN f ELSE RETURN -f END
END sinh;
-
+
PROCEDURE cosh* (x: LONGREAL): LONGREAL;
(* cosh(x) is the hyperbolic cosine of x. The argument x must not be so large
- that exp(|x|) overflows. *)
+ that exp(|x|) overflows. *)
VAR y, f: LONGREAL;
BEGIN y:=ABS(x);
IF y>LnInfinity THEN (* handle exp overflows *)
y:=y-lnv;
- IF y>LnInfinity-lnv+0.69 THEN l.ErrorHandler(Overflow);
+ IF y>LnInfinity-lnv+0.69 THEN l.ErrorHandler(Overflow);
IF x>ZERO THEN RETURN huge ELSE RETURN -huge END
ELSE f:=exp(y); RETURN f+f*vbytwo (* don't change to f(1+vbytwo) *)
END
ELSE f:=exp(y); RETURN (f+ONE/f)*HALF
END
END cosh;
-
+
PROCEDURE tanh* (x: LONGREAL): LONGREAL;
(* tanh(x) is the hyperbolic tangent of x. All arguments are legal. *)
- CONST
- P0=-0.16134119023996228053D+4; P1=-0.99225929672236083313D+2; P2=-0.96437492777225469787D+0;
+ CONST
+ P0=-0.16134119023996228053D+4; P1=-0.99225929672236083313D+2; P2=-0.96437492777225469787D+0;
Q0= 0.48402357071988688686D+4; Q1= 0.22337720718962312926D+4; Q2= 0.11274474380534949335D+3;
- ln3over2=0.54930614433405484570D0;
+ ln3over2=0.54930614433405484570D0;
BIG=19.06154747D0; (* (ln(2)+(t+1)*ln(B))/2 where t=mantissa bits, B=base *)
VAR f, t: LONGREAL;
BEGIN f:=ABS(x);
@@ -487,7 +487,7 @@ BEGIN
END arcsinh;
PROCEDURE arccosh* (x: LONGREAL): LONGREAL;
-(* arccosh(x) is the arc hyperbolic cosine of x. All arguments greater than
+(* arccosh(x) is the arc hyperbolic cosine of x. All arguments greater than
or equal to 1 are legal. *)
BEGIN
IF x*)
- a1[ 1]:=ONE;
- a1[ 2]:=ToLONGREAL(3FEEA4AFH, 0A2A490DAH);
- a1[ 3]:=ToLONGREAL(3FED5818H, 0DCFBA487H);
- a1[ 4]:=ToLONGREAL(3FEC199BH, 0DD85529CH);
- a1[ 5]:=ToLONGREAL(3FEAE89FH, 0995AD3ADH);
- a1[ 6]:=ToLONGREAL(3FE9C491H, 082A3F090H);
- a1[ 7]:=ToLONGREAL(3FE8ACE5H, 0422AA0DBH);
- a1[ 8]:=ToLONGREAL(3FE7A114H, 073EB0186H);
- a1[ 9]:=ToLONGREAL(3FE6A09EH, 0667F3BCCH);
- a1[10]:=ToLONGREAL(3FE5AB07H, 0DD485429H);
- a1[11]:=ToLONGREAL(3FE4BFDAH, 0D5362A27H);
- a1[12]:=ToLONGREAL(3FE3DEA6H, 04C123422H);
- a1[13]:=ToLONGREAL(3FE306FEH, 00A31B715H);
- a1[14]:=ToLONGREAL(3FE2387AH, 06E756238H);
- a1[15]:=ToLONGREAL(3FE172B8H, 03C7D517AH);
- a1[16]:=ToLONGREAL(3FE0B558H, 06CF9890FH);
- a1[17]:=HALF;
+ a1[ 1] := ONE;
+ a1[ 2] := ToLONGREAL(3FEEA4AFA2A490DAH); (* ToLONGREAL(3FEEA4AFH, 0A2A490DAH); *)
+ a1[ 3] := ToLONGREAL(3FED5818DCFBA487H); (* ToLONGREAL(3FED5818H, 0DCFBA487H); *)
+ a1[ 4] := ToLONGREAL(3FEC199BDD85529CH); (* ToLONGREAL(3FEC199BH, 0DD85529CH); *)
+ a1[ 5] := ToLONGREAL(3FEAE89F995AD3ADH); (* ToLONGREAL(3FEAE89FH, 0995AD3ADH); *)
+ a1[ 6] := ToLONGREAL(3FE9C49182A3F090H); (* ToLONGREAL(3FE9C491H, 082A3F090H); *)
+ a1[ 7] := ToLONGREAL(3FE8ACE5422AA0DBH); (* ToLONGREAL(3FE8ACE5H, 0422AA0DBH); *)
+ a1[ 8] := ToLONGREAL(3FE7A11473EB0186H); (* ToLONGREAL(3FE7A114H, 073EB0186H); *)
+ a1[ 9] := ToLONGREAL(3FE6A09E667F3BCCH); (* ToLONGREAL(3FE6A09EH, 0667F3BCCH); *)
+ a1[10] := ToLONGREAL(3FE5AB07DD485429H); (* ToLONGREAL(3FE5AB07H, 0DD485429H); *)
+ a1[11] := ToLONGREAL(3FE4BFDAD5362A27H); (* ToLONGREAL(3FE4BFDAH, 0D5362A27H); *)
+ a1[12] := ToLONGREAL(3FE3DEA64C123422H); (* ToLONGREAL(3FE3DEA6H, 04C123422H); *)
+ a1[13] := ToLONGREAL(3FE306FE0A31B715H); (* ToLONGREAL(3FE306FEH, 00A31B715H); *)
+ a1[14] := ToLONGREAL(3FE2387A6E756238H); (* ToLONGREAL(3FE2387AH, 06E756238H); *)
+ a1[15] := ToLONGREAL(3FE172B83C7D517AH); (* ToLONGREAL(3FE172B8H, 03C7D517AH); *)
+ a1[16] := ToLONGREAL(3FE0B5586CF9890FH); (* ToLONGREAL(3FE0B558H, 06CF9890FH); *)
+ a1[17] := HALF;
(* a2[i]=2**[(1-2i)/16] - a1[2i]; delta resolution *)
- a2[1]:=ToLONGREAL(3C90B1EEH, 074320000H);
- a2[2]:=ToLONGREAL(3C711065H, 089500000H);
- a2[3]:=ToLONGREAL(3C6C7C46H, 0B0700000H);
- a2[4]:=ToLONGREAL(3C9AFAA2H, 0047F0000H);
- a2[5]:=ToLONGREAL(3C86324CH, 005460000H);
- a2[6]:=ToLONGREAL(3C7ADA09H, 011F00000H);
- a2[7]:=ToLONGREAL(3C89B07EH, 0B6C80000H);
- a2[8]:=ToLONGREAL(3C88A62EH, 04ADC0000H);
-
+ a2[1] := ToLONGREAL(3C90B1EE74320000H); (* ToLONGREAL(3C90B1EEH, 074320000H); *)
+ a2[2] := ToLONGREAL(3C71106589500000H); (* ToLONGREAL(3C711065H, 089500000H); *)
+ a2[3] := ToLONGREAL(3C6C7C46B0700000H); (* ToLONGREAL(3C6C7C46H, 0B0700000H); *)
+ a2[4] := ToLONGREAL(3C9AFAA2047F0000H); (* ToLONGREAL(3C9AFAA2H, 0047F0000H); *)
+ a2[5] := ToLONGREAL(3C86324C05460000H); (* ToLONGREAL(3C86324CH, 005460000H); *)
+ a2[6] := ToLONGREAL(3C7ADA0911F00000H); (* ToLONGREAL(3C7ADA09H, 011F00000H); *)
+ a2[7] := ToLONGREAL(3C89B07EB6C80000H); (* ToLONGREAL(3C89B07EH, 0B6C80000H); *)
+ a2[8] := ToLONGREAL(3C88A62E4ADC0000H); (* ToLONGREAL(3C88A62EH, 04ADC0000H); *)
+
(* reenable compiler warnings *)
(*<* POP *>*)
END oocLRealMath.
diff --git a/src/library/ooc/oocLowLReal.Mod b/src/library/ooc/oocLowLReal.Mod
index 0a15f6dd..e28e13cf 100644
--- a/src/library/ooc/oocLowLReal.Mod
+++ b/src/library/ooc/oocLowLReal.Mod
@@ -1,21 +1,23 @@
(* $Id: LowLReal.Mod,v 1.6 1999/09/02 13:15:35 acken Exp $ *)
MODULE oocLowLReal;
+(* ToDo. support 64 bit builds *)
+
(*
- LowLReal - Gives access to the underlying properties of the type LONGREAL
- for IEEE double-precision numbers.
+ LowLReal - Gives access to the underlying properties of the type LONGREAL
+ for IEEE double-precision numbers.
Copyright (C) 1996 Michael Griebling
-
+
This module is free software; you can redistribute it and/or modify
- it under the terms of the GNU Lesser General Public License as
+ it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
-
+
This module is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Lesser General Public License for more details.
-
+
You should have received a copy of the GNU Lesser General Public
License along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
@@ -26,7 +28,7 @@ MODULE oocLowLReal;
IMPORT Low := oocLowReal, S := SYSTEM;
(*
-
+
Real number properties are defined as follows:
radix--The whole number value of the radix used to represent the
@@ -44,50 +46,50 @@ IMPORT Low := oocLowReal, S := SYSTEM;
small--The smallest positive value of the corresponding real number
type, represented to maximal precision.
- IEC559--A Boolean value that is TRUE if and only if the implementation
- of the corresponding real number type conforms to IEC 559:1989
+ IEC559--A Boolean value that is TRUE if and only if the implementation
+ of the corresponding real number type conforms to IEC 559:1989
(IEEE 754:1987) in all regards.
NOTES
6 -- If `IEC559' is TRUE, the value of `radix' is 2.
- 7 -- If LowReal.IEC559 is TRUE, the 32-bit format of IEC 559:1989
+ 7 -- If LowReal.IEC559 is TRUE, the 32-bit format of IEC 559:1989
is used for the type REAL.
- 7 -- If LowLong.IEC559 is TRUE, the 64-bit format of IEC 559:1989
+ 7 -- If LowLong.IEC559 is TRUE, the 64-bit format of IEC 559:1989
is used for the type REAL.
- LIA1--A Boolean value that is TRUE if and only if the implementation of
- the corresponding real number type conforms to ISO/IEC 10967-1:199x
- (LIA-1) in all regards: parameters, arithmetic, exceptions, and
+ LIA1--A Boolean value that is TRUE if and only if the implementation of
+ the corresponding real number type conforms to ISO/IEC 10967-1:199x
+ (LIA-1) in all regards: parameters, arithmetic, exceptions, and
notification.
- rounds--A Boolean value that is TRUE if and only if each operation produces
- a result that is one of the values of the corresponding real number
+ rounds--A Boolean value that is TRUE if and only if each operation produces
+ a result that is one of the values of the corresponding real number
type nearest to the mathematical result.
- gUnderflow--A Boolean value that is TRUE if and only if there are values of
- the corresponding real number type between 0.0 and `small'.
+ gUnderflow--A Boolean value that is TRUE if and only if there are values of
+ the corresponding real number type between 0.0 and `small'.
- exception--A Boolean value that is TRUE if and only if every operation that
+ exception--A Boolean value that is TRUE if and only if every operation that
attempts to produce a real value out of range raises an exception.
- extend--A Boolean value that is TRUE if and only if expressions of the
- corresponding real number type are computed to higher precision than
+ extend--A Boolean value that is TRUE if and only if expressions of the
+ corresponding real number type are computed to higher precision than
the stored values.
- nModes--The whole number value giving the number of bit positions needed for
+ nModes--The whole number value giving the number of bit positions needed for
the status flags for mode control.
-
+
*)
CONST
radix*= 2;
- places*= 53;
- expoMax*= 1023;
+ places*= 53;
+ expoMax*= 1023;
expoMin*= 1-expoMax;
large*= MAX(LONGREAL); (*1.7976931348623157D+308;*) (* MAX(LONGREAL) *)
(*small*= 2.2250738585072014D-308;*)
small*= 2.2250738585072014/9.9999999999999981D307(*/10^308)*);
- IEC559*= TRUE;
+ IEC559*= TRUE;
LIA1*= FALSE;
rounds*= FALSE;
gUnderflow*= TRUE; (* there are IEEE numbers smaller than `small' *)
@@ -97,23 +99,23 @@ CONST
ONE=1.0D0; (* some commonly-used constants *)
ZERO=0.0D0;
TEN=1.0D1;
-
+
DEBUG = TRUE;
- expOffset=expoMax;
- hiBit=19;
+ expOffset=expoMax;
+ hiBit=19;
expBit=hiBit+1;
nMask={0..hiBit,31}; (* number mask *)
expMask={expBit..30}; (* exponent mask *)
-
+
TYPE
Modes*= SET;
LongInt=ARRAY 2 OF LONGINT;
- LongSet=ARRAY 2 OF SET;
-
+ LongSet=ARRAY 2 OF SET;
+
VAR
(*sml* : LONGREAL; tmp: LONGREAL;*) (* this was a test to get small as a variable at runtime. obviously, compile time preferred; -- noch *)
- isBigEndian-: BOOLEAN; (* set when target is big endian *)
+ isBigEndian-: BOOLEAN; (* set when target is big endian *)
(*
PROCEDURE power0(i, j : INTEGER) : LONGREAL; (* used to calculate sml at runtime; -- noch *)
VAR k : INTEGER;
@@ -139,7 +141,7 @@ END err;
PROCEDURE ClearError*;
BEGIN
Low.ClearError
-END ClearError;
+END ClearError;
PROCEDURE ErrorHandler*(err: INTEGER);
BEGIN
@@ -185,26 +187,26 @@ BEGIN
RETURN x
END ToReal;
(*<* POP *> *)
-
+
PROCEDURE exponent*(x: LONGREAL): INTEGER;
-(*
+(*
The value of the call exponent(x) shall be the exponent value of `x'
that lies between `expoMin' and `expoMax'. An exception shall occur
and may be raised if `x' is equal to 0.0.
- *)
+ *)
VAR ra: LongInt;
BEGIN
(* NOTE: x=0.0 should raise exception *)
IF x=ZERO THEN RETURN 0
- ELSE Move(x, ra);
- RETURN SHORT(S.LSH(ra[0],-expBit) MOD 2048)-expOffset
+ ELSE Move(x, ra);
+ RETURN SHORT(S.LSH(ra[0],-expBit) MOD 2048)-expOffset
END
END exponent;
PROCEDURE exponent10*(x: LONGREAL): INTEGER;
-(*
- The value of the call exponent10(x) shall be the base 10 exponent
- value of `x'. An exception shall occur and may be raised if `x' is
+(*
+ The value of the call exponent10(x) shall be the base 10 exponent
+ value of `x'. An exception shall occur and may be raised if `x' is
equal to 0.0.
*)
VAR exp: INTEGER;
@@ -215,19 +217,19 @@ BEGIN
WHILE x<1 DO x:=x*TEN; DEC(exp) END;
RETURN exp
END exponent10;
-
+
PROCEDURE fraction*(x: LONGREAL): LONGREAL;
(*
The value of the call fraction(x) shall be the significand (or
significant) part of `x'. Hence the following relationship shall
- hold: x = scale(fraction(x), exponent(x)).
+ hold: x = scale(fraction(x), exponent(x)).
*)
CONST eZero={(hiBit+2)..29};
VAR ra: LongInt;
BEGIN
- IF x=ZERO THEN RETURN ZERO
+ IF x=ZERO THEN RETURN ZERO
ELSE Move(x, ra);
- ra[0]:=S.VAL(LONGINT, S.VAL(SET,ra[0])*nMask+eZero);
+ ra[0]:=S.VAL(LONGINT, S.VAL(SET,ra[0])*nMask+eZero);
RETURN Real(ra)*2.0D0
END
END fraction;
@@ -246,13 +248,13 @@ PROCEDURE IsNaN * (real: LONGREAL) : BOOLEAN;
BEGIN
MoveSet(real, ra);
RETURN (ra[0]*expMask=expMask) & ((ra[1]#{}) OR (ra[0]*fracMask#{}))
-END IsNaN;
+END IsNaN;
PROCEDURE sign*(x: LONGREAL): LONGREAL;
(*
The value of the call sign(x) shall be 1.0 if `x' is greater than 0.0,
or shall be -1.0 if `x' is less than 0.0, or shall be either 1.0 or
- -1.0 if `x' is equal to 0.0.
+ -1.0 if `x' is equal to 0.0.
*)
BEGIN
IF x 0 THEN
SYSTEM.MOVE(SYSTEM.ADR(buf[beg]), SYSTEM.ADR(context.in[0]), len)
diff --git a/src/library/s3/ethReals.Mod b/src/library/s3/ethReals.Mod
index d13397f6..484b186c 100644
--- a/src/library/s3/ethReals.Mod
+++ b/src/library/s3/ethReals.Mod
@@ -3,14 +3,14 @@ Refer to the "General ETH Oberon System Source License" contract available at: h
MODULE ethReals; (** portable *)
-(** Implementation of the non-portable components of IEEE REAL and
-LONGREAL manipulation. The routines here are required to do conversion
-of reals to strings and back.
-Implemented by Bernd Moesli, Seminar for Applied Mathematics,
+(** Implementation of the non-portable components of IEEE REAL and
+LONGREAL manipulation. The routines here are required to do conversion
+of reals to strings and back.
+Implemented by Bernd Moesli, Seminar for Applied Mathematics,
Swiss Federal Institute of Technology Zrich.
*)
-IMPORT SYSTEM, Platform, Configuration;
+IMPORT SYSTEM, Modules;
(* Bernd Moesli
Seminar for Applied Mathematics
@@ -50,7 +50,7 @@ BEGIN
RETURN SHORT(ASH(SYSTEM.VAL(INTEGER, x), -23)) MOD 256
ELSIF SIZE(LONGINT) = 4 THEN
RETURN SHORT(ASH(SYSTEM.VAL(LONGINT, x), -23)) MOD 256
- ELSE Platform.Halt(-15);
+ ELSE Modules.Halt(-15);
END
END Expo;
@@ -77,7 +77,7 @@ BEGIN
SYSTEM.GET(SYSTEM.ADR(x), i);
i := SHORT(ASH(ASH(ASH(i, -31), 8) + e MOD 256, 23) + i MOD ASH(1, 23));
SYSTEM.PUT(SYSTEM.ADR(x), i)
- ELSE Platform.Halt(-15)
+ ELSE Modules.Halt(-15)
END
END SetExpo;
@@ -93,19 +93,19 @@ BEGIN
SYSTEM.GET(SYSTEM.ADR(x) + H, i);
i := SHORT(ASH(ASH(ASH(i, -31), 11) + e MOD 2048, 20) + i MOD ASH(1, 20));
SYSTEM.PUT(SYSTEM.ADR(x) + H, i)
- ELSE Platform.Halt(-15)
+ ELSE Modules.Halt(-15)
END
END SetExpoL;
(** Convert hexadecimal to REAL. *)
PROCEDURE Real* (h: LONGINT): REAL;
VAR x: REAL;
-BEGIN
+BEGIN
IF SIZE(LONGINT) = 4 THEN
SYSTEM.PUT(SYSTEM.ADR(x), h)
ELSIF SIZE(INTEGER) = 4 THEN
SYSTEM.PUT(SYSTEM.ADR(x), SYSTEM.VAL(INTEGER, h))
- ELSE Platform.Halt(-15)
+ ELSE Modules.Halt(-15)
END;
RETURN x
END Real;
@@ -113,14 +113,14 @@ END Real;
(** Convert hexadecimal to LONGREAL. h and l are the high and low parts.*)
PROCEDURE RealL* (h, l: LONGINT): LONGREAL;
VAR x: LONGREAL;
-BEGIN
+BEGIN
IF SIZE(LONGINT) = 4 THEN
- SYSTEM.PUT(SYSTEM.ADR(x) + H, h);
+ SYSTEM.PUT(SYSTEM.ADR(x) + H, h);
SYSTEM.PUT(SYSTEM.ADR(x) + L, l)
ELSIF SIZE(INTEGER) = 4 THEN
- SYSTEM.PUT(SYSTEM.ADR(x) + H, SYSTEM.VAL(INTEGER, h));
+ SYSTEM.PUT(SYSTEM.ADR(x) + H, SYSTEM.VAL(INTEGER, h));
SYSTEM.PUT(SYSTEM.ADR(x) + L, SYSTEM.VAL(INTEGER, l))
- ELSE Platform.Halt(-15)
+ ELSE Modules.Halt(-15)
END;
RETURN x
END RealL;
@@ -128,26 +128,26 @@ END RealL;
(** Convert REAL to hexadecimal. *)
PROCEDURE Int* (x: REAL): LONGINT;
VAR i: INTEGER; l: LONGINT;
-BEGIN
+BEGIN
IF SIZE(LONGINT) = 4 THEN
SYSTEM.PUT(SYSTEM.ADR(l), x); RETURN l
ELSIF SIZE(INTEGER) = 4 THEN
SYSTEM.PUT(SYSTEM.ADR(i), x); RETURN i
- ELSE Platform.Halt(-15)
+ ELSE Modules.Halt(-15)
END
END Int;
(** Convert LONGREAL to hexadecimal. h and l are the high and low parts. *)
PROCEDURE IntL* (x: LONGREAL; VAR h, l: LONGINT);
VAR i: INTEGER;
-BEGIN
+BEGIN
IF SIZE(LONGINT) = 4 THEN
- SYSTEM.GET(SYSTEM.ADR(x) + H, h);
+ SYSTEM.GET(SYSTEM.ADR(x) + H, h);
SYSTEM.GET(SYSTEM.ADR(x) + L, l)
ELSIF SIZE(INTEGER) = 4 THEN
- SYSTEM.GET(SYSTEM.ADR(x) + H, i); h := i;
+ SYSTEM.GET(SYSTEM.ADR(x) + H, i); h := i;
SYSTEM.GET(SYSTEM.ADR(x) + L, i); l := i
- ELSE Platform.Halt(-15)
+ ELSE Modules.Halt(-15)
END
END IntL;
@@ -218,69 +218,63 @@ BEGIN
END SetFCR;
*)
-PROCEDURE RealX (h, l: LONGINT; adr: LONGINT);
-BEGIN
- IF SIZE(LONGINT) = 4 THEN
- SYSTEM.PUT(adr + H, h); SYSTEM.PUT(adr + L, l);
- ELSIF SIZE(INTEGER) = 4 THEN
- SYSTEM.PUT(adr + H, SYSTEM.VAL(INTEGER, h));
- SYSTEM.PUT(adr + L, SYSTEM.VAL(INTEGER, l));
- ELSE Platform.Halt(-15)
- END
+
+PROCEDURE RealX (v: HUGEINT; VAR lr: LONGREAL);
+BEGIN lr := SYSTEM.VAL(LONGREAL, v)
END RealX;
BEGIN
- RealX(03FF00000H, 000000000H, SYSTEM.ADR(tene[0]));
- RealX(040240000H, 000000000H, SYSTEM.ADR(tene[1])); (* 1 *)
- RealX(040590000H, 000000000H, SYSTEM.ADR(tene[2])); (* 2 *)
- RealX(0408F4000H, 000000000H, SYSTEM.ADR(tene[3])); (* 3 *)
- RealX(040C38800H, 000000000H, SYSTEM.ADR(tene[4])); (* 4 *)
- RealX(040F86A00H, 000000000H, SYSTEM.ADR(tene[5])); (* 5 *)
- RealX(0412E8480H, 000000000H, SYSTEM.ADR(tene[6])); (* 6 *)
- RealX(0416312D0H, 000000000H, SYSTEM.ADR(tene[7])); (* 7 *)
- RealX(04197D784H, 000000000H, SYSTEM.ADR(tene[8])); (* 8 *)
- RealX(041CDCD65H, 000000000H, SYSTEM.ADR(tene[9])); (* 9 *)
- RealX(04202A05FH, 020000000H, SYSTEM.ADR(tene[10])); (* 10 *)
- RealX(042374876H, 0E8000000H, SYSTEM.ADR(tene[11])); (* 11 *)
- RealX(0426D1A94H, 0A2000000H, SYSTEM.ADR(tene[12])); (* 12 *)
- RealX(042A2309CH, 0E5400000H, SYSTEM.ADR(tene[13])); (* 13 *)
- RealX(042D6BCC4H, 01E900000H, SYSTEM.ADR(tene[14])); (* 14 *)
- RealX(0430C6BF5H, 026340000H, SYSTEM.ADR(tene[15])); (* 15 *)
- RealX(04341C379H, 037E08000H, SYSTEM.ADR(tene[16])); (* 16 *)
- RealX(043763457H, 085D8A000H, SYSTEM.ADR(tene[17])); (* 17 *)
- RealX(043ABC16DH, 0674EC800H, SYSTEM.ADR(tene[18])); (* 18 *)
- RealX(043E158E4H, 060913D00H, SYSTEM.ADR(tene[19])); (* 19 *)
- RealX(04415AF1DH, 078B58C40H, SYSTEM.ADR(tene[20])); (* 20 *)
- RealX(0444B1AE4H, 0D6E2EF50H, SYSTEM.ADR(tene[21])); (* 21 *)
- RealX(04480F0CFH, 0064DD592H, SYSTEM.ADR(tene[22])); (* 22 *)
-
- RealX(00031FA18H, 02C40C60DH, SYSTEM.ADR(ten[0])); (* -307 *)
- RealX(004F7CAD2H, 03DE82D7BH, SYSTEM.ADR(ten[1])); (* -284 *)
- RealX(009BF7D22H, 08322BAF5H, SYSTEM.ADR(ten[2])); (* -261 *)
- RealX(00E84D669H, 05B193BF8H, SYSTEM.ADR(ten[3])); (* -238 *)
- RealX(0134B9408H, 0EEFEA839H, SYSTEM.ADR(ten[4])); (* -215 *)
- RealX(018123FF0H, 06EEA847AH, SYSTEM.ADR(ten[5])); (* -192 *)
- RealX(01CD82742H, 091C6065BH, SYSTEM.ADR(ten[6])); (* -169 *)
- RealX(0219FF779H, 0FD329CB9H, SYSTEM.ADR(ten[7])); (* -146 *)
- RealX(02665275EH, 0D8D8F36CH, SYSTEM.ADR(ten[8])); (* -123 *)
- RealX(02B2BFF2EH, 0E48E0530H, SYSTEM.ADR(ten[9])); (* -100 *)
- RealX(02FF286D8H, 00EC190DCH, SYSTEM.ADR(ten[10])); (* -77 *)
- RealX(034B8851AH, 00B548EA4H, SYSTEM.ADR(ten[11])); (* -54 *)
- RealX(0398039D6H, 065896880H, SYSTEM.ADR(ten[12])); (* -31 *)
- RealX(03E45798EH, 0E2308C3AH, SYSTEM.ADR(ten[13])); (* -8 *)
- RealX(0430C6BF5H, 026340000H, SYSTEM.ADR(ten[14])); (* 15 *)
- RealX(047D2CED3H, 02A16A1B1H, SYSTEM.ADR(ten[15])); (* 38 *)
- RealX(04C98E45EH, 01DF3B015H, SYSTEM.ADR(ten[16])); (* 61 *)
- RealX(0516078E1H, 011C3556DH, SYSTEM.ADR(ten[17])); (* 84 *)
- RealX(05625CCFEH, 03D35D80EH, SYSTEM.ADR(ten[18])); (* 107 *)
- RealX(05AECDA62H, 0055B2D9EH, SYSTEM.ADR(ten[19])); (* 130 *)
- RealX(05FB317E5H, 0EF3AB327H, SYSTEM.ADR(ten[20])); (* 153 *)
- RealX(064794514H, 05230B378H, SYSTEM.ADR(ten[21])); (* 176 *)
- RealX(06940B8E0H, 0ACAC4EAFH, SYSTEM.ADR(ten[22])); (* 199 *)
- RealX(06E0621B1H, 0C28AC20CH, SYSTEM.ADR(ten[23])); (* 222 *)
- RealX(072CD4A7BH, 0EBFA31ABH, SYSTEM.ADR(ten[24])); (* 245 *)
- RealX(077936214H, 09CBD3226H, SYSTEM.ADR(ten[25])); (* 268 *)
- RealX(07C59A742H, 0461887F6H, SYSTEM.ADR(ten[26])); (* 291 *)
+ RealX(03FF0000000000000H, tene[0]);
+ RealX(04024000000000000H, tene[1]); (* 1 *)
+ RealX(04059000000000000H, tene[2]); (* 2 *)
+ RealX(0408F400000000000H, tene[3]); (* 3 *)
+ RealX(040C3880000000000H, tene[4]); (* 4 *)
+ RealX(040F86A0000000000H, tene[5]); (* 5 *)
+ RealX(0412E848000000000H, tene[6]); (* 6 *)
+ RealX(0416312D000000000H, tene[7]); (* 7 *)
+ RealX(04197D78400000000H, tene[8]); (* 8 *)
+ RealX(041CDCD6500000000H, tene[9]); (* 9 *)
+ RealX(04202A05F20000000H, tene[10]); (* 10 *)
+ RealX(042374876E8000000H, tene[11]); (* 11 *)
+ RealX(0426D1A94A2000000H, tene[12]); (* 12 *)
+ RealX(042A2309CE5400000H, tene[13]); (* 13 *)
+ RealX(042D6BCC41E900000H, tene[14]); (* 14 *)
+ RealX(0430C6BF526340000H, tene[15]); (* 15 *)
+ RealX(04341C37937E08000H, tene[16]); (* 16 *)
+ RealX(04376345785D8A000H, tene[17]); (* 17 *)
+ RealX(043ABC16D674EC800H, tene[18]); (* 18 *)
+ RealX(043E158E460913D00H, tene[19]); (* 19 *)
+ RealX(04415AF1D78B58C40H, tene[20]); (* 20 *)
+ RealX(0444B1AE4D6E2EF50H, tene[21]); (* 21 *)
+ RealX(04480F0CF064DD592H, tene[22]); (* 22 *)
+
+ RealX(00031FA182C40C60DH, ten[0]); (* -307 *)
+ RealX(004F7CAD23DE82D7BH, ten[1]); (* -284 *)
+ RealX(009BF7D228322BAF5H, ten[2]); (* -261 *)
+ RealX(00E84D6695B193BF8H, ten[3]); (* -238 *)
+ RealX(0134B9408EEFEA839H, ten[4]); (* -215 *)
+ RealX(018123FF06EEA847AH, ten[5]); (* -192 *)
+ RealX(01CD8274291C6065BH, ten[6]); (* -169 *)
+ RealX(0219FF779FD329CB9H, ten[7]); (* -146 *)
+ RealX(02665275ED8D8F36CH, ten[8]); (* -123 *)
+ RealX(02B2BFF2EE48E0530H, ten[9]); (* -100 *)
+ RealX(02FF286D80EC190DCH, ten[10]); (* -77 *)
+ RealX(034B8851A0B548EA4H, ten[11]); (* -54 *)
+ RealX(0398039D665896880H, ten[12]); (* -31 *)
+ RealX(03E45798EE2308C3AH, ten[13]); (* -8 *)
+ RealX(0430C6BF526340000H, ten[14]); (* 15 *)
+ RealX(047D2CED32A16A1B1H, ten[15]); (* 38 *)
+ RealX(04C98E45E1DF3B015H, ten[16]); (* 61 *)
+ RealX(0516078E111C3556DH, ten[17]); (* 84 *)
+ RealX(05625CCFE3D35D80EH, ten[18]); (* 107 *)
+ RealX(05AECDA62055B2D9EH, ten[19]); (* 130 *)
+ RealX(05FB317E5EF3AB327H, ten[20]); (* 153 *)
+ RealX(0647945145230B378H, ten[21]); (* 176 *)
+ RealX(06940B8E0ACAC4EAFH, ten[22]); (* 199 *)
+ RealX(06E0621B1C28AC20CH, ten[23]); (* 222 *)
+ RealX(072CD4A7BEBFA31ABH, ten[24]); (* 245 *)
+ RealX(0779362149CBD3226H, ten[25]); (* 268 *)
+ RealX(07C59A742461887F6H, ten[26]); (* 291 *)
eq[0]:= {0, 3, 4, 5, 9, 16, 23, 25, 26, 28, 31};
eq[1]:= {2, 5, 6, 8, 9, 10, 11, 12, 13, 14, 15, 17, 18, 19, 20, 21, 23, 24, 25, 27, 28, 29, 30, 31};
diff --git a/src/library/s3/ethZlibBuffers.Mod b/src/library/s3/ethZlibBuffers.Mod
index 9db0736c..f484a980 100644
--- a/src/library/s3/ethZlibBuffers.Mod
+++ b/src/library/s3/ethZlibBuffers.Mod
@@ -3,8 +3,7 @@ Refer to the "General ETH Oberon System Source License" contract available at: h
MODULE ethZlibBuffers; (** Stefan Walthert **)
-IMPORT
- SYSTEM;
+IMPORT SYSTEM;
(*
should be portable even if SYSTEM is imported:
- PUT and GET only with byte sized operands
@@ -13,13 +12,14 @@ IMPORT
TYPE
(** input/output buffer **)
- Address = LONGINT;
+ Address = SYSTEM.ADDRESS;
Buffer* = RECORD
- avail-: LONGINT; (** number of bytes that can be produced/consumed **)
- size-: LONGINT; (** total number of bytes in buffer memory **)
- totalOut-, totalIn-: LONGINT; (** total number of bytes produced/consumed **)
- next: Address; (* address of next byte to produce/consume **)
- adr: Address; (* buffer memory *)
+ avail-: LONGINT; (** number of bytes that can be produced/consumed **)
+ size-: LONGINT; (** total number of bytes in buffer memory **)
+ totalOut-: LONGINT; (** total number of bytes produced **)
+ totalIn-: LONGINT; (** total number of bytes consumed **)
+ next: Address; (* address of next byte to produce/consume **)
+ adr: Address; (* buffer memory *)
END;
@@ -50,9 +50,9 @@ PROCEDURE ReadBytes* (VAR buf: Buffer; VAR dst: ARRAY OF CHAR; offset, len: LONG
BEGIN
ASSERT((0 <= offset) & (0 < len) & (offset + len <= LEN(dst)) & (len <= buf.avail), 100);
SYSTEM.MOVE(buf.next, SYSTEM.ADR(dst[offset]), len);
- INC(buf.next, len); DEC(buf.avail, len); INC(buf.totalIn, len)
+ INC(buf.next, len); DEC(buf.avail, len); INC(buf.totalIn, len)
END ReadBytes;
-
+
(** write byte into (output) buffer **)
PROCEDURE Write* (VAR buf: Buffer; ch: CHAR);
BEGIN
@@ -89,7 +89,7 @@ PROCEDURE Rewrite* (VAR buf: Buffer);
BEGIN
buf.next := buf.adr; buf.avail := buf.size
END Rewrite;
-
+
(** fill input buffer with new bytes to consume **)
PROCEDURE Fill* (VAR buf: Buffer; VAR src: ARRAY OF CHAR; offset, size: LONGINT);
BEGIN
diff --git a/src/library/ulm/ulmCipherOps.Mod b/src/library/ulm/ulmCipherOps.Mod
index cf3318a7..f2ef7602 100644
--- a/src/library/ulm/ulmCipherOps.Mod
+++ b/src/library/ulm/ulmCipherOps.Mod
@@ -1,67 +1,69 @@
(* Ulm's Oberon Library
- Copyright (C) 1989-1997 by University of Ulm, SAI, D-89069 Ulm, Germany
- ----------------------------------------------------------------------------
- Ulm's Oberon Library is free software; you can redistribute it
- and/or modify it under the terms of the GNU Library General Public
- License as published by the Free Software Foundation; either version
- 2 of the License, or (at your option) any later version.
+ Copyright (C) 1989-1997 by University of Ulm, SAI, D-89069 Ulm, Germany
+ ----------------------------------------------------------------------------
+ Ulm's Oberon Library is free software; you can redistribute it
+ and/or modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either version
+ 2 of the License, or (at your option) any later version.
- Ulm's Oberon Library is distributed in the hope that it will be
- useful, but WITHOUT ANY WARRANTY; without even the implied warranty
- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Library General Public License for more details.
+ Ulm's Oberon Library is distributed in the hope that it will be
+ useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+ of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
- You should have received a copy of the GNU Library General Public
- License along with this library; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ----------------------------------------------------------------------------
- E-mail contact: oberon@mathematik.uni-ulm.de
- ----------------------------------------------------------------------------
- $Id: CipherOps.om,v 1.1 1997/04/02 11:53:20 borchert Exp borchert $
- ----------------------------------------------------------------------------
- $Log: CipherOps.om,v $
- Revision 1.1 1997/04/02 11:53:20 borchert
- Initial revision
+ You should have received a copy of the GNU Library General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ----------------------------------------------------------------------------
+ E-mail contact: oberon@mathematik.uni-ulm.de
+ ----------------------------------------------------------------------------
+ $Id: CipherOps.om,v 1.1 1997/04/02 11:53:20 borchert Exp borchert $
+ ----------------------------------------------------------------------------
+ $Log: CipherOps.om,v $
+ Revision 1.1 1997/04/02 11:53:20 borchert
+ Initial revision
- ----------------------------------------------------------------------------
+ ----------------------------------------------------------------------------
*)
MODULE ulmCipherOps; (* Michael Szczuka *)
- (* useful functions for stream ciphers *)
+ (* useful functions for stream ciphers *)
- IMPORT Streams := ulmStreams, SYS := SYSTEM, Write := ulmWrite;
+ IMPORT Streams := ulmStreams, SYS := SYSTEM, Write := ulmWrite;
- PROCEDURE XorByte* (b1, b2: SYS.BYTE) : SYS.BYTE;
- (* adds two bytes bitwise modulo 2 *)
- BEGIN
- RETURN SYS.VAL(SYS.BYTE, SYS.VAL(SET, b1) / SYS.VAL(SET, b2))
- END XorByte;
+ PROCEDURE XorByte* (b1, b2: SYS.BYTE) : SYS.BYTE;
+ (* adds two bytes bitwise modulo 2 *)
+ BEGIN
+ (*RETURN SYS.VAL(SYS.BYTE, SYS.VAL(SET, LONG(b1)) / SYS.VAL(SET, LONG(b2)))*)
+ RETURN SYS.VAL(SYS.BYTE, SYS.VAL(SET, LONG(LONG(SYS.VAL(SHORTINT, b1))))
+ / SYS.VAL(SET, LONG(LONG(SYS.VAL(SHORTINT, b2)))))
+ END XorByte;
- PROCEDURE XorStream* (in1, in2, out: Streams.Stream;
- length: INTEGER) : BOOLEAN;
- (* adds two streams bitwise modulo 2; restricted to length bytes *)
- VAR
- b1, b2, res : SYS.BYTE;
- wholeStream : BOOLEAN;
- BEGIN
- IF length < 0 THEN
- wholeStream := TRUE;
+ PROCEDURE XorStream* (in1, in2, out: Streams.Stream;
+ length: INTEGER) : BOOLEAN;
+ (* adds two streams bitwise modulo 2; restricted to length bytes *)
+ VAR
+ b1, b2, res : SYS.BYTE;
+ wholeStream : BOOLEAN;
+ BEGIN
+ IF length < 0 THEN
+ wholeStream := TRUE;
+ ELSE
+ wholeStream := FALSE;
+ END;
+ WHILE wholeStream OR (length > 0) DO
+ IF Streams.ReadByte(in1, b1) & Streams.ReadByte(in2, b2) THEN
+ res := XorByte(b1, b2);
+ IF ~Streams.WriteByte(out, res) THEN
+ RETURN FALSE
+ END;
ELSE
- wholeStream := FALSE;
+ RETURN wholeStream
END;
- WHILE wholeStream OR (length > 0) DO
- IF Streams.ReadByte(in1, b1) & Streams.ReadByte(in2, b2) THEN
- res := XorByte(b1, b2);
- IF ~Streams.WriteByte(out, res) THEN
- RETURN FALSE
- END;
- ELSE
- RETURN wholeStream
- END;
- DEC(length);
- END;
- RETURN TRUE
- END XorStream;
+ DEC(length);
+ END;
+ RETURN TRUE
+ END XorStream;
END ulmCipherOps.
diff --git a/src/library/ulm/ulmCiphers.Mod b/src/library/ulm/ulmCiphers.Mod
index bc881c83..95d66aa8 100644
--- a/src/library/ulm/ulmCiphers.Mod
+++ b/src/library/ulm/ulmCiphers.Mod
@@ -29,15 +29,15 @@
(* abstraction for the use of ciphers and cryptographic methods *)
MODULE ulmCiphers;
-IMPORT Objects := ulmObjects, PersistentObjects := ulmPersistentObjects, PersistentDisciplines := ulmPersistentDisciplines, Services := ulmServices,
+IMPORT Objects := ulmObjects, PersistentObjects := ulmPersistentObjects, PersistentDisciplines := ulmPersistentDisciplines, Services := ulmServices,
Streams := ulmStreams, Write := ulmWrite;
TYPE
Cipher* = POINTER TO CipherRec;
-TYPE
- CryptProc* = PROCEDURE (in: Streams.Stream; key: Cipher;
- length: INTEGER; out: Streams.Stream) : BOOLEAN;
+TYPE
+ CryptProc* = PROCEDURE (in: Streams.Stream; key: Cipher;
+ length: INTEGER; out: Streams.Stream) : BOOLEAN;
TYPE
Interface* = POINTER TO InterfaceRec;
@@ -48,7 +48,7 @@ TYPE
END;
TYPE
- CipherRec* = RECORD
+ CipherRec* = RECORD
(PersistentDisciplines.ObjectRec)
(* private *)
if : Interface
@@ -64,31 +64,31 @@ BEGIN
key.if := if;
END Init;
-PROCEDURE Encrypt*(in: Streams.Stream; key: Cipher;
- out: Streams.Stream) : BOOLEAN;
+PROCEDURE Encrypt*(in: Streams.Stream; key: Cipher;
+ out: Streams.Stream) : BOOLEAN;
BEGIN
RETURN key.if.encrypt(in, key, -1, out);
END Encrypt;
-PROCEDURE Decrypt*(in: Streams.Stream; key: Cipher;
- out: Streams.Stream) : BOOLEAN;
+PROCEDURE Decrypt*(in: Streams.Stream; key: Cipher;
+ out: Streams.Stream) : BOOLEAN;
BEGIN
RETURN key.if.decrypt(in, key, -1, out);
END Decrypt;
-PROCEDURE EncryptPart*(in: Streams.Stream; key: Cipher;
- length: INTEGER; out: Streams.Stream) : BOOLEAN;
+PROCEDURE EncryptPart*(in: Streams.Stream; key: Cipher;
+ length: INTEGER; out: Streams.Stream) : BOOLEAN;
BEGIN
RETURN key.if.encrypt(in, key, length, out);
END EncryptPart;
-PROCEDURE DecryptPart*(in: Streams.Stream; key: Cipher;
- length: INTEGER; out: Streams.Stream) : BOOLEAN;
+PROCEDURE DecryptPart*(in: Streams.Stream; key: Cipher;
+ length: INTEGER; out: Streams.Stream) : BOOLEAN;
BEGIN
RETURN key.if.decrypt(in, key, length, out);
END DecryptPart;
BEGIN
- PersistentObjects.RegisterType(cipherType, "Ciphers.Cipher",
+ PersistentObjects.RegisterType(cipherType, "Ciphers.Cipher",
"PersistentDisciplines.Object", NIL);
END ulmCiphers.
diff --git a/src/library/ulm/ulmDisciplines.Mod b/src/library/ulm/ulmDisciplines.Mod
index 913f7c03..d96617a6 100644
--- a/src/library/ulm/ulmDisciplines.Mod
+++ b/src/library/ulm/ulmDisciplines.Mod
@@ -1,140 +1,140 @@
(* Ulm's Oberon Library
- Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
- ----------------------------------------------------------------------------
- Ulm's Oberon Library is free software; you can redistribute it
- and/or modify it under the terms of the GNU Library General Public
- License as published by the Free Software Foundation; either version
- 2 of the License, or (at your option) any later version.
+ Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
+ ----------------------------------------------------------------------------
+ Ulm's Oberon Library is free software; you can redistribute it
+ and/or modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either version
+ 2 of the License, or (at your option) any later version.
- Ulm's Oberon Library is distributed in the hope that it will be
- useful, but WITHOUT ANY WARRANTY; without even the implied warranty
- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Library General Public License for more details.
+ Ulm's Oberon Library is distributed in the hope that it will be
+ useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+ of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
- You should have received a copy of the GNU Library General Public
- License along with this library; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ----------------------------------------------------------------------------
- E-mail contact: oberon@mathematik.uni-ulm.de
- ----------------------------------------------------------------------------
- $Id: Disciplines.om,v 1.1 1994/02/22 20:07:03 borchert Exp $
- ----------------------------------------------------------------------------
- $Log: Disciplines.om,v $
- Revision 1.1 1994/02/22 20:07:03 borchert
- Initial revision
+ You should have received a copy of the GNU Library General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ----------------------------------------------------------------------------
+ E-mail contact: oberon@mathematik.uni-ulm.de
+ ----------------------------------------------------------------------------
+ $Id: Disciplines.om,v 1.1 1994/02/22 20:07:03 borchert Exp $
+ ----------------------------------------------------------------------------
+ $Log: Disciplines.om,v $
+ Revision 1.1 1994/02/22 20:07:03 borchert
+ Initial revision
- ----------------------------------------------------------------------------
- AFB 5/91
- ----------------------------------------------------------------------------
+ ----------------------------------------------------------------------------
+ AFB 5/91
+ ----------------------------------------------------------------------------
*)
MODULE ulmDisciplines;
- (* Disciplines allows to attach additional data structures to
- abstract datatypes like Streams;
- these added data structures permit to parametrize operations
- which are provided by other modules (e.g. Read or Write for Streams)
- *)
+ (* Disciplines allows to attach additional data structures to
+ abstract datatypes like Streams;
+ these added data structures permit to parametrize operations
+ which are provided by other modules (e.g. Read or Write for Streams)
+ *)
- IMPORT Objects := ulmObjects;
+ IMPORT Objects := ulmObjects;
- TYPE
- Identifier* = LONGINT;
+ TYPE
+ Identifier* = LONGINT;
- Discipline* = POINTER TO DisciplineRec;
- DisciplineRec* =
- RECORD
- (Objects.ObjectRec)
- id*: Identifier; (* should be unique for all types of disciplines *)
- END;
-
- DisciplineList = POINTER TO DisciplineListRec;
- DisciplineListRec =
- RECORD
- discipline: Discipline;
- id: Identifier; (* copied from discipline.id *)
- next: DisciplineList;
- END;
-
- Object* = POINTER TO ObjectRec;
- ObjectRec* =
- RECORD
- (Objects.ObjectRec)
- (* private part *)
- list: DisciplineList; (* set of disciplines *)
- END;
-
- VAR
- unique: Identifier;
-
- PROCEDURE Unique*() : Identifier;
- (* returns a unique identifier;
- this procedure should be called during initialization by
- all modules defining a discipline type
- *)
- BEGIN
- INC(unique);
- RETURN unique
- END Unique;
-
- PROCEDURE Remove*(object: Object; id: Identifier);
- (* remove the discipline with the given id from object, if it exists *)
- VAR
- prev, dl: DisciplineList;
- BEGIN
- prev := NIL;
- dl := object.list;
- WHILE (dl # NIL) & (dl.id # id) DO
- prev := dl; dl := dl.next;
+ Discipline* = POINTER TO DisciplineRec;
+ DisciplineRec* =
+ RECORD
+ (Objects.ObjectRec)
+ id*: Identifier; (* should be unique for all types of disciplines *)
END;
- IF dl # NIL THEN
- IF prev = NIL THEN
- object.list := dl.next;
- ELSE
- prev.next := dl.next;
- END;
- END;
- END Remove;
- PROCEDURE Add*(object: Object; discipline: Discipline);
- (* adds a new discipline to the given object;
- if already a discipline with the same identifier exist
- it is deleted first
- *)
- VAR
- dl: DisciplineList;
- BEGIN
- dl := object.list;
- WHILE (dl # NIL) & (dl.id # discipline.id) DO
- dl := dl.next;
+ DisciplineList = POINTER TO DisciplineListRec;
+ DisciplineListRec =
+ RECORD
+ discipline: Discipline;
+ id: Identifier; (* copied from discipline.id *)
+ next: DisciplineList;
END;
- IF dl = NIL THEN
- NEW(dl);
- dl.id := discipline.id;
- dl.next := object.list;
- object.list := dl;
- END;
- dl.discipline := discipline;
- END Add;
- PROCEDURE Seek*(object: Object; id: Identifier;
- VAR discipline: Discipline) : BOOLEAN;
- (* returns TRUE if a discipline with the given id is found *)
- VAR
- dl: DisciplineList;
- BEGIN
- dl := object.list;
- WHILE (dl # NIL) & (dl.id # id) DO
- dl := dl.next;
+ Object* = POINTER TO ObjectRec;
+ ObjectRec* =
+ RECORD
+ (Objects.ObjectRec)
+ (* private part *)
+ list: DisciplineList; (* set of disciplines *)
END;
- IF dl # NIL THEN
- discipline := dl.discipline;
+
+ VAR
+ unique: Identifier;
+
+ PROCEDURE Unique*() : Identifier;
+ (* returns a unique identifier;
+ this procedure should be called during initialization by
+ all modules defining a discipline type
+ *)
+ BEGIN
+ INC(unique);
+ RETURN unique
+ END Unique;
+
+ PROCEDURE Remove*(object: Object; id: Identifier);
+ (* remove the discipline with the given id from object, if it exists *)
+ VAR
+ prev, dl: DisciplineList;
+ BEGIN
+ prev := NIL;
+ dl := object.list;
+ WHILE (dl # NIL) & (dl.id # id) DO
+ prev := dl; dl := dl.next;
+ END;
+ IF dl # NIL THEN
+ IF prev = NIL THEN
+ object.list := dl.next;
ELSE
- discipline := NIL;
+ prev.next := dl.next;
END;
- RETURN discipline # NIL
- END Seek;
+ END;
+ END Remove;
+
+ PROCEDURE Add*(object: Object; discipline: Discipline);
+ (* adds a new discipline to the given object;
+ if already a discipline with the same identifier exist
+ it is deleted first
+ *)
+ VAR
+ dl: DisciplineList;
+ BEGIN
+ dl := object.list;
+ WHILE (dl # NIL) & (dl.id # discipline.id) DO
+ dl := dl.next;
+ END;
+ IF dl = NIL THEN
+ NEW(dl);
+ dl.id := discipline.id;
+ dl.next := object.list;
+ object.list := dl;
+ END;
+ dl.discipline := discipline;
+ END Add;
+
+ PROCEDURE Seek*(object: Object; id: Identifier;
+ VAR discipline: Discipline) : BOOLEAN;
+ (* returns TRUE if a discipline with the given id is found *)
+ VAR
+ dl: DisciplineList;
+ BEGIN
+ dl := object.list;
+ WHILE (dl # NIL) & (dl.id # id) DO
+ dl := dl.next;
+ END;
+ IF dl # NIL THEN
+ discipline := dl.discipline;
+ ELSE
+ discipline := NIL;
+ END;
+ RETURN discipline # NIL
+ END Seek;
BEGIN
- unique := 0;
+ unique := 0;
END ulmDisciplines.
diff --git a/src/library/ulm/ulmErrors.Mod b/src/library/ulm/ulmErrors.Mod
index edb1cb6f..7336bca2 100644
--- a/src/library/ulm/ulmErrors.Mod
+++ b/src/library/ulm/ulmErrors.Mod
@@ -1,158 +1,161 @@
(* Ulm's Oberon Library
- Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
- ----------------------------------------------------------------------------
- Ulm's Oberon Library is free software; you can redistribute it
- and/or modify it under the terms of the GNU Library General Public
- License as published by the Free Software Foundation; either version
- 2 of the License, or (at your option) any later version.
+ Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
+ ----------------------------------------------------------------------------
+ Ulm's Oberon Library is free software; you can redistribute it
+ and/or modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either version
+ 2 of the License, or (at your option) any later version.
- Ulm's Oberon Library is distributed in the hope that it will be
- useful, but WITHOUT ANY WARRANTY; without even the implied warranty
- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Library General Public License for more details.
+ Ulm's Oberon Library is distributed in the hope that it will be
+ useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+ of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
- You should have received a copy of the GNU Library General Public
- License along with this library; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ----------------------------------------------------------------------------
- E-mail contact: oberon@mathematik.uni-ulm.de
- ----------------------------------------------------------------------------
- $Id: Errors.om,v 1.2 1994/07/18 14:16:33 borchert Exp $
- ----------------------------------------------------------------------------
- $Log: Errors.om,v $
- Revision 1.2 1994/07/18 14:16:33 borchert
- unused variables of Write (ch & index) removed
+ You should have received a copy of the GNU Library General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ----------------------------------------------------------------------------
+ E-mail contact: oberon@mathematik.uni-ulm.de
+ ----------------------------------------------------------------------------
+ $Id: Errors.om,v 1.2 1994/07/18 14:16:33 borchert Exp $
+ ----------------------------------------------------------------------------
+ $Log: Errors.om,v $
+ Revision 1.2 1994/07/18 14:16:33 borchert
+ unused variables of Write (ch & index) removed
- Revision 1.1 1994/02/22 20:07:15 borchert
- Initial revision
+ Revision 1.1 1994/02/22 20:07:15 borchert
+ Initial revision
- ----------------------------------------------------------------------------
- AFB 11/91
- ----------------------------------------------------------------------------
+ ----------------------------------------------------------------------------
+ AFB 11/91
+ ----------------------------------------------------------------------------
*)
MODULE ulmErrors;
- (* translate events to errors *)
+ (* translate events to errors *)
- IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, Objects := ulmObjects, RelatedEvents := ulmRelatedEvents, Streams := ulmStreams, Strings := ulmStrings,
- SYS := SYSTEM;
+ IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, Objects := ulmObjects, RelatedEvents := ulmRelatedEvents, Streams := ulmStreams, Strings := ulmStrings,
+ SYS := SYSTEM;
- CONST
- (* Kind = (debug, message, warning, error, fatal, bug) *)
- debug* = 0;
- message* = 1;
- warning* = 2;
- error* = 3;
- fatal* = 4;
- bug* = 5;
- nkinds* = 6;
- TYPE
- Kind* = SHORTINT; (* debug..bug *)
- VAR
- kindText*: ARRAY nkinds OF ARRAY 12 OF CHAR;
+ CONST
+ (* Kind = (debug, message, warning, error, fatal, bug) *)
+ debug* = 0;
+ message* = 1;
+ warning* = 2;
+ error* = 3;
+ fatal* = 4;
+ bug* = 5;
+ nkinds* = 6;
+ TYPE
+ Kind* = SHORTINT; (* debug..bug *)
+ VAR
+ kindText*: ARRAY nkinds OF ARRAY 12 OF CHAR;
- TYPE
- Handler* = PROCEDURE (event: Events.Event; kind: Kind);
- HandlerSet* = POINTER TO HandlerSetRec;
- HandlerSetRec* =
- RECORD
- (Disciplines.ObjectRec)
- (* private components *)
- handlerSet: SET; (* set of installed handlers *)
- handler: ARRAY nkinds OF Handler;
- END;
-
- (* ========== write discipline ========================================= *)
- TYPE
- WriteProcedure* = PROCEDURE (s: Streams.Stream; event: Events.Event);
- WriteDiscipline = POINTER TO WriteDisciplineRec;
- WriteDisciplineRec =
- RECORD
- (Disciplines.DisciplineRec)
- write: WriteProcedure;
- END;
- VAR
- writeDiscId: Disciplines.Identifier;
-
- (* ========== handler discipline ======================================= *)
- TYPE
- HandlerDiscipline = POINTER TO HandlerDisciplineRec;
- HandlerDisciplineRec =
- RECORD
- (Disciplines.DisciplineRec)
- hs: HandlerSet;
- kind: Kind;
- END;
- VAR
- handlerDiscId: Disciplines.Identifier;
-
- VAR
- null*: HandlerSet; (* empty handler set *)
-
- PROCEDURE CreateHandlerSet*(VAR hs: HandlerSet);
- BEGIN
- NEW(hs); hs.handlerSet := {};
- END CreateHandlerSet;
-
- PROCEDURE InstallHandler*(hs: HandlerSet; kind: Kind; handler: Handler);
- BEGIN
- hs.handler[kind] := handler;
- INCL(hs.handlerSet, kind);
- END InstallHandler;
-
- PROCEDURE AssignWriteProcedure*(eventType: Events.EventType;
- write: WriteProcedure);
- VAR
- writeDiscipline: WriteDiscipline;
- BEGIN
- NEW(writeDiscipline);
- writeDiscipline.id := writeDiscId;
- writeDiscipline.write := write;
- Disciplines.Add(eventType, writeDiscipline);
- END AssignWriteProcedure;
-
- PROCEDURE Write*(s: Streams.Stream; event: Events.Event);
- VAR
- writeDiscipline: WriteDiscipline;
- BEGIN
- IF Disciplines.Seek(event.type, writeDiscId, SYS.VAL(Disciplines.Discipline, writeDiscipline)) THEN
- writeDiscipline.write(s, event);
- ELSE
- IF ~Streams.WritePart(s, event.message, 0,
- Strings.Len(event.message)) THEN
- END;
+ TYPE
+ Handler* = PROCEDURE (event: Events.Event; kind: Kind);
+ HandlerSet* = POINTER TO HandlerSetRec;
+ HandlerSetRec* =
+ RECORD
+ (Disciplines.ObjectRec)
+ (* private components *)
+ handlerSet: SET; (* set of installed handlers *)
+ handler: ARRAY nkinds OF Handler;
END;
- END Write;
- PROCEDURE GeneralEventHandler(event: Events.Event);
- VAR
- disc: HandlerDiscipline;
- BEGIN
- IF Disciplines.Seek(event.type, handlerDiscId, SYS.VAL(Disciplines.Discipline, disc)) &
- (disc.kind IN disc.hs.handlerSet) THEN
- disc.hs.handler[disc.kind](event, disc.kind);
+ (* ========== write discipline ========================================= *)
+ TYPE
+ WriteProcedure* = PROCEDURE (s: Streams.Stream; event: Events.Event);
+ WriteDiscipline = POINTER TO WriteDisciplineRec;
+ WriteDisciplineRec =
+ RECORD
+ (Disciplines.DisciplineRec)
+ write: WriteProcedure;
END;
- END GeneralEventHandler;
+ VAR
+ writeDiscId: Disciplines.Identifier;
- PROCEDURE CatchEvent*(hs: HandlerSet; kind: Kind; type: Events.EventType);
- VAR
- handlerDiscipline: HandlerDiscipline;
- BEGIN
- NEW(handlerDiscipline); handlerDiscipline.id := handlerDiscId;
- handlerDiscipline.hs := hs; handlerDiscipline.kind := kind;
- Disciplines.Add(type, handlerDiscipline);
- Events.Handler(type, GeneralEventHandler);
- END CatchEvent;
+ (* ========== handler discipline ======================================= *)
+ TYPE
+ HandlerDiscipline = POINTER TO HandlerDisciplineRec;
+ HandlerDisciplineRec =
+ RECORD
+ (Disciplines.DisciplineRec)
+ hs: HandlerSet;
+ kind: Kind;
+ END;
+ VAR
+ handlerDiscId: Disciplines.Identifier;
+
+ VAR
+ null*: HandlerSet; (* empty handler set *)
+
+ PROCEDURE CreateHandlerSet*(VAR hs: HandlerSet);
+ BEGIN
+ NEW(hs); hs.handlerSet := {};
+ END CreateHandlerSet;
+
+ PROCEDURE InstallHandler*(hs: HandlerSet; kind: Kind; handler: Handler);
+ BEGIN
+ hs.handler[kind] := handler;
+ INCL(hs.handlerSet, kind);
+ END InstallHandler;
+
+ PROCEDURE AssignWriteProcedure*(eventType: Events.EventType;
+ write: WriteProcedure);
+ VAR
+ writeDiscipline: WriteDiscipline;
+ BEGIN
+ NEW(writeDiscipline);
+ writeDiscipline.id := writeDiscId;
+ writeDiscipline.write := write;
+ Disciplines.Add(eventType, writeDiscipline);
+ END AssignWriteProcedure;
+
+ PROCEDURE Write*(s: Streams.Stream; event: Events.Event);
+ VAR
+ writeDiscipline: Disciplines.Discipline;
+ BEGIN
+ IF Disciplines.Seek(event.type, writeDiscId, writeDiscipline) THEN
+ writeDiscipline(WriteDiscipline).write(s, event);
+ ELSE
+ IF ~Streams.WritePart(s, event.message, 0,
+ Strings.Len(event.message)) THEN
+ END;
+ END;
+ END Write;
+
+ PROCEDURE GeneralEventHandler(event: Events.Event);
+ VAR
+ disc: Disciplines.Discipline;
+ hdisc: HandlerDiscipline;
+ BEGIN
+ IF Disciplines.Seek(event.type, handlerDiscId, disc) THEN
+ hdisc := disc(HandlerDiscipline);
+ IF hdisc.kind IN hdisc.hs.handlerSet THEN
+ hdisc.hs.handler[hdisc.kind](event, hdisc.kind)
+ END
+ END;
+ END GeneralEventHandler;
+
+ PROCEDURE CatchEvent*(hs: HandlerSet; kind: Kind; type: Events.EventType);
+ VAR
+ handlerDiscipline: HandlerDiscipline;
+ BEGIN
+ NEW(handlerDiscipline); handlerDiscipline.id := handlerDiscId;
+ handlerDiscipline.hs := hs; handlerDiscipline.kind := kind;
+ Disciplines.Add(type, handlerDiscipline);
+ Events.Handler(type, GeneralEventHandler);
+ END CatchEvent;
BEGIN
- writeDiscId := Disciplines.Unique();
- handlerDiscId := Disciplines.Unique();
- CreateHandlerSet(null);
- kindText[debug] := "debug";
- kindText[message] := "message";
- kindText[warning] := "warning";
- kindText[error] := "error";
- kindText[fatal] := "fatal";
- kindText[bug] := "bug";
+ writeDiscId := Disciplines.Unique();
+ handlerDiscId := Disciplines.Unique();
+ CreateHandlerSet(null);
+ kindText[debug] := "debug";
+ kindText[message] := "message";
+ kindText[warning] := "warning";
+ kindText[error] := "error";
+ kindText[fatal] := "fatal";
+ kindText[bug] := "bug";
END ulmErrors.
diff --git a/src/library/ulm/ulmEvents.Mod b/src/library/ulm/ulmEvents.Mod
index 6016f8b0..52695762 100644
--- a/src/library/ulm/ulmEvents.Mod
+++ b/src/library/ulm/ulmEvents.Mod
@@ -46,88 +46,88 @@ MODULE ulmEvents;
CONST
(* possibilities on receipt of an event: *)
- default* = 0; (* causes abortion *)
- ignore* = 1; (* ignore event *)
- funcs* = 2; (* call associated event handlers *)
+ default* = 0; (* causes abortion *)
+ ignore* = 1; (* ignore event *)
+ funcs* = 2; (* call associated event handlers *)
TYPE
- Reaction* = INTEGER; (* one of default, ignore, or funcs *)
+ Reaction* = INTEGER; (* one of default, ignore, or funcs *)
Message* = ARRAY 80 OF CHAR;
Event* = POINTER TO EventRec;
EventRec* =
- RECORD
- (Objects.ObjectRec)
- type*: EventType;
- message*: Message;
- (* private part *)
- next: Event; (* queue *)
- END;
+ RECORD
+ (Objects.ObjectRec)
+ type*: EventType;
+ message*: Message;
+ (* private part *)
+ next: Event; (* queue *)
+ END;
EventHandler = PROCEDURE (event: Event);
(* event managers are needed if there is any action necessary
- on changing the kind of reaction
+ on changing the kind of reaction
*)
EventManager = PROCEDURE (type: EventType; reaction: Reaction);
Priority = INTEGER; (* must be non-negative *)
(* every event with reaction `funcs' has a handler list;
- the list is in calling order which is reverse to
- the order of `Handler'-calls
+ the list is in calling order which is reverse to
+ the order of `Handler'-calls
*)
HandlerList = POINTER TO HandlerRec;
HandlerRec* =
- RECORD
- (Objects.ObjectRec)
- handler*: EventHandler;
- next*: HandlerList;
- END;
+ RECORD
+ (Objects.ObjectRec)
+ handler*: EventHandler;
+ next*: HandlerList;
+ END;
SaveList = POINTER TO SaveRec;
SaveRec =
- RECORD
- reaction: Reaction;
- handlers: HandlerList;
- next: SaveList;
- END;
+ RECORD
+ reaction: Reaction;
+ handlers: HandlerList;
+ next: SaveList;
+ END;
EventTypeRec* =
- RECORD
- (Services.ObjectRec)
- (* private components *)
- handlers: HandlerList;
- priority: Priority;
- reaction: Reaction;
- manager: EventManager;
- savelist: SaveList;
- END;
+ RECORD
+ (Services.ObjectRec)
+ (* private components *)
+ handlers: HandlerList;
+ priority: Priority;
+ reaction: Reaction;
+ manager: EventManager;
+ savelist: SaveList;
+ END;
Queue = POINTER TO QueueRec;
QueueRec =
- RECORD
- priority: INTEGER; (* queue for this priority *)
- head, tail: Event;
- next: Queue; (* queue with lower priority *)
- END;
+ RECORD
+ priority: INTEGER; (* queue for this priority *)
+ head, tail: Event;
+ next: Queue; (* queue with lower priority *)
+ END;
VAR
eventTypeType: Services.Type;
-
+
CONST
- priotabsize = 256; (* size of a priority table *)
- maxnestlevel = 1024; (* of Raise-calls (avoids endless recursion) *)
+ priotabsize = 256; (* size of a priority table *)
+ maxnestlevel = 1024; (* of Raise-calls (avoids endless recursion) *)
TYPE
(* in some cases coroutines uses local priority systems *)
PrioritySystem* = POINTER TO PrioritySystemRec;
PrioritySystemRec* =
- RECORD
- (Objects.ObjectRec)
- (* private part *)
- currentPriority: Priority;
- priotab: ARRAY priotabsize OF Priority;
- priotop: INTEGER;
- overflow: INTEGER; (* of priority table *)
- END;
+ RECORD
+ (Objects.ObjectRec)
+ (* private part *)
+ currentPriority: Priority;
+ priotab: ARRAY priotabsize OF Priority;
+ priotop: INTEGER;
+ overflow: INTEGER; (* of priority table *)
+ END;
CONST
priorityViolation* = 0; (* priority violation (EnterPriority *)
@@ -139,10 +139,10 @@ MODULE ulmEvents;
TYPE
ErrorEvent* = POINTER TO ErrorEventRec;
ErrorEventRec* =
- RECORD
- (EventRec)
- errorcode*: SHORTINT;
- END;
+ RECORD
+ (EventRec)
+ errorcode*: SHORTINT;
+ END;
VAR
errormsg*: ARRAY errorcodes OF Message;
@@ -151,10 +151,10 @@ MODULE ulmEvents;
VAR
(* private part *)
abort, log, queueHandler: EventHandler;
- nestlevel: INTEGER; (* of Raise calls *)
+ nestlevel: INTEGER; (* of Raise calls *)
queue: Queue;
- lock: BOOLEAN; (* lock critical operations *)
- psys: PrioritySystem; (* current priority system *)
+ lock: BOOLEAN; (* lock critical operations *)
+ psys: PrioritySystem; (* current priority system *)
PROCEDURE ^ Define*(VAR type: EventType);
PROCEDURE ^ SetPriority*(type: EventType; priority: Priority);
@@ -164,13 +164,13 @@ MODULE ulmEvents;
BEGIN
Define(error); SetPriority(error, Priorities.liberrors);
errormsg[priorityViolation] :=
- "priority violation (Events.EnterPriority)";
+ "priority violation (Events.EnterPriority)";
errormsg[unbalancedExitPriority] :=
- "unbalanced call of Events.ExitPriority";
+ "unbalanced call of Events.ExitPriority";
errormsg[unbalancedRestoreReaction] :=
- "unbalanced call of Events.RestoreReaction";
+ "unbalanced call of Events.RestoreReaction";
errormsg[negPriority] :=
- "negative priority given to Events.SetPriority";
+ "negative priority given to Events.SetPriority";
END InitErrorHandling;
PROCEDURE Error(code: SHORTINT);
@@ -187,7 +187,7 @@ MODULE ulmEvents;
PROCEDURE Init*(type: EventType);
VAR
- stype: Services.Type;
+ stype: Services.Type;
BEGIN
Services.GetType(type, stype); ASSERT(stype # NIL);
type.handlers := NIL;
@@ -199,8 +199,8 @@ MODULE ulmEvents;
PROCEDURE Define*(VAR type: EventType);
(* definition of a new event;
- an unique event number is returned;
- the reaction on receipt of `type' is defined to be `default'
+ an unique event number is returned;
+ the reaction on receipt of `type' is defined to be `default'
*)
BEGIN
NEW(type);
@@ -218,9 +218,9 @@ MODULE ulmEvents;
(* (re-)defines the priority of an event *)
BEGIN
IF priority <= 0 THEN
- Error(negPriority);
+ Error(negPriority);
ELSE
- type.priority := priority;
+ type.priority := priority;
END;
END SetPriority;
@@ -238,42 +238,42 @@ MODULE ulmEvents;
PROCEDURE Handler*(type: EventType; handler: EventHandler);
(* add `handler' to the list of handlers for event `type' *)
VAR
- newhandler: HandlerList;
+ newhandler: HandlerList;
BEGIN
NEW(newhandler);
newhandler.handler := handler; newhandler.next := type.handlers;
type.handlers := newhandler;
IF type.reaction # funcs THEN
- type.reaction := funcs; type.manager(type, funcs);
+ type.reaction := funcs; type.manager(type, funcs);
END;
END Handler;
PROCEDURE RemoveHandlers*(type: EventType);
(* remove list of handlers for event `type';
- implies default reaction (abortion) on
- receipt of `type'
+ implies default reaction (abortion) on
+ receipt of `type'
*)
BEGIN
type.handlers := NIL;
IF type.reaction # default THEN
- type.reaction := default; type.manager(type, default);
+ type.reaction := default; type.manager(type, default);
END;
END RemoveHandlers;
PROCEDURE Ignore*(type: EventType);
(* implies RemoveHandlers(type) and causes receipt
- of `type' to be ignored
+ of `type' to be ignored
*)
BEGIN
type.handlers := NIL;
IF type.reaction # ignore THEN
- type.reaction := ignore; type.manager(type, ignore);
+ type.reaction := ignore; type.manager(type, ignore);
END;
END Ignore;
PROCEDURE GetHandlers*(type: EventType; handlers: HandlerList);
(* returns the list of handlers in `handlers';
- the reaction of `type' must be `funcs'
+ the reaction of `type' must be `funcs'
*)
BEGIN
handlers := type.handlers;
@@ -281,8 +281,8 @@ MODULE ulmEvents;
PROCEDURE Log*(loghandler: EventHandler);
(* call `loghandler' for every event;
- subsequent calls of `Log' replace the loghandler;
- the loghandler is not called on default and ignore
+ subsequent calls of `Log' replace the loghandler;
+ the loghandler is not called on default and ignore
*)
BEGIN
log := loghandler;
@@ -311,8 +311,8 @@ MODULE ulmEvents;
PROCEDURE QueueHandler*(handler: EventHandler);
(* setup an alternative handler of events
- that cannot be processed now because
- of their unsufficient priority
+ that cannot be processed now because
+ of their unsufficient priority
*)
VAR b : BOOLEAN; (* noch *)
tmphandler : EventHandler;
@@ -345,93 +345,93 @@ MODULE ulmEvents;
PROCEDURE WorkupQueue;
VAR
- ptr: Event;
+ ptr: Event;
BEGIN
WHILE (queue # NIL) & (queue.priority > psys.currentPriority) DO
- IF SYS.TAS(lock) THEN RETURN END;
- ptr := queue.head; queue := queue.next;
- lock := FALSE;
- WHILE ptr # NIL DO
- CallHandlers(ptr);
- ptr := ptr.next;
- END;
+ IF SYS.TAS(lock) THEN RETURN END;
+ ptr := queue.head; queue := queue.next;
+ lock := FALSE;
+ WHILE ptr # NIL DO
+ CallHandlers(ptr);
+ ptr := ptr.next;
+ END;
END;
END WorkupQueue;
PROCEDURE CallHandlers(event: Event);
VAR
- ptr: HandlerList;
- oldPriority: Priority;
+ ptr: HandlerList;
+ oldPriority: Priority;
BEGIN
CASE event.type.reaction OF
| default: abort(event);
| ignore:
| funcs: oldPriority := psys.currentPriority;
- psys.currentPriority := event.type.priority;
- log(event);
- ptr := event.type.handlers;
- WHILE ptr # NIL DO
- ptr.handler(event);
- ptr := ptr.next;
- END;
- psys.currentPriority := oldPriority;
+ psys.currentPriority := event.type.priority;
+ log(event);
+ ptr := event.type.handlers;
+ WHILE ptr # NIL DO
+ ptr.handler(event);
+ ptr := ptr.next;
+ END;
+ psys.currentPriority := oldPriority;
ELSE (* Explicitly ignore unhandled even type reactions *)
END;
END CallHandlers;
PROCEDURE Raise*(event: Event);
(* call all event handlers (in reverse order)
- associated with event.type;
- abort if there are none;
- some system events may abort in another way
- (i.e. they do not cause the abortion handler to be called)
+ associated with event.type;
+ abort if there are none;
+ some system events may abort in another way
+ (i.e. they do not cause the abortion handler to be called)
*)
VAR
- priority: Priority;
+ priority: Priority;
PROCEDURE AddToQueue(event: Event);
- VAR
- prev, ptr: Queue;
+ VAR
+ prev, ptr: Queue;
BEGIN
- event.next := NIL;
- ptr := queue; prev := NIL;
- WHILE (ptr # NIL) & (ptr.priority > priority) DO
- prev := ptr;
- ptr := ptr.next;
- END;
- IF (ptr # NIL) & (ptr.priority = priority) THEN
- ptr.tail.next := event;
- ptr.tail := event;
- ELSE
- NEW(ptr);
- ptr.priority := priority;
- ptr.head := event; ptr.tail := event;
- IF prev = NIL THEN
- ptr.next := queue;
- queue := ptr;
- ELSE
- ptr.next := prev.next;
- prev.next := ptr;
- END;
- END;
+ event.next := NIL;
+ ptr := queue; prev := NIL;
+ WHILE (ptr # NIL) & (ptr.priority > priority) DO
+ prev := ptr;
+ ptr := ptr.next;
+ END;
+ IF (ptr # NIL) & (ptr.priority = priority) THEN
+ ptr.tail.next := event;
+ ptr.tail := event;
+ ELSE
+ NEW(ptr);
+ ptr.priority := priority;
+ ptr.head := event; ptr.tail := event;
+ IF prev = NIL THEN
+ ptr.next := queue;
+ queue := ptr;
+ ELSE
+ ptr.next := prev.next;
+ prev.next := ptr;
+ END;
+ END;
END AddToQueue;
BEGIN (* Raise *)
INC(nestlevel);
IF nestlevel >= maxnestlevel THEN
- abort(event);
+ abort(event);
ELSE
- IF event.type.reaction # ignore THEN
- priority := event.type.priority;
- IF psys.currentPriority < priority THEN
- CallHandlers(event); WorkupQueue;
- ELSIF queueHandler # NIL THEN
- queueHandler(event);
- ELSIF ~SYS.TAS(lock) THEN
- AddToQueue(event);
- lock := FALSE;
- END;
- END;
+ IF event.type.reaction # ignore THEN
+ priority := event.type.priority;
+ IF psys.currentPriority < priority THEN
+ CallHandlers(event); WorkupQueue;
+ ELSIF queueHandler # NIL THEN
+ queueHandler(event);
+ ELSIF ~SYS.TAS(lock) THEN
+ AddToQueue(event);
+ lock := FALSE;
+ END;
+ END;
END;
DEC(nestlevel);
END Raise;
@@ -452,7 +452,7 @@ MODULE ulmEvents;
PROCEDURE SwitchPrioritySystem*(prioritySystem: PrioritySystem);
(* switch to another priority system; this is typically
- done in case of task switches
+ done in case of task switches
*)
BEGIN
psys := prioritySystem;
@@ -460,52 +460,52 @@ MODULE ulmEvents;
PROCEDURE EnterPriority*(priority: Priority);
(* sets the current priority to `priority';
- it is an error to give a priority less than
- the current priority (event `badpriority')
+ it is an error to give a priority less than
+ the current priority (event `badpriority')
*)
BEGIN
IF psys.currentPriority <= priority THEN
- IF (psys.overflow = 0) & (psys.priotop < priotabsize) THEN
- psys.priotab[psys.priotop] := psys.currentPriority;
- INC(psys.priotop);
- psys.currentPriority := priority;
- ELSE
- INC(psys.overflow);
- END;
+ IF (psys.overflow = 0) & (psys.priotop < priotabsize) THEN
+ psys.priotab[psys.priotop] := psys.currentPriority;
+ INC(psys.priotop);
+ psys.currentPriority := priority;
+ ELSE
+ INC(psys.overflow);
+ END;
ELSE
- Error(priorityViolation);
- INC(psys.overflow);
+ Error(priorityViolation);
+ INC(psys.overflow);
END;
END EnterPriority;
PROCEDURE AssertPriority*(priority: Priority);
(* current priority
- < priority: set the current priority to `priority'
- >= priority: the current priority remains unchanged
+ < priority: set the current priority to `priority'
+ >= priority: the current priority remains unchanged
*)
BEGIN
IF (psys.overflow = 0) & (psys.priotop < priotabsize) THEN
- psys.priotab[psys.priotop] := psys.currentPriority; INC(psys.priotop);
- IF psys.currentPriority < priority THEN
- psys.currentPriority := priority;
- END;
+ psys.priotab[psys.priotop] := psys.currentPriority; INC(psys.priotop);
+ IF psys.currentPriority < priority THEN
+ psys.currentPriority := priority;
+ END;
ELSE
- INC(psys.overflow);
+ INC(psys.overflow);
END;
END AssertPriority;
PROCEDURE ExitPriority*;
(* causes the priority before the last effective call
- of SetPriority or AssertPriority to be restored
+ of SetPriority or AssertPriority to be restored
*)
BEGIN
IF psys.overflow > 0 THEN
- DEC(psys.overflow);
+ DEC(psys.overflow);
ELSIF psys.priotop = 0 THEN
- Error(unbalancedExitPriority);
+ Error(unbalancedExitPriority);
ELSE
- DEC(psys.priotop); psys.currentPriority := psys.priotab[psys.priotop];
- WorkupQueue;
+ DEC(psys.priotop); psys.currentPriority := psys.priotab[psys.priotop];
+ WorkupQueue;
END;
END ExitPriority;
@@ -517,11 +517,11 @@ MODULE ulmEvents;
PROCEDURE SaveReaction*(type: EventType);
(* saves current reaction until call of RestoreReaction;
- the new reaction of `type' is defined to be `ignore'
- but can be changed by Events.Handler or Events.RemoveHandlers
+ the new reaction of `type' is defined to be `ignore'
+ but can be changed by Events.Handler or Events.RemoveHandlers
*)
VAR
- savelist: SaveList;
+ savelist: SaveList;
BEGIN
NEW(savelist);
savelist.reaction := type.reaction;
@@ -530,27 +530,27 @@ MODULE ulmEvents;
type.savelist := savelist;
type.handlers := NIL;
IF type.reaction # ignore THEN
- type.reaction := ignore; type.manager(type, ignore);
+ type.reaction := ignore; type.manager(type, ignore);
END;
END SaveReaction;
PROCEDURE RestoreReaction*(type: EventType);
(* restores old reaction;
- must be properly nested
+ must be properly nested
*)
VAR
- savelist: SaveList;
+ savelist: SaveList;
BEGIN
IF type.savelist = NIL THEN
- Error(unbalancedRestoreReaction);
+ Error(unbalancedRestoreReaction);
ELSE
- savelist := type.savelist;
- type.savelist := savelist.next;
- type.handlers := savelist.handlers;
- IF type.reaction # savelist.reaction THEN
- type.reaction := savelist.reaction;
- type.manager(type, savelist.reaction);
- END;
+ savelist := type.savelist;
+ type.savelist := savelist.next;
+ type.handlers := savelist.handlers;
+ IF type.reaction # savelist.reaction THEN
+ type.reaction := savelist.reaction;
+ type.manager(type, savelist.reaction);
+ END;
END;
END RestoreReaction;
diff --git a/src/library/ulm/ulmForwarders.Mod b/src/library/ulm/ulmForwarders.Mod
index ac4fa0b8..27f68104 100644
--- a/src/library/ulm/ulmForwarders.Mod
+++ b/src/library/ulm/ulmForwarders.Mod
@@ -1,244 +1,252 @@
(* Ulm's Oberon Library
- Copyright (C) 1989-1995 by University of Ulm, SAI, D-89069 Ulm, Germany
- ----------------------------------------------------------------------------
- Ulm's Oberon Library is free software; you can redistribute it
- and/or modify it under the terms of the GNU Library General Public
- License as published by the Free Software Foundation; either version
- 2 of the License, or (at your option) any later version.
+ Copyright (C) 1989-1995 by University of Ulm, SAI, D-89069 Ulm, Germany
+ ----------------------------------------------------------------------------
+ Ulm's Oberon Library is free software; you can redistribute it
+ and/or modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either version
+ 2 of the License, or (at your option) any later version.
- Ulm's Oberon Library is distributed in the hope that it will be
- useful, but WITHOUT ANY WARRANTY; without even the implied warranty
- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Library General Public License for more details.
+ Ulm's Oberon Library is distributed in the hope that it will be
+ useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+ of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
- You should have received a copy of the GNU Library General Public
- License along with this library; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ----------------------------------------------------------------------------
- E-mail contact: oberon@mathematik.uni-ulm.de
- ----------------------------------------------------------------------------
- $Id: Forwarders.om,v 1.1 1996/01/04 16:40:57 borchert Exp $
- ----------------------------------------------------------------------------
- $Log: Forwarders.om,v $
- Revision 1.1 1996/01/04 16:40:57 borchert
- Initial revision
+ You should have received a copy of the GNU Library General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ----------------------------------------------------------------------------
+ E-mail contact: oberon@mathematik.uni-ulm.de
+ ----------------------------------------------------------------------------
+ $Id: Forwarders.om,v 1.1 1996/01/04 16:40:57 borchert Exp $
+ ----------------------------------------------------------------------------
+ $Log: Forwarders.om,v $
+ Revision 1.1 1996/01/04 16:40:57 borchert
+ Initial revision
- ----------------------------------------------------------------------------
+ ----------------------------------------------------------------------------
*)
MODULE ulmForwarders; (* AFB 3/95 *)
- IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, Resources := ulmResources, Services := ulmServices, SYSTEM;
- (* SYSTEM is necessary to cast to Disciplines.Discipline; noch *)
+ IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, Resources := ulmResources, Services := ulmServices;
- TYPE
- Object* = Services.Object;
- ForwardProc* = PROCEDURE (from, to: Object);
+ TYPE
+ Object* = Services.Object;
+ ForwardProc* = PROCEDURE (from, to: Object);
- TYPE
- ListOfForwarders = POINTER TO ListOfForwardersRec;
- ListOfForwardersRec =
- RECORD
- forward: ForwardProc;
- next: ListOfForwarders;
- END;
- ListOfDependants = POINTER TO ListOfDependantsRec;
- ListOfDependantsRec =
- RECORD
- dependant: Object;
- next: ListOfDependants;
- END;
- TypeDiscipline = POINTER TO TypeDisciplineRec;
- TypeDisciplineRec =
- RECORD
- (Disciplines.DisciplineRec)
- list: ListOfForwarders;
- END;
- ObjectDiscipline = POINTER TO ObjectDisciplineRec;
- ObjectDisciplineRec =
- RECORD
- (Disciplines.DisciplineRec)
- dependants: ListOfDependants;
- forwarders: ListOfForwarders;
- dependsOn: Object;
- END;
- VAR
- genlist: ListOfForwarders; (* list which applies to all types *)
- typeDiscID: Disciplines.Identifier;
- objectDiscID: Disciplines.Identifier;
-
- (* === private procedures ============================================ *)
-
- PROCEDURE RemoveDependant(VAR list: ListOfDependants; dependant: Object);
- VAR
- prev, p: ListOfDependants;
- BEGIN
- prev := NIL; p := list;
- WHILE (p # NIL) & (p.dependant # dependant) DO
- prev := p; p := p.next;
+ TYPE
+ ListOfForwarders = POINTER TO ListOfForwardersRec;
+ ListOfForwardersRec =
+ RECORD
+ forward: ForwardProc;
+ next: ListOfForwarders;
END;
- IF p # NIL THEN
- IF prev = NIL THEN
- list := p.next;
- ELSE
- prev.next := p.next;
- END;
+ ListOfDependants = POINTER TO ListOfDependantsRec;
+ ListOfDependantsRec =
+ RECORD
+ dependant: Object;
+ next: ListOfDependants;
END;
- END RemoveDependant;
-
- PROCEDURE TerminationHandler(event: Events.Event);
- (* remove list of dependants in case of termination and
- remove event.resource from the list of dependants of that
- object it depends on
- *)
- VAR
- odisc: ObjectDiscipline;
- dependsOn: Object;
- BEGIN
- WITH event: Resources.Event DO
- IF event.change = Resources.terminated THEN
- IF Disciplines.Seek(event.resource, objectDiscID, SYSTEM.VAL(Disciplines.Discipline, odisc)) THEN (* noch *)
- Disciplines.Remove(event.resource, objectDiscID);
- dependsOn := odisc.dependsOn;
- IF (dependsOn # NIL) & ~Resources.Terminated(dependsOn) &
- Disciplines.Seek(dependsOn, objectDiscID, SYSTEM.VAL(Disciplines.Discipline, odisc)) THEN (* noch *)
- RemoveDependant(odisc.dependants, event.resource(Object));
- END;
- END;
- END;
+ TypeDiscipline = POINTER TO TypeDisciplineRec;
+ TypeDisciplineRec =
+ RECORD
+ (Disciplines.DisciplineRec)
+ list: ListOfForwarders;
END;
- END TerminationHandler;
-
- PROCEDURE Insert(VAR list: ListOfForwarders; forward: ForwardProc);
- VAR
- member: ListOfForwarders;
- BEGIN
- NEW(member); member.forward := forward;
- member.next := list; list := member;
- END Insert;
-
- PROCEDURE GetObjectDiscipline(object: Object; VAR odisc: ObjectDiscipline);
- VAR
- resourceNotification: Events.EventType;
- BEGIN
- IF ~Disciplines.Seek(object, objectDiscID, SYSTEM.VAL(Disciplines.Discipline, odisc)) THEN (* noch *)
- NEW(odisc); odisc.id := objectDiscID; odisc.dependants := NIL;
- odisc.forwarders := NIL; odisc.dependsOn := NIL;
- (* let's state our interest in termination of `object' if
- we see this object the first time
- *)
- Resources.TakeInterest(object, resourceNotification);
- Events.Handler(resourceNotification, TerminationHandler);
- Disciplines.Add(object, odisc);
+ ObjectDiscipline = POINTER TO ObjectDisciplineRec;
+ ObjectDisciplineRec =
+ RECORD
+ (Disciplines.DisciplineRec)
+ dependants: ListOfDependants;
+ forwarders: ListOfForwarders;
+ dependsOn: Object;
END;
- END GetObjectDiscipline;
+ VAR
+ genlist: ListOfForwarders; (* list which applies to all types *)
+ typeDiscID: Disciplines.Identifier;
+ objectDiscID: Disciplines.Identifier;
- (* === exported procedures =========================================== *)
+ (* === private procedures ============================================ *)
- PROCEDURE Register*(for: ARRAY OF CHAR; forward: ForwardProc);
- (* register a forwarder which is to be called for all
- forward operations which affects extensions of `for';
- "" may be given for Services.Object
- *)
-
- VAR
- type: Services.Type;
- tdisc: TypeDiscipline;
-
- BEGIN (* Register *)
- IF for = "" THEN
- Insert(genlist, forward);
+ PROCEDURE RemoveDependant(VAR list: ListOfDependants; dependant: Object);
+ VAR
+ prev, p: ListOfDependants;
+ BEGIN
+ prev := NIL; p := list;
+ WHILE (p # NIL) & (p.dependant # dependant) DO
+ prev := p; p := p.next;
+ END;
+ IF p # NIL THEN
+ IF prev = NIL THEN
+ list := p.next;
ELSE
- Services.SeekType(for, type);
- ASSERT(type # NIL);
- IF ~Disciplines.Seek(type, typeDiscID, SYSTEM.VAL(Disciplines.Discipline, tdisc)) THEN
- NEW(tdisc); tdisc.id := typeDiscID; tdisc.list := NIL;
- END;
- Insert(tdisc.list, forward);
- Disciplines.Add(type, tdisc);
+ prev.next := p.next;
END;
- END Register;
+ END;
+ END RemoveDependant;
- PROCEDURE RegisterObject*(object: Object; forward: ForwardProc);
- (* to be called instead of Register if specific objects
- are supported only and not all extensions of a type
+ PROCEDURE TerminationHandler(event: Events.Event);
+ (* remove list of dependants in case of termination and
+ remove event.resource from the list of dependants of that
+ object it depends on
+ *)
+ VAR
+ odisc: Disciplines.Discipline;
+ dependsOn: Object;
+ BEGIN
+ WITH event: Resources.Event DO
+ IF event.change = Resources.terminated THEN
+ IF Disciplines.Seek(event.resource, objectDiscID, odisc) THEN
+ Disciplines.Remove(event.resource, objectDiscID);
+ dependsOn := odisc(ObjectDiscipline).dependsOn;
+ IF (dependsOn # NIL) & ~Resources.Terminated(dependsOn) &
+ Disciplines.Seek(dependsOn, objectDiscID, odisc) THEN
+ RemoveDependant(odisc(ObjectDiscipline).dependants, event.resource(Object));
+ END;
+ END;
+ END;
+ END;
+ END TerminationHandler;
+
+ PROCEDURE Insert(VAR list: ListOfForwarders; forward: ForwardProc);
+ VAR
+ member: ListOfForwarders;
+ BEGIN
+ NEW(member); member.forward := forward;
+ member.next := list; list := member;
+ END Insert;
+
+ PROCEDURE GetObjectDiscipline(object: Object; VAR odisc: ObjectDiscipline);
+ VAR
+ disc: Disciplines.Discipline;
+ resourceNotification: Events.EventType;
+ BEGIN
+ IF Disciplines.Seek(object, objectDiscID, disc) THEN
+ odisc := disc(ObjectDiscipline)
+ ELSE
+ NEW(odisc); odisc.id := objectDiscID; odisc.dependants := NIL;
+ odisc.forwarders := NIL; odisc.dependsOn := NIL;
+ (* let's state our interest in termination of `object' if
+ we see this object the first time
*)
- VAR
- odisc: ObjectDiscipline;
- BEGIN
- GetObjectDiscipline(object, odisc);
- Insert(odisc.forwarders, forward);
- END RegisterObject;
+ Resources.TakeInterest(object, resourceNotification);
+ Events.Handler(resourceNotification, TerminationHandler);
+ Disciplines.Add(object, odisc);
+ END;
+ END GetObjectDiscipline;
- PROCEDURE Update*(object: Object; forward: ForwardProc);
- (* is to be called by one of the registered forwarders if
- an interface for object has been newly installed or changed
- in a way which needs forward to be called for each of
- the filter objects which delegate to `object'
- *)
- VAR
- odisc: ObjectDiscipline;
- client: ListOfDependants;
- BEGIN
- IF Disciplines.Seek(object, objectDiscID, SYSTEM.VAL(Disciplines.Discipline, odisc)) THEN (* noch *)
- client := odisc.dependants;
- WHILE client # NIL DO
- forward(client.dependant, object);
- client := client.next;
- END;
+ (* === exported procedures =========================================== *)
+
+ PROCEDURE Register*(for: ARRAY OF CHAR; forward: ForwardProc);
+ (* register a forwarder which is to be called for all
+ forward operations which affects extensions of `for';
+ "" may be given for Services.Object
+ *)
+
+ VAR
+ type: Services.Type;
+ tdisc: TypeDiscipline;
+ disc: Disciplines.Discipline;
+
+ BEGIN (* Register *)
+ IF for = "" THEN
+ Insert(genlist, forward);
+ ELSE
+ Services.SeekType(for, type);
+ ASSERT(type # NIL);
+ IF Disciplines.Seek(type, typeDiscID, disc) THEN
+ tdisc := disc(TypeDiscipline)
+ ELSE
+ NEW(tdisc); tdisc.id := typeDiscID; tdisc.list := NIL;
END;
- END Update;
+ Insert(tdisc.list, forward);
+ Disciplines.Add(type, tdisc);
+ END;
+ END Register;
- PROCEDURE Forward*(from, to: Object);
- (* forward (as far as supported) all operations from `from' to `to' *)
- VAR
- type, otherType, baseType: Services.Type;
- tdisc: TypeDiscipline;
- odisc: ObjectDiscipline;
- client: ListOfDependants;
- forwarder: ListOfForwarders;
+ PROCEDURE RegisterObject*(object: Object; forward: ForwardProc);
+ (* to be called instead of Register if specific objects
+ are supported only and not all extensions of a type
+ *)
+ VAR
+ odisc: ObjectDiscipline;
+ BEGIN
+ GetObjectDiscipline(object, odisc);
+ Insert(odisc.forwarders, forward);
+ END RegisterObject;
- PROCEDURE CallForwarders(list: ListOfForwarders);
- BEGIN
- WHILE list # NIL DO
- list.forward(from, to);
- list := list.next;
- END;
- END CallForwarders;
-
- BEGIN (* Forward *)
- Services.GetType(from, type);
- Services.GetType(to, otherType);
- ASSERT((type # NIL) & (otherType # NIL));
-
- IF Resources.Terminated(to) OR Resources.Terminated(from) THEN
- (* forwarding operations is no longer useful *)
- RETURN
+ PROCEDURE Update*(object: Object; forward: ForwardProc);
+ (* is to be called by one of the registered forwarders if
+ an interface for object has been newly installed or changed
+ in a way which needs forward to be called for each of
+ the filter objects which delegate to `object'
+ *)
+ VAR
+ odisc: ObjectDiscipline;
+ disc: Disciplines.Discipline;
+ client: ListOfDependants;
+ BEGIN
+ IF Disciplines.Seek(object, objectDiscID, disc) THEN
+ odisc := disc(ObjectDiscipline);
+ client := odisc.dependants;
+ WHILE client # NIL DO
+ forward(client.dependant, object);
+ client := client.next;
END;
- Resources.DependsOn(from, to);
+ END;
+ END Update;
- (* update the list of dependants for `to' *)
- GetObjectDiscipline(to, odisc);
- NEW(client); client.dependant := from;
- client.next := odisc.dependants; odisc.dependants := client;
+ PROCEDURE Forward*(from, to: Object);
+ (* forward (as far as supported) all operations from `from' to `to' *)
+ VAR
+ type, otherType, baseType: Services.Type;
+ disc: Disciplines.Discipline;
+ tdisc: TypeDiscipline;
+ odisc: ObjectDiscipline;
+ client: ListOfDependants;
+ forwarder: ListOfForwarders;
- (* call object-specific forwarders *)
- CallForwarders(odisc.forwarders);
-
- LOOP (* go through the list of base types in descending order *)
- IF Disciplines.Seek(type, typeDiscID, SYSTEM.VAL(Disciplines.Discipline, tdisc)) & (* noch *)
- Services.IsExtensionOf(otherType, type) THEN
- CallForwarders(tdisc.list);
- END;
- Services.GetBaseType(type, baseType);
- IF baseType = NIL THEN EXIT END;
- type := baseType;
+ PROCEDURE CallForwarders(list: ListOfForwarders);
+ BEGIN
+ WHILE list # NIL DO
+ list.forward(from, to);
+ list := list.next;
END;
- CallForwarders(genlist);
- END Forward;
+ END CallForwarders;
+
+ BEGIN (* Forward *)
+ Services.GetType(from, type);
+ Services.GetType(to, otherType);
+ ASSERT((type # NIL) & (otherType # NIL));
+
+ IF Resources.Terminated(to) OR Resources.Terminated(from) THEN
+ (* forwarding operations is no longer useful *)
+ RETURN
+ END;
+ Resources.DependsOn(from, to);
+
+ (* update the list of dependants for `to' *)
+ GetObjectDiscipline(to, odisc);
+ NEW(client); client.dependant := from;
+ client.next := odisc.dependants; odisc.dependants := client;
+
+ (* call object-specific forwarders *)
+ CallForwarders(odisc.forwarders);
+
+ LOOP (* go through the list of base types in descending order *)
+ IF Disciplines.Seek(type, typeDiscID, disc) & Services.IsExtensionOf(otherType, type) THEN
+ tdisc := disc(TypeDiscipline);
+ CallForwarders(tdisc.list);
+ END;
+ Services.GetBaseType(type, baseType);
+ IF baseType = NIL THEN EXIT END;
+ type := baseType;
+ END;
+ CallForwarders(genlist);
+ END Forward;
BEGIN
- genlist := NIL;
- typeDiscID := Disciplines.Unique();
- objectDiscID := Disciplines.Unique();
+ genlist := NIL;
+ typeDiscID := Disciplines.Unique();
+ objectDiscID := Disciplines.Unique();
END ulmForwarders.
diff --git a/src/library/ulm/ulmIO.Mod b/src/library/ulm/ulmIO.Mod
index 2fa775e1..162aa127 100644
--- a/src/library/ulm/ulmIO.Mod
+++ b/src/library/ulm/ulmIO.Mod
@@ -1,244 +1,259 @@
MODULE ulmIO;
- IMPORT SYS := ulmSYSTEM, SYSTEM;
+ IMPORT SYS := ulmSYSTEM, SYSTEM, Platform;
- CONST nl = 0AX;
+ CONST nl = 0AX;
- (* conversions *)
+ (* conversions *)
- CONST
- oct = 0;
- dec = 1;
- hex = 2;
- TYPE
- Basetype = SHORTINT; (* oct..hex *)
+ CONST
+ oct = 0;
+ dec = 1;
+ hex = 2;
+ TYPE
+ Basetype = SHORTINT; (* oct..hex *)
- (* basic IO *)
+ (* basic IO *)
- VAR
- Done*: BOOLEAN;
- oldch: CHAR;
- readAgain: BOOLEAN;
+ VAR
+ Done*: BOOLEAN;
+ oldch: CHAR;
+ readAgain: BOOLEAN;
- (* ==================== conversions ================================= *)
+ (* ==================== conversions ================================= *)
- PROCEDURE ConvertNumber(num, len: LONGINT; btyp: Basetype; neg: BOOLEAN;
- VAR str: ARRAY OF CHAR);
+ PROCEDURE ConvertNumber(num, len: LONGINT; btyp: Basetype; neg: BOOLEAN;
+ VAR str: ARRAY OF CHAR);
- (* conversion of a number into a string of characters *)
- (* num must get the absolute value of the number *)
- (* len is the minimal length of the generated string *)
- (* neg means: "the number is negative" for btyp = dec *)
+ (* conversion of a number into a string of characters *)
+ (* num must get the absolute value of the number *)
+ (* len is the minimal length of the generated string *)
+ (* neg means: "the number is negative" for btyp = dec *)
- (*CONST
- NumberLen = 11;*)
- (* we need it as variable to change the value depending on architecture; -- noch *)
- VAR
- (*digits : ARRAY NumberLen+1 OF CHAR;*)
- digits : POINTER TO ARRAY OF CHAR;
- base : INTEGER;
- cnt, ix : INTEGER;
- maxlen : LONGINT;
- dig : LONGINT;
- NumberLen : SHORTINT;
- BEGIN
-
- IF SIZE(LONGINT) = 4 THEN
- NumberLen := 11
- ELSIF SIZE(LONGINT) = 8 THEN
- NumberLen := 21
+ (*CONST
+ NumberLen = 11;*)
+ (* we need it as variable to change the value depending on architecture; -- noch *)
+ VAR
+ (*digits : ARRAY NumberLen+1 OF CHAR;*)
+ digits : POINTER TO ARRAY OF CHAR;
+ base : INTEGER;
+ cnt, ix : INTEGER;
+ maxlen : LONGINT;
+ dig : LONGINT;
+ NumberLen : SHORTINT;
+ BEGIN
+ IF SIZE(LONGINT) = 8 THEN
+ NumberLen := 21
+ ELSE
+ NumberLen := 11 (* default value, corresponds to 32 bit *)
+ END;
+ NEW(digits, NumberLen + 1 );
+ ASSERT(num >= 0);
+ ix := 1;
+ WHILE ix <= NumberLen DO
+ digits[ix] := "0";
+ INC(ix);
+ END; (* initialisation *)
+ IF btyp = oct THEN
+ base := 8;
+ ELSIF btyp = dec THEN
+ base := 10;
+ ELSIF btyp = hex THEN
+ base := 10H;
+ END;
+ cnt := 0;
+ REPEAT
+ INC(cnt);
+ dig := num MOD base;
+ num := num DIV base;
+ IF dig < 10 THEN
+ dig := dig + ORD("0");
ELSE
- NumberLen := 11 (* default value, corresponds to 32 bit *)
+ dig := dig - 10 + ORD("A");
END;
- NEW(digits, NumberLen + 1 );
- ASSERT(num >= 0);
- ix := 1;
- WHILE ix <= NumberLen DO
- digits[ix] := "0";
- INC(ix);
- END; (* initialisation *)
- IF btyp = oct THEN
- base := 8;
- ELSIF btyp = dec THEN
- base := 10;
- ELSIF btyp = hex THEN
- base := 10H;
- END;
- cnt := 0;
- REPEAT
- INC(cnt);
- dig := num MOD base;
- num := num DIV base;
- IF dig < 10 THEN
- dig := dig + ORD("0");
- ELSE
- dig := dig - 10 + ORD("A");
- END;
- digits[cnt] := CHR(dig);
- UNTIL num = 0;
- (* (* i don't like this *)
- IF btyp = oct THEN
- cnt := 11;
- ELSIF btyp = hex THEN
- cnt := 8;
- ELSIF neg THEN
- *)
- IF neg THEN
- INC(cnt);
- digits[cnt] := "-";
- END;
- maxlen := LEN(str); (* get maximal length *)
- IF len > maxlen THEN
- len := SHORT(maxlen);
- END;
- IF cnt > maxlen THEN
- cnt := SHORT(maxlen);
- END;
- ix := 0;
- WHILE len > cnt DO
- str[ix] := " ";
- INC(ix);
- DEC(len);
- END;
- WHILE cnt > 0 DO
- str[ix] := digits[cnt];
- INC(ix);
- DEC(cnt);
- END;
- IF ix < maxlen THEN
- str[ix] := 0X;
- END;
- END ConvertNumber;
+ digits[cnt] := CHR(dig);
+ UNTIL num = 0;
+ (* (* i don't like this *)
+ IF btyp = oct THEN
+ cnt := 11;
+ ELSIF btyp = hex THEN
+ cnt := 8;
+ ELSIF neg THEN
+ *)
+ IF neg THEN
+ INC(cnt);
+ digits[cnt] := "-";
+ END;
+ maxlen := LEN(str); (* get maximal length *)
+ IF len > maxlen THEN
+ len := SHORT(maxlen);
+ END;
+ IF cnt > maxlen THEN
+ cnt := SHORT(maxlen);
+ END;
+ ix := 0;
+ WHILE len > cnt DO
+ str[ix] := " ";
+ INC(ix);
+ DEC(len);
+ END;
+ WHILE cnt > 0 DO
+ str[ix] := digits[cnt];
+ INC(ix);
+ DEC(cnt);
+ END;
+ IF ix < maxlen THEN
+ str[ix] := 0X;
+ END;
+ END ConvertNumber;
- PROCEDURE ConvertInteger(num: LONGINT; len: INTEGER; VAR str: ARRAY OF
- CHAR);
- (* conversion of an integer decimal number to a string *)
- BEGIN
- ConvertNumber(ABS(num),len,dec,num < 0,str);
- END ConvertInteger;
+ PROCEDURE ConvertInteger(num: LONGINT; len: INTEGER; VAR str: ARRAY OF
+ CHAR);
+ (* conversion of an integer decimal number to a string *)
+ BEGIN
+ ConvertNumber(ABS(num),len,dec,num < 0,str);
+ END ConvertInteger;
- (* ========================= terminal ============================ *)
+ (* ========================= terminal ============================ *)
- PROCEDURE ReadChar(VAR ch: CHAR) : BOOLEAN;
- CONST read = 3;
- (*VAR r0, r1: INTEGER;*)
- VAR r0, r1: LONGINT; (* in ulm system INTEGER and LONGINT have the same 4 byte size; -- noch *)
- BEGIN
- RETURN SYS.UNIXCALL(read, r0, r1, 0, SYSTEM.ADR(ch), 1) & (r0 > 0)
- END ReadChar;
+(*
+ PROCEDURE ReadChar(VAR ch: CHAR) : BOOLEAN;
+ CONST read = 3;
+ (*VAR r0, r1: INTEGER;*)
+ VAR r0, r1: LONGINT; (* in ulm system INTEGER and LONGINT have the same 4 byte size; -- noch *)
+ BEGIN
+ RETURN SYS.UNIXCALL(read, r0, r1, 0, SYSTEM.ADR(ch), 1) & (r0 > 0)
+ END ReadChar;
+*)
- PROCEDURE WriteChar(ch: CHAR) : BOOLEAN;
- CONST write = 4;
- (*VAR r0, r1: INTEGER;*)
- VAR r0, r1: LONGINT; (* same here *)
- BEGIN
- RETURN SYS.UNIXCALL(write, r0, r1, 1, SYSTEM.ADR(ch), 1)
- END WriteChar;
+ PROCEDURE ReadChar(VAR ch: CHAR) : BOOLEAN;
+ (* Read one byte, returning success flag *)
+ VAR error: Platform.ErrorCode; readcount: LONGINT;
+ BEGIN
+ error := Platform.ReadBuf(Platform.StdIn, ch, readcount);
+ RETURN readcount > 0
+ END ReadChar;
- PROCEDURE Read*(VAR ch: CHAR);
- BEGIN
- Done := TRUE;
- IF readAgain THEN
- ch := oldch;
- readAgain := FALSE;
- ELSIF ~ReadChar(ch) THEN
- Done := FALSE;
- ch := 0X;
- ELSE
- oldch := ch;
- END;
- END Read;
+(*
+ PROCEDURE WriteChar(ch: CHAR) : BOOLEAN;
+ CONST write = 4;
+ (*VAR r0, r1: INTEGER;*)
+ VAR r0, r1: LONGINT; (* same here *)
+ BEGIN
+ RETURN SYS.UNIXCALL(write, r0, r1, 1, SYSTEM.ADR(ch), 1)
+ END WriteChar;
+*)
- PROCEDURE ReadAgain*;
- BEGIN
- IF readAgain THEN
- Done := FALSE;
- ELSE
- Done := TRUE;
- readAgain := TRUE;
- END;
- END ReadAgain;
+ PROCEDURE WriteChar(ch: CHAR) : BOOLEAN;
+ (* Write one byte, returning success flag *)
+ BEGIN
+ RETURN Platform.Write(Platform.StdOut, SYSTEM.ADR(ch), 1) = 0
+ END WriteChar;
- PROCEDURE Write*(ch: CHAR);
- BEGIN
- Done := WriteChar(ch);
- END Write;
-
- PROCEDURE WriteLn*;
- CONST nl = 0AX;
- BEGIN
- Write(nl);
- END WriteLn;
-
- PROCEDURE WriteString*(s: ARRAY OF CHAR);
- VAR i: INTEGER;
- BEGIN
- i := 0;
- WHILE (i < LEN(s)) & (s[i] # 0X) DO
- Write(s[i]);
- INC(i);
- END;
- END WriteString;
-
- PROCEDURE InitIO;
- BEGIN
+ PROCEDURE Read*(VAR ch: CHAR);
+ BEGIN
+ Done := TRUE;
+ IF readAgain THEN
+ ch := oldch;
readAgain := FALSE;
+ ELSIF ~ReadChar(ch) THEN
+ Done := FALSE;
+ ch := 0X;
+ ELSE
+ oldch := ch;
+ END;
+ END Read;
+
+ PROCEDURE ReadAgain*;
+ BEGIN
+ IF readAgain THEN
+ Done := FALSE;
+ ELSE
Done := TRUE;
- END InitIO;
+ readAgain := TRUE;
+ END;
+ END ReadAgain;
- PROCEDURE WriteInt*(arg: LONGINT);
- VAR field: ARRAY 23 OF CHAR;
- BEGIN (* the field size should be big enough to hold the long number. it was 12 to hold just 32 bit numbers, now it can hold 64 bit numbers; need to be more for 128bit numbers; -- noch *)
- ConvertInteger(arg, 1, field);
- WriteString(field);
- END WriteInt;
+ PROCEDURE Write*(ch: CHAR);
+ BEGIN
+ Done := WriteChar(ch);
+ END Write;
- PROCEDURE ReadInt*(VAR arg: LONGINT);
- VAR ch: CHAR;
- minus: BOOLEAN;
- BEGIN
- minus := FALSE;
- REPEAT
- Read(ch);
- IF ~Done THEN RETURN END;
- IF ch = "-" THEN
- minus := TRUE;
- ELSIF (ch # " ") & (ch # nl) & ((ch < "0") OR (ch > "9")) THEN
- WriteString("--- Integer expected on input"); WriteLn;
- END;
- UNTIL (ch >= "0") & (ch <= "9");
- arg := ORD(ch) - ORD("0");
- REPEAT
- Read(ch);
- IF ~Done THEN RETURN END;
- IF (ch >= "0") & (ch <= "9") THEN
- arg := arg*10 + (ORD(ch) - ORD("0"));
- END;
- UNTIL (ch < "0") OR (ch > "9");
- ReadAgain;
- IF minus THEN arg := -arg; END;
- END ReadInt;
+ PROCEDURE WriteLn*;
+ CONST nl = 0AX;
+ BEGIN
+ Write(nl);
+ END WriteLn;
- PROCEDURE ReadLine*(VAR string: ARRAY OF CHAR);
- VAR
- index: INTEGER;
- ch: CHAR;
- ok: BOOLEAN;
- BEGIN
- index := 0; ok := TRUE;
- LOOP
- IF ~ReadChar(ch) THEN ok := FALSE; EXIT END;
- IF ch = nl THEN EXIT END;
- IF index < LEN(string) THEN
- string[index] := ch; INC(index);
- END;
+ PROCEDURE WriteString*(s: ARRAY OF CHAR);
+ VAR i: INTEGER;
+ BEGIN
+ i := 0;
+ WHILE (i < LEN(s)) & (s[i] # 0X) DO
+ Write(s[i]);
+ INC(i);
+ END;
+ END WriteString;
+
+ PROCEDURE InitIO;
+ BEGIN
+ readAgain := FALSE;
+ Done := TRUE;
+ END InitIO;
+
+ PROCEDURE WriteInt*(arg: LONGINT);
+ VAR field: ARRAY 23 OF CHAR;
+ BEGIN (* the field size should be big enough to hold the long number. it was 12 to hold just 32 bit numbers, now it can hold 64 bit numbers; need to be more for 128bit numbers; -- noch *)
+ ConvertInteger(arg, 1, field);
+ WriteString(field);
+ END WriteInt;
+
+ PROCEDURE ReadInt*(VAR arg: LONGINT);
+ VAR ch: CHAR;
+ minus: BOOLEAN;
+ BEGIN
+ minus := FALSE;
+ REPEAT
+ Read(ch);
+ IF ~Done THEN RETURN END;
+ IF ch = "-" THEN
+ minus := TRUE;
+ ELSIF (ch # " ") & (ch # nl) & ((ch < "0") OR (ch > "9")) THEN
+ WriteString("--- Integer expected on input"); WriteLn;
END;
+ UNTIL (ch >= "0") & (ch <= "9");
+ arg := ORD(ch) - ORD("0");
+ REPEAT
+ Read(ch);
+ IF ~Done THEN RETURN END;
+ IF (ch >= "0") & (ch <= "9") THEN
+ arg := arg*10 + (ORD(ch) - ORD("0"));
+ END;
+ UNTIL (ch < "0") OR (ch > "9");
+ ReadAgain;
+ IF minus THEN arg := -arg; END;
+ END ReadInt;
+
+ PROCEDURE ReadLine*(VAR string: ARRAY OF CHAR);
+ VAR
+ index: INTEGER;
+ ch: CHAR;
+ ok: BOOLEAN;
+ BEGIN
+ index := 0; ok := TRUE;
+ LOOP
+ IF ~ReadChar(ch) THEN ok := FALSE; EXIT END;
+ IF ch = nl THEN EXIT END;
IF index < LEN(string) THEN
- string[index] := 0X;
+ string[index] := ch; INC(index);
END;
- Done := ok OR (index > 0);
- END ReadLine;
+ END;
+ IF index < LEN(string) THEN
+ string[index] := 0X;
+ END;
+ Done := ok OR (index > 0);
+ END ReadLine;
BEGIN
- InitIO;
+ InitIO;
END ulmIO.
diff --git a/src/library/ulm/ulmIndirectDisciplines.Mod b/src/library/ulm/ulmIndirectDisciplines.Mod
index 3118852e..22e06b14 100644
--- a/src/library/ulm/ulmIndirectDisciplines.Mod
+++ b/src/library/ulm/ulmIndirectDisciplines.Mod
@@ -43,23 +43,24 @@ MODULE ulmIndirectDisciplines;
TYPE
IndDiscipline = POINTER TO IndDisciplineRec;
IndDisciplineRec =
- RECORD
- (DisciplineRec)
- forwardTo: Object;
- END;
+ RECORD
+ (DisciplineRec)
+ forwardTo: Object;
+ END;
+
VAR
discID: Identifier;
PROCEDURE Forward*(from, to: Object);
VAR
- disc: IndDiscipline;
+ disc: IndDiscipline;
BEGIN
IF to = NIL THEN
- Disciplines.Remove(from, discID);
+ Disciplines.Remove(from, discID);
ELSE
- NEW(disc); disc.id := discID;
- disc.forwardTo := to;
- Disciplines.Add(from, disc);
+ NEW(disc); disc.id := discID;
+ disc.forwardTo := to;
+ Disciplines.Add(from, disc);
END;
END Forward;
@@ -70,44 +71,43 @@ MODULE ulmIndirectDisciplines;
PROCEDURE Add*(object: Object; discipline: Discipline);
VAR
- disc: IndDiscipline;
+ disc: Discipline;
BEGIN
- WHILE Disciplines.Seek(object, discID, SYSTEM.VAL(Disciplines.Discipline, disc)) DO
- object := disc.forwardTo;
+ WHILE Disciplines.Seek(object, discID, disc) DO
+ object := disc(IndDiscipline).forwardTo;
END;
Disciplines.Add(object, discipline);
END Add;
PROCEDURE Remove*(object: Object; id: Identifier);
VAR
- dummy: Discipline;
- disc: IndDiscipline;
+ dummy, disc: Discipline;
BEGIN
LOOP
- IF Disciplines.Seek(object, id, dummy) THEN
- Disciplines.Remove(object, id);
- EXIT
- END;
- IF ~Disciplines.Seek(object, discID, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN
- EXIT
- END;
- object := disc.forwardTo;
+ IF Disciplines.Seek(object, id, dummy) THEN
+ Disciplines.Remove(object, id);
+ EXIT
+ END;
+ IF ~Disciplines.Seek(object, discID, disc) THEN
+ EXIT
+ END;
+ object := disc(IndDiscipline).forwardTo;
END;
END Remove;
PROCEDURE Seek*(object: Object; id: Identifier;
- VAR discipline: Discipline) : BOOLEAN;
+ VAR discipline: Discipline) : BOOLEAN;
VAR
- disc: IndDiscipline;
+ disc: Discipline;
BEGIN
LOOP
- IF Disciplines.Seek(object, id, discipline) THEN
- RETURN TRUE
- END;
- IF ~Disciplines.Seek(object, discID, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN
- RETURN FALSE
- END;
- object := disc.forwardTo;
+ IF Disciplines.Seek(object, id, discipline) THEN
+ RETURN TRUE
+ END;
+ IF ~Disciplines.Seek(object, discID, disc) THEN
+ RETURN FALSE
+ END;
+ object := disc(IndDiscipline).forwardTo;
END;
END Seek;
diff --git a/src/library/ulm/ulmIntOperations.Mod b/src/library/ulm/ulmIntOperations.Mod
index 33ec3161..3f1799aa 100644
--- a/src/library/ulm/ulmIntOperations.Mod
+++ b/src/library/ulm/ulmIntOperations.Mod
@@ -28,52 +28,53 @@
MODULE ulmIntOperations; (* Frank B.J. Fischer *)
- IMPORT Operations := ulmOperations, PersistentObjects := ulmPersistentObjects, Services := ulmServices, Streams := ulmStreams, Types := ulmTypes, SYSTEM;
+ IMPORT
+ Operations := ulmOperations, PersistentObjects := ulmPersistentObjects,
+ Services := ulmServices, Streams := ulmStreams,
+ Types := ulmTypes;
-(* SYSTEM added to make casts necessary to port ulm library because ulm compiler is not as strict (read it's wrong) as it had to be --noch *)
-
- CONST
+ CONST
mod* = 5; pow* = 6; inc* = 7; dec* = 8; mmul* = 9; mpow* = 10;
odd* = 11; shift* = 12;
- TYPE
+ TYPE
Operation* = Operations.Operation; (* Operations.add..mpow *)
Operand* = POINTER TO OperandRec;
TYPE
- CapabilitySet* = Operations.CapabilitySet;
- (* SET of [Operations.add..shift] *)
+ CapabilitySet* = Operations.CapabilitySet;
+ (* SET of [Operations.add..shift] *)
IsLargeEnoughForProc* = PROCEDURE (op: Operations.Operand;
- n: LONGINT): BOOLEAN;
+ n: LONGINT): BOOLEAN;
UnsignedProc* = PROCEDURE (op: Operations.Operand): BOOLEAN;
IntToOpProc* = PROCEDURE (int32: Types.Int32; VAR op: Operations.Operand);
OpToIntProc* = PROCEDURE (op: Operations.Operand; VAR int32: Types.Int32);
Log2Proc* = PROCEDURE (op: Operations.Operand): LONGINT;
OddProc* = PROCEDURE (op: Operations.Operand): BOOLEAN;
- ShiftProc* = PROCEDURE (op: Operations.Operand;
- n: INTEGER): Operations.Operand;
- IntOperatorProc* = PROCEDURE(op: Operation;
- op1, op2, op3: Operations.Operand;
- VAR result: Operations.Operand);
+ ShiftProc* = PROCEDURE (op: Operations.Operand;
+ n: INTEGER): Operations.Operand;
+ IntOperatorProc* = PROCEDURE(op: Operation;
+ op1, op2, op3: Operations.Operand;
+ VAR result: Operations.Operand);
Interface* = POINTER TO InterfaceRec;
InterfaceRec* = RECORD
- (Operations.InterfaceRec)
- isLargeEnoughFor*: IsLargeEnoughForProc;
- unsigned* : UnsignedProc;
- intToOp* : IntToOpProc;
- opToInt* : OpToIntProc;
- log2* : Log2Proc;
- odd* : OddProc;
- shift* : ShiftProc;
- intOp* : IntOperatorProc;
+ (Operations.InterfaceRec)
+ isLargeEnoughFor*: IsLargeEnoughForProc;
+ unsigned* : UnsignedProc;
+ intToOp* : IntToOpProc;
+ opToInt* : OpToIntProc;
+ log2* : Log2Proc;
+ odd* : OddProc;
+ shift* : ShiftProc;
+ intOp* : IntOperatorProc;
END;
TYPE
OperandRec* = RECORD
- (Operations.OperandRec);
- (* private components *)
- if : Interface;
- caps: CapabilitySet;
+ (Operations.OperandRec);
+ (* private components *)
+ if : Interface;
+ caps: CapabilitySet;
END;
VAR
@@ -97,7 +98,7 @@ MODULE ulmIntOperations; (* Frank B.J. Fischer *)
PROCEDURE IsLargeEnoughFor*(op: Operations.Operand; n: LONGINT): BOOLEAN;
BEGIN
WITH op: Operand DO
- RETURN op.if.isLargeEnoughFor(op, n)
+ RETURN op.if.isLargeEnoughFor(op, n)
END;
END IsLargeEnoughFor;
@@ -105,34 +106,18 @@ MODULE ulmIntOperations; (* Frank B.J. Fischer *)
PROCEDURE Unsigned*(op: Operations.Operand): BOOLEAN;
BEGIN
WITH op: Operand DO
- RETURN op.if.unsigned(op)
+ RETURN op.if.unsigned(op)
END;
END Unsigned;
PROCEDURE IntToOp*(int32: Types.Int32; VAR op: Operations.Operand);
(* converts int32 into operand type, and stores result in already
- initialized op
+ initialized op
*)
BEGIN
- (*WITH op: Operand DO*)
- (*
- with original ulm source we were getting:
-
- WITH op: Operand DO
- ^
- pos 4101 err 245 guarded pointer variable may be manipulated by non-local operations; use auxiliary pointer variable
-
- thus we considered changing WITH op: Operand by op(Operand)
-
- -- noch
-
- *)
- (*ASSERT(op.if # NIL);*)
- ASSERT(op(Operand).if # NIL);
- (*op.if.intToOp(int32, op);*)
- op(Operand).if.intToOp(int32, op(Operations.Operand));
- (*END;*)
+ ASSERT(op(Operand).if # NIL);
+ op(Operand).if.intToOp(int32, op);
END IntToOp;
@@ -140,7 +125,7 @@ MODULE ulmIntOperations; (* Frank B.J. Fischer *)
(* converts op into int32 *)
BEGIN
WITH op: Operand DO
- op.if.opToInt(op, int32);
+ op.if.opToInt(op, int32);
END;
END OpToInt;
@@ -148,7 +133,7 @@ MODULE ulmIntOperations; (* Frank B.J. Fischer *)
PROCEDURE Log2*(op: Operations.Operand): LONGINT;
BEGIN
WITH op: Operand DO
- RETURN op.if.log2(op)
+ RETURN op.if.log2(op)
END;
END Log2;
@@ -162,22 +147,22 @@ MODULE ulmIntOperations; (* Frank B.J. Fischer *)
END Odd;
- PROCEDURE Op(op: Operation; op1, op2, op3: Operations.Operand;
- VAR result: Operations.Operand);
+ PROCEDURE Op(op: Operation; op1, op2, op3: Operations.Operand;
+ VAR result: Operations.Operand);
VAR
tmpresult: Operations.Operand;
BEGIN
WITH op1: Operand DO
- IF (op2#NIL) & (op3#NIL) THEN
- ASSERT((op1.if = op2(Operand).if) &
- (op2(Operand).if = op3(Operand).if));
- ELSIF (op2#NIL) THEN
- ASSERT(op1.if = op2(Operand).if);
- END;
- ASSERT(op IN op1.caps);
- op1.if.create(tmpresult);
- op1.if.intOp(op, op1, op2, op3, tmpresult);
- result := tmpresult;
+ IF (op2#NIL) & (op3#NIL) THEN
+ ASSERT((op1.if = op2(Operand).if) &
+ (op2(Operand).if = op3(Operand).if));
+ ELSIF (op2#NIL) THEN
+ ASSERT(op1.if = op2(Operand).if);
+ END;
+ ASSERT(op IN op1.caps);
+ op1.if.create(tmpresult);
+ op1.if.intOp(op, op1, op2, op3, tmpresult);
+ result := tmpresult;
END;
END Op;
@@ -197,15 +182,15 @@ MODULE ulmIntOperations; (* Frank B.J. Fischer *)
END Shift2;
- PROCEDURE Shift3*(VAR result: Operations.Operand; op1: Operations.Operand;
- n : INTEGER);
+ PROCEDURE Shift3*(VAR result: Operations.Operand; op1: Operations.Operand;
+ n : INTEGER);
VAR
tmpresult: Operations.Operand;
BEGIN
WITH op1: Operand DO
- op1.if.create(tmpresult);
- tmpresult := Shift(op1, n);
- result := tmpresult;
+ op1.if.create(tmpresult);
+ tmpresult := Shift(op1, n);
+ result := tmpresult;
END;
END Shift3;
@@ -230,7 +215,7 @@ MODULE ulmIntOperations; (* Frank B.J. Fischer *)
BEGIN
Op(inc,op1,NIL,NIL,result);
END Inc3;
-
+
PROCEDURE Dec*(op1: Operations.Operand): Operations.Operand;
VAR
@@ -252,7 +237,7 @@ MODULE ulmIntOperations; (* Frank B.J. Fischer *)
BEGIN
Op(dec,op1,NIL,NIL,result);
END Dec3;
-
+
PROCEDURE Mod*(op1, op2: Operations.Operand): Operations.Operand;
VAR
@@ -278,11 +263,10 @@ MODULE ulmIntOperations; (* Frank B.J. Fischer *)
PROCEDURE Pow*(op1, op2: Operations.Operand): Operations.Operand;
VAR
- result : Operand;
+ result: Operations.Operand;
BEGIN
result := NIL;
- (*Op(pow, op1, op2, NIL, result);*)
- Op(pow, op1, op2, NIL, SYSTEM.VAL(Operations.Operand, result)); (* -- noch *)
+ Op(pow, op1, op2, NIL, result);
RETURN result
END Pow;
@@ -301,11 +285,10 @@ MODULE ulmIntOperations; (* Frank B.J. Fischer *)
PROCEDURE MMul*(op1, op2, op3: Operations.Operand): Operations.Operand;
VAR
- result : Operand;
+ result : Operations.Operand;
BEGIN
result := NIL;
- (*Op(mmul, op1, op2, op3, result); *)
- Op(mmul, op1, op2, op3, SYSTEM.VAL(Operations.Operand, result)); (* --noch*)
+ Op(mmul, op1, op2, op3, result);
RETURN result
END MMul;
@@ -316,8 +299,8 @@ MODULE ulmIntOperations; (* Frank B.J. Fischer *)
END MMul2;
- PROCEDURE MMul3*(VAR result: Operations.Operand;
- op1, op2, op3: Operations.Operand);
+ PROCEDURE MMul3*(VAR result: Operations.Operand;
+ op1, op2, op3: Operations.Operand);
BEGIN
Op(mmul, op1, op2, op3, result);
END MMul3;
@@ -325,11 +308,10 @@ MODULE ulmIntOperations; (* Frank B.J. Fischer *)
PROCEDURE MPow*(op1, op2, op3: Operations.Operand): Operations.Operand;
VAR
- result : Operand;
+ result : Operations.Operand;
BEGIN
result := NIL;
- (*Op(mpow, op1, op2, op3, result); *)
- Op(mpow, op1, op2, op3, SYSTEM.VAL(Operations.Operand, result)); (* -- noch*)
+ Op(mpow, op1, op2, op3, result);
RETURN result
END MPow;
@@ -340,8 +322,8 @@ MODULE ulmIntOperations; (* Frank B.J. Fischer *)
END MPow2;
- PROCEDURE MPow3*(VAR result: Operations.Operand;
- op1, op2, op3: Operations.Operand);
+ PROCEDURE MPow3*(VAR result: Operations.Operand;
+ op1, op2, op3: Operations.Operand);
BEGIN
Op(mpow, op1, op2, op3, result);
END MPow3;
diff --git a/src/library/ulm/ulmNetIO.Mod b/src/library/ulm/ulmNetIO.Mod
index 0d0d44a0..b9741f30 100644
--- a/src/library/ulm/ulmNetIO.Mod
+++ b/src/library/ulm/ulmNetIO.Mod
@@ -1,546 +1,554 @@
(* Ulm's Oberon Library
- Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
- ----------------------------------------------------------------------------
- Ulm's Oberon Library is free software; you can redistribute it
- and/or modify it under the terms of the GNU Library General Public
- License as published by the Free Software Foundation; either version
- 2 of the License, or (at your option) any later version.
+ Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
+ ----------------------------------------------------------------------------
+ Ulm's Oberon Library is free software; you can redistribute it
+ and/or modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either version
+ 2 of the License, or (at your option) any later version.
- Ulm's Oberon Library is distributed in the hope that it will be
- useful, but WITHOUT ANY WARRANTY; without even the implied warranty
- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Library General Public License for more details.
+ Ulm's Oberon Library is distributed in the hope that it will be
+ useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+ of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
- You should have received a copy of the GNU Library General Public
- License along with this library; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ----------------------------------------------------------------------------
- E-mail contact: oberon@mathematik.uni-ulm.de
- ----------------------------------------------------------------------------
- $Id: NetIO.om,v 1.4 2004/05/21 15:19:03 borchert Exp $
- ----------------------------------------------------------------------------
- $Log: NetIO.om,v $
- Revision 1.4 2004/05/21 15:19:03 borchert
- performance improvements:
- - ReadConstStringD prefers Streams.ReadPart and ConstStrings.CreateD,
- if possible
- (based on code by Christian Ehrhardt)
- - WriteConstString uses Streams.Copy instead of a loop that uses
- Streams.ReadByte and Streams.WriteByte
+ You should have received a copy of the GNU Library General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ----------------------------------------------------------------------------
+ E-mail contact: oberon@mathematik.uni-ulm.de
+ ----------------------------------------------------------------------------
+ $Id: NetIO.om,v 1.4 2004/05/21 15:19:03 borchert Exp $
+ ----------------------------------------------------------------------------
+ $Log: NetIO.om,v $
+ Revision 1.4 2004/05/21 15:19:03 borchert
+ performance improvements:
+ - ReadConstStringD prefers Streams.ReadPart and ConstStrings.CreateD,
+ if possible
+ (based on code by Christian Ehrhardt)
+ - WriteConstString uses Streams.Copy instead of a loop that uses
+ Streams.ReadByte and Streams.WriteByte
- Revision 1.3 1995/03/17 16:28:20 borchert
- - SizeOf stuff removed
- - support of const strings added
- - support of Forwarders added
+ Revision 1.3 1995/03/17 16:28:20 borchert
+ - SizeOf stuff removed
+ - support of const strings added
+ - support of Forwarders added
- Revision 1.2 1994/07/18 14:18:37 borchert
- unused variables of WriteString (ch + index) removed
+ Revision 1.2 1994/07/18 14:18:37 borchert
+ unused variables of WriteString (ch + index) removed
- Revision 1.1 1994/02/22 20:08:43 borchert
- Initial revision
+ Revision 1.1 1994/02/22 20:08:43 borchert
+ Initial revision
- ----------------------------------------------------------------------------
- AFB 6/93
- ----------------------------------------------------------------------------
+ ----------------------------------------------------------------------------
+ AFB 6/93
+ ----------------------------------------------------------------------------
*)
MODULE ulmNetIO;
- (* abstraction for the exchange of Oberon base types which
- are components of persistent data structures
- *)
+ (* abstraction for the exchange of Oberon base types which
+ are components of persistent data structures
+ *)
- IMPORT ConstStrings := ulmConstStrings, Disciplines := ulmDisciplines, Forwarders := ulmForwarders, Streams := ulmStreams, Strings := ulmStrings,
- SYS := SYSTEM, Types := ulmTypes;
+ IMPORT ConstStrings := ulmConstStrings, Disciplines := ulmDisciplines, Forwarders := ulmForwarders, Streams := ulmStreams, Strings := ulmStrings,
+ SYS := SYSTEM, Types := ulmTypes;
- TYPE
- Byte* = Types.Byte;
+ TYPE
+ Byte* = Types.Byte;
- TYPE
- ReadByteProc* =
- PROCEDURE (s: Streams.Stream; VAR byte: Byte) : BOOLEAN;
- ReadCharProc* =
- PROCEDURE (s: Streams.Stream; VAR char: CHAR) : BOOLEAN;
- ReadBooleanProc* =
- PROCEDURE (s: Streams.Stream; VAR boolean: BOOLEAN) : BOOLEAN;
- ReadShortIntProc* =
- PROCEDURE (s: Streams.Stream; VAR shortint: SHORTINT) : BOOLEAN;
- ReadIntegerProc* =
- PROCEDURE (s: Streams.Stream; VAR integer: INTEGER) : BOOLEAN;
- ReadLongIntProc* =
- PROCEDURE (s: Streams.Stream; VAR longint: LONGINT) : BOOLEAN;
- ReadRealProc* =
- PROCEDURE (s: Streams.Stream; VAR real: REAL) : BOOLEAN;
- ReadLongRealProc* =
- PROCEDURE (s: Streams.Stream; VAR longreal: LONGREAL) : BOOLEAN;
- ReadSetProc* =
- PROCEDURE (s: Streams.Stream; VAR set: SET) : BOOLEAN;
- ReadStringProc* =
- PROCEDURE (s: Streams.Stream; VAR string: ARRAY OF CHAR) : BOOLEAN;
- ReadConstStringProc* =
- PROCEDURE (s: Streams.Stream; domain: ConstStrings.Domain;
- VAR string: ConstStrings.String) : BOOLEAN;
+ TYPE
+ ReadByteProc* =
+ PROCEDURE (s: Streams.Stream; VAR byte: Byte) : BOOLEAN;
+ ReadCharProc* =
+ PROCEDURE (s: Streams.Stream; VAR char: CHAR) : BOOLEAN;
+ ReadBooleanProc* =
+ PROCEDURE (s: Streams.Stream; VAR boolean: BOOLEAN) : BOOLEAN;
+ ReadShortIntProc* =
+ PROCEDURE (s: Streams.Stream; VAR shortint: SHORTINT) : BOOLEAN;
+ ReadIntegerProc* =
+ PROCEDURE (s: Streams.Stream; VAR integer: INTEGER) : BOOLEAN;
+ ReadLongIntProc* =
+ PROCEDURE (s: Streams.Stream; VAR longint: LONGINT) : BOOLEAN;
+ ReadRealProc* =
+ PROCEDURE (s: Streams.Stream; VAR real: REAL) : BOOLEAN;
+ ReadLongRealProc* =
+ PROCEDURE (s: Streams.Stream; VAR longreal: LONGREAL) : BOOLEAN;
+ ReadSetProc* =
+ PROCEDURE (s: Streams.Stream; VAR set: SET) : BOOLEAN;
+ ReadStringProc* =
+ PROCEDURE (s: Streams.Stream; VAR string: ARRAY OF CHAR) : BOOLEAN;
+ ReadConstStringProc* =
+ PROCEDURE (s: Streams.Stream; domain: ConstStrings.Domain;
+ VAR string: ConstStrings.String) : BOOLEAN;
- WriteByteProc* =
- PROCEDURE (s: Streams.Stream; byte: Byte) : BOOLEAN;
- WriteCharProc* =
- PROCEDURE (s: Streams.Stream; char: CHAR) : BOOLEAN;
- WriteBooleanProc* =
- PROCEDURE (s: Streams.Stream; boolean: BOOLEAN) : BOOLEAN;
- WriteShortIntProc* =
- PROCEDURE (s: Streams.Stream; shortint: SHORTINT) : BOOLEAN;
- WriteIntegerProc* =
- PROCEDURE (s: Streams.Stream; integer: INTEGER) : BOOLEAN;
- WriteLongIntProc* =
- PROCEDURE (s: Streams.Stream; longint: LONGINT) : BOOLEAN;
- WriteRealProc* =
- PROCEDURE (s: Streams.Stream; real: REAL) : BOOLEAN;
- WriteLongRealProc* =
- PROCEDURE (s: Streams.Stream; longreal: LONGREAL) : BOOLEAN;
- WriteSetProc* =
- PROCEDURE (s: Streams.Stream; set: SET) : BOOLEAN;
- WriteStringProc* =
- PROCEDURE (s: Streams.Stream; string: ARRAY OF CHAR) : BOOLEAN;
- WriteConstStringProc* =
- PROCEDURE (s: Streams.Stream;
- string: ConstStrings.String) : BOOLEAN;
+ WriteByteProc* =
+ PROCEDURE (s: Streams.Stream; byte: Byte) : BOOLEAN;
+ WriteCharProc* =
+ PROCEDURE (s: Streams.Stream; char: CHAR) : BOOLEAN;
+ WriteBooleanProc* =
+ PROCEDURE (s: Streams.Stream; boolean: BOOLEAN) : BOOLEAN;
+ WriteShortIntProc* =
+ PROCEDURE (s: Streams.Stream; shortint: SHORTINT) : BOOLEAN;
+ WriteIntegerProc* =
+ PROCEDURE (s: Streams.Stream; integer: INTEGER) : BOOLEAN;
+ WriteLongIntProc* =
+ PROCEDURE (s: Streams.Stream; longint: LONGINT) : BOOLEAN;
+ WriteRealProc* =
+ PROCEDURE (s: Streams.Stream; real: REAL) : BOOLEAN;
+ WriteLongRealProc* =
+ PROCEDURE (s: Streams.Stream; longreal: LONGREAL) : BOOLEAN;
+ WriteSetProc* =
+ PROCEDURE (s: Streams.Stream; set: SET) : BOOLEAN;
+ WriteStringProc* =
+ PROCEDURE (s: Streams.Stream; string: ARRAY OF CHAR) : BOOLEAN;
+ WriteConstStringProc* =
+ PROCEDURE (s: Streams.Stream;
+ string: ConstStrings.String) : BOOLEAN;
- Interface* = POINTER TO InterfaceRec;
- InterfaceRec* =
- RECORD
- readByte*: ReadByteProc;
- readChar*: ReadCharProc;
- readBoolean*: ReadBooleanProc;
- readShortInt*: ReadShortIntProc;
- readInteger*: ReadIntegerProc;
- readLongInt*: ReadLongIntProc;
- readReal*: ReadRealProc;
- readLongReal*: ReadLongRealProc;
- readSet*: ReadSetProc;
- readString*: ReadStringProc;
- readConstString*: ReadConstStringProc;
+ Interface* = POINTER TO InterfaceRec;
+ InterfaceRec* =
+ RECORD
+ readByte*: ReadByteProc;
+ readChar*: ReadCharProc;
+ readBoolean*: ReadBooleanProc;
+ readShortInt*: ReadShortIntProc;
+ readInteger*: ReadIntegerProc;
+ readLongInt*: ReadLongIntProc;
+ readReal*: ReadRealProc;
+ readLongReal*: ReadLongRealProc;
+ readSet*: ReadSetProc;
+ readString*: ReadStringProc;
+ readConstString*: ReadConstStringProc;
- writeByte*: WriteByteProc;
- writeChar*: WriteCharProc;
- writeBoolean*: WriteBooleanProc;
- writeShortInt*: WriteShortIntProc;
- writeInteger*: WriteIntegerProc;
- writeLongInt*: WriteLongIntProc;
- writeReal*: WriteRealProc;
- writeLongReal*: WriteLongRealProc;
- writeSet*: WriteSetProc;
- writeString*: WriteStringProc;
- writeConstString*: WriteConstStringProc;
- END;
-
- (* private data structures *)
- TYPE
- Discipline = POINTER TO DisciplineRec;
- DisciplineRec =
- RECORD
- (Disciplines.DisciplineRec)
- if: Interface;
- END;
- VAR
- discID: Disciplines.Identifier;
-
- PROCEDURE Swap (VAR a : ARRAY OF SYS.BYTE);
- VAR
- i,j : LONGINT;
- tmp : SYS.BYTE;
- BEGIN
- i := 0; j := LEN (a) - 1;
- WHILE i < j DO
- tmp := a[i]; a[i] := a[j]; a[j] := tmp;
- INC (i); DEC (j);
+ writeByte*: WriteByteProc;
+ writeChar*: WriteCharProc;
+ writeBoolean*: WriteBooleanProc;
+ writeShortInt*: WriteShortIntProc;
+ writeInteger*: WriteIntegerProc;
+ writeLongInt*: WriteLongIntProc;
+ writeReal*: WriteRealProc;
+ writeLongReal*: WriteLongRealProc;
+ writeSet*: WriteSetProc;
+ writeString*: WriteStringProc;
+ writeConstString*: WriteConstStringProc;
END;
- END Swap;
- PROCEDURE BitSwap (VAR a : ARRAY OF SYS.BYTE);
- VAR
- i,old, bit : LONGINT;
- new : LONGINT;
-
- BEGIN
- i := 0;
- WHILE i < LEN (a) DO
- old := ORD (SYS.VAL (CHAR, a[i]));
- new := 0; bit := 080H;
- WHILE old # 0 DO
- IF ODD (old) THEN
- INC (new, bit);
- END;
- bit := ASH (bit, -1);;
- old := ASH (old, -1);
- END;
- a[i] := SYS.VAL (SYS.BYTE, new);
- INC (i);
+ (* private data structures *)
+ TYPE
+ Discipline = POINTER TO DisciplineRec;
+ DisciplineRec =
+ RECORD
+ (Disciplines.DisciplineRec)
+ if: Interface;
END;
- END BitSwap;
+ VAR
+ discID: Disciplines.Identifier;
- PROCEDURE ^ Forward(from, to: Forwarders.Object);
+ PROCEDURE Seek(s: Streams.Stream; id: Disciplines.Identifier; disc: Discipline): BOOLEAN;
+ VAR d: Disciplines.Discipline; result: BOOLEAN;
+ BEGIN
+ result := Disciplines.Seek(s, id, d);
+ IF result THEN disc := d(Discipline) ELSE disc := NIL END;
+ RETURN result
+ END Seek;
- PROCEDURE AttachInterface*(s: Streams.Stream; if: Interface);
- VAR
- disc: Discipline;
- BEGIN
- IF if # NIL THEN
- NEW(disc); disc.id := discID; disc.if := if;
- Disciplines.Add(s, disc);
+ PROCEDURE Swap (VAR a : ARRAY OF SYS.BYTE);
+ VAR
+ i,j : LONGINT;
+ tmp : SYS.BYTE;
+ BEGIN
+ i := 0; j := LEN (a) - 1;
+ WHILE i < j DO
+ tmp := a[i]; a[i] := a[j]; a[j] := tmp;
+ INC (i); DEC (j);
+ END;
+ END Swap;
+
+ PROCEDURE BitSwap (VAR a : ARRAY OF SYS.BYTE);
+ VAR
+ i,old, bit : LONGINT;
+ new : LONGINT;
+
+ BEGIN
+ i := 0;
+ WHILE i < LEN (a) DO
+ old := ORD (SYS.VAL (CHAR, a[i]));
+ new := 0; bit := 080H;
+ WHILE old # 0 DO
+ IF ODD (old) THEN
+ INC (new, bit);
+ END;
+ bit := ASH (bit, -1);;
+ old := ASH (old, -1);
+ END;
+ a[i] := SYS.VAL (SYS.BYTE, new);
+ INC (i);
+ END;
+ END BitSwap;
+
+ PROCEDURE ^ Forward(from, to: Forwarders.Object);
+
+ PROCEDURE AttachInterface*(s: Streams.Stream; if: Interface);
+ VAR
+ disc: Discipline;
+ BEGIN
+ IF if # NIL THEN
+ NEW(disc); disc.id := discID; disc.if := if;
+ Disciplines.Add(s, disc);
+ ELSE
+ Disciplines.Remove(s, discID);
+ END;
+ Forwarders.Update(s, Forward);
+ END AttachInterface;
+
+ PROCEDURE GetInterface(s: Streams.Stream; VAR if: Interface);
+ VAR
+ disc: Discipline;
+ BEGIN
+ IF Seek(s, discID, disc) THEN
+ if := disc.if;
+ ELSE
+ if := NIL;
+ END;
+ END GetInterface;
+
+ PROCEDURE CopyInterface*(from, to: Streams.Stream);
+ VAR
+ if: Interface;
+ BEGIN
+ GetInterface(from, if);
+ AttachInterface(to, if);
+ END CopyInterface;
+
+ PROCEDURE Forward(from, to: Forwarders.Object);
+ BEGIN
+ (* this check is necessary because of Forwarders.Update *)
+ IF ~(from IS Streams.Stream) OR ~(to IS Streams.Stream) THEN
+ RETURN
+ END;
+
+ WITH from: Streams.Stream DO WITH to: Streams.Stream DO
+ (* be careful here, from & to must be reversed *)
+ CopyInterface(to, from);
+ END; END;
+ END Forward;
+
+ PROCEDURE ReadByte*(s: Streams.Stream; VAR byte: Byte) : BOOLEAN;
+ VAR
+ disc: Discipline;
+ BEGIN
+ IF Seek(s, discID, disc) THEN
+ RETURN disc.if.readByte(s, byte)
+ ELSE
+ RETURN Streams.ReadByte(s, byte)
+ END;
+ END ReadByte;
+
+ PROCEDURE ReadChar*(s: Streams.Stream; VAR char: CHAR) : BOOLEAN;
+ VAR
+ disc: Discipline;
+ BEGIN
+ IF Seek(s, discID, disc) THEN
+ RETURN disc.if.readChar(s, char)
+ ELSE
+ RETURN Streams.ReadByte(s, char)
+ END;
+ END ReadChar;
+
+ PROCEDURE ReadBoolean*(s: Streams.Stream; VAR boolean: BOOLEAN) : BOOLEAN;
+ VAR
+ disc: Discipline;
+ BEGIN
+ IF Seek(s, discID, disc) THEN
+ RETURN disc.if.readBoolean(s, boolean)
+ ELSE
+ RETURN Streams.Read(s, boolean)
+ END;
+ END ReadBoolean;
+
+ PROCEDURE ReadShortInt*(s: Streams.Stream; VAR shortint: SHORTINT) : BOOLEAN;
+ VAR
+ disc: Discipline;
+ BEGIN
+ IF Seek(s, discID, disc) THEN
+ RETURN disc.if.readShortInt(s, shortint)
+ ELSE
+ RETURN Streams.ReadByte(s, shortint)
+ END;
+ END ReadShortInt;
+
+ PROCEDURE ReadInteger*(s: Streams.Stream; VAR integer: INTEGER) : BOOLEAN;
+ VAR
+ disc: Discipline;
+ ret : BOOLEAN;
+ BEGIN
+ IF Seek(s, discID, disc) THEN
+ RETURN disc.if.readInteger(s, integer)
+ ELSE
+ ret := Streams.Read(s, integer);
+ IF Types.byteorder = Types.littleEndian THEN
+ Swap (integer);
+ END;
+ RETURN ret;
+ END;
+ END ReadInteger;
+
+ PROCEDURE ReadLongInt*(s: Streams.Stream; VAR longint: LONGINT) : BOOLEAN;
+ VAR
+ disc: Discipline;
+ ret : BOOLEAN;
+ BEGIN
+ IF Seek(s, discID, disc) THEN
+ RETURN disc.if.readLongInt(s, longint)
+ ELSE
+ ret := Streams.Read(s, longint);
+ IF Types.byteorder = Types.littleEndian THEN
+ Swap (longint);
+ END;
+ RETURN ret;
+ END;
+ END ReadLongInt;
+
+ PROCEDURE ReadReal*(s: Streams.Stream; VAR real: REAL) : BOOLEAN;
+ VAR
+ disc: Discipline;
+ BEGIN
+ IF Seek(s, discID, disc) THEN
+ RETURN disc.if.readReal(s, real)
+ ELSE
+ RETURN Streams.Read(s, real)
+ END;
+ END ReadReal;
+
+ PROCEDURE ReadLongReal*(s: Streams.Stream; VAR longreal: LONGREAL) : BOOLEAN;
+ VAR
+ disc: Discipline;
+ BEGIN
+ IF Seek(s, discID, disc) THEN
+ RETURN disc.if.readLongReal(s, longreal)
+ ELSE
+ RETURN Streams.Read(s, longreal)
+ END;
+ END ReadLongReal;
+
+ PROCEDURE ReadSet*(s: Streams.Stream; VAR set: SET) : BOOLEAN;
+ VAR
+ disc: Discipline;
+ ret : BOOLEAN;
+ BEGIN
+ IF Seek(s, discID, disc) THEN
+ RETURN disc.if.readSet(s, set)
+ ELSE
+ ret := Streams.Read(s, set);
+ IF Types.byteorder = Types.littleEndian THEN
+ BitSwap (set);
+ END;
+ RETURN ret;
+ END;
+ END ReadSet;
+
+ PROCEDURE ReadString*(s: Streams.Stream; VAR string: ARRAY OF CHAR) : BOOLEAN;
+ VAR
+ disc: Discipline;
+ ch: CHAR; index: LONGINT;
+ BEGIN
+ IF Seek(s, discID, disc) THEN
+ RETURN disc.if.readString(s, string)
+ ELSE
+ index := 0;
+ WHILE Streams.ReadByte(s, ch) & (ch # 0X) DO
+ IF index + 1 < LEN(string) THEN
+ string[index] := ch; INC(index);
+ END;
+ END;
+ string[index] := 0X;
+ RETURN ~s.error
+ END;
+ END ReadString;
+
+ PROCEDURE ReadConstStringD*(s: Streams.Stream;
+ domain: ConstStrings.Domain;
+ VAR string: ConstStrings.String) : BOOLEAN;
+ CONST
+ bufsize = 512;
+ VAR
+ length: LONGINT;
+ buf: Streams.Stream;
+ ch: CHAR;
+ disc: Discipline;
+ stringbuf: ARRAY bufsize OF CHAR;
+ BEGIN
+ IF Seek(s, discID, disc) THEN
+ RETURN disc.if.readConstString(s, domain, string)
+ ELSE
+ IF ReadLongInt(s, length) THEN
+ IF length >= bufsize THEN
+ ConstStrings.Init(buf);
+ IF ~Streams.Copy(s, buf, length) THEN
+ RETURN FALSE
+ END;
+ ConstStrings.CloseD(buf, domain, string);
+ RETURN length = s.count;
+ ELSE
+ IF ~Streams.ReadPart(s, stringbuf, 0, length) THEN
+ RETURN FALSE
+ END;
+ stringbuf[length] := 0X;
+ ConstStrings.CreateD(string, domain, stringbuf);
+ RETURN TRUE
+ END;
ELSE
- Disciplines.Remove(s, discID);
+ RETURN FALSE
END;
- Forwarders.Update(s, Forward);
- END AttachInterface;
+ END;
+ END ReadConstStringD;
- PROCEDURE GetInterface(s: Streams.Stream; VAR if: Interface);
- VAR
- disc: Discipline;
- BEGIN
- IF Disciplines.Seek(s, discID, SYS.VAL(Disciplines.Discipline, disc)) THEN
- if := disc.if;
+ PROCEDURE ReadConstString*(s: Streams.Stream;
+ VAR string: ConstStrings.String) : BOOLEAN;
+ BEGIN
+ RETURN ReadConstStringD(s, ConstStrings.std, string)
+ END ReadConstString;
+
+ PROCEDURE WriteByte*(s: Streams.Stream; byte: Byte) : BOOLEAN;
+ VAR
+ disc: Discipline;
+ BEGIN
+ IF Seek(s, discID, disc) THEN
+ RETURN disc.if.writeByte(s, byte)
+ ELSE
+ RETURN Streams.WriteByte(s, byte)
+ END;
+ END WriteByte;
+
+ PROCEDURE WriteChar*(s: Streams.Stream; char: CHAR) : BOOLEAN;
+ VAR
+ disc: Discipline;
+ BEGIN
+ IF Seek(s, discID, disc) THEN
+ RETURN disc.if.writeChar(s, char)
+ ELSE
+ RETURN Streams.WriteByte(s, char)
+ END;
+ END WriteChar;
+
+ PROCEDURE WriteBoolean*(s: Streams.Stream; boolean: BOOLEAN) : BOOLEAN;
+ VAR
+ disc: Discipline;
+ BEGIN
+ IF Seek(s, discID, disc) THEN
+ RETURN disc.if.writeBoolean(s, boolean)
+ ELSE
+ RETURN Streams.Write(s, boolean)
+ END;
+ END WriteBoolean;
+
+ PROCEDURE WriteShortInt*(s: Streams.Stream; shortint: SHORTINT) : BOOLEAN;
+ VAR
+ disc: Discipline;
+ BEGIN
+ IF Seek(s, discID, disc) THEN
+ RETURN disc.if.writeShortInt(s, shortint)
+ ELSE
+ RETURN Streams.WriteByte(s, shortint)
+ END;
+ END WriteShortInt;
+
+ PROCEDURE WriteInteger*(s: Streams.Stream; integer: INTEGER) : BOOLEAN;
+ VAR
+ disc: Discipline;
+ BEGIN
+ IF Seek(s, discID, disc) THEN
+ RETURN disc.if.writeInteger(s, integer)
+ ELSE
+ IF Types.byteorder = Types.littleEndian THEN
+ Swap (integer);
+ END;
+ RETURN Streams.Write(s, integer);
+ END;
+ END WriteInteger;
+
+ PROCEDURE WriteLongInt*(s: Streams.Stream; longint: LONGINT) : BOOLEAN;
+ VAR
+ disc: Discipline;
+ BEGIN
+ IF Seek(s, discID, disc) THEN
+ RETURN disc.if.writeLongInt(s, longint)
+ ELSE
+ IF Types.byteorder = Types.littleEndian THEN
+ Swap (longint);
+ END;
+ RETURN Streams.Write(s, longint);
+ END;
+ END WriteLongInt;
+
+ PROCEDURE WriteReal*(s: Streams.Stream; real: REAL) : BOOLEAN;
+ VAR
+ disc: Discipline;
+ BEGIN
+ IF Seek(s, discID, disc) THEN
+ RETURN disc.if.writeReal(s, real)
+ ELSE
+ RETURN Streams.Write(s, real)
+ END;
+ END WriteReal;
+
+ PROCEDURE WriteLongReal*(s: Streams.Stream; longreal: LONGREAL) : BOOLEAN;
+ VAR
+ disc: Discipline;
+ BEGIN
+ IF Seek(s, discID, disc) THEN
+ RETURN disc.if.writeLongReal(s, longreal)
+ ELSE
+ RETURN Streams.Write(s, longreal)
+ END;
+ END WriteLongReal;
+
+ PROCEDURE WriteSet*(s: Streams.Stream; set: SET) : BOOLEAN;
+ VAR
+ disc: Discipline;
+ BEGIN
+ IF Seek(s, discID, disc) THEN
+ RETURN disc.if.writeSet(s, set)
+ ELSE
+ IF Types.byteorder = Types.littleEndian THEN
+ BitSwap (set);
+ END;
+ RETURN Streams.Write(s, set)
+ END;
+ END WriteSet;
+
+ PROCEDURE WriteString*(s: Streams.Stream; string: ARRAY OF CHAR) : BOOLEAN;
+ VAR
+ disc: Discipline;
+ BEGIN
+ IF Seek(s, discID, disc) THEN
+ RETURN disc.if.writeString(s, string)
+ ELSE
+ RETURN Streams.WritePart(s, string, 0, Strings.Len(string)) &
+ Streams.WriteByte(s, 0X)
+ END;
+ END WriteString;
+
+ PROCEDURE WriteConstString*(s: Streams.Stream;
+ string: ConstStrings.String) : BOOLEAN;
+ VAR
+ ch: CHAR;
+ buf: Streams.Stream;
+ disc: Discipline;
+ BEGIN
+ IF Seek(s, discID, disc) THEN
+ RETURN disc.if.writeConstString(s, string)
+ ELSE
+ IF WriteLongInt(s, string.len) THEN
+ ConstStrings.Open(buf, string);
+ RETURN Streams.Copy(buf, s, string.len)
ELSE
- if := NIL;
+ RETURN FALSE
END;
- END GetInterface;
-
- PROCEDURE CopyInterface*(from, to: Streams.Stream);
- VAR
- if: Interface;
- BEGIN
- GetInterface(from, if);
- AttachInterface(to, if);
- END CopyInterface;
-
- PROCEDURE Forward(from, to: Forwarders.Object);
- BEGIN
- (* this check is necessary because of Forwarders.Update *)
- IF ~(from IS Streams.Stream) OR ~(to IS Streams.Stream) THEN
- RETURN
- END;
-
- WITH from: Streams.Stream DO WITH to: Streams.Stream DO
- (* be careful here, from & to must be reversed *)
- CopyInterface(to, from);
- END; END;
- END Forward;
-
- PROCEDURE ReadByte*(s: Streams.Stream; VAR byte: Byte) : BOOLEAN;
- VAR
- disc: Discipline;
- BEGIN
- IF Disciplines.Seek(s, discID, SYS.VAL(Disciplines.Discipline, disc)) THEN
- RETURN disc.if.readByte(s, byte)
- ELSE
- RETURN Streams.ReadByte(s, byte)
- END;
- END ReadByte;
-
- PROCEDURE ReadChar*(s: Streams.Stream; VAR char: CHAR) : BOOLEAN;
- VAR
- disc: Discipline;
- BEGIN
- IF Disciplines.Seek(s, discID, SYS.VAL(Disciplines.Discipline, disc)) THEN
- RETURN disc.if.readChar(s, char)
- ELSE
- RETURN Streams.ReadByte(s, char)
- END;
- END ReadChar;
-
- PROCEDURE ReadBoolean*(s: Streams.Stream; VAR boolean: BOOLEAN) : BOOLEAN;
- VAR
- disc: Discipline;
- BEGIN
- IF Disciplines.Seek(s, discID, SYS.VAL(Disciplines.Discipline, disc)) THEN
- RETURN disc.if.readBoolean(s, boolean)
- ELSE
- RETURN Streams.Read(s, boolean)
- END;
- END ReadBoolean;
-
- PROCEDURE ReadShortInt*(s: Streams.Stream; VAR shortint: SHORTINT) : BOOLEAN;
- VAR
- disc: Discipline;
- BEGIN
- IF Disciplines.Seek(s, discID, SYS.VAL(Disciplines.Discipline, disc)) THEN
- RETURN disc.if.readShortInt(s, shortint)
- ELSE
- RETURN Streams.ReadByte(s, shortint)
- END;
- END ReadShortInt;
-
- PROCEDURE ReadInteger*(s: Streams.Stream; VAR integer: INTEGER) : BOOLEAN;
- VAR
- disc: Discipline;
- ret : BOOLEAN;
- BEGIN
- IF Disciplines.Seek(s, discID, SYS.VAL(Disciplines.Discipline, disc)) THEN
- RETURN disc.if.readInteger(s, integer)
- ELSE
- ret := Streams.Read(s, integer);
- IF Types.byteorder = Types.littleEndian THEN
- Swap (integer);
- END;
- RETURN ret;
- END;
- END ReadInteger;
-
- PROCEDURE ReadLongInt*(s: Streams.Stream; VAR longint: LONGINT) : BOOLEAN;
- VAR
- disc: Discipline;
- ret : BOOLEAN;
- BEGIN
- IF Disciplines.Seek(s, discID, SYS.VAL(Disciplines.Discipline, disc)) THEN
- RETURN disc.if.readLongInt(s, longint)
- ELSE
- ret := Streams.Read(s, longint);
- IF Types.byteorder = Types.littleEndian THEN
- Swap (longint);
- END;
- RETURN ret;
- END;
- END ReadLongInt;
-
- PROCEDURE ReadReal*(s: Streams.Stream; VAR real: REAL) : BOOLEAN;
- VAR
- disc: Discipline;
- BEGIN
- IF Disciplines.Seek(s, discID, SYS.VAL(Disciplines.Discipline, disc)) THEN
- RETURN disc.if.readReal(s, real)
- ELSE
- RETURN Streams.Read(s, real)
- END;
- END ReadReal;
-
- PROCEDURE ReadLongReal*(s: Streams.Stream; VAR longreal: LONGREAL) : BOOLEAN;
- VAR
- disc: Discipline;
- BEGIN
- IF Disciplines.Seek(s, discID, SYS.VAL(Disciplines.Discipline, disc)) THEN
- RETURN disc.if.readLongReal(s, longreal)
- ELSE
- RETURN Streams.Read(s, longreal)
- END;
- END ReadLongReal;
-
- PROCEDURE ReadSet*(s: Streams.Stream; VAR set: SET) : BOOLEAN;
- VAR
- disc: Discipline;
- ret : BOOLEAN;
- BEGIN
- IF Disciplines.Seek(s, discID, SYS.VAL(Disciplines.Discipline, disc)) THEN
- RETURN disc.if.readSet(s, set)
- ELSE
- ret := Streams.Read(s, set);
- IF Types.byteorder = Types.littleEndian THEN
- BitSwap (set);
- END;
- RETURN ret;
- END;
- END ReadSet;
-
- PROCEDURE ReadString*(s: Streams.Stream; VAR string: ARRAY OF CHAR) : BOOLEAN;
- VAR
- disc: Discipline;
- ch: CHAR; index: LONGINT;
- BEGIN
- IF Disciplines.Seek(s, discID, SYS.VAL(Disciplines.Discipline, disc)) THEN
- RETURN disc.if.readString(s, string)
- ELSE
- index := 0;
- WHILE Streams.ReadByte(s, ch) & (ch # 0X) DO
- IF index + 1 < LEN(string) THEN
- string[index] := ch; INC(index);
- END;
- END;
- string[index] := 0X;
- RETURN ~s.error
- END;
- END ReadString;
-
- PROCEDURE ReadConstStringD*(s: Streams.Stream;
- domain: ConstStrings.Domain;
- VAR string: ConstStrings.String) : BOOLEAN;
- CONST
- bufsize = 512;
- VAR
- length: LONGINT;
- buf: Streams.Stream;
- ch: CHAR;
- disc: Discipline;
- stringbuf: ARRAY bufsize OF CHAR;
- BEGIN
- IF Disciplines.Seek(s, discID, SYS.VAL(Disciplines.Discipline, disc)) THEN
- RETURN disc.if.readConstString(s, domain, string)
- ELSE
- IF ReadLongInt(s, length) THEN
- IF length >= bufsize THEN
- ConstStrings.Init(buf);
- IF ~Streams.Copy(s, buf, length) THEN
- RETURN FALSE
- END;
- ConstStrings.CloseD(buf, domain, string);
- RETURN length = s.count;
- ELSE
- IF ~Streams.ReadPart(s, stringbuf, 0, length) THEN
- RETURN FALSE
- END;
- stringbuf[length] := 0X;
- ConstStrings.CreateD(string, domain, stringbuf);
- RETURN TRUE
- END;
- ELSE
- RETURN FALSE
- END;
- END;
- END ReadConstStringD;
-
- PROCEDURE ReadConstString*(s: Streams.Stream;
- VAR string: ConstStrings.String) : BOOLEAN;
- BEGIN
- RETURN ReadConstStringD(s, ConstStrings.std, string)
- END ReadConstString;
-
- PROCEDURE WriteByte*(s: Streams.Stream; byte: Byte) : BOOLEAN;
- VAR
- disc: Discipline;
- BEGIN
- IF Disciplines.Seek(s, discID, SYS.VAL(Disciplines.Discipline, disc)) THEN
- RETURN disc.if.writeByte(s, byte)
- ELSE
- RETURN Streams.WriteByte(s, byte)
- END;
- END WriteByte;
-
- PROCEDURE WriteChar*(s: Streams.Stream; char: CHAR) : BOOLEAN;
- VAR
- disc: Discipline;
- BEGIN
- IF Disciplines.Seek(s, discID, SYS.VAL(Disciplines.Discipline, disc)) THEN
- RETURN disc.if.writeChar(s, char)
- ELSE
- RETURN Streams.WriteByte(s, char)
- END;
- END WriteChar;
-
- PROCEDURE WriteBoolean*(s: Streams.Stream; boolean: BOOLEAN) : BOOLEAN;
- VAR
- disc: Discipline;
- BEGIN
- IF Disciplines.Seek(s, discID, SYS.VAL(Disciplines.Discipline, disc)) THEN
- RETURN disc.if.writeBoolean(s, boolean)
- ELSE
- RETURN Streams.Write(s, boolean)
- END;
- END WriteBoolean;
-
- PROCEDURE WriteShortInt*(s: Streams.Stream; shortint: SHORTINT) : BOOLEAN;
- VAR
- disc: Discipline;
- BEGIN
- IF Disciplines.Seek(s, discID, SYS.VAL(Disciplines.Discipline, disc)) THEN
- RETURN disc.if.writeShortInt(s, shortint)
- ELSE
- RETURN Streams.WriteByte(s, shortint)
- END;
- END WriteShortInt;
-
- PROCEDURE WriteInteger*(s: Streams.Stream; integer: INTEGER) : BOOLEAN;
- VAR
- disc: Discipline;
- BEGIN
- IF Disciplines.Seek(s, discID, SYS.VAL(Disciplines.Discipline, disc)) THEN
- RETURN disc.if.writeInteger(s, integer)
- ELSE
- IF Types.byteorder = Types.littleEndian THEN
- Swap (integer);
- END;
- RETURN Streams.Write(s, integer);
- END;
- END WriteInteger;
-
- PROCEDURE WriteLongInt*(s: Streams.Stream; longint: LONGINT) : BOOLEAN;
- VAR
- disc: Discipline;
- BEGIN
- IF Disciplines.Seek(s, discID, SYS.VAL(Disciplines.Discipline, disc)) THEN
- RETURN disc.if.writeLongInt(s, longint)
- ELSE
- IF Types.byteorder = Types.littleEndian THEN
- Swap (longint);
- END;
- RETURN Streams.Write(s, longint);
- END;
- END WriteLongInt;
-
- PROCEDURE WriteReal*(s: Streams.Stream; real: REAL) : BOOLEAN;
- VAR
- disc: Discipline;
- BEGIN
- IF Disciplines.Seek(s, discID, SYS.VAL(Disciplines.Discipline, disc)) THEN
- RETURN disc.if.writeReal(s, real)
- ELSE
- RETURN Streams.Write(s, real)
- END;
- END WriteReal;
-
- PROCEDURE WriteLongReal*(s: Streams.Stream; longreal: LONGREAL) : BOOLEAN;
- VAR
- disc: Discipline;
- BEGIN
- IF Disciplines.Seek(s, discID, SYS.VAL(Disciplines.Discipline, disc)) THEN
- RETURN disc.if.writeLongReal(s, longreal)
- ELSE
- RETURN Streams.Write(s, longreal)
- END;
- END WriteLongReal;
-
- PROCEDURE WriteSet*(s: Streams.Stream; set: SET) : BOOLEAN;
- VAR
- disc: Discipline;
- BEGIN
- IF Disciplines.Seek(s, discID, SYS.VAL(Disciplines.Discipline, disc)) THEN
- RETURN disc.if.writeSet(s, set)
- ELSE
- IF Types.byteorder = Types.littleEndian THEN
- BitSwap (set);
- END;
- RETURN Streams.Write(s, set)
- END;
- END WriteSet;
-
- PROCEDURE WriteString*(s: Streams.Stream; string: ARRAY OF CHAR) : BOOLEAN;
- VAR
- disc: Discipline;
- BEGIN
- IF Disciplines.Seek(s, discID, SYS.VAL(Disciplines.Discipline, disc)) THEN
- RETURN disc.if.writeString(s, string)
- ELSE
- RETURN Streams.WritePart(s, string, 0, Strings.Len(string)) &
- Streams.WriteByte(s, 0X)
- END;
- END WriteString;
-
- PROCEDURE WriteConstString*(s: Streams.Stream;
- string: ConstStrings.String) : BOOLEAN;
- VAR
- ch: CHAR;
- buf: Streams.Stream;
- disc: Discipline;
- BEGIN
- IF Disciplines.Seek(s, discID, SYS.VAL(Disciplines.Discipline, disc)) THEN
- RETURN disc.if.writeConstString(s, string)
- ELSE
- IF WriteLongInt(s, string.len) THEN
- ConstStrings.Open(buf, string);
- RETURN Streams.Copy(buf, s, string.len)
- ELSE
- RETURN FALSE
- END;
- END;
- END WriteConstString;
+ END;
+ END WriteConstString;
BEGIN
- discID := Disciplines.Unique();
- Forwarders.Register("Streams.Stream", Forward);
+ discID := Disciplines.Unique();
+ Forwarders.Register("Streams.Stream", Forward);
END ulmNetIO.
diff --git a/src/library/ulm/ulmOperations.Mod b/src/library/ulm/ulmOperations.Mod
index 4f74cc61..617b9808 100644
--- a/src/library/ulm/ulmOperations.Mod
+++ b/src/library/ulm/ulmOperations.Mod
@@ -1,234 +1,234 @@
(* Ulm's Oberon Library
- Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
- ----------------------------------------------------------------------------
- Ulm's Oberon Library is free software; you can redistribute it
- and/or modify it under the terms of the GNU Library General Public
- License as published by the Free Software Foundation; either version
- 2 of the License, or (at your option) any later version.
+ Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
+ ----------------------------------------------------------------------------
+ Ulm's Oberon Library is free software; you can redistribute it
+ and/or modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either version
+ 2 of the License, or (at your option) any later version.
- Ulm's Oberon Library is distributed in the hope that it will be
- useful, but WITHOUT ANY WARRANTY; without even the implied warranty
- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Library General Public License for more details.
+ Ulm's Oberon Library is distributed in the hope that it will be
+ useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+ of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
- You should have received a copy of the GNU Library General Public
- License along with this library; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ----------------------------------------------------------------------------
- E-mail contact: oberon@mathematik.uni-ulm.de
- ----------------------------------------------------------------------------
- $Id: Operations.om,v 1.4 2004/09/16 18:31:54 borchert Exp $
- ----------------------------------------------------------------------------
- $Log: Operations.om,v $
- Revision 1.4 2004/09/16 18:31:54 borchert
- optimization for Assign added in case of a non-NIL target
- and identical types for target and source
+ You should have received a copy of the GNU Library General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ----------------------------------------------------------------------------
+ E-mail contact: oberon@mathematik.uni-ulm.de
+ ----------------------------------------------------------------------------
+ $Id: Operations.om,v 1.4 2004/09/16 18:31:54 borchert Exp $
+ ----------------------------------------------------------------------------
+ $Log: Operations.om,v $
+ Revision 1.4 2004/09/16 18:31:54 borchert
+ optimization for Assign added in case of a non-NIL target
+ and identical types for target and source
- Revision 1.3 1997/02/05 16:27:45 borchert
- Init asserts now that Services.Init hat been called previously
- for ``op''
+ Revision 1.3 1997/02/05 16:27:45 borchert
+ Init asserts now that Services.Init hat been called previously
+ for ``op''
- Revision 1.2 1995/01/16 21:39:50 borchert
- - assertions of Assertions have been converted into real assertions
- - some fixes due to changes of PersistentObjects
+ Revision 1.2 1995/01/16 21:39:50 borchert
+ - assertions of Assertions have been converted into real assertions
+ - some fixes due to changes of PersistentObjects
- Revision 1.1 1994/02/22 20:09:03 borchert
- Initial revision
+ Revision 1.1 1994/02/22 20:09:03 borchert
+ Initial revision
- ----------------------------------------------------------------------------
- AFB 12/91
- ----------------------------------------------------------------------------
+ ----------------------------------------------------------------------------
+ AFB 12/91
+ ----------------------------------------------------------------------------
*)
MODULE ulmOperations;
- (* generic support of arithmetic operations *)
+ (* generic support of arithmetic operations *)
- IMPORT Events := ulmEvents, Objects := ulmObjects, PersistentDisciplines := ulmPersistentDisciplines, PersistentObjects := ulmPersistentObjects, Services := ulmServices;
+ IMPORT Events := ulmEvents, Objects := ulmObjects, PersistentDisciplines := ulmPersistentDisciplines, PersistentObjects := ulmPersistentObjects, Services := ulmServices;
- CONST
- add* = 0; sub* = 1; mul* = 2; div* = 3; cmp* = 4;
- TYPE
- Operation* = SHORTINT; (* add..cmp *)
- Operand* = POINTER TO OperandRec;
+ CONST
+ add* = 0; sub* = 1; mul* = 2; div* = 3; cmp* = 4;
+ TYPE
+ Operation* = SHORTINT; (* add..cmp *)
+ Operand* = POINTER TO OperandRec;
- TYPE
- CapabilitySet* = SET; (* SET OF [add..cmp] *)
- CreateProc* = PROCEDURE (VAR op: Operand);
- (* should call Operations.Init for op *)
- OperatorProc* = PROCEDURE (op: Operation; op1, op2: Operand;
- VAR result: Operand);
- AssignProc* = PROCEDURE (VAR target: Operand; source: Operand);
- CompareProc* = PROCEDURE (op1, op2: Operand) : INTEGER;
- Interface* = POINTER TO InterfaceRec;
- InterfaceRec* =
- RECORD
- (Objects.ObjectRec)
- create*: CreateProc;
- assign*: AssignProc;
- op*: OperatorProc;
- compare*: CompareProc;
- END;
-
- TYPE
- OperandRec* =
- RECORD
- (PersistentDisciplines.ObjectRec)
- if: Interface;
- caps: CapabilitySet;
- END;
- VAR
- operandType: Services.Type;
-
- PROCEDURE Init*(op: Operand; if: Interface; caps: CapabilitySet);
- VAR
- type: Services.Type;
- BEGIN
- Services.GetType(op, type); ASSERT(type # NIL);
- op.if := if; op.caps := caps;
- END Init;
-
- PROCEDURE Capabilities*(op: Operand) : CapabilitySet;
- BEGIN
- RETURN op.caps
- END Capabilities;
-
- PROCEDURE Compatible*(op1, op2: Operand) : BOOLEAN;
- (* return TRUE if both operands have the same interface *)
- BEGIN
- RETURN op1.if = op2.if
- END Compatible;
-
- (* the interface of the first operand must match the interface
- of all other operands;
- the result parameter must be either NIL or already initialized
- with the same interface
- *)
-
- PROCEDURE Op(op: Operation; op1, op2: Operand; VAR result: Operand);
-
- VAR
- tmpresult: Operand;
- BEGIN
- ASSERT(op1.if = op2.if);
- ASSERT(op IN op1.caps);
- (* we are very defensive here because the type of tmpresult
- is perhaps not identical to result or an extension of it;
- op1.if.create(result) will not work in all cases
- because of type guard failures
- *)
- op1.if.create(tmpresult);
- op1.if.op(op, op1, op2, tmpresult);
- result := tmpresult;
- END Op;
-
- PROCEDURE Add*(op1, op2: Operand) : Operand;
- VAR result: Operand;
- BEGIN
- result := NIL;
- Op(add, op1, op2, result);
- RETURN result
- END Add;
-
- PROCEDURE Add2*(VAR op1: Operand; op2: Operand);
- BEGIN
- Op(add, op1, op2, op1);
- END Add2;
-
- PROCEDURE Add3*(VAR result: Operand; op1, op2: Operand);
- BEGIN
- Op(add, op1, op2, result);
- END Add3;
-
- PROCEDURE Sub*(op1, op2: Operand) : Operand;
- VAR result: Operand;
- BEGIN
- result := NIL;
- Op(sub, op1, op2, result);
- RETURN result
- END Sub;
-
- PROCEDURE Sub2*(VAR op1: Operand; op2: Operand);
- BEGIN
- Op(sub, op1, op2, op1);
- END Sub2;
-
- PROCEDURE Sub3*(VAR result: Operand; op1, op2: Operand);
- BEGIN
- Op(sub, op1, op2, result);
- END Sub3;
-
- PROCEDURE Mul*(op1, op2: Operand) : Operand;
- VAR result: Operand;
- BEGIN
- result := NIL;
- Op(mul, op1, op2, result);
- RETURN result
- END Mul;
-
- PROCEDURE Mul2*(VAR op1: Operand; op2: Operand);
- BEGIN
- Op(mul, op1, op2, op1);
- END Mul2;
-
- PROCEDURE Mul3*(VAR result: Operand; op1, op2: Operand);
- BEGIN
- Op(mul, op1, op2, result);
- END Mul3;
-
- PROCEDURE Div*(op1, op2: Operand) : Operand;
- VAR result: Operand;
- BEGIN
- result := NIL;
- Op(div, op1, op2, result);
- RETURN result
- END Div;
-
- PROCEDURE Div2*(VAR op1: Operand; op2: Operand);
- BEGIN
- Op(div, op1, op2, op1);
- END Div2;
-
- PROCEDURE Div3*(VAR result: Operand; op1, op2: Operand);
- BEGIN
- Op(div, op1, op2, result);
- END Div3;
-
- PROCEDURE Compare*(op1, op2: Operand) : INTEGER;
- BEGIN
- ASSERT(op1.if = op2.if);
- ASSERT(cmp IN op1.caps);
- RETURN op1.if.compare(op1, op2)
- END Compare;
-
- PROCEDURE Assign*(VAR target: Operand; source: Operand);
- VAR
- tmpTarget: Operand;
- typesIdentical: BOOLEAN;
- targetType, sourceType: Services.Type;
- BEGIN
- IF (target # NIL) & (target.if = source.if) THEN
- Services.GetType(target, targetType);
- Services.GetType(source, sourceType);
- typesIdentical := targetType = sourceType;
- ELSE
- typesIdentical := FALSE;
+ TYPE
+ CapabilitySet* = SET; (* SET OF [add..cmp] *)
+ CreateProc* = PROCEDURE (VAR op: Operand);
+ (* should call Operations.Init for op *)
+ OperatorProc* = PROCEDURE (op: Operation; op1, op2: Operand;
+ VAR result: Operand);
+ AssignProc* = PROCEDURE (VAR target: Operand; source: Operand);
+ CompareProc* = PROCEDURE (op1, op2: Operand) : INTEGER;
+ Interface* = POINTER TO InterfaceRec;
+ InterfaceRec* =
+ RECORD
+ (Objects.ObjectRec)
+ create*: CreateProc;
+ assign*: AssignProc;
+ op*: OperatorProc;
+ compare*: CompareProc;
END;
- IF typesIdentical THEN
- source.if.assign(target, source);
- ELSE
- source.if.create(tmpTarget);
- source.if.assign(tmpTarget, source);
- target := tmpTarget;
- END;
- END Assign;
- PROCEDURE Copy*(source, target: Operand);
- BEGIN
+ TYPE
+ OperandRec* =
+ RECORD
+ (PersistentDisciplines.ObjectRec)
+ if: Interface;
+ caps: CapabilitySet;
+ END;
+ VAR
+ operandType: Services.Type;
+
+ PROCEDURE Init*(op: Operand; if: Interface; caps: CapabilitySet);
+ VAR
+ type: Services.Type;
+ BEGIN
+ Services.GetType(op, type); ASSERT(type # NIL);
+ op.if := if; op.caps := caps;
+ END Init;
+
+ PROCEDURE Capabilities*(op: Operand) : CapabilitySet;
+ BEGIN
+ RETURN op.caps
+ END Capabilities;
+
+ PROCEDURE Compatible*(op1, op2: Operand) : BOOLEAN;
+ (* return TRUE if both operands have the same interface *)
+ BEGIN
+ RETURN op1.if = op2.if
+ END Compatible;
+
+ (* the interface of the first operand must match the interface
+ of all other operands;
+ the result parameter must be either NIL or already initialized
+ with the same interface
+ *)
+
+ PROCEDURE Op(op: Operation; op1, op2: Operand; VAR result: Operand);
+
+ VAR
+ tmpresult: Operand;
+ BEGIN
+ ASSERT(op1.if = op2.if);
+ ASSERT(op IN op1.caps);
+ (* we are very defensive here because the type of tmpresult
+ is perhaps not identical to result or an extension of it;
+ op1.if.create(result) will not work in all cases
+ because of type guard failures
+ *)
+ op1.if.create(tmpresult);
+ op1.if.op(op, op1, op2, tmpresult);
+ result := tmpresult;
+ END Op;
+
+ PROCEDURE Add*(op1, op2: Operand) : Operand;
+ VAR result: Operand;
+ BEGIN
+ result := NIL;
+ Op(add, op1, op2, result);
+ RETURN result
+ END Add;
+
+ PROCEDURE Add2*(VAR op1: Operand; op2: Operand);
+ BEGIN
+ Op(add, op1, op2, op1);
+ END Add2;
+
+ PROCEDURE Add3*(VAR result: Operand; op1, op2: Operand);
+ BEGIN
+ Op(add, op1, op2, result);
+ END Add3;
+
+ PROCEDURE Sub*(op1, op2: Operand) : Operand;
+ VAR result: Operand;
+ BEGIN
+ result := NIL;
+ Op(sub, op1, op2, result);
+ RETURN result
+ END Sub;
+
+ PROCEDURE Sub2*(VAR op1: Operand; op2: Operand);
+ BEGIN
+ Op(sub, op1, op2, op1);
+ END Sub2;
+
+ PROCEDURE Sub3*(VAR result: Operand; op1, op2: Operand);
+ BEGIN
+ Op(sub, op1, op2, result);
+ END Sub3;
+
+ PROCEDURE Mul*(op1, op2: Operand) : Operand;
+ VAR result: Operand;
+ BEGIN
+ result := NIL;
+ Op(mul, op1, op2, result);
+ RETURN result
+ END Mul;
+
+ PROCEDURE Mul2*(VAR op1: Operand; op2: Operand);
+ BEGIN
+ Op(mul, op1, op2, op1);
+ END Mul2;
+
+ PROCEDURE Mul3*(VAR result: Operand; op1, op2: Operand);
+ BEGIN
+ Op(mul, op1, op2, result);
+ END Mul3;
+
+ PROCEDURE Div*(op1, op2: Operand) : Operand;
+ VAR result: Operand;
+ BEGIN
+ result := NIL;
+ Op(div, op1, op2, result);
+ RETURN result
+ END Div;
+
+ PROCEDURE Div2*(VAR op1: Operand; op2: Operand);
+ BEGIN
+ Op(div, op1, op2, op1);
+ END Div2;
+
+ PROCEDURE Div3*(VAR result: Operand; op1, op2: Operand);
+ BEGIN
+ Op(div, op1, op2, result);
+ END Div3;
+
+ PROCEDURE Compare*(op1, op2: Operand) : INTEGER;
+ BEGIN
+ ASSERT(op1.if = op2.if);
+ ASSERT(cmp IN op1.caps);
+ RETURN op1.if.compare(op1, op2)
+ END Compare;
+
+ PROCEDURE Assign*(VAR target: Operand; source: Operand);
+ VAR
+ tmpTarget: Operand;
+ typesIdentical: BOOLEAN;
+ targetType, sourceType: Services.Type;
+ BEGIN
+ IF (target # NIL) & (target.if = source.if) THEN
+ Services.GetType(target, targetType);
+ Services.GetType(source, sourceType);
+ typesIdentical := targetType = sourceType;
+ ELSE
+ typesIdentical := FALSE;
+ END;
+ IF typesIdentical THEN
source.if.assign(target, source);
- END Copy;
+ ELSE
+ source.if.create(tmpTarget);
+ source.if.assign(tmpTarget, source);
+ target := tmpTarget;
+ END;
+ END Assign;
+
+ PROCEDURE Copy*(source, target: Operand);
+ BEGIN
+ source.if.assign(target, source);
+ END Copy;
BEGIN
- PersistentObjects.RegisterType(operandType,
- "Operations.Operand", "PersistentDisciplines.Object", NIL);
+ PersistentObjects.RegisterType(operandType,
+ "Operations.Operand", "PersistentDisciplines.Object", NIL);
END ulmOperations.
diff --git a/src/library/ulm/ulmPersistentDisciplines.Mod b/src/library/ulm/ulmPersistentDisciplines.Mod
index 8f37d4ce..538b8de6 100644
--- a/src/library/ulm/ulmPersistentDisciplines.Mod
+++ b/src/library/ulm/ulmPersistentDisciplines.Mod
@@ -1,391 +1,392 @@
(* Ulm's Oberon Library
- Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
- ----------------------------------------------------------------------------
- Ulm's Oberon Library is free software; you can redistribute it
- and/or modify it under the terms of the GNU Library General Public
- License as published by the Free Software Foundation; either version
- 2 of the License, or (at your option) any later version.
+ Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
+ ----------------------------------------------------------------------------
+ Ulm's Oberon Library is free software; you can redistribute it
+ and/or modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either version
+ 2 of the License, or (at your option) any later version.
- Ulm's Oberon Library is distributed in the hope that it will be
- useful, but WITHOUT ANY WARRANTY; without even the implied warranty
- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Library General Public License for more details.
+ Ulm's Oberon Library is distributed in the hope that it will be
+ useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+ of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
- You should have received a copy of the GNU Library General Public
- License along with this library; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ----------------------------------------------------------------------------
- E-mail contact: oberon@mathematik.uni-ulm.de
- ----------------------------------------------------------------------------
- $Id: PersistentD.om,v 1.4 1998/02/22 10:25:22 borchert Exp $
- ----------------------------------------------------------------------------
- $Log: PersistentD.om,v $
- Revision 1.4 1998/02/22 10:25:22 borchert
- bug fix in GetObject: Disciplines.Add was missing if the main object
- is just an extension of Disciplines.Object and not of
- PersistentDisciplines.Object
+ You should have received a copy of the GNU Library General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ----------------------------------------------------------------------------
+ E-mail contact: oberon@mathematik.uni-ulm.de
+ ----------------------------------------------------------------------------
+ $Id: PersistentD.om,v 1.4 1998/02/22 10:25:22 borchert Exp $
+ ----------------------------------------------------------------------------
+ $Log: PersistentD.om,v $
+ Revision 1.4 1998/02/22 10:25:22 borchert
+ bug fix in GetObject: Disciplines.Add was missing if the main object
+ is just an extension of Disciplines.Object and not of
+ PersistentDisciplines.Object
- Revision 1.3 1996/07/24 07:41:28 borchert
- bug fix: count component was not initialized (with the
- exception of CreateObject) -- detected by Martin Hasch
+ Revision 1.3 1996/07/24 07:41:28 borchert
+ bug fix: count component was not initialized (with the
+ exception of CreateObject) -- detected by Martin Hasch
- Revision 1.2 1995/03/17 16:13:33 borchert
- - persistent disciplines may now be attached to non-persistent objects
- - some fixes due to changes of PersistentObjects
+ Revision 1.2 1995/03/17 16:13:33 borchert
+ - persistent disciplines may now be attached to non-persistent objects
+ - some fixes due to changes of PersistentObjects
- Revision 1.1 1994/02/22 20:09:12 borchert
- Initial revision
+ Revision 1.1 1994/02/22 20:09:12 borchert
+ Initial revision
- ----------------------------------------------------------------------------
+ ----------------------------------------------------------------------------
*)
MODULE ulmPersistentDisciplines;
- IMPORT Disciplines := ulmDisciplines, Forwarders := ulmForwarders, NetIO := ulmNetIO, Objects := ulmObjects, PersistentObjects := ulmPersistentObjects,
- Services := ulmServices, Streams := ulmStreams, SYS := SYSTEM;
+ IMPORT Disciplines := ulmDisciplines, Forwarders := ulmForwarders, NetIO := ulmNetIO, Objects := ulmObjects, PersistentObjects := ulmPersistentObjects,
+ Services := ulmServices, Streams := ulmStreams;
- CONST
- objectName = "PersistentDisciplines.Object";
- disciplineName = "PersistentDisciplines.Discipline";
+ CONST
+ objectName = "PersistentDisciplines.Object";
+ disciplineName = "PersistentDisciplines.Discipline";
- TYPE
- Identifier* = LONGINT;
+ TYPE
+ Identifier* = LONGINT;
- Discipline* = POINTER TO DisciplineRec;
- DisciplineRec* =
- RECORD
- (PersistentObjects.ObjectRec)
- id*: Identifier; (* should be unique for all types of disciplines *)
- END;
+ Discipline* = POINTER TO DisciplineRec;
+ DisciplineRec* =
+ RECORD
+ (PersistentObjects.ObjectRec)
+ id*: Identifier; (* should be unique for all types of disciplines *)
+ END;
- DisciplineList = POINTER TO DisciplineListRec;
- DisciplineListRec =
- RECORD
- discipline: Discipline;
- id: Identifier; (* copied from discipline.id *)
- next: DisciplineList;
- END;
+ DisciplineList = POINTER TO DisciplineListRec;
+ DisciplineListRec =
+ RECORD
+ discipline: Discipline;
+ id: Identifier; (* copied from discipline.id *)
+ next: DisciplineList;
+ END;
- Interface = POINTER TO InterfaceRec;
- Object = POINTER TO ObjectRec;
- ObjectRec* =
- RECORD
- (PersistentObjects.ObjectRec)
- (* private part *)
- count: LONGINT; (* number of attached disciplines *)
- list: DisciplineList; (* set of disciplines *)
- if: Interface; (* overrides builtins if # NIL *)
- forwardTo: Object;
- usedBy: Object; (* used as target of UseInterfaceOf *)
- (* very restrictive way of avoiding reference cycles:
- forwardTo references must be built from inner to
- outer objects and not vice versa
- *)
- END;
+ Interface = POINTER TO InterfaceRec;
+ Object = POINTER TO ObjectRec;
+ ObjectRec* =
+ RECORD
+ (PersistentObjects.ObjectRec)
+ (* private part *)
+ count: LONGINT; (* number of attached disciplines *)
+ list: DisciplineList; (* set of disciplines *)
+ if: Interface; (* overrides builtins if # NIL *)
+ forwardTo: Object;
+ usedBy: Object; (* used as target of UseInterfaceOf *)
+ (* very restrictive way of avoiding reference cycles:
+ forwardTo references must be built from inner to
+ outer objects and not vice versa
+ *)
+ END;
- TYPE
- VolatileDiscipline = POINTER TO VolatileDisciplineRec;
- VolatileDisciplineRec =
- RECORD
- (Disciplines.DisciplineRec)
- object: Object;
- END;
- VAR
- volDiscID: Disciplines.Identifier;
+ TYPE
+ VolatileDiscipline = POINTER TO VolatileDisciplineRec;
+ VolatileDisciplineRec =
+ RECORD
+ (Disciplines.DisciplineRec)
+ object: Object;
+ END;
+ VAR
+ volDiscID: Disciplines.Identifier;
- TYPE
- AddProc* = PROCEDURE (object: Disciplines.Object; discipline: Discipline);
- RemoveProc* = PROCEDURE (object: Disciplines.Object; id: Identifier);
- SeekProc* = PROCEDURE (object: Disciplines.Object; id: Identifier;
- VAR discipline: Discipline) : BOOLEAN;
- InterfaceRec* =
- RECORD
- (Objects.ObjectRec)
- add*: AddProc;
- remove*: RemoveProc;
- seek*: SeekProc;
- END;
+ TYPE
+ AddProc* = PROCEDURE (object: Disciplines.Object; discipline: Discipline);
+ RemoveProc* = PROCEDURE (object: Disciplines.Object; id: Identifier);
+ SeekProc* = PROCEDURE (object: Disciplines.Object; id: Identifier;
+ VAR discipline: Discipline) : BOOLEAN;
+ InterfaceRec* =
+ RECORD
+ (Objects.ObjectRec)
+ add*: AddProc;
+ remove*: RemoveProc;
+ seek*: SeekProc;
+ END;
- VAR
- unique: Identifier;
- objIf: PersistentObjects.Interface;
- objDatatype, discDatatype: Services.Type;
+ VAR
+ unique: Identifier;
+ objIf: PersistentObjects.Interface;
+ objDatatype, discDatatype: Services.Type;
- CONST
- hashtabsize = 32;
- TYPE
- Sample = POINTER TO SampleRec;
- SampleRec =
- RECORD
- id: Identifier;
- sample: Discipline;
- next: Sample;
- END;
- BucketTable = ARRAY hashtabsize OF Sample;
- VAR
- samples: BucketTable;
+ CONST
+ hashtabsize = 32;
+ TYPE
+ Sample = POINTER TO SampleRec;
+ SampleRec =
+ RECORD
+ id: Identifier;
+ sample: Discipline;
+ next: Sample;
+ END;
+ BucketTable = ARRAY hashtabsize OF Sample;
+ VAR
+ samples: BucketTable;
- PROCEDURE CreateObject*(VAR object: Object);
- (* creates a new object; this procedures should be called instead of
- NEW for objects of type `Object'
+ PROCEDURE CreateObject*(VAR object: Object);
+ (* creates a new object; this procedures should be called instead of
+ NEW for objects of type `Object'
+ *)
+ BEGIN
+ NEW(object);
+ object.count := 0; (* up to now, there are no attached disciplines *)
+ object.list := NIL;
+ object.if := NIL;
+ PersistentObjects.Init(object, objDatatype);
+ END CreateObject;
+
+ PROCEDURE GetObject(obj: Disciplines.Object; VAR object: Object);
+ VAR
+ disc: Disciplines.Discipline;
+ vdisc: VolatileDiscipline;
+ BEGIN
+ IF obj IS Object THEN
+ object := obj(Object);
+ (* initialize private components now if not done already;
+ we assume here that pointers which have not been
+ initialized yet are defined to be NIL
+ (because of the garbage collection);
+ a similar assumption does not necessarily hold for
+ other types (e.g. integers)
*)
- BEGIN
- NEW(object);
- object.count := 0; (* up to now, there are no attached disciplines *)
- object.list := NIL;
- object.if := NIL;
- PersistentObjects.Init(object, objDatatype);
- END CreateObject;
+ IF object.list = NIL THEN
+ object.count := 0;
+ END;
+ ELSIF Disciplines.Seek(obj, volDiscID, disc) THEN
+ object := disc(VolatileDiscipline).object;
+ ELSE
+ CreateObject(object);
+ NEW(vdisc); vdisc.id := volDiscID; vdisc.object := object;
+ Disciplines.Add(obj, vdisc);
+ END;
+ END GetObject;
- PROCEDURE GetObject(obj: Disciplines.Object; VAR object: Object);
- VAR
- disc: VolatileDiscipline;
- BEGIN
- IF obj IS Object THEN
- object := obj(Object);
- (* initialize private components now if not done already;
- we assume here that pointers which have not been
- initialized yet are defined to be NIL
- (because of the garbage collection);
- a similar assumption does not necessarily hold for
- other types (e.g. integers)
- *)
- IF object.list = NIL THEN
- object.count := 0;
- END;
- ELSIF Disciplines.Seek(obj, volDiscID, SYS.VAL(Disciplines.Discipline, disc)) THEN
- object := disc.object;
+ (* === normal stuff for disciplines ===================================== *)
+
+ PROCEDURE Unique*(sample: Discipline) : Identifier;
+ (* returns a unique identifier;
+ this procedure should be called during initialization by
+ all modules defining a discipline type;
+ a sample of the associated discipline has to be provided
+ *)
+ VAR
+ hashval: Identifier;
+ entry: Sample;
+ BEGIN
+ INC(unique);
+ NEW(entry); entry.id := unique; entry.sample := sample;
+ hashval := unique MOD hashtabsize;
+ entry.next := samples[hashval]; samples[hashval] := entry;
+ RETURN unique
+ END Unique;
+
+ PROCEDURE GetSample*(id: Identifier) : Discipline;
+ (* return sample for the given identifier;
+ NIL will be returned if id has not yet been returned by Unique
+ *)
+ VAR
+ hashval: Identifier;
+ ptr: Sample;
+ BEGIN
+ hashval := id MOD hashtabsize;
+ ptr := samples[hashval];
+ WHILE (ptr # NIL) & (ptr.id # id) DO
+ ptr := ptr.next;
+ END;
+ IF ptr # NIL THEN
+ RETURN ptr.sample
+ ELSE
+ RETURN NIL
+ END;
+ END GetSample;
+
+ PROCEDURE AttachInterface*(object: Disciplines.Object; if: Interface);
+ (* override the builtin implementations of Add, Remove and
+ Seek for `object' with the implementations given by `if'
+ *)
+ VAR
+ po: Object;
+ BEGIN
+ GetObject(object, po);
+ IF (po.list = NIL) & (po.forwardTo = NIL) THEN
+ po.if := if;
+ END;
+ END AttachInterface;
+
+ PROCEDURE UseInterfaceOf*(object, host: Disciplines.Object);
+ (* forward Add, Remove and Seek operations from object to host *)
+ VAR
+ po, phost: Object;
+ BEGIN
+ GetObject(object, po); GetObject(host, phost);
+ IF (po.list = NIL) & (po.forwardTo = NIL) &
+ (po.usedBy = NIL) THEN
+ po.forwardTo := phost;
+ phost.usedBy := po; (* avoid reference cycles *)
+ END;
+ END UseInterfaceOf;
+
+ PROCEDURE Forward(from, to: Forwarders.Object);
+ BEGIN
+ UseInterfaceOf(from, to);
+ END Forward;
+
+ PROCEDURE Remove*(object: Disciplines.Object; id: Identifier);
+ (* remove the discipline with the given id from object, if it exists *)
+ VAR
+ po: Object;
+ prev, dl: DisciplineList;
+ BEGIN
+ GetObject(object, po);
+ WHILE po.forwardTo # NIL DO
+ po := po.forwardTo;
+ END;
+ IF po.if = NIL THEN
+ prev := NIL;
+ dl := po.list;
+ WHILE (dl # NIL) & (dl.id # id) DO
+ prev := dl; dl := dl.next;
+ END;
+ IF dl # NIL THEN
+ IF prev = NIL THEN
+ po.list := dl.next;
+ ELSE
+ prev.next := dl.next;
+ END;
+ DEC(po.count); (* discipline removed *)
+ END;
+ ELSE
+ po.if.remove(po, id);
+ END;
+ END Remove;
+
+ PROCEDURE Add*(object: Disciplines.Object; discipline: Discipline);
+ (* adds a new discipline to the given object;
+ if already a discipline with the same identifier exist
+ it is deleted first
+ *)
+ VAR
+ po: Object;
+ dl: DisciplineList;
+ BEGIN
+ GetObject(object, po);
+ WHILE po.forwardTo # NIL DO
+ po := po.forwardTo;
+ END;
+ IF po.if = NIL THEN
+ dl := po.list;
+ WHILE (dl # NIL) & (dl.id # discipline.id) DO
+ dl := dl.next;
+ END;
+ IF dl = NIL THEN
+ NEW(dl);
+ dl.id := discipline.id;
+ dl.next := po.list;
+ po.list := dl;
+ INC(po.count); (* discipline added *)
+ END;
+ dl.discipline := discipline;
+ ELSE
+ po.if.add(po, discipline);
+ END;
+ END Add;
+
+ PROCEDURE Seek*(object: Disciplines.Object; id: Identifier;
+ VAR discipline: Discipline) : BOOLEAN;
+ (* returns TRUE if a discipline with the given id is found *)
+ VAR
+ po: Object;
+ dl: DisciplineList;
+ BEGIN
+ GetObject(object, po);
+ WHILE po.forwardTo # NIL DO
+ po := po.forwardTo;
+ END;
+ IF po.if = NIL THEN
+ dl := po.list;
+ WHILE (dl # NIL) & (dl.id # id) DO
+ dl := dl.next;
+ END;
+ IF dl # NIL THEN
+ discipline := dl.discipline;
ELSE
- CreateObject(object);
- NEW(disc); disc.id := volDiscID; disc.object := object;
- Disciplines.Add(obj, disc);
+ discipline := NIL;
END;
- END GetObject;
+ RETURN discipline # NIL
+ ELSE
+ RETURN po.if.seek(po, id, discipline)
+ END;
+ END Seek;
- (* === normal stuff for disciplines ===================================== *)
+ (* === interface procedures for PersistentObjects for Object === *)
- PROCEDURE Unique*(sample: Discipline) : Identifier;
- (* returns a unique identifier;
- this procedure should be called during initialization by
- all modules defining a discipline type;
- a sample of the associated discipline has to be provided
- *)
- VAR
- hashval: Identifier;
- entry: Sample;
- BEGIN
- INC(unique);
- NEW(entry); entry.id := unique; entry.sample := sample;
- hashval := unique MOD hashtabsize;
- entry.next := samples[hashval]; samples[hashval] := entry;
- RETURN unique
- END Unique;
+ PROCEDURE ReadObjectData(stream: Streams.Stream;
+ object: PersistentObjects.Object) : BOOLEAN;
+ (* read data and attached disciplines of given object from stream *)
+ VAR
+ discipline: PersistentObjects.Object; (* Discipline *)
+ count: LONGINT;
+ BEGIN
+ (* get number of attached disciplines *)
+ IF ~NetIO.ReadLongInt(stream, count) THEN
+ RETURN FALSE;
+ END;
+ (* read all disciplines from `stream' and attach them to `object' *)
+ WHILE count > 0 DO
+ IF ~PersistentObjects.Read(stream, discipline) THEN
+ RETURN FALSE;
+ END;
+ Add(object(Object), discipline(Discipline));
+ DEC(count);
+ END;
+ RETURN TRUE;
+ END ReadObjectData;
- PROCEDURE GetSample*(id: Identifier) : Discipline;
- (* return sample for the given identifier;
- NIL will be returned if id has not yet been returned by Unique
- *)
- VAR
- hashval: Identifier;
- ptr: Sample;
- BEGIN
- hashval := id MOD hashtabsize;
- ptr := samples[hashval];
- WHILE (ptr # NIL) & (ptr.id # id) DO
- ptr := ptr.next;
+ PROCEDURE WriteObjectData(stream: Streams.Stream;
+ object: PersistentObjects.Object) : BOOLEAN;
+ (* write data and attached disciplines of given object to stream *)
+ VAR
+ dl: DisciplineList;
+ BEGIN
+ WITH object: Object DO
+ (* write number of attached disciplines to `stream' *)
+ IF ~NetIO.WriteLongInt(stream, object.count) THEN
+ RETURN FALSE;
END;
- IF ptr # NIL THEN
- RETURN ptr.sample
- ELSE
- RETURN NIL
+ (* write all attached disciplines to the stream *)
+ dl := object.list;
+ WHILE dl # NIL DO
+ IF ~PersistentObjects.Write(stream, dl.discipline) THEN
+ RETURN FALSE;
+ END;
+ dl := dl.next;
END;
- END GetSample;
+ END;
+ RETURN TRUE;
+ END WriteObjectData;
- PROCEDURE AttachInterface*(object: Disciplines.Object; if: Interface);
- (* override the builtin implementations of Add, Remove and
- Seek for `object' with the implementations given by `if'
- *)
- VAR
- po: Object;
- BEGIN
- GetObject(object, po);
- IF (po.list = NIL) & (po.forwardTo = NIL) THEN
- po.if := if;
- END;
- END AttachInterface;
-
- PROCEDURE UseInterfaceOf*(object, host: Disciplines.Object);
- (* forward Add, Remove and Seek operations from object to host *)
- VAR
- po, phost: Object;
- BEGIN
- GetObject(object, po); GetObject(host, phost);
- IF (po.list = NIL) & (po.forwardTo = NIL) &
- (po.usedBy = NIL) THEN
- po.forwardTo := phost;
- phost.usedBy := po; (* avoid reference cycles *)
- END;
- END UseInterfaceOf;
-
- PROCEDURE Forward(from, to: Forwarders.Object);
- BEGIN
- UseInterfaceOf(from, to);
- END Forward;
-
- PROCEDURE Remove*(object: Disciplines.Object; id: Identifier);
- (* remove the discipline with the given id from object, if it exists *)
- VAR
- po: Object;
- prev, dl: DisciplineList;
- BEGIN
- GetObject(object, po);
- WHILE po.forwardTo # NIL DO
- po := po.forwardTo;
- END;
- IF po.if = NIL THEN
- prev := NIL;
- dl := po.list;
- WHILE (dl # NIL) & (dl.id # id) DO
- prev := dl; dl := dl.next;
- END;
- IF dl # NIL THEN
- IF prev = NIL THEN
- po.list := dl.next;
- ELSE
- prev.next := dl.next;
- END;
- DEC(po.count); (* discipline removed *)
- END;
- ELSE
- po.if.remove(po, id);
- END;
- END Remove;
-
- PROCEDURE Add*(object: Disciplines.Object; discipline: Discipline);
- (* adds a new discipline to the given object;
- if already a discipline with the same identifier exist
- it is deleted first
- *)
- VAR
- po: Object;
- dl: DisciplineList;
- BEGIN
- GetObject(object, po);
- WHILE po.forwardTo # NIL DO
- po := po.forwardTo;
- END;
- IF po.if = NIL THEN
- dl := po.list;
- WHILE (dl # NIL) & (dl.id # discipline.id) DO
- dl := dl.next;
- END;
- IF dl = NIL THEN
- NEW(dl);
- dl.id := discipline.id;
- dl.next := po.list;
- po.list := dl;
- INC(po.count); (* discipline added *)
- END;
- dl.discipline := discipline;
- ELSE
- po.if.add(po, discipline);
- END;
- END Add;
-
- PROCEDURE Seek*(object: Disciplines.Object; id: Identifier;
- VAR discipline: Discipline) : BOOLEAN;
- (* returns TRUE if a discipline with the given id is found *)
- VAR
- po: Object;
- dl: DisciplineList;
- BEGIN
- GetObject(object, po);
- WHILE po.forwardTo # NIL DO
- po := po.forwardTo;
- END;
- IF po.if = NIL THEN
- dl := po.list;
- WHILE (dl # NIL) & (dl.id # id) DO
- dl := dl.next;
- END;
- IF dl # NIL THEN
- discipline := dl.discipline;
- ELSE
- discipline := NIL;
- END;
- RETURN discipline # NIL
- ELSE
- RETURN po.if.seek(po, id, discipline)
- END;
- END Seek;
-
- (* === interface procedures for PersistentObjects for Object === *)
-
- PROCEDURE ReadObjectData(stream: Streams.Stream;
- object: PersistentObjects.Object) : BOOLEAN;
- (* read data and attached disciplines of given object from stream *)
- VAR
- discipline: Discipline;
- count: LONGINT;
- BEGIN
- (* get number of attached disciplines *)
- IF ~NetIO.ReadLongInt(stream, count) THEN
- RETURN FALSE;
- END;
- (* read all disciplines from `stream' and attach them to `object' *)
- WHILE count > 0 DO
- IF ~PersistentObjects.Read(stream, SYS.VAL(PersistentObjects.Object, discipline)) THEN
- RETURN FALSE;
- END;
- Add(object(Object), discipline);
- DEC(count);
- END;
- RETURN TRUE;
- END ReadObjectData;
-
- PROCEDURE WriteObjectData(stream: Streams.Stream;
- object: PersistentObjects.Object) : BOOLEAN;
- (* write data and attached disciplines of given object to stream *)
- VAR
- dl: DisciplineList;
- BEGIN
- WITH object: Object DO
- (* write number of attached disciplines to `stream' *)
- IF ~NetIO.WriteLongInt(stream, object.count) THEN
- RETURN FALSE;
- END;
- (* write all attached disciplines to the stream *)
- dl := object.list;
- WHILE dl # NIL DO
- IF ~PersistentObjects.Write(stream, dl.discipline) THEN
- RETURN FALSE;
- END;
- dl := dl.next;
- END;
- END;
- RETURN TRUE;
- END WriteObjectData;
-
- PROCEDURE InternalCreate(VAR obj: PersistentObjects.Object);
- VAR
- myObject: Object;
- BEGIN
- CreateObject(myObject);
- obj := myObject;
- END InternalCreate;
+ PROCEDURE InternalCreate(VAR obj: PersistentObjects.Object);
+ VAR
+ myObject: Object;
+ BEGIN
+ CreateObject(myObject);
+ obj := myObject;
+ END InternalCreate;
BEGIN
- unique := 0;
+ unique := 0;
- NEW(objIf);
- objIf.read := ReadObjectData;
- objIf.write := WriteObjectData;
- objIf.create := InternalCreate;
- objIf.createAndRead := NIL;
- PersistentObjects.RegisterType(objDatatype, objectName, "", objIf);
- PersistentObjects.RegisterType(discDatatype, disciplineName, "", NIL);
+ NEW(objIf);
+ objIf.read := ReadObjectData;
+ objIf.write := WriteObjectData;
+ objIf.create := InternalCreate;
+ objIf.createAndRead := NIL;
+ PersistentObjects.RegisterType(objDatatype, objectName, "", objIf);
+ PersistentObjects.RegisterType(discDatatype, disciplineName, "", NIL);
- volDiscID := Disciplines.Unique();
+ volDiscID := Disciplines.Unique();
- Forwarders.Register("", Forward);
+ Forwarders.Register("", Forward);
END ulmPersistentDisciplines.
diff --git a/src/library/ulm/ulmPersistentObjects.Mod b/src/library/ulm/ulmPersistentObjects.Mod
index 3f82e089..c64b4fc0 100644
--- a/src/library/ulm/ulmPersistentObjects.Mod
+++ b/src/library/ulm/ulmPersistentObjects.Mod
@@ -1,1079 +1,1086 @@
(* Ulm's Oberon Library
- Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
- ----------------------------------------------------------------------------
- Ulm's Oberon Library is free software; you can redistribute it
- and/or modify it under the terms of the GNU Library General Public
- License as published by the Free Software Foundation; either version
- 2 of the License, or (at your option) any later version.
+ Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
+ ----------------------------------------------------------------------------
+ Ulm's Oberon Library is free software; you can redistribute it
+ and/or modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either version
+ 2 of the License, or (at your option) any later version.
- Ulm's Oberon Library is distributed in the hope that it will be
- useful, but WITHOUT ANY WARRANTY; without even the implied warranty
- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Library General Public License for more details.
+ Ulm's Oberon Library is distributed in the hope that it will be
+ useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+ of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
- You should have received a copy of the GNU Library General Public
- License along with this library; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ----------------------------------------------------------------------------
- E-mail contact: oberon@mathematik.uni-ulm.de
- ----------------------------------------------------------------------------
- $Id: PersistentO.om,v 1.8 2004/03/30 13:14:16 borchert Exp $
- ----------------------------------------------------------------------------
- $Log: PersistentO.om,v $
- Revision 1.8 2004/03/30 13:14:16 borchert
- introduced more elaborate error events for cannotReadData
+ You should have received a copy of the GNU Library General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ----------------------------------------------------------------------------
+ E-mail contact: oberon@mathematik.uni-ulm.de
+ ----------------------------------------------------------------------------
+ $Id: PersistentO.om,v 1.8 2004/03/30 13:14:16 borchert Exp $
+ ----------------------------------------------------------------------------
+ $Log: PersistentO.om,v $
+ Revision 1.8 2004/03/30 13:14:16 borchert
+ introduced more elaborate error events for cannotReadData
- Revision 1.7 1998/04/09 16:55:48 borchert
- bug fix: ReadTypeInfo failed on hierarchical mode if none of the
- types were known by returning TRUE with type set to NIL
+ Revision 1.7 1998/04/09 16:55:48 borchert
+ bug fix: ReadTypeInfo failed on hierarchical mode if none of the
+ types were known by returning TRUE with type set to NIL
- Revision 1.6 1998/03/24 22:42:28 borchert
- improvements:
- - it is now acceptable that read and write if procedures are given
- but neither create nor createAndRead -- this is fine for
- abstractions that maintain some components
- - Read operates now immediately on the given object to support
- LinearizedStructures -- otherwise it would be nearly impossible
- to reconstruct self-referential data structures;
- note that this is *not supported* by GuardedRead
+ Revision 1.6 1998/03/24 22:42:28 borchert
+ improvements:
+ - it is now acceptable that read and write if procedures are given
+ but neither create nor createAndRead -- this is fine for
+ abstractions that maintain some components
+ - Read operates now immediately on the given object to support
+ LinearizedStructures -- otherwise it would be nearly impossible
+ to reconstruct self-referential data structures;
+ note that this is *not supported* by GuardedRead
- Revision 1.5 1995/04/04 12:36:39 borchert
- major redesign of PersistentObjects:
- - new type encoding schemes
- - size if proc removed
- - support for NIL and guards added
+ Revision 1.5 1995/04/04 12:36:39 borchert
+ major redesign of PersistentObjects:
+ - new type encoding schemes
+ - size if proc removed
+ - support for NIL and guards added
- Revision 1.4 1994/07/18 14:19:13 borchert
- bug fix: SizeOf used uninitialized variable (name) and added the
- length of all type names of the hierarchy to the sum
+ Revision 1.4 1994/07/18 14:19:13 borchert
+ bug fix: SizeOf used uninitialized variable (name) and added the
+ length of all type names of the hierarchy to the sum
- Revision 1.3 1994/07/05 08:47:26 borchert
- bug fix: modifications due to last bug fix didn't work correctly in
- in all cases
- code cleaned up at several locations
+ Revision 1.3 1994/07/05 08:47:26 borchert
+ bug fix: modifications due to last bug fix didn't work correctly in
+ in all cases
+ code cleaned up at several locations
- Revision 1.2 1994/03/25 15:54:09 borchert
- bug fix: the complete type hierarchy together with all abstract types
- was written -- this caused a NIL-procedure to be called in
- case of projections. Now, we write shorter type hierarchies and
- GetCreate checks the create-procedure against NIL
+ Revision 1.2 1994/03/25 15:54:09 borchert
+ bug fix: the complete type hierarchy together with all abstract types
+ was written -- this caused a NIL-procedure to be called in
+ case of projections. Now, we write shorter type hierarchies and
+ GetCreate checks the create-procedure against NIL
- Revision 1.1 1994/02/22 20:09:21 borchert
- Initial revision
+ Revision 1.1 1994/02/22 20:09:21 borchert
+ Initial revision
- ----------------------------------------------------------------------------
- DB 7/93
- ----------------------------------------------------------------------------
+ ----------------------------------------------------------------------------
+ DB 7/93
+ ----------------------------------------------------------------------------
*)
MODULE ulmPersistentObjects;
- (* handling of persistent objects *)
+ (* handling of persistent objects *)
- IMPORT ASCII := ulmASCII, ConstStrings := ulmConstStrings, Disciplines := ulmDisciplines, Errors := ulmErrors, Events := ulmEvents, Forwarders := ulmForwarders,
- IndirectDisciplines := ulmIndirectDisciplines, Loader := ulmLoader, NetIO := ulmNetIO, Objects := ulmObjects, Priorities := ulmPriorities,
- RelatedEvents := ulmRelatedEvents, Services := ulmServices, StreamDisciplines := ulmStreamDisciplines, Streams := ulmStreams, Strings := ulmStrings, Texts := ulmTexts, SYS := SYSTEM;
+ IMPORT ASCII := ulmASCII, ConstStrings := ulmConstStrings, Disciplines := ulmDisciplines, Errors := ulmErrors, Events := ulmEvents, Forwarders := ulmForwarders,
+ IndirectDisciplines := ulmIndirectDisciplines, Loader := ulmLoader, NetIO := ulmNetIO, Objects := ulmObjects, Priorities := ulmPriorities,
+ RelatedEvents := ulmRelatedEvents, Services := ulmServices, StreamDisciplines := ulmStreamDisciplines, Streams := ulmStreams, Strings := ulmStrings, Texts := ulmTexts, SYS := SYSTEM;
- CONST
- maxNameLen = 128; (* max length of data type names *)
- TYPE
- TypeName = ARRAY maxNameLen OF CHAR; (* for temporary use only *)
- ShortTypeName = ARRAY 32 OF CHAR; (* for error messages only *)
+ CONST
+ maxNameLen = 128; (* max length of data type names *)
+ TYPE
+ TypeName = ARRAY maxNameLen OF CHAR; (* for temporary use only *)
+ ShortTypeName = ARRAY 32 OF CHAR; (* for error messages only *)
- CONST
- cannotReadData* = 0;
- cannotWriteData* = 1;
- cannotReadType* = 2;
- cannotWriteType* = 3;
- invalidType* = 4;
- unknownType* = 5;
- otherTypeHier* = 6;
- eofReached* = 7;
- cannotSkip* = 8;
- typeGuardFailure* = 9; (* GuardedRead failed to type guard failure *)
- errorcodes* = 10; (* number of error codes *)
+ CONST
+ cannotReadData* = 0;
+ cannotWriteData* = 1;
+ cannotReadType* = 2;
+ cannotWriteType* = 3;
+ invalidType* = 4;
+ unknownType* = 5;
+ otherTypeHier* = 6;
+ eofReached* = 7;
+ cannotSkip* = 8;
+ typeGuardFailure* = 9; (* GuardedRead failed to type guard failure *)
+ errorcodes* = 10; (* number of error codes *)
- (* how are types specified: fullTypeName, typeCode, incrTypeCode
- with or without size info: withSize, withoutSize
- with or without type hier: withHier, withoutHier
+ (* how are types specified: fullTypeName, typeCode, incrTypeCode
+ with or without size info: withSize, withoutSize
+ with or without type hier: withHier, withoutHier
- combinations are given as additions,
- e.g. typeCode + withSize + withHier
- *)
- fullTypeName* = 1; typeCode* = 2; incrTypeCode* = 3;
- withSize* = 4; withoutSize* = 0;
- withHier* = 8; withoutHier* = 0;
+ combinations are given as additions,
+ e.g. typeCode + withSize + withHier
+ *)
+ fullTypeName* = 1; typeCode* = 2; incrTypeCode* = 3;
+ withSize* = 4; withoutSize* = 0;
+ withHier* = 8; withoutHier* = 0;
- defaultMode = fullTypeName + withSize + withHier;
- (* provide all informations on default *)
+ defaultMode = fullTypeName + withSize + withHier;
+ (* provide all informations on default *)
- (* forms:
- type spec: codeF | incrF | nameF | incrhierF | hierF
- size spec: sizeF | noSizeF
- add specs, eg. codeF + sizeF
- *)
- codeF = 1; (* just a type code *)
- incrF = 2; (* type name + code given *)
- nameF = 3; (* type name given *)
- incrhierF = 4; (* type hierarchy with codes *)
- hierF = 5; (* type hierarchy without codes *)
- sizeF = 8; (* size information given *)
- noSizeF = 0; (* no size information given *)
- maskF = 8;
- maxF = 13; (* maximal valid form code *)
+ (* forms:
+ type spec: codeF | incrF | nameF | incrhierF | hierF
+ size spec: sizeF | noSizeF
+ add specs, eg. codeF + sizeF
+ *)
+ codeF = 1; (* just a type code *)
+ incrF = 2; (* type name + code given *)
+ nameF = 3; (* type name given *)
+ incrhierF = 4; (* type hierarchy with codes *)
+ hierF = 5; (* type hierarchy without codes *)
+ sizeF = 8; (* size information given *)
+ noSizeF = 0; (* no size information given *)
+ maskF = 8;
+ maxF = 13; (* maximal valid form code *)
- TYPE
- Mode* = SHORTINT;
- Form = SHORTINT;
+ TYPE
+ Mode* = SHORTINT;
+ Form = SHORTINT;
- Object* = POINTER TO ObjectRec;
- Type = POINTER TO TypeRec;
+ Object* = POINTER TO ObjectRec;
+ Type = POINTER TO TypeRec;
- ReadProc* = PROCEDURE (s: Streams.Stream; o: Object) : BOOLEAN;
- WriteProc* = PROCEDURE (s: Streams.Stream; o: Object) : BOOLEAN;
- CreateProc* = PROCEDURE (VAR o: Object);
- CreateAndReadProc* = PROCEDURE (s: Streams.Stream;
- create: BOOLEAN;
- VAR o: Object) : BOOLEAN;
+ ReadProc* = PROCEDURE (s: Streams.Stream; o: Object) : BOOLEAN;
+ WriteProc* = PROCEDURE (s: Streams.Stream; o: Object) : BOOLEAN;
+ CreateProc* = PROCEDURE (VAR o: Object);
+ CreateAndReadProc* = PROCEDURE (s: Streams.Stream;
+ create: BOOLEAN;
+ VAR o: Object) : BOOLEAN;
- Interface* = POINTER TO InterfaceRec;
- InterfaceRec* =
- RECORD
- (Objects.ObjectRec)
- create*: CreateProc; (* create object *)
- read*: ReadProc; (* read data from stream *)
- write*: WriteProc; (* write data to stream *)
- createAndRead*: CreateAndReadProc; (* replaces create & read *)
- END;
+ Interface* = POINTER TO InterfaceRec;
+ InterfaceRec* =
+ RECORD
+ (Objects.ObjectRec)
+ create*: CreateProc; (* create object *)
+ read*: ReadProc; (* read data from stream *)
+ write*: WriteProc; (* write data to stream *)
+ createAndRead*: CreateAndReadProc; (* replaces create & read *)
+ END;
- ObjectRec* =
- RECORD
- (Services.ObjectRec)
- (* private data *)
- type: Type;
- projected: BOOLEAN; (* set after Read *)
- END;
+ ObjectRec* =
+ RECORD
+ (Services.ObjectRec)
+ (* private data *)
+ type: Type;
+ projected: BOOLEAN; (* set after Read *)
+ END;
- CONST
- ttlen = 16;
- TYPE
- TypeEntry = POINTER TO TypeEntryRec;
- TypeEntryRec =
- RECORD
- code: LONGINT;
- type: Type;
- next: TypeEntry;
- END;
- TypeTable = ARRAY ttlen OF TypeEntry;
- StreamDiscipline = POINTER TO StreamDisciplineRec;
- StreamDisciplineRec =
- RECORD
- (Disciplines.DisciplineRec)
- mode: Mode; (* type encoding mode for the stream *)
- rtypes, wtypes: TypeTable;
- END;
+ CONST
+ ttlen = 16;
+ TYPE
+ TypeEntry = POINTER TO TypeEntryRec;
+ TypeEntryRec =
+ RECORD
+ code: LONGINT;
+ type: Type;
+ next: TypeEntry;
+ END;
+ TypeTable = ARRAY ttlen OF TypeEntry;
+ StreamDiscipline = POINTER TO StreamDisciplineRec;
+ StreamDisciplineRec =
+ RECORD
+ (Disciplines.DisciplineRec)
+ mode: Mode; (* type encoding mode for the stream *)
+ rtypes, wtypes: TypeTable;
+ END;
- InterfaceList = POINTER TO InterfaceListRec;
- InterfaceListRec =
- RECORD
- if: Interface;
- next: InterfaceList; (* points to next extension *)
- END;
- TypeRec =
- RECORD
- (Services.TypeRec)
- baseType: Type; (* the next non-abstract base type *)
- if: Interface; (* may be = NIL for abstract types *)
- ifs: InterfaceList; (* list of interfaces in reverse order *)
- code: LONGINT; (* unique number *)
- END;
+ InterfaceList = POINTER TO InterfaceListRec;
+ InterfaceListRec =
+ RECORD
+ if: Interface;
+ next: InterfaceList; (* points to next extension *)
+ END;
+ TypeRec =
+ RECORD
+ (Services.TypeRec)
+ baseType: Type; (* the next non-abstract base type *)
+ if: Interface; (* may be = NIL for abstract types *)
+ ifs: InterfaceList; (* list of interfaces in reverse order *)
+ code: LONGINT; (* unique number *)
+ END;
- (* this list is used for storing the base type list of an object during
- reading this object
- *)
- BaseTypeList = POINTER TO BaseTypeRec;
- BaseTypeRec =
- RECORD
- name: ConstStrings.String; (* name of the base type *)
- next: BaseTypeList;
- END;
+ (* this list is used for storing the base type list of an object during
+ reading this object
+ *)
+ BaseTypeList = POINTER TO BaseTypeRec;
+ BaseTypeRec =
+ RECORD
+ name: ConstStrings.String; (* name of the base type *)
+ next: BaseTypeList;
+ END;
- (* each error causes an event; the error number is stored in
- event.errorcode; the associated text can be taken from event.message
- *)
- ErrorCode = SHORTINT;
- Event = POINTER TO EventRec;
- EventRec* =
- RECORD
- (Events.EventRec)
- stream*: Streams.Stream;
- errorcode*: ErrorCode;
- END;
- UnknownTypeEvent = POINTER TO UnknownTypeEventRec;
- UnknownTypeEventRec =
- RECORD
- (EventRec)
- typeName: ARRAY 80 OF CHAR;
- END;
- DecodeFailureEvent = POINTER TO DecodeFailureEventRec;
- DecodeFailureEventRec =
- RECORD
- (EventRec)
- objectType: Services.Type;
- END;
- TypeGuardFailureEvent = POINTER TO TypeGuardFailureEventRec;
- TypeGuardFailureEventRec =
- RECORD
- (EventRec)
- found, expected: Services.Type;
- END;
+ (* each error causes an event; the error number is stored in
+ event.errorcode; the associated text can be taken from event.message
+ *)
+ ErrorCode = SHORTINT;
+ Event = POINTER TO EventRec;
+ EventRec* =
+ RECORD
+ (Events.EventRec)
+ stream*: Streams.Stream;
+ errorcode*: ErrorCode;
+ END;
+ UnknownTypeEvent = POINTER TO UnknownTypeEventRec;
+ UnknownTypeEventRec =
+ RECORD
+ (EventRec)
+ typeName: ARRAY 80 OF CHAR;
+ END;
+ DecodeFailureEvent = POINTER TO DecodeFailureEventRec;
+ DecodeFailureEventRec =
+ RECORD
+ (EventRec)
+ objectType: Services.Type;
+ END;
+ TypeGuardFailureEvent = POINTER TO TypeGuardFailureEventRec;
+ TypeGuardFailureEventRec =
+ RECORD
+ (EventRec)
+ found, expected: Services.Type;
+ END;
- VAR
- id: Disciplines.Identifier;
- nextTypeCode: LONGINT; (* for the generation of unique numbers *)
- potype: Services.Type;
+ VAR
+ id: Disciplines.Identifier;
+ nextTypeCode: LONGINT; (* for the generation of unique numbers *)
+ potype: Services.Type;
- errormsg*: ARRAY errorcodes OF Events.Message;
- (* readable text for error codes *)
- error*: Events.EventType;
- (* raised on failed stream operations; ignored by default *)
+ errormsg*: ARRAY errorcodes OF Events.Message;
+ (* readable text for error codes *)
+ error*: Events.EventType;
+ (* raised on failed stream operations; ignored by default *)
- (* ===== for internal use only ========================================== *)
+ (* ===== for internal use only ========================================== *)
- PROCEDURE Error(stream: Streams.Stream; code: ErrorCode);
- (* raise an error event with the error code `code' *)
+ PROCEDURE Error(stream: Streams.Stream; code: ErrorCode);
+ (* raise an error event with the error code `code' *)
+ VAR
+ event: Event;
+ BEGIN
+ stream.count := 0;
+ NEW(event);
+ event.type := error;
+ event.message := errormsg[code];
+ event.stream := stream;
+ event.errorcode := code;
+ RelatedEvents.Raise(stream, event);
+ END Error;
+
+ PROCEDURE UnknownType(stream: Streams.Stream; typeName: ARRAY OF CHAR);
+ VAR
+ event: UnknownTypeEvent;
+ BEGIN
+ stream.count := 0;
+ NEW(event);
+ event.type := error;
+ event.message := errormsg[unknownType];
+ event.stream := stream;
+ event.errorcode := unknownType;
+ COPY(typeName, event.typeName);
+ RelatedEvents.Raise(stream, event);
+ END UnknownType;
+
+ PROCEDURE TypeGuardFailure(stream: Streams.Stream;
+ found, expected: Services.Type);
+ VAR
+ event: TypeGuardFailureEvent;
+ BEGIN
+ stream.count := 0;
+ NEW(event);
+ event.type := error;
+ event.message := errormsg[typeGuardFailure];
+ event.stream := stream;
+ event.errorcode := typeGuardFailure;
+ event.found := found;
+ event.expected := expected;
+ RelatedEvents.Raise(stream, event);
+ END TypeGuardFailure;
+
+ PROCEDURE WriteEvent(s: Streams.Stream; event: Events.Event);
+
+ VAR
+ typename: ARRAY 128 OF CHAR;
+
+ PROCEDURE WriteString(s: Streams.Stream;
+ string: ARRAY OF CHAR) : BOOLEAN;
+ BEGIN
+ RETURN Streams.WritePart(s, string, 0, Strings.Len(string))
+ END WriteString;
+
+ PROCEDURE WriteLn(s: Streams.Stream) : BOOLEAN;
VAR
- event: Event;
- BEGIN
- stream.count := 0;
+ lineterm: StreamDisciplines.LineTerminator;
+ width: INTEGER;
+ BEGIN
+ StreamDisciplines.GetLineTerm(s, lineterm);
+ IF ~WriteString(s, lineterm) THEN RETURN FALSE END;
+ StreamDisciplines.GetIndentationWidth(s, width);
+ WHILE width > 0 DO
+ IF ~Streams.WriteByte(s, " ") THEN RETURN FALSE END;
+ DEC(width);
+ END;
+ RETURN TRUE
+ END WriteLn;
+
+ PROCEDURE WriteType(s: Streams.Stream;
+ type: Services.Type) : BOOLEAN;
+ VAR
+ name: TypeName;
+ BEGIN
+ Services.GetTypeName(type, name);
+ RETURN Streams.WriteByte(s, ASCII.quote) &
+ WriteString(s, name) &
+ Streams.WriteByte(s, ASCII.quote)
+ END WriteType;
+
+ BEGIN
+ IF event IS UnknownTypeEvent THEN
+ WITH event: UnknownTypeEvent DO
+ IF WriteString(s, event.message) &
+ WriteString(s, ": ") &
+ Streams.WriteByte(s, ASCII.quote) &
+ WriteString(s, event.typeName) &
+ Streams.WriteByte(s, ASCII.quote) THEN
+ END;
+ END;
+ ELSIF event IS TypeGuardFailureEvent THEN
+ WITH event: TypeGuardFailureEvent DO
+ IF WriteString(s, event.message) &
+ WriteString(s, ":") &
+ WriteLn(s) &
+ WriteString(s, "expected extension of ") &
+ WriteType(s, event.expected) &
+ WriteString(s, " but got ") &
+ WriteType(s, event.found) THEN
+ END;
+ END;
+ ELSIF event IS DecodeFailureEvent THEN
+ WITH event: DecodeFailureEvent DO
+ Services.GetTypeName(event.objectType, typename);
+ IF WriteString(s, event.message) &
+ WriteString(s, ":") &
+ WriteLn(s) &
+ WriteString(s, "unable to parse object of type ") &
+ Streams.WriteByte(s, ASCII.quote) &
+ WriteString(s, typename) &
+ Streams.WriteByte(s, ASCII.quote) THEN
+ END;
+ END;
+ ELSE
+ IF WriteString(s, event.message) THEN END;
+ END;
+ END WriteEvent;
+
+ PROCEDURE InitErrorHandling;
+ BEGIN
+ errormsg[cannotReadData] := "cannot read data part of persistent object";
+ errormsg[cannotWriteData] := "cannot write data part of persistent object";
+ errormsg[cannotReadType] := "cannot read type of persistent object";
+ errormsg[cannotWriteType] := "cannot write type of persistent object";
+ errormsg[invalidType] := "invalid type form read";
+ errormsg[unknownType] := "unknown type information found";
+ errormsg[otherTypeHier] := "different & nonconforming type hierarchy found";
+ errormsg[eofReached] := "unexpected EOF encountered during reading";
+ errormsg[cannotSkip] := "unable to skip unknown data parts";
+ errormsg[typeGuardFailure] := "read object is of unexpected type";
+
+ Events.Define(error);
+ Events.SetPriority(error, Priorities.liberrors);
+ Events.Ignore(error);
+ Errors.AssignWriteProcedure(error, WriteEvent);
+ END InitErrorHandling;
+
+ (* ==== marshalling procedures ======================================== *)
+
+ (* encoding scheme:
+
+ Object = Form Type Size ObjectInfo .
+ Form = SHORTINT;
+ Type = Code (* codeF *) |
+ Code TypeName (* incrF *) |
+ TypeName (* nameF *) |
+ Code TypeName { Code TypeName } 0 (* incrhierF *) |
+ TypeName { TypeName } 0X (* hierF *) .
+ Size = (* noSizeF *) |
+ Size (* sizeF *) . (* size of object info in bytes *)
+ ObjectInfo = { Byte } .
+ *)
+
+ PROCEDURE DecodeForm(form: Form;
+ VAR nameGiven, codeGiven, hier, size: BOOLEAN);
+ VAR
+ typeform: SHORTINT;
+ sizeform: SHORTINT;
+ BEGIN
+ typeform := form MOD maskF; sizeform := form DIV maskF;
+ nameGiven := typeform IN {incrF, nameF, hierF, incrhierF};
+ codeGiven := typeform IN {codeF, incrF, incrhierF};
+ hier := (typeform = incrhierF) OR (typeform = hierF);
+ size := (sizeform = sizeF);
+ END DecodeForm;
+
+ PROCEDURE GetModule(name: ARRAY OF CHAR; VAR module: ARRAY OF CHAR);
+ (* get the name of the module where 'name' was defined *)
+ VAR
+ index: INTEGER;
+ BEGIN
+ index := 0;
+ WHILE (name[index] # ".") & (name[index] # 0X) &
+ (index < LEN(module)-1) DO
+ module[index] := name[index]; INC(index);
+ END;
+ module[index] := 0X;
+ END GetModule;
+
+ PROCEDURE Failure(s: Streams.Stream; code: ErrorCode);
+ BEGIN
+ IF s.eof THEN
+ Error(s, eofReached);
+ ELSE
+ Error(s, code);
+ END;
+ END Failure;
+
+ PROCEDURE DecodeFailure(s: Streams.Stream; type: Services.Type);
+ VAR
+ event: DecodeFailureEvent;
+ BEGIN
+ IF s.eof THEN
+ Error(s, eofReached);
+ ELSE
NEW(event);
event.type := error;
- event.message := errormsg[code];
- event.stream := stream;
- event.errorcode := code;
- RelatedEvents.Raise(stream, event);
- END Error;
+ event.message := errormsg[cannotReadData];
+ event.stream := s;
+ event.errorcode := cannotReadData;
+ event.objectType := type;
+ RelatedEvents.Raise(s, event);
+ END;
+ END DecodeFailure;
- PROCEDURE UnknownType(stream: Streams.Stream; typeName: ARRAY OF CHAR);
+ PROCEDURE GetStreamDisc(s: Streams.Stream; VAR disc: StreamDiscipline);
+ VAR d: IndirectDisciplines.Discipline;
+ BEGIN
+ IF IndirectDisciplines.Seek(s, id, d) THEN
+ disc := d(StreamDiscipline)
+ ELSE
+ NEW(disc); disc.id := id; disc.mode := defaultMode;
+ IndirectDisciplines.Add(s, disc);
+ END;
+ END GetStreamDisc;
+
+ PROCEDURE ReadTypeInfo(s: Streams.Stream; VAR type: Type;
+ VAR projection: BOOLEAN;
+ VAR size: Streams.Count) : BOOLEAN;
+ VAR
+ form: Form;
+ btype: Type;
+ nameGiven, codeGiven, hier, sizeGiven: BOOLEAN;
+ disc: StreamDiscipline;
+ sentinelFound, unknownTypeFound: BOOLEAN;
+ lastType: Type;
+
+ PROCEDURE ReadType(s: Streams.Stream; VAR type: Type;
+ VAR sentinelFound, unknownTypeFound: BOOLEAN) : BOOLEAN;
VAR
- event: UnknownTypeEvent;
- BEGIN
- stream.count := 0;
- NEW(event);
- event.type := error;
- event.message := errormsg[unknownType];
- event.stream := stream;
- event.errorcode := unknownType;
- COPY(typeName, event.typeName);
- RelatedEvents.Raise(stream, event);
- END UnknownType;
+ code: LONGINT;
+ entry: TypeEntry;
+ typeName: TypeName;
+ btype: Type;
- PROCEDURE TypeGuardFailure(stream: Streams.Stream;
- found, expected: Services.Type);
- VAR
- event: TypeGuardFailureEvent;
- BEGIN
- stream.count := 0;
- NEW(event);
- event.type := error;
- event.message := errormsg[typeGuardFailure];
- event.stream := stream;
- event.errorcode := typeGuardFailure;
- event.found := found;
- event.expected := expected;
- RelatedEvents.Raise(stream, event);
- END TypeGuardFailure;
-
- PROCEDURE WriteEvent(s: Streams.Stream; event: Events.Event);
-
- VAR
- typename: ARRAY 128 OF CHAR;
-
- PROCEDURE WriteString(s: Streams.Stream;
- string: ARRAY OF CHAR) : BOOLEAN;
+ PROCEDURE SeekType(typeName: ARRAY OF CHAR;
+ VAR type: Type) : BOOLEAN;
+ VAR
+ t: Services.Type;
+ module: TypeName;
BEGIN
- RETURN Streams.WritePart(s, string, 0, Strings.Len(string))
- END WriteString;
+ Services.SeekType(typeName, t);
+ IF t = NIL THEN
+ GetModule(typeName, module);
+ IF Loader.Load(module, s) THEN
+ (* maybe the type is now registered *)
+ Services.SeekType(typeName, t);
+ END;
+ END;
+ IF (t # NIL) & (t IS Type) THEN
+ type := t(Type); RETURN TRUE
+ END;
+ RETURN FALSE
+ END SeekType;
- PROCEDURE WriteLn(s: Streams.Stream) : BOOLEAN;
- VAR
- lineterm: StreamDisciplines.LineTerminator;
- width: INTEGER;
- BEGIN
- StreamDisciplines.GetLineTerm(s, lineterm);
- IF ~WriteString(s, lineterm) THEN RETURN FALSE END;
- StreamDisciplines.GetIndentationWidth(s, width);
- WHILE width > 0 DO
- IF ~Streams.WriteByte(s, " ") THEN RETURN FALSE END;
- DEC(width);
- END;
- RETURN TRUE
- END WriteLn;
-
- PROCEDURE WriteType(s: Streams.Stream;
- type: Services.Type) : BOOLEAN;
- VAR
- name: TypeName;
- BEGIN
- Services.GetTypeName(type, name);
- RETURN Streams.WriteByte(s, ASCII.quote) &
- WriteString(s, name) &
- Streams.WriteByte(s, ASCII.quote)
- END WriteType;
-
- BEGIN
- IF event IS UnknownTypeEvent THEN
- WITH event: UnknownTypeEvent DO
- IF WriteString(s, event.message) &
- WriteString(s, ": ") &
- Streams.WriteByte(s, ASCII.quote) &
- WriteString(s, event.typeName) &
- Streams.WriteByte(s, ASCII.quote) THEN
- END;
- END;
- ELSIF event IS TypeGuardFailureEvent THEN
- WITH event: TypeGuardFailureEvent DO
- IF WriteString(s, event.message) &
- WriteString(s, ":") &
- WriteLn(s) &
- WriteString(s, "expected extension of ") &
- WriteType(s, event.expected) &
- WriteString(s, " but got ") &
- WriteType(s, event.found) THEN
- END;
- END;
- ELSIF event IS DecodeFailureEvent THEN
- WITH event: DecodeFailureEvent DO
- Services.GetTypeName(event.objectType, typename);
- IF WriteString(s, event.message) &
- WriteString(s, ":") &
- WriteLn(s) &
- WriteString(s, "unable to parse object of type ") &
- Streams.WriteByte(s, ASCII.quote) &
- WriteString(s, typename) &
- Streams.WriteByte(s, ASCII.quote) THEN
- END;
- END;
- ELSE
- IF WriteString(s, event.message) THEN END;
- END;
- END WriteEvent;
-
- PROCEDURE InitErrorHandling;
- BEGIN
- errormsg[cannotReadData] := "cannot read data part of persistent object";
- errormsg[cannotWriteData] := "cannot write data part of persistent object";
- errormsg[cannotReadType] := "cannot read type of persistent object";
- errormsg[cannotWriteType] := "cannot write type of persistent object";
- errormsg[invalidType] := "invalid type form read";
- errormsg[unknownType] := "unknown type information found";
- errormsg[otherTypeHier] := "different & nonconforming type hierarchy found";
- errormsg[eofReached] := "unexpected EOF encountered during reading";
- errormsg[cannotSkip] := "unable to skip unknown data parts";
- errormsg[typeGuardFailure] := "read object is of unexpected type";
-
- Events.Define(error);
- Events.SetPriority(error, Priorities.liberrors);
- Events.Ignore(error);
- Errors.AssignWriteProcedure(error, WriteEvent);
- END InitErrorHandling;
-
- (* ==== marshalling procedures ======================================== *)
-
- (* encoding scheme:
-
- Object = Form Type Size ObjectInfo .
- Form = SHORTINT;
- Type = Code (* codeF *) |
- Code TypeName (* incrF *) |
- TypeName (* nameF *) |
- Code TypeName { Code TypeName } 0 (* incrhierF *) |
- TypeName { TypeName } 0X (* hierF *) .
- Size = (* noSizeF *) |
- Size (* sizeF *) . (* size of object info in bytes *)
- ObjectInfo = { Byte } .
- *)
-
- PROCEDURE DecodeForm(form: Form;
- VAR nameGiven, codeGiven, hier, size: BOOLEAN);
- VAR
- typeform: SHORTINT;
- sizeform: SHORTINT;
- BEGIN
- typeform := form MOD maskF; sizeform := form DIV maskF;
- nameGiven := typeform IN {incrF, nameF, hierF, incrhierF};
- codeGiven := typeform IN {codeF, incrF, incrhierF};
- hier := (typeform = incrhierF) OR (typeform = hierF);
- size := (sizeform = sizeF);
- END DecodeForm;
-
- PROCEDURE GetModule(name: ARRAY OF CHAR; VAR module: ARRAY OF CHAR);
- (* get the name of the module where 'name' was defined *)
- VAR
- index: INTEGER;
- BEGIN
- index := 0;
- WHILE (name[index] # ".") & (name[index] # 0X) &
- (index < LEN(module)-1) DO
- module[index] := name[index]; INC(index);
- END;
- module[index] := 0X;
- END GetModule;
-
- PROCEDURE Failure(s: Streams.Stream; code: ErrorCode);
- BEGIN
- IF s.eof THEN
- Error(s, eofReached);
- ELSE
- Error(s, code);
- END;
- END Failure;
-
- PROCEDURE DecodeFailure(s: Streams.Stream; type: Services.Type);
- VAR
- event: DecodeFailureEvent;
- BEGIN
- IF s.eof THEN
- Error(s, eofReached);
- ELSE
- NEW(event);
- event.type := error;
- event.message := errormsg[cannotReadData];
- event.stream := s;
- event.errorcode := cannotReadData;
- event.objectType := type;
- RelatedEvents.Raise(s, event);
- END;
- END DecodeFailure;
-
- PROCEDURE GetStreamDisc(s: Streams.Stream; VAR disc: StreamDiscipline);
- BEGIN
- IF ~IndirectDisciplines.Seek(s, id, SYS.VAL(IndirectDisciplines.Discipline, disc)) THEN
- NEW(disc); disc.id := id; disc.mode := defaultMode;
- IndirectDisciplines.Add(s, disc);
- END;
- END GetStreamDisc;
-
- PROCEDURE ReadTypeInfo(s: Streams.Stream; VAR type: Type;
- VAR projection: BOOLEAN;
- VAR size: Streams.Count) : BOOLEAN;
- VAR
- form: Form;
- btype: Type;
- nameGiven, codeGiven, hier, sizeGiven: BOOLEAN;
- disc: StreamDiscipline;
- sentinelFound, unknownTypeFound: BOOLEAN;
- lastType: Type;
-
- PROCEDURE ReadType(s: Streams.Stream; VAR type: Type;
- VAR sentinelFound, unknownTypeFound: BOOLEAN) : BOOLEAN;
- VAR
- code: LONGINT;
- entry: TypeEntry;
- typeName: TypeName;
- btype: Type;
-
- PROCEDURE SeekType(typeName: ARRAY OF CHAR;
- VAR type: Type) : BOOLEAN;
- VAR
- t: Services.Type;
- module: TypeName;
- BEGIN
- Services.SeekType(typeName, t);
- IF t = NIL THEN
- GetModule(typeName, module);
- IF Loader.Load(module, s) THEN
- (* maybe the type is now registered *)
- Services.SeekType(typeName, t);
- END;
- END;
- IF (t # NIL) & (t IS Type) THEN
- type := t(Type); RETURN TRUE
- END;
- RETURN FALSE
- END SeekType;
-
- BEGIN (* ReadType *)
- sentinelFound := FALSE; unknownTypeFound := FALSE;
- type := NIL;
- IF codeGiven THEN
- IF ~NetIO.ReadLongInt(s, code) THEN
- Failure(s, cannotReadType); RETURN FALSE
- END;
- IF code = 0 THEN sentinelFound := TRUE; RETURN FALSE END;
- entry := disc.rtypes[code MOD ttlen];
- WHILE (entry # NIL) & (entry.code # code) DO
- entry := entry.next;
- END;
- IF entry # NIL THEN
- type := entry.type;
- END;
- IF (entry = NIL) & ~nameGiven THEN
- Failure(s, unknownType); unknownTypeFound := TRUE; RETURN FALSE
- END;
- END;
- IF nameGiven THEN
- IF ~NetIO.ReadString(s, typeName) THEN
- Failure(s, cannotReadType); RETURN FALSE
- END;
- IF typeName[0] = 0X THEN sentinelFound := TRUE; RETURN FALSE END;
- IF (type = NIL) & ~SeekType(typeName, type) THEN
- UnknownType(s, typeName); unknownTypeFound := TRUE; RETURN FALSE
- END;
- END;
- IF codeGiven & (entry = NIL) THEN
- NEW(entry);
- entry.code := code;
- entry.type := type;
- entry.next := disc.rtypes[code MOD ttlen];
- disc.rtypes[code MOD ttlen] := entry;
- END;
- RETURN TRUE
- END ReadType;
-
- BEGIN (* ReadTypeInfo *)
- (* read & check form of type info *)
- IF ~NetIO.ReadShortInt(s, form) THEN
- Failure(s, cannotReadType); RETURN FALSE
- END;
- IF (form <= 0) OR (form > maxF) THEN
- Failure(s, invalidType); RETURN FALSE
- END;
- DecodeForm(form, nameGiven, codeGiven, hier, sizeGiven);
+ BEGIN (* ReadType *)
+ sentinelFound := FALSE; unknownTypeFound := FALSE;
+ type := NIL;
IF codeGiven THEN
- GetStreamDisc(s, disc);
+ IF ~NetIO.ReadLongInt(s, code) THEN
+ Failure(s, cannotReadType); RETURN FALSE
+ END;
+ IF code = 0 THEN sentinelFound := TRUE; RETURN FALSE END;
+ entry := disc.rtypes[code MOD ttlen];
+ WHILE (entry # NIL) & (entry.code # code) DO
+ entry := entry.next;
+ END;
+ IF entry # NIL THEN
+ type := entry.type;
+ END;
+ IF (entry = NIL) & ~nameGiven THEN
+ Failure(s, unknownType); unknownTypeFound := TRUE; RETURN FALSE
+ END;
END;
-
- (* read first type information *)
- IF ~ReadType(s, type, sentinelFound, unknownTypeFound) & ~hier THEN
- RETURN FALSE
+ IF nameGiven THEN
+ IF ~NetIO.ReadString(s, typeName) THEN
+ Failure(s, cannotReadType); RETURN FALSE
+ END;
+ IF typeName[0] = 0X THEN sentinelFound := TRUE; RETURN FALSE END;
+ IF (type = NIL) & ~SeekType(typeName, type) THEN
+ UnknownType(s, typeName); unknownTypeFound := TRUE; RETURN FALSE
+ END;
END;
-
- (* read type hierarchy, if any *)
- projection := FALSE;
- IF hier THEN
- IF sentinelFound THEN
- Failure(s, invalidType); RETURN FALSE
- END;
- lastType := type;
- LOOP (* until type hierarchy is read *)
- IF ReadType(s, btype, sentinelFound, unknownTypeFound) THEN
- IF (lastType # NIL) & (lastType.baseType # btype) THEN
- Failure(s, otherTypeHier); RETURN FALSE
- END;
- IF type = NIL THEN
- projection := TRUE;
- type := btype;
- END;
- lastType := btype;
- ELSIF sentinelFound THEN
- EXIT
- ELSIF unknownTypeFound THEN
- IF lastType # NIL THEN
- Failure(s, otherTypeHier); RETURN FALSE
- END;
- ELSE
- RETURN FALSE
- END;
- END;
- IF type = NIL THEN
- (* error events already generated by ReadType *)
- RETURN FALSE
- END;
- END;
-
- (* read size information, if any *)
- IF sizeGiven THEN
- IF ~NetIO.ReadLongInt(s, size) THEN
- Failure(s, cannotReadType); RETURN FALSE
- END;
- IF size < 0 THEN
- Failure(s, invalidType); RETURN FALSE
- END;
- ELSE
- size := -1;
+ IF codeGiven & (entry = NIL) THEN
+ NEW(entry);
+ entry.code := code;
+ entry.type := type;
+ entry.next := disc.rtypes[code MOD ttlen];
+ disc.rtypes[code MOD ttlen] := entry;
END;
RETURN TRUE
- END ReadTypeInfo;
+ END ReadType;
- PROCEDURE ReadData(s: Streams.Stream; VAR object: Object) : BOOLEAN;
- (* use the interface list to read all data in the right order *)
+ BEGIN (* ReadTypeInfo *)
+ (* read & check form of type info *)
+ IF ~NetIO.ReadShortInt(s, form) THEN
+ Failure(s, cannotReadType); RETURN FALSE
+ END;
+ IF (form <= 0) OR (form > maxF) THEN
+ Failure(s, invalidType); RETURN FALSE
+ END;
+ DecodeForm(form, nameGiven, codeGiven, hier, sizeGiven);
+ IF codeGiven THEN
+ GetStreamDisc(s, disc);
+ END;
+
+ (* read first type information *)
+ IF ~ReadType(s, type, sentinelFound, unknownTypeFound) & ~hier THEN
+ RETURN FALSE
+ END;
+
+ (* read type hierarchy, if any *)
+ projection := FALSE;
+ IF hier THEN
+ IF sentinelFound THEN
+ Failure(s, invalidType); RETURN FALSE
+ END;
+ lastType := type;
+ LOOP (* until type hierarchy is read *)
+ IF ReadType(s, btype, sentinelFound, unknownTypeFound) THEN
+ IF (lastType # NIL) & (lastType.baseType # btype) THEN
+ Failure(s, otherTypeHier); RETURN FALSE
+ END;
+ IF type = NIL THEN
+ projection := TRUE;
+ type := btype;
+ END;
+ lastType := btype;
+ ELSIF sentinelFound THEN
+ EXIT
+ ELSIF unknownTypeFound THEN
+ IF lastType # NIL THEN
+ Failure(s, otherTypeHier); RETURN FALSE
+ END;
+ ELSE
+ RETURN FALSE
+ END;
+ END;
+ IF type = NIL THEN
+ (* error events already generated by ReadType *)
+ RETURN FALSE
+ END;
+ END;
+
+ (* read size information, if any *)
+ IF sizeGiven THEN
+ IF ~NetIO.ReadLongInt(s, size) THEN
+ Failure(s, cannotReadType); RETURN FALSE
+ END;
+ IF size < 0 THEN
+ Failure(s, invalidType); RETURN FALSE
+ END;
+ ELSE
+ size := -1;
+ END;
+ RETURN TRUE
+ END ReadTypeInfo;
+
+ PROCEDURE ReadData(s: Streams.Stream; VAR object: Object) : BOOLEAN;
+ (* use the interface list to read all data in the right order *)
+ VAR
+ ifList: InterfaceList;
+ BEGIN
+ ifList := object.type.ifs;
+ WHILE ifList # NIL DO
+ IF ~ifList.if.read(s, object) THEN
+ (* error handling is done by the calling procedure *)
+ RETURN FALSE
+ END;
+ ifList := ifList.next;
+ END;
+ RETURN (object.type.if.read = NIL) OR object.type.if.read(s, object)
+ END ReadData;
+
+ PROCEDURE EncodeForm(s: Streams.Stream; type: Type; VAR form: Form);
+ VAR
+ mode: Mode;
+ disc: IndirectDisciplines.Discipline;
+ hier: BOOLEAN;
+
+ PROCEDURE KnownType() : BOOLEAN;
VAR
- ifList: InterfaceList;
- BEGIN
- ifList := object.type.ifs;
- WHILE ifList # NIL DO
- IF ~ifList.if.read(s, object) THEN
- (* error handling is done by the calling procedure *)
- RETURN FALSE
- END;
- ifList := ifList.next;
+ p: TypeEntry;
+ BEGIN
+ p := disc(StreamDiscipline).wtypes[type.code MOD ttlen];
+ WHILE (p # NIL) & (p.type # type) DO
+ p := p.next;
END;
- RETURN (object.type.if.read = NIL) OR object.type.if.read(s, object)
- END ReadData;
+ RETURN p # NIL
+ END KnownType;
- PROCEDURE EncodeForm(s: Streams.Stream; type: Type; VAR form: Form);
+ BEGIN
+ IF ~IndirectDisciplines.Seek(s, id, disc) THEN
+ mode := defaultMode; disc := NIL;
+ ELSE
+ mode := disc(StreamDiscipline).mode;
+ END;
+ form := 0;
+ hier := mode DIV 8 MOD 2 > 0;
+ CASE mode MOD 4 OF
+ | fullTypeName: IF hier THEN form := hierF ELSE form := nameF END;
+ | typeCode: form := codeF; ASSERT(~hier);
+ | incrTypeCode: IF KnownType() THEN
+ form := codeF;
+ ELSIF hier THEN
+ form := incrhierF;
+ ELSE
+ form := incrF;
+ END;
+ ELSE
+ END;
+ IF mode DIV 4 MOD 2 > 0 THEN
+ INC(form, sizeF);
+ ELSE
+ INC(form, noSizeF);
+ END;
+ END EncodeForm;
+
+ PROCEDURE WriteTypeInfo(s: Streams.Stream; type: Type;
+ VAR giveSize: BOOLEAN) : BOOLEAN;
+ (* write type information without size *)
+ VAR
+ form: Form;
+ giveName, giveCode, hier: BOOLEAN;
+ mode: Mode; incr: BOOLEAN;
+ disc: IndirectDisciplines.Discipline;
+ btype: Type;
+
+ PROCEDURE WriteType(s: Streams.Stream; type: Type) : BOOLEAN;
VAR
- mode: Mode;
- disc: StreamDiscipline;
- hier: BOOLEAN;
-
- PROCEDURE KnownType() : BOOLEAN;
- VAR
- p: TypeEntry;
- BEGIN
- p := disc.wtypes[type.code MOD ttlen];
- WHILE (p # NIL) & (p.type # type) DO
- p := p.next;
- END;
- RETURN p # NIL
- END KnownType;
-
- BEGIN
- IF ~IndirectDisciplines.Seek(s, id, SYS.VAL(IndirectDisciplines.Discipline, disc)) THEN
- mode := defaultMode; disc := NIL;
- ELSE
- mode := disc.mode;
+ typeName: TypeName;
+ entry: TypeEntry;
+ BEGIN
+ IF giveCode THEN
+ IF ~NetIO.WriteLongInt(s, type.code) THEN
+ Error(s, cannotWriteType); RETURN FALSE
+ END;
END;
- form := 0;
- hier := mode DIV 8 MOD 2 > 0;
- CASE mode MOD 4 OF
- | fullTypeName: IF hier THEN form := hierF ELSE form := nameF END;
- | typeCode: form := codeF; ASSERT(~hier);
- | incrTypeCode: IF KnownType() THEN
- form := codeF;
- ELSIF hier THEN
- form := incrhierF;
- ELSE
- form := incrF;
- END;
- ELSE
+ IF giveName THEN
+ Services.GetTypeName(type, typeName);
+ IF ~NetIO.WriteString(s, typeName) THEN
+ Error(s, cannotWriteType); RETURN FALSE
+ END;
END;
- IF mode DIV 4 MOD 2 > 0 THEN
- INC(form, sizeF);
- ELSE
- INC(form, noSizeF);
+ IF incr THEN
+ NEW(entry); entry.type := type; entry.code := type.code;
+ entry.next := disc(StreamDiscipline).wtypes[type.code MOD ttlen];
+ disc(StreamDiscipline).wtypes[type.code MOD ttlen] := entry;
END;
- END EncodeForm;
-
- PROCEDURE WriteTypeInfo(s: Streams.Stream; type: Type;
- VAR giveSize: BOOLEAN) : BOOLEAN;
- (* write type information without size *)
- VAR
- form: Form;
- giveName, giveCode, hier: BOOLEAN;
- mode: Mode; incr: BOOLEAN;
- disc: StreamDiscipline;
- btype: Type;
-
- PROCEDURE WriteType(s: Streams.Stream; type: Type) : BOOLEAN;
- VAR
- typeName: TypeName;
- entry: TypeEntry;
- BEGIN
- IF giveCode THEN
- IF ~NetIO.WriteLongInt(s, type.code) THEN
- Error(s, cannotWriteType); RETURN FALSE
- END;
- END;
- IF giveName THEN
- Services.GetTypeName(type, typeName);
- IF ~NetIO.WriteString(s, typeName) THEN
- Error(s, cannotWriteType); RETURN FALSE
- END;
- END;
- IF incr THEN
- NEW(entry); entry.type := type; entry.code := type.code;
- entry.next := disc.wtypes[type.code MOD ttlen];
- disc.wtypes[type.code MOD ttlen] := entry;
- END;
- RETURN TRUE
- END WriteType;
-
- BEGIN (* WriteTypeInfo *)
- EncodeForm(s, type, form);
- IF ~NetIO.WriteShortInt(s, form) THEN
- Error(s, cannotWriteType);
- END;
- DecodeForm(form, giveName, giveCode, hier, giveSize);
- IF ~IndirectDisciplines.Seek(s, id, SYS.VAL(IndirectDisciplines.Discipline, disc)) THEN
- mode := defaultMode;
- END;
- incr := giveName & giveCode;
-
- IF ~WriteType(s, type) THEN RETURN FALSE END;
-
- IF hier THEN
- btype := type.baseType;
- WHILE btype # NIL DO
- IF ~WriteType(s, btype) THEN RETURN FALSE END;
- btype := btype.baseType;
- END;
- (* write sentinel *)
- IF giveCode THEN
- IF ~NetIO.WriteLongInt(s, 0) THEN
- Error(s, cannotWriteType);
- RETURN FALSE
- END;
- ELSE
- IF ~NetIO.WriteString(s, "") THEN
- Error(s, cannotWriteType);
- RETURN FALSE
- END;
- END;
- END;
-
RETURN TRUE
- END WriteTypeInfo;
+ END WriteType;
- PROCEDURE WriteData(s: Streams.Stream; object: Object) : BOOLEAN;
- (* use the interface list to write all data in the right order *)
- VAR
- ifList: InterfaceList;
- BEGIN
- ifList := object.type.ifs;
- WHILE ifList # NIL DO
- IF ~ifList.if.write(s, object) THEN
- (* error handling is done by the calling procedure *)
- RETURN FALSE
- END;
- ifList := ifList.next;
+ BEGIN (* WriteTypeInfo *)
+ EncodeForm(s, type, form);
+ IF ~NetIO.WriteShortInt(s, form) THEN
+ Error(s, cannotWriteType);
+ END;
+ DecodeForm(form, giveName, giveCode, hier, giveSize);
+ IF ~IndirectDisciplines.Seek(s, id, disc) THEN
+ mode := defaultMode;
+ END;
+ incr := giveName & giveCode;
+
+ IF ~WriteType(s, type) THEN RETURN FALSE END;
+
+ IF hier THEN
+ btype := type.baseType;
+ WHILE btype # NIL DO
+ IF ~WriteType(s, btype) THEN RETURN FALSE END;
+ btype := btype.baseType;
END;
- RETURN (object.type.if.write = NIL) OR object.type.if.write(s, object)
- END WriteData;
-
- (* ===== exported procedures ============================================ *)
-
- PROCEDURE RegisterType*(VAR type: Services.Type;
- name, baseName: ARRAY OF CHAR;
- if: Interface);
- VAR
- newtype: Type;
- baseType: Services.Type;
- member: InterfaceList;
- bt: Type;
- ifval: INTEGER;
- BEGIN
- (* check the parameters *)
- ASSERT(name[0] # 0X);
- IF if # NIL THEN
- ifval := 0;
- IF if.create # NIL THEN INC(ifval, 1) END;
- IF if.read # NIL THEN INC(ifval, 2) END;
- IF if.write # NIL THEN INC(ifval, 4) END;
- IF if.createAndRead # NIL THEN INC(ifval, 8) END;
- (* legal variants:
-
- if = NIL abstract data type
-
- create read write createAndRead
- #NIL NIL NIL NIL 1 empty data type
- NIL #NIL #NIL NIL 6 abstract data type
- #NIL #NIL #NIL NIL 7 normal case
- NIL NIL #NIL #NIL 12 special case
-
- note that the special case must not be given as base type!
- *)
- ASSERT(ifval IN {1, 6, 7, 12});
- END;
-
- (* create type and determine next non-abstract base type *)
- NEW(newtype);
- newtype.code := nextTypeCode; INC(nextTypeCode);
- newtype.if := if;
- IF baseName = "" THEN
- Services.InitType(newtype, name, "PersistentObjects.Object");
+ (* write sentinel *)
+ IF giveCode THEN
+ IF ~NetIO.WriteLongInt(s, 0) THEN
+ Error(s, cannotWriteType);
+ RETURN FALSE
+ END;
ELSE
- Services.InitType(newtype, name, baseName);
+ IF ~NetIO.WriteString(s, "") THEN
+ Error(s, cannotWriteType);
+ RETURN FALSE
+ END;
END;
- IF baseName = "" THEN
- newtype.baseType := NIL;
- ELSE
- Services.GetBaseType(newtype, baseType);
- ASSERT((baseType # NIL) & (baseType IS Type));
- WHILE (baseType # NIL) & (baseType IS Type) &
- (baseType(Type).if = NIL) DO
- Services.GetBaseType(baseType, baseType);
- END;
- IF (baseType = NIL) OR ~(baseType IS Type) THEN
- newtype.baseType := NIL;
- ELSE
- newtype.baseType := baseType(Type);
- ASSERT(newtype.baseType.if.createAndRead = NIL);
- END;
+ END;
+
+ RETURN TRUE
+ END WriteTypeInfo;
+
+ PROCEDURE WriteData(s: Streams.Stream; object: Object) : BOOLEAN;
+ (* use the interface list to write all data in the right order *)
+ VAR
+ ifList: InterfaceList;
+ BEGIN
+ ifList := object.type.ifs;
+ WHILE ifList # NIL DO
+ IF ~ifList.if.write(s, object) THEN
+ (* error handling is done by the calling procedure *)
+ RETURN FALSE
END;
+ ifList := ifList.next;
+ END;
+ RETURN (object.type.if.write = NIL) OR object.type.if.write(s, object)
+ END WriteData;
- (* build up list of interfaces *)
- newtype.ifs := NIL; bt := newtype.baseType;
- WHILE bt # NIL DO
- NEW(member); member.if := bt.if;
- member.next := newtype.ifs; newtype.ifs := member;
- bt := bt.baseType;
- END;
+ (* ===== exported procedures ============================================ *)
- type := newtype;
- END RegisterType;
+ PROCEDURE RegisterType*(VAR type: Services.Type;
+ name, baseName: ARRAY OF CHAR;
+ if: Interface);
+ VAR
+ newtype: Type;
+ baseType: Services.Type;
+ member: InterfaceList;
+ bt: Type;
+ ifval: INTEGER;
+ BEGIN
+ (* check the parameters *)
+ ASSERT(name[0] # 0X);
+ IF if # NIL THEN
+ ifval := 0;
+ IF if.create # NIL THEN INC(ifval, 1) END;
+ IF if.read # NIL THEN INC(ifval, 2) END;
+ IF if.write # NIL THEN INC(ifval, 4) END;
+ IF if.createAndRead # NIL THEN INC(ifval, 8) END;
+ (* legal variants:
- PROCEDURE Init*(object: Object; type: Services.Type);
- BEGIN
- ASSERT(type IS Type);
- WITH type: Type DO
- ASSERT((type.if.create # NIL) OR (type.if.createAndRead # NIL));
- object.type := type;
- object.projected := FALSE;
- Services.Init(object, type);
- END;
- END Init;
+ if = NIL abstract data type
- PROCEDURE SetMode*(s: Streams.Stream; mode: Mode);
- VAR
- disc: StreamDiscipline;
- BEGIN
- IF ~Disciplines.Seek(s, id, SYS.VAL(Disciplines.Discipline, disc)) THEN
- NEW(disc); disc.id := id;
- END;
- disc.mode := mode;
- Disciplines.Add(s, disc);
- END SetMode;
+ create read write createAndRead
+ #NIL NIL NIL NIL 1 empty data type
+ NIL #NIL #NIL NIL 6 abstract data type
+ #NIL #NIL #NIL NIL 7 normal case
+ NIL NIL #NIL #NIL 12 special case
- PROCEDURE GetMode*(s: Streams.Stream; VAR mode: Mode);
- (* return the current mode for the given stream *)
- VAR
- disc: StreamDiscipline;
- BEGIN
- IF Disciplines.Seek(s, id, SYS.VAL(Disciplines.Discipline, disc)) THEN
- mode := disc.mode;
- ELSE
- mode := defaultMode;
- END;
- END GetMode;
-
- PROCEDURE IsProjected*(object: Object) : BOOLEAN;
- (* show whether the object was a victim of projection or not *)
- BEGIN
- RETURN object.projected
- END IsProjected;
-
- PROCEDURE InternalRead(s: Streams.Stream; create: BOOLEAN;
- VAR object: Object) : BOOLEAN;
- (* read `object' from `s';
- note that we have to operate on `object' directly because
- LinearizedStructures relies on this in case of cyclic
- references
+ note that the special case must not be given as base type!
*)
- VAR
- streamCaps: Streams.CapabilitySet;
- type, objectType: Type;
- projection: BOOLEAN; (* necessary due to unknown types? *)
- size: Streams.Count; (* size information, if unknown it equals -1 *)
- skipUnknownParts: BOOLEAN; (* are we able to skip data if necessary? *)
+ ASSERT(ifval IN {1, 6, 7, 12});
+ END;
- (* these vars are used for skipping unknown data areas *)
- oldPos, newPos: Streams.Count;
- textbuf: Texts.Text;
-
- BEGIN (* InternalRead *)
- IF ~ReadTypeInfo(s, type, projection, size) THEN RETURN FALSE END;
- IF ~create & (type.if.createAndRead = NIL) THEN
- (* projection necessary due to target object? *)
- Services.GetType(object, SYS.VAL(Services.Type, objectType));
- IF ~Services.IsExtensionOf(type, objectType) THEN
- TypeGuardFailure(s, type, objectType); RETURN FALSE
- END;
- projection := projection OR (type # objectType);
+ (* create type and determine next non-abstract base type *)
+ NEW(newtype);
+ newtype.code := nextTypeCode; INC(nextTypeCode);
+ newtype.if := if;
+ IF baseName = "" THEN
+ Services.InitType(newtype, name, "PersistentObjects.Object");
+ ELSE
+ Services.InitType(newtype, name, baseName);
+ END;
+ IF baseName = "" THEN
+ newtype.baseType := NIL;
+ ELSE
+ Services.GetBaseType(newtype, baseType);
+ ASSERT((baseType # NIL) & (baseType IS Type));
+ WHILE (baseType # NIL) & (baseType IS Type) &
+ (baseType(Type).if = NIL) DO
+ Services.GetBaseType(baseType, baseType);
END;
- skipUnknownParts := projection & (size > 0);
+ IF (baseType = NIL) OR ~(baseType IS Type) THEN
+ newtype.baseType := NIL;
+ ELSE
+ newtype.baseType := baseType(Type);
+ ASSERT(newtype.baseType.if.createAndRead = NIL);
+ END;
+ END;
+
+ (* build up list of interfaces *)
+ newtype.ifs := NIL; bt := newtype.baseType;
+ WHILE bt # NIL DO
+ NEW(member); member.if := bt.if;
+ member.next := newtype.ifs; newtype.ifs := member;
+ bt := bt.baseType;
+ END;
+
+ type := newtype;
+ END RegisterType;
+
+ PROCEDURE Init*(object: Object; type: Services.Type);
+ BEGIN
+ ASSERT(type IS Type);
+ WITH type: Type DO
+ ASSERT((type.if.create # NIL) OR (type.if.createAndRead # NIL));
+ object.type := type;
+ object.projected := FALSE;
+ Services.Init(object, type);
+ END;
+ END Init;
+
+ PROCEDURE SetMode*(s: Streams.Stream; mode: Mode);
+ VAR
+ disc: StreamDiscipline;
+ d: Disciplines.Discipline;
+ BEGIN
+ IF Disciplines.Seek(s, id, d) THEN
+ disc := d(StreamDiscipline)
+ ELSE
+ NEW(disc); disc.id := id;
+ END;
+ disc.mode := mode;
+ Disciplines.Add(s, disc);
+ END SetMode;
+
+ PROCEDURE GetMode*(s: Streams.Stream; VAR mode: Mode);
+ (* return the current mode for the given stream *)
+ VAR
+ disc: Disciplines.Discipline;
+ BEGIN
+ IF Disciplines.Seek(s, id, disc) THEN
+ mode := disc(StreamDiscipline).mode;
+ ELSE
+ mode := defaultMode;
+ END;
+ END GetMode;
+
+ PROCEDURE IsProjected*(object: Object) : BOOLEAN;
+ (* show whether the object was a victim of projection or not *)
+ BEGIN
+ RETURN object.projected
+ END IsProjected;
+
+ PROCEDURE InternalRead(s: Streams.Stream; create: BOOLEAN;
+ VAR object: Object) : BOOLEAN;
+ (* read `object' from `s';
+ note that we have to operate on `object' directly because
+ LinearizedStructures relies on this in case of cyclic
+ references
+ *)
+ VAR
+ streamCaps: Streams.CapabilitySet;
+ type: Type;
+ objectType: Services.Type;
+ projection: BOOLEAN; (* necessary due to unknown types? *)
+ size: Streams.Count; (* size information, if unknown it equals -1 *)
+ skipUnknownParts: BOOLEAN; (* are we able to skip data if necessary? *)
+
+ (* these vars are used for skipping unknown data areas *)
+ oldPos, newPos: Streams.Count;
+ textbuf: Texts.Text;
+
+ BEGIN (* InternalRead *)
+ IF ~ReadTypeInfo(s, type, projection, size) THEN RETURN FALSE END;
+ IF ~create & (type.if.createAndRead = NIL) THEN
+ (* projection necessary due to target object? *)
+ Services.GetType(object, objectType);
+ IF ~Services.IsExtensionOf(type, objectType) THEN
+ TypeGuardFailure(s, type, objectType); RETURN FALSE
+ END;
+ projection := projection OR (type # objectType);
+ END;
+ skipUnknownParts := projection & (size > 0);
+ streamCaps := Streams.Capabilities(s);
+ IF skipUnknownParts THEN
+ IF Streams.tell IN streamCaps THEN
+ Streams.GetPos(s, oldPos);
+ ELSE
+ Texts.Open(SYS.VAL(Streams.Stream, textbuf));
+ IF ~Streams.Copy(s, textbuf, size) THEN
+ Failure(s, cannotReadData); RETURN FALSE
+ END;
+ Forwarders.Forward(textbuf, s);
+ RelatedEvents.Forward(textbuf, s);
+ s := textbuf;
+ skipUnknownParts := FALSE;
+ END;
+ END;
+
+ IF type.if.createAndRead # NIL THEN
+ IF ~type.if.createAndRead(s, create, object) THEN
+ DecodeFailure(s, type); object := NIL; RETURN FALSE
+ END;
+ ELSE
+ IF create THEN
+ type.if.create(object);
+ END;
+ IF ~ReadData(s, object) THEN
+ DecodeFailure(s, type);
+ object := NIL;
+ RETURN FALSE
+ END;
+ END;
+
+ (* store information about projection into object *)
+ object.projected := projection;
+
+ IF skipUnknownParts THEN
+ IF Streams.seek IN streamCaps THEN
+ Streams.SetPos(s, oldPos + size);
+ ELSE
+ Streams.GetPos(s, newPos);
+ IF ~Streams.Copy(s, Streams.null, size - newPos + oldPos) THEN
+ Failure(s, cannotSkip); RETURN FALSE
+ END;
+ END;
+ ELSIF projection & (size < 0) THEN
+ Error(s, cannotSkip); RETURN FALSE
+ END;
+
+ s.count := 1; (* show success *)
+ RETURN TRUE
+ END InternalRead;
+
+ PROCEDURE Read*(s: Streams.Stream; VAR object: Object) : BOOLEAN;
+ (* read `object' from `s'; object # NIL on success *)
+ BEGIN
+ RETURN InternalRead(s, (* create = *) TRUE, object)
+ END Read;
+
+ PROCEDURE ReadInto*(s: Streams.Stream; object: Object) : BOOLEAN;
+ (* read an object from `s' and assign it to `object';
+ this fails if `object' doesn't has the IDENTICAL type
+ (thus projections are not supported here)
+ *)
+ BEGIN
+ RETURN InternalRead(s, (* create = *) FALSE, object)
+ END ReadInto;
+
+ PROCEDURE GuardedRead*(s: Streams.Stream; guard: Services.Type;
+ VAR object: Object) : BOOLEAN;
+ (* read an object from `s' and return it, provided
+ the type of the read object is an extension of `guard'
+ *)
+ VAR
+ testObject: Object;
+ type: Services.Type;
+ BEGIN
+ IF ~Read(s, testObject) THEN RETURN FALSE END;
+ Services.GetType(testObject, type);
+ IF Services.IsExtensionOf(type, guard) THEN
+ object := testObject; RETURN TRUE
+ ELSE
+ TypeGuardFailure(s, type, guard);
+ RETURN FALSE
+ END;
+ END GuardedRead;
+
+ PROCEDURE Write*(s: Streams.Stream; object: Object) : BOOLEAN;
+ (* write `obj' to `s' *)
+ VAR
+ giveSize: BOOLEAN;
+ streamCaps: Streams.CapabilitySet;
+ patchSize: BOOLEAN;
+ sizePos, beginPos, endPos: Streams.Count;
+ textbuf, origStream: Streams.Stream;
+ mode: Mode;
+ BEGIN
+ IF ~WriteTypeInfo(s, object.type, giveSize) THEN RETURN FALSE END;
+ IF giveSize THEN
streamCaps := Streams.Capabilities(s);
- IF skipUnknownParts THEN
- IF Streams.tell IN streamCaps THEN
- Streams.GetPos(s, oldPos);
- ELSE
- Texts.Open(SYS.VAL(Streams.Stream, textbuf));
- IF ~Streams.Copy(s, textbuf, size) THEN
- Failure(s, cannotReadData); RETURN FALSE
- END;
- Forwarders.Forward(textbuf, s);
- RelatedEvents.Forward(textbuf, s);
- s := textbuf;
- skipUnknownParts := FALSE;
- END;
- END;
-
- IF type.if.createAndRead # NIL THEN
- IF ~type.if.createAndRead(s, create, object) THEN
- DecodeFailure(s, type); object := NIL; RETURN FALSE
- END;
+ patchSize := ({Streams.tell, Streams.seek} - streamCaps = {}) &
+ Streams.Tell(s, sizePos);
+ IF patchSize THEN
+ IF ~NetIO.WriteLongInt(s, 0) THEN
+ Error(s, cannotWriteData); RETURN FALSE
+ END;
+ Streams.GetPos(s, beginPos);
ELSE
- IF create THEN
- type.if.create(object);
- END;
- IF ~ReadData(s, object) THEN
- DecodeFailure(s, type);
- object := NIL;
- RETURN FALSE
- END;
+ Texts.Open(textbuf);
+ Forwarders.Forward(textbuf, s);
+ RelatedEvents.Forward(textbuf, s);
+ GetMode(s, mode); SetMode(textbuf, mode);
+ origStream := s; s := textbuf;
END;
+ END;
- (* store information about projection into object *)
- object.projected := projection;
-
- IF skipUnknownParts THEN
- IF Streams.seek IN streamCaps THEN
- Streams.SetPos(s, oldPos + size);
- ELSE
- Streams.GetPos(s, newPos);
- IF ~Streams.Copy(s, Streams.null, size - newPos + oldPos) THEN
- Failure(s, cannotSkip); RETURN FALSE
- END;
- END;
- ELSIF projection & (size < 0) THEN
- Error(s, cannotSkip); RETURN FALSE
+ IF object.type.if.createAndRead # NIL THEN
+ IF ~object.type.if.write(s, object) THEN
+ Error(s, cannotWriteData); RETURN FALSE
END;
+ ELSE
+ IF ~WriteData(s, object) THEN
+ Error(s, cannotWriteData); RETURN FALSE
+ END;
+ END;
- s.count := 1; (* show success *)
- RETURN TRUE
- END InternalRead;
-
- PROCEDURE Read*(s: Streams.Stream; VAR object: Object) : BOOLEAN;
- (* read `object' from `s'; object # NIL on success *)
- BEGIN
- RETURN InternalRead(s, (* create = *) TRUE, object)
- END Read;
-
- PROCEDURE ReadInto*(s: Streams.Stream; object: Object) : BOOLEAN;
- (* read an object from `s' and assign it to `object';
- this fails if `object' doesn't has the IDENTICAL type
- (thus projections are not supported here)
- *)
- BEGIN
- RETURN InternalRead(s, (* create = *) FALSE, object)
- END ReadInto;
-
- PROCEDURE GuardedRead*(s: Streams.Stream; guard: Services.Type;
- VAR object: Object) : BOOLEAN;
- (* read an object from `s' and return it, provided
- the type of the read object is an extension of `guard'
- *)
- VAR
- testObject: Object;
- type: Services.Type;
- BEGIN
- IF ~Read(s, testObject) THEN RETURN FALSE END;
- Services.GetType(testObject, type);
- IF Services.IsExtensionOf(type, guard) THEN
- object := testObject; RETURN TRUE
+ IF giveSize THEN
+ IF patchSize THEN
+ Streams.GetPos(s, endPos);
+ Streams.SetPos(s, sizePos);
+ IF ~NetIO.WriteLongInt(s, endPos - beginPos) THEN
+ Streams.SetPos(s, endPos);
+ Error(s, cannotWriteData);
+ RETURN FALSE
+ END;
+ Streams.SetPos(s, endPos);
ELSE
- TypeGuardFailure(s, type, guard);
- RETURN FALSE
+ Streams.GetPos(textbuf, endPos);
+ Streams.SetPos(textbuf, 0);
+ s := origStream;
+ IF ~NetIO.WriteLongInt(s, endPos) OR
+ ~Streams.Copy(textbuf, s, endPos) THEN
+ Error(s, cannotWriteData);
+ END;
END;
- END GuardedRead;
+ END;
+ s.count := 1;
+ RETURN TRUE
+ END Write;
- PROCEDURE Write*(s: Streams.Stream; object: Object) : BOOLEAN;
- (* write `obj' to `s' *)
- VAR
- giveSize: BOOLEAN;
- streamCaps: Streams.CapabilitySet;
- patchSize: BOOLEAN;
- sizePos, beginPos, endPos: Streams.Count;
- textbuf, origStream: Streams.Stream;
- mode: Mode;
- BEGIN
- IF ~WriteTypeInfo(s, object.type, giveSize) THEN RETURN FALSE END;
- IF giveSize THEN
- streamCaps := Streams.Capabilities(s);
- patchSize := ({Streams.tell, Streams.seek} - streamCaps = {}) &
- Streams.Tell(s, sizePos);
- IF patchSize THEN
- IF ~NetIO.WriteLongInt(s, 0) THEN
- Error(s, cannotWriteData); RETURN FALSE
- END;
- Streams.GetPos(s, beginPos);
- ELSE
- Texts.Open(textbuf);
- Forwarders.Forward(textbuf, s);
- RelatedEvents.Forward(textbuf, s);
- GetMode(s, mode); SetMode(textbuf, mode);
- origStream := s; s := textbuf;
- END;
- END;
+ PROCEDURE ReadObjectOrNIL*(s: Streams.Stream; VAR object: Object) : BOOLEAN;
+ VAR
+ nil: BOOLEAN;
+ BEGIN
+ object := NIL;
+ RETURN NetIO.ReadBoolean(s, nil) & (nil OR Read(s, object))
+ END ReadObjectOrNIL;
- IF object.type.if.createAndRead # NIL THEN
- IF ~object.type.if.write(s, object) THEN
- Error(s, cannotWriteData); RETURN FALSE
- END;
- ELSE
- IF ~WriteData(s, object) THEN
- Error(s, cannotWriteData); RETURN FALSE
- END;
- END;
-
- IF giveSize THEN
- IF patchSize THEN
- Streams.GetPos(s, endPos);
- Streams.SetPos(s, sizePos);
- IF ~NetIO.WriteLongInt(s, endPos - beginPos) THEN
- Streams.SetPos(s, endPos);
- Error(s, cannotWriteData);
- RETURN FALSE
- END;
- Streams.SetPos(s, endPos);
- ELSE
- Streams.GetPos(textbuf, endPos);
- Streams.SetPos(textbuf, 0);
- s := origStream;
- IF ~NetIO.WriteLongInt(s, endPos) OR
- ~Streams.Copy(textbuf, s, endPos) THEN
- Error(s, cannotWriteData);
- END;
- END;
- END;
- s.count := 1;
- RETURN TRUE
- END Write;
-
- PROCEDURE ReadObjectOrNIL*(s: Streams.Stream; VAR object: Object) : BOOLEAN;
- VAR
- nil: BOOLEAN;
- BEGIN
+ PROCEDURE GuardedReadObjectOrNIL*(s: Streams.Stream; guard: Services.Type;
+ VAR object: Object) : BOOLEAN;
+ (* may be used instead of ReadObjectOrNIL *)
+ VAR
+ testObject: Object;
+ type: Services.Type;
+ nil: BOOLEAN;
+ BEGIN
+ IF ~NetIO.ReadBoolean(s, nil) THEN RETURN FALSE END;
+ IF nil THEN
object := NIL;
- RETURN NetIO.ReadBoolean(s, nil) & (nil OR Read(s, object))
- END ReadObjectOrNIL;
+ RETURN TRUE
+ END;
+ IF ~Read(s, testObject) THEN RETURN FALSE END;
+ IF testObject = NIL THEN RETURN TRUE END;
+ Services.GetType(testObject, type);
+ IF Services.IsExtensionOf(type, guard) THEN
+ object := testObject; RETURN TRUE
+ ELSE
+ TypeGuardFailure(s, type, guard);
+ RETURN FALSE
+ END;
+ END GuardedReadObjectOrNIL;
- PROCEDURE GuardedReadObjectOrNIL*(s: Streams.Stream; guard: Services.Type;
- VAR object: Object) : BOOLEAN;
- (* may be used instead of ReadObjectOrNIL *)
- VAR
- testObject: Object;
- type: Services.Type;
- nil: BOOLEAN;
- BEGIN
- IF ~NetIO.ReadBoolean(s, nil) THEN RETURN FALSE END;
- IF nil THEN
- object := NIL;
- RETURN TRUE
- END;
- IF ~Read(s, testObject) THEN RETURN FALSE END;
- IF testObject = NIL THEN RETURN TRUE END;
- Services.GetType(testObject, type);
- IF Services.IsExtensionOf(type, guard) THEN
- object := testObject; RETURN TRUE
- ELSE
- TypeGuardFailure(s, type, guard);
- RETURN FALSE
- END;
- END GuardedReadObjectOrNIL;
-
- PROCEDURE WriteObjectOrNIL*(s: Streams.Stream; object: Object) : BOOLEAN;
- VAR
- nil: BOOLEAN;
- BEGIN
- nil := object = NIL;
- RETURN NetIO.WriteBoolean(s, nil) & (nil OR Write(s, object))
- END WriteObjectOrNIL;
+ PROCEDURE WriteObjectOrNIL*(s: Streams.Stream; object: Object) : BOOLEAN;
+ VAR
+ nil: BOOLEAN;
+ BEGIN
+ nil := object = NIL;
+ RETURN NetIO.WriteBoolean(s, nil) & (nil OR Write(s, object))
+ END WriteObjectOrNIL;
BEGIN
- id := Disciplines.Unique();
- nextTypeCode := 1;
- InitErrorHandling;
- Services.CreateType(potype, "PersistentObjects.Object", "");
+ id := Disciplines.Unique();
+ nextTypeCode := 1;
+ InitErrorHandling;
+ Services.CreateType(potype, "PersistentObjects.Object", "");
END ulmPersistentObjects.
diff --git a/src/library/ulm/ulmRandomGenerators.Mod b/src/library/ulm/ulmRandomGenerators.Mod
index cb63a9a5..f1aa36de 100644
--- a/src/library/ulm/ulmRandomGenerators.Mod
+++ b/src/library/ulm/ulmRandomGenerators.Mod
@@ -1,419 +1,421 @@
(* Ulm's Oberon Library
- Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
- ----------------------------------------------------------------------------
- Ulm's Oberon Library is free software; you can redistribute it
- and/or modify it under the terms of the GNU Library General Public
- License as published by the Free Software Foundation; either version
- 2 of the License, or (at your option) any later version.
+ Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
+ ----------------------------------------------------------------------------
+ Ulm's Oberon Library is free software; you can redistribute it
+ and/or modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either version
+ 2 of the License, or (at your option) any later version.
- Ulm's Oberon Library is distributed in the hope that it will be
- useful, but WITHOUT ANY WARRANTY; without even the implied warranty
- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Library General Public License for more details.
+ Ulm's Oberon Library is distributed in the hope that it will be
+ useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+ of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
- You should have received a copy of the GNU Library General Public
- License along with this library; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ----------------------------------------------------------------------------
- E-mail contact: oberon@mathematik.uni-ulm.de
- ----------------------------------------------------------------------------
- $Id: RandomGener.om,v 1.9 2004/03/09 21:44:12 borchert Exp $
- ----------------------------------------------------------------------------
- $Log: RandomGener.om,v $
- Revision 1.9 2004/03/09 21:44:12 borchert
- unpredictable added to the standard set of PRNGs
+ You should have received a copy of the GNU Library General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ----------------------------------------------------------------------------
+ E-mail contact: oberon@mathematik.uni-ulm.de
+ ----------------------------------------------------------------------------
+ $Id: RandomGener.om,v 1.9 2004/03/09 21:44:12 borchert Exp $
+ ----------------------------------------------------------------------------
+ $Log: RandomGener.om,v $
+ Revision 1.9 2004/03/09 21:44:12 borchert
+ unpredictable added to the standard set of PRNGs
- Revision 1.8 2004/03/06 07:22:09 borchert
- Init asserts that the sequence has been registered at Services
+ Revision 1.8 2004/03/06 07:22:09 borchert
+ Init asserts that the sequence has been registered at Services
- Revision 1.7 1998/02/14 22:04:09 martin
- Missing calls of Services.Init and Services.CreateType added.
+ Revision 1.7 1998/02/14 22:04:09 martin
+ Missing calls of Services.Init and Services.CreateType added.
- Revision 1.6 1997/10/11 21:22:03 martin
- assertion in ValS added, obsolete variable removed
+ Revision 1.6 1997/10/11 21:22:03 martin
+ assertion in ValS added, obsolete variable removed
- Revision 1.5 1997/10/10 16:26:49 martin
- RestartSequence added, range conversions improved,
- default implementation replaced.
+ Revision 1.5 1997/10/10 16:26:49 martin
+ RestartSequence added, range conversions improved,
+ default implementation replaced.
- Revision 1.4 1997/04/01 16:33:41 borchert
- major revision of Random:
- - module renamed to RandomGenerators
- - abstraction instead of simple implementation (work by Frank Fischer)
+ Revision 1.4 1997/04/01 16:33:41 borchert
+ major revision of Random:
+ - module renamed to RandomGenerators
+ - abstraction instead of simple implementation (work by Frank Fischer)
- Revision 1.3 1994/09/01 18:15:41 borchert
- bug fix: avoid arithmetic overflow in ValS
+ Revision 1.3 1994/09/01 18:15:41 borchert
+ bug fix: avoid arithmetic overflow in ValS
- Revision 1.2 1994/08/30 09:48:00 borchert
- sequences added
+ Revision 1.2 1994/08/30 09:48:00 borchert
+ sequences added
- Revision 1.1 1994/02/23 07:25:30 borchert
- Initial revision
+ Revision 1.1 1994/02/23 07:25:30 borchert
+ Initial revision
- ----------------------------------------------------------------------------
- original implementation by AFB 2/90
- conversion to abstraction by Frank B.J. Fischer 3/97
- ----------------------------------------------------------------------------
+ ----------------------------------------------------------------------------
+ original implementation by AFB 2/90
+ conversion to abstraction by Frank B.J. Fischer 3/97
+ ----------------------------------------------------------------------------
*)
MODULE ulmRandomGenerators;
- (* Anyone who considers arithmetical
- methods of producing random digits
- is, of course, in a state of sin.
- - John von Neumann (1951)
- *)
+ (* Anyone who considers arithmetical
+ methods of producing random digits
+ is, of course, in a state of sin.
+ - John von Neumann (1951)
+ *)
- IMPORT
- Clocks := ulmClocks, Disciplines := ulmDisciplines, Objects := ulmObjects, Operations := ulmOperations, Process := ulmProcess, Services := ulmServices, Times := ulmTimes,
- Types := ulmTypes, S := SYSTEM;
+ IMPORT
+ Clocks := ulmClocks, Disciplines := ulmDisciplines,
+ Objects := ulmObjects, Operations := ulmOperations,
+ Process := ulmProcess, Services := ulmServices,
+ Times := ulmTimes, Types := ulmTypes;
- TYPE
- Sequence* = POINTER TO SequenceRec;
+ TYPE
+ Sequence* = POINTER TO SequenceRec;
- Int32ValSProc* = PROCEDURE (sequence: Sequence): Types.Int32;
- LongRealValSProc* = PROCEDURE (sequence: Sequence): LONGREAL;
- RewindSequenceProc* = PROCEDURE (sequence: Sequence);
- RestartSequenceProc* = PROCEDURE (sequence, seed: Sequence);
- SetValSProc* = PROCEDURE (sequence: Sequence; value: Operations.Operand);
+ Int32ValSProc* = PROCEDURE (sequence: Sequence): Types.Int32;
+ LongRealValSProc* = PROCEDURE (sequence: Sequence): LONGREAL;
+ RewindSequenceProc* = PROCEDURE (sequence: Sequence);
+ RestartSequenceProc* = PROCEDURE (sequence, seed: Sequence);
+ SetValSProc* = PROCEDURE (sequence: Sequence; value: Operations.Operand);
- CONST
- int32ValS* = 0; longRealValS* = 1; rewindSequence* = 2; restartSequence* = 3;
+ CONST
+ int32ValS* = 0; longRealValS* = 1; rewindSequence* = 2; restartSequence* = 3;
- TYPE
- CapabilitySet* = SET; (* of [int32ValS..restartSequence] *)
- Interface* = POINTER TO InterfaceRec;
- InterfaceRec* =
- RECORD
- (Objects.ObjectRec)
- int32ValS* : Int32ValSProc; (* at least one of ... *)
- longRealValS* : LongRealValSProc; (* ... these required *)
- rewindSequence* : RewindSequenceProc; (* optional *)
- restartSequence*: RestartSequenceProc; (* optional *)
- END;
+ TYPE
+ CapabilitySet* = SET; (* of [int32ValS..restartSequence] *)
+ Interface* = POINTER TO InterfaceRec;
+ InterfaceRec* =
+ RECORD
+ (Objects.ObjectRec)
+ int32ValS* : Int32ValSProc; (* at least one of ... *)
+ longRealValS* : LongRealValSProc; (* ... these required *)
+ rewindSequence* : RewindSequenceProc; (* optional *)
+ restartSequence*: RestartSequenceProc; (* optional *)
+ END;
- SequenceRec* =
- RECORD
- (Services.ObjectRec)
- (* private components *)
- if : Interface;
- caps: CapabilitySet;
- END;
+ SequenceRec* =
+ RECORD
+ (Services.ObjectRec)
+ (* private components *)
+ if : Interface;
+ caps: CapabilitySet;
+ END;
- VAR
- std* : Sequence; (* default sequence *)
- seed*: Sequence; (* sequence of seed values *)
- unpredictable*: Sequence;
- (* reasonably fast sequence of unpredictable values;
- is initially NIL
- *)
+ VAR
+ std* : Sequence; (* default sequence *)
+ seed*: Sequence; (* sequence of seed values *)
+ unpredictable*: Sequence;
+ (* reasonably fast sequence of unpredictable values;
+ is initially NIL
+ *)
- (* ----- private definitions ----- *)
+ (* ----- private definitions ----- *)
- CONST
- modulus1 = 2147483647; (* a Mersenne prime *)
- factor1 = 48271; (* passes spectral test *)
- quotient1 = modulus1 DIV factor1; (* 44488 *)
- remainder1 = modulus1 MOD factor1; (* 3399; must be < quotient1 *)
- modulus2 = 2147483399; (* a non-Mersenne prime *)
- factor2 = 40692; (* also passes spectral test *)
- quotient2 = modulus2 DIV factor2; (* 52774 *)
- remainder2 = modulus2 MOD factor2; (* 3791; must be < quotient2 *)
+ CONST
+ modulus1 = 2147483647; (* a Mersenne prime *)
+ factor1 = 48271; (* passes spectral test *)
+ quotient1 = modulus1 DIV factor1; (* 44488 *)
+ remainder1 = modulus1 MOD factor1; (* 3399; must be < quotient1 *)
+ modulus2 = 2147483399; (* a non-Mersenne prime *)
+ factor2 = 40692; (* also passes spectral test *)
+ quotient2 = modulus2 DIV factor2; (* 52774 *)
+ remainder2 = modulus2 MOD factor2; (* 3791; must be < quotient2 *)
- TYPE
- DefaultSequence = POINTER TO DefaultSequenceRec;
- DefaultSequenceRec =
- RECORD
- (SequenceRec)
- seed1, seed2: LONGINT;
- value1, value2: LONGINT;
- END;
+ TYPE
+ DefaultSequence = POINTER TO DefaultSequenceRec;
+ DefaultSequenceRec =
+ RECORD
+ (SequenceRec)
+ seed1, seed2: LONGINT;
+ value1, value2: LONGINT;
+ END;
- ServiceDiscipline = POINTER TO ServiceDisciplineRec;
- ServiceDisciplineRec =
- RECORD
- (Disciplines.DisciplineRec)
- setValS: SetValSProc;
- END;
+ ServiceDiscipline = POINTER TO ServiceDisciplineRec;
+ ServiceDisciplineRec =
+ RECORD
+ (Disciplines.DisciplineRec)
+ setValS: SetValSProc;
+ END;
- VAR
- service : Services.Service;
- serviceDiscID: Disciplines.Identifier;
- sequenceType,
- defaultSequenceType: Services.Type;
+ VAR
+ service : Services.Service;
+ serviceDiscID: Disciplines.Identifier;
+ sequenceType,
+ defaultSequenceType: Services.Type;
- (* ----- bug workaround ----- *)
+ (* ----- bug workaround ----- *)
- PROCEDURE Entier(value: LONGREAL): LONGINT;
+ PROCEDURE Entier(value: LONGREAL): LONGINT;
+ VAR
+ result: LONGINT;
+ BEGIN
+ result := ENTIER(value);
+ IF result > value THEN
+ DEC(result);
+ END;
+ RETURN result
+ END Entier;
+
+ (* ----- exported procedures ----- *)
+
+ PROCEDURE Init*(sequence: Sequence; if: Interface; caps: CapabilitySet);
+ (* initialize sequence *)
+ VAR
+ type: Services.Type;
+ BEGIN
+ ASSERT((if.int32ValS # NIL) OR (if.longRealValS # NIL));
+ ASSERT(~(int32ValS IN caps) OR (if.int32ValS # NIL));
+ ASSERT(~(longRealValS IN caps) OR (if.longRealValS # NIL));
+ ASSERT(~(rewindSequence IN caps) OR (if.rewindSequence # NIL));
+ Services.GetType(sequence, type); ASSERT(type # NIL);
+ sequence.if := if;
+ sequence.caps := caps;
+ END Init;
+
+ PROCEDURE Capabilities*(sequence: Sequence): CapabilitySet;
+ (* tell which procedures are implemented *)
+ BEGIN
+ RETURN sequence.caps
+ END Capabilities;
+
+ PROCEDURE RewindSequence*(sequence: Sequence);
+ (* re-examine sequence *)
+ BEGIN
+ ASSERT(rewindSequence IN sequence.caps);
+ sequence.if.rewindSequence(sequence);
+ END RewindSequence;
+
+ PROCEDURE RestartSequence*(sequence, seed: Sequence);
+ (* restart sequence with new seed values *)
+ BEGIN
+ ASSERT(restartSequence IN sequence.caps);
+ sequence.if.restartSequence(sequence, seed);
+ END RestartSequence;
+
+ PROCEDURE ^ LongRealValS*(sequence: Sequence): LONGREAL;
+
+ PROCEDURE Int32ValS*(sequence: Sequence): Types.Int32;
+ (* get random 32-bit value from sequence *)
+ VAR
+ real: LONGREAL;
+ BEGIN
+ IF int32ValS IN sequence.caps THEN
+ RETURN sequence.if.int32ValS(sequence)
+ ELSE
+ real := LongRealValS(sequence);
+ RETURN SHORT(Entier( (1. - real - real) * MIN(Types.Int32) ))
+ END;
+ END Int32ValS;
+
+ PROCEDURE Int32Val*(): Types.Int32;
+ (* get random 32-bit value from std sequence *)
+ BEGIN
+ RETURN Int32ValS(std);
+ END Int32Val;
+
+ PROCEDURE LongRealValS*(sequence: Sequence): LONGREAL;
+ (* get a uniformly distributed longreal value in [0..1) *)
+ BEGIN
+ IF longRealValS IN sequence.caps THEN
+ RETURN sequence.if.longRealValS(sequence)
+ ELSE
+ RETURN 0.5 +
+ Int32ValS(sequence) / (0. - MIN(Types.Int32) - MIN(Types.Int32))
+ END;
+ END LongRealValS;
+
+ PROCEDURE LongRealVal*(): LONGREAL;
+ (* get a uniformly distributed longreal value in [0..1) *)
+ BEGIN
+ RETURN LongRealValS(std)
+ END LongRealVal;
+
+ PROCEDURE RealValS*(sequence: Sequence): REAL;
+ (* get a uniformly distributed real value in [0..1) *)
+ BEGIN
+ RETURN SHORT(LongRealValS(sequence))
+ END RealValS;
+
+ PROCEDURE RealVal*(): REAL;
+ (* get a uniformly distributed real value in [0..1) *)
+ BEGIN
+ RETURN SHORT(LongRealValS(std))
+ END RealVal;
+
+ PROCEDURE ValS*(sequence: Sequence; low, high: LONGINT): LONGINT;
+ (* get a uniformly distributed integer in [low..high] *)
+ BEGIN
+ ASSERT(low <= high);
+ RETURN Entier( low + LongRealValS(sequence) * (1. + high - low) )
+ END ValS;
+
+ PROCEDURE Val*(low, high: LONGINT): LONGINT;
+ (* get a uniformly distributed integer in [low..high] *)
+ BEGIN
+ RETURN ValS(std, low, high)
+ END Val;
+
+ PROCEDURE FlipS*(sequence: Sequence): BOOLEAN;
+ (* return TRUE or FALSE *)
+ BEGIN
+ IF int32ValS IN sequence.caps THEN
+ RETURN sequence.if.int32ValS(sequence) >= 0
+ ELSE
+ RETURN sequence.if.longRealValS(sequence) >= 0.5
+ END;
+ END FlipS;
+
+ PROCEDURE Flip*(): BOOLEAN;
+ (* return TRUE or FALSE *)
+ BEGIN
+ RETURN FlipS(std)
+ END Flip;
+
+ PROCEDURE Support*(type: Services.Type; setValS: SetValSProc);
+ (* support service for type *)
+ VAR
+ serviceDisc: ServiceDiscipline;
+ BEGIN
+ NEW(serviceDisc);
+ serviceDisc.id := serviceDiscID;
+ serviceDisc.setValS := setValS;
+ Disciplines.Add(type, serviceDisc);
+ Services.Define(type, service, NIL);
+ END Support;
+
+ PROCEDURE SetValS*(sequence: Sequence; value: Operations.Operand);
+ (* store random value from sequence into already initialized value *)
+ VAR
+ baseType : Services.Type;
+ serviceDisc: Disciplines.Discipline; (* ServiceDiscipline *)
+ ok : BOOLEAN;
+ BEGIN
+ Services.GetSupportedBaseType(value, service, baseType);
+ ok := Disciplines.Seek(baseType, serviceDiscID, serviceDisc);
+ ASSERT(ok);
+ serviceDisc(ServiceDiscipline).setValS(sequence, value);
+ END SetValS;
+
+ PROCEDURE SetVal*(value: Operations.Operand);
+ (* store random value from std sequence into already initialized value *)
+ BEGIN
+ SetValS(std, value);
+ END SetVal;
+
+ (* ----- DefaultSequence ----- *)
+
+ PROCEDURE CongruentialStep(VAR value1, value2: LONGINT);
+ BEGIN
+ value1 :=
+ factor1 * (value1 MOD quotient1) - remainder1 * (value1 DIV quotient1);
+ IF value1 < 0 THEN
+ INC(value1, modulus1);
+ END;
+ value2 :=
+ factor2 * (value2 MOD quotient2) - remainder2 * (value2 DIV quotient2);
+ IF value2 < 0 THEN
+ INC(value2, modulus2);
+ END;
+ END CongruentialStep;
+
+ PROCEDURE DefaultSequenceValue(sequence: Sequence): LONGREAL;
+ VAR
+ value: LONGINT;
+ BEGIN
+ WITH sequence: DefaultSequence DO
+ CongruentialStep(sequence.value1, sequence.value2);
+ value := sequence.value1 - sequence.value2;
+ IF value <= 0 THEN
+ INC(value, modulus1);
+ END;
+ RETURN (value - 1.) / (modulus1 - 1.)
+ END;
+ END DefaultSequenceValue;
+
+ PROCEDURE DefaultSequenceRewind(sequence: Sequence);
+ BEGIN
+ WITH sequence: DefaultSequence DO
+ sequence.value1 := sequence.seed1;
+ sequence.value2 := sequence.seed2;
+ END;
+ END DefaultSequenceRewind;
+
+ PROCEDURE DefaultSequenceRestart(sequence, seed: Sequence);
+ BEGIN
+ WITH sequence: DefaultSequence DO
+ sequence.seed1 := ValS(seed, 1, modulus1-1);
+ sequence.seed2 := ValS(seed, 1, modulus2-1);
+ sequence.value1 := sequence.seed1;
+ sequence.value2 := sequence.seed2;
+ END;
+ END DefaultSequenceRestart;
+
+ PROCEDURE CreateDefaultSequences;
+ VAR
+ mySeed, myStd: DefaultSequence;
+ if: Interface;
+ daytime: Times.Time;
+ timeval: Times.TimeValueRec;
+ count: LONGINT;
+
+ PROCEDURE Hash(str: ARRAY OF CHAR): LONGINT;
VAR
- result: LONGINT;
- BEGIN
- result := ENTIER(value);
- IF result > value THEN
- DEC(result);
- END;
- RETURN result
- END Entier;
+ index,
+ val: LONGINT;
+ BEGIN
+ val := 27567352;
+ index := 0;
+ WHILE str[index] # 0X DO
+ val := (val MOD 16777216) * 128 +
+ (val DIV 16777216 + ORD(str[index])) MOD 128;
+ INC(index);
+ END; (*WHILE*)
+ RETURN val
+ END Hash;
- (* ----- exported procedures ----- *)
+ BEGIN
+ (* define interface for all default sequences *)
+ NEW(if);
+ if.longRealValS := DefaultSequenceValue;
+ if.rewindSequence := DefaultSequenceRewind;
+ if.restartSequence := DefaultSequenceRestart;
- PROCEDURE Init*(sequence: Sequence; if: Interface; caps: CapabilitySet);
- (* initialize sequence *)
- VAR
- type: Services.Type;
- BEGIN
- ASSERT((if.int32ValS # NIL) OR (if.longRealValS # NIL));
- ASSERT(~(int32ValS IN caps) OR (if.int32ValS # NIL));
- ASSERT(~(longRealValS IN caps) OR (if.longRealValS # NIL));
- ASSERT(~(rewindSequence IN caps) OR (if.rewindSequence # NIL));
- Services.GetType(sequence, type); ASSERT(type # NIL);
- sequence.if := if;
- sequence.caps := caps;
- END Init;
+ (* fake initial randomness using some portably accessible sources *)
+ NEW(mySeed);
+ Services.Init(mySeed, defaultSequenceType);
+ Init(mySeed, if, {longRealValS});
+ Clocks.GetTime(Clocks.system, daytime);
+ Times.GetValue(daytime, timeval);
+ (* extract those 31 bits from daytime that are most likely to vary *)
+ mySeed.value1 := timeval.usec * 2048 + timeval.second MOD 65536 + 1;
+ (* generate 31 more bits from the process name *)
+ mySeed.value2 := Hash(Process.name) MOD (modulus2 - 1) + 1;
+ (* scramble these values *)
+ count := 0;
+ WHILE count < 4 DO
+ CongruentialStep(mySeed.value1, mySeed.value2);
+ INC(count);
+ END;
+ (* mix them together *)
+ DefaultSequenceRestart(mySeed, mySeed);
+ seed := mySeed;
- PROCEDURE Capabilities*(sequence: Sequence): CapabilitySet;
- (* tell which procedures are implemented *)
- BEGIN
- RETURN sequence.caps
- END Capabilities;
+ (* now use our seed to initialize std sequence *)
+ NEW(myStd);
+ Services.Init(myStd, defaultSequenceType);
+ Init(myStd, if, {longRealValS, rewindSequence, restartSequence});
+ DefaultSequenceRestart(myStd, mySeed);
+ std := myStd;
- PROCEDURE RewindSequence*(sequence: Sequence);
- (* re-examine sequence *)
- BEGIN
- ASSERT(rewindSequence IN sequence.caps);
- sequence.if.rewindSequence(sequence);
- END RewindSequence;
-
- PROCEDURE RestartSequence*(sequence, seed: Sequence);
- (* restart sequence with new seed values *)
- BEGIN
- ASSERT(restartSequence IN sequence.caps);
- sequence.if.restartSequence(sequence, seed);
- END RestartSequence;
-
- PROCEDURE ^ LongRealValS*(sequence: Sequence): LONGREAL;
-
- PROCEDURE Int32ValS*(sequence: Sequence): Types.Int32;
- (* get random 32-bit value from sequence *)
- VAR
- real: LONGREAL;
- BEGIN
- IF int32ValS IN sequence.caps THEN
- RETURN sequence.if.int32ValS(sequence)
- ELSE
- real := LongRealValS(sequence);
- RETURN SHORT(Entier( (1. - real - real) * MIN(Types.Int32) ))
- END;
- END Int32ValS;
-
- PROCEDURE Int32Val*(): Types.Int32;
- (* get random 32-bit value from std sequence *)
- BEGIN
- RETURN Int32ValS(std);
- END Int32Val;
-
- PROCEDURE LongRealValS*(sequence: Sequence): LONGREAL;
- (* get a uniformly distributed longreal value in [0..1) *)
- BEGIN
- IF longRealValS IN sequence.caps THEN
- RETURN sequence.if.longRealValS(sequence)
- ELSE
- RETURN 0.5 +
- Int32ValS(sequence) / (0. - MIN(Types.Int32) - MIN(Types.Int32))
- END;
- END LongRealValS;
-
- PROCEDURE LongRealVal*(): LONGREAL;
- (* get a uniformly distributed longreal value in [0..1) *)
- BEGIN
- RETURN LongRealValS(std)
- END LongRealVal;
-
- PROCEDURE RealValS*(sequence: Sequence): REAL;
- (* get a uniformly distributed real value in [0..1) *)
- BEGIN
- RETURN SHORT(LongRealValS(sequence))
- END RealValS;
-
- PROCEDURE RealVal*(): REAL;
- (* get a uniformly distributed real value in [0..1) *)
- BEGIN
- RETURN SHORT(LongRealValS(std))
- END RealVal;
-
- PROCEDURE ValS*(sequence: Sequence; low, high: LONGINT): LONGINT;
- (* get a uniformly distributed integer in [low..high] *)
- BEGIN
- ASSERT(low <= high);
- RETURN Entier( low + LongRealValS(sequence) * (1. + high - low) )
- END ValS;
-
- PROCEDURE Val*(low, high: LONGINT): LONGINT;
- (* get a uniformly distributed integer in [low..high] *)
- BEGIN
- RETURN ValS(std, low, high)
- END Val;
-
- PROCEDURE FlipS*(sequence: Sequence): BOOLEAN;
- (* return TRUE or FALSE *)
- BEGIN
- IF int32ValS IN sequence.caps THEN
- RETURN sequence.if.int32ValS(sequence) >= 0
- ELSE
- RETURN sequence.if.longRealValS(sequence) >= 0.5
- END;
- END FlipS;
-
- PROCEDURE Flip*(): BOOLEAN;
- (* return TRUE or FALSE *)
- BEGIN
- RETURN FlipS(std)
- END Flip;
-
- PROCEDURE Support*(type: Services.Type; setValS: SetValSProc);
- (* support service for type *)
- VAR
- serviceDisc: ServiceDiscipline;
- BEGIN
- NEW(serviceDisc);
- serviceDisc.id := serviceDiscID;
- serviceDisc.setValS := setValS;
- Disciplines.Add(type, serviceDisc);
- Services.Define(type, service, NIL);
- END Support;
-
- PROCEDURE SetValS*(sequence: Sequence; value: Operations.Operand);
- (* store random value from sequence into already initialized value *)
- VAR
- baseType : Services.Type;
- serviceDisc: ServiceDiscipline;
- ok : BOOLEAN;
- BEGIN
- Services.GetSupportedBaseType(value, service, baseType);
- ok := Disciplines.Seek(baseType, serviceDiscID, S.VAL(Disciplines.Discipline, serviceDisc));
- ASSERT(ok);
- serviceDisc.setValS(sequence, value);
- END SetValS;
-
- PROCEDURE SetVal*(value: Operations.Operand);
- (* store random value from std sequence into already initialized value *)
- BEGIN
- SetValS(std, value);
- END SetVal;
-
- (* ----- DefaultSequence ----- *)
-
- PROCEDURE CongruentialStep(VAR value1, value2: LONGINT);
- BEGIN
- value1 :=
- factor1 * (value1 MOD quotient1) - remainder1 * (value1 DIV quotient1);
- IF value1 < 0 THEN
- INC(value1, modulus1);
- END;
- value2 :=
- factor2 * (value2 MOD quotient2) - remainder2 * (value2 DIV quotient2);
- IF value2 < 0 THEN
- INC(value2, modulus2);
- END;
- END CongruentialStep;
-
- PROCEDURE DefaultSequenceValue(sequence: Sequence): LONGREAL;
- VAR
- value: LONGINT;
- BEGIN
- WITH sequence: DefaultSequence DO
- CongruentialStep(sequence.value1, sequence.value2);
- value := sequence.value1 - sequence.value2;
- IF value <= 0 THEN
- INC(value, modulus1);
- END;
- RETURN (value - 1.) / (modulus1 - 1.)
- END;
- END DefaultSequenceValue;
-
- PROCEDURE DefaultSequenceRewind(sequence: Sequence);
- BEGIN
- WITH sequence: DefaultSequence DO
- sequence.value1 := sequence.seed1;
- sequence.value2 := sequence.seed2;
- END;
- END DefaultSequenceRewind;
-
- PROCEDURE DefaultSequenceRestart(sequence, seed: Sequence);
- BEGIN
- WITH sequence: DefaultSequence DO
- sequence.seed1 := ValS(seed, 1, modulus1-1);
- sequence.seed2 := ValS(seed, 1, modulus2-1);
- sequence.value1 := sequence.seed1;
- sequence.value2 := sequence.seed2;
- END;
- END DefaultSequenceRestart;
-
- PROCEDURE CreateDefaultSequences;
- VAR
- mySeed, myStd: DefaultSequence;
- if: Interface;
- daytime: Times.Time;
- timeval: Times.TimeValueRec;
- count: LONGINT;
-
- PROCEDURE Hash(str: ARRAY OF CHAR): LONGINT;
- VAR
- index,
- val: LONGINT;
- BEGIN
- val := 27567352;
- index := 0;
- WHILE str[index] # 0X DO
- val := (val MOD 16777216) * 128 +
- (val DIV 16777216 + ORD(str[index])) MOD 128;
- INC(index);
- END; (*WHILE*)
- RETURN val
- END Hash;
-
- BEGIN
- (* define interface for all default sequences *)
- NEW(if);
- if.longRealValS := DefaultSequenceValue;
- if.rewindSequence := DefaultSequenceRewind;
- if.restartSequence := DefaultSequenceRestart;
-
- (* fake initial randomness using some portably accessible sources *)
- NEW(mySeed);
- Services.Init(mySeed, defaultSequenceType);
- Init(mySeed, if, {longRealValS});
- Clocks.GetTime(Clocks.system, daytime);
- Times.GetValue(daytime, timeval);
- (* extract those 31 bits from daytime that are most likely to vary *)
- mySeed.value1 := timeval.usec * 2048 + timeval.second MOD 65536 + 1;
- (* generate 31 more bits from the process name *)
- mySeed.value2 := Hash(Process.name) MOD (modulus2 - 1) + 1;
- (* scramble these values *)
- count := 0;
- WHILE count < 4 DO
- CongruentialStep(mySeed.value1, mySeed.value2);
- INC(count);
- END;
- (* mix them together *)
- DefaultSequenceRestart(mySeed, mySeed);
- seed := mySeed;
-
- (* now use our seed to initialize std sequence *)
- NEW(myStd);
- Services.Init(myStd, defaultSequenceType);
- Init(myStd, if, {longRealValS, rewindSequence, restartSequence});
- DefaultSequenceRestart(myStd, mySeed);
- std := myStd;
-
- unpredictable := NIL;
- END CreateDefaultSequences;
+ unpredictable := NIL;
+ END CreateDefaultSequences;
BEGIN
- serviceDiscID := Disciplines.Unique();
- Services.Create(service, "RandomGenerators");
- Services.CreateType(sequenceType, "RandomGenerators.Sequence", "");
- Services.CreateType(defaultSequenceType, "RandomGenerators.DefaultSequence",
- "RandomGenerators.Sequence");
- CreateDefaultSequences;
+ serviceDiscID := Disciplines.Unique();
+ Services.Create(service, "RandomGenerators");
+ Services.CreateType(sequenceType, "RandomGenerators.Sequence", "");
+ Services.CreateType(defaultSequenceType, "RandomGenerators.DefaultSequence",
+ "RandomGenerators.Sequence");
+ CreateDefaultSequences;
END ulmRandomGenerators.
diff --git a/src/library/ulm/ulmRelatedEvents.Mod b/src/library/ulm/ulmRelatedEvents.Mod
index 6f9a0c32..a5ad5453 100644
--- a/src/library/ulm/ulmRelatedEvents.Mod
+++ b/src/library/ulm/ulmRelatedEvents.Mod
@@ -1,422 +1,429 @@
(* Ulm's Oberon Library
- Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
- ----------------------------------------------------------------------------
- Ulm's Oberon Library is free software; you can redistribute it
- and/or modify it under the terms of the GNU Library General Public
- License as published by the Free Software Foundation; either version
- 2 of the License, or (at your option) any later version.
+ Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
+ ----------------------------------------------------------------------------
+ Ulm's Oberon Library is free software; you can redistribute it
+ and/or modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either version
+ 2 of the License, or (at your option) any later version.
- Ulm's Oberon Library is distributed in the hope that it will be
- useful, but WITHOUT ANY WARRANTY; without even the implied warranty
- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Library General Public License for more details.
+ Ulm's Oberon Library is distributed in the hope that it will be
+ useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+ of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
- You should have received a copy of the GNU Library General Public
- License along with this library; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ----------------------------------------------------------------------------
- E-mail contact: oberon@mathematik.uni-ulm.de
- ----------------------------------------------------------------------------
- $Id: RelatedEven.om,v 1.8 2005/04/28 08:30:09 borchert Exp $
- ----------------------------------------------------------------------------
- $Log: RelatedEven.om,v $
- Revision 1.8 2005/04/28 08:30:09 borchert
- added assertion to Forward that takes care that from # to
- (otherwise we get a nasty infinite loop)
+ You should have received a copy of the GNU Library General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ----------------------------------------------------------------------------
+ E-mail contact: oberon@mathematik.uni-ulm.de
+ ----------------------------------------------------------------------------
+ $Id: RelatedEven.om,v 1.8 2005/04/28 08:30:09 borchert Exp $
+ ----------------------------------------------------------------------------
+ $Log: RelatedEven.om,v $
+ Revision 1.8 2005/04/28 08:30:09 borchert
+ added assertion to Forward that takes care that from # to
+ (otherwise we get a nasty infinite loop)
- Revision 1.7 2004/09/09 21:04:24 borchert
- undoing change of Revision 1.5:
- fields dependants and dependson must not be subject of
- Save/Restore as this makes it impossible to undo the
- dependencies within the TerminationHandler
- we no longer remove the discipline in case of terminated
- objects as this causes a list of error events to be lost
+ Revision 1.7 2004/09/09 21:04:24 borchert
+ undoing change of Revision 1.5:
+ fields dependants and dependson must not be subject of
+ Save/Restore as this makes it impossible to undo the
+ dependencies within the TerminationHandler
+ we no longer remove the discipline in case of terminated
+ objects as this causes a list of error events to be lost
- Revision 1.6 2004/02/18 17:01:59 borchert
- Raise asserts now that event.type # NIL
+ Revision 1.6 2004/02/18 17:01:59 borchert
+ Raise asserts now that event.type # NIL
- Revision 1.5 2004/02/18 16:53:48 borchert
- fields dependants and dependson moved from discipline to state
- object to support them for Save/Restore
+ Revision 1.5 2004/02/18 16:53:48 borchert
+ fields dependants and dependson moved from discipline to state
+ object to support them for Save/Restore
- Revision 1.4 1998/01/12 14:39:18 borchert
- some bug fixes around RelatedEvents.null
+ Revision 1.4 1998/01/12 14:39:18 borchert
+ some bug fixes around RelatedEvents.null
- Revision 1.3 1995/03/20 17:05:13 borchert
- - Save & Restore added
- - support for Forwarders & Resources added
+ Revision 1.3 1995/03/20 17:05:13 borchert
+ - Save & Restore added
+ - support for Forwarders & Resources added
- Revision 1.2 1994/08/27 14:49:44 borchert
- null object added
+ Revision 1.2 1994/08/27 14:49:44 borchert
+ null object added
- Revision 1.1 1994/02/22 20:09:53 borchert
- Initial revision
+ Revision 1.1 1994/02/22 20:09:53 borchert
+ Initial revision
- ----------------------------------------------------------------------------
- AFB 11/91
- ----------------------------------------------------------------------------
+ ----------------------------------------------------------------------------
+ AFB 11/91
+ ----------------------------------------------------------------------------
*)
MODULE ulmRelatedEvents;
- (* relate events to objects *)
+ (* relate events to objects *)
- IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, Forwarders := ulmForwarders, Objects := ulmObjects, Priorities := ulmPriorities, Resources := ulmResources, SYSTEM;
+ IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, Forwarders := ulmForwarders, Objects := ulmObjects, Priorities := ulmPriorities, Resources := ulmResources, SYSTEM;
- CONST
- (* possible directions of propagated events *)
- forward = 0; (* forward along the forwardTo chain, if given *)
- backward = 1; (* forward event to all dependants, if present *)
- both = 2; (* forward event to both directions *)
- TYPE
- Direction = SHORTINT; (* forward, backward, both *)
+ CONST
+ (* possible directions of propagated events *)
+ forward = 0; (* forward along the forwardTo chain, if given *)
+ backward = 1; (* forward event to all dependants, if present *)
+ both = 2; (* forward event to both directions *)
+ TYPE
+ Direction = SHORTINT; (* forward, backward, both *)
- TYPE
- Object* = Disciplines.Object;
- Event* = POINTER TO EventRec;
- EventRec* =
- RECORD
- (Events.EventRec)
- object*: Object;
- event*: Events.Event;
- END;
- Queue* = POINTER TO QueueRec;
- QueueRec* =
- RECORD
- (Objects.ObjectRec)
- event*: Events.Event;
- next*: Queue;
- END;
- ObjectList = POINTER TO ObjectListRec;
- ObjectListRec =
- RECORD
- object: Object;
- next: ObjectList;
- END;
-
- TYPE
- State = POINTER TO StateRec;
- StateRec =
- RECORD
- default: BOOLEAN; (* default reaction? *)
- eventType: Events.EventType; (* may be NIL *)
- queue: BOOLEAN; (* are events to be queued? *)
- forwardto: Object;
- head, tail: Queue;
- saved: State;
- END;
- Discipline = POINTER TO DisciplineRec;
- DisciplineRec =
- RECORD
- (Disciplines.DisciplineRec)
- state: State;
- dependants: ObjectList;
- dependsOn: Object;
- END;
- VAR
- id: Disciplines.Identifier;
- VAR
- null*: Object; (* object which ignores all related events *)
- nullevent: Events.EventType;
-
- PROCEDURE RemoveDependant(VAR list: ObjectList; dependant: Object);
- VAR
- prev, p: ObjectList;
- BEGIN
- prev := NIL; p := list;
- WHILE (p # NIL) & (p.object # dependant) DO
- prev := p; p := p.next;
+ TYPE
+ Object* = Disciplines.Object;
+ Event* = POINTER TO EventRec;
+ EventRec* =
+ RECORD
+ (Events.EventRec)
+ object*: Object;
+ event*: Events.Event;
END;
- IF p # NIL THEN
- IF prev = NIL THEN
- list := p.next;
- ELSE
- prev.next := p.next;
- END;
+ Queue* = POINTER TO QueueRec;
+ QueueRec* =
+ RECORD
+ (Objects.ObjectRec)
+ event*: Events.Event;
+ next*: Queue;
END;
- END RemoveDependant;
-
- PROCEDURE TerminationHandler(event: Events.Event);
- VAR
- disc: Discipline;
- BEGIN
- WITH event: Resources.Event DO
- IF (event.change = Resources.terminated) &
- Disciplines.Seek(event.resource, id, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN (* noch *)
- IF (disc.dependsOn # NIL) &
- Disciplines.Seek(disc.dependsOn, id, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN (* noch *)
- RemoveDependant(disc.dependants, event.resource);
- disc.dependsOn := NIL;
- END;
- (*
- afb 9/2004:
- do not remove this discipline for dead objects
- as this makes it impossible to retrieve the final
- list of error events
- Disciplines.Remove(event.resource, id);
- *)
- END;
+ ObjectList = POINTER TO ObjectListRec;
+ ObjectListRec =
+ RECORD
+ object: Object;
+ next: ObjectList;
END;
- END TerminationHandler;
- PROCEDURE CreateState(VAR state: State);
- BEGIN
- NEW(state);
- state.eventType := NIL;
- state.queue := FALSE; state.head := NIL; state.tail := NIL;
- state.forwardto := NIL;
- state.default := TRUE;
- state.saved := NIL;
- END CreateState;
+ TYPE
+ State = POINTER TO StateRec;
+ StateRec =
+ RECORD
+ default: BOOLEAN; (* default reaction? *)
+ eventType: Events.EventType; (* may be NIL *)
+ queue: BOOLEAN; (* are events to be queued? *)
+ forwardto: Object;
+ head, tail: Queue;
+ saved: State;
+ END;
+ Discipline = POINTER TO DisciplineRec;
+ DisciplineRec =
+ RECORD
+ (Disciplines.DisciplineRec)
+ state: State;
+ dependants: ObjectList;
+ dependsOn: Object;
+ END;
+ VAR
+ id: Disciplines.Identifier;
+ VAR
+ null*: Object; (* object which ignores all related events *)
+ nullevent: Events.EventType;
- PROCEDURE CreateDiscipline(VAR disc: Discipline);
- BEGIN
- NEW(disc); disc.id := id; CreateState(disc.state);
- END CreateDiscipline;
-
- PROCEDURE GetEventType*(object: Object; VAR eventType: Events.EventType);
- (* returns an event type for the given object;
- all events related to the object are also handled by this event type
- *)
- VAR
- disc: Discipline;
- state: State;
- BEGIN
- IF object = null THEN
- eventType := nullevent;
+ PROCEDURE RemoveDependant(VAR list: ObjectList; dependant: Object);
+ VAR
+ prev, p: ObjectList;
+ BEGIN
+ prev := NIL; p := list;
+ WHILE (p # NIL) & (p.object # dependant) DO
+ prev := p; p := p.next;
+ END;
+ IF p # NIL THEN
+ IF prev = NIL THEN
+ list := p.next;
ELSE
- IF ~Disciplines.Seek(object, id, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN (* noch *)
- CreateDiscipline(disc);
- Disciplines.Add(object, disc);
- END;
- state := disc.state;
- state.default := FALSE;
- IF state.eventType = NIL THEN
- Events.Define(state.eventType);
- Events.SetPriority(state.eventType, Priorities.liberrors + 1);
- Events.Ignore(state.eventType);
- END;
- eventType := state.eventType;
+ prev.next := p.next;
END;
- END GetEventType;
+ END;
+ END RemoveDependant;
- PROCEDURE Forward*(from, to: Object);
- (* causes all events related to `from' to be forwarded to `to' *)
- VAR
- disc: Discipline;
- BEGIN
- IF (from # NIL) & (from # null) THEN
- ASSERT(from # to);
- IF ~Disciplines.Seek(from, id, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN (* noch *)
- CreateDiscipline(disc);
- Disciplines.Add(from, disc);
- END;
- IF to = null THEN
- to := NIL;
- END;
- disc.state.forwardto := to;
- disc.state.default := FALSE;
+ PROCEDURE Seek(object: Object; id: Disciplines.Identifier;
+ VAR discipline: Discipline): BOOLEAN;
+ VAR
+ disc: Disciplines.Discipline;
+ result: BOOLEAN;
+ BEGIN
+ result := Disciplines.Seek(object, id, disc);
+ IF result THEN discipline := disc(Discipline) ELSE discipline := NIL END;
+ RETURN result
+ END Seek;
+
+ PROCEDURE TerminationHandler(event: Events.Event);
+ VAR
+ disc: Discipline;
+ BEGIN
+ WITH event: Resources.Event DO
+ IF (event.change = Resources.terminated) & Seek(event.resource, id, disc) THEN
+ IF (disc.dependsOn # NIL) & Seek(disc.dependsOn, id, disc) THEN
+ RemoveDependant(disc.dependants, event.resource);
+ disc.dependsOn := NIL;
+ END;
+ (*
+ afb 9/2004:
+ do not remove this discipline for dead objects
+ as this makes it impossible to retrieve the final
+ list of error events
+ Disciplines.Remove(event.resource, id);
+ *)
END;
- END Forward;
+ END;
+ END TerminationHandler;
- PROCEDURE ForwardToDependants(from, to: Forwarders.Object);
- (* is called by Forwarders.Forward:
- build a backward chain from `to' to `from'
- *)
- VAR
- fromDisc, toDisc: Discipline;
- member: ObjectList;
- eventType: Events.EventType;
- BEGIN
- IF (from = null) OR (to = null) THEN RETURN END;
- IF ~Disciplines.Seek(from, id, SYSTEM.VAL(Disciplines.Discipline, fromDisc)) THEN (* noch *)
- CreateDiscipline(fromDisc); Disciplines.Add(from, fromDisc);
+ PROCEDURE CreateState(VAR state: State);
+ BEGIN
+ NEW(state);
+ state.eventType := NIL;
+ state.queue := FALSE; state.head := NIL; state.tail := NIL;
+ state.forwardto := NIL;
+ state.default := TRUE;
+ state.saved := NIL;
+ END CreateState;
+
+ PROCEDURE CreateDiscipline(VAR disc: Discipline);
+ BEGIN
+ NEW(disc); disc.id := id; CreateState(disc.state);
+ END CreateDiscipline;
+
+ PROCEDURE GetEventType*(object: Object; VAR eventType: Events.EventType);
+ (* returns an event type for the given object;
+ all events related to the object are also handled by this event type
+ *)
+ VAR
+ disc: Discipline;
+ state: State;
+ BEGIN
+ IF object = null THEN
+ eventType := nullevent;
+ ELSE
+ IF ~Seek(object, id, disc) THEN
+ CreateDiscipline(disc);
+ Disciplines.Add(object, disc);
END;
- IF fromDisc.dependsOn # NIL THEN RETURN END;
- fromDisc.dependsOn := to;
- Resources.TakeInterest(from, eventType);
- Events.Handler(eventType, TerminationHandler);
-
- IF ~Disciplines.Seek(to, id, SYSTEM.VAL(Disciplines.Discipline, toDisc)) THEN (* noch *)
- CreateDiscipline(toDisc); Disciplines.Add(to, toDisc);
+ state := disc.state;
+ state.default := FALSE;
+ IF state.eventType = NIL THEN
+ Events.Define(state.eventType);
+ Events.SetPriority(state.eventType, Priorities.liberrors + 1);
+ Events.Ignore(state.eventType);
END;
- NEW(member); member.object := from;
- member.next := toDisc.dependants; toDisc.dependants := member;
- END ForwardToDependants;
+ eventType := state.eventType;
+ END;
+ END GetEventType;
- PROCEDURE QueueEvents*(object: Object);
- (* put all incoming events into a queue *)
- VAR
- disc: Discipline;
- state: State;
- BEGIN
- IF (object # NIL) & (object # null) THEN
- IF ~Disciplines.Seek(object, id, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN
- CreateDiscipline(disc);
- Disciplines.Add(object, disc);
- END;
- state := disc.state;
- state.default := FALSE;
- IF ~state.queue THEN
- state.queue := TRUE; state.head := NIL; state.tail := NIL;
- END;
+ PROCEDURE Forward*(from, to: Object);
+ (* causes all events related to `from' to be forwarded to `to' *)
+ VAR
+ disc: Discipline;
+ BEGIN
+ IF (from # NIL) & (from # null) THEN
+ ASSERT(from # to);
+ IF ~Seek(from, id, disc) THEN
+ CreateDiscipline(disc);
+ Disciplines.Add(from, disc);
END;
- END QueueEvents;
+ IF to = null THEN
+ to := NIL;
+ END;
+ disc.state.forwardto := to;
+ disc.state.default := FALSE;
+ END;
+ END Forward;
- PROCEDURE GetQueue*(object: Object; VAR queue: Queue);
- (* return queue of related events which is removed
- from the object;
- object must have been prepared by QueueEvents
- *)
- VAR
- disc: Discipline;
- state: State;
- BEGIN
- IF (object # NIL) & (object # null) &
- Disciplines.Seek(object, id, SYSTEM.VAL(Disciplines.Discipline, disc)) & disc.state.queue THEN (* noch *)
- state := disc.state;
- queue := state.head; state.head := NIL; state.tail := NIL;
+ PROCEDURE ForwardToDependants(from, to: Forwarders.Object);
+ (* is called by Forwarders.Forward:
+ build a backward chain from `to' to `from'
+ *)
+ VAR
+ fromDisc, toDisc: Discipline;
+ member: ObjectList;
+ eventType: Events.EventType;
+ BEGIN
+ IF (from = null) OR (to = null) THEN RETURN END;
+ IF ~Seek(from, id, fromDisc) THEN
+ CreateDiscipline(fromDisc); Disciplines.Add(from, fromDisc);
+ END;
+ IF fromDisc.dependsOn # NIL THEN RETURN END;
+ fromDisc.dependsOn := to;
+ Resources.TakeInterest(from, eventType);
+ Events.Handler(eventType, TerminationHandler);
+
+ IF ~Seek(to, id, toDisc) THEN
+ CreateDiscipline(toDisc); Disciplines.Add(to, toDisc);
+ END;
+ NEW(member); member.object := from;
+ member.next := toDisc.dependants; toDisc.dependants := member;
+ END ForwardToDependants;
+
+ PROCEDURE QueueEvents*(object: Object);
+ (* put all incoming events into a queue *)
+ VAR
+ disc: Discipline;
+ state: State;
+ BEGIN
+ IF (object # NIL) & (object # null) THEN
+ IF ~Seek(object, id, disc) THEN
+ CreateDiscipline(disc);
+ Disciplines.Add(object, disc);
+ END;
+ state := disc.state;
+ state.default := FALSE;
+ IF ~state.queue THEN
+ state.queue := TRUE; state.head := NIL; state.tail := NIL;
+ END;
+ END;
+ END QueueEvents;
+
+ PROCEDURE GetQueue*(object: Object; VAR queue: Queue);
+ (* return queue of related events which is removed
+ from the object;
+ object must have been prepared by QueueEvents
+ *)
+ VAR
+ disc: Discipline;
+ state: State;
+ BEGIN
+ IF (object # NIL) & (object # null) & Seek(object, id, disc) & disc.state.queue THEN
+ state := disc.state;
+ queue := state.head; state.head := NIL; state.tail := NIL;
+ ELSE
+ queue := NIL;
+ END;
+ END GetQueue;
+
+ PROCEDURE EventsPending*(object: Object) : BOOLEAN;
+ (* return TRUE if GetQueue will return a queue # NIL *)
+ VAR
+ disc: Discipline;
+ BEGIN
+ IF (object # NIL) & (object # null) & Seek(object, id, disc) & disc.state.queue THEN
+ RETURN disc.state.head # NIL
+ ELSE
+ RETURN FALSE
+ END;
+ END EventsPending;
+
+ PROCEDURE Reset*(object: Object);
+ (* return to default behaviour *)
+ VAR
+ disc: Discipline;
+ state: State;
+ BEGIN
+ IF object # null THEN
+ IF Seek(object, id, disc) THEN
+ IF (disc.state.saved = NIL) &
+ (disc.dependsOn = NIL) &
+ (disc.dependants = NIL) THEN
+ Disciplines.Remove(object, id);
+ ELSE
+ state := disc.state;
+ state.queue := FALSE; state.head := NIL; state.tail := NIL;
+ state.eventType := NIL; state.forwardto := NIL;
+ state.default := TRUE;
+ END;
+ END;
+ END;
+ END Reset;
+
+ PROCEDURE Save*(object: Object);
+ (* save current status of the given object and reset to
+ default behaviour;
+ the status includes the reaction types and event queues;
+ Save operations may be nested
+ *)
+ VAR
+ disc: Discipline;
+ state: State;
+ BEGIN
+ IF object # null THEN
+ IF ~Seek(object, id, disc) THEN
+ CreateDiscipline(disc);
+ Disciplines.Add(object, disc);
+ END;
+ CreateState(state);
+ state.saved := disc.state; disc.state := state;
+ END;
+ END Save;
+
+ PROCEDURE Restore*(object: Object);
+ (* restore status saved earlier by Save *)
+ VAR
+ disc: Discipline;
+ BEGIN
+ IF Seek(object, id, disc) & (disc.state.saved # NIL) THEN
+ disc.state := disc.state.saved;
+ END;
+ END Restore;
+
+ PROCEDURE InternalRaise(object: Object; dir: Direction; event: Events.Event);
+ VAR
+ disc: Discipline;
+ state: State;
+ relEvent: Event;
+ element: Queue; (* new element of queue *)
+ dependant: ObjectList;
+ BEGIN
+ IF (object = null) OR ~Seek(object, id, disc) THEN RETURN END;
+
+ (* backward chaining *)
+ IF (disc.dependants # NIL) & (dir IN {backward, both}) THEN
+ dependant := disc.dependants;
+ WHILE dependant # NIL DO
+ InternalRaise(dependant.object, backward, event);
+ dependant := dependant.next;
+ END;
+ END;
+
+ (* local handling & forward chaining *)
+ IF ~disc.state.default THEN
+ state := disc.state;
+ IF state.queue THEN
+ NEW(element); element.next := NIL; element.event := event;
+ IF state.tail # NIL THEN
+ state.tail.next := element;
+ ELSE
+ state.head := element;
+ END;
+ state.tail := element;
+ END;
+ IF state.eventType # NIL THEN
+ NEW(relEvent);
+ relEvent.message := event.message;
+ relEvent.type := state.eventType;
+ relEvent.object := object;
+ relEvent.event := event;
+ Events.Raise(relEvent);
+ END;
+ IF (state.forwardto # NIL) & (dir IN {both, forward}) THEN
+ InternalRaise(state.forwardto, forward, event);
+ END;
+ END;
+ END InternalRaise;
+
+ PROCEDURE Raise*(object: Object; event: Events.Event);
+ VAR
+ disc: Discipline;
+ BEGIN
+ ASSERT(event.type # NIL);
+ IF object # null THEN
+ IF (object = NIL) OR ~Seek(object, id, disc) THEN
+ Events.Raise(event);
ELSE
- queue := NIL;
+ InternalRaise(object, both, event);
END;
- END GetQueue;
+ END;
+ END Raise;
- PROCEDURE EventsPending*(object: Object) : BOOLEAN;
- (* return TRUE if GetQueue will return a queue # NIL *)
- VAR
- disc: Discipline;
- BEGIN
- IF (object # NIL) & (object # null) &
- Disciplines.Seek(object, id, SYSTEM.VAL(Disciplines.Discipline, disc)) & disc.state.queue THEN (* noch *)
- RETURN disc.state.head # NIL
- ELSE
- RETURN FALSE
- END;
- END EventsPending;
-
- PROCEDURE Reset*(object: Object);
- (* return to default behaviour *)
- VAR
- disc: Discipline;
- state: State;
- BEGIN
- IF object # null THEN
- IF Disciplines.Seek(object, id, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN (* noch *)
- IF (disc.state.saved = NIL) &
- (disc.dependsOn = NIL) &
- (disc.dependants = NIL) THEN
- Disciplines.Remove(object, id);
- ELSE
- state := disc.state;
- state.queue := FALSE; state.head := NIL; state.tail := NIL;
- state.eventType := NIL; state.forwardto := NIL;
- state.default := TRUE;
- END;
- END;
- END;
- END Reset;
-
- PROCEDURE Save*(object: Object);
- (* save current status of the given object and reset to
- default behaviour;
- the status includes the reaction types and event queues;
- Save operations may be nested
- *)
- VAR
- disc: Discipline;
- state: State;
- BEGIN
- IF object # null THEN
- IF ~Disciplines.Seek(object, id, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN (* noch *)
- CreateDiscipline(disc);
- Disciplines.Add(object, disc);
- END;
- CreateState(state);
- state.saved := disc.state; disc.state := state;
- END;
- END Save;
-
- PROCEDURE Restore*(object: Object);
- (* restore status saved earlier by Save *)
- VAR
- disc: Discipline;
- BEGIN
- IF Disciplines.Seek(object, id, SYSTEM.VAL(Disciplines.Discipline, disc)) & (disc.state.saved # NIL) THEN (* noch *)
- disc.state := disc.state.saved;
- END;
- END Restore;
-
- PROCEDURE InternalRaise(object: Object; dir: Direction; event: Events.Event);
- VAR
- disc: Discipline;
- state: State;
- relEvent: Event;
- element: Queue; (* new element of queue *)
- dependant: ObjectList;
- BEGIN
- IF (object = null) OR ~Disciplines.Seek(object, id, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN RETURN END;
-
- (* backward chaining *)
- IF (disc.dependants # NIL) & (dir IN {backward, both}) THEN
- dependant := disc.dependants;
- WHILE dependant # NIL DO
- InternalRaise(dependant.object, backward, event);
- dependant := dependant.next;
- END;
- END;
-
- (* local handling & forward chaining *)
- IF ~disc.state.default THEN
- state := disc.state;
- IF state.queue THEN
- NEW(element); element.next := NIL; element.event := event;
- IF state.tail # NIL THEN
- state.tail.next := element;
- ELSE
- state.head := element;
- END;
- state.tail := element;
- END;
- IF state.eventType # NIL THEN
- NEW(relEvent);
- relEvent.message := event.message;
- relEvent.type := state.eventType;
- relEvent.object := object;
- relEvent.event := event;
- Events.Raise(relEvent);
- END;
- IF (state.forwardto # NIL) & (dir IN {both, forward}) THEN
- InternalRaise(state.forwardto, forward, event);
- END;
- END;
- END InternalRaise;
-
- PROCEDURE Raise*(object: Object; event: Events.Event);
- VAR
- disc: Discipline;
- BEGIN
- ASSERT(event.type # NIL);
- IF object # null THEN
- IF (object = NIL) OR ~Disciplines.Seek(object, id, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN (* noch *)
- Events.Raise(event);
- ELSE
- InternalRaise(object, both, event);
- END;
- END;
- END Raise;
-
- PROCEDURE AppendQueue*(object: Object; queue: Queue);
- (* Raise(object, event) for all events of the queue *)
- BEGIN
- WHILE queue # NIL DO
- Raise(object, queue.event);
- queue := queue.next;
- END;
- END AppendQueue;
+ PROCEDURE AppendQueue*(object: Object; queue: Queue);
+ (* Raise(object, event) for all events of the queue *)
+ BEGIN
+ WHILE queue # NIL DO
+ Raise(object, queue.event);
+ queue := queue.next;
+ END;
+ END AppendQueue;
BEGIN
- id := Disciplines.Unique();
- NEW(null);
- Events.Define(nullevent);
- Forwarders.Register("", ForwardToDependants);
+ id := Disciplines.Unique();
+ NEW(null);
+ Events.Define(nullevent);
+ Forwarders.Register("", ForwardToDependants);
END ulmRelatedEvents.
diff --git a/src/library/ulm/ulmResources.Mod b/src/library/ulm/ulmResources.Mod
index 9ff929bd..a700d22a 100644
--- a/src/library/ulm/ulmResources.Mod
+++ b/src/library/ulm/ulmResources.Mod
@@ -107,19 +107,11 @@ MODULE ulmResources;
(* === private procedures ============================================ *)
PROCEDURE GetDisc(resource: Resource; VAR disc: Discipline);
+ VAR d: Disciplines.Discipline;
BEGIN
- (*IF ~Disciplines.Seek(resource, discID, disc) THEN*)
- (* this line causes error
- err 123 type of actual parameter is not identical with that of formal VAR-parameter
- because Discipline defined in this module is an extention of the same type in module Disciplines
- Disciplines.Seek expects Disciplines.Discipline, not the extended type.
- voc (ofront, OP2, as well as oo2c) behaves right by not allowing this, while Ulm's Oberon system
- accepts this.
- So we introduce here a workaround, which makes usage of this module unsafe;
-
- noch
- *)
- IF ~Disciplines.Seek(resource, discID, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN (* noch *)
+ IF Disciplines.Seek(resource, discID, d) THEN
+ disc := d(Discipline)
+ ELSE
NEW(disc); disc.id := discID;
disc.state := alive; disc.refcnt := 0;
disc.eventType := NIL;
diff --git a/src/library/ulm/ulmSYSTEM.Mod b/src/library/ulm/ulmSYSTEM.Mod
index 838548f0..ece334a7 100644
--- a/src/library/ulm/ulmSYSTEM.Mod
+++ b/src/library/ulm/ulmSYSTEM.Mod
@@ -49,24 +49,27 @@ TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
RETURN oldflag;
END TAS;
+(*
PROCEDURE UNIXCALL*(syscall: LONGINT; VAR d0, d1: LONGINT; (* in ulm version both LONGINT and INTEGER are 4 byte size *)
- arg1, arg2, arg3: LONGINT) : BOOLEAN;
+ arg1, arg2, arg3: LONGINT) : BOOLEAN;
VAR
n: LONGINT;
ch: CHAR;
pch: pchar;
- pstr: pstring;
+ pstr: pstring;
h: Platform.FileHandle;
(* pst : pstatus; *)
BEGIN
-
+
IF syscall = Sys.read THEN
- RETURN Platform.Read(arg1, arg2, arg3, n) = 0;
+ d0 := Platform.Read(arg1, arg2, arg3, n);
+ IF d0 >= 0 THEN d0 := n END;
+ RETURN d0 >= 0;
(*NEW(pch);
pch := SYSTEM.VAL(pchar, arg2);
ch := pch^[0];
n := read(ch);
- IF n # 1 THEN
+ IF n # 1 THEN
ch := 0X;
RETURN FALSE
ELSE
@@ -81,7 +84,7 @@ TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
n := Write(SYSTEM.VAL(LONGINT, pch), 1);
IF n # 1 THEN RETURN FALSE ELSE RETURN TRUE END
*)
- ELSIF syscall = Sys.open THEN
+ ELSIF syscall = Sys.open THEN
pstr := SYSTEM.VAL(pstring, arg1);
IF SYSTEM.VAL(SET, arg3) * {0,1} # {} THEN
RETURN Platform.OldRW(pstr^, d0) = 0
@@ -120,7 +123,7 @@ TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
END
END UNIXCALL;
-
+*)
PROCEDURE UNIXFORK(VAR pid: LONGINT) : BOOLEAN;
BEGIN
@@ -133,8 +136,7 @@ TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
END UNIXSIGNAL;
- PROCEDURE WMOVE*(from, to, n : LONGINT);
- VAR l : LONGINT;
+ PROCEDURE WMOVE*(from, to, n : SYSTEM.ADDRESS);
BEGIN
SYSTEM.MOVE(from, to, n);
END WMOVE;
diff --git a/src/library/ulm/ulmScales.Mod b/src/library/ulm/ulmScales.Mod
index 5de1188b..12cf5363 100644
--- a/src/library/ulm/ulmScales.Mod
+++ b/src/library/ulm/ulmScales.Mod
@@ -1,446 +1,446 @@
(* Ulm's Oberon Library
- Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
- ----------------------------------------------------------------------------
- Ulm's Oberon Library is free software; you can redistribute it
- and/or modify it under the terms of the GNU Library General Public
- License as published by the Free Software Foundation; either version
- 2 of the License, or (at your option) any later version.
+ Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
+ ----------------------------------------------------------------------------
+ Ulm's Oberon Library is free software; you can redistribute it
+ and/or modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either version
+ 2 of the License, or (at your option) any later version.
- Ulm's Oberon Library is distributed in the hope that it will be
- useful, but WITHOUT ANY WARRANTY; without even the implied warranty
- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Library General Public License for more details.
+ Ulm's Oberon Library is distributed in the hope that it will be
+ useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+ of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
- You should have received a copy of the GNU Library General Public
- License along with this library; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ----------------------------------------------------------------------------
- E-mail contact: oberon@mathematik.uni-ulm.de
- ----------------------------------------------------------------------------
- $Id: Scales.om,v 1.3 2004/09/03 09:31:53 borchert Exp $
- ----------------------------------------------------------------------------
- $Log: Scales.om,v $
- Revision 1.3 2004/09/03 09:31:53 borchert
- bug fixes: Services.Init added in CreateOperand
- Scales.Measure changed to Measure
+ You should have received a copy of the GNU Library General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ----------------------------------------------------------------------------
+ E-mail contact: oberon@mathematik.uni-ulm.de
+ ----------------------------------------------------------------------------
+ $Id: Scales.om,v 1.3 2004/09/03 09:31:53 borchert Exp $
+ ----------------------------------------------------------------------------
+ $Log: Scales.om,v $
+ Revision 1.3 2004/09/03 09:31:53 borchert
+ bug fixes: Services.Init added in CreateOperand
+ Scales.Measure changed to Measure
- Revision 1.2 1995/01/16 21:40:39 borchert
- - assertions of Assertions converted into real assertions
- - fixes due to changed if of PersistentObjects
+ Revision 1.2 1995/01/16 21:40:39 borchert
+ - assertions of Assertions converted into real assertions
+ - fixes due to changed if of PersistentObjects
- Revision 1.1 1994/02/22 20:10:03 borchert
- Initial revision
+ Revision 1.1 1994/02/22 20:10:03 borchert
+ Initial revision
- ----------------------------------------------------------------------------
- AFB 12/91
- ----------------------------------------------------------------------------
+ ----------------------------------------------------------------------------
+ AFB 12/91
+ ----------------------------------------------------------------------------
*)
MODULE ulmScales;
- IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, Objects := ulmObjects, Operations := ulmOperations, PersistentObjects := ulmPersistentObjects,
- RelatedEvents := ulmRelatedEvents, Services := ulmServices, SYS := SYSTEM;
+ IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, Objects := ulmObjects, Operations := ulmOperations, PersistentObjects := ulmPersistentObjects,
+ RelatedEvents := ulmRelatedEvents, Services := ulmServices, SYS := SYSTEM;
- TYPE
- Scale* = POINTER TO ScaleRec;
- Family* = POINTER TO FamilyRec;
- FamilyRec* =
- RECORD
- (Disciplines.ObjectRec)
- (* private components *)
- reference: Scale;
- END;
-
- TYPE
- Unit* = POINTER TO UnitRec;
- UnitList = POINTER TO UnitListRec;
- UnitListRec =
- RECORD
- unit: Unit;
- next: UnitList;
- END;
- Interface* = POINTER TO InterfaceRec;
- ScaleRec* =
- RECORD
- (Disciplines.ObjectRec)
- (* private components *)
- if: Interface;
- family: Family;
- head, tail: UnitList;
- nextUnit: UnitList;
- END;
-
- CONST
- unitNameLength* = 32;
- TYPE
- UnitName* = ARRAY unitNameLength OF CHAR;
- UnitRec* = RECORD
- (Disciplines.ObjectRec)
- name: UnitName;
- scale: Scale;
+ TYPE
+ Scale* = POINTER TO ScaleRec;
+ Family* = POINTER TO FamilyRec;
+ FamilyRec* =
+ RECORD
+ (Disciplines.ObjectRec)
+ (* private components *)
+ reference: Scale;
END;
- CONST
- undefined = 0; absolute* = 1; relative* = 2;
- TYPE
- Measure* = POINTER TO MeasureRec;
- MeasureRec* =
- RECORD
- (Operations.OperandRec)
- scale: Scale;
- type: SHORTINT; (* absolute or relative? *)
- END;
- VAR
- measureType: Services.Type;
+ TYPE
+ Unit* = POINTER TO UnitRec;
+ UnitList = POINTER TO UnitListRec;
+ UnitListRec =
+ RECORD
+ unit: Unit;
+ next: UnitList;
+ END;
+ Interface* = POINTER TO InterfaceRec;
+ ScaleRec* =
+ RECORD
+ (Disciplines.ObjectRec)
+ (* private components *)
+ if: Interface;
+ family: Family;
+ head, tail: UnitList;
+ nextUnit: UnitList;
+ END;
- TYPE
- Value* = LONGINT;
+ CONST
+ unitNameLength* = 32;
+ TYPE
+ UnitName* = ARRAY unitNameLength OF CHAR;
+ UnitRec* = RECORD
+ (Disciplines.ObjectRec)
+ name: UnitName;
+ scale: Scale;
+ END;
- CONST
- add* = Operations.add; sub* = Operations.sub;
- TYPE
- Operation* = SHORTINT; (* add or sub *)
- TYPE
- CreateProc* = PROCEDURE (scale: Scale; VAR measure: Measure; abs: BOOLEAN);
- GetValueProc* = PROCEDURE (measure: Measure; unit: Unit; VAR value: Value);
- SetValueProc* = PROCEDURE (measure: Measure; unit: Unit; value: Value);
- AssignProc* = PROCEDURE (target: Measure; source: Measure);
- OperatorProc* = PROCEDURE (op: Operation; op1, op2, result: Measure);
- CompareProc* = PROCEDURE (op1, op2: Measure) : INTEGER;
- ConvertProc* = PROCEDURE (from, to: Measure);
-
- InterfaceRec* =
- RECORD
- (Objects.ObjectRec)
- create*: CreateProc;
- getvalue*: GetValueProc;
- setvalue*: SetValueProc;
- assign*: AssignProc;
- op*: OperatorProc;
- compare*: CompareProc;
- (* the conversion routines are only to be provided
- if the scaling system belongs to a family
- *)
- scaleToReference*: ConvertProc;
- referenceToScale*: ConvertProc;
- END;
+ CONST
+ undefined = 0; absolute* = 1; relative* = 2;
+ TYPE
+ Measure* = POINTER TO MeasureRec;
+ MeasureRec* =
+ RECORD
+ (Operations.OperandRec)
+ scale: Scale;
+ type: SHORTINT; (* absolute or relative? *)
+ END;
+ VAR
+ measureType: Services.Type;
- VAR
- invalidOperation*: Events.EventType;
- (* operation cannot be performed for the given combination
- of types (absolute or relative)
- *)
- incompatibleScales*: Events.EventType;
- (* the scales of the operands do not belong to the same family *)
- badCombination*: Events.EventType;
- (* SetValue or GetValue:
- given measure and unit do not belong to the same scaling system
- *)
+ TYPE
+ Value* = LONGINT;
- (* our interface to Operations *)
- opif: Operations.Interface;
- opcaps: Operations.CapabilitySet;
+ CONST
+ add* = Operations.add; sub* = Operations.sub;
+ TYPE
+ Operation* = SHORTINT; (* add or sub *)
+ TYPE
+ CreateProc* = PROCEDURE (scale: Scale; VAR measure: Measure; abs: BOOLEAN);
+ GetValueProc* = PROCEDURE (measure: Measure; unit: Unit; VAR value: Value);
+ SetValueProc* = PROCEDURE (measure: Measure; unit: Unit; value: Value);
+ AssignProc* = PROCEDURE (target: Measure; source: Measure);
+ OperatorProc* = PROCEDURE (op: Operation; op1, op2, result: Measure);
+ CompareProc* = PROCEDURE (op1, op2: Measure) : INTEGER;
+ ConvertProc* = PROCEDURE (from, to: Measure);
- (* ======= private procedures ===================================== *)
+ InterfaceRec* =
+ RECORD
+ (Objects.ObjectRec)
+ create*: CreateProc;
+ getvalue*: GetValueProc;
+ setvalue*: SetValueProc;
+ assign*: AssignProc;
+ op*: OperatorProc;
+ compare*: CompareProc;
+ (* the conversion routines are only to be provided
+ if the scaling system belongs to a family
+ *)
+ scaleToReference*: ConvertProc;
+ referenceToScale*: ConvertProc;
+ END;
- PROCEDURE DummyConversion(from, to: Measure);
- BEGIN
- from.scale.if.assign(to, from);
- END DummyConversion;
+ VAR
+ invalidOperation*: Events.EventType;
+ (* operation cannot be performed for the given combination
+ of types (absolute or relative)
+ *)
+ incompatibleScales*: Events.EventType;
+ (* the scales of the operands do not belong to the same family *)
+ badCombination*: Events.EventType;
+ (* SetValue or GetValue:
+ given measure and unit do not belong to the same scaling system
+ *)
- (* ======== exported procedures ==================================== *)
+ (* our interface to Operations *)
+ opif: Operations.Interface;
+ opcaps: Operations.CapabilitySet;
- PROCEDURE InitFamily*(family: Family; reference: Scale);
- BEGIN
- family.reference := reference;
- (* the reference scale becomes now a member of the family *)
- reference.family := family;
- reference.if.scaleToReference := DummyConversion;
- reference.if.referenceToScale := DummyConversion;
- END InitFamily;
+ (* ======= private procedures ===================================== *)
- PROCEDURE Init*(scale: Scale; family: Family; if: Interface);
- (* reference scales are to be initialized with family = NIL *)
- BEGIN
- scale.if := if;
- scale.family := family;
- scale.head := NIL; scale.tail := NIL;
- scale.nextUnit := NIL;
- END Init;
+ PROCEDURE DummyConversion(from, to: Measure);
+ BEGIN
+ from.scale.if.assign(to, from);
+ END DummyConversion;
- PROCEDURE InitUnit*(scale: Scale; unit: Unit; name: UnitName);
- VAR
- listp: UnitList;
- BEGIN
- unit.name := name;
- unit.scale := scale;
- NEW(listp); listp.unit := unit; listp.next := NIL;
- IF scale.head # NIL THEN
- scale.tail.next := listp;
+ (* ======== exported procedures ==================================== *)
+
+ PROCEDURE InitFamily*(family: Family; reference: Scale);
+ BEGIN
+ family.reference := reference;
+ (* the reference scale becomes now a member of the family *)
+ reference.family := family;
+ reference.if.scaleToReference := DummyConversion;
+ reference.if.referenceToScale := DummyConversion;
+ END InitFamily;
+
+ PROCEDURE Init*(scale: Scale; family: Family; if: Interface);
+ (* reference scales are to be initialized with family = NIL *)
+ BEGIN
+ scale.if := if;
+ scale.family := family;
+ scale.head := NIL; scale.tail := NIL;
+ scale.nextUnit := NIL;
+ END Init;
+
+ PROCEDURE InitUnit*(scale: Scale; unit: Unit; name: UnitName);
+ VAR
+ listp: UnitList;
+ BEGIN
+ unit.name := name;
+ unit.scale := scale;
+ NEW(listp); listp.unit := unit; listp.next := NIL;
+ IF scale.head # NIL THEN
+ scale.tail.next := listp;
+ ELSE
+ scale.head := listp;
+ END;
+ scale.tail := listp;
+ END InitUnit;
+
+ PROCEDURE CreateMeasure*(scale: Scale; VAR measure: Measure; type: SHORTINT);
+ BEGIN
+ scale.if.create(scale, measure, type = absolute);
+ Operations.Init(measure, opif, opcaps);
+ measure.scale := scale;
+ measure.type := type;
+ END CreateMeasure;
+
+ PROCEDURE CreateAbsMeasure*(scale: Scale; VAR measure: Measure);
+ (* init measure to the origin of the given system *)
+ BEGIN
+ CreateMeasure(scale, measure, absolute);
+ END CreateAbsMeasure;
+
+ PROCEDURE CreateRelMeasure*(scale: Scale; VAR measure: Measure);
+ (* init relative measure to 0 *)
+ BEGIN
+ CreateMeasure(scale, measure, relative);
+ END CreateRelMeasure;
+
+ PROCEDURE ConvertMeasure*(scale: Scale; VAR measure: Measure);
+ (* convert measure to the given scale which must belong
+ to the same family as the original scale of measure
+ *)
+ VAR
+ newMeasure: Measure;
+ refMeasure: Measure;
+ reference: Scale;
+ BEGIN
+ IF scale = measure.scale THEN
+ (* trivial case -- nothing is to be done *)
+ RETURN
+ END;
+ (* check that both scales belong to the same family *)
+ ASSERT((scale.family # NIL) & (scale.family = measure.scale.family));
+ CreateMeasure(scale, newMeasure, measure.type);
+ reference := scale.family.reference;
+ CreateMeasure(reference, refMeasure, measure.type);
+ measure.scale.if.scaleToReference(measure, refMeasure);
+ scale.if.referenceToScale(refMeasure, newMeasure);
+ measure := newMeasure;
+ END ConvertMeasure;
+
+ PROCEDURE GetReference*(family: Family; VAR reference: Scale);
+ BEGIN
+ reference := family.reference;
+ END GetReference;
+
+ PROCEDURE GetFamily*(scale: Scale; VAR family: Family);
+ BEGIN
+ family := scale.family;
+ END GetFamily;
+
+ PROCEDURE GetScaleOfUnit*(unit: Unit; VAR scale: Scale);
+ BEGIN
+ scale := unit.scale;
+ END GetScaleOfUnit;
+
+ PROCEDURE GetScale*(measure: Measure; VAR scale: Scale);
+ BEGIN
+ scale := measure.scale;
+ END GetScale;
+
+ PROCEDURE TraverseUnits*(scale: Scale);
+ BEGIN
+ scale.nextUnit := scale.head;
+ END TraverseUnits;
+
+ PROCEDURE NextUnit*(scale: Scale; VAR unit: Unit) : BOOLEAN;
+ BEGIN
+ IF scale.nextUnit # NIL THEN
+ unit := scale.nextUnit.unit;
+ scale.nextUnit := scale.nextUnit.next;
+ RETURN TRUE
+ ELSE
+ RETURN FALSE
+ END;
+ END NextUnit;
+
+ PROCEDURE GetName*(unit: Unit; VAR name: UnitName);
+ BEGIN
+ name := unit.name;
+ END GetName;
+
+ PROCEDURE GetValue*(measure: Measure; unit: Unit; VAR value: Value);
+ VAR
+ scale: Scale;
+ BEGIN
+ scale := measure.scale;
+ ASSERT(unit.scale = scale);
+ scale.if.getvalue(measure, unit, value);
+ END GetValue;
+
+ PROCEDURE SetValue*(measure: Measure; unit: Unit; value: Value);
+ VAR
+ scale: Scale;
+ BEGIN
+ scale := measure.scale;
+ ASSERT(unit.scale = scale);
+ scale.if.setvalue(measure, unit, value);
+ END SetValue;
+
+ PROCEDURE IsAbsolute*(measure: Measure) : BOOLEAN;
+ BEGIN
+ RETURN measure.type = absolute
+ END IsAbsolute;
+
+ PROCEDURE IsRelative*(measure: Measure) : BOOLEAN;
+ BEGIN
+ RETURN measure.type = relative
+ END IsRelative;
+
+ PROCEDURE MeasureType*(measure: Measure) : SHORTINT;
+ BEGIN
+ RETURN measure.type
+ END MeasureType;
+
+ (* ======== interface procedures for Operations ================= *)
+
+ PROCEDURE CreateOperand(VAR op: Operations.Operand);
+ (* at this time we don't know anything about the
+ associated scale -- so we've have to delay this decision
+ *)
+ VAR
+ measure: Measure;
+ BEGIN
+ NEW(measure);
+ measure.type := undefined;
+ measure.scale := NIL;
+ Services.Init(measure, measureType);
+ op := measure;
+ Operations.Init(op, opif, {Operations.add..Operations.cmp});
+ END CreateOperand;
+
+ PROCEDURE Assign(VAR target: Operations.Operand; source: Operations.Operand);
+ BEGIN
+ (*WITH source: Measure DO WITH target: Measure DO*)
+ WITH source: Measure DO IF target IS Measure THEN (* WITH is replaced by IS -- noch *)
+ (* target is already initialized but possibly to a dummy operand
+ by CreateOperand
+ *)
+ IF target(Measure).type = undefined THEN (* type guard introduced *)
+ (* init target with the scale of source *)
+ CreateMeasure(source.scale, SYS.VAL(Measure, target), source.type); (* need to cast *)
+ END;
+ IF target(Measure).scale # source.scale THEN
+ (* adapt scale type from source --
+ this could lead to a type guard failure if
+ target is not of the appropiate type
+ *)
+ CreateMeasure(source.scale, SYS.VAL(Measure, target), source.type);
+ END;
+ IF target(Measure).type # source.type THEN
+ (* adapt measure type from source *)
+ CreateMeasure(target(Measure).scale, SYS.VAL(Measure, target), source.type);
+ END;
+ source.scale.if.assign(SYS.VAL(Measure, target), source);
+ END; END;
+ END Assign;
+
+ PROCEDURE CheckCompatibility(op1, op2: Operations.Operand;
+ VAR m1, m2: Measure);
+ (* is needed by Op and Compare:
+ both operands are checked to be members of the same family;
+ if they have different scales of the same family a
+ conversion is done;
+ *)
+ VAR
+ scale1, scale2: Scale;
+ BEGIN
+ WITH op1: Measure DO WITH op2: Measure DO
+ scale1 := op1.scale; scale2 := op2.scale;
+ IF scale1 # scale2 THEN
+ ASSERT((scale1.family # NIL) & (scale1.family = scale2.family));
+ (* convert both operands to the reference scale *)
+ CreateMeasure(scale1.family.reference, m1, op1.type);
+ scale1.if.scaleToReference(op1, m1);
+ CreateMeasure(scale2.family.reference, m2, op2.type);
+ scale2.if.scaleToReference(op2, m2);
ELSE
- scale.head := listp;
+ m1 := op1;
+ m2 := op2;
END;
- scale.tail := listp;
- END InitUnit;
+ END; END;
+ END CheckCompatibility;
- PROCEDURE CreateMeasure*(scale: Scale; VAR measure: Measure; type: SHORTINT);
- BEGIN
- scale.if.create(scale, measure, type = absolute);
- Operations.Init(measure, opif, opcaps);
- measure.scale := scale;
- measure.type := type;
- END CreateMeasure;
+ PROCEDURE Op(op: Operations.Operation; op1, op2: Operations.Operand;
+ VAR result: Operations.Operand);
+ VAR
+ restype: SHORTINT; (* type of result -- set by CheckTypes *)
+ m1, m2: Measure;
- PROCEDURE CreateAbsMeasure*(scale: Scale; VAR measure: Measure);
- (* init measure to the origin of the given system *)
- BEGIN
- CreateMeasure(scale, measure, absolute);
- END CreateAbsMeasure;
-
- PROCEDURE CreateRelMeasure*(scale: Scale; VAR measure: Measure);
- (* init relative measure to 0 *)
- BEGIN
- CreateMeasure(scale, measure, relative);
- END CreateRelMeasure;
-
- PROCEDURE ConvertMeasure*(scale: Scale; VAR measure: Measure);
- (* convert measure to the given scale which must belong
- to the same family as the original scale of measure
+ PROCEDURE CheckTypes(VAR restype: SHORTINT);
+ (* check operands for correct typing;
+ sets restype to the correct result type;
*)
- VAR
- newMeasure: Measure;
- refMeasure: Measure;
- reference: Scale;
- BEGIN
- IF scale = measure.scale THEN
- (* trivial case -- nothing is to be done *)
- RETURN
- END;
- (* check that both scales belong to the same family *)
- ASSERT((scale.family # NIL) & (scale.family = measure.scale.family));
- CreateMeasure(scale, newMeasure, measure.type);
- reference := scale.family.reference;
- CreateMeasure(reference, refMeasure, measure.type);
- measure.scale.if.scaleToReference(measure, refMeasure);
- scale.if.referenceToScale(refMeasure, newMeasure);
- measure := newMeasure;
- END ConvertMeasure;
-
- PROCEDURE GetReference*(family: Family; VAR reference: Scale);
- BEGIN
- reference := family.reference;
- END GetReference;
-
- PROCEDURE GetFamily*(scale: Scale; VAR family: Family);
- BEGIN
- family := scale.family;
- END GetFamily;
-
- PROCEDURE GetScaleOfUnit*(unit: Unit; VAR scale: Scale);
- BEGIN
- scale := unit.scale;
- END GetScaleOfUnit;
-
- PROCEDURE GetScale*(measure: Measure; VAR scale: Scale);
- BEGIN
- scale := measure.scale;
- END GetScale;
-
- PROCEDURE TraverseUnits*(scale: Scale);
- BEGIN
- scale.nextUnit := scale.head;
- END TraverseUnits;
-
- PROCEDURE NextUnit*(scale: Scale; VAR unit: Unit) : BOOLEAN;
- BEGIN
- IF scale.nextUnit # NIL THEN
- unit := scale.nextUnit.unit;
- scale.nextUnit := scale.nextUnit.next;
- RETURN TRUE
- ELSE
- RETURN FALSE
- END;
- END NextUnit;
-
- PROCEDURE GetName*(unit: Unit; VAR name: UnitName);
- BEGIN
- name := unit.name;
- END GetName;
-
- PROCEDURE GetValue*(measure: Measure; unit: Unit; VAR value: Value);
- VAR
- scale: Scale;
- BEGIN
- scale := measure.scale;
- ASSERT(unit.scale = scale);
- scale.if.getvalue(measure, unit, value);
- END GetValue;
-
- PROCEDURE SetValue*(measure: Measure; unit: Unit; value: Value);
- VAR
- scale: Scale;
- BEGIN
- scale := measure.scale;
- ASSERT(unit.scale = scale);
- scale.if.setvalue(measure, unit, value);
- END SetValue;
-
- PROCEDURE IsAbsolute*(measure: Measure) : BOOLEAN;
- BEGIN
- RETURN measure.type = absolute
- END IsAbsolute;
-
- PROCEDURE IsRelative*(measure: Measure) : BOOLEAN;
- BEGIN
- RETURN measure.type = relative
- END IsRelative;
-
- PROCEDURE MeasureType*(measure: Measure) : SHORTINT;
- BEGIN
- RETURN measure.type
- END MeasureType;
-
- (* ======== interface procedures for Operations ================= *)
-
- PROCEDURE CreateOperand(VAR op: Operations.Operand);
- (* at this time we don't know anything about the
- associated scale -- so we've have to delay this decision
- *)
- VAR
- measure: Measure;
- BEGIN
- NEW(measure);
- measure.type := undefined;
- measure.scale := NIL;
- Services.Init(measure, measureType);
- op := measure;
- Operations.Init(op, opif, {Operations.add..Operations.cmp});
- END CreateOperand;
-
- PROCEDURE Assign(VAR target: Operations.Operand; source: Operations.Operand);
- BEGIN
- (*WITH source: Measure DO WITH target: Measure DO*)
- WITH source: Measure DO IF target IS Measure THEN (* WITH is replaced by IS -- noch *)
- (* target is already initialized but possibly to a dummy operand
- by CreateOperand
- *)
- IF target(Measure).type = undefined THEN (* type guard introduced *)
- (* init target with the scale of source *)
- CreateMeasure(source.scale, SYS.VAL(Measure, target), source.type); (* need to cast *)
- END;
- IF target(Measure).scale # source.scale THEN
- (* adapt scale type from source --
- this could lead to a type guard failure if
- target is not of the appropiate type
- *)
- CreateMeasure(source.scale, SYS.VAL(Measure, target), source.type);
- END;
- IF target(Measure).type # source.type THEN
- (* adapt measure type from source *)
- CreateMeasure(target(Measure).scale, SYS.VAL(Measure, target), source.type);
- END;
- source.scale.if.assign(SYS.VAL(Measure, target), source);
+ VAR ok: BOOLEAN;
+ BEGIN
+ (*WITH op1: Measure DO WITH op2: Measure DO*)
+ IF op1 IS Measure THEN IF op2 IS Measure THEN
+ CASE op OF
+ | Operations.add: (* only abs + abs is invalid *)
+ ok := (op1(Measure).type = relative) OR
+ (op2(Measure).type = relative);
+ IF op1(Measure).type = op2(Measure).type THEN
+ (* both are relative *)
+ restype := relative;
+ ELSE
+ (* exactly one absolute type is involved *)
+ restype := absolute;
+ END;
+ | Operations.sub: (* only rel - abs is invalid *)
+ ok := op1(Measure).type <= op2(Measure).type;
+ IF op1(Measure).type # op2(Measure).type THEN
+ (* abs - rel *)
+ restype := absolute;
+ ELSE
+ (* abs - abs or rel - rel *)
+ restype := relative;
+ END;
+ ELSE
+ END;
+ ASSERT(ok); (* invalid operation *)
END; END;
- END Assign;
+ END CheckTypes;
- PROCEDURE CheckCompatibility(op1, op2: Operations.Operand;
- VAR m1, m2: Measure);
- (* is needed by Op and Compare:
- both operands are checked to be members of the same family;
- if they have different scales of the same family a
- conversion is done;
- *)
- VAR
- scale1, scale2: Scale;
- BEGIN
- WITH op1: Measure DO WITH op2: Measure DO
- scale1 := op1.scale; scale2 := op2.scale;
- IF scale1 # scale2 THEN
- ASSERT((scale1.family # NIL) & (scale1.family = scale2.family));
- (* convert both operands to the reference scale *)
- CreateMeasure(scale1.family.reference, m1, op1.type);
- scale1.if.scaleToReference(op1, m1);
- CreateMeasure(scale2.family.reference, m2, op2.type);
- scale2.if.scaleToReference(op2, m2);
- ELSE
- m1 := op1;
- m2 := op2;
- END;
- END; END;
- END CheckCompatibility;
-
- PROCEDURE Op(op: Operations.Operation; op1, op2: Operations.Operand;
- VAR result: Operations.Operand);
- VAR
- restype: SHORTINT; (* type of result -- set by CheckTypes *)
- m1, m2: Measure;
-
- PROCEDURE CheckTypes(VAR restype: SHORTINT);
- (* check operands for correct typing;
- sets restype to the correct result type;
- *)
- VAR ok: BOOLEAN;
- BEGIN
- (*WITH op1: Measure DO WITH op2: Measure DO*)
- IF op1 IS Measure THEN IF op2 IS Measure THEN
- CASE op OF
- | Operations.add: (* only abs + abs is invalid *)
- ok := (op1(Measure).type = relative) OR
- (op2(Measure).type = relative);
- IF op1(Measure).type = op2(Measure).type THEN
- (* both are relative *)
- restype := relative;
- ELSE
- (* exactly one absolute type is involved *)
- restype := absolute;
- END;
- | Operations.sub: (* only rel - abs is invalid *)
- ok := op1(Measure).type <= op2(Measure).type;
- IF op1(Measure).type # op2(Measure).type THEN
- (* abs - rel *)
- restype := absolute;
- ELSE
- (* abs - abs or rel - rel *)
- restype := relative;
- END;
- ELSE
- END;
- ASSERT(ok); (* invalid operation *)
- END; END;
- END CheckTypes;
-
- BEGIN (* Op *)
- (* result is already of type Measure; this is guaranteed by Operations *)
- IF result IS Measure THEN
- CheckTypes(restype);
- CheckCompatibility(op1, op2, m1, m2);
- CreateMeasure(m1.scale, SYS.VAL(Measure, result), restype);
- m1.scale.if.op(op, m1, m2, SYS.VAL(Measure, result));
- END;
- END Op;
-
- PROCEDURE Compare(op1, op2: Operations.Operand) : INTEGER;
- VAR
- m1, m2: Measure;
- BEGIN
+ BEGIN (* Op *)
+ (* result is already of type Measure; this is guaranteed by Operations *)
+ IF result IS Measure THEN
+ CheckTypes(restype);
CheckCompatibility(op1, op2, m1, m2);
- ASSERT(m1.type = m2.type);
- CheckCompatibility(op1, op2, m1, m2);
- RETURN m1.scale.if.compare(m1, m2)
- END Compare;
+ CreateMeasure(m1.scale, SYS.VAL(Measure, result), restype);
+ m1.scale.if.op(op, m1, m2, SYS.VAL(Measure, result));
+ END;
+ END Op;
- PROCEDURE InitInterface;
- BEGIN
- NEW(opif);
- opif.create := CreateOperand;
- opif.assign := Assign;
- opif.op := Op;
- opif.compare := Compare;
- opcaps := {Operations.add, Operations.sub, Operations.cmp};
- END InitInterface;
+ PROCEDURE Compare(op1, op2: Operations.Operand) : INTEGER;
+ VAR
+ m1, m2: Measure;
+ BEGIN
+ CheckCompatibility(op1, op2, m1, m2);
+ ASSERT(m1.type = m2.type);
+ CheckCompatibility(op1, op2, m1, m2);
+ RETURN m1.scale.if.compare(m1, m2)
+ END Compare;
+
+ PROCEDURE InitInterface;
+ BEGIN
+ NEW(opif);
+ opif.create := CreateOperand;
+ opif.assign := Assign;
+ opif.op := Op;
+ opif.compare := Compare;
+ opcaps := {Operations.add, Operations.sub, Operations.cmp};
+ END InitInterface;
BEGIN
- InitInterface;
- PersistentObjects.RegisterType(measureType,
- "Scales.Measure", "Operations.Operand", NIL);
+ InitInterface;
+ PersistentObjects.RegisterType(measureType,
+ "Scales.Measure", "Operations.Operand", NIL);
END ulmScales.
diff --git a/src/library/ulm/ulmServices.Mod b/src/library/ulm/ulmServices.Mod
index 3b804e4f..7ec557df 100644
--- a/src/library/ulm/ulmServices.Mod
+++ b/src/library/ulm/ulmServices.Mod
@@ -1,520 +1,520 @@
(* Ulm's Oberon Library
- Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
- ----------------------------------------------------------------------------
- Ulm's Oberon Library is free software; you can redistribute it
- and/or modify it under the terms of the GNU Library General Public
- License as published by the Free Software Foundation; either version
- 2 of the License, or (at your option) any later version.
+ Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
+ ----------------------------------------------------------------------------
+ Ulm's Oberon Library is free software; you can redistribute it
+ and/or modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either version
+ 2 of the License, or (at your option) any later version.
- Ulm's Oberon Library is distributed in the hope that it will be
- useful, but WITHOUT ANY WARRANTY; without even the implied warranty
- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Library General Public License for more details.
+ Ulm's Oberon Library is distributed in the hope that it will be
+ useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+ of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
- You should have received a copy of the GNU Library General Public
- License along with this library; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ----------------------------------------------------------------------------
- E-mail contact: oberon@mathematik.uni-ulm.de
- ----------------------------------------------------------------------------
- $Id: Services.om,v 1.2 2004/09/03 09:34:24 borchert Exp $
- ----------------------------------------------------------------------------
- $Log: Services.om,v $
- Revision 1.2 2004/09/03 09:34:24 borchert
- cache results of LoadService to avoid further attempts
+ You should have received a copy of the GNU Library General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ----------------------------------------------------------------------------
+ E-mail contact: oberon@mathematik.uni-ulm.de
+ ----------------------------------------------------------------------------
+ $Id: Services.om,v 1.2 2004/09/03 09:34:24 borchert Exp $
+ ----------------------------------------------------------------------------
+ $Log: Services.om,v $
+ Revision 1.2 2004/09/03 09:34:24 borchert
+ cache results of LoadService to avoid further attempts
- Revision 1.1 1995/03/03 09:32:15 borchert
- Initial revision
+ Revision 1.1 1995/03/03 09:32:15 borchert
+ Initial revision
- ----------------------------------------------------------------------------
+ ----------------------------------------------------------------------------
*)
MODULE ulmServices;
- IMPORT Disciplines := ulmDisciplines, Objects := ulmObjects;
+ IMPORT Disciplines := ulmDisciplines, Objects := ulmObjects;
- TYPE
- Type* = POINTER TO TypeRec;
- ServiceList = POINTER TO ServiceListRec;
- Service* = POINTER TO ServiceRec;
- Object* = POINTER TO ObjectRec;
- ObjectRec* =
- RECORD
- (Disciplines.ObjectRec)
- type: Type;
- installed: ServiceList; (* set of installed services *)
- END;
-
- InstallProc = PROCEDURE (object: Object; service: Service);
-
- ServiceRec* =
- RECORD
- (Disciplines.ObjectRec)
- name: ARRAY 64 OF CHAR;
- next: Service;
- END;
-
- ServiceListRec =
- RECORD
- service: Service;
- type: Type;
- install: InstallProc;
- next: ServiceList;
- END;
-
- VAR
- services: Service;
- (* list of services -- needed to support Seek *)
-
- TYPE
- LoadModuleProc* = PROCEDURE (module: ARRAY OF CHAR) : BOOLEAN;
- LoadServiceProc* = PROCEDURE (service, for: ARRAY OF CHAR) : BOOLEAN;
- LoaderInterface* = POINTER TO LoaderInterfaceRec;
- LoaderInterfaceRec* =
- RECORD
- loadModule*: LoadModuleProc;
- loadService*: LoadServiceProc;
- END;
- VAR
- loaderIF: LoaderInterface;
-
- (* ==== name tables ================================================== *)
-
- CONST
- bufsize = 512; (* length of a name buffer in bytes *)
- tabsize = 1171;
- TYPE
- BufferPosition = INTEGER;
- Length = LONGINT;
- HashValue = INTEGER;
- Buffer = ARRAY bufsize OF CHAR;
- NameList = POINTER TO NameListRec;
- NameListRec =
- RECORD
- buffer: Buffer;
- next: NameList;
- END;
- VAR
- currentBuf: NameList; currentPos: BufferPosition;
- TYPE
- TypeRec* =
- RECORD
- (Disciplines.ObjectRec)
- baseType: Type;
- services: ServiceList;
- cachedservices: ServiceList; (* of base types *)
- (* table management *)
- hashval: HashValue;
- length: Length;
- begin: NameList;
- pos: BufferPosition;
- next: Type; (* next type with same hash value *)
- END;
- BucketTable = ARRAY tabsize OF Type;
- VAR
- bucket: BucketTable;
-
- (* ==== name table management ======================================== *)
-
- PROCEDURE Hash(name: ARRAY OF CHAR; length: LONGINT) : HashValue;
- CONST
- shift = 4;
- VAR
- index: LONGINT;
- val: LONGINT;
- ch: CHAR;
- ordval: INTEGER;
- BEGIN
- index := 0; val := length;
- WHILE index < length DO
- ch := name[index];
- IF ch >= " " THEN
- ordval := ORD(ch) - ORD(" ");
- ELSE
- ordval := ORD(MAX(CHAR)) - ORD(" ") + ORD(ch);
- END;
- val := ASH(val, shift) + ordval;
- INC(index);
+ TYPE
+ Type* = POINTER TO TypeRec;
+ ServiceList = POINTER TO ServiceListRec;
+ Service* = POINTER TO ServiceRec;
+ Object* = POINTER TO ObjectRec;
+ ObjectRec* =
+ RECORD
+ (Disciplines.ObjectRec)
+ type: Type;
+ installed: ServiceList; (* set of installed services *)
END;
- val := val MOD tabsize;
- RETURN SHORT(val)
- END Hash;
- PROCEDURE CreateBuf(VAR buf: NameList);
- BEGIN
- NEW(buf); buf.next := NIL;
- IF currentBuf # NIL THEN
- currentBuf.next := buf;
+ InstallProc = PROCEDURE (object: Object; service: Service);
+
+ ServiceRec* =
+ RECORD
+ (Disciplines.ObjectRec)
+ name: ARRAY 64 OF CHAR;
+ next: Service;
END;
- currentBuf := buf;
- currentPos := 0;
- END CreateBuf;
- PROCEDURE StringLength(string: ARRAY OF CHAR) : LONGINT;
- VAR
- index: LONGINT;
- BEGIN
- index := 0;
- WHILE (index < LEN(string)) & (string[index] # 0X) DO
- INC(index);
+ ServiceListRec =
+ RECORD
+ service: Service;
+ type: Type;
+ install: InstallProc;
+ next: ServiceList;
END;
- RETURN index
- END StringLength;
- PROCEDURE InitName(name: Type; string: ARRAY OF CHAR);
- VAR
- index, length: LONGINT;
- firstbuf, buf: NameList;
- startpos: BufferPosition;
- BEGIN
- IF currentBuf = NIL THEN
- CreateBuf(buf);
+ VAR
+ services: Service;
+ (* list of services -- needed to support Seek *)
+
+ TYPE
+ LoadModuleProc* = PROCEDURE (module: ARRAY OF CHAR) : BOOLEAN;
+ LoadServiceProc* = PROCEDURE (service, for: ARRAY OF CHAR) : BOOLEAN;
+ LoaderInterface* = POINTER TO LoaderInterfaceRec;
+ LoaderInterfaceRec* =
+ RECORD
+ loadModule*: LoadModuleProc;
+ loadService*: LoadServiceProc;
+ END;
+ VAR
+ loaderIF: LoaderInterface;
+
+ (* ==== name tables ================================================== *)
+
+ CONST
+ bufsize = 512; (* length of a name buffer in bytes *)
+ tabsize = 1171;
+ TYPE
+ BufferPosition = INTEGER;
+ Length = LONGINT;
+ HashValue = INTEGER;
+ Buffer = ARRAY bufsize OF CHAR;
+ NameList = POINTER TO NameListRec;
+ NameListRec =
+ RECORD
+ buffer: Buffer;
+ next: NameList;
+ END;
+ VAR
+ currentBuf: NameList; currentPos: BufferPosition;
+ TYPE
+ TypeRec* =
+ RECORD
+ (Disciplines.ObjectRec)
+ baseType: Type;
+ services: ServiceList;
+ cachedservices: ServiceList; (* of base types *)
+ (* table management *)
+ hashval: HashValue;
+ length: Length;
+ begin: NameList;
+ pos: BufferPosition;
+ next: Type; (* next type with same hash value *)
+ END;
+ BucketTable = ARRAY tabsize OF Type;
+ VAR
+ bucket: BucketTable;
+
+ (* ==== name table management ======================================== *)
+
+ PROCEDURE Hash(name: ARRAY OF CHAR; length: LONGINT) : HashValue;
+ CONST
+ shift = 4;
+ VAR
+ index: LONGINT;
+ val: LONGINT;
+ ch: CHAR;
+ ordval: INTEGER;
+ BEGIN
+ index := 0; val := length;
+ WHILE index < length DO
+ ch := name[index];
+ IF ch >= " " THEN
+ ordval := ORD(ch) - ORD(" ");
ELSE
- buf := currentBuf;
+ ordval := ORD(MAX(CHAR)) - ORD(" ") + ORD(ch);
END;
+ val := ASH(val, shift) + ordval;
+ INC(index);
+ END;
+ val := val MOD tabsize;
+ RETURN SHORT(val)
+ END Hash;
- firstbuf := buf; startpos := currentPos;
- index := 0;
- WHILE (index < LEN(string)) & (string[index] # 0X) DO
- IF currentPos = bufsize THEN
- CreateBuf(buf);
- END;
- buf.buffer[currentPos] := string[index]; INC(currentPos);
- INC(index);
+ PROCEDURE CreateBuf(VAR buf: NameList);
+ BEGIN
+ NEW(buf); buf.next := NIL;
+ IF currentBuf # NIL THEN
+ currentBuf.next := buf;
+ END;
+ currentBuf := buf;
+ currentPos := 0;
+ END CreateBuf;
+
+ PROCEDURE StringLength(string: ARRAY OF CHAR) : LONGINT;
+ VAR
+ index: LONGINT;
+ BEGIN
+ index := 0;
+ WHILE (index < LEN(string)) & (string[index] # 0X) DO
+ INC(index);
+ END;
+ RETURN index
+ END StringLength;
+
+ PROCEDURE InitName(name: Type; string: ARRAY OF CHAR);
+ VAR
+ index, length: LONGINT;
+ firstbuf, buf: NameList;
+ startpos: BufferPosition;
+ BEGIN
+ IF currentBuf = NIL THEN
+ CreateBuf(buf);
+ ELSE
+ buf := currentBuf;
+ END;
+
+ firstbuf := buf; startpos := currentPos;
+ index := 0;
+ WHILE (index < LEN(string)) & (string[index] # 0X) DO
+ IF currentPos = bufsize THEN
+ CreateBuf(buf);
END;
- length := index;
+ buf.buffer[currentPos] := string[index]; INC(currentPos);
+ INC(index);
+ END;
+ length := index;
- name.hashval := Hash(string, length);
- name.length := length;
- name.begin := firstbuf;
- name.pos := startpos;
- name.next := bucket[name.hashval];
- bucket[name.hashval] := name;
- END InitName;
+ name.hashval := Hash(string, length);
+ name.length := length;
+ name.begin := firstbuf;
+ name.pos := startpos;
+ name.next := bucket[name.hashval];
+ bucket[name.hashval] := name;
+ END InitName;
- PROCEDURE EqualName(name: Type; string: ARRAY OF CHAR) : BOOLEAN;
- (* precondition: both have the same length *)
+ PROCEDURE EqualName(name: Type; string: ARRAY OF CHAR) : BOOLEAN;
+ (* precondition: both have the same length *)
+ VAR
+ index: LONGINT;
+ buf: NameList;
+ pos: INTEGER;
+ BEGIN
+ buf := name.begin; pos := name.pos;
+ index := 0;
+ WHILE index < name.length DO
+ IF pos = bufsize THEN
+ buf := buf.next; pos := 0;
+ END;
+ IF string[index] # buf.buffer[pos] THEN
+ RETURN FALSE
+ END;
+ INC(pos);
+ INC(index);
+ END;
+ RETURN TRUE
+ END EqualName;
+
+ PROCEDURE SeekName(string: ARRAY OF CHAR; VAR name: Type) : BOOLEAN;
+ VAR
+ length: LONGINT;
+ hashval: HashValue;
+ p: Type;
+ BEGIN
+ length := StringLength(string);
+ hashval := Hash(string, length);
+ p := bucket[hashval];
+ WHILE (p # NIL) & ((length # p.length) OR ~EqualName(p, string)) DO
+ p := p.next;
+ END;
+ name := p;
+ RETURN p # NIL
+ END SeekName;
+
+ PROCEDURE ExtractName(name: Type; VAR string: ARRAY OF CHAR);
+ VAR
+ index: LONGINT;
+ buf: NameList;
+ pos: INTEGER;
+ BEGIN
+ buf := name.begin; pos := name.pos;
+ index := 0;
+ WHILE (index + 1 < LEN(string)) & (index < name.length) DO
+ IF pos = bufsize THEN
+ buf := buf.next; pos := 0;
+ END;
+ string[index] := buf.buffer[pos];
+ INC(pos);
+ INC(index);
+ END;
+ string[index] := 0X;
+ END ExtractName;
+
+ PROCEDURE LoadModule(module: ARRAY OF CHAR) : BOOLEAN;
+ BEGIN
+ IF (loaderIF # NIL) & (loaderIF.loadModule # NIL) THEN
+ RETURN loaderIF.loadModule(module)
+ ELSE
+ RETURN FALSE
+ END;
+ END LoadModule;
+
+ PROCEDURE LoadService(service, for: ARRAY OF CHAR) : BOOLEAN;
+ BEGIN
+ IF (loaderIF # NIL) & (loaderIF.loadService # NIL) THEN
+ RETURN loaderIF.loadService(service, for)
+ ELSE
+ RETURN FALSE
+ END;
+ END LoadService;
+
+ PROCEDURE MemberOf(list: ServiceList; service: Service;
+ VAR member: ServiceList) : BOOLEAN;
+ VAR
+ p: ServiceList;
+ BEGIN
+ p := list;
+ WHILE (p # NIL) & (p.service # service) DO
+ p := p.next;
+ END;
+ member := p;
+ RETURN p # NIL
+ END MemberOf;
+
+ PROCEDURE SeekService(type: Type; service: Service;
+ VAR member: ServiceList;
+ VAR baseType: Type) : BOOLEAN;
+
+ VAR
+ btype: Type;
+ cachedservice: ServiceList;
+
+ PROCEDURE Seek(type: Type; service: Service;
+ VAR member: ServiceList) : BOOLEAN;
VAR
- index: LONGINT;
- buf: NameList;
- pos: INTEGER;
- BEGIN
- buf := name.begin; pos := name.pos;
- index := 0;
- WHILE index < name.length DO
- IF pos = bufsize THEN
- buf := buf.next; pos := 0;
- END;
- IF string[index] # buf.buffer[pos] THEN
- RETURN FALSE
- END;
- INC(pos);
- INC(index);
+ typeName: ARRAY 512 OF CHAR;
+ BEGIN
+ IF MemberOf(type.services, service, member) OR
+ MemberOf(type.cachedservices, service, member) THEN
+ RETURN TRUE
END;
+ ExtractName(type, typeName);
+ RETURN LoadService(service.name, typeName) &
+ MemberOf(type.services, service, member)
+ END Seek;
+
+ BEGIN (* SeekService *)
+ btype := type;
+ WHILE (btype # NIL) & ~Seek(btype, service, member) DO
+ btype := btype.baseType;
+ END;
+ IF (member # NIL) & (btype # type) THEN
+ (* cache result to avoid further tries to load
+ a more fitting variant dynamically
+ *)
+ NEW(cachedservice);
+ cachedservice.service := service;
+ cachedservice.type := member.type;
+ cachedservice.install := member.install;
+ cachedservice.next := type.cachedservices;
+ type.cachedservices := cachedservice;
+ baseType := member.type;
RETURN TRUE
- END EqualName;
+ END;
+ IF member = NIL THEN
+ RETURN FALSE
+ ELSE
+ baseType := member.type;
+ RETURN TRUE
+ END;
+ END SeekService;
- PROCEDURE SeekName(string: ARRAY OF CHAR; VAR name: Type) : BOOLEAN;
- VAR
- length: LONGINT;
- hashval: HashValue;
- p: Type;
- BEGIN
- length := StringLength(string);
- hashval := Hash(string, length);
- p := bucket[hashval];
- WHILE (p # NIL) & ((length # p.length) OR ~EqualName(p, string)) DO
- p := p.next;
+ PROCEDURE GetModule(name: ARRAY OF CHAR; VAR module: ARRAY OF CHAR);
+ (* get the name of the module where 'name' was defined *)
+ VAR
+ index: INTEGER;
+ BEGIN
+ index := 0;
+ WHILE (name[index] # ".") & (name[index] # 0X) &
+ (index < LEN(module)-1) DO
+ module[index] := name[index]; INC(index);
+ END;
+ module[index] := 0X;
+ END GetModule;
+
+ (* ==== exported procedures ========================================== *)
+
+ PROCEDURE InitLoader*(if: LoaderInterface);
+ BEGIN
+ ASSERT((loaderIF = NIL) & (if # NIL));
+ loaderIF := if;
+ END InitLoader;
+
+ PROCEDURE InitType*(type: Type; name, baseName: ARRAY OF CHAR);
+ VAR
+ baseType: Type;
+ otherType: Type;
+ ok: BOOLEAN;
+ BEGIN
+ IF baseName = "" THEN
+ baseType := NIL;
+ ELSE
+ ok := SeekName(baseName, baseType); ASSERT(ok);
+ END;
+ ASSERT(~SeekName(name, otherType));
+ InitName(type, name);
+ type.baseType := baseType;
+ type.services := NIL;
+ type.cachedservices := NIL;
+ END InitType;
+
+ PROCEDURE CreateType*(VAR type: Type; name, baseName: ARRAY OF CHAR);
+ BEGIN
+ NEW(type); InitType(type, name, baseName);
+ END CreateType;
+
+ PROCEDURE Init*(object: Object; type: Type);
+ BEGIN
+ ASSERT(type # NIL);
+ ASSERT(object.type = NIL);
+ object.type := type;
+ object.installed := NIL;
+ END Init;
+
+ PROCEDURE GetType*(object: Object; VAR type: Type);
+ BEGIN
+ type := object.type;
+ END GetType;
+
+ PROCEDURE GetTypeName*(type: Type; VAR name: ARRAY OF CHAR);
+ BEGIN
+ ExtractName(type, name);
+ END GetTypeName;
+
+ PROCEDURE GetBaseType*(type: Type; VAR baseType: Type);
+ BEGIN
+ baseType := type.baseType;
+ END GetBaseType;
+
+ PROCEDURE IsExtensionOf*(type, baseType: Type) : BOOLEAN;
+ BEGIN
+ ASSERT(baseType # NIL);
+ WHILE (type # NIL) & (type # baseType) DO
+ type := type.baseType;
+ END;
+ RETURN type = baseType
+ END IsExtensionOf;
+
+ PROCEDURE SeekType*(name: ARRAY OF CHAR; VAR type: Type);
+ VAR
+ module: ARRAY 64 OF CHAR;
+ BEGIN
+ IF ~SeekName(name, type) THEN
+ (* try to load the associated module *)
+ GetModule(name, module);
+ IF ~LoadModule(module) OR ~SeekName(name, type) THEN
+ type := NIL;
END;
- name := p;
- RETURN p # NIL
- END SeekName;
+ END;
+ END SeekType;
- PROCEDURE ExtractName(name: Type; VAR string: ARRAY OF CHAR);
- VAR
- index: LONGINT;
- buf: NameList;
- pos: INTEGER;
- BEGIN
- buf := name.begin; pos := name.pos;
- index := 0;
- WHILE (index + 1 < LEN(string)) & (index < name.length) DO
- IF pos = bufsize THEN
- buf := buf.next; pos := 0;
- END;
- string[index] := buf.buffer[pos];
- INC(pos);
- INC(index);
- END;
- string[index] := 0X;
- END ExtractName;
+ PROCEDURE Seek*(name: ARRAY OF CHAR; VAR service: Service);
+ BEGIN
+ service := services;
+ WHILE (service # NIL) & (service.name # name) DO
+ service := service.next;
+ END;
- PROCEDURE LoadModule(module: ARRAY OF CHAR) : BOOLEAN;
- BEGIN
- IF (loaderIF # NIL) & (loaderIF.loadModule # NIL) THEN
- RETURN loaderIF.loadModule(module)
- ELSE
- RETURN FALSE
- END;
- END LoadModule;
-
- PROCEDURE LoadService(service, for: ARRAY OF CHAR) : BOOLEAN;
- BEGIN
- IF (loaderIF # NIL) & (loaderIF.loadService # NIL) THEN
- RETURN loaderIF.loadService(service, for)
- ELSE
- RETURN FALSE
- END;
- END LoadService;
-
- PROCEDURE MemberOf(list: ServiceList; service: Service;
- VAR member: ServiceList) : BOOLEAN;
- VAR
- p: ServiceList;
- BEGIN
- p := list;
- WHILE (p # NIL) & (p.service # service) DO
- p := p.next;
- END;
- member := p;
- RETURN p # NIL
- END MemberOf;
-
- PROCEDURE SeekService(type: Type; service: Service;
- VAR member: ServiceList;
- VAR baseType: Type) : BOOLEAN;
-
- VAR
- btype: Type;
- cachedservice: ServiceList;
-
- PROCEDURE Seek(type: Type; service: Service;
- VAR member: ServiceList) : BOOLEAN;
- VAR
- typeName: ARRAY 512 OF CHAR;
- BEGIN
- IF MemberOf(type.services, service, member) OR
- MemberOf(type.cachedservices, service, member) THEN
- RETURN TRUE
- END;
- ExtractName(type, typeName);
- RETURN LoadService(service.name, typeName) &
- MemberOf(type.services, service, member)
- END Seek;
-
- BEGIN (* SeekService *)
- btype := type;
- WHILE (btype # NIL) & ~Seek(btype, service, member) DO
- btype := btype.baseType;
- END;
- IF (member # NIL) & (btype # type) THEN
- (* cache result to avoid further tries to load
- a more fitting variant dynamically
- *)
- NEW(cachedservice);
- cachedservice.service := service;
- cachedservice.type := member.type;
- cachedservice.install := member.install;
- cachedservice.next := type.cachedservices;
- type.cachedservices := cachedservice;
- baseType := member.type;
- RETURN TRUE
- END;
- IF member = NIL THEN
- RETURN FALSE
- ELSE
- baseType := member.type;
- RETURN TRUE
- END;
- END SeekService;
-
- PROCEDURE GetModule(name: ARRAY OF CHAR; VAR module: ARRAY OF CHAR);
- (* get the name of the module where 'name' was defined *)
- VAR
- index: INTEGER;
- BEGIN
- index := 0;
- WHILE (name[index] # ".") & (name[index] # 0X) &
- (index < LEN(module)-1) DO
- module[index] := name[index]; INC(index);
- END;
- module[index] := 0X;
- END GetModule;
-
- (* ==== exported procedures ========================================== *)
-
- PROCEDURE InitLoader*(if: LoaderInterface);
- BEGIN
- ASSERT((loaderIF = NIL) & (if # NIL));
- loaderIF := if;
- END InitLoader;
-
- PROCEDURE InitType*(type: Type; name, baseName: ARRAY OF CHAR);
- VAR
- baseType: Type;
- otherType: Type;
- ok: BOOLEAN;
- BEGIN
- IF baseName = "" THEN
- baseType := NIL;
- ELSE
- ok := SeekName(baseName, baseType); ASSERT(ok);
- END;
- ASSERT(~SeekName(name, otherType));
- InitName(type, name);
- type.baseType := baseType;
- type.services := NIL;
- type.cachedservices := NIL;
- END InitType;
-
- PROCEDURE CreateType*(VAR type: Type; name, baseName: ARRAY OF CHAR);
- BEGIN
- NEW(type); InitType(type, name, baseName);
- END CreateType;
-
- PROCEDURE Init*(object: Object; type: Type);
- BEGIN
- ASSERT(type # NIL);
- ASSERT(object.type = NIL);
- object.type := type;
- object.installed := NIL;
- END Init;
-
- PROCEDURE GetType*(object: Object; VAR type: Type);
- BEGIN
- type := object.type;
- END GetType;
-
- PROCEDURE GetTypeName*(type: Type; VAR name: ARRAY OF CHAR);
- BEGIN
- ExtractName(type, name);
- END GetTypeName;
-
- PROCEDURE GetBaseType*(type: Type; VAR baseType: Type);
- BEGIN
- baseType := type.baseType;
- END GetBaseType;
-
- PROCEDURE IsExtensionOf*(type, baseType: Type) : BOOLEAN;
- BEGIN
- ASSERT(baseType # NIL);
- WHILE (type # NIL) & (type # baseType) DO
- type := type.baseType;
- END;
- RETURN type = baseType
- END IsExtensionOf;
-
- PROCEDURE SeekType*(name: ARRAY OF CHAR; VAR type: Type);
- VAR
- module: ARRAY 64 OF CHAR;
- BEGIN
- IF ~SeekName(name, type) THEN
- (* try to load the associated module *)
- GetModule(name, module);
- IF ~LoadModule(module) OR ~SeekName(name, type) THEN
- type := NIL;
- END;
- END;
- END SeekType;
-
- PROCEDURE Seek*(name: ARRAY OF CHAR; VAR service: Service);
- BEGIN
+ (* try to load a module named after `name', if not successful *)
+ IF (service = NIL) & LoadModule(name) THEN
service := services;
WHILE (service # NIL) & (service.name # name) DO
- service := service.next;
+ service := service.next;
END;
+ END;
+ END Seek;
- (* try to load a module named after `name', if not successful *)
- IF (service = NIL) & LoadModule(name) THEN
- service := services;
- WHILE (service # NIL) & (service.name # name) DO
- service := service.next;
- END;
+ PROCEDURE Create*(VAR service: Service; name: ARRAY OF CHAR);
+
+ PROCEDURE Created(name: ARRAY OF CHAR) : BOOLEAN;
+ VAR
+ service: Service;
+ BEGIN
+ service := services;
+ WHILE (service # NIL) & (service.name # name) DO
+ service := service.next;
END;
- END Seek;
+ RETURN service # NIL
+ END Created;
- PROCEDURE Create*(VAR service: Service; name: ARRAY OF CHAR);
+ BEGIN
+ ASSERT(~Created(name));
+ NEW(service);
+ COPY(name, service.name);
+ service.next := services; services := service;
+ END Create;
- PROCEDURE Created(name: ARRAY OF CHAR) : BOOLEAN;
- VAR
- service: Service;
- BEGIN
- service := services;
- WHILE (service # NIL) & (service.name # name) DO
- service := service.next;
- END;
- RETURN service # NIL
- END Created;
+ PROCEDURE Define*(type: Type; service: Service; install: InstallProc);
+ VAR
+ member: ServiceList;
+ BEGIN
+ ASSERT(service # NIL);
+ (* protect against multiple definitions: *)
+ ASSERT(~MemberOf(type.services, service, member));
- BEGIN
- ASSERT(~Created(name));
- NEW(service);
- COPY(name, service.name);
- service.next := services; services := service;
- END Create;
+ NEW(member); member.service := service;
+ member.install := install; member.type := type;
+ member.next := type.services; type.services := member;
+ END Define;
- PROCEDURE Define*(type: Type; service: Service; install: InstallProc);
- VAR
- member: ServiceList;
- BEGIN
- ASSERT(service # NIL);
- (* protect against multiple definitions: *)
- ASSERT(~MemberOf(type.services, service, member));
-
- NEW(member); member.service := service;
- member.install := install; member.type := type;
- member.next := type.services; type.services := member;
- END Define;
-
- PROCEDURE Install*(object: Object; service: Service) : BOOLEAN;
- VAR
- member, installed: ServiceList;
- baseType: Type;
- BEGIN
- IF object.type = NIL THEN RETURN FALSE END;
- IF ~SeekService(object.type, service, member, baseType) THEN
- (* service not supported for this object type *)
- RETURN FALSE
+ PROCEDURE Install*(object: Object; service: Service) : BOOLEAN;
+ VAR
+ member, installed: ServiceList;
+ baseType: Type;
+ BEGIN
+ IF object.type = NIL THEN RETURN FALSE END;
+ IF ~SeekService(object.type, service, member, baseType) THEN
+ (* service not supported for this object type *)
+ RETURN FALSE
+ END;
+ IF ~MemberOf(object.installed, service, installed) THEN
+ (* install services only once *)
+ IF member.install # NIL THEN
+ member.install(object, service);
END;
- IF ~MemberOf(object.installed, service, installed) THEN
- (* install services only once *)
- IF member.install # NIL THEN
- member.install(object, service);
- END;
- NEW(installed);
- installed.service := service;
- installed.next := object.installed;
- object.installed := installed;
- END;
- RETURN TRUE
- END Install;
+ NEW(installed);
+ installed.service := service;
+ installed.next := object.installed;
+ object.installed := installed;
+ END;
+ RETURN TRUE
+ END Install;
- PROCEDURE Supported*(object: Object; service: Service) : BOOLEAN;
- VAR
- member: ServiceList;
- baseType: Type;
- BEGIN
- RETURN (object.type # NIL) &
- SeekService(object.type, service, member, baseType)
- END Supported;
+ PROCEDURE Supported*(object: Object; service: Service) : BOOLEAN;
+ VAR
+ member: ServiceList;
+ baseType: Type;
+ BEGIN
+ RETURN (object.type # NIL) &
+ SeekService(object.type, service, member, baseType)
+ END Supported;
- PROCEDURE Installed*(object: Object; service: Service) : BOOLEAN;
- VAR
- member: ServiceList;
- BEGIN
- RETURN MemberOf(object.installed, service, member)
- END Installed;
+ PROCEDURE Installed*(object: Object; service: Service) : BOOLEAN;
+ VAR
+ member: ServiceList;
+ BEGIN
+ RETURN MemberOf(object.installed, service, member)
+ END Installed;
- PROCEDURE GetSupportedBaseType*(object: Object; service: Service;
- VAR baseType: Type);
- VAR
- member: ServiceList;
- BEGIN
- IF ~SeekService(object.type, service, member, baseType) THEN
- baseType := NIL;
- END;
- END GetSupportedBaseType;
+ PROCEDURE GetSupportedBaseType*(object: Object; service: Service;
+ VAR baseType: Type);
+ VAR
+ member: ServiceList;
+ BEGIN
+ IF ~SeekService(object.type, service, member, baseType) THEN
+ baseType := NIL;
+ END;
+ END GetSupportedBaseType;
BEGIN
- currentBuf := NIL; currentPos := 0; loaderIF := NIL;
+ currentBuf := NIL; currentPos := 0; loaderIF := NIL;
END ulmServices.
diff --git a/src/library/ulm/ulmStreamDisciplines.Mod b/src/library/ulm/ulmStreamDisciplines.Mod
index 686214c9..522f9cda 100644
--- a/src/library/ulm/ulmStreamDisciplines.Mod
+++ b/src/library/ulm/ulmStreamDisciplines.Mod
@@ -1,246 +1,249 @@
(* Ulm's Oberon Library
- Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
- ----------------------------------------------------------------------------
- Ulm's Oberon Library is free software; you can redistribute it
- and/or modify it under the terms of the GNU Library General Public
- License as published by the Free Software Foundation; either version
- 2 of the License, or (at your option) any later version.
+ Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
+ ----------------------------------------------------------------------------
+ Ulm's Oberon Library is free software; you can redistribute it
+ and/or modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either version
+ 2 of the License, or (at your option) any later version.
- Ulm's Oberon Library is distributed in the hope that it will be
- useful, but WITHOUT ANY WARRANTY; without even the implied warranty
- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Library General Public License for more details.
+ Ulm's Oberon Library is distributed in the hope that it will be
+ useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+ of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
- You should have received a copy of the GNU Library General Public
- License along with this library; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ----------------------------------------------------------------------------
- E-mail contact: oberon@mathematik.uni-ulm.de
- ----------------------------------------------------------------------------
- $Id: StreamDisci.om,v 1.2 1994/07/04 14:53:25 borchert Exp $
- ----------------------------------------------------------------------------
- $Log: StreamDisci.om,v $
- Revision 1.2 1994/07/04 14:53:25 borchert
- parameter for indentation width added
+ You should have received a copy of the GNU Library General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ----------------------------------------------------------------------------
+ E-mail contact: oberon@mathematik.uni-ulm.de
+ ----------------------------------------------------------------------------
+ $Id: StreamDisci.om,v 1.2 1994/07/04 14:53:25 borchert Exp $
+ ----------------------------------------------------------------------------
+ $Log: StreamDisci.om,v $
+ Revision 1.2 1994/07/04 14:53:25 borchert
+ parameter for indentation width added
- Revision 1.1 1994/02/22 20:10:34 borchert
- Initial revision
+ Revision 1.1 1994/02/22 20:10:34 borchert
+ Initial revision
- ----------------------------------------------------------------------------
- AFB 10/91
- ----------------------------------------------------------------------------
+ ----------------------------------------------------------------------------
+ AFB 10/91
+ ----------------------------------------------------------------------------
*)
MODULE ulmStreamDisciplines;
- (* definition of general-purpose disciplines for streams *)
+ (* definition of general-purpose disciplines for streams *)
- IMPORT ASCII := ulmASCII, Disciplines := ulmIndirectDisciplines, Events := ulmEvents, Sets := ulmSets, Streams := ulmStreams, SYSTEM;
+ IMPORT ASCII := ulmASCII, Disciplines := ulmIndirectDisciplines, Events := ulmEvents, Sets := ulmSets, Streams := ulmStreams, SYSTEM;
- TYPE
- LineTerminator* = ARRAY 4 OF CHAR;
- VAR
- badfieldsepset*: Events.EventType;
+ TYPE
+ LineTerminator* = ARRAY 4 OF CHAR;
+ VAR
+ badfieldsepset*: Events.EventType;
- TYPE
- StreamDiscipline = POINTER TO StreamDisciplineRec;
- StreamDisciplineRec =
- RECORD
- (Disciplines.DisciplineRec)
- lineterm: LineTerminator;
- fieldseps: Sets.CharSet;
- fieldsep: CHAR; (* one of them *)
- whitespace: Sets.CharSet;
- indentwidth: INTEGER;
- END;
-
- VAR
- id: Disciplines.Identifier;
- (* default values *)
- defaultFieldSeps: Sets.CharSet;
- defaultFieldSep: CHAR;
- defaultLineTerm: LineTerminator;
- defaultWhiteSpace: Sets.CharSet;
- defaultIndentWidth: INTEGER;
-
- PROCEDURE InitDiscipline(VAR disc: StreamDiscipline);
- BEGIN
- NEW(disc); disc.id := id;
- disc.fieldseps := defaultFieldSeps;
- disc.fieldsep := defaultFieldSep;
- disc.lineterm := defaultLineTerm;
- disc.whitespace := defaultWhiteSpace;
- disc.indentwidth := defaultIndentWidth;
- END InitDiscipline;
-
- PROCEDURE SetLineTerm*(s: Streams.Stream; lineterm: LineTerminator);
- VAR
- disc: StreamDiscipline;
- BEGIN
- IF ~Disciplines.Seek(s, id, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN
- InitDiscipline(disc);
+ TYPE
+ StreamDiscipline = POINTER TO StreamDisciplineRec;
+ StreamDisciplineRec =
+ RECORD
+ (Disciplines.DisciplineRec)
+ lineterm: LineTerminator;
+ fieldseps: Sets.CharSet;
+ fieldsep: CHAR; (* one of them *)
+ whitespace: Sets.CharSet;
+ indentwidth: INTEGER;
END;
- disc.lineterm := lineterm;
+
+ VAR
+ id: Disciplines.Identifier;
+ (* default values *)
+ defaultFieldSeps: Sets.CharSet;
+ defaultFieldSep: CHAR;
+ defaultLineTerm: LineTerminator;
+ defaultWhiteSpace: Sets.CharSet;
+ defaultIndentWidth: INTEGER;
+
+ PROCEDURE InitDiscipline(VAR disc: Disciplines.Discipline);
+ VAR
+ sdisc: StreamDiscipline;
+ BEGIN
+ NEW(sdisc); sdisc.id := id;
+ sdisc.fieldseps := defaultFieldSeps;
+ sdisc.fieldsep := defaultFieldSep;
+ sdisc.lineterm := defaultLineTerm;
+ sdisc.whitespace := defaultWhiteSpace;
+ sdisc.indentwidth := defaultIndentWidth;
+ disc := sdisc
+ END InitDiscipline;
+
+ PROCEDURE SetLineTerm*(s: Streams.Stream; lineterm: LineTerminator);
+ VAR
+ disc: Disciplines.Discipline;
+ BEGIN
+ IF ~Disciplines.Seek(s, id, disc) THEN
+ InitDiscipline(disc);
+ END;
+ disc(StreamDiscipline).lineterm := lineterm;
+ Disciplines.Add(s, disc);
+ END SetLineTerm;
+
+ PROCEDURE GetLineTerm*(s: Streams.Stream; VAR lineterm: LineTerminator);
+ (* default line terminator is ASCII.nl *)
+ VAR
+ disc: Disciplines.Discipline;
+ BEGIN
+ IF Disciplines.Seek(s, id, disc) THEN
+ lineterm := disc(StreamDiscipline).lineterm;
+ ELSE
+ lineterm := defaultLineTerm;
+ END;
+ END GetLineTerm;
+
+ PROCEDURE SetFieldSepSet*(s: Streams.Stream; fieldsepset: Sets.CharSet);
+ (* cardinality of fieldsepset must be >= 1 *)
+ VAR
+ disc: Disciplines.Discipline;
+ ch: CHAR; found: BOOLEAN;
+ fieldsep: CHAR;
+ event: Events.Event;
+ BEGIN
+ ch := 0X;
+ LOOP (* seek for the first element inside fieldsepset *)
+ IF Sets.CharIn(fieldsepset, ch) THEN
+ found := TRUE; fieldsep := ch; EXIT
+ END;
+ IF ch = MAX(CHAR) THEN
+ found := FALSE; EXIT
+ END;
+ ch := CHR(ORD(ch) + 1);
+ END;
+ IF ~found THEN
+ NEW(event);
+ event.message := "StreamDisciplines.SetFieldSepSet: empty fieldsepset";
+ event.type := badfieldsepset;
+ Events.Raise(event);
+ RETURN
+ END;
+ IF ~Disciplines.Seek(s, id, disc) THEN
+ InitDiscipline(disc);
+ END;
+ disc(StreamDiscipline).fieldseps := fieldsepset;
+ disc(StreamDiscipline).fieldsep := fieldsep;
+ Disciplines.Add(s, disc);
+ END SetFieldSepSet;
+
+ PROCEDURE GetFieldSepSet*(s: Streams.Stream; VAR fieldsepset: Sets.CharSet);
+ (* default field separators are ASCII.tab and ASCII.sp *)
+ VAR
+ disc: Disciplines.Discipline;
+ BEGIN
+ IF Disciplines.Seek(s, id, disc) THEN
+ fieldsepset := disc(StreamDiscipline).fieldseps;
+ ELSE
+ fieldsepset := defaultFieldSeps;
+ END;
+ END GetFieldSepSet;
+
+ PROCEDURE SetFieldSep*(s: Streams.Stream; fieldsep: CHAR);
+ VAR
+ disc: Disciplines.Discipline;
+ BEGIN
+ IF ~Disciplines.Seek(s, id, disc) THEN
+ InitDiscipline(disc);
+ END;
+ Sets.InclChar(disc(StreamDiscipline).fieldseps, fieldsep);
+ disc(StreamDiscipline).fieldsep := fieldsep;
+ Disciplines.Add(s, disc);
+ END SetFieldSep;
+
+ PROCEDURE GetFieldSep*(s: Streams.Stream; VAR fieldsep: CHAR);
+ (* default field separator is ASCII.tab;
+ if a set of field separators has been given via SetFieldSepSet,
+ one of them is returned
+ *)
+ VAR
+ disc: Disciplines.Discipline;
+ BEGIN
+ IF Disciplines.Seek(s, id, disc) THEN
+ fieldsep := disc(StreamDiscipline).fieldsep;
+ ELSE
+ fieldsep := defaultFieldSep;
+ END;
+ END GetFieldSep;
+
+ PROCEDURE GetWhiteSpace*(s: Streams.Stream; VAR whitespace: Sets.CharSet);
+ (* default: ASCII.tab, ASCII.sp, ASCII.np and ASCII.nl *)
+ VAR
+ disc: Disciplines.Discipline;
+ BEGIN
+ IF Disciplines.Seek(s, id, disc) THEN
+ whitespace := disc(StreamDiscipline).whitespace;
+ ELSE
+ whitespace := defaultWhiteSpace;
+ END;
+ END GetWhiteSpace;
+
+ PROCEDURE SetWhiteSpace*(s: Streams.Stream; whitespace: Sets.CharSet);
+ VAR
+ disc: Disciplines.Discipline;
+ BEGIN
+ IF ~Disciplines.Seek(s, id, disc) THEN
+ InitDiscipline(disc);
+ END;
+ disc(StreamDiscipline).whitespace := whitespace;
+ Disciplines.Add(s, disc);
+ END SetWhiteSpace;
+
+ PROCEDURE SetIndentationWidth*(s: Streams.Stream; indentwidth: INTEGER);
+ VAR
+ disc: Disciplines.Discipline;
+ BEGIN
+ IF indentwidth >= 0 THEN
+ IF ~Disciplines.Seek(s, id, disc) THEN
+ InitDiscipline(disc);
+ END;
+ disc(StreamDiscipline).indentwidth := indentwidth;
Disciplines.Add(s, disc);
- END SetLineTerm;
+ END;
+ END SetIndentationWidth;
- PROCEDURE GetLineTerm*(s: Streams.Stream; VAR lineterm: LineTerminator);
- (* default line terminator is ASCII.nl *)
- VAR
- disc: StreamDiscipline;
- BEGIN
- IF Disciplines.Seek(s, id, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN
- lineterm := disc.lineterm;
- ELSE
- lineterm := defaultLineTerm;
- END;
- END GetLineTerm;
+ PROCEDURE GetIndentationWidth*(s: Streams.Stream; VAR indentwidth: INTEGER);
+ VAR
+ disc: Disciplines.Discipline;
+ BEGIN
+ IF Disciplines.Seek(s, id, disc) THEN
+ indentwidth := disc(StreamDiscipline).indentwidth;
+ ELSE
+ indentwidth := defaultIndentWidth;
+ END;
+ END GetIndentationWidth;
- PROCEDURE SetFieldSepSet*(s: Streams.Stream; fieldsepset: Sets.CharSet);
- (* cardinality of fieldsepset must be >= 1 *)
- VAR
- disc: StreamDiscipline;
- ch: CHAR; found: BOOLEAN;
- fieldsep: CHAR;
- event: Events.Event;
- BEGIN
- ch := 0X;
- LOOP (* seek for the first element inside fieldsepset *)
- IF Sets.CharIn(fieldsepset, ch) THEN
- found := TRUE; fieldsep := ch; EXIT
- END;
- IF ch = MAX(CHAR) THEN
- found := FALSE; EXIT
- END;
- ch := CHR(ORD(ch) + 1);
- END;
- IF ~found THEN
- NEW(event);
- event.message := "StreamDisciplines.SetFieldSepSet: empty fieldsepset";
- event.type := badfieldsepset;
- Events.Raise(event);
- RETURN
- END;
- IF ~Disciplines.Seek(s, id, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN
- InitDiscipline(disc);
- END;
- disc.fieldseps := fieldsepset;
- disc.fieldsep := fieldsep;
- Disciplines.Add(s, disc);
- END SetFieldSepSet;
-
- PROCEDURE GetFieldSepSet*(s: Streams.Stream; VAR fieldsepset: Sets.CharSet);
- (* default field separators are ASCII.tab and ASCII.sp *)
- VAR
- disc: StreamDiscipline;
- BEGIN
- IF Disciplines.Seek(s, id, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN
- fieldsepset := disc.fieldseps;
- ELSE
- fieldsepset := defaultFieldSeps;
- END;
- END GetFieldSepSet;
-
- PROCEDURE SetFieldSep*(s: Streams.Stream; fieldsep: CHAR);
- VAR
- disc: StreamDiscipline;
- BEGIN
- IF ~Disciplines.Seek(s, id, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN
- InitDiscipline(disc);
- END;
- Sets.InclChar(disc.fieldseps, fieldsep);
- disc.fieldsep := fieldsep;
- Disciplines.Add(s, disc);
- END SetFieldSep;
-
- PROCEDURE GetFieldSep*(s: Streams.Stream; VAR fieldsep: CHAR);
- (* default field separator is ASCII.tab;
- if a set of field separators has been given via SetFieldSepSet,
- one of them is returned
- *)
- VAR
- disc: StreamDiscipline;
- BEGIN
- IF Disciplines.Seek(s, id, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN
- fieldsep := disc.fieldsep;
- ELSE
- fieldsep := defaultFieldSep;
- END;
- END GetFieldSep;
-
- PROCEDURE GetWhiteSpace*(s: Streams.Stream; VAR whitespace: Sets.CharSet);
- (* default: ASCII.tab, ASCII.sp, ASCII.np and ASCII.nl *)
- VAR
- disc: StreamDiscipline;
- BEGIN
- IF Disciplines.Seek(s, id, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN
- whitespace := disc.whitespace;
- ELSE
- whitespace := defaultWhiteSpace;
- END;
- END GetWhiteSpace;
-
- PROCEDURE SetWhiteSpace*(s: Streams.Stream; whitespace: Sets.CharSet);
- VAR
- disc: StreamDiscipline;
- BEGIN
- IF ~Disciplines.Seek(s, id, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN
- InitDiscipline(disc);
- END;
- disc.whitespace := whitespace;
- Disciplines.Add(s, disc);
- END SetWhiteSpace;
-
- PROCEDURE SetIndentationWidth*(s: Streams.Stream; indentwidth: INTEGER);
- VAR
- disc: StreamDiscipline;
- BEGIN
- IF indentwidth >= 0 THEN
- IF ~Disciplines.Seek(s, id, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN
- InitDiscipline(disc);
- END;
- disc.indentwidth := indentwidth;
- Disciplines.Add(s, disc);
- END;
- END SetIndentationWidth;
-
- PROCEDURE GetIndentationWidth*(s: Streams.Stream; VAR indentwidth: INTEGER);
- VAR
- disc: StreamDiscipline;
- BEGIN
- IF Disciplines.Seek(s, id, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN
- indentwidth := disc.indentwidth;
- ELSE
- indentwidth := defaultIndentWidth;
- END;
- END GetIndentationWidth;
-
- PROCEDURE IncrIndentationWidth*(s: Streams.Stream; incr: INTEGER);
- VAR
- disc: StreamDiscipline;
- BEGIN
- IF ~Disciplines.Seek(s, id, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN
- InitDiscipline(disc);
- END;
- IF disc.indentwidth + incr >= 0 THEN
- INC(disc.indentwidth, incr);;
- END;
- Disciplines.Add(s, disc);
- END IncrIndentationWidth;
+ PROCEDURE IncrIndentationWidth*(s: Streams.Stream; incr: INTEGER);
+ VAR
+ disc: Disciplines.Discipline;
+ BEGIN
+ IF ~Disciplines.Seek(s, id, disc) THEN
+ InitDiscipline(disc);
+ END;
+ IF disc(StreamDiscipline).indentwidth + incr >= 0 THEN
+ INC(disc(StreamDiscipline).indentwidth, incr);;
+ END;
+ Disciplines.Add(s, disc);
+ END IncrIndentationWidth;
BEGIN
- Events.Define(badfieldsepset);
+ Events.Define(badfieldsepset);
- id := Disciplines.Unique();
- Sets.InitSet(defaultFieldSeps);
- Sets.InclChar(defaultFieldSeps, ASCII.tab);
- Sets.InclChar(defaultFieldSeps, ASCII.sp);
- defaultFieldSep := ASCII.tab;
- defaultLineTerm[0] := ASCII.nl; defaultLineTerm[1] := 0X;
- Sets.InitSet(defaultWhiteSpace);
- Sets.InclChar(defaultWhiteSpace, ASCII.tab);
- Sets.InclChar(defaultWhiteSpace, ASCII.sp);
- Sets.InclChar(defaultWhiteSpace, ASCII.np);
- Sets.InclChar(defaultWhiteSpace, ASCII.nl);
- defaultIndentWidth := 0;
+ id := Disciplines.Unique();
+ Sets.InitSet(defaultFieldSeps);
+ Sets.InclChar(defaultFieldSeps, ASCII.tab);
+ Sets.InclChar(defaultFieldSeps, ASCII.sp);
+ defaultFieldSep := ASCII.tab;
+ defaultLineTerm[0] := ASCII.nl; defaultLineTerm[1] := 0X;
+ Sets.InitSet(defaultWhiteSpace);
+ Sets.InclChar(defaultWhiteSpace, ASCII.tab);
+ Sets.InclChar(defaultWhiteSpace, ASCII.sp);
+ Sets.InclChar(defaultWhiteSpace, ASCII.np);
+ Sets.InclChar(defaultWhiteSpace, ASCII.nl);
+ defaultIndentWidth := 0;
END ulmStreamDisciplines.
diff --git a/src/library/ulm/ulmStreams.Mod b/src/library/ulm/ulmStreams.Mod
index 149b1220..bb55c3e6 100644
--- a/src/library/ulm/ulmStreams.Mod
+++ b/src/library/ulm/ulmStreams.Mod
@@ -1,2150 +1,2150 @@
(* Ulm's Oberon Library
- Copyright (C) 1989-2001 by University of Ulm, SAI, D-89069 Ulm, Germany
- ----------------------------------------------------------------------------
- Ulm's Oberon Library is free software; you can redistribute it
- and/or modify it under the terms of the GNU Library General Public
- License as published by the Free Software Foundation; either version
- 2 of the License, or (at your option) any later version.
+ Copyright (C) 1989-2001 by University of Ulm, SAI, D-89069 Ulm, Germany
+ ----------------------------------------------------------------------------
+ Ulm's Oberon Library is free software; you can redistribute it
+ and/or modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either version
+ 2 of the License, or (at your option) any later version.
- Ulm's Oberon Library is distributed in the hope that it will be
- useful, but WITHOUT ANY WARRANTY; without even the implied warranty
- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Library General Public License for more details.
+ Ulm's Oberon Library is distributed in the hope that it will be
+ useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+ of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
- You should have received a copy of the GNU Library General Public
- License along with this library; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ----------------------------------------------------------------------------
- E-mail contact: oberon@mathematik.uni-ulm.de
- ----------------------------------------------------------------------------
- $Id: Streams.om,v 1.13 2005/02/14 23:36:35 borchert Exp $
- ----------------------------------------------------------------------------
- $Log: Streams.om,v $
- Revision 1.13 2005/02/14 23:36:35 borchert
- bug fix: WritePart called InternalFlush without considering
- that s.pos may be implicitly changed
- (this assumption was wrong since revision 1.11)
+ You should have received a copy of the GNU Library General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ----------------------------------------------------------------------------
+ E-mail contact: oberon@mathematik.uni-ulm.de
+ ----------------------------------------------------------------------------
+ $Id: Streams.om,v 1.13 2005/02/14 23:36:35 borchert Exp $
+ ----------------------------------------------------------------------------
+ $Log: Streams.om,v $
+ Revision 1.13 2005/02/14 23:36:35 borchert
+ bug fix: WritePart called InternalFlush without considering
+ that s.pos may be implicitly changed
+ (this assumption was wrong since revision 1.11)
- Revision 1.12 2004/05/20 09:52:43 borchert
- performance improvements:
- - WritePart and Write take now the buffer by reference
- - ReadByteFromBuf replaced by ReadBytesFromBuf
- (contributed by Christian Ehrhardt)
+ Revision 1.12 2004/05/20 09:52:43 borchert
+ performance improvements:
+ - WritePart and Write take now the buffer by reference
+ - ReadByteFromBuf replaced by ReadBytesFromBuf
+ (contributed by Christian Ehrhardt)
- Revision 1.11 2001/05/03 15:17:58 borchert
- InternalFlush adapted for unidirectional pipelines to avoid
- unintentional flushes due to buffer boundaries
+ Revision 1.11 2001/05/03 15:17:58 borchert
+ InternalFlush adapted for unidirectional pipelines to avoid
+ unintentional flushes due to buffer boundaries
- Revision 1.10 2000/04/25 21:41:47 borchert
- Streams.ReadPart loops now for unbuffered streams to collect input
- until cnt is reached
+ Revision 1.10 2000/04/25 21:41:47 borchert
+ Streams.ReadPart loops now for unbuffered streams to collect input
+ until cnt is reached
- Revision 1.9 1998/03/31 11:13:05 borchert
- bug fix: NotificationHandler just reacted on Resources.unreferenced
- but not on Resources.terminated
+ Revision 1.9 1998/03/31 11:13:05 borchert
+ bug fix: NotificationHandler just reacted on Resources.unreferenced
+ but not on Resources.terminated
- Revision 1.8 1998/03/24 22:58:28 borchert
- bug fix in Copy: left was computed incorrectly in case of
- copies with fixed length (# -1)
+ Revision 1.8 1998/03/24 22:58:28 borchert
+ bug fix in Copy: left was computed incorrectly in case of
+ copies with fixed length (# -1)
- Revision 1.7 1997/04/02 07:50:05 borchert
- Copy replaced by a slightly more efficient variant
+ Revision 1.7 1997/04/02 07:50:05 borchert
+ Copy replaced by a slightly more efficient variant
- Revision 1.6 1996/09/18 07:43:51 borchert
- qualified references to own module (i.e. Streams.XXX) removed
+ Revision 1.6 1996/09/18 07:43:51 borchert
+ qualified references to own module (i.e. Streams.XXX) removed
- Revision 1.5 1996/01/04 16:43:57 borchert
- some bug fixes in the updates of read and write regions
+ Revision 1.5 1996/01/04 16:43:57 borchert
+ some bug fixes in the updates of read and write regions
- Revision 1.4 1995/10/11 09:46:41 borchert
- - closeEvent re-introduced (because it gets raised *before*
- the actual close)
- - bug fix: s.write was diminished in ReadPart but the write region
- not properly adjusted
- - bug fix: InternalSeek was setting s.left to negative values in
- a special case
+ Revision 1.4 1995/10/11 09:46:41 borchert
+ - closeEvent re-introduced (because it gets raised *before*
+ the actual close)
+ - bug fix: s.write was diminished in ReadPart but the write region
+ not properly adjusted
+ - bug fix: InternalSeek was setting s.left to negative values in
+ a special case
- Revision 1.3 1995/04/18 12:17:12 borchert
- - Streams.Stream is now an extension of Services.Object
- - Library variant of assertions replaced by ASSERT
- - support of Resources added
- - EnableClose, PreventClose & closeEvent removed
+ Revision 1.3 1995/04/18 12:17:12 borchert
+ - Streams.Stream is now an extension of Services.Object
+ - Library variant of assertions replaced by ASSERT
+ - support of Resources added
+ - EnableClose, PreventClose & closeEvent removed
- Revision 1.2 1994/07/05 12:45:57 borchert
- some minor bug fixes & enhancements:
- - ReadPacket added
- - streams which don't require cleanup are now subject to the GC
- even if Close will never be called for them
- - line buffered streams w/o bufio/addrio capability fill now buffer
- up to the next line terminator only instead of trying to fill the
- whole buffer
- - ReadPart didn't set count correctly in all cases
- - Touch calls now the flush interface procedure
+ Revision 1.2 1994/07/05 12:45:57 borchert
+ some minor bug fixes & enhancements:
+ - ReadPacket added
+ - streams which don't require cleanup are now subject to the GC
+ even if Close will never be called for them
+ - line buffered streams w/o bufio/addrio capability fill now buffer
+ up to the next line terminator only instead of trying to fill the
+ whole buffer
+ - ReadPart didn't set count correctly in all cases
+ - Touch calls now the flush interface procedure
- Revision 1.1 1994/02/22 20:10:45 borchert
- Initial revision
+ Revision 1.1 1994/02/22 20:10:45 borchert
+ Initial revision
- ----------------------------------------------------------------------------
- AFB 6/89
- Major Revision: AFB 1/92: bufpool
- ----------------------------------------------------------------------------
+ ----------------------------------------------------------------------------
+ AFB 6/89
+ Major Revision: AFB 1/92: bufpool
+ ----------------------------------------------------------------------------
*)
MODULE ulmStreams;
- IMPORT Events := ulmEvents, Objects := ulmObjects, Priorities := ulmPriorities, Process := ulmProcess, RelatedEvents := ulmRelatedEvents, Resources := ulmResources,
- Services := ulmServices, SYS := ulmSYSTEM, SYSTEM, Types := ulmTypes;
+ IMPORT Events := ulmEvents, Objects := ulmObjects, Priorities := ulmPriorities, Process := ulmProcess, RelatedEvents := ulmRelatedEvents, Resources := ulmResources,
+ Services := ulmServices, SYS := ulmSYSTEM, SYSTEM, Types := ulmTypes;
- CONST
- (* 3rd parameter of Seek *)
- (* Whence = (fromStart, fromPos, fromEnd); *)
- fromStart* = 0; fromPos* = 1; fromEnd* = 2;
+ CONST
+ (* 3rd parameter of Seek *)
+ (* Whence = (fromStart, fromPos, fromEnd); *)
+ fromStart* = 0; fromPos* = 1; fromEnd* = 2;
- (* capabilities of a stream *)
- (* Capability = (read, write, addrio, bufio, seek, tell, trunc, close,
- holes, handler);
+ (* capabilities of a stream *)
+ (* Capability = (read, write, addrio, bufio, seek, tell, trunc, close,
+ holes, handler);
+ *)
+ read* = 0; write* = 1; addrio* = 2; bufio* = 3; seek* = 4; tell* = 5;
+ trunc* = 6; flush* = 7; close* = 8; holes* = 9; handler* = 10;
+
+ (* BufMode = (nobuf, linebuf, onebuf, bufpool); *)
+ nobuf* = 0; linebuf* = 1; onebuf* = 2; bufpool* = 3;
+
+ (* ErrorCode = (NoHandlerDefined, CannotRead, CannotSeek, CloseFailed,
+ NotLineBuffered, SeekFailed, TellFailed, BadWhence,
+ CannotTell, WriteFailed, CannotWrite, ReadFailed,
+ Unbuffered, BadParameters, CannotTrunc, TruncFailed,
+ NestedCall, FlushFailed);
+ *)
+ NoHandlerDefined* = 0; (* no handler defined *)
+ CannotRead* = 1; (* stream is write only *)
+ CannotSeek* = 2; (* stream is not capable of seeking *)
+ CloseFailed* = 3; (* Flush or Close failed *)
+ NotLineBuffered* = 4; (* LineTerm must not be called *)
+ SeekFailed* = 5; (* seek operation failed *)
+ TellFailed* = 6; (* tell operation failed *)
+ BadWhence* = 7; (* whence value out of [fromStart..fromEnd] *)
+ CannotTell* = 8; (* stream does not have a current position *)
+ WriteFailed* = 9; (* write error *)
+ CannotWrite* = 10; (* stream is read only *)
+ ReadFailed* = 11; (* read error *)
+ Unbuffered* = 12; (* operation isn't valid for unbuff'd streams *)
+ BadParameters* = 13; (* e.g. wrong count or offset values *)
+ CannotTrunc* = 14; (* stream is not capable of truncating *)
+ TruncFailed* = 15; (* trunc operation failed *)
+ NestedCall* = 16; (* nested stream operation *)
+ FlushFailed* = 17; (* flush operation failed *)
+ errorcodes* = 18; (* number of error codes *)
+
+ (* === private constants ======================================= *)
+ bufsize = 8192; (* should be the file system block size *)
+ defaulttermch = 0AX; (* default line terminator (for linebuf) *)
+
+ TYPE
+ Address* = Types.Address;
+ Count* = Types.Count;
+ Byte* = Types.Byte;
+ Whence* = SHORTINT; (* Whence = (fromStart, fromPos, fromEnd); *)
+ CapabilitySet* = SET; (* OF Capability; *)
+ BufMode* = SHORTINT;
+ ErrorCode* = SHORTINT;
+ Stream* = POINTER TO StreamRec;
+ Message* = RECORD (Objects.ObjectRec) END;
+
+ (* the buffering system:
+
+ buffers are always on bufsize-boundaries
+
+ ok: the other components are defined
+ pos: file position of cont[0] (pos MOD bufsize = 0)
+ cont: valid data: cont[rbegin]..cont[rend-1] (read-region)
+ written data: cont[wbegin]..cont[wend-1] (write-region)
+
+ both regions are maintained (even for non-rw streams)
+ *)
+ Buffer = POINTER TO BufferRec;
+ BufferRec =
+ RECORD
+ ok: BOOLEAN; (* TRUE if other components are valid *)
+ pos: Count; (* file position which corresponds to cont[0] *)
+ rbegin: Count; (* read-region: starting index *)
+ rend: Count; (* read-region: ending index *)
+ wbegin: Count; (* write-region: starting index of dirty region *)
+ wend: Count; (* write-region: ending index *)
+ cont: ARRAY bufsize OF Byte; (* buffer contents *)
+ nextfree: Buffer; (* only needed for released buffers *)
+ (* components for buffers which are members of a buffer pool *)
+ prevh, nexth: Buffer; (* next buffer with same the hash value *)
+ preva, nexta: Buffer; (* sorted list of buffers (access time) *)
+ END;
+
+ CONST
+ hashtabsize = 128; (* size of bucket table *)
+ TYPE
+ BucketTable = ARRAY hashtabsize OF Buffer;
+ BufferPool = POINTER TO BufferPoolRec;
+ BufferPoolRec =
+ RECORD
+ maxbuf: INTEGER; (* maximal number of buffers to be used *)
+ nbuf: INTEGER; (* number of buffers in use *)
+ bucket: BucketTable;
+ (* list of all buffers sorted after the last access time;
+ tail points to the buffer most recently accessed
+ *)
+ head, tail: Buffer;
+ END;
+
+ TYPE
+ AddrIOProc* = PROCEDURE (s: Stream; ptr: Address; cnt: Count) : Count;
+ BufIOProc* = PROCEDURE (s: Stream; VAR buf: ARRAY OF Byte;
+ off, cnt: Count) : Count;
+ SeekProc* = PROCEDURE (s: Stream; cnt: Count; whence: Whence) : BOOLEAN;
+ TellProc* = PROCEDURE (s: Stream; VAR cnt: Count) : BOOLEAN;
+ ReadProc* = PROCEDURE (s: Stream; VAR byte: Byte) : BOOLEAN;
+ WriteProc* = PROCEDURE (s: Stream; byte: Byte) : BOOLEAN;
+ TruncProc* = PROCEDURE (s: Stream; cnt: Count) : BOOLEAN;
+ FlushProc* = PROCEDURE (s: Stream) : BOOLEAN;
+ CloseProc* = PROCEDURE (s: Stream) : BOOLEAN;
+ HandlerProc* = PROCEDURE (s: Stream; VAR msg: Message);
+
+ Interface* = POINTER TO InterfaceRec;
+ InterfaceRec* =
+ RECORD
+ (Objects.ObjectRec)
+ addrread*: AddrIOProc; (* read, addrio *)
+ addrwrite*: AddrIOProc; (* write, addrio *)
+ bufread*: BufIOProc; (* read, bufio *)
+ bufwrite*: BufIOProc; (* write, bufio *)
+ read*: ReadProc; (* read *)
+ write*: WriteProc; (* write *)
+ seek*: SeekProc; (* seek *)
+ tell*: TellProc; (* tell *)
+ trunc*: TruncProc; (* trunc *)
+ flush*: FlushProc; (* flush *)
+ close*: CloseProc; (* close *)
+ handler*: HandlerProc; (* handler *)
+ END;
+
+ StreamRec* =
+ RECORD
+ (Services.ObjectRec)
+ (* following components are set after i/o-operations *)
+ count*: Count; (* resulting count of last operation *)
+ errors*: INTEGER; (* incremented for each error; may be set to 0 *)
+ error*: BOOLEAN; (* last operation successful? *)
+ lasterror*: ErrorCode; (* error code of last error *)
+ eof*: BOOLEAN; (* last read-operation with count=0 returned *)
+ (* === private part ============================================ *)
+ prev, next: Stream; (* list of open streams *)
+ if: Interface; caps: CapabilitySet;
+ bufmode: BufMode; (* buffering mode *)
+ bidirect: BOOLEAN; (* bidirectional buffering? *)
+ termch: Byte; (* flush on termch (linebuf only) *)
+ inlist: BOOLEAN; (* member of the list of opened streams? *)
+ tiedStream: Stream; (* to be flushed before read operations *)
+ buf: Buffer; (* current buffer; = NIL for unbuffered streams *)
+ wbuf: Buffer; (* buffer for writing (only if bidirect = TRUE) *)
+ bufpool: BufferPool; (* only if bufmode = bufpool *)
+ validpos: BOOLEAN; (* pos valid? *)
+ pos: Count; (* current position in stream *)
+ maxpos: Count; (* maximal position until now (only if buf # NIL) *)
+ left: Count; (* number of bytes left in buf (after pos) *)
+ write: Count; (* number of bytes which can be written in buf *)
+ rpos: Count; (* current position of if.tell *)
+ wextensible: BOOLEAN; (* write region extensible? *)
+ eofFound: BOOLEAN; (* eof seen yet? temporary use only *)
+ lock: BOOLEAN; (* avoid recursive operations *)
+ flushEvent: Events.EventType; (* valid if # NIL *)
+ closeEvent: Events.EventType; (* valid if # NIL *)
+ END;
+ VAR
+ type: Services.Type;
+
+ TYPE
+ (* each error causes an event;
+ the error number is stored in event.errorcode;
+ the associated text can be taken from event.message
+ *)
+ Event* = POINTER TO EventRec;
+ EventRec* =
+ RECORD
+ (Events.EventRec)
+ stream*: Stream;
+ errorcode*: ErrorCode;
+ END;
+
+ VAR
+ null*: Stream; (* accepts any output; does not return input *)
+ (* these streams are set by other modules;
+ after initialization of Streams they equal `null';
+ so, connections with the standard UNIX streams must be
+ done by other modules
+ *)
+ stdin*, stdout*, stderr*: Stream;
+ errormsg*: ARRAY errorcodes OF Events.Message;
+ error*: Events.EventType;
+
+ (* === private variables ========================================== *)
+
+ opened: Stream; (* list of opened streams *)
+ (* this list has been reduced to the set of streams which
+ need to be cleaned up explicitly;
+ all other streams are subject to the garbage collection
+ even if Close has never been called for them
*)
- read* = 0; write* = 1; addrio* = 2; bufio* = 3; seek* = 4; tell* = 5;
- trunc* = 6; flush* = 7; close* = 8; holes* = 9; handler* = 10;
+ freelist: Buffer; (* list of free buffers *)
+ nullif: Interface; (* interface of null-devices *)
- (* BufMode = (nobuf, linebuf, onebuf, bufpool); *)
- nobuf* = 0; linebuf* = 1; onebuf* = 2; bufpool* = 3;
+ (* === private procedures ========================================= *)
- (* ErrorCode = (NoHandlerDefined, CannotRead, CannotSeek, CloseFailed,
- NotLineBuffered, SeekFailed, TellFailed, BadWhence,
- CannotTell, WriteFailed, CannotWrite, ReadFailed,
- Unbuffered, BadParameters, CannotTrunc, TruncFailed,
- NestedCall, FlushFailed);
+ PROCEDURE NewStream(s: Stream);
+ BEGIN
+ IF s.inlist THEN
+ s.prev := NIL;
+ s.next := opened;
+ IF opened # NIL THEN
+ opened.prev := s;
+ END;
+ opened := s;
+ END;
+ END NewStream;
+
+ PROCEDURE OldStream(s: Stream);
+ BEGIN
+ IF s.inlist THEN
+ IF s.prev # NIL THEN
+ s.prev.next := s.next;
+ ELSE
+ opened := s.next;
+ END;
+ IF s.next # NIL THEN
+ s.next.prev := s.prev;
+ END;
+ END;
+ END OldStream;
+
+ PROCEDURE NewBuffer(VAR b: Buffer);
+ BEGIN
+ IF freelist # NIL THEN
+ b := freelist;
+ freelist := freelist.nextfree;
+ ELSE
+ NEW(b);
+ END;
+ b.nextfree := NIL;
+ b.ok := FALSE;
+ END NewBuffer;
+
+ PROCEDURE OldBuffer(VAR b: Buffer);
+ BEGIN
+ b.nextfree := freelist;
+ freelist := b;
+ b := NIL;
+ END OldBuffer;
+
+ PROCEDURE Error(s: Stream; code: ErrorCode);
+ VAR
+ event: Event;
+ BEGIN
+ IF s # NIL THEN
+ INC(s.errors);
+ s.error := TRUE;
+ s.lasterror := code;
+
+ (* generate error event *)
+ NEW(event);
+ event.type := error;
+ event.message := errormsg[code];
+ event.stream := s;
+ event.errorcode := code;
+ RelatedEvents.Raise(s, event);
+ END;
+ END Error;
+
+ PROCEDURE ^ InternalFlush(s: Stream) : BOOLEAN;
+
+ (* ===== management of buffer pool ================================== *)
+
+ PROCEDURE InitBufPool(s: Stream);
+ VAR
+ index: INTEGER;
+ BEGIN
+ s.bufpool.maxbuf := 16; (* default size *)
+ s.bufpool.nbuf := 0; (* currently, no buffers are allocated *)
+ s.bufpool.head := NIL; s.bufpool.tail := NIL;
+ index := 0;
+ WHILE index < hashtabsize DO
+ s.bufpool.bucket[index] := NIL;
+ INC(index);
+ END;
+ END InitBufPool;
+
+ PROCEDURE HashValue(pos: Count) : INTEGER;
+ (* HashValue returns a hash value for pos *)
+ BEGIN
+ RETURN SHORT(pos DIV bufsize) MOD hashtabsize
+ END HashValue;
+
+ PROCEDURE FindBuffer(s: Stream; pos: Count; VAR buf: Buffer) : BOOLEAN;
+ VAR
+ index: INTEGER;
+ bp: Buffer;
+ BEGIN
+ index := HashValue(pos);
+ bp := s.bufpool.bucket[index];
+ WHILE bp # NIL DO
+ IF bp.pos = pos THEN
+ buf := bp; RETURN TRUE
+ END;
+ bp := bp.nexth; (* next buffer with same hash value *)
+ END;
+ buf := NIL;
+ RETURN FALSE
+ END FindBuffer;
+
+ PROCEDURE GetBuffer(s: Stream);
+ (* look for buffer for s.pos and make it to the current buffer;
+ set s.left and s.write in dependance of s.pos
+ *)
+ VAR
+ buf: Buffer;
+ pos: Count; (* buffer boundary for s.pos *)
+ posindex: Count; (* buf[posindex] corresponds to s.pos *)
+ index: INTEGER; (* index into bucket table of the buffer pool *)
+
+ PROCEDURE InitBuf(buf: Buffer);
+ VAR
+ index: INTEGER; (* of bucket table *)
+ BEGIN
+ buf.ok := TRUE;
+ buf.pos := pos;
+ buf.rbegin := posindex; buf.rend := posindex; s.left := 0;
+ buf.wbegin := posindex; buf.wend := posindex;
+ s.write := bufsize - posindex;
+ buf.nextfree := NIL;
+
+ (* insert buf into hash list *)
+ index := HashValue(pos);
+ buf.prevh := NIL;
+ buf.nexth := s.bufpool.bucket[index];
+ IF buf.nexth # NIL THEN
+ buf.nexth.prevh := buf;
+ END;
+ s.bufpool.bucket[index] := buf;
+
+ (* buf is already at the end of the sorted list if we
+ re-use an old buffer
*)
- NoHandlerDefined* = 0; (* no handler defined *)
- CannotRead* = 1; (* stream is write only *)
- CannotSeek* = 2; (* stream is not capable of seeking *)
- CloseFailed* = 3; (* Flush or Close failed *)
- NotLineBuffered* = 4; (* LineTerm must not be called *)
- SeekFailed* = 5; (* seek operation failed *)
- TellFailed* = 6; (* tell operation failed *)
- BadWhence* = 7; (* whence value out of [fromStart..fromEnd] *)
- CannotTell* = 8; (* stream does not have a current position *)
- WriteFailed* = 9; (* write error *)
- CannotWrite* = 10; (* stream is read only *)
- ReadFailed* = 11; (* read error *)
- Unbuffered* = 12; (* operation isn't valid for unbuff'd streams *)
- BadParameters* = 13; (* e.g. wrong count or offset values *)
- CannotTrunc* = 14; (* stream is not capable of truncating *)
- TruncFailed* = 15; (* trunc operation failed *)
- NestedCall* = 16; (* nested stream operation *)
- FlushFailed* = 17; (* flush operation failed *)
- errorcodes* = 18; (* number of error codes *)
+ IF s.bufpool.tail # buf THEN
+ (* append buf to the sorted list *)
+ buf.nexta := NIL;
+ IF s.bufpool.tail = NIL THEN
+ s.bufpool.head := buf;
+ buf.preva := NIL;
+ ELSE
+ s.bufpool.tail.nexta := buf;
+ buf.preva := s.bufpool.tail;
+ END;
+ s.bufpool.tail := buf;
+ END;
+ END InitBuf;
- (* === private constants ======================================= *)
- bufsize = 8192; (* should be the file system block size *)
- defaulttermch = 0AX; (* default line terminator (for linebuf) *)
+ PROCEDURE UseBuffer(s: Stream; buf: Buffer);
+ (* make buf to the current buffer of s *)
+ BEGIN
+ IF s.buf # buf THEN
+ (* remove buf from sorted list *)
+ IF buf.preva # NIL THEN
+ buf.preva.nexta := buf.nexta;
+ ELSE
+ s.bufpool.head := buf.nexta;
+ END;
+ IF buf.nexta # NIL THEN
+ buf.nexta.preva := buf.preva;
+ ELSE
+ s.bufpool.tail := buf.preva;
+ END;
- TYPE
- Address* = Types.Address;
- Count* = Types.Count;
- Byte* = Types.Byte;
- Whence* = SHORTINT; (* Whence = (fromStart, fromPos, fromEnd); *)
- CapabilitySet* = SET; (* OF Capability; *)
- BufMode* = SHORTINT;
- ErrorCode* = SHORTINT;
- Stream* = POINTER TO StreamRec;
- Message* = RECORD (Objects.ObjectRec) END;
+ (* append buf to sorted list *)
+ buf.nexta := NIL;
+ IF s.bufpool.tail = NIL THEN
+ s.bufpool.head := buf;
+ buf.preva := NIL;
+ ELSE
+ s.bufpool.tail.nexta := buf;
+ buf.preva := s.bufpool.tail;
+ END;
+ s.bufpool.tail := buf;
- (* the buffering system:
+ (* set current buf of s to buf *)
+ s.buf := buf;
- buffers are always on bufsize-boundaries
+ (* update s.left and s.write *)
+ IF buf.rbegin = buf.rend THEN
+ buf.rbegin := posindex; buf.rend := posindex; s.left := 0;
+ ELSIF (posindex >= buf.rbegin) & (posindex < buf.rend) THEN
+ s.left := buf.rend - posindex;
+ ELSE
+ s.left := 0;
+ END;
+ IF buf.wbegin = buf.wend THEN
+ buf.wbegin := posindex; buf.wend := posindex;
+ s.write := bufsize - posindex;
+ ELSIF (posindex >= buf.wbegin) & (posindex < buf.wend) THEN
+ s.write := bufsize - posindex;
+ ELSE
+ s.write := 0;
+ END;
+ END;
+ END UseBuffer;
- ok: the other components are defined
- pos: file position of cont[0] (pos MOD bufsize = 0)
- cont: valid data: cont[rbegin]..cont[rend-1] (read-region)
- written data: cont[wbegin]..cont[wend-1] (write-region)
+ BEGIN (* GetBuffer *)
+ posindex := s.pos MOD bufsize;
+ pos := s.pos - posindex;
- both regions are maintained (even for non-rw streams)
- *)
- Buffer = POINTER TO BufferRec;
- BufferRec =
- RECORD
- ok: BOOLEAN; (* TRUE if other components are valid *)
- pos: Count; (* file position which corresponds to cont[0] *)
- rbegin: Count; (* read-region: starting index *)
- rend: Count; (* read-region: ending index *)
- wbegin: Count; (* write-region: starting index of dirty region *)
- wend: Count; (* write-region: ending index *)
- cont: ARRAY bufsize OF Byte; (* buffer contents *)
- nextfree: Buffer; (* only needed for released buffers *)
- (* components for buffers which are members of a buffer pool *)
- prevh, nexth: Buffer; (* next buffer with same the hash value *)
- preva, nexta: Buffer; (* sorted list of buffers (access time) *)
- END;
+ IF ~s.buf.ok THEN
+ (* init first allocated buffer which has not been used until now *)
+ InitBuf(s.buf);
+ INC(s.bufpool.nbuf);
+ ELSIF s.buf.pos # pos THEN
+ IF FindBuffer(s, pos, buf) THEN
+ UseBuffer(s, buf);
+ ELSE
+ IF s.bufpool.nbuf >= s.bufpool.maxbuf THEN
+ (* re-use already allocated buffer *)
+ buf := s.bufpool.head;
+ UseBuffer(s, buf);
+ IF buf.wbegin # buf.wend THEN
+ IF ~InternalFlush(s) THEN END;
+ END;
- CONST
- hashtabsize = 128; (* size of bucket table *)
- TYPE
- BucketTable = ARRAY hashtabsize OF Buffer;
- BufferPool = POINTER TO BufferPoolRec;
- BufferPoolRec =
- RECORD
- maxbuf: INTEGER; (* maximal number of buffers to be used *)
- nbuf: INTEGER; (* number of buffers in use *)
- bucket: BucketTable;
- (* list of all buffers sorted after the last access time;
- tail points to the buffer most recently accessed
- *)
- head, tail: Buffer;
- END;
+ (* remove buf from hash list *)
+ IF buf.prevh # NIL THEN
+ buf.prevh.nexth := buf.nexth;
+ ELSE
+ index := HashValue(buf.pos);
+ s.bufpool.bucket[index] := buf.nexth;
+ END;
+ IF buf.nexth # NIL THEN
+ buf.nexth.prevh := buf.prevh;
+ END;
- TYPE
- AddrIOProc* = PROCEDURE (s: Stream; ptr: Address; cnt: Count) : Count;
- BufIOProc* = PROCEDURE (s: Stream; VAR buf: ARRAY OF Byte;
- off, cnt: Count) : Count;
- SeekProc* = PROCEDURE (s: Stream; cnt: Count; whence: Whence) : BOOLEAN;
- TellProc* = PROCEDURE (s: Stream; VAR cnt: Count) : BOOLEAN;
- ReadProc* = PROCEDURE (s: Stream; VAR byte: Byte) : BOOLEAN;
- WriteProc* = PROCEDURE (s: Stream; byte: Byte) : BOOLEAN;
- TruncProc* = PROCEDURE (s: Stream; cnt: Count) : BOOLEAN;
- FlushProc* = PROCEDURE (s: Stream) : BOOLEAN;
- CloseProc* = PROCEDURE (s: Stream) : BOOLEAN;
- HandlerProc* = PROCEDURE (s: Stream; VAR msg: Message);
+ InitBuf(buf);
+ ELSE
+ (* allocate and initialize new buffer *)
+ NewBuffer(buf);
+ InitBuf(buf);
+ INC(s.bufpool.nbuf);
+ END;
+ s.buf := buf;
+ END;
+ END;
+ END GetBuffer;
- Interface* = POINTER TO InterfaceRec;
- InterfaceRec* =
- RECORD
- (Objects.ObjectRec)
- addrread*: AddrIOProc; (* read, addrio *)
- addrwrite*: AddrIOProc; (* write, addrio *)
- bufread*: BufIOProc; (* read, bufio *)
- bufwrite*: BufIOProc; (* write, bufio *)
- read*: ReadProc; (* read *)
- write*: WriteProc; (* write *)
- seek*: SeekProc; (* seek *)
- tell*: TellProc; (* tell *)
- trunc*: TruncProc; (* trunc *)
- flush*: FlushProc; (* flush *)
- close*: CloseProc; (* close *)
- handler*: HandlerProc; (* handler *)
- END;
+ PROCEDURE FlushBufPool(s: Stream) : BOOLEAN;
+ VAR
+ buf: Buffer;
+ ok: BOOLEAN;
+ BEGIN
+ ok := TRUE;
+ IF s.bufpool.nbuf > 0 THEN
+ buf := s.bufpool.head;
+ WHILE buf # NIL DO
+ s.buf := buf;
+ ok := InternalFlush(s) & ok;
+ buf := buf.nexta;
+ END;
+ END;
+ RETURN ok
+ END FlushBufPool;
- StreamRec* =
- RECORD
- (Services.ObjectRec)
- (* following components are set after i/o-operations *)
- count*: Count; (* resulting count of last operation *)
- errors*: INTEGER; (* incremented for each error; may be set to 0 *)
- error*: BOOLEAN; (* last operation successful? *)
- lasterror*: ErrorCode; (* error code of last error *)
- eof*: BOOLEAN; (* last read-operation with count=0 returned *)
- (* === private part ============================================ *)
- prev, next: Stream; (* list of open streams *)
- if: Interface; caps: CapabilitySet;
- bufmode: BufMode; (* buffering mode *)
- bidirect: BOOLEAN; (* bidirectional buffering? *)
- termch: Byte; (* flush on termch (linebuf only) *)
- inlist: BOOLEAN; (* member of the list of opened streams? *)
- tiedStream: Stream; (* to be flushed before read operations *)
- buf: Buffer; (* current buffer; = NIL for unbuffered streams *)
- wbuf: Buffer; (* buffer for writing (only if bidirect = TRUE) *)
- bufpool: BufferPool; (* only if bufmode = bufpool *)
- validpos: BOOLEAN; (* pos valid? *)
- pos: Count; (* current position in stream *)
- maxpos: Count; (* maximal position until now (only if buf # NIL) *)
- left: Count; (* number of bytes left in buf (after pos) *)
- write: Count; (* number of bytes which can be written in buf *)
- rpos: Count; (* current position of if.tell *)
- wextensible: BOOLEAN; (* write region extensible? *)
- eofFound: BOOLEAN; (* eof seen yet? temporary use only *)
- lock: BOOLEAN; (* avoid recursive operations *)
- flushEvent: Events.EventType; (* valid if # NIL *)
- closeEvent: Events.EventType; (* valid if # NIL *)
- END;
- VAR
+ PROCEDURE ReleaseBufPool(s: Stream);
+ (* precondition: all buffers are flushed *)
+ VAR
+ buf: Buffer;
+ BEGIN
+ IF s.bufpool.nbuf > 0 THEN
+ buf := s.bufpool.head;
+ WHILE buf # NIL DO
+ s.buf := buf;
+ OldBuffer(s.buf);
+ buf := buf.nexta;
+ END;
+ END;
+ NewBuffer(s.buf);
+ InitBufPool(s);
+ END ReleaseBufPool;
+
+ (* ================================================================== *)
+
+ PROCEDURE GetBufMode*(s: Stream) : BufMode;
+ BEGIN
+ RETURN s.bufmode
+ END GetBufMode;
+
+ PROCEDURE LineTerm*(s: Stream; termch: Byte);
+ (* set line terminator of `s' (linebuf) to `termch' *)
+ BEGIN
+ s.error := FALSE;
+ IF s.bufmode = linebuf THEN
+ s.termch := termch;
+ ELSE
+ Error(s, NotLineBuffered);
+ END;
+ END LineTerm;
+
+ PROCEDURE Tie*(in, out: Stream);
+ (* PRE: `in' is an line buffered input stream,
+ `out' an output stream,
+ and `in' # `out';
+ causes `out' to be flushed before reading from `in';
+ `out' may be NIL to undo the effect
+ *)
+ BEGIN
+ in.error := FALSE;
+ IF in.bufmode # linebuf THEN
+ Error(in, NotLineBuffered); RETURN
+ END;
+ IF (in = out) OR ~(read IN in.caps) OR
+ (out # NIL) & ~(write IN out.caps) THEN
+ Error(in, BadParameters); RETURN
+ END;
+ in.tiedStream := out;
+ END Tie;
+
+ PROCEDURE SetBufferPoolSize*(s: Stream; nbuf: INTEGER);
+ BEGIN
+ s.error := FALSE;
+ IF SYS.TAS(s.lock) THEN
+ Error(s, NestedCall); RETURN
+ END;
+ IF (s.bufmode = bufpool) & (nbuf >= 1) THEN
+ s.bufpool.maxbuf := nbuf;
+ END;
+ s.lock := FALSE;
+ END SetBufferPoolSize;
+
+ PROCEDURE GetBufferPoolSize*(s: Stream; VAR nbuf: INTEGER);
+ BEGIN
+ s.error := FALSE;
+ CASE s.bufmode OF
+ | nobuf: nbuf := 0;
+ | linebuf: nbuf := 1;
+ | onebuf: nbuf := 1;
+ | bufpool: nbuf := s.bufpool.maxbuf;
+ ELSE (* Explicitly ignore unhandled values of s.bufmode *)
+ END;
+ END GetBufferPoolSize;
+
+ PROCEDURE Capabilities*(s: Stream) : CapabilitySet;
+ BEGIN
+ s.error := FALSE;
+ RETURN s.caps
+ END Capabilities;
+
+ PROCEDURE GetFlushEvent*(s: Stream; VAR type: Events.EventType);
+ (* `type' will be raised BEFORE every flush operation *)
+ BEGIN
+ s.error := FALSE;
+ IF s.flushEvent = NIL THEN
+ Events.Define(s.flushEvent);
+ END;
+ type := s.flushEvent;
+ END GetFlushEvent;
+
+ PROCEDURE GetCloseEvent*(s: Stream; VAR type: Events.EventType);
+ (* `type' will be raised BEFORE the stream gets closed;
+ that means write operations etc. are legal
+ *)
+ BEGIN
+ s.error := FALSE;
+ IF s.closeEvent = NIL THEN
+ Events.Define(s.closeEvent);
+ END;
+ type := s.closeEvent;
+ END GetCloseEvent;
+
+ PROCEDURE Close*(s: Stream) : BOOLEAN;
+ VAR
+ event: Event;
+ type: Events.EventType;
+ otherStream: Stream;
+ BEGIN
+ s.error := FALSE;
+
+ IF (s.closeEvent # NIL) & ~SYS.TAS(s.lock) THEN
+ type := s.closeEvent; s.closeEvent := NIL;
+ s.lock := FALSE;
+ Events.SetPriority(type, Events.GetPriority() + 1);
+ NEW(event);
+ event.type := type;
+ event.message := "close event of Streams";
+ event.stream := s;
+ Events.Raise(event);
+ END;
+
+ IF ~SYS.TAS(s.lock) THEN
+ IF write IN s.caps THEN
+ IF s.bufmode = bufpool THEN
+ IF ~FlushBufPool(s) THEN END;
+ ELSE
+ IF ~InternalFlush(s) THEN END;
+ END;
+ END;
+ IF close IN s.caps THEN
+ IF ~s.if.close(s) THEN
+ Error(s, CloseFailed);
+ END;
+ END;
+ IF s.buf # NIL THEN
+ IF s.bufmode = bufpool THEN
+ ReleaseBufPool(s);
+ END;
+ OldBuffer(s.buf);
+ END;
+ OldStream(s);
+
+ (* check if this stream has been tied to another stream *)
+ otherStream := opened;
+ WHILE otherStream # NIL DO
+ IF otherStream.tiedStream = s THEN
+ otherStream.tiedStream := NIL; (* undo tie operation *)
+ END;
+ otherStream := otherStream.next;
+ END;
+ (* s.lock remains TRUE to prevent further operations *)
+ Resources.Notify(s, Resources.terminated);
+ RETURN ~s.error
+ ELSE
+ Error(s, NestedCall);
+ RETURN FALSE
+ END;
+ END Close;
+
+ PROCEDURE Release*(s: Stream);
+ BEGIN
+ IF ~Close(s) THEN END;
+ END Release;
+
+ PROCEDURE CloseAll*;
+ BEGIN
+ WHILE opened # NIL DO
+ (* that's no endless loop; see Close/OldStream *)
+ Release(opened);
+ END;
+ END CloseAll;
+
+ PROCEDURE NotificationHandler(event: Events.Event);
+ VAR
+ s: Stream;
+ BEGIN
+ IF ~(event IS Resources.Event) THEN RETURN END;
+ WITH event: Resources.Event DO
+ IF ~(event.resource IS Stream) THEN RETURN END;
+ s := event.resource(Stream);
+ IF event.change IN {Resources.unreferenced, Resources.terminated} THEN
+ IF ~s.lock THEN
+ Release(s);
+ END;
+ END;
+ END;
+ END NotificationHandler;
+
+ PROCEDURE Init*(s: Stream; if: Interface; caps: CapabilitySet;
+ bufmode: BufMode);
+
+ VAR
+ eventType: Events.EventType;
type: Services.Type;
- TYPE
- (* each error causes an event;
- the error number is stored in event.errorcode;
- the associated text can be taken from event.message
- *)
- Event* = POINTER TO EventRec;
- EventRec* =
- RECORD
- (Events.EventRec)
- stream*: Stream;
- errorcode*: ErrorCode;
- END;
+ PROCEDURE InitBidirectionalBuffering(s: Stream);
+ BEGIN
+ s.validpos := TRUE;
+ s.pos := 0;
+ NewBuffer(s.wbuf);
+ s.buf.ok := TRUE; s.buf.rbegin := 0; s.buf.rend := 0; s.buf.pos := 0;
+ s.wbuf.ok := TRUE; s.wbuf.wbegin := 0; s.wbuf.wend := 0;
+ s.wbuf.pos := 0;
+ s.left := 0; s.write := bufsize;
+ END InitBidirectionalBuffering;
- VAR
- null*: Stream; (* accepts any output; does not return input *)
- (* these streams are set by other modules;
- after initialization of Streams they equal `null';
- so, connections with the standard UNIX streams must be
- done by other modules
- *)
- stdin*, stdout*, stderr*: Stream;
- errormsg*: ARRAY errorcodes OF Events.Message;
- error*: Events.EventType;
-
- (* === private variables ========================================== *)
-
- opened: Stream; (* list of opened streams *)
- (* this list has been reduced to the set of streams which
- need to be cleaned up explicitly;
- all other streams are subject to the garbage collection
- even if Close has never been called for them
- *)
- freelist: Buffer; (* list of free buffers *)
- nullif: Interface; (* interface of null-devices *)
-
- (* === private procedures ========================================= *)
-
- PROCEDURE NewStream(s: Stream);
- BEGIN
- IF s.inlist THEN
- s.prev := NIL;
- s.next := opened;
- IF opened # NIL THEN
- opened.prev := s;
- END;
- opened := s;
- END;
- END NewStream;
-
- PROCEDURE OldStream(s: Stream);
- BEGIN
- IF s.inlist THEN
- IF s.prev # NIL THEN
- s.prev.next := s.next;
- ELSE
- opened := s.next;
- END;
- IF s.next # NIL THEN
- s.next.prev := s.prev;
- END;
- END;
- END OldStream;
-
- PROCEDURE NewBuffer(VAR b: Buffer);
- BEGIN
- IF freelist # NIL THEN
- b := freelist;
- freelist := freelist.nextfree;
- ELSE
- NEW(b);
- END;
- b.nextfree := NIL;
- b.ok := FALSE;
- END NewBuffer;
-
- PROCEDURE OldBuffer(VAR b: Buffer);
- BEGIN
- b.nextfree := freelist;
- freelist := b;
- b := NIL;
- END OldBuffer;
-
- PROCEDURE Error(s: Stream; code: ErrorCode);
- VAR
- event: Event;
- BEGIN
- IF s # NIL THEN
- INC(s.errors);
- s.error := TRUE;
- s.lasterror := code;
-
- (* generate error event *)
- NEW(event);
- event.type := error;
- event.message := errormsg[code];
- event.stream := s;
- event.errorcode := code;
- RelatedEvents.Raise(s, event);
- END;
- END Error;
-
- PROCEDURE ^ InternalFlush(s: Stream) : BOOLEAN;
-
- (* ===== management of buffer pool ================================== *)
-
- PROCEDURE InitBufPool(s: Stream);
- VAR
- index: INTEGER;
- BEGIN
- s.bufpool.maxbuf := 16; (* default size *)
- s.bufpool.nbuf := 0; (* currently, no buffers are allocated *)
- s.bufpool.head := NIL; s.bufpool.tail := NIL;
- index := 0;
- WHILE index < hashtabsize DO
- s.bufpool.bucket[index] := NIL;
- INC(index);
- END;
- END InitBufPool;
-
- PROCEDURE HashValue(pos: Count) : INTEGER;
- (* HashValue returns a hash value for pos *)
- BEGIN
- RETURN SHORT(pos DIV bufsize) MOD hashtabsize
- END HashValue;
-
- PROCEDURE FindBuffer(s: Stream; pos: Count; VAR buf: Buffer) : BOOLEAN;
- VAR
- index: INTEGER;
- bp: Buffer;
- BEGIN
- index := HashValue(pos);
- bp := s.bufpool.bucket[index];
- WHILE bp # NIL DO
- IF bp.pos = pos THEN
- buf := bp; RETURN TRUE
- END;
- bp := bp.nexth; (* next buffer with same hash value *)
- END;
- buf := NIL;
- RETURN FALSE
- END FindBuffer;
-
- PROCEDURE GetBuffer(s: Stream);
- (* look for buffer for s.pos and make it to the current buffer;
- set s.left and s.write in dependance of s.pos
- *)
- VAR
- buf: Buffer;
- pos: Count; (* buffer boundary for s.pos *)
- posindex: Count; (* buf[posindex] corresponds to s.pos *)
- index: INTEGER; (* index into bucket table of the buffer pool *)
-
- PROCEDURE InitBuf(buf: Buffer);
- VAR
- index: INTEGER; (* of bucket table *)
- BEGIN
- buf.ok := TRUE;
- buf.pos := pos;
- buf.rbegin := posindex; buf.rend := posindex; s.left := 0;
- buf.wbegin := posindex; buf.wend := posindex;
- s.write := bufsize - posindex;
- buf.nextfree := NIL;
-
- (* insert buf into hash list *)
- index := HashValue(pos);
- buf.prevh := NIL;
- buf.nexth := s.bufpool.bucket[index];
- IF buf.nexth # NIL THEN
- buf.nexth.prevh := buf;
- END;
- s.bufpool.bucket[index] := buf;
-
- (* buf is already at the end of the sorted list if we
- re-use an old buffer
- *)
- IF s.bufpool.tail # buf THEN
- (* append buf to the sorted list *)
- buf.nexta := NIL;
- IF s.bufpool.tail = NIL THEN
- s.bufpool.head := buf;
- buf.preva := NIL;
- ELSE
- s.bufpool.tail.nexta := buf;
- buf.preva := s.bufpool.tail;
- END;
- s.bufpool.tail := buf;
- END;
- END InitBuf;
-
- PROCEDURE UseBuffer(s: Stream; buf: Buffer);
- (* make buf to the current buffer of s *)
- BEGIN
- IF s.buf # buf THEN
- (* remove buf from sorted list *)
- IF buf.preva # NIL THEN
- buf.preva.nexta := buf.nexta;
- ELSE
- s.bufpool.head := buf.nexta;
- END;
- IF buf.nexta # NIL THEN
- buf.nexta.preva := buf.preva;
- ELSE
- s.bufpool.tail := buf.preva;
- END;
-
- (* append buf to sorted list *)
- buf.nexta := NIL;
- IF s.bufpool.tail = NIL THEN
- s.bufpool.head := buf;
- buf.preva := NIL;
- ELSE
- s.bufpool.tail.nexta := buf;
- buf.preva := s.bufpool.tail;
- END;
- s.bufpool.tail := buf;
-
- (* set current buf of s to buf *)
- s.buf := buf;
-
- (* update s.left and s.write *)
- IF buf.rbegin = buf.rend THEN
- buf.rbegin := posindex; buf.rend := posindex; s.left := 0;
- ELSIF (posindex >= buf.rbegin) & (posindex < buf.rend) THEN
- s.left := buf.rend - posindex;
- ELSE
- s.left := 0;
- END;
- IF buf.wbegin = buf.wend THEN
- buf.wbegin := posindex; buf.wend := posindex;
- s.write := bufsize - posindex;
- ELSIF (posindex >= buf.wbegin) & (posindex < buf.wend) THEN
- s.write := bufsize - posindex;
- ELSE
- s.write := 0;
- END;
- END;
- END UseBuffer;
-
- BEGIN (* GetBuffer *)
- posindex := s.pos MOD bufsize;
- pos := s.pos - posindex;
-
- IF ~s.buf.ok THEN
- (* init first allocated buffer which has not been used until now *)
- InitBuf(s.buf);
- INC(s.bufpool.nbuf);
- ELSIF s.buf.pos # pos THEN
- IF FindBuffer(s, pos, buf) THEN
- UseBuffer(s, buf);
- ELSE
- IF s.bufpool.nbuf >= s.bufpool.maxbuf THEN
- (* re-use already allocated buffer *)
- buf := s.bufpool.head;
- UseBuffer(s, buf);
- IF buf.wbegin # buf.wend THEN
- IF ~InternalFlush(s) THEN END;
- END;
-
- (* remove buf from hash list *)
- IF buf.prevh # NIL THEN
- buf.prevh.nexth := buf.nexth;
- ELSE
- index := HashValue(buf.pos);
- s.bufpool.bucket[index] := buf.nexth;
- END;
- IF buf.nexth # NIL THEN
- buf.nexth.prevh := buf.prevh;
- END;
-
- InitBuf(buf);
- ELSE
- (* allocate and initialize new buffer *)
- NewBuffer(buf);
- InitBuf(buf);
- INC(s.bufpool.nbuf);
- END;
- s.buf := buf;
- END;
- END;
- END GetBuffer;
-
- PROCEDURE FlushBufPool(s: Stream) : BOOLEAN;
- VAR
- buf: Buffer;
- ok: BOOLEAN;
- BEGIN
- ok := TRUE;
- IF s.bufpool.nbuf > 0 THEN
- buf := s.bufpool.head;
- WHILE buf # NIL DO
- s.buf := buf;
- ok := InternalFlush(s) & ok;
- buf := buf.nexta;
- END;
- END;
- RETURN ok
- END FlushBufPool;
-
- PROCEDURE ReleaseBufPool(s: Stream);
- (* precondition: all buffers are flushed *)
- VAR
- buf: Buffer;
- BEGIN
- IF s.bufpool.nbuf > 0 THEN
- buf := s.bufpool.head;
- WHILE buf # NIL DO
- s.buf := buf;
- OldBuffer(s.buf);
- buf := buf.nexta;
- END;
- END;
+ BEGIN
+ ASSERT((s # NIL) & (if # NIL) & ({read, write} * caps # {}));
+ Services.GetType(s, type); ASSERT(type # NIL);
+ s.inlist := (close IN caps) OR (bufmode # nobuf) & (write IN caps);
+ NewStream(s);
+ (* initialize public part *)
+ s.count := 0;
+ s.errors := 0;
+ s.error := FALSE;
+ s.lasterror := 0;
+ s.eof := FALSE;
+ (* private part *)
+ s.if := if; s.caps := caps;
+ s.bufmode := bufmode;
+ s.validpos := FALSE;
+ s.left := 0; s.write := 0;
+ s.tiedStream := NIL;
+ IF bufmode IN {linebuf, onebuf, bufpool} THEN
NewBuffer(s.buf);
- InitBufPool(s);
- END ReleaseBufPool;
-
- (* ================================================================== *)
-
- PROCEDURE GetBufMode*(s: Stream) : BufMode;
- BEGIN
- RETURN s.bufmode
- END GetBufMode;
-
- PROCEDURE LineTerm*(s: Stream; termch: Byte);
- (* set line terminator of `s' (linebuf) to `termch' *)
- BEGIN
- s.error := FALSE;
- IF s.bufmode = linebuf THEN
- s.termch := termch;
+ IF (bufmode = bufpool) & ~(seek IN caps) THEN
+ bufmode := onebuf;
+ END;
+ CASE bufmode OF
+ | linebuf: s.termch := defaulttermch;
+ | bufpool: NEW(s.bufpool); InitBufPool(s);
ELSE
- Error(s, NotLineBuffered);
END;
- END LineTerm;
+ s.maxpos := 0;
+ s.wextensible := {read, write, seek, tell, holes} * caps =
+ {read, write, seek, tell};
+ s.bidirect := {read, write, seek, tell, trunc} * caps = {read, write};
+ IF s.bidirect THEN
+ InitBidirectionalBuffering(s);
+ ELSE
+ s.wbuf := NIL;
+ END;
+ ELSE
+ s.buf := NIL;
+ s.wbuf := NIL;
+ s.wextensible := FALSE;
+ s.bidirect := FALSE;
+ END;
+ s.flushEvent := NIL;
+ s.closeEvent := NIL;
+ Resources.TakeInterest(s, eventType);
+ Events.Handler(eventType, NotificationHandler);
+ s.lock := FALSE;
+ END Init;
- PROCEDURE Tie*(in, out: Stream);
- (* PRE: `in' is an line buffered input stream,
- `out' an output stream,
- and `in' # `out';
- causes `out' to be flushed before reading from `in';
- `out' may be NIL to undo the effect
- *)
- BEGIN
- in.error := FALSE;
- IF in.bufmode # linebuf THEN
- Error(in, NotLineBuffered); RETURN
- END;
- IF (in = out) OR ~(read IN in.caps) OR
- (out # NIL) & ~(write IN out.caps) THEN
- Error(in, BadParameters); RETURN
- END;
- in.tiedStream := out;
- END Tie;
-
- PROCEDURE SetBufferPoolSize*(s: Stream; nbuf: INTEGER);
- BEGIN
- s.error := FALSE;
- IF SYS.TAS(s.lock) THEN
- Error(s, NestedCall); RETURN
- END;
- IF (s.bufmode = bufpool) & (nbuf >= 1) THEN
- s.bufpool.maxbuf := nbuf;
+ PROCEDURE Send*(s: Stream; VAR message: Message);
+ BEGIN
+ IF ~SYS.TAS(s.lock) THEN
+ IF handler IN s.caps THEN
+ s.if.handler(s, message);
+ ELSE
+ Error(s, NoHandlerDefined);
END;
s.lock := FALSE;
- END SetBufferPoolSize;
+ ELSE
+ Error(s, NestedCall);
+ END;
+ END Send;
- PROCEDURE GetBufferPoolSize*(s: Stream; VAR nbuf: INTEGER);
- BEGIN
- s.error := FALSE;
- CASE s.bufmode OF
- | nobuf: nbuf := 0;
- | linebuf: nbuf := 1;
- | onebuf: nbuf := 1;
- | bufpool: nbuf := s.bufpool.maxbuf;
- ELSE (* Explicitly ignore unhandled values of s.bufmode *)
+ (* === private i/o procedures ================================= *)
+
+ PROCEDURE ValidPos(s: Stream);
+ BEGIN
+ IF ~s.validpos THEN
+ IF tell IN s.caps THEN
+ IF ~s.if.tell(s, s.pos) OR (s.pos < 0) THEN
+ Error(s, TellFailed);
+ s.pos := 0;
+ END;
+ ELSE
+ s.pos := 0;
END;
- END GetBufferPoolSize;
+ s.rpos := s.pos;
+ s.validpos := TRUE;
+ s.left := 0;
+ s.write := 0;
+ END;
+ END ValidPos;
- PROCEDURE Capabilities*(s: Stream) : CapabilitySet;
- BEGIN
- s.error := FALSE;
- RETURN s.caps
- END Capabilities;
+ PROCEDURE InitBuf(s: Stream);
+ BEGIN
+ IF s.bufmode = bufpool THEN
+ GetBuffer(s);
+ ELSE
+ s.buf.pos := s.pos - s.pos MOD bufsize;
+ s.buf.wbegin := s.pos MOD bufsize;
+ s.write := bufsize - s.buf.wbegin;
+ s.buf.wend := s.buf.wbegin;
+ s.buf.rbegin := s.buf.wbegin;
+ s.buf.rend := s.buf.wbegin;
+ s.left := 0;
+ s.buf.ok := TRUE;
+ END;
+ END InitBuf;
- PROCEDURE GetFlushEvent*(s: Stream; VAR type: Events.EventType);
- (* `type' will be raised BEFORE every flush operation *)
- BEGIN
- s.error := FALSE;
- IF s.flushEvent = NIL THEN
- Events.Define(s.flushEvent);
- END;
- type := s.flushEvent;
- END GetFlushEvent;
+ PROCEDURE FillBuf(s: Stream) : BOOLEAN;
+ (* return FALSE on EOF or errors *)
+ VAR
+ offset, count: Count;
+ posindex: Count; (* s.pos MOD bufsize *)
- PROCEDURE GetCloseEvent*(s: Stream; VAR type: Events.EventType);
- (* `type' will be raised BEFORE the stream gets closed;
- that means write operations etc. are legal
+ PROCEDURE Fill(s: Stream; VAR offset, count: Count) : BOOLEAN;
+ (* try to fill buf.cont[offset]..buf.cont[offset+count-1];
+ return FALSE on EOF;
+ Fill always extends a read region:
+ s.buf.rend is set to offset + the number of bytes read
*)
- BEGIN
- s.error := FALSE;
- IF s.closeEvent = NIL THEN
- Events.Define(s.closeEvent);
- END;
- type := s.closeEvent;
- END GetCloseEvent;
-
- PROCEDURE Close*(s: Stream) : BOOLEAN;
VAR
- event: Event;
- type: Events.EventType;
- otherStream: Stream;
- BEGIN
- s.error := FALSE;
-
- IF (s.closeEvent # NIL) & ~SYS.TAS(s.lock) THEN
- type := s.closeEvent; s.closeEvent := NIL;
- s.lock := FALSE;
- Events.SetPriority(type, Events.GetPriority() + 1);
- NEW(event);
- event.type := type;
- event.message := "close event of Streams";
- event.stream := s;
- Events.Raise(event);
+ linetermseen: BOOLEAN;
+ byte: Byte;
+ BEGIN
+ IF s.eofFound THEN
+ RETURN FALSE
END;
-
- IF ~SYS.TAS(s.lock) THEN
- IF write IN s.caps THEN
- IF s.bufmode = bufpool THEN
- IF ~FlushBufPool(s) THEN END;
- ELSE
- IF ~InternalFlush(s) THEN END;
- END;
- END;
- IF close IN s.caps THEN
- IF ~s.if.close(s) THEN
- Error(s, CloseFailed);
- END;
- END;
- IF s.buf # NIL THEN
- IF s.bufmode = bufpool THEN
- ReleaseBufPool(s);
- END;
- OldBuffer(s.buf);
- END;
- OldStream(s);
-
- (* check if this stream has been tied to another stream *)
- otherStream := opened;
- WHILE otherStream # NIL DO
- IF otherStream.tiedStream = s THEN
- otherStream.tiedStream := NIL; (* undo tie operation *)
- END;
- otherStream := otherStream.next;
- END;
- (* s.lock remains TRUE to prevent further operations *)
- Resources.Notify(s, Resources.terminated);
- RETURN ~s.error
- ELSE
- Error(s, NestedCall);
- RETURN FALSE
- END;
- END Close;
-
- PROCEDURE Release*(s: Stream);
- BEGIN
- IF ~Close(s) THEN END;
- END Release;
-
- PROCEDURE CloseAll*;
- BEGIN
- WHILE opened # NIL DO
- (* that's no endless loop; see Close/OldStream *)
- Release(opened);
- END;
- END CloseAll;
-
- PROCEDURE NotificationHandler(event: Events.Event);
- VAR
- s: Stream;
- BEGIN
- IF ~(event IS Resources.Event) THEN RETURN END;
- WITH event: Resources.Event DO
- IF ~(event.resource IS Stream) THEN RETURN END;
- s := event.resource(Stream);
- IF event.change IN {Resources.unreferenced, Resources.terminated} THEN
- IF ~s.lock THEN
- Release(s);
- END;
- END;
- END;
- END NotificationHandler;
-
- PROCEDURE Init*(s: Stream; if: Interface; caps: CapabilitySet;
- bufmode: BufMode);
-
- VAR
- eventType: Events.EventType;
- type: Services.Type;
-
- PROCEDURE InitBidirectionalBuffering(s: Stream);
- BEGIN
- s.validpos := TRUE;
- s.pos := 0;
- NewBuffer(s.wbuf);
- s.buf.ok := TRUE; s.buf.rbegin := 0; s.buf.rend := 0; s.buf.pos := 0;
- s.wbuf.ok := TRUE; s.wbuf.wbegin := 0; s.wbuf.wend := 0;
- s.wbuf.pos := 0;
- s.left := 0; s.write := bufsize;
- END InitBidirectionalBuffering;
-
- BEGIN
- ASSERT((s # NIL) & (if # NIL) & ({read, write} * caps # {}));
- Services.GetType(s, type); ASSERT(type # NIL);
- s.inlist := (close IN caps) OR (bufmode # nobuf) & (write IN caps);
- NewStream(s);
- (* initialize public part *)
- s.count := 0;
- s.errors := 0;
- s.error := FALSE;
- s.lasterror := 0;
- s.eof := FALSE;
- (* private part *)
- s.if := if; s.caps := caps;
- s.bufmode := bufmode;
- s.validpos := FALSE;
- s.left := 0; s.write := 0;
- s.tiedStream := NIL;
- IF bufmode IN {linebuf, onebuf, bufpool} THEN
- NewBuffer(s.buf);
- IF (bufmode = bufpool) & ~(seek IN caps) THEN
- bufmode := onebuf;
- END;
- CASE bufmode OF
- | linebuf: s.termch := defaulttermch;
- | bufpool: NEW(s.bufpool); InitBufPool(s);
- ELSE
- END;
- s.maxpos := 0;
- s.wextensible := {read, write, seek, tell, holes} * caps =
- {read, write, seek, tell};
- s.bidirect := {read, write, seek, tell, trunc} * caps = {read, write};
- IF s.bidirect THEN
- InitBidirectionalBuffering(s);
- ELSE
- s.wbuf := NIL;
- END;
- ELSE
- s.buf := NIL;
- s.wbuf := NIL;
- s.wextensible := FALSE;
- s.bidirect := FALSE;
- END;
- s.flushEvent := NIL;
- s.closeEvent := NIL;
- Resources.TakeInterest(s, eventType);
- Events.Handler(eventType, NotificationHandler);
- s.lock := FALSE;
- END Init;
-
- PROCEDURE Send*(s: Stream; VAR message: Message);
- BEGIN
- IF ~SYS.TAS(s.lock) THEN
- IF handler IN s.caps THEN
- s.if.handler(s, message);
- ELSE
- Error(s, NoHandlerDefined);
- END;
- s.lock := FALSE;
- ELSE
- Error(s, NestedCall);
- END;
- END Send;
-
- (* === private i/o procedures ================================= *)
-
- PROCEDURE ValidPos(s: Stream);
- BEGIN
- IF ~s.validpos THEN
- IF tell IN s.caps THEN
- IF ~s.if.tell(s, s.pos) OR (s.pos < 0) THEN
- Error(s, TellFailed);
- s.pos := 0;
- END;
- ELSE
- s.pos := 0;
- END;
- s.rpos := s.pos;
- s.validpos := TRUE;
- s.left := 0;
- s.write := 0;
- END;
- END ValidPos;
-
- PROCEDURE InitBuf(s: Stream);
- BEGIN
- IF s.bufmode = bufpool THEN
- GetBuffer(s);
- ELSE
- s.buf.pos := s.pos - s.pos MOD bufsize;
- s.buf.wbegin := s.pos MOD bufsize;
- s.write := bufsize - s.buf.wbegin;
- s.buf.wend := s.buf.wbegin;
- s.buf.rbegin := s.buf.wbegin;
- s.buf.rend := s.buf.wbegin;
- s.left := 0;
- s.buf.ok := TRUE;
- END;
- END InitBuf;
-
- PROCEDURE FillBuf(s: Stream) : BOOLEAN;
- (* return FALSE on EOF or errors *)
- VAR
- offset, count: Count;
- posindex: Count; (* s.pos MOD bufsize *)
-
- PROCEDURE Fill(s: Stream; VAR offset, count: Count) : BOOLEAN;
- (* try to fill buf.cont[offset]..buf.cont[offset+count-1];
- return FALSE on EOF;
- Fill always extends a read region:
- s.buf.rend is set to offset + the number of bytes read
- *)
- VAR
- linetermseen: BOOLEAN;
- byte: Byte;
- BEGIN
- IF s.eofFound THEN
- RETURN FALSE
- END;
- IF addrio IN s.caps THEN
- s.buf.rend := s.if.addrread(s, SYSTEM.ADR(s.buf.cont[offset]), count) +
- offset;
- ELSIF bufio IN s.caps THEN
- s.buf.rend := s.if.bufread(s, s.buf.cont, offset, count) + offset;
- ELSIF s.bufmode = linebuf THEN
- s.buf.rend := offset; linetermseen := FALSE;
- WHILE ~linetermseen & (s.buf.rend < offset+count) &
- s.if.read(s, byte) DO
- s.buf.cont[s.buf.rend] := byte; INC(s.buf.rend);
- linetermseen := byte = s.termch;
- END;
- s.eofFound := ~linetermseen &
- (s.buf.rend < offset+count); (* s.if.read failed? *)
- ELSE
- s.buf.rend := offset;
- WHILE (s.buf.rend < offset+count) &
- s.if.read(s, s.buf.cont[s.buf.rend]) DO
- INC(s.buf.rend);
- END;
- s.eofFound := s.buf.rend < offset+count; (* s.if.read failed? *)
- END;
- (* negative counts of addrread or bufread indicate read errors *)
- IF s.buf.rend < offset THEN
- (* note error and recover s.buf.rend *)
- Error(s, ReadFailed);
- s.buf.rend := offset;
- END;
- INC(s.rpos, s.buf.rend - offset);
- IF s.buf.rend > offset THEN
- DEC(count, s.buf.rend - offset);
- offset := s.buf.rend;
- RETURN TRUE
- ELSE
- s.eofFound := TRUE;
- RETURN FALSE
- END;
- END Fill;
-
- BEGIN (* FillBuf *)
- ValidPos(s);
- posindex := s.pos MOD bufsize;
- s.eofFound := FALSE;
-
- (* flush associated output streams (line buffered streams only) *)
- IF s.bufmode = linebuf THEN
- IF write IN s.caps THEN
- IF ~InternalFlush(s) THEN END;
- END;
- IF (s.tiedStream # NIL) & ~SYS.TAS(s.tiedStream.lock) THEN
- IF ~InternalFlush(s.tiedStream) THEN END;
- s.tiedStream.lock := FALSE;
- END;
- END;
-
- (* get a valid buffer and set
- offset and count to the buffer range which is to be filled;
- on default, we want to fill the whole buffer
- *)
- offset := 0; count := bufsize; (* default *)
- IF ~s.buf.ok THEN
- InitBuf(s);
- ELSIF s.bidirect THEN
- s.buf.rbegin := 0; s.buf.rend := 0; s.pos := 0; posindex := 0;
- ELSE
- IF s.bufmode = bufpool THEN
- GetBuffer(s);
- IF s.left > 0 THEN
- (* buffer is already filled *)
- s.eof := FALSE; RETURN TRUE
- END;
- ELSIF s.buf.pos # s.pos - posindex THEN
- (* reuse filled buffer *)
- IF write IN s.caps THEN
- IF ~InternalFlush(s) THEN END;
- END;
- InitBuf(s);
- END;
- IF s.buf.rbegin # s.buf.rend THEN
- IF (write IN s.caps) &
- (s.buf.wbegin <= posindex) & (s.buf.wend > posindex) THEN
- (* set read region to write region *)
- s.buf.rbegin := s.buf.wbegin; s.buf.rend := s.buf.wend;
- s.left := s.buf.wend - posindex;
- s.eof := FALSE; RETURN TRUE
- ELSIF s.buf.rend = posindex THEN
- (* stream position equals end of read region *)
- offset := s.buf.rend; count := bufsize - offset;
- END;
- END;
-
- (* take care of the write region by limiting count;
- note that s.pos does *not* point into the write region;
- this is guaranteed by WritePart and other operations
- which would have extended the read region in such a case
- *)
- IF (write IN s.caps) & (s.buf.wbegin # s.buf.wend) THEN
- IF s.buf.wbegin >= offset THEN
- IF s.buf.wbegin > posindex THEN
- (* write-region behind current position *)
- count := s.buf.wbegin - offset;
- ELSE
- (* write-region before current position *)
- offset := s.buf.wend; count := bufsize - offset;
- END;
- END;
- IF (s.buf.pos + s.buf.wbegin = s.rpos) & ~(seek IN s.caps) THEN
- (* flush if the start of write region corresponds to real
- file position and we are not able to change the position
- *)
- IF ~InternalFlush(s) THEN END;
- END;
- END;
- END;
-
- (* set the real position to the position we want to read from *)
- IF ~s.bidirect & (s.buf.pos + offset # s.rpos) THEN
- IF (seek IN s.caps) & s.if.seek(s, s.buf.pos+offset, fromStart) THEN
- s.rpos := s.buf.pos + offset;
- ELSIF s.pos = s.rpos THEN
- DEC(count, posindex - offset);
- offset := posindex;
- ELSIF seek IN s.caps THEN
- Error(s, SeekFailed); RETURN FALSE
- ELSE
- Error(s, CannotSeek); RETURN FALSE
- END;
- END;
-
- (* try to fill buf[offset..offset+count-1];
- and set s.buf.rbegin & s.buf.rend to the new read region
- *)
- IF s.buf.rend # offset THEN
- (* forget old read region if we cannot extend it *)
- s.buf.rbegin := offset; s.buf.rend := offset;
- END;
- WHILE Fill(s, offset, count) & (posindex >= s.buf.rend) DO END;
-
- IF posindex >= s.buf.rend THEN
- (* read operation failed *)
- IF (s.pos > s.rpos) &
- (seek IN s.caps) & s.if.seek(s, s.pos, fromStart) THEN
- s.rpos := s.pos;
- (* second try: we were not able to fill the whole buffer
- but perhaps we are able to read what we were requested for
- *)
- DEC(count, posindex - offset);
- offset := posindex;
- s.buf.rbegin := offset; s.buf.rend := offset;
- s.eofFound := FALSE; (* retry it *)
- s.eof := ~Fill(s, offset, count);
- ELSE
- s.eof := TRUE;
- END;
- ELSE
- s.eof := FALSE;
- END;
-
- IF s.eof THEN
- s.left := 0;
- ELSE
- s.left := s.buf.rend - posindex;
- END;
-
- RETURN ~s.eof
- END FillBuf;
-
-
- (* ==== i/o operations ============================================== *)
-
- PROCEDURE ReadPart*(s: Stream; VAR buf: ARRAY OF Byte;
- off, cnt: Count) : BOOLEAN;
- (* fill buf[off..off+cnt-1] *)
-
- VAR
- pos: Count;
- partcnt: Count;
-
- PROCEDURE ReadBytesFromBuf(s: Stream;
- VAR to: ARRAY OF Byte;
- off, cnt: Count) : BOOLEAN;
- VAR
- bytes, max, spos: Count;
- BEGIN
- IF s.left = 0 THEN
- IF s.eofFound OR ~FillBuf(s) THEN RETURN FALSE END;
- END;
- spos := s.pos MOD bufsize;
- max := s.left;
- IF max > cnt THEN
- max := cnt;
- END;
- bytes := 0;
- WHILE bytes < max DO
- to[off] := s.buf.cont[spos];
- INC(off); INC(spos); INC(bytes);
- END;
- INC(s.pos, bytes); DEC(s.left, bytes); INC(s.count, bytes);
- IF ~s.bidirect THEN
- IF s.write >= bytes THEN
- DEC(s.write, bytes);
- ELSE
- s.write := 0;
- END;
- END;
- RETURN TRUE
- END ReadBytesFromBuf;
-
- BEGIN (* ReadPart *)
- IF SYS.TAS(s.lock) THEN
- Error(s, NestedCall);
- RETURN FALSE
- END;
- s.error := FALSE; s.count := 0;
- IF ~(read IN s.caps) THEN
- s.lock := FALSE; Error(s, CannotRead); RETURN FALSE
- ELSIF (off < 0) OR (off+cnt > LEN(buf)) OR (cnt < 0) THEN
- s.lock := FALSE; Error(s, BadParameters); RETURN FALSE
- END;
- IF cnt = 0 THEN s.lock := FALSE; RETURN TRUE END;
- IF s.buf # NIL THEN
- s.eofFound := FALSE;
- WHILE (s.count < cnt) &
- ReadBytesFromBuf(s, buf, s.count + off, cnt - s.count) DO
- (* s.count is already incremented by ReadBytesFromBuf *)
- END;
- (* extend write region, if necessary *)
- IF ~s.bidirect THEN
- pos := s.pos MOD bufsize;
- IF (s.write > 0) & (s.buf.wend < pos) THEN
- IF s.buf.wbegin = s.buf.wend THEN
- s.buf.wbegin := pos;
- END;
- s.buf.wend := pos;
- END;
- END;
- ELSE
- IF addrio IN s.caps THEN
- s.count := s.if.addrread(s, SYSTEM.ADR(buf[off]), cnt);
- IF (s.count > 0) & (s.count < cnt) THEN
- LOOP
- partcnt := s.if.addrread(s,
- SYSTEM.ADR(buf[off + s.count]), cnt - s.count);
- IF (partcnt < 0) OR (partcnt = 0) THEN EXIT END;
- ASSERT(partcnt <= cnt - s.count);
- INC(s.count, partcnt);
- IF s.count = cnt THEN EXIT END;
- END;
- END;
- ELSIF bufio IN s.caps THEN
- s.count := s.if.bufread(s, buf, off, cnt);
- IF (s.count > 0) & (s.count < cnt) THEN
- LOOP
- partcnt := s.if.bufread(s, buf, off + s.count, cnt - s.count);
- IF (partcnt < 0) OR (partcnt = 0) THEN EXIT END;
- ASSERT(partcnt <= cnt - s.count);
- INC(s.count, partcnt);
- IF s.count = cnt THEN EXIT END;
- END;
- END;
- ELSE
- s.count := 0;
- WHILE (s.count < cnt) & s.if.read(s, buf[s.count+off]) DO
- INC(s.count);
- END;
- END;
- IF s.count < 0 THEN
- s.count := 0;
- Error(s, ReadFailed);
- ELSE
- s.eof := s.count = 0;
- END;
- END;
- s.lock := FALSE;
- RETURN s.count = cnt
- END ReadPart;
-
- PROCEDURE Read*(s: Stream; VAR buf: ARRAY OF Byte) : BOOLEAN;
- BEGIN
- RETURN ReadPart(s, buf, 0, LEN(buf))
- END Read;
-
- PROCEDURE ReadByte*(s: Stream; VAR byte: Byte) : BOOLEAN;
- VAR
- ok: BOOLEAN;
- pos: Count;
- BEGIN
- IF SYS.TAS(s.lock) THEN
- Error(s, NestedCall); RETURN FALSE
- END;
- s.error := FALSE;
- IF s.left = 0 THEN
- IF ~(read IN s.caps) THEN
- s.lock := FALSE; Error(s, CannotRead); s.count := 0; RETURN FALSE
- END;
- IF s.buf # NIL THEN
- IF ~FillBuf(s) THEN
- (* FillBuf sets s.eof *)
- s.lock := FALSE;
- s.count := 0;
- RETURN FALSE
- END;
- ELSE
- ok := s.if.read(s, byte);
- IF ok THEN
- s.count := 1;
- ELSE
- s.count := 0;
- END;
- s.eof := ~ok;
- s.lock := FALSE;
- RETURN ok
- END;
- END;
- (* s.left > 0 *)
- s.count := 1;
- byte := s.buf.cont[s.pos MOD bufsize];
- INC(s.pos); DEC(s.left);
- IF ~s.bidirect & (s.write # 0) THEN
- DEC(s.write);
- pos := s.pos MOD bufsize;
- IF s.buf.wend < pos THEN
- IF s.buf.wbegin = s.buf.wend THEN
- s.buf.wbegin := pos;
- END;
- s.buf.wend := pos;
- END;
- END;
- (* s.eof has been set by FillBuf *)
- s.lock := FALSE;
- RETURN TRUE
- END ReadByte;
-
- PROCEDURE ReadPacket*(s: Stream; VAR buf: ARRAY OF Byte;
- off, maxcnt: Count) : Count;
- (* fill buf[off..] with next packet *)
- BEGIN
- IF s.left > 0 THEN
- IF maxcnt > s.left THEN
- maxcnt := s.left;
- END;
- IF ReadPart(s, buf, off, maxcnt) THEN END;
- RETURN s.count
- END;
-
- IF SYS.TAS(s.lock) THEN
- Error(s, NestedCall);
- s.count := 0;
- RETURN 0
- END;
- s.error := FALSE; s.count := 0;
- IF ~(read IN s.caps) THEN
- s.lock := FALSE; Error(s, CannotRead); s.count := 0; RETURN 0
- ELSIF (off < 0) OR (off+maxcnt > LEN(buf)) OR (maxcnt < 0) THEN
- s.lock := FALSE; Error(s, BadParameters); s.count := 0; RETURN 0
- END;
- IF maxcnt = 0 THEN s.lock := FALSE; RETURN 0 END;
-
- IF s.buf # NIL THEN
- (* s.left = 0 *)
- IF ~FillBuf(s) THEN
- (* FillBuf sets s.eof *)
- s.lock := FALSE;
- RETURN 0
- END;
- s.lock := FALSE;
- IF maxcnt > s.left THEN
- maxcnt := s.left;
- END;
- IF ReadPart(s, buf, off, maxcnt) THEN END;
- RETURN s.count
- END;
-
- (* s.buf = NIL *)
IF addrio IN s.caps THEN
- s.count := s.if.addrread(s, SYSTEM.ADR(buf[off]), maxcnt);
+ s.buf.rend := s.if.addrread(s, SYSTEM.ADR(s.buf.cont[offset]), count) +
+ offset;
ELSIF bufio IN s.caps THEN
- s.count := s.if.bufread(s, buf, off, maxcnt);
+ s.buf.rend := s.if.bufread(s, s.buf.cont, offset, count) + offset;
+ ELSIF s.bufmode = linebuf THEN
+ s.buf.rend := offset; linetermseen := FALSE;
+ WHILE ~linetermseen & (s.buf.rend < offset+count) &
+ s.if.read(s, byte) DO
+ s.buf.cont[s.buf.rend] := byte; INC(s.buf.rend);
+ linetermseen := byte = s.termch;
+ END;
+ s.eofFound := ~linetermseen &
+ (s.buf.rend < offset+count); (* s.if.read failed? *)
ELSE
- s.count := 0;
- WHILE (s.count < maxcnt) & s.if.read(s, buf[s.count+off]) DO
- INC(s.count);
- END;
+ s.buf.rend := offset;
+ WHILE (s.buf.rend < offset+count) &
+ s.if.read(s, s.buf.cont[s.buf.rend]) DO
+ INC(s.buf.rend);
+ END;
+ s.eofFound := s.buf.rend < offset+count; (* s.if.read failed? *)
+ END;
+ (* negative counts of addrread or bufread indicate read errors *)
+ IF s.buf.rend < offset THEN
+ (* note error and recover s.buf.rend *)
+ Error(s, ReadFailed);
+ s.buf.rend := offset;
+ END;
+ INC(s.rpos, s.buf.rend - offset);
+ IF s.buf.rend > offset THEN
+ DEC(count, s.buf.rend - offset);
+ offset := s.buf.rend;
+ RETURN TRUE
+ ELSE
+ s.eofFound := TRUE;
+ RETURN FALSE
+ END;
+ END Fill;
+
+ BEGIN (* FillBuf *)
+ ValidPos(s);
+ posindex := s.pos MOD bufsize;
+ s.eofFound := FALSE;
+
+ (* flush associated output streams (line buffered streams only) *)
+ IF s.bufmode = linebuf THEN
+ IF write IN s.caps THEN
+ IF ~InternalFlush(s) THEN END;
+ END;
+ IF (s.tiedStream # NIL) & ~SYS.TAS(s.tiedStream.lock) THEN
+ IF ~InternalFlush(s.tiedStream) THEN END;
+ s.tiedStream.lock := FALSE;
+ END;
+ END;
+
+ (* get a valid buffer and set
+ offset and count to the buffer range which is to be filled;
+ on default, we want to fill the whole buffer
+ *)
+ offset := 0; count := bufsize; (* default *)
+ IF ~s.buf.ok THEN
+ InitBuf(s);
+ ELSIF s.bidirect THEN
+ s.buf.rbegin := 0; s.buf.rend := 0; s.pos := 0; posindex := 0;
+ ELSE
+ IF s.bufmode = bufpool THEN
+ GetBuffer(s);
+ IF s.left > 0 THEN
+ (* buffer is already filled *)
+ s.eof := FALSE; RETURN TRUE
+ END;
+ ELSIF s.buf.pos # s.pos - posindex THEN
+ (* reuse filled buffer *)
+ IF write IN s.caps THEN
+ IF ~InternalFlush(s) THEN END;
+ END;
+ InitBuf(s);
+ END;
+ IF s.buf.rbegin # s.buf.rend THEN
+ IF (write IN s.caps) &
+ (s.buf.wbegin <= posindex) & (s.buf.wend > posindex) THEN
+ (* set read region to write region *)
+ s.buf.rbegin := s.buf.wbegin; s.buf.rend := s.buf.wend;
+ s.left := s.buf.wend - posindex;
+ s.eof := FALSE; RETURN TRUE
+ ELSIF s.buf.rend = posindex THEN
+ (* stream position equals end of read region *)
+ offset := s.buf.rend; count := bufsize - offset;
+ END;
+ END;
+
+ (* take care of the write region by limiting count;
+ note that s.pos does *not* point into the write region;
+ this is guaranteed by WritePart and other operations
+ which would have extended the read region in such a case
+ *)
+ IF (write IN s.caps) & (s.buf.wbegin # s.buf.wend) THEN
+ IF s.buf.wbegin >= offset THEN
+ IF s.buf.wbegin > posindex THEN
+ (* write-region behind current position *)
+ count := s.buf.wbegin - offset;
+ ELSE
+ (* write-region before current position *)
+ offset := s.buf.wend; count := bufsize - offset;
+ END;
+ END;
+ IF (s.buf.pos + s.buf.wbegin = s.rpos) & ~(seek IN s.caps) THEN
+ (* flush if the start of write region corresponds to real
+ file position and we are not able to change the position
+ *)
+ IF ~InternalFlush(s) THEN END;
+ END;
+ END;
+ END;
+
+ (* set the real position to the position we want to read from *)
+ IF ~s.bidirect & (s.buf.pos + offset # s.rpos) THEN
+ IF (seek IN s.caps) & s.if.seek(s, s.buf.pos+offset, fromStart) THEN
+ s.rpos := s.buf.pos + offset;
+ ELSIF s.pos = s.rpos THEN
+ DEC(count, posindex - offset);
+ offset := posindex;
+ ELSIF seek IN s.caps THEN
+ Error(s, SeekFailed); RETURN FALSE
+ ELSE
+ Error(s, CannotSeek); RETURN FALSE
+ END;
+ END;
+
+ (* try to fill buf[offset..offset+count-1];
+ and set s.buf.rbegin & s.buf.rend to the new read region
+ *)
+ IF s.buf.rend # offset THEN
+ (* forget old read region if we cannot extend it *)
+ s.buf.rbegin := offset; s.buf.rend := offset;
+ END;
+ WHILE Fill(s, offset, count) & (posindex >= s.buf.rend) DO END;
+
+ IF posindex >= s.buf.rend THEN
+ (* read operation failed *)
+ IF (s.pos > s.rpos) &
+ (seek IN s.caps) & s.if.seek(s, s.pos, fromStart) THEN
+ s.rpos := s.pos;
+ (* second try: we were not able to fill the whole buffer
+ but perhaps we are able to read what we were requested for
+ *)
+ DEC(count, posindex - offset);
+ offset := posindex;
+ s.buf.rbegin := offset; s.buf.rend := offset;
+ s.eofFound := FALSE; (* retry it *)
+ s.eof := ~Fill(s, offset, count);
+ ELSE
+ s.eof := TRUE;
+ END;
+ ELSE
+ s.eof := FALSE;
+ END;
+
+ IF s.eof THEN
+ s.left := 0;
+ ELSE
+ s.left := s.buf.rend - posindex;
+ END;
+
+ RETURN ~s.eof
+ END FillBuf;
+
+
+ (* ==== i/o operations ============================================== *)
+
+ PROCEDURE ReadPart*(s: Stream; VAR buf: ARRAY OF Byte;
+ off, cnt: Count) : BOOLEAN;
+ (* fill buf[off..off+cnt-1] *)
+
+ VAR
+ pos: Count;
+ partcnt: Count;
+
+ PROCEDURE ReadBytesFromBuf(s: Stream;
+ VAR to: ARRAY OF Byte;
+ off, cnt: Count) : BOOLEAN;
+ VAR
+ bytes, max, spos: Count;
+ BEGIN
+ IF s.left = 0 THEN
+ IF s.eofFound OR ~FillBuf(s) THEN RETURN FALSE END;
+ END;
+ spos := s.pos MOD bufsize;
+ max := s.left;
+ IF max > cnt THEN
+ max := cnt;
+ END;
+ bytes := 0;
+ WHILE bytes < max DO
+ to[off] := s.buf.cont[spos];
+ INC(off); INC(spos); INC(bytes);
+ END;
+ INC(s.pos, bytes); DEC(s.left, bytes); INC(s.count, bytes);
+ IF ~s.bidirect THEN
+ IF s.write >= bytes THEN
+ DEC(s.write, bytes);
+ ELSE
+ s.write := 0;
+ END;
+ END;
+ RETURN TRUE
+ END ReadBytesFromBuf;
+
+ BEGIN (* ReadPart *)
+ IF SYS.TAS(s.lock) THEN
+ Error(s, NestedCall);
+ RETURN FALSE
+ END;
+ s.error := FALSE; s.count := 0;
+ IF ~(read IN s.caps) THEN
+ s.lock := FALSE; Error(s, CannotRead); RETURN FALSE
+ ELSIF (off < 0) OR (off+cnt > LEN(buf)) OR (cnt < 0) THEN
+ s.lock := FALSE; Error(s, BadParameters); RETURN FALSE
+ END;
+ IF cnt = 0 THEN s.lock := FALSE; RETURN TRUE END;
+ IF s.buf # NIL THEN
+ s.eofFound := FALSE;
+ WHILE (s.count < cnt) &
+ ReadBytesFromBuf(s, buf, s.count + off, cnt - s.count) DO
+ (* s.count is already incremented by ReadBytesFromBuf *)
+ END;
+ (* extend write region, if necessary *)
+ IF ~s.bidirect THEN
+ pos := s.pos MOD bufsize;
+ IF (s.write > 0) & (s.buf.wend < pos) THEN
+ IF s.buf.wbegin = s.buf.wend THEN
+ s.buf.wbegin := pos;
+ END;
+ s.buf.wend := pos;
+ END;
+ END;
+ ELSE
+ IF addrio IN s.caps THEN
+ s.count := s.if.addrread(s, SYSTEM.ADR(buf[off]), cnt);
+ IF (s.count > 0) & (s.count < cnt) THEN
+ LOOP
+ partcnt := s.if.addrread(s,
+ SYSTEM.ADR(buf[off + s.count]), cnt - s.count);
+ IF (partcnt < 0) OR (partcnt = 0) THEN EXIT END;
+ ASSERT(partcnt <= cnt - s.count);
+ INC(s.count, partcnt);
+ IF s.count = cnt THEN EXIT END;
+ END;
+ END;
+ ELSIF bufio IN s.caps THEN
+ s.count := s.if.bufread(s, buf, off, cnt);
+ IF (s.count > 0) & (s.count < cnt) THEN
+ LOOP
+ partcnt := s.if.bufread(s, buf, off + s.count, cnt - s.count);
+ IF (partcnt < 0) OR (partcnt = 0) THEN EXIT END;
+ ASSERT(partcnt <= cnt - s.count);
+ INC(s.count, partcnt);
+ IF s.count = cnt THEN EXIT END;
+ END;
+ END;
+ ELSE
+ s.count := 0;
+ WHILE (s.count < cnt) & s.if.read(s, buf[s.count+off]) DO
+ INC(s.count);
+ END;
END;
IF s.count < 0 THEN
- s.count := 0;
- Error(s, ReadFailed);
+ s.count := 0;
+ Error(s, ReadFailed);
ELSE
- s.eof := s.count = 0;
+ s.eof := s.count = 0;
END;
- s.lock := FALSE;
- RETURN s.count
- END ReadPacket;
+ END;
+ s.lock := FALSE;
+ RETURN s.count = cnt
+ END ReadPart;
- PROCEDURE WritePart*(s: Stream;
- (* read-only *) VAR buf: ARRAY OF Byte;
- off, cnt: Count) : BOOLEAN;
- (* write buf[off..off+cnt-1] to s *)
- VAR
- posindex: Count;
+ PROCEDURE Read*(s: Stream; VAR buf: ARRAY OF Byte) : BOOLEAN;
+ BEGIN
+ RETURN ReadPart(s, buf, 0, LEN(buf))
+ END Read;
- PROCEDURE NewBuffer(s: Stream) : BOOLEAN;
- (* flush and get new buffer *)
- BEGIN
- IF s.pos - posindex # s.buf.pos THEN
- IF s.bufmode # bufpool THEN
- IF ~InternalFlush(s) THEN RETURN FALSE END;
- END;
- InitBuf(s);
- IF s.write # 0 THEN RETURN TRUE END;
- END;
- IF s.buf.wbegin = s.buf.wend THEN
- (* nothing written into this buffer until now *)
- s.buf.wbegin := posindex; s.buf.wend := posindex;
- s.write := bufsize - posindex;
- ELSIF s.wextensible & (s.buf.rbegin # s.buf.rend) THEN
- (* check if the write region may be extended
- over parts of the read region
- *)
- IF s.buf.wend < posindex THEN
- (* write region before current position *)
- IF (s.buf.rbegin <= s.buf.wend) & (s.buf.rend >= posindex) THEN
- s.buf.wend := posindex;
- s.write := bufsize - posindex;
- END;
- ELSE (* s.wbegin > posindex *)
- (* write region after current position *)
- IF (s.buf.rbegin <= posindex) & (s.buf.rend >= s.buf.wbegin) THEN
- s.buf.wbegin := posindex;
- s.write := bufsize - posindex;
- END;
- END;
- END;
- IF (* still *) s.write = 0 THEN
- (* Flush necessary *)
- IF ~InternalFlush(s) THEN RETURN FALSE END;
- s.buf.wbegin := posindex; s.buf.wend := posindex;
- s.write := bufsize - posindex;
- END;
- RETURN TRUE
- END NewBuffer;
-
- PROCEDURE UpdateReadRegion(s: Stream);
- BEGIN
- (* update s.left and extend read region, if possible *)
- IF s.buf.rbegin = s.buf.rend THEN
- (* set read region to write region *)
- s.buf.rbegin := s.buf.wbegin; s.buf.rend := s.buf.wend;
- s.left := s.buf.rend - posindex;
- ELSIF (s.buf.rbegin < s.buf.wbegin) & (s.buf.rend >= s.buf.wbegin) THEN
- (* forward extension of read region possible *)
- IF s.buf.rend < s.buf.wend THEN
- s.buf.rend := s.buf.wend;
- END;
- s.left := s.buf.rend - posindex;
- ELSIF (s.buf.rbegin <= s.buf.wend) & (s.buf.rend > s.buf.wend) THEN
- (* backward extension of read region possible *)
- IF s.buf.rbegin > s.buf.wbegin THEN
- s.buf.rbegin := s.buf.wend;
- END;
- s.left := s.buf.rend - posindex;
- ELSE
- (* posindex does not fall into [s.buf.rbegin..s.buf.rend-1] *)
- s.left := 0;
- END;
- IF s.pos = s.buf.pos + bufsize THEN
- s.left := 0;
- END;
- END UpdateReadRegion;
-
- BEGIN
- IF SYS.TAS(s.lock) THEN
- Error(s, NestedCall); RETURN FALSE
+ PROCEDURE ReadByte*(s: Stream; VAR byte: Byte) : BOOLEAN;
+ VAR
+ ok: BOOLEAN;
+ pos: Count;
+ BEGIN
+ IF SYS.TAS(s.lock) THEN
+ Error(s, NestedCall); RETURN FALSE
+ END;
+ s.error := FALSE;
+ IF s.left = 0 THEN
+ IF ~(read IN s.caps) THEN
+ s.lock := FALSE; Error(s, CannotRead); s.count := 0; RETURN FALSE
END;
- s.error := FALSE; s.count := 0;
- IF ~(write IN s.caps) THEN
- s.lock := FALSE; Error(s, CannotWrite); RETURN FALSE
- ELSIF (off < 0) OR (off+cnt > LEN(buf)) OR (cnt < 0) THEN
- s.lock := FALSE; Error(s, BadParameters); RETURN FALSE
- ELSIF cnt = 0 THEN
- s.lock := FALSE; RETURN TRUE
- END;
-
IF s.buf # NIL THEN
- IF s.bidirect THEN
- WHILE s.count < cnt DO
- IF (s.write = 0) & ~InternalFlush(s) THEN
- s.lock := FALSE; RETURN FALSE
- END;
- s.wbuf.cont[s.wbuf.wend] := buf[off + s.count];
- INC(s.wbuf.wend); INC(s.count); DEC(s.write);
- IF (s.bufmode = linebuf) &
- (buf[s.count+off-1] = s.termch) THEN
- IF ~InternalFlush(s) THEN
- s.lock := FALSE; RETURN FALSE
- END;
- END;
- END;
- ELSE
- ValidPos(s);
- posindex := s.pos MOD bufsize;
- IF ~s.buf.ok THEN
- InitBuf(s);
- END;
+ IF ~FillBuf(s) THEN
+ (* FillBuf sets s.eof *)
+ s.lock := FALSE;
+ s.count := 0;
+ RETURN FALSE
+ END;
+ ELSE
+ ok := s.if.read(s, byte);
+ IF ok THEN
+ s.count := 1;
+ ELSE
+ s.count := 0;
+ END;
+ s.eof := ~ok;
+ s.lock := FALSE;
+ RETURN ok
+ END;
+ END;
+ (* s.left > 0 *)
+ s.count := 1;
+ byte := s.buf.cont[s.pos MOD bufsize];
+ INC(s.pos); DEC(s.left);
+ IF ~s.bidirect & (s.write # 0) THEN
+ DEC(s.write);
+ pos := s.pos MOD bufsize;
+ IF s.buf.wend < pos THEN
+ IF s.buf.wbegin = s.buf.wend THEN
+ s.buf.wbegin := pos;
+ END;
+ s.buf.wend := pos;
+ END;
+ END;
+ (* s.eof has been set by FillBuf *)
+ s.lock := FALSE;
+ RETURN TRUE
+ END ReadByte;
- (* copy from buf to s.buf *)
- WHILE s.count < cnt DO
- IF s.write = 0 THEN
- posindex := s.pos MOD bufsize;
- IF s.count > 0 THEN
- UpdateReadRegion(s);
- END;
- IF ~NewBuffer(s) THEN
- s.lock := FALSE; RETURN FALSE
- END;
- END;
- s.buf.cont[posindex] := buf[off + s.count];
- IF s.buf.wend = posindex THEN
- INC(s.buf.wend);
- END;
- INC(s.count); INC(s.pos); DEC(s.write); INC(posindex);
- IF (s.bufmode = linebuf) &
- (buf[s.count+off-1] = s.termch) THEN
- UpdateReadRegion(s);
- IF ~InternalFlush(s) THEN
- s.lock := FALSE; RETURN FALSE
- END;
- (* s.pos can be changed by InternalFlush *)
- posindex := s.pos MOD bufsize;
- END;
- END;
- UpdateReadRegion(s);
- END;
- ELSE (* unbuffered stream *)
- IF addrio IN s.caps THEN
- s.count := s.if.addrwrite(s, SYSTEM.ADR(buf[off]), cnt);
- ELSIF bufio IN s.caps THEN
- s.count := s.if.bufwrite(s, buf, off, cnt);
- ELSE
- s.count := 0;
- WHILE (s.count < cnt) & s.if.write(s, buf[off+s.count]) DO
- INC(s.count);
- END;
- END;
- IF s.count # cnt THEN
- Error(s, WriteFailed);
- END;
+ PROCEDURE ReadPacket*(s: Stream; VAR buf: ARRAY OF Byte;
+ off, maxcnt: Count) : Count;
+ (* fill buf[off..] with next packet *)
+ BEGIN
+ IF s.left > 0 THEN
+ IF maxcnt > s.left THEN
+ maxcnt := s.left;
+ END;
+ IF ReadPart(s, buf, off, maxcnt) THEN END;
+ RETURN s.count
+ END;
+
+ IF SYS.TAS(s.lock) THEN
+ Error(s, NestedCall);
+ s.count := 0;
+ RETURN 0
+ END;
+ s.error := FALSE; s.count := 0;
+ IF ~(read IN s.caps) THEN
+ s.lock := FALSE; Error(s, CannotRead); s.count := 0; RETURN 0
+ ELSIF (off < 0) OR (off+maxcnt > LEN(buf)) OR (maxcnt < 0) THEN
+ s.lock := FALSE; Error(s, BadParameters); s.count := 0; RETURN 0
+ END;
+ IF maxcnt = 0 THEN s.lock := FALSE; RETURN 0 END;
+
+ IF s.buf # NIL THEN
+ (* s.left = 0 *)
+ IF ~FillBuf(s) THEN
+ (* FillBuf sets s.eof *)
+ s.lock := FALSE;
+ RETURN 0
END;
s.lock := FALSE;
- RETURN s.count = cnt
- END WritePart;
-
- PROCEDURE Write*(s: Stream;
- (* read-only *) VAR buf: ARRAY OF Byte) : BOOLEAN;
- BEGIN
- RETURN WritePart(s, buf, 0, LEN(buf))
- END Write;
-
- PROCEDURE WritePartC*(s: Stream; buf: ARRAY OF Byte;
- off, cnt: Count) : BOOLEAN;
- (* write buf[off..off+cnt-1] to s *)
- BEGIN
- RETURN WritePart(s, buf, off, cnt)
- END WritePartC;
-
- PROCEDURE WriteC*(s: Stream; buf: ARRAY OF Byte) : BOOLEAN;
- BEGIN
- RETURN WritePart(s, buf, 0, LEN(buf))
- END WriteC;
-
- PROCEDURE WriteByte*(s: Stream; byte: Byte) : BOOLEAN;
- VAR
- posindex: Count;
- BEGIN
- IF (s.write > 0) & ~SYS.TAS(s.lock) THEN
- s.error := FALSE; s.count := 1;
-
- IF s.bidirect THEN
- s.wbuf.cont[s.wbuf.wend] := byte; INC(s.wbuf.wend); DEC(s.write);
- ELSE
- (* put byte into s.buf *)
- posindex := s.pos MOD bufsize;
- s.buf.cont[posindex] := byte;
- IF s.buf.wend = posindex THEN
- INC(s.buf.wend);
- END;
- DEC(s.write);
-
- (* update s.buf.rend and s.left, if necessary *)
- IF s.buf.rend = posindex THEN
- INC(s.buf.rend);
- END;
- IF s.left # 0 THEN
- DEC(s.left);
- ELSIF s.buf.rbegin = s.buf.rend THEN
- (* set read-region to write-region *)
- s.buf.rbegin := s.buf.wbegin; s.buf.rend := s.buf.wend;
- s.left := s.buf.wend - posindex;
- END;
-
- INC(s.pos);
- END;
-
- IF (s.bufmode = linebuf) & (byte = s.termch) THEN
- IF ~InternalFlush(s) THEN
- s.lock := FALSE; RETURN FALSE
- END;
- IF ~s.bidirect THEN
- s.buf.wbegin := s.pos MOD bufsize;
- END;
- END;
-
- s.lock := FALSE; RETURN TRUE
- ELSE
- RETURN WritePart(s, byte, 0, 1)
+ IF maxcnt > s.left THEN
+ maxcnt := s.left;
END;
- END WriteByte;
+ IF ReadPart(s, buf, off, maxcnt) THEN END;
+ RETURN s.count
+ END;
- PROCEDURE InternalSeek(s: Stream; offset: Count; whence: Whence) : BOOLEAN;
- VAR
- oldpos: Count; pos: Count;
- BEGIN
- s.error := FALSE;
+ (* s.buf = NIL *)
+ IF addrio IN s.caps THEN
+ s.count := s.if.addrread(s, SYSTEM.ADR(buf[off]), maxcnt);
+ ELSIF bufio IN s.caps THEN
+ s.count := s.if.bufread(s, buf, off, maxcnt);
+ ELSE
+ s.count := 0;
+ WHILE (s.count < maxcnt) & s.if.read(s, buf[s.count+off]) DO
+ INC(s.count);
+ END;
+ END;
+ IF s.count < 0 THEN
+ s.count := 0;
+ Error(s, ReadFailed);
+ ELSE
+ s.eof := s.count = 0;
+ END;
+ s.lock := FALSE;
+ RETURN s.count
+ END ReadPacket;
+
+ PROCEDURE WritePart*(s: Stream;
+ (* read-only *) VAR buf: ARRAY OF Byte;
+ off, cnt: Count) : BOOLEAN;
+ (* write buf[off..off+cnt-1] to s *)
+ VAR
+ posindex: Count;
+
+ PROCEDURE NewBuffer(s: Stream) : BOOLEAN;
+ (* flush and get new buffer *)
+ BEGIN
+ IF s.pos - posindex # s.buf.pos THEN
+ IF s.bufmode # bufpool THEN
+ IF ~InternalFlush(s) THEN RETURN FALSE END;
+ END;
+ InitBuf(s);
+ IF s.write # 0 THEN RETURN TRUE END;
+ END;
+ IF s.buf.wbegin = s.buf.wend THEN
+ (* nothing written into this buffer until now *)
+ s.buf.wbegin := posindex; s.buf.wend := posindex;
+ s.write := bufsize - posindex;
+ ELSIF s.wextensible & (s.buf.rbegin # s.buf.rend) THEN
+ (* check if the write region may be extended
+ over parts of the read region
+ *)
+ IF s.buf.wend < posindex THEN
+ (* write region before current position *)
+ IF (s.buf.rbegin <= s.buf.wend) & (s.buf.rend >= posindex) THEN
+ s.buf.wend := posindex;
+ s.write := bufsize - posindex;
+ END;
+ ELSE (* s.wbegin > posindex *)
+ (* write region after current position *)
+ IF (s.buf.rbegin <= posindex) & (s.buf.rend >= s.buf.wbegin) THEN
+ s.buf.wbegin := posindex;
+ s.write := bufsize - posindex;
+ END;
+ END;
+ END;
+ IF (* still *) s.write = 0 THEN
+ (* Flush necessary *)
+ IF ~InternalFlush(s) THEN RETURN FALSE END;
+ s.buf.wbegin := posindex; s.buf.wend := posindex;
+ s.write := bufsize - posindex;
+ END;
+ RETURN TRUE
+ END NewBuffer;
+
+ PROCEDURE UpdateReadRegion(s: Stream);
+ BEGIN
+ (* update s.left and extend read region, if possible *)
+ IF s.buf.rbegin = s.buf.rend THEN
+ (* set read region to write region *)
+ s.buf.rbegin := s.buf.wbegin; s.buf.rend := s.buf.wend;
+ s.left := s.buf.rend - posindex;
+ ELSIF (s.buf.rbegin < s.buf.wbegin) & (s.buf.rend >= s.buf.wbegin) THEN
+ (* forward extension of read region possible *)
+ IF s.buf.rend < s.buf.wend THEN
+ s.buf.rend := s.buf.wend;
+ END;
+ s.left := s.buf.rend - posindex;
+ ELSIF (s.buf.rbegin <= s.buf.wend) & (s.buf.rend > s.buf.wend) THEN
+ (* backward extension of read region possible *)
+ IF s.buf.rbegin > s.buf.wbegin THEN
+ s.buf.rbegin := s.buf.wend;
+ END;
+ s.left := s.buf.rend - posindex;
+ ELSE
+ (* posindex does not fall into [s.buf.rbegin..s.buf.rend-1] *)
+ s.left := 0;
+ END;
+ IF s.pos = s.buf.pos + bufsize THEN
+ s.left := 0;
+ END;
+ END UpdateReadRegion;
+
+ BEGIN
+ IF SYS.TAS(s.lock) THEN
+ Error(s, NestedCall); RETURN FALSE
+ END;
+ s.error := FALSE; s.count := 0;
+ IF ~(write IN s.caps) THEN
+ s.lock := FALSE; Error(s, CannotWrite); RETURN FALSE
+ ELSIF (off < 0) OR (off+cnt > LEN(buf)) OR (cnt < 0) THEN
+ s.lock := FALSE; Error(s, BadParameters); RETURN FALSE
+ ELSIF cnt = 0 THEN
+ s.lock := FALSE; RETURN TRUE
+ END;
+
+ IF s.buf # NIL THEN
IF s.bidirect THEN
- Error(s, CannotSeek); RETURN FALSE
- ELSIF s.buf = NIL THEN
- IF ~(seek IN s.caps) THEN
- Error(s, CannotSeek); RETURN FALSE
- ELSIF ~s.if.seek(s, offset, whence) THEN
- Error(s, SeekFailed); RETURN FALSE
- END;
+ WHILE s.count < cnt DO
+ IF (s.write = 0) & ~InternalFlush(s) THEN
+ s.lock := FALSE; RETURN FALSE
+ END;
+ s.wbuf.cont[s.wbuf.wend] := buf[off + s.count];
+ INC(s.wbuf.wend); INC(s.count); DEC(s.write);
+ IF (s.bufmode = linebuf) &
+ (buf[s.count+off-1] = s.termch) THEN
+ IF ~InternalFlush(s) THEN
+ s.lock := FALSE; RETURN FALSE
+ END;
+ END;
+ END;
ELSE
- IF ~s.validpos & (seek IN s.caps) THEN
- IF (write IN s.caps) & ~InternalFlush(s) THEN END;
- IF ~s.if.seek(s, offset, whence) THEN
- Error(s, SeekFailed); RETURN FALSE
- END;
- IF whence = fromStart THEN
- s.validpos := TRUE;
- s.pos := offset; s.rpos := offset;
- END;
- ELSE
- ValidPos(s); oldpos := s.pos;
- IF s.pos > s.maxpos THEN
- s.maxpos := s.pos;
- END;
- CASE whence OF
- | fromStart: IF offset < 0 THEN
- Error(s, SeekFailed); RETURN FALSE
- END;
- s.pos := offset;
- | fromPos: IF s.pos + offset < 0 THEN
- Error(s, SeekFailed); RETURN FALSE
- END;
- INC(s.pos, offset);
- | fromEnd: IF (write IN s.caps) & ~InternalFlush(s) THEN END;
- IF ~(seek IN s.caps) OR
- ~s.if.seek(s, offset, whence) THEN
- Error(s, SeekFailed); RETURN FALSE
- END;
- s.validpos := FALSE; ValidPos(s);
- ELSE
- Error(s, BadWhence); RETURN FALSE
- END;
- IF ~(holes IN s.caps) & (s.pos > s.maxpos) THEN
- (* if holes are not permitted
- we need to check the new position
- *)
- IF ~(seek IN s.caps) THEN
- Error(s, CannotSeek); RETURN FALSE
- ELSIF s.if.seek(s, s.pos, fromStart) THEN
- s.rpos := s.pos; s.maxpos := s.pos;
- ELSE
- Error(s, SeekFailed); RETURN FALSE
- END;
- END;
- IF s.buf.ok & (s.pos # oldpos) THEN
- (* set s.left and s.write *)
- IF (s.pos < s.buf.pos) OR (s.pos >= s.buf.pos + bufsize) THEN
- s.left := 0; s.write := 0;
- ELSE
- pos := s.pos MOD bufsize;
- IF s.buf.rbegin = s.buf.rend THEN
- s.buf.rbegin := pos; s.buf.rend := pos;
- END;
- IF s.buf.wbegin = s.buf.wend THEN
- s.buf.wbegin := pos; s.buf.wend := pos;
- END;
- IF s.pos > oldpos THEN
- IF (pos >= s.buf.rbegin) & (pos < s.buf.rend) THEN
- s.left := s.buf.rend - pos;
- ELSE
- s.left := 0;
- END;
- IF (pos >= s.buf.wbegin) & (pos <= s.buf.wend) THEN
- s.write := bufsize - pos;
- ELSE
- s.write := 0;
- END;
- IF s.wextensible &
- (s.write < s.left) & (s.buf.wbegin # s.buf.wend) THEN
- (* s.write = 0 (else s.write >= s.left);
- try to extend write-region to avoid
- an unnecessary flush operation
- *)
- IF (s.buf.wbegin < pos) &
- (s.buf.wend >= s.buf.rbegin) THEN
- (* write-region is followed by read-region *)
- s.buf.wend := pos; s.write := bufsize - pos;
- ELSIF (pos < s.buf.wbegin) &
- (s.buf.wbegin >= s.buf.rend) THEN
- (* read-region is followed by write-region *)
- s.buf.wbegin := pos; s.write := bufsize - pos;
- END;
- END;
- ELSE (* s.pos < oldpos *)
- IF (pos < s.buf.rbegin) OR (pos > s.buf.rend) THEN
- s.left := 0;
- ELSE
- s.left := s.buf.rend - pos;
- END;
- IF (pos < s.buf.wbegin) OR (pos > s.buf.wend) THEN
- s.write := 0;
- ELSE
- s.write := bufsize - pos;
- END;
- END;
- END;
- END;
- END;
- END;
- IF s.left > 0 THEN
- s.eof := FALSE;
- END;
- RETURN TRUE
- END InternalSeek;
+ ValidPos(s);
+ posindex := s.pos MOD bufsize;
+ IF ~s.buf.ok THEN
+ InitBuf(s);
+ END;
- PROCEDURE Seek*(s: Stream; offset: Count; whence: Whence) : BOOLEAN;
- VAR
- rval: BOOLEAN;
- BEGIN
- IF ~SYS.TAS(s.lock) THEN
- rval := InternalSeek(s, offset, whence);
- s.lock := FALSE;
- RETURN rval
+ (* copy from buf to s.buf *)
+ WHILE s.count < cnt DO
+ IF s.write = 0 THEN
+ posindex := s.pos MOD bufsize;
+ IF s.count > 0 THEN
+ UpdateReadRegion(s);
+ END;
+ IF ~NewBuffer(s) THEN
+ s.lock := FALSE; RETURN FALSE
+ END;
+ END;
+ s.buf.cont[posindex] := buf[off + s.count];
+ IF s.buf.wend = posindex THEN
+ INC(s.buf.wend);
+ END;
+ INC(s.count); INC(s.pos); DEC(s.write); INC(posindex);
+ IF (s.bufmode = linebuf) &
+ (buf[s.count+off-1] = s.termch) THEN
+ UpdateReadRegion(s);
+ IF ~InternalFlush(s) THEN
+ s.lock := FALSE; RETURN FALSE
+ END;
+ (* s.pos can be changed by InternalFlush *)
+ posindex := s.pos MOD bufsize;
+ END;
+ END;
+ UpdateReadRegion(s);
+ END;
+ ELSE (* unbuffered stream *)
+ IF addrio IN s.caps THEN
+ s.count := s.if.addrwrite(s, SYSTEM.ADR(buf[off]), cnt);
+ ELSIF bufio IN s.caps THEN
+ s.count := s.if.bufwrite(s, buf, off, cnt);
ELSE
- Error(s, NestedCall);
- RETURN FALSE
+ s.count := 0;
+ WHILE (s.count < cnt) & s.if.write(s, buf[off+s.count]) DO
+ INC(s.count);
+ END;
END;
- END Seek;
+ IF s.count # cnt THEN
+ Error(s, WriteFailed);
+ END;
+ END;
+ s.lock := FALSE;
+ RETURN s.count = cnt
+ END WritePart;
- PROCEDURE Tell*(s: Stream; VAR offset: Count) : BOOLEAN;
- BEGIN
- IF ~SYS.TAS(s.lock) THEN
- s.error := FALSE;
- IF tell IN s.caps THEN
- IF s.buf # NIL THEN
- IF s.validpos THEN
- offset := s.pos;
- ELSIF s.if.tell(s, s.rpos) THEN
- s.validpos := TRUE;
- s.pos := s.rpos;
- offset := s.pos;
- ELSE
- s.lock := FALSE;
- Error(s, TellFailed);
- END;
- ELSIF ~s.if.tell(s, offset) THEN
- s.lock := FALSE;
- Error(s, TellFailed);
- END;
- ELSE
- s.lock := FALSE;
- Error(s, CannotTell);
- END;
- s.lock := FALSE;
+ PROCEDURE Write*(s: Stream;
+ (* read-only *) VAR buf: ARRAY OF Byte) : BOOLEAN;
+ BEGIN
+ RETURN WritePart(s, buf, 0, LEN(buf))
+ END Write;
+
+ PROCEDURE WritePartC*(s: Stream; buf: ARRAY OF Byte;
+ off, cnt: Count) : BOOLEAN;
+ (* write buf[off..off+cnt-1] to s *)
+ BEGIN
+ RETURN WritePart(s, buf, off, cnt)
+ END WritePartC;
+
+ PROCEDURE WriteC*(s: Stream; buf: ARRAY OF Byte) : BOOLEAN;
+ BEGIN
+ RETURN WritePart(s, buf, 0, LEN(buf))
+ END WriteC;
+
+ PROCEDURE WriteByte*(s: Stream; byte: Byte) : BOOLEAN;
+ VAR
+ posindex: Count;
+ BEGIN
+ IF (s.write > 0) & ~SYS.TAS(s.lock) THEN
+ s.error := FALSE; s.count := 1;
+
+ IF s.bidirect THEN
+ s.wbuf.cont[s.wbuf.wend] := byte; INC(s.wbuf.wend); DEC(s.write);
ELSE
- Error(s, NestedCall);
+ (* put byte into s.buf *)
+ posindex := s.pos MOD bufsize;
+ s.buf.cont[posindex] := byte;
+ IF s.buf.wend = posindex THEN
+ INC(s.buf.wend);
+ END;
+ DEC(s.write);
+
+ (* update s.buf.rend and s.left, if necessary *)
+ IF s.buf.rend = posindex THEN
+ INC(s.buf.rend);
+ END;
+ IF s.left # 0 THEN
+ DEC(s.left);
+ ELSIF s.buf.rbegin = s.buf.rend THEN
+ (* set read-region to write-region *)
+ s.buf.rbegin := s.buf.wbegin; s.buf.rend := s.buf.wend;
+ s.left := s.buf.wend - posindex;
+ END;
+
+ INC(s.pos);
END;
- RETURN ~s.error
- END Tell;
- PROCEDURE GetPos*(s: Stream; VAR offset: Count);
- (* IF ~Tell(s, offset) THEN offset := internal position END; *)
- BEGIN
- IF ~Tell(s, offset) THEN
- IF SYS.TAS(s.lock) THEN
- Error(s, NestedCall);
- ELSE
- ValidPos(s);
- offset := s.pos;
- s.lock := FALSE;
- END;
+ IF (s.bufmode = linebuf) & (byte = s.termch) THEN
+ IF ~InternalFlush(s) THEN
+ s.lock := FALSE; RETURN FALSE
+ END;
+ IF ~s.bidirect THEN
+ s.buf.wbegin := s.pos MOD bufsize;
+ END;
END;
- END GetPos;
- PROCEDURE SetPos*(s: Stream; offset: Count);
- (* IF ~Seek(s, offset, fromStart) THEN END; *)
- BEGIN
- IF ~Seek(s, offset, fromStart) THEN END;
- END SetPos;
+ s.lock := FALSE; RETURN TRUE
+ ELSE
+ RETURN WritePart(s, byte, 0, 1)
+ END;
+ END WriteByte;
- PROCEDURE ^ Touch*(s: Stream);
-
- PROCEDURE Trunc*(s: Stream; length: Count) : BOOLEAN;
- (* truncate `s' to a total length of `length';
- following holds if holes are permitted:
- (1) the current position remains unchanged
- (2) the contents between `length' and
- the current position is undefined
- this call fails if holes are not permitted and the
- current position is beyond `length'
- *)
- VAR
- ok: BOOLEAN;
- BEGIN
- IF ~SYS.TAS(s.lock) THEN
- IF (trunc IN s.caps) & (length >= 0) THEN
- s.error := FALSE; ok := TRUE;
- IF s.buf # NIL THEN
- ValidPos(s);
- IF ~(holes IN s.caps) & (s.pos > length) THEN
- ok := FALSE;
- ELSIF (s.bufmode = bufpool) OR s.buf.ok &
- (s.buf.pos DIV bufsize >= length DIV bufsize) THEN
- Touch(s);
- END;
- END;
- IF ~ok OR ~s.if.trunc(s, length) THEN
- s.lock := FALSE; Error(s, TruncFailed);
- END;
- ELSE
- s.lock := FALSE; Error(s, CannotTrunc);
- END;
- s.lock := FALSE;
+ PROCEDURE InternalSeek(s: Stream; offset: Count; whence: Whence) : BOOLEAN;
+ VAR
+ oldpos: Count; pos: Count;
+ BEGIN
+ s.error := FALSE;
+ IF s.bidirect THEN
+ Error(s, CannotSeek); RETURN FALSE
+ ELSIF s.buf = NIL THEN
+ IF ~(seek IN s.caps) THEN
+ Error(s, CannotSeek); RETURN FALSE
+ ELSIF ~s.if.seek(s, offset, whence) THEN
+ Error(s, SeekFailed); RETURN FALSE
+ END;
+ ELSE
+ IF ~s.validpos & (seek IN s.caps) THEN
+ IF (write IN s.caps) & ~InternalFlush(s) THEN END;
+ IF ~s.if.seek(s, offset, whence) THEN
+ Error(s, SeekFailed); RETURN FALSE
+ END;
+ IF whence = fromStart THEN
+ s.validpos := TRUE;
+ s.pos := offset; s.rpos := offset;
+ END;
ELSE
- Error(s, NestedCall);
+ ValidPos(s); oldpos := s.pos;
+ IF s.pos > s.maxpos THEN
+ s.maxpos := s.pos;
+ END;
+ CASE whence OF
+ | fromStart: IF offset < 0 THEN
+ Error(s, SeekFailed); RETURN FALSE
+ END;
+ s.pos := offset;
+ | fromPos: IF s.pos + offset < 0 THEN
+ Error(s, SeekFailed); RETURN FALSE
+ END;
+ INC(s.pos, offset);
+ | fromEnd: IF (write IN s.caps) & ~InternalFlush(s) THEN END;
+ IF ~(seek IN s.caps) OR
+ ~s.if.seek(s, offset, whence) THEN
+ Error(s, SeekFailed); RETURN FALSE
+ END;
+ s.validpos := FALSE; ValidPos(s);
+ ELSE
+ Error(s, BadWhence); RETURN FALSE
+ END;
+ IF ~(holes IN s.caps) & (s.pos > s.maxpos) THEN
+ (* if holes are not permitted
+ we need to check the new position
+ *)
+ IF ~(seek IN s.caps) THEN
+ Error(s, CannotSeek); RETURN FALSE
+ ELSIF s.if.seek(s, s.pos, fromStart) THEN
+ s.rpos := s.pos; s.maxpos := s.pos;
+ ELSE
+ Error(s, SeekFailed); RETURN FALSE
+ END;
+ END;
+ IF s.buf.ok & (s.pos # oldpos) THEN
+ (* set s.left and s.write *)
+ IF (s.pos < s.buf.pos) OR (s.pos >= s.buf.pos + bufsize) THEN
+ s.left := 0; s.write := 0;
+ ELSE
+ pos := s.pos MOD bufsize;
+ IF s.buf.rbegin = s.buf.rend THEN
+ s.buf.rbegin := pos; s.buf.rend := pos;
+ END;
+ IF s.buf.wbegin = s.buf.wend THEN
+ s.buf.wbegin := pos; s.buf.wend := pos;
+ END;
+ IF s.pos > oldpos THEN
+ IF (pos >= s.buf.rbegin) & (pos < s.buf.rend) THEN
+ s.left := s.buf.rend - pos;
+ ELSE
+ s.left := 0;
+ END;
+ IF (pos >= s.buf.wbegin) & (pos <= s.buf.wend) THEN
+ s.write := bufsize - pos;
+ ELSE
+ s.write := 0;
+ END;
+ IF s.wextensible &
+ (s.write < s.left) & (s.buf.wbegin # s.buf.wend) THEN
+ (* s.write = 0 (else s.write >= s.left);
+ try to extend write-region to avoid
+ an unnecessary flush operation
+ *)
+ IF (s.buf.wbegin < pos) &
+ (s.buf.wend >= s.buf.rbegin) THEN
+ (* write-region is followed by read-region *)
+ s.buf.wend := pos; s.write := bufsize - pos;
+ ELSIF (pos < s.buf.wbegin) &
+ (s.buf.wbegin >= s.buf.rend) THEN
+ (* read-region is followed by write-region *)
+ s.buf.wbegin := pos; s.write := bufsize - pos;
+ END;
+ END;
+ ELSE (* s.pos < oldpos *)
+ IF (pos < s.buf.rbegin) OR (pos > s.buf.rend) THEN
+ s.left := 0;
+ ELSE
+ s.left := s.buf.rend - pos;
+ END;
+ IF (pos < s.buf.wbegin) OR (pos > s.buf.wend) THEN
+ s.write := 0;
+ ELSE
+ s.write := bufsize - pos;
+ END;
+ END;
+ END;
+ END;
END;
- RETURN ~s.error
- END Trunc;
+ END;
+ IF s.left > 0 THEN
+ s.eof := FALSE;
+ END;
+ RETURN TRUE
+ END InternalSeek;
- PROCEDURE Back*(s: Stream) : BOOLEAN;
- (* undo last read operation (one byte);
- because of the delayed buffer filling
- Back is always successful for buffered streams
- immediately after read-operations
- *)
- VAR
- rval: BOOLEAN;
- BEGIN
- IF ~SYS.TAS(s.lock) THEN
- s.error := FALSE;
- IF read IN s.caps THEN
- IF seek IN s.caps THEN
- (* fails if s.pos = 0 *)
- rval := InternalSeek(s, -1, 1)
- ELSIF s.bidirect & s.buf.ok THEN
- IF s.pos > 0 THEN
- DEC(s.pos); INC(s.left);
- rval := TRUE;
- ELSE
- rval := FALSE;
- END;
- ELSIF (s.buf # NIL) & s.buf.ok THEN
- rval := InternalSeek(s, -1, 1) & (s.left > 0)
- ELSE
- rval := FALSE
- END;
- ELSE
- s.lock := FALSE; Error(s, CannotRead);
- rval := FALSE
- END;
- s.lock := FALSE;
- RETURN rval
- ELSE
- Error(s, NestedCall);
- RETURN FALSE
- END;
- END Back;
-
- PROCEDURE Insert*(s: Stream; byte: Byte) : BOOLEAN;
- (* return `byte' on next read-operation *)
- BEGIN
- IF ~SYS.TAS(s.lock) THEN
- s.error := FALSE;
- IF read IN s.caps THEN
- IF s.buf # NIL THEN
- (* seek in buffer possible? *)
- IF s.bidirect THEN
- IF s.pos > 0 THEN
- DEC(s.pos); s.buf.cont[s.pos] := byte;
- RETURN TRUE
- ELSE
- RETURN FALSE
- END;
- ELSIF s.buf.ok &
- (s.pos > s.buf.pos+s.buf.rbegin) &
- (s.pos < s.buf.pos+s.buf.rend) &
- InternalSeek(s, -1, 1) THEN
- s.buf.cont[s.pos MOD bufsize] := byte;
- s.lock := FALSE;
- RETURN TRUE
- ELSE
- s.lock := FALSE;
- RETURN FALSE
- END;
- ELSE
- s.lock := FALSE; Error(s, Unbuffered); RETURN FALSE
- END;
- ELSE
- s.lock := FALSE; Error(s, CannotRead); RETURN FALSE
- END;
- ELSE
- Error(s, NestedCall);
- RETURN FALSE
- END;
- END Insert;
-
- PROCEDURE InternalFlush(s: Stream) : BOOLEAN;
-
- PROCEDURE Write(s: Stream; buf: Buffer) : BOOLEAN;
-
- VAR
- count: Count;
- BEGIN
- IF addrio IN s.caps THEN
- count := s.if.addrwrite(s, SYSTEM.ADR(buf.cont[buf.wbegin]),
- buf.wend-buf.wbegin);
- ELSIF bufio IN s.caps THEN
- count := s.if.bufwrite(s, buf.cont,
- buf.wbegin, buf.wend-buf.wbegin);
- ELSIF s.if.write(s, buf.cont[buf.wbegin]) THEN
- count := 1;
- ELSE
- count := 0;
- END;
- IF count < 0 THEN
- count := 0;
- END;
- INC(buf.wbegin, count); INC(s.rpos, count);
- RETURN count > 0
- END Write;
-
- PROCEDURE FlushEvent;
- VAR
- event: Event;
- BEGIN
- IF s.flushEvent # NIL THEN
- NEW(event);
- event.type := s.flushEvent;
- event.message := "flush event of Streams";
- event.stream := s;
- Events.Raise(event);
- END;
- END FlushEvent;
-
- BEGIN
- s.error := FALSE;
- IF (write IN s.caps) & (s.buf # NIL) & s.buf.ok THEN
- IF s.bidirect & (s.wbuf.wend > s.wbuf.wbegin) THEN
- FlushEvent;
- WHILE (s.wbuf.wend > s.wbuf.wbegin) & Write(s, s.wbuf) DO END;
- IF s.wbuf.wend > s.wbuf.wbegin THEN
- s.wbuf.wbegin := 0; s.wbuf.wend := 0; s.write := bufsize;
- Error(s, WriteFailed); RETURN FALSE
- END;
- s.wbuf.wbegin := 0; s.wbuf.wend := 0; s.write := bufsize;
- ELSIF ~s.bidirect & (s.buf.wend > s.buf.wbegin) THEN
- FlushEvent;
- ValidPos(s);
- IF s.buf.pos + s.buf.wbegin # s.rpos THEN
- IF ~(seek IN s.caps) THEN
- Error(s, CannotSeek);
- (* write in this case at the current position
- else there is no easy way to write anyhow
- *)
- ELSIF ~s.if.seek(s, s.buf.pos + s.buf.wbegin, fromStart) THEN
- s.buf.wend := s.buf.wbegin; s.write := 0;
- Error(s, SeekFailed); RETURN FALSE
- END;
- s.rpos := s.buf.pos + s.buf.wbegin;
- END;
- WHILE (s.buf.wend > s.buf.wbegin) & Write(s, s.buf) DO END;
- IF s.buf.wend > s.buf.wbegin THEN
- s.buf.wend := s.buf.wbegin; s.write := bufsize - s.buf.wbegin;
- Error(s, WriteFailed); RETURN FALSE
- END;
- IF {seek, tell, trunc} * s.caps = {} THEN
- (* unidirectional pipeline; reset s.pos to avoid
- unintentional flushes due to buffer boundaries
- *)
- s.pos := 0; s.rpos := 0; s.buf.pos := 0;
- s.buf.wbegin := 0; s.buf.wend := 0; s.write := bufsize;
- ELSE
- IF (s.pos >= s.buf.pos) & (s.pos < s.buf.pos + bufsize) THEN
- s.buf.wbegin := s.pos MOD bufsize;
- s.buf.wend := s.buf.wbegin;
- s.write := bufsize - s.buf.wbegin;
- ELSE
- s.write := 0;
- END;
- END;
- END;
- END;
- RETURN TRUE
- END InternalFlush;
-
- PROCEDURE Flush*(s: Stream) : BOOLEAN;
- VAR
- ok: BOOLEAN;
- BEGIN
- IF ~SYS.TAS(s.lock) THEN
- IF s.bufmode = bufpool THEN
- ok := FlushBufPool(s);
- ELSE
- ok := InternalFlush(s);
- END;
- IF ok & (flush IN s.caps) THEN
- ok := s.if.flush(s);
- IF ~ok THEN
- Error(s, FlushFailed);
- END;
- END;
- s.lock := FALSE;
- RETURN ok
- ELSE
- Error(s, NestedCall);
- RETURN FALSE
- END;
- END Flush;
-
- PROCEDURE InputInBuffer*(s: Stream) : BOOLEAN;
- (* returns TRUE if the next byte to be read is buffered *)
- VAR
- buf: Buffer;
- pos: Count;
- BEGIN
- IF s.bufmode = bufpool THEN
- IF ~s.buf.ok THEN RETURN FALSE END;
- pos := s.pos - s.pos MOD bufsize;
- IF s.buf.pos # pos THEN
- IF ~FindBuffer(s, pos, buf) THEN
- RETURN FALSE
- END;
- pos := s.pos - buf.pos;
- RETURN (pos >= buf.rbegin) & (pos < buf.rend)
- END;
- ELSIF s.bidirect THEN
- RETURN s.left > 0
- END;
- pos := s.pos MOD bufsize;
- RETURN (read IN s.caps) & (s.buf # NIL) & s.buf.ok &
- ((s.left > 0) OR
- (write IN s.caps) & (s.buf.wbegin <= pos) & (s.buf.wend > pos))
- END InputInBuffer;
-
- PROCEDURE OutputInBuffer*(s: Stream) : BOOLEAN;
- (* returns TRUE if Flush would lead to a write-operation *)
- VAR
- buf: Buffer;
- BEGIN
- IF s.bufmode = bufpool THEN
- buf := s.bufpool.head;
- WHILE buf # NIL DO
- IF buf.wbegin # buf.wend THEN RETURN TRUE END;
- buf := buf.nexta;
- END;
- RETURN FALSE
- ELSIF s.bidirect THEN
- RETURN s.wbuf.wend > s.wbuf.wbegin
- ELSE
- RETURN (write IN s.caps) & (s.buf # NIL) & s.buf.ok &
- (s.buf.wend > s.buf.wbegin)
- END;
- END OutputInBuffer;
-
- PROCEDURE OutputWillBeBuffered*(s: Stream) : BOOLEAN;
- (* returns TRUE if the next written byte will be buffered *)
- VAR
- buf: Buffer;
- pos: Count;
- BEGIN
- IF s.bufmode = bufpool THEN
- IF s.bufpool.nbuf < s.bufpool.maxbuf THEN RETURN TRUE END;
- pos := s.pos - s.pos MOD bufsize;
- IF s.buf.pos # pos THEN
- IF ~FindBuffer(s, pos, buf) THEN RETURN FALSE END;
- IF s.buf.wbegin = s.buf.wend THEN RETURN TRUE END;
- pos := s.pos - buf.pos;
- RETURN (pos >= buf.wbegin) & (pos <= buf.wend) OR
- (buf.wbegin > 0) & (pos + 1 = buf.wbegin)
- END;
- ELSIF s.bidirect THEN
- RETURN s.write > 0
- END;
- RETURN (write IN s.caps) & (s.buf # NIL) &
- ((s.write > 0) OR ~s.buf.ok)
- END OutputWillBeBuffered;
-
- PROCEDURE Touch*(s: Stream);
- (* forget any buffer contents *)
- BEGIN
- IF ~SYS.TAS(s.lock) THEN
- s.error := FALSE;
- IF write IN s.caps THEN
- IF s.bufmode = bufpool THEN
- IF ~FlushBufPool(s) THEN END;
- ReleaseBufPool(s);
- ELSE
- IF ~InternalFlush(s) THEN END;
- END;
- END;
- IF flush IN s.caps THEN
- IF ~s.if.flush(s) THEN
- Error(s, FlushFailed);
- END;
- END;
- IF s.bidirect THEN
- s.buf.rbegin := 0; s.buf.rend := 0; s.left := 0;
- ELSE
- s.validpos := FALSE;
- IF s.buf # NIL THEN
- s.buf.ok := FALSE;
- s.left := 0;
- s.write := 0;
- s.eofFound := FALSE;
- END;
- END;
- s.lock := FALSE;
- ELSE
- Error(s, NestedCall);
- END;
- END Touch;
-
- PROCEDURE Copy*(source, dest: Stream; maxcnt: Count) : BOOLEAN;
- (* more efficient variants are possible *)
- VAR
- left, count, copied, read, written: Count;
- buffer: ARRAY bufsize OF Byte;
- ok: BOOLEAN;
- BEGIN
- IF maxcnt >= 0 THEN
- read := 0; written := 0; ok := TRUE;
- left := maxcnt;
- LOOP
- IF left = 0 THEN
- EXIT
- END;
- ASSERT(left > 0);
- IF left > bufsize THEN
- count := bufsize;
- ELSE
- count := left;
- END;
-
- ok := ReadPacket(source, buffer, 0, count) > 0;
- ASSERT(source.count <= count);
- INC(read, source.count);
- IF ~ok THEN EXIT END;
-
- ok := WritePart(dest, buffer, 0, source.count);
- ASSERT(dest.count <= source.count);
- INC(written, dest.count);
- IF ~ok THEN EXIT END;
-
- DEC(left, dest.count);
- END;
- source.count := read; dest.count := written;
- RETURN ok
- ELSE
- copied := 0;
- WHILE (ReadPacket(source, buffer, 0, bufsize) > 0) &
- WritePart(dest, buffer, 0, source.count) DO
- INC(copied, source.count);
- END;
- source.count := copied; dest.count := copied;
- RETURN ~source.error & ~dest.error
- END;
- END Copy;
-
- (* === nulldev procedures ========================================== *)
-
- PROCEDURE NulldevRead(s: Stream; VAR byte: Byte) : BOOLEAN;
- BEGIN
- byte := 0X;
+ PROCEDURE Seek*(s: Stream; offset: Count; whence: Whence) : BOOLEAN;
+ VAR
+ rval: BOOLEAN;
+ BEGIN
+ IF ~SYS.TAS(s.lock) THEN
+ rval := InternalSeek(s, offset, whence);
+ s.lock := FALSE;
+ RETURN rval
+ ELSE
+ Error(s, NestedCall);
RETURN FALSE
- END NulldevRead;
+ END;
+ END Seek;
- PROCEDURE NulldevWrite(s: Stream; byte: Byte) : BOOLEAN;
- BEGIN
- RETURN TRUE
- END NulldevWrite;
-
- PROCEDURE InitNullIf(VAR nullif: Interface);
- BEGIN
- NEW(nullif);
- nullif.read := NulldevRead;
- nullif.write := NulldevWrite;
- END InitNullIf;
-
- PROCEDURE OpenNulldev(VAR s: Stream);
- BEGIN
- NEW(s);
- Services.Init(s, type);
- Init(s, nullif, {read, write}, nobuf);
- END OpenNulldev;
-
- PROCEDURE ExitHandler(event: Events.Event);
- (* flush all streams on exit;
- we do not close them to allow output by other exit event handlers
- *)
- VAR s: Stream;
- BEGIN
- s := opened;
- WHILE s # NIL DO
- IF (s.bufmode # nobuf) & (write IN s.caps) THEN
- IF ~Flush(s) THEN END;
- END;
- s := s.next;
+ PROCEDURE Tell*(s: Stream; VAR offset: Count) : BOOLEAN;
+ BEGIN
+ IF ~SYS.TAS(s.lock) THEN
+ s.error := FALSE;
+ IF tell IN s.caps THEN
+ IF s.buf # NIL THEN
+ IF s.validpos THEN
+ offset := s.pos;
+ ELSIF s.if.tell(s, s.rpos) THEN
+ s.validpos := TRUE;
+ s.pos := s.rpos;
+ offset := s.pos;
+ ELSE
+ s.lock := FALSE;
+ Error(s, TellFailed);
+ END;
+ ELSIF ~s.if.tell(s, offset) THEN
+ s.lock := FALSE;
+ Error(s, TellFailed);
+ END;
+ ELSE
+ s.lock := FALSE;
+ Error(s, CannotTell);
END;
- END ExitHandler;
+ s.lock := FALSE;
+ ELSE
+ Error(s, NestedCall);
+ END;
+ RETURN ~s.error
+ END Tell;
- PROCEDURE FreeHandler(event: Events.Event);
- (* set all free lists to NIL to return the associated storage
- to the garbage collector
- *)
- BEGIN
- freelist := NIL;
- END FreeHandler;
+ PROCEDURE GetPos*(s: Stream; VAR offset: Count);
+ (* IF ~Tell(s, offset) THEN offset := internal position END; *)
+ BEGIN
+ IF ~Tell(s, offset) THEN
+ IF SYS.TAS(s.lock) THEN
+ Error(s, NestedCall);
+ ELSE
+ ValidPos(s);
+ offset := s.pos;
+ s.lock := FALSE;
+ END;
+ END;
+ END GetPos;
+
+ PROCEDURE SetPos*(s: Stream; offset: Count);
+ (* IF ~Seek(s, offset, fromStart) THEN END; *)
+ BEGIN
+ IF ~Seek(s, offset, fromStart) THEN END;
+ END SetPos;
+
+ PROCEDURE ^ Touch*(s: Stream);
+
+ PROCEDURE Trunc*(s: Stream; length: Count) : BOOLEAN;
+ (* truncate `s' to a total length of `length';
+ following holds if holes are permitted:
+ (1) the current position remains unchanged
+ (2) the contents between `length' and
+ the current position is undefined
+ this call fails if holes are not permitted and the
+ current position is beyond `length'
+ *)
+ VAR
+ ok: BOOLEAN;
+ BEGIN
+ IF ~SYS.TAS(s.lock) THEN
+ IF (trunc IN s.caps) & (length >= 0) THEN
+ s.error := FALSE; ok := TRUE;
+ IF s.buf # NIL THEN
+ ValidPos(s);
+ IF ~(holes IN s.caps) & (s.pos > length) THEN
+ ok := FALSE;
+ ELSIF (s.bufmode = bufpool) OR s.buf.ok &
+ (s.buf.pos DIV bufsize >= length DIV bufsize) THEN
+ Touch(s);
+ END;
+ END;
+ IF ~ok OR ~s.if.trunc(s, length) THEN
+ s.lock := FALSE; Error(s, TruncFailed);
+ END;
+ ELSE
+ s.lock := FALSE; Error(s, CannotTrunc);
+ END;
+ s.lock := FALSE;
+ ELSE
+ Error(s, NestedCall);
+ END;
+ RETURN ~s.error
+ END Trunc;
+
+ PROCEDURE Back*(s: Stream) : BOOLEAN;
+ (* undo last read operation (one byte);
+ because of the delayed buffer filling
+ Back is always successful for buffered streams
+ immediately after read-operations
+ *)
+ VAR
+ rval: BOOLEAN;
+ BEGIN
+ IF ~SYS.TAS(s.lock) THEN
+ s.error := FALSE;
+ IF read IN s.caps THEN
+ IF seek IN s.caps THEN
+ (* fails if s.pos = 0 *)
+ rval := InternalSeek(s, -1, 1)
+ ELSIF s.bidirect & s.buf.ok THEN
+ IF s.pos > 0 THEN
+ DEC(s.pos); INC(s.left);
+ rval := TRUE;
+ ELSE
+ rval := FALSE;
+ END;
+ ELSIF (s.buf # NIL) & s.buf.ok THEN
+ rval := InternalSeek(s, -1, 1) & (s.left > 0)
+ ELSE
+ rval := FALSE
+ END;
+ ELSE
+ s.lock := FALSE; Error(s, CannotRead);
+ rval := FALSE
+ END;
+ s.lock := FALSE;
+ RETURN rval
+ ELSE
+ Error(s, NestedCall);
+ RETURN FALSE
+ END;
+ END Back;
+
+ PROCEDURE Insert*(s: Stream; byte: Byte) : BOOLEAN;
+ (* return `byte' on next read-operation *)
+ BEGIN
+ IF ~SYS.TAS(s.lock) THEN
+ s.error := FALSE;
+ IF read IN s.caps THEN
+ IF s.buf # NIL THEN
+ (* seek in buffer possible? *)
+ IF s.bidirect THEN
+ IF s.pos > 0 THEN
+ DEC(s.pos); s.buf.cont[s.pos] := byte;
+ RETURN TRUE
+ ELSE
+ RETURN FALSE
+ END;
+ ELSIF s.buf.ok &
+ (s.pos > s.buf.pos+s.buf.rbegin) &
+ (s.pos < s.buf.pos+s.buf.rend) &
+ InternalSeek(s, -1, 1) THEN
+ s.buf.cont[s.pos MOD bufsize] := byte;
+ s.lock := FALSE;
+ RETURN TRUE
+ ELSE
+ s.lock := FALSE;
+ RETURN FALSE
+ END;
+ ELSE
+ s.lock := FALSE; Error(s, Unbuffered); RETURN FALSE
+ END;
+ ELSE
+ s.lock := FALSE; Error(s, CannotRead); RETURN FALSE
+ END;
+ ELSE
+ Error(s, NestedCall);
+ RETURN FALSE
+ END;
+ END Insert;
+
+ PROCEDURE InternalFlush(s: Stream) : BOOLEAN;
+
+ PROCEDURE Write(s: Stream; buf: Buffer) : BOOLEAN;
+
+ VAR
+ count: Count;
+ BEGIN
+ IF addrio IN s.caps THEN
+ count := s.if.addrwrite(s, SYSTEM.ADR(buf.cont[buf.wbegin]),
+ buf.wend-buf.wbegin);
+ ELSIF bufio IN s.caps THEN
+ count := s.if.bufwrite(s, buf.cont,
+ buf.wbegin, buf.wend-buf.wbegin);
+ ELSIF s.if.write(s, buf.cont[buf.wbegin]) THEN
+ count := 1;
+ ELSE
+ count := 0;
+ END;
+ IF count < 0 THEN
+ count := 0;
+ END;
+ INC(buf.wbegin, count); INC(s.rpos, count);
+ RETURN count > 0
+ END Write;
+
+ PROCEDURE FlushEvent;
+ VAR
+ event: Event;
+ BEGIN
+ IF s.flushEvent # NIL THEN
+ NEW(event);
+ event.type := s.flushEvent;
+ event.message := "flush event of Streams";
+ event.stream := s;
+ Events.Raise(event);
+ END;
+ END FlushEvent;
+
+ BEGIN
+ s.error := FALSE;
+ IF (write IN s.caps) & (s.buf # NIL) & s.buf.ok THEN
+ IF s.bidirect & (s.wbuf.wend > s.wbuf.wbegin) THEN
+ FlushEvent;
+ WHILE (s.wbuf.wend > s.wbuf.wbegin) & Write(s, s.wbuf) DO END;
+ IF s.wbuf.wend > s.wbuf.wbegin THEN
+ s.wbuf.wbegin := 0; s.wbuf.wend := 0; s.write := bufsize;
+ Error(s, WriteFailed); RETURN FALSE
+ END;
+ s.wbuf.wbegin := 0; s.wbuf.wend := 0; s.write := bufsize;
+ ELSIF ~s.bidirect & (s.buf.wend > s.buf.wbegin) THEN
+ FlushEvent;
+ ValidPos(s);
+ IF s.buf.pos + s.buf.wbegin # s.rpos THEN
+ IF ~(seek IN s.caps) THEN
+ Error(s, CannotSeek);
+ (* write in this case at the current position
+ else there is no easy way to write anyhow
+ *)
+ ELSIF ~s.if.seek(s, s.buf.pos + s.buf.wbegin, fromStart) THEN
+ s.buf.wend := s.buf.wbegin; s.write := 0;
+ Error(s, SeekFailed); RETURN FALSE
+ END;
+ s.rpos := s.buf.pos + s.buf.wbegin;
+ END;
+ WHILE (s.buf.wend > s.buf.wbegin) & Write(s, s.buf) DO END;
+ IF s.buf.wend > s.buf.wbegin THEN
+ s.buf.wend := s.buf.wbegin; s.write := bufsize - s.buf.wbegin;
+ Error(s, WriteFailed); RETURN FALSE
+ END;
+ IF {seek, tell, trunc} * s.caps = {} THEN
+ (* unidirectional pipeline; reset s.pos to avoid
+ unintentional flushes due to buffer boundaries
+ *)
+ s.pos := 0; s.rpos := 0; s.buf.pos := 0;
+ s.buf.wbegin := 0; s.buf.wend := 0; s.write := bufsize;
+ ELSE
+ IF (s.pos >= s.buf.pos) & (s.pos < s.buf.pos + bufsize) THEN
+ s.buf.wbegin := s.pos MOD bufsize;
+ s.buf.wend := s.buf.wbegin;
+ s.write := bufsize - s.buf.wbegin;
+ ELSE
+ s.write := 0;
+ END;
+ END;
+ END;
+ END;
+ RETURN TRUE
+ END InternalFlush;
+
+ PROCEDURE Flush*(s: Stream) : BOOLEAN;
+ VAR
+ ok: BOOLEAN;
+ BEGIN
+ IF ~SYS.TAS(s.lock) THEN
+ IF s.bufmode = bufpool THEN
+ ok := FlushBufPool(s);
+ ELSE
+ ok := InternalFlush(s);
+ END;
+ IF ok & (flush IN s.caps) THEN
+ ok := s.if.flush(s);
+ IF ~ok THEN
+ Error(s, FlushFailed);
+ END;
+ END;
+ s.lock := FALSE;
+ RETURN ok
+ ELSE
+ Error(s, NestedCall);
+ RETURN FALSE
+ END;
+ END Flush;
+
+ PROCEDURE InputInBuffer*(s: Stream) : BOOLEAN;
+ (* returns TRUE if the next byte to be read is buffered *)
+ VAR
+ buf: Buffer;
+ pos: Count;
+ BEGIN
+ IF s.bufmode = bufpool THEN
+ IF ~s.buf.ok THEN RETURN FALSE END;
+ pos := s.pos - s.pos MOD bufsize;
+ IF s.buf.pos # pos THEN
+ IF ~FindBuffer(s, pos, buf) THEN
+ RETURN FALSE
+ END;
+ pos := s.pos - buf.pos;
+ RETURN (pos >= buf.rbegin) & (pos < buf.rend)
+ END;
+ ELSIF s.bidirect THEN
+ RETURN s.left > 0
+ END;
+ pos := s.pos MOD bufsize;
+ RETURN (read IN s.caps) & (s.buf # NIL) & s.buf.ok &
+ ((s.left > 0) OR
+ (write IN s.caps) & (s.buf.wbegin <= pos) & (s.buf.wend > pos))
+ END InputInBuffer;
+
+ PROCEDURE OutputInBuffer*(s: Stream) : BOOLEAN;
+ (* returns TRUE if Flush would lead to a write-operation *)
+ VAR
+ buf: Buffer;
+ BEGIN
+ IF s.bufmode = bufpool THEN
+ buf := s.bufpool.head;
+ WHILE buf # NIL DO
+ IF buf.wbegin # buf.wend THEN RETURN TRUE END;
+ buf := buf.nexta;
+ END;
+ RETURN FALSE
+ ELSIF s.bidirect THEN
+ RETURN s.wbuf.wend > s.wbuf.wbegin
+ ELSE
+ RETURN (write IN s.caps) & (s.buf # NIL) & s.buf.ok &
+ (s.buf.wend > s.buf.wbegin)
+ END;
+ END OutputInBuffer;
+
+ PROCEDURE OutputWillBeBuffered*(s: Stream) : BOOLEAN;
+ (* returns TRUE if the next written byte will be buffered *)
+ VAR
+ buf: Buffer;
+ pos: Count;
+ BEGIN
+ IF s.bufmode = bufpool THEN
+ IF s.bufpool.nbuf < s.bufpool.maxbuf THEN RETURN TRUE END;
+ pos := s.pos - s.pos MOD bufsize;
+ IF s.buf.pos # pos THEN
+ IF ~FindBuffer(s, pos, buf) THEN RETURN FALSE END;
+ IF s.buf.wbegin = s.buf.wend THEN RETURN TRUE END;
+ pos := s.pos - buf.pos;
+ RETURN (pos >= buf.wbegin) & (pos <= buf.wend) OR
+ (buf.wbegin > 0) & (pos + 1 = buf.wbegin)
+ END;
+ ELSIF s.bidirect THEN
+ RETURN s.write > 0
+ END;
+ RETURN (write IN s.caps) & (s.buf # NIL) &
+ ((s.write > 0) OR ~s.buf.ok)
+ END OutputWillBeBuffered;
+
+ PROCEDURE Touch*(s: Stream);
+ (* forget any buffer contents *)
+ BEGIN
+ IF ~SYS.TAS(s.lock) THEN
+ s.error := FALSE;
+ IF write IN s.caps THEN
+ IF s.bufmode = bufpool THEN
+ IF ~FlushBufPool(s) THEN END;
+ ReleaseBufPool(s);
+ ELSE
+ IF ~InternalFlush(s) THEN END;
+ END;
+ END;
+ IF flush IN s.caps THEN
+ IF ~s.if.flush(s) THEN
+ Error(s, FlushFailed);
+ END;
+ END;
+ IF s.bidirect THEN
+ s.buf.rbegin := 0; s.buf.rend := 0; s.left := 0;
+ ELSE
+ s.validpos := FALSE;
+ IF s.buf # NIL THEN
+ s.buf.ok := FALSE;
+ s.left := 0;
+ s.write := 0;
+ s.eofFound := FALSE;
+ END;
+ END;
+ s.lock := FALSE;
+ ELSE
+ Error(s, NestedCall);
+ END;
+ END Touch;
+
+ PROCEDURE Copy*(source, dest: Stream; maxcnt: Count) : BOOLEAN;
+ (* more efficient variants are possible *)
+ VAR
+ left, count, copied, read, written: Count;
+ buffer: ARRAY bufsize OF Byte;
+ ok: BOOLEAN;
+ BEGIN
+ IF maxcnt >= 0 THEN
+ read := 0; written := 0; ok := TRUE;
+ left := maxcnt;
+ LOOP
+ IF left = 0 THEN
+ EXIT
+ END;
+ ASSERT(left > 0);
+ IF left > bufsize THEN
+ count := bufsize;
+ ELSE
+ count := left;
+ END;
+
+ ok := ReadPacket(source, buffer, 0, count) > 0;
+ ASSERT(source.count <= count);
+ INC(read, source.count);
+ IF ~ok THEN EXIT END;
+
+ ok := WritePart(dest, buffer, 0, source.count);
+ ASSERT(dest.count <= source.count);
+ INC(written, dest.count);
+ IF ~ok THEN EXIT END;
+
+ DEC(left, dest.count);
+ END;
+ source.count := read; dest.count := written;
+ RETURN ok
+ ELSE
+ copied := 0;
+ WHILE (ReadPacket(source, buffer, 0, bufsize) > 0) &
+ WritePart(dest, buffer, 0, source.count) DO
+ INC(copied, source.count);
+ END;
+ source.count := copied; dest.count := copied;
+ RETURN ~source.error & ~dest.error
+ END;
+ END Copy;
+
+ (* === nulldev procedures ========================================== *)
+
+ PROCEDURE NulldevRead(s: Stream; VAR byte: Byte) : BOOLEAN;
+ BEGIN
+ byte := 0X;
+ RETURN FALSE
+ END NulldevRead;
+
+ PROCEDURE NulldevWrite(s: Stream; byte: Byte) : BOOLEAN;
+ BEGIN
+ RETURN TRUE
+ END NulldevWrite;
+
+ PROCEDURE InitNullIf(VAR nullif: Interface);
+ BEGIN
+ NEW(nullif);
+ nullif.read := NulldevRead;
+ nullif.write := NulldevWrite;
+ END InitNullIf;
+
+ PROCEDURE OpenNulldev(VAR s: Stream);
+ BEGIN
+ NEW(s);
+ Services.Init(s, type);
+ Init(s, nullif, {read, write}, nobuf);
+ END OpenNulldev;
+
+ PROCEDURE ExitHandler(event: Events.Event);
+ (* flush all streams on exit;
+ we do not close them to allow output by other exit event handlers
+ *)
+ VAR s: Stream;
+ BEGIN
+ s := opened;
+ WHILE s # NIL DO
+ IF (s.bufmode # nobuf) & (write IN s.caps) THEN
+ IF ~Flush(s) THEN END;
+ END;
+ s := s.next;
+ END;
+ END ExitHandler;
+
+ PROCEDURE FreeHandler(event: Events.Event);
+ (* set all free lists to NIL to return the associated storage
+ to the garbage collector
+ *)
+ BEGIN
+ freelist := NIL;
+ END FreeHandler;
BEGIN
- Services.CreateType(type, "Streams.Stream", "");
+ Services.CreateType(type, "Streams.Stream", "");
- errormsg[NoHandlerDefined] := "no handler defined";
- errormsg[CannotRead] := "not opened for reading";
- errormsg[CannotSeek] := "not capable of seeking";
- errormsg[CloseFailed] := "close operation failed";
- errormsg[NotLineBuffered] := "stream is not line buffered";
- errormsg[SeekFailed] := "seek operation failed";
- errormsg[TellFailed] := "tell operation failed";
- errormsg[BadWhence] := "bad value of whence parameter";
- errormsg[CannotTell] := "not capable of telling current position";
- errormsg[WriteFailed] := "write operation failed";
- errormsg[CannotWrite] := "not opened for writing";
- errormsg[ReadFailed] := "read operation failed";
- errormsg[Unbuffered] := "operation is not valid for unbuffered streams";
- errormsg[BadParameters] := "bad parameter values";
- errormsg[CannotTrunc] := "not capable of truncating";
- errormsg[TruncFailed] := "trunc operation failed";
- errormsg[NestedCall] := "nested stream operation";
- errormsg[FlushFailed] := "flush operation failed";
+ errormsg[NoHandlerDefined] := "no handler defined";
+ errormsg[CannotRead] := "not opened for reading";
+ errormsg[CannotSeek] := "not capable of seeking";
+ errormsg[CloseFailed] := "close operation failed";
+ errormsg[NotLineBuffered] := "stream is not line buffered";
+ errormsg[SeekFailed] := "seek operation failed";
+ errormsg[TellFailed] := "tell operation failed";
+ errormsg[BadWhence] := "bad value of whence parameter";
+ errormsg[CannotTell] := "not capable of telling current position";
+ errormsg[WriteFailed] := "write operation failed";
+ errormsg[CannotWrite] := "not opened for writing";
+ errormsg[ReadFailed] := "read operation failed";
+ errormsg[Unbuffered] := "operation is not valid for unbuffered streams";
+ errormsg[BadParameters] := "bad parameter values";
+ errormsg[CannotTrunc] := "not capable of truncating";
+ errormsg[TruncFailed] := "trunc operation failed";
+ errormsg[NestedCall] := "nested stream operation";
+ errormsg[FlushFailed] := "flush operation failed";
- Events.Define(error); Events.SetPriority(error, Priorities.liberrors);
- Events.Ignore(error);
+ Events.Define(error); Events.SetPriority(error, Priorities.liberrors);
+ Events.Ignore(error);
- opened := NIL;
- InitNullIf(nullif);
- OpenNulldev(null); stdin := null; stdout := null; stderr := null;
+ opened := NIL;
+ InitNullIf(nullif);
+ OpenNulldev(null); stdin := null; stdout := null; stderr := null;
- Events.Handler(Process.termination, ExitHandler);
- Events.Handler(Process.startOfGarbageCollection, FreeHandler);
+ Events.Handler(Process.termination, ExitHandler);
+ Events.Handler(Process.startOfGarbageCollection, FreeHandler);
END ulmStreams.
diff --git a/src/library/ulm/ulmSysIO.Mod b/src/library/ulm/ulmSysIO.Mod
index a961f64d..2a22d29f 100644
--- a/src/library/ulm/ulmSysIO.Mod
+++ b/src/library/ulm/ulmSysIO.Mod
@@ -30,7 +30,10 @@
MODULE ulmSysIO;
- IMPORT RelatedEvents := ulmRelatedEvents, Sys := ulmSys, SYS := SYSTEM, ulmSYSTEM, SysErrors := ulmSysErrors, SysTypes := ulmSysTypes;
+ IMPORT RelatedEvents := ulmRelatedEvents,
+ Sys := ulmSys, SYS := SYSTEM, ulmSYSTEM,
+ SysErrors := ulmSysErrors, SysTypes := ulmSysTypes,
+ Platform;
CONST
(* file control options: arguments of Fcntl and Open *)
@@ -86,20 +89,20 @@ MODULE ulmSysIO;
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
(* the filename must be 0X-terminated *)
VAR
- d0, d1: (*INTEGER*)LONGINT;
+ error: Platform.ErrorCode;
BEGIN
interrupted := FALSE;
LOOP
- IF ulmSYSTEM.UNIXCALL(Sys.open, d0, d1,
- SYS.ADR(filename), SYS.VAL(LONGINT, options), protection) THEN
- fd := d0;
- RETURN TRUE
+ IF options * creat # {} THEN error := Platform.New(filename, fd)
+ ELSIF options * (rdwr+wronly) # {} THEN error := Platform.OldRW(filename, fd)
+ ELSE error := Platform.OldRO(filename, fd) END;
+ IF error = 0 THEN RETURN TRUE
ELSE
- IF d0 = SysErrors.intr THEN
+ IF Platform.Interrupted(error) THEN
interrupted := TRUE;
END;
- IF (d0 # SysErrors.intr) OR ~retry THEN
- SysErrors.Raise(errors, d0, Sys.open, filename);
+ IF ~Platform.Interrupted(error) OR ~retry THEN
+ SysErrors.Raise(errors, error, Sys.open, filename);
RETURN FALSE
END;
END;
@@ -119,21 +122,18 @@ MODULE ulmSysIO;
errors: RelatedEvents.Object;
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
VAR
- d0, d1: LONGINT;
- a0, a1 : LONGINT; (* just to match UNIXCALL interface *)
+ error: Platform.ErrorCode;
BEGIN
interrupted := FALSE;
- a0 := 0; a1 := 0; (* Initialised to disable compiler warning. *)
LOOP
- IF ulmSYSTEM.UNIXCALL(Sys.close, d0, d1, fd, a0, a1) THEN
- (*IF ulmSYSTEM.UNIXCALL(Sys.close, d0, d1, fd) THEN*)
- RETURN TRUE
+ error := Platform.Close(fd);
+ IF error = 0 THEN RETURN TRUE
ELSE
- IF d0 = SysErrors.intr THEN
+ IF Platform.Interrupted(error) THEN
interrupted := TRUE;
END;
- IF (d0 # SysErrors.intr) OR ~retry THEN
- SysErrors.Raise(errors, d0, Sys.close, "");
+ IF ~Platform.Interrupted(error) OR ~retry THEN
+ SysErrors.Raise(errors, error, Sys.close, "");
RETURN FALSE
END;
END;
@@ -148,18 +148,19 @@ MODULE ulmSysIO;
>0: number of bytes read
*)
VAR
- d0, d1: LONGINT;
+ error: Platform.ErrorCode;
+ bytesread: Count;
BEGIN
interrupted := FALSE;
LOOP
- IF ulmSYSTEM.UNIXCALL(Sys.read, d0, d1, fd, buf, cnt) THEN
- RETURN d0
+ error := Platform.Read(fd, buf, cnt, bytesread);
+ IF error = 0 THEN RETURN bytesread
ELSE
- IF d0 = SysErrors.intr THEN
+ IF Platform.Interrupted(error) THEN
interrupted := TRUE;
END;
- IF (d0 # SysErrors.intr) OR ~retry THEN
- SysErrors.Raise(errors, d0, Sys.read, "");
+ IF ~Platform.Interrupted(error) OR ~retry THEN
+ SysErrors.Raise(errors, error, Sys.read, "");
RETURN -1
END;
END;
@@ -173,18 +174,19 @@ MODULE ulmSysIO;
>=0: number of bytes written
*)
VAR
- d0, d1: LONGINT;
+ error: Platform.ErrorCode;
+ byteswritten: Count;
BEGIN
interrupted := FALSE;
LOOP
- IF ulmSYSTEM.UNIXCALL(Sys.write, d0, d1, fd, buf, cnt) THEN
- RETURN d0
+ error := Platform.Write(fd, buf, cnt);
+ IF error = 0 THEN RETURN cnt (* todo: Upfate Platform.Write to return actual length written. *)
ELSE
- IF d0 = SysErrors.intr THEN
+ IF Platform.Interrupted(error) THEN
interrupted := TRUE;
END;
- IF (d0 # SysErrors.intr) OR ~retry THEN
- SysErrors.Raise(errors, d0, Sys.write, "");
+ IF ~Platform.Interrupted(error) OR ~retry THEN
+ SysErrors.Raise(errors, error, Sys.write, "");
RETURN -1
END;
END;
@@ -194,16 +196,23 @@ MODULE ulmSysIO;
PROCEDURE Seek*(fd: File; offset: Count; whence: Whence;
errors: RelatedEvents.Object) : BOOLEAN;
VAR
- d0, d1: LONGINT;
+ error: Platform.ErrorCode; relativity: INTEGER;
BEGIN
- IF ulmSYSTEM.UNIXCALL(Sys.lseek, d0, d1, fd, offset, whence) THEN
- RETURN TRUE
+ CASE whence OF
+ |fromPos: relativity := Platform.SeekCur
+ |fromEnd: relativity := Platform.SeekEnd
+ ELSE relativity := Platform.SeekSet
+ END;
+ error := Platform.Seek(fd, offset, relativity);
+ IF error = 0 THEN RETURN TRUE
ELSE
- SysErrors.Raise(errors, d0, Sys.lseek, "");
+ SysErrors.Raise(errors, error, Sys.lseek, "");
RETURN FALSE
END;
END Seek;
+(*
+
PROCEDURE Tell*(fd: File; VAR offset: Count;
errors: RelatedEvents.Object) : BOOLEAN;
VAR
@@ -229,7 +238,6 @@ MODULE ulmSysIO;
(* following system call fails for non-tty's *)
RETURN ulmSYSTEM.UNIXCALL(Sys.ioctl, d0, d1, fd, tcgeta, SYS.ADR(buf))
END Isatty;
-
PROCEDURE Fcntl*(fd: File; request: INTEGER; VAR arg: LONGINT;
errors: RelatedEvents.Object;
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
@@ -343,5 +351,6 @@ MODULE ulmSysIO;
RETURN FALSE
END;
END Pipe;
+*)
END ulmSysIO.
diff --git a/src/library/ulm/ulmSysTypes.Mod b/src/library/ulm/ulmSysTypes.Mod
index 174140e7..6d16ab4b 100644
--- a/src/library/ulm/ulmSysTypes.Mod
+++ b/src/library/ulm/ulmSysTypes.Mod
@@ -30,7 +30,7 @@
MODULE ulmSysTypes;
- IMPORT Types := ulmTypes;
+ IMPORT Types := ulmTypes, Platform;
TYPE
Address* = Types.Address;
@@ -39,17 +39,17 @@ MODULE ulmSysTypes;
Size* = Types.Size;
Byte* = Types.Byte;
- File* = (*INTEGER*)LONGINT; (* in ulm's system both INTEGER and LONGINT are 4 bytes long *)
+ File* = Platform.FileHandle;
Offset* = LONGINT;
Device* = LONGINT;
- Inode* = LONGINT;
- Time* = LONGINT;
+ Inode* = LONGINT;
+ Time* = LONGINT;
- Word* = INTEGER; (* must have the size of C's int-type *)
+ Word* = INTEGER; (* must have the size of C's int-type *)
(* Note: linux supports wait4 but not waitid, i.e. these
* constants aren't needed. *)
- (*
+ (*
CONST
(* possible values of the idtype parameter (4 bytes),
see
diff --git a/src/library/ulm/ulmTCrypt.Mod b/src/library/ulm/ulmTCrypt.Mod
index 4003eaf0..c35c7809 100644
--- a/src/library/ulm/ulmTCrypt.Mod
+++ b/src/library/ulm/ulmTCrypt.Mod
@@ -1,1764 +1,1770 @@
(* Ulm's Oberon Library
- Copyright (C) 1989-1997 by University of Ulm, SAI, D-89069 Ulm, Germany
- ----------------------------------------------------------------------------
- Ulm's Oberon Library is free software; you can redistribute it
- and/or modify it under the terms of the GNU Library General Public
- License as published by the Free Software Foundation; either version
- 2 of the License, or (at your option) any later version.
+ Copyright (C) 1989-1997 by University of Ulm, SAI, D-89069 Ulm, Germany
+ ----------------------------------------------------------------------------
+ Ulm's Oberon Library is free software; you can redistribute it
+ and/or modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either version
+ 2 of the License, or (at your option) any later version.
- Ulm's Oberon Library is distributed in the hope that it will be
- useful, but WITHOUT ANY WARRANTY; without even the implied warranty
- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Library General Public License for more details.
+ Ulm's Oberon Library is distributed in the hope that it will be
+ useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+ of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
- You should have received a copy of the GNU Library General Public
- License along with this library; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ----------------------------------------------------------------------------
- E-mail contact: oberon@mathematik.uni-ulm.de
- ----------------------------------------------------------------------------
- $Id: TCrypt.om,v 1.1 1997/04/02 11:54:02 borchert Exp borchert $
- ----------------------------------------------------------------------------
- $Log: TCrypt.om,v $
- Revision 1.1 1997/04/02 11:54:02 borchert
- Initial revision
+ You should have received a copy of the GNU Library General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ----------------------------------------------------------------------------
+ E-mail contact: oberon@mathematik.uni-ulm.de
+ ----------------------------------------------------------------------------
+ $Id: TCrypt.om,v 1.1 1997/04/02 11:54:02 borchert Exp borchert $
+ ----------------------------------------------------------------------------
+ $Log: TCrypt.om,v $
+ Revision 1.1 1997/04/02 11:54:02 borchert
+ Initial revision
- ----------------------------------------------------------------------------
+ ----------------------------------------------------------------------------
*)
MODULE ulmTCrypt; (* Michael Szczuka *)
- (* Trautner's association method for key exchange *)
+ (* Trautner's association method for key exchange *)
- IMPORT AsymmetricCiphers := ulmAsymmetricCiphers, BlockCiphers := ulmBlockCiphers, Ciphers := ulmCiphers, Conclusions := ulmConclusions, Events := ulmEvents,
- NetIO := ulmNetIO, PersistentObjects := ulmPersistentObjects, Random := ulmRandomGenerators, RelatedEvents := ulmRelatedEvents,
- Services := ulmServices, Streams := ulmStreams, SYS := SYSTEM;
+ IMPORT
+ AsymmetricCiphers := ulmAsymmetricCiphers, BlockCiphers := ulmBlockCiphers,
+ Ciphers := ulmCiphers, Conclusions := ulmConclusions,
+ Events := ulmEvents, NetIO := ulmNetIO,
+ PersistentObjects := ulmPersistentObjects, Random := ulmRandomGenerators,
+ RelatedEvents := ulmRelatedEvents, Services := ulmServices,
+ Streams := ulmStreams, SYS := SYSTEM;
- CONST
- M = 16; (* size of an element of CC(M) [ring of Circular Convolution] *)
- MaxVar = 8; (* number of variables of a polynomial *)
- MaxNrExp = 4; (* maxiumum number of different exponts used during
- initialisaton *)
- Dim = 2; (* dimension of the linear recursion *)
- Rounds = 16; (* length of the linear recursion in rounds *)
- LastRounds = 4; (* use the last LastRounds polynomial vectors as
- the composed function eta *)
- reg = 1; sing = 2; random = 3;
- LIST = TRUE; NOLIST = FALSE;
- MaxTerms = 1000;
+ CONST
+ M = 16; (* size of an element of CC(M) [ring of Circular Convolution] *)
+ MaxVar = 8; (* number of variables of a polynomial *)
+ MaxNrExp = 4; (* maxiumum number of different exponts used during
+ initialisaton *)
+ Dim = 2; (* dimension of the linear recursion *)
+ Rounds = 16; (* length of the linear recursion in rounds *)
+ LastRounds = 4; (* use the last LastRounds polynomial vectors as
+ the composed function eta *)
+ reg = 1; sing = 2; random = 3;
+ LIST = TRUE; NOLIST = FALSE;
+ MaxTerms = 1000;
- CONST
- writeSetFailed = 0;
- readSetFailed = 1;
- notRegular = 2;
- errorcodes = 3;
+ CONST
+ writeSetFailed = 0;
+ readSetFailed = 1;
+ notRegular = 2;
+ errorcodes = 3;
- TYPE
- (* an element out of CC(M) *)
- CCMElement = SET;
- Exponent = ARRAY MaxVar OF SHORTINT;
+ TYPE
+ (* an element out of CC(M) *)
+ CCMElement = SET;
+ Exponent = ARRAY MaxVar OF SHORTINT;
- TYPE
- (* a polynomial with coefficients out of CC(M) *)
- Polynom = POINTER TO PolynomRec;
- PolynomRec = RECORD
- koeff : CCMElement;
- exp : Exponent;
- next : Polynom;
+ TYPE
+ (* a polynomial with coefficients out of CC(M) *)
+ Polynom = POINTER TO PolynomRec;
+ PolynomRec = RECORD
+ koeff : CCMElement;
+ exp : Exponent;
+ next : Polynom;
+ END;
+
+ TYPE
+ VektorCCM = ARRAY Dim OF CCMElement;
+ VektorPolynom = ARRAY Dim OF Polynom;
+ MatCCM = ARRAY Dim, Dim OF CCMElement;
+ MatPolynom = ARRAY Dim, Dim OF Polynom;
+ ListCCM = ARRAY Rounds OF CCMElement;
+ ListPolynom = ARRAY Rounds OF Polynom;
+ ChainCCM = ARRAY Rounds OF VektorCCM;
+ ChainPolynom = ARRAY Rounds OF VektorPolynom;
+ (* to increase the performance of the algorithm there shouldn't be too
+ many different exponents to start with *)
+ ListExp = ARRAY MaxNrExp OF Exponent;
+
+ TYPE
+ (* this type is the input of the TCrypt method *)
+ TCryptInput = POINTER TO TCryptInputRec;
+ TCryptInputRec = RECORD
+ arg : ARRAY MaxVar OF CCMElement;
+ END;
+
+ TYPE
+ (* result type after encryption with the public key *)
+ TCryptTmp = POINTER TO TCryptTmpRec;
+ TCryptTmpRec = RECORD
+ numerator : ChainCCM;
+ denominator : ListCCM;
+ END;
+
+ TYPE
+ (* result type of the algorithm *)
+ TCryptRes = POINTER TO TCryptResRec;
+ TCryptResRec = RECORD
+ arg : ARRAY LastRounds OF VektorCCM;
+ END;
+
+ TYPE
+ (* this type represents the public function f resp. phi *)
+ Phi = POINTER TO PhiRec;
+ PhiRec = RECORD
+ num : ChainPolynom;
+ denom : ListPolynom;
+ END;
+
+ TYPE
+ (* the private/secret function g resp. psi consisting of an inital matrix
+ and a permutation *)
+ Psi = POINTER TO PsiRec;
+ PsiRec = RECORD
+ (* although the inital matrix consists only of elements out of CC(M)
+ this generalization is useful since all other matrces consist of
+ polynomials *)
+ initialmatrix : MatCCM;
+ (* correcting factors *)
+ korrNum : ChainCCM;
+ korrDenom : ListCCM;
+ END;
+
+ (* the public function h resp. eta being the composition of f/phi
+ and g/psi *)
+ TYPE
+ Eta = POINTER TO EtaRec;
+ EtaRec = RECORD
+ p : ARRAY LastRounds OF VektorPolynom;
+ END;
+
+ TYPE
+ (* the declaration of a basic type which PublicCipher and PrivateCipher
+ are descendents from seems a good idea ... at least to me :) *)
+ Cipher* = POINTER TO CipherRec;
+ CipherRec* = RECORD (AsymmetricCiphers.CipherRec) END;
+ (* the specific format of a public key for Trautner's technique *)
+ PublicCipher = POINTER TO PublicCipherRec;
+ PublicCipherRec = RECORD
+ (CipherRec)
+ phi : Phi;
+ eta : Eta;
+ END;
+ (* the specific format of a key for Trautner's technique *)
+ PrivateCipher = POINTER TO PrivateCipherRec;
+ PrivateCipherRec = RECORD
+ (CipherRec)
+ phi : Phi;
+ psi : Psi;
+ eta : Eta;
+ END;
+
+ TYPE
+ ErrorEvent = POINTER TO ErrorEventRec;
+ ErrorEventRec = RECORD
+ (Events.EventRec)
+ errorcode : SHORTINT;
+ END;
+
+ VAR
+ pubType, privType, cipherType : Services.Type;
+ pubIf, privIf, cipherIf : PersistentObjects.Interface;
+ NullCCM, EinsCCM : CCMElement; (* the zero and unit of CC(M) *)
+ NullExp : Exponent; (* consists of zero exponents *)
+ NullExpList : ListExp; (* a pseudo list for CreatePolynom *)
+ GlobalExpList : ListExp; (* contains the exponents which should be used
+ when calling CreatePolynom *)
+ NullPolynom : Polynom; (* the zero polynomial *)
+ PolFeld : ARRAY MaxTerms OF Polynom; (* used for sorting purposes *)
+ PreEvalArg : ARRAY M OF TCryptInput; (* precomputed values to speed
+ up evaluation of a polynomial *)
+ k : SHORTINT; (* simple counter during initialisation *)
+ error : Events.EventType;
+ errormsg : ARRAY errorcodes OF Events.Message;
+
+
+ (* ***** error handling ***** *)
+
+ PROCEDURE InitErrorHandling;
+ BEGIN
+ Events.Define(error);
+ errormsg[writeSetFailed] := "couldn't write set";
+ errormsg[readSetFailed] := "couldn't read set";
+ errormsg[notRegular] := "element isn't regular";
+ END InitErrorHandling;
+
+ PROCEDURE Error(s: Streams.Stream; errorcode: SHORTINT);
+ VAR
+ event: ErrorEvent;
+ BEGIN
+ NEW(event);
+ event.message := errormsg[errorcode];
+ event.type := error;
+ event.errorcode := errorcode;
+ RelatedEvents.Raise(s, event);
+ END Error;
+
+ (* ***** arithmetic functions for elements out of CC(M) ***** *)
+
+ PROCEDURE RegulaerCCM (x: CCMElement) : BOOLEAN;
+ (* tests x for regularity [a regular CCMElement contains an odd number of
+ set bits]; returns TRUE when x is regular, FALSE otherwise *)
+ VAR
+ res, i : SHORTINT;
+ BEGIN
+ i := 0;
+ res := 0;
+ REPEAT (* counting the set bits *)
+ IF i IN x THEN
+ INC(res);
END;
+ INC(i);
+ UNTIL i>=M;
+ RETURN ((res MOD 2) = 1);
+ END RegulaerCCM;
- TYPE
- VektorCCM = ARRAY Dim OF CCMElement;
- VektorPolynom = ARRAY Dim OF Polynom;
- MatCCM = ARRAY Dim, Dim OF CCMElement;
- MatPolynom = ARRAY Dim, Dim OF Polynom;
- ListCCM = ARRAY Rounds OF CCMElement;
- ListPolynom = ARRAY Rounds OF Polynom;
- ChainCCM = ARRAY Rounds OF VektorCCM;
- ChainPolynom = ARRAY Rounds OF VektorPolynom;
- (* to increase the performance of the algorithm there shouldn't be too
- many different exponents to start with *)
- ListExp = ARRAY MaxNrExp OF Exponent;
-
- TYPE
- (* this type is the input of the TCrypt method *)
- TCryptInput = POINTER TO TCryptInputRec;
- TCryptInputRec = RECORD
- arg : ARRAY MaxVar OF CCMElement;
+ PROCEDURE EqualCCM (x, y: CCMElement) : BOOLEAN;
+ (* compares x and y for equality; if x and y are equal TRUE is returned,
+ FALSE otherwise *)
+ VAR
+ i : SHORTINT;
+ BEGIN
+ i := 0;
+ WHILE i < M DO
+ IF ((i IN x) & (~(i IN y))) OR ((~(i IN x)) & (i IN y)) THEN
+ RETURN FALSE;
END;
+ INC(i);
+ END;
+ RETURN TRUE;
+ END EqualCCM;
- TYPE
- (* result type after encryption with the public key *)
- TCryptTmp = POINTER TO TCryptTmpRec;
- TCryptTmpRec = RECORD
- numerator : ChainCCM;
- denominator : ListCCM;
+ PROCEDURE AddCCM (x, y: CCMElement; VAR z: CCMElement);
+ (* add x and y in CC(M) *)
+ VAR
+ i : SHORTINT;
+ BEGIN
+ z := NullCCM;
+ i := 0;
+ REPEAT
+ IF ((i IN x) & (~(i IN y))) OR ((~(i IN x)) & (i IN y)) THEN
+ z := z + {i};
END;
+ INC(i);
+ UNTIL i>=M;
+ END AddCCM;
- TYPE
- (* result type of the algorithm *)
- TCryptRes = POINTER TO TCryptResRec;
- TCryptResRec = RECORD
- arg : ARRAY LastRounds OF VektorCCM;
- END;
-
- TYPE
- (* this type represents the public function f resp. phi *)
- Phi = POINTER TO PhiRec;
- PhiRec = RECORD
- num : ChainPolynom;
- denom : ListPolynom;
- END;
-
- TYPE
- (* the private/secret function g resp. psi consisting of an inital matrix
- and a permutation *)
- Psi = POINTER TO PsiRec;
- PsiRec = RECORD
- (* although the inital matrix consists only of elements out of CC(M)
- this generalization is useful since all other matrces consist of
- polynomials *)
- initialmatrix : MatCCM;
- (* correcting factors *)
- korrNum : ChainCCM;
- korrDenom : ListCCM;
- END;
-
- (* the public function h resp. eta being the composition of f/phi
- and g/psi *)
- TYPE
- Eta = POINTER TO EtaRec;
- EtaRec = RECORD
- p : ARRAY LastRounds OF VektorPolynom;
- END;
-
- TYPE
- (* the declaration of a basic type which PublicCipher and PrivateCipher
- are descendents from seems a good idea ... at least to me :) *)
- Cipher* = POINTER TO CipherRec;
- CipherRec* = RECORD (AsymmetricCiphers.CipherRec) END;
- (* the specific format of a public key for Trautner's technique *)
- PublicCipher = POINTER TO PublicCipherRec;
- PublicCipherRec = RECORD
- (CipherRec)
- phi : Phi;
- eta : Eta;
- END;
- (* the specific format of a key for Trautner's technique *)
- PrivateCipher = POINTER TO PrivateCipherRec;
- PrivateCipherRec = RECORD
- (CipherRec)
- phi : Phi;
- psi : Psi;
- eta : Eta;
- END;
-
- TYPE
- ErrorEvent = POINTER TO ErrorEventRec;
- ErrorEventRec = RECORD
- (Events.EventRec)
- errorcode : SHORTINT;
- END;
-
- VAR
- pubType, privType, cipherType : Services.Type;
- pubIf, privIf, cipherIf : PersistentObjects.Interface;
- NullCCM, EinsCCM : CCMElement; (* the zero and unit of CC(M) *)
- NullExp : Exponent; (* consists of zero exponents *)
- NullExpList : ListExp; (* a pseudo list for CreatePolynom *)
- GlobalExpList : ListExp; (* contains the exponents which should be used
- when calling CreatePolynom *)
- NullPolynom : Polynom; (* the zero polynomial *)
- PolFeld : ARRAY MaxTerms OF Polynom; (* used for sorting purposes *)
- PreEvalArg : ARRAY M OF TCryptInput; (* precomputed values to speed
- up evaluation of a polynomial *)
- k : SHORTINT; (* simple counter during initialisation *)
- error : Events.EventType;
- errormsg : ARRAY errorcodes OF Events.Message;
-
-
- (* ***** error handling ***** *)
-
- PROCEDURE InitErrorHandling;
- BEGIN
- Events.Define(error);
- errormsg[writeSetFailed] := "couldn't write set";
- errormsg[readSetFailed] := "couldn't read set";
- errormsg[notRegular] := "element isn't regular";
- END InitErrorHandling;
-
- PROCEDURE Error(s: Streams.Stream; errorcode: SHORTINT);
- VAR
- event: ErrorEvent;
- BEGIN
- NEW(event);
- event.message := errormsg[errorcode];
- event.type := error;
- event.errorcode := errorcode;
- RelatedEvents.Raise(s, event);
- END Error;
-
- (* ***** arithmetic functions for elements out of CC(M) ***** *)
-
- PROCEDURE RegulaerCCM (x: CCMElement) : BOOLEAN;
- (* tests x for regularity [a regular CCMElement contains an odd number of
- set bits]; returns TRUE when x is regular, FALSE otherwise *)
- VAR
- res, i : SHORTINT;
- BEGIN
- i := 0;
- res := 0;
- REPEAT (* counting the set bits *)
- IF i IN x THEN
- INC(res);
- END;
- INC(i);
- UNTIL i>=M;
- RETURN ((res MOD 2) = 1);
- END RegulaerCCM;
-
- PROCEDURE EqualCCM (x, y: CCMElement) : BOOLEAN;
- (* compares x and y for equality; if x and y are equal TRUE is returned,
- FALSE otherwise *)
- VAR
- i : SHORTINT;
- BEGIN
- i := 0;
- WHILE i < M DO
- IF ((i IN x) & (~(i IN y))) OR ((~(i IN x)) & (i IN y)) THEN
- RETURN FALSE;
- END;
- INC(i);
- END;
- RETURN TRUE;
- END EqualCCM;
-
- PROCEDURE AddCCM (x, y: CCMElement; VAR z: CCMElement);
- (* add x and y in CC(M) *)
- VAR
- i : SHORTINT;
- BEGIN
- z := NullCCM;
- i := 0;
+ PROCEDURE MulCCM (x, y: CCMElement; VAR z: CCMElement);
+ (* multiply x and y in CC(M) *)
+ VAR
+ i, j, diff : SHORTINT;
+ tmp : INTEGER;
+ BEGIN
+ z := NullCCM;
+ i := 0;
+ REPEAT
+ j := 0;
+ tmp := 0;
REPEAT
- IF ((i IN x) & (~(i IN y))) OR ((~(i IN x)) & (i IN y)) THEN
- z := z + {i};
- END;
- INC(i);
- UNTIL i>=M;
- END AddCCM;
-
- PROCEDURE MulCCM (x, y: CCMElement; VAR z: CCMElement);
- (* multiply x and y in CC(M) *)
- VAR
- i, j, diff : SHORTINT;
- tmp : INTEGER;
- BEGIN
- z := NullCCM;
- i := 0;
- REPEAT
- j := 0;
- tmp := 0;
- REPEAT
- diff := i-j;
- IF diff >= 0 THEN
- IF (j IN x) & (diff IN y) THEN
- INC(tmp);
- END;
- ELSE
- IF (j IN x) & ((M+diff) IN y) THEN
- INC(tmp);
- END;
- END;
- INC(j);
- UNTIL j>=M;
- IF (tmp MOD 2) = 1 THEN
- z := z + {i};
- END;
- INC(i);
- UNTIL i>=M;
- END MulCCM;
-
- PROCEDURE PowerCCM (x: CCMElement; exp: INTEGER; VAR z: CCMElement);
- (* raises x to the power exp in CC(M) *)
- VAR
- tmp : CCMElement;
- BEGIN
- (* some special cases first *)
- IF exp >= M THEN
- IF ~RegulaerCCM(x) THEN
- (* x is singular -> result is zero *)
- z := NullCCM;
- RETURN;
- END;
- (* x is regular -> compute the modulus of exp mod M and use this
- instead of exp *)
- exp := exp MOD M;
- END;
- IF exp = 0 THEN
- z := EinsCCM;
- RETURN;
- END;
- IF exp = 1 THEN
- z := x;
- RETURN;
+ diff := i-j;
+ IF diff >= 0 THEN
+ IF (j IN x) & (diff IN y) THEN
+ INC(tmp);
+ END;
+ ELSE
+ IF (j IN x) & ((M+diff) IN y) THEN
+ INC(tmp);
+ END;
+ END;
+ INC(j);
+ UNTIL j>=M;
+ IF (tmp MOD 2) = 1 THEN
+ z := z + {i};
END;
+ INC(i);
+ UNTIL i>=M;
+ END MulCCM;
- (* default case; use a "square and multiply" technique *)
- tmp := x;
+ PROCEDURE PowerCCM (x: CCMElement; exp: INTEGER; VAR z: CCMElement);
+ (* raises x to the power exp in CC(M) *)
+ VAR
+ tmp : CCMElement;
+ BEGIN
+ (* some special cases first *)
+ IF exp >= M THEN
+ IF ~RegulaerCCM(x) THEN
+ (* x is singular -> result is zero *)
+ z := NullCCM;
+ RETURN;
+ END;
+ (* x is regular -> compute the modulus of exp mod M and use this
+ instead of exp *)
+ exp := exp MOD M;
+ END;
+ IF exp = 0 THEN
z := EinsCCM;
- REPEAT
- IF exp MOD 2 = 1 THEN
- MulCCM(z, tmp, z);
- END;
- exp := exp DIV 2;
- MulCCM(tmp, tmp, tmp);
- UNTIL exp < 1;
- END PowerCCM;
+ RETURN;
+ END;
+ IF exp = 1 THEN
+ z := x;
+ RETURN;
+ END;
- PROCEDURE CreateCCM (VAR x: CCMElement; mode: SHORTINT);
- (* creates a random element out of CC(M) depending on mode which
- can be reg, sing or random;
- the result is in any case different from the zero *)
+ (* default case; use a "square and multiply" technique *)
+ tmp := x;
+ z := EinsCCM;
+ REPEAT
+ IF exp MOD 2 = 1 THEN
+ MulCCM(z, tmp, z);
+ END;
+ exp := exp DIV 2;
+ MulCCM(tmp, tmp, tmp);
+ UNTIL exp < 1;
+ END PowerCCM;
+
+ PROCEDURE CreateCCM (VAR x: CCMElement; mode: SHORTINT);
+ (* creates a random element out of CC(M) depending on mode which
+ can be reg, sing or random;
+ the result is in any case different from the zero *)
+ VAR
+ i, SetBits: SHORTINT;
+ BEGIN
+ x := NullCCM;
+ REPEAT
+ i := 0;
+ SetBits := 0;
+ REPEAT
+ IF Random.Flip() THEN
+ (* set bit *)
+ x := x + {i};
+ INC(SetBits);
+ END;
+ INC(i);
+ UNTIL i >= (M-1);
+ UNTIL SetBits > 0; (* at least one bit must be set so that the result
+ differs from zero *)
+
+ CASE mode OF
+ random:
+ IF Random.Flip() THEN
+ x := x + {M-1};
+ END;
+ | sing: (* singular element - even # of bits *)
+ IF (SetBits MOD 2) = 1 THEN
+ x := x + {M-1};
+ END;
+ | reg: (* regular element - odd # of bits *)
+ IF ((SetBits + 1) MOD 2) = 1 THEN
+ x := x + {M-1};
+ END;
+ ELSE
+ END;
+ END CreateCCM;
+
+ (* ***** arithmetic functions for polynomials over CC(M) ***** *)
+
+ PROCEDURE LengthPolynom(p: Polynom) : INTEGER;
+ (* returns the number of terms which make up the polynomial p *)
+ VAR
+ i : INTEGER;
+ BEGIN
+ i := 0;
+ WHILE p # NIL DO
+ INC(i);
+ p := p.next;
+ END;
+ RETURN i;
+ END LengthPolynom;
+
+ PROCEDURE RegulaerPolynom (p: Polynom) : BOOLEAN;
+ (* tests the regularity of a polynomial [a polynomial is regular
+ iff the # of regular coefficients is odd] *)
+ VAR
+ regkoeffs : SHORTINT;
+ BEGIN
+ regkoeffs := 0;
+ WHILE p # NIL DO
+ IF RegulaerCCM(p.koeff) THEN
+ (* count # of reg. coefficients *)
+ INC(regkoeffs);
+ END;
+ p := p.next;
+ END;
+ RETURN (regkoeffs MOD 2) = 1;
+ END RegulaerPolynom;
+
+ PROCEDURE CmpExp (exp1, exp2: Exponent) : SHORTINT;
+ (* compares two exponent vectors and returns 0 on equality, a
+ positive value if exp1>exp2 and a negative value if exp1 e2 THEN
+ cmp := 1; diff := TRUE;
+ END;
+ END;
+ INC(i);
+ UNTIL i >= MaxVar;
+
+ IF sum1 < sum2 THEN
+ RETURN -2;
+ END;
+ IF sum1 > sum2 THEN
+ RETURN 2;
+ END;
+
+ RETURN cmp
+ END CmpExp;
+
+ PROCEDURE ArrangePolynom (VAR p: Polynom);
+ (* arrange a polynomial according to the order given by CmpExp *)
+ VAR
+ r : Polynom;
+ cnt : INTEGER;
+
+ PROCEDURE SortPolynom(left, right: INTEGER);
+ (* sort the global field PolFeld with the quicksort algorithm *)
VAR
- i, SetBits: SHORTINT;
- BEGIN
- x := NullCCM;
- REPEAT
- i := 0;
- SetBits := 0;
- REPEAT
- IF Random.Flip() THEN
- (* set bit *)
- x := x + {i};
- INC(SetBits);
- END;
- INC(i);
- UNTIL i >= (M-1);
- UNTIL SetBits > 0; (* at least one bit must be set so that the result
- differs from zero *)
+ mid : INTEGER;
- CASE mode OF
- random:
- IF Random.Flip() THEN
- x := x + {M-1};
- END;
- | sing: (* singular element - even # of bits *)
- IF (SetBits MOD 2) = 1 THEN
- x := x + {M-1};
- END;
- | reg: (* regular element - odd # of bits *)
- IF ((SetBits + 1) MOD 2) = 1 THEN
- x := x + {M-1};
- END;
+ PROCEDURE Partition(l, r: INTEGER) : INTEGER;
+ VAR
+ koeff : CCMElement;
+ exp : Exponent;
+ cmp : Exponent;
+ i, j : INTEGER;
+ BEGIN
+ cmp := PolFeld[(l+r) DIV 2].exp;
+ i := l-1;
+ j := r+1;
+ LOOP
+ REPEAT
+ DEC(j);
+ UNTIL CmpExp(PolFeld[j].exp, cmp) >= 0;
+ REPEAT
+ INC(i);
+ UNTIL CmpExp(PolFeld[i].exp, cmp) <= 0;
+ IF i < j THEN
+ koeff := PolFeld[i].koeff;
+ exp := PolFeld[i].exp;
+ PolFeld[i].koeff := PolFeld[j].koeff;
+ PolFeld[i].exp := PolFeld[j].exp;
+ PolFeld[j].koeff := koeff;
+ PolFeld[j].exp := exp;
+ ELSE
+ RETURN j;
+ END;
+ END;
+ END Partition;
+
+ BEGIN
+ IF left < right THEN
+ mid := Partition(left, right);
+ SortPolynom(left, mid);
+ SortPolynom(mid+1, right);
+ END;
+ END SortPolynom;
+
+ BEGIN (* ArrangePolynom *)
+ IF p = NIL THEN
+ RETURN;
+ END;
+ r := p;
+ cnt := 0;
+ WHILE (p # NIL) & (cnt < MaxTerms) DO
+ PolFeld[cnt] := p;
+ INC(cnt);
+ p := p.next;
+ END;
+ (* polynomial contains too many terms; this shouldn't happen if all
+ parameters are set to reasonable values and MaxTerms is high
+ enough *)
+ ASSERT(cnt 1 THEN
+ SortPolynom(0, cnt-1);
+ END;
+ p := r;
+ END ArrangePolynom;
+
+ PROCEDURE CopyPolynom (s: Polynom; VAR t: Polynom);
+ (* copy the source polynomial s to a new target t *)
+ VAR
+ troot : Polynom;
+ BEGIN
+ IF s = NIL THEN
+ t := NIL;
+ RETURN;
+ END;
+ NEW(t);
+ troot := t; (* save the root of t *)
+ WHILE s # NIL DO
+ troot.koeff := s.koeff;
+ troot.exp := s.exp;
+ s := s.next;
+ IF s # NIL THEN
+ NEW(troot.next);
+ troot := troot.next;
ELSE
+ troot.next := NIL;
END;
- END CreateCCM;
+ END;
+ END CopyPolynom;
- (* ***** arithmetic functions for polynomials over CC(M) ***** *)
-
- PROCEDURE LengthPolynom(p: Polynom) : INTEGER;
- (* returns the number of terms which make up the polynomial p *)
- VAR
- i : INTEGER;
- BEGIN
- i := 0;
- WHILE p # NIL DO
- INC(i);
- p := p.next;
- END;
- RETURN i;
- END LengthPolynom;
-
- PROCEDURE RegulaerPolynom (p: Polynom) : BOOLEAN;
- (* tests the regularity of a polynomial [a polynomial is regular
- iff the # of regular coefficients is odd] *)
- VAR
- regkoeffs : SHORTINT;
- BEGIN
- regkoeffs := 0;
- WHILE p # NIL DO
- IF RegulaerCCM(p.koeff) THEN
- (* count # of reg. coefficients *)
- INC(regkoeffs);
- END;
- p := p.next;
- END;
- RETURN (regkoeffs MOD 2) = 1;
- END RegulaerPolynom;
-
- PROCEDURE CmpExp (exp1, exp2: Exponent) : SHORTINT;
- (* compares two exponent vectors and returns 0 on equality, a
- positive value if exp1>exp2 and a negative value if exp1 e2 THEN
- cmp := 1; diff := TRUE;
- END;
- END;
- INC(i);
- UNTIL i >= MaxVar;
-
- IF sum1 < sum2 THEN
- RETURN -2;
- END;
- IF sum1 > sum2 THEN
- RETURN 2;
- END;
-
- RETURN cmp
- END CmpExp;
-
- PROCEDURE ArrangePolynom (VAR p: Polynom);
- (* arrange a polynomial according to the order given by CmpExp *)
- VAR
- r : Polynom;
- cnt : INTEGER;
-
- PROCEDURE SortPolynom(left, right: INTEGER);
- (* sort the global field PolFeld with the quicksort algorithm *)
- VAR
- mid : INTEGER;
-
- PROCEDURE Partition(l, r: INTEGER) : INTEGER;
- VAR
- koeff : CCMElement;
- exp : Exponent;
- cmp : Exponent;
- i, j : INTEGER;
- BEGIN
- cmp := PolFeld[(l+r) DIV 2].exp;
- i := l-1;
- j := r+1;
- LOOP
- REPEAT
- DEC(j);
- UNTIL CmpExp(PolFeld[j].exp, cmp) >= 0;
- REPEAT
- INC(i);
- UNTIL CmpExp(PolFeld[i].exp, cmp) <= 0;
- IF i < j THEN
- koeff := PolFeld[i].koeff;
- exp := PolFeld[i].exp;
- PolFeld[i].koeff := PolFeld[j].koeff;
- PolFeld[i].exp := PolFeld[j].exp;
- PolFeld[j].koeff := koeff;
- PolFeld[j].exp := exp;
- ELSE
- RETURN j;
- END;
- END;
- END Partition;
-
- BEGIN
- IF left < right THEN
- mid := Partition(left, right);
- SortPolynom(left, mid);
- SortPolynom(mid+1, right);
- END;
- END SortPolynom;
-
- BEGIN (* ArrangePolynom *)
- IF p = NIL THEN
- RETURN;
- END;
- r := p;
- cnt := 0;
- WHILE (p # NIL) & (cnt < MaxTerms) DO
- PolFeld[cnt] := p;
- INC(cnt);
- p := p.next;
- END;
- (* polynomial contains too many terms; this shouldn't happen if all
- parameters are set to reasonable values and MaxTerms is high
- enough *)
- ASSERT(cnt 1 THEN
- SortPolynom(0, cnt-1);
- END;
- p := r;
- END ArrangePolynom;
-
- PROCEDURE CopyPolynom (s: Polynom; VAR t: Polynom);
- (* copy the source polynomial s to a new target t *)
- VAR
- troot : Polynom;
- BEGIN
- IF s = NIL THEN
- t := NIL;
- RETURN;
- END;
- NEW(t);
- troot := t; (* save the root of t *)
- WHILE s # NIL DO
- troot.koeff := s.koeff;
- troot.exp := s.exp;
- s := s.next;
- IF s # NIL THEN
- NEW(troot.next);
- troot := troot.next;
- ELSE
- troot.next := NIL;
- END;
- END;
- END CopyPolynom;
-
- PROCEDURE AddPolynom (p, q: Polynom; VAR r: Polynom);
- (* add two polynomial; the polynomials must be sorted by the exponents as
- is the result *)
- VAR
- term1, term2 : Polynom;
- last : Polynom; (* the last term of the result *)
- tmp : Polynom;
- cmpres : SHORTINT;
- BEGIN
- IF (p = NIL) & (q = NIL) THEN
- r := NIL;
- RETURN;
- END;
- NEW(r);
- term1 := p; (* term1 runs through all terms of p *)
- term2 := q; (* same with term2 for q *)
- tmp := r; (* save the root of r *)
- last := tmp;
- REPEAT
- IF (term1 = NIL) OR (term2 = NIL) THEN
- IF term2 = NIL THEN
- (* no further terms in q *)
- WHILE term1 # NIL DO
- (* copy the remaining terms of p *)
- tmp.koeff := term1.koeff;
- tmp.exp := term1.exp;
- term1 := term1.next;
- IF ~EqualCCM(tmp.koeff, NullCCM) THEN
- last := tmp;
- NEW(tmp.next);
- tmp := tmp.next;
- END;
- END;
- ELSE (* no further terms in p *)
- WHILE term2 # NIL DO
- tmp.koeff := term2.koeff;
- tmp.exp := term2.exp;
- term2 := term2.next;
- IF ~EqualCCM(tmp.koeff, NullCCM) THEN
- last := tmp;
- NEW(tmp.next);
- tmp := tmp.next;
- END;
- END;
- END;
- ELSE (* both p and q still have a term *)
- cmpres := CmpExp(term1.exp, term2.exp);
- IF cmpres = 0 THEN (* add when exponents are equal *)
- AddCCM(term1.koeff, term2.koeff, tmp.koeff);
- tmp.exp := term1.exp;
- term1 := term1.next;
- term2 := term2.next;
- ELSE
- IF cmpres < 0 THEN (* exp2 > exp1 *)
- tmp.koeff := term2.koeff;
- tmp.exp := term2.exp;
- term2 := term2.next;
- ELSE (* exp1 > exp2 *)
- tmp.koeff := term1.koeff;
- tmp.exp := term1.exp;
- term1 := term1.next;
- END;
- END;
- (* zero coefficients = zero terms shouldn't occur in the result *)
- IF ~EqualCCM(tmp.koeff, NullCCM) THEN
- NEW(tmp.next);
- last := tmp;
- tmp := tmp.next;
- END;
- END;
- UNTIL (term1 = NIL) & (term2 = NIL);
-
- (* forget last created term *)
- last.next := NIL;
- END AddPolynom;
-
- PROCEDURE MulTerm (p, term: Polynom; VAR r: Polynom);
- (* multiply a polynomial with a single term; is used by MulPolynom *)
- VAR
- tmp : Polynom;
- last : Polynom;
-
- (* add two exponent vetors; addition is modulo M *)
- PROCEDURE AddExp (exp1, exp2 : Exponent; VAR res: Exponent);
- VAR
- i : SHORTINT;
- BEGIN
- i := 0;
- WHILE i exp1 *)
+ tmp.koeff := term2.koeff;
+ tmp.exp := term2.exp;
+ term2 := term2.next;
+ ELSE (* exp1 > exp2 *)
+ tmp.koeff := term1.koeff;
+ tmp.exp := term1.exp;
+ term1 := term1.next;
+ END;
+ END;
+ (* zero coefficients = zero terms shouldn't occur in the result *)
+ IF ~EqualCCM(tmp.koeff, NullCCM) THEN
+ NEW(tmp.next);
+ last := tmp;
+ tmp := tmp.next;
+ END;
END;
- qterm := q;
- WHILE qterm # NIL DO
- MulTerm(p,qterm,tmp); (* multiply p with current term of q *)
- AddPolynom(tmp,r,r); (* add up results *)
- qterm := qterm.next;
- END;
- ArrangePolynom(r);
- END MulPolynom;
+ UNTIL (term1 = NIL) & (term2 = NIL);
- PROCEDURE MulPolynomWithCCM (p: Polynom; c: CCMElement; VAR r: Polynom);
- (* multiplies a polynomial with a single element out of CC(M) *)
- VAR
- tmp : Polynom;
- BEGIN
- IF p = NIL THEN
- r := NIL;
- RETURN;
- END;
- CopyPolynom(p, r);
- tmp := r;
- WHILE tmp # NIL DO
- MulCCM(tmp.koeff, c, tmp.koeff);
- tmp := tmp.next;
- END;
- END MulPolynomWithCCM;
+ (* forget last created term *)
+ last.next := NIL;
+ END AddPolynom;
- PROCEDURE InvertPolynom (p: Polynom; VAR res: Polynom);
- (* inverts a regular polynomial; if p is illegal (NIL) or singular the
- result is NIL *)
- VAR
- exp : SHORTINT;
- tmp : Polynom;
- BEGIN
- IF (p = NIL) OR ~RegulaerPolynom(p) THEN
- res := NIL;
- RETURN;
- END;
- CopyPolynom(p, tmp);
- CopyPolynom(NullPolynom, res);
- res.koeff := EinsCCM;
- (* works the same way as PowerCCM ["square-and-multiply"] *)
- exp := M - 1; (* inverse means "power M-1" *)
- WHILE exp > 0 DO
- IF (exp MOD 2) = 1 THEN
- MulPolynom(res, tmp, res);
- END;
- MulPolynom(tmp, tmp, tmp);
- exp := exp DIV 2;
- END;
- END InvertPolynom;
+ PROCEDURE MulTerm (p, term: Polynom; VAR r: Polynom);
+ (* multiply a polynomial with a single term; is used by MulPolynom *)
+ VAR
+ tmp : Polynom;
+ last : Polynom;
- PROCEDURE EvalPolynom (p: Polynom; VAR res: CCMElement);
- (* evaluate p; a precomputed list of all the powers of the argument can
- be found in the global variable PreEvalArg *)
+ (* add two exponent vetors; addition is modulo M *)
+ PROCEDURE AddExp (exp1, exp2 : Exponent; VAR res: Exponent);
VAR
- i : SHORTINT;
- pow, prod : CCMElement;
- BEGIN
- res := NullCCM;
- IF p = NIL THEN
- RETURN;
- END;
- WHILE p # NIL DO
- prod := PreEvalArg[p.exp[0]].arg[0];
- i := 1;
- REPEAT
- pow := PreEvalArg[p.exp[i]].arg[i];
- MulCCM(prod, pow, prod);
- INC(i);
- UNTIL i >= MaxVar;
- MulCCM(prod, p.koeff, prod);
- AddCCM(res, prod, res);
- p := p.next;
- END;
- END EvalPolynom;
-
- PROCEDURE CreateExp (VAR exp: Exponent);
- (* creates a random vector of exponents *)
- VAR
- i : SHORTINT;
- BEGIN
+ i : SHORTINT;
+ BEGIN
i := 0;
WHILE i 0 DO
+ IF (exp MOD 2) = 1 THEN
+ MulPolynom(res, tmp, res);
END;
+ MulPolynom(tmp, tmp, tmp);
+ exp := exp DIV 2;
+ END;
+ END InvertPolynom;
- NEW(p);
- proot := p; (* save root of p *)
- regkoeffs := 0; (* # of regular coeff. in p *)
- i := 0;
- WHILE i= MaxVar;
+ MulCCM(prod, p.koeff, prod);
+ AddCCM(res, prod, res);
+ p := p.next;
+ END;
+ END EvalPolynom;
- (* the last term must be created manually so that the result is
- regular/singular (depending on mode) *)
- IF i # terms THEN
- CreateCCM(p.koeff, random);
- IF RegulaerCCM(p.koeff) THEN
- INC(regkoeffs);
- END;
- NEW(p.next);
- p := p.next;
- END;
+ PROCEDURE CreateExp (VAR exp: Exponent);
+ (* creates a random vector of exponents *)
+ VAR
+ i : SHORTINT;
+ BEGIN
+ i := 0;
+ WHILE i 0 DO
+ IF (kk MOD 2) = 1 THEN
+ MulCCM(tmp, PreEvalArg[ii].arg[i], tmp);
+ END;
+ INC(ii,ii);
+ kk := kk DIV 2;
+ END;
+ PreEvalArg[k].arg[i] := tmp;
+ INC(k);
+ END;
+ INC(i);
+ END;
+ END PreComputeArgs;
- (* E(n), n=1,...,Rounds, und sigma := psi *)
- NEW(psi);
- dy := 0;
- WHILE dy < Dim DO
- dx := 0;
- WHILE dx < Dim DO
- psi.initialmatrix[dy][dx] := E[0][dy][dx].koeff;
- INC(dx);
- END;
- INC(dy);
- END;
- r := 0;
- WHILE r < Rounds DO
- d := 0;
- WHILE d < Dim DO
- psi.korrNum[r][d] := korrNum[r][d];
- INC(d);
- END;
- psi.korrDenom[r] := korrDenom[r];
- INC(r);
+ PROCEDURE EvaluatePhi (arg: TCryptInput; data: Phi) : TCryptTmp;
+ (* evaluate the public function phi (represented by data) with
+ argument arg *)
+ VAR
+ res : TCryptTmp;
+ r, d : SHORTINT;
+ BEGIN
+ NEW(res);
+ PreComputeArgs(arg);
+ r := 0;
+ WHILE r < Rounds DO
+ d := 0;
+ WHILE d < Dim DO
+ EvalPolynom(data.num[r][d], res.numerator[r][d]);
+ INC(d);
END;
+ EvalPolynom(data.denom[r], res.denominator[r]);
+ INC(r);
+ END;
+ RETURN res;
+ END EvaluatePhi;
- (* A(Rounds) := eta *)
- NEW(eta);
- r := 0;
- idx := Rounds - LastRounds;
- WHILE idx < Rounds DO
- d := 0;
- WHILE d < Dim DO
- CopyPolynom(A[idx][d], eta.p[r][d]);
- INC(d);
- END;
- INC(r);
- INC(idx);
- END;
- END CreateMaps;
-
- PROCEDURE PreComputeArgs(arg: TCryptInput);
- (* used for preevaluation of a polynomial argument *)
- VAR
- k, i, kk, ii : INTEGER;
- tmp : CCMElement;
- BEGIN
- i := 0;
- WHILE i < MaxVar DO
- PreEvalArg[1].arg[i] := arg.arg[i];
- INC(i);
- END;
- i := 0;
- WHILE i < MaxVar DO
- k := 2;
- tmp := arg.arg[i];
- WHILE k < M DO
- MulCCM(tmp, tmp, tmp);
- PreEvalArg[k].arg[i] := tmp;
- INC(k,k);
- END;
- k := 3;
- WHILE k < M DO
- kk := k;
- ii := 1;
- tmp := EinsCCM;
- WHILE kk > 0 DO
- IF (kk MOD 2) = 1 THEN
- MulCCM(tmp, PreEvalArg[ii].arg[i], tmp);
- END;
- INC(ii,ii);
- kk := kk DIV 2;
- END;
- PreEvalArg[k].arg[i] := tmp;
- INC(k);
- END;
- INC(i);
- END;
- END PreComputeArgs;
-
- PROCEDURE EvaluatePhi (arg: TCryptInput; data: Phi) : TCryptTmp;
- (* evaluate the public function phi (represented by data) with
- argument arg *)
- VAR
- res : TCryptTmp;
- r, d : SHORTINT;
- BEGIN
- NEW(res);
- PreComputeArgs(arg);
- r := 0;
- WHILE r < Rounds DO
- d := 0;
- WHILE d < Dim DO
- EvalPolynom(data.num[r][d], res.numerator[r][d]);
- INC(d);
- END;
- EvalPolynom(data.denom[r], res.denominator[r]);
- INC(r);
- END;
- RETURN res;
- END EvaluatePhi;
-
- PROCEDURE EvaluatePsi (arg: TCryptTmp; data: Psi) : TCryptRes;
- (* evalute the private function psi *)
- VAR
- res : TCryptRes;
- mat, prev : MatCCM;
- num, denom, inv : CCMElement;
- vek : VektorCCM;
- A : ChainCCM;
- r, d : SHORTINT;
- BEGIN
- (* first correct the input with the correlating inverts *)
- MulCCM(arg.denominator[0], data.korrDenom[0], denom);
+ PROCEDURE EvaluatePsi (arg: TCryptTmp; data: Psi) : TCryptRes;
+ (* evalute the private function psi *)
+ VAR
+ res : TCryptRes;
+ mat, prev : MatCCM;
+ num, denom, inv : CCMElement;
+ vek : VektorCCM;
+ A : ChainCCM;
+ r, d : SHORTINT;
+ BEGIN
+ (* first correct the input with the correlating inverts *)
+ MulCCM(arg.denominator[0], data.korrDenom[0], denom);
+ PowerCCM(denom, M-1, inv);
+ MulCCM(arg.numerator[0][0], data.korrNum[0][0], num);
+ MulCCM(num, inv, vek[0]);
+ MulCCM(arg.numerator[0][1], data.korrNum[0][1], num);
+ MulCCM(num, inv, vek[1]);
+ MulMatrix(data.initialmatrix, vek, A[0]);
+ prev := data.initialmatrix;
+ r := 1;
+ WHILE r < Rounds DO
+ (* the matrix for the current round of the recursion must be computed
+ each round *)
+ BuildMatrix(mat, prev, A[r-1]);
+ prev := mat;
+ MulCCM(arg.denominator[r], data.korrDenom[r], denom);
PowerCCM(denom, M-1, inv);
- MulCCM(arg.numerator[0][0], data.korrNum[0][0], num);
+ MulCCM(arg.numerator[r][0], data.korrNum[r][0], num);
MulCCM(num, inv, vek[0]);
- MulCCM(arg.numerator[0][1], data.korrNum[0][1], num);
+ MulCCM(arg.numerator[r][1], data.korrNum[r][1], num);
MulCCM(num, inv, vek[1]);
- MulMatrix(data.initialmatrix, vek, A[0]);
- prev := data.initialmatrix;
- r := 1;
- WHILE r < Rounds DO
- (* the matrix for the current round of the recursion must be computed
- each round *)
- BuildMatrix(mat, prev, A[r-1]);
- prev := mat;
- MulCCM(arg.denominator[r], data.korrDenom[r], denom);
- PowerCCM(denom, M-1, inv);
- MulCCM(arg.numerator[r][0], data.korrNum[r][0], num);
- MulCCM(num, inv, vek[0]);
- MulCCM(arg.numerator[r][1], data.korrNum[r][1], num);
- MulCCM(num, inv, vek[1]);
- MulMatrix(mat, vek, A[r]);
- INC(r);
+ MulMatrix(mat, vek, A[r]);
+ INC(r);
+ END;
+ NEW(res);
+ r := 0;
+ WHILE r < LastRounds DO
+ d := 0;
+ WHILE d < Dim DO
+ res.arg[r][d] := A[Rounds-LastRounds+r][d];
+ INC(d);
END;
- NEW(res);
- r := 0;
- WHILE r < LastRounds DO
- d := 0;
- WHILE d < Dim DO
- res.arg[r][d] := A[Rounds-LastRounds+r][d];
- INC(d);
- END;
- INC(r);
- END;
- RETURN res;
- END EvaluatePsi;
+ INC(r);
+ END;
+ RETURN res;
+ END EvaluatePsi;
- PROCEDURE EvaluateEta (arg: TCryptInput; data: Eta) : TCryptRes;
- (* evaluate the public function eta (composition of phi and psi) *)
- VAR
- l, d : SHORTINT;
- res : TCryptRes;
- BEGIN
- NEW(res);
- PreComputeArgs(arg);
- l := 0;
- WHILE l < LastRounds DO
- d := 0;
- WHILE d < Dim DO
- EvalPolynom(data.p[l][d], res.arg[l][d]);
- INC(d);
- END;
- INC(l);
+ PROCEDURE EvaluateEta (arg: TCryptInput; data: Eta) : TCryptRes;
+ (* evaluate the public function eta (composition of phi and psi) *)
+ VAR
+ l, d : SHORTINT;
+ res : TCryptRes;
+ BEGIN
+ NEW(res);
+ PreComputeArgs(arg);
+ l := 0;
+ WHILE l < LastRounds DO
+ d := 0;
+ WHILE d < Dim DO
+ EvalPolynom(data.p[l][d], res.arg[l][d]);
+ INC(d);
END;
- RETURN res;
- END EvaluateEta;
+ INC(l);
+ END;
+ RETURN res;
+ END EvaluateEta;
- PROCEDURE Eof (s: Streams.Stream) : BOOLEAN;
- (* returns TRUE if no bytes are left to read from stream s *)
- VAR
- b : SYS.BYTE;
- BEGIN
- RETURN ~Streams.ReadByte(s, b) OR ~Streams.Back(s);
- END Eof;
+ PROCEDURE Eof (s: Streams.Stream) : BOOLEAN;
+ (* returns TRUE if no bytes are left to read from stream s *)
+ VAR
+ b : SYS.BYTE;
+ BEGIN
+ RETURN ~Streams.ReadByte(s, b) OR ~Streams.Back(s);
+ END Eof;
- PROCEDURE Encrypt (msg: Streams.Stream; key: Ciphers.Cipher;
- length: INTEGER; s: Streams.Stream) : BOOLEAN;
- (* interface procedure for Ciphers.Encrypt *)
- VAR
- i, j : SHORTINT;
- ccmarg : TCryptInput;
- ccmres : TCryptTmp;
- wholeStream : BOOLEAN;
- BEGIN
- (* check if the whole stream msg shall be encrypted or only a certain
- amount of bytes *)
- IF length <= 0 THEN
- wholeStream := TRUE;
- ELSE
- wholeStream := FALSE
- END;
- NEW(ccmarg);
- WHILE ~Eof(msg) & (wholeStream OR (length > 0)) DO
- i := 0;
- WHILE i < MaxVar DO
- IF ~NetIO.ReadSet(msg, ccmarg.arg[i]) THEN
- Error(msg, readSetFailed);
- RETURN FALSE;
- END;
- IF ~RegulaerCCM(ccmarg.arg[i]) THEN
- Error(msg, notRegular);
- RETURN FALSE;
- END;
- INC(i);
- END;
- IF key IS PublicCipher THEN
- ccmres := EvaluatePhi(ccmarg, key(PublicCipher).phi);
- ELSE
- ccmres := EvaluatePhi(ccmarg, key(PrivateCipher).phi);
- END;
- i := 0;
- WHILE i < Rounds DO
- j := 0;
- WHILE j < Dim DO
- IF ~NetIO.WriteSet(s, ccmres.numerator[i][j]) THEN
- Error(s, writeSetFailed);
- RETURN FALSE;
- END;
- INC(j);
- END;
- IF ~NetIO.WriteSet(s, ccmres.denominator[i]) THEN
- Error(s, writeSetFailed);
- RETURN FALSE;
- END;
- INC(i);
- END;
- DEC(length, MaxVar*(M DIV 8));
- END;
- RETURN TRUE;
- END Encrypt;
-
- PROCEDURE Decrypt (msg: Streams.Stream; key: Ciphers.Cipher;
- length: INTEGER; s: Streams.Stream) : BOOLEAN;
- (* interface procedure for Ciphers.Decrypt *)
- VAR
- i, j : SHORTINT;
- inNum, inDenom, out : ARRAY (M DIV 8) OF SYS.BYTE;
- ccmarg : TCryptTmp;
- ccmres : TCryptRes;
- wholeStream : BOOLEAN;
- BEGIN
- IF length < 0 THEN
- wholeStream := TRUE;
- ELSE
- wholeStream := FALSE;
- END;
- WITH key:PrivateCipher DO
- NEW(ccmarg);
- WHILE ~Eof(msg) & (wholeStream OR (length > 0)) DO
- i := 0;
- WHILE i < Rounds DO
- j := 0;
- WHILE j < Dim DO
- IF ~NetIO.ReadSet(msg, ccmarg.numerator[i][j]) THEN
- Error(msg, readSetFailed);
- RETURN FALSE;
- END;
- INC(j);
- END;
- IF ~NetIO.ReadSet(msg, ccmarg.denominator[i]) THEN
- Error(msg, readSetFailed);
- RETURN FALSE;
- END;
- INC(i);
- END;
- ccmres := EvaluatePsi(ccmarg, key.psi);
- i := 0;
- WHILE i < LastRounds DO
- j := 0;
- WHILE j < Dim DO
- IF ~NetIO.WriteSet(s, ccmres.arg[i][j]) THEN
- Error(s, writeSetFailed);
- RETURN FALSE;
- END;
- INC(j);
- END;
- INC(i);
- END;
- DEC (length, Rounds*Dim*(M DIV 8));
- END;
- END;
- RETURN TRUE;
- END Decrypt;
-
- PROCEDURE ComposedEncrypt (msg: Streams.Stream; key: Ciphers.Cipher;
- length: INTEGER; s: Streams.Stream) : BOOLEAN;
- (* interface procedure for AsymmetricCiphers.ComposedEncrypt *)
- VAR
- i, j : SHORTINT;
- ccmarg : TCryptInput;
- ccmres : TCryptRes;
- in, out : ARRAY (M DIV 8) OF SYS.BYTE;
- wholeStream : BOOLEAN;
- BEGIN
- IF length < 0 THEN
- wholeStream := TRUE;
- ELSE
- wholeStream := FALSE;
- END;
- NEW(ccmarg);
- WHILE ~Eof(msg) & (wholeStream OR (length > 0)) DO
- i := 0;
- WHILE i < MaxVar DO
- IF ~NetIO.ReadSet(msg, ccmarg.arg[i]) THEN
- Error(msg, readSetFailed);
- RETURN FALSE;
- END;
- INC(i);
- END;
- IF key IS PublicCipher THEN
- ccmres := EvaluateEta(ccmarg, key(PublicCipher).eta);
- ELSE
- ccmres := EvaluateEta(ccmarg, key(PrivateCipher).eta);
- END;
- i := 0;
- WHILE i < LastRounds DO
- j := 0;
- WHILE j < Dim DO
- IF ~NetIO.WriteSet(s, ccmres.arg[i][j]) THEN
- Error(s, writeSetFailed);
- RETURN FALSE;
- END;
- INC(j);
- END;
- INC(i);
- END;
- DEC (length, MaxVar*(M DIV 8));
- END;
- RETURN TRUE;
- END ComposedEncrypt;
-
- PROCEDURE RandomStream (s: Streams.Stream);
- (* writes some random elements of CC(M) to the stream s which can then
- be used as an input for Trautner's TCRYPT *)
- VAR
- ccm : CCMElement;
- bytes : ARRAY M DIV 8 OF SYS.BYTE;
- i : INTEGER;
- BEGIN
+ PROCEDURE Encrypt (msg: Streams.Stream; key: Ciphers.Cipher;
+ length: INTEGER; s: Streams.Stream) : BOOLEAN;
+ (* interface procedure for Ciphers.Encrypt *)
+ VAR
+ i, j : SHORTINT;
+ ccmarg : TCryptInput;
+ ccmres : TCryptTmp;
+ wholeStream : BOOLEAN;
+ BEGIN
+ (* check if the whole stream msg shall be encrypted or only a certain
+ amount of bytes *)
+ IF length <= 0 THEN
+ wholeStream := TRUE;
+ ELSE
+ wholeStream := FALSE
+ END;
+ NEW(ccmarg);
+ WHILE ~Eof(msg) & (wholeStream OR (length > 0)) DO
i := 0;
WHILE i < MaxVar DO
- CreateCCM(ccm, reg);
- IF ~NetIO.WriteSet(s, ccm) THEN
+ IF ~NetIO.ReadSet(msg, ccmarg.arg[i]) THEN
+ Error(msg, readSetFailed);
+ RETURN FALSE;
+ END;
+ IF ~RegulaerCCM(ccmarg.arg[i]) THEN
+ Error(msg, notRegular);
+ RETURN FALSE;
+ END;
+ INC(i);
+ END;
+ IF key IS PublicCipher THEN
+ ccmres := EvaluatePhi(ccmarg, key(PublicCipher).phi);
+ ELSE
+ ccmres := EvaluatePhi(ccmarg, key(PrivateCipher).phi);
+ END;
+ i := 0;
+ WHILE i < Rounds DO
+ j := 0;
+ WHILE j < Dim DO
+ IF ~NetIO.WriteSet(s, ccmres.numerator[i][j]) THEN
Error(s, writeSetFailed);
- END;
- INC(i);
- END;
- END RandomStream;
-
- PROCEDURE PublicCipherCreate (VAR obj: PersistentObjects.Object);
- (* constructor for a public cipher *)
- VAR
- pub : PublicCipher;
- if : AsymmetricCiphers.Interface;
- caps : AsymmetricCiphers.CapabilitySet;
- BEGIN
- NEW(pub); NEW(pub.phi); NEW(pub.eta);
- PersistentObjects.Init(pub, pubType);
- NEW(if); if.encrypt := Encrypt; if.decrypt := NIL;
- if.compencrypt := ComposedEncrypt; if.split := NIL;
- if.randomStream := RandomStream;
- caps := {AsymmetricCiphers.composed};
- AsymmetricCiphers.Init(pub, if, caps, M*MaxVar, M*Dim);
- obj := pub;
- END PublicCipherCreate;
-
- PROCEDURE Split (VAR public: AsymmetricCiphers.Cipher;
- key: AsymmetricCiphers.Cipher);
- (* interface procedure for asymmetric interface *)
- VAR
- pub: PublicCipher;
- BEGIN
- WITH key:PrivateCipher DO
- PublicCipherCreate(SYS.VAL(PersistentObjects.Object, pub));
- pub.phi := key.phi;
- pub.eta := key.eta;
- public := pub;
- END;
- END Split;
-
- PROCEDURE CipherCreate (VAR obj: PersistentObjects.Object);
- (* constructor for a private cipher *)
- VAR
- key : PrivateCipher;
- if : AsymmetricCiphers.Interface;
- caps : AsymmetricCiphers.CapabilitySet;
- BEGIN
- NEW(key); NEW(key.phi); NEW(key.psi); NEW(key.eta);
- PersistentObjects.Init(key, privType);
- NEW(if); if.encrypt := Encrypt; if.decrypt := Decrypt;
- if.compencrypt := ComposedEncrypt; if.split := Split;
- if.randomStream := RandomStream;
- caps := {AsymmetricCiphers.composed, AsymmetricCiphers.isPrivateKey};
- AsymmetricCiphers.Init(key, if, caps, M*MaxVar, M*Dim);
- obj := key;
- END CipherCreate;
-
- PROCEDURE Create* (VAR key: Ciphers.Cipher);
- (* creates a cipher for the use with Trautner's TCRYPT algorithm *)
- VAR
- tmpKey : PrivateCipher;
- phi : Phi;
- psi : Psi;
- eta : Eta;
- BEGIN
- CipherCreate(SYS.VAL(PersistentObjects.Object, tmpKey));
- CreateMaps(tmpKey.phi, tmpKey.psi, tmpKey.eta);
- key := tmpKey;
- END Create;
-
- PROCEDURE WritePolynom (s: Streams.Stream; p: Polynom) : BOOLEAN;
- (* writes the polynomial p onto the stream s *)
- CONST
- index = M DIV 8;
- VAR
- nrOfTerms, i : INTEGER;
- bytes : ARRAY index OF SYS.BYTE;
- BEGIN
- nrOfTerms := LengthPolynom(p);
- IF ~NetIO.WriteInteger(s, nrOfTerms) THEN
- RETURN FALSE;
- END;
- WHILE nrOfTerms > 0 DO
- IF ~NetIO.WriteSet(s, p.koeff) THEN
RETURN FALSE;
- END;
- i := 0;
- WHILE i < MaxVar DO
- IF ~NetIO.WriteShortInt(s, p.exp[i]) THEN
- RETURN FALSE;
- END;
- INC(i);
- END;
- p := p.next;
- DEC(nrOfTerms);
+ END;
+ INC(j);
+ END;
+ IF ~NetIO.WriteSet(s, ccmres.denominator[i]) THEN
+ Error(s, writeSetFailed);
+ RETURN FALSE;
+ END;
+ INC(i);
END;
- RETURN TRUE;
- END WritePolynom;
+ DEC(length, MaxVar*(M DIV 8));
+ END;
+ RETURN TRUE;
+ END Encrypt;
- PROCEDURE ReadPolynom (s: Streams.Stream; VAR p: Polynom) : BOOLEAN;
- (* reads a polynomial from stream s *)
- CONST
- index = M DIV 8;
- VAR
- nrOfTerms, i : INTEGER;
- pol : Polynom;
- bytes : ARRAY index OF SYS.BYTE;
- BEGIN
- IF ~NetIO.ReadInteger(s, nrOfTerms) THEN
- RETURN FALSE;
- END;
- NEW(p);
- pol := p;
- WHILE nrOfTerms > 0 DO
- IF ~NetIO.ReadSet(s, pol.koeff) THEN
+ PROCEDURE Decrypt (msg: Streams.Stream; key: Ciphers.Cipher;
+ length: INTEGER; s: Streams.Stream) : BOOLEAN;
+ (* interface procedure for Ciphers.Decrypt *)
+ VAR
+ i, j : SHORTINT;
+ inNum, inDenom, out : ARRAY (M DIV 8) OF SYS.BYTE;
+ ccmarg : TCryptTmp;
+ ccmres : TCryptRes;
+ wholeStream : BOOLEAN;
+ BEGIN
+ IF length < 0 THEN
+ wholeStream := TRUE;
+ ELSE
+ wholeStream := FALSE;
+ END;
+ WITH key:PrivateCipher DO
+ NEW(ccmarg);
+ WHILE ~Eof(msg) & (wholeStream OR (length > 0)) DO
+ i := 0;
+ WHILE i < Rounds DO
+ j := 0;
+ WHILE j < Dim DO
+ IF ~NetIO.ReadSet(msg, ccmarg.numerator[i][j]) THEN
+ Error(msg, readSetFailed);
+ RETURN FALSE;
+ END;
+ INC(j);
+ END;
+ IF ~NetIO.ReadSet(msg, ccmarg.denominator[i]) THEN
+ Error(msg, readSetFailed);
RETURN FALSE;
- END;
- i := 0;
- WHILE i < MaxVar DO
- IF ~NetIO.ReadShortInt(s, pol.exp[i]) THEN
- RETURN FALSE;
+ END;
+ INC(i);
+ END;
+ ccmres := EvaluatePsi(ccmarg, key.psi);
+ i := 0;
+ WHILE i < LastRounds DO
+ j := 0;
+ WHILE j < Dim DO
+ IF ~NetIO.WriteSet(s, ccmres.arg[i][j]) THEN
+ Error(s, writeSetFailed);
+ RETURN FALSE;
END;
- INC(i);
- END;
- DEC(nrOfTerms);
- IF nrOfTerms > 0 THEN
- NEW(pol.next);
- pol := pol.next;
- END
+ INC(j);
+ END;
+ INC(i);
+ END;
+ DEC (length, Rounds*Dim*(M DIV 8));
END;
- RETURN TRUE;
- END ReadPolynom;
+ END;
+ RETURN TRUE;
+ END Decrypt;
- PROCEDURE PhiWrite (s: Streams.Stream; data: Phi) : BOOLEAN;
- (* writes the data structure for the public function phi onto a stream *)
- VAR
- r, d, k : INTEGER;
- BEGIN
- r := 0;
- WHILE r < Rounds DO
- d := 0;
- WHILE d < Dim DO
- IF ~WritePolynom(s, data.num[r][d]) THEN
- RETURN FALSE;
- END;
- INC(d);
- END;
- IF ~WritePolynom(s, data.denom[r]) THEN
+ PROCEDURE ComposedEncrypt (msg: Streams.Stream; key: Ciphers.Cipher;
+ length: INTEGER; s: Streams.Stream) : BOOLEAN;
+ (* interface procedure for AsymmetricCiphers.ComposedEncrypt *)
+ VAR
+ i, j : SHORTINT;
+ ccmarg : TCryptInput;
+ ccmres : TCryptRes;
+ in, out : ARRAY (M DIV 8) OF SYS.BYTE;
+ wholeStream : BOOLEAN;
+ BEGIN
+ IF length < 0 THEN
+ wholeStream := TRUE;
+ ELSE
+ wholeStream := FALSE;
+ END;
+ NEW(ccmarg);
+ WHILE ~Eof(msg) & (wholeStream OR (length > 0)) DO
+ i := 0;
+ WHILE i < MaxVar DO
+ IF ~NetIO.ReadSet(msg, ccmarg.arg[i]) THEN
+ Error(msg, readSetFailed);
+ RETURN FALSE;
+ END;
+ INC(i);
+ END;
+ IF key IS PublicCipher THEN
+ ccmres := EvaluateEta(ccmarg, key(PublicCipher).eta);
+ ELSE
+ ccmres := EvaluateEta(ccmarg, key(PrivateCipher).eta);
+ END;
+ i := 0;
+ WHILE i < LastRounds DO
+ j := 0;
+ WHILE j < Dim DO
+ IF ~NetIO.WriteSet(s, ccmres.arg[i][j]) THEN
+ Error(s, writeSetFailed);
RETURN FALSE;
- END;
- INC(r);
+ END;
+ INC(j);
+ END;
+ INC(i);
END;
- RETURN TRUE;
- END PhiWrite;
+ DEC (length, MaxVar*(M DIV 8));
+ END;
+ RETURN TRUE;
+ END ComposedEncrypt;
- PROCEDURE PhiRead (s: Streams.Stream; VAR data: Phi) : BOOLEAN;
- (* reads the data structure for the public function phi from a stream *)
- VAR
- r, d, k : INTEGER;
- BEGIN
- NEW(data);
- r := 0;
- WHILE r < Rounds DO
- d := 0;
- WHILE d < Dim DO
- IF ~ReadPolynom(s, data.num[r][d]) THEN
- RETURN FALSE;
- END;
- INC(d);
- END;
- IF ~ReadPolynom(s, data.denom[r]) THEN
- RETURN FALSE;
- END;
- INC(r);
+ PROCEDURE RandomStream (s: Streams.Stream);
+ (* writes some random elements of CC(M) to the stream s which can then
+ be used as an input for Trautner's TCRYPT *)
+ VAR
+ ccm : CCMElement;
+ bytes : ARRAY M DIV 8 OF SYS.BYTE;
+ i : INTEGER;
+ BEGIN
+ i := 0;
+ WHILE i < MaxVar DO
+ CreateCCM(ccm, reg);
+ IF ~NetIO.WriteSet(s, ccm) THEN
+ Error(s, writeSetFailed);
END;
- RETURN TRUE;
- END PhiRead;
+ INC(i);
+ END;
+ END RandomStream;
- PROCEDURE PsiWrite (s: Streams.Stream; data: Psi) : BOOLEAN;
- (* writes the data structure for the private function psi onto a stream *)
- CONST
- index = M DIV 8;
- VAR
- dx, dy, r, d : INTEGER;
- bytes : ARRAY index OF SYS.BYTE;
- BEGIN
- dy := 0;
- WHILE dy < Dim DO
- dx := 0;
- WHILE dx < Dim DO
- IF ~NetIO.WriteSet(s, data.initialmatrix[dy][dx]) THEN
- RETURN FALSE;
- END;
- INC(dx);
- END;
- INC(dy);
- END;
- r := 0;
- WHILE r < Rounds DO
- d := 0;
- WHILE d < Dim DO
- IF ~NetIO.WriteSet(s, data.korrNum[r][d]) THEN
- RETURN FALSE;
- END;
- INC(d);
- END;
- IF ~NetIO.WriteSet(s, data.korrDenom[r]) THEN
- RETURN FALSE;
- END;
- INC(r);
- END;
- RETURN TRUE;
- END PsiWrite;
+ PROCEDURE PublicCipherCreate (VAR obj: PersistentObjects.Object);
+ (* constructor for a public cipher *)
+ VAR
+ pub : PublicCipher;
+ if : AsymmetricCiphers.Interface;
+ caps : AsymmetricCiphers.CapabilitySet;
+ BEGIN
+ NEW(pub); NEW(pub.phi); NEW(pub.eta);
+ PersistentObjects.Init(pub, pubType);
+ NEW(if); if.encrypt := Encrypt; if.decrypt := NIL;
+ if.compencrypt := ComposedEncrypt; if.split := NIL;
+ if.randomStream := RandomStream;
+ caps := {AsymmetricCiphers.composed};
+ AsymmetricCiphers.Init(pub, if, caps, M*MaxVar, M*Dim);
+ obj := pub;
+ END PublicCipherCreate;
- PROCEDURE PsiRead (s: Streams.Stream; VAR data: Psi) : BOOLEAN;
- (* reads the data structure for the private function psi from a stream *)
- CONST
- index = M DIV 8;
- VAR
- dy, dx, r, d : INTEGER;
- bytes : ARRAY index OF SYS.BYTE;
- BEGIN
- dy := 0;
- WHILE dy < Dim DO
- dx := 0;
- WHILE dx < Dim DO
- IF ~NetIO.ReadSet(s, data.initialmatrix[dy][dx]) THEN
- RETURN FALSE;
- END;
- INC(dx);
- END;
- INC(dy);
- END;
- r := 0;
- WHILE r < Rounds DO
- d := 0;
- WHILE d < Dim DO
- IF ~NetIO.ReadSet(s, data.korrNum[r][d]) THEN
- RETURN FALSE;
- END;
- INC(d);
- END;
- IF ~NetIO.ReadSet(s, data.korrDenom[r]) THEN
- RETURN FALSE;
- END;
- INC(r);
- END;
- RETURN TRUE;
- END PsiRead;
+ PROCEDURE Split (VAR public: AsymmetricCiphers.Cipher;
+ key: AsymmetricCiphers.Cipher);
+ (* interface procedure for asymmetric interface *)
+ VAR
+ pub: PublicCipher;
+ obj: PersistentObjects.Object;
+ BEGIN
+ WITH key:PrivateCipher DO
+ PublicCipherCreate(obj); pub := obj(PublicCipher);
+ pub.phi := key.phi;
+ pub.eta := key.eta;
+ public := pub;
+ END;
+ END Split;
- PROCEDURE EtaWrite (s: Streams.Stream; data: Eta) : BOOLEAN;
- (* writes the data structure for the public function eta onto a stream *)
- VAR
- l, d : INTEGER;
- BEGIN
- l := 0;
- WHILE l < LastRounds DO
- d := 0;
- WHILE d < Dim DO
- IF ~WritePolynom(s, data.p[l][d]) THEN
- RETURN FALSE;
- END;
- INC(d);
- END;
- INC(l);
- END;
- RETURN TRUE;
- END EtaWrite;
+ PROCEDURE CipherCreate (VAR obj: PersistentObjects.Object);
+ (* constructor for a private cipher *)
+ VAR
+ key : PrivateCipher;
+ if : AsymmetricCiphers.Interface;
+ caps : AsymmetricCiphers.CapabilitySet;
+ BEGIN
+ NEW(key); NEW(key.phi); NEW(key.psi); NEW(key.eta);
+ PersistentObjects.Init(key, privType);
+ NEW(if); if.encrypt := Encrypt; if.decrypt := Decrypt;
+ if.compencrypt := ComposedEncrypt; if.split := Split;
+ if.randomStream := RandomStream;
+ caps := {AsymmetricCiphers.composed, AsymmetricCiphers.isPrivateKey};
+ AsymmetricCiphers.Init(key, if, caps, M*MaxVar, M*Dim);
+ obj := key;
+ END CipherCreate;
- PROCEDURE EtaRead (s: Streams.Stream; VAR data: Eta) : BOOLEAN;
- (* reads the data structure for the public function eta from a stream *)
- VAR
- l, d : INTEGER;
- BEGIN
- NEW(data);
- l := 0;
- WHILE l < LastRounds DO
- d := 0;
- WHILE d < Dim DO
- IF ~ReadPolynom(s, data.p[l][d]) THEN
- RETURN FALSE;
- END;
- INC(d);
- END;
- INC(l);
- END;
- RETURN TRUE;
- END EtaRead;
+ PROCEDURE Create* (VAR key: Ciphers.Cipher);
+ (* creates a cipher for the use with Trautner's TCRYPT algorithm *)
+ VAR
+ tmpKey : PrivateCipher;
+ obj : PersistentObjects.Object;
+ phi : Phi;
+ psi : Psi;
+ eta : Eta;
+ BEGIN
+ CipherCreate(obj); tmpKey := obj(PrivateCipher);
+ CreateMaps(tmpKey.phi, tmpKey.psi, tmpKey.eta);
+ key := tmpKey;
+ END Create;
- PROCEDURE PubWrite (s: Streams.Stream;
- obj: PersistentObjects.Object) : BOOLEAN;
- (* interface procedure for PersistentObjects *)
- BEGIN
- WITH obj:PublicCipher DO
- RETURN PhiWrite(s, obj.phi) & EtaWrite(s, obj.eta);
+ PROCEDURE WritePolynom (s: Streams.Stream; p: Polynom) : BOOLEAN;
+ (* writes the polynomial p onto the stream s *)
+ CONST
+ index = M DIV 8;
+ VAR
+ nrOfTerms, i : INTEGER;
+ bytes : ARRAY index OF SYS.BYTE;
+ BEGIN
+ nrOfTerms := LengthPolynom(p);
+ IF ~NetIO.WriteInteger(s, nrOfTerms) THEN
+ RETURN FALSE;
+ END;
+ WHILE nrOfTerms > 0 DO
+ IF ~NetIO.WriteSet(s, p.koeff) THEN
+ RETURN FALSE;
END;
- END PubWrite;
+ i := 0;
+ WHILE i < MaxVar DO
+ IF ~NetIO.WriteShortInt(s, p.exp[i]) THEN
+ RETURN FALSE;
+ END;
+ INC(i);
+ END;
+ p := p.next;
+ DEC(nrOfTerms);
+ END;
+ RETURN TRUE;
+ END WritePolynom;
- PROCEDURE CipherWrite (s: Streams.Stream;
- obj: PersistentObjects.Object) : BOOLEAN;
- (* interface procedure for PersistentObjects *)
- BEGIN
- WITH obj:PrivateCipher DO
- RETURN PhiWrite(s, obj.phi) &
- PsiWrite(s, obj.psi) &
- EtaWrite(s, obj.eta);
+ PROCEDURE ReadPolynom (s: Streams.Stream; VAR p: Polynom) : BOOLEAN;
+ (* reads a polynomial from stream s *)
+ CONST
+ index = M DIV 8;
+ VAR
+ nrOfTerms, i : INTEGER;
+ pol : Polynom;
+ bytes : ARRAY index OF SYS.BYTE;
+ BEGIN
+ IF ~NetIO.ReadInteger(s, nrOfTerms) THEN
+ RETURN FALSE;
+ END;
+ NEW(p);
+ pol := p;
+ WHILE nrOfTerms > 0 DO
+ IF ~NetIO.ReadSet(s, pol.koeff) THEN
+ RETURN FALSE;
END;
- END CipherWrite;
+ i := 0;
+ WHILE i < MaxVar DO
+ IF ~NetIO.ReadShortInt(s, pol.exp[i]) THEN
+ RETURN FALSE;
+ END;
+ INC(i);
+ END;
+ DEC(nrOfTerms);
+ IF nrOfTerms > 0 THEN
+ NEW(pol.next);
+ pol := pol.next;
+ END
+ END;
+ RETURN TRUE;
+ END ReadPolynom;
- PROCEDURE PubRead (s: Streams.Stream;
- obj: PersistentObjects.Object) : BOOLEAN;
- (* interface procedure for PersistentObjects *)
- BEGIN
- WITH obj:PublicCipher DO
- IF ~PhiRead(s, obj.phi) OR ~EtaRead(s, obj.eta) THEN
- RETURN FALSE;
- END;
+ PROCEDURE PhiWrite (s: Streams.Stream; data: Phi) : BOOLEAN;
+ (* writes the data structure for the public function phi onto a stream *)
+ VAR
+ r, d, k : INTEGER;
+ BEGIN
+ r := 0;
+ WHILE r < Rounds DO
+ d := 0;
+ WHILE d < Dim DO
+ IF ~WritePolynom(s, data.num[r][d]) THEN
+ RETURN FALSE;
+ END;
+ INC(d);
END;
- RETURN TRUE;
- END PubRead;
+ IF ~WritePolynom(s, data.denom[r]) THEN
+ RETURN FALSE;
+ END;
+ INC(r);
+ END;
+ RETURN TRUE;
+ END PhiWrite;
- PROCEDURE CipherRead (s: Streams.Stream;
- obj: PersistentObjects.Object) : BOOLEAN;
- (* interface procedure for PersistentObjects *)
- BEGIN
- WITH obj:PrivateCipher DO
- IF ~PhiRead(s, obj.phi) OR
- ~PsiRead(s, obj.psi) OR
- ~EtaRead(s, obj.eta) THEN
- RETURN FALSE;
- END;
+ PROCEDURE PhiRead (s: Streams.Stream; VAR data: Phi) : BOOLEAN;
+ (* reads the data structure for the public function phi from a stream *)
+ VAR
+ r, d, k : INTEGER;
+ BEGIN
+ NEW(data);
+ r := 0;
+ WHILE r < Rounds DO
+ d := 0;
+ WHILE d < Dim DO
+ IF ~ReadPolynom(s, data.num[r][d]) THEN
+ RETURN FALSE;
+ END;
+ INC(d);
END;
- RETURN TRUE;
- END CipherRead;
+ IF ~ReadPolynom(s, data.denom[r]) THEN
+ RETURN FALSE;
+ END;
+ INC(r);
+ END;
+ RETURN TRUE;
+ END PhiRead;
+
+ PROCEDURE PsiWrite (s: Streams.Stream; data: Psi) : BOOLEAN;
+ (* writes the data structure for the private function psi onto a stream *)
+ CONST
+ index = M DIV 8;
+ VAR
+ dx, dy, r, d : INTEGER;
+ bytes : ARRAY index OF SYS.BYTE;
+ BEGIN
+ dy := 0;
+ WHILE dy < Dim DO
+ dx := 0;
+ WHILE dx < Dim DO
+ IF ~NetIO.WriteSet(s, data.initialmatrix[dy][dx]) THEN
+ RETURN FALSE;
+ END;
+ INC(dx);
+ END;
+ INC(dy);
+ END;
+ r := 0;
+ WHILE r < Rounds DO
+ d := 0;
+ WHILE d < Dim DO
+ IF ~NetIO.WriteSet(s, data.korrNum[r][d]) THEN
+ RETURN FALSE;
+ END;
+ INC(d);
+ END;
+ IF ~NetIO.WriteSet(s, data.korrDenom[r]) THEN
+ RETURN FALSE;
+ END;
+ INC(r);
+ END;
+ RETURN TRUE;
+ END PsiWrite;
+
+ PROCEDURE PsiRead (s: Streams.Stream; VAR data: Psi) : BOOLEAN;
+ (* reads the data structure for the private function psi from a stream *)
+ CONST
+ index = M DIV 8;
+ VAR
+ dy, dx, r, d : INTEGER;
+ bytes : ARRAY index OF SYS.BYTE;
+ BEGIN
+ dy := 0;
+ WHILE dy < Dim DO
+ dx := 0;
+ WHILE dx < Dim DO
+ IF ~NetIO.ReadSet(s, data.initialmatrix[dy][dx]) THEN
+ RETURN FALSE;
+ END;
+ INC(dx);
+ END;
+ INC(dy);
+ END;
+ r := 0;
+ WHILE r < Rounds DO
+ d := 0;
+ WHILE d < Dim DO
+ IF ~NetIO.ReadSet(s, data.korrNum[r][d]) THEN
+ RETURN FALSE;
+ END;
+ INC(d);
+ END;
+ IF ~NetIO.ReadSet(s, data.korrDenom[r]) THEN
+ RETURN FALSE;
+ END;
+ INC(r);
+ END;
+ RETURN TRUE;
+ END PsiRead;
+
+ PROCEDURE EtaWrite (s: Streams.Stream; data: Eta) : BOOLEAN;
+ (* writes the data structure for the public function eta onto a stream *)
+ VAR
+ l, d : INTEGER;
+ BEGIN
+ l := 0;
+ WHILE l < LastRounds DO
+ d := 0;
+ WHILE d < Dim DO
+ IF ~WritePolynom(s, data.p[l][d]) THEN
+ RETURN FALSE;
+ END;
+ INC(d);
+ END;
+ INC(l);
+ END;
+ RETURN TRUE;
+ END EtaWrite;
+
+ PROCEDURE EtaRead (s: Streams.Stream; VAR data: Eta) : BOOLEAN;
+ (* reads the data structure for the public function eta from a stream *)
+ VAR
+ l, d : INTEGER;
+ BEGIN
+ NEW(data);
+ l := 0;
+ WHILE l < LastRounds DO
+ d := 0;
+ WHILE d < Dim DO
+ IF ~ReadPolynom(s, data.p[l][d]) THEN
+ RETURN FALSE;
+ END;
+ INC(d);
+ END;
+ INC(l);
+ END;
+ RETURN TRUE;
+ END EtaRead;
+
+ PROCEDURE PubWrite (s: Streams.Stream;
+ obj: PersistentObjects.Object) : BOOLEAN;
+ (* interface procedure for PersistentObjects *)
+ BEGIN
+ WITH obj:PublicCipher DO
+ RETURN PhiWrite(s, obj.phi) & EtaWrite(s, obj.eta);
+ END;
+ END PubWrite;
+
+ PROCEDURE CipherWrite (s: Streams.Stream;
+ obj: PersistentObjects.Object) : BOOLEAN;
+ (* interface procedure for PersistentObjects *)
+ BEGIN
+ WITH obj:PrivateCipher DO
+ RETURN PhiWrite(s, obj.phi) &
+ PsiWrite(s, obj.psi) &
+ EtaWrite(s, obj.eta);
+ END;
+ END CipherWrite;
+
+ PROCEDURE PubRead (s: Streams.Stream;
+ obj: PersistentObjects.Object) : BOOLEAN;
+ (* interface procedure for PersistentObjects *)
+ BEGIN
+ WITH obj:PublicCipher DO
+ IF ~PhiRead(s, obj.phi) OR ~EtaRead(s, obj.eta) THEN
+ RETURN FALSE;
+ END;
+ END;
+ RETURN TRUE;
+ END PubRead;
+
+ PROCEDURE CipherRead (s: Streams.Stream;
+ obj: PersistentObjects.Object) : BOOLEAN;
+ (* interface procedure for PersistentObjects *)
+ BEGIN
+ WITH obj:PrivateCipher DO
+ IF ~PhiRead(s, obj.phi) OR
+ ~PsiRead(s, obj.psi) OR
+ ~EtaRead(s, obj.eta) THEN
+ RETURN FALSE;
+ END;
+ END;
+ RETURN TRUE;
+ END CipherRead;
BEGIN
- (* init of the zero and unit of CC(M) *)
- NullCCM := {};
- EinsCCM := {0};
+ (* init of the zero and unit of CC(M) *)
+ NullCCM := {};
+ EinsCCM := {0};
- (* init of the zero exponent *)
- k := 0;
- WHILE k Priorities.base THEN
- desc.caps := desc.caps + {Conditions.select, Conditions.async};
- desc.internal := priorityOfClock < Priorities.interrupts;
- END;
- END;
- NEW(domain); Conditions.InitDomain(domain, if, desc);
- domain.clock := clock;
- IF Clocks.timer IN Clocks.Capabilities(clock) THEN
- Events.Define(domain.alarm);
- Events.SetPriority(domain.alarm, priorityOfClock + 1);
- Events.Handler(domain.alarm, Wakeup);
- ELSE
- domain.alarm := NIL;
- END;
- NEW(clockDisc); clockDisc.id := disciplineId;
- clockDisc.domain := domain;
- Disciplines.Add(clock, clockDisc);
- domain.event := NIL;
+ TYPE
+ WakeupEvent = POINTER TO WakeupEventRec;
+ WakeupEventRec =
+ RECORD
+ (Events.EventRec)
+ condition: Condition;
+ awaked: BOOLEAN; (* set to true by Wakeup event handler *)
END;
- Conditions.Init(condition, domain);
- FixTime(time, currentTime, clock); condition.time := time;
- condition.domain := domain;
- condition.passed := Clocks.Passed(clock, time);
- condition.scheduled := FALSE;
- IF ~condition.passed &
- (domain.alarm # NIL) & (clock # Clocks.system) THEN
- ScheduleEvent(condition);
- END;
- END Init;
- PROCEDURE Create*(VAR condition: Conditions.Condition;
- clock: Clocks.Clock; time: Times.Time);
- (* create and initialize a time condition:
- is the current time of the clock greater than or
- equal to `time';
- if time is relative then it is taken relative to the current time
- *)
- VAR
- timeCond: Condition;
- BEGIN
- NEW(timeCond);
- Init(timeCond, clock, time);
- condition := timeCond;
- END Create;
+ VAR
+ if: Conditions.Interface;
- (* ======== interface procedures ================================ *)
-
- PROCEDURE GetTime(clock: Clocks.Clock;
- VAR currentTime: Times.Time;
- errors: RelatedEvents.Object) : BOOLEAN;
- (* get the current time of clock and check for errors *)
- VAR
- oldEvents, newEvents: RelatedEvents.Queue;
- BEGIN
- RelatedEvents.GetQueue(clock, oldEvents);
+ PROCEDURE FixTime(VAR time: Times.Time;
+ currentTime: Times.Time;
+ clock: Clocks.Clock);
+ (* convert relative time measures into absolute time specs *)
+ VAR op: Op.Operand;
+ BEGIN
+ IF Scales.IsRelative(time) THEN
Clocks.GetTime(clock, currentTime);
- RelatedEvents.GetQueue(clock, newEvents);
- IF newEvents # NIL THEN
- RelatedEvents.AppendQueue(errors, newEvents);
- END;
- IF oldEvents # NIL THEN
- RelatedEvents.AppendQueue(clock, oldEvents);
- END;
- IF newEvents # NIL THEN
- RelatedEvents.AppendQueue(clock, newEvents);
- END;
- RETURN newEvents = NIL
- END GetTime;
+ op := time; Op.Add3(op, currentTime, time); time := op(Times.Time)
+ END;
+ END FixTime;
- PROCEDURE Passed(clock: Clocks.Clock;
- time: Times.Time;
- VAR passed: BOOLEAN;
- errors: RelatedEvents.Object) : BOOLEAN;
- VAR
- oldEvents, newEvents: RelatedEvents.Queue;
- BEGIN
- RelatedEvents.GetQueue(clock, oldEvents);
- passed := Clocks.Passed(clock, time);
- RelatedEvents.GetQueue(clock, newEvents);
- IF newEvents # NIL THEN
- RelatedEvents.AppendQueue(errors, newEvents);
+ PROCEDURE Wakeup(event: Events.Event);
+ (* note that we strictly rely on the capability of the
+ underlying clock to raise this event at the appropriate
+ time; we are unable to verify it because that could
+ deadlock us in case of remote clocks
+ *)
+ VAR
+ condevent: Events.Event; (* event requested by SendEvent *)
+ BEGIN
+ WITH event: WakeupEvent DO
+ event.awaked := TRUE;
+ IF event.condition # NIL THEN
+ event.condition.passed := TRUE;
+ event.condition.scheduled := FALSE;
+ condevent := event.condition.domain.event;
+ IF condevent # NIL THEN
+ event.condition.domain.event := NIL;
+ Events.Raise(condevent);
+ END;
END;
- IF oldEvents # NIL THEN
- RelatedEvents.AppendQueue(clock, oldEvents);
- END;
- IF newEvents # NIL THEN
- RelatedEvents.AppendQueue(clock, newEvents);
- END;
- RETURN newEvents = NIL
- END Passed;
+ END;
+ END Wakeup;
- PROCEDURE Test(domain: Conditions.Domain; condition: Conditions.Condition;
- errors: RelatedEvents.Object) : BOOLEAN;
- VAR
- currentTime: Times.Time;
- BEGIN
- WITH domain: Domain DO WITH condition: Condition DO
- IF condition.passed THEN RETURN TRUE END;
- IF condition.domain.event # NIL THEN RETURN FALSE END;
- IF condition.scheduled THEN RETURN FALSE END;
- IF ~Passed(domain.clock, condition.time,
- condition.passed, errors) THEN
- condition.passed := TRUE;
- RETURN TRUE
- END;
- RETURN condition.passed
- END; END;
- END Test;
+ PROCEDURE ScheduleEvent(condition: Condition);
+ VAR
+ wakeup: WakeupEvent;
+ domain: Domain;
+ BEGIN
+ IF ~condition.scheduled THEN
+ domain := condition.domain;
+ ASSERT(domain.alarm # NIL);
+ NEW(wakeup); wakeup.type := domain.alarm;
+ wakeup.awaked := FALSE; wakeup.condition := condition;
+ condition.scheduled := TRUE;
+ Timers.Schedule(domain.clock, condition.time, wakeup);
+ END;
+ END ScheduleEvent;
- PROCEDURE GetMinTime(conditionSet: Conditions.ConditionSet;
- VAR minTime: Times.Time;
- VAR minCond: Condition);
+ PROCEDURE Init*(condition: Condition; clock: Clocks.Clock; time: Times.Time);
+ (* like Create but without NEW *)
+ VAR
+ clockDisc: Discipline;
+ disc: Disciplines.Discipline;
+ domain: Domain;
+ desc: Conditions.Description;
+ priorityOfClock: Priorities.Priority;
+ currentTime: Times.Time;
+ BEGIN
+ IF Disciplines.Seek(clock, disciplineId, disc) THEN
+ domain := disc(Discipline).domain;
+ ELSE
+ (* create new domain *)
+ NEW(desc); desc.caps := {}; desc.internal := TRUE;
+ IF clock = Clocks.system THEN
+ desc.caps := desc.caps +
+ {Conditions.timelimit, Conditions.timecond};
+ END;
+ IF Clocks.timer IN Clocks.Capabilities(clock) THEN
+ Clocks.GetPriority(clock, priorityOfClock);
+ IF priorityOfClock > Priorities.base THEN
+ desc.caps := desc.caps + {Conditions.select, Conditions.async};
+ desc.internal := priorityOfClock < Priorities.interrupts;
+ END;
+ END;
+ NEW(domain); Conditions.InitDomain(domain, if, desc);
+ domain.clock := clock;
+ IF Clocks.timer IN Clocks.Capabilities(clock) THEN
+ Events.Define(domain.alarm);
+ Events.SetPriority(domain.alarm, priorityOfClock + 1);
+ Events.Handler(domain.alarm, Wakeup);
+ ELSE
+ domain.alarm := NIL;
+ END;
+ NEW(clockDisc); clockDisc.id := disciplineId;
+ clockDisc.domain := domain;
+ Disciplines.Add(clock, clockDisc);
+ domain.event := NIL;
+ END;
+ Conditions.Init(condition, domain);
+ FixTime(time, currentTime, clock); condition.time := time;
+ condition.domain := domain;
+ condition.passed := Clocks.Passed(clock, time);
+ condition.scheduled := FALSE;
+ IF ~condition.passed &
+ (domain.alarm # NIL) & (clock # Clocks.system) THEN
+ ScheduleEvent(condition);
+ END;
+ END Init;
+
+ PROCEDURE Create*(VAR condition: Conditions.Condition;
+ clock: Clocks.Clock; time: Times.Time);
+ (* create and initialize a time condition:
+ is the current time of the clock greater than or
+ equal to `time';
+ if time is relative then it is taken relative to the current time
+ *)
+ VAR
+ timeCond: Condition;
+ BEGIN
+ NEW(timeCond);
+ Init(timeCond, clock, time);
+ condition := timeCond;
+ END Create;
+
+ (* ======== interface procedures ================================ *)
+
+ PROCEDURE GetTime(clock: Clocks.Clock;
+ VAR currentTime: Times.Time;
+ errors: RelatedEvents.Object) : BOOLEAN;
+ (* get the current time of clock and check for errors *)
+ VAR
+ oldEvents, newEvents: RelatedEvents.Queue;
+ BEGIN
+ RelatedEvents.GetQueue(clock, oldEvents);
+ Clocks.GetTime(clock, currentTime);
+ RelatedEvents.GetQueue(clock, newEvents);
+ IF newEvents # NIL THEN
+ RelatedEvents.AppendQueue(errors, newEvents);
+ END;
+ IF oldEvents # NIL THEN
+ RelatedEvents.AppendQueue(clock, oldEvents);
+ END;
+ IF newEvents # NIL THEN
+ RelatedEvents.AppendQueue(clock, newEvents);
+ END;
+ RETURN newEvents = NIL
+ END GetTime;
+
+ PROCEDURE Passed(clock: Clocks.Clock;
+ time: Times.Time;
+ VAR passed: BOOLEAN;
+ errors: RelatedEvents.Object) : BOOLEAN;
+ VAR
+ oldEvents, newEvents: RelatedEvents.Queue;
+ BEGIN
+ RelatedEvents.GetQueue(clock, oldEvents);
+ passed := Clocks.Passed(clock, time);
+ RelatedEvents.GetQueue(clock, newEvents);
+ IF newEvents # NIL THEN
+ RelatedEvents.AppendQueue(errors, newEvents);
+ END;
+ IF oldEvents # NIL THEN
+ RelatedEvents.AppendQueue(clock, oldEvents);
+ END;
+ IF newEvents # NIL THEN
+ RelatedEvents.AppendQueue(clock, newEvents);
+ END;
+ RETURN newEvents = NIL
+ END Passed;
+
+ PROCEDURE Test(domain: Conditions.Domain; condition: Conditions.Condition;
+ errors: RelatedEvents.Object) : BOOLEAN;
+ VAR
+ currentTime: Times.Time;
+ BEGIN
+ WITH domain: Domain DO WITH condition: Condition DO
+ IF condition.passed THEN RETURN TRUE END;
+ IF condition.domain.event # NIL THEN RETURN FALSE END;
+ IF condition.scheduled THEN RETURN FALSE END;
+ IF ~Passed(domain.clock, condition.time,
+ condition.passed, errors) THEN
+ condition.passed := TRUE;
+ RETURN TRUE
+ END;
+ RETURN condition.passed
+ END; END;
+ END Test;
+
+ PROCEDURE GetMinTime(conditionSet: Conditions.ConditionSet;
+ VAR minTime: Times.Time;
+ VAR minCond: Condition);
+ VAR
+ condition: Conditions.Condition; (* Condition *)
+ op: Op.Operand;
+ BEGIN
+ minTime := NIL;
+ Conditions.ExamineConditions(conditionSet);
+ WHILE Conditions.GetNextCondition(conditionSet, condition) DO
+ IF (minTime = NIL) OR (Op.Compare(condition(Condition).time, minTime) < 0) THEN
+ minTime := condition(Condition).time; minCond := condition(Condition)
+ END;
+ END;
+ op := minTime; Op.Assign(op, minTime); minTime := op(Times.Time) (* take a copy *)
+ END GetMinTime;
+
+ PROCEDURE Select(domain: Conditions.Domain;
+ conditionSet: Conditions.ConditionSet;
+ time: Times.Time;
+ VAR setOfTrueConditions: Conditions.ConditionSet;
+ errors: RelatedEvents.Object;
+ retry: BOOLEAN;
+ VAR interrupted: BOOLEAN) : BOOLEAN;
+ VAR
+ minTime: Times.Time;
+ minCond: Condition;
+ currentTime: Times.Time; (* of Clocks.system *)
+ condition: Conditions.Condition; (* Condition *)
+ wakeup: WakeupEvent;
+ anythingTrue: BOOLEAN;
+
+ PROCEDURE Failure;
+ (* we are unable to retrieve the time;
+ so we have to mark all conditions as passed
+ and to return the whole set
+ *)
VAR
- condition: Condition;
- BEGIN
- minTime := NIL;
+ condition: Conditions.Condition; (* Condition *)
+ BEGIN
+ Conditions.CreateSet(setOfTrueConditions);
Conditions.ExamineConditions(conditionSet);
- WHILE Conditions.GetNextCondition(conditionSet, SYSTEM.VAL(Conditions.Condition, condition)) DO
- IF (minTime = NIL) OR (Op.Compare(condition.time, minTime) < 0) THEN
- minTime := condition.time; minCond := condition;
- END;
+ WHILE Conditions.GetNextCondition(conditionSet, condition) DO
+ condition(Condition).passed := TRUE;
+ Conditions.Incl(setOfTrueConditions, condition(Condition));
END;
- Op.Assign(SYSTEM.VAL(Op.Operand, minTime), minTime); (* take a copy *)
- END GetMinTime;
+ END Failure;
- PROCEDURE Select(domain: Conditions.Domain;
- conditionSet: Conditions.ConditionSet;
- time: Times.Time;
- VAR setOfTrueConditions: Conditions.ConditionSet;
- errors: RelatedEvents.Object;
- retry: BOOLEAN;
- VAR interrupted: BOOLEAN) : BOOLEAN;
- VAR
- minTime: Times.Time;
- minCond: Condition;
- currentTime: Times.Time; (* of Clocks.system *)
- condition: Condition;
- wakeup: WakeupEvent;
- anythingTrue: BOOLEAN;
+ BEGIN (* Select *)
+ WITH domain: Domain DO
+ GetMinTime(conditionSet, minTime, minCond);
- PROCEDURE Failure;
- (* we are unable to retrieve the time;
- so we have to mark all conditions as passed
- and to return the whole set
- *)
- VAR
- condition: Condition;
- BEGIN
- Conditions.CreateSet(setOfTrueConditions);
- Conditions.ExamineConditions(conditionSet);
- WHILE Conditions.GetNextCondition(conditionSet, SYSTEM.VAL(Conditions.Condition, condition)) DO
- condition.passed := TRUE;
- Conditions.Incl(setOfTrueConditions, condition);
- END;
- END Failure;
-
- BEGIN (* Select *)
- WITH domain: Domain DO
- GetMinTime(conditionSet, minTime, minCond);
-
- (* block current process, if necessary *)
- interrupted := FALSE;
- IF time # NIL THEN
- Clocks.GetTime(Clocks.system, currentTime);
- FixTime(time, currentTime, Clocks.system);
- NEW(wakeup); wakeup.type := domain.alarm;
- wakeup.condition := NIL; wakeup.awaked := FALSE;
- Timers.Schedule(Clocks.system, time, wakeup);
- END;
- IF ~GetTime(domain.clock, currentTime, errors) THEN
- Failure; RETURN TRUE
- END;
-
- IF ~minCond.passed THEN
- LOOP (* goes only into loop if retry = TRUE & we get interrupted *)
- Process.Pause;
- IF wakeup.awaked THEN EXIT END;
- interrupted := ~minCond.passed;
- IF ~interrupted THEN EXIT END;
- IF ~retry THEN RETURN FALSE END;
- END;
- END;
-
- anythingTrue := FALSE;
- Conditions.CreateSet(setOfTrueConditions);
- Conditions.ExamineConditions(conditionSet);
- WHILE Conditions.GetNextCondition(conditionSet, SYSTEM.VAL(Conditions.Condition, condition)) DO
- IF condition.passed THEN
- Conditions.Incl(setOfTrueConditions, condition);
- anythingTrue := TRUE;
- END;
- END;
- RETURN anythingTrue
+ (* block current process, if necessary *)
+ interrupted := FALSE;
+ IF time # NIL THEN
+ Clocks.GetTime(Clocks.system, currentTime);
+ FixTime(time, currentTime, Clocks.system);
+ NEW(wakeup); wakeup.type := domain.alarm;
+ wakeup.condition := NIL; wakeup.awaked := FALSE;
+ Timers.Schedule(Clocks.system, time, wakeup);
+ END;
+ IF ~GetTime(domain.clock, currentTime, errors) THEN
+ Failure; RETURN TRUE
END;
- END Select;
- PROCEDURE SendEvent(domain: Conditions.Domain;
- condition: Conditions.Condition;
- event: Events.Event;
- errors: RelatedEvents.Object) : BOOLEAN;
- BEGIN
- WITH domain: Domain DO WITH condition: Condition DO
- IF condition.passed THEN
- RETURN FALSE
- ELSE
- domain.event := event;
- ScheduleEvent(condition);
- RETURN TRUE
- END;
- END; END;
- END SendEvent;
+ IF ~minCond.passed THEN
+ LOOP (* goes only into loop if retry = TRUE & we get interrupted *)
+ Process.Pause;
+ IF wakeup.awaked THEN EXIT END;
+ interrupted := ~minCond.passed;
+ IF ~interrupted THEN EXIT END;
+ IF ~retry THEN RETURN FALSE END;
+ END;
+ END;
- PROCEDURE GetNextTime(domain: Conditions.Domain;
- conditionSet: Conditions.ConditionSet;
- VAR nextTime: Times.Time;
- VAR nextCond: Conditions.Condition;
- errors: RelatedEvents.Object);
- VAR
- condition: Condition;
- BEGIN
- GetMinTime(conditionSet, nextTime, condition);
- nextCond := condition;
- END GetNextTime;
+ anythingTrue := FALSE;
+ Conditions.CreateSet(setOfTrueConditions);
+ Conditions.ExamineConditions(conditionSet);
+ WHILE Conditions.GetNextCondition(conditionSet, condition) DO
+ IF condition(Condition).passed THEN
+ Conditions.Incl(setOfTrueConditions, condition(Condition));
+ anythingTrue := TRUE;
+ END;
+ END;
+ RETURN anythingTrue
+ END;
+ END Select;
- PROCEDURE InitInterface;
- BEGIN
- NEW(if);
- if.test := Test;
- if.select := Select;
- if.sendevent := SendEvent;
- if.gettime := GetNextTime;
- END InitInterface;
+ PROCEDURE SendEvent(domain: Conditions.Domain;
+ condition: Conditions.Condition;
+ event: Events.Event;
+ errors: RelatedEvents.Object) : BOOLEAN;
+ BEGIN
+ WITH domain: Domain DO WITH condition: Condition DO
+ IF condition.passed THEN
+ RETURN FALSE
+ ELSE
+ domain.event := event;
+ ScheduleEvent(condition);
+ RETURN TRUE
+ END;
+ END; END;
+ END SendEvent;
+
+ PROCEDURE GetNextTime(domain: Conditions.Domain;
+ conditionSet: Conditions.ConditionSet;
+ VAR nextTime: Times.Time;
+ VAR nextCond: Conditions.Condition;
+ errors: RelatedEvents.Object);
+ VAR
+ condition: Condition;
+ BEGIN
+ GetMinTime(conditionSet, nextTime, condition);
+ nextCond := condition;
+ END GetNextTime;
+
+ PROCEDURE InitInterface;
+ BEGIN
+ NEW(if);
+ if.test := Test;
+ if.select := Select;
+ if.sendevent := SendEvent;
+ if.gettime := GetNextTime;
+ END InitInterface;
BEGIN
- disciplineId := Disciplines.Unique();
- InitInterface;
+ disciplineId := Disciplines.Unique();
+ InitInterface;
END ulmTimeConditions.
diff --git a/src/library/ulm/ulmTimers.Mod b/src/library/ulm/ulmTimers.Mod
index 88ca1996..62c45e7f 100644
--- a/src/library/ulm/ulmTimers.Mod
+++ b/src/library/ulm/ulmTimers.Mod
@@ -1,336 +1,338 @@
(* Ulm's Oberon Library
- Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
- ----------------------------------------------------------------------------
- Ulm's Oberon Library is free software; you can redistribute it
- and/or modify it under the terms of the GNU Library General Public
- License as published by the Free Software Foundation; either version
- 2 of the License, or (at your option) any later version.
+ Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
+ ----------------------------------------------------------------------------
+ Ulm's Oberon Library is free software; you can redistribute it
+ and/or modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either version
+ 2 of the License, or (at your option) any later version.
- Ulm's Oberon Library is distributed in the hope that it will be
- useful, but WITHOUT ANY WARRANTY; without even the implied warranty
- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Library General Public License for more details.
+ Ulm's Oberon Library is distributed in the hope that it will be
+ useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+ of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
- You should have received a copy of the GNU Library General Public
- License along with this library; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ----------------------------------------------------------------------------
- E-mail contact: oberon@mathematik.uni-ulm.de
- ----------------------------------------------------------------------------
- $Id: Timers.om,v 1.3 2001/04/30 14:58:18 borchert Exp $
- ----------------------------------------------------------------------------
- $Log: Timers.om,v $
- Revision 1.3 2001/04/30 14:58:18 borchert
- bug fix: recursion via Clocks.TimerOn was not possible
+ You should have received a copy of the GNU Library General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ----------------------------------------------------------------------------
+ E-mail contact: oberon@mathematik.uni-ulm.de
+ ----------------------------------------------------------------------------
+ $Id: Timers.om,v 1.3 2001/04/30 14:58:18 borchert Exp $
+ ----------------------------------------------------------------------------
+ $Log: Timers.om,v $
+ Revision 1.3 2001/04/30 14:58:18 borchert
+ bug fix: recursion via Clocks.TimerOn was not possible
- Revision 1.2 1994/07/18 14:21:51 borchert
- bug fix: CreateQueue took uninitialized priority variable instead of
- queue.priority
+ Revision 1.2 1994/07/18 14:21:51 borchert
+ bug fix: CreateQueue took uninitialized priority variable instead of
+ queue.priority
- Revision 1.1 1994/02/22 20:11:37 borchert
- Initial revision
+ Revision 1.1 1994/02/22 20:11:37 borchert
+ Initial revision
- ----------------------------------------------------------------------------
- AFB 1/92
- ----------------------------------------------------------------------------
+ ----------------------------------------------------------------------------
+ AFB 1/92
+ ----------------------------------------------------------------------------
*)
MODULE ulmTimers;
- IMPORT Clocks := ulmClocks, Disciplines := ulmDisciplines, Events := ulmEvents, Objects := ulmObjects, Op := ulmOperations, Priorities := ulmPriorities,
- SYS := ulmSYSTEM, SYSTEM, RelatedEvents := ulmRelatedEvents, Scales := ulmScales, Times := ulmTimes;
+ IMPORT Clocks := ulmClocks, Disciplines := ulmDisciplines, Events := ulmEvents, Objects := ulmObjects, Op := ulmOperations, Priorities := ulmPriorities,
+ SYS := ulmSYSTEM, RelatedEvents := ulmRelatedEvents, Scales := ulmScales, Times := ulmTimes;
- TYPE
- Queue = POINTER TO QueueRec;
- Timer* = POINTER TO TimerRec;
- TimerRec* =
- RECORD
- (Objects.ObjectRec)
- valid: BOOLEAN; (* a valid timer entry? *)
- queue: Queue; (* timer belongs to this queue *)
- prev, next: Timer; (* double-linked and sorted list *)
- time: Times.Time; (* key *)
- event: Events.Event; (* raise this event at the given time *)
- END;
- QueueRec =
- RECORD
- (Disciplines.ObjectRec)
- clock: Clocks.Clock; (* queue of this clock *)
- priority: Priorities.Priority; (* priority of the clock *)
- checkQueue: Events.EventType; (* check queue on this event *)
- head, tail: Timer; (* sorted list of timers *)
- lock: BOOLEAN;
- END;
- TYPE
- CheckQueueEvent = POINTER TO CheckQueueEventRec;
- CheckQueueEventRec =
- RECORD
- (Events.EventRec)
- queue: Queue;
- END;
- TYPE
- ClockDiscipline = POINTER TO ClockDisciplineRec;
- ClockDisciplineRec =
- RECORD
- (Disciplines.DisciplineRec)
- queue: Queue;
- END;
- VAR
- clockDisciplineId: Disciplines.Identifier;
-
- CONST
- invalidTimer* = 0; (* timer is no longer valid *)
- queueLocked* = 1; (* the queue is currently locked *)
- badClock* = 2; (* clock is unable to maintain a timer *)
- errorcodes* = 3;
- TYPE
- ErrorEvent* = POINTER TO ErrorEventRec;
- ErrorEventRec* =
- RECORD
- (Events.EventRec)
- errorcode*: SHORTINT;
- END;
- VAR
- errormsg*: ARRAY errorcodes OF Events.Message;
- error*: Events.EventType;
-
- PROCEDURE InitErrorHandling;
- BEGIN
- errormsg[invalidTimer] := "invalid timer given to Timers.Remove";
- errormsg[queueLocked] := "the queue is currently locked";
- errormsg[badClock] := "clock is unable to maintain a timer";
- Events.Define(error); Events.SetPriority(error, Priorities.liberrors);
- END InitErrorHandling;
-
- PROCEDURE Error(errors: RelatedEvents.Object; code: SHORTINT);
- VAR
- event: ErrorEvent;
- BEGIN
- NEW(event);
- event.type := error;
- event.message := errormsg[code];
- event.errorcode := code;
- RelatedEvents.Raise(errors, event);
- END Error;
-
- PROCEDURE CheckQueue(queue: Queue);
- VAR
- currentTime: Times.Time;
- oldTimers: Timer;
- p, prev: Timer;
- checkQueueEvent: CheckQueueEvent;
- nextTimer: Timer;
- BEGIN
- IF queue.head = NIL THEN queue.lock := FALSE; RETURN END;
-
- Clocks.GetTime(queue.clock, currentTime);
-
- (* remove old timers from queue *)
- oldTimers := queue.head;
- p := queue.head; prev := NIL;
- WHILE (p # NIL) & (Op.Compare(currentTime, p.time) >= 0) DO
- prev := p; p := p.next;
+ TYPE
+ Queue = POINTER TO QueueRec;
+ Timer* = POINTER TO TimerRec;
+ TimerRec* =
+ RECORD
+ (Objects.ObjectRec)
+ valid: BOOLEAN; (* a valid timer entry? *)
+ queue: Queue; (* timer belongs to this queue *)
+ prev, next: Timer; (* double-linked and sorted list *)
+ time: Times.Time; (* key *)
+ event: Events.Event; (* raise this event at the given time *)
END;
- IF p = NIL THEN
- queue.head := NIL; queue.tail := NIL;
- ELSE
- queue.head := p;
- p.prev := NIL;
+ QueueRec =
+ RECORD
+ (Disciplines.ObjectRec)
+ clock: Clocks.Clock; (* queue of this clock *)
+ priority: Priorities.Priority; (* priority of the clock *)
+ checkQueue: Events.EventType; (* check queue on this event *)
+ head, tail: Timer; (* sorted list of timers *)
+ lock: BOOLEAN;
END;
- IF prev = NIL THEN
- oldTimers := NIL;
- ELSE
- prev.next := NIL;
+ TYPE
+ CheckQueueEvent = POINTER TO CheckQueueEventRec;
+ CheckQueueEventRec =
+ RECORD
+ (Events.EventRec)
+ queue: Queue;
END;
+ TYPE
+ ClockDiscipline = POINTER TO ClockDisciplineRec;
+ ClockDisciplineRec =
+ RECORD
+ (Disciplines.DisciplineRec)
+ queue: Queue;
+ END;
+ VAR
+ clockDisciplineId: Disciplines.Identifier;
- (* set up next check-queue-event, if necessary *)
- nextTimer := queue.head;
- queue.lock := FALSE;
- (* unlock queue now to allow recursion via Clocks.TimerOn *)
- IF nextTimer # NIL THEN
- NEW(checkQueueEvent);
- checkQueueEvent.type := queue.checkQueue;
- checkQueueEvent.message := "check queue of timer";
- checkQueueEvent.queue := queue;
- Clocks.TimerOn(queue.clock, nextTimer.time, checkQueueEvent);
- ELSE
- Clocks.TimerOff(queue.clock);
+ CONST
+ invalidTimer* = 0; (* timer is no longer valid *)
+ queueLocked* = 1; (* the queue is currently locked *)
+ badClock* = 2; (* clock is unable to maintain a timer *)
+ errorcodes* = 3;
+ TYPE
+ ErrorEvent* = POINTER TO ErrorEventRec;
+ ErrorEventRec* =
+ RECORD
+ (Events.EventRec)
+ errorcode*: SHORTINT;
END;
+ VAR
+ errormsg*: ARRAY errorcodes OF Events.Message;
+ error*: Events.EventType;
- (* process old timers *)
- p := oldTimers;
- WHILE p # NIL DO
- p.valid := FALSE;
- Events.Raise(p.event);
- p := p.next;
- END;
- END CheckQueue;
+ PROCEDURE InitErrorHandling;
+ BEGIN
+ errormsg[invalidTimer] := "invalid timer given to Timers.Remove";
+ errormsg[queueLocked] := "the queue is currently locked";
+ errormsg[badClock] := "clock is unable to maintain a timer";
+ Events.Define(error); Events.SetPriority(error, Priorities.liberrors);
+ END InitErrorHandling;
- PROCEDURE CatchCheckQueueEvents(event: Events.Event);
- BEGIN
- WITH event: CheckQueueEvent DO
- IF ~SYS.TAS(event.queue.lock) THEN
- CheckQueue(event.queue);
- (* event.queue.lock := FALSE; (* done by CheckQueue *) *)
- END;
- END;
- END CatchCheckQueueEvents;
+ PROCEDURE Error(errors: RelatedEvents.Object; code: SHORTINT);
+ VAR
+ event: ErrorEvent;
+ BEGIN
+ NEW(event);
+ event.type := error;
+ event.message := errormsg[code];
+ event.errorcode := code;
+ RelatedEvents.Raise(errors, event);
+ END Error;
- PROCEDURE CreateQueue(errors: RelatedEvents.Object;
- VAR queue: Queue; clock: Clocks.Clock) : BOOLEAN;
- VAR
- clockDiscipline: ClockDiscipline;
- BEGIN
- IF ~(Clocks.timer IN Clocks.Capabilities(clock)) THEN
- Error(errors, badClock); RETURN FALSE
- END;
+ PROCEDURE CheckQueue(queue: Queue);
+ VAR
+ currentTime: Times.Time;
+ oldTimers: Timer;
+ p, prev: Timer;
+ checkQueueEvent: CheckQueueEvent;
+ nextTimer: Timer;
+ BEGIN
+ IF queue.head = NIL THEN queue.lock := FALSE; RETURN END;
- NEW(queue);
- queue.clock := clock;
+ Clocks.GetTime(queue.clock, currentTime);
+
+ (* remove old timers from queue *)
+ oldTimers := queue.head;
+ p := queue.head; prev := NIL;
+ WHILE (p # NIL) & (Op.Compare(currentTime, p.time) >= 0) DO
+ prev := p; p := p.next;
+ END;
+ IF p = NIL THEN
queue.head := NIL; queue.tail := NIL;
- queue.lock := FALSE;
- Events.Define(queue.checkQueue);
- Events.Handler(queue.checkQueue, CatchCheckQueueEvents);
- Clocks.GetPriority(clock, queue.priority);
- IF queue.priority > Priorities.base THEN
- Events.SetPriority(queue.checkQueue, queue.priority + 1);
+ ELSE
+ queue.head := p;
+ p.prev := NIL;
+ END;
+ IF prev = NIL THEN
+ oldTimers := NIL;
+ ELSE
+ prev.next := NIL;
+ END;
+
+ (* set up next check-queue-event, if necessary *)
+ nextTimer := queue.head;
+ queue.lock := FALSE;
+ (* unlock queue now to allow recursion via Clocks.TimerOn *)
+ IF nextTimer # NIL THEN
+ NEW(checkQueueEvent);
+ checkQueueEvent.type := queue.checkQueue;
+ checkQueueEvent.message := "check queue of timer";
+ checkQueueEvent.queue := queue;
+ Clocks.TimerOn(queue.clock, nextTimer.time, checkQueueEvent);
+ ELSE
+ Clocks.TimerOff(queue.clock);
+ END;
+
+ (* process old timers *)
+ p := oldTimers;
+ WHILE p # NIL DO
+ p.valid := FALSE;
+ Events.Raise(p.event);
+ p := p.next;
+ END;
+ END CheckQueue;
+
+ PROCEDURE CatchCheckQueueEvents(event: Events.Event);
+ BEGIN
+ WITH event: CheckQueueEvent DO
+ IF ~SYS.TAS(event.queue.lock) THEN
+ CheckQueue(event.queue);
+ (* event.queue.lock := FALSE; (* done by CheckQueue *) *)
+ END;
+ END;
+ END CatchCheckQueueEvents;
+
+ PROCEDURE CreateQueue(errors: RelatedEvents.Object;
+ VAR queue: Queue; clock: Clocks.Clock) : BOOLEAN;
+ VAR
+ clockDiscipline: ClockDiscipline;
+ BEGIN
+ IF ~(Clocks.timer IN Clocks.Capabilities(clock)) THEN
+ Error(errors, badClock); RETURN FALSE
+ END;
+
+ NEW(queue);
+ queue.clock := clock;
+ queue.head := NIL; queue.tail := NIL;
+ queue.lock := FALSE;
+ Events.Define(queue.checkQueue);
+ Events.Handler(queue.checkQueue, CatchCheckQueueEvents);
+ Clocks.GetPriority(clock, queue.priority);
+ IF queue.priority > Priorities.base THEN
+ Events.SetPriority(queue.checkQueue, queue.priority + 1);
+ ELSE
+ queue.priority := Priorities.default;
+ END;
+
+ NEW(clockDiscipline); clockDiscipline.id := clockDisciplineId;
+ clockDiscipline.queue := queue;
+ Disciplines.Add(clock, clockDiscipline);
+ RETURN TRUE
+ END CreateQueue;
+
+ PROCEDURE Add*(clock: Clocks.Clock; time: Times.Time; event: Events.Event;
+ VAR timer: Timer);
+ VAR
+ queue: Queue;
+ clockDiscipline: Disciplines.Discipline; (* ClockDiscipline *)
+ p: Timer;
+ absTime: Times.Time;
+ op: Op.Operand;
+ BEGIN
+ IF Disciplines.Seek(clock, clockDisciplineId, clockDiscipline) THEN
+ queue := clockDiscipline(ClockDiscipline).queue;
+ ELSIF ~CreateQueue(clock, queue, clock) THEN
+ RETURN
+ END;
+
+ IF SYS.TAS(queue.lock) THEN
+ Error(clock, queueLocked); RETURN
+ END;
+ Events.AssertPriority(queue.priority);
+
+ IF Scales.IsRelative(time) THEN
+ (* take relative time to be relative to the current time *)
+ Clocks.GetTime(clock, absTime);
+ (* Op.Add2(SYSTEM.VAL(Op.Operand, absTime), time); *)
+ op := absTime; Op.Add2(op, time); absTime := op(Times.Time);
+ ELSE
+ (* create a copy of time *)
+ op := NIL; Op.Assign(op, time); absTime := op(Times.Time);
+ END;
+ time := absTime;
+ NEW(timer); timer.time := time; timer.event := event;
+ timer.queue := queue; timer.valid := TRUE;
+
+ (* look for the insertion point *)
+ p := queue.head;
+ WHILE (p # NIL) & (Op.Compare(time, p.time) > 0) DO
+ p := p.next;
+ END;
+
+ (* insert timer in front of p *)
+ timer.next := p;
+ IF p = NIL THEN
+ (* append timer at the end of the queue *)
+ timer.prev := queue.tail;
+ IF queue.tail = NIL THEN
+ queue.head := timer;
ELSE
- queue.priority := Priorities.default;
+ queue.tail.next := timer;
END;
-
- NEW(clockDiscipline); clockDiscipline.id := clockDisciplineId;
- clockDiscipline.queue := queue;
- Disciplines.Add(clock, clockDiscipline);
- RETURN TRUE
- END CreateQueue;
-
- PROCEDURE Add*(clock: Clocks.Clock; time: Times.Time; event: Events.Event;
- VAR timer: Timer);
- VAR
- queue: Queue;
- clockDiscipline: ClockDiscipline;
- p: Timer;
- absTime: Times.Time;
- BEGIN
- IF Disciplines.Seek(clock, clockDisciplineId, SYSTEM.VAL(Disciplines.Discipline, clockDiscipline)) THEN
- queue := clockDiscipline.queue;
- ELSIF ~CreateQueue(clock, queue, clock) THEN
- RETURN
+ queue.tail := timer;
+ ELSE
+ timer.prev := p.prev;
+ timer.next := p;
+ IF p = queue.head THEN
+ queue.head := timer;
+ ELSE
+ p.prev.next := timer;
END;
+ p.prev := timer;
+ END;
+ CheckQueue(queue);
+ (* queue.lock := FALSE; (* done by CheckQueue *) *)
+ Events.ExitPriority;
+ END Add;
+
+ PROCEDURE Remove*(timer: Timer);
+ VAR
+ queue: Queue;
+ BEGIN
+ IF timer.valid THEN
+ queue := timer.queue;
IF SYS.TAS(queue.lock) THEN
- Error(clock, queueLocked); RETURN
+ Error(queue.clock, queueLocked); RETURN
END;
Events.AssertPriority(queue.priority);
-
- IF Scales.IsRelative(time) THEN
- (* take relative time to be relative to the current time *)
- Clocks.GetTime(clock, absTime);
- Op.Add2(SYSTEM.VAL(Op.Operand, absTime), time);
+ timer.valid := FALSE;
+ IF timer.prev = NIL THEN
+ queue.head := timer.next;
ELSE
- (* create a copy of time *)
- absTime := NIL; Op.Assign(SYSTEM.VAL(Op.Operand, absTime), time);
+ timer.prev.next := timer.next;
END;
- time := absTime;
- NEW(timer); timer.time := time; timer.event := event;
- timer.queue := queue; timer.valid := TRUE;
-
- (* look for the insertion point *)
- p := queue.head;
- WHILE (p # NIL) & (Op.Compare(time, p.time) > 0) DO
- p := p.next;
- END;
-
- (* insert timer in front of p *)
- timer.next := p;
- IF p = NIL THEN
- (* append timer at the end of the queue *)
- timer.prev := queue.tail;
- IF queue.tail = NIL THEN
- queue.head := timer;
- ELSE
- queue.tail.next := timer;
- END;
- queue.tail := timer;
+ IF timer.next = NIL THEN
+ queue.tail := timer.prev;
ELSE
- timer.prev := p.prev;
- timer.next := p;
- IF p = queue.head THEN
- queue.head := timer;
- ELSE
- p.prev.next := timer;
- END;
- p.prev := timer;
+ timer.next.prev := timer.prev;
END;
-
CheckQueue(queue);
(* queue.lock := FALSE; (* done by CheckQueue *) *)
Events.ExitPriority;
- END Add;
+ ELSE
+ Error(timer.queue.clock, invalidTimer);
+ END;
+ END Remove;
- PROCEDURE Remove*(timer: Timer);
- VAR
- queue: Queue;
- BEGIN
- IF timer.valid THEN
- queue := timer.queue;
- IF SYS.TAS(queue.lock) THEN
- Error(queue.clock, queueLocked); RETURN
- END;
- Events.AssertPriority(queue.priority);
- timer.valid := FALSE;
- IF timer.prev = NIL THEN
- queue.head := timer.next;
- ELSE
- timer.prev.next := timer.next;
- END;
- IF timer.next = NIL THEN
- queue.tail := timer.prev;
- ELSE
- timer.next.prev := timer.prev;
- END;
- CheckQueue(queue);
- (* queue.lock := FALSE; (* done by CheckQueue *) *)
- Events.ExitPriority;
- ELSE
- Error(timer.queue.clock, invalidTimer);
- END;
- END Remove;
+ PROCEDURE Schedule*(clock: Clocks.Clock;
+ time: Times.Time; event: Events.Event);
+ VAR
+ timer: Timer;
+ BEGIN
+ Add(clock, time, event, timer);
+ END Schedule;
- PROCEDURE Schedule*(clock: Clocks.Clock;
- time: Times.Time; event: Events.Event);
- VAR
- timer: Timer;
- BEGIN
- Add(clock, time, event, timer);
- END Schedule;
+ PROCEDURE NextEvent*(clock: Clocks.Clock; VAR time: Times.Time) : BOOLEAN;
+ VAR
+ rval: BOOLEAN;
+ queue: Queue;
+ clockDiscipline: Disciplines.Discipline; (* ClockDiscipline *)
+ BEGIN
+ IF ~Disciplines.Seek(clock, clockDisciplineId, clockDiscipline) THEN
+ RETURN FALSE
+ END;
+ queue := clockDiscipline(ClockDiscipline).queue;
- PROCEDURE NextEvent*(clock: Clocks.Clock; VAR time: Times.Time) : BOOLEAN;
- VAR
- rval: BOOLEAN;
- queue: Queue;
- clockDiscipline: ClockDiscipline;
- BEGIN
- IF ~Disciplines.Seek(clock, clockDisciplineId, SYSTEM.VAL(Disciplines.Discipline, clockDiscipline)) THEN
- RETURN FALSE
- END;
- queue := clockDiscipline.queue;
-
- IF SYS.TAS(queue.lock) THEN
- Error(clock, queueLocked); RETURN FALSE
- END;
- CheckQueue(queue);
- IF queue.head # NIL THEN
- time := queue.head.time;
- rval := TRUE;
- ELSE
- rval := FALSE
- END;
- (* queue.lock := FALSE; (* done by CheckQueue *) *)
- RETURN rval
- END NextEvent;
+ IF SYS.TAS(queue.lock) THEN
+ Error(clock, queueLocked); RETURN FALSE
+ END;
+ CheckQueue(queue);
+ IF queue.head # NIL THEN
+ time := queue.head.time;
+ rval := TRUE;
+ ELSE
+ rval := FALSE
+ END;
+ (* queue.lock := FALSE; (* done by CheckQueue *) *)
+ RETURN rval
+ END NextEvent;
BEGIN
- InitErrorHandling;
- clockDisciplineId := Disciplines.Unique();
+ InitErrorHandling;
+ clockDisciplineId := Disciplines.Unique();
END ulmTimers.
diff --git a/src/library/ulm/ulmTimes.Mod b/src/library/ulm/ulmTimes.Mod
index e7dc122f..cf45c823 100644
--- a/src/library/ulm/ulmTimes.Mod
+++ b/src/library/ulm/ulmTimes.Mod
@@ -1,398 +1,401 @@
(* Ulm's Oberon Library
- Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
- ----------------------------------------------------------------------------
- Ulm's Oberon Library is free software; you can redistribute it
- and/or modify it under the terms of the GNU Library General Public
- License as published by the Free Software Foundation; either version
- 2 of the License, or (at your option) any later version.
+ Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
+ ----------------------------------------------------------------------------
+ Ulm's Oberon Library is free software; you can redistribute it
+ and/or modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either version
+ 2 of the License, or (at your option) any later version.
- Ulm's Oberon Library is distributed in the hope that it will be
- useful, but WITHOUT ANY WARRANTY; without even the implied warranty
- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Library General Public License for more details.
+ Ulm's Oberon Library is distributed in the hope that it will be
+ useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+ of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
- You should have received a copy of the GNU Library General Public
- License along with this library; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ----------------------------------------------------------------------------
- E-mail contact: oberon@mathematik.uni-ulm.de
- ----------------------------------------------------------------------------
- $Id: Times.om,v 1.3 2001/04/30 14:54:44 borchert Exp $
- ----------------------------------------------------------------------------
- $Log: Times.om,v $
- Revision 1.3 2001/04/30 14:54:44 borchert
- bug fix: base type is TimeRec instead of Times.TimeRec
- (invalid self-reference)
+ You should have received a copy of the GNU Library General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ----------------------------------------------------------------------------
+ E-mail contact: oberon@mathematik.uni-ulm.de
+ ----------------------------------------------------------------------------
+ $Id: Times.om,v 1.3 2001/04/30 14:54:44 borchert Exp $
+ ----------------------------------------------------------------------------
+ $Log: Times.om,v $
+ Revision 1.3 2001/04/30 14:54:44 borchert
+ bug fix: base type is TimeRec instead of Times.TimeRec
+ (invalid self-reference)
- Revision 1.2 1995/04/07 13:25:07 borchert
- fixes due to changed if of PersistentObjects
+ Revision 1.2 1995/04/07 13:25:07 borchert
+ fixes due to changed if of PersistentObjects
- Revision 1.1 1994/02/22 20:12:02 borchert
- Initial revision
+ Revision 1.1 1994/02/22 20:12:02 borchert
+ Initial revision
- ----------------------------------------------------------------------------
- AFB 12/91
- ----------------------------------------------------------------------------
+ ----------------------------------------------------------------------------
+ AFB 12/91
+ ----------------------------------------------------------------------------
*)
MODULE ulmTimes;
- IMPORT NetIO := ulmNetIO, Objects := ulmObjects, Operations := ulmOperations, PersistentObjects := ulmPersistentObjects, Scales := ulmScales,
- Services := ulmServices, Streams := ulmStreams, SYSTEM;
+ IMPORT NetIO := ulmNetIO, Objects := ulmObjects, Operations := ulmOperations, PersistentObjects := ulmPersistentObjects, Scales := ulmScales,
+ Services := ulmServices, Streams := ulmStreams;
- CONST
- relative* = Scales.relative;
- absolute* = Scales.absolute;
- TYPE
- (* the common base type of all time measures *)
- Time* = POINTER TO TimeRec;
- TimeRec* = RECORD (Scales.MeasureRec) END;
+ CONST
+ relative* = Scales.relative;
+ absolute* = Scales.absolute;
+ TYPE
+ (* the common base type of all time measures *)
+ Time* = POINTER TO TimeRec;
+ TimeRec* = RECORD (Scales.MeasureRec) END;
- CONST
- usecsPerSec = 1000000; (* 10^6 *)
- TYPE
- (* units of the reference implementation:
- epoch, second and usec
- *)
- TimeValueRec* =
- RECORD
- (Objects.ObjectRec)
- (* epoch 0: Jan. 1, 1970;
- each epoch has a length of MAX(Scales.Value) + 1 seconds;
- epoch may be negative:
- -1 is the epoch just before 1970
- *)
- epoch*: Scales.Value;
- (* seconds and ... *)
- second*: Scales.Value;
- (* ... microseconds since the beginning of the epoch *)
- usec*: Scales.Value;
- END;
-
- (* ==== private datatypes for the reference scale *)
- TYPE
- ReferenceTime = POINTER TO ReferenceTimeRec;
- ReferenceTimeRec =
- RECORD
- (TimeRec)
- timeval: TimeValueRec;
- END;
- VAR
- absType, relType: Services.Type;
- CONST
- epochUnit = 0; secondUnit = 1; usecUnit = 2;
- TYPE
- Unit = POINTER TO UnitRec;
- UnitRec =
- RECORD
- (Scales.UnitRec)
- index: SHORTINT; (* epochUnit..usecUnit *)
- END;
-
- VAR
- scale*: Scales.Scale; (* reference scale *)
- family*: Scales.Family; (* family of time scales *)
- if: Scales.Interface;
-
- PROCEDURE Create*(VAR time: Time; type: SHORTINT);
- (* type = absolute or relative *)
- VAR
- m: Scales.Measure;
- BEGIN
- Scales.CreateMeasure(scale, m, type);
- time := m(Time);
- END Create;
-
- PROCEDURE Normalize(VAR timeval: TimeValueRec);
- (* make sure that second and usec >= 0 *)
- VAR
- toomanysecs: Scales.Value;
- secs: Scales.Value;
- BEGIN
- IF timeval.second < 0 THEN
- INC(timeval.second, 1);
- INC(timeval.second, MAX(Scales.Value));
- DEC(timeval.epoch);
+ CONST
+ usecsPerSec = 1000000; (* 10^6 *)
+ TYPE
+ (* units of the reference implementation:
+ epoch, second and usec
+ *)
+ TimeValueRec* =
+ RECORD
+ (Objects.ObjectRec)
+ (* epoch 0: Jan. 1, 1970;
+ each epoch has a length of MAX(Scales.Value) + 1 seconds;
+ epoch may be negative:
+ -1 is the epoch just before 1970
+ *)
+ epoch*: Scales.Value;
+ (* seconds and ... *)
+ second*: Scales.Value;
+ (* ... microseconds since the beginning of the epoch *)
+ usec*: Scales.Value;
END;
- IF timeval.usec < 0 THEN
- toomanysecs := timeval.usec DIV usecsPerSec;
- IF toomanysecs > timeval.second THEN
- timeval.second := - toomanysecs + MAX(Scales.Value) + 1 +
- timeval.second;
- DEC(timeval.epoch);
- ELSE
- DEC(timeval.second, toomanysecs);
- END;
- timeval.usec := timeval.usec MOD usecsPerSec;
- ELSIF timeval.usec >= usecsPerSec THEN
- secs := timeval.usec DIV usecsPerSec;
- IF MAX(Scales.Value) - timeval.second <= secs THEN
- INC(timeval.second, secs);
- ELSE
- timeval.second := secs - (MAX(Scales.Value) - timeval.second);
- INC(timeval.epoch);
- END;
- timeval.usec := timeval.usec MOD usecsPerSec;
- END;
- END Normalize;
- PROCEDURE SetValue*(time: Time; value: TimeValueRec);
- VAR
- refTime: Time;
- scaleOfTime: Scales.Scale;
- BEGIN
- Normalize(value);
- IF time IS ReferenceTime THEN
- WITH time: ReferenceTime DO
- time.timeval := value;
- END;
+ (* ==== private datatypes for the reference scale *)
+ TYPE
+ ReferenceTime = POINTER TO ReferenceTimeRec;
+ ReferenceTimeRec =
+ RECORD
+ (TimeRec)
+ timeval: TimeValueRec;
+ END;
+ VAR
+ absType, relType: Services.Type;
+ CONST
+ epochUnit = 0; secondUnit = 1; usecUnit = 2;
+ TYPE
+ Unit = POINTER TO UnitRec;
+ UnitRec =
+ RECORD
+ (Scales.UnitRec)
+ index: SHORTINT; (* epochUnit..usecUnit *)
+ END;
+
+ VAR
+ scale*: Scales.Scale; (* reference scale *)
+ family*: Scales.Family; (* family of time scales *)
+ if: Scales.Interface;
+
+ PROCEDURE Create*(VAR time: Time; type: SHORTINT);
+ (* type = absolute or relative *)
+ VAR
+ m: Scales.Measure;
+ BEGIN
+ Scales.CreateMeasure(scale, m, type);
+ time := m(Time);
+ END Create;
+
+ PROCEDURE Normalize(VAR timeval: TimeValueRec);
+ (* make sure that second and usec >= 0 *)
+ VAR
+ toomanysecs: Scales.Value;
+ secs: Scales.Value;
+ BEGIN
+ IF timeval.second < 0 THEN
+ INC(timeval.second, 1);
+ INC(timeval.second, MAX(Scales.Value));
+ DEC(timeval.epoch);
+ END;
+ IF timeval.usec < 0 THEN
+ toomanysecs := timeval.usec DIV usecsPerSec;
+ IF toomanysecs > timeval.second THEN
+ timeval.second := - toomanysecs + MAX(Scales.Value) + 1 +
+ timeval.second;
+ DEC(timeval.epoch);
ELSE
- Create(refTime, Scales.MeasureType(time));
- refTime(ReferenceTime).timeval := value;
- Scales.GetScale(time, scaleOfTime);
- Scales.ConvertMeasure(scaleOfTime, SYSTEM.VAL(Scales.Measure, refTime));
- Operations.Copy(refTime, time);
+ DEC(timeval.second, toomanysecs);
END;
- END SetValue;
-
- PROCEDURE CreateAndSet*(VAR time: Time; type: SHORTINT;
- epoch, second, usec: Scales.Value);
- VAR
- timeval: TimeValueRec;
- BEGIN
- Create(time, type);
- timeval.epoch := epoch; timeval.second := second; timeval.usec := usec;
- SetValue(time, timeval);
- END CreateAndSet;
-
- PROCEDURE GetValue*(time: Time; VAR value: TimeValueRec);
- BEGIN
- IF ~(time IS ReferenceTime) THEN
- Scales.ConvertMeasure(scale, SYSTEM.VAL(Scales.Measure, time));
- END;
- value := time(ReferenceTime).timeval;
- END GetValue;
-
- (* ===== interface procedures =================================== *)
-
- PROCEDURE InternalCreate(scale: Scales.Scale;
- VAR measure: Scales.Measure; abs: BOOLEAN);
- VAR
- time: ReferenceTime;
- BEGIN
- NEW(time);
- time.timeval.epoch := 0;
- time.timeval.second := 0;
- time.timeval.usec := 0;
- IF abs THEN
- PersistentObjects.Init(time, absType);
+ timeval.usec := timeval.usec MOD usecsPerSec;
+ ELSIF timeval.usec >= usecsPerSec THEN
+ secs := timeval.usec DIV usecsPerSec;
+ IF MAX(Scales.Value) - timeval.second <= secs THEN
+ INC(timeval.second, secs);
ELSE
- PersistentObjects.Init(time, relType);
+ timeval.second := secs - (MAX(Scales.Value) - timeval.second);
+ INC(timeval.epoch);
END;
- measure := time;
- END InternalCreate;
+ timeval.usec := timeval.usec MOD usecsPerSec;
+ END;
+ END Normalize;
- PROCEDURE InternalGetValue(measure: Scales.Measure; unit: Scales.Unit;
- VAR value: Scales.Value);
- BEGIN
- WITH measure: ReferenceTime DO WITH unit: Unit DO
- CASE unit.index OF
- | epochUnit: value := measure.timeval.epoch;
- | secondUnit: value := measure.timeval.second;
- | usecUnit: value := measure.timeval.usec;
+ PROCEDURE SetValue*(time: Time; value: TimeValueRec);
+ VAR
+ refTime: Time;
+ measure: Scales.Measure;
+ scaleOfTime: Scales.Scale;
+ BEGIN
+ Normalize(value);
+ IF time IS ReferenceTime THEN
+ WITH time: ReferenceTime DO
+ time.timeval := value;
+ END;
ELSE
- END;
- END; END;
- END InternalGetValue;
+ Create(refTime, Scales.MeasureType(time));
+ refTime(ReferenceTime).timeval := value;
+ Scales.GetScale(time, scaleOfTime);
+ measure := refTime;
+ Scales.ConvertMeasure(scaleOfTime, measure);
+ Operations.Copy(measure, time);
+ END;
+ END SetValue;
- PROCEDURE InternalSetValue(measure: Scales.Measure; unit: Scales.Unit;
- value: Scales.Value);
- BEGIN
- WITH measure: ReferenceTime DO WITH unit: Unit DO
- CASE unit.index OF
- | epochUnit: measure.timeval.epoch := value;
- | secondUnit: measure.timeval.second := value;
- | usecUnit: measure.timeval.usec := value;
+ PROCEDURE CreateAndSet*(VAR time: Time; type: SHORTINT;
+ epoch, second, usec: Scales.Value);
+ VAR
+ timeval: TimeValueRec;
+ BEGIN
+ Create(time, type);
+ timeval.epoch := epoch; timeval.second := second; timeval.usec := usec;
+ SetValue(time, timeval);
+ END CreateAndSet;
+
+ PROCEDURE GetValue*(time: Time; VAR value: TimeValueRec);
+ VAR mtime: Scales.Measure;
+ BEGIN
+ IF ~(time IS ReferenceTime) THEN
+ Scales.ConvertMeasure(scale, mtime); time := mtime(Time)
+ END;
+ value := time(ReferenceTime).timeval;
+ END GetValue;
+
+ (* ===== interface procedures =================================== *)
+
+ PROCEDURE InternalCreate(scale: Scales.Scale;
+ VAR measure: Scales.Measure; abs: BOOLEAN);
+ VAR
+ time: ReferenceTime;
+ BEGIN
+ NEW(time);
+ time.timeval.epoch := 0;
+ time.timeval.second := 0;
+ time.timeval.usec := 0;
+ IF abs THEN
+ PersistentObjects.Init(time, absType);
ELSE
- END;
- Normalize(measure.timeval);
- END; END;
- END InternalSetValue;
+ PersistentObjects.Init(time, relType);
+ END;
+ measure := time;
+ END InternalCreate;
- PROCEDURE Assign(target: Scales.Measure; source: Scales.Measure);
- BEGIN
- WITH target: ReferenceTime DO WITH source: ReferenceTime DO
- target.timeval := source.timeval;
- END; END;
- END Assign;
-
- PROCEDURE Op(op: Scales.Operation; op1, op2, result: Scales.Measure);
-
- PROCEDURE Add(op1, op2: TimeValueRec; VAR result: TimeValueRec);
- BEGIN
- result.epoch := op1.epoch + op2.epoch;
- IF op1.second > MAX(Scales.Value) - op2.second THEN
- INC(result.epoch);
- result.second := op1.second - MAX(Scales.Value) - 1 +
- op2.second;
- ELSE
- result.second := op1.second + op2.second;
- END;
- result.usec := op1.usec + op2.usec;
- IF result.usec > usecsPerSec THEN
- DEC(result.usec, usecsPerSec);
- IF result.second = MAX(Scales.Value) THEN
- result.second := 0; INC(result.epoch);
- ELSE
- INC(result.second);
- END;
- END;
- END Add;
-
- PROCEDURE Sub(op1, op2: TimeValueRec; VAR result: TimeValueRec);
- BEGIN
- result.epoch := op1.epoch - op2.epoch;
- IF op1.second >= op2.second THEN
- result.second := op1.second - op2.second;
- ELSE
- DEC(result.epoch);
- result.second := - op2.second + MAX(Scales.Value) + 1 + op1.second;
- END;
- result.usec := op1.usec - op2.usec;
- IF result.usec < 0 THEN
- INC(result.usec, usecsPerSec);
- IF result.second = 0 THEN
- result.second := MAX(Scales.Value);
- DEC(result.epoch);
- ELSE
- DEC(result.second);
- END;
- END;
- END Sub;
-
- BEGIN
- WITH op1: ReferenceTime DO WITH op2: ReferenceTime DO
- WITH result: ReferenceTime DO
- CASE op OF
- | Scales.add: Add(op1.timeval, op2.timeval, result.timeval);
- | Scales.sub: Sub(op1.timeval, op2.timeval, result.timeval);
- ELSE
- END;
- END;
- END; END;
- END Op;
-
- PROCEDURE Compare(op1, op2: Scales.Measure) : INTEGER;
-
- PROCEDURE ReturnVal(val1, val2: Scales.Value) : INTEGER;
- BEGIN
- IF val1 < val2 THEN
- RETURN -1
- ELSIF val1 > val2 THEN
- RETURN 1
- ELSE
- RETURN 0
- END;
- END ReturnVal;
-
- BEGIN
- WITH op1: ReferenceTime DO
- WITH op2: ReferenceTime DO
- IF op1.timeval.epoch # op2.timeval.epoch THEN
- RETURN ReturnVal(op1.timeval.epoch, op2.timeval.epoch)
- ELSIF op1.timeval.second # op2.timeval.second THEN
- RETURN ReturnVal(op1.timeval.second, op2.timeval.second)
- ELSE
- RETURN ReturnVal(op1.timeval.usec, op2.timeval.usec)
- END;
- END;
+ PROCEDURE InternalGetValue(measure: Scales.Measure; unit: Scales.Unit;
+ VAR value: Scales.Value);
+ BEGIN
+ WITH measure: ReferenceTime DO WITH unit: Unit DO
+ CASE unit.index OF
+ | epochUnit: value := measure.timeval.epoch;
+ | secondUnit: value := measure.timeval.second;
+ | usecUnit: value := measure.timeval.usec;
+ ELSE
END;
- RETURN 0;
- END Compare;
+ END; END;
+ END InternalGetValue;
- (* ========= initialization procedures ========================== *)
-
- PROCEDURE InitInterface;
- VAR
- timeType: Services.Type;
- BEGIN
- NEW(if);
- if.create := InternalCreate;
- if.getvalue := InternalGetValue; if.setvalue := InternalSetValue;
- if.assign := Assign; if.op := Op; if.compare := Compare;
- (* conversion procedures are not necessary *)
-
- PersistentObjects.RegisterType(timeType, "Times.Time", "Scales.Measure",
- NIL);
- END InitInterface;
-
- PROCEDURE CreateAbs(VAR object: PersistentObjects.Object);
- VAR
- measure: Scales.Measure;
- BEGIN
- Scales.CreateAbsMeasure(scale, measure);
- object := measure;
- END CreateAbs;
-
- PROCEDURE CreateRel(VAR object: PersistentObjects.Object);
- VAR
- measure: Scales.Measure;
- BEGIN
- Scales.CreateRelMeasure(scale, measure);
- object := measure;
- END CreateRel;
-
- PROCEDURE Write(s: Streams.Stream;
- object: PersistentObjects.Object) : BOOLEAN;
- BEGIN
- WITH object: ReferenceTime DO
- RETURN NetIO.WriteLongInt(s, object.timeval.epoch) &
- NetIO.WriteLongInt(s, object.timeval.second) &
- NetIO.WriteLongInt(s, object.timeval.usec)
+ PROCEDURE InternalSetValue(measure: Scales.Measure; unit: Scales.Unit;
+ value: Scales.Value);
+ BEGIN
+ WITH measure: ReferenceTime DO WITH unit: Unit DO
+ CASE unit.index OF
+ | epochUnit: measure.timeval.epoch := value;
+ | secondUnit: measure.timeval.second := value;
+ | usecUnit: measure.timeval.usec := value;
+ ELSE
END;
- END Write;
+ Normalize(measure.timeval);
+ END; END;
+ END InternalSetValue;
- PROCEDURE Read(s: Streams.Stream;
- object: PersistentObjects.Object) : BOOLEAN;
- BEGIN
- WITH object: ReferenceTime DO
- RETURN NetIO.ReadLongInt(s, object.timeval.epoch) &
- NetIO.ReadLongInt(s, object.timeval.second) &
- NetIO.ReadLongInt(s, object.timeval.usec)
+ PROCEDURE Assign(target: Scales.Measure; source: Scales.Measure);
+ BEGIN
+ WITH target: ReferenceTime DO WITH source: ReferenceTime DO
+ target.timeval := source.timeval;
+ END; END;
+ END Assign;
+
+ PROCEDURE Op(op: Scales.Operation; op1, op2, result: Scales.Measure);
+
+ PROCEDURE Add(op1, op2: TimeValueRec; VAR result: TimeValueRec);
+ BEGIN
+ result.epoch := op1.epoch + op2.epoch;
+ IF op1.second > MAX(Scales.Value) - op2.second THEN
+ INC(result.epoch);
+ result.second := op1.second - MAX(Scales.Value) - 1 +
+ op2.second;
+ ELSE
+ result.second := op1.second + op2.second;
END;
- END Read;
+ result.usec := op1.usec + op2.usec;
+ IF result.usec > usecsPerSec THEN
+ DEC(result.usec, usecsPerSec);
+ IF result.second = MAX(Scales.Value) THEN
+ result.second := 0; INC(result.epoch);
+ ELSE
+ INC(result.second);
+ END;
+ END;
+ END Add;
- PROCEDURE InitRefScale;
+ PROCEDURE Sub(op1, op2: TimeValueRec; VAR result: TimeValueRec);
+ BEGIN
+ result.epoch := op1.epoch - op2.epoch;
+ IF op1.second >= op2.second THEN
+ result.second := op1.second - op2.second;
+ ELSE
+ DEC(result.epoch);
+ result.second := - op2.second + MAX(Scales.Value) + 1 + op1.second;
+ END;
+ result.usec := op1.usec - op2.usec;
+ IF result.usec < 0 THEN
+ INC(result.usec, usecsPerSec);
+ IF result.second = 0 THEN
+ result.second := MAX(Scales.Value);
+ DEC(result.epoch);
+ ELSE
+ DEC(result.second);
+ END;
+ END;
+ END Sub;
+ BEGIN
+ WITH op1: ReferenceTime DO WITH op2: ReferenceTime DO
+ WITH result: ReferenceTime DO
+ CASE op OF
+ | Scales.add: Add(op1.timeval, op2.timeval, result.timeval);
+ | Scales.sub: Sub(op1.timeval, op2.timeval, result.timeval);
+ ELSE
+ END;
+ END;
+ END; END;
+ END Op;
+
+ PROCEDURE Compare(op1, op2: Scales.Measure) : INTEGER;
+
+ PROCEDURE ReturnVal(val1, val2: Scales.Value) : INTEGER;
+ BEGIN
+ IF val1 < val2 THEN
+ RETURN -1
+ ELSIF val1 > val2 THEN
+ RETURN 1
+ ELSE
+ RETURN 0
+ END;
+ END ReturnVal;
+
+ BEGIN
+ WITH op1: ReferenceTime DO
+ WITH op2: ReferenceTime DO
+ IF op1.timeval.epoch # op2.timeval.epoch THEN
+ RETURN ReturnVal(op1.timeval.epoch, op2.timeval.epoch)
+ ELSIF op1.timeval.second # op2.timeval.second THEN
+ RETURN ReturnVal(op1.timeval.second, op2.timeval.second)
+ ELSE
+ RETURN ReturnVal(op1.timeval.usec, op2.timeval.usec)
+ END;
+ END;
+ END;
+ RETURN 0;
+ END Compare;
+
+ (* ========= initialization procedures ========================== *)
+
+ PROCEDURE InitInterface;
+ VAR
+ timeType: Services.Type;
+ BEGIN
+ NEW(if);
+ if.create := InternalCreate;
+ if.getvalue := InternalGetValue; if.setvalue := InternalSetValue;
+ if.assign := Assign; if.op := Op; if.compare := Compare;
+ (* conversion procedures are not necessary *)
+
+ PersistentObjects.RegisterType(timeType, "Times.Time", "Scales.Measure",
+ NIL);
+ END InitInterface;
+
+ PROCEDURE CreateAbs(VAR object: PersistentObjects.Object);
+ VAR
+ measure: Scales.Measure;
+ BEGIN
+ Scales.CreateAbsMeasure(scale, measure);
+ object := measure;
+ END CreateAbs;
+
+ PROCEDURE CreateRel(VAR object: PersistentObjects.Object);
+ VAR
+ measure: Scales.Measure;
+ BEGIN
+ Scales.CreateRelMeasure(scale, measure);
+ object := measure;
+ END CreateRel;
+
+ PROCEDURE Write(s: Streams.Stream;
+ object: PersistentObjects.Object) : BOOLEAN;
+ BEGIN
+ WITH object: ReferenceTime DO
+ RETURN NetIO.WriteLongInt(s, object.timeval.epoch) &
+ NetIO.WriteLongInt(s, object.timeval.second) &
+ NetIO.WriteLongInt(s, object.timeval.usec)
+ END;
+ END Write;
+
+ PROCEDURE Read(s: Streams.Stream;
+ object: PersistentObjects.Object) : BOOLEAN;
+ BEGIN
+ WITH object: ReferenceTime DO
+ RETURN NetIO.ReadLongInt(s, object.timeval.epoch) &
+ NetIO.ReadLongInt(s, object.timeval.second) &
+ NetIO.ReadLongInt(s, object.timeval.usec)
+ END;
+ END Read;
+
+ PROCEDURE InitRefScale;
+
+ VAR
+ poif: PersistentObjects.Interface;
+
+ PROCEDURE InitUnit(unitIndex: SHORTINT; name: Scales.UnitName);
VAR
- poif: PersistentObjects.Interface;
+ unit: Unit;
+ BEGIN
+ NEW(unit); unit.index := unitIndex;
+ Scales.InitUnit(scale, unit, name);
+ END InitUnit;
- PROCEDURE InitUnit(unitIndex: SHORTINT; name: Scales.UnitName);
- VAR
- unit: Unit;
- BEGIN
- NEW(unit); unit.index := unitIndex;
- Scales.InitUnit(scale, unit, name);
- END InitUnit;
+ BEGIN
+ NEW(scale); Scales.Init(scale, NIL, if);
+ InitUnit(epochUnit, "epoch");
+ InitUnit(secondUnit, "second");
+ InitUnit(usecUnit, "usec");
- BEGIN
- NEW(scale); Scales.Init(scale, NIL, if);
- InitUnit(epochUnit, "epoch");
- InitUnit(secondUnit, "second");
- InitUnit(usecUnit, "usec");
-
- NEW(poif); poif.read := Read; poif.write := Write;
- poif.create := CreateAbs; poif.createAndRead := NIL;
- PersistentObjects.RegisterType(absType,
- "Times.AbsReferenceTime", "Times.Time", poif);
- NEW(poif); poif.read := Read; poif.write := Write;
- poif.create := CreateRel; poif.createAndRead := NIL;
- PersistentObjects.RegisterType(relType,
- "Times.RelReferenceTime", "Times.Time", poif);
- END InitRefScale;
+ NEW(poif); poif.read := Read; poif.write := Write;
+ poif.create := CreateAbs; poif.createAndRead := NIL;
+ PersistentObjects.RegisterType(absType,
+ "Times.AbsReferenceTime", "Times.Time", poif);
+ NEW(poif); poif.read := Read; poif.write := Write;
+ poif.create := CreateRel; poif.createAndRead := NIL;
+ PersistentObjects.RegisterType(relType,
+ "Times.RelReferenceTime", "Times.Time", poif);
+ END InitRefScale;
BEGIN
- InitInterface;
- InitRefScale;
- NEW(family); Scales.InitFamily(family, scale);
+ InitInterface;
+ InitRefScale;
+ NEW(family); Scales.InitFamily(family, scale);
END ulmTimes.
diff --git a/src/library/ulm/ulmTypes.Mod b/src/library/ulm/ulmTypes.Mod
index c9d6f4fe..93bab9fc 100644
--- a/src/library/ulm/ulmTypes.Mod
+++ b/src/library/ulm/ulmTypes.Mod
@@ -50,15 +50,8 @@ MODULE ulmTypes;
IMPORT SYS := SYSTEM;
TYPE
- Address* = LONGINT (*SYS.ADDRESS*);
- (* ulm compiler can accept
- VAR p : SYSTEM.ADDRESS; // SYSTEM.PTR in ETH and V4 versions
- ...
- p := SYSTEM.ADR(something);
- and this is how it is used in ulm oberon system library,
- while SYSTEM.ADR returns LONGINT in ETH and V4 versions.
- Thus I leave it as LONGINT for now, before coming up with better solution -- noch *)
-
+ Address* = SYS.ADDRESS;
+
UntracedAddress* = POINTER[1] TO UntracedAddressDesc; (*SYS.UNTRACEDADDRESS;*)
UntracedAddressDesc* = RECORD[1] END;
diff --git a/src/library/v4/Args.Mod b/src/library/v4/Args.Mod
index 0d4ff925..a196b5c5 100644
--- a/src/library/v4/Args.Mod
+++ b/src/library/v4/Args.Mod
@@ -3,7 +3,7 @@ MODULE Args; (* jt, 8.12.94 *)
(* command line argument handling for voc (jet backend) *)
- IMPORT Platform;
+ IMPORT Platform, SYSTEM;
TYPE
ArgPtr = POINTER TO ARRAY 1024 OF CHAR;
@@ -11,17 +11,17 @@ MODULE Args; (* jt, 8.12.94 *)
VAR
argc-: LONGINT;
- argv-: LONGINT;
+ argv-: SYSTEM.ADDRESS;
PROCEDURE Get* (n: INTEGER; VAR val: ARRAY OF CHAR); BEGIN Platform.GetArg(n, val) END Get;
PROCEDURE GetInt*(n: INTEGER; VAR val: LONGINT); BEGIN Platform.GetIntArg(n, val) END GetInt;
PROCEDURE Pos* (s: ARRAY OF CHAR): INTEGER; BEGIN RETURN Platform.ArgPos(s) END Pos;
-PROCEDURE GetEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR);
+PROCEDURE GetEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR);
BEGIN Platform.GetEnv(var, val) END GetEnv;
-PROCEDURE getEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR): BOOLEAN;
+PROCEDURE getEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR): BOOLEAN;
BEGIN RETURN Platform.getEnv(var, val) END getEnv;
diff --git a/src/system/Console.Mod b/src/library/v4/Console.Mod
similarity index 82%
rename from src/system/Console.Mod
rename to src/library/v4/Console.Mod
index 8e2be161..070ba46b 100644
--- a/src/system/Console.Mod
+++ b/src/library/v4/Console.Mod
@@ -10,7 +10,7 @@ MODULE Console; (* J. Templ, 29-June-96 *)
PROCEDURE Flush*;
VAR error: Platform.ErrorCode;
BEGIN
- error := Platform.Write(Platform.StdOut, SYSTEM.ADR(line), pos);
+ error := Platform.Write(Platform.StdOut, SYSTEM.ADR(line), pos);
pos := 0;
END Flush;
@@ -27,7 +27,8 @@ MODULE Console; (* J. Templ, 29-June-96 *)
WHILE s[i] # 0X DO Char(s[i]); INC(i) END
END String;
- PROCEDURE Int*(i, n: LONGINT);
+(* todo. support int64 properly *)
+ PROCEDURE Int*(i, n: SYSTEM.INT64);
VAR s: ARRAY 32 OF CHAR; i1, k: LONGINT;
BEGIN
IF i = SYSTEM.LSH(LONG(LONG(1)), SIZE(LONGINT)*8 - 1) THEN
@@ -35,7 +36,7 @@ MODULE Console; (* J. Templ, 29-June-96 *)
ELSE s := "8463847412"; k := 10
END
ELSE
- i1 := ABS(i);
+ i1 := ABS(SYSTEM.VAL(LONGINT,i));
s[0] := CHR(i1 MOD 10 + ORD("0")); i1 := i1 DIV 10; k := 1;
WHILE i1 > 0 DO s[k] := CHR(i1 MOD 10 + ORD("0")); i1 := i1 DIV 10; INC(k) END
END ;
@@ -45,7 +46,7 @@ MODULE Console; (* J. Templ, 29-June-96 *)
END Int;
PROCEDURE Ln*;
- BEGIN Char(0AX); (* Unix end-of-line *)
+ BEGIN String(Platform.NL);
END Ln;
PROCEDURE Bool*(b: BOOLEAN);
@@ -53,9 +54,9 @@ MODULE Console; (* J. Templ, 29-June-96 *)
END Bool;
PROCEDURE Hex*(i: LONGINT);
- VAR k, n: LONGINT;
+ VAR k: INTEGER; n: SYSTEM.INT64;
BEGIN
- k := -28;
+ k := 4 - 8 * SIZE(LONGINT);
WHILE k <= 0 DO
n := ASH(i, k) MOD 16;
IF n <= 9 THEN Char(CHR(ORD("0") + n)) ELSE Char(CHR(ORD("A") - 10 + n)) END ;
@@ -74,7 +75,12 @@ MODULE Console; (* J. Templ, 29-June-96 *)
VAR i: LONGINT; ch: CHAR;
BEGIN Flush();
i := 0; Read(ch);
- WHILE (i < LEN(line) - 1) & (ch # 0AX) & (ch # 0X) DO line[i] := ch; INC(i); Read(ch) END ;
+ WHILE (i < LEN(line) - 1)
+ & (ch # 0AX)
+ & (ch # 0X) DO
+ line[i] := ch; INC(i); Read(ch)
+ END;
+ IF (i > 0) & (line[i-1] = 0DX) THEN DEC(i) END; (* Swallow CR before LF *)
line[i] := 0X
END ReadLine;
diff --git a/src/library/v4/Printer.Mod b/src/library/v4/Printer.Mod
index 39b06c0c..803b567f 100644
--- a/src/library/v4/Printer.Mod
+++ b/src/library/v4/Printer.Mod
@@ -87,7 +87,7 @@ MODULE Printer; (*UNIX version: JT 11.5.90, RC 2.7.93, JS 29.4.94, JT 14.4.95
VAR family: ARRAY 7 OF CHAR;
BEGIN
COPY(fname, family);
- Ch(fontR, "/"); Str(fontR, fname);
+ Ch(fontR, "/"); Str(fontR, fname);
IF family = "Syntax" THEN Str(fontR, " DefineSMapFont") ELSE Str(fontR, " DefineMapFont") END;
Ln(fontR); Ln(fontR);
END SetMappedFont;
@@ -161,7 +161,7 @@ MODULE Printer; (*UNIX version: JT 11.5.90, RC 2.7.93, JS 29.4.94, JT 14.4.95
| 92: Str(fontR, "backslash")
| 93: Str(fontR, "bracketright")
| 94: Str(fontR, "arrowup")
- | 95: Str(fontR, "underscore")
+ | 95: Str(fontR, "underscore")
| 96: Str(fontR, "grave")
| 97..122: Ch(fontR, CHR(m))
| 123: Str(fontR, "braceleft")
@@ -205,8 +205,8 @@ MODULE Printer; (*UNIX version: JT 11.5.90, RC 2.7.93, JS 29.4.94, JT 14.4.95
Str(fontR, "% Conversion of the Oberon font "); Str(fontR, fd.name); Ln(fontR);
Files.Read(R, ch);
IF ch = fontFileId THEN
- Files.Read(R, ch); Str(fontR, "% abstraction: "); Int(fontR, ORD(ch));
- Files.Read(R, ch); Str(fontR, ", family: "); Ch(fontR, ch);
+ Files.Read(R, ch); Str(fontR, "% abstraction: "); Int(fontR, ORD(ch));
+ Files.Read(R, ch); Str(fontR, ", family: "); Ch(fontR, ch);
Files.Read(R, ch); Str(fontR, ", variant: "); Int(fontR, ORD(ch)); Ln(fontR);
Files.ReadInt(R, height); Str(fontR, "% height: "); Int(fontR, height); Ln(fontR); Ln(fontR);
Files.ReadInt(R, minX); Files.ReadInt(R, maxX);
@@ -223,7 +223,7 @@ MODULE Printer; (*UNIX version: JT 11.5.90, RC 2.7.93, JS 29.4.94, JT 14.4.95
Str(fontR, "/FontMatrix [ 72 "); Int(fontR, pRes); Str(fontR, " div "); Str(fontR, " .24 div 0 0 ");
Str(fontR, "72 "); Int(fontR, pRes); Str(fontR, " div "); Str(fontR, " .24 div 0 0");
Str(fontR, "] def"); Ln(fontR);
- Str(fontR, "/FontBBox [");
+ Str(fontR, "/FontBBox [");
Int(fontR, minX); Ch(fontR, " ");
Int(fontR, minY); Ch(fontR, " ");
Int(fontR, maxX); Ch(fontR, " ");
@@ -339,7 +339,7 @@ END;
Error("file not found", headerFileName)
END
END Open;
-
+
PROCEDURE UseListFont*(VAR name: ARRAY OF CHAR);
BEGIN
COPY(name, listFont); curFont := -1
@@ -368,7 +368,7 @@ END;
IF fname = listFont THEN fontname := "Courier8.Scn.Fnt" ELSE COPY(fname, fontname) END ;
IF (curFont < 0) OR (fontTable[curFont].name # fontname) THEN
COPY(fontname, fontTable[fontIndex+1].name);
- i := 0; WHILE i < 8 DO fontTable[fontIndex+1].used[i] := {}; INC(i) END;
+ i := 0; WHILE i < 8 DO fontTable[fontIndex+1].used[i] := {}; INC(i) END;
fNo := 0;
WHILE fontTable[fNo].name # fontname DO INC(fNo) END;
IF fNo > fontIndex THEN (* DefineFont(fontname); *) fontIndex := fNo END;
@@ -394,7 +394,7 @@ END;
END;
Str(bodyR, ") s"); Ln(bodyR)
END ContString;
-
+
PROCEDURE String*(x, y: INTEGER; VAR s, fname: ARRAY OF CHAR);
BEGIN
Int(bodyR, x); Ch(bodyR, " ");
@@ -410,7 +410,7 @@ END;
Int(bodyR, col); Str(bodyR, " b"); Ln(bodyR);
END ReplPattern;
- PROCEDURE Picture*(x, y, w, h, mode: INTEGER; adr: LONGINT);
+ PROCEDURE Picture*(x, y, w, h, mode: INTEGER; adr: SYSTEM.ADDRESS);
VAR n, i, v: INTEGER; ch: CHAR;
BEGIN
Int(bodyR, x); Ch(bodyR, " ");
@@ -517,7 +517,7 @@ END;
a[i] := 2.0*b[i-1] + hn; d[i] := d1 + dn;
w[i] := 1.0; i := 0;
WHILE i < n-2 DO c[i] := c[i]/a[i]; a[i+1] := a[i+1] - c[i]*b[i]; INC(i) END ;
- SolveTriDiag(a, b, c, d, n-1); SolveTriDiag(a, b, c, w, n-1);
+ SolveTriDiag(a, b, c, d, n-1); SolveTriDiag(a, b, c, w, n-1);
d1 := (d[0] + d[i])/(w[0] + w[i] + x[i+1] - x[i]); i := 0;
WHILE i < n-1 DO d[i] := d[i] - d1*w[i]; INC(i) END ;
d[i] := d[0]
@@ -582,7 +582,7 @@ END;
END Spline;
PROCEDURE Page*(nofcopies: INTEGER);
- BEGIN
+ BEGIN
curR := 0; curG := 0; curB := 0; curFont := -1;
INC(pno); ppos := Files.Pos(bodyR); PrintCopies := nofcopies;
IF PrintMode[1] # ":" THEN
@@ -639,7 +639,7 @@ END;
IF PrinterName # "none" THEN Files.Write(printR, 4X) (*force reset postscript*) END ;
Files.Register(printF);
IF PrinterName # "none" THEN
- cmd := "lp -c -s ";
+ cmd := "lp -c -s ";
IF PrinterName # "Pluto" THEN Append(cmd, "-d "); Append(cmd, PrinterName) END ;
Append(cmd, " "); Append(cmd, printFileName);
i := Platform.System(cmd);
diff --git a/src/runtime/Errors.Txt b/src/runtime/Errors.Txt
new file mode 100644
index 00000000..5e608945
--- /dev/null
+++ b/src/runtime/Errors.Txt
@@ -0,0 +1,196 @@
+The first line of this file is ignored.
+Any line not starting /^ *[0-9]/ is ignored.
+There should be only one space between the number and the message text.
+
+Compiler error messages
+ 0 undeclared identifier
+ 1 multiply defined identifier
+ 2 illegal character in number
+ 3 illegal character in string
+ 4 identifier does not match procedure name
+ 5 comment not closed
+
+ 9 '=' expected
+
+ 12 type definition starts with incorrect symbol
+ 13 factor starts with incorrect symbol
+ 14 statement starts with incorrect symbol
+ 15 declaration followed by incorrect symbol
+ 16 MODULE expected
+
+ 18 '.' missing
+ 19 ',' missing
+ 20 ':' missing
+
+ 22 ')' missing
+ 23 ']' missing
+ 24 '}' missing
+ 25 OF missing
+ 26 THEN missing
+ 27 DO missing
+ 28 TO missing
+
+ 30 '(' missing
+
+ 34 ':=' missing
+ 35 ',' or OF expected
+
+ 38 identifier expected
+ 39 ';' missing
+
+ 41 END missing
+
+ 44 UNTIL missing
+
+ 46 EXIT not within loop statement
+ 47 illegally marked identifier
+
+ 50 expression should be constant
+ 51 constant not an integer
+ 52 identifier does not denote a type
+ 53 identifier does not denote a record type
+ 54 result type of procedure is not a basic type
+ 55 procedure call of a function
+ 56 assignment to non-variable
+ 57 pointer not bound to record or array type
+ 58 recursive type definition
+ 59 illegal open array parameter
+ 60 wrong type of case label
+ 61 inadmissible type of case label
+ 62 case label defined more than once
+ 63 illegal value of constant
+ 64 more actual than formal parameters
+ 65 fewer actual than formal parameters
+ 66 element types of actual array and formal open array differ
+ 67 actual parameter corresponding to open array is not an array
+ 68 control variable must be integer
+ 69 parameter must be an integer constant
+ 70 pointer or VAR record required as formal receiver
+ 71 pointer expected as actual receiver
+ 72 procedure must be bound to a record of the same scope
+ 73 procedure must have level 0
+ 74 procedure unknown in base type
+ 75 invalid call of base procedure
+ 76 this variable (field) is read only
+ 77 object is not a record
+ 78 dereferenced object is not a variable
+ 79 indexed object is not a variable
+ 80 index expression is not an integer
+ 81 index out of specified bounds
+ 82 indexed variable is not an array
+ 83 undefined record field
+ 84 dereferenced variable is not a pointer
+ 85 guard or test type is not an extension of variable type
+ 86 guard or testtype is not a pointer
+ 87 guarded or tested variable is neither a pointer nor a VAR-parameter record
+ 88 open array not allowed as variable, record field or array element
+
+ 92 operand of IN not an integer, or not a set
+ 93 set element type is not an integer
+ 94 operand of & is not of type BOOLEAN
+ 95 operand of OR is not of type BOOLEAN
+ 96 operand not applicable to (unary) +
+ 97 operand not applicable to (unary) -
+ 98 operand of ~ is not of type BOOLEAN
+ 99 ASSERT fault
+100 incompatible operands of dyadic operator
+101 operand type inapplicable to *
+102 operand type inapplicable to /
+103 operand type inapplicable to DIV
+104 operand type inapplicable to MOD
+105 operand type inapplicable to +
+106 operand type inapplicable to -
+107 operand type inapplicable to = or #
+108 operand type inapplicable to relation
+109 overriding method must be exported
+110 operand is not a type
+111 operand inapplicable to (this) function
+112 operand is not a variable
+113 incompatible assignment
+114 string too long to be assigned
+115 parameter doesn't match
+116 number of parameters doesn't match
+117 result type doesn't match
+118 export mark doesn't match with forward declaration
+119 redefinition textually precedes procedure bound to base type
+120 type of expression following IF, WHILE, UNTIL or ASSERT is not BOOLEAN
+121 called object is not a procedure (or is an interrupt procedure)
+122 actual VAR-parameter is not a variable
+123 type of actual parameter is not identical with that of formal VAR-parameter
+124 type of result expression differs from that of procedure
+125 type of case expression is neither INTEGER nor CHAR
+126 this expression cannot be a type or a procedure
+127 illegal use of object
+128 unsatisfied forward reference
+129 unsatisfied forward procedure
+130 WITH clause does not specify a variable
+131 LEN not applied to array
+132 dimension in LEN too large or negative
+135 SYSTEM not imported
+150 key inconsistency of imported module
+151 incorrect symbol file
+152 symbol file of imported module not found
+153 object or symbol file not opened (disk full?)
+154 recursive import not allowed
+155 generation of new symbol file not allowed
+156 parameter file not found
+157 syntax error in parameter file
+
+Limitations of implementation
+200 not yet implemented
+201 lower bound of set range greater than higher bound
+202 set element greater than MAX(SET) or less than 0
+203 number too large
+204 product too large
+205 division by zero
+206 sum too large
+207 difference too large
+208 overflow in arithmetic shift
+209 case range too large
+213 too many cases in case statement
+218 illegal value of parameter (0 <= p < 256)
+219 machine registers cannot be accessed
+220 illegal value of parameter
+221 too many pointers in a record
+222 too many global pointers
+223 too many record types
+224 too many pointer types
+225 address of pointer variable too large (move forward in text)
+226 too many exported procedures
+227 too many imported modules
+228 too many exported structures
+229 too many nested records for import
+230 too many constants (strings) in module
+231 too many link table entries (external procedures)
+232 too many commands in module
+233 record extension hierarchy too high
+234 export of recursive type not allowed
+240 identifier too long
+241 string too long
+242 address overflow
+244 cyclic type definition not allowed
+245 guarded pointer variable may be manipulated by non-local operations; use auxiliary pointer variable
+
+Compiler Warnings
+301 implicit type cast
+306 inappropriate symbol file ignored
+307 no ELSE symbol after CASE statement sequence may lead to trap
+308 SYSTEM.VAL result includes memory past end of source variable; use SYSTEM.GET
+309 you should name this parameter type, or else no actual parameter will match
+
+Run-time Error Messages
+ -1 assertion failed, cf. SYSTEM_assert
+ -2 invalid array index
+ -3 function procedure without RETURN statement
+ -4 invalid case in CASE statement
+ -5 type guard failed
+ -6 implicit type guard in record assignment failed
+ -7 invalid case in WITH statement
+ -8 value out of range
+ -9 (delayed) interrupt
+-10 NIL access
+-11 alignment error
+-12 zero divide
+-13 arithmetic overflow/underflow
+-14 invalid function argument
+-15 internal error
diff --git a/src/system/Files.Mod b/src/runtime/Files.Mod
similarity index 78%
rename from src/system/Files.Mod
rename to src/runtime/Files.Mod
index 7aeee5ac..9e51f73b 100644
--- a/src/system/Files.Mod
+++ b/src/runtime/Files.Mod
@@ -1,6 +1,6 @@
MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *)
- IMPORT SYSTEM, Platform, Heap, Strings, Configuration, Console;
+ IMPORT SYSTEM, Platform, Heap, Strings, Out;
(* standard data type I/O
@@ -14,10 +14,9 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
CONST
- nofbufs = 4;
- bufsize = 4096;
- noDesc = -1;
- notDone = -1;
+ NumBufs = 4;
+ BufSize = 4096;
+ NoDesc = -1;
(* file states *)
open = 0; (* OS File has been opened *)
@@ -34,14 +33,16 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
Buffer = POINTER TO BufDesc;
FileDesc = RECORD
- workName, registerName: FileName;
- tempFile: BOOLEAN;
- identity: Platform.FileIdentity;
- fd-: Platform.FileHandle;
- len, pos: LONGINT;
- bufs: ARRAY nofbufs OF Buffer;
- swapper, state: INTEGER;
- next: File;
+ workName: FileName;
+ registerName: FileName;
+ tempFile: BOOLEAN;
+ identity: Platform.FileIdentity;
+ fd-: Platform.FileHandle;
+ len, pos: LONGINT;
+ bufs: ARRAY NumBufs OF Buffer;
+ swapper: INTEGER;
+ state: INTEGER;
+ next: File;
END;
BufDesc = RECORD
@@ -49,14 +50,15 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
chg: BOOLEAN;
org: LONGINT;
size: LONGINT;
- data: ARRAY bufsize OF SYSTEM.BYTE
+ data: ARRAY BufSize OF SYSTEM.BYTE
END;
- Rider* = RECORD
- res*: LONGINT;
- eof*: BOOLEAN;
- buf: Buffer;
- org, offset: LONGINT
+ Rider* = RECORD
+ res*: LONGINT;
+ eof*: BOOLEAN;
+ buf: Buffer;
+ org: LONGINT; (* File offset of block containing current position *)
+ offset: LONGINT (* Current position offset within block at org. *)
END;
@@ -70,18 +72,19 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
PROCEDURE -IdxTrap "__HALT(-1)";
+ PROCEDURE -ToAdr(x: SYSTEM.INT64): SYSTEM.ADDRESS "(ADDRESS)x";
PROCEDURE^ Finalize(o: SYSTEM.PTR);
PROCEDURE Err(s: ARRAY OF CHAR; f: File; errcode: Platform.ErrorCode);
BEGIN
- Console.Ln; Console.String("-- "); Console.String(s); Console.String(": ");
+ Out.Ln; Out.String("-- "); Out.String(s); Out.String(": ");
IF f # NIL THEN
- IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END;
- IF f.fd # 0 THEN Console.String("f.fd = "); Console.Int(f.fd,1) END
+ IF f.registerName # "" THEN Out.String(f.registerName) ELSE Out.String(f.workName) END;
+ IF f.fd # 0 THEN Out.String("f.fd = "); Out.Int(f.fd,1) END
END;
- IF errcode # 0 THEN Console.String(" errcode = "); Console.Int(errcode, 1) END;
- Console.Ln;
+ IF errcode # 0 THEN Out.String(" errcode = "); Out.Int(errcode, 1) END;
+ Out.Ln;
HALT(99)
END Err;
@@ -121,13 +124,13 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
err: ARRAY 32 OF CHAR;
BEGIN
(*
- Console.String("Files.Create fd = "); Console.Int(f.fd,1);
- Console.String(", registerName = "); Console.String(f.registerName);
- Console.String(", workName = "); Console.String(f.workName);
- Console.String(", state = "); Console.Int(f.state,1);
- Console.Ln;
+ Out.String("Files.Create fd = "); Out.Int(f.fd,1);
+ Out.String(", registerName = "); Out.String(f.registerName);
+ Out.String(", workName = "); Out.String(f.workName);
+ Out.String(", state = "); Out.Int(f.state,1);
+ Out.Ln;
*)
- IF f.fd = noDesc THEN
+ IF f.fd = NoDesc THEN
IF f.state = create THEN
GetTempName(f.registerName, f.workName); f.tempFile := TRUE
ELSIF f.state = close THEN
@@ -161,17 +164,17 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
(* identity: Platform.FileIdentity; *)
BEGIN
(*
- Console.String("Files.Flush buf.f.registername = "); Console.String(buf.f.registerName);
- Console.String(", buf.f.fd = "); Console.Int(buf.f.fd,1);
- Console.String(", buffer at $"); Console.Hex(SYSTEM.ADR(buf.data));
- Console.String(", size "); Console.Int(buf.size,1); Console.Ln;
+ Out.String("Files.Flush buf.f.registername = "); Out.String(buf.f.registerName);
+ Out.String(", buf.f.fd = "); Out.Int(buf.f.fd,1);
+ Out.String(", buffer at $"); Out.Hex(SYSTEM.ADR(buf.data));
+ Out.String(", size "); Out.Int(buf.size,1); Out.Ln;
*)
IF buf.chg THEN f := buf.f; Create(f);
IF buf.org # f.pos THEN
error := Platform.Seek(f.fd, buf.org, Platform.SeekSet);
(*
- Console.String("Seeking to "); Console.Int(buf.org,1);
- Console.String(", error code "); Console.Int(error,1); Console.Ln;
+ Out.String("Seeking to "); Out.Int(buf.org,1);
+ Out.String(", error code "); Out.Int(error,1); Out.Ln;
*)
END;
error := Platform.Write(f.fd, SYSTEM.ADR(buf.data), buf.size);
@@ -199,7 +202,7 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
IF prev.next # NIL THEN prev.next := f.next END
END;
error := Platform.Close(f.fd);
- f.fd := noDesc; f.state := create; DEC(Heap.FileCount);
+ f.fd := NoDesc; f.state := create; DEC(Heap.FileCount);
END CloseOSFile;
@@ -210,9 +213,12 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
BEGIN
IF (f.state # create) OR (f.registerName # "") THEN
Create(f); i := 0;
- WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END;
+ WHILE (i < NumBufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END;
+ (* There's no reason to sync this file - we're about to close it. The OS
+ will sync if necessary. Further, sync will fail for a R/O file on Windows.
error := Platform.Sync(f.fd);
- IF error # 0 THEN Err("error writing file", f, error) END;
+ IF error # 0 THEN Err("error syncing file", f, error) END;
+ *)
CloseOSFile(f);
END
END Close;
@@ -224,7 +230,7 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
VAR f: File;
BEGIN
NEW(f); f.workName := ""; COPY(name, f.registerName);
- f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
+ f.fd := NoDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
RETURN f
END New;
@@ -268,7 +274,7 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
WHILE f # NIL DO
IF Platform.SameFile(identity, f.identity) THEN
IF ~Platform.SameFileTime(identity, f.identity) THEN i := 0;
- WHILE i < nofbufs DO
+ WHILE i < NumBufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END;
INC(i)
END;
@@ -292,7 +298,7 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
error: Platform.ErrorCode;
identity: Platform.FileIdentity;
BEGIN
- (* Console.String("Files.Old "); Console.String(name); Console.Ln; *)
+ (* Out.String("Files.Old "); Out.String(name); Out.Ln; *)
IF name # "" THEN
IF HasDir(name) THEN dir := ""; COPY(name, path)
ELSE pos := 0; ScanPath(pos, dir); MakeFileName(dir, name, path); ScanPath(pos, dir)
@@ -304,11 +310,11 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
error := Platform.OldRO(path, fd); done := error = 0;
END;
IF ~done & ~Platform.Absent(error) THEN
- Console.String("Warning: Files.Old "); Console.String(name);
- Console.String(" error = "); Console.Int(error, 0); Console.Ln;
+ Out.String("Warning: Files.Old "); Out.String(name);
+ Out.String(" error = "); Out.Int(error, 0); Out.Ln;
END;
IF done THEN
- (* Console.String(" fd = "); Console.Int(fd,1); Console.Ln; *)
+ (* Out.String(" fd = "); Out.Int(fd,1); Out.Ln; *)
error := Platform.Identify(fd, identity);
f := CacheEntry(identity);
IF f # NIL THEN
@@ -333,11 +339,11 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
PROCEDURE Purge* (f: File);
VAR i: INTEGER; identity: Platform.FileIdentity; error: Platform.ErrorCode;
BEGIN i := 0;
- WHILE i < nofbufs DO
+ WHILE i < NumBufs DO
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END;
INC(i)
END;
- IF f.fd # noDesc THEN
+ IF f.fd # NoDesc THEN
error := Platform.Truncate(f.fd, 0);
error := Platform.Seek(f.fd, 0, Platform.SeekSet)
END;
@@ -354,7 +360,9 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
END GetDate;
PROCEDURE Pos* (VAR r: Rider): LONGINT;
- BEGIN RETURN r.org + r.offset
+ BEGIN
+ ASSERT(r.offset <= BufSize);
+ RETURN r.org + r.offset
END Pos;
PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT);
@@ -362,21 +370,21 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
BEGIN
IF f # NIL THEN
(*
- Console.String("Files.Set rider on fd = "); Console.Int(f.fd,1);
- Console.String(", registerName = "); Console.String(f.registerName);
- Console.String(", workName = "); Console.String(f.workName);
- Console.String(", state = "); Console.Int(f.state,1);
- Console.Ln;
+ Out.String("Files.Set rider on fd = "); Out.Int(f.fd,1);
+ Out.String(", registerName = "); Out.String(f.registerName);
+ Out.String(", workName = "); Out.String(f.workName);
+ Out.String(", state = "); Out.Int(f.state,1);
+ Out.Ln;
*)
IF pos > f.len THEN pos := f.len ELSIF pos < 0 THEN pos := 0 END;
- offset := pos MOD bufsize; org := pos - offset; i := 0;
- WHILE (i < nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END;
- IF i < nofbufs THEN
+ offset := pos MOD BufSize; org := pos - offset; i := 0;
+ WHILE (i < NumBufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END;
+ IF i < NumBufs THEN
IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf
ELSE buf := f.bufs[i]
END
ELSE
- f.swapper := (f.swapper + 1) MOD nofbufs;
+ f.swapper := (f.swapper + 1) MOD NumBufs;
buf := f.bufs[f.swapper];
Flush(buf)
END;
@@ -393,6 +401,7 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
END
ELSE buf := NIL; org := 0; offset := 0
END;
+ ASSERT(offset <= BufSize);
r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE; r.res := 0
END Set;
@@ -401,6 +410,7 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
BEGIN
buf := r.buf; offset := r.offset;
IF r.org # buf.org THEN Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset END;
+ ASSERT(offset <= buf.size);
IF (offset < buf.size) THEN
x := buf.data[offset]; r.offset := offset + 1
ELSIF r.org + offset < buf.f.len THEN
@@ -417,24 +427,20 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
IF n > LEN(x) THEN IdxTrap END;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
- IF (r.org # buf.org) OR (offset >= bufsize) THEN
+ IF (r.org # buf.org) OR (offset >= BufSize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END;
restInBuf := buf.size - offset;
IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN
ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END;
- SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.ADR(x) + xpos, min);
- INC(offset, min); r.offset := offset; INC(xpos, min); DEC(n, min)
+ SYSTEM.MOVE(SYSTEM.ADR(buf.data) + ToAdr(offset), SYSTEM.ADR(x) + ToAdr(xpos), min);
+ INC(offset, min); r.offset := offset; INC(xpos, min); DEC(n, min);
+ ASSERT(offset <= BufSize)
END;
r.res := 0; r.eof := FALSE
END ReadBytes;
- PROCEDURE ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE);
- BEGIN
- ReadBytes(r, x, 1);
- END ReadByte;
-
PROCEDURE Base* (VAR r: Rider): File;
BEGIN RETURN r.buf.f
END Base;
@@ -443,10 +449,12 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
- IF (r.org # buf.org) OR (offset >= bufsize) THEN
+ ASSERT(offset <= BufSize);
+ IF (r.org # buf.org) OR (offset >= BufSize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END;
+ ASSERT(offset < BufSize);
buf.data[offset] := x;
buf.chg := TRUE;
IF offset = buf.size THEN
@@ -461,14 +469,17 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
IF n > LEN(x) THEN IdxTrap END;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
- IF (r.org # buf.org) OR (offset >= bufsize) THEN
+ ASSERT(offset <= BufSize);
+ IF (r.org # buf.org) OR (offset >= BufSize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END;
- restInBuf := bufsize - offset;
+ ASSERT(offset <= BufSize);
+ restInBuf := BufSize - offset;
IF n > restInBuf THEN min := restInBuf ELSE min := n END;
- SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.ADR(buf.data) + offset, min);
+ SYSTEM.MOVE(SYSTEM.ADR(x) + ToAdr(xpos), SYSTEM.ADR(buf.data) + ToAdr(offset), min);
INC(offset, min); r.offset := offset;
+ ASSERT(offset <= BufSize);
IF offset > buf.size THEN INC(buf.f.len, offset - buf.size); buf.size := offset END;
INC(xpos, min); DEC(n, min); buf.chg := TRUE
END;
@@ -477,14 +488,14 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
(* another solution would be one that is similar to ReadBytes, WriteBytes.
No code duplication, more symmetric, only two ifs for
-Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len
+Read and Write in buffer, buf.size replaced by BufSize in Write ops, buf.size and len
must be made consistent with offset (if offset > buf.size) in a lazy way.
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
- IF (offset >= bufsize) OR (r.org # buf.org) THEN
+ IF (offset >= BufSize) OR (r.org # buf.org) THEN
Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset;
END;
buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE
@@ -520,8 +531,8 @@ Especially Length would become fairly complex.
buf: ARRAY 4096 OF CHAR;
BEGIN
(*
- Console.String("Files.Rename old = "); Console.String(old);
- Console.String(", new = "); Console.String(new); Console.Ln;
+ Out.String("Files.Rename old = "); Out.String(old);
+ Out.String(", new = "); Out.String(new); Out.Ln;
*)
error := Platform.IdentifyByName(old, oldidentity);
IF error = 0 THEN
@@ -530,7 +541,7 @@ Especially Length would become fairly complex.
Delete(new, error); (* work around stale nfs handles *)
END;
error := Platform.Rename(old, new);
- (* Console.String("Platform.Rename error code "); Console.Int(error,1); Console.Ln; *)
+ (* Out.String("Platform.Rename error code "); Out.Int(error,1); Out.Ln; *)
IF ~Platform.DifferentFilesystems(error) THEN
res := error; RETURN
ELSE
@@ -539,7 +550,7 @@ Especially Length would become fairly complex.
IF error # 0 THEN res := 2; RETURN END;
error := Platform.New(new, fdnew);
IF error # 0 THEN error := Platform.Close(fdold); res := 3; RETURN END;
- error := Platform.Read(fdold, SYSTEM.ADR(buf), bufsize, n);
+ error := Platform.Read(fdold, SYSTEM.ADR(buf), BufSize, n);
WHILE n > 0 DO
error := Platform.Write(fdnew, SYSTEM.ADR(buf), n);
IF error # 0 THEN
@@ -547,7 +558,7 @@ Especially Length would become fairly complex.
ignore := Platform.Close(fdnew);
Err("cannot move file", NIL, error)
END;
- error := Platform.Read(fdold, SYSTEM.ADR(buf), bufsize, n);
+ error := Platform.Read(fdold, SYSTEM.ADR(buf), BufSize, n);
END;
ignore := Platform.Close(fdold);
ignore := Platform.Close(fdnew);
@@ -566,18 +577,18 @@ Especially Length would become fairly complex.
VAR idx, errcode: INTEGER; f1: File; file: ARRAY 104 OF CHAR;
BEGIN
(*
- Console.String("Files.Register f.registerName = "); Console.String(f.registerName);
- Console.String(", fd = "); Console.Int(f.fd,1); Console.Ln;
+ Out.String("Files.Register f.registerName = "); Out.String(f.registerName);
+ Out.String(", fd = "); Out.Int(f.fd,1); Out.Ln;
*)
IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END;
Close(f);
IF f.registerName # "" THEN
Rename(f.workName, f.registerName, errcode);
(*
- Console.String("Renamed (for register) f.fd = "); Console.Int(f.fd,1);
- Console.String(" from workname "); Console.String(f.workName);
- Console.String(" to registerName "); Console.String(f.registerName);
- Console.String(" errorcode = "); Console.Int(errcode,1); Console.Ln;
+ Out.String("Renamed (for register) f.fd = "); Out.Int(f.fd,1);
+ Out.String(" from workname "); Out.String(f.workName);
+ Out.String(" to registerName "); Out.String(f.registerName);
+ Out.String(" errorcode = "); Out.Int(errcode,1); Out.Ln;
*)
IF errcode # 0 THEN COPY(f.registerName, file); HALT(99) END;
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
@@ -640,27 +651,21 @@ Especially Length would become fairly complex.
END ReadString;
PROCEDURE ReadLine* (VAR R: Rider; VAR x: ARRAY OF CHAR);
- VAR i: INTEGER; ch: CHAR; b : BOOLEAN;
+ VAR i: INTEGER;
BEGIN
- i := 0;
- b := FALSE;
- REPEAT
- Read(R, ch);
- IF ((ch = 0X) OR (ch = 0AX) OR (ch = 0DX)) THEN
- b := TRUE
- ELSE
- x[i] := ch;
- INC(i);
- END;
- UNTIL b
+ i := 0; REPEAT Read(R, x[i]); INC(i) UNTIL (x[i-1] = 0X) OR (x[i-1] = 0AX);
+ IF x[i-1] = 0AX THEN DEC(i) END; (* Omit trailing LF *)
+ IF (i > 0) & (x[i-1] = 0DX) THEN DEC(i) END; (* Also omit preceeding trailing CR if present. *)
+ x[i] := 0X; (* Guarantee zero termination. *)
END ReadLine;
- PROCEDURE ReadNum* (VAR R: Rider; VAR x: LONGINT);
- VAR s: SHORTINT; ch: CHAR; n: LONGINT;
- BEGIN s := 0; n := 0; Read(R, ch);
- WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, s) ); INC(s, 7); Read(R, ch) END;
- INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) );
- x := n
+ PROCEDURE ReadNum*(VAR R: Rider; VAR x: ARRAY OF SYSTEM.BYTE);
+ VAR s, b: SYSTEM.INT8; q: SYSTEM.INT64;
+ BEGIN s := 0; q := 0; Read(R, b);
+ WHILE b < 0 DO INC(q, ASH(b+128, s)); INC(s, 7); Read(R, b) END;
+ INC(q, ASH(b MOD 64 - b DIV 64 * 64, s));
+ ASSERT(LEN(x) <= 8);
+ SYSTEM.MOVE(SYSTEM.ADR(q), SYSTEM.ADR(x), LEN(x)) (* Assumes little endian representation of q and x. *)
END ReadNum;
PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN);
@@ -704,7 +709,7 @@ Especially Length would become fairly complex.
WriteBytes(R, x, i+1)
END WriteString;
- PROCEDURE WriteNum* (VAR R: Rider; x: LONGINT);
+ PROCEDURE WriteNum* (VAR R: Rider; x: SYSTEM.INT64);
BEGIN
WHILE (x < - 64) OR (x > 63) DO Write(R, CHR(x MOD 128 + 128)); x := x DIV 128 END;
Write(R, CHR(x MOD 128))
@@ -720,9 +725,9 @@ Especially Length would become fairly complex.
BEGIN
f := SYSTEM.VAL(File, o);
(*
- Console.String("Files.Finalize f.fd = "); Console.Int(f.fd,1);
- Console.String(", f.registername = "); Console.String(f.registerName);
- Console.String(", f.workName = "); Console.String(f.workName); Console.Ln;
+ Out.String("Files.Finalize f.fd = "); Out.Int(f.fd,1);
+ Out.String(", f.registername = "); Out.String(f.registerName);
+ Out.String(", f.workName = "); Out.String(f.workName); Out.Ln;
*)
IF f.fd >= 0 THEN
CloseOSFile(f);
diff --git a/src/system/Heap.Mod b/src/runtime/Heap.Mod
similarity index 54%
rename from src/system/Heap.Mod
rename to src/runtime/Heap.Mod
index 6395c0a7..550867f7 100644
--- a/src/system/Heap.Mod
+++ b/src/runtime/Heap.Mod
@@ -1,36 +1,36 @@
MODULE Heap;
- IMPORT SYSTEM; (* Cannot import anything else as heap initialization must complete
- before any other modules are initialized. *)
+ IMPORT S := SYSTEM; (* Cannot import anything else as heap initialization must complete
+ before any other modules are initialized. *)
CONST
ModNameLen = 20;
CmdNameLen = 24;
- SZL = SIZE(LONGINT);
- Unit = 4*SZL; (* smallest possible heap block *)
- nofLists = 9; (* number of free_lists *)
- heapSize0 = 8000*Unit; (* startup heap size *)
+ SZA = SIZE(S.ADDRESS); (* Size of address *)
+ Unit = 4*SZA; (* smallest possible heap block *)
+ nofLists = 9; (* number of free_lists *)
+ heapSize0 = 8000*Unit; (* startup heap size *)
(* all blocks look the same:
free blocks describe themselves: size = Unit
tag = &tag++
->block size
- sentinel = -SZL
+ sentinel = -SZA
next
*)
(* heap chunks *)
- nextChnkOff = LONG(LONG(0)); (* next heap chunk, sorted ascendingly! *)
- endOff = LONG(LONG(SZL)); (* end of heap chunk *)
- blkOff = LONG(LONG(3*SZL)); (* first block in a chunk *)
+ nextChnkOff = S.VAL(S.ADDRESS, 0); (* next heap chunk, sorted ascendingly! *)
+ endOff = S.VAL(S.ADDRESS, SZA); (* end of heap chunk *)
+ blkOff = S.VAL(S.ADDRESS, 3*SZA); (* first block in a chunk *)
(* heap blocks *)
- tagOff = LONG(LONG(0)); (* block starts with tag *)
- sizeOff = LONG(LONG(SZL)); (* block size in free block relative to block start *)
- sntlOff = LONG(LONG(2*SZL)); (* pointer offset table sentinel in free block relative to block start *)
- nextOff = LONG(LONG(3*SZL)); (* next pointer in free block relative to block start *)
- NoPtrSntl = LONG(LONG(-SZL));
- LongZero = LONG(LONG(0));
+ tagOff = S.VAL(S.ADDRESS, 0); (* block starts with tag *)
+ sizeOff = S.VAL(S.ADDRESS, SZA); (* block size in free block relative to block start *)
+ sntlOff = S.VAL(S.ADDRESS, 2*SZA); (* pointer offset table sentinel in free block relative to block start *)
+ nextOff = S.VAL(S.ADDRESS, 3*SZA); (* next pointer in free block relative to block start *)
+ NoPtrSntl = S.VAL(S.ADDRESS, -SZA);
+ AddressZero = S.VAL(S.ADDRESS, 0);
TYPE
ModuleName = ARRAY ModNameLen OF CHAR;
@@ -39,14 +39,14 @@ MODULE Heap;
Module = POINTER TO ModuleDesc;
Cmd = POINTER TO CmdDesc;
- EnumProc = PROCEDURE(P: PROCEDURE(p: SYSTEM.PTR));
+ EnumProc = PROCEDURE(P: PROCEDURE(p: S.PTR));
ModuleDesc = RECORD
next: Module;
name: ModuleName;
refcnt: LONGINT;
cmds: Cmd;
- types: LONGINT;
+ types: S.ADDRESS;
enumPtrs: EnumProc;
reserved1, reserved2: LONGINT
END ;
@@ -59,29 +59,29 @@ MODULE Heap;
cmd: Command
END ;
- Finalizer = PROCEDURE(obj: SYSTEM.PTR);
+ Finalizer = PROCEDURE(obj: S.PTR);
FinNode = POINTER TO FinDesc;
FinDesc = RECORD
next: FinNode;
- obj: LONGINT; (* weak pointer *)
+ obj: S.ADDRESS; (* weak pointer *)
marked: BOOLEAN;
finalize: Finalizer;
END ;
VAR
(* the list of loaded (=initialization started) modules *)
- modules*: SYSTEM.PTR;
+ modules*: S.PTR;
- freeList: ARRAY nofLists + 1 OF LONGINT; (* dummy, 16, 32, 48, 64, 80, 96, 112, 128, sentinel *)
- bigBlocks: LONGINT;
- allocated*: LONGINT;
+ freeList: ARRAY nofLists + 1 OF S.ADDRESS; (* dummy, 16, 32, 48, 64, 80, 96, 112, 128, sentinel *)
+ bigBlocks: S.ADDRESS;
+ allocated*: S.ADDRESS;
firstTry: BOOLEAN;
(* extensible heap *)
- heap: LONGINT; (* the sorted list of heap chunks *)
- heapend: LONGINT; (* max possible pointer value (used for stack collection) *)
- heapsize*: LONGINT; (* the sum of all heap chunk sizes *)
+ heap: S.ADDRESS; (* the sorted list of heap chunks *)
+ heapend: S.ADDRESS; (* max possible pointer value (used for stack collection) *)
+ heapsize*: S.ADDRESS; (* the sum of all heap chunk sizes *)
(* finalization candidates *)
fin: FinNode;
@@ -99,13 +99,13 @@ MODULE Heap;
INC(lockdepth);
END Lock;
- PROCEDURE -PlatformHalt(code: LONGINT) "Platform_Halt(code)";
+ PROCEDURE -ModulesHalt(code: LONGINT) "Modules_Halt(code)";
PROCEDURE Unlock*;
BEGIN
DEC(lockdepth);
IF interrupted & (lockdepth = 0) THEN
- PlatformHalt(-9);
+ ModulesHalt(-9);
END
END Unlock;
@@ -120,20 +120,20 @@ MODULE Heap;
END TAS;
*)
- PROCEDURE REGMOD*(VAR name: ModuleName; enumPtrs: EnumProc): SYSTEM.PTR;
+ PROCEDURE REGMOD*(VAR name: ModuleName; enumPtrs: EnumProc): S.PTR;
VAR m: Module;
BEGIN
(* REGMOD is called at the start of module initialisation code before that modules
type descriptors have been set up. 'NEW' depends on the Heap modules type
descriptors being ready for use, therefore, just for the Heap module itself, we
- must use SYSTEM.NEW. *)
+ must use S.NEW. *)
IF name = "Heap" THEN
- SYSTEM.NEW(m, SIZE(ModuleDesc))
+ S.NEW(m, SIZE(ModuleDesc))
ELSE
NEW(m)
END;
m.types := 0; m.cmds := NIL;
- COPY(name, m.name); m.refcnt := 0; m.enumPtrs := enumPtrs; m.next := SYSTEM.VAL(Module, modules);
+ COPY(name, m.name); m.refcnt := 0; m.enumPtrs := enumPtrs; m.next := S.VAL(Module, modules);
modules := m;
RETURN m
END REGMOD;
@@ -144,17 +144,17 @@ MODULE Heap;
(* REGCMD is called during module initialisation code before that modules
type descriptors have been set up. 'NEW' depends on the Heap modules type
descriptors being ready for use, therefore, just for the commands registered
- by the Heap module itself, we must use SYSTEM.NEW. *)
+ by the Heap module itself, we must use S.NEW. *)
IF m.name = "Heap" THEN
- SYSTEM.NEW(c, SIZE(CmdDesc))
+ S.NEW(c, SIZE(CmdDesc))
ELSE
NEW(c)
END;
COPY(name, c.name); c.cmd := cmd; c.next := m.cmds; m.cmds := c
END REGCMD;
- PROCEDURE REGTYP*(m: Module; typ: LONGINT);
- BEGIN SYSTEM.PUT(typ, m.types); m.types := typ
+ PROCEDURE REGTYP*(m: Module; typ: S.ADDRESS);
+ BEGIN S.PUT(typ, m.types); m.types := typ
END REGTYP;
PROCEDURE INCREF*(m: Module);
@@ -162,34 +162,27 @@ MODULE Heap;
END INCREF;
- PROCEDURE -ExternPlatformOSAllocate "extern LONGINT Platform_OSAllocate(LONGINT size);";
- PROCEDURE -OSAllocate(size: LONGINT): LONGINT "Platform_OSAllocate(size)";
+ PROCEDURE -ExternPlatformOSAllocate "extern ADDRESS Platform_OSAllocate(ADDRESS size);";
+ PROCEDURE -OSAllocate(size: S.ADDRESS): S.ADDRESS "Platform_OSAllocate(size)";
- PROCEDURE NewChunk(blksz: LONGINT): LONGINT;
- VAR chnk: LONGINT;
+ PROCEDURE NewChunk(blksz: S.ADDRESS): S.ADDRESS;
+ VAR chnk: S.ADDRESS;
BEGIN
chnk := OSAllocate(blksz + blkOff);
IF chnk # 0 THEN
- SYSTEM.PUT(chnk + endOff, chnk + (blkOff + blksz));
- SYSTEM.PUT(chnk + blkOff, chnk + (blkOff + sizeOff));
- SYSTEM.PUT(chnk + (blkOff + sizeOff), blksz);
- SYSTEM.PUT(chnk + (blkOff + sntlOff), NoPtrSntl);
- SYSTEM.PUT(chnk + (blkOff + nextOff), bigBlocks);
+ S.PUT(chnk + endOff, chnk + (blkOff + blksz));
+ S.PUT(chnk + blkOff, chnk + (blkOff + sizeOff));
+ S.PUT(chnk + (blkOff + sizeOff), blksz);
+ S.PUT(chnk + (blkOff + sntlOff), NoPtrSntl);
+ S.PUT(chnk + (blkOff + nextOff), bigBlocks);
bigBlocks := chnk + blkOff;
INC(heapsize, blksz)
END ;
RETURN chnk
END NewChunk;
-
- (* FetchAddress fetches a pointer from memory and returns it as a LONGINT. It works
- correctly regardless of the size of an address. Specifically on 32 bit address
- architectures with 64 bit LONGINT, it loads 32 bits and extends it to LONGINT
- rather than loading 64 bits. *)
- PROCEDURE -FetchAddress(pointer: LONGINT): LONGINT "(LONGINT)(SYSTEM_ADDRESS)(*((void**)((SYSTEM_ADDRESS)pointer)))";
-
- PROCEDURE ExtendHeap(blksz: LONGINT);
- VAR size, chnk, j, next: LONGINT;
+ PROCEDURE ExtendHeap(blksz: S.ADDRESS);
+ VAR size, chnk, j, next: S.ADDRESS;
BEGIN
IF blksz > 10000*Unit THEN size := blksz
ELSE size := 10000*Unit (* additional heuristics *)
@@ -198,31 +191,31 @@ MODULE Heap;
IF chnk # 0 THEN
(*sorted insertion*)
IF chnk < heap THEN
- SYSTEM.PUT(chnk, heap); heap := chnk
+ S.PUT(chnk, heap); heap := chnk
ELSE
- j := heap; next := FetchAddress(j);
+ j := heap; S.GET(j, next);
WHILE (next # 0) & (chnk > next) DO
j := next;
- next := FetchAddress(j)
+ S.GET(j, next)
END;
- SYSTEM.PUT(chnk, next); SYSTEM.PUT(j, chnk)
+ S.PUT(chnk, next); S.PUT(j, chnk)
END ;
- IF next = 0 THEN heapend := FetchAddress(chnk+endOff) END
+ IF next = 0 THEN S.GET(chnk+endOff, heapend) END
END
END ExtendHeap;
PROCEDURE ^GC*(markStack: BOOLEAN);
- PROCEDURE NEWREC*(tag: LONGINT): SYSTEM.PTR;
+ PROCEDURE NEWREC*(tag: S.ADDRESS): S.PTR;
VAR
- i, i0, di, blksz, restsize, t, adr, end, next, prev: LONGINT;
- new: SYSTEM.PTR;
+ i, i0, di, blksz, restsize, t, adr, end, next, prev: S.ADDRESS;
+ new: S.PTR;
BEGIN
Lock();
- blksz := FetchAddress(tag);
+ S.GET(tag, blksz);
ASSERT((Unit = 16) OR (Unit = 32));
- ASSERT(SIZE(SYSTEM.PTR) <= SIZE(LONGINT));
+ ASSERT(SIZE(S.PTR) = SIZE(S.ADDRESS));
ASSERT(blksz MOD Unit = 0);
i0 := blksz DIV Unit; i := i0;
@@ -230,15 +223,15 @@ MODULE Heap;
WHILE adr = 0 DO INC(i); adr := freeList[i] END
END ;
IF i < nofLists THEN (* unlink *)
- next := FetchAddress(adr + nextOff);
+ S.GET(adr + nextOff, next);
freeList[i] := next;
IF i # i0 THEN (* split *)
di := i - i0; restsize := di * Unit; end := adr + restsize;
- SYSTEM.PUT(end + sizeOff, blksz);
- SYSTEM.PUT(end + sntlOff, NoPtrSntl);
- SYSTEM.PUT(end, end + sizeOff);
- SYSTEM.PUT(adr + sizeOff, restsize);
- SYSTEM.PUT(adr + nextOff, freeList[di]);
+ S.PUT(end + sizeOff, blksz);
+ S.PUT(end + sntlOff, NoPtrSntl);
+ S.PUT(end, end + sizeOff);
+ S.PUT(adr + sizeOff, restsize);
+ S.PUT(adr + nextOff, freeList[di]);
freeList[di] := adr;
INC(adr, restsize)
END
@@ -264,153 +257,153 @@ MODULE Heap;
Unlock(); RETURN NIL
END
END ;
- t := FetchAddress(adr+sizeOff);
+ S.GET(adr+sizeOff, t);
IF t >= blksz THEN EXIT END ;
- prev := adr; adr := FetchAddress(adr + nextOff)
+ prev := adr; S.GET(adr + nextOff, adr)
END ;
restsize := t - blksz; end := adr + restsize;
- SYSTEM.PUT(end + sizeOff, blksz);
- SYSTEM.PUT(end + sntlOff, NoPtrSntl);
- SYSTEM.PUT(end, end + sizeOff);
+ S.PUT(end + sizeOff, blksz);
+ S.PUT(end + sntlOff, NoPtrSntl);
+ S.PUT(end, end + sizeOff);
IF restsize > nofLists * Unit THEN (*resize*)
- SYSTEM.PUT(adr + sizeOff, restsize)
+ S.PUT(adr + sizeOff, restsize)
ELSE (*unlink*)
- next := FetchAddress(adr + nextOff);
+ S.GET(adr + nextOff, next);
IF prev = 0 THEN bigBlocks := next
- ELSE SYSTEM.PUT(prev + nextOff, next);
+ ELSE S.PUT(prev + nextOff, next);
END ;
IF restsize > 0 THEN (*move*)
di := restsize DIV Unit;
- SYSTEM.PUT(adr + sizeOff, restsize);
- SYSTEM.PUT(adr + nextOff, freeList[di]);
+ S.PUT(adr + sizeOff, restsize);
+ S.PUT(adr + nextOff, freeList[di]);
freeList[di] := adr
END
END ;
INC(adr, restsize)
END ;
- i := adr + 4*SZL; end := adr + blksz;
+ i := adr + 4*SZA; end := adr + blksz;
WHILE i < end DO (*deliberately unrolled*)
- SYSTEM.PUT(i, LongZero);
- SYSTEM.PUT(i + SZL, LongZero);
- SYSTEM.PUT(i + 2*SZL, LongZero);
- SYSTEM.PUT(i + 3*SZL, LongZero);
- INC(i, 4*SZL)
+ S.PUT(i, AddressZero);
+ S.PUT(i + SZA, AddressZero);
+ S.PUT(i + 2*SZA, AddressZero);
+ S.PUT(i + 3*SZA, AddressZero);
+ INC(i, 4*SZA)
END ;
- SYSTEM.PUT(adr + nextOff, LongZero);
- SYSTEM.PUT(adr, tag);
- SYSTEM.PUT(adr + sizeOff, LongZero);
- SYSTEM.PUT(adr + sntlOff, LongZero);
+ S.PUT(adr + nextOff, AddressZero);
+ S.PUT(adr, tag);
+ S.PUT(adr + sizeOff, AddressZero);
+ S.PUT(adr + sntlOff, AddressZero);
INC(allocated, blksz);
Unlock();
- RETURN SYSTEM.VAL(SYSTEM.PTR, adr + SZL)
+ RETURN S.VAL(S.PTR, adr + SZA)
END NEWREC;
- PROCEDURE NEWBLK*(size: LONGINT): SYSTEM.PTR;
- VAR blksz, tag: LONGINT; new: SYSTEM.PTR;
+ PROCEDURE NEWBLK*(size: S.ADDRESS): S.PTR;
+ VAR blksz, tag: S.ADDRESS; new: S.PTR;
BEGIN
Lock();
- blksz := (size + (4*SZL + Unit - 1)) DIV Unit * Unit; (*size + tag + meta + blksz + sntnl + UnitAlignment*)
- new := NEWREC(SYSTEM.ADR(blksz));
- tag := SYSTEM.VAL(LONGINT, new) + blksz - 3*SZL;
- SYSTEM.PUT(tag - SZL, LongZero); (*reserved for meta info*)
- SYSTEM.PUT(tag, blksz);
- SYSTEM.PUT(tag + SZL, NoPtrSntl);
- SYSTEM.PUT(SYSTEM.VAL(LONGINT, new) - SZL, tag);
+ blksz := (size + (4*SZA + Unit - 1)) DIV Unit * Unit; (*size + tag + meta + blksz + sntnl + UnitAlignment*)
+ new := NEWREC(S.ADR(blksz));
+ tag := S.VAL(S.ADDRESS, new) + blksz - 3*SZA;
+ S.PUT(tag - SZA, AddressZero); (*reserved for meta info*)
+ S.PUT(tag, blksz);
+ S.PUT(tag + SZA, NoPtrSntl);
+ S.PUT(S.VAL(S.ADDRESS, new) - SZA, tag);
Unlock();
RETURN new
END NEWBLK;
- PROCEDURE Mark(q: LONGINT);
- VAR p, tag, fld, n, offset, tagbits: LONGINT;
+ PROCEDURE Mark(q: S.ADDRESS);
+ VAR p, tag, offset, fld, n, tagbits: S.ADDRESS;
BEGIN
IF q # 0 THEN
- tagbits := FetchAddress(q - SZL); (* Load the tag for the record at q *)
- IF ~ODD(tagbits) THEN (* If it has not already been marked *)
- SYSTEM.PUT(q - SZL, tagbits + 1); (* Mark it *)
+ S.GET(q - SZA, tagbits); (* Load the tag for the record at q *)
+ IF ~ODD(tagbits) THEN (* If it has not already been marked *)
+ S.PUT(q - SZA, tagbits + 1); (* Mark it *)
p := 0;
- tag := tagbits + SZL; (* Tag addresses first offset *)
+ tag := tagbits + SZA; (* Tag addresses first offset *)
LOOP
- SYSTEM.GET(tag, offset); (* Get next ptr field offset *)
- IF offset < 0 THEN (* If sentinel. (Value is -8*(#fields+1) *)
- SYSTEM.PUT(q - SZL, tag + offset + 1); (* Rotate base ptr into tag *)
+ S.GET(tag, offset); (* Get next ptr field offset *)
+ IF offset < 0 THEN (* Sentinel reached: Value is -8*(#fields+1) *)
+ S.PUT(q - SZA, tag + offset + 1); (* Rotate base ptr into tag *)
IF p = 0 THEN EXIT END ;
n := q; q := p;
- tag := FetchAddress(q - SZL); DEC(tag, 1);
- SYSTEM.GET(tag, offset); fld := q + offset;
- p := FetchAddress(fld); SYSTEM.PUT(fld, SYSTEM.VAL(SYSTEM.PTR, n))
- ELSE (* offset references a ptr field *)
- fld := q + offset; (* Address the pointer *)
- n := FetchAddress(fld); (* Load the pointer *)
- IF n # 0 THEN (* If pointer is not NIL *)
- tagbits := FetchAddress(n - SZL); (* Consider record pointed to by this field *)
+ S.GET(q - SZA, tag); DEC(tag, 1);
+ S.GET(tag, offset); fld := q + offset;
+ S.GET(fld, p); S.PUT(fld, S.VAL(S.PTR, n))
+ ELSE (* offset references a ptr field *)
+ fld := q + offset; (* S.ADDRESS the pointer *)
+ S.GET(fld, n); (* Load the pointer *)
+ IF n # 0 THEN (* If pointer is not NIL *)
+ S.GET(n - SZA, tagbits); (* Consider record pointed to by this field *)
IF ~ODD(tagbits) THEN
- SYSTEM.PUT(n - SZL, tagbits + 1);
- SYSTEM.PUT(q - SZL, tag + 1);
- SYSTEM.PUT(fld, SYSTEM.VAL(SYSTEM.PTR, p));
+ S.PUT(n - SZA, tagbits + 1);
+ S.PUT(q - SZA, tag + 1);
+ S.PUT(fld, S.VAL(S.PTR, p));
p := q; q := n;
tag := tagbits
END
END
END ;
- INC(tag, SZL)
+ INC(tag, SZA)
END
END
END
END Mark;
- PROCEDURE MarkP(p: SYSTEM.PTR); (* for compatibility with EnumPtrs in ANSI mode *)
+ PROCEDURE MarkP(p: S.PTR); (* for compatibility with EnumPtrs in ANSI mode *)
BEGIN
- Mark(SYSTEM.VAL(LONGINT, p))
+ Mark(S.VAL(S.ADDRESS, p))
END MarkP;
PROCEDURE Scan;
- VAR chnk, adr, end, start, tag, i, size, freesize: LONGINT;
+ VAR chnk, adr, end, start, tag, i, size, freesize: S.ADDRESS;
BEGIN bigBlocks := 0; i := 1;
WHILE i < nofLists DO freeList[i] := 0; INC(i) END ;
freesize := 0; allocated := 0; chnk := heap;
WHILE chnk # 0 DO
adr := chnk + blkOff;
- end := FetchAddress(chnk + endOff);
+ S.GET(chnk + endOff, end);
WHILE adr < end DO
- tag := FetchAddress(adr);
+ S.GET(adr, tag);
IF ODD(tag) THEN (*marked*)
IF freesize > 0 THEN
start := adr - freesize;
- SYSTEM.PUT(start, start+SZL);
- SYSTEM.PUT(start+sizeOff, freesize);
- SYSTEM.PUT(start+sntlOff, NoPtrSntl);
+ S.PUT(start, start+SZA);
+ S.PUT(start+sizeOff, freesize);
+ S.PUT(start+sntlOff, NoPtrSntl);
i := freesize DIV Unit; freesize := 0;
- IF i < nofLists THEN SYSTEM.PUT(start + nextOff, freeList[i]); freeList[i] := start
- ELSE SYSTEM.PUT(start + nextOff, bigBlocks); bigBlocks := start
+ IF i < nofLists THEN S.PUT(start + nextOff, freeList[i]); freeList[i] := start
+ ELSE S.PUT(start + nextOff, bigBlocks); bigBlocks := start
END
END ;
DEC(tag, 1);
- SYSTEM.PUT(adr, tag);
- size := FetchAddress(tag);
+ S.PUT(adr, tag);
+ S.GET(tag, size);
INC(allocated, size);
INC(adr, size)
ELSE (*unmarked*)
- size := FetchAddress(tag);
+ S.GET(tag, size);
INC(freesize, size);
INC(adr, size)
END
END ;
IF freesize > 0 THEN (*collect last block*)
start := adr - freesize;
- SYSTEM.PUT(start, start+SZL);
- SYSTEM.PUT(start+sizeOff, freesize);
- SYSTEM.PUT(start+sntlOff, NoPtrSntl);
+ S.PUT(start, start+SZA);
+ S.PUT(start+sizeOff, freesize);
+ S.PUT(start+sntlOff, NoPtrSntl);
i := freesize DIV Unit; freesize := 0;
- IF i < nofLists THEN SYSTEM.PUT(start + nextOff, freeList[i]); freeList[i] := start
- ELSE SYSTEM.PUT(start + nextOff, bigBlocks); bigBlocks := start
+ IF i < nofLists THEN S.PUT(start + nextOff, freeList[i]); freeList[i] := start
+ ELSE S.PUT(start + nextOff, bigBlocks); bigBlocks := start
END
END ;
- chnk := FetchAddress(chnk)
+ S.GET(chnk, chnk)
END
END Scan;
- PROCEDURE Sift (l, r: LONGINT; VAR a: ARRAY OF LONGINT);
- VAR i, j, x: LONGINT;
+ PROCEDURE Sift (l, r: S.ADDRESS; VAR a: ARRAY OF S.ADDRESS);
+ VAR i, j, x: S.ADDRESS;
BEGIN j := l; x := a[j];
LOOP i := j; j := 2*j + 1;
IF (j < r) & (a[j] < a[j+1]) THEN INC(j) END;
@@ -420,28 +413,28 @@ MODULE Heap;
a[i] := x
END Sift;
- PROCEDURE HeapSort (n: LONGINT; VAR a: ARRAY OF LONGINT);
- VAR l, r, x: LONGINT;
+ PROCEDURE HeapSort (n: S.ADDRESS; VAR a: ARRAY OF S.ADDRESS);
+ VAR l, r, x: S.ADDRESS;
BEGIN l := n DIV 2; r := n - 1;
WHILE l > 0 DO DEC(l); Sift(l, r, a) END;
WHILE r > 0 DO x := a[0]; a[0] := a[r]; a[r] := x; DEC(r); Sift(l, r, a) END
END HeapSort;
- PROCEDURE MarkCandidates(n: LONGINT; VAR cand: ARRAY OF LONGINT);
- VAR chnk, adr, tag, next, lim, lim1, i, ptr, size: LONGINT;
+ PROCEDURE MarkCandidates(n: S.ADDRESS; VAR cand: ARRAY OF S.ADDRESS);
+ VAR chnk, adr, tag, next, lim, lim1, i, ptr, size: S.ADDRESS;
BEGIN
chnk := heap; i := 0; lim := cand[n-1];
WHILE (chnk # 0 ) & (chnk < lim) DO
adr := chnk + blkOff;
- lim1 := FetchAddress(chnk + endOff);
+ S.GET(chnk + endOff, lim1);
IF lim < lim1 THEN lim1 := lim END ;
WHILE adr < lim1 DO
- tag := FetchAddress(adr);
+ S.GET(adr, tag);
IF ODD(tag) THEN (*already marked*)
- size := FetchAddress(tag-1); INC(adr, size)
+ S.GET(tag-1, size); INC(adr, size)
ELSE
- size := FetchAddress(tag);
- ptr := adr + SZL;
+ S.GET(tag, size);
+ ptr := adr + SZA;
WHILE cand[i] < ptr DO INC(i) END ;
IF i = n THEN RETURN END ;
next := adr + size;
@@ -449,16 +442,16 @@ MODULE Heap;
adr := next
END
END ;
- chnk := FetchAddress(chnk)
+ S.GET(chnk, chnk)
END
END MarkCandidates;
PROCEDURE CheckFin;
- VAR n: FinNode; tag: LONGINT;
+ VAR n: FinNode; tag: S.ADDRESS;
BEGIN
n := fin;
WHILE n # NIL DO
- tag := FetchAddress(n.obj - SZL);
+ S.GET(n.obj - SZA, tag);
IF ~ODD(tag) THEN n.marked := FALSE; Mark(n.obj)
ELSE n.marked := TRUE
END ;
@@ -472,7 +465,7 @@ MODULE Heap;
WHILE n # NIL DO
IF ~n.marked THEN
IF n = fin THEN fin := fin.next ELSE prev.next := n.next END ;
- n.finalize(SYSTEM.VAL(SYSTEM.PTR, n.obj));
+ n.finalize(S.VAL(S.PTR, n.obj));
(* new nodes may have been pushed in n.finalize, therefore: *)
IF prev = NIL THEN n := fin ELSE n := n.next END
ELSE
@@ -486,31 +479,31 @@ MODULE Heap;
BEGIN
WHILE fin # NIL DO
n := fin; fin := fin.next;
- n.finalize(SYSTEM.VAL(SYSTEM.PTR, n.obj))
+ n.finalize(S.VAL(S.PTR, n.obj))
END
END FINALL;
- PROCEDURE -ExternMainStackFrame "extern LONGINT Platform_MainStackFrame;";
- PROCEDURE -PlatformMainStackFrame(): LONGINT "Platform_MainStackFrame";
+ PROCEDURE -ExternMainStackFrame "extern ADDRESS Platform_MainStackFrame;";
+ PROCEDURE -PlatformMainStackFrame(): S.ADDRESS "Platform_MainStackFrame";
- PROCEDURE MarkStack(n: LONGINT; VAR cand: ARRAY OF LONGINT);
+ PROCEDURE MarkStack(n: S.ADDRESS; VAR cand: ARRAY OF S.ADDRESS);
VAR
- frame: SYSTEM.PTR;
- inc, nofcand: LONGINT;
- sp, p, stack0: LONGINT;
- align: RECORD ch: CHAR; p: SYSTEM.PTR END ;
+ frame: S.PTR;
+ inc, nofcand: S.ADDRESS;
+ sp, p, stack0: S.ADDRESS;
+ align: RECORD ch: CHAR; p: S.PTR END ;
BEGIN
IF n > 0 THEN MarkStack(n-1, cand); (* flush register windows by means of recursive calls *)
IF n > 100 THEN RETURN END (* prevent tail recursion optimization *)
END ;
IF n = 0 THEN
- nofcand := 0; sp := SYSTEM.ADR(frame);
+ nofcand := 0; sp := S.ADR(frame);
stack0 := PlatformMainStackFrame();
(* check for minimum alignment of pointers *)
- inc := SYSTEM.ADR(align.p) - SYSTEM.ADR(align);
+ inc := S.ADR(align.p) - S.ADR(align);
IF sp > stack0 THEN inc := -inc END ;
WHILE sp # stack0 DO
- SYSTEM.GET(sp, p);
+ S.GET(sp, p);
IF (p > heap) & (p < heapend) THEN
IF nofcand = LEN(cand) THEN HeapSort(nofcand, cand); MarkCandidates(nofcand, cand); nofcand := 0 END ;
cand[nofcand] := p; INC(nofcand)
@@ -524,12 +517,12 @@ MODULE Heap;
PROCEDURE GC*(markStack: BOOLEAN);
VAR
m: Module;
- i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23: LONGINT;
- cand: ARRAY 10000 OF LONGINT;
+ i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23: S.ADDRESS;
+ cand: ARRAY 10000 OF S.ADDRESS;
BEGIN
IF (lockdepth = 0) OR (lockdepth = 1) & ~markStack THEN
Lock();
- m := SYSTEM.VAL(Module, modules);
+ m := S.VAL(Module, modules);
WHILE m # NIL DO
IF m.enumPtrs # NIL THEN m.enumPtrs(MarkP) END ;
m := m^.next
@@ -557,10 +550,10 @@ MODULE Heap;
END
END GC;
- PROCEDURE RegisterFinalizer*(obj: SYSTEM.PTR; finalize: Finalizer);
+ PROCEDURE RegisterFinalizer*(obj: S.PTR; finalize: Finalizer);
VAR f: FinNode;
BEGIN NEW(f);
- f.obj := SYSTEM.VAL(LONGINT, obj); f.finalize := finalize; f.marked := TRUE;
+ f.obj := S.VAL(S.ADDRESS, obj); f.finalize := finalize; f.marked := TRUE;
f.next := fin; fin := f;
END RegisterFinalizer;
@@ -570,11 +563,11 @@ PROCEDURE -HeapModuleInit 'Heap__init()';
PROCEDURE InitHeap*;
(* InitHeap is called by Platform.init before any module bodies have been
- initialised, to enable NEW, SYSTEM.NEW *)
+ initialised, to enable NEW, S.NEW *)
BEGIN
heap := NewChunk(heapSize0);
- heapend := FetchAddress(heap + endOff);
- SYSTEM.PUT(heap, LongZero);
+ S.GET(heap + endOff, heapend);
+ S.PUT(heap, AddressZero);
allocated := 0; firstTry := TRUE; freeList[nofLists] := 1; lockdepth := 0;
FileCount := 0; modules := NIL; heapsize := 0; bigBlocks := 0; fin := NIL;
interrupted := FALSE;
diff --git a/src/runtime/In.Mod b/src/runtime/In.Mod
new file mode 100644
index 00000000..873a00d9
--- /dev/null
+++ b/src/runtime/In.Mod
@@ -0,0 +1,151 @@
+MODULE In;
+
+IMPORT Platform, SYSTEM, Out;
+
+VAR
+ Done-: BOOLEAN;
+ nextch: CHAR; (* Maintains 1 character read ahaead except at end of line. *)
+ readstate: INTEGER;
+
+CONST
+ pending = 0; (* readstate when at start of input or end of line. Implies nextch undefined. *)
+ ready = 1; (* readstate when nextch is defined and contains next character on current line. *)
+ eof = 2; (* readstate when at end of file. *)
+
+PROCEDURE Open*;
+VAR error: Platform.ErrorCode;
+BEGIN
+ error := Platform.Seek(Platform.StdIn, 0, Platform.SeekSet); (* Rewind STDIN to beginning of file. *)
+ readstate := pending;
+ Done := TRUE;
+END Open;
+
+PROCEDURE ReadChar;
+VAR error: Platform.ErrorCode; n: LONGINT;
+BEGIN
+ error := Platform.ReadBuf(Platform.StdIn, nextch, n);
+ IF (error = 0) & (n = 1) THEN readstate := ready ELSE readstate := eof END
+END ReadChar;
+
+PROCEDURE StartRead; (* Ensure either nextch is valid or we're at EOF. *)
+BEGIN Out.Flush; IF readstate = pending THEN ReadChar END;
+END StartRead;
+
+PROCEDURE StartAndSkip; (* Like StartRead, but also skip over blanks, CR, LF, tab. *)
+BEGIN StartRead;
+ WHILE (readstate = ready) & (nextch <= " ") DO ReadChar END
+END StartAndSkip;
+
+PROCEDURE Char*(VAR ch: CHAR);
+BEGIN
+ StartRead;
+ Done := readstate = ready;
+ IF Done THEN
+ ch := nextch;
+ IF ch = 0AX THEN readstate := pending ELSE ReadChar END
+ ELSE
+ ch := 0X
+ END
+END Char;
+
+PROCEDURE HugeInt*(VAR h: HUGEINT);
+VAR
+ neg, hex, endofnum: BOOLEAN;
+ decacc, hexacc, digit: HUGEINT;
+BEGIN
+ StartAndSkip;
+ Done := FALSE;
+ IF readstate = ready THEN
+ neg := nextch = '-'; IF neg THEN ReadChar END;
+ hex := FALSE;
+ endofnum := FALSE;
+ decacc := 0;
+ hexacc := 0;
+ WHILE (readstate = ready) & ~endofnum DO
+ digit := -1;
+ IF (nextch >= "0") & (nextch <= "9") THEN
+ digit := ORD(nextch) MOD 16
+ ELSIF (nextch >= "a") & (nextch <= "f")
+ OR (nextch >= "A") & (nextch <= "F") THEN
+ digit := ORD(nextch) MOD 16 + 9; hex := TRUE
+ END;
+ IF digit >= 0 THEN
+ Done := TRUE;
+ decacc := decacc * 10 + digit;
+ hexacc := hexacc * 16 + digit;
+ ReadChar
+ ELSIF nextch = "H" THEN
+ hex := TRUE; endofnum := TRUE; ReadChar
+ ELSE
+ endofnum := TRUE
+ END
+ END;
+ IF Done THEN
+ IF hex THEN h := hexacc ELSE h := decacc END;
+ IF neg THEN h := -h END
+ ELSE
+ h := 0
+ END
+ END
+END HugeInt;
+
+PROCEDURE Int*(VAR i: INTEGER);
+VAR h: HUGEINT;
+BEGIN HugeInt(h); i := SYSTEM.VAL(INTEGER, h)
+END Int;
+
+PROCEDURE LongInt*(VAR i: LONGINT);
+VAR h: HUGEINT;
+BEGIN HugeInt(h); i := SYSTEM.VAL(LONGINT, h)
+END LongInt;
+
+PROCEDURE Real*(VAR x: REAL);
+BEGIN HALT(99) (* Not implemented *)
+END Real;
+
+PROCEDURE LongReal*(VAR y: LONGREAL);
+BEGIN HALT(99) (* Not implemented *)
+END LongReal;
+
+PROCEDURE Line*(VAR line: ARRAY OF CHAR);
+VAR i: INTEGER;
+BEGIN StartRead; i := 0; Done := readstate = ready;
+ WHILE (readstate = ready) & (nextch # 0DX) & (nextch # 0AX) & (i < LEN(line)-1) DO
+ line[i] := nextch; INC(i); ReadChar
+ END;
+ line[i] := 0X;
+ IF (readstate = ready) & (nextch = 0DX) THEN ReadChar END;
+ IF (readstate = ready) & (nextch = 0AX) THEN readstate := pending END;
+END Line;
+
+PROCEDURE String*(VAR str: ARRAY OF CHAR);
+VAR i: INTEGER;
+BEGIN StartAndSkip; i := 0;
+ IF (readstate = ready) & (nextch = '"') THEN (* " *)
+ ReadChar;
+ WHILE (readstate = ready)
+ & (i < LEN(str)-1)
+ & (nextch >= " ")
+ & (nextch # '"') DO (* " *)
+ str[i] := nextch; ReadChar; INC(i)
+ END
+ END;
+ Done := (readstate = ready)
+ & (i < LEN(str)-1)
+ & (nextch = '"'); (* " *)
+ IF Done THEN
+ ReadChar; str[i] := 0X
+ ELSE
+ str[0] := 0X
+ END
+END String;
+
+PROCEDURE Name*(VAR name: ARRAY OF CHAR); (* Read filename. Presumably using shell semantics. *)
+BEGIN HALT(99) (* Not implemented *)
+END Name;
+
+BEGIN
+ nextch := 0X;
+ readstate := pending;
+ Done := TRUE;
+END In.
diff --git a/src/runtime/Math.Mod b/src/runtime/Math.Mod
new file mode 100644
index 00000000..b3ca4e6a
--- /dev/null
+++ b/src/runtime/Math.Mod
@@ -0,0 +1,787 @@
+MODULE Math;
+
+IMPORT SYSTEM;
+
+(* Math - Oakwood REAL Mathematics.
+ Adapted from OOC LowReal.Mod and RealMath.Mod
+
+ Target independent mathematical functions for REAL
+ (IEEE single - precision) numbers.
+
+ Numerical approximations are taken from "Software Manual for the
+ Elementary Functions" by Cody & Waite and "Computer Approximations"
+ by Hart et al.
+
+ Copyright (C) 1995 Michael Griebling
+
+ This module is free software; you can redistribute it and/or modify
+ it under the terms of the GNU Lesser General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This module is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111 - 1307 USA
+*)
+
+(*
+ Real number properties are defined as follows:
+
+ radix - -The whole number value of the radix used to represent the
+ corresponding read number values.
+
+ places - -The whole number value of the number of radix places used
+ to store values of the corresponding real number type.
+
+ expoMin - -The whole number value of the exponent minimum.
+
+ expoMax - -The whole number value of the exponent maximum.
+
+ large - -The largest value of the corresponding real number type.
+
+ small - -The smallest positive value of the corresponding real number
+ type, represented to maximal precision.
+
+ IEC559 - -A Boolean value that is TRUE if and only if the implementation
+ of the corresponding real number type conforms to IEC 559:1989
+ (IEEE 754:1987) in all regards.
+
+ NOTES
+ 6 -- If `IEC559' is TRUE, the value of `radix' is 2.
+ 7 -- If LowReal.IEC559 is TRUE, the 32 - bit format of IEC 559:1989
+ is used for the type REAL.
+ 7 -- If LowLong.IEC559 is TRUE, the 64 - bit format of IEC 559:1989
+ is used for the type REAL.
+
+ LIA1 - -A Boolean value that is TRUE if and only if the implementation of
+ the corresponding real number type conforms to ISO/IEC 10967 - 1:199x
+ (LIA - 1) in all regards: parameters, arithmetic, exceptions, and
+ notification.
+
+ rounds - -A Boolean value that is TRUE if and only if each operation produces
+ a result that is one of the values of the corresponding real number
+ type nearest to the mathematical result.
+
+ gUnderflow - -A Boolean value that is TRUE if and only if there are values of
+ the corresponding real number type between 0.0 and `small'.
+
+ exception - -A Boolean value that is TRUE if and only if every operation that
+ attempts to produce a real value out of range raises an exception.
+
+ extend - -A Boolean value that is TRUE if and only if expressions of the
+ corresponding real number type are computed to higher precision than
+ the stored values.
+
+ nModes - -The whole number value giving the number of bit positions needed for
+ the status flags for mode control.
+ *)
+
+CONST
+ pi* = 3.1415926535897932384626433832795028841972;
+ e* = 2.7182818284590452353602874713526624977572;
+
+ places* = 24;
+ large* = MAX(REAL); (* 3.40282347E+38. Largest number this package accepts *)
+(*small* = 1.17549435E-38; *) (* 2^(-126) *)
+ small* = 1/8.50705917E37; (* don't know better way; -- noch *)
+ expoMax* = 127;
+ expoMin* = 1-expoMax;
+ expOffset = expoMax;
+ nMask = {0..22,31}; (* number mask: Sign and mantissa *)
+ expMask = {23..30}; (* exponent mask: exponent value + 127 *)
+
+ ZERO = 0.0;
+ HALF = 0.5;
+ ONE = 1.0;
+ TWO = 2.0;
+ TEN = 10.0;
+ miny = ONE/large; (* Smallest number this package accepts *)
+ sqrtHalf = 0.70710678118654752440;
+ Limit = 2.4414062E-4; (* 2 * *( - MantBits/2) *)
+ eps = 2.9802322E-8; (* 2 * *( - MantBits - 1) *)
+ piInv = 0.31830988618379067154; (* 1/pi *)
+ piByTwo = 1.57079632679489661923132;
+ piByFour = 0.78539816339744830962;
+ lnv = 0.6931610107421875; (* should be exact *)
+ vbytwo = 0.13830277879601902638E-4; (* used in sinh/cosh *)
+ ln2Inv = 1.44269504088896340735992468100189213;
+
+ (* error/exception codes *)
+ NoError* = 0; IllegalRoot* = 1; IllegalLog* = 2; Overflow* = 3;
+ IllegalPower* = 4; IllegalLogBase* = 5; IllegalTrig* = 6; IllegalInvTrig* = 7;
+ HypInvTrigClipped* = 8; IllegalHypInvTrig* = 9; LossOfAccuracy* = 10; Underflow* = 11;
+
+VAR
+ ErrorHandler*: PROCEDURE (errno : INTEGER);
+ err-: INTEGER;
+
+ a1: ARRAY 18 OF REAL; (* lookup table for power function *)
+ a2: ARRAY 9 OF REAL; (* lookup table for power function *)
+ em: REAL; (* largest number such that 1 + epsilon > 1.0 *)
+ LnInfinity: REAL; (* natural log of infinity *)
+ LnSmall: REAL; (* natural log of very small number *)
+ SqrtInfinity: REAL; (* square root of infinity *)
+ TanhMax: REAL; (* maximum Tanh value *)
+ t: REAL; (* internal variables *)
+
+
+PROCEDURE DefaultErrorHandler(errno : INTEGER);
+BEGIN err:=errno END DefaultErrorHandler;
+
+PROCEDURE ClearError*;
+BEGIN err:=0 END ClearError;
+
+
+(* TYPE REAL: 1/sign, 8/exponent, 23/significand *)
+
+PROCEDURE fraction*(x: REAL): REAL;
+(*
+ The value of the call fraction(x) shall be the significand (or
+ significant) part of `x'. Hence the following relationship shall
+ hold: x = scale(fraction(x), exponent(x)).
+*)
+ VAR s: SET;
+BEGIN
+ IF x = ZERO THEN RETURN ZERO
+ ELSE
+ s := SYSTEM.VAL(SYSTEM.SET32, x) * nMask + {24..29};
+ RETURN SYSTEM.VAL(REAL, s) * 2.0;
+ END
+END fraction;
+
+PROCEDURE exponent*(x: REAL): INTEGER;
+(*
+ The value of the call exponent(x) shall be the exponent value of `x'
+ that lies between `expoMin' and `expoMax'. An exception shall occur
+ and may be raised if `x' is equal to 0.0.
+ *)
+BEGIN
+ IF x = ZERO THEN RETURN 0 (* NOTE: x=0.0 should raise exception *)
+ ELSE
+ RETURN SHORT(SYSTEM.LSH(SYSTEM.VAL(SYSTEM.INT32, x), -23) MOD 256) - 127
+ END
+END exponent;
+
+PROCEDURE sign*(x: REAL): REAL;
+(*
+ The value of the call sign(x) shall be 1.0 if `x' is greater than 0.0,
+ or shall be -1.0 if `x' is less than 0.0, or shall be either 1.0 or
+ -1.0 if `x' is equal to 0.0.
+*)
+BEGIN
+ IF x < ZERO THEN RETURN -ONE ELSE RETURN ONE END
+END sign;
+
+PROCEDURE scale*(x: REAL; n: INTEGER): REAL;
+(*
+ The value of the call scale(x,n) shall be the value x*radix^n if such
+ a value exists; otherwise an execption shall occur and may be raised.
+*)
+ VAR exp: LONGINT; lexp: SET;
+BEGIN
+ IF x = ZERO THEN RETURN ZERO END;
+ exp := exponent(x) + n; (* new exponent *)
+ IF exp > expoMax THEN RETURN large * sign(x) (* exception raised here *)
+ ELSIF exp < expoMin THEN RETURN small * sign(x) (* exception here as well *)
+ END;
+ lexp := SYSTEM.VAL(SYSTEM.SET32, x) * nMask (* sign and significand *)
+ + SYSTEM.VAL(SYSTEM.SET32, SYSTEM.LSH(exp+expOffset, 23)); (* shifted exponent bits *)
+ RETURN SYSTEM.VAL(REAL, lexp)
+END scale;
+
+PROCEDURE ulp*(x: REAL): REAL;
+(*
+ The value of the call ulp(x) shall be the value of the corresponding
+ real number type equal to a unit in the last place of `x', if such a
+ value exists; otherwise an exception shall occur and may be raised.
+*)
+BEGIN
+ RETURN scale(ONE, exponent(x)-places+1)
+END ulp;
+
+PROCEDURE succ*(x: REAL): REAL;
+(*
+ The value of the call succ(x) shall be the next value of the
+ corresponding real number type greater than `x', if such a type
+ exists; otherwise an exception shall occur and may be raised.
+*)
+BEGIN
+ RETURN x+ulp(x)*sign(x)
+END succ;
+
+PROCEDURE pred*(x: REAL): REAL;
+(*
+ The value of the call pred(x) shall be the next value of the
+ corresponding real number type less than `x', if such a type exists;
+ otherwise an exception shall occur and may be raised.
+*)
+BEGIN
+ RETURN x-ulp(x)*sign(x)
+END pred;
+
+
+PROCEDURE SinCos (x, y, sign: REAL): REAL;
+ CONST
+ ymax = 9099; (* ENTIER(pi * 2* * (MantBits/2)) *)
+ r1 = -0.1666665668E+0;
+ r2 = 0.8333025139E-2;
+ r3 = -0.1980741872E-3;
+ r4 = 0.2601903036E-5;
+ VAR
+ n: LONGINT; xn, f, g: REAL;
+BEGIN
+ IF y >= ymax THEN ErrorHandler(LossOfAccuracy); RETURN ZERO END;
+
+ (* determine the reduced number *)
+ n := ENTIER(y * piInv + HALF); xn := n;
+ IF ODD(n) THEN sign := -sign END;
+ x := ABS(x);
+ IF x # y THEN xn := xn - HALF END;
+
+ (* fractional part of reduced number *)
+ f := SHORT(ABS(LONG(x)) - LONG(xn) * pi);
+
+ (* Pre: |f| <= pi/2 *)
+ IF ABS(f) < Limit THEN RETURN sign * f END;
+
+ (* evaluate polynomial approximation of sin *)
+ g := f * f; g := (((r4 * g + r3) * g + r2) * g + r1) * g;
+ g := f + f * g; (* don't use less accurate f(1 + g) *)
+ RETURN sign * g
+END SinCos;
+
+PROCEDURE div (x, y : LONGINT) : LONGINT;
+(* corrected MOD function *)
+BEGIN
+ IF x < 0 THEN
+ (*ASSERT((x DIV y) = ( - ABS(x) DIV y));*) (* x DIV y should already be correct *)
+ RETURN -ABS(x) DIV y
+ ELSE
+ RETURN x DIV y
+ END
+END div;
+
+
+(* forward declarations *)
+PROCEDURE^ arctan2* (xn, xd: REAL): REAL;
+PROCEDURE^ sincos* (x: REAL; VAR Sin, Cos: REAL);
+
+PROCEDURE round* (x: REAL): LONGINT;
+ (* Returns the value of x rounded to the nearest integer *)
+BEGIN
+ IF x < ZERO THEN RETURN -ENTIER(HALF - x)
+ ELSE RETURN ENTIER(x + HALF)
+ END
+END round;
+
+PROCEDURE sqrt* (x: REAL): REAL;
+ (* Returns the positive square root of x where x >= 0 *)
+ CONST
+ P0 = 0.41731; P1 = 0.59016;
+ VAR
+ xMant, yEst, z: REAL; xExp: INTEGER;
+BEGIN
+ (* optimize zeros and check for illegal negative roots *)
+ IF x = ZERO THEN RETURN ZERO END;
+ IF x < ZERO THEN ErrorHandler(IllegalRoot); x := -x END;
+
+ (* reduce the input number to the range 0.5 <= x <= 1.0 *)
+ xMant := fraction(x) * HALF; xExp := exponent(x) + 1;
+
+ (* initial estimate of the square root *)
+ yEst := P0 + P1 * xMant;
+
+ (* perform two newtonian iterations *)
+ z := (yEst + xMant/yEst); yEst := 0.25 * z + xMant/z;
+
+ (* adjust for odd exponents *)
+ IF ODD(xExp) THEN yEst := yEst * sqrtHalf; INC(xExp) END;
+
+ (* single Newtonian iteration to produce real number accuracy *)
+ RETURN scale(yEst, xExp DIV 2)
+END sqrt;
+
+PROCEDURE exp* (x: REAL): REAL;
+ (* Returns the exponential of x for x < Ln(MAX(REAL)) *)
+ CONST
+ ln2 = 0.6931471805599453094172321D0;
+ P0 = 0.24999999950E+0; P1 = 0.41602886268E-2; Q1 = 0.49987178778E-1;
+ VAR xn, g, p, q, z: REAL; n: LONGINT;
+BEGIN
+ (* Ensure we detect overflows and return 0 for underflows *)
+ IF x >= LnInfinity THEN ErrorHandler(Overflow); RETURN large
+ ELSIF x < LnSmall THEN ErrorHandler(Underflow); RETURN ZERO
+ ELSIF ABS(x) < eps THEN RETURN ONE
+ END;
+
+ (* Decompose and scale the number *)
+ n := round(ln2Inv * x);
+ xn := n; g := SHORT(LONG(x) - LONG(xn) * ln2);
+
+ (* Calculate exp(g)/2 from "Software Manual for the Elementary Functions" *)
+ z := g * g; p := (P1 * z + P0) * g; q := Q1 * z + HALF;
+ RETURN scale(HALF + p/(q - p), SHORT(n + 1))
+END exp;
+
+PROCEDURE ln* (x: REAL): REAL;
+ (* Returns the natural logarithm of x for x > 0 *)
+ CONST
+ c1 = 355.0/512.0; c2 = -2.121944400546905827679E-4;
+ A0 = -0.5527074855E+0; B0 = -0.6632718214E+1;
+ VAR f, zn, zd, r, z, w, xn: REAL; n: INTEGER;
+BEGIN
+ (* ensure illegal inputs are trapped and handled *)
+ IF x <= ZERO THEN ErrorHandler(IllegalLog); RETURN -large END;
+
+ (* reduce the range of the input *)
+ f := fraction(x) * HALF; n := exponent(x) + 1;
+ IF f > sqrtHalf THEN zn := (f - HALF) - HALF; zd := f * HALF + HALF
+ ELSE zn := f - HALF; zd := zn * HALF + HALF; DEC(n)
+ END;
+
+ (* evaluate rational approximation from "Software Manual for the Elementary Functions" *)
+ z := zn/zd; w := z * z; r := z + z * (w * A0/(w + B0));
+
+ (* scale the output *)
+ xn := n;
+ RETURN (xn * c2 + r) + xn * c1
+END ln;
+
+(* The angle in all trigonometric functions is measured in radians *)
+
+PROCEDURE sin* (x: REAL): REAL;
+ (* Returns the sine of x for all x *)
+BEGIN
+ IF x < ZERO THEN RETURN SinCos(x, -x, -ONE)
+ ELSE RETURN SinCos(x, x, ONE)
+ END
+END sin;
+
+PROCEDURE cos* (x: REAL): REAL;
+ (* Returns the cosine of x for all x *)
+BEGIN
+ RETURN SinCos(x, ABS(x) + piByTwo, ONE)
+END cos;
+
+PROCEDURE tan* (x: REAL): REAL;
+ (* Returns the tangent of x where x cannot be an odd multiple of pi/2 *)
+CONST
+ ymax = 6434; (* ENTIER(2 * *(MantBits/2) * pi/2) *)
+ twoByPi = 0.63661977236758134308;
+ P1 = -0.958017723E-1; Q1 = -0.429135777E+0; Q2 = 0.971685835E-2;
+VAR
+ n: LONGINT;
+ y, xn, f, xnum, xden, g: REAL;
+BEGIN
+ (* check for error limits *)
+ y := ABS(x);
+ IF y > ymax THEN ErrorHandler(LossOfAccuracy); RETURN ZERO END;
+
+ (* determine n and the fraction f *)
+ n := round(x * twoByPi); xn := n;
+ f := SHORT(LONG(x) - LONG(xn) * piByTwo);
+
+ (* check for underflow *)
+ IF ABS(f) < Limit THEN xnum := f; xden := ONE
+ ELSE g := f * f; xnum := P1 * g*f + f; xden := (Q2 * g + Q1) * g + HALF + HALF
+ END;
+
+ (* find the final result *)
+ IF ODD(n) THEN RETURN xden/( - xnum)
+ ELSE RETURN xnum/xden
+ END
+END tan;
+
+PROCEDURE asincos (x: REAL; flag: LONGINT; VAR i: LONGINT; VAR res: REAL);
+CONST
+ P1 = 0.933935835E+0; P2 = -0.504400557E+0;
+ Q0 = 0.560363004E+1; Q1 = -0.554846723E+1;
+VAR
+ y, g, r: REAL;
+BEGIN
+ y := ABS(x);
+ IF y > HALF THEN
+ i := 1 - flag;
+ IF y > ONE THEN ErrorHandler(IllegalInvTrig); res := large; RETURN END;
+
+ (* reduce the input argument *)
+ g := (ONE-y) * HALF; r := -sqrt(g); y := r + r;
+
+ (* compute approximation *)
+ r := ((P2 * g + P1) * g)/((g + Q1) * g + Q0);
+ res := y + (y * r)
+ ELSE
+ i := flag;
+ IF y < Limit THEN res := y
+ ELSE
+ g := y * y;
+
+ (* compute approximation *)
+ g := ((P2 * g + P1) * g)/((g + Q1) * g + Q0);
+ res := y + y * g
+ END
+ END
+END asincos;
+
+PROCEDURE arcsin* (x: REAL): REAL;
+ (* Returns the arcsine of x, in the range [ - pi/2, pi/2] where -1 <= x <= 1 *)
+VAR
+ res: REAL; i: LONGINT;
+BEGIN
+ asincos(x, 0, i, res);
+ IF err # 0 THEN RETURN res END;
+
+ (* adjust result for the correct quadrant *)
+ IF i = 1 THEN res := piByFour + (piByFour + res) END;
+ IF x < 0 THEN res := -res END;
+ RETURN res
+END arcsin;
+
+PROCEDURE arccos* (x: REAL): REAL;
+ (* Returns the arccosine of x, in the range [0, pi] where -1 <= x <= 1 *)
+VAR
+ res: REAL; i: LONGINT;
+BEGIN
+ asincos(x, 1, i, res);
+ IF err # 0 THEN RETURN res END;
+
+ (* adjust result for the correct quadrant *)
+ IF x < 0 THEN
+ IF i = 0 THEN res := piByTwo + (piByTwo + res)
+ ELSE res := piByFour + (piByFour + res)
+ END
+ ELSE
+ IF i = 1 THEN res := piByFour + (piByFour - res)
+ ELSE res := -res
+ END;
+ END;
+ RETURN res
+END arccos;
+
+PROCEDURE atan(f: REAL): REAL;
+(* internal arctan algorithm *)
+CONST
+ rt32 = 0.26794919243112270647;
+ rt3 = 1.73205080756887729353;
+ a = rt3 - ONE;
+ P0 = -0.4708325141E+0; P1 = -0.5090958253E-1; Q0 = 0.1412500740E+1;
+ piByThree = 1.04719755119659774615;
+ piBySix = 0.52359877559829887308;
+VAR
+ n: LONGINT; res, g: REAL;
+BEGIN
+ IF f > ONE THEN f := ONE/f; n := 2
+ ELSE n := 0
+ END;
+
+ (* check if f should be scaled *)
+ IF f > rt32 THEN f := (((a * f - HALF) - HALF) + f)/(rt3 + f); INC(n) END;
+
+ (* check for underflow *)
+ IF ABS(f) < Limit THEN res := f
+ ELSE
+ g := f * f; res := (P1 * g + P0) * g/(g + Q0); res := f + f * res
+ END;
+ IF n > 1 THEN res := -res END;
+ CASE n OF
+ | 1: res := res + piBySix
+ | 2: res := res + piByTwo
+ | 3: res := res + piByThree
+ | ELSE (* do nothing *)
+ END;
+ RETURN res
+END atan;
+
+PROCEDURE arctan* (x: REAL): REAL;
+ (* Returns the arctangent of x, in the range [ - pi/2, pi/2] for all x *)
+BEGIN
+ IF x < 0 THEN RETURN -atan( - x)
+ ELSE RETURN atan(x)
+ END
+END arctan;
+
+PROCEDURE power* (base, exp: REAL): REAL;
+ (* Returns the value of the number base raised to the power exponent
+ for base > 0 *)
+ CONST P1 = 0.83357541E-1; K = 0.4426950409;
+ Q1 = 0.69314675; Q2 = 0.24018510; Q3 = 0.54360383E-1;
+ OneOver16 = 0.0625;
+ XMAX = 16 * (expoMax + 1) - 1;
+ (* XMIN = 16 * expoMin; *) XMIN = -2016; (* to make it easier for voc; -- noch *)
+ VAR z, g, R, v, u2, u1, w1, w2: REAL; w: LONGREAL;
+ m, p, i: INTEGER; mp, pp, iw1: LONGINT;
+BEGIN
+ (* handle all possible error conditions *)
+ IF base <= ZERO THEN
+ IF base # ZERO THEN ErrorHandler(IllegalPower); base := -base
+ ELSIF exp > ZERO THEN RETURN ZERO
+ ELSE ErrorHandler(IllegalPower); RETURN large
+ END
+ END;
+
+ (* extract the exponent of base to m and clear exponent of base in g *)
+ g := fraction(base) * HALF;
+ m := exponent(base) + 1;
+
+ (* determine p table offset with an unrolled binary search *)
+ p := 1;
+ IF g <= a1[9] THEN p := 9 END;
+ IF g <= a1[p + 4] THEN INC(p, 4) END;
+ IF g <= a1[p + 2] THEN INC(p, 2) END;
+
+ (* compute scaled z so that |z| <= 0.044 *)
+ z := ((g - a1[p + 1]) - a2[(p + 1) DIV 2])/(g + a1[p + 1]); z := z + z;
+
+ (* approximation for log2(z) from "Software Manual for the Elementary Functions" *)
+ v := z * z; R := P1 * v*z; R := R + K * R; u2 := (R + z * K) + z;
+ u1 := (m * 16 - p) * OneOver16; w := LONG(exp) * (LONG(u1) + LONG(u2)); (* need extra precision *)
+
+ (* calculations below were modified to work properly -- incorrect in cited reference? *)
+ iw1 := ENTIER(16 * w); w1 := iw1 * OneOver16; w2 := SHORT(w - w1);
+
+ (* check for overflow/underflow *)
+ IF iw1 > XMAX THEN ErrorHandler(Overflow); RETURN large
+ ELSIF iw1 < XMIN THEN ErrorHandler(Underflow); RETURN ZERO
+ END;
+
+ (* final approximation 2 * *w2 - 1 where -0.0625 <= w2 <= 0 *)
+ IF w2 > ZERO THEN INC(iw1); w2 := w2 - OneOver16 END;
+ IF iw1 < 0 THEN i := 0 ELSE i := 1 END;
+ mp := div(iw1, 16) + i; pp := 16 * mp - iw1;
+ z := ((Q3 * w2 + Q2) * w2 + Q1) * w2;
+ z := a1[pp + 1] + a1[pp + 1] * z;
+ RETURN scale(z, SHORT(mp))
+END power;
+
+PROCEDURE IsRMathException* (): BOOLEAN;
+ (* Returns TRUE if the current coroutine is in the exceptional execution state
+ because of the raising of the RealMath exception; otherwise returns FALSE.
+ *)
+BEGIN
+ RETURN FALSE
+END IsRMathException;
+
+
+(*
+ Following routines are provided as extensions to the ISO standard.
+ They are either used as the basis of other functions or provide
+ useful functions which are not part of the ISO standard.
+ *)
+
+PROCEDURE log* (x, base: REAL): REAL;
+(* log(x,base) is the logarithm of x base 'base'. All positive arguments are
+ allowed but base > 0 and base # 1 *)
+BEGIN
+ (* log(x, base) = ln(x) / ln(base) *)
+ IF base <= ZERO THEN ErrorHandler(IllegalLogBase); RETURN -large
+ ELSE RETURN ln(x)/ln(base)
+ END
+END log;
+
+PROCEDURE ipower* (x: REAL; base: INTEGER): REAL;
+(* ipower(x, base) returns the x to the integer power base where Log2(x) < expoMax *)
+ VAR Exp: INTEGER; y: REAL; neg: BOOLEAN;
+
+ PROCEDURE Adjust(xadj: REAL): REAL;
+ BEGIN
+ IF (x < ZERO)&ODD(base) THEN RETURN -xadj ELSE RETURN xadj END
+ END Adjust;
+
+BEGIN
+ (* handle all possible error conditions *)
+ IF base = 0 THEN RETURN ONE (* x * *0 = 1 *)
+ ELSIF ABS(x) < miny THEN
+ IF base > 0 THEN RETURN ZERO ELSE ErrorHandler(Overflow); RETURN Adjust(large) END
+ END;
+
+ (* trap potential overflows and underflows *)
+ Exp := (exponent(x) + 1) * base; y := LnInfinity * ln2Inv;
+ IF Exp > y THEN ErrorHandler(Overflow); RETURN Adjust(large)
+ ELSIF Exp< - y THEN RETURN ZERO
+ END;
+
+ (* compute x * *base using an optimised algorithm from Knuth, slightly
+ altered : p442, The Art Of Computer Programming, Vol 2 *)
+ y := ONE; IF base < 0 THEN neg := TRUE; base := -base ELSE neg:= FALSE END;
+ LOOP
+ IF ODD(base) THEN y := y * x END;
+ base := base DIV 2; IF base = 0 THEN EXIT END;
+ x := x * x;
+ END;
+ IF neg THEN RETURN ONE/y ELSE RETURN y END
+END ipower;
+
+PROCEDURE sincos* (x: REAL; VAR Sin, Cos: REAL);
+(* More efficient sin/cos implementation if both values are needed. *)
+BEGIN
+ Sin := sin(x); Cos := sqrt(ONE-Sin * Sin)
+END sincos;
+
+PROCEDURE arctan2* (xn, xd: REAL): REAL;
+(* arctan2(xn,xd) is the quadrant - correct arc tangent atan(xn/xd). If the
+ denominator xd is zero, then the numerator xn must not be zero. All
+ arguments are legal except xn = xd = 0. *)
+VAR
+ res: REAL; xpdiff: LONGINT;
+BEGIN
+ (* check for error conditions *)
+ IF xd = ZERO THEN
+ IF xn = ZERO THEN ErrorHandler(IllegalTrig); RETURN ZERO
+ ELSIF xn < 0 THEN RETURN -piByTwo
+ ELSE RETURN piByTwo
+ END;
+ ELSE
+ xpdiff := exponent(xn) - exponent(xd);
+ IF ABS(xpdiff) >= expoMax - 3 THEN
+ (* overflow detected *)
+ IF xn < 0 THEN RETURN -piByTwo
+ ELSE RETURN piByTwo
+ END
+ ELSE
+ res := ABS(xn/xd);
+ IF res # ZERO THEN res := atan(res) END;
+ IF xd < ZERO THEN res := pi - res END;
+ IF xn < ZERO THEN RETURN -res
+ ELSE RETURN res
+ END
+ END
+ END
+END arctan2;
+
+PROCEDURE sinh* (x: REAL): REAL;
+(* sinh(x) is the hyperbolic sine of x. The argument x must not be so large
+ that exp(|x|) overflows. *)
+ CONST P0 = -7.13793159; P1 = -0.190333399; Q0 = -42.8277109;
+ VAR y, f: REAL;
+BEGIN y := ABS(x);
+ IF y <= ONE THEN (* handle small arguments *)
+ IF y < Limit THEN RETURN x END;
+
+ (* use approximation from "Software Manual for the Elementary Functions" *)
+ f := y * y; y := f * ((f * P1 + P0)/(f + Q0)); RETURN x + x * y
+ ELSIF y > LnInfinity THEN (* handle exp overflows *)
+ y := y - lnv;
+ IF y > LnInfinity - lnv + 0.69 THEN ErrorHandler(Overflow);
+ IF x > ZERO THEN RETURN large ELSE RETURN -large END
+ ELSE f := exp(y); f := f + f * vbytwo (* don't change to f(1 + vbytwo) *)
+ END
+ ELSE f := exp(y); f := (f - ONE/f) * HALF
+ END;
+
+ (* reach here when 1 < ABS(x) < LnInfinity - lnv + 0.69 *)
+ IF x > ZERO THEN RETURN f ELSE RETURN -f END
+END sinh;
+
+PROCEDURE cosh* (x: REAL): REAL;
+(* cosh(x) is the hyperbolic cosine of x. The argument x must not be so large
+ that exp(|x|) overflows. *)
+ VAR y, f: REAL;
+BEGIN y := ABS(x);
+ IF y > LnInfinity THEN (* handle exp overflows *)
+ y := y - lnv;
+ IF y > LnInfinity - lnv + 0.69 THEN ErrorHandler(Overflow);
+ IF x > ZERO THEN RETURN large ELSE RETURN -large END
+ ELSE f := exp(y); RETURN f + f * vbytwo (* don't change to f(1 + vbytwo) *)
+ END
+ ELSE f := exp(y); RETURN (f + ONE/f) * HALF
+ END
+END cosh;
+
+PROCEDURE tanh* (x: REAL): REAL;
+(* tanh(x) is the hyperbolic tangent of x. All arguments are legal. *)
+ CONST P0 = -0.8237728127; P1 = -0.3831010665E-2; Q0 = 2.471319654; ln3over2 = 0.5493061443;
+ BIG = 9.010913347; (* (ln(2) + (t + 1) * ln(B))/2 where t = mantissa bits, B = base *)
+ VAR f, t: REAL;
+BEGIN f := ABS(x);
+ IF f > BIG THEN t := ONE
+ ELSIF f > ln3over2 THEN t := ONE - TWO/(exp(TWO * f) + ONE)
+ ELSIF f < Limit THEN t := f
+ ELSE (* approximation from "Software Manual for the Elementary Functions" *)
+ t := f * f; t := t * (P1 * t + P0)/(t + Q0); t := f + f * t
+ END;
+ IF x < ZERO THEN RETURN -t ELSE RETURN t END
+END tanh;
+
+PROCEDURE arcsinh* (x: REAL): REAL;
+(* arcsinh(x) is the arc hyperbolic sine of x. All arguments are legal. *)
+BEGIN
+ IF ABS(x) > SqrtInfinity * HALF THEN ErrorHandler(HypInvTrigClipped);
+ IF x > ZERO THEN RETURN ln(SqrtInfinity) ELSE RETURN -ln(SqrtInfinity) END;
+ ELSIF x < ZERO THEN RETURN -ln( - x + sqrt(x * x + ONE))
+ ELSE RETURN ln(x + sqrt(x * x + ONE))
+ END
+END arcsinh;
+
+PROCEDURE arccosh* (x: REAL): REAL;
+(* arccosh(x) is the arc hyperbolic cosine of x. All arguments greater than
+ or equal to 1 are legal. *)
+BEGIN
+ IF x < ONE THEN ErrorHandler(IllegalHypInvTrig); RETURN ZERO
+ ELSIF x > SqrtInfinity * HALF THEN ErrorHandler(HypInvTrigClipped); RETURN ln(SqrtInfinity)
+ ELSE RETURN ln(x + sqrt(x * x - ONE))
+ END
+END arccosh;
+
+PROCEDURE arctanh* (x: REAL): REAL;
+(* arctanh(x) is the arc hyperbolic tangent of x. |x| < 1 - sqrt(em), where
+ em is machine epsilon. Note that |x| must not be so close to 1 that the
+ result is less accurate than half precision. *)
+ CONST TanhLimit = 0.999984991; (* Tanh(5.9) *)
+ VAR t: REAL;
+BEGIN t := ABS(x);
+ IF (t >= ONE) OR (t > (ONE - TWO * em)) THEN ErrorHandler(IllegalHypInvTrig);
+ IF x < ZERO THEN RETURN -TanhMax ELSE RETURN TanhMax END
+ ELSIF t > TanhLimit THEN ErrorHandler(LossOfAccuracy)
+ END;
+ RETURN arcsinh(x/sqrt(ONE - x * x))
+END arctanh;
+
+PROCEDURE ToREAL(h: HUGEINT): REAL;
+BEGIN RETURN SYSTEM.VAL(REAL, h)
+END ToREAL;
+
+BEGIN
+ ErrorHandler := DefaultErrorHandler;
+
+ (* determine fundamental constants used by hyperbolic trig functions *)
+ em := ulp(ONE);
+ LnInfinity := ln(large);
+ LnSmall := ln(miny);
+ SqrtInfinity := sqrt(large);
+ t := pred(ONE)/sqrt(em);
+ TanhMax := ln(t + sqrt(t * t + ONE));
+
+ (* initialize tables for the power() function a1[i] = 2 * *((1 - i)/16) *)
+ a1[1] := ONE;
+ a1[2] := ToREAL(3F75257DH);
+ a1[3] := ToREAL(3F6AC0C7H);
+ a1[4] := ToREAL(3F60CCDFH);
+ a1[5] := ToREAL(3F5744FDH);
+ a1[6] := ToREAL(3F4E248CH);
+ a1[7] := ToREAL(3F45672AH);
+ a1[8] := ToREAL(3F3D08A4H);
+ a1[9] := ToREAL(3F3504F3H);
+ a1[10] := ToREAL(3F2D583FH);
+ a1[11] := ToREAL(3F25FED7H);
+ a1[12] := ToREAL(3F1EF532H);
+ a1[13] := ToREAL(3F1837F0H);
+ a1[14] := ToREAL(3F11C3D3H);
+ a1[15] := ToREAL(3F0B95C2H);
+ a1[16] := ToREAL(3F05AAC3H);
+ a1[17] := HALF;
+
+ (* a2[i] = 2 * *[(1 - 2i)/16] - a1[2i]; delta resolution *)
+ a2[1] := ToREAL(31A92436H);
+ a2[2] := ToREAL(336C2A95H);
+ a2[3] := ToREAL(31A8FC24H);
+ a2[4] := ToREAL(331F580CH);
+ a2[5] := ToREAL(336A42A1H);
+ a2[6] := ToREAL(32C12342H);
+ a2[7] := ToREAL(32E75624H);
+ a2[8] := ToREAL(32CF9890H)
+END Math.
diff --git a/src/runtime/MathL.Mod b/src/runtime/MathL.Mod
new file mode 100644
index 00000000..bd17b490
--- /dev/null
+++ b/src/runtime/MathL.Mod
@@ -0,0 +1,722 @@
+MODULE MathL;
+
+(* MathL - Oakwood LONGREAL Mathematics.
+ Adapted from OOC LowLReal.Mod and LRealMath.Mod
+
+ Target independent mathematical functions for LONGREAL
+ (IEEE double-precision) numbers.
+
+ Numerical approximations are taken from "Software Manual for the
+ Elementary Functions" by Cody & Waite and "Computer Approximations"
+ by Hart et al.
+
+ Copyright (C) 1996-1998 Michael Griebling
+
+ This module is free software; you can redistribute it and/or modify
+ it under the terms of the GNU Lesser General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ This module is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+(*
+ Real number properties are defined as follows:
+
+ radix--The whole number value of the radix used to represent the
+ corresponding read number values.
+
+ places--The whole number value of the number of radix places used
+ to store values of the corresponding real number type.
+
+ expoMin--The whole number value of the exponent minimum.
+
+ expoMax--The whole number value of the exponent maximum.
+
+ large--The largest value of the corresponding real number type.
+
+ small--The smallest positive value of the corresponding real number
+ type, represented to maximal precision.
+
+ IEC559--A Boolean value that is TRUE if and only if the implementation
+ of the corresponding real number type conforms to IEC 559:1989
+ (IEEE 754:1987) in all regards.
+
+ NOTES
+ 6 -- If `IEC559' is TRUE, the value of `radix' is 2.
+ 7 -- If LowReal.IEC559 is TRUE, the 32-bit format of IEC 559:1989
+ is used for the type REAL.
+ 7 -- If LowLong.IEC559 is TRUE, the 64-bit format of IEC 559:1989
+ is used for the type REAL.
+
+ LIA1--A Boolean value that is TRUE if and only if the implementation of
+ the corresponding real number type conforms to ISO/IEC 10967-1:199x
+ (LIA-1) in all regards: parameters, arithmetic, exceptions, and
+ notification.
+
+ rounds--A Boolean value that is TRUE if and only if each operation produces
+ a result that is one of the values of the corresponding real number
+ type nearest to the mathematical result.
+
+ gUnderflow--A Boolean value that is TRUE if and only if there are values of
+ the corresponding real number type between 0.0 and `small'.
+
+ exception--A Boolean value that is TRUE if and only if every operation that
+ attempts to produce a real value out of range raises an exception.
+
+ extend--A Boolean value that is TRUE if and only if expressions of the
+ corresponding real number type are computed to higher precision than
+ the stored values.
+
+ nModes--The whole number value giving the number of bit positions needed for
+ the status flags for mode control.
+*)
+
+IMPORT Math, SYSTEM;
+
+CONST
+ pi* = 3.1415926535897932384626433832795028841972D0;
+ e* = 2.7182818284590452353602874713526624977572D0;
+
+ places* = 53;
+ large* = MAX(LONGREAL); (*1.7976931348623157D+308;*) (* MAX(LONGREAL) *)
+(*small* = 2.2250738585072014D-308; *)
+ small* = 2.2250738585072014/9.9999999999999981D307(*/10^308)*);
+ expoMax* = 1023;
+ expoMin* = 1-expoMax;
+ expOffset = expoMax;
+
+ ZERO = 0.0D0;
+ ONE = 1.0D0;
+ HALF = 0.5D0;
+ TWO = 2.0D0;
+ miny = ONE/large; (* Smallest number this package accepts *)
+ sqrtHalf = 0.70710678118654752440D0;
+ Limit = 1.0536712D-8; (* 2**(-MantBits/2) *)
+ eps = 5.5511151D-17; (* 2**(-MantBits-1) *)
+ piInv = 0.31830988618379067154D0; (* 1/pi *)
+ piByTwo = 1.57079632679489661923D0;
+ lnv = 0.6931610107421875D0; (* should be exact *)
+ vbytwo = 0.13830277879601902638D-4; (* used in sinh/cosh *)
+ ln2Inv = 1.44269504088896340735992468100189213D0;
+
+VAR
+ a1: ARRAY 18 OF LONGREAL; (* lookup table for power function *)
+ a2: ARRAY 9 OF LONGREAL; (* lookup table for power function *)
+ em: LONGREAL; (* largest number such that 1 + epsilon > 1.0 *)
+ LnInfinity: LONGREAL; (* natural log of infinity *)
+ LnSmall: LONGREAL; (* natural log of very small number *)
+ SqrtInfinity: LONGREAL; (* square root of infinity *)
+ TanhMax: LONGREAL; (* maximum Tanh value *)
+ NumberMask: SYSTEM.SET64; (* Sign and significand, {0..51, 63} *)
+ ExponentMask: SYSTEM.SET64; (* Exponent part, {53..62} *)
+ ZeroExponent: SYSTEM.SET64; (* Zero valued exponent {54..61} *)
+ t: LONGREAL; (* internal variables *)
+ i: INTEGER; (* For initialisation loops in module body. *)
+
+
+
+
+(* TYPE LONGREAL: 1/sign, 11/exponent, 52/significand *)
+
+PROCEDURE fraction*(x: LONGREAL): LONGREAL;
+(*
+ The value of the call fraction(x) shall be the significand (or
+ significant) part of `x'. Hence the following relationship shall
+ hold: x = scale(fraction(x), exponent(x)).
+*)
+ VAR s: SYSTEM.SET64;
+BEGIN
+ IF x = ZERO THEN RETURN ZERO
+ ELSE
+ s := SYSTEM.VAL(SYSTEM.SET64, x) * NumberMask + ZeroExponent;
+ RETURN SYSTEM.VAL(LONGREAL, s) * 2.0;
+ END
+END fraction;
+
+PROCEDURE exponent*(x: LONGREAL): INTEGER;
+(*
+ The value of the call exponent(x) shall be the exponent value of `x'
+ that lies between `expoMin' and `expoMax'. An exception shall occur
+ and may be raised if `x' is equal to 0.0.
+*)
+ VAR i: SYSTEM.INT64;
+BEGIN
+ IF x = ZERO THEN RETURN 0 (* NOTE: x=0.0 should raise exception *)
+ ELSE
+ i := SYSTEM.LSH(SYSTEM.VAL(SYSTEM.INT64, x), -52) MOD 2048;
+ RETURN SYSTEM.VAL(INTEGER, i) - 1023
+ END
+END exponent;
+
+PROCEDURE sign*(x: LONGREAL): LONGREAL;
+(*
+ The value of the call sign(x) shall be 1.0 if `x' is greater than 0.0,
+ or shall be -1.0 if `x' is less than 0.0, or shall be either 1.0 or
+ -1.0 if `x' is equal to 0.0.
+*)
+BEGIN
+ IF x < ZERO THEN RETURN -ONE ELSE RETURN ONE END
+END sign;
+
+PROCEDURE scale*(x: LONGREAL; n: INTEGER): LONGREAL;
+(*
+ The value of the call scale(x,n) shall be the value x*radix^n if such
+ a value exists; otherwise an execption shall occur and may be raised.
+*)
+ VAR exp: HUGEINT; lexp: SYSTEM.SET64;
+BEGIN
+ IF x = ZERO THEN RETURN ZERO END;
+ exp := exponent(x) + n; (* new exponent *)
+ IF exp > expoMax THEN RETURN large * sign(x) (* exception raised here *)
+ ELSIF exp < expoMin THEN RETURN small * sign(x) (* exception here as well *)
+ END;
+ lexp := SYSTEM.VAL(SYSTEM.SET64, x) * NumberMask (* sign and significand *)
+ + SYSTEM.VAL(SYSTEM.SET64, SYSTEM.LSH(exp + expOffset, 52)); (* shifted exponent bits *)
+ RETURN SYSTEM.VAL(LONGREAL, lexp)
+END scale;
+
+PROCEDURE ulp*(x: LONGREAL): LONGREAL;
+(*
+ The value of the call ulp(x) shall be the value of the corresponding
+ real number type equal to a unit in the last place of `x', if such a
+ value exists; otherwise an exception shall occur and may be raised.
+*)
+BEGIN
+ RETURN scale(ONE, exponent(x)-places+1)
+END ulp;
+
+PROCEDURE succ*(x: LONGREAL): LONGREAL;
+(*
+ The value of the call succ(x) shall be the next value of the
+ corresponding real number type greater than `x', if such a type
+ exists; otherwise an exception shall occur and may be raised.
+*)
+BEGIN
+ RETURN x+ulp(x)*sign(x)
+END succ;
+
+PROCEDURE pred*(x: LONGREAL): LONGREAL;
+(*
+ The value of the call pred(x) shall be the next value of the
+ corresponding real number type less than `x', if such a type exists;
+ otherwise an exception shall occur and may be raised.
+*)
+BEGIN
+ RETURN x-ulp(x)*sign(x)
+END pred;
+
+
+PROCEDURE SinCos (x, y, sign: LONGREAL): LONGREAL;
+ CONST
+ ymax = 210828714; (* ENTIER(pi*2**(MantBits/2)) *)
+ c1 = 3.1416015625D0;
+ c2 = -8.908910206761537356617D-6;
+ r1 = -0.16666666666666665052D+0;
+ r2 = 0.83333333333331650314D-2;
+ r3 = -0.19841269841201840457D-3;
+ r4 = 0.27557319210152756119D-5;
+ r5 = -0.25052106798274584544D-7;
+ r6 = 0.16058936490371589114D-9;
+ r7 = -0.76429178068910467734D-12;
+ r8 = 0.27204790957888846175D-14;
+ VAR
+ n: LONGINT; xn, f, x1, g: LONGREAL;
+BEGIN
+ IF y >= ymax THEN Math.ErrorHandler(Math.LossOfAccuracy); RETURN ZERO END;
+
+ (* determine the reduced number *)
+ n := ENTIER(y*piInv + HALF); xn := n;
+ IF ODD(n) THEN sign := -sign END;
+ x := ABS(x);
+ IF x # y THEN xn := xn-HALF END;
+
+ (* fractional part of reduced number *)
+ x1 := ENTIER(x);
+ f := ((x1-xn*c1) + (x-x1))-xn*c2;
+
+ (* Pre: |f| <= pi/2 *)
+ IF ABS(f) < Limit THEN RETURN sign*f END;
+
+ (* evaluate polynomial approximation of sin *)
+ g := f*f; g := (((((((r8*g + r7)*g + r6)*g + r5)*g + r4)*g + r3)*g + r2)*g + r1)*g;
+ g := f + f*g; (* don't use less accurate f(1 + g) *)
+ RETURN sign*g
+END SinCos;
+
+PROCEDURE div (x, y : LONGINT) : LONGINT;
+(* corrected MOD function *)
+BEGIN
+ IF x < 0 THEN RETURN -ABS(x) DIV y ELSE RETURN x DIV y END
+END div;
+
+
+(* forward declarations *)
+PROCEDURE^ arctan2* (xn, xd: LONGREAL): LONGREAL;
+PROCEDURE^ sincos* (x: LONGREAL; VAR Sin, Cos: LONGREAL);
+
+PROCEDURE sqrt*(x: LONGREAL): LONGREAL;
+ (* Returns the positive square root of x where x >= 0 *)
+ CONST
+ P0=0.41731; P1=0.59016;
+ VAR
+ xMant, yEst, z: LONGREAL; xExp: INTEGER;
+BEGIN
+ (* optimize zeros and check for illegal negative roots *)
+ IF x=ZERO THEN RETURN ZERO END;
+ IF x < ZERO THEN Math.ErrorHandler(Math.IllegalRoot); x := -x END;
+
+ (* reduce the input number to the range 0.5 <= x <= 1.0 *)
+ xMant := fraction(x)*HALF; xExp := exponent(x) + 1;
+
+ (* initial estimate of the square root *)
+ yEst := P0 + P1*xMant;
+
+ (* perform three newtonian iterations *)
+ z := (yEst + xMant/yEst); yEst := 0.25*z + xMant/z;
+ yEst := HALF*(yEst + xMant/yEst);
+
+ (* adjust for odd exponents *)
+ IF ODD(xExp) THEN yEst := yEst*sqrtHalf; INC(xExp) END;
+
+ (* single Newtonian iteration to produce real number accuracy *)
+ RETURN scale(yEst, xExp DIV 2)
+END sqrt;
+
+PROCEDURE exp*(x: LONGREAL): LONGREAL;
+ (* Returns the exponential of x for x < Ln(MAX(REAL) *)
+ CONST
+ c1 = 0.693359375D0;
+ c2 = -2.1219444005469058277D-4;
+ P0 = 0.249999999999999993D+0;
+ P1 = 0.694360001511792852D-2;
+ P2 = 0.165203300268279130D-4;
+ Q1 = 0.555538666969001188D-1;
+ Q2 = 0.495862884905441294D-3;
+ VAR xn, g, p, q, z: LONGREAL; n: INTEGER;
+BEGIN
+ (* Ensure we detect overflows and return 0 for underflows *)
+ IF x > LnInfinity THEN Math.ErrorHandler(Math.Overflow); RETURN large
+ ELSIF x < LnSmall THEN RETURN ZERO
+ ELSIF ABS(x) < eps THEN RETURN ONE
+ END;
+
+ (* Decompose and scale the number *)
+ IF x >= ZERO THEN n := SHORT(ENTIER(ln2Inv*x + HALF))
+ ELSE n := SHORT(ENTIER(ln2Inv*x-HALF))
+ END;
+ xn := n; g := (x-xn*c1)-xn*c2;
+
+ (* Calculate exp(g)/2 from "Software Manual for the Elementary Functions" *)
+ z := g*g; p := ((P2*z + P1)*z + P0)*g; q := (Q2*z + Q1)*z + HALF;
+ RETURN scale(HALF + p/(q-p), n + 1)
+END exp;
+
+PROCEDURE ln*(x: LONGREAL): LONGREAL;
+ (* Returns the natural logarithm of x for x > 0 *)
+ CONST
+ c1=355.0D0/512.0D0; c2=-2.121944400546905827679D-4;
+ P0=-0.64124943423745581147D+2; P1=0.16383943563021534222D+2; P2=-0.78956112887491257267D+0;
+ Q0=-0.76949932108494879777D+3; Q1=0.31203222091924532844D+3; Q2=-0.35667977739034646171D+2;
+ VAR f, zn, zd, r, z, w, p, q, xn: LONGREAL; n: INTEGER;
+BEGIN
+ (* ensure illegal inputs are trapped and handled *)
+ IF x <= ZERO THEN Math.ErrorHandler(Math.IllegalLog); RETURN -large END;
+
+ (* reduce the range of the input *)
+ f := fraction(x)*HALF; n := exponent(x) + 1;
+ IF f > sqrtHalf THEN zn := (f-HALF)-HALF; zd := f*HALF + HALF
+ ELSE zn := f-HALF; zd := zn*HALF + HALF; DEC(n)
+ END;
+
+ (* evaluate rational approximation from "Software Manual for the Elementary Functions" *)
+ z := zn/zd; w := z*z; q := ((w + Q2)*w + Q1)*w + Q0; p := w*((P2*w + P1)*w + P0); r := z + z*(p/q);
+
+ (* scale the output *)
+ xn := n;
+ RETURN (xn*c2 + r) + xn*c1
+END ln;
+
+
+(* The angle in all trigonometric functions is measured in radians *)
+
+PROCEDURE sin* (x: LONGREAL): LONGREAL;
+BEGIN
+ IF x < ZERO THEN RETURN SinCos(x, -x, -ONE)
+ ELSE RETURN SinCos(x, x, ONE)
+ END
+END sin;
+
+PROCEDURE cos* (x: LONGREAL): LONGREAL;
+BEGIN
+ RETURN SinCos(x, ABS(x) + piByTwo, ONE)
+END cos;
+
+PROCEDURE tan*(x: LONGREAL): LONGREAL;
+ (* Returns the tangent of x where x cannot be an odd multiple of pi/2 *)
+ VAR Sin, Cos: LONGREAL;
+BEGIN
+ sincos(x, Sin, Cos);
+ IF ABS(Cos) < miny THEN Math.ErrorHandler(Math.IllegalTrig); RETURN large
+ ELSE RETURN Sin/Cos
+ END
+END tan;
+
+PROCEDURE arcsin*(x: LONGREAL): LONGREAL;
+ (* Returns the arcsine of x, in the range [-pi/2, pi/2] where -1 <= x <= 1 *)
+BEGIN
+ IF ABS(x) > ONE THEN Math.ErrorHandler(Math.IllegalInvTrig); RETURN large
+ ELSE RETURN arctan2(x, sqrt(ONE-x*x))
+ END
+END arcsin;
+
+PROCEDURE arccos*(x: LONGREAL): LONGREAL;
+ (* Returns the arccosine of x, in the range [0, pi] where -1 <= x <= 1 *)
+BEGIN
+ IF ABS(x) > ONE THEN Math.ErrorHandler(Math.IllegalInvTrig); RETURN large
+ ELSE RETURN arctan2(sqrt(ONE-x*x), x)
+ END
+END arccos;
+
+PROCEDURE arctan*(x: LONGREAL): LONGREAL;
+ (* Returns the arctangent of x, in the range [-pi/2, pi/2] for all x *)
+BEGIN
+ RETURN arctan2(x, ONE)
+END arctan;
+
+PROCEDURE power*(base, exp: LONGREAL): LONGREAL;
+ (* Returns the value of the number base raised to the power exponent
+ for base > 0 *)
+ CONST
+ P1=0.83333333333333211405D-1; P2=0.12500000000503799174D-1;
+ P3=0.22321421285924258967D-2; P4=0.43445775672163119635D-3;
+ K=0.44269504088896340736D0;
+ Q1=0.69314718055994529629D+0; Q2=0.24022650695909537056D+0;
+ Q3=0.55504108664085595326D-1; Q4=0.96181290595172416964D-2;
+ Q5=0.13333541313585784703D-2; Q6=0.15400290440989764601D-3;
+ Q7=0.14928852680595608186D-4;
+ OneOver16 = 0.0625D0;
+ XMAX = 16*expoMax - 1; (*XMIN=16*l.expoMin + 1;*)
+ XMIN = -16351; (* noch *)
+ VAR z, g, R, v, u2, u1, w1, w2, y1, y2, w: LONGREAL; m, p, i: INTEGER; mp, pp, iw1: LONGINT;
+BEGIN
+ (* handle all possible error conditions *)
+ IF ABS(exp) < miny THEN RETURN ONE (* base**0 = 1 *)
+ ELSIF base < ZERO THEN Math.ErrorHandler(Math.IllegalPower); RETURN -large
+ ELSIF ABS(base) < miny THEN
+ IF exp > ZERO THEN RETURN ZERO ELSE Math.ErrorHandler(Math.Overflow); RETURN -large END
+ END;
+
+ (* extract the exponent of base to m and clear exponent of base in g *)
+ g := fraction(base)*HALF; m := exponent(base) + 1;
+
+ (* determine p table offset with an unrolled binary search *)
+ p := 1;
+ IF g <= a1[9] THEN p := 9 END;
+ IF g <= a1[p + 4] THEN INC(p, 4) END;
+ IF g <= a1[p + 2] THEN INC(p, 2) END;
+
+ (* compute scaled z so that |z| <= 0.044 *)
+ z := ((g-a1[p + 1])-a2[(p + 1) DIV 2])/(g + a1[p + 1]); z := z + z;
+
+ (* approximation for log2(z) from "Software Manual for the Elementary Functions" *)
+ v := z*z; R := (((P4*v + P3)*v + P2)*v + P1)*v*z; R := R + K*R; u2 := (R + z*K) + z; u1 := (m*16-p)*OneOver16;
+
+ (* generate w with extra precision calculations *)
+ y1 := ENTIER(16*exp)*OneOver16; y2 := exp-y1; w := u2*exp + u1*y2;
+ w1 := ENTIER(16*w)*OneOver16; w2 := w-w1; w := w1 + u1*y1;
+ w1 := ENTIER(16*w)*OneOver16; w2 := w2 + (w-w1); w := ENTIER(16*w2)*OneOver16;
+ iw1 := ENTIER(16*(w + w1)); w2 := w2-w;
+
+ (* check for overflow/underflow *)
+ IF iw1 > XMAX THEN Math.ErrorHandler(Math.Overflow); RETURN large
+ ELSIF iw1 < XMIN THEN RETURN ZERO (* underflow *)
+ END;
+
+ (* final approximation 2**w2-1 where -0.0625 <= w2 <= 0 *)
+ IF w2 > ZERO THEN INC(iw1); w2 := w2-OneOver16 END; IF iw1 < 0 THEN i := 0 ELSE i := 1 END;
+ mp := div(iw1, 16) + i; pp := 16*mp-iw1;
+ z := ((((((Q7*w2 + Q6)*w2 + Q5)*w2 + Q4)*w2 + Q3)*w2 + Q2)*w2 + Q1)*w2; z := a1[pp + 1] + a1[pp + 1]*z;
+ RETURN scale(z, SHORT(mp))
+END power;
+
+PROCEDURE round*(x: LONGREAL): LONGINT;
+ (* Returns the value of x rounded to the nearest integer *)
+BEGIN
+ IF x < ZERO THEN RETURN -ENTIER(HALF-x)
+ ELSE RETURN ENTIER(x + HALF)
+ END
+END round;
+
+PROCEDURE IsRMathException*(): BOOLEAN;
+ (* Returns TRUE if the current coroutine is in the exceptional execution state
+ because of the raising of the RealMath exception; otherwise returns FALSE.
+ *)
+BEGIN
+ RETURN FALSE
+END IsRMathException;
+
+
+(*
+ Following routines are provided as extensions to the ISO standard.
+ They are either used as the basis of other functions or provide
+ useful functions which are not part of the ISO standard.
+*)
+
+PROCEDURE log* (x, base: LONGREAL): LONGREAL;
+(* log(x,base) is the logarithm of x base b. All positive arguments are
+ allowed but base > 0 and base # 1. *)
+BEGIN
+ (* log(x, base) = log2(x) / log2(base) *)
+ IF base <= ZERO THEN Math.ErrorHandler(Math.IllegalLogBase); RETURN -large
+ ELSE RETURN ln(x)/ln(base)
+ END
+END log;
+
+PROCEDURE ipower* (x: LONGREAL; base: INTEGER): LONGREAL;
+(* ipower(x, base) returns the x to the integer power base where base*Log2(x) < Log2(Max) *)
+ VAR y: LONGREAL; neg: BOOLEAN; Exp: LONGINT;
+
+ PROCEDURE Adjust(xadj: LONGREAL): LONGREAL;
+ BEGIN
+ IF (x < ZERO)&ODD(base) THEN RETURN -xadj ELSE RETURN xadj END
+ END Adjust;
+
+BEGIN
+ (* handle all possible error conditions *)
+ IF base=0 THEN RETURN ONE (* x**0 = 1 *)
+ ELSIF ABS(x) < miny THEN
+ IF base > 0 THEN RETURN ZERO ELSE Math.ErrorHandler(Math.Overflow); RETURN Adjust(large) END
+ END;
+
+ (* trap potential overflows and underflows *)
+ Exp := (exponent(x) + 1)*base; y := LnInfinity*ln2Inv;
+ IF Exp > y THEN Math.ErrorHandler(Math.Overflow); RETURN Adjust(large)
+ ELSIF Exp < -y THEN RETURN ZERO
+ END;
+
+ (* compute x**base using an optimised algorithm from Knuth, slightly
+ altered : p442, The Art Of Computer Programming, Vol 2 *)
+ y := ONE; IF base < 0 THEN neg := TRUE; base := -base ELSE neg:= FALSE END;
+ LOOP
+ IF ODD(base) THEN y := y*x END;
+ base := base DIV 2; IF base=0 THEN EXIT END;
+ x := x*x;
+ END;
+ IF neg THEN RETURN ONE/y ELSE RETURN y END
+END ipower;
+
+PROCEDURE sincos* (x: LONGREAL; VAR Sin, Cos: LONGREAL);
+(* More efficient sin/cos implementation if both values are needed. *)
+BEGIN
+ Sin := sin(x); Cos := sqrt(ONE-Sin*Sin)
+END sincos;
+
+PROCEDURE arctan2* (xn, xd: LONGREAL): LONGREAL;
+(* arctan2(xn,xd) is the quadrant-correct arc tangent atan(xn/xd). If the
+ denominator xd is zero, then the numerator xn must not be zero. All
+ arguments are legal except xn = xd = 0. *)
+ CONST
+ P0=0.216062307897242551884D+3; P1=0.3226620700132512059245D+3;
+ P2=0.13270239816397674701D+3; P3=0.1288838303415727934D+2;
+ Q0=0.2160623078972426128957D+3; Q1=0.3946828393122829592162D+3;
+ Q2=0.221050883028417680623D+3; Q3=0.3850148650835119501D+2;
+ PiOver2=pi/2; Sqrt3=1.7320508075688772935D0;
+ VAR atan, z, z2, p, q: LONGREAL; xnExp, xdExp: INTEGER; Quadrant: SHORTINT;
+BEGIN
+ IF ABS(xd) < miny THEN
+ IF ABS(xn) < miny THEN Math.ErrorHandler(Math.IllegalInvTrig); atan := ZERO
+ ELSE Math.ErrorHandler(Math.Overflow); atan := PiOver2
+ END
+ ELSE xnExp := exponent(xn); xdExp := exponent(xd);
+ IF xnExp-xdExp >= expoMax-3 THEN Math.ErrorHandler(Math.Overflow); atan := PiOver2
+ ELSIF xnExp-xdExp < expoMin + 3 THEN atan := ZERO
+ ELSE
+ (* ensure division of xn/xd always produces a number < 1 & resolve quadrant *)
+ IF ABS(xn) > ABS(xd) THEN z := ABS(xd/xn); Quadrant := 2
+ ELSE z := ABS(xn/xd); Quadrant := 0
+ END;
+
+ (* further reduce range to within 0 to 2-sqrt(3) *)
+ IF z > TWO-Sqrt3 THEN z := (z*Sqrt3-ONE)/(Sqrt3 + z); INC(Quadrant) END;
+
+ (* approximation from "Computer Approximations" table ARCTN 5075 *)
+ IF ABS(z) < Limit THEN atan := z (* for small values of z2, return this value *)
+ ELSE z2 := z*z; p := (((P3*z2 + P2)*z2 + P1)*z2 + P0)*z; q := (((z2 + Q3)*z2 + Q2)*z2 + Q1)*z2 + Q0; atan := p/q;
+ END;
+
+ (* adjust for z's quadrant *)
+ IF Quadrant > 1 THEN atan := -atan END;
+ CASE Quadrant OF
+ 1: atan := atan + pi/6
+ | 2: atan := atan + PiOver2
+ | 3: atan := atan + pi/3
+ | ELSE (* angle is correct *)
+ END
+ END;
+
+ (* map negative xds into the correct quadrant *)
+ IF xd < ZERO THEN atan := pi-atan END
+ END;
+
+ (* map negative xns into the correct quadrant *)
+ IF xn < ZERO THEN atan := -atan END;
+ RETURN atan
+END arctan2;
+
+PROCEDURE sinh* (x: LONGREAL): LONGREAL;
+(* sinh(x) is the hyperbolic sine of x. The argument x must not be so large
+ that exp(|x|) overflows. *)
+ CONST
+ P0=-0.35181283430177117881D+6; P1=-0.11563521196851768270D+5;
+ P2=-0.16375798202630751372D+3; P3=-0.78966127417357099479D+0;
+ Q0=-0.21108770058106271242D+7; Q1= 0.36162723109421836460D+5;
+ Q2=-0.27773523119650701667D+3;
+ VAR y, f, p, q: LONGREAL;
+BEGIN y := ABS(x);
+ IF y <= ONE THEN (* handle small arguments *)
+ IF y < Limit THEN RETURN x END;
+
+ (* use approximation from "Software Manual for the Elementary Functions" *)
+ f := y*y; p := ((P3*f + P2)*f + P1)*f + P0; q := ((f + Q2)*f + Q1)*f + Q0; y := f*(p/q); RETURN x + x*y
+ ELSIF y > LnInfinity THEN (* handle exp overflows *)
+ y := y-lnv;
+ IF y > LnInfinity-lnv + 0.69 THEN Math.ErrorHandler(Math.Overflow);
+ IF x > ZERO THEN RETURN large ELSE RETURN -large END
+ ELSE f := exp(y); f := f + f*vbytwo (* don't change to f(1 + vbytwo) *)
+ END
+ ELSE f := exp(y); f := (f-ONE/f)*HALF
+ END;
+
+ (* reach here when 1 < ABS(x) < LnInfinity-lnv + 0.69 *)
+ IF x > ZERO THEN RETURN f ELSE RETURN -f END
+END sinh;
+
+PROCEDURE cosh* (x: LONGREAL): LONGREAL;
+(* cosh(x) is the hyperbolic cosine of x. The argument x must not be so large
+ that exp(|x|) overflows. *)
+ VAR y, f: LONGREAL;
+BEGIN y := ABS(x);
+ IF y > LnInfinity THEN (* handle exp overflows *)
+ y := y-lnv;
+ IF y > LnInfinity-lnv + 0.69 THEN Math.ErrorHandler(Math.Overflow);
+ IF x > ZERO THEN RETURN large ELSE RETURN -large END
+ ELSE f := exp(y); RETURN f + f*vbytwo (* don't change to f(1 + vbytwo) *)
+ END
+ ELSE f := exp(y); RETURN (f + ONE/f)*HALF
+ END
+END cosh;
+
+PROCEDURE tanh* (x: LONGREAL): LONGREAL;
+(* tanh(x) is the hyperbolic tangent of x. All arguments are legal. *)
+ CONST
+ P0=-0.16134119023996228053D+4; P1=-0.99225929672236083313D+2; P2=-0.96437492777225469787D+0;
+ Q0= 0.48402357071988688686D+4; Q1= 0.22337720718962312926D+4; Q2= 0.11274474380534949335D+3;
+ ln3over2=0.54930614433405484570D0;
+ BIG=19.06154747D0; (* (ln(2) + (t + 1)*ln(B))/2 where t=mantissa bits, B=base *)
+ VAR f, t: LONGREAL;
+BEGIN f := ABS(x);
+ IF f > BIG THEN t := ONE
+ ELSIF f > ln3over2 THEN t := ONE-TWO/(exp(TWO*f) + ONE)
+ ELSIF f < Limit THEN t := f
+ ELSE (* approximation from "Software Manual for the Elementary Functions" *)
+ t := f*f; t := t*(((P2*t + P1)*t + P0)/(((t + Q2)*t + Q1)*t + Q0)); t := f + f*t
+ END;
+ IF x < ZERO THEN RETURN -t ELSE RETURN t END
+END tanh;
+
+PROCEDURE arcsinh* (x: LONGREAL): LONGREAL;
+(* arcsinh(x) is the arc hyperbolic sine of x. All arguments are legal. *)
+BEGIN
+ IF ABS(x) > SqrtInfinity*HALF THEN Math.ErrorHandler(Math.HypInvTrigClipped);
+ IF x > ZERO THEN RETURN ln(SqrtInfinity) ELSE RETURN -ln(SqrtInfinity) END;
+ ELSIF x < ZERO THEN RETURN -ln(-x + sqrt(x*x + ONE))
+ ELSE RETURN ln(x + sqrt(x*x + ONE))
+ END
+END arcsinh;
+
+PROCEDURE arccosh* (x: LONGREAL): LONGREAL;
+(* arccosh(x) is the arc hyperbolic cosine of x. All arguments greater than
+ or equal to 1 are legal. *)
+BEGIN
+ IF x < ONE THEN Math.ErrorHandler(Math.IllegalHypInvTrig); RETURN ZERO
+ ELSIF x > SqrtInfinity*HALF THEN Math.ErrorHandler(Math.HypInvTrigClipped); RETURN ln(SqrtInfinity)
+ ELSE RETURN ln(x + sqrt(x*x-ONE))
+ END
+END arccosh;
+
+PROCEDURE arctanh* (x: LONGREAL): LONGREAL;
+(* arctanh(x) is the arc hyperbolic tangent of x. |x| < 1 - sqrt(em), where
+ em is machine epsilon. Note that |x| must not be so close to 1 that the
+ result is less accurate than half precision. *)
+ CONST TanhLimit=0.999984991D0; (* Tanh(5.9) *)
+ VAR t: LONGREAL;
+BEGIN t := ABS(x);
+ IF (t >= ONE) OR (t > (ONE-TWO*em)) THEN Math.ErrorHandler(Math.IllegalHypInvTrig);
+ IF x < ZERO THEN RETURN -TanhMax ELSE RETURN TanhMax END
+ ELSIF t > TanhLimit THEN Math.ErrorHandler(Math.LossOfAccuracy)
+ END;
+ RETURN arcsinh(x/sqrt(ONE-x*x))
+END arctanh;
+
+PROCEDURE ToLONGREAL(h: HUGEINT): LONGREAL;
+BEGIN RETURN SYSTEM.VAL(LONGREAL, h)
+END ToLONGREAL;
+
+BEGIN
+ (* Initialise masks. *)
+ NumberMask := {}; INCL(NumberMask, 63);
+ FOR i := 0 TO 51 DO INCL(NumberMask, i) END;
+ ExponentMask := -NumberMask;
+ ZeroExponent := {};
+ FOR i := 53 TO 61 DO INCL(ZeroExponent, i) END;
+
+ (* determine some fundamental constants used by hyperbolic trig functions *)
+ em := ulp(ONE);
+ LnInfinity := ln(large);
+ LnSmall := ln(miny);
+ SqrtInfinity := sqrt(large);
+ t := pred(ONE)/sqrt(em);
+ TanhMax := ln(t + sqrt(t*t + ONE));
+
+ (* initialize some tables for the power() function a1[i]=2**((1-i)/16) *)
+ (* disable compiler warnings about 32-bit negative integers *)
+ (* < * PUSH; Warnings := FALSE * > *)
+ a1[ 1] := ONE;
+ a1[ 2] := ToLONGREAL(3FEEA4AFA2A490DAH);
+ a1[ 3] := ToLONGREAL(3FED5818DCFBA487H);
+ a1[ 4] := ToLONGREAL(3FEC199BDD85529CH);
+ a1[ 5] := ToLONGREAL(3FEAE89F995AD3ADH);
+ a1[ 6] := ToLONGREAL(3FE9C49182A3F090H);
+ a1[ 7] := ToLONGREAL(3FE8ACE5422AA0DBH);
+ a1[ 8] := ToLONGREAL(3FE7A11473EB0186H);
+ a1[ 9] := ToLONGREAL(3FE6A09E667F3BCCH);
+ a1[10] := ToLONGREAL(3FE5AB07DD485429H);
+ a1[11] := ToLONGREAL(3FE4BFDAD5362A27H);
+ a1[12] := ToLONGREAL(3FE3DEA64C123422H);
+ a1[13] := ToLONGREAL(3FE306FE0A31B715H);
+ a1[14] := ToLONGREAL(3FE2387A6E756238H);
+ a1[15] := ToLONGREAL(3FE172B83C7D517AH);
+ a1[16] := ToLONGREAL(3FE0B5586CF9890FH);
+ a1[17] := HALF;
+
+ (* a2[i]=2**[(1-2i)/16] - a1[2i]; delta resolution *)
+ a2[1] := ToLONGREAL(3C90B1EE74320000H);
+ a2[2] := ToLONGREAL(3C71106589500000H);
+ a2[3] := ToLONGREAL(3C6C7C46B0700000H);
+ a2[4] := ToLONGREAL(3C9AFAA2047F0000H);
+ a2[5] := ToLONGREAL(3C86324C05460000H);
+ a2[6] := ToLONGREAL(3C7ADA0911F00000H);
+ a2[7] := ToLONGREAL(3C89B07EB6C80000H);
+ a2[8] := ToLONGREAL(3C88A62E4ADC0000H);
+
+ (* reenable compiler warnings *)
+ (* < * POP * > *)
+END MathL.
+
diff --git a/src/library/v4/Modules.Mod b/src/runtime/Modules.Mod
similarity index 50%
rename from src/library/v4/Modules.Mod
rename to src/runtime/Modules.Mod
index 46c933f5..d6b8eeeb 100644
--- a/src/library/v4/Modules.Mod
+++ b/src/runtime/Modules.Mod
@@ -3,7 +3,7 @@ MODULE Modules; (* jt 6.1.96 *)
(* access to list of modules and commands, based on ETH Oberon *)
- IMPORT SYSTEM, Console, Heap;
+ IMPORT SYSTEM, Heap, Platform;
CONST
ModNameLen* = 20;
@@ -36,13 +36,6 @@ MODULE Modules; (* jt 6.1.96 *)
imported*, importing*: ModuleName;
- PROCEDURE -modules*(): Module
- "(Modules_Module)Heap_modules";
-
- PROCEDURE -setmodules*(m: Module)
- "Heap_modules = m";
-
-
PROCEDURE Append(VAR a: ARRAY OF CHAR; b: ARRAY OF CHAR);
VAR i, j: INTEGER;
BEGIN
@@ -51,6 +44,10 @@ MODULE Modules; (* jt 6.1.96 *)
a[i] := 0X
END Append;
+
+ PROCEDURE -modules(): Module "(Modules_Module)Heap_modules";
+ PROCEDURE -setmodules(m: Module) "Heap_modules = m";
+
PROCEDURE ThisMod* (name: ARRAY OF CHAR): Module;
VAR m: Module; bodyname: ARRAY 64 OF CHAR; body: Command;
BEGIN m := modules();
@@ -93,4 +90,70 @@ MODULE Modules; (* jt 6.1.96 *)
END
END Free;
+
+ (* Run time error reporting. *)
+
+ PROCEDURE errch(c: CHAR); (* Here we favour simplicity over efficiency, so no buffering. *)
+ VAR e: Platform.ErrorCode;
+ BEGIN e := Platform.Write(1, SYSTEM.ADR(c), 1)
+ END errch;
+
+ PROCEDURE errstring(s: ARRAY OF CHAR);
+ VAR i: LONGINT;
+ BEGIN
+ i := 0; WHILE (i= 10 THEN errint(l DIV 10) END;
+ errch(CHR(l MOD 10 + 30H))
+ END errint;
+
+ PROCEDURE DisplayHaltCode(code: SYSTEM.INT32);
+ BEGIN
+ CASE code OF
+ | -1: errstring("Assertion failure.")
+ | -2: errstring("Index out of range.")
+ | -3: errstring("Reached end of function without reaching RETURN.")
+ | -4: errstring("CASE statement: no matching label and no ELSE.")
+ | -5: errstring("Type guard failed.")
+ | -6: errstring("Implicit type guard in record assignment failed.")
+ | -7: errstring("Invalid case in WITH statement.")
+ | -8: errstring("Value out of range.")
+ | -9: errstring("Heap interrupted while locked, but lockdepth = 0 at unlock.")
+ |-10: errstring("NIL access.");
+ |-11: errstring("Alignment error.");
+ |-12: errstring("Divide by zero.");
+ |-13: errstring("Arithmetic overflow/underflow.");
+ |-14: errstring("Invalid function argument.");
+ |-15: errstring("Internal error, e.g. Type descriptor size mismatch.")
+ |-20: errstring("Too many, or negative number of, elements in dynamic array.")
+ ELSE
+ END
+ END DisplayHaltCode;
+
+ PROCEDURE Halt*(code: SYSTEM.INT32);
+ BEGIN
+ (*IF HaltHandler # NIL THEN HaltHandler(code) END;*)
+ errstring("Terminated by Halt("); errint(code); errstring("). ");
+ IF code < 0 THEN DisplayHaltCode(code) END;
+ errstring(Platform.NL);
+ Platform.Exit(code);
+ END Halt;
+
+ PROCEDURE AssertFail*(code: SYSTEM.INT32);
+ BEGIN
+ errstring("Assertion failure.");
+ IF code # 0 THEN errstring(" ASSERT code "); errint(code); errstring("."); END;
+ errstring(Platform.NL);
+ Platform.Exit(code);
+ END AssertFail;
+
+ (*
+ PROCEDURE SetHalt*(p: HaltProcedure);
+ BEGIN HaltHandler := p; END SetHalt;
+ *)
+
END Modules.
diff --git a/src/runtime/Oberon.Mod b/src/runtime/Oberon.Mod
new file mode 100644
index 00000000..fbc3abd4
--- /dev/null
+++ b/src/runtime/Oberon.Mod
@@ -0,0 +1,74 @@
+MODULE Oberon;
+
+(* this version should not have dependency on graphics -- noch *)
+
+ IMPORT Platform, Texts, Out;
+
+ TYPE
+ ParList* = POINTER TO ParRec;
+ ParRec* = RECORD
+ (*
+ vwr*: Viewers.Viewer;
+ frame*: Display.Frame;
+ *)
+ text*: Texts.Text;
+ pos*: LONGINT
+ END;
+
+ VAR
+ Log*: Texts.Text;
+ Par*: ParList; (*actual parameters*)
+ OptionChar*: CHAR;
+
+ R: Texts.Reader;
+ W: Texts.Writer;
+
+ (*clocks*)
+
+PROCEDURE GetClock* (VAR t, d: LONGINT);
+BEGIN Platform.GetClock(t, d)
+END GetClock;
+
+PROCEDURE Time* (): LONGINT;
+BEGIN RETURN Platform.Time()
+END Time;
+
+PROCEDURE PopulateParams;
+ VAR W: Texts.Writer; i: INTEGER; str: ARRAY 256 OF CHAR;
+BEGIN
+ Texts.OpenWriter(W);
+ i := 1; (* skip program name *)
+ WHILE i < Platform.ArgCount DO
+ Platform.GetArg(i, str); Texts.WriteString(W, str); Texts.Write(W, " ");
+ INC(i)
+ END;
+ Texts.Append (Par^.text, W.buf);
+END PopulateParams;
+
+PROCEDURE GetSelection*(VAR text: Texts.Text; VAR beg, end, time: LONGINT);
+BEGIN text := NIL; beg := 0; end := 0; time := 0
+END GetSelection;
+
+(* --- Notifier for echoing to the comsole all text appended to the log. --- *)
+PROCEDURE LogNotifier(Log: Texts.Text; op: INTEGER; beg, end: LONGINT);
+ VAR ch: CHAR;
+BEGIN
+ Texts.OpenReader(R, Log, beg);
+ WHILE ~R.eot & (beg < end) DO
+ Texts.Read(R, ch);
+ IF ch = 0DX THEN Out.Ln ELSE Out.Char(ch) END;
+ INC(beg)
+ END
+END LogNotifier;
+
+BEGIN
+ NEW(Par);
+ NEW(Par.text);
+ Par.pos := 0;
+ OptionChar := '-';
+ Texts.Open(Par.text, "");
+ PopulateParams;
+ NEW(Log);
+ Texts.Open(Log, "");
+ Log.notify := LogNotifier;
+END Oberon.
diff --git a/src/runtime/Out.Mod b/src/runtime/Out.Mod
new file mode 100644
index 00000000..9564f275
--- /dev/null
+++ b/src/runtime/Out.Mod
@@ -0,0 +1,211 @@
+MODULE Out; (* DCW Brown. 2016-09-27 *)
+
+IMPORT SYSTEM, Platform;
+
+VAR
+ IsConsole-: BOOLEAN;
+
+ buf: ARRAY 128 OF CHAR;
+ in: INTEGER;
+
+
+
+PROCEDURE Flush*;
+VAR error: Platform.ErrorCode;
+BEGIN
+ IF in > 0 THEN error := Platform.Write(Platform.StdOut, SYSTEM.ADR(buf), in) END;
+ in := 0;
+END Flush;
+
+PROCEDURE Open*;
+BEGIN
+END Open;
+
+PROCEDURE Char*(ch: CHAR);
+BEGIN
+ IF in >= LEN(buf) THEN Flush END;
+ buf[in] := ch; INC(in);
+ IF ch = 0AX THEN Flush END;
+END Char;
+
+PROCEDURE Length(VAR s: ARRAY OF CHAR): LONGINT;
+VAR l: LONGINT;
+BEGIN l := 0; WHILE (l < LEN(s)) & (s[l] # 0X) DO INC(l) END; RETURN l
+END Length;
+
+PROCEDURE String*(str: ARRAY OF CHAR);
+ VAR l: LONGINT; error: Platform.ErrorCode;
+BEGIN
+ l := Length(str);
+ IF in + l > LEN(buf) THEN Flush END;
+ IF l > LEN(buf) THEN
+ (* Doesn't fit buf. Bypass buffering. *)
+ error := Platform.Write(Platform.StdOut, SYSTEM.ADR(str), l)
+ ELSE
+ SYSTEM.MOVE(SYSTEM.ADR(str), SYSTEM.ADR(buf[in]), l); INC(in, SHORT(l));
+ END
+END String;
+
+
+PROCEDURE Int*(x, n: HUGEINT);
+ CONST zero = ORD('0');
+ VAR s: ARRAY 22 OF CHAR; i: INTEGER; negative: BOOLEAN;
+BEGIN
+ negative := x < 0;
+ IF x = MIN(HUGEINT) THEN
+ s := "8085774586302733229"; i := 19
+ ELSE
+ IF x < 0 THEN x := - x END;
+ s[0] := CHR(zero + (x MOD 10)); x := x DIV 10;
+ i := 1; WHILE x # 0 DO
+ s[i] := CHR(zero + (x MOD 10));
+ x := x DIV 10;
+ INC(i)
+ END
+ END;
+ IF negative THEN s[i] := '-'; INC(i) END;
+ WHILE n > i DO Char(' '); DEC(n) END;
+ WHILE i > 0 DO DEC(i); Char(s[i]) END
+END Int;
+
+PROCEDURE Ln*;
+BEGIN String(Platform.NL); Flush;
+END Ln;
+
+
+(* Real and Longreal display *)
+
+PROCEDURE digit(n: HUGEINT; VAR s: ARRAY OF CHAR; VAR i: INTEGER);
+BEGIN
+ DEC(i); s[i] := CHR(n MOD 10 + 48);
+END digit;
+
+PROCEDURE prepend(t: ARRAY OF CHAR; VAR s: ARRAY OF CHAR; VAR i: INTEGER);
+ VAR j: INTEGER; l: LONGINT;
+BEGIN
+ l := Length(t); IF l > i THEN l := i END;
+ DEC(i, SHORT(l)); j := 0;
+ WHILE j < l DO s[i+j] := t[j]; INC(j) END
+END prepend;
+
+
+PROCEDURE Ten*(e: INTEGER): LONGREAL;
+VAR r, power: LONGREAL;
+BEGIN r := 1.0D0; power := 1.0D1;
+ WHILE e > 0 DO
+ IF ODD(e) THEN r := r*power END;
+ power := power*power; e := e DIV 2
+ END;
+ RETURN r
+END Ten;
+
+PROCEDURE -Entier64(x: LONGREAL): SYSTEM.INT64 "(INT64)(x)";
+
+PROCEDURE RealP(x: LONGREAL; n: INTEGER; long: BOOLEAN);
+
+(* RealP(x, n) writes the long real number x to the end of the output stream using an
+ exponential form. If the textual representation of x requires m characters (including a
+ three-digit signed exponent), x is right adjusted in a field of Max(n, m) characters padded
+ with blanks at the left end. A plus sign of the mantissa is not written.
+ LONGREAL is 1/sign, 11/exponent, 52/significand *)
+
+VAR
+ e: INTEGER; (* Exponent field *)
+ f: HUGEINT; (* Fraction field *)
+ s: ARRAY 30 OF CHAR; (* Buffer built backwards *)
+ i: INTEGER; (* Index into s *)
+ el: INTEGER; (* Exponent length *)
+ x0: LONGREAL;
+ nn: BOOLEAN; (* Number negative *)
+ en: BOOLEAN; (* Exponent negative *)
+ m: HUGEINT; (* Mantissa digits *)
+ d: INTEGER; (* Significant digit count to display *)
+ dr: INTEGER; (* Number of insignificant digits that can be dropped *)
+
+BEGIN
+ e := SYSTEM.VAL(INTEGER, (SYSTEM.VAL(HUGEINT, x) DIV 10000000000000H) MOD 800H);
+ f := SYSTEM.VAL(HUGEINT, x) MOD 10000000000000H;
+ nn := (SYSTEM.VAL(HUGEINT, x) < 0) & ~((e = 7FFH) & (f # 0)); (* Ignore sign on Nan *)
+ IF nn THEN DEC(n) END;
+
+ i := LEN(s);
+ IF e = 7FFH THEN (* NaN / Infinity *)
+ IF f = 0 THEN prepend("Infinity", s, i) ELSE prepend("NaN", s, i) END
+ ELSE
+ (* Calculate number of significant digits caller has proposed space for, and
+ number of digits to generate. *)
+ IF long THEN
+ el := 3;
+ dr := n-6; (* Leave room for dp and '+D000' *)
+ IF dr > 17 THEN dr := 17 END; (* Limit to max useful significant digits *)
+ d := dr; (* Number of digits to generate *)
+ IF d < 15 THEN d := 15 END (* Generate enough digits to do trailing zero supporession *)
+ ELSE
+ el := 2;
+ dr := n-5; (* Leave room for dp and '+E00' *)
+ IF dr > 9 THEN dr := 9 END; (* Limit to max useful significant digits *)
+ d := dr; (* Number of digits to generate *)
+ IF d < 6 THEN d := 6 END (* Generate enough digits to do trailing zero supporession *)
+ END;
+
+ IF e = 0 THEN
+ WHILE el > 0 DO DEC(i); s[i] := "0"; DEC(el) END;
+ DEC(i); s[i] := "+";
+ m := 0;
+ ELSE
+ IF nn THEN x := -x END;
+
+ (* Scale e to be an exponent of 10 rather than 2 *)
+ e := SHORT(LONG(e - 1023) * 77 DIV 256);
+ IF e >= 0 THEN x := x / Ten(e) ELSE x := Ten(-e) * x END ;
+ IF x >= 10.0D0 THEN x := 0.1D0 * x; INC(e) END;
+
+ (* Generate the exponent digits *)
+ en := e < 0; IF en THEN e := - e END;
+ WHILE el > 0 DO digit(e, s, i); e := e DIV 10; DEC(el) END;
+ DEC(i); IF en THEN s[i] := "-" ELSE s[i] := "+" END;
+
+ (* Scale x to enough significant digits to reliably test for trailing
+ zeroes or to the amount of space available, if greater. *)
+ x0 := Ten(d-1);
+ x := x0 * x;
+ x := x + 0.5D0; (* Do not combine with previous line as doing so
+ introduces a least significant bit difference
+ between 32 bit and 64 bit builds. *)
+ IF x >= 10.0D0 * x0 THEN x := 0.1D0 * x; INC(e) END;
+ m := Entier64(x)
+ END;
+
+ DEC(i); IF long THEN s[i] := "D" ELSE s[i] := "E" END;
+
+ (* Drop trailing zeroes where caller proposes to use less space *)
+ IF dr < 2 THEN dr := 2 END;
+ WHILE (d > dr) & (m MOD 10 = 0) DO m := m DIV 10; DEC(d) END;
+
+ (* Render significant digits *)
+ WHILE d > 1 DO digit(m, s, i); m := m DIV 10; DEC(d) END;
+ DEC(i); s[i] := '.';
+ digit(m, s, i);
+ END;
+
+ (* Generate leading padding *)
+ DEC(n, LEN(s)-i); WHILE n > 0 DO Char(" "); DEC(n) END;
+
+ (* Render prepared number from right end of buffer s *)
+ IF nn THEN Char("-") END;
+ WHILE i < LEN(s) DO Char(s[i]); INC(i) END
+END RealP;
+
+
+PROCEDURE Real*(x: REAL; n: INTEGER);
+BEGIN RealP(x, n, FALSE);
+END Real;
+
+PROCEDURE LongReal*(x: LONGREAL; n: INTEGER);
+BEGIN RealP(x, n, TRUE);
+END LongReal;
+
+BEGIN
+ IsConsole := Platform.IsConsole(Platform.StdOut);
+ in := 0
+END Out.
diff --git a/src/system/Platformunix.Mod b/src/runtime/Platformunix.Mod
similarity index 74%
rename from src/system/Platformunix.Mod
rename to src/runtime/Platformunix.Mod
index 1c2da65d..fa22d7ee 100644
--- a/src/system/Platformunix.Mod
+++ b/src/runtime/Platformunix.Mod
@@ -7,33 +7,32 @@ CONST
StdErr- = 2;
TYPE
- HaltProcedure = PROCEDURE(n: LONGINT);
- SignalHandler = PROCEDURE(signal: INTEGER);
+ HaltProcedure = PROCEDURE(n: SYSTEM.INT32);
+ SignalHandler = PROCEDURE(signal: SYSTEM.INT32);
ErrorCode* = INTEGER;
FileHandle* = LONGINT;
FileIdentity* = RECORD
- volume*: LONGINT; (* dev on Unix filesystems, volume serial number on NTFS *)
- index*: LONGINT; (* inode on Unix filesystems, file id on NTFS *)
- mtime*: LONGINT; (* File modification time, value is system dependent *)
+ volume: LONGINT; (* dev on Unix filesystems, volume serial number on NTFS *)
+ index: LONGINT; (* inode on Unix filesystems, file id on NTFS *)
+ mtime: LONGINT; (* File modification time, value is system dependent *)
END;
EnvPtr = POINTER TO ARRAY 1024 OF CHAR;
ArgPtr = POINTER TO ARRAY 1024 OF CHAR;
ArgVec = POINTER TO ARRAY 1024 OF ArgPtr;
- ArgVecPtr = POINTER TO ARRAY 1 OF LONGINT;
+ ArgVecPtr = POINTER TO ARRAY 1 OF SYSTEM.ADDRESS;
VAR
LittleEndian-: BOOLEAN;
- MainStackFrame-: LONGINT;
- HaltCode-: LONGINT;
+ MainStackFrame-: SYSTEM.ADDRESS;
PID-: INTEGER; (* Note: Must be updated by Fork implementation *)
CWD-: ARRAY 256 OF CHAR;
ArgCount-: INTEGER;
- ArgVector-: LONGINT;
+ ArgVector-: SYSTEM.ADDRESS;
HaltHandler: HaltProcedure;
TimeStart: LONGINT;
@@ -41,7 +40,7 @@ VAR
SeekCur-: INTEGER;
SeekEnd-: INTEGER;
- nl-: ARRAY 3 OF CHAR; (* Platform specific newline representation *)
+ NL-: ARRAY 3 OF CHAR; (* Platform specific newline representation *)
@@ -75,6 +74,7 @@ PROCEDURE -ECONNREFUSED(): ErrorCode 'ECONNREFUSED';
PROCEDURE -ECONNABORTED(): ErrorCode 'ECONNABORTED';
PROCEDURE -ENETUNREACH(): ErrorCode 'ENETUNREACH';
PROCEDURE -EHOSTUNREACH(): ErrorCode 'EHOSTUNREACH';
+PROCEDURE -EINTR(): ErrorCode 'EINTR';
@@ -92,25 +92,28 @@ PROCEDURE Inaccessible*(e: ErrorCode): BOOLEAN;
BEGIN RETURN (e = EACCES()) OR (e = EROFS()) OR (e = EAGAIN()) END Inaccessible;
PROCEDURE Absent*(e: ErrorCode): BOOLEAN;
-BEGIN RETURN (e = ENOENT()) END Absent;
+BEGIN RETURN e = ENOENT() END Absent;
PROCEDURE TimedOut*(e: ErrorCode): BOOLEAN;
-BEGIN RETURN (e = ETIMEDOUT()) END TimedOut;
+BEGIN RETURN e = ETIMEDOUT() END TimedOut;
PROCEDURE ConnectionFailed*(e: ErrorCode): BOOLEAN;
BEGIN RETURN (e = ECONNREFUSED()) OR (e = ECONNABORTED())
OR (e = ENETUNREACH()) OR (e = EHOSTUNREACH()) END ConnectionFailed;
+PROCEDURE Interrupted*(e: ErrorCode): BOOLEAN;
+BEGIN RETURN e = EINTR() END Interrupted;
+
(* OS memory allocaton *)
-PROCEDURE -allocate(size: LONGINT): LONGINT "(LONGINT)(SYSTEM_ADDRESS)((void*)malloc((size_t)size))";
-PROCEDURE OSAllocate*(size: LONGINT): LONGINT; BEGIN RETURN allocate(size) END OSAllocate;
+PROCEDURE -allocate (size: SYSTEM.ADDRESS): SYSTEM.ADDRESS "(ADDRESS)((void*)malloc((size_t)size))";
+PROCEDURE OSAllocate*(size: SYSTEM.ADDRESS): SYSTEM.ADDRESS; BEGIN RETURN allocate(size) END OSAllocate;
-PROCEDURE -free(address: LONGINT) "free((void*)(SYSTEM_ADDRESS)address)";
-PROCEDURE OSFree*(address: LONGINT); BEGIN free(address) END OSFree;
+PROCEDURE -free(address: SYSTEM.ADDRESS) "free((void*)address)";
+PROCEDURE OSFree*(address: SYSTEM.ADDRESS); BEGIN free(address) END OSFree;
@@ -120,14 +123,13 @@ PROCEDURE OSFree*(address: LONGINT); BEGIN free(address) END OSFree;
PROCEDURE -ExternInitHeap "extern void Heap_InitHeap();";
PROCEDURE -HeapInitHeap() "Heap_InitHeap()";
-PROCEDURE Init*(argc: INTEGER; argvadr: LONGINT);
+PROCEDURE Init*(argc: SYSTEM.INT32; argvadr: SYSTEM.ADDRESS);
VAR av: ArgVecPtr;
BEGIN
MainStackFrame := argvadr;
- ArgCount := argc;
+ ArgCount := SYSTEM.VAL(INTEGER, argc);
av := SYSTEM.VAL(ArgVecPtr, argvadr);
ArgVector := av[0];
- HaltCode := -128;
(* This function (Platform.Init) is called at program startup BEFORE any
modules have been initalised. In turn we must initialise the heap
@@ -189,7 +191,7 @@ END ArgPos;
(* Signals and traps *)
-PROCEDURE -sethandler(s: INTEGER; h: SignalHandler) "SystemSetHandler(s, (SYSTEM_ADDRESS)h)";
+PROCEDURE -sethandler(s: INTEGER; h: SignalHandler) "SystemSetHandler(s, (ADDRESS)h)";
PROCEDURE SetInterruptHandler*(handler: SignalHandler);
BEGIN sethandler(2, handler); END SetInterruptHandler;
@@ -301,7 +303,7 @@ END New;
-PROCEDURE -closefile (fd: LONGINT): INTEGER "close(fd)";
+PROCEDURE -closefile(fd: LONGINT): INTEGER "close(fd)";
PROCEDURE Close*(h: FileHandle): ErrorCode;
BEGIN
@@ -309,6 +311,12 @@ BEGIN
END Close;
+PROCEDURE -isatty(fd: LONGINT): INTEGER "isatty(fd)";
+
+PROCEDURE IsConsole*(h: FileHandle): BOOLEAN;
+BEGIN RETURN isatty(h) # 0 END IsConsole;
+
+
PROCEDURE -fstat(fd: LONGINT): INTEGER "fstat(fd, &s)";
PROCEDURE -stat(n: ARRAY OF CHAR): INTEGER "stat((char*)n, &s)";
@@ -316,7 +324,7 @@ PROCEDURE -structstats "struct stat s";
PROCEDURE -statdev(): LONGINT "(LONGINT)s.st_dev";
PROCEDURE -statino(): LONGINT "(LONGINT)s.st_ino";
PROCEDURE -statmtime(): LONGINT "(LONGINT)s.st_mtime";
-PROCEDURE -statsize(): LONGINT "(LONGINT)s.st_size";
+PROCEDURE -statsize(): LONGINT "(ADDRESS)s.st_size";
PROCEDURE Identify*(h: FileHandle; VAR identity: FileIdentity): ErrorCode;
BEGIN
@@ -368,10 +376,10 @@ END Size;
-PROCEDURE -readfile (fd: LONGINT; p: LONGINT; l: LONGINT): LONGINT
-"read(fd, (void*)(SYSTEM_ADDRESS)(p), l)";
+PROCEDURE -readfile (fd: LONGINT; p: SYSTEM.ADDRESS; l: LONGINT): LONGINT
+"(LONGINT)read(fd, (void*)(ADDRESS)(p), l)";
-PROCEDURE Read*(h: FileHandle; p: LONGINT; l: LONGINT; VAR n: LONGINT): ErrorCode;
+PROCEDURE Read*(h: FileHandle; p: SYSTEM.ADDRESS; l: LONGINT; VAR n: LONGINT): ErrorCode;
BEGIN
n := readfile(h, p, l);
IF n < 0 THEN n := 0; RETURN err() ELSE RETURN 0 END
@@ -385,11 +393,11 @@ END ReadBuf;
-PROCEDURE -writefile(fd: LONGINT; p: LONGINT; l: LONGINT): LONGINT
-"write(fd, (void*)(SYSTEM_ADDRESS)(p), l)";
+PROCEDURE -writefile(fd: LONGINT; p: SYSTEM.ADDRESS; l: LONGINT): SYSTEM.ADDRESS
+"write(fd, (void*)(ADDRESS)(p), l)";
-PROCEDURE Write*(h: FileHandle; p: LONGINT; l: LONGINT): ErrorCode;
- VAR written: LONGINT;
+PROCEDURE Write*(h: FileHandle; p: SYSTEM.ADDRESS; l: LONGINT): ErrorCode;
+ VAR written: SYSTEM.ADDRESS;
BEGIN
written := writefile(h, p, l);
IF written < 0 THEN RETURN err() ELSE RETURN 0 END
@@ -437,13 +445,13 @@ END Unlink;
PROCEDURE -chdir(n: ARRAY OF CHAR): INTEGER "chdir((char*)n)";
-PROCEDURE -getcwd(VAR cwd: ARRAY OF CHAR) "getcwd((char*)cwd, cwd__len)";
+PROCEDURE -getcwd(VAR cwd: ARRAY OF CHAR): SYSTEM.PTR "getcwd((char*)cwd, cwd__len)";
PROCEDURE Chdir*(VAR n: ARRAY OF CHAR): ErrorCode;
VAR r: INTEGER;
BEGIN
- r := chdir(n); getcwd(CWD);
- IF r < 0 THEN RETURN err() ELSE RETURN 0 END
+ IF (chdir(n) >= 0) & (getcwd(CWD) # NIL) THEN RETURN 0
+ ELSE RETURN err() END
END Chdir;
@@ -460,68 +468,8 @@ END Rename;
(* Process termination *)
-PROCEDURE -exit(code: INTEGER) "exit(code)";
-PROCEDURE Exit*(code: INTEGER);
-BEGIN exit(code) END Exit;
-
-PROCEDURE -errstring(s: ARRAY OF CHAR) 'write(1, s, s__len-1)';
-PROCEDURE -errc (c: CHAR) 'write(1, &c, 1)';
-PROCEDURE errch(c: CHAR); BEGIN errc(c) END errch;
-PROCEDURE errln; BEGIN errch(0DX); errch(0AX) END errln;
-
-PROCEDURE errposint(l: LONGINT);
-BEGIN IF l>10 THEN errposint(l DIV 10) END; errch(CHR(ORD('0') + (l MOD 10))) END errposint;
-
-PROCEDURE errint(l: LONGINT);
-BEGIN IF l<0 THEN errch('-'); l := -l END; errposint(l) END errint;
-
-PROCEDURE DisplayHaltCode(code: LONGINT);
-BEGIN
- CASE code OF
- | -1: errstring("Assertion failure.")
- | -2: errstring("Index out of range.")
- | -3: errstring("Reached end of function without reaching RETURN.")
- | -4: errstring("CASE statement: no matching label and no ELSE.")
- | -5: errstring("Type guard failed.")
- | -6: errstring("Implicit type guard in record assignment failed.")
- | -7: errstring("Invalid case in WITH statement.")
- | -8: errstring("Value out of range.")
- | -9: errstring("Heap interrupted while locked, but lockdepth = 0 at unlock.")
- |-10: errstring("NIL access.");
- |-11: errstring("Alignment error.");
- |-12: errstring("Divide by zero.");
- |-13: errstring("Arithmetic overflow/underflow.");
- |-14: errstring("Invalid function argument.");
- |-15: errstring("Internal error, e.g. Type descriptor size mismatch.")
- |-20: errstring("Too many, or negative number of, elements in dynamic array.")
- ELSE
- END
-END DisplayHaltCode;
-
-PROCEDURE Halt*(code: LONGINT);
-VAR e: ErrorCode;
-BEGIN
- HaltCode := code;
- IF HaltHandler # NIL THEN HaltHandler(code) END;
- errstring("Terminated by Halt("); errint(code); errstring("). ");
- IF code < 0 THEN DisplayHaltCode(code) END;
- errln;
- exit(SYSTEM.VAL(INTEGER,code));
-END Halt;
-
-PROCEDURE AssertFail*(code: LONGINT);
-VAR e: ErrorCode;
-BEGIN
- errstring("Assertion failure.");
- IF code # 0 THEN errstring(" ASSERT code "); errint(code); errstring("."); END;
- errln;
- exit(SYSTEM.VAL(INTEGER,code));
-END AssertFail;
-
-PROCEDURE SetHalt*(p: HaltProcedure);
-BEGIN HaltHandler := p; END SetHalt;
-
-
+PROCEDURE -exit(code: LONGINT) "exit((int)code)";
+PROCEDURE Exit*(code: LONGINT); BEGIN exit(code) END Exit;
@@ -535,16 +483,15 @@ PROCEDURE -getpid(): INTEGER "(INTEGER)getpid()";
BEGIN
TestLittleEndian;
- HaltCode := -128;
HaltHandler := NIL;
TimeStart := 0; TimeStart := Time();
- CWD := ""; getcwd(CWD);
PID := getpid();
+ IF getcwd(CWD) = NIL THEN CWD := "" END;
SeekSet := seekset();
SeekCur := seekcur();
SeekEnd := seekend();
- nl[0] := 0AX; (* LF *)
- nl[1] := 0X;
+ NL[0] := 0AX; (* LF *)
+ NL[1] := 0X;
END Platform.
diff --git a/src/system/Platformwindows.Mod b/src/runtime/Platformwindows.Mod
similarity index 72%
rename from src/system/Platformwindows.Mod
rename to src/runtime/Platformwindows.Mod
index a97d7da9..bde70184 100644
--- a/src/system/Platformwindows.Mod
+++ b/src/runtime/Platformwindows.Mod
@@ -8,11 +8,11 @@ IMPORT SYSTEM;
TYPE
- HaltProcedure = PROCEDURE(n: LONGINT);
- SignalHandler = PROCEDURE(signal: INTEGER);
+ HaltProcedure = PROCEDURE(n: SYSTEM.INT32);
+ SignalHandler = PROCEDURE(signal: SYSTEM.INT32);
ErrorCode* = INTEGER;
- FileHandle* = LONGINT;
+ FileHandle* = SYSTEM.ADDRESS;
FileIdentity* = RECORD
volume: LONGINT; (* dev on Unix filesystems, volume serial number on NTFS *)
@@ -25,18 +25,18 @@ TYPE
EnvPtr = POINTER TO ARRAY 1024 OF CHAR;
ArgPtr = POINTER TO ARRAY 1024 OF CHAR;
ArgVec = POINTER TO ARRAY 1024 OF ArgPtr;
- ArgVecPtr = POINTER TO ARRAY 1 OF LONGINT;
+ ArgVecPtr = POINTER TO ARRAY 1 OF SYSTEM.ADDRESS;
VAR
LittleEndian-: BOOLEAN;
- MainStackFrame-: LONGINT;
+ MainStackFrame-: SYSTEM.ADDRESS;
HaltCode-: LONGINT;
PID-: INTEGER; (* Note: Must be updated by Fork implementation *)
CWD-: ARRAY 4096 OF CHAR;
ArgCount-: INTEGER;
- ArgVector-: LONGINT;
+ ArgVector-: SYSTEM.ADDRESS;
HaltHandler: HaltProcedure;
TimeStart: LONGINT;
@@ -50,7 +50,7 @@ VAR
InterruptHandler: SignalHandler;
- nl-: ARRAY 3 OF CHAR; (* Platform specific newline representation *)
+ NL-: ARRAY 3 OF CHAR; (* Platform specific newline representation *)
@@ -72,6 +72,7 @@ PROCEDURE -ECONNREFUSED(): ErrorCode 'WSAECONNREFUSED';
PROCEDURE -ECONNABORTED(): ErrorCode 'WSAECONNABORTED';
PROCEDURE -ENETUNREACH(): ErrorCode 'WSAENETUNREACH';
PROCEDURE -EHOSTUNREACH(): ErrorCode 'WSAEHOSTUNREACH';
+PROCEDURE -EINTR(): ErrorCode 'WSAEINTR';
@@ -100,15 +101,18 @@ PROCEDURE ConnectionFailed*(e: ErrorCode): BOOLEAN;
BEGIN RETURN (e = ECONNREFUSED()) OR (e = ECONNABORTED())
OR (e = ENETUNREACH()) OR (e = EHOSTUNREACH()) END ConnectionFailed;
+PROCEDURE Interrupted*(e: ErrorCode): BOOLEAN;
+BEGIN RETURN e = EINTR() END Interrupted;
+
(* OS memory allocaton *)
-PROCEDURE -allocate(size: LONGINT): LONGINT "(LONGINT)(SYSTEM_ADDRESS)((void*)HeapAlloc(GetProcessHeap(), 0, (size_t)size))";
-PROCEDURE OSAllocate*(size: LONGINT): LONGINT; BEGIN RETURN allocate(size) END OSAllocate;
+PROCEDURE -allocate(size: SYSTEM.ADDRESS): SYSTEM.ADDRESS "(ADDRESS)((void*)HeapAlloc(GetProcessHeap(), 0, (size_t)size))";
+PROCEDURE OSAllocate*(size: SYSTEM.ADDRESS): SYSTEM.ADDRESS; BEGIN RETURN allocate(size) END OSAllocate;
-PROCEDURE -free(address: LONGINT) "HeapFree(GetProcessHeap(), 0, (void*)(SYSTEM_ADDRESS)address)";
-PROCEDURE OSFree*(address: LONGINT); BEGIN free(address) END OSFree;
+PROCEDURE -free(address: SYSTEM.ADDRESS) "HeapFree(GetProcessHeap(), 0, (void*)address)";
+PROCEDURE OSFree*(address: SYSTEM.ADDRESS); BEGIN free(address) END OSFree;
@@ -118,11 +122,11 @@ PROCEDURE OSFree*(address: LONGINT); BEGIN free(address) END OSFree;
PROCEDURE -ExternInitHeap "extern void Heap_InitHeap();";
PROCEDURE -HeapInitHeap() "Heap_InitHeap()";
-PROCEDURE Init*(argc: INTEGER; argvadr: LONGINT);
+PROCEDURE Init*(argc: SYSTEM.INT32; argvadr: SYSTEM.ADDRESS);
VAR av: ArgVecPtr;
BEGIN
MainStackFrame := argvadr;
- ArgCount := argc;
+ ArgCount := SYSTEM.VAL(INTEGER, argc);
av := SYSTEM.VAL(ArgVecPtr, argvadr);
ArgVector := av[0];
HaltCode := -128;
@@ -200,8 +204,8 @@ END ArgPos;
(* Ctrl/c handling *)
-PROCEDURE -SetInterruptHandler*(h: SignalHandler) "SystemSetInterruptHandler((SYSTEM_ADDRESS)h)";
-PROCEDURE -SetQuitHandler* (h: SignalHandler) "SystemSetQuitHandler((SYSTEM_ADDRESS)h)";
+PROCEDURE -SetInterruptHandler*(h: SignalHandler) "SystemSetInterruptHandler((ADDRESS)h)";
+PROCEDURE -SetQuitHandler* (h: SignalHandler) "SystemSetQuitHandler((ADDRESS)h)";
PROCEDURE SetBadInstructionHandler*(handler: SignalHandler);
BEGIN (* TODO *) END SetBadInstructionHandler;
@@ -232,7 +236,7 @@ BEGIN
YMDHMStoClock(styear(), stmon(), stmday(), sthour(), stmin(), stsec(), t, d);
END GetClock;
-PROCEDURE -GetTickCount(): LONGINT "(LONGINT)(SYSTEM_CARD32)GetTickCount()";
+PROCEDURE -GetTickCount(): LONGINT "(LONGINT)(UINT32)GetTickCount()";
PROCEDURE Time*(): LONGINT;
VAR ms: LONGINT;
@@ -293,16 +297,16 @@ PROCEDURE Error*(): ErrorCode; BEGIN RETURN err() END Error;
(* File system *)
-PROCEDURE -invalidHandleValue(): LONGINT "((LONGINT)(SYSTEM_ADDRESS)INVALID_HANDLE_VALUE)";
+PROCEDURE -invalidHandleValue(): SYSTEM.ADDRESS "((ADDRESS)INVALID_HANDLE_VALUE)";
-PROCEDURE -openrw (n: ARRAY OF CHAR): LONGINT
-"(LONGINT)(SYSTEM_ADDRESS)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)";
+PROCEDURE -openrw (n: ARRAY OF CHAR): FileHandle
+"(ADDRESS)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)";
-PROCEDURE -openro (n: ARRAY OF CHAR): LONGINT
-"(LONGINT)(SYSTEM_ADDRESS)CreateFile((char*)n, GENERIC_READ , FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)";
+PROCEDURE -openro (n: ARRAY OF CHAR): FileHandle
+"(ADDRESS)CreateFile((char*)n, GENERIC_READ , FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)";
-PROCEDURE -opennew(n: ARRAY OF CHAR): LONGINT
-"(LONGINT)(SYSTEM_ADDRESS)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)";
+PROCEDURE -opennew(n: ARRAY OF CHAR): FileHandle
+"(ADDRESS)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)";
@@ -310,21 +314,21 @@ PROCEDURE -opennew(n: ARRAY OF CHAR): LONGINT
(* File APIs *)
PROCEDURE OldRO*(VAR n: ARRAY OF CHAR; VAR h: FileHandle): ErrorCode;
-VAR fd: LONGINT;
+VAR fd: FileHandle;
BEGIN
fd := openro(n);
IF (fd = invalidHandleValue()) THEN RETURN err() ELSE h := fd; RETURN 0 END;
END OldRO;
PROCEDURE OldRW*(VAR n: ARRAY OF CHAR; VAR h: FileHandle): ErrorCode;
-VAR fd: LONGINT;
+VAR fd: FileHandle;
BEGIN
fd := openrw(n);
IF (fd = invalidHandleValue()) THEN RETURN err() ELSE h := fd; RETURN 0 END;
END OldRW;
PROCEDURE New*(VAR n: ARRAY OF CHAR; VAR h: FileHandle): ErrorCode;
-VAR fd: LONGINT;
+VAR fd: FileHandle;
BEGIN
fd := opennew(n);
IF (fd = invalidHandleValue()) THEN RETURN err() ELSE h := fd; RETURN 0 END;
@@ -332,7 +336,7 @@ END New;
-PROCEDURE -closeHandle(h: FileHandle): INTEGER "(INTEGER)CloseHandle((HANDLE)(SYSTEM_ADDRESS)h)";
+PROCEDURE -closeHandle(h: FileHandle): INTEGER "(INTEGER)CloseHandle((HANDLE)h)";
PROCEDURE Close*(h: FileHandle): ErrorCode;
BEGIN
@@ -342,7 +346,7 @@ END Close;
PROCEDURE -byHandleFileInformation "BY_HANDLE_FILE_INFORMATION bhfi";
-PROCEDURE -getFileInformationByHandle(h: FileHandle): INTEGER "(INTEGER)GetFileInformationByHandle((HANDLE)(SYSTEM_ADDRESS)h, &bhfi)";
+PROCEDURE -getFileInformationByHandle(h: FileHandle): INTEGER "(INTEGER)GetFileInformationByHandle((HANDLE)h, &bhfi)";
PROCEDURE -bhfiMtimeHigh(): LONGINT "(LONGINT)bhfi.ftLastWriteTime.dwHighDateTime";
PROCEDURE -bhfiMtimeLow(): LONGINT "(LONGINT)bhfi.ftLastWriteTime.dwLowDateTime";
PROCEDURE -bhfiVsn(): LONGINT "(LONGINT)bhfi.dwVolumeSerialNumber";
@@ -401,7 +405,7 @@ END MTimeAsClock;
PROCEDURE -largeInteger "LARGE_INTEGER li";
PROCEDURE -liLongint(): LONGINT "(LONGINT)li.QuadPart";
-PROCEDURE -getFileSize(h: FileHandle): INTEGER "(INTEGER)GetFileSizeEx((HANDLE)(SYSTEM_ADDRESS)h, &li)";
+PROCEDURE -getFileSize(h: FileHandle): INTEGER "(INTEGER)GetFileSizeEx((HANDLE)h, &li)";
PROCEDURE Size*(h: FileHandle; VAR l: LONGINT): ErrorCode;
BEGIN
@@ -412,38 +416,37 @@ BEGIN
END Size;
-PROCEDURE -readfile (fd: LONGINT; p: LONGINT; l: LONGINT; VAR n: LONGINT): INTEGER
-"(INTEGER)ReadFile ((HANDLE)(SYSTEM_ADDRESS)fd, (void*)(SYSTEM_ADDRESS)(p), (DWORD)l, (DWORD*)n, 0)";
+PROCEDURE -readfile (fd: FileHandle; p: SYSTEM.ADDRESS; l: LONGINT; VAR n: SYSTEM.INT32): INTEGER
+"(INTEGER)ReadFile((HANDLE)fd, (void*)p, (DWORD)l, (DWORD*)n, 0)";
-PROCEDURE Read*(h: FileHandle; p: LONGINT; l: LONGINT; VAR n: LONGINT): ErrorCode;
-VAR result: INTEGER;
+PROCEDURE Read*(h: FileHandle; p: SYSTEM.ADDRESS; l: LONGINT; VAR n: LONGINT): ErrorCode;
+VAR result: INTEGER; lengthread: SYSTEM.INT32;
BEGIN
- n := 0; (* Clear n because readfile takes a LONGINT but only updates the bottom 32 bits *)
- result := readfile(h, p, l, n);
- IF result = 0 THEN n := 0; RETURN err() ELSE RETURN 0 END
+ result := readfile(h, p, l, lengthread);
+ IF result = 0 THEN n := 0; RETURN err() ELSE n := lengthread; RETURN 0 END
END Read;
PROCEDURE ReadBuf*(h: FileHandle; VAR b: ARRAY OF SYSTEM.BYTE; VAR n: LONGINT): ErrorCode;
-VAR result: INTEGER;
+VAR result: INTEGER; lengthread: SYSTEM.INT32;
BEGIN
- n := 0; (* Clear n because readfile takes a LONGINT but only updates the bottom 32 bits *)
- result := readfile(h, SYSTEM.ADR(b), LEN(b), n);
- IF result = 0 THEN n := 0; RETURN err() ELSE RETURN 0 END
+ result := readfile(h, SYSTEM.ADR(b), LEN(b), lengthread);
+ IF result = 0 THEN n := 0; RETURN err() ELSE n := lengthread; RETURN 0 END
END ReadBuf;
-PROCEDURE -writefile(fd: LONGINT; p: LONGINT; l: LONGINT): INTEGER
-"(INTEGER)WriteFile((HANDLE)(SYSTEM_ADDRESS)fd, (void*)(SYSTEM_ADDRESS)(p), (DWORD)l, 0,0)";
+PROCEDURE -writefile(fd: FileHandle; p: SYSTEM.ADDRESS; l: LONGINT; VAR n: SYSTEM.INT32): INTEGER
+"(INTEGER)WriteFile((HANDLE)fd, (void*)(p), (DWORD)l, (DWORD*)n, 0)";
-PROCEDURE Write*(h: FileHandle; p: LONGINT; l: LONGINT): ErrorCode;
+PROCEDURE Write*(h: FileHandle; p: SYSTEM.ADDRESS; l: LONGINT): ErrorCode;
+VAR n: SYSTEM.INT32;
BEGIN
- IF writefile(h, p, l) = 0 THEN RETURN err() ELSE RETURN 0 END
+ IF writefile(h, p, l, n) = 0 THEN RETURN err() ELSE RETURN 0 END
END Write;
-PROCEDURE -flushFileBuffers(h: FileHandle): INTEGER "(INTEGER)FlushFileBuffers((HANDLE)(SYSTEM_ADDRESS)h)";
+PROCEDURE -flushFileBuffers(h: FileHandle): INTEGER "(INTEGER)FlushFileBuffers((HANDLE)h)";
PROCEDURE Sync*(h: FileHandle): ErrorCode;
BEGIN
@@ -453,7 +456,7 @@ END Sync;
PROCEDURE -setFilePointerEx(h: FileHandle; o: LONGINT; r: INTEGER; VAR rc: INTEGER)
-"li.QuadPart=o; *rc = (INTEGER)SetFilePointerEx((HANDLE)(SYSTEM_ADDRESS)h, li, 0, (DWORD)r)";
+"li.QuadPart=o; *rc = (INTEGER)SetFilePointerEx((HANDLE)h, li, 0, (DWORD)r)";
PROCEDURE -seekset(): INTEGER "FILE_BEGIN";
PROCEDURE -seekcur(): INTEGER "FILE_CURRENT";
@@ -469,9 +472,9 @@ END Seek;
-PROCEDURE -setEndOfFile(h: FileHandle): INTEGER "(INTEGER)SetEndOfFile((HANDLE)(SYSTEM_ADDRESS)h)";
+PROCEDURE -setEndOfFile(h: FileHandle): INTEGER "(INTEGER)SetEndOfFile((HANDLE)h)";
PROCEDURE -getFilePos(h: FileHandle; VAR r: LONGINT; VAR rc: INTEGER)
-"LARGE_INTEGER liz = {0}; *rc = (INTEGER)SetFilePointerEx((HANDLE)(SYSTEM_ADDRESS)h, liz, &li, FILE_CURRENT); *r = (LONGINT)li.QuadPart";
+"LARGE_INTEGER liz = {0}; *rc = (INTEGER)SetFilePointerEx((HANDLE)h, liz, &li, FILE_CURRENT); *r = (LONGINT)li.QuadPart";
PROCEDURE Truncate*(h: FileHandle; limit: LONGINT): ErrorCode;
VAR rc: INTEGER; oldpos: LONGINT;
@@ -524,64 +527,23 @@ END Rename;
(* Process termination *)
-PROCEDURE -exit(code: INTEGER) "ExitProcess((UINT)code)";
-PROCEDURE Exit*(code: INTEGER);
-BEGIN exit(code) END Exit;
+PROCEDURE -exit(code: LONGINT) "ExitProcess((UINT)code)";
+PROCEDURE Exit*(code: LONGINT); BEGIN exit(code) END Exit;
-PROCEDURE -errstring(s: ARRAY OF CHAR) 'WriteFile((HANDLE)(SYSTEM_ADDRESS)Platform_StdOut, s, s__len-1, 0,0)';
-PROCEDURE -errc (c: CHAR) 'WriteFile((HANDLE)(SYSTEM_ADDRESS)Platform_StdOut, &c, 1, 0,0)';
-PROCEDURE errch(c: CHAR); BEGIN errc(c) END errch;
-PROCEDURE errln; BEGIN errch(0DX); errch(0AX) END errln;
-
-PROCEDURE errposint(l: LONGINT);
-BEGIN IF l>10 THEN errposint(l DIV 10) END; errch(CHR(ORD('0') + (l MOD 10))) END errposint;
-
-PROCEDURE errint(l: LONGINT);
-BEGIN IF l<0 THEN errch('-'); l := -l END; errposint(l) END errint;
-
-PROCEDURE DisplayHaltCode(code: LONGINT);
-BEGIN
- CASE code OF
- | -1: errstring("Rider ReadBuf/WriteBuf transfer size longer than buffer.")
- | -2: errstring("Index out of range.")
- | -3: errstring("Reached end of function without reaching RETURN.")
- | -4: errstring("CASE statement: no matching label and no ELSE.")
- | -5: errstring("Type guard failed.")
- | -6: errstring("Type equality failed.")
- | -7: errstring("WITH statement type guard failed.")
- | -8: errstring("SHORT: Value too large for shorter type.")
- | -9: errstring("Heap interrupted while locked, but lockdepth = 0 at unlock.")
- |-15: errstring("Type descriptor size mismatch.")
- |-20: errstring("Too many, or negative number of, elements in dynamic array.")
- ELSE
- END
-END DisplayHaltCode;
-
-PROCEDURE Halt*(code: LONGINT);
-VAR e: ErrorCode;
-BEGIN
- HaltCode := code;
- IF HaltHandler # NIL THEN HaltHandler(code) END;
- errstring("Terminated by Halt("); errint(code); errstring("). ");
- IF code < 0 THEN DisplayHaltCode(code) END;
- errln;
- exit(SYSTEM.VAL(INTEGER,code));
-END Halt;
-
-PROCEDURE AssertFail*(code: LONGINT);
-VAR e: ErrorCode;
-BEGIN
- errstring("Assertion failure.");
- IF code # 0 THEN errstring(" ASSERT code "); errint(code); errstring("."); END;
- errln;
- exit(SYSTEM.VAL(INTEGER,code));
-END AssertFail;
-
-PROCEDURE SetHalt*(p: HaltProcedure);
-BEGIN HaltHandler := p; END SetHalt;
+PROCEDURE -GetConsoleMode(h: FileHandle; VAR m: SYSTEM.INT32): BOOLEAN "GetConsoleMode((HANDLE)h, (DWORD*)m)";
+PROCEDURE -SetConsoleMode(h: FileHandle; m: SYSTEM.INT32) "SetConsoleMode((HANDLE)h, (DWORD)m)";
+PROCEDURE EnableVT100;
+CONST VTprocessing = 4; (* ENABLE_VIRTUAL_TERMINAL_PROCESSING: value specified by MSDN *)
+VAR mode: SYSTEM.INT32;
+BEGIN IF GetConsoleMode(StdOut, mode) THEN SetConsoleMode(StdOut, mode+VTprocessing) END
+END EnableVT100;
+PROCEDURE IsConsole*(h: FileHandle): BOOLEAN;
+VAR mode: SYSTEM.INT32;
+BEGIN RETURN GetConsoleMode(StdOut, mode)
+END IsConsole;
PROCEDURE TestLittleEndian;
@@ -589,9 +551,9 @@ PROCEDURE TestLittleEndian;
BEGIN i := 1; SYSTEM.GET(SYSTEM.ADR(i), LittleEndian); END TestLittleEndian;
-PROCEDURE -getstdinhandle(): FileHandle "(SYSTEM_ADDRESS)GetStdHandle(STD_INPUT_HANDLE)";
-PROCEDURE -getstdouthandle(): FileHandle "(SYSTEM_ADDRESS)GetStdHandle(STD_OUTPUT_HANDLE)";
-PROCEDURE -getstderrhandle(): FileHandle "(SYSTEM_ADDRESS)GetStdHandle(STD_ERROR_HANDLE)";
+PROCEDURE -getstdinhandle(): FileHandle "(ADDRESS)GetStdHandle(STD_INPUT_HANDLE)";
+PROCEDURE -getstdouthandle(): FileHandle "(ADDRESS)GetStdHandle(STD_OUTPUT_HANDLE)";
+PROCEDURE -getstderrhandle(): FileHandle "(ADDRESS)GetStdHandle(STD_ERROR_HANDLE)";
PROCEDURE -getpid(): INTEGER "(INTEGER)GetCurrentProcessId()";
BEGIN
@@ -611,7 +573,9 @@ BEGIN
StdOut := getstdouthandle();
StdErr := getstderrhandle();
- nl[0] := 0DX; (* CR *)
- nl[1] := 0AX; (* LF *)
- nl[2] := 0X;
+ EnableVT100;
+
+ NL[0] := 0DX; (* CR *)
+ NL[1] := 0AX; (* LF *)
+ NL[2] := 0X;
END Platform.
diff --git a/src/library/v4/Reals.Mod b/src/runtime/Reals.Mod
similarity index 100%
rename from src/library/v4/Reals.Mod
rename to src/runtime/Reals.Mod
diff --git a/bootstrap/windows-48/SYSTEM.c b/src/runtime/SYSTEM.c
similarity index 66%
rename from bootstrap/windows-48/SYSTEM.c
rename to src/runtime/SYSTEM.c
index 33511a70..a1b2cb14 100644
--- a/bootstrap/windows-48/SYSTEM.c
+++ b/src/runtime/SYSTEM.c
@@ -18,13 +18,48 @@
#include
-LONGINT SYSTEM_XCHK(LONGINT i, LONGINT ub) {return __X(i, ub);}
-LONGINT SYSTEM_RCHK(LONGINT i, LONGINT ub) {return __R(i, ub);}
-LONGINT SYSTEM_ASH (LONGINT i, LONGINT n) {return __ASH(i, n);}
-LONGINT SYSTEM_ABS (LONGINT i) {return __ABS(i);}
-double SYSTEM_ABSD(double i) {return __ABS(i);}
+// Procedure verions of SYSTEM.H versions used when a multiply accessed
+// parameter has side effects.
-void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0)
+
+
+
+INT64 SYSTEM_DIV(INT64 x, INT64 y)
+{
+ if (x == 0) return 0;
+ if (x >= 0)
+ if (y >= 0) {return x/y;}
+ else {return -((x-y-1)/(-y));}
+ else
+ if (y >= 0) {return -((y-x-1)/y);}
+ else {return (-x)/(-y);}
+}
+
+INT64 SYSTEM_MOD(INT64 x, INT64 y)
+{
+ if (x == 0) return 0;
+ if (x >= 0)
+ if (y >= 0) {return x % y;}
+ else {return (y+1) + ((x-1) % (-y));}
+ else
+ if (y >= 0) {return (y-1) - ((-x-1) % y);}
+ else {return -((-x) % (-y));}
+}
+
+INT64 SYSTEM_ENTIER(double x)
+{
+ INT64 y;
+ if (x >= 0)
+ return (INT64)x;
+ else {
+ y = (INT64)x;
+ if (y <= x) return y; else return y - 1;
+ }
+}
+
+
+
+void SYSTEM_INHERIT(ADDRESS *t, ADDRESS *t0)
{
t -= __TPROC0OFF;
t0 -= __TPROC0OFF;
@@ -32,68 +67,44 @@ void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0)
}
-void SYSTEM_ENUMP(void *adr, LONGINT n, void (*P)())
+void SYSTEM_ENUMP(void *adr, ADDRESS n, void (*P)())
{
while (n > 0) {
- P((LONGINT)(SYSTEM_ADDRESS)(*((void**)(adr))));
+ P((ADDRESS)(*((void**)(adr))));
adr = ((void**)adr) + 1;
n--;
}
}
-void SYSTEM_ENUMR(void *adr, LONGINT *typ, LONGINT size, LONGINT n, void (*P)())
+void SYSTEM_ENUMR(void *adr, ADDRESS *typ, ADDRESS size, ADDRESS n, void (*P)())
{
- LONGINT *t, off;
+ ADDRESS *t, off;
typ++;
while (n > 0) {
t = typ;
off = *t;
- while (off >= 0) {P(*(LONGINT*)((char*)adr+off)); t++; off = *t;}
+ while (off >= 0) {P(*(ADDRESS*)((char*)adr+off)); t++; off = *t;}
adr = ((char*)adr) + size;
n--;
}
}
-LONGINT SYSTEM_DIV(U_LONGINT x, U_LONGINT y)
-{ if ((LONGINT) x >= 0) return (x / y);
- else return -((y - 1 - x) / y);
-}
-
-LONGINT SYSTEM_MOD(U_LONGINT x, U_LONGINT y)
-{ U_LONGINT m;
- if ((LONGINT) x >= 0) return (x % y);
- else { m = (-x) % y;
- if (m != 0) return (y - m); else return 0;
- }
-}
-
-LONGINT SYSTEM_ENTIER(double x)
-{
- LONGINT y;
- if (x >= 0)
- return (LONGINT)x;
- else {
- y = (LONGINT)x;
- if (y <= x) return y; else return y - 1;
- }
-}
-
extern void Heap_Lock();
extern void Heap_Unlock();
-SYSTEM_PTR SYSTEM_NEWARR(LONGINT *typ, LONGINT elemsz, int elemalgn, int nofdim, int nofdyn, ...)
+SYSTEM_PTR SYSTEM_NEWARR(ADDRESS *typ, ADDRESS elemsz, int elemalgn, int nofdim, int nofdyn, ...)
{
- LONGINT nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off;
+ ADDRESS nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off;
va_list ap;
va_start(ap, nofdyn);
nofelems = 1;
while (nofdim > 0) {
- nofelems = nofelems * va_arg(ap, LONGINT); nofdim--;
+ nofelems = nofelems * va_arg(ap, ADDRESS); nofdim--;
if (nofelems <= 0) __HALT(-20);
}
va_end(ap);
- dataoff = nofdyn * sizeof(LONGINT);
- if (elemalgn > sizeof(LONGINT)) {
+ dataoff = nofdyn * sizeof(ADDRESS);
+ if (elemalgn > sizeof(ADDRESS)) {
n = dataoff % elemalgn;
if (n != 0) dataoff += elemalgn - n;
}
@@ -103,37 +114,37 @@ SYSTEM_PTR SYSTEM_NEWARR(LONGINT *typ, LONGINT elemsz, int elemalgn, int nofdim,
/* element typ does not contain pointers */
x = Heap_NEWBLK(size);
}
- else if (typ == (LONGINT*)POINTER__typ) {
+ else if (typ == (ADDRESS*)POINTER__typ) {
/* element type is a pointer */
- x = Heap_NEWBLK(size + nofelems * sizeof(LONGINT));
- p = (LONGINT*)(SYSTEM_ADDRESS)x[-1];
+ x = Heap_NEWBLK(size + nofelems * sizeof(ADDRESS));
+ p = (ADDRESS*)(ADDRESS)x[-1];
p[-nofelems] = *p; /* build new type desc in situ: 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */
p -= nofelems - 1; n = 1; /* n =1 for skipping the size field */
- while (n <= nofelems) {*p = n*sizeof(LONGINT); p++; n++;}
- *p = - (nofelems + 1) * sizeof(LONGINT); /* sentinel */
- x[-1] -= nofelems * sizeof(LONGINT);
+ while (n <= nofelems) {*p = n*sizeof(ADDRESS); p++; n++;}
+ *p = - (nofelems + 1) * sizeof(ADDRESS); /* sentinel */
+ x[-1] -= nofelems * sizeof(ADDRESS);
}
else {
/* element type is a record that contains pointers */
ptab = typ + 1; nofptrs = 0;
while (ptab[nofptrs] >= 0) {nofptrs++;} /* number of pointers per element */
nptr = nofelems * nofptrs; /* total number of pointers */
- x = Heap_NEWBLK(size + nptr * sizeof(LONGINT));
- p = (LONGINT*)(SYSTEM_ADDRESS)x[- 1];
+ x = Heap_NEWBLK(size + nptr * sizeof(ADDRESS));
+ p = (ADDRESS*)(ADDRESS)x[- 1];
p[-nptr] = *p; /* build new type desc in situ; 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */
p -= nptr - 1; n = 0; off = dataoff;
while (n < nofelems) {i = 0;
while (i < nofptrs) {*p = off + ptab[i]; p++; i++;}
off += elemsz; n++;
}
- *p = - (nptr + 1) * sizeof(LONGINT); /* sentinel */
- x[-1] -= nptr * sizeof(LONGINT);
+ *p = - (nptr + 1) * sizeof(ADDRESS); /* sentinel */
+ x[-1] -= nptr * sizeof(ADDRESS);
}
if (nofdyn != 0) {
/* setup len vector for index checks */
va_start(ap, nofdyn);
p = x;
- while (nofdyn > 0) {*p = va_arg(ap, LONGINT); p++, nofdyn--;}
+ while (nofdyn > 0) {*p = va_arg(ap, ADDRESS); p++, nofdyn--;}
va_end(ap);
}
Heap_Unlock();
@@ -143,7 +154,7 @@ SYSTEM_PTR SYSTEM_NEWARR(LONGINT *typ, LONGINT elemsz, int elemalgn, int nofdim,
-typedef void (*SystemSignalHandler)(INTEGER); // = Platform_SignalHandler
+typedef void (*SystemSignalHandler)(INT32); // = Platform_SignalHandler
#ifndef _WIN32
@@ -155,7 +166,7 @@ typedef void (*SystemSignalHandler)(INTEGER); // = Platform_SignalHandler
// (Ignore other signals)
}
- void SystemSetHandler(int s, SYSTEM_ADDRESS h) {
+ void SystemSetHandler(int s, ADDRESS h) {
if (s >= 2 && s <= 4) {
int needtosetsystemhandler = handler[s-2] == 0;
handler[s-2] = (SystemSignalHandler)h;
@@ -194,12 +205,12 @@ typedef void (*SystemSignalHandler)(INTEGER); // = Platform_SignalHandler
}
}
- void SystemSetInterruptHandler(SYSTEM_ADDRESS h) {
+ void SystemSetInterruptHandler(ADDRESS h) {
EnsureConsoleCtrlHandler();
SystemInterruptHandler = (SystemSignalHandler)h;
}
- void SystemSetQuitHandler(SYSTEM_ADDRESS h) {
+ void SystemSetQuitHandler(ADDRESS h) {
EnsureConsoleCtrlHandler();
SystemQuitHandler = (SystemSignalHandler)h;
}
diff --git a/src/runtime/SYSTEM.h b/src/runtime/SYSTEM.h
new file mode 100644
index 00000000..43baa836
--- /dev/null
+++ b/src/runtime/SYSTEM.h
@@ -0,0 +1,326 @@
+#ifndef SYSTEM__h
+#define SYSTEM__h
+
+
+// 64 bit system detection
+
+#if (__SIZEOF_POINTER__ == 8) || defined (_LP64) || defined(__LP64__) || defined(_WIN64)
+ #define o__64
+#endif
+
+
+// Declare memcpy in a way compatible with C compilers intrinsic
+// built in implementations.
+
+#if defined (o__64)
+ #if defined(_WIN64)
+ typedef unsigned long long size_t;
+ #else
+ typedef unsigned long size_t;
+ #endif
+#else
+ typedef unsigned int size_t;
+#endif
+
+#define _SIZE_T_DECLARED // For FreeBSD
+#define _SIZE_T_DEFINED_ // For OpenBSD
+
+void *memcpy(void *dest, const void *source, size_t size);
+#if defined _MSC_VER
+#define alloca _alloca
+#endif
+void *alloca(size_t size);
+
+
+// Declare fixed size versions of basic intger types
+
+#if defined (o__64) && !defined(_WIN64)
+ // LP64
+ typedef long INT64;
+ typedef unsigned long UINT64;
+#else
+ // ILP32 or LLP64
+ typedef long long INT64;
+ typedef unsigned long long UINT64;
+#endif
+
+typedef int INT32;
+typedef unsigned int UINT32;
+
+typedef short int INT16;
+typedef unsigned short int UINT16;
+
+typedef signed char INT8;
+typedef unsigned char UINT8;
+
+
+// The compiler uses 'import' and 'export' which translate to 'extern' and
+// nothing respectively.
+
+#define import extern
+#define export
+
+
+
+// Known constants
+
+#define NIL ((void*)0)
+#define __MAXEXT 16
+#define POINTER__typ ((ADDRESS*)(1)) // not NIL and not a valid type
+
+
+// Oberon types
+
+typedef INT8 BOOLEAN;
+typedef INT8 SYSTEM_BYTE;
+typedef UINT8 CHAR;
+typedef float REAL;
+typedef double LONGREAL;
+typedef void* SYSTEM_PTR;
+
+
+
+// 'ADDRESS' is a synonym for an integer of pointer size
+
+#if defined (o__64)
+ #define ADDRESS INT64
+#else
+ #define ADDRESS INT32
+#endif
+
+
+
+// ----------------------------------------------------------------------
+// ----------------------------------------------------------------------
+
+
+
+// OS Memory allocation interfaces are in PlatformXXX.Mod
+
+extern ADDRESS Platform_OSAllocate (ADDRESS size);
+extern void Platform_OSFree (ADDRESS addr);
+
+
+// Assertions and Halts
+
+extern void Modules_Halt(INT32 x);
+extern void Modules_AssertFail(INT32 x);
+
+#define __HALT(x) Modules_Halt((INT32)(x))
+#define __ASSERT(cond, x) if (!(cond)) Modules_AssertFail((INT32)(x))
+
+
+// Index checking
+
+static inline INT64 __XF(UINT64 i, UINT64 ub) {if (i >= ub) {__HALT(-2);} return i;}
+#define __X(i, ub) (((i)<(ub))?i:(__HALT(-2),0))
+
+
+// Range checking, and checked SHORT and CHR functions
+
+static inline INT64 __RF(UINT64 i, UINT64 ub) {if (i >= ub) {__HALT(-8);} return i;}
+#define __R(i, ub) (((i)<(ub))?i:(__HALT(-8),0))
+#define __SHORT(x, ub) ((int)((UINT64)(x)+(ub)<(ub)+(ub)?(x):(__HALT(-8),0)))
+#define __SHORTF(x, ub) ((int)(__RF((x)+(ub),(ub)+(ub))-(ub)))
+#define __CHR(x) ((CHAR)__R(x, 256))
+#define __CHRF(x) ((CHAR)__RF(x, 256))
+
+
+
+// Signal handling in SYSTEM.c
+
+#ifndef _WIN32
+ extern void SystemSetHandler(int s, ADDRESS h);
+#else
+ extern void SystemSetInterruptHandler(ADDRESS h);
+ extern void SystemSetQuitHandler (ADDRESS h);
+#endif
+
+
+
+// String comparison
+
+static inline int __str_cmp(CHAR *x, CHAR *y){
+ INT64 i = 0;
+ CHAR ch1, ch2;
+ do {ch1 = x[i]; ch2 = y[i]; i++;
+ if (!ch1) return -(int)ch2;
+ } while (ch1==ch2);
+ return (int)ch1 - (int)ch2;
+}
+#define __STRCMP(a,b) __str_cmp((CHAR*)(a), (CHAR*)(b))
+
+
+
+// Inline string, record and array copy
+
+#define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d; LONGINT _i=0,_t=n-1; \
+ while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;}
+#define __DUPARR(v, t) v=(void*)memcpy(v##__copy,v,sizeof(t))
+#define __DUP(x, l, t) x=(void*)memcpy(alloca(l*sizeof(t)),x,l*sizeof(t))
+#define __DEL(x)
+
+
+/* SYSTEM ops */
+
+#define __VAL(t, x) (*(t*)&(x))
+
+#define __GET(a, x, t) x=*(t*)(ADDRESS)(a)
+#define __PUT(a, x, t) *(t*)(ADDRESS)(a)=x
+
+#define __LSHL(x, n, s) ((INT##s)((UINT##s)(x)<<(n)))
+#define __LSHR(x, n, s) ((INT##s)((UINT##s)(x)>>(n)))
+#define __LSH(x, n, s) ((n)>=0? __LSHL(x, n, s): __LSHR(x, -(n), s))
+
+#define __ROTL(x, n, s) ((INT##s)((UINT##s)(x)<<(n)|(UINT##s)(x)>>(s-(n))))
+#define __ROTR(x, n, s) ((INT##s)((UINT##s)(x)>>(n)|(UINT##s)(x)<<(s-(n))))
+#define __ROT(x, n, s) ((n)>=0? __ROTL(x, n, s): __ROTR(x, -(n), s))
+
+#define __ASHL(x, n) ((INT64)(x)<<(n))
+#define __ASHR(x, n) ((INT64)(x)>>(n))
+#define __ASH(x, n) ((n)>=0?__ASHL(x,n):__ASHR(x,-(n)))
+static inline INT64 SYSTEM_ASH(INT64 x, INT64 n) {return __ASH(x,n);}
+#define __ASHF(x, n) SYSTEM_ASH((INT64)(x), (INT64)(n))
+
+#define __MOVE(s, d, n) memcpy((char*)(ADDRESS)(d),(char*)(ADDRESS)(s),n)
+
+
+extern INT64 SYSTEM_DIV(INT64 x, INT64 y);
+#define __DIVF(x, y) SYSTEM_DIV(x, y)
+#define __DIV(x, y) (((x)>0 && (y)>0) ? (x)/(y) : __DIVF(x, y))
+
+
+extern INT64 SYSTEM_MOD(INT64 x, INT64 y);
+#define __MODF(x, y) SYSTEM_MOD(x, y)
+#define __MOD(x, y) (((x)>0 && (y)>0) ? (x)%(y) : __MODF(x, y))
+
+
+extern INT64 SYSTEM_ENTIER (double x);
+#define __ENTIER(x) SYSTEM_ENTIER(x)
+
+
+#define __ABS(x) (((x)<0)?-(x):(x))
+
+static inline INT32 SYSTEM_ABS64(INT64 i) {return i >= 0 ? i : -i;}
+static inline INT64 SYSTEM_ABS32(INT32 i) {return i >= 0 ? i : -i;}
+#define __ABSF(x) ((sizeof(x) <= 4) ? SYSTEM_ABS32(x) : SYSTEM_ABS64(x))
+
+static inline double SYSTEM_ABSD(double i) {return i >= 0.0 ? i : -i;}
+#define __ABSFD(x) SYSTEM_ABSD(x)
+
+#define __CAP(ch) ((CHAR)((ch)&0x5f))
+#define __ODD(x) ((x)&1)
+
+#define __IN(x, s, size) (((unsigned int)(x))>(x))&1))
+// todo tested versions of SETOF and SETRNG: check that x, l and h fit size
+#define __SETOF(x, size) ((UINT##size)1<<(x))
+#define __SETRNG(l, h, size) ((~(UINT##size)0<<(l))&~(UINT##size)0>>(size-1-(h)))
+
+#define __MASK(x, m) ((x)&~(m))
+#define __BIT(x, n) (*(UINT64*)(x)>>(n)&1)
+
+
+
+// Runtime checks
+
+#define __RETCHK __retchk: __HALT(-3); return 0;
+#define __CASECHK __HALT(-4)
+#define __WITHCHK __HALT(-7)
+
+
+#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(ADDRESS)typ##__typ)
+#define __TYPEOF(p) (*(((ADDRESS**)(p))-1))
+#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level)
+
+
+#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p)))
+#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r))))
+#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p)))
+#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p)
+#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p)
+
+
+
+// Module entry/registration/exit
+
+extern void Heap_REGCMD();
+extern SYSTEM_PTR Heap_REGMOD();
+extern void Heap_REGTYP();
+extern void Heap_INCREF();
+
+#define __DEFMOD static void *m; if (m!=0) {return m;}
+#define __REGCMD(name, cmd) Heap_REGCMD(m, (CHAR*)name, cmd)
+#define __REGMOD(name, enum) if (m==0) {m = Heap_REGMOD((CHAR*)name,enum);}
+#define __ENDMOD return m
+#define __MODULE_IMPORT(name) Heap_INCREF(name##__init())
+
+
+
+// Main module initialisation, registration and finalisation
+
+extern void Platform_Init(INT32 argc, ADDRESS argv);
+extern void Heap_FINALL();
+
+#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
+
+
+// Memory allocation
+
+extern SYSTEM_PTR Heap_NEWBLK (ADDRESS size);
+extern SYSTEM_PTR Heap_NEWREC (ADDRESS tag);
+extern SYSTEM_PTR SYSTEM_NEWARR(ADDRESS*, ADDRESS, int, int, int, ...);
+
+#define __SYSNEW(p, len) p = Heap_NEWBLK((ADDRESS)(len))
+#define __NEW(p, t) p = Heap_NEWREC((ADDRESS)t##__typ)
+#define __NEWARR SYSTEM_NEWARR
+
+
+
+/* Type handling */
+
+extern void SYSTEM_INHERIT(ADDRESS *t, ADDRESS *t0);
+extern void SYSTEM_ENUMP (void *adr, ADDRESS n, void (*P)());
+extern void SYSTEM_ENUMR (void *adr, ADDRESS *typ, ADDRESS size, ADDRESS n, void (*P)());
+
+
+#define __TDESC(t, m, n) \
+ static struct t##__desc { \
+ ADDRESS tproc[m]; /* Proc for each ptr field */ \
+ ADDRESS tag; \
+ ADDRESS next; /* Module table type list points here */ \
+ ADDRESS level; \
+ ADDRESS module; \
+ char name[24]; \
+ ADDRESS basep[__MAXEXT]; /* List of bases this extends */ \
+ ADDRESS reserved; \
+ ADDRESS blksz; /* xxx_typ points here */ \
+ ADDRESS ptr[n+1]; /* Offsets of ptrs up to -ve sentinel */ \
+ } t##__desc
+
+#define __BASEOFF (__MAXEXT+1) // blksz as index to base.
+#define __TPROC0OFF (__BASEOFF+24/sizeof(ADDRESS)+5) // blksz as index to tproc IFF m=1.
+#define __EOM 1
+#define __TDFLDS(name, size) {__EOM}, 1, 0, 0, 0, name, {0}, 0, size
+#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (ADDRESS)(n), P)
+#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (ADDRESS)(size), (ADDRESS)(n), P)
+
+#define __INITYP(t, t0, level) \
+ t##__typ = (ADDRESS*)&t##__desc.blksz; \
+ memcpy(t##__desc.basep, t0##__typ - __BASEOFF, level*sizeof(ADDRESS)); \
+ t##__desc.basep[level] = (ADDRESS)t##__typ; \
+ t##__desc.module = (ADDRESS)m; \
+ if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \
+ t##__desc.blksz = (t##__desc.blksz+5*sizeof(ADDRESS)-1)/(4*sizeof(ADDRESS))*(4*sizeof(ADDRESS)); \
+ Heap_REGTYP(m, (ADDRESS)&t##__desc.next); \
+ SYSTEM_INHERIT(t##__typ, t0##__typ)
+
+// Oberon-2 type bound procedures support
+#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(ADDRESS)proc
+#define __SEND(typ, num, funtyp, parlist) ((funtyp)((ADDRESS)*(typ-(__TPROC0OFF+num))))parlist
+
+
+
+
+#endif
diff --git a/src/library/v4/Strings.Mod b/src/runtime/Strings.Mod
similarity index 97%
rename from src/library/v4/Strings.Mod
rename to src/runtime/Strings.Mod
index e6fe12ac..0dcfa6d2 100644
--- a/src/library/v4/Strings.Mod
+++ b/src/runtime/Strings.Mod
@@ -32,10 +32,10 @@ MODULE Strings; (*HM 94-06-22 / *)
PROCEDURE Length* (s: ARRAY OF CHAR): INTEGER;
- VAR i: INTEGER;
+ VAR i: LONGINT;
BEGIN
- i := 0; WHILE (i < LEN(s)) & (s[i] # 0X) DO INC(i) END ;
- RETURN i
+ i := 0; WHILE (i < LEN(s)) & (s[i] # 0X) DO INC(i) END;
+ IF i <= MAX(INTEGER) THEN RETURN SHORT(i) ELSE RETURN MAX(INTEGER) END
END Length;
diff --git a/src/library/v4/Texts.Mod b/src/runtime/Texts.Mod
similarity index 97%
rename from src/library/v4/Texts.Mod
rename to src/runtime/Texts.Mod
index 26b13c81..305b225d 100644
--- a/src/library/v4/Texts.Mod
+++ b/src/runtime/Texts.Mod
@@ -1,6 +1,6 @@
MODULE Texts; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91**) (* << RC, MB, JT *)
IMPORT
- Files, Modules, Reals;
+ Files, Modules, Reals, SYSTEM;
(*--- insert field e: Elem into Texts.Scanner and change Texts.Scan to set it in case of class=6 *)
@@ -29,7 +29,7 @@ MODULE Texts; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91**
prev, next: Run;
len: LONGINT;
fnt: FontsFont;
- col, voff: SHORTINT;
+ col, voff: SYSTEM.INT8;
ascii: BOOLEAN (* << *)
END;
@@ -83,7 +83,7 @@ MODULE Texts; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91**
Reader* = RECORD
eot*: BOOLEAN;
fnt*: FontsFont;
- col*, voff*: SHORTINT;
+ col*, voff*: SYSTEM.INT8;
elem*: Elem;
rider: Files.Rider;
run: Run;
@@ -104,7 +104,7 @@ MODULE Texts; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91**
Writer* = RECORD
buf*: Buffer;
fnt*: FontsFont;
- col*, voff*: SHORTINT;
+ col*, voff*: SYSTEM.INT8;
rider: Files.Rider;
file: Files.File
END;
@@ -306,7 +306,7 @@ MODULE Texts; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91**
IF T.notify # NIL THEN T.notify(T, delete, beg, end) END
END Delete;
- PROCEDURE ChangeLooks* (T: Text; beg, end: LONGINT; sel: SET; fnt: FontsFont; col, voff: SHORTINT);
+ PROCEDURE ChangeLooks* (T: Text; beg, end: LONGINT; sel: SET; fnt: FontsFont; col, voff: SYSTEM.INT8);
VAR c, u, un, v, vn: Run; co, uo, ud, vo, vd: LONGINT;
BEGIN Find(T, beg, u, uo, ud); Split(ud, u, un); c := T.cache; co := T.corg;
Find(T, end, v, vo, vd); Split(vd, v, vn); T.cache := c; T.corg := co;
@@ -506,11 +506,11 @@ MODULE Texts; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91**
BEGIN W.fnt := fnt
END SetFont;
- PROCEDURE SetColor* (VAR W: Writer; col: SHORTINT);
+ PROCEDURE SetColor* (VAR W: Writer; col: SYSTEM.INT8);
BEGIN W.col := col
END SetColor;
- PROCEDURE SetOffset* (VAR W: Writer; voff: SHORTINT);
+ PROCEDURE SetOffset* (VAR W: Writer; voff: SYSTEM.INT8);
BEGIN W.voff := voff
END SetOffset;
@@ -545,19 +545,13 @@ MODULE Texts; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91**
WHILE s[i] >= " " DO Write(W, s[i]); INC(i) END
END WriteString;
- PROCEDURE WriteInt* (VAR W: Writer; x, n: LONGINT);
+ PROCEDURE WriteInt* (VAR W: Writer; x, n: SYSTEM.INT64);
VAR
- i: INTEGER; x0: LONGINT;
- a: ARRAY 22 OF CHAR;
+ i: INTEGER; x0: SYSTEM.INT64;
+ a: ARRAY 24 OF CHAR;
BEGIN i := 0;
IF x < 0 THEN
- IF x = MIN(LONGINT) THEN
- IF SIZE(LONGINT) = 4 THEN
- WriteString(W, " -2147483648")
- ELSE
- WriteString(W, " -9223372036854775808")
- END;
- RETURN
+ IF x = MIN(SYSTEM.INT64) THEN WriteString(W, " -9223372036854775808"); RETURN
ELSE DEC(n); x0 := -x
END
ELSE x0 := x
@@ -724,7 +718,8 @@ MODULE Texts; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91**
PROCEDURE Load0 (VAR r: Files.Rider; T: Text);
VAR u, un: Run; p: Piece; e: Elem;
- org, pos, hlen, plen: LONGINT; ecnt, fno, fcnt, col, voff: SHORTINT;
+ org, pos, hlen, plen: LONGINT; ecnt, fcnt: SHORTINT;
+ fno, col, voff: SYSTEM.INT8;
f: Files.File;
msg: FileMsg;
mods, procs: ARRAY 64, 32 OF CHAR;
@@ -733,7 +728,7 @@ MODULE Texts; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91**
PROCEDURE LoadElem (VAR r: Files.Rider; pos, span: LONGINT; VAR e: Elem);
VAR M: Modules.Module; Cmd: Modules.Command; a: Alien;
- org, ew, eh: LONGINT; eno: SHORTINT;
+ org, ew, eh: LONGINT; eno: SYSTEM.INT8;
BEGIN new := NIL;
Files.ReadLInt(r, ew); Files.ReadLInt(r, eh); Files.Read(r, eno);
IF eno > ecnt THEN ecnt := eno; Files.ReadString(r, mods[eno]); Files.ReadString(r, procs[eno]) END;
@@ -806,14 +801,15 @@ MODULE Texts; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91**
END Open;
PROCEDURE Store* (VAR r: Files.Rider; T: Text);
- VAR r1: Files.Rider; u, un: Run; e: Elem; org, pos, delta, hlen, rlen: LONGINT; ecnt, fno, fcnt: SHORTINT; ch: CHAR; (* << *)
+ VAR r1: Files.Rider; u, un: Run; e: Elem; org, pos, delta, hlen, rlen: LONGINT; ecnt, fcnt: SHORTINT; ch: CHAR; (* << *)
+ fno: SYSTEM.INT8;
msg: FileMsg; iden: IdentifyMsg;
mods, procs: ARRAY 64, 32 OF CHAR;
fnts: ARRAY 32 OF FontsFont;
block: ARRAY 1024 OF CHAR;
PROCEDURE StoreElem (VAR r: Files.Rider; pos: LONGINT; e: Elem);
- VAR r1: Files.Rider; org, span: LONGINT; eno: SHORTINT;
+ VAR r1: Files.Rider; org, span: LONGINT; eno: SYSTEM.INT8;
BEGIN COPY(iden.mod, mods[ecnt]); COPY(iden.proc, procs[ecnt]); eno := 1;
WHILE (mods[eno] # iden.mod) OR (procs[eno] # iden.proc) DO INC(eno) END;
Files.Set(r1, Files.Base(r), Files.Pos(r));
diff --git a/src/library/misc/vt100.Mod b/src/runtime/VT100.Mod
similarity index 96%
rename from src/library/misc/vt100.Mod
rename to src/runtime/VT100.Mod
index 37ab5895..03cc1d2c 100644
--- a/src/library/misc/vt100.Mod
+++ b/src/runtime/VT100.Mod
@@ -1,6 +1,6 @@
-MODULE vt100;
+MODULE VT100;
-IMPORT Console, Strings;
+IMPORT Out, Strings;
(* reference http://en.wikipedia.org/wiki/ANSI_escape_code
& http://misc.flogisoft.com/bash/tip_colors_and_formatting
*)
@@ -65,7 +65,7 @@ CONST
BLightCyan* = "106m";
BWhite* = "107m";
- VAR
+ VAR
CSI* : ARRAY 5 OF CHAR;
tmpstr : ARRAY 32 OF CHAR;
@@ -102,7 +102,7 @@ CONST
ELSE (* SIZE(LONGINT) = 8 *)
b := "-9223372036854775808";
e := 20
- END
+ END
ELSE
IF int < 0 THEN (* negative sign *)
b[0] := "-"; int := -int; s := 1
@@ -127,7 +127,7 @@ CONST
BEGIN
COPY(CSI, cmd);
Strings.Append (letter, cmd);
- Console.String (cmd);
+ Out.String (cmd);
END EscSeq0;
PROCEDURE EscSeq (n : INTEGER; letter : ARRAY OF CHAR);
@@ -138,7 +138,7 @@ CONST
COPY(CSI, cmd);
Strings.Append (nstr, cmd);
Strings.Append (letter, cmd);
- Console.String (cmd);
+ Out.String (cmd);
END EscSeq;
PROCEDURE EscSeqSwapped (n : INTEGER; letter : ARRAY OF CHAR);
@@ -149,7 +149,7 @@ CONST
COPY(CSI, cmd);
Strings.Append (letter, cmd);
Strings.Append (nstr, cmd);
- Console.String (cmd);
+ Out.String (cmd);
END EscSeqSwapped;
PROCEDURE EscSeq2(n, m : INTEGER; letter : ARRAY OF CHAR);
@@ -164,13 +164,13 @@ CONST
Strings.Append (';', cmd);
Strings.Append (mstr, cmd);
Strings.Append (letter, cmd);
- Console.String (cmd);
+ Out.String (cmd);
END EscSeq2;
-(* Cursor up
+(* Cursor up
moves cursor n cells in the given direction. if the cursor is already at the edge of the screen, this has no effect *)
PROCEDURE CUU*(n : INTEGER);
@@ -187,7 +187,7 @@ CONST
END CUD;
-(* Cursor forward
+(* Cursor forward
moves cursor n cells in the given direction. if the cursor is already at the edge of the screen, this has no effect *)
PROCEDURE CUF*(n : INTEGER);
@@ -195,7 +195,7 @@ CONST
EscSeq (n, 'C');
END CUF;
-(* Cursor back
+(* Cursor back
moves cursor n cells in the given direction. if the cursor is already at the edge of the screen, this has no effect *)
PROCEDURE CUB*(n : INTEGER);
@@ -259,7 +259,7 @@ CONST
END SU;
(* Scroll Down
- Scroll whole page down by n (default 1) lines. New lines are added at the top *)
+ Scroll whole page down by n (default 1) lines. New lines are added at the top *)
PROCEDURE SD*( n : INTEGER);
BEGIN
EscSeq(n, 'T');
@@ -324,7 +324,7 @@ CONST
BEGIN
COPY(CSI, tmpstr);
Strings.Append(attr, tmpstr);
- Console.String(tmpstr);
+ Out.String(tmpstr);
END SetAttr;
BEGIN
@@ -337,6 +337,6 @@ CONST
COPY(CSI, tmpstr);
Strings.Append(Green, tmpstr);
Strings.Append("hello", tmpstr);
- Console.String(tmpstr); Console.Ln;
+ Out.String(tmpstr); Out.Ln;
*)
- END vt100.
+ END VT100.
diff --git a/bootstrap/unix-48/WindowsWrapper.h b/src/runtime/WindowsWrapper.h
similarity index 100%
rename from bootstrap/unix-48/WindowsWrapper.h
rename to src/runtime/WindowsWrapper.h
diff --git a/src/system/Oberon.Mod b/src/system/Oberon.Mod
deleted file mode 100644
index d0125cdc..00000000
--- a/src/system/Oberon.Mod
+++ /dev/null
@@ -1,86 +0,0 @@
-MODULE Oberon;
-
-(* this version should not have dependency on graphics -- noch *)
-
- IMPORT Platform, Texts, Args, Console;
-
- TYPE
- ParList* = POINTER TO ParRec;
-
- ParRec* = RECORD
- (* vwr*: Viewers.Viewer;
- frame*: Display.Frame;*)
- text*: Texts.Text;
- pos*: LONGINT
- END;
-
- VAR
-
- Log*: Texts.Text;
- Par*: ParList; (*actual parameters*)
- R: Texts.Reader;
- W: Texts.Writer;
- OptionChar*: CHAR;
-
- (*clocks*)
-
- PROCEDURE GetClock* (VAR t, d: LONGINT);
- BEGIN Platform.GetClock(t, d)
- END GetClock;
-
- PROCEDURE Time* (): LONGINT;
- BEGIN
- RETURN Platform.Time()
- END Time;
-
- PROCEDURE PopulateParams;
- VAR
- W: Texts.Writer;
- i: INTEGER;
- str: ARRAY 32 OF CHAR;
- BEGIN
-
- i := 1; (* skip program name *)
- Texts.OpenWriter(W);
-
- REPEAT
- IF i < Args.argc THEN
- Args.Get(i, str);
- Texts.WriteString(W, str);
- Texts.WriteString(W, " ");
- END;
- INC(i)
- UNTIL i >= Args.argc;
-
- Texts.Append (Par^.text, W.buf);
-
- END PopulateParams;
-
- PROCEDURE GetSelection*(VAR text: Texts.Text; VAR beg, end, time: LONGINT);
- BEGIN text := NIL; beg := 0; end := 0; time := 0;
- END GetSelection;
-
-(* --- Notifier for echoing all text appended to the log onto the console. --- *)
-
-PROCEDURE LogNotifier(Log: Texts.Text; op: INTEGER; beg, end: LONGINT);
- VAR ch: CHAR;
-BEGIN
- Texts.OpenReader(R, Log, beg);
- WHILE ~R.eot & (beg < end) DO
- Texts.Read(R, ch);
- IF ch = 0DX THEN Console.Ln ELSE Console.Char(ch) END;
- INC(beg)
- END
-END LogNotifier;
-
-BEGIN
- NEW(Par);
- NEW(Par.text);
- Par.pos := 0;
- OptionChar := '-';
- Texts.Open(Par.text, "");
- PopulateParams;
- NEW(Log);
- Texts.Open(Log, "");
- Log.notify := LogNotifier;
-END Oberon.
diff --git a/src/system/SYSTEM.c b/src/system/SYSTEM.c
deleted file mode 100644
index 33511a70..00000000
--- a/src/system/SYSTEM.c
+++ /dev/null
@@ -1,207 +0,0 @@
-/*
-* The body prefix file of the voc(jet backend) runtime system, Version 1.0
-*
-* Copyright (c) Software Templ, 1994, 1995
-*
-* Module SYSTEM is subject to change any time without prior notification.
-* Software Templ disclaims all warranties with regard to module SYSTEM,
-* in particular shall Software Templ not be liable for any damage resulting
-* from inappropriate use or modification of module SYSTEM.
-*
-* Version 1.1 jt, 24.11.95 fixes for correct pointer arithmetic on Cray computers
-* jt 31.1.2007 ANSI prototypes for malloc and exit in order to avoid cc warnings
-*
-*/
-
-#include "SYSTEM.h"
-#include "stdarg.h"
-#include
-
-
-LONGINT SYSTEM_XCHK(LONGINT i, LONGINT ub) {return __X(i, ub);}
-LONGINT SYSTEM_RCHK(LONGINT i, LONGINT ub) {return __R(i, ub);}
-LONGINT SYSTEM_ASH (LONGINT i, LONGINT n) {return __ASH(i, n);}
-LONGINT SYSTEM_ABS (LONGINT i) {return __ABS(i);}
-double SYSTEM_ABSD(double i) {return __ABS(i);}
-
-void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0)
-{
- t -= __TPROC0OFF;
- t0 -= __TPROC0OFF;
- while (*t0 != __EOM) {*t = *t0; t--; t0--;}
-}
-
-
-void SYSTEM_ENUMP(void *adr, LONGINT n, void (*P)())
-{
- while (n > 0) {
- P((LONGINT)(SYSTEM_ADDRESS)(*((void**)(adr))));
- adr = ((void**)adr) + 1;
- n--;
- }
-}
-
-void SYSTEM_ENUMR(void *adr, LONGINT *typ, LONGINT size, LONGINT n, void (*P)())
-{
- LONGINT *t, off;
- typ++;
- while (n > 0) {
- t = typ;
- off = *t;
- while (off >= 0) {P(*(LONGINT*)((char*)adr+off)); t++; off = *t;}
- adr = ((char*)adr) + size;
- n--;
- }
-}
-
-LONGINT SYSTEM_DIV(U_LONGINT x, U_LONGINT y)
-{ if ((LONGINT) x >= 0) return (x / y);
- else return -((y - 1 - x) / y);
-}
-
-LONGINT SYSTEM_MOD(U_LONGINT x, U_LONGINT y)
-{ U_LONGINT m;
- if ((LONGINT) x >= 0) return (x % y);
- else { m = (-x) % y;
- if (m != 0) return (y - m); else return 0;
- }
-}
-
-LONGINT SYSTEM_ENTIER(double x)
-{
- LONGINT y;
- if (x >= 0)
- return (LONGINT)x;
- else {
- y = (LONGINT)x;
- if (y <= x) return y; else return y - 1;
- }
-}
-
-extern void Heap_Lock();
-extern void Heap_Unlock();
-
-SYSTEM_PTR SYSTEM_NEWARR(LONGINT *typ, LONGINT elemsz, int elemalgn, int nofdim, int nofdyn, ...)
-{
- LONGINT nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off;
- va_list ap;
- va_start(ap, nofdyn);
- nofelems = 1;
- while (nofdim > 0) {
- nofelems = nofelems * va_arg(ap, LONGINT); nofdim--;
- if (nofelems <= 0) __HALT(-20);
- }
- va_end(ap);
- dataoff = nofdyn * sizeof(LONGINT);
- if (elemalgn > sizeof(LONGINT)) {
- n = dataoff % elemalgn;
- if (n != 0) dataoff += elemalgn - n;
- }
- size = dataoff + nofelems * elemsz;
- Heap_Lock();
- if (typ == NIL) {
- /* element typ does not contain pointers */
- x = Heap_NEWBLK(size);
- }
- else if (typ == (LONGINT*)POINTER__typ) {
- /* element type is a pointer */
- x = Heap_NEWBLK(size + nofelems * sizeof(LONGINT));
- p = (LONGINT*)(SYSTEM_ADDRESS)x[-1];
- p[-nofelems] = *p; /* build new type desc in situ: 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */
- p -= nofelems - 1; n = 1; /* n =1 for skipping the size field */
- while (n <= nofelems) {*p = n*sizeof(LONGINT); p++; n++;}
- *p = - (nofelems + 1) * sizeof(LONGINT); /* sentinel */
- x[-1] -= nofelems * sizeof(LONGINT);
- }
- else {
- /* element type is a record that contains pointers */
- ptab = typ + 1; nofptrs = 0;
- while (ptab[nofptrs] >= 0) {nofptrs++;} /* number of pointers per element */
- nptr = nofelems * nofptrs; /* total number of pointers */
- x = Heap_NEWBLK(size + nptr * sizeof(LONGINT));
- p = (LONGINT*)(SYSTEM_ADDRESS)x[- 1];
- p[-nptr] = *p; /* build new type desc in situ; 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */
- p -= nptr - 1; n = 0; off = dataoff;
- while (n < nofelems) {i = 0;
- while (i < nofptrs) {*p = off + ptab[i]; p++; i++;}
- off += elemsz; n++;
- }
- *p = - (nptr + 1) * sizeof(LONGINT); /* sentinel */
- x[-1] -= nptr * sizeof(LONGINT);
- }
- if (nofdyn != 0) {
- /* setup len vector for index checks */
- va_start(ap, nofdyn);
- p = x;
- while (nofdyn > 0) {*p = va_arg(ap, LONGINT); p++, nofdyn--;}
- va_end(ap);
- }
- Heap_Unlock();
- return x;
-}
-
-
-
-
-typedef void (*SystemSignalHandler)(INTEGER); // = Platform_SignalHandler
-
-#ifndef _WIN32
-
- SystemSignalHandler handler[3] = {0};
-
- // Provide signal handling for Unix based systems
- void signalHandler(int s) {
- if (s >= 2 && s <= 4) handler[s-2](s);
- // (Ignore other signals)
- }
-
- void SystemSetHandler(int s, SYSTEM_ADDRESS h) {
- if (s >= 2 && s <= 4) {
- int needtosetsystemhandler = handler[s-2] == 0;
- handler[s-2] = (SystemSignalHandler)h;
- if (needtosetsystemhandler) {signal(s, signalHandler);}
- }
- }
-
-#else
-
- // Provides Windows callback handlers for signal-like scenarios
- #include "WindowsWrapper.h"
-
- SystemSignalHandler SystemInterruptHandler = 0;
- SystemSignalHandler SystemQuitHandler = 0;
- BOOL ConsoleCtrlHandlerSet = FALSE;
-
- BOOL WINAPI SystemConsoleCtrlHandler(DWORD ctrlType) {
- if ((ctrlType == CTRL_C_EVENT) || (ctrlType == CTRL_BREAK_EVENT)) {
- if (SystemInterruptHandler) {
- SystemInterruptHandler(2); // SIGINT
- return TRUE;
- }
- } else { // Close, logoff or shutdown
- if (SystemQuitHandler) {
- SystemQuitHandler(3); // SIGQUIT
- return TRUE;
- }
- }
- return FALSE;
- }
-
- void EnsureConsoleCtrlHandler() {
- if (!ConsoleCtrlHandlerSet) {
- SetConsoleCtrlHandler(SystemConsoleCtrlHandler, TRUE);
- ConsoleCtrlHandlerSet = TRUE;
- }
- }
-
- void SystemSetInterruptHandler(SYSTEM_ADDRESS h) {
- EnsureConsoleCtrlHandler();
- SystemInterruptHandler = (SystemSignalHandler)h;
- }
-
- void SystemSetQuitHandler(SYSTEM_ADDRESS h) {
- EnsureConsoleCtrlHandler();
- SystemQuitHandler = (SystemSignalHandler)h;
- }
-
-#endif
diff --git a/src/system/SYSTEM.h b/src/system/SYSTEM.h
deleted file mode 100644
index 6377745e..00000000
--- a/src/system/SYSTEM.h
+++ /dev/null
@@ -1,295 +0,0 @@
-#ifndef SYSTEM__h
-#define SYSTEM__h
-
-#if defined(_WIN64)
- typedef long long SYSTEM_INT64;
- typedef unsigned long long SYSTEM_CARD64;
-#else
- typedef long SYSTEM_INT64;
- typedef unsigned long SYSTEM_CARD64;
-#endif
-
-typedef int SYSTEM_INT32;
-typedef unsigned int SYSTEM_CARD32;
-typedef short int SYSTEM_INT16;
-typedef unsigned short int SYSTEM_CARD16;
-typedef signed char SYSTEM_INT8;
-typedef unsigned char SYSTEM_CARD8;
-
-#if (__SIZEOF_POINTER__ == 8) || defined(_WIN64) || defined(__LP64__)
- #if defined(_WIN64)
- typedef unsigned long long size_t;
- #else
- typedef unsigned long size_t;
- #endif
-#else
- typedef unsigned int size_t;
-#endif
-
-#define SYSTEM_ADDRESS size_t
-#define _SIZE_T_DECLARED // For FreeBSD
-#define _SIZE_T_DEFINED_ // For OpenBSD
-
-void *memcpy(void *dest, const void *source, SYSTEM_ADDRESS size);
-
-
-
-// The compiler uses 'import' and 'export' which translate to 'extern' and
-// nothing respectively.
-
-#define import extern
-#define export
-
-
-
-// Known constants
-
-#define NIL ((void*)0)
-#define __MAXEXT 16
-#define POINTER__typ ((LONGINT*)(1)) // not NIL and not a valid type
-
-
-// Oberon types
-
-typedef char BOOLEAN;
-typedef unsigned char SYSTEM_BYTE;
-typedef unsigned char CHAR;
-typedef signed char SHORTINT;
-typedef float REAL;
-typedef double LONGREAL;
-typedef void* SYSTEM_PTR;
-
-// Unsigned variants are for use by shift and rotate macros.
-
-typedef unsigned char U_SYSTEM_BYTE;
-typedef unsigned char U_CHAR;
-typedef unsigned char U_SHORTINT;
-
-// For 32 bit builds, the size of LONGINT depends on a make option:
-
-#if (__SIZEOF_POINTER__ == 8) || defined(LARGE) || defined(_WIN64)
- typedef int INTEGER; // INTEGER is 32 bit.
- typedef long long LONGINT; // LONGINT is 64 bit. (long long is always 64 bits, while long can be 32 bits e.g. under MSC/MingW)
- typedef unsigned int U_INTEGER;
- typedef unsigned long long U_LONGINT;
-#else
- typedef short int INTEGER; // INTEGER is 16 bit.
- typedef long LONGINT; // LONGINT is 32 bit.
- typedef unsigned short int U_INTEGER;
- typedef unsigned long U_LONGINT;
-#endif
-
-typedef U_LONGINT SET;
-typedef U_LONGINT U_SET;
-
-
-// OS Memory allocation interfaces are in PlatformXXX.Mod
-
-extern LONGINT Platform_OSAllocate (LONGINT size);
-extern void Platform_OSFree (LONGINT addr);
-
-
-// Run time system routines in SYSTEM.c
-
-extern LONGINT SYSTEM_XCHK (LONGINT i, LONGINT ub);
-extern LONGINT SYSTEM_RCHK (LONGINT i, LONGINT ub);
-extern LONGINT SYSTEM_ASH (LONGINT i, LONGINT n);
-extern LONGINT SYSTEM_ABS (LONGINT i);
-extern double SYSTEM_ABSD (double i);
-extern void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0);
-extern void SYSTEM_ENUMP (void *adr, LONGINT n, void (*P)());
-extern void SYSTEM_ENUMR (void *adr, LONGINT *typ, LONGINT size, LONGINT n, void (*P)());
-extern LONGINT SYSTEM_DIV (U_LONGINT x, U_LONGINT y);
-extern LONGINT SYSTEM_MOD (U_LONGINT x, U_LONGINT y);
-extern LONGINT SYSTEM_ENTIER (double x);
-
-
-// Signal handling in SYSTEM.c
-
-#ifndef _WIN32
- extern void SystemSetHandler(int s, SYSTEM_ADDRESS h);
-#else
- extern void SystemSetInterruptHandler(SYSTEM_ADDRESS h);
- extern void SystemSetQuitHandler (SYSTEM_ADDRESS h);
-#endif
-
-
-
-// String comparison
-
-static int __str_cmp(CHAR *x, CHAR *y){
- LONGINT i = 0;
- CHAR ch1, ch2;
- do {ch1 = x[i]; ch2 = y[i]; i++;
- if (!ch1) return -(int)ch2;
- } while (ch1==ch2);
- return (int)ch1 - (int)ch2;
-}
-#define __STRCMP(a,b) __str_cmp((CHAR*)(a), (CHAR*)(b))
-
-
-
-// Inline string, record and array copy
-
-#define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d; LONGINT _i=0,_t=n-1; \
- while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;}
-#define __DUP(x, l, t) x=(void*)memcpy((void*)(SYSTEM_ADDRESS)Platform_OSAllocate(l*sizeof(t)),x,l*sizeof(t))
-#define __DUPARR(v, t) v=(void*)memcpy(v##__copy,v,sizeof(t))
-#define __DEL(x) Platform_OSFree((LONGINT)(SYSTEM_ADDRESS)x)
-
-
-
-
-/* SYSTEM ops */
-
-#define __VAL(t, x) (*(t*)&(x))
-
-
-#define __GET(a, x, t) x= *(t*)(SYSTEM_ADDRESS)(a)
-#define __PUT(a, x, t) *(t*)(SYSTEM_ADDRESS)(a)=x
-
-#define __LSHL(x, n, t) ((t)((U_##t)(x)<<(n)))
-#define __LSHR(x, n, t) ((t)((U_##t)(x)>>(n)))
-#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t))
-
-#define __ASHL(x, n) ((LONGINT)(x)<<(n))
-#define __ASHR(x, n) ((LONGINT)(x)>>(n))
-#define __ASH(x, n) ((n)>=0?__ASHL(x,n):__ASHR(x,-(n)))
-
-#define __ROTL(x, n, t) ((t)((U_##t)(x)<<(n)|(U_##t)(x)>>(8*sizeof(t)-(n))))
-#define __ROTR(x, n, t) ((t)((U_##t)(x)>>(n)|(U_##t)(x)<<(8*sizeof(t)-(n))))
-#define __ROT(x, n, t) ((n)>=0? __ROTL(x, n, t): __ROTR(x, -(n), t))
-
-#define __BIT(x, n) (*(U_LONGINT*)(x)>>(n)&1)
-#define __MOVE(s, d, n) memcpy((char*)(SYSTEM_ADDRESS)(d),(char*)(SYSTEM_ADDRESS)(s),n)
-#define __ASHF(x, n) SYSTEM_ASH((LONGINT)(x), (LONGINT)(n))
-#define __SHORT(x, y) ((int)((U_LONGINT)(x)+(y)<(y)+(y)?(x):(__HALT(-8),0)))
-#define __SHORTF(x, y) ((int)(__RF((x)+(y),(y)+(y))-(y)))
-#define __CHR(x) ((CHAR)__R(x, 256))
-#define __CHRF(x) ((CHAR)__RF(x, 256))
-#define __DIV(x, y) ((x)>=0?(x)/(y):-(((y)-1-(x))/(y)))
-#define __DIVF(x, y) SYSTEM_DIV((LONGINT)(x),(LONGINT)(y))
-#define __MOD(x, y) ((x)>=0?(x)%(y):__MODF(x,y))
-#define __MODF(x, y) SYSTEM_MOD((LONGINT)(x),(LONGINT)(y))
-#define __ENTIER(x) SYSTEM_ENTIER(x)
-#define __ABS(x) (((x)<0)?-(x):(x))
-#define __ABSF(x) SYSTEM_ABS((LONGINT)(x))
-#define __ABSFD(x) SYSTEM_ABSD((double)(x))
-#define __CAP(ch) ((CHAR)((ch)&0x5f))
-#define __ODD(x) ((x)&1)
-#define __IN(x, s) (((s)>>(x))&1)
-#define __SETOF(x) ((SET)1<<(x))
-#define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h)))
-#define __MASK(x, m) ((x)&~(m))
-
-
-
-// Runtime checks
-
-#define __X(i, ub) (((U_LONGINT)(i)<(U_LONGINT)(ub))?i:(__HALT(-2),0))
-#define __XF(i, ub) SYSTEM_XCHK((LONGINT)(i), (LONGINT)(ub))
-#define __R(i, ub) (((U_LONGINT)(i)<(U_LONGINT)(ub))?i:(__HALT(-8),0))
-#define __RF(i, ub) SYSTEM_RCHK((LONGINT)(i),(LONGINT)(ub))
-#define __RETCHK __retchk: __HALT(-3); return 0;
-#define __CASECHK __HALT(-4)
-#define __WITHCHK __HALT(-7)
-
-#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p)))
-#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r))))
-#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p)))
-#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p)
-#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p)
-
-
-
-// Module entry/registration/exit
-
-extern void Heap_REGCMD();
-extern SYSTEM_PTR Heap_REGMOD();
-extern void Heap_REGTYP();
-extern void Heap_INCREF();
-
-#define __DEFMOD static void *m; if (m!=0) {return m;}
-#define __REGCMD(name, cmd) Heap_REGCMD(m, (CHAR*)name, cmd)
-#define __REGMOD(name, enum) if (m==0) {m = Heap_REGMOD((CHAR*)name,enum);}
-#define __ENDMOD return m
-#define __MODULE_IMPORT(name) Heap_INCREF(name##__init())
-
-
-
-// Main module initialisation, registration and finalisation
-
-extern void Platform_Init(INTEGER argc, LONGINT argv);
-extern void Heap_FINALL();
-
-#define __INIT(argc, argv) static void *m; Platform_Init((INTEGER)argc, (LONGINT)(SYSTEM_ADDRESS)&argv);
-#define __REGMAIN(name, enum) m = Heap_REGMOD((CHAR*)name,enum)
-#define __FINI Heap_FINALL(); return 0
-
-
-// Assertions and Halts
-
-extern void Platform_Halt(LONGINT x);
-extern void Platform_AssertFail(LONGINT x);
-
-#define __HALT(x) Platform_Halt(x)
-#define __ASSERT(cond, x) if (!(cond)) Platform_AssertFail((LONGINT)(x))
-
-
-// Memory allocation
-
-extern SYSTEM_PTR Heap_NEWBLK (LONGINT size);
-extern SYSTEM_PTR Heap_NEWREC (LONGINT tag);
-extern SYSTEM_PTR SYSTEM_NEWARR(LONGINT*, LONGINT, int, int, int, ...);
-
-#define __SYSNEW(p, len) p = Heap_NEWBLK((LONGINT)(len))
-#define __NEW(p, t) p = Heap_NEWREC((LONGINT)(SYSTEM_ADDRESS)t##__typ)
-#define __NEWARR SYSTEM_NEWARR
-
-
-
-/* Type handling */
-
-#define __TDESC(t, m, n) \
- static struct t##__desc { \
- LONGINT tproc[m]; /* Proc for each ptr field */ \
- LONGINT tag; \
- LONGINT next; /* Module table type list points here */ \
- LONGINT level; \
- LONGINT module; \
- char name[24]; \
- LONGINT basep[__MAXEXT]; /* List of bases this extends */ \
- LONGINT reserved; \
- LONGINT blksz; /* xxx_typ points here */ \
- LONGINT ptr[n+1]; /* Offsets of ptrs up to -ve sentinel */ \
- } t##__desc
-
-#define __BASEOFF (__MAXEXT+1) // blksz as index to base.
-#define __TPROC0OFF (__BASEOFF+24/sizeof(LONGINT)+5) // blksz as index to tproc IFF m=1.
-#define __EOM 1
-#define __TDFLDS(name, size) {__EOM}, 1, 0, 0, 0, name, {0}, 0, size
-#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (LONGINT)(n), P)
-#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (LONGINT)(size), (LONGINT)(n), P)
-
-#define __INITYP(t, t0, level) \
- t##__typ = (LONGINT*)&t##__desc.blksz; \
- memcpy(t##__desc.basep, t0##__typ - __BASEOFF, level*sizeof(LONGINT)); \
- t##__desc.basep[level] = (LONGINT)(SYSTEM_ADDRESS)t##__typ; \
- t##__desc.module = (LONGINT)(SYSTEM_ADDRESS)m; \
- if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \
- t##__desc.blksz = (t##__desc.blksz+5*sizeof(LONGINT)-1)/(4*sizeof(LONGINT))*(4*sizeof(LONGINT)); \
- Heap_REGTYP(m, (LONGINT)(SYSTEM_ADDRESS)&t##__desc.next); \
- SYSTEM_INHERIT(t##__typ, t0##__typ)
-
-#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(LONGINT)(SYSTEM_ADDRESS)typ##__typ)
-#define __TYPEOF(p) ((LONGINT*)(SYSTEM_ADDRESS)(*(((LONGINT*)(p))-1)))
-#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level)
-
-// Oberon-2 type bound procedures support
-#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(LONGINT)(SYSTEM_ADDRESS)proc
-#define __SEND(typ, num, funtyp, parlist) ((funtyp)((SYSTEM_ADDRESS)*(typ-(__TPROC0OFF+num))))parlist
-
-
-
-
-#endif
diff --git a/src/system/WindowsWrapper.h b/src/system/WindowsWrapper.h
deleted file mode 100644
index b72c815a..00000000
--- a/src/system/WindowsWrapper.h
+++ /dev/null
@@ -1,10 +0,0 @@
-// WindowsWrapper.h
-//
-// Includes Windows.h while avoiding conflicts with Oberon types.
-
-
-#define BOOLEAN _BOOLEAN
-#define CHAR _CHAR
-#include
-#undef BOOLEAN
-#undef CHAR
diff --git a/src/test/confidence/arrayassignment/test.sh b/src/test/confidence/arrayassignment/test.sh
index 115040ef..c4fd00f5 100755
--- a/src/test/confidence/arrayassignment/test.sh
+++ b/src/test/confidence/arrayassignment/test.sh
@@ -1,5 +1,6 @@
#!/bin/sh
. ../testenv.sh
+rm -f aa # Remove LSW binary so it doesn't hide Cygwin binary.
$OBECOMP aa.mod -m
./aa >result
. ../testresult.sh
diff --git a/src/test/confidence/in/expected b/src/test/confidence/in/expected
new file mode 100644
index 00000000..df0db21e
--- /dev/null
+++ b/src/test/confidence/in/expected
@@ -0,0 +1,14 @@
+--- Testing with Oberon 2 variable model ---
+chars: Splurdle
+integer: 37
+string: "Bert"
+line: rest of line
+line: another line
+
+
+--- Testing with Component Pascal variable model ---
+chars: Splurdle
+integer: 37
+string: "Bert"
+line: rest of line
+line: another line
diff --git a/src/test/confidence/in/intest.mod b/src/test/confidence/in/intest.mod
new file mode 100644
index 00000000..cb8d2963
--- /dev/null
+++ b/src/test/confidence/in/intest.mod
@@ -0,0 +1,16 @@
+MODULE intest;
+IMPORT Out, In;
+
+VAR ch: CHAR; i: INTEGER; s: ARRAY 100 OF CHAR;
+
+BEGIN
+ In.Char(ch); Out.String("chars: ");
+ WHILE In.Done & (ch # ".") DO Out.Char(ch); In.Char(ch) END;
+ Out.Ln;
+ In.Int(i); IF In.Done THEN Out.String("integer: "); Out.Int(i,1); Out.Ln END;
+ In.String(s); IF In.Done THEN Out.String('string: "'); Out.String(s); Out.String('"'); Out.Ln END;
+ In.Line(s);
+ WHILE In.Done DO
+ Out.String("line: "); Out.String(s); Out.Ln; In.Line(s)
+ END
+END intest.
diff --git a/src/test/confidence/in/test.sh b/src/test/confidence/in/test.sh
new file mode 100644
index 00000000..ee738ab4
--- /dev/null
+++ b/src/test/confidence/in/test.sh
@@ -0,0 +1,16 @@
+#!/bin/sh
+. ../testenv.sh
+rm -f intest # Remove LSW binary so it doesn't hide Cygwin binary.
+echo 'Splurdle.25H "Bert"rest of line'>input
+echo another line>>input
+$OBECOMP intest.mod -m -O2
+./intest result-O2
+$OBECOMP intest.mod -m -OC
+./intest result-OC
+echo --- Testing with Oberon 2 variable model --- >result
+cat result-O2 >>result
+echo "" >>result
+echo "" >>result
+echo --- Testing with Component Pascal variable model --- >>result
+cat result-OC >>result
+. ../testresult.sh
diff --git a/src/test/confidence/intsyntax/expected b/src/test/confidence/intsyntax/expected
index 82813b89..1abe43f9 100644
--- a/src/test/confidence/intsyntax/expected
+++ b/src/test/confidence/intsyntax/expected
@@ -1,15 +1,15 @@
IntSyntax.mod compiling IntSyntax.
14: i := l; (* Bad, INTEGER shorter than LONGINT *)
- [32m^[0m
- pos 341[31m err [0m113 incompatible assignment
+ ^
+ pos 341 err 113 incompatible assignment
15: s := l; (* Bad, SHORTINT shorter than LONGINT *)
- [32m^[0m
- pos 393[31m err [0m113 incompatible assignment
+ ^
+ pos 393 err 113 incompatible assignment
16: i := l; (* Bad, SHORTINT shorter than INTEGER *)
- [32m^[0m
- pos 446[31m err [0m113 incompatible assignment
+ ^
+ pos 446 err 113 incompatible assignment
Module compilation failed.
diff --git a/src/test/confidence/intsyntax/test.sh b/src/test/confidence/intsyntax/test.sh
index 7699daea..3929cc8c 100644
--- a/src/test/confidence/intsyntax/test.sh
+++ b/src/test/confidence/intsyntax/test.sh
@@ -1,5 +1,5 @@
#!/bin/sh
. ../testenv.sh
# Generate mixed source and assembly code listing
-$OBECOMP IntSyntax.mod -m >result
+$OBECOMP IntSyntax.mod -fm >result
. ../testresult.sh
diff --git a/src/test/confidence/isptest/expected b/src/test/confidence/isptest/expected
new file mode 100644
index 00000000..b5af3090
--- /dev/null
+++ b/src/test/confidence/isptest/expected
@@ -0,0 +1,1176 @@
+--- Testing with Oberon 2 variable model ---
+pos=2 char=O
+pos=3 char=D
+pos=4 char=U
+pos=5 char=L
+pos=6 char=E
+pos=7 char=
+pos=8 char=i
+pos=9 char=s
+pos=10 char=p
+pos=11 char=t
+pos=12 char=e
+pos=13 char=s
+pos=14 char=t
+pos=15 char=;
+pos=16 char=
+pos=17 char=
+pos=18 char=I
+pos=19 char=M
+pos=20 char=P
+pos=21 char=O
+pos=22 char=R
+pos=23 char=T
+pos=24 char=
+pos=25 char=F
+pos=26 char=i
+pos=27 char=l
+pos=28 char=e
+pos=29 char=s
+pos=30 char=,
+pos=31 char=
+pos=32 char=T
+pos=33 char=e
+pos=34 char=x
+pos=35 char=t
+pos=36 char=s
+pos=37 char=,
+pos=38 char=
+pos=39 char=O
+pos=40 char=u
+pos=41 char=t
+pos=42 char=,
+pos=43 char=
+pos=44 char=P
+pos=45 char=l
+pos=46 char=a
+pos=47 char=t
+pos=48 char=f
+pos=49 char=o
+pos=50 char=r
+pos=51 char=m
+pos=52 char=;
+pos=53 char=
+pos=54 char=
+pos=55 char=C
+pos=56 char=O
+pos=57 char=N
+pos=58 char=S
+pos=59 char=T
+pos=60 char=
+pos=61 char=p
+pos=62 char=a
+pos=63 char=t
+pos=64 char=h
+pos=65 char==
+pos=66 char="
+pos=67 char=i
+pos=68 char=s
+pos=69 char=p
+pos=70 char=t
+pos=71 char=e
+pos=72 char=s
+pos=73 char=t
+pos=74 char=.
+pos=75 char=m
+pos=76 char=o
+pos=77 char=d
+pos=78 char="
+pos=79 char=;
+pos=80 char=
+pos=81 char=
+pos=82 char=V
+pos=83 char=A
+pos=84 char=R
+pos=85 char=
+pos=86 char=
+pos=87 char=
+pos=88 char=T
+pos=89 char=:
+pos=90 char=
+pos=91 char=T
+pos=92 char=e
+pos=93 char=x
+pos=94 char=t
+pos=95 char=s
+pos=96 char=.
+pos=97 char=T
+pos=98 char=e
+pos=99 char=x
+pos=100 char=t
+pos=101 char=;
+pos=102 char=
+pos=103 char=
+pos=104 char=
+pos=105 char=R
+pos=106 char=:
+pos=107 char=
+pos=108 char=T
+pos=109 char=e
+pos=110 char=x
+pos=111 char=t
+pos=112 char=s
+pos=113 char=.
+pos=114 char=R
+pos=115 char=e
+pos=116 char=a
+pos=117 char=d
+pos=118 char=e
+pos=119 char=r
+pos=120 char=;
+pos=121 char=
+pos=122 char=
+pos=123 char=
+pos=124 char=c
+pos=125 char=h
+pos=126 char=:
+pos=127 char=
+pos=128 char=C
+pos=129 char=H
+pos=130 char=A
+pos=131 char=R
+pos=132 char=;
+pos=133 char=
+pos=134 char=
+pos=135 char=
+pos=136 char=i
+pos=137 char=,
+pos=138 char=
+pos=139 char=j
+pos=140 char=,
+pos=141 char=
+pos=142 char=k
+pos=143 char=
+pos=144 char=:
+pos=145 char=
+pos=146 char=L
+pos=147 char=O
+pos=148 char=N
+pos=149 char=G
+pos=150 char=I
+pos=151 char=N
+pos=152 char=T
+pos=153 char=;
+pos=154 char=
+pos=155 char=B
+pos=156 char=E
+pos=157 char=G
+pos=158 char=I
+pos=159 char=N
+pos=160 char=
+pos=161 char=
+pos=162 char=
+pos=163 char=N
+pos=164 char=E
+pos=165 char=W
+pos=166 char=(
+pos=167 char=T
+pos=168 char=)
+pos=169 char=;
+pos=170 char=
+pos=171 char=
+pos=172 char=
+pos=173 char=I
+pos=174 char=F
+pos=175 char=
+pos=176 char=F
+pos=177 char=i
+pos=178 char=l
+pos=179 char=e
+pos=180 char=s
+pos=181 char=.
+pos=182 char=O
+pos=183 char=l
+pos=184 char=d
+pos=185 char=(
+pos=186 char=p
+pos=187 char=a
+pos=188 char=t
+pos=189 char=h
+pos=190 char=)
+pos=191 char=
+pos=192 char=#
+pos=193 char=
+pos=194 char=N
+pos=195 char=I
+pos=196 char=L
+pos=197 char=
+pos=198 char=T
+pos=199 char=H
+pos=200 char=E
+pos=201 char=N
+pos=202 char=
+pos=203 char=
+pos=204 char=
+pos=205 char=
+pos=206 char=
+pos=207 char=T
+pos=208 char=e
+pos=209 char=x
+pos=210 char=t
+pos=211 char=s
+pos=212 char=.
+pos=213 char=O
+pos=214 char=p
+pos=215 char=e
+pos=216 char=n
+pos=217 char=(
+pos=218 char=T
+pos=219 char=,
+pos=220 char=
+pos=221 char=p
+pos=222 char=a
+pos=223 char=t
+pos=224 char=h
+pos=225 char=)
+pos=226 char=;
+pos=227 char=
+pos=228 char=
+pos=229 char=
+pos=230 char=
+pos=231 char=
+pos=232 char=T
+pos=233 char=e
+pos=234 char=x
+pos=235 char=t
+pos=236 char=s
+pos=237 char=.
+pos=238 char=O
+pos=239 char=p
+pos=240 char=e
+pos=241 char=n
+pos=242 char=R
+pos=243 char=e
+pos=244 char=a
+pos=245 char=d
+pos=246 char=e
+pos=247 char=r
+pos=248 char=(
+pos=249 char=R
+pos=250 char=,
+pos=251 char=
+pos=252 char=T
+pos=253 char=,
+pos=254 char=
+pos=255 char=0
+pos=256 char=)
+pos=257 char=;
+pos=258 char=
+pos=259 char=T
+pos=260 char=e
+pos=261 char=x
+pos=262 char=t
+pos=263 char=s
+pos=264 char=.
+pos=265 char=R
+pos=266 char=e
+pos=267 char=a
+pos=268 char=d
+pos=269 char=(
+pos=270 char=R
+pos=271 char=,
+pos=272 char=
+pos=273 char=c
+pos=274 char=h
+pos=275 char=)
+pos=276 char=;
+pos=277 char=
+pos=278 char=
+pos=279 char=
+pos=280 char=
+pos=281 char=
+pos=282 char=W
+pos=283 char=H
+pos=284 char=I
+pos=285 char=L
+pos=286 char=E
+pos=287 char=
+pos=288 char=~
+pos=289 char=R
+pos=290 char=.
+pos=291 char=e
+pos=292 char=o
+pos=293 char=t
+pos=294 char=
+pos=295 char=D
+pos=296 char=O
+pos=297 char=
+pos=298 char=
+pos=299 char=
+pos=300 char=
+pos=301 char=
+pos=302 char=
+pos=303 char=
+pos=304 char=
+pos=305 char=T
+pos=306 char=e
+pos=307 char=x
+pos=308 char=t
+pos=309 char=s
+pos=310 char=.
+pos=311 char=R
+pos=312 char=e
+pos=313 char=a
+pos=314 char=d
+pos=315 char=(
+pos=316 char=R
+pos=317 char=,
+pos=318 char=
+pos=319 char=c
+pos=320 char=h
+pos=321 char=)
+pos=322 char=;
+pos=323 char=
+pos=324 char=
+pos=325 char=
+pos=326 char=
+pos=327 char=
+pos=328 char=
+pos=329 char=
+pos=330 char=
+pos=331 char=i
+pos=332 char=
+pos=333 char=:
+pos=334 char==
+pos=335 char=
+pos=336 char=T
+pos=337 char=e
+pos=338 char=x
+pos=339 char=t
+pos=340 char=s
+pos=341 char=.
+pos=342 char=P
+pos=343 char=o
+pos=344 char=s
+pos=345 char=(
+pos=346 char=R
+pos=347 char=)
+pos=348 char=;
+pos=349 char=
+pos=350 char=
+pos=351 char=
+pos=352 char=
+pos=353 char=
+pos=354 char=
+pos=355 char=
+pos=356 char=
+pos=357 char=O
+pos=358 char=u
+pos=359 char=t
+pos=360 char=.
+pos=361 char=S
+pos=362 char=t
+pos=363 char=r
+pos=364 char=i
+pos=365 char=n
+pos=366 char=g
+pos=367 char=(
+pos=368 char="
+pos=369 char=p
+pos=370 char=o
+pos=371 char=s
+pos=372 char==
+pos=373 char="
+pos=374 char=)
+pos=375 char=;
+pos=376 char=
+pos=377 char=O
+pos=378 char=u
+pos=379 char=t
+pos=380 char=.
+pos=381 char=I
+pos=382 char=n
+pos=383 char=t
+pos=384 char=(
+pos=385 char=i
+pos=386 char=,
+pos=387 char=0
+pos=388 char=)
+pos=389 char=;
+pos=390 char=
+pos=391 char=O
+pos=392 char=u
+pos=393 char=t
+pos=394 char=.
+pos=395 char=S
+pos=396 char=t
+pos=397 char=r
+pos=398 char=i
+pos=399 char=n
+pos=400 char=g
+pos=401 char=(
+pos=402 char="
+pos=403 char=
+pos=404 char=c
+pos=405 char=h
+pos=406 char=a
+pos=407 char=r
+pos=408 char==
+pos=409 char="
+pos=410 char=)
+pos=411 char=;
+pos=412 char=
+pos=413 char=O
+pos=414 char=u
+pos=415 char=t
+pos=416 char=.
+pos=417 char=C
+pos=418 char=h
+pos=419 char=a
+pos=420 char=r
+pos=421 char=(
+pos=422 char=c
+pos=423 char=h
+pos=424 char=)
+pos=425 char=;
+pos=426 char=
+pos=427 char=O
+pos=428 char=u
+pos=429 char=t
+pos=430 char=.
+pos=431 char=C
+pos=432 char=h
+pos=433 char=a
+pos=434 char=r
+pos=435 char=(
+pos=436 char=0
+pos=437 char=A
+pos=438 char=X
+pos=439 char=)
+pos=440 char=;
+pos=441 char=
+pos=442 char=
+pos=443 char=
+pos=444 char=
+pos=445 char=
+pos=446 char=
+pos=447 char=
+pos=448 char=
+pos=449 char=I
+pos=450 char=F
+pos=451 char=
+pos=452 char=i
+pos=453 char=
+pos=454 char==
+pos=455 char=
+pos=456 char=2
+pos=457 char=1
+pos=458 char=9
+pos=459 char=0
+pos=460 char=6
+pos=461 char=
+pos=462 char=T
+pos=463 char=H
+pos=464 char=E
+pos=465 char=N
+pos=466 char=
+pos=467 char=
+pos=468 char=
+pos=469 char=
+pos=470 char=
+pos=471 char=
+pos=472 char=
+pos=473 char=
+pos=474 char=
+pos=475 char=
+pos=476 char=O
+pos=477 char=u
+pos=478 char=t
+pos=479 char=.
+pos=480 char=S
+pos=481 char=t
+pos=482 char=r
+pos=483 char=i
+pos=484 char=n
+pos=485 char=g
+pos=486 char=(
+pos=487 char="
+pos=488 char=2
+pos=489 char=1
+pos=490 char=9
+pos=491 char=0
+pos=492 char=6
+pos=493 char="
+pos=494 char=)
+pos=495 char=;
+pos=496 char=
+pos=497 char=O
+pos=498 char=u
+pos=499 char=t
+pos=500 char=.
+pos=501 char=C
+pos=502 char=h
+pos=503 char=a
+pos=504 char=r
+pos=505 char=(
+pos=506 char=0
+pos=507 char=A
+pos=508 char=X
+pos=509 char=)
+pos=510 char=;
+pos=511 char=
+pos=512 char=
+pos=513 char=
+pos=514 char=
+pos=515 char=
+pos=516 char=
+pos=517 char=
+pos=518 char=
+pos=519 char=
+pos=520 char=
+pos=521 char=(
+pos=522 char=*
+pos=523 char=P
+pos=524 char=l
+pos=525 char=a
+pos=526 char=t
+pos=527 char=f
+pos=528 char=o
+pos=529 char=r
+pos=530 char=m
+pos=531 char=.
+pos=532 char=D
+pos=533 char=e
+pos=534 char=l
+pos=535 char=a
+pos=536 char=y
+pos=537 char=(
+pos=538 char=1
+pos=539 char=0
+pos=540 char=0
+pos=541 char=0
+pos=542 char=0
+pos=543 char=)
+pos=544 char=;
+pos=545 char=*
+pos=546 char=)
+pos=547 char=
+pos=548 char=
+pos=549 char=
+pos=550 char=
+pos=551 char=
+pos=552 char=
+pos=553 char=
+pos=554 char=
+pos=555 char=E
+pos=556 char=N
+pos=557 char=D
+pos=558 char=;
+pos=559 char=
+pos=560 char=
+pos=561 char=
+pos=562 char=
+pos=563 char=
+pos=564 char=E
+pos=565 char=N
+pos=566 char=D
+pos=567 char=;
+pos=568 char=
+pos=569 char=
+pos=570 char=
+pos=571 char=E
+pos=572 char=N
+pos=573 char=D
+pos=574 char=
+pos=575 char=E
+pos=576 char=N
+pos=577 char=D
+pos=578 char=
+pos=579 char=i
+pos=580 char=s
+pos=581 char=p
+pos=582 char=t
+pos=583 char=e
+pos=584 char=s
+pos=585 char=t
+pos=586 char=.
+pos=587 char=
+
+
+--- Testing with Component Pascal variable model ---
+pos=2 char=O
+pos=3 char=D
+pos=4 char=U
+pos=5 char=L
+pos=6 char=E
+pos=7 char=
+pos=8 char=i
+pos=9 char=s
+pos=10 char=p
+pos=11 char=t
+pos=12 char=e
+pos=13 char=s
+pos=14 char=t
+pos=15 char=;
+pos=16 char=
+pos=17 char=
+pos=18 char=I
+pos=19 char=M
+pos=20 char=P
+pos=21 char=O
+pos=22 char=R
+pos=23 char=T
+pos=24 char=
+pos=25 char=F
+pos=26 char=i
+pos=27 char=l
+pos=28 char=e
+pos=29 char=s
+pos=30 char=,
+pos=31 char=
+pos=32 char=T
+pos=33 char=e
+pos=34 char=x
+pos=35 char=t
+pos=36 char=s
+pos=37 char=,
+pos=38 char=
+pos=39 char=O
+pos=40 char=u
+pos=41 char=t
+pos=42 char=,
+pos=43 char=
+pos=44 char=P
+pos=45 char=l
+pos=46 char=a
+pos=47 char=t
+pos=48 char=f
+pos=49 char=o
+pos=50 char=r
+pos=51 char=m
+pos=52 char=;
+pos=53 char=
+pos=54 char=
+pos=55 char=C
+pos=56 char=O
+pos=57 char=N
+pos=58 char=S
+pos=59 char=T
+pos=60 char=
+pos=61 char=p
+pos=62 char=a
+pos=63 char=t
+pos=64 char=h
+pos=65 char==
+pos=66 char="
+pos=67 char=i
+pos=68 char=s
+pos=69 char=p
+pos=70 char=t
+pos=71 char=e
+pos=72 char=s
+pos=73 char=t
+pos=74 char=.
+pos=75 char=m
+pos=76 char=o
+pos=77 char=d
+pos=78 char="
+pos=79 char=;
+pos=80 char=
+pos=81 char=
+pos=82 char=V
+pos=83 char=A
+pos=84 char=R
+pos=85 char=
+pos=86 char=
+pos=87 char=
+pos=88 char=T
+pos=89 char=:
+pos=90 char=
+pos=91 char=T
+pos=92 char=e
+pos=93 char=x
+pos=94 char=t
+pos=95 char=s
+pos=96 char=.
+pos=97 char=T
+pos=98 char=e
+pos=99 char=x
+pos=100 char=t
+pos=101 char=;
+pos=102 char=
+pos=103 char=
+pos=104 char=
+pos=105 char=R
+pos=106 char=:
+pos=107 char=
+pos=108 char=T
+pos=109 char=e
+pos=110 char=x
+pos=111 char=t
+pos=112 char=s
+pos=113 char=.
+pos=114 char=R
+pos=115 char=e
+pos=116 char=a
+pos=117 char=d
+pos=118 char=e
+pos=119 char=r
+pos=120 char=;
+pos=121 char=
+pos=122 char=
+pos=123 char=
+pos=124 char=c
+pos=125 char=h
+pos=126 char=:
+pos=127 char=
+pos=128 char=C
+pos=129 char=H
+pos=130 char=A
+pos=131 char=R
+pos=132 char=;
+pos=133 char=
+pos=134 char=
+pos=135 char=
+pos=136 char=i
+pos=137 char=,
+pos=138 char=
+pos=139 char=j
+pos=140 char=,
+pos=141 char=
+pos=142 char=k
+pos=143 char=
+pos=144 char=:
+pos=145 char=
+pos=146 char=L
+pos=147 char=O
+pos=148 char=N
+pos=149 char=G
+pos=150 char=I
+pos=151 char=N
+pos=152 char=T
+pos=153 char=;
+pos=154 char=
+pos=155 char=B
+pos=156 char=E
+pos=157 char=G
+pos=158 char=I
+pos=159 char=N
+pos=160 char=
+pos=161 char=
+pos=162 char=
+pos=163 char=N
+pos=164 char=E
+pos=165 char=W
+pos=166 char=(
+pos=167 char=T
+pos=168 char=)
+pos=169 char=;
+pos=170 char=
+pos=171 char=
+pos=172 char=
+pos=173 char=I
+pos=174 char=F
+pos=175 char=
+pos=176 char=F
+pos=177 char=i
+pos=178 char=l
+pos=179 char=e
+pos=180 char=s
+pos=181 char=.
+pos=182 char=O
+pos=183 char=l
+pos=184 char=d
+pos=185 char=(
+pos=186 char=p
+pos=187 char=a
+pos=188 char=t
+pos=189 char=h
+pos=190 char=)
+pos=191 char=
+pos=192 char=#
+pos=193 char=
+pos=194 char=N
+pos=195 char=I
+pos=196 char=L
+pos=197 char=
+pos=198 char=T
+pos=199 char=H
+pos=200 char=E
+pos=201 char=N
+pos=202 char=
+pos=203 char=
+pos=204 char=
+pos=205 char=
+pos=206 char=
+pos=207 char=T
+pos=208 char=e
+pos=209 char=x
+pos=210 char=t
+pos=211 char=s
+pos=212 char=.
+pos=213 char=O
+pos=214 char=p
+pos=215 char=e
+pos=216 char=n
+pos=217 char=(
+pos=218 char=T
+pos=219 char=,
+pos=220 char=
+pos=221 char=p
+pos=222 char=a
+pos=223 char=t
+pos=224 char=h
+pos=225 char=)
+pos=226 char=;
+pos=227 char=
+pos=228 char=
+pos=229 char=
+pos=230 char=
+pos=231 char=
+pos=232 char=T
+pos=233 char=e
+pos=234 char=x
+pos=235 char=t
+pos=236 char=s
+pos=237 char=.
+pos=238 char=O
+pos=239 char=p
+pos=240 char=e
+pos=241 char=n
+pos=242 char=R
+pos=243 char=e
+pos=244 char=a
+pos=245 char=d
+pos=246 char=e
+pos=247 char=r
+pos=248 char=(
+pos=249 char=R
+pos=250 char=,
+pos=251 char=
+pos=252 char=T
+pos=253 char=,
+pos=254 char=
+pos=255 char=0
+pos=256 char=)
+pos=257 char=;
+pos=258 char=
+pos=259 char=T
+pos=260 char=e
+pos=261 char=x
+pos=262 char=t
+pos=263 char=s
+pos=264 char=.
+pos=265 char=R
+pos=266 char=e
+pos=267 char=a
+pos=268 char=d
+pos=269 char=(
+pos=270 char=R
+pos=271 char=,
+pos=272 char=
+pos=273 char=c
+pos=274 char=h
+pos=275 char=)
+pos=276 char=;
+pos=277 char=
+pos=278 char=
+pos=279 char=
+pos=280 char=
+pos=281 char=
+pos=282 char=W
+pos=283 char=H
+pos=284 char=I
+pos=285 char=L
+pos=286 char=E
+pos=287 char=
+pos=288 char=~
+pos=289 char=R
+pos=290 char=.
+pos=291 char=e
+pos=292 char=o
+pos=293 char=t
+pos=294 char=
+pos=295 char=D
+pos=296 char=O
+pos=297 char=
+pos=298 char=
+pos=299 char=
+pos=300 char=
+pos=301 char=
+pos=302 char=
+pos=303 char=
+pos=304 char=
+pos=305 char=T
+pos=306 char=e
+pos=307 char=x
+pos=308 char=t
+pos=309 char=s
+pos=310 char=.
+pos=311 char=R
+pos=312 char=e
+pos=313 char=a
+pos=314 char=d
+pos=315 char=(
+pos=316 char=R
+pos=317 char=,
+pos=318 char=
+pos=319 char=c
+pos=320 char=h
+pos=321 char=)
+pos=322 char=;
+pos=323 char=
+pos=324 char=
+pos=325 char=
+pos=326 char=
+pos=327 char=
+pos=328 char=
+pos=329 char=
+pos=330 char=
+pos=331 char=i
+pos=332 char=
+pos=333 char=:
+pos=334 char==
+pos=335 char=
+pos=336 char=T
+pos=337 char=e
+pos=338 char=x
+pos=339 char=t
+pos=340 char=s
+pos=341 char=.
+pos=342 char=P
+pos=343 char=o
+pos=344 char=s
+pos=345 char=(
+pos=346 char=R
+pos=347 char=)
+pos=348 char=;
+pos=349 char=
+pos=350 char=
+pos=351 char=
+pos=352 char=
+pos=353 char=
+pos=354 char=
+pos=355 char=
+pos=356 char=
+pos=357 char=O
+pos=358 char=u
+pos=359 char=t
+pos=360 char=.
+pos=361 char=S
+pos=362 char=t
+pos=363 char=r
+pos=364 char=i
+pos=365 char=n
+pos=366 char=g
+pos=367 char=(
+pos=368 char="
+pos=369 char=p
+pos=370 char=o
+pos=371 char=s
+pos=372 char==
+pos=373 char="
+pos=374 char=)
+pos=375 char=;
+pos=376 char=
+pos=377 char=O
+pos=378 char=u
+pos=379 char=t
+pos=380 char=.
+pos=381 char=I
+pos=382 char=n
+pos=383 char=t
+pos=384 char=(
+pos=385 char=i
+pos=386 char=,
+pos=387 char=0
+pos=388 char=)
+pos=389 char=;
+pos=390 char=
+pos=391 char=O
+pos=392 char=u
+pos=393 char=t
+pos=394 char=.
+pos=395 char=S
+pos=396 char=t
+pos=397 char=r
+pos=398 char=i
+pos=399 char=n
+pos=400 char=g
+pos=401 char=(
+pos=402 char="
+pos=403 char=
+pos=404 char=c
+pos=405 char=h
+pos=406 char=a
+pos=407 char=r
+pos=408 char==
+pos=409 char="
+pos=410 char=)
+pos=411 char=;
+pos=412 char=
+pos=413 char=O
+pos=414 char=u
+pos=415 char=t
+pos=416 char=.
+pos=417 char=C
+pos=418 char=h
+pos=419 char=a
+pos=420 char=r
+pos=421 char=(
+pos=422 char=c
+pos=423 char=h
+pos=424 char=)
+pos=425 char=;
+pos=426 char=
+pos=427 char=O
+pos=428 char=u
+pos=429 char=t
+pos=430 char=.
+pos=431 char=C
+pos=432 char=h
+pos=433 char=a
+pos=434 char=r
+pos=435 char=(
+pos=436 char=0
+pos=437 char=A
+pos=438 char=X
+pos=439 char=)
+pos=440 char=;
+pos=441 char=
+pos=442 char=
+pos=443 char=
+pos=444 char=
+pos=445 char=
+pos=446 char=
+pos=447 char=
+pos=448 char=
+pos=449 char=I
+pos=450 char=F
+pos=451 char=
+pos=452 char=i
+pos=453 char=
+pos=454 char==
+pos=455 char=
+pos=456 char=2
+pos=457 char=1
+pos=458 char=9
+pos=459 char=0
+pos=460 char=6
+pos=461 char=
+pos=462 char=T
+pos=463 char=H
+pos=464 char=E
+pos=465 char=N
+pos=466 char=
+pos=467 char=
+pos=468 char=
+pos=469 char=
+pos=470 char=
+pos=471 char=
+pos=472 char=
+pos=473 char=
+pos=474 char=
+pos=475 char=
+pos=476 char=O
+pos=477 char=u
+pos=478 char=t
+pos=479 char=.
+pos=480 char=S
+pos=481 char=t
+pos=482 char=r
+pos=483 char=i
+pos=484 char=n
+pos=485 char=g
+pos=486 char=(
+pos=487 char="
+pos=488 char=2
+pos=489 char=1
+pos=490 char=9
+pos=491 char=0
+pos=492 char=6
+pos=493 char="
+pos=494 char=)
+pos=495 char=;
+pos=496 char=
+pos=497 char=O
+pos=498 char=u
+pos=499 char=t
+pos=500 char=.
+pos=501 char=C
+pos=502 char=h
+pos=503 char=a
+pos=504 char=r
+pos=505 char=(
+pos=506 char=0
+pos=507 char=A
+pos=508 char=X
+pos=509 char=)
+pos=510 char=;
+pos=511 char=
+pos=512 char=
+pos=513 char=
+pos=514 char=
+pos=515 char=
+pos=516 char=
+pos=517 char=
+pos=518 char=
+pos=519 char=
+pos=520 char=
+pos=521 char=(
+pos=522 char=*
+pos=523 char=P
+pos=524 char=l
+pos=525 char=a
+pos=526 char=t
+pos=527 char=f
+pos=528 char=o
+pos=529 char=r
+pos=530 char=m
+pos=531 char=.
+pos=532 char=D
+pos=533 char=e
+pos=534 char=l
+pos=535 char=a
+pos=536 char=y
+pos=537 char=(
+pos=538 char=1
+pos=539 char=0
+pos=540 char=0
+pos=541 char=0
+pos=542 char=0
+pos=543 char=)
+pos=544 char=;
+pos=545 char=*
+pos=546 char=)
+pos=547 char=
+pos=548 char=
+pos=549 char=
+pos=550 char=
+pos=551 char=
+pos=552 char=
+pos=553 char=
+pos=554 char=
+pos=555 char=E
+pos=556 char=N
+pos=557 char=D
+pos=558 char=;
+pos=559 char=
+pos=560 char=
+pos=561 char=
+pos=562 char=
+pos=563 char=
+pos=564 char=E
+pos=565 char=N
+pos=566 char=D
+pos=567 char=;
+pos=568 char=
+pos=569 char=
+pos=570 char=
+pos=571 char=E
+pos=572 char=N
+pos=573 char=D
+pos=574 char=
+pos=575 char=E
+pos=576 char=N
+pos=577 char=D
+pos=578 char=
+pos=579 char=i
+pos=580 char=s
+pos=581 char=p
+pos=582 char=t
+pos=583 char=e
+pos=584 char=s
+pos=585 char=t
+pos=586 char=.
+pos=587 char=
diff --git a/src/test/confidence/isptest/isptest.mod b/src/test/confidence/isptest/isptest.mod
new file mode 100644
index 00000000..86fb0fb9
--- /dev/null
+++ b/src/test/confidence/isptest/isptest.mod
@@ -0,0 +1,27 @@
+MODULE isptest;
+
+IMPORT Files, Texts, Out, Platform;
+
+CONST path="isptest.mod";
+
+VAR
+ T: Texts.Text;
+ R: Texts.Reader;
+ ch: CHAR;
+ i, j, k : LONGINT;
+BEGIN
+ NEW(T);
+ IF Files.Old(path) # NIL THEN
+ Texts.Open(T, path);
+ Texts.OpenReader(R, T, 0); Texts.Read(R, ch);
+ WHILE ~R.eot DO
+ Texts.Read(R, ch);
+ i := Texts.Pos(R);
+ Out.String("pos="); Out.Int(i,0); Out.String(" char="); Out.Char(ch); Out.Char(0AX);
+ IF i = 21906 THEN
+ Out.String("21906"); Out.Char(0AX);
+ (*Platform.Delay(10000);*)
+ END;
+ END;
+ END
+END isptest.
\ No newline at end of file
diff --git a/src/test/confidence/isptest/test.sh b/src/test/confidence/isptest/test.sh
new file mode 100644
index 00000000..49e2dfdd
--- /dev/null
+++ b/src/test/confidence/isptest/test.sh
@@ -0,0 +1,13 @@
+#!/bin/sh
+. ../testenv.sh
+$OBECOMP isptest.mod -m -O2
+./isptest >result-O2
+$OBECOMP isptest.mod -m -OC
+./isptest >result-OC
+echo --- Testing with Oberon 2 variable model --- >result
+cat result-O2 >>result
+echo "" >>result
+echo "" >>result
+echo --- Testing with Component Pascal variable model --- >>result
+cat result-OC >>result
+. ../testresult.sh
diff --git a/src/test/confidence/language/TestLanguage.mod b/src/test/confidence/language/TestLanguage.mod
index d3653c0b..7399b006 100644
--- a/src/test/confidence/language/TestLanguage.mod
+++ b/src/test/confidence/language/TestLanguage.mod
@@ -2,8 +2,22 @@ MODULE TestLanguage;
IMPORT SYSTEM, Console;
+ VAR gz: LONGREAL;
+
+PROCEDURE TestShiftResult(of, by, actual, expected: LONGINT; msg: ARRAY OF CHAR);
+BEGIN
+ IF actual # expected THEN
+ Console.String(msg);
+ Console.String(" of $"); Console.Hex(of);
+ Console.String(" by "); Console.Int(by,1);
+ Console.String(" is $"); Console.Hex(actual);
+ Console.String(" but should be $"); Console.Hex(expected);
+ Console.Ln;
+ END
+END TestShiftResult;
+
PROCEDURE Shift;
-VAR c: CHAR; b: SYSTEM.BYTE; s,t,u: SHORTINT; h,i,j,k: INTEGER; l,m,n: LONGINT;
+VAR c: CHAR; b: SYSTEM.BYTE; s,t,u: SHORTINT; h,i,j,k: INTEGER; l,m,n,r: LONGINT;
(*
Aritmetic shift always returns type LONGINT. Defined as x * 2**n.
LSH and ROT produces results of the same type as the value being shifted.
@@ -13,8 +27,8 @@ BEGIN
i := 0; m := 1;
WHILE i < SIZE(LONGINT)*8 DO
- l := 1; l := SYSTEM.LSH(l,i); ASSERT(l = m, 16);
- l := 1; l := SYSTEM.ROT(l,i); ASSERT(l = m, 17);
+ l := 1; r := SYSTEM.LSH(l,i); TestShiftResult(l, i, r, m, "LSH");
+ l := 1; r := SYSTEM.ROT(l,i); TestShiftResult(l, i, r, m, "ROT(1)");
m := m * 2; INC(i);
END;
@@ -84,9 +98,55 @@ BEGIN
END;
+ (* Positive LSH shifts and ROTs with overflow *)
+
+ i := 1; m := 1;
+ WHILE i < SIZE(LONGINT)*8 DO
+ l := MAX(LONGINT); INC(l); r := SYSTEM.LSH(l,i); TestShiftResult(l, i, r, 0, "LSH");
+ l := MAX(LONGINT); INC(l); r := SYSTEM.ROT(l,i); TestShiftResult(l, i, r, m, "ROT(2)");
+ m := m * 2; INC(i);
+ END;
+
+ i := 1; k := 1;
+ WHILE i < SIZE(INTEGER)*8 DO
+ j := MAX(INTEGER); INC(j); r := SYSTEM.LSH(j,i); TestShiftResult(j, i, r, 0, "LSH");
+ j := MAX(INTEGER); INC(j); r := SYSTEM.ROT(j,i); TestShiftResult(j, i, r, k, "ROT(3)");
+ k := k * 2; INC(i);
+ END;
+
+ i := 1; t := 1;
+ WHILE i < SIZE(SHORTINT)*8 DO
+ s := MAX(SHORTINT); INC(s); r := SYSTEM.LSH(s,i); TestShiftResult(s, i, r, 0, "LSH");
+ s := MAX(SHORTINT); INC(s); r := SYSTEM.ROT(s,i); TestShiftResult(s, i, r, t, "ROT(4)");
+ t := t * 2; INC(i);
+ END;
+
+ (* Negative LSH shifts and ROTs without overflow *)
+
+ i := -1; m := MAX(LONGINT); INC(m);
+ WHILE i > -SIZE(LONGINT)*8 DO
+ l := 1; r := SYSTEM.LSH(l,i); TestShiftResult(l, i, r, 0, "LSH");
+ l := 1; r := SYSTEM.ROT(l,i); TestShiftResult(l, i, r, m, "ROT");
+ m := SYSTEM.LSH(m,-1); (* m := m DIV 2; *)
+ DEC(i);
+ END;
+
+ i := -1; k := MAX(INTEGER); INC(k);
+ WHILE i > -SIZE(INTEGER)*8 DO
+ j := 1; r := SYSTEM.LSH(j,i); TestShiftResult(j, i, r, 0, "LSH");
+ j := 1; r := SYSTEM.ROT(j,i); TestShiftResult(j, i, r, k, "ROT");
+ k := SYSTEM.LSH(k,-1); (* k := k DIV 2; *)
+ DEC(i);
+ END;
+
+ i := -1; t := MAX(SHORTINT); INC(t);
+ WHILE i > -SIZE(SHORTINT)*8 DO
+ s := 1; r := SYSTEM.LSH(s,i); TestShiftResult(s, i, r, 0, "LSH");
+ s := 1; r := SYSTEM.ROT(s,i); TestShiftResult(s, i, r, t, "ROT");
+ t := SYSTEM.LSH(t,-1); (* t := t DIV 2; *)
+ DEC(i);
+ END;
- (* Also need tests that bits that are shifted / rotated off the end
- are zeroed or wrapped correctly. *)
(* Also need full tests for CHAR, and poossibly SYSTEM.BYTE. Here's a simple one *)
@@ -108,6 +168,97 @@ BEGIN
END
END TestValue;
+
+PROCEDURE side(i: INTEGER): INTEGER; BEGIN RETURN i END side;
+
+PROCEDURE DivMod;
+ VAR i,j: INTEGER;
+BEGIN
+ j := 2;
+ i := 4; TestValue(i DIV j, 2, "4 DIV 2"); TestValue(side(i) DIV side(j), 2, "side(4) DIV side(2)");
+ i := 5; TestValue(i DIV j, 2, "5 DIV 2"); TestValue(side(i) DIV side(j), 2, "side(5) DIV side(2)");
+ i := 6; TestValue(i DIV j, 3, "6 DIV 2"); TestValue(side(i) DIV side(j), 3, "side(6) DIV side(2)");
+ i := 7; TestValue(i DIV j, 3, "7 DIV 2"); TestValue(side(i) DIV side(j), 3, "side(7) DIV side(2)");
+ i := -4; TestValue(i DIV j, -2, "(-4) DIV 2"); TestValue(side(i) DIV side(j), -2, "side(-4) DIV side(2)");
+ i := -5; TestValue(i DIV j, -3, "(-5) DIV 2"); TestValue(side(i) DIV side(j), -3, "side(-5) DIV side(2)");
+ i := -6; TestValue(i DIV j, -3, "(-6) DIV 2"); TestValue(side(i) DIV side(j), -3, "side(-6) DIV side(2)");
+ i := -7; TestValue(i DIV j, -4, "(-7) DIV 2"); TestValue(side(i) DIV side(j), -4, "side(-7) DIV side(2)");
+
+ j := -2;
+ i := 4; TestValue(i DIV j, -2, "4 DIV (-2)"); TestValue(side(i) DIV side(j), -2, "side(4) DIV side(-2)");
+ i := 5; TestValue(i DIV j, -3, "5 DIV (-2)"); TestValue(side(i) DIV side(j), -3, "side(5) DIV side(-2)");
+ i := 6; TestValue(i DIV j, -3, "6 DIV (-2)"); TestValue(side(i) DIV side(j), -3, "side(6) DIV side(-2)");
+ i := 7; TestValue(i DIV j, -4, "7 DIV (-2)"); TestValue(side(i) DIV side(j), -4, "side(7) DIV side(-2)");
+ i := -4; TestValue(i DIV j, 2, "(-4) DIV (-2)"); TestValue(side(i) DIV side(j), 2, "side(-4) DIV side(-2)");
+ i := -5; TestValue(i DIV j, 2, "(-5) DIV (-2)"); TestValue(side(i) DIV side(j), 2, "side(-5) DIV side(-2)");
+ i := -6; TestValue(i DIV j, 3, "(-6) DIV (-2)"); TestValue(side(i) DIV side(j), 3, "side(-6) DIV side(-2)");
+ i := -7; TestValue(i DIV j, 3, "(-7) DIV (-2)"); TestValue(side(i) DIV side(j), 3, "side(-7) DIV side(-2)");
+
+ (* x = (x DIV y) * y + (x MOD y)
+ => x MOd y = x - ((x DIV y) * y)
+ *)
+
+ i := 4; j := 3; TestValue(i MOD j, i - ((i DIV j) * j), "4 MOD 3");
+ i := 5; j := 3; TestValue(i MOD j, i - ((i DIV j) * j), "5 MOD 3");
+ i := 6; j := 3; TestValue(i MOD j, i - ((i DIV j) * j), "6 MOD 3");
+ i := 7; j := 3; TestValue(i MOD j, i - ((i DIV j) * j), "7 MOD 3");
+
+ i := -4; j := 3; TestValue(i MOD j, i - ((i DIV j) * j), "-4 MOD 3");
+ i := -5; j := 3; TestValue(i MOD j, i - ((i DIV j) * j), "-5 MOD 3");
+ i := -6; j := 3; TestValue(i MOD j, i - ((i DIV j) * j), "-6 MOD 3");
+ i := -7; j := 3; TestValue(i MOD j, i - ((i DIV j) * j), "-7 MOD 3");
+
+ i := 4; j := -3; TestValue(i MOD j, i - ((i DIV j) * j), "4 MOD -3");
+ i := 5; j := -3; TestValue(i MOD j, i - ((i DIV j) * j), "5 MOD -3");
+ i := 6; j := -3; TestValue(i MOD j, i - ((i DIV j) * j), "6 MOD -3");
+ i := 7; j := -3; TestValue(i MOD j, i - ((i DIV j) * j), "7 MOD -3");
+
+ i := -4; j := -3; TestValue(i MOD j, i - ((i DIV j) * j), "-4 MOD -3");
+ i := -5; j := -3; TestValue(i MOD j, i - ((i DIV j) * j), "-5 MOD -3");
+ i := -6; j := -3; TestValue(i MOD j, i - ((i DIV j) * j), "-6 MOD -3");
+ i := -7; j := -3; TestValue(i MOD j, i - ((i DIV j) * j), "-7 MOD -3");
+END DivMod;
+
+
+
+
+PROCEDURE Abs;
+ VAR
+ i: INTEGER;
+ l: LONGINT;
+ h: SYSTEM.INT64;
+BEGIN
+ i := 5; TestValue(ABS(i), 5, "ABS(INTEGER 5)");
+ i := -5; TestValue(ABS(i), 5, "ABS(INTEGER -5)");
+ l := 5; TestValue(ABS(l), 5, "ABS(LONGINT 5)");
+ l := -5; TestValue(ABS(l), 5, "ABS(LONGINT -5)");
+ h := 5; TestValue(SYSTEM.VAL(LONGINT,ABS(h)), 5, "ABS(SYSTEM.INT64 5)");
+ h := -5; TestValue(SYSTEM.VAL(LONGINT,ABS(h)), 5, "ABS(SYSTEM.INT64 -5)");
+END Abs;
+
+
+
+(* LR does nothing numerically, but is enough to stop the C compiler
+ optimizing away the LR assignment and ENTIER implementation. *)
+PROCEDURE LR(lr: LONGREAL): LONGREAL; BEGIN RETURN lr + gz; END LR;
+
+PROCEDURE Entier;
+ VAR lr: LONGREAL;
+BEGIN
+ gz := 0.0;
+ lr := LR(-0.01); TestValue(ENTIER(lr), -1, "ENTIER(-0.01");
+ lr := LR( 0.00); TestValue(ENTIER(lr), 0, "ENTIER(0.00");
+ lr := LR( 5.00); TestValue(ENTIER(lr), 5, "ENTIER(5.00");
+ lr := LR( 5.50); TestValue(ENTIER(lr), 5, "ENTIER(5.50");
+ lr := LR( 5.99); TestValue(ENTIER(lr), 5, "ENTIER(5.99");
+ lr := LR(-5.00); TestValue(ENTIER(lr), -5, "ENTIER(-5.00");
+ lr := LR(-5.50); TestValue(ENTIER(lr), -6, "ENTIER(-5.50");
+ lr := LR(-5.99); TestValue(ENTIER(lr), -6, "ENTIER(-5.99");
+END Entier;
+
+
+
+
PROCEDURE IntSize;
VAR l: LONGINT;
BEGIN
@@ -134,8 +285,14 @@ BEGIN
END;
END IntSize;
+
+
+
BEGIN
Shift;
+ DivMod;
IntSize;
+ Abs;
+ Entier;
Console.String("Language tests successful."); Console.Ln;
END TestLanguage.
diff --git a/src/test/confidence/language/test.sh b/src/test/confidence/language/test.sh
index 82f3efbf..27b9f951 100755
--- a/src/test/confidence/language/test.sh
+++ b/src/test/confidence/language/test.sh
@@ -1,6 +1,7 @@
#!/bin/sh
. ../testenv.sh
# Generate mixed source and assembly code listing
+rm -f TestLanguage # Remove LSW binary so it doesn't hide Cygwin binary.
$OBECOMP TestLanguage.mod -m
./TestLanguage >result
. ../testresult.sh
diff --git a/src/test/confidence/library/test.sh b/src/test/confidence/library/test.sh
index e59c074c..91780313 100644
--- a/src/test/confidence/library/test.sh
+++ b/src/test/confidence/library/test.sh
@@ -1,6 +1,7 @@
#!/bin/sh
. ../testenv.sh
# Generate mixed source and assembly code listing
+rm -f TestLibrary # Remove LSW binary so it doesn't hide Cygwin binary.
$OBECOMP TestLibrary.mod -m
./TestLibrary >result
. ../testresult.sh
diff --git a/src/test/confidence/math/expected b/src/test/confidence/math/expected
new file mode 100644
index 00000000..fb01dc20
--- /dev/null
+++ b/src/test/confidence/math/expected
@@ -0,0 +1,328 @@
+Math and MathL module tests.
+
+Math.fraction(9.00000E-01): 1.80000E+00. MathL.fraction(9.00000000000000D-001): 1.80000000000000D+000
+Math.fraction(1.00000E+00): 1.00000E+00. MathL.fraction(1.00000000000000D+000): 1.00000000000000D+000
+Math.fraction(1.40000E+00): 1.40000E+00. MathL.fraction(1.40000000000000D+000): 1.40000000000000D+000
+Math.fraction(1.50000E+00): 1.50000E+00. MathL.fraction(1.50000000000000D+000): 1.50000000000000D+000
+Math.fraction(1.60000E+00): 1.60000E+00. MathL.fraction(1.60000000000000D+000): 1.60000000000000D+000
+Math.fraction(1.90000E+00): 1.90000E+00. MathL.fraction(1.90000000000000D+000): 1.90000000000000D+000
+Math.fraction(2.00000E+00): 1.00000E+00. MathL.fraction(2.00000000000000D+000): 1.00000000000000D+000
+Math.fraction(2.40000E+00): 1.20000E+00. MathL.fraction(2.40000000000000D+000): 1.20000000000000D+000
+Math.fraction(2.50000E+00): 1.25000E+00. MathL.fraction(2.50000000000000D+000): 1.25000000000000D+000
+Math.fraction(3.00000E+00): 1.50000E+00. MathL.fraction(3.00000000000000D+000): 1.50000000000000D+000
+Math.fraction(4.00000E+00): 1.00000E+00. MathL.fraction(4.00000000000000D+000): 1.00000000000000D+000
+Math.fraction(-9.0000E-01): -1.8000E+00. MathL.fraction(-9.0000000000000D-001): -1.8000000000000D+000
+Math.fraction(-1.0000E+00): -1.0000E+00. MathL.fraction(-1.0000000000000D+000): -1.0000000000000D+000
+Math.fraction(-1.4000E+00): -1.4000E+00. MathL.fraction(-1.4000000000000D+000): -1.4000000000000D+000
+Math.fraction(-1.5000E+00): -1.5000E+00. MathL.fraction(-1.5000000000000D+000): -1.5000000000000D+000
+Math.fraction(-1.6000E+00): -1.6000E+00. MathL.fraction(-1.6000000000000D+000): -1.6000000000000D+000
+Math.fraction(-1.9000E+00): -1.9000E+00. MathL.fraction(-1.9000000000000D+000): -1.9000000000000D+000
+Math.fraction(-2.0000E+00): -1.0000E+00. MathL.fraction(-2.0000000000000D+000): -1.0000000000000D+000
+Math.fraction(-2.4000E+00): -1.2000E+00. MathL.fraction(-2.4000000000000D+000): -1.2000000000000D+000
+Math.fraction(-2.5000E+00): -1.2500E+00. MathL.fraction(-2.5000000000000D+000): -1.2500000000000D+000
+Math.fraction(-3.0000E+00): -1.5000E+00. MathL.fraction(-3.0000000000000D+000): -1.5000000000000D+000
+Math.fraction(-4.0000E+00): -1.0000E+00. MathL.fraction(-4.0000000000000D+000): -1.0000000000000D+000
+
+Math.round(9.00000E-01): 1. MathL.round(9.00000000000000D-001): 1
+Math.round(1.00000E+00): 1. MathL.round(1.00000000000000D+000): 1
+Math.round(1.40000E+00): 1. MathL.round(1.40000000000000D+000): 1
+Math.round(1.50000E+00): 2. MathL.round(1.50000000000000D+000): 2
+Math.round(1.60000E+00): 2. MathL.round(1.60000000000000D+000): 2
+Math.round(1.90000E+00): 2. MathL.round(1.90000000000000D+000): 2
+Math.round(2.00000E+00): 2. MathL.round(2.00000000000000D+000): 2
+Math.round(2.40000E+00): 2. MathL.round(2.40000000000000D+000): 2
+Math.round(2.50000E+00): 3. MathL.round(2.50000000000000D+000): 3
+Math.round(3.00000E+00): 3. MathL.round(3.00000000000000D+000): 3
+Math.round(4.00000E+00): 4. MathL.round(4.00000000000000D+000): 4
+Math.round(-9.0000E-01): -1. MathL.round(-9.0000000000000D-001): -1
+Math.round(-1.0000E+00): -1. MathL.round(-1.0000000000000D+000): -1
+Math.round(-1.4000E+00): -1. MathL.round(-1.4000000000000D+000): -1
+Math.round(-1.5000E+00): -2. MathL.round(-1.5000000000000D+000): -2
+Math.round(-1.6000E+00): -2. MathL.round(-1.6000000000000D+000): -2
+Math.round(-1.9000E+00): -2. MathL.round(-1.9000000000000D+000): -2
+Math.round(-2.0000E+00): -2. MathL.round(-2.0000000000000D+000): -2
+Math.round(-2.4000E+00): -2. MathL.round(-2.4000000000000D+000): -2
+Math.round(-2.5000E+00): -3. MathL.round(-2.5000000000000D+000): -3
+Math.round(-3.0000E+00): -3. MathL.round(-3.0000000000000D+000): -3
+Math.round(-4.0000E+00): -4. MathL.round(-4.0000000000000D+000): -4
+
+Math.sqrt(9.00000E-01): 9.48683E-01. MathL.sqrt(9.00000000000000D-001): 9.48683298050514D-001
+Math.sqrt(1.00000E+00): 1.00000E-01. MathL.sqrt(1.00000000000000D+000): 1.00000000000000D+000
+Math.sqrt(1.40000E+00): 1.18322E+00. MathL.sqrt(1.40000000000000D+000): 1.18321595661992D+000
+Math.sqrt(1.50000E+00): 1.22474E+00. MathL.sqrt(1.50000000000000D+000): 1.22474487139159D+000
+Math.sqrt(1.60000E+00): 1.26491E+00. MathL.sqrt(1.60000000000000D+000): 1.26491106406735D+000
+Math.sqrt(1.90000E+00): 1.37840E+00. MathL.sqrt(1.90000000000000D+000): 1.37840487520902D+000
+Math.sqrt(2.00000E+00): 1.41421E+00. MathL.sqrt(2.00000000000000D+000): 1.41421356237310D+000
+Math.sqrt(2.40000E+00): 1.54919E+00. MathL.sqrt(2.40000000000000D+000): 1.54919333848297D+000
+Math.sqrt(2.50000E+00): 1.58114E+00. MathL.sqrt(2.50000000000000D+000): 1.58113883008419D+000
+Math.sqrt(3.00000E+00): 1.73205E+00. MathL.sqrt(3.00000000000000D+000): 1.73205080756888D+000
+Math.sqrt(4.00000E+00): 2.00000E+00. MathL.sqrt(4.00000000000000D+000): 2.00000000000000D+000
+Math.sqrt(-9.0000E-01): 9.48683E-01. MathL.sqrt(-9.0000000000000D-001): 9.48683298050514D-001
+Math.sqrt(-1.0000E+00): 1.00000E-01. MathL.sqrt(-1.0000000000000D+000): 1.00000000000000D+000
+Math.sqrt(-1.4000E+00): 1.18322E+00. MathL.sqrt(-1.4000000000000D+000): 1.18321595661992D+000
+Math.sqrt(-1.5000E+00): 1.22474E+00. MathL.sqrt(-1.5000000000000D+000): 1.22474487139159D+000
+Math.sqrt(-1.6000E+00): 1.26491E+00. MathL.sqrt(-1.6000000000000D+000): 1.26491106406735D+000
+Math.sqrt(-1.9000E+00): 1.37840E+00. MathL.sqrt(-1.9000000000000D+000): 1.37840487520902D+000
+Math.sqrt(-2.0000E+00): 1.41421E+00. MathL.sqrt(-2.0000000000000D+000): 1.41421356237310D+000
+Math.sqrt(-2.4000E+00): 1.54919E+00. MathL.sqrt(-2.4000000000000D+000): 1.54919333848297D+000
+Math.sqrt(-2.5000E+00): 1.58114E+00. MathL.sqrt(-2.5000000000000D+000): 1.58113883008419D+000
+Math.sqrt(-3.0000E+00): 1.73205E+00. MathL.sqrt(-3.0000000000000D+000): 1.73205080756888D+000
+Math.sqrt(-4.0000E+00): 2.00000E+00. MathL.sqrt(-4.0000000000000D+000): 2.00000000000000D+000
+
+Math.ln(9.00000E-01): -1.05361E-01. MathL.ln(9.00000000000000D-001): -1.05360515657826D-001
+Math.ln(1.00000E+00): 0.00000E+00. MathL.ln(1.00000000000000D+000): 0.00000000000000D+000
+Math.ln(1.40000E+00): 3.36472E-01. MathL.ln(1.40000000000000D+000): 3.36472236621213D-001
+Math.ln(1.50000E+00): 4.05465E-01. MathL.ln(1.50000000000000D+000): 4.05465108108164D-001
+Math.ln(1.60000E+00): 4.70004E-01. MathL.ln(1.60000000000000D+000): 4.70003629245736D-001
+Math.ln(1.90000E+00): 6.41854E-01. MathL.ln(1.90000000000000D+000): 6.41853886172395D-001
+Math.ln(2.00000E+00): 6.93147E-01. MathL.ln(2.00000000000000D+000): 6.93147180559945D-001
+Math.ln(2.40000E+00): 8.75469E-01. MathL.ln(2.40000000000000D+000): 8.75468737353900D-001
+Math.ln(2.50000E+00): 9.16291E-01. MathL.ln(2.50000000000000D+000): 9.16290731874155D-001
+Math.ln(3.00000E+00): 1.09861E+00. MathL.ln(3.00000000000000D+000): 1.09861228866811D+000
+Math.ln(4.00000E+00): 1.38629E+00. MathL.ln(4.00000000000000D+000): 1.38629436111989D+000
+Math.ln(-9.0000E-01): -3.40282E+38. MathL.ln(-9.0000000000000D-001): -1.79769296342094D+308
+Math.ln(-1.0000E+00): -3.40282E+38. MathL.ln(-1.0000000000000D+000): -1.79769296342094D+308
+Math.ln(-1.4000E+00): -3.40282E+38. MathL.ln(-1.4000000000000D+000): -1.79769296342094D+308
+Math.ln(-1.5000E+00): -3.40282E+38. MathL.ln(-1.5000000000000D+000): -1.79769296342094D+308
+Math.ln(-1.6000E+00): -3.40282E+38. MathL.ln(-1.6000000000000D+000): -1.79769296342094D+308
+Math.ln(-1.9000E+00): -3.40282E+38. MathL.ln(-1.9000000000000D+000): -1.79769296342094D+308
+Math.ln(-2.0000E+00): -3.40282E+38. MathL.ln(-2.0000000000000D+000): -1.79769296342094D+308
+Math.ln(-2.4000E+00): -3.40282E+38. MathL.ln(-2.4000000000000D+000): -1.79769296342094D+308
+Math.ln(-2.5000E+00): -3.40282E+38. MathL.ln(-2.5000000000000D+000): -1.79769296342094D+308
+Math.ln(-3.0000E+00): -3.40282E+38. MathL.ln(-3.0000000000000D+000): -1.79769296342094D+308
+Math.ln(-4.0000E+00): -3.40282E+38. MathL.ln(-4.0000000000000D+000): -1.79769296342094D+308
+
+Math.sin(0.00000E+00): 0.00000E+00. MathL.sin(0.00000000000000D+000): 0.00000000000000D+000
+Math.sin(1.00000E-01): 9.98334E-02. MathL.sin(1.00000000000000D-001): 9.98334166468282D-002
+Math.sin(1.04720E+00): 8.66025E-01. MathL.sin(1.04719755119660D+000): 8.66025403784440D-001
+Math.sin(1.57080E+00): 1.00000E+00. MathL.sin(1.57079632679490D+000): 9.99999999999999D-001
+Math.sin(3.14159E+00): -3.10862E-15. MathL.sin(3.14159265358979D+000): 3.23108679839857D-015
+Math.sin(-1.0472E+00): -8.66025E-01. MathL.sin(-1.0471975511966D+000): -8.6602540378444D-001
+Math.sin(-1.5708E+00): -1.0000E+00. MathL.sin(-1.5707963267949D+000): -9.99999999999999D-001
+Math.sin(-3.14159E+00): 3.10862E-15. MathL.sin(-3.14159265358979D+000): -3.23108679839857D-015
+
+Math.cos(0.00000E+00): 1.00000E+00. MathL.cos(0.00000000000000D+000): 9.99999999999999D-001
+Math.cos(1.00000E-01): 9.95004E-01. MathL.cos(1.00000000000000D-001): 9.95004165278025D-001
+Math.cos(1.04720E+00): 5.00000E-01. MathL.cos(1.04719755119660D+000): 4.99999999999998D-001
+Math.cos(1.57080E+00): -1.55431E-15. MathL.cos(1.57079632679490D+000): -3.49148251407644D-015
+Math.cos(3.14159E+00): -1.0000E+00. MathL.cos(3.14159265358979D+000): -9.99999999999999D-001
+Math.cos(-1.0472E+00): 5.00000E-01. MathL.cos(-1.0471975511966D+000): 4.99999999999998D-001
+Math.cos(-1.5708E+00): -1.55431E-15. MathL.cos(-1.5707963267949D+000): -3.49148251407644D-015
+Math.cos(-3.14159E+00): -1.0000E+00. MathL.cos(-3.14159265358979D+000): -9.99999999999999D-001
+
+Math.tan(0.00000E+00): 0.00000E+00. MathL.tan(0.00000000000000D+000): 0.00000000000000D+000
+Math.tan(1.00000E-01): 1.00335E-01. MathL.tan(1.00000000000000D-001): 1.00334672085451D-001
+Math.tan(1.04720E+00): 1.73205E+00. MathL.tan(1.04719755119660D+000): 1.73205080756888D+000
+Math.tan(1.57080E+00): 3.00240E+14. MathL.tan(1.57079632679490D+000): 2.02340838177263D+007
+Math.tan(3.14159E+00): -6.66134E-15. MathL.tan(3.14159265358979D+000): 3.23108679839857D-015
+Math.tan(-1.0472E+00): -1.73205E+00. MathL.tan(-1.0471975511966D+000): -1.73205080756888D+000
+Math.tan(-1.5708E+00): -3.0024E+14. MathL.tan(-1.5707963267949D+000): -2.02340838177263D+007
+Math.tan(-3.14159E+00): 6.66134E-15. MathL.tan(-3.14159265358979D+000): -3.23108679839857D-015
+
+Math.arcsin(9.00000E-01): -4.51027E-01. MathL.arcsin(9.00000000000000D-001): 1.11976951499864D+000
+Math.arcsin(1.00000E+00): -0.0000E+00. MathL.arcsin(1.00000000000000D+000): 1.57079632679490D+000
+Math.arcsin(1.40000E+00): 3.40282E+38. MathL.arcsin(1.40000000000000D+000): 1.79769296342094D+308
+Math.arcsin(1.50000E+00): 3.40282E+38. MathL.arcsin(1.50000000000000D+000): 1.79769296342094D+308
+Math.arcsin(1.60000E+00): 3.40282E+38. MathL.arcsin(1.60000000000000D+000): 1.79769296342094D+308
+Math.arcsin(1.90000E+00): 3.40282E+38. MathL.arcsin(1.90000000000000D+000): 1.79769296342094D+308
+Math.arcsin(2.00000E+00): 3.40282E+38. MathL.arcsin(2.00000000000000D+000): 1.79769296342094D+308
+Math.arcsin(2.40000E+00): 3.40282E+38. MathL.arcsin(2.40000000000000D+000): 1.79769296342094D+308
+Math.arcsin(2.50000E+00): 3.40282E+38. MathL.arcsin(2.50000000000000D+000): 1.79769296342094D+308
+Math.arcsin(3.00000E+00): 3.40282E+38. MathL.arcsin(3.00000000000000D+000): 1.79769296342094D+308
+Math.arcsin(4.00000E+00): 3.40282E+38. MathL.arcsin(4.00000000000000D+000): 1.79769296342094D+308
+Math.arcsin(-9.0000E-01): -4.51027E-01. MathL.arcsin(-9.0000000000000D-001): -1.11976951499864D+000
+Math.arcsin(-1.0000E+00): -0.0000E+00. MathL.arcsin(-1.0000000000000D+000): -1.5707963267949D+000
+Math.arcsin(-1.4000E+00): 3.40282E+38. MathL.arcsin(-1.4000000000000D+000): 1.79769296342094D+308
+Math.arcsin(-1.5000E+00): 3.40282E+38. MathL.arcsin(-1.5000000000000D+000): 1.79769296342094D+308
+Math.arcsin(-1.6000E+00): 3.40282E+38. MathL.arcsin(-1.6000000000000D+000): 1.79769296342094D+308
+Math.arcsin(-1.9000E+00): 3.40282E+38. MathL.arcsin(-1.9000000000000D+000): 1.79769296342094D+308
+Math.arcsin(-2.0000E+00): 3.40282E+38. MathL.arcsin(-2.0000000000000D+000): 1.79769296342094D+308
+Math.arcsin(-2.4000E+00): 3.40282E+38. MathL.arcsin(-2.4000000000000D+000): 1.79769296342094D+308
+Math.arcsin(-2.5000E+00): 3.40282E+38. MathL.arcsin(-2.5000000000000D+000): 1.79769296342094D+308
+Math.arcsin(-3.0000E+00): 3.40282E+38. MathL.arcsin(-3.0000000000000D+000): 1.79769296342094D+308
+Math.arcsin(-4.0000E+00): 3.40282E+38. MathL.arcsin(-4.0000000000000D+000): 1.79769296342094D+308
+
+Math.arccos(9.00000E-01): -4.51027E-01. MathL.arccos(9.00000000000000D-001): 4.51026811796263D-001
+Math.arccos(1.00000E+00): -0.0000E+00. MathL.arccos(1.00000000000000D+000): 0.00000000000000D+000
+Math.arccos(1.40000E+00): 3.40282E+38. MathL.arccos(1.40000000000000D+000): 1.79769296342094D+308
+Math.arccos(1.50000E+00): 3.40282E+38. MathL.arccos(1.50000000000000D+000): 1.79769296342094D+308
+Math.arccos(1.60000E+00): 3.40282E+38. MathL.arccos(1.60000000000000D+000): 1.79769296342094D+308
+Math.arccos(1.90000E+00): 3.40282E+38. MathL.arccos(1.90000000000000D+000): 1.79769296342094D+308
+Math.arccos(2.00000E+00): 3.40282E+38. MathL.arccos(2.00000000000000D+000): 1.79769296342094D+308
+Math.arccos(2.40000E+00): 3.40282E+38. MathL.arccos(2.40000000000000D+000): 1.79769296342094D+308
+Math.arccos(2.50000E+00): 3.40282E+38. MathL.arccos(2.50000000000000D+000): 1.79769296342094D+308
+Math.arccos(3.00000E+00): 3.40282E+38. MathL.arccos(3.00000000000000D+000): 1.79769296342094D+308
+Math.arccos(4.00000E+00): 3.40282E+38. MathL.arccos(4.00000000000000D+000): 1.79769296342094D+308
+Math.arccos(-9.0000E-01): -4.51027E-01. MathL.arccos(-9.0000000000000D-001): 2.69056584179353D+000
+Math.arccos(-1.0000E+00): -0.0000E+00. MathL.arccos(-1.0000000000000D+000): 3.14159265358979D+000
+Math.arccos(-1.4000E+00): 3.40282E+38. MathL.arccos(-1.4000000000000D+000): 1.79769296342094D+308
+Math.arccos(-1.5000E+00): 3.40282E+38. MathL.arccos(-1.5000000000000D+000): 1.79769296342094D+308
+Math.arccos(-1.6000E+00): 3.40282E+38. MathL.arccos(-1.6000000000000D+000): 1.79769296342094D+308
+Math.arccos(-1.9000E+00): 3.40282E+38. MathL.arccos(-1.9000000000000D+000): 1.79769296342094D+308
+Math.arccos(-2.0000E+00): 3.40282E+38. MathL.arccos(-2.0000000000000D+000): 1.79769296342094D+308
+Math.arccos(-2.4000E+00): 3.40282E+38. MathL.arccos(-2.4000000000000D+000): 1.79769296342094D+308
+Math.arccos(-2.5000E+00): 3.40282E+38. MathL.arccos(-2.5000000000000D+000): 1.79769296342094D+308
+Math.arccos(-3.0000E+00): 3.40282E+38. MathL.arccos(-3.0000000000000D+000): 1.79769296342094D+308
+Math.arccos(-4.0000E+00): 3.40282E+38. MathL.arccos(-4.0000000000000D+000): 1.79769296342094D+308
+
+Math.arctan(9.00000E-01): 7.32815E-01. MathL.arctan(9.00000000000000D-001): 7.32815101786508D-001
+Math.arctan(1.00000E+00): 7.85398E-01. MathL.arctan(1.00000000000000D+000): 7.85398163397449D-001
+Math.arctan(1.40000E+00): 9.50547E-01. MathL.arctan(1.40000000000000D+000): 9.50546840812077D-001
+Math.arctan(1.50000E+00): 9.82794E-01. MathL.arctan(1.50000000000000D+000): 9.82793723247331D-001
+Math.arctan(1.60000E+00): 1.01220E+00. MathL.arctan(1.60000000000000D+000): 1.01219701145134D+000
+Math.arctan(1.90000E+00): 1.08632E+00. MathL.arctan(1.90000000000000D+000): 1.08631839775788D+000
+Math.arctan(2.00000E+00): 1.10715E+00. MathL.arctan(2.00000000000000D+000): 1.10714871779409D+000
+Math.arctan(2.40000E+00): 1.17601E+00. MathL.arctan(2.40000000000000D+000): 1.17600520709514D+000
+Math.arctan(2.50000E+00): 1.19029E+00. MathL.arctan(2.50000000000000D+000): 1.19028994968253D+000
+Math.arctan(3.00000E+00): 1.24905E+00. MathL.arctan(3.00000000000000D+000): 1.24904577239826D+000
+Math.arctan(4.00000E+00): 1.32582E+00. MathL.arctan(4.00000000000000D+000): 1.32581766366804D+000
+Math.arctan(-9.0000E-01): -7.32815E-01. MathL.arctan(-9.0000000000000D-001): -7.32815101786508D-001
+Math.arctan(-1.0000E+00): -7.85398E-01. MathL.arctan(-1.0000000000000D+000): -7.85398163397449D-001
+Math.arctan(-1.4000E+00): -9.50547E-01. MathL.arctan(-1.4000000000000D+000): -9.50546840812077D-001
+Math.arctan(-1.5000E+00): -9.82794E-01. MathL.arctan(-1.5000000000000D+000): -9.82793723247331D-001
+Math.arctan(-1.6000E+00): -1.0122E+00. MathL.arctan(-1.6000000000000D+000): -1.01219701145134D+000
+Math.arctan(-1.9000E+00): -1.08632E+00. MathL.arctan(-1.9000000000000D+000): -1.08631839775788D+000
+Math.arctan(-2.0000E+00): -1.10715E+00. MathL.arctan(-2.0000000000000D+000): -1.10714871779409D+000
+Math.arctan(-2.4000E+00): -1.17601E+00. MathL.arctan(-2.4000000000000D+000): -1.17600520709514D+000
+Math.arctan(-2.5000E+00): -1.19029E+00. MathL.arctan(-2.5000000000000D+000): -1.19028994968253D+000
+Math.arctan(-3.0000E+00): -1.24905E+00. MathL.arctan(-3.0000000000000D+000): -1.24904577239826D+000
+Math.arctan(-4.0000E+00): -1.32582E+00. MathL.arctan(-4.0000000000000D+000): -1.32581766366804D+000
+
+Math.sinh(9.00000E-01): 1.02652E+00. MathL.sinh(9.00000000000000D-001): 1.02651672570818D+000
+Math.sinh(1.00000E+00): 1.17520E+00. MathL.sinh(1.00000000000000D+000): 1.17520119364380D+000
+Math.sinh(1.40000E+00): 1.90430E+00. MathL.sinh(1.40000000000000D+000): 1.90430150145153D+000
+Math.sinh(1.50000E+00): 2.12928E+00. MathL.sinh(1.50000000000000D+000): 2.12927945509482D+000
+Math.sinh(1.60000E+00): 2.37557E+00. MathL.sinh(1.60000000000000D+000): 2.37556795320023D+000
+Math.sinh(1.90000E+00): 3.26816E+00. MathL.sinh(1.90000000000000D+000): 3.26816291152832D+000
+Math.sinh(2.00000E+00): 3.62686E+00. MathL.sinh(2.00000000000000D+000): 3.62686040784702D+000
+Math.sinh(2.40000E+00): 5.46623E+00. MathL.sinh(2.40000000000000D+000): 5.46622921367609D+000
+Math.sinh(2.50000E+00): 6.05020E+00. MathL.sinh(2.50000000000000D+000): 6.05020448103979D+000
+Math.sinh(3.00000E+00): 1.00179E+01. MathL.sinh(3.00000000000000D+000): 1.00178749274099D+001
+Math.sinh(4.00000E+00): 2.72899E+01. MathL.sinh(4.00000000000000D+000): 2.72899171971278D+001
+Math.sinh(-9.0000E-01): -1.02652E+00. MathL.sinh(-9.0000000000000D-001): -1.02651672570818D+000
+Math.sinh(-1.0000E+00): -1.1752E+00. MathL.sinh(-1.0000000000000D+000): -1.1752011936438D+000
+Math.sinh(-1.4000E+00): -1.9043E+00. MathL.sinh(-1.4000000000000D+000): -1.90430150145153D+000
+Math.sinh(-1.5000E+00): -2.12928E+00. MathL.sinh(-1.5000000000000D+000): -2.12927945509482D+000
+Math.sinh(-1.6000E+00): -2.37557E+00. MathL.sinh(-1.6000000000000D+000): -2.37556795320023D+000
+Math.sinh(-1.9000E+00): -3.26816E+00. MathL.sinh(-1.9000000000000D+000): -3.26816291152832D+000
+Math.sinh(-2.0000E+00): -3.62686E+00. MathL.sinh(-2.0000000000000D+000): -3.62686040784702D+000
+Math.sinh(-2.4000E+00): -5.46623E+00. MathL.sinh(-2.4000000000000D+000): -5.46622921367609D+000
+Math.sinh(-2.5000E+00): -6.0502E+00. MathL.sinh(-2.5000000000000D+000): -6.05020448103979D+000
+Math.sinh(-3.0000E+00): -1.00179E+01. MathL.sinh(-3.0000000000000D+000): -1.00178749274099D+001
+Math.sinh(-4.0000E+00): -2.72899E+01. MathL.sinh(-4.0000000000000D+000): -2.72899171971278D+001
+
+Math.cosh(9.00000E-01): 1.43309E+00. MathL.cosh(9.00000000000000D-001): 1.43308638544877D+000
+Math.cosh(1.00000E+00): 1.54308E+00. MathL.cosh(1.00000000000000D+000): 1.54308063481524D+000
+Math.cosh(1.40000E+00): 2.15090E+00. MathL.cosh(1.40000000000000D+000): 2.15089846539314D+000
+Math.cosh(1.50000E+00): 2.35241E+00. MathL.cosh(1.50000000000000D+000): 2.35240961524325D+000
+Math.cosh(1.60000E+00): 2.57746E+00. MathL.cosh(1.60000000000000D+000): 2.57746447119489D+000
+Math.cosh(1.90000E+00): 3.41773E+00. MathL.cosh(1.90000000000000D+000): 3.41773153075095D+000
+Math.cosh(2.00000E+00): 3.76220E+00. MathL.cosh(2.00000000000000D+000): 3.76219569108363D+000
+Math.cosh(2.40000E+00): 5.55695E+00. MathL.cosh(2.40000000000000D+000): 5.55694716696551D+000
+Math.cosh(2.50000E+00): 6.13229E+00. MathL.cosh(2.50000000000000D+000): 6.13228947966369D+000
+Math.cosh(3.00000E+00): 1.00677E+01. MathL.cosh(3.00000000000000D+000): 1.00676619957778D+001
+Math.cosh(4.00000E+00): 2.73082E+01. MathL.cosh(4.00000000000000D+000): 2.73082328360165D+001
+Math.cosh(-9.0000E-01): 1.43309E+00. MathL.cosh(-9.0000000000000D-001): 1.43308638544877D+000
+Math.cosh(-1.0000E+00): 1.54308E+00. MathL.cosh(-1.0000000000000D+000): 1.54308063481524D+000
+Math.cosh(-1.4000E+00): 2.15090E+00. MathL.cosh(-1.4000000000000D+000): 2.15089846539314D+000
+Math.cosh(-1.5000E+00): 2.35241E+00. MathL.cosh(-1.5000000000000D+000): 2.35240961524325D+000
+Math.cosh(-1.6000E+00): 2.57746E+00. MathL.cosh(-1.6000000000000D+000): 2.57746447119489D+000
+Math.cosh(-1.9000E+00): 3.41773E+00. MathL.cosh(-1.9000000000000D+000): 3.41773153075095D+000
+Math.cosh(-2.0000E+00): 3.76220E+00. MathL.cosh(-2.0000000000000D+000): 3.76219569108363D+000
+Math.cosh(-2.4000E+00): 5.55695E+00. MathL.cosh(-2.4000000000000D+000): 5.55694716696551D+000
+Math.cosh(-2.5000E+00): 6.13229E+00. MathL.cosh(-2.5000000000000D+000): 6.13228947966369D+000
+Math.cosh(-3.0000E+00): 1.00677E+01. MathL.cosh(-3.0000000000000D+000): 1.00676619957778D+001
+Math.cosh(-4.0000E+00): 2.73082E+01. MathL.cosh(-4.0000000000000D+000): 2.73082328360165D+001
+
+Math.tanh(9.00000E-01): 7.16298E-01. MathL.tanh(9.00000000000000D-001): 7.16297870199025D-001
+Math.tanh(1.00000E+00): 7.61594E-01. MathL.tanh(1.00000000000000D+000): 7.61594155955765D-001
+Math.tanh(1.40000E+00): 8.85352E-01. MathL.tanh(1.40000000000000D+000): 8.85351648202263D-001
+Math.tanh(1.50000E+00): 9.05148E-01. MathL.tanh(1.50000000000000D+000): 9.05148253644866D-001
+Math.tanh(1.60000E+00): 9.21669E-01. MathL.tanh(1.60000000000000D+000): 9.21668554406471D-001
+Math.tanh(1.90000E+00): 9.56237E-01. MathL.tanh(1.90000000000000D+000): 9.56237458127739D-001
+Math.tanh(2.00000E+00): 9.64028E-01. MathL.tanh(2.00000000000000D+000): 9.64027580075817D-001
+Math.tanh(2.40000E+00): 9.83675E-01. MathL.tanh(2.40000000000000D+000): 9.83674857693680D-001
+Math.tanh(2.50000E+00): 9.86614E-01. MathL.tanh(2.50000000000000D+000): 9.86614298151430D-001
+Math.tanh(3.00000E+00): 9.95055E-01. MathL.tanh(3.00000000000000D+000): 9.95054753686731D-001
+Math.tanh(4.00000E+00): 9.99329E-01. MathL.tanh(4.00000000000000D+000): 9.99329299739067D-001
+Math.tanh(-9.0000E-01): -7.16298E-01. MathL.tanh(-9.0000000000000D-001): -7.16297870199025D-001
+Math.tanh(-1.0000E+00): -7.61594E-01. MathL.tanh(-1.0000000000000D+000): -7.61594155955765D-001
+Math.tanh(-1.4000E+00): -8.85352E-01. MathL.tanh(-1.4000000000000D+000): -8.85351648202263D-001
+Math.tanh(-1.5000E+00): -9.05148E-01. MathL.tanh(-1.5000000000000D+000): -9.05148253644866D-001
+Math.tanh(-1.6000E+00): -9.21669E-01. MathL.tanh(-1.6000000000000D+000): -9.21668554406471D-001
+Math.tanh(-1.9000E+00): -9.56237E-01. MathL.tanh(-1.9000000000000D+000): -9.56237458127739D-001
+Math.tanh(-2.0000E+00): -9.64028E-01. MathL.tanh(-2.0000000000000D+000): -9.64027580075817D-001
+Math.tanh(-2.4000E+00): -9.83675E-01. MathL.tanh(-2.4000000000000D+000): -9.8367485769368D-001
+Math.tanh(-2.5000E+00): -9.86614E-01. MathL.tanh(-2.5000000000000D+000): -9.8661429815143D-001
+Math.tanh(-3.0000E+00): -9.95055E-01. MathL.tanh(-3.0000000000000D+000): -9.95054753686731D-001
+Math.tanh(-4.0000E+00): -9.99329E-01. MathL.tanh(-4.0000000000000D+000): -9.99329299739067D-001
+
+Math.arcsinh(9.00000E-01): 8.08867E-01. MathL.arcsinh(9.00000000000000D-001): 8.08866935652783D-001
+Math.arcsinh(1.00000E+00): 8.81374E-01. MathL.arcsinh(1.00000000000000D+000): 8.81373587019543D-001
+Math.arcsinh(1.40000E+00): 1.13798E+00. MathL.arcsinh(1.40000000000000D+000): 1.13798204629337D+000
+Math.arcsinh(1.50000E+00): 1.19476E+00. MathL.arcsinh(1.50000000000000D+000): 1.19476321728711D+000
+Math.arcsinh(1.60000E+00): 1.24898E+00. MathL.arcsinh(1.60000000000000D+000): 1.24898332790488D+000
+Math.arcsinh(1.90000E+00): 1.39800E+00. MathL.arcsinh(1.90000000000000D+000): 1.39799836511143D+000
+Math.arcsinh(2.00000E+00): 1.44364E+00. MathL.arcsinh(2.00000000000000D+000): 1.44363547517881D+000
+Math.arcsinh(2.40000E+00): 1.60944E+00. MathL.arcsinh(2.40000000000000D+000): 1.60943791243410D+000
+Math.arcsinh(2.50000E+00): 1.64723E+00. MathL.arcsinh(2.50000000000000D+000): 1.64723114637110D+000
+Math.arcsinh(3.00000E+00): 1.81845E+00. MathL.arcsinh(3.00000000000000D+000): 1.81844645923207D+000
+Math.arcsinh(4.00000E+00): 2.09471E+00. MathL.arcsinh(4.00000000000000D+000): 2.09471254726110D+000
+Math.arcsinh(-9.0000E-01): -8.08867E-01. MathL.arcsinh(-9.0000000000000D-001): -8.08866935652783D-001
+Math.arcsinh(-1.0000E+00): -8.81374E-01. MathL.arcsinh(-1.0000000000000D+000): -8.81373587019543D-001
+Math.arcsinh(-1.4000E+00): -1.13798E+00. MathL.arcsinh(-1.4000000000000D+000): -1.13798204629337D+000
+Math.arcsinh(-1.5000E+00): -1.19476E+00. MathL.arcsinh(-1.5000000000000D+000): -1.19476321728711D+000
+Math.arcsinh(-1.6000E+00): -1.24898E+00. MathL.arcsinh(-1.6000000000000D+000): -1.24898332790488D+000
+Math.arcsinh(-1.9000E+00): -1.3980E+00. MathL.arcsinh(-1.9000000000000D+000): -1.39799836511143D+000
+Math.arcsinh(-2.0000E+00): -1.44364E+00. MathL.arcsinh(-2.0000000000000D+000): -1.44363547517881D+000
+Math.arcsinh(-2.4000E+00): -1.60944E+00. MathL.arcsinh(-2.4000000000000D+000): -1.6094379124341D+000
+Math.arcsinh(-2.5000E+00): -1.64723E+00. MathL.arcsinh(-2.5000000000000D+000): -1.6472311463711D+000
+Math.arcsinh(-3.0000E+00): -1.81845E+00. MathL.arcsinh(-3.0000000000000D+000): -1.81844645923207D+000
+Math.arcsinh(-4.0000E+00): -2.09471E+00. MathL.arcsinh(-4.0000000000000D+000): -2.0947125472611D+000
+
+Math.arccosh(9.00000E-01): 0.00000E+00. MathL.arccosh(9.00000000000000D-001): 0.00000000000000D+000
+Math.arccosh(1.00000E+00): 0.00000E+00. MathL.arccosh(1.00000000000000D+000): 0.00000000000000D+000
+Math.arccosh(1.40000E+00): 8.67015E-01. MathL.arccosh(1.40000000000000D+000): 8.67014726490565D-001
+Math.arccosh(1.50000E+00): 9.62424E-01. MathL.arccosh(1.50000000000000D+000): 9.62423650119207D-001
+Math.arccosh(1.60000E+00): 1.04697E+00. MathL.arccosh(1.60000000000000D+000): 1.04696791500319D+000
+Math.arccosh(1.90000E+00): 1.25720E+00. MathL.arccosh(1.90000000000000D+000): 1.25719582660038D+000
+Math.arccosh(2.00000E+00): 1.31696E+00. MathL.arccosh(2.00000000000000D+000): 1.31695789692482D+000
+Math.arccosh(2.40000E+00): 1.52208E+00. MathL.arccosh(2.40000000000000D+000): 1.52207936746365D+000
+Math.arccosh(2.50000E+00): 1.56680E+00. MathL.arccosh(2.50000000000000D+000): 1.56679923697241D+000
+Math.arccosh(3.00000E+00): 1.76275E+00. MathL.arccosh(3.00000000000000D+000): 1.76274717403909D+000
+Math.arccosh(4.00000E+00): 2.06344E+00. MathL.arccosh(4.00000000000000D+000): 2.06343706889556D+000
+Math.arccosh(-9.0000E-01): 0.00000E+00. MathL.arccosh(-9.0000000000000D-001): 0.00000000000000D+000
+Math.arccosh(-1.0000E+00): 0.00000E+00. MathL.arccosh(-1.0000000000000D+000): 0.00000000000000D+000
+Math.arccosh(-1.4000E+00): 0.00000E+00. MathL.arccosh(-1.4000000000000D+000): 0.00000000000000D+000
+Math.arccosh(-1.5000E+00): 0.00000E+00. MathL.arccosh(-1.5000000000000D+000): 0.00000000000000D+000
+Math.arccosh(-1.6000E+00): 0.00000E+00. MathL.arccosh(-1.6000000000000D+000): 0.00000000000000D+000
+Math.arccosh(-1.9000E+00): 0.00000E+00. MathL.arccosh(-1.9000000000000D+000): 0.00000000000000D+000
+Math.arccosh(-2.0000E+00): 0.00000E+00. MathL.arccosh(-2.0000000000000D+000): 0.00000000000000D+000
+Math.arccosh(-2.4000E+00): 0.00000E+00. MathL.arccosh(-2.4000000000000D+000): 0.00000000000000D+000
+Math.arccosh(-2.5000E+00): 0.00000E+00. MathL.arccosh(-2.5000000000000D+000): 0.00000000000000D+000
+Math.arccosh(-3.0000E+00): 0.00000E+00. MathL.arccosh(-3.0000000000000D+000): 0.00000000000000D+000
+Math.arccosh(-4.0000E+00): 0.00000E+00. MathL.arccosh(-4.0000000000000D+000): 0.00000000000000D+000
+
+Math.arctanh(9.00000E-01): 1.47222E+00. MathL.arctanh(9.00000000000000D-001): 1.47221948958322D+000
+Math.arctanh(1.00000E+00): 8.66434E+00. MathL.arctanh(1.00000000000000D+000): 1.87149738751185D+001
+Math.arctanh(1.40000E+00): 8.66434E+00. MathL.arctanh(1.40000000000000D+000): 1.87149738751185D+001
+Math.arctanh(1.50000E+00): 8.66434E+00. MathL.arctanh(1.50000000000000D+000): 1.87149738751185D+001
+Math.arctanh(1.60000E+00): 8.66434E+00. MathL.arctanh(1.60000000000000D+000): 1.87149738751185D+001
+Math.arctanh(1.90000E+00): 8.66434E+00. MathL.arctanh(1.90000000000000D+000): 1.87149738751185D+001
+Math.arctanh(2.00000E+00): 8.66434E+00. MathL.arctanh(2.00000000000000D+000): 1.87149738751185D+001
+Math.arctanh(2.40000E+00): 8.66434E+00. MathL.arctanh(2.40000000000000D+000): 1.87149738751185D+001
+Math.arctanh(2.50000E+00): 8.66434E+00. MathL.arctanh(2.50000000000000D+000): 1.87149738751185D+001
+Math.arctanh(3.00000E+00): 8.66434E+00. MathL.arctanh(3.00000000000000D+000): 1.87149738751185D+001
+Math.arctanh(4.00000E+00): 8.66434E+00. MathL.arctanh(4.00000000000000D+000): 1.87149738751185D+001
+Math.arctanh(-9.0000E-01): -1.47222E+00. MathL.arctanh(-9.0000000000000D-001): -1.47221948958322D+000
+Math.arctanh(-1.0000E+00): -8.66434E+00. MathL.arctanh(-1.0000000000000D+000): -1.87149738751185D+001
+Math.arctanh(-1.4000E+00): -8.66434E+00. MathL.arctanh(-1.4000000000000D+000): -1.87149738751185D+001
+Math.arctanh(-1.5000E+00): -8.66434E+00. MathL.arctanh(-1.5000000000000D+000): -1.87149738751185D+001
+Math.arctanh(-1.6000E+00): -8.66434E+00. MathL.arctanh(-1.6000000000000D+000): -1.87149738751185D+001
+Math.arctanh(-1.9000E+00): -8.66434E+00. MathL.arctanh(-1.9000000000000D+000): -1.87149738751185D+001
+Math.arctanh(-2.0000E+00): -8.66434E+00. MathL.arctanh(-2.0000000000000D+000): -1.87149738751185D+001
+Math.arctanh(-2.4000E+00): -8.66434E+00. MathL.arctanh(-2.4000000000000D+000): -1.87149738751185D+001
+Math.arctanh(-2.5000E+00): -8.66434E+00. MathL.arctanh(-2.5000000000000D+000): -1.87149738751185D+001
+Math.arctanh(-3.0000E+00): -8.66434E+00. MathL.arctanh(-3.0000000000000D+000): -1.87149738751185D+001
+Math.arctanh(-4.0000E+00): -8.66434E+00. MathL.arctanh(-4.0000000000000D+000): -1.87149738751185D+001
+
diff --git a/src/test/confidence/math/mathtest.mod b/src/test/confidence/math/mathtest.mod
new file mode 100644
index 00000000..b062c844
--- /dev/null
+++ b/src/test/confidence/math/mathtest.mod
@@ -0,0 +1,145 @@
+MODULE mathtest;
+IMPORT Math, MathL, Out, SYSTEM;
+
+TYPE
+ RtoR = PROCEDURE(x: REAL): REAL;
+ LRtoLR = PROCEDURE(x: LONGREAL): LONGREAL;
+ RtoLI = PROCEDURE(x: REAL): LONGINT;
+ LRtoLI = PROCEDURE(x: LONGREAL): LONGINT;
+
+ Values = RECORD
+ v: ARRAY 100 OF LONGREAL;
+ n: INTEGER
+ END;
+
+VAR
+ r: REAL;
+ lr: LONGREAL;
+ misc: Values;
+ angles: Values;
+
+
+PROCEDURE wc(c: CHAR); BEGIN Out.Char(c) END wc;
+PROCEDURE ws(s: ARRAY OF CHAR); BEGIN Out.String(s) END ws;
+PROCEDURE wi(i: HUGEINT); BEGIN Out.Int(i,1) END wi;
+PROCEDURE wr(r: REAL); BEGIN Out.Real(r,11) END wr;
+PROCEDURE wlr(lr: LONGREAL); BEGIN Out.LongReal(lr,21) END wlr;
+PROCEDURE wl; BEGIN Out.Ln END wl;
+
+PROCEDURE wh(VAR h: ARRAY OF SYSTEM.BYTE);
+ VAR i: INTEGER; b: SYSTEM.INT8;
+BEGIN
+ i := SHORT(LEN(h));
+ WHILE i > 0 DO
+ DEC(i); b := SYSTEM.VAL(SYSTEM.INT8, h[i]);
+ IF b DIV 16 MOD 16 < 10 THEN wc(CHR(b DIV 16 MOD 16 + 48)) ELSE wc(CHR(b DIV 16 MOD 16 + 55)) END;
+ IF b MOD 16 < 10 THEN wc(CHR(b MOD 16 + 48)) ELSE wc(CHR(b MOD 16 + 55)) END;
+ END
+END wh;
+
+PROCEDURE addvalue(lr: LONGREAL; VAR val: Values);
+BEGIN val.v[val.n] := lr; INC(val.n)
+END addvalue;
+
+PROCEDURE MathErrorHandler(error: INTEGER);
+BEGIN
+ ws(" ")
+END MathErrorHandler;
+
+PROCEDURE TestRtoR(s: ARRAY OF CHAR; p: RtoR; lp: LRtoLR; val: Values);
+ VAR i: INTEGER; r: REAL;
+BEGIN
+ i := 0;
+ WHILE i < val.n DO
+ r := SHORT(val.v[i]);
+ ws("Math."); ws(s); ws("("); wr(r); ws("): "); wr(p(r));
+ ws(". MathL."); ws(s); ws("("); wlr(val.v[i]); ws("): "); wlr(lp(val.v[i])); wl;
+ INC(i)
+ END;
+ wl;
+END TestRtoR;
+
+PROCEDURE TestRtoLI(s: ARRAY OF CHAR; p: RtoLI; lp: LRtoLI; val: Values);
+ VAR i: INTEGER; r: REAL;
+BEGIN
+ i := 0;
+ WHILE i < val.n DO
+ r := SHORT(val.v[i]);
+ ws("Math."); ws(s); ws("("); wr(r); ws("): "); wi(p(r));
+ ws(". MathL."); ws(s); ws("("); wlr(val.v[i]); ws("): "); wi(lp(val.v[i])); wl;
+ INC(i)
+ END;
+ wl;
+END TestRtoLI;
+
+PROCEDURE round(lr: LONGREAL);
+ VAR r: REAL;
+BEGIN
+ r := SHORT(lr);
+ ws("Math.round("); wr(r); ws("): "); wi(Math.round(r));
+ ws(". MathL.round("); wlr(lr); ws("): "); wi(MathL.round(lr)); wl
+END round;
+
+PROCEDURE sqrt(lr: LONGREAL);
+ VAR r: REAL;
+BEGIN
+ r := SHORT(lr);
+ ws("Math.sqrt("); wr(r); ws("): "); wr(Math.sqrt(r));
+ ws(". MathL.sqrt("); wlr(r); ws("): "); wlr(MathL.sqrt(r)); wl
+END sqrt;
+
+
+BEGIN
+ ws("Math and MathL module tests."); wl; wl;
+
+ misc.n := 0;
+ addvalue(0.9D0, misc); addvalue(1.0D0, misc); addvalue(1.4D0, misc); addvalue(1.5D0, misc); addvalue(1.6D0, misc); addvalue(1.9D0, misc);
+ addvalue(2.0D0, misc); addvalue(2.4D0, misc); addvalue(2.5D0, misc);
+ addvalue(3.0D0, misc); addvalue(4.0D0, misc);
+
+ addvalue(-0.9D0, misc); addvalue(-1.0D0, misc); addvalue(-1.4D0, misc); addvalue(-1.5D0, misc); addvalue(-1.6D0, misc); addvalue(-1.9D0, misc);
+ addvalue(-2.0D0, misc); addvalue(-2.4D0, misc); addvalue(-2.5D0, misc);
+ addvalue(-3.0D0, misc); addvalue(-4.0D0, misc);
+
+ angles.n:= 0;
+ addvalue(0.0D0, angles); addvalue(0.1D0, angles);
+ addvalue(MathL.pi/3.0D0, angles); addvalue(MathL.pi/2.0D0, angles); addvalue(MathL.pi, angles);
+ addvalue(-MathL.pi/3.0D0, angles); addvalue(-MathL.pi/2.0D0, angles); addvalue(-MathL.pi, angles);
+
+ TestRtoR("fraction", Math.fraction, MathL.fraction, misc);
+ TestRtoLI("round", Math.round, MathL.round, misc);
+ TestRtoR("sqrt", Math.sqrt, MathL.sqrt, misc);
+(*TestRtoR("exp", Math.exp, MathL.exp, misc);*) (* bypass exp test as MathL result differs between x86 and x64. *)
+ TestRtoR("ln", Math.ln, MathL.ln, misc);
+ TestRtoR("sin", Math.sin, MathL.sin, angles);
+ TestRtoR("cos", Math.cos, MathL.cos, angles);
+ TestRtoR("tan", Math.tan, MathL.tan, angles);
+ TestRtoR("arcsin", Math.arcsin, MathL.arcsin, misc);
+ TestRtoR("arccos", Math.arccos, MathL.arccos, misc);
+ TestRtoR("arctan", Math.arctan, MathL.arctan, misc);
+ TestRtoR("sinh", Math.sinh, MathL.sinh, misc);
+ TestRtoR("cosh", Math.cosh, MathL.cosh, misc);
+ TestRtoR("tanh", Math.tanh, MathL.tanh, misc);
+ TestRtoR("arcsinh", Math.arcsinh, MathL.arcsinh, misc);
+ TestRtoR("arccosh", Math.arccosh, MathL.arccosh, misc);
+ TestRtoR("arctanh", Math.arctanh, MathL.arctanh, misc);
+
+ (* todo power, log, ipower, sincos, arctan2 *)
+
+END mathtest.
diff --git a/src/test/confidence/math/test.sh b/src/test/confidence/math/test.sh
new file mode 100644
index 00000000..c64bde88
--- /dev/null
+++ b/src/test/confidence/math/test.sh
@@ -0,0 +1,6 @@
+#!/bin/sh
+. ../testenv.sh
+rm -f mathtest # Remove LSW binary so it doesn't hide Cygwin binary.
+$OBECOMP mathtest.mod -m -OC
+./mathtest >result
+. ../testresult.sh
diff --git a/src/test/confidence/out/expected b/src/test/confidence/out/expected
new file mode 100644
index 00000000..dab1e079
--- /dev/null
+++ b/src/test/confidence/out/expected
@@ -0,0 +1,254 @@
+--- Testing with Oberon 2 variable model ---
+Real number hex representation.
+ 1.0D0: 3FF0000000000000
+ 1.1D0: 3FF199999999999A
+ 2.1D0: 4000CCCCCCCCCCCD
+-1.1D0: BFF199999999999A
+ 1.1D3: 4091300000000000
+ 1.1D-3: 3F5205BC01A36E2F
+ 1.2345678987654321D3: 40934A45874103D8
+ 0.0: 0000000000000000
+ 0.000123D0: 3F201F31F46ED246
+ 1/0.0: 7FF0000000000000
+-1/0.0: FFF0000000000000
+
+ 1.0E0: 3F800000
+ 1.1E0: 3F8CCCCD
+ 2.1E0: 40066666
+-1.1E0: BF8CCCCD
+ 1.1E3: 44898000
+ 1.1E-3: 3A902DE0
+ 1.2345678987654321E3: 449A522C
+ 0.0: 00000000
+ 0.000123E0: 3900F990
+ 1/0.0: 7F800000
+-1/0.0: FF800000
+
+
+Out module tests.
+SIZE(INTEGER) = 2
+
+Testing LONGREAL.
+
+ 1 2 3 4
+ 1234567890123456789012345678901234567890
+ 1.0D0: 1.0D+000
+ 1.1D0: 1.1D+000
+ 2.1D0: 2.1D+000
+-1.1D0: -1.1D+000
+ 1.1D3: 1.1D+003
+ 1.1D-3: 1.1D-003
+ 1.2345678987654321D3: 1.23456789876543D+003
+ 0.0: 0.0D+000
+ 0.000123D0: 1.23D-004
+ 1/0.0: Infinity
+-1/0.0: -Infinity
+ 0.0/0.0: NaN
+
+ 1 2 3 4
+ 1234567890123456789012345678901234567890
+ 1.0D0: 1.00000D+000
+ 1.1D0: 1.10000D+000
+ 2.1D0: 2.10000D+000
+-1.1D0: -1.1000D+000
+ 1.1D3: 1.10000D+003
+ 1.1D-3: 1.10000D-003
+ 1.2345678987654321D3: 1.23456789876543D+003
+ 0.0: 0.00000D+000
+ 0.000123D0: 1.23000D-004
+ 1/0.0: Infinity
+-1/0.0: -Infinity
+ 0.0/0.0: NaN
+
+ 1 2 3 4
+ 1234567890123456789012345678901234567890
+ 1.0D0: 1.0000000000000000D+000
+ 1.1D0: 1.1000000000000000D+000
+ 2.1D0: 2.1000000000000000D+000
+-1.1D0: -1.1000000000000000D+000
+ 1.1D3: 1.1000000000000000D+003
+ 1.1D-3: 1.1000000000000000D-003
+ 1.2345678987654321D3: 1.2345678987654300D+003
+ 0.0: 0.0000000000000000D+000
+ 0.000123D0: 1.2300000000000000D-004
+ 1/0.0: Infinity
+-1/0.0: -Infinity
+ 0.0/0.0: NaN
+
+
+
+Testing REAL.
+
+ 1 2 3 4
+ 1234567890123456789012345678901234567890
+ 1.0E0: 1.0E+00
+ 1.1E0: 1.1E+00
+ 2.1E0: 2.1E+00
+-1.1E0: -1.1E+00
+ 1.1E3: 1.1E+03
+ 1.1E-3: 1.1E-03
+ 1.2345678987654321E3: 1.23457E+03
+ 0.0: 0.0E+00
+ 0.000123E0: 1.23E-04
+ 1/0.0: Infinity
+-1/0.0: -Infinity
+ 0.0/0.0: NaN
+
+ 1 2 3
+ 123456789012345678901234567890
+ 1.0E0: 1.000000E+00
+ 1.1E0: 1.100000E+00
+ 2.1E0: 2.100000E+00
+-1.1E0: -1.10000E+00
+ 1.1E3: 1.100000E+03
+ 1.1E-3: 1.100000E-03
+ 1.2345678987654321E3: 1.234568E+03
+ 0.0: 0.000000E+00
+ 0.000123E0: 1.230000E-04
+ 1/0.0: Infinity
+-1/0.0: -Infinity
+ 0.0/0.0: NaN
+
+ 1 2 3 4
+ 1234567890123456789012345678901234567890
+ 1.0E0: 1.00000000E+00
+ 1.1E0: 1.10000002E+00
+ 2.1E0: 2.09999990E+00
+-1.1E0: -1.10000002E+00
+ 1.1E3: 1.10000000E+03
+ 1.1E-3: 1.09999999E-03
+ 1.2345678987654321E3: 1.23456787E+03
+ 0.0: 0.00000000E+00
+ 0.000123E0: 1.23000005E-04
+ 1/0.0: Infinity
+-1/0.0: -Infinity
+ 0.0/0.0: NaN
+
+
+
+--- Testing with Component Pascal variable model ---
+Real number hex representation.
+ 1.0D0: 3FF0000000000000
+ 1.1D0: 3FF199999999999A
+ 2.1D0: 4000CCCCCCCCCCCD
+-1.1D0: BFF199999999999A
+ 1.1D3: 4091300000000000
+ 1.1D-3: 3F5205BC01A36E2F
+ 1.2345678987654321D3: 40934A45874103D8
+ 0.0: 0000000000000000
+ 0.000123D0: 3F201F31F46ED246
+ 1/0.0: 7FF0000000000000
+-1/0.0: FFF0000000000000
+
+ 1.0E0: 3F800000
+ 1.1E0: 3F8CCCCD
+ 2.1E0: 40066666
+-1.1E0: BF8CCCCD
+ 1.1E3: 44898000
+ 1.1E-3: 3A902DE0
+ 1.2345678987654321E3: 449A522C
+ 0.0: 00000000
+ 0.000123E0: 3900F990
+ 1/0.0: 7F800000
+-1/0.0: FF800000
+
+
+Out module tests.
+SIZE(INTEGER) = 4
+
+Testing LONGREAL.
+
+ 1 2 3 4
+ 1234567890123456789012345678901234567890
+ 1.0D0: 1.0D+000
+ 1.1D0: 1.1D+000
+ 2.1D0: 2.1D+000
+-1.1D0: -1.1D+000
+ 1.1D3: 1.1D+003
+ 1.1D-3: 1.1D-003
+ 1.2345678987654321D3: 1.23456789876543D+003
+ 0.0: 0.0D+000
+ 0.000123D0: 1.23D-004
+ 1/0.0: Infinity
+-1/0.0: -Infinity
+ 0.0/0.0: NaN
+
+ 1 2 3 4
+ 1234567890123456789012345678901234567890
+ 1.0D0: 1.00000D+000
+ 1.1D0: 1.10000D+000
+ 2.1D0: 2.10000D+000
+-1.1D0: -1.1000D+000
+ 1.1D3: 1.10000D+003
+ 1.1D-3: 1.10000D-003
+ 1.2345678987654321D3: 1.23456789876543D+003
+ 0.0: 0.00000D+000
+ 0.000123D0: 1.23000D-004
+ 1/0.0: Infinity
+-1/0.0: -Infinity
+ 0.0/0.0: NaN
+
+ 1 2 3 4
+ 1234567890123456789012345678901234567890
+ 1.0D0: 1.0000000000000000D+000
+ 1.1D0: 1.1000000000000000D+000
+ 2.1D0: 2.1000000000000000D+000
+-1.1D0: -1.1000000000000000D+000
+ 1.1D3: 1.1000000000000000D+003
+ 1.1D-3: 1.1000000000000000D-003
+ 1.2345678987654321D3: 1.2345678987654300D+003
+ 0.0: 0.0000000000000000D+000
+ 0.000123D0: 1.2300000000000000D-004
+ 1/0.0: Infinity
+-1/0.0: -Infinity
+ 0.0/0.0: NaN
+
+
+
+Testing REAL.
+
+ 1 2 3 4
+ 1234567890123456789012345678901234567890
+ 1.0E0: 1.0E+00
+ 1.1E0: 1.1E+00
+ 2.1E0: 2.1E+00
+-1.1E0: -1.1E+00
+ 1.1E3: 1.1E+03
+ 1.1E-3: 1.1E-03
+ 1.2345678987654321E3: 1.23457E+03
+ 0.0: 0.0E+00
+ 0.000123E0: 1.23E-04
+ 1/0.0: Infinity
+-1/0.0: -Infinity
+ 0.0/0.0: NaN
+
+ 1 2 3
+ 123456789012345678901234567890
+ 1.0E0: 1.000000E+00
+ 1.1E0: 1.100000E+00
+ 2.1E0: 2.100000E+00
+-1.1E0: -1.10000E+00
+ 1.1E3: 1.100000E+03
+ 1.1E-3: 1.100000E-03
+ 1.2345678987654321E3: 1.234568E+03
+ 0.0: 0.000000E+00
+ 0.000123E0: 1.230000E-04
+ 1/0.0: Infinity
+-1/0.0: -Infinity
+ 0.0/0.0: NaN
+
+ 1 2 3 4
+ 1234567890123456789012345678901234567890
+ 1.0E0: 1.00000000E+00
+ 1.1E0: 1.10000002E+00
+ 2.1E0: 2.09999990E+00
+-1.1E0: -1.10000002E+00
+ 1.1E3: 1.10000000E+03
+ 1.1E-3: 1.09999999E-03
+ 1.2345678987654321E3: 1.23456787E+03
+ 0.0: 0.00000000E+00
+ 0.000123E0: 1.23000005E-04
+ 1/0.0: Infinity
+-1/0.0: -Infinity
+ 0.0/0.0: NaN
+
diff --git a/src/test/confidence/out/outtest.mod b/src/test/confidence/out/outtest.mod
new file mode 100644
index 00000000..aa1997cb
--- /dev/null
+++ b/src/test/confidence/out/outtest.mod
@@ -0,0 +1,183 @@
+MODULE outtest;
+
+IMPORT Out, SYSTEM;
+
+VAR
+ r: REAL;
+ lr: LONGREAL;
+ cw: SYSTEM.INT16;
+
+PROCEDURE wc(c: CHAR); BEGIN Out.Char(c) END wc;
+PROCEDURE ws(s: ARRAY OF CHAR); BEGIN Out.String(s) END ws;
+PROCEDURE wi(i: HUGEINT); BEGIN Out.Int(i,1) END wi;
+PROCEDURE wl; BEGIN Out.Ln END wl;
+
+PROCEDURE wh(VAR h: ARRAY OF SYSTEM.BYTE);
+ VAR i: INTEGER; b: SYSTEM.INT8;
+BEGIN
+ i := SHORT(LEN(h));
+ WHILE i > 0 DO
+ DEC(i); b := SYSTEM.VAL(SYSTEM.INT8, h[i]);
+ IF b DIV 16 MOD 16 < 10 THEN wc(CHR(b DIV 16 MOD 16 + 48)) ELSE wc(CHR(b DIV 16 MOD 16 + 55)) END;
+ IF b MOD 16 < 10 THEN wc(CHR(b MOD 16 + 48)) ELSE wc(CHR(b MOD 16 + 55)) END;
+ END
+END wh;
+
+
+(*
+PROCEDURE -GetFpcw() '__asm__ __volatile__ ("fnstcw %0" : "=m" (outtest_cw))';
+*)
+
+
+
+BEGIN
+ (*
+ ws("Floating point control word: "); GetFpcw; wh(cw); wl;
+ wl;
+ *)
+
+ ws("Real number hex representation."); wl;
+ lr := 1.0D0; ws(" 1.0D0: "); wh(lr); wl;
+ lr := 1.1D0; ws(" 1.1D0: "); wh(lr); wl;
+ lr := 2.1D0; ws(" 2.1D0: "); wh(lr); wl;
+ lr := -1.1D0; ws("-1.1D0: "); wh(lr); wl;
+ lr := 1.1D3; ws(" 1.1D3: "); wh(lr); wl;
+ lr := 1.1D-3; ws(" 1.1D-3: "); wh(lr); wl;
+ lr := 1.2345678987654321D3; ws(" 1.2345678987654321D3: "); wh(lr); wl;
+ lr := 0.0; ws(" 0.0: "); wh(lr); wl;
+ lr := 0.000123D0; ws(" 0.000123D0: "); wh(lr); wl;
+ lr := 0.0; lr := 1/lr; ws(" 1/0.0: "); wh(lr); wl;
+ lr := 0.0; lr := -1/lr; ws("-1/0.0: "); wh(lr); wl;
+(*lr := 0.0; lr := 0.0D0/lr; ws(" 0.0/0.0: "); wh(lr); wl;*)
+ wl;
+ r := 1.0E0; ws(" 1.0E0: "); wh(r); wl;
+ r := 1.1E0; ws(" 1.1E0: "); wh(r); wl;
+ r := 2.1E0; ws(" 2.1E0: "); wh(r); wl;
+ r := -1.1E0; ws("-1.1E0: "); wh(r); wl;
+ r := 1.1E3; ws(" 1.1E3: "); wh(r); wl;
+ r := 1.1E-3; ws(" 1.1E-3: "); wh(r); wl;
+ r := 1.2345678987654321E3; ws(" 1.2345678987654321E3: "); wh(r); wl;
+ r := 0.0; ws(" 0.0: "); wh(r); wl;
+ r := 0.000123E0; ws(" 0.000123E0: "); wh(r); wl;
+ r := 0.0; r := 1/r; ws(" 1/0.0: "); wh(r); wl;
+ r := 0.0; r := -1/r; ws("-1/0.0: "); wh(r); wl;
+(*r := 0.0; r := 0.0E0/r; ws(" 0.0/0.0: "); wh(r); wl;*)
+ wl; wl;
+
+ ws("Out module tests."); wl;
+ ws("SIZE(INTEGER) = "); wi(SIZE(INTEGER)); wl; wl;
+
+ ws("Testing LONGREAL."); wl; wl;
+ ws(" 1 2 3 4"); wl;
+ ws(" 1234567890123456789012345678901234567890"); wl;
+ ws(" 1.0D0: "); Out.LongReal( 1.0D0, 1); wl;
+ ws(" 1.1D0: "); Out.LongReal( 1.1D0, 1); wl;
+ ws(" 2.1D0: "); Out.LongReal( 2.1D0, 1); wl;
+ ws("-1.1D0: "); Out.LongReal(-1.1D0, 1); wl;
+ ws(" 1.1D3: "); Out.LongReal( 1.1D3, 1); wl;
+ ws(" 1.1D-3: "); Out.LongReal( 1.1D-3, 1); wl;
+ ws(" 1.2345678987654321D3: "); Out.LongReal( 1.2345678987654321D3, 1); wl;
+ ws(" 0.0: "); Out.LongReal(0.0, 1); wl;
+ ws(" 0.000123D0: "); Out.LongReal(0.000123D0, 1); wl;
+ lr := 0.0; lr := 1/lr;
+ ws(" 1/0.0: "); Out.LongReal(lr, 1); wl;
+ lr := 0.0; lr := -1/lr;
+ ws("-1/0.0: "); Out.LongReal(lr, 1); wl;
+ lr := 0.0; lr := 0.0D0/lr;
+ ws(" 0.0/0.0: "); Out.LongReal(lr, 1); wl;
+ wl;
+ ws(" 1 2 3 4"); wl;
+ ws(" 1234567890123456789012345678901234567890"); wl;
+ ws(" 1.0D0: "); Out.LongReal( 1.0D0, 12); wl;
+ ws(" 1.1D0: "); Out.LongReal( 1.1D0, 12); wl;
+ ws(" 2.1D0: "); Out.LongReal( 2.1D0, 12); wl;
+ ws("-1.1D0: "); Out.LongReal(-1.1D0, 12); wl;
+ ws(" 1.1D3: "); Out.LongReal( 1.1D3, 12); wl;
+ ws(" 1.1D-3: "); Out.LongReal( 1.1D-3, 12); wl;
+ ws(" 1.2345678987654321D3: "); Out.LongReal( 1.2345678987654321D3, 12); wl;
+ ws(" 0.0: "); Out.LongReal(0.0, 12); wl;
+ ws(" 0.000123D0: "); Out.LongReal(0.000123D0, 12); wl;
+ lr := 0.0; lr := 1/lr;
+ ws(" 1/0.0: "); Out.LongReal(lr, 12); wl;
+ lr := 0.0; lr := -1/lr;
+ ws("-1/0.0: "); Out.LongReal(lr, 12); wl;
+ lr := 0.0; lr := 0.0D0/lr;
+ ws(" 0.0/0.0: "); Out.LongReal(lr, 12); wl;
+ wl;
+ ws(" 1 2 3 4"); wl;
+ ws(" 1234567890123456789012345678901234567890"); wl;
+ ws(" 1.0D0: "); Out.LongReal( 1.0D0, 40); wl;
+ ws(" 1.1D0: "); Out.LongReal( 1.1D0, 40); wl;
+ ws(" 2.1D0: "); Out.LongReal( 2.1D0, 40); wl;
+ ws("-1.1D0: "); Out.LongReal(-1.1D0, 40); wl;
+ ws(" 1.1D3: "); Out.LongReal( 1.1D3, 40); wl;
+ ws(" 1.1D-3: "); Out.LongReal( 1.1D-3, 40); wl;
+ ws(" 1.2345678987654321D3: "); Out.LongReal( 1.2345678987654321D3, 40); wl;
+ ws(" 0.0: "); Out.LongReal(0.0, 40); wl;
+ ws(" 0.000123D0: "); Out.LongReal(0.000123D0, 40); wl;
+ lr := 0.0; lr := 1/lr;
+ ws(" 1/0.0: "); Out.LongReal(lr, 40); wl;
+ lr := 0.0; lr := -1/lr;
+ ws("-1/0.0: "); Out.LongReal(lr, 40); wl;
+ lr := 0.0; lr := 0.0D0/lr;
+ ws(" 0.0/0.0: "); Out.LongReal(lr, 40); wl;
+ wl; wl; wl;
+
+
+ ws("Testing REAL."); wl; wl;
+ ws(" 1 2 3 4"); wl;
+ ws(" 1234567890123456789012345678901234567890"); wl;
+ ws(" 1.0E0: "); Out.Real( 1.0E0, 1); wl;
+ ws(" 1.1E0: "); Out.Real( 1.1E0, 1); wl;
+ ws(" 2.1E0: "); Out.Real( 2.1E0, 1); wl;
+ ws("-1.1E0: "); Out.Real(-1.1E0, 1); wl;
+ ws(" 1.1E3: "); Out.Real( 1.1E3, 1); wl;
+ ws(" 1.1E-3: "); Out.Real( 1.1E-3, 1); wl;
+ ws(" 1.2345678987654321E3: "); Out.Real( 1.2345678987654321E3, 1); wl;
+ ws(" 0.0: "); Out.Real(0.0, 1); wl;
+ ws(" 0.000123E0: "); Out.Real(0.000123E0, 1); wl;
+ r := 0.0; r := 1/r;
+ ws(" 1/0.0: "); Out.Real(r, 1); wl;
+ r := 0.0; r := -1/r;
+ ws("-1/0.0: "); Out.Real(r, 1); wl;
+ r := 0.0; r := 0.0E0/r;
+ ws(" 0.0/0.0: "); Out.Real(r, 1); wl;
+ wl;
+ ws(" 1 2 3"); wl;
+ ws(" 123456789012345678901234567890"); wl;
+ ws(" 1.0E0: "); Out.Real( 1.0E0, 12); wl;
+ ws(" 1.1E0: "); Out.Real( 1.1E0, 12); wl;
+ ws(" 2.1E0: "); Out.Real( 2.1E0, 12); wl;
+ ws("-1.1E0: "); Out.Real(-1.1E0, 12); wl;
+ ws(" 1.1E3: "); Out.Real( 1.1E3, 12); wl;
+ ws(" 1.1E-3: "); Out.Real( 1.1E-3, 12); wl;
+ ws(" 1.2345678987654321E3: "); Out.Real( 1.2345678987654321E3, 12); wl;
+ ws(" 0.0: "); Out.Real(0.0, 12); wl;
+ ws(" 0.000123E0: "); Out.Real(0.000123E0, 12); wl;
+ r := 0.0; r := 1/r;
+ ws(" 1/0.0: "); Out.Real(r, 12); wl;
+ r := 0.0; r := -1/r;
+ ws("-1/0.0: "); Out.Real(r, 12); wl;
+ r := 0.0; r := 0.0E0/r;
+ ws(" 0.0/0.0: "); Out.Real(r, 12); wl;
+ wl;
+ ws(" 1 2 3 4"); wl;
+ ws(" 1234567890123456789012345678901234567890"); wl;
+ ws(" 1.0E0: "); Out.Real( 1.0E0, 40); wl;
+ ws(" 1.1E0: "); Out.Real( 1.1E0, 40); wl;
+ ws(" 2.1E0: "); Out.Real( 2.1E0, 40); wl;
+ ws("-1.1E0: "); Out.Real(-1.1E0, 40); wl;
+ ws(" 1.1E3: "); Out.Real( 1.1E3, 40); wl;
+ ws(" 1.1E-3: "); Out.Real( 1.1E-3, 40); wl;
+ ws(" 1.2345678987654321E3: "); Out.Real( 1.2345678987654321E3, 40); wl;
+ ws(" 0.0: "); Out.Real(0.0, 40); wl;
+ ws(" 0.000123E0: "); Out.Real(0.000123E0, 40); wl;
+ r := 0.0; r := 1/r;
+ ws(" 1/0.0: "); Out.Real(r, 40); wl;
+ r := 0.0; r := -1/r;
+ ws("-1/0.0: "); Out.Real(r, 40); wl;
+ r := 0.0; r := 0.0E0/r;
+ ws(" 0.0/0.0: "); Out.Real(r, 40); wl;
+ wl;
+
+END outtest.
diff --git a/src/test/confidence/out/test.sh b/src/test/confidence/out/test.sh
new file mode 100644
index 00000000..16bf63be
--- /dev/null
+++ b/src/test/confidence/out/test.sh
@@ -0,0 +1,14 @@
+#!/bin/sh
+. ../testenv.sh
+rm -f outtest # Remove LSW binary so it doesn't hide Cygwin binary.
+$OBECOMP outtest.mod -m -O2
+./outtest >result-O2
+$OBECOMP outtest.mod -m -OC
+./outtest >result-OC
+echo --- Testing with Oberon 2 variable model --- >result
+cat result-O2 >>result
+echo "" >>result
+echo "" >>result
+echo --- Testing with Component Pascal variable model --- >>result
+cat result-OC >>result
+. ../testresult.sh
diff --git a/src/test/confidence/planned-binary-change b/src/test/confidence/planned-binary-change
index 78981922..d7a05d09 100644
--- a/src/test/confidence/planned-binary-change
+++ b/src/test/confidence/planned-binary-change
@@ -1 +1 @@
-a
+18 Oct 2016 18:12:01
diff --git a/src/test/confidence/signal/signal.mod b/src/test/confidence/signal/signal.mod
index c7b58a48..3a897392 100644
--- a/src/test/confidence/signal/signal.mod
+++ b/src/test/confidence/signal/signal.mod
@@ -1,6 +1,6 @@
(* Test that interrupt and quit are handled correctly. *)
MODULE SignalTest;
-IMPORT Console, Platform, Files;
+IMPORT Console, Platform, Files, SYSTEM;
VAR result: Files.File; rider: Files.Rider;
@@ -24,7 +24,7 @@ BEGIN
END wi;
-PROCEDURE handle(signal: INTEGER);
+PROCEDURE handle(signal: SYSTEM.INT32);
BEGIN
Console.Ln; Console.String("Signal: "); Console.Int(signal,1); Console.Ln;
ws("Signal "); wi(signal); wl;
diff --git a/src/test/confidence/signal/test.sh b/src/test/confidence/signal/test.sh
index fadc1879..b9131862 100755
--- a/src/test/confidence/signal/test.sh
+++ b/src/test/confidence/signal/test.sh
@@ -1,5 +1,6 @@
#!/bin/sh
. ../testenv.sh
+rm -f SignalTest # Remove LSW binary so it doesn't hide Cygwin binary.
$OBECOMP signal.mod -m
./SignalTest x &
sleep 1
diff --git a/src/test/confidence/testenv.sh b/src/test/confidence/testenv.sh
index 63d5fa26..de1630fa 100755
--- a/src/test/confidence/testenv.sh
+++ b/src/test/confidence/testenv.sh
@@ -11,7 +11,7 @@ fi
# Set ibrary paths for darwin and termux(android)
export DYLD_LIBRARY_PATH=$1/lib:$DYLD_LIBRARY_PATH
export LD_LIBRARY_PATH=$1/lib:$LD_LIBRARY_PATH
-rm -f *.o *.obj *.exe *.sym *.c *.h result new.asm
+rm -f *.o *.obj *.exe *.sym *.c *.h result new.asm $(basename $PWD)
# Under gcc generate assembly source for source change test.
# NOTE: The following CFLAGS causes the assembler to write source
@@ -22,5 +22,5 @@ rm -f *.o *.obj *.exe *.sym *.c *.h result new.asm
# NOTE 2: The cygwin 64 bit build has relocation errors with
# these assembly generation options.
if [ "$COMPILER" = "gcc" -a "$FLAVOUR" != "cygwin.LP64.gcc" ]
-then export CFLAGS="-gstabs -g1 -Wa,-acdhln=new.asm"
+then export CFLAGS="-gstabs -g1 -Wa,-acdhln=new.asm -Wl,-Map=output.map"
fi
diff --git a/src/test/confidence/testresult.sh b/src/test/confidence/testresult.sh
index bdfcccfe..2dfd8a34 100755
--- a/src/test/confidence/testresult.sh
+++ b/src/test/confidence/testresult.sh
@@ -7,8 +7,8 @@ fi
# Compare generated code
if [ -f new.asm ]
-#then egrep '^[0-9 ]{4} ([0-9a-f]{4}| ) [0-9A-F]{2}[0-9A-F ]{6}' new.asm|cut -c 11- >new.$FLAVOUR.$BRANCH.s
-then sed -n '/^ *[0-9]\+ \([0-9a-f]\{4\}\| \) [0-9A-F]\{2\}[0-9A-F ]\{6\}/s/^ *[0-9]\+ ....//p' new.asm>new.$FLAVOUR.$BRANCH.s
+#then sed -n '/^ *[0-9]\+ \([0-9a-f]\{4\}\| \) [0-9A-F]\{2\}[0-9A-F ]\{6\}/s/^ *[0-9]\+ ....//p' new.asm>new.$FLAVOUR.$BRANCH.s
+then sed -n '/^ *[0-9]\+ \([0-9a-f]\{4\}\| \) [0-9A-F]\{2\}[0-9A-F ]\{6\}/s/^ *[0-9]\+ ....//p' new.asm | sed 's/_m.[0-9]\+/_m.xxx/' >new.$FLAVOUR.$BRANCH.s
if [ -f old.$FLAVOUR.$BRANCH.s -a old.$FLAVOUR.$BRANCH.s -nt ../planned-binary-change ]
then
diff --git a/src/test/confidence/texts/test.sh b/src/test/confidence/texts/test.sh
index 6a798eee..d84c0df4 100644
--- a/src/test/confidence/texts/test.sh
+++ b/src/test/confidence/texts/test.sh
@@ -1,5 +1,6 @@
#!/bin/sh
. ../testenv.sh
+rm -f testTexts # Remove LSW binary so it doesn't hide Cygwin binary.
$OBECOMP testTexts.mod -m
./testTexts >result
. ../testresult.sh
diff --git a/src/tools/browser/BrowserCmd.Mod b/src/tools/browser/BrowserCmd.Mod
index 55b6c192..d463c22d 100644
--- a/src/tools/browser/BrowserCmd.Mod
+++ b/src/tools/browser/BrowserCmd.Mod
@@ -1,42 +1,32 @@
MODULE BrowserCmd; (* RC 29.10.93 *) (* object model 4.12.93, command line version jt 4.4.95 *)
IMPORT
- OPM, OPS, OPT, OPV, Texts, Console, Platform;
-
+ OPM, OPS, OPT, OPV,
+ Texts, Strings, Files, Out,
+ Oberon, Platform, SYSTEM, Configuration;
CONST
OptionChar = "-";
- (* object modes *)
- Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7;
- SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13;
-
- (* structure forms *)
- Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;
- Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
- Pointer = 13; ProcTyp = 14; Comp = 15;
-
- (* composite structure forms *)
- Basic = 1; Array = 2; DynArr = 3; Record = 4;
-
- (* module visibility of objects *)
- internal = 0; external = 1; externalR = 2;
-
- (* symbol file items *)
- Smname = 16; Send = 18; Stype = 19; Salias = 20; Svar = 21; Srvar = 22;
- Svalpar = 23; Svarpar = 24; Sfld = 25; Srfld = 26; Shdptr = 27; Shdpro = 28; Stpro = 29; Shdtpro = 30;
- Sxpro = 31; Sipro = 32; Scpro = 33; Sstruct = 34; Ssys = 35; Sptr = 36; Sarr = 37; Sdarr = 38; Srec = 39; Spro = 40;
VAR
W: Texts.Writer;
option: CHAR;
PROCEDURE Ws(s: ARRAY OF CHAR); BEGIN Texts.WriteString(W, s) END Ws;
- PROCEDURE Wch(ch: CHAR); BEGIN Texts.Write(W, ch) END Wch;
- PROCEDURE Wi(i: LONGINT); BEGIN Texts.WriteInt(W, i, 0) END Wi;
- PROCEDURE Wln; BEGIN Texts.WriteLn(W) END Wln;
+ PROCEDURE Wc(ch: CHAR); BEGIN Texts.Write(W, ch) END Wc;
+ PROCEDURE Wi(i: SYSTEM.INT64); BEGIN Texts.WriteInt(W, i, 0) END Wi;
+ PROCEDURE Wln; BEGIN Texts.WriteLn(W) END Wln;
+
+ PROCEDURE Wh(i: SYSTEM.INT64);
+ BEGIN
+ IF i >= 16 THEN Wh(i DIV 10H)
+ ELSIF i >= 10 THEN Wc("0") END;
+ i := i MOD 16;
+ IF i < 10 THEN Wc(CHR(i+30H)) ELSE Wc(CHR(i+37H)) END
+ END Wh;
PROCEDURE Indent(i: INTEGER);
- BEGIN WHILE i > 0 DO Wch(" "); Wch(" "); DEC(i) END
+ BEGIN WHILE i > 0 DO Wc(" "); Wc(" "); DEC(i) END
END Indent;
PROCEDURE ^Wtype(typ: OPT.Struct);
@@ -47,91 +37,89 @@ MODULE BrowserCmd; (* RC 29.10.93 *) (* object model 4.12.93, command line ver
BEGIN first := TRUE;
res := (result # NIL) (* hidden mthd *) & (result # OPT.notyp);
paren := res OR (par # NIL);
- IF paren THEN Wch("(") END ;
+ IF paren THEN Wc("(") END;
WHILE par # NIL DO
- IF ~first THEN Ws("; ") ELSE first := FALSE END ;
- IF option = "x" THEN Wi(par^.adr); Wch(" ") END ;
- IF par^.mode = VarPar THEN Ws("VAR ") END ;
+ IF ~first THEN Ws("; ") ELSE first := FALSE END;
+ IF option = "x" THEN Wi(par^.adr); Wc(" ") END;
+ IF par^.mode = OPT.VarPar THEN Ws("VAR ") END;
Ws(par^.name); Ws(": "); Wtype(par^.typ);
par := par^.link
- END ;
- IF paren THEN Wch(")") END ;
+ END;
+ IF paren THEN Wc(")") END;
IF res THEN Ws(": "); Wtype(result) END
END Wsign;
+ PROCEDURE HasForm(obj: OPT.Object; mode: SET): BOOLEAN;
+ BEGIN
+ RETURN (obj # NIL)
+ & ( ((obj.mode IN mode) & (obj.name # ""))
+ OR HasForm(obj.left, mode)
+ OR HasForm(obj.right, mode));
+ END HasForm;
+
PROCEDURE Objects(obj: OPT.Object; mode: SET);
- VAR i: LONGINT; m: INTEGER; s: SET; ext: OPT.ConstExt;
+ VAR i: SYSTEM.INT64; m: INTEGER; s: SYSTEM.SET64; ext: OPT.ConstExt;
BEGIN
IF obj # NIL THEN
Objects(obj^.left, mode);
IF obj^.mode IN mode THEN
CASE obj^.mode OF
- | Con:
- Indent(2); Ws(obj^.name); Ws(" = ");
- CASE obj^.typ^.form OF
- | Bool:
- IF obj^.conval^.intval = 1 THEN Ws("TRUE") ELSE Ws("FALSE") END
- | Char:
- IF (obj^.conval^.intval >= 32) & (obj^.conval^.intval <= 126) THEN
- Wch(22X); Wch(CHR(obj^.conval^.intval)); Wch(22X)
- ELSE
- i := obj^.conval^.intval DIV 16;
- IF i > 9 THEN Wch(CHR(55 + i)) ELSE Wch(CHR(48 + i)) END ;
- i := obj^.conval^.intval MOD 16;
- IF i > 9 THEN Wch(CHR(55 + i)) ELSE Wch(CHR(48 + i)) END ;
- Wch("X")
- END
- | SInt, Int, LInt:
- Wi(obj^.conval^.intval)
- | Set:
- Wch("{"); i := 0; s := obj^.conval^.setval;
- WHILE i <= MAX(SET) DO
- IF i IN s THEN Wi(i); EXCL(s, i);
- IF s # {} THEN Ws(", ") END
- END ;
- INC(i)
- END ;
- Wch("}")
- | Real:
- Texts.WriteReal(W, SHORT(obj^.conval^.realval), 16)
- | LReal:
- Texts.WriteLongReal(W, obj^.conval^.realval, 23)
- | String:
- Ws(obj^.conval^.ext^)
- | NilTyp:
- Ws("NIL")
- ELSE (* Ignore other forms *)
- END ;
- Wch(";"); Wln
- | Typ:
- IF obj^.name # "" THEN Indent(2);
- IF obj^.typ^.strobj = obj THEN (* canonical name *)
- Wtype(obj^.typ); Ws(" = "); Wstruct(obj^.typ)
- ELSE (* alias *)
- Ws(obj^.name); Ws(" = "); Wtype(obj^.typ)
- END ;
- Wch(";"); Wln
- END
- | Var:
- Indent(2); Ws(obj^.name);
- IF obj^.vis = externalR THEN Ws("-: ") ELSE Ws(": ") END ;
- Wtype(obj^.typ); Wch(";"); Wln
- | XProc, CProc, IProc:
- Indent(1); Ws("PROCEDURE ");
- IF obj^.mode = IProc THEN Wch("+")
- ELSIF obj^.mode = CProc THEN Wch("-")
- END ;
- Ws(obj^.name);
- Wsign(obj^.typ, obj^.link);
- IF obj^.mode = CProc THEN
- ext := obj^.conval^.ext; m := ORD(ext^[0]); i := 1; Ws(' "');
- WHILE i <= m DO Wch(ext^[i]); INC(i) END ;
- Wch('"');
- END ;
- Wch(";"); Wln
+ |OPT.Con: Indent(2); Ws(obj^.name); Ws(" = ");
+ CASE obj^.typ^.form OF
+ |OPT.Bool: IF obj^.conval^.intval = 1 THEN Ws("TRUE") ELSE Ws("FALSE") END
+ |OPT.Char: IF (obj^.conval^.intval >= 32) & (obj^.conval^.intval <= 126) THEN
+ Wc(22X); Wc(CHR(obj^.conval^.intval)); Wc(22X)
+ ELSE
+ i := obj^.conval^.intval DIV 16;
+ IF i > 9 THEN Wc(CHR(55 + i)) ELSE Wc(CHR(48 + i)) END;
+ i := obj^.conval^.intval MOD 16;
+ IF i > 9 THEN Wc(CHR(55 + i)) ELSE Wc(CHR(48 + i)) END;
+ Wc("X")
+ END
+ |OPT.Int: Wi(obj^.conval^.intval)
+ |OPT.Set: Wc("{"); i := 0; s := obj^.conval^.setval;
+ WHILE i <= MAX(SYSTEM.SET64) DO
+ IF i IN s THEN Wi(i); EXCL(s, i);
+ IF s # {} THEN Ws(", ") END
+ END;
+ INC(i)
+ END;
+ Wc("}")
+ |OPT.Real: Texts.WriteReal(W, SHORT(obj^.conval^.realval), 16)
+ |OPT.LReal: Texts.WriteLongReal(W, obj^.conval^.realval, 23)
+ |OPT.String: Wc('"'); Ws(obj^.conval^.ext^); Wc('"')
+ |OPT.NilTyp: Ws("NIL")
+ ELSE (* Ignore other forms *)
+ END;
+ Wc(";"); Wln
+ |OPT.Typ: IF obj^.name # "" THEN Indent(2);
+ IF obj^.typ^.strobj = obj THEN (* canonical name *)
+ Wtype(obj^.typ); Ws(" = "); Wstruct(obj^.typ)
+ ELSE (* alias *)
+ Ws(obj^.name); Ws(" = "); Wtype(obj^.typ)
+ END;
+ Wc(";"); Wln
+ END
+ |OPT.Var: Indent(2); Ws(obj^.name);
+ IF obj^.vis = OPT.externalR THEN Ws("-: ") ELSE Ws(": ") END;
+ Wtype(obj^.typ); Wc(";"); Wln
+ |OPT.XProc,
+ OPT.CProc,
+ OPT.IProc: Indent(1); Ws("PROCEDURE ");
+ IF obj^.mode = OPT.IProc THEN Wc("+")
+ ELSIF obj^.mode = OPT.CProc THEN Wc("-")
+ END;
+ Ws(obj^.name);
+ Wsign(obj^.typ, obj^.link);
+ IF obj^.mode = OPT.CProc THEN
+ ext := obj^.conval^.ext; m := ORD(ext^[0]); i := 1; Ws(' "');
+ WHILE i <= m DO Wc(ext^[i]); INC(i) END;
+ Wc('"');
+ END;
+ Wc(";"); Wln
ELSE (* Ignore other modes *)
END
- END ;
+ END;
Objects(obj^.right, mode)
END
END Objects;
@@ -141,20 +129,20 @@ MODULE BrowserCmd; (* RC 29.10.93 *) (* object model 4.12.93, command line ver
BEGIN
IF obj # NIL THEN
Wmthd(obj^.left);
- IF (obj^.mode = TProc) & ((obj^.name # OPM.HdTProcName) OR (option = "x")) THEN
+ IF (obj^.mode = OPT.TProc) & ((obj^.name # OPM.HdTProcName) OR (option = "x")) THEN
Indent(3); Ws("PROCEDURE (");
IF obj^.name # OPM.HdTProcName THEN
- IF obj^.link^.mode = VarPar THEN Ws("VAR ") END ;
+ IF obj^.link^.mode = OPT.VarPar THEN Ws("VAR ") END;
Ws(obj^.link^.name); Ws(": "); Wtype(obj^.link^.typ)
- END ;
+ END;
Ws(") "); Ws(obj^.name);
Wsign(obj^.typ, obj^.link^.link);
- Wch(";");
+ Wc(";");
IF option = "x" THEN Indent(1);
Ws("(* methno: "); Wi(obj^.adr DIV 10000H); Ws(" *)")
- END ;
+ END;
Wln;
- END ;
+ END;
Wmthd(obj^.right)
END
END Wmthd;
@@ -163,48 +151,38 @@ MODULE BrowserCmd; (* RC 29.10.93 *) (* object model 4.12.93, command line ver
VAR fld: OPT.Object;
PROCEDURE SysFlag;
- BEGIN
- IF typ^.sysflag # 0 THEN
- Wch("["); Wi(typ^.sysflag); Ws("] ")
- END
+ BEGIN IF typ^.sysflag # 0 THEN Wc("["); Wh(typ^.sysflag); Ws("H] ") END
END SysFlag;
BEGIN
CASE typ^.form OF
- | Undef:
- Ws("Undef")
- | Pointer:
- Ws("POINTER "); SysFlag; Ws("TO "); Wtype(typ^.BaseTyp)
- | ProcTyp:
- Ws("PROCEDURE "); SysFlag; Wsign(typ^.BaseTyp, typ^.link)
- | Comp:
- CASE typ^.comp OF
- | Array:
- Ws("ARRAY "); SysFlag; Wi(typ^.n); Ws(" OF "); Wtype(typ^.BaseTyp)
- | DynArr:
- Ws("ARRAY "); SysFlag; Ws("OF "); Wtype(typ^.BaseTyp)
- | Record:
- Ws("RECORD ");SysFlag;
- IF typ^.BaseTyp # NIL THEN Wch("("); Wtype(typ^.BaseTyp); Wch(")") END ;
- Wln; fld := typ^.link;
- WHILE (fld # NIL) & (fld^.mode = Fld) DO
- IF (option = "x") OR (fld^.name[0] # "@") THEN Indent(3);
- IF option = "x" THEN Wi(fld^.adr); Wch(" ") END ;
- Ws(fld^.name);
- IF fld^.vis = externalR THEN Wch("-") END ;
- Ws(": "); Wtype(fld^.typ); Wch(";");
- Wln
- END ;
- fld := fld^.link
- END ;
- Wmthd(typ^.link);
- Indent(2); Ws("END ");
- IF option = "x" THEN Indent(1);
- Ws("(* size: "); Wi(typ^.size); Ws(" align: "); Wi(typ^.align);
- Ws(" nofm: "); Wi(typ^.n); Ws(" *)")
- END
- ELSE (* Ignore other comps *)
- END
+ |OPT.Undef: Ws("Undef")
+ |OPT.Pointer: Ws("POINTER "); SysFlag; Ws("TO "); Wtype(typ^.BaseTyp)
+ |OPT.ProcTyp: Ws("PROCEDURE "); SysFlag; Wsign(typ^.BaseTyp, typ^.link)
+ |OPT.Comp: CASE typ^.comp OF
+ |OPT.Array: Ws("ARRAY "); SysFlag; Wi(typ^.n); Ws(" OF "); Wtype(typ^.BaseTyp)
+ |OPT.DynArr: Ws("ARRAY "); SysFlag; Ws("OF "); Wtype(typ^.BaseTyp)
+ |OPT.Record: Ws("RECORD ");SysFlag;
+ IF typ^.BaseTyp # NIL THEN Wc("("); Wtype(typ^.BaseTyp); Wc(")") END;
+ Wln; fld := typ^.link;
+ WHILE (fld # NIL) & (fld^.mode = OPT.Fld) DO
+ IF (option = "x") OR (fld^.name[0] # "@") THEN Indent(3);
+ IF option = "x" THEN Wi(fld^.adr); Wc(" ") END;
+ Ws(fld^.name);
+ IF fld^.vis = OPT.externalR THEN Wc("-") END;
+ Ws(": "); Wtype(fld^.typ); Wc(";");
+ Wln
+ END;
+ fld := fld^.link
+ END;
+ Wmthd(typ^.link);
+ Indent(2); Ws("END");
+ IF option = "x" THEN Indent(1);
+ Ws("(* size: "); Wi(typ^.size); Ws(" align: "); Wi(typ^.align);
+ Ws(" nofm: "); Wi(typ^.n); Ws(" *)")
+ END
+ ELSE (* Ignore other comps *)
+ END
ELSE (* Ignore other froms *)
END
END Wstruct;
@@ -214,20 +192,23 @@ MODULE BrowserCmd; (* RC 29.10.93 *) (* object model 4.12.93, command line ver
BEGIN
obj := typ^.strobj;
IF obj^.name # "" THEN
- IF typ^.mno # 0 THEN Ws(OPT.GlbMod[typ^.mno].name); Wch(".")
+ IF typ^.mno # 0 THEN Ws(OPT.GlbMod[typ^.mno].name); Wc(".")
ELSIF (typ = OPT.bytetyp) OR (typ = OPT.sysptrtyp) THEN Ws("SYSTEM.")
- ELSIF obj^.vis = internal THEN Wch("#")
- END ;
+ ELSIF obj^.vis = OPT.internal THEN Wc("#")
+ END;
Ws(obj^.name)
ELSE
- IF (option = "x") & (typ^.ref > OPM.MaxStruct) THEN Wch("#"); Wi(typ^.ref - OPM.MaxStruct); Wch(" ") END ;
+ IF (option = "x") & (typ^.ref > OPM.MaxStruct) THEN Wc("#"); Wi(typ^.ref - OPM.MaxStruct); Wc(" ") END;
Wstruct(typ)
END
END Wtype;
PROCEDURE WModule(name: OPS.Name; T: Texts.Text);
- VAR i: INTEGER;
- beg, end: LONGINT; first, done: BOOLEAN;
+ VAR
+ i: INTEGER;
+ beg, end: LONGINT;
+ first, done: BOOLEAN;
+ obj: OPT.Object;
PROCEDURE Header(s: ARRAY OF CHAR);
BEGIN
@@ -242,66 +223,82 @@ MODULE BrowserCmd; (* RC 29.10.93 *) (* object model 4.12.93, command line ver
ELSE Wln
END
END CheckHeader;
-
+
BEGIN
OPT.Import("@notself", name, done);
IF done THEN
- Ws("DEFINITION "); Ws(name); Wch(";"); Wln; Wln;
- Header("IMPORT"); i := 1; first := TRUE;
- WHILE i < OPT.nofGmod DO
- IF first THEN first := FALSE; Indent(2) ELSE Ws(", ") END ;
- Ws(OPT.GlbMod[i].name);
- INC(i)
- END ;
- IF ~first THEN Wch(";"); Wln END ;
+ Ws("DEFINITION "); Ws(name); Wc(";"); Wln;
+
+ IF OPT.nofGmod > 1 THEN
+ Header("IMPORT"); i := 1; first := TRUE;
+ WHILE i < OPT.nofGmod DO
+ IF first THEN first := FALSE; Indent(2) ELSE Ws(", ") END;
+ Ws(OPT.GlbMod[i].name);
+ INC(i)
+ END;
+ IF ~first THEN Wc(";"); Wln END
+ END;
CheckHeader;
- Header("CONST"); Objects(OPT.GlbMod[0].right, {Con}); CheckHeader;
- Header("TYPE"); Objects(OPT.GlbMod[0].right, {Typ}); CheckHeader;
- Header("VAR"); Objects(OPT.GlbMod[0].right, {Var}); CheckHeader;
- Objects(OPT.GlbMod[0].right, {XProc, IProc, CProc});
- Wln;
- Ws("END "); Ws(name); Wch("."); Wln; Texts.Append(T, W.buf)
+ obj := OPT.GlbMod[0].right;
+ IF HasForm(obj, {OPT.Con}) THEN Header("CONST"); Objects(obj, {OPT.Con}); CheckHeader END;
+ IF HasForm(obj, {OPT.Typ}) THEN Header("TYPE"); Objects(obj, {OPT.Typ}); CheckHeader END;
+ IF HasForm(obj, {OPT.Var}) THEN Header("VAR"); Objects(obj, {OPT.Var}); CheckHeader END;
+ Objects(obj, {OPT.XProc, OPT.IProc, OPT.CProc}); Wln;
+ Ws("END "); Ws(name); Wc("."); Wln; Texts.Append(T, W.buf)
ELSE
Texts.WriteString(W, name); Texts.WriteString(W, " -- symbol file not found");
Texts.WriteLn(W); Texts.Append(T, W.buf)
END
END WModule;
-
+
PROCEDURE Ident(VAR name, first: ARRAY OF CHAR);
- VAR i, j: INTEGER; ch: CHAR;
+ VAR i, j: INTEGER; ch: CHAR;
BEGIN i := 0;
- WHILE name[i] # 0X DO INC(i) END ;
- WHILE (i >= 0) & (name[i] # "/") DO DEC(i) END ;
+ WHILE name[i] # 0X DO INC(i) END;
+ WHILE (i >= 0) & (name[i] # "/") DO DEC(i) END;
+ IF i > 0 THEN name[i] := 0X; Files.SetSearchPath(name) END;
INC(i); j := 0; ch := name[i];
- WHILE (ch # ".") & (ch # 0X) DO first[j] := ch; INC(i); INC(j); ch := name[i] END ;
+ WHILE (ch # ".") & (ch # 0X) DO first[j] := ch; INC(i); INC(j); ch := name[i] END;
first[j] := 0X
END Ident;
PROCEDURE ShowDef*;
- VAR T, dummyT: Texts.Text; S, vname, name: OPS.Name; R: Texts.Reader; ch: CHAR;
- s: ARRAY 1024 OF CHAR; i: INTEGER;
+ VAR S, vname, name: OPS.Name;
BEGIN
option := 0X; Platform.GetArg(1, S);
IF Platform.ArgCount > 2 THEN
IF S[0] = OptionChar THEN option := S[1]; Platform.GetArg(2, S)
ELSE Platform.GetArg(2, vname); option := vname[1]
END
- END ;
+ END;
IF Platform.ArgCount >= 2 THEN
Ident(S, name);
- NEW(T); Texts.Open(T, "");
- OPT.Init(name, {}); OPT.SelfName := "AvoidErr154"; WModule(name, T); OPT.Close;
- Texts.OpenReader(R, T, 0); Texts.Read(R, ch); i := 0;
- WHILE ~R.eot DO
- IF ch = 0DX THEN s[i] := 0X; i := 0; Console.String(s); Console.Ln
- ELSE s[i] := ch; INC(i)
- END ;
- Texts.Read(R, ch)
- END ;
- s[i] := 0X; Console.String(s)
+ OPT.Init(name, {}); OPT.SelfName := "AvoidErr154";
+ WModule(name, Oberon.Log);
+ OPT.Close;
+ ELSE
+ Ws("showdef - Display module's public interface."); Wln;
+ Wln;
+ Ws("Usage: showdef module"); Wln;
+ Wln;
+ Ws("Where is a symbol file name. The .sym may be omitted."); Wln;
+ Ws("If no path is provided, and the module does not exist in the current directory,"); Wln;
+ Ws("then showdef will also look for the module in the installed libraries."); Wln;
+ Texts.Append(Oberon.Log, W.buf)
END
END ShowDef;
+PROCEDURE SetDefaultPath;
+VAR path: ARRAY 256 OF CHAR;
BEGIN
- OPT.typSize := OPV.TypSize; Texts.OpenWriter(W); ShowDef
+ path := ".;";
+ Strings.Append(Configuration.installdir, path);
+ Strings.Append("/2/sym", path);
+ Files.SetSearchPath(path)
+END SetDefaultPath;
+
+BEGIN
+ Texts.OpenWriter(W);
+ SetDefaultPath;
+ ShowDef
END BrowserCmd.
diff --git a/src/tools/make/buildall.pl b/src/tools/make/buildall.pl
index 01f262c2..0dbb0260 100755
--- a/src/tools/make/buildall.pl
+++ b/src/tools/make/buildall.pl
@@ -6,22 +6,29 @@ use Cwd;
my $branch = "master";
+
if (defined($ARGV[0]) && ($ARGV[0] ne "")) {$branch = $ARGV[0]}
my %machines = (
"pi" => ['pi@pie', "sudo", "projects/oberon/vishap/voc", "make full"],
"darwin" => ['dave@dcb', "sudo", "projects/oberon/vishap/voc", "make full"],
- "wind" => ['-p5932 dave@wax', "", "vishaps/voc", "export CC=gcc && make full;"
- . "export CC=i686-w64-mingw32-gcc && make full;"
+ "cygwin" => ['-p5932 dave@wax', "", "oberon/cygwin/voc", "export CC=gcc && make full;"
. "cd ~;"
- . "sh start64.sh \\\"cd vishaps/voc && git pull && git checkout $branch && git pull;"
- . "export CC=gcc && make full;"
- . "export CC=x86_64-w64-mingw32-gcc && make full\\\""],
+ . "sh start64.sh \\\"cd oberon/cygwin/voc && git reset --hard && git clean -dfx &&"
+ . "git pull && git checkout $branch && git pull;"
+ . "export CC=gcc && make full;\\\""],
+ "mingw" => ['-p5932 dave@wax', "", "oberon/mingw/voc", "export CC=i686-w64-mingw32-gcc && make full;"
+ . "cd ~;"
+ . "sh start64.sh \\\"cd oberon/mingw/voc && git reset --hard && git clean -dfx &&"
+ . "git pull && git checkout $branch && git pull;"
+ . "export CC=x86_64-w64-mingw32-gcc && make full;\\\""],
"android" => ['-p8022 root@and', "", "vishap/voc", "export CC=gcc && make full"],
- "lub32" => ['dave@lub32', "sudo", "vishap/voc", "make full"],
+ "lub64" => ['dave@vim', "sudo", "oberon/voc", "make full"],
+ "lub32" => ['dave@vim-lub32', "sudo", "oberon/voc", "make full"],
+ "fed64" => ['dave@vim-fed64', "sudo", "oberon/voc", "make full"],
+ "osu64" => ['dave@vim-osu64', "sudo", "oberon/voc", "make full"],
"ob32" => ['root@nas-ob32', "", "vishap/voc", "make full"],
"ce64" => ['-p5922 obe@www', "sudo", "vishap/voc", "make full"],
- "ub64" => ['dave@nas-ub64', "sudo", "vishap/voc", "make full"],
"fb64" => ['root@oberon', "", "vishap/voc", "make full"]
);
@@ -55,7 +62,8 @@ unlink glob "log/*";
for my $machine (sort keys %machines) {
my ($login, $sudo, $dir, $mkcmd) = @{$machines{$machine}};
- my $cmd = "ssh $login \"cd $dir && $sudo git pull && $sudo git checkout -f $branch && $sudo git pull && $sudo $mkcmd\" ";
+ my $cmd = "ssh $login \"cd $dir && $sudo git reset --hard && $sudo git clean -dfx &&"
+ . "$sudo git pull && $sudo git checkout -f $branch && $sudo git pull && $sudo $mkcmd\" ";
logged($cmd, $machine);
}
diff --git a/src/tools/make/configure.c b/src/tools/make/configure.c
index 312b3ca5..24b7b903 100644
--- a/src/tools/make/configure.c
+++ b/src/tools/make/configure.c
@@ -11,14 +11,13 @@
#define O_VER 1.95 // Version number to be reported by compiler.
#define O_NAME voc // Compiler name used for binary, install dir and references in text.
-// #define LARGE // Define this to get 32 bit INTEGER and 64 bit longints even on 32 bit platforms.
-
#include "SYSTEM.h"
#ifdef _WIN32
#define strncasecmp _strnicmp
+ char* getcwd(char* buf, size_t size);
#else
#include
#include
@@ -53,6 +52,7 @@ char *version = macrotostring(O_VER);
char *objext = ".o";
char *objflag = " -o ";
char *linkflags = " -L\"";
+char *libext = "";
char *oname = NULL; // From O_NAME env var if present, or O_NAME macro otherwise.
@@ -68,6 +68,7 @@ int addressSize = 0;
int intsize = 0;
int bsd = 0;
int termux = 0;
+int bootstrap = 0; // 1 iff generating a bootstrap compiler.
@@ -124,26 +125,27 @@ void determineOS() {
#endif
}
+#define optimize "" // " -O1"
void determineCCompiler() {
snprintf(libspec, sizeof(libspec), " -l %s", oname);
#if defined(__MINGW32__)
compiler = "mingw";
if (sizeof (void*) == 4) {
- cc = "i686-w64-mingw32-gcc -g";
+ cc = "i686-w64-mingw32-gcc -g" optimize;
} else {
- cc = "x86_64-w64-mingw32-gcc -g";
+ cc = "x86_64-w64-mingw32-gcc -g" optimize;
}
#elif defined(__clang__)
compiler = "clang";
- cc = "clang -fPIC -g";
+ cc = "clang -fPIC -g" optimize;
#elif defined(__GNUC__)
compiler = "gcc";
if (strncasecmp(os, "cygwin", 6) == 0) {
// Avoid cygwin specific warning that -fPIC is ignored.
- cc = "gcc -g";
+ cc = "gcc -g" optimize;
} else {
- cc = "gcc -fPIC -g";
+ cc = "gcc -fPIC -g" optimize;
}
#elif defined(_MSC_VER)
compiler = "MSC";
@@ -151,7 +153,8 @@ void determineCCompiler() {
objext = ".obj";
objflag = " -Fe";
linkflags = " -link -libpath:\"";
- snprintf(libspec, sizeof(libspec), " lib%s.lib", oname);
+ snprintf(libspec, sizeof(libspec), " lib%s", oname);
+ libext = ".lib";
#else
fail("Unrecognised C compiler.");
#endif
@@ -160,28 +163,32 @@ void determineCCompiler() {
void determineInstallDirectory() {
- char *env = getenv("INSTALLDIR");
- if (env) {
- strncpy(installdir, env, sizeof(installdir));
+ if (bootstrap) {
+ installdir[0] = 0;
} else {
- #if defined(_MSC_VER) || defined(__MINGW32__)
- if (sizeof (void*) == 8) {
- snprintf(installdir, sizeof(installdir), "%s\\%s", getenv("ProgramFiles"), oname);
- } else {
- snprintf(installdir, sizeof(installdir), "%s\\%s", getenv("ProgramFiles(x86)"), oname);
- }
- #if defined(__MINGW32__)
- int i; for(i=0; installdir[i]; i++) if (installdir[i] == '\\') installdir[i] = '/';
+ char *env = getenv("INSTALLDIR");
+ if (env) {
+ strncpy(installdir, env, sizeof(installdir));
+ } else {
+ #if defined(_MSC_VER) || defined(__MINGW32__)
+ if (sizeof (void*) == 8) {
+ snprintf(installdir, sizeof(installdir), "%s\\%s", getenv("ProgramFiles"), oname);
+ } else {
+ snprintf(installdir, sizeof(installdir), "%s\\%s", getenv("ProgramFiles(x86)"), oname);
+ }
+ #if defined(__MINGW32__)
+ int i; for(i=0; installdir[i]; i++) if (installdir[i] == '\\') installdir[i] = '/';
+ #endif
+ #else
+ if (bsd) {
+ snprintf(installdir, sizeof(installdir), "/usr/local/share/%s", oname);
+ } else if (termux) {
+ snprintf(installdir, sizeof(installdir), "/data/data/com.termux/files/opt/%s", oname);
+ } else {
+ snprintf(installdir, sizeof(installdir), "/opt/%s", oname);
+ }
#endif
- #else
- if (bsd) {
- snprintf(installdir, sizeof(installdir), "/usr/local/share/%s", oname);
- } else if (termux) {
- snprintf(installdir, sizeof(installdir), "/data/data/com.termux/files/opt/%s", oname);
- } else {
- snprintf(installdir, sizeof(installdir), "/opt/%s", oname);
- }
- #endif
+ }
}
}
@@ -212,10 +219,10 @@ void determineBuildDate() {
struct {char ch; CHAR x;} c;
struct {char ch; BOOLEAN x;} b;
-struct {char ch; SHORTINT x;} si;
-struct {char ch; INTEGER x;} i;
-struct {char ch; LONGINT x;} li;
-struct {char ch; SET x;} s;
+//struct {char ch; SHORTINT x;} si;
+//struct {char ch; INTEGER x;} i;
+//struct {char ch; LONGINT x;} li;
+//struct {char ch; SET x;} s;
struct {char ch; REAL x;} r;
struct {char ch; LONGREAL x;} lr;
struct {char ch; void* x;} p;
@@ -246,10 +253,10 @@ void ReportSizesAndAlignments() {
printf("Type Size Align\n");
printf("CHAR %4zd %4td\n", sizeof(CHAR), (char*)&c.x - (char*)&c);
printf("BOOLEAN %4zd %4td\n", sizeof(BOOLEAN), (char*)&b.x - (char*)&b);
- printf("SHORTINT %4zd %4td\n", sizeof(SHORTINT), (char*)&si.x - (char*)&si);
- printf("INTEGER %4zd %4td\n", sizeof(INTEGER), (char*)&i.x - (char*)&i);
- printf("LONGINT %4zd %4td\n", sizeof(LONGINT), (char*)&li.x - (char*)&li);
- printf("SET %4zd %4td\n", sizeof(SET), (char*)&s.x - (char*)&s);
+//printf("SHORTINT %4zd %4td\n", sizeof(SHORTINT), (char*)&si.x - (char*)&si);
+//printf("INTEGER %4zd %4td\n", sizeof(INTEGER), (char*)&i.x - (char*)&i);
+//printf("LONGINT %4zd %4td\n", sizeof(LONGINT), (char*)&li.x - (char*)&li);
+//printf("SET %4zd %4td\n", sizeof(SET), (char*)&s.x - (char*)&s);
printf("REAL %4zd %4td\n", sizeof(REAL), (char*)&r.x - (char*)&r);
printf("LONGREAL %4zd %4td\n", sizeof(LONGREAL), (char*)&lr.x - (char*)&lr);
printf("void* %4zd %4td\n", sizeof(void*), (char*)&p.x - (char*)&p);
@@ -311,8 +318,14 @@ void testSystemDotH() {
/* test the __SETRNG macro */
long x = 0;
- long y = sizeof(SET)*8 - 1;
- assert(__SETRNG(x, y) == -1, "SETRNG(0, MAX(SET)) != -1.");
+ long y;
+ y=31; assert(__SETRNG(x, y, 32) == -1, "SETRNG(0, MAX(SET), 32) != -1.");
+ y=63; assert(__SETRNG(x, y, 64) == -1, "SETRNG(0, MAX(SET), 32) != -1.");
+// long y = sizeof(SET)*8 - 1;
+// if (sizeof(SET) == 4)
+// assert(__SETRNG(x, y, 32) == -1, "SETRNG(0, MAX(SET)) != -1.");
+// else
+// assert(__SETRNG(x, y, 64) == -1, "SETRNG(0, MAX(SET)) != -1.");
/* test string comparison for extended ascii */
{char a[10], b[10];
@@ -326,12 +339,12 @@ void testSystemDotH() {
assert(sizeof(CHAR) == 1, "Size of CHAR not 1.");
assert(sizeof(BOOLEAN) == 1, "Size of BOOLEAN not 1.");
- assert(sizeof(SHORTINT) == 1, "Size of SHORTINT not 1.");
- assert(sizeof(INTEGER) == 2
- || sizeof(INTEGER) == 4, "Size of INTEGER neither 2 nor 4 bytes.");
- assert(sizeof(LONGINT) == 4
- || sizeof(LONGINT) == 8, "Size of LONGINT neither 4 nor 8 bytes.");
- assert(sizeof(SET) == sizeof(LONGINT), "Size of SET differs from size of LONGINT.");
+//assert(sizeof(SHORTINT) == 1, "Size of SHORTINT not 1.");
+//assert(sizeof(INTEGER) == 2
+// || sizeof(INTEGER) == 4, "Size of INTEGER neither 2 nor 4 bytes.");
+//assert(sizeof(LONGINT) == 4
+// || sizeof(LONGINT) == 8, "Size of LONGINT neither 4 nor 8 bytes.");
+//assert(sizeof(SET) == sizeof(LONGINT), "Size of SET differs from size of LONGINT.");
assert(sizeof(REAL) == 4, "Size of REAL not 4 bytes.");
assert(sizeof(LONGREAL) == 8, "Size of LONGREAL not 8 bytes.");
assert(sizeof(f.x) == sizeof(p.x), "Size of function pointer differs from size of data pointer.");
@@ -340,19 +353,20 @@ void testSystemDotH() {
assert(((char*)&c.x - (char*)&c) == 1, "Alignment of CHAR not 1.");
assert(((char*)&b.x - (char*)&b) == 1, "Alignment of BOOLEAN not 1.");
- assert(((char*)&si.x - (char*)&si) == 1, "Alignment of SHORTINT not 1.");
- //assert(((char*)&i.x - (char*)&i) == 4, "Alignment of INTEGER not 4 bytes.");
+//assert(((char*)&si.x - (char*)&si) == 1, "Alignment of SHORTINT not 1.");
+//assert(((char*)&i.x - (char*)&i) == 4, "Alignment of INTEGER not 4 bytes.");
assert(((char*)&r.x - (char*)&r) == 4, "Alignment of REAL not 4 bytes.");
assert(((char*)&lr.x - (char*)&lr) >= 4, "Alignment of LONGREAL less than 4 bytes.");
- assert(((char*)&s.x - (char*)&s) == MIN(alignment, sizeof(SET)), "Alignment of SET differs from alignmnet of LONGINT.");
+//assert(((char*)&s.x - (char*)&s) == MIN(alignment, sizeof(SET)), "Alignment of SET differs from alignmnet of LONGINT.");
assert(((char*)&p.x - (char*)&p) == addressSize, "Alignment of data pointer differs from address size.");
assert(((char*)&f.x - (char*)&f) == addressSize, "Alignment of data pointer differs from address size.");
+ assert(((char*)&lr.x - (char*)&lr) == ((char*)&ll.x - (char*)&ll), "Alignment of LONGREAL differs from alignment of long long.");
assert(sizeof(rec0) == 1, "CHAR wrapped in record aligns differently to CHAR alone.");
assert(sizeof(rec2) == 65, "CHAR array wrapped in record aligns differently to CHAR array alone.");
- assert(sizeof(LONGINT) >= sizeof(p.x), "LONGINT should have at least the same size as data pointers.");
- assert(sizeof(LONGINT) >= sizeof(f.x), "LONGINT should have at least the same size as function pointers.");
+//assert(sizeof(LONGINT) >= sizeof(p.x), "LONGINT should have at least the same size as data pointers.");
+//assert(sizeof(LONGINT) >= sizeof(f.x), "LONGINT should have at least the same size as function pointers.");
if (((sizeof(rec2)==65) == (sizeof(rec0)==1)) && ((sizeof(rec2)-64) != sizeof(rec0)))
printf("error: unsupported record layout sizeof(rec0) = %lu sizeof(rec2) = %lu\n", (long)sizeof(rec0), (long)sizeof(rec2));
@@ -373,7 +387,6 @@ void writeMakeParameters() {
fprintf(fd, "VERSION=%s\n", version);
fprintf(fd, "ONAME=%s\n", oname);
fprintf(fd, "DATAMODEL=%s\n", dataModel);
- fprintf(fd, "INTSIZE=%d\n", intsize);
fprintf(fd, "ADRSIZE=%d\n", addressSize);
fprintf(fd, "ALIGNMENT=%d\n", alignment);
fprintf(fd, "INSTALLDIR=%s\n", installdir);
@@ -395,15 +408,12 @@ void writeConfigurationMod() {
fprintf(fd, "MODULE Configuration;\n");
fprintf(fd, "CONST\n");
fprintf(fd, " name* = '%s';\n", oname);
- fprintf(fd, " intsize* = %d;\n", intsize);
- fprintf(fd, " addressSize* = %d;\n", addressSize);
- fprintf(fd, " alignment* = %d;\n", alignment);
fprintf(fd, " objext* = '%s';\n", objext);
fprintf(fd, " objflag* = '%s';\n", objflag);
fprintf(fd, " linkflags* = '%s';\n", linkflags);
fprintf(fd, " libspec* = '%s';\n", libspec);
+ fprintf(fd, " libext* = '%s';\n", libext);
fprintf(fd, " compile* = '%s';\n", cc);
- fprintf(fd, " dataModel* = '%s';\n", dataModel);
fprintf(fd, " installdir* = '%s';\n", installdir);
fprintf(fd, " staticLink* = '%s';\n", staticlink);
fprintf(fd, "VAR\n");
@@ -420,11 +430,21 @@ void writeConfigurationMod() {
int main(int argc, char *argv[])
{
+ // Make sure SYSTEM.h has set up our core data types correctly.
+ assert(sizeof(INT8) == 1, "sizeof(INT8) is not 1.");
+ assert(sizeof(INT16) == 2, "sizeof(INT16) is not 2.");
+ assert(sizeof(INT32) == 4, "sizeof(INT32) is not 4.");
+ assert(sizeof(INT64) == 8, "sizeof(INT64) is not 8.");
+
oname = getenv("ONAME"); if (!oname) oname = macrotostring(O_NAME);
if (argc>1) {
- ReportSizesAndAlignments();
- exit(0);
+ if (strncasecmp(argv[1], "rep", 3) == 0) {
+ ReportSizesAndAlignments();
+ exit(0);
+ } else {
+ bootstrap = 1;
+ }
}
getcwd(cwd, sizeof(cwd));
@@ -439,9 +459,15 @@ int main(int argc, char *argv[])
testSystemDotH();
- snprintf(versionstring, sizeof(versionstring),
- "%s [%s] for %s %s on %s",
- version, builddate, compiler, dataModel, os);
+ if (bootstrap) {
+ snprintf(versionstring, sizeof(versionstring),
+ "%s [%s]. Bootstrapping compiler for address size %d, alignment %d.",
+ version, builddate, addressSize, alignment);
+ } else {
+ snprintf(versionstring, sizeof(versionstring),
+ "%s [%s] for %s %s on %s",
+ version, builddate, compiler, dataModel, os);
+ }
writeConfigurationMod();
writeMakeParameters();
diff --git a/src/tools/make/ignore b/src/tools/make/ignore
new file mode 100644
index 00000000..42554f00
--- /dev/null
+++ b/src/tools/make/ignore
@@ -0,0 +1,7 @@
+^/\* voc +
+Configuration_
+OPM_ResourceDir
+__MOVE.* cmd,
+OPM_(IntSize|PointerSize|Alignment) =
+Strings_Append.+void\*\)(cmd|OPM_OBERON|extTools_comp)
+__COPY\("(gcc|clang|msc|i686-w64-mingw|x86_64-w64-mingw)
diff --git a/src/tools/make/oberon.mk b/src/tools/make/oberon.mk
new file mode 100644
index 00000000..796cb8d5
--- /dev/null
+++ b/src/tools/make/oberon.mk
@@ -0,0 +1,405 @@
+# DO NOT RUN THIS MAKEFILE DIRECTLY.
+#
+# Always use the makefile in the root of the enlistment. This makefile
+# depends on up to date configuration files generated by the root makefile.
+
+
+
+
+# Be independent of any CFLAGS settings in the calling environment
+CFLAGS =
+
+# Gnu make has the make initial directory in CURDIR, BSD make has it in .CURDIR.
+ROOTDIR = $(CURDIR)$(.CURDIR)
+
+# Configuration.Make is created by src/tools/make/configure.c, which is run on
+# *every* build by the makefile in the enlistment root.
+include ./Configuration.Make
+
+FLAVOUR = $(OS).$(DATAMODEL).$(COMPILER)
+BUILDDIR = build/$(FLAVOUR)
+OBECOMP = $(ONAME)$(BINEXT)
+
+
+
+# Default make target - explain usage
+usage:
+ @echo ""
+ @echo Do not run this makefile directly, always run the makefile in
+ @echo the root of the enlistment.
+
+
+
+
+clean:
+ @printf "\n\n--- Cleaning branch $(BRANCH) $(OS) $(COMPILER) $(DATAMODEL) ---\n\n"
+ rm -rf $(BUILDDIR)
+ rm -f $(OBECOMP)
+
+
+
+
+# Assemble: Generate the Vishap Oberon compiler binary by compiling the C sources in the build directory
+
+assemble:
+ @printf "\nmake assemble - compiling Oberon compiler c source:\n"
+ @printf " VERSION: %s\n" "$(VERSION)"
+ @printf " BRANCH: %s\n" "$(BRANCH)"
+ @printf " Target characteristics:\n"
+ @printf " PLATFORM: %s\n" "$(PLATFORM)"
+ @printf " OS: %s\n" "$(OS)"
+ @printf " BUILDDIR: %s\n" "$(BUILDDIR)"
+ @printf " INSTALLDIR: %s\n" "$(INSTALLDIR)"
+ @printf " Oberon characteristics:\n"
+ @printf " MODEL: %s\n" "$(MODEL)"
+ @printf " ADRSIZE: %s\n" "$(ADRSIZE)"
+ @printf " ALIGNMENT: %s\n" "$(ALIGNMENT)"
+ @printf " C compiler:\n"
+ @printf " COMPILER: %s\n" "$(COMPILER)"
+ @printf " COMPILE: %s\n" "$(COMPILE)"
+ @printf " DATAMODEL: %s\n" "$(DATAMODEL)"
+
+ cd $(BUILDDIR) && $(COMPILE) -c SYSTEM.c Configuration.c Platform.c Heap.c
+ cd $(BUILDDIR) && $(COMPILE) -c Out.c Strings.c Modules.c Files.c
+ cd $(BUILDDIR) && $(COMPILE) -c Reals.c Texts.c VT100.c
+ cd $(BUILDDIR) && $(COMPILE) -c OPM.c extTools.c OPS.c OPT.c
+ cd $(BUILDDIR) && $(COMPILE) -c OPC.c OPV.c OPB.c OPP.c
+
+ cd $(BUILDDIR) && $(COMPILE) $(STATICLINK) Compiler.c -o $(ROOTDIR)/$(OBECOMP) \
+ SYSTEM.o Configuration.o Platform.o Heap.o Out.o Strings.o \
+ Modules.o Files.o Reals.o Texts.o VT100.o extTools.o \
+ OPM.o OPS.o OPT.o OPC.o OPV.o OPB.o OPP.o
+
+ cp src/runtime/*.[ch] $(BUILDDIR)
+ cp src/runtime/*.Txt $(BUILDDIR)
+ cp src/runtime/*.Txt $(ROOTDIR)
+ @printf "$(OBECOMP) created.\n"
+
+
+
+
+compilerfromsavedsource:
+ @echo Populating clean build directory from bootstrap C sources $(PLATFORM)-$(ADRSIZE)$(ALIGNMENT).
+ @mkdir -p $(BUILDDIR)
+ @cp bootstrap/$(PLATFORM)-$(ADRSIZE)$(ALIGNMENT)/* $(BUILDDIR)
+ @cp bootstrap/*.[ch] $(BUILDDIR)
+ @make -f src/tools/make/oberon.mk -s assemble
+ @cp bootstrap/*.[ch] $(BUILDDIR)
+
+
+
+
+translate:
+# Make sure we have an oberon compiler binary: if we built one earlier we'll use it,
+# otherwise use one of the pre-prepared sets of C sources in the bootstrap directory.
+
+ if [ ! -e $(OBECOMP) ]; then make -f src/tools/make/oberon.mk -s compilerfromsavedsource; fi
+
+ @printf "\nmake translate - translating compiler source from Oberon to C:\n"
+ @printf " PLATFORM: %s\n" $(PLATFORM)
+ @printf " MODEL: %s\n" $(MODEL)
+ @printf " ADRSIZE: %s\n" $(ADRSIZE)
+ @printf " ALIGNMENT: %s\n" $(ALIGNMENT)
+ @mkdir -p $(BUILDDIR)
+ @rm -f $(BUILDDIR)/*.sym
+
+ cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../Configuration.Mod
+ cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Platform$(PLATFORM).Mod
+ cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsFapx -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Heap.Mod
+ cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Strings.Mod
+ cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Out.Mod
+ cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Modules.Mod
+ cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsFx -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Files.Mod
+ cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Reals.Mod
+ cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Texts.Mod
+ cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/VT100.Mod
+ cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/OPM.Mod
+ cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/extTools.Mod
+ cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsFx -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/OPS.Mod
+ cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/OPT.Mod
+ cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/OPC.Mod
+ cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/OPV.Mod
+ cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/OPB.Mod
+ cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/OPP.Mod
+ cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -Ssm -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/Compiler.Mod
+
+ cp src/runtime/*.[ch] $(BUILDDIR)
+ cp src/runtime/*.Txt $(BUILDDIR)
+ @printf "$(BUILDDIR) filled with compiler C source.\n"
+
+
+
+
+browsercmd:
+ @printf "\nMaking symbol browser\n"
+ @cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -Ss -O$(MODEL) ../../src/runtime/Oberon.Mod
+ @cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -Sm -O$(MODEL) ../../src/tools/browser/BrowserCmd.Mod
+ @cd $(BUILDDIR); $(COMPILE) BrowserCmd.c Oberon.c -o showdef \
+ Platform.o Texts.o OPT.o Heap.o Out.o SYSTEM.o OPM.o OPS.o OPV.o \
+ Files.o Reals.o Modules.o VT100.o Configuration.o Strings.o \
+ OPC.o
+
+
+
+
+FORCE:
+
+# installable: Check for access to the installation directory
+
+installable:
+ @rm -rf "S(INSTALLDIR)/test-access-qqq"
+ @if ! mkdir -p "$(INSTALLDIR)/test-access-qqq";then echo "\\n\\n Cannot write to install directory.\\n Please use sudo or run as root/administrator.\\n\\n"; exit 1;fi
+ @rm -rf "S(INSTALLDIR)/test-access-qqq"
+
+
+
+
+# install: Use only after a successful full build. Installs the compiler
+# and libraries in /opt/$(ONAME).
+# May require root access.
+install:
+ @printf "\nInstalling into \"$(INSTALLDIR)\"\n"
+ @rm -rf "$(INSTALLDIR)"
+
+ @mkdir -p "$(INSTALLDIR)/bin"
+ @cp $(OBECOMP) "$(INSTALLDIR)/bin/$(OBECOMP)"
+ @-cp $(BUILDDIR)/showdef$(BINEXT) "$(INSTALLDIR)/bin"
+
+ @mkdir -p "$(INSTALLDIR)/2/include" && cp $(BUILDDIR)/2/*.h "$(INSTALLDIR)/2/include/"
+ @mkdir -p "$(INSTALLDIR)/2/sym" && cp $(BUILDDIR)/2/*.sym "$(INSTALLDIR)/2/sym/"
+ @mkdir -p "$(INSTALLDIR)/C/include" && cp $(BUILDDIR)/C/*.h "$(INSTALLDIR)/C/include/"
+ @mkdir -p "$(INSTALLDIR)/C/sym" && cp $(BUILDDIR)/C/*.sym "$(INSTALLDIR)/C/sym/"
+
+ @cp $(BUILDDIR)/*.Txt "$(INSTALLDIR)/2/sym/"
+ @cp $(BUILDDIR)/*.Txt "$(INSTALLDIR)/C/sym/"
+
+ @mkdir -p "$(INSTALLDIR)/lib"
+ @cp $(BUILDDIR)/2/lib$(ONAME)* "$(INSTALLDIR)/lib/"
+ @cp $(BUILDDIR)/C/lib$(ONAME)* "$(INSTALLDIR)/lib/"
+ @if which ldconfig >/dev/null 2>&1; then $(LDCONFIG); fi
+
+
+
+
+# showpath: Describe how to set the PATH variable
+showpath:
+ @printf "\nNow add $(INSTALLDIR)/bin to your path, for example with the command:\n"
+ @printf "export PATH=\"$(INSTALLDIR)/bin:\$$PATH\"\n"
+ @printf "\n"
+
+
+
+
+uninstall:
+ @printf "\nUninstalling from \"$(INSTALLDIR)\"\n"
+ rm -rf "$(INSTALLDIR)"
+ rm -f /etc/ld.so.conf/lib$(ONAME)
+ if which ldconfig >/dev/null 2>&1; then ldconfig; fi
+
+
+runtime:
+ @printf "\nMaking run time library for -O$(MODEL)\n"
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/Platform$(PLATFORM).Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/Heap.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/Modules.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/Strings.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/Out.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/In.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/VT100.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/Files.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/Math.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/MathL.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/Reals.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/Texts.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/Oberon.Mod
+
+
+v4:
+ @printf "\nMaking v4 library for -O$(MODEL)\n"
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/v4/Args.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/v4/Console.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/v4/Printer.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/v4/Sets.Mod
+
+ooc2:
+ @printf "\nMaking ooc2 library for -O$(MODEL)\n"
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc2/ooc2Strings.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc2/ooc2Ascii.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc2/ooc2CharClass.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc2/ooc2ConvTypes.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc2/ooc2IntConv.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc2/ooc2IntStr.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc2/ooc2Real0.Mod
+
+ooc:
+ @printf "\nMaking ooc library for -O$(MODEL)\n"
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocLowReal.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocLowLReal.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocRealMath.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocOakMath.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocLRealMath.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocLongInts.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocComplexMath.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocLComplexMath.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocAscii.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocCharClass.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocStrings.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocConvTypes.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocLRealConv.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocLRealStr.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocRealConv.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocRealStr.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocIntConv.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocIntStr.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocMsg.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocSysClock.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocTime.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocChannel.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocStrings2.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocRts.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocFilenames.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocTextRider.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocBinaryRider.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocJulianDay.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocFilenames.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocwrapperlibc.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocC$(DATAMODEL).Mod
+
+oocX11:
+ @printf "\nMaking oocX11 library for -O$(MODEL)\n"
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/oocX11/oocX11.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/oocX11/oocXutil.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/oocX11/oocXYplane.Mod
+
+ulm:
+ @printf "\nMaking ulm library for -O$(MODEL)\n"
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmObjects.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmPriorities.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmDisciplines.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmServices.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmSys.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmSYSTEM.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmEvents.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmProcess.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmResources.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmForwarders.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmRelatedEvents.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmTypes.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmStreams.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmStrings.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmSysTypes.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmTexts.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmSysConversions.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmErrors.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmSysErrors.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmSysStat.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmASCII.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmSets.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmIO.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmAssertions.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmIndirectDisciplines.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmStreamDisciplines.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmIEEE.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmMC68881.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmReals.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmPrint.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmWrite.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmConstStrings.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmPlotters.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmSysIO.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmLoader.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmNetIO.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmPersistentObjects.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmPersistentDisciplines.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmOperations.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmScales.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmTimes.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmClocks.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmTimers.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmConditions.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmStreamConditions.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmTimeConditions.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmCiphers.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmCipherOps.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmBlockCiphers.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmAsymmetricCiphers.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmConclusions.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmRandomGenerators.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmTCrypt.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmIntOperations.Mod
+
+pow32:
+ @printf "\nMaking pow library for -O$(MODEL)\n"
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/pow/powStrings.Mod
+
+misc:
+ @printf "\nMaking misc library for -O$(MODEL)\n"
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/misc/crt.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/misc/Listen.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/misc/MersenneTwister.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/misc/MultiArrays.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/misc/MultiArrayRiders.Mod
+
+s3:
+ @printf "\nMaking s3 library for -O$(MODEL)\n"
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethBTrees.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethMD5.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethSets.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethZlib.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethZlibBuffers.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethZlibInflate.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethZlibDeflate.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethZlibReaders.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethZlibWriters.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethZip.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethRandomNumbers.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethGZReaders.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethGZWriters.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethUnicode.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethDates.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethReals.Mod
+ cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethStrings.Mod
+
+
+
+
+O2library: runtime v4 ooc2 ooc ulm pow32 misc s3
+
+OClibrary: runtime
+
+library:
+ @printf "\nCompiling lib$(ONAME)-O$(MODEL) sources\n"
+ rm -rf $(BUILDDIR)/$(MODEL)
+ mkdir -p $(BUILDDIR)/$(MODEL)
+ cp $(BUILDDIR)/SYSTEM.[ho] $(BUILDDIR)/$(MODEL)
+ cp $(BUILDDIR)/WindowsWrapper.h $(BUILDDIR)/$(MODEL)
+ @make -f src/tools/make/oberon.mk -s O$(MODEL)library MODEL=$(MODEL)
+ @printf "\nMaking lib$(ONAME)-O$(MODEL) .a and .so\n"
+ ar rcs "$(BUILDDIR)/$(MODEL)/lib$(ONAME)-O$(MODEL).a" $(BUILDDIR)/$(MODEL)/*.o
+ @cd $(BUILDDIR)/$(MODEL) && $(COMPILE) -shared -o lib$(ONAME)-O$(MODEL).so *.o
+
+
+
+sourcechanges:
+ @cd $(BUILDDIR) && sh $(ROOTDIR)/src/tools/make/sourcechanges.sh $(ROOTDIR)/bootstrap/$(PLATFORM)-$(ADRSIZE)$(ALIGNMENT)
+
+
+
+
+RUNTEST = COMPILER=$(COMPILER) OBECOMP="$(OBECOMP) -O$(MODEL)" FLAVOUR=$(FLAVOUR) BRANCH=$(BRANCH) sh ./test.sh "$(INSTALLDIR)"
+
+confidence:
+ @printf "\n\n--- Confidence tests ---\n\n"
+ cd src/test/confidence/hello; $(RUNTEST)
+ cd src/test/confidence/out; $(RUNTEST)
+ cd src/test/confidence/in; $(RUNTEST)
+ cd src/test/confidence/math; $(RUNTEST)
+ cd src/test/confidence/intsyntax; $(RUNTEST)
+ cd src/test/confidence/language; $(RUNTEST)
+ cd src/test/confidence/arrayassignment; $(RUNTEST)
+ cd src/test/confidence/texts; $(RUNTEST)
+ cd src/test/confidence/library; $(RUNTEST)
+ cd src/test/confidence/isptest; $(RUNTEST)
+ cd src/test/confidence/lola; $(RUNTEST)
+ if [ "$(PLATFORM)" != "windows" ] ; then cd src/test/confidence/signal; $(RUNTEST); fi
+ @printf "\n\n--- Confidence tests passed ---\n\n"
diff --git a/src/tools/make/postpush.pl b/src/tools/make/postpush.pl
index fe9e62ad..5bfe0ffb 100755
--- a/src/tools/make/postpush.pl
+++ b/src/tools/make/postpush.pl
@@ -1,11 +1,9 @@
#!/usr/bin/perl -w
-
use strict;
use warnings;
use POSIX "strftime";
-
use CGI qw(:standard escapeHTML);
use JSON;
@@ -17,6 +15,7 @@ sub writelog {
flock(LOG, 2) or die "Could not lock postpush.log";
print LOG sprintf("%s %s\n", strftime("%Y/%m/%d %H.%M.%S", localtime), $msg);
close(LOG);
+ system "id >> /tmp/postpush.log";
}
my $postdata = from_json(param('POSTDATA'));
@@ -43,7 +42,7 @@ if ($buildneeded) {
} else {
close(STDIN); close(STDOUT); close(STDERR); # child process
system 'echo Syncing voc>postpush.log';
- system '(cd voc; git pull; git checkout -f ' . $branch . '; git pull; git checkout -f) >>postpush.log';
+ system '(cd voc; git reset --hard; git clean -dfx; git pull; git checkout -f ' . $branch . '; git pull; git checkout -f) >>postpush.log';
exec 'perl voc/src/tools/make/buildall.pl ' . $branch . ' >/tmp/buildall.log';
exit;
}
diff --git a/src/tools/make/sourcechanges.sh b/src/tools/make/sourcechanges.sh
index 08aa873b..1439ce4e 100644
--- a/src/tools/make/sourcechanges.sh
+++ b/src/tools/make/sourcechanges.sh
@@ -14,8 +14,8 @@
changes="0"
for f in $1/*; do
fn=$(basename $f)
- egrep -v "(^/\* voc +)|Configuration_|__MOVE.* cmd, |OPM_(IntSize|PointerSize|Alignment) =|Strings_Append.+void\*\)(cmd|OPM_OBERON|extTools_comp)" $f >$fn.old
- egrep -v "(^/\* voc +)|Configuration_|__MOVE.* cmd, |OPM_(IntSize|PointerSize|Alignment) =|Strings_Append.+void\*\)(cmd|OPM_OBERON|extTools_comp)" $fn >$fn.new
+ egrep -v -f ../../src/tools/make/ignore $f >$fn.old
+ egrep -v -f ../../src/tools/make/ignore $fn >$fn.new
if ! diff -U 2 -b $fn.old $fn.new >$fn.diff; then
echo ""
echo ""
diff --git a/src/tools/make/vishap.make b/src/tools/make/vishap.make
deleted file mode 100644
index 17bb1b95..00000000
--- a/src/tools/make/vishap.make
+++ /dev/null
@@ -1,403 +0,0 @@
-# DO NOT RUN THIS MAKEFILE DIRECTLY.
-#
-# Always use the makefile in the root of the enlistment. This makefile
-# depends on up to date configuration files generated by the root makefile.
-
-
-
-
-# Be independent of any CFLAGS settings in the calling environment
-CFLAGS =
-
-# Gnu make has the make initial directory in CURDIR, BSD make has it in .CURDIR.
-ROOTDIR = $(CURDIR)$(.CURDIR)
-
-# Configuration.Make is created by src/tools/make/configure.c, which is run on
-# *every* build by the makefile in the enlistment root.
-include ./Configuration.Make
-
-FLAVOUR = $(OS).$(DATAMODEL).$(COMPILER)
-BUILDDIR = build/$(FLAVOUR)
-VISHAP = $(ONAME)$(BINEXT)
-
-
-
-
-# Default make target - explain usage
-usage:
- @echo ""
- @echo Do not run this makefile directly, always run the makefile in
- @echo the root of the enlistment.
-
-
-
-
-clean:
- @printf "\n\n--- Cleaning branch $(BRANCH) $(OS) $(COMPILER) $(DATAMODEL) ---\n\n"
- rm -rf $(BUILDDIR)
- rm -f $(VISHAP)
-
-
-
-
-# Assemble: Generate the Vishap Oberon compiler binary by compiling the C sources in the build directory
-
-assemble:
- @printf "\nmake assemble - compiling Oberon compiler c source:\n"
- @printf " VERSION: %s\n" "$(VERSION)"
- @printf " BRANCH: %s\n" "$(BRANCH)"
- @printf " Target characteristics:\n"
- @printf " PLATFORM: %s\n" "$(PLATFORM)"
- @printf " OS: %s\n" "$(OS)"
- @printf " BUILDDIR: %s\n" "$(BUILDDIR)"
- @printf " INSTALLDIR: %s\n" "$(INSTALLDIR)"
- @printf " Oberon characteristics:\n"
- @printf " INTSIZE: %s\n" "$(INTSIZE)"
- @printf " ADRSIZE: %s\n" "$(ADRSIZE)"
- @printf " ALIGNMENT: %s\n" "$(ALIGNMENT)"
- @printf " C compiler:\n"
- @printf " COMPILER: %s\n" "$(COMPILER)"
- @printf " COMPILE: %s\n" "$(COMPILE)"
- @printf " DATAMODEL: %s\n" "$(DATAMODEL)"
-
- cd $(BUILDDIR) && $(COMPILE) -c SYSTEM.c Configuration.c Platform.c Heap.c
- cd $(BUILDDIR) && $(COMPILE) -c Console.c Strings.c Modules.c Files.c
- cd $(BUILDDIR) && $(COMPILE) -c Reals.c Texts.c vt100.c errors.c
- cd $(BUILDDIR) && $(COMPILE) -c OPM.c extTools.c OPS.c OPT.c
- cd $(BUILDDIR) && $(COMPILE) -c OPC.c OPV.c OPB.c OPP.c
-
- cd $(BUILDDIR) && $(COMPILE) $(STATICLINK) Vishap.c -o $(ROOTDIR)/$(VISHAP) \
- SYSTEM.o Configuration.o Platform.o Heap.o Console.o Strings.o Modules.o Files.o \
- Reals.o Texts.o vt100.o errors.o OPM.o extTools.o OPS.o OPT.o \
- OPC.o OPV.o OPB.o OPP.o
- @printf "$(VISHAP) created.\n"
-
-
-
-
-compilerfromsavedsource:
- @echo Populating clean build directory from bootstrap C sources.
- @mkdir -p $(BUILDDIR)
- @cp bootstrap/$(PLATFORM)-$(ADRSIZE)$(ALIGNMENT)/* $(BUILDDIR)
- @make -f src/tools/make/vishap.make -s assemble
-
-
-
-
-translate:
-# Make sure we have an oberon compiler binary: if we built one earlier we'll use it,
-# otherwise use one of the pre-prepared sets of C sources in the bootstrap directory.
-
- if [ ! -e $(VISHAP) ]; then make -f src/tools/make/vishap.make -s compilerfromsavedsource; fi
-
- @printf "\nmake translate - translating compiler source from Oberon to C:\n"
- @printf " PLATFORM: %s\n" $(PLATFORM)
- @printf " INTSIZE: %s\n" $(INTSIZE)
- @printf " ADRSIZE: %s\n" $(ADRSIZE)
- @printf " ALIGNMENT: %s\n" $(ALIGNMENT)
- @mkdir -p $(BUILDDIR)
-
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../Configuration.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/system/Platform$(PLATFORM).Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfFapx -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/system/Heap.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/system/Console.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/library/v4/Strings.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/library/v4/Modules.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfFx -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/system/Files.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/library/v4/Reals.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/library/v4/Texts.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/library/misc/vt100.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/compiler/errors.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/compiler/OPM.cmdln.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/compiler/extTools.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfFx -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/compiler/OPS.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/compiler/OPT.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/compiler/OPC.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/compiler/OPV.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/compiler/OPB.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/compiler/OPP.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ssfm -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/compiler/Vishap.Mod
-
- cp src/system/*.[ch] $(BUILDDIR)
-
- @printf "$(BUILDDIR) filled with compiler C source.\n"
-
-
-
-
-browsercmd:
- @printf "\nMaking symbol browser\n"
- @cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -fSm ../../src/tools/browser/BrowserCmd.Mod
- @cd $(BUILDDIR); $(COMPILE) BrowserCmd.c -o showdef \
- Platform.o Texts.o OPT.o Heap.o Console.o SYSTEM.o OPM.o OPS.o OPV.o \
- Files.o Reals.o Modules.o vt100.o errors.o Configuration.o Strings.o \
- OPC.o
-
-
-
-
-FORCE:
-
-testcoordinator: FORCE
- @rm -f testcoordinator.exe testclient.exe
- @make -f src/tools/make/vishap.make -s testtools
-
-
-testtools:
- @printf "\nMaking test coordinator\n"
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SfFs ../../src/tools/testcoordinator/IP.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Sfsm ../../src/tools/testcoordinator/TestCoordinator.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Sfsm ../../src/tools/testcoordinator/TestClient.Mod
- cd $(BUILDDIR); $(COMPILE) -c IP.c
- cd $(BUILDDIR); $(COMPILE) TestCoordinator.c -o $(ROOTDIR)/testcoordinator \
- Platform.o SYSTEM.o Heap.o Console.o Strings.o IP.o
- cd $(BUILDDIR); $(COMPILE) TestClient.c -o $(ROOTDIR)/testclient \
- Platform.o SYSTEM.o Heap.o Console.o Strings.o IP.o
-
-
-
-
-# installable: Check for access to the installation directory
-
-installable:
- @rm -rf "S(INSTALLDIR)/test-access-qqq"
- @if ! mkdir -p "$(INSTALLDIR)/test-access-qqq";then echo "\\n\\n Cannot write to install directory.\\n Please use sudo or run as root/administrator.\\n\\n"; exit 1;fi
- @rm -rf "S(INSTALLDIR)/test-access-qqq"
-
-
-
-
-# install: Use only after a successful full build. Installs the compiler
-# and libraries in /opt/$(ONAME).
-# May require root access.
-install:
- @printf "\nInstalling into \"$(INSTALLDIR)\"\n"
- @rm -rf "$(INSTALLDIR)"
- @mkdir -p "$(INSTALLDIR)/bin" "$(INSTALLDIR)/include" "$(INSTALLDIR)/sym" "$(INSTALLDIR)/lib"
- @cp $(BUILDDIR)/*.h "$(INSTALLDIR)/include/"
- @cp $(BUILDDIR)/*.sym "$(INSTALLDIR)/sym/"
- @cp $(VISHAP) "$(INSTALLDIR)/bin/$(VISHAP)"
- @-cp $(BUILDDIR)/showdef$(BINEXT) "$(INSTALLDIR)/bin"
- @cp $(BUILDDIR)/lib$(ONAME).* "$(INSTALLDIR)/lib/"
- @if which ldconfig >/dev/null 2>&1; then $(LDCONFIG); fi
-
-
-# showpath: Describe how to set the PATH variable
-showpath:
- @printf "\nNow add $(INSTALLDIR)/bin to your path, for example with the command:\n"
- @printf "export PATH=\"$(INSTALLDIR)/bin:\$$PATH\"\n"
- @printf "\n"
-
-
-
-
-uninstall:
- @printf "\nUninstalling from \"$(INSTALLDIR)\"\n"
- rm -rf "$(INSTALLDIR)"
- rm -f /etc/ld.so.conf/lib$(ONAME)
- if which ldconfig >/dev/null 2>&1; then ldconfig; fi
-
-
-
-
-v4:
- @printf "\nMaking v4 library\n"
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/v4/Args.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/v4/Printer.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/v4/Sets.Mod
-
-ooc2:
- @printf "\nMaking ooc2 library\n"
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc2/ooc2Strings.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc2/ooc2Ascii.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc2/ooc2CharClass.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc2/ooc2ConvTypes.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc2/ooc2IntConv.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc2/ooc2IntStr.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc2/ooc2Real0.Mod
-
-
-TODO: Comment disabled lines contain use of VAL that reads beyond source variable
-
-ooc:
- @printf "\nMaking ooc library\n"
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocLowReal.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocLowLReal.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocRealMath.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocOakMath.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocLRealMath.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocLongInts.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocComplexMath.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocLComplexMath.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocAscii.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocCharClass.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocStrings.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocConvTypes.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocLRealConv.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocLRealStr.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocRealConv.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocRealStr.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocIntConv.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocIntStr.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocMsg.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocSysClock.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocTime.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocChannel.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocStrings2.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocRts.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocFilenames.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocTextRider.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocBinaryRider.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocJulianDay.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocFilenames.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocwrapperlibc.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocC$(DATAMODEL).Mod
-
-oocX11:
- @printf "\nMaking oocX11 library\n"
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/oocX11/oocX11.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/oocX11/oocXutil.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/oocX11/oocXYplane.Mod
-
-ulm:
- @printf "\nMaking ulm library\n"
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmObjects.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmPriorities.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmDisciplines.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmServices.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmSys.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmSYSTEM.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmEvents.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmProcess.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmResources.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmForwarders.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmRelatedEvents.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmTypes.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmStreams.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmStrings.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmSysTypes.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmTexts.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmSysConversions.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmErrors.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmSysErrors.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmSysStat.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmASCII.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmSets.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmIO.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmAssertions.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmIndirectDisciplines.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmStreamDisciplines.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmIEEE.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmMC68881.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmReals.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmPrint.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmWrite.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmConstStrings.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmPlotters.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmSysIO.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmLoader.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmNetIO.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmPersistentObjects.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmPersistentDisciplines.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmOperations.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmScales.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmTimes.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmClocks.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmTimers.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmConditions.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmStreamConditions.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmTimeConditions.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmCiphers.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmCipherOps.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmBlockCiphers.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmAsymmetricCiphers.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmConclusions.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmRandomGenerators.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmTCrypt.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmIntOperations.Mod
-
-pow32:
- @printf "\nMaking pow library\n"
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/pow/powStrings.Mod
-
-misc:
- @printf "\nMaking misc library\n"
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/system/Oberon.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/misc/crt.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/misc/Listen.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/misc/MersenneTwister.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/misc/MultiArrays.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/misc/MultiArrayRiders.Mod
-
-s3:
- @printf "\nMaking s3 library\n"
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethBTrees.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethMD5.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethSets.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethZlib.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethZlibBuffers.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethZlibInflate.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethZlibDeflate.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethZlibReaders.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethZlibWriters.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethZip.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethRandomNumbers.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethGZReaders.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethGZWriters.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethUnicode.Mod
- cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethDates.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethReals.Mod
-# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethStrings.Mod
-
-librarybinary:
- @printf "\nMaking lib$(ONAME)\n"
-
-# Remove objects that should not be part of the library
- rm -f $(BUILDDIR)/vishap.o
-
-# Note: remining compiler files are retained in the library allowing the building
-# of utilities like BrowserCmd.Mod (aka showdef).
-
-# Make static library
- ar rcs "$(BUILDDIR)/lib$(ONAME).a" $(BUILDDIR)/*.o
-
-# Make shared library
- @cd $(BUILDDIR) && $(COMPILE) -shared -o lib$(ONAME).so *.o
-
-
-
-
-library: v4 ooc2 ooc ulm pow32 misc s3 librarybinary
-
-
-
-
-sourcechanges:
- @cd $(BUILDDIR) && sh $(ROOTDIR)/src/tools/make/sourcechanges.sh $(ROOTDIR)/bootstrap/$(PLATFORM)-$(ADRSIZE)$(ALIGNMENT)
-
-
-
-
-RUNTEST = COMPILER=$(COMPILER) OBECOMP=$(VISHAP) FLAVOUR=$(FLAVOUR) BRANCH=$(BRANCH) sh ./test.sh "$(INSTALLDIR)"
-
-confidence:
- @printf "\n\n--- Confidence tests ---\n\n"
- cd src/test/confidence/hello; $(RUNTEST)
- cd src/test/confidence/intsyntax; $(RUNTEST)
- cd src/test/confidence/language; $(RUNTEST)
- cd src/test/confidence/texts; $(RUNTEST)
- cd src/test/confidence/library; $(RUNTEST)
- cd src/test/confidence/lola; $(RUNTEST)
- cd src/test/confidence/arrayassignment; $(RUNTEST)
- if [ "$(PLATFORM)" != "windows" ] ; then cd src/test/confidence/signal; $(RUNTEST); fi
- @printf "\n\n--- Confidence tests passed ---\n\n"
-
-
-
-# auto: A full build started from a central machine running TestCoordinator.
-auto:
- @make -f src/tools/make/vishap.make -s clean
- @make -f src/tools/make/vishap.make -s translate
- @make -f src/tools/make/vishap.make -s assemble
- @make -f src/tools/make/vishap.make -s testtools
- while cmd=$$(./testclient -w "$(FLAVOUR)"); do $$cmd 2>&1 | ./testclient -s "$(FLAVOUR)"; done