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

Merge branch 'ADRINT'

Browse source
This commit is contained in:
David Brown 2016-11-24 17:34:53 +00:00
commit 7296800b03
346 changed files with 43913 additions and 41601 deletions
Download patch file Download diff file Expand all files Collapse all files

14
.gitignore vendored
View file

@ -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

137
ReadMe.md
View file

@ -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)
&nbsp;&nbsp;&nbsp;&nbsp;[**Installation**](#installation)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**A 'Hello' application**](#a-hello-application)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**Licensing**](#licensing)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**Platform support and porting**](#platform-support-and-porting)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**Language support and libraries**](#language-support-and-libraries)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**History**](#history)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**Roadmap**](#roadmap)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**Contributors**](#contributors)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**Origin of the name "Ѵishap Oberon"**](#origin-of-the-name-Ѵishap-oberon)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**References**](#references)<br>
## Installation
###### Prerequisites
While pre-built packages are not provided, it is easy to install the Oberon compiler and libraries
with the following simple steps.
#### 1. Install prerequisites
| Platform | Packages |
| --------- | ------------ |
| Debian/Ubuntu/Mint ... | `apt-get install git` |
| Fedora/RHEL/CentOS ... | `yum install git gcc glibc-static` |
| Fedora/RHEL/CentOS ... | `yum install git gcc glibc-static` (`dnf` instead of `yum` on recent Fedoras) |
| FreeBSD/OpenBSD/NetBSD | `pkg install git` |
| Cygwin | use setup-x86[_x64] to add packages git, make and gcc-core |
| 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. |
More details, including for MingW and MS C, in [Installation](/doc/Installation.md).
More details, including for MingW and MS C, in [**Installation**](/doc/Installation.md).
###### Build and install
#### 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/)

121
bootstrap/unix-88/SYSTEM.c → bootstrap/SYSTEM.c
View file

@ -18,13 +18,48 @@
#include <signal.h>
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;
}

326
bootstrap/SYSTEM.h Normal file
View file

@ -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))<size && ((((UINT##size)(s))>>(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

0
bootstrap/unix-44/WindowsWrapper.h → bootstrap/WindowsWrapper.h
View file

184
bootstrap/unix-44/Compiler.c Normal file
View file

@ -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;
}

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

@ -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;
}

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

@ -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

150
bootstrap/unix-44/Console.c
View file

@ -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;
}

23
bootstrap/unix-44/Console.h
View file

@ -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

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

File diff suppressed because it is too large Load diff

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

@ -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

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

@ -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;

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

@ -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

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

@ -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);

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

@ -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

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

File diff suppressed because it is too large Load diff

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

@ -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

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

File diff suppressed because it is too large Load diff

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

@ -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

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

File diff suppressed because it is too large Load diff

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

@ -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

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

@ -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);

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

@ -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

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

@ -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);

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

@ -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

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

File diff suppressed because it is too large Load diff

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

@ -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

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

File diff suppressed because it is too large Load diff

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

@ -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

318
bootstrap/unix-44/Out.c Normal file
View file

@ -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;
}

24
bootstrap/unix-44/Out.h Normal file
View file

@ -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

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

@ -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 <errno.h>
@ -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;
}

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

@ -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

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

@ -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);
}

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

@ -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

207
bootstrap/unix-44/SYSTEM.c
View file

@ -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 <signal.h>
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

295
bootstrap/unix-44/SYSTEM.h
View file

@ -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

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

@ -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;
if (i <= 32767) {
__DEL(s);
return _o_result;
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;
}

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

@ -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

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

File diff suppressed because it is too large Load diff

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

@ -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

264
bootstrap/unix-44/VT100.c Normal file
View file

@ -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;
}

37
bootstrap/unix-44/VT100.h Normal file
View file

@ -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

168
bootstrap/unix-44/Vishap.c
View file

@ -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;
}

199
bootstrap/unix-44/errors.c
View file

@ -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;
}

18
bootstrap/unix-44/errors.h
View file

@ -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

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

@ -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;
}

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

@ -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

258
bootstrap/unix-44/vt100.c
View file

@ -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;
}

37
bootstrap/unix-44/vt100.h
View file

@ -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

184
bootstrap/unix-48/Compiler.c Normal file
View file

@ -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;
}

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

@ -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;
}

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

@ -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

150
bootstrap/unix-48/Console.c
View file

@ -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;
}

23
bootstrap/unix-48/Console.h
View file

@ -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

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

File diff suppressed because it is too large Load diff

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

@ -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

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

@ -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;

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

@ -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

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

@ -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);

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

@ -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

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

File diff suppressed because it is too large Load diff

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

@ -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

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

File diff suppressed because it is too large Load diff

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

@ -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

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

File diff suppressed because it is too large Load diff

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

@ -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

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

@ -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);

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

@ -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

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

@ -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);

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

@ -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

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

File diff suppressed because it is too large Load diff

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

@ -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

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

File diff suppressed because it is too large Load diff

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

@ -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

318
bootstrap/unix-48/Out.c Normal file
View file

@ -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;
}

24
bootstrap/unix-48/Out.h Normal file
View file

@ -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

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

@ -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 <errno.h>
@ -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;
}

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

@ -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

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

@ -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);
}

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

@ -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

207
bootstrap/unix-48/SYSTEM.c
View file

@ -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 <signal.h>
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

295
bootstrap/unix-48/SYSTEM.h
View file

@ -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

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

@ -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;
if (i <= 32767) {
__DEL(s);
return _o_result;
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;
}

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

@ -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

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

File diff suppressed because it is too large Load diff

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

@ -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

264
bootstrap/unix-48/VT100.c Normal file
View file

@ -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;
}

37
bootstrap/unix-48/VT100.h Normal file
View file

@ -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

168
bootstrap/unix-48/Vishap.c
View file

@ -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;
}

199
bootstrap/unix-48/errors.c
View file

@ -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;
}

18
bootstrap/unix-48/errors.h
View file

@ -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

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

@ -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;
}

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

@ -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

258
bootstrap/unix-48/vt100.c
View file

@ -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;
}

37
bootstrap/unix-48/vt100.h
View file

@ -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

184
bootstrap/unix-88/Compiler.c Normal file
View file

@ -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;
}

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

@ -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;
}

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

@ -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

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