mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 14:32:24 +00:00
Update system source to V2.
This commit is contained in:
David Brown
parent
efb7b6b030
commit
4245c6e8b3
10 changed files with 2150 additions and 1482 deletions
|
|
@ -1,205 +1,207 @@
|
|||
/*
|
||||
* The body prefix file of the voc(jet backend) runtime system, Version 1.0
|
||||
/*
|
||||
* The body prefix file of the voc(jet backend) runtime system, Version 1.0
|
||||
*
|
||||
* Copyright (c) Software Templ, 1994, 1995
|
||||
* 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.
|
||||
* 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
|
||||
* 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"
|
||||
#ifdef __STDC__
|
||||
#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)(uintptr_t)(*((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(unsigned LONGINT x, unsigned LONGINT y)
|
||||
{ if ((LONGINT) x >= 0) return (x / y);
|
||||
else return -((y - 1 - x) / y);
|
||||
}
|
||||
|
||||
LONGINT SYSTEM_MOD(unsigned LONGINT x, unsigned LONGINT y)
|
||||
{ unsigned 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*)(uintptr_t)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*)(uintptr_t)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, uintptr_t h) {
|
||||
if (s >= 2 && s <= 4) {
|
||||
int needtosetsystemhandler = handler[s-2] == 0;
|
||||
handler[s-2] = (SystemSignalHandler)h;
|
||||
if (needtosetsystemhandler) {signal(s, signalHandler);}
|
||||
}
|
||||
}
|
||||
|
||||
#else
|
||||
#include "varargs.h"
|
||||
|
||||
// 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(uintptr_t h) {
|
||||
EnsureConsoleCtrlHandler();
|
||||
SystemInterruptHandler = (SystemSignalHandler)h;
|
||||
}
|
||||
|
||||
void SystemSetQuitHandler(uintptr_t h) {
|
||||
EnsureConsoleCtrlHandler();
|
||||
SystemQuitHandler = (SystemSignalHandler)h;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
extern void *malloc(unsigned long size);
|
||||
extern void exit(int status);
|
||||
|
||||
void (*SYSTEM_Halt)();
|
||||
LONGINT SYSTEM_halt; /* x in HALT(x) */
|
||||
LONGINT SYSTEM_assert; /* x in ASSERT(cond, x) */
|
||||
LONGINT SYSTEM_argc;
|
||||
LONGINT SYSTEM_argv;
|
||||
LONGINT SYSTEM_lock;
|
||||
BOOLEAN SYSTEM_interrupted;
|
||||
static LONGINT SYSTEM_mainfrm; /* adr of main proc stack frame, used for stack collection */
|
||||
|
||||
#define Lock SYSTEM_lock++
|
||||
#define Unlock SYSTEM_lock--; if (SYSTEM_interrupted && (SYSTEM_lock == 0)) __HALT(-9)
|
||||
|
||||
|
||||
static void SYSTEM_InitHeap();
|
||||
void *SYSTEM__init();
|
||||
|
||||
void SYSTEM_INIT(argc, argvadr)
|
||||
int argc; long argvadr;
|
||||
{
|
||||
SYSTEM_mainfrm = argvadr;
|
||||
SYSTEM_argc = argc;
|
||||
SYSTEM_argv = *(long*)argvadr;
|
||||
SYSTEM_InitHeap();
|
||||
SYSTEM_halt = -128;
|
||||
SYSTEM__init();
|
||||
}
|
||||
|
||||
void SYSTEM_FINI()
|
||||
{
|
||||
SYSTEM_FINALL();
|
||||
}
|
||||
|
||||
long SYSTEM_XCHK(i, ub) long i, ub; {return __X(i, ub);}
|
||||
long SYSTEM_RCHK(i, ub) long i, ub; {return __R(i, ub);}
|
||||
long SYSTEM_ASH(i, n) long i, n; {return __ASH(i, n);}
|
||||
long SYSTEM_ABS(i) long i; {return __ABS(i);}
|
||||
double SYSTEM_ABSD(i) double i; {return __ABS(i);}
|
||||
|
||||
void SYSTEM_INHERIT(t, t0)
|
||||
long *t, *t0;
|
||||
{
|
||||
t -= __TPROC0OFF;
|
||||
t0 -= __TPROC0OFF;
|
||||
while (*t0 != __EOM) {*t = *t0; t--; t0--;}
|
||||
}
|
||||
|
||||
void SYSTEM_ENUMP(adr, n, P)
|
||||
long *adr;
|
||||
long n;
|
||||
void (*P)();
|
||||
{
|
||||
while (n > 0) {P(*adr); adr++; n--;}
|
||||
}
|
||||
|
||||
void SYSTEM_ENUMR(adr, typ, size, n, P)
|
||||
char *adr;
|
||||
long *typ, size, n;
|
||||
void (*P)();
|
||||
{
|
||||
long *t, off;
|
||||
typ++;
|
||||
while (n > 0) {
|
||||
t = typ;
|
||||
off = *t;
|
||||
while (off >= 0) {P(*(long*)(adr+off)); t++; off = *t;}
|
||||
adr += size; n--;
|
||||
}
|
||||
}
|
||||
|
||||
long SYSTEM_DIV(x, y)
|
||||
unsigned long x, y;
|
||||
{ if ((long) x >= 0) return (x / y);
|
||||
else return -((y - 1 - x) / y);
|
||||
}
|
||||
|
||||
long SYSTEM_MOD(x, y)
|
||||
unsigned long x, y;
|
||||
{ unsigned long m;
|
||||
if ((long) x >= 0) return (x % y);
|
||||
else { m = (-x) % y;
|
||||
if (m != 0) return (y - m); else return 0;
|
||||
}
|
||||
}
|
||||
|
||||
long SYSTEM_ENTIER(x)
|
||||
double x;
|
||||
{
|
||||
long y;
|
||||
if (x >= 0)
|
||||
return (long)x;
|
||||
else {
|
||||
y = (long)x;
|
||||
if (y <= x) return y; else return y - 1;
|
||||
}
|
||||
}
|
||||
|
||||
void SYSTEM_HALT(n)
|
||||
int n;
|
||||
{
|
||||
SYSTEM_halt = n;
|
||||
if (SYSTEM_Halt!=0) SYSTEM_Halt(n);
|
||||
exit(n);
|
||||
}
|
||||
|
||||
#ifdef __STDC__
|
||||
SYSTEM_PTR SYSTEM_NEWARR(long *typ, long elemsz, int elemalgn, int nofdim, int nofdyn, ...)
|
||||
#else
|
||||
SYSTEM_PTR SYSTEM_NEWARR(typ, elemsz, elemalgn, nofdim, nofdyn, va_alist)
|
||||
long *typ, elemsz;
|
||||
int elemalgn, nofdim, nofdyn;
|
||||
va_dcl
|
||||
#endif
|
||||
{
|
||||
long nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off;
|
||||
va_list ap;
|
||||
#ifdef __STDC__
|
||||
va_start(ap, nofdyn);
|
||||
#else
|
||||
va_start(ap);
|
||||
#endif
|
||||
nofelems = 1;
|
||||
while (nofdim > 0) {
|
||||
nofelems = nofelems * va_arg(ap, long); nofdim--;
|
||||
if (nofelems <= 0) __HALT(-20);
|
||||
}
|
||||
va_end(ap);
|
||||
dataoff = nofdyn * sizeof(long);
|
||||
if (elemalgn > sizeof(long)) {
|
||||
n = dataoff % elemalgn;
|
||||
if (n != 0) dataoff += elemalgn - n;
|
||||
}
|
||||
size = dataoff + nofelems * elemsz;
|
||||
Lock;
|
||||
if (typ == NIL) {
|
||||
/* element typ does not contain pointers */
|
||||
x = SYSTEM_NEWBLK(size);
|
||||
}
|
||||
else if (typ == POINTER__typ) {
|
||||
/* element type is a pointer */
|
||||
x = SYSTEM_NEWBLK(size + nofelems * sizeof(long));
|
||||
p = (long*)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(long); p++; n++;}
|
||||
*p = - (nofelems + 1) * sizeof(long); /* sentinel */
|
||||
x[-1] -= nofelems * sizeof(long);
|
||||
}
|
||||
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 = SYSTEM_NEWBLK(size + nptr * sizeof(long));
|
||||
p = (long*)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(long); /* sentinel */
|
||||
x[-1] -= nptr * sizeof(long);
|
||||
}
|
||||
if (nofdyn != 0) {
|
||||
/* setup len vector for index checks */
|
||||
#ifdef __STDC__
|
||||
va_start(ap, nofdyn);
|
||||
#else
|
||||
va_start(ap);
|
||||
#endif
|
||||
p = x;
|
||||
while (nofdyn > 0) {*p = va_arg(ap, long); p++, nofdyn--;}
|
||||
va_end(ap);
|
||||
}
|
||||
Unlock;
|
||||
return x;
|
||||
}
|
||||
|
||||
/* ----------- end of SYSTEM.co ------------- */
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue