* Deduplicate common constants into OPM and do some source format tidying.

* Fix postpush buildall script to force checkout of updated buildall.

* Show enlistment branch in makefiles

* Support non-printables in string literals and tidy case alignment and constant literals.

* Common code for MIN and MAX of integer types.

* Common code for SInt/Int/LInt in ConstOp parameter preparation.

* Common code for SInt/Int/LInt in Op parameter preparation.

* Refactor SetIntType to work with byte size directly. Prepare to revert my incorrect VAL changes.

* Original meaning of VAL restored. Many library files disabled until use of VAL in 64 bits fixed.

* Make Reals.Mod independent of INTEGER size and add reals tests.

* Implement fraction, IsInfinity and IsNaN in oocLowReal.Mod.

* OPB little simplifications and ShorterSize/LongerSize functions.

* Add test for alignment computability

* Replace alignment constants with calculated alignment.

* typ.size aware OPV.Convert

* Add SYSTEM_INT64 and make tests name independent.

* Remove SYSTEM.H includes (string.h and stdint.h).

* Replace uses of uintptr_t and size_t with SYSTEM_ADDRESS.

* Sad hack to make FreeBSD and OpenBSD happy with memcpy declaration.

* Detect 64 bit on FreeBSD, and size_t defined on OpenBSD.

* %zd not supportd by mingw, cast strnlen return to int.

* Add debug for intermittent failure only on OpenBSD.

* Add textTexts as a confidence test and tidy up a couple of other tests.

* Update binary test process.
This commit is contained in:
David C W Brown 2016-08-25 14:41:00 +01:00 committed by GitHub
parent 1f41d80b1e
commit da88496c5f
224 changed files with 7494 additions and 8065 deletions

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
@ -13,6 +13,6 @@ export void *Configuration__init(void)
__DEFMOD;
__REGMOD("Configuration", 0);
/* BEGIN */
__MOVE("1.95 [2016/08/24] for gcc LP64 on cygwin", Configuration_versionLong, 41);
__MOVE("1.95 [2016/08/23] for gcc LP64 on cygwin", Configuration_versionLong, 41);
__ENDMOD;
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef Configuration__h
#define Configuration__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
#include "Platform.h"
@ -21,7 +21,7 @@ export void Console_String (CHAR *s, LONGINT s__len);
void Console_Flush (void)
{
INTEGER error;
error = Platform_Write(((LONGINT)(1)), (LONGINT)(uintptr_t)Console_line, Console_pos);
error = Platform_Write(((LONGINT)(1)), (LONGINT)(SYSTEM_ADDRESS)Console_line, Console_pos);
Console_pos = 0;
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef Console__h
#define Console__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin tspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
#include "SYSTEM.h"
#include "Configuration.h"
#include "Console.h"
@ -257,7 +257,7 @@ static void Files_Flush (Files_Buffer buf)
if (buf->org != f->pos) {
error = Platform_Seek(f->fd, buf->org, Platform_SeekSet);
}
error = Platform_Write(f->fd, (LONGINT)(uintptr_t)buf->data, buf->size);
error = Platform_Write(f->fd, (LONGINT)(SYSTEM_ADDRESS)buf->data, buf->size);
if (error != 0) {
Files_Err((CHAR*)"error writing file", (LONGINT)19, f, error);
}
@ -656,7 +656,7 @@ void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x
} else {
min = n;
}
__MOVE((LONGINT)(uintptr_t)buf->data + offset, (LONGINT)(uintptr_t)x + xpos, min);
__MOVE((LONGINT)(SYSTEM_ADDRESS)buf->data + offset, (LONGINT)(SYSTEM_ADDRESS)x + xpos, min);
offset += min;
(*r).offset = offset;
xpos += min;
@ -721,7 +721,7 @@ void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT
} else {
min = n;
}
__MOVE((LONGINT)(uintptr_t)x + xpos, (LONGINT)(uintptr_t)buf->data + offset, min);
__MOVE((LONGINT)(SYSTEM_ADDRESS)x + xpos, (LONGINT)(SYSTEM_ADDRESS)buf->data + offset, min);
offset += min;
(*r).offset = offset;
if (offset > buf->size) {
@ -772,15 +772,15 @@ void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT
*res = 3;
return;
}
error = Platform_Read(fdold, (LONGINT)(uintptr_t)buf, ((LONGINT)(4096)), &n);
error = Platform_Read(fdold, (LONGINT)(SYSTEM_ADDRESS)buf, ((LONGINT)(4096)), &n);
while (n > 0) {
error = Platform_Write(fdnew, (LONGINT)(uintptr_t)buf, n);
error = Platform_Write(fdnew, (LONGINT)(SYSTEM_ADDRESS)buf, n);
if (error != 0) {
ignore = Platform_Close(fdold);
ignore = Platform_Close(fdnew);
Files_Err((CHAR*)"cannot move file", (LONGINT)17, NIL, error);
}
error = Platform_Read(fdold, (LONGINT)(uintptr_t)buf, ((LONGINT)(4096)), &n);
error = Platform_Read(fdold, (LONGINT)(SYSTEM_ADDRESS)buf, ((LONGINT)(4096)), &n);
}
ignore = Platform_Close(fdold);
ignore = Platform_Close(fdnew);
@ -838,7 +838,7 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *de
j += 1;
}
} else {
__MOVE((LONGINT)(uintptr_t)src, (LONGINT)(uintptr_t)dest, src__len);
__MOVE((LONGINT)(SYSTEM_ADDRESS)src, (LONGINT)(SYSTEM_ADDRESS)dest, src__len);
}
}
@ -858,14 +858,16 @@ void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x)
{
CHAR b[4];
Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
*x = ((LONGINT)((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((LONGINT)b[2], 16)) + __ASHL((LONGINT)b[3], 24);
*x = ((int)((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((int)b[2], 16)) + __ASHL((int)b[3], 24);
}
void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x)
{
CHAR b[4];
LONGINT l;
Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
*x = (SET)(((LONGINT)((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((LONGINT)b[2], 16)) + __ASHL((LONGINT)b[3], 24));
l = ((int)((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((int)b[2], 16)) + __ASHL((int)b[3], 24);
*x = (SET)l;
}
void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x)
@ -921,11 +923,11 @@ void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x)
n = 0;
Files_Read(&*R, R__typ, (void*)&ch);
while ((int)ch >= 128) {
n += __ASH((LONGINT)((int)ch - 128), s);
n += __ASH((int)((int)ch - 128), s);
s += 7;
Files_Read(&*R, R__typ, (void*)&ch);
}
n += __ASH((LONGINT)(__MASK((int)ch, -64) - __ASHL(__ASHR((int)ch, 6), 6)), s);
n += __ASH((int)(__MASK((int)ch, -64) - __ASHL(__ASHR((int)ch, 6), 6)), s);
*x = n;
}
@ -1006,7 +1008,7 @@ static void Files_Finalize (SYSTEM_PTR o)
{
Files_File f = NIL;
LONGINT res;
f = (Files_File)(uintptr_t)o;
f = (Files_File)(SYSTEM_ADDRESS)o;
if (f->fd >= 0) {
Files_CloseOSFile(f);
if (f->tempFile) {

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin tspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
#ifndef Files__h
#define Files__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin tskSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tskSfF */
#include "SYSTEM.h"
struct Heap__1 {
@ -101,7 +101,7 @@ export void Heap_Unlock (void);
extern void *Heap__init();
extern LONGINT Platform_MainStackFrame;
extern LONGINT Platform_OSAllocate(LONGINT size);
#define Heap_FetchAddress(pointer) (LONGINT)(uintptr_t)(*((void**)((uintptr_t)pointer)))
#define Heap_FetchAddress(pointer) (LONGINT)(SYSTEM_ADDRESS)(*((void**)((SYSTEM_ADDRESS)pointer)))
#define Heap_HeapModuleInit() Heap__init()
#define Heap_OSAllocate(size) Platform_OSAllocate(size)
#define Heap_PlatformHalt(code) Platform_Halt(code)
@ -134,7 +134,7 @@ SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs)
__COPY(name, m->name, ((LONGINT)(20)));
m->refcnt = 0;
m->enumPtrs = enumPtrs;
m->next = (Heap_Module)(uintptr_t)Heap_modules;
m->next = (Heap_Module)(SYSTEM_ADDRESS)Heap_modules;
Heap_modules = (SYSTEM_PTR)m;
_o_result = (void*)m;
return _o_result;
@ -315,7 +315,7 @@ SYSTEM_PTR Heap_NEWREC (LONGINT tag)
__PUT(adr + 8, 0, LONGINT);
Heap_allocated += blksz;
Heap_Unlock();
_o_result = (SYSTEM_PTR)(uintptr_t)(adr + 4);
_o_result = (SYSTEM_PTR)(SYSTEM_ADDRESS)(adr + 4);
return _o_result;
}
@ -326,12 +326,12 @@ SYSTEM_PTR Heap_NEWBLK (LONGINT size)
SYSTEM_PTR new;
Heap_Lock();
blksz = __ASHL(__ASHR(size + 31, 4), 4);
new = Heap_NEWREC((LONGINT)(uintptr_t)&blksz);
tag = ((LONGINT)(uintptr_t)new + blksz) - 12;
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)(uintptr_t)new - 4, tag, LONGINT);
__PUT((LONGINT)(SYSTEM_ADDRESS)new - 4, tag, LONGINT);
Heap_Unlock();
_o_result = new;
return _o_result;
@ -360,7 +360,7 @@ static void Heap_Mark (LONGINT q)
__GET(tag, offset, LONGINT);
fld = q + offset;
p = Heap_FetchAddress(fld);
__PUT(fld, (SYSTEM_PTR)(uintptr_t)n, SYSTEM_PTR);
__PUT(fld, (SYSTEM_PTR)(SYSTEM_ADDRESS)n, SYSTEM_PTR);
} else {
fld = q + offset;
n = Heap_FetchAddress(fld);
@ -369,7 +369,7 @@ static void Heap_Mark (LONGINT q)
if (!__ODD(tagbits)) {
__PUT(n - 4, tagbits + 1, LONGINT);
__PUT(q - 4, tag + 1, LONGINT);
__PUT(fld, (SYSTEM_PTR)(uintptr_t)p, SYSTEM_PTR);
__PUT(fld, (SYSTEM_PTR)(SYSTEM_ADDRESS)p, SYSTEM_PTR);
p = q;
q = n;
tag = tagbits;
@ -384,7 +384,7 @@ static void Heap_Mark (LONGINT q)
static void Heap_MarkP (SYSTEM_PTR p)
{
Heap_Mark((LONGINT)(uintptr_t)p);
Heap_Mark((LONGINT)(SYSTEM_ADDRESS)p);
}
static void Heap_Scan (void)
@ -553,7 +553,7 @@ static void Heap_Finalize (void)
} else {
prev->next = n->next;
}
(*n->finalize)((SYSTEM_PTR)(uintptr_t)n->obj);
(*n->finalize)((SYSTEM_PTR)(SYSTEM_ADDRESS)n->obj);
if (prev == NIL) {
n = Heap_fin;
} else {
@ -572,7 +572,7 @@ void Heap_FINALL (void)
while (Heap_fin != NIL) {
n = Heap_fin;
Heap_fin = Heap_fin->next;
(*n->finalize)((SYSTEM_PTR)(uintptr_t)n->obj);
(*n->finalize)((SYSTEM_PTR)(SYSTEM_ADDRESS)n->obj);
}
}
@ -589,9 +589,9 @@ static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len)
}
if (n == 0) {
nofcand = 0;
sp = (LONGINT)(uintptr_t)&frame;
sp = (LONGINT)(SYSTEM_ADDRESS)&frame;
stack0 = Heap_PlatformMainStackFrame();
inc = (LONGINT)(uintptr_t)&align.p - (LONGINT)(uintptr_t)&align;
inc = (LONGINT)(SYSTEM_ADDRESS)&align.p - (LONGINT)(SYSTEM_ADDRESS)&align;
if (sp > stack0) {
inc = -inc;
}
@ -622,7 +622,7 @@ void Heap_GC (BOOLEAN markStack)
LONGINT cand[10000];
if (Heap_lockdepth == 0 || (Heap_lockdepth == 1 && !markStack)) {
Heap_Lock();
m = (Heap_Module)(uintptr_t)Heap_modules;
m = (Heap_Module)(SYSTEM_ADDRESS)Heap_modules;
while (m != NIL) {
if (m->enumPtrs != NIL) {
(*m->enumPtrs)(Heap_MarkP);
@ -699,7 +699,7 @@ void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
{
Heap_FinNode f;
__NEW(f, Heap_FinDesc);
f->obj = (LONGINT)(uintptr_t)obj;
f->obj = (LONGINT)(SYSTEM_ADDRESS)obj;
f->finalize = finalize;
f->marked = 1;
f->next = Heap_fin;

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin tskSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tskSfF */
#ifndef Heap__h
#define Heap__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
#include "Console.h"
#include "Heap.h"

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef Modules__h
#define Modules__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
#include "OPM.h"
#include "OPS.h"
@ -34,7 +34,9 @@ export void OPB_In (OPT_Node *x, OPT_Node y);
export void OPB_Index (OPT_Node *x, OPT_Node y);
export void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ);
static BOOLEAN OPB_IntToBool (LONGINT i);
static OPT_Struct OPB_IntType (LONGINT size);
export void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y);
static LONGINT OPB_LongerSize (LONGINT i);
export void OPB_MOp (SHORTINT op, OPT_Node *x);
export OPT_Node OPB_NewBoolConst (BOOLEAN boolval);
export OPT_Node OPB_NewIntConst (LONGINT intval);
@ -51,6 +53,8 @@ export void OPB_Return (OPT_Node *x, OPT_Object proc);
export void OPB_SetElem (OPT_Node *x);
static void OPB_SetIntType (OPT_Node node);
export void OPB_SetRange (OPT_Node *x, OPT_Node y);
static LONGINT OPB_ShorterSize (LONGINT i);
static INTEGER OPB_SignedByteSize (LONGINT n);
export void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno);
export void OPB_StPar0 (OPT_Node *par0, INTEGER fctno);
export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno);
@ -90,8 +94,8 @@ OPT_Node OPB_NewLeaf (OPT_Object obj)
node = OPT_NewNode(9);
break;
default:
OPB_err(127);
node = OPT_NewNode(0);
OPB_err(127);
break;
}
node->obj = obj;
@ -220,21 +224,68 @@ OPT_Node OPB_EmptySet (void)
return _o_result;
}
static INTEGER OPB_SignedByteSize (LONGINT n)
{
INTEGER _o_result;
INTEGER b;
if (n < 0) {
n = -(n + 1);
}
b = 1;
while ((b < 8 && __ASH(n, -(__ASHL(b, 3) - 1)) != 0)) {
b += 1;
}
_o_result = b;
return _o_result;
}
static LONGINT OPB_ShorterSize (LONGINT i)
{
LONGINT _o_result;
if (i >= (int)OPM_LIntSize) {
_o_result = OPM_IntSize;
return _o_result;
} else {
_o_result = OPM_SIntSize;
return _o_result;
}
__RETCHK;
}
static LONGINT OPB_LongerSize (LONGINT i)
{
LONGINT _o_result;
if (i <= (int)OPM_SIntSize) {
_o_result = OPM_IntSize;
return _o_result;
} else {
_o_result = OPM_LIntSize;
return _o_result;
}
__RETCHK;
}
static OPT_Struct OPB_IntType (LONGINT size)
{
OPT_Struct _o_result;
OPT_Struct result = NIL;
if (size <= OPT_sinttyp->size) {
result = OPT_sinttyp;
} else if (size <= OPT_inttyp->size) {
result = OPT_inttyp;
} else {
result = OPT_linttyp;
}
if (size > OPT_linttyp->size) {
OPB_err(203);
}
_o_result = result;
return _o_result;
}
static void OPB_SetIntType (OPT_Node node)
{
LONGINT v;
v = node->conval->intval;
if ((OPM_MinSInt <= (LONGINT)v && (LONGINT)v <= OPM_MaxSInt)) {
node->typ = OPT_sinttyp;
} else if ((OPM_MinInt <= (LONGINT)v && (LONGINT)v <= OPM_MaxInt)) {
node->typ = OPT_inttyp;
} else if ((OPM_MinLInt <= v && v <= OPM_MaxLInt)) {
node->typ = OPT_linttyp;
} else {
OPB_err(203);
node->typ = OPT_sinttyp;
node->conval->intval = 1;
}
node->typ = OPB_IntType(OPB_SignedByteSize(node->conval->intval));
}
OPT_Node OPB_NewIntConst (LONGINT intval)
@ -378,16 +429,16 @@ void OPB_Field (OPT_Node *x, OPT_Object y)
}
}
static struct TypTest__57 {
static struct TypTest__61 {
OPT_Node *x;
OPT_Object *obj;
BOOLEAN *guard;
struct TypTest__57 *lnk;
} *TypTest__57_s;
struct TypTest__61 *lnk;
} *TypTest__61_s;
static void GTT__58 (OPT_Struct t0, OPT_Struct t1);
static void GTT__62 (OPT_Struct t0, OPT_Struct t1);
static void GTT__58 (OPT_Struct t0, OPT_Struct t1)
static void GTT__62 (OPT_Struct t0, OPT_Struct t1)
{
OPT_Node node = NIL;
OPT_Struct t = NIL;
@ -400,54 +451,54 @@ static void GTT__58 (OPT_Struct t0, OPT_Struct t1)
t1 = t1->BaseTyp;
}
if (t1 == t0 || t0->form == 0) {
if (*TypTest__57_s->guard) {
OPB_BindNodes(5, NIL, &*TypTest__57_s->x, NIL);
(*TypTest__57_s->x)->readonly = (*TypTest__57_s->x)->left->readonly;
if (*TypTest__61_s->guard) {
OPB_BindNodes(5, NIL, &*TypTest__61_s->x, NIL);
(*TypTest__61_s->x)->readonly = (*TypTest__61_s->x)->left->readonly;
} else {
node = OPT_NewNode(11);
node->subcl = 16;
node->left = *TypTest__57_s->x;
node->obj = *TypTest__57_s->obj;
*TypTest__57_s->x = node;
node->left = *TypTest__61_s->x;
node->obj = *TypTest__61_s->obj;
*TypTest__61_s->x = node;
}
} else {
OPB_err(85);
}
} else if (t0 != t1) {
OPB_err(85);
} else if (!*TypTest__57_s->guard) {
if ((*TypTest__57_s->x)->class == 5) {
} else if (!*TypTest__61_s->guard) {
if ((*TypTest__61_s->x)->class == 5) {
node = OPT_NewNode(11);
node->subcl = 16;
node->left = *TypTest__57_s->x;
node->obj = *TypTest__57_s->obj;
*TypTest__57_s->x = node;
node->left = *TypTest__61_s->x;
node->obj = *TypTest__61_s->obj;
*TypTest__61_s->x = node;
} else {
*TypTest__57_s->x = OPB_NewBoolConst(1);
*TypTest__61_s->x = OPB_NewBoolConst(1);
}
}
}
void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
{
struct TypTest__57 _s;
struct TypTest__61 _s;
_s.x = x;
_s.obj = &obj;
_s.guard = &guard;
_s.lnk = TypTest__57_s;
TypTest__57_s = &_s;
_s.lnk = TypTest__61_s;
TypTest__61_s = &_s;
if (OPB_NotVar(*x)) {
OPB_err(112);
} else if ((*x)->typ->form == 13) {
if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) {
OPB_err(85);
} else if (obj->typ->form == 13) {
GTT__58((*x)->typ->BaseTyp, obj->typ->BaseTyp);
GTT__62((*x)->typ->BaseTyp, obj->typ->BaseTyp);
} else {
OPB_err(86);
}
} else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) {
GTT__58((*x)->typ, obj->typ);
GTT__62((*x)->typ, obj->typ);
} else {
OPB_err(87);
}
@ -456,7 +507,7 @@ void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
} else {
(*x)->typ = OPT_booltyp;
}
TypTest__57_s = _s.lnk;
TypTest__61_s = _s.lnk;
}
void OPB_In (OPT_Node *x, OPT_Node y)
@ -469,7 +520,7 @@ void OPB_In (OPT_Node *x, OPT_Node y)
} else if ((__IN(f, 0x70) && y->typ->form == 9)) {
if ((*x)->class == 7) {
k = (*x)->conval->intval;
if (k < 0 || k > (LONGINT)OPM_MaxSet) {
if (k < 0 || k > (int)OPM_MaxSet) {
OPB_err(202);
} else if (y->class == 7) {
(*x)->conval->intval = OPB_BoolToInt(__IN(k, y->conval->setval));
@ -522,13 +573,13 @@ static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x)
x->intval = -1;
}
static struct MOp__28 {
struct MOp__28 *lnk;
} *MOp__28_s;
static struct MOp__30 {
struct MOp__30 *lnk;
} *MOp__30_s;
static OPT_Node NewOp__29 (SHORTINT op, OPT_Struct typ, OPT_Node z);
static OPT_Node NewOp__31 (SHORTINT op, OPT_Struct typ, OPT_Node z);
static OPT_Node NewOp__29 (SHORTINT op, OPT_Struct typ, OPT_Node z)
static OPT_Node NewOp__31 (SHORTINT op, OPT_Struct typ, OPT_Node z)
{
OPT_Node _o_result;
OPT_Node node = NIL;
@ -545,9 +596,9 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
INTEGER f;
OPT_Struct typ = NIL;
OPT_Node z = NIL;
struct MOp__28 _s;
_s.lnk = MOp__28_s;
MOp__28_s = &_s;
struct MOp__30 _s;
_s.lnk = MOp__30_s;
MOp__30_s = &_s;
z = *x;
if (z->class == 8 || z->class == 9) {
OPB_err(126);
@ -561,7 +612,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval));
z->obj = NIL;
} else {
z = NewOp__29(op, typ, z);
z = NewOp__31(op, typ, z);
}
} else {
OPB_err(98);
@ -589,7 +640,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
}
z->obj = NIL;
} else {
z = NewOp__29(op, typ, z);
z = NewOp__31(op, typ, z);
}
} else {
OPB_err(97);
@ -610,7 +661,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
}
z->obj = NIL;
} else {
z = NewOp__29(op, typ, z);
z = NewOp__31(op, typ, z);
}
} else {
OPB_err(111);
@ -622,7 +673,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->conval->intval = (int)__CAP((CHAR)z->conval->intval);
z->obj = NIL;
} else {
z = NewOp__29(op, typ, z);
z = NewOp__31(op, typ, z);
}
} else {
OPB_err(111);
@ -635,7 +686,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval));
z->obj = NIL;
} else {
z = NewOp__29(op, typ, z);
z = NewOp__31(op, typ, z);
}
} else {
OPB_err(111);
@ -648,7 +699,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
f = 10;
}
if (z->class < 7 || f == 10) {
z = NewOp__29(op, typ, z);
z = NewOp__31(op, typ, z);
} else {
OPB_err(127);
}
@ -657,7 +708,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
case 25:
if ((__IN(f, 0x70) && z->class == 7)) {
if ((0 <= z->conval->intval && z->conval->intval <= -1)) {
z = NewOp__29(op, typ, z);
z = NewOp__31(op, typ, z);
} else {
OPB_err(219);
}
@ -674,7 +725,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
}
}
*x = z;
MOp__28_s = _s.lnk;
MOp__30_s = _s.lnk;
}
static void OPB_CheckPtr (OPT_Node x, OPT_Node y)
@ -865,41 +916,13 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
case 4:
case 4: case 5: case 6:
if (__IN(g, 0x70)) {
x->typ = y->typ;
} else if (g == 7) {
x->typ = OPT_realtyp;
xval->realval = xval->intval;
} else if (g == 8) {
x->typ = OPT_lrltyp;
xval->realval = xval->intval;
} else {
OPB_err(100);
y->typ = x->typ;
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
case 5:
if (g == 4) {
y->typ = OPT_inttyp;
} else if (__IN(g, 0x70)) {
x->typ = y->typ;
} else if (g == 7) {
x->typ = OPT_realtyp;
xval->realval = xval->intval;
} else if (g == 8) {
x->typ = OPT_lrltyp;
xval->realval = xval->intval;
} else {
OPB_err(100);
y->typ = x->typ;
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
case 6:
if (__IN(g, 0x70)) {
y->typ = OPT_linttyp;
if (x->typ->size <= y->typ->size) {
x->typ = y->typ;
} else {
x->typ = OPB_IntType(x->typ->size);
}
} else if (g == 7) {
x->typ = OPT_realtyp;
xval->realval = xval->intval;
@ -1178,7 +1201,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
OPB_err(203);
r = (LONGREAL)1;
}
(*x)->conval->intval = __ENTIER(r);
(*x)->conval->intval = (int)__ENTIER(r);
OPB_SetIntType(*x);
}
}
@ -1196,15 +1219,15 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
(*x)->typ = typ;
}
static struct Op__38 {
static struct Op__40 {
INTEGER *f, *g;
struct Op__38 *lnk;
} *Op__38_s;
struct Op__40 *lnk;
} *Op__40_s;
static void NewOp__39 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y);
static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y);
static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y);
static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y);
static void NewOp__39 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
{
OPT_Node node = NIL;
node = OPT_NewNode(12);
@ -1215,29 +1238,29 @@ static void NewOp__39 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
*x = node;
}
static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y)
static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y)
{
BOOLEAN _o_result;
BOOLEAN ok, xCharArr, yCharArr;
xCharArr = (__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp->form == 3) || *Op__38_s->f == 10;
yCharArr = (__IN((*y)->typ->comp, 0x0c) && (*y)->typ->BaseTyp->form == 3) || *Op__38_s->g == 10;
if ((((xCharArr && *Op__38_s->g == 3)) && (*y)->class == 7)) {
xCharArr = (__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp->form == 3) || *Op__40_s->f == 10;
yCharArr = (__IN((*y)->typ->comp, 0x0c) && (*y)->typ->BaseTyp->form == 3) || *Op__40_s->g == 10;
if ((((xCharArr && *Op__40_s->g == 3)) && (*y)->class == 7)) {
OPB_CharToString(*y);
*Op__38_s->g = 10;
*Op__40_s->g = 10;
yCharArr = 1;
}
if ((((yCharArr && *Op__38_s->f == 3)) && (*x)->class == 7)) {
if ((((yCharArr && *Op__40_s->f == 3)) && (*x)->class == 7)) {
OPB_CharToString(*x);
*Op__38_s->f = 10;
*Op__40_s->f = 10;
xCharArr = 1;
}
ok = (xCharArr && yCharArr);
if (ok) {
if ((*Op__38_s->f == 10 && (*x)->conval->intval2 == 1)) {
if ((*Op__40_s->f == 10 && (*x)->conval->intval2 == 1)) {
(*x)->typ = OPT_chartyp;
(*x)->conval->intval = 0;
OPB_Index(&*y, OPB_NewIntConst(((LONGINT)(0))));
} else if ((*Op__38_s->g == 10 && (*y)->conval->intval2 == 1)) {
} else if ((*Op__40_s->g == 10 && (*y)->conval->intval2 == 1)) {
(*y)->typ = OPT_chartyp;
(*y)->conval->intval = 0;
OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0))));
@ -1254,11 +1277,11 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPT_Struct typ = NIL;
BOOLEAN do_;
LONGINT val;
struct Op__38 _s;
struct Op__40 _s;
_s.f = &f;
_s.g = &g;
_s.lnk = Op__38_s;
Op__38_s = &_s;
_s.lnk = Op__40_s;
Op__40_s = &_s;
z = *x;
if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) {
OPB_err(126);
@ -1276,15 +1299,8 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(100);
}
break;
case 4:
if (__IN(g, 0x01f0)) {
OPB_Convert(&z, y->typ);
} else {
OPB_err(100);
}
break;
case 5:
if (g == 4) {
case 4: case 5: case 6:
if ((__IN(g, 0x70) && y->typ->size < z->typ->size)) {
OPB_Convert(&y, z->typ);
} else if (__IN(g, 0x01f0)) {
OPB_Convert(&z, y->typ);
@ -1292,15 +1308,6 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(100);
}
break;
case 6:
if (__IN(g, 0x70)) {
OPB_Convert(&y, z->typ);
} else if (__IN(g, 0x0180)) {
OPB_Convert(&z, y->typ);
} else {
OPB_err(100);
}
break;
case 7:
if (__IN(g, 0x70)) {
OPB_Convert(&y, z->typ);
@ -1386,7 +1393,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp;
}
if (do_) {
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
}
break;
case 2:
@ -1405,7 +1412,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(102);
typ = OPT_undftyp;
}
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
break;
case 3:
do_ = 1;
@ -1428,7 +1435,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp;
}
if (do_) {
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
}
break;
case 4:
@ -1446,7 +1453,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(104);
typ = OPT_undftyp;
}
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
break;
case 5:
if (f == 2) {
@ -1456,7 +1463,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
} else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) {
} else {
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
}
} else if (f != 0) {
OPB_err(94);
@ -1479,7 +1486,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
}
if (do_) {
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
}
break;
case 7:
@ -1488,7 +1495,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp;
}
if ((!__IN(f, 0x70) || y->class != 7) || y->conval->intval != 0) {
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
}
break;
case 8:
@ -1499,7 +1506,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
} else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) {
} else {
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
}
} else if (f != 0) {
OPB_err(95);
@ -1507,16 +1514,16 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
break;
case 9: case 10:
if (__IN(f, 0x6bff) || strings__41(&z, &y)) {
if (__IN(f, 0x6bff) || strings__43(&z, &y)) {
typ = OPT_booltyp;
} else {
OPB_err(107);
typ = OPT_undftyp;
}
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
break;
case 11: case 12: case 13: case 14:
if (__IN(f, 0x01f9) || strings__41(&z, &y)) {
if (__IN(f, 0x01f9) || strings__43(&z, &y)) {
typ = OPT_booltyp;
} else {
OPM_LogWLn();
@ -1525,7 +1532,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(108);
typ = OPT_undftyp;
}
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
break;
default:
OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", (LONGINT)32);
@ -1535,7 +1542,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
}
*x = z;
Op__38_s = _s.lnk;
Op__40_s = _s.lnk;
}
void OPB_SetRange (OPT_Node *x, OPT_Node y)
@ -1546,13 +1553,13 @@ void OPB_SetRange (OPT_Node *x, OPT_Node y)
} else if ((__IN((*x)->typ->form, 0x70) && __IN(y->typ->form, 0x70))) {
if ((*x)->class == 7) {
k = (*x)->conval->intval;
if (0 > k || k > (LONGINT)OPM_MaxSet) {
if (0 > k || k > (int)OPM_MaxSet) {
OPB_err(202);
}
}
if (y->class == 7) {
l = y->conval->intval;
if (0 > l || l > (LONGINT)OPM_MaxSet) {
if (0 > l || l > (int)OPM_MaxSet) {
OPB_err(202);
}
}
@ -1582,7 +1589,7 @@ void OPB_SetElem (OPT_Node *x)
OPB_err(93);
} else if ((*x)->class == 7) {
k = (*x)->conval->intval;
if ((0 <= k && k <= (LONGINT)OPM_MaxSet)) {
if ((0 <= k && k <= (int)OPM_MaxSet)) {
(*x)->conval->setval = __SETOF(k);
} else {
OPB_err(202);
@ -1596,8 +1603,9 @@ void OPB_SetElem (OPT_Node *x)
static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
{
OPT_Struct y = NIL;
INTEGER f, g;
OPT_Struct y = NIL, p = NIL, q = NIL;
OPT_Struct p = NIL, q = NIL;
if (OPM_Verbose) {
OPM_LogWLn();
OPM_LogWStr((CHAR*)"PROCEDURE CheckAssign", (LONGINT)22);
@ -1627,31 +1635,20 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
case 0: case 10:
break;
case 1:
if (!__IN(g, 0x1a)) {
if (!((__IN(g, 0x7a) && y->size == 1))) {
OPB_err(113);
}
break;
case 2: case 3: case 4: case 9:
case 2: case 3: case 9:
if (g != f) {
OPB_err(113);
}
break;
case 5:
if (!__IN(g, 0x30)) {
case 4: case 5: case 6:
if (!__IN(g, 0x70) || x->size < y->size) {
OPB_err(113);
}
break;
case 6:
if (OPM_LIntSize == 4) {
if (!__IN(g, 0x70)) {
OPB_err(113);
}
} else {
if (!__IN(g, 0x70)) {
OPB_err(113);
}
}
break;
case 7:
if (!__IN(g, 0xf0)) {
OPB_err(113);
@ -1832,14 +1829,8 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
x = OPB_NewIntConst(((LONGINT)(0)));
x->typ = OPT_chartyp;
break;
case 4:
x = OPB_NewIntConst(OPM_MinSInt);
break;
case 5:
x = OPB_NewIntConst(OPM_MinInt);
break;
case 6:
x = OPB_NewIntConst(OPM_MinLInt);
case 4: case 5: case 6:
x = OPB_NewIntConst(OPM_SignedMinimum(x->typ->size));
break;
case 9:
x = OPB_NewIntConst(((LONGINT)(0)));
@ -1869,14 +1860,8 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
x = OPB_NewIntConst(((LONGINT)(255)));
x->typ = OPT_chartyp;
break;
case 4:
x = OPB_NewIntConst(OPM_MaxSInt);
break;
case 5:
x = OPB_NewIntConst(OPM_MaxInt);
break;
case 6:
x = OPB_NewIntConst(OPM_MaxLInt);
case 4: case 5: case 6:
x = OPB_NewIntConst(OPM_SignedMaximum(x->typ->size));
break;
case 9:
x = OPB_NewIntConst(OPM_MaxSet);
@ -1909,10 +1894,8 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 10:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if (f == 5) {
OPB_Convert(&x, OPT_sinttyp);
} else if (f == 6) {
OPB_Convert(&x, OPT_inttyp);
} else if ((__IN(f, 0x70) && x->typ->size > (int)OPM_SIntSize)) {
OPB_Convert(&x, OPB_IntType(OPB_ShorterSize(x->typ->size)));
} else if (f == 8) {
OPB_Convert(&x, OPT_realtyp);
} else {
@ -1922,10 +1905,8 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 11:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if (f == 4) {
OPB_Convert(&x, OPT_inttyp);
} else if (f == 5) {
OPB_Convert(&x, OPT_linttyp);
} else if ((__IN(f, 0x70) && x->typ->size < (int)OPM_LIntSize)) {
OPB_Convert(&x, OPB_IntType(OPB_LongerSize(x->typ->size)));
} else if (f == 7) {
OPB_Convert(&x, OPT_lrltyp);
} else if (f == 3) {
@ -1973,7 +1954,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if (__IN(f, 0x70)) {
if (f != 6) {
if (x->typ->size != (int)OPM_LIntSize) {
OPB_Convert(&x, OPT_linttyp);
}
} else {
@ -2011,9 +1992,9 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 24: case 25: case 28: case 31:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if ((x->class == 7 && __IN(f, 0x30))) {
} else if ((((x->class == 7 && __IN(f, 0x70))) && x->typ->size < OPT_linttyp->size)) {
OPB_Convert(&x, OPT_linttyp);
} else if (!__IN(f, 0x2040)) {
} else if (!((__IN(x->typ->form, 0x2070) && x->typ->size == (int)OPM_PointerSize))) {
OPB_err(111);
x->typ = OPT_linttyp;
}
@ -2062,13 +2043,13 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
*par0 = x;
}
static struct StPar1__52 {
struct StPar1__52 *lnk;
} *StPar1__52_s;
static struct StPar1__56 {
struct StPar1__56 *lnk;
} *StPar1__56_s;
static OPT_Node NewOp__53 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right);
static OPT_Node NewOp__57 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right);
static OPT_Node NewOp__53 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right)
static OPT_Node NewOp__57 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right)
{
OPT_Node _o_result;
OPT_Node node = NIL;
@ -2085,9 +2066,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
INTEGER f, L;
OPT_Struct typ = NIL;
OPT_Node p = NIL, t = NIL;
struct StPar1__52 _s;
_s.lnk = StPar1__52_s;
StPar1__52_s = &_s;
struct StPar1__56 _s;
_s.lnk = StPar1__56_s;
StPar1__56_s = &_s;
p = *par0;
f = x->typ->form;
switch (fctno) {
@ -2103,7 +2084,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
OPB_err(111);
}
}
p = NewOp__53(19, fctno, p, x);
p = NewOp__57(19, fctno, p, x);
p->typ = OPT_notyp;
}
break;
@ -2111,10 +2092,10 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if (__IN(f, 0x70)) {
if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval > (LONGINT)OPM_MaxSet))) {
if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval > (int)OPM_MaxSet))) {
OPB_err(202);
}
p = NewOp__53(19, fctno, p, x);
p = NewOp__57(19, fctno, p, x);
} else {
OPB_err(111);
}
@ -2123,7 +2104,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 17:
if (!__IN(f, 0x70) || x->class != 7) {
OPB_err(69);
} else if (f == 4) {
} else if (x->typ->size == 1) {
L = (int)x->conval->intval;
typ = p->typ;
while ((L > 0 && __IN(typ->comp, 0x0c))) {
@ -2139,7 +2120,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
p = p->left;
x->conval->intval += 1;
}
p = NewOp__53(12, 19, p, x);
p = NewOp__57(12, 19, p, x);
p->typ = OPT_linttyp;
} else {
p = x;
@ -2161,7 +2142,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
t = x;
x = p;
p = t;
p = NewOp__53(19, 18, p, x);
p = NewOp__57(19, 18, p, x);
} else {
OPB_err(111);
}
@ -2187,7 +2168,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
}
p->obj = NIL;
} else {
p = NewOp__53(12, 17, p, x);
p = NewOp__57(12, 17, p, x);
p->typ = OPT_linttyp;
}
} else {
@ -2218,9 +2199,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
OPB_err(111);
} else {
if (fctno == 22) {
p = NewOp__53(12, 27, p, x);
p = NewOp__57(12, 27, p, x);
} else {
p = NewOp__53(12, 28, p, x);
p = NewOp__57(12, 28, p, x);
}
p->typ = p->left->typ;
}
@ -2237,7 +2218,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
x = p;
p = t;
}
p = NewOp__53(19, fctno, p, x);
p = NewOp__57(19, fctno, p, x);
} else {
OPB_err(111);
}
@ -2247,7 +2228,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if (__IN(f, 0x70)) {
p = NewOp__53(12, 26, p, x);
p = NewOp__57(12, 26, p, x);
} else {
OPB_err(111);
}
@ -2257,6 +2238,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if (((x->class == 8 || x->class == 9) || __IN(f, 0x1401)) || x->typ->comp == 3) {
OPB_err(126);
}
if (x->typ->size < p->typ->size) {
OPB_err(-308);
}
t = OPT_NewNode(11);
t->subcl = 29;
t->left = x;
@ -2268,7 +2252,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if (__IN(f, 0x70)) {
p = NewOp__53(19, 30, p, x);
p = NewOp__57(19, 30, p, x);
} else {
OPB_err(111);
}
@ -2277,9 +2261,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 31:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if ((x->class == 7 && __IN(f, 0x30))) {
} else if ((((x->class == 7 && __IN(f, 0x70))) && x->typ->size < OPT_linttyp->size)) {
OPB_Convert(&x, OPT_linttyp);
} else if (!__IN(f, 0x2040)) {
} else if (!((__IN(x->typ->form, 0x2070) && x->typ->size == (int)OPM_PointerSize))) {
OPB_err(111);
x->typ = OPT_linttyp;
}
@ -2314,7 +2298,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
break;
}
*par0 = p;
StPar1__52_s = _s.lnk;
StPar1__56_s = _s.lnk;
}
void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
@ -2433,7 +2417,7 @@ static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpa
ftyp = ftyp->BaseTyp;
atyp = atyp->BaseTyp;
if ((fvarpar && ftyp == OPT_bytetyp)) {
if (!__IN(f, 0x0c) || !__IN(atyp->form, 0x1e)) {
if (!__IN(f, 0x0c) || !((__IN(atyp->form, 0x7e) && atyp->size == 1))) {
if (__IN(18, OPM_opt)) {
OPB_err(-301);
}
@ -2516,7 +2500,7 @@ void OPB_Param (OPT_Node ap, OPT_Object fp)
OPB_err(111);
}
} else if ((fp->typ == OPT_sysptrtyp && ap->typ->form == 13)) {
} else if ((ap->typ != fp->typ && !((fp->typ->form == 1 && __IN(ap->typ->form, 0x18))))) {
} else if ((ap->typ != fp->typ && !((fp->typ->form == 1 && ((__IN(ap->typ->form, 0x7e) && ap->typ->size == 1)))))) {
OPB_err(123);
} else if ((fp->typ->form == 13 && ap->class == 5)) {
OPB_err(123);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPB__h
#define OPB__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
#include "Configuration.h"
#include "OPM.h"
@ -16,12 +16,13 @@ static CHAR OPC_BodyNameExt[13];
export void OPC_Align (LONGINT *adr, LONGINT base);
export void OPC_Andent (OPT_Struct typ);
static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames);
export LONGINT OPC_Base (OPT_Struct typ);
export LONGINT OPC_BaseAlignment (OPT_Struct typ);
export OPT_Object OPC_BaseTProc (OPT_Object obj);
export void OPC_BegBlk (void);
export void OPC_BegStat (void);
static void OPC_CProcDefs (OPT_Object obj, INTEGER vis);
export void OPC_Case (LONGINT caseVal, INTEGER form);
static void OPC_CharacterLiteral (LONGINT c);
export void OPC_Cmp (INTEGER rel);
export void OPC_CompleteIdent (OPT_Object obj);
export void OPC_Constant (OPT_Const con, INTEGER form);
@ -73,8 +74,10 @@ static void OPC_PutBase (OPT_Struct typ);
static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt);
static void OPC_RegCmds (OPT_Object obj);
export void OPC_SetInclude (BOOLEAN exclude);
export LONGINT OPC_SizeAlignment (LONGINT size);
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause);
static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x);
static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l);
export void OPC_TDescDecl (OPT_Struct typ);
export void OPC_TypeDefs (OPT_Object obj, INTEGER vis);
export void OPC_TypeOf (OPT_Object ap);
@ -315,7 +318,7 @@ void OPC_Andent (OPT_Struct typ)
static BOOLEAN OPC_Undefined (OPT_Object obj)
{
BOOLEAN _o_result;
_o_result = (((obj->mnolev >= 0 && obj->linkadr != (LONGINT)(3 + OPM_currFile))) && obj->linkadr != 2) || obj->name[0] == 0x00;
_o_result = obj->name[0] == 0x00 || (((obj->mnolev >= 0 && obj->linkadr != (int)(3 + OPM_currFile))) && obj->linkadr != 2);
return _o_result;
}
@ -815,14 +818,15 @@ void OPC_TDescDecl (OPT_Struct typ)
OPC_Andent(typ);
OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1);
OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ));
OPM_Write('\"');
OPM_Write('"');
if (typ->strobj != NIL) {
OPM_WriteStringVar((void*)typ->strobj->name, ((LONGINT)(256)));
}
OPC_Str1((CHAR*)"\", #), {", (LONGINT)9, typ->size);
OPM_Write('"');
OPC_Str1((CHAR*)", #), {", (LONGINT)8, typ->size);
nofptrs = 0;
OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs);
OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (LONGINT)OPM_LIntSize));
OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (int)OPM_LIntSize));
OPC_EndStat();
}
@ -864,70 +868,37 @@ void OPC_Align (LONGINT *adr, LONGINT base)
}
}
LONGINT OPC_Base (OPT_Struct typ)
LONGINT OPC_SizeAlignment (LONGINT size)
{
LONGINT _o_result;
switch (typ->form) {
case 1:
_o_result = 1;
return _o_result;
break;
case 3:
_o_result = OPM_CharAlign;
return _o_result;
break;
case 2:
_o_result = OPM_BoolAlign;
return _o_result;
break;
case 4:
_o_result = OPM_SIntAlign;
return _o_result;
break;
case 5:
_o_result = OPM_IntAlign;
return _o_result;
break;
case 6:
_o_result = OPM_LIntAlign;
return _o_result;
break;
case 7:
_o_result = OPM_RealAlign;
return _o_result;
break;
case 8:
_o_result = OPM_LRealAlign;
return _o_result;
break;
case 9:
_o_result = OPM_SetAlign;
return _o_result;
break;
case 13:
_o_result = OPM_PointerAlign;
return _o_result;
break;
case 14:
_o_result = OPM_ProcAlign;
return _o_result;
break;
case 15:
if (typ->comp == 4) {
_o_result = __MASK(typ->align, -65536);
return _o_result;
} else {
_o_result = OPC_Base(typ->BaseTyp);
return _o_result;
}
break;
default:
OPM_LogWStr((CHAR*)"unhandled case in OPC.Base, typ^form = ", (LONGINT)40);
OPM_LogWNum(typ->form, ((LONGINT)(0)));
OPM_LogWLn();
break;
LONGINT alignment;
if (size < (int)OPM_Alignment) {
alignment = 1;
while (alignment < size) {
alignment = __ASHL(alignment, 1);
}
} else {
alignment = OPM_Alignment;
}
__RETCHK;
_o_result = alignment;
return _o_result;
}
LONGINT OPC_BaseAlignment (OPT_Struct typ)
{
LONGINT _o_result;
LONGINT alignment;
if (typ->form == 15) {
if (typ->comp == 4) {
alignment = __MASK(typ->align, -65536);
} else {
alignment = OPC_BaseAlignment(typ->BaseTyp);
}
} else {
alignment = OPC_SizeAlignment(typ->size);
}
_o_result = alignment;
return _o_result;
}
static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LONGINT *curAlign)
@ -938,11 +909,11 @@ static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LO
if ((*curAlign < align && gap - (adr - off) >= align)) {
gap -= (adr - off) + align;
OPC_BegStat();
if (align == (LONGINT)OPM_IntSize) {
if (align == (int)OPM_IntSize) {
OPM_WriteString((CHAR*)"INTEGER", (LONGINT)8);
} else if (align == (LONGINT)OPM_LIntSize) {
} else if (align == (int)OPM_LIntSize) {
OPM_WriteString((CHAR*)"LONGINT", (LONGINT)8);
} else if (align == (LONGINT)OPM_LRealSize) {
} else if (align == (int)OPM_LRealSize) {
OPM_WriteString((CHAR*)"LONGREAL", (LONGINT)9);
}
OPC_Str1((CHAR*)" _prvt#", (LONGINT)8, *n);
@ -981,7 +952,7 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
}
} else {
adr = *off;
fldAlign = OPC_Base(fld->typ);
fldAlign = OPC_BaseAlignment(fld->typ);
OPC_Align(&adr, fldAlign);
gap = fld->adr - adr;
if (fldAlign > *curAlign) {
@ -1007,7 +978,7 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
}
}
if (last) {
adr = typ->size - (LONGINT)__ASHR(typ->sysflag, 8);
adr = typ->size - (int)__ASHR(typ->sysflag, 8);
if (adr == 0) {
gap = 1;
} else {
@ -1170,10 +1141,10 @@ static void OPC_Include (CHAR *name, LONGINT name__len)
{
__DUP(name, name__len, CHAR);
OPM_WriteString((CHAR*)"#include ", (LONGINT)10);
OPM_Write('\"');
OPM_Write('"');
OPM_WriteStringVar((void*)name, name__len);
OPM_WriteString((CHAR*)".h", (LONGINT)3);
OPM_Write('\"');
OPM_Write('"');
OPM_WriteLn();
__DEL(name);
}
@ -1238,8 +1209,8 @@ void OPC_GenHdr (OPT_Node n)
static void OPC_GenHeaderMsg (void)
{
INTEGER i;
OPM_WriteString((CHAR*)"/*", (LONGINT)3);
OPM_WriteString((CHAR*)" voc ", (LONGINT)6);
OPM_WriteString((CHAR*)"/* ", (LONGINT)4);
OPM_WriteString((CHAR*)"voc", (LONGINT)4);
OPM_Write(' ');
OPM_WriteString(Configuration_versionLong, ((LONGINT)(41)));
OPM_Write(' ');
@ -1855,26 +1826,56 @@ void OPC_Cmp (INTEGER rel)
}
}
static void OPC_CharacterLiteral (LONGINT c)
{
if (c < 32 || c > 126) {
OPM_WriteString((CHAR*)"0x", (LONGINT)3);
OPM_WriteHex(c);
} else {
OPM_Write('\'');
if ((c == 92 || c == 39) || c == 63) {
OPM_Write('\\');
}
OPM_Write((CHAR)c);
OPM_Write('\'');
}
}
static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l)
{
LONGINT i;
INTEGER c;
__DUP(s, s__len, CHAR);
OPM_Write('"');
i = 0;
while (i < l) {
c = (int)s[__X(i, s__len)];
if (c < 32 || c > 126) {
OPM_Write('\\');
OPM_Write((CHAR)(48 + __ASHR(c, 6)));
c = __MASK(c, -64);
OPM_Write((CHAR)(48 + __ASHR(c, 3)));
c = __MASK(c, -8);
OPM_Write((CHAR)(48 + c));
} else {
if ((c == 92 || c == 34) || c == 63) {
OPM_Write('\\');
}
OPM_Write((CHAR)c);
}
i += 1;
}
OPM_Write('"');
__DEL(s);
}
void OPC_Case (LONGINT caseVal, INTEGER form)
{
CHAR ch;
OPM_WriteString((CHAR*)"case ", (LONGINT)6);
switch (form) {
case 3:
ch = (CHAR)caseVal;
if ((ch >= ' ' && ch <= '~')) {
OPM_Write('\'');
if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') {
OPM_Write('\\');
OPM_Write(ch);
} else {
OPM_Write(ch);
}
OPM_Write('\'');
} else {
OPM_WriteString((CHAR*)"0x", (LONGINT)3);
OPM_WriteHex(caseVal);
}
OPC_CharacterLiteral(caseVal);
break;
case 4: case 5: case 6:
OPM_WriteInt(caseVal);
@ -1932,8 +1933,7 @@ void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim)
void OPC_Constant (OPT_Const con, INTEGER form)
{
INTEGER i, len;
CHAR ch;
INTEGER i;
SET s;
LONGINT hex;
BOOLEAN skipLeading;
@ -1945,18 +1945,7 @@ void OPC_Constant (OPT_Const con, INTEGER form)
OPM_WriteInt(con->intval);
break;
case 3:
ch = (CHAR)con->intval;
if ((ch >= ' ' && ch <= '~')) {
OPM_Write('\'');
if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') {
OPM_Write('\\');
}
OPM_Write(ch);
OPM_Write('\'');
} else {
OPM_WriteString((CHAR*)"0x", (LONGINT)3);
OPM_WriteHex(con->intval);
}
OPC_CharacterLiteral(con->intval);
break;
case 4: case 5: case 6:
OPM_WriteInt(con->intval);
@ -1991,18 +1980,7 @@ void OPC_Constant (OPT_Const con, INTEGER form)
}
break;
case 10:
OPM_Write('\"');
len = (int)con->intval2 - 1;
i = 0;
while (i < len) {
ch = (*con->ext)[__X(i, ((LONGINT)(256)))];
if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') {
OPM_Write('\\');
}
OPM_Write(ch);
i += 1;
}
OPM_Write('\"');
OPC_StringLiteral(*con->ext, ((LONGINT)(256)), con->intval2 - 1);
break;
case 11:
OPM_WriteString((CHAR*)"NIL", (LONGINT)4);
@ -2015,74 +1993,74 @@ void OPC_Constant (OPT_Const con, INTEGER form)
}
}
static struct InitKeywords__47 {
static struct InitKeywords__48 {
SHORTINT *n;
struct InitKeywords__47 *lnk;
} *InitKeywords__47_s;
struct InitKeywords__48 *lnk;
} *InitKeywords__48_s;
static void Enter__48 (CHAR *s, LONGINT s__len);
static void Enter__49 (CHAR *s, LONGINT s__len);
static void Enter__48 (CHAR *s, LONGINT s__len)
static void Enter__49 (CHAR *s, LONGINT s__len)
{
INTEGER h;
__DUP(s, s__len, CHAR);
h = OPC_PerfectHash((void*)s, s__len);
OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__47_s->n;
__COPY(s, OPC_keytab[__X(*InitKeywords__47_s->n, ((LONGINT)(36)))], ((LONGINT)(9)));
*InitKeywords__47_s->n += 1;
OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__48_s->n;
__COPY(s, OPC_keytab[__X(*InitKeywords__48_s->n, ((LONGINT)(36)))], ((LONGINT)(9)));
*InitKeywords__48_s->n += 1;
__DEL(s);
}
static void OPC_InitKeywords (void)
{
SHORTINT n, i;
struct InitKeywords__47 _s;
struct InitKeywords__48 _s;
_s.n = &n;
_s.lnk = InitKeywords__47_s;
InitKeywords__47_s = &_s;
_s.lnk = InitKeywords__48_s;
InitKeywords__48_s = &_s;
n = 0;
i = 0;
while (i <= 104) {
OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1;
i += 1;
}
Enter__48((CHAR*)"asm", (LONGINT)4);
Enter__48((CHAR*)"auto", (LONGINT)5);
Enter__48((CHAR*)"break", (LONGINT)6);
Enter__48((CHAR*)"case", (LONGINT)5);
Enter__48((CHAR*)"char", (LONGINT)5);
Enter__48((CHAR*)"const", (LONGINT)6);
Enter__48((CHAR*)"continue", (LONGINT)9);
Enter__48((CHAR*)"default", (LONGINT)8);
Enter__48((CHAR*)"do", (LONGINT)3);
Enter__48((CHAR*)"double", (LONGINT)7);
Enter__48((CHAR*)"else", (LONGINT)5);
Enter__48((CHAR*)"enum", (LONGINT)5);
Enter__48((CHAR*)"extern", (LONGINT)7);
Enter__48((CHAR*)"export", (LONGINT)7);
Enter__48((CHAR*)"float", (LONGINT)6);
Enter__48((CHAR*)"for", (LONGINT)4);
Enter__48((CHAR*)"fortran", (LONGINT)8);
Enter__48((CHAR*)"goto", (LONGINT)5);
Enter__48((CHAR*)"if", (LONGINT)3);
Enter__48((CHAR*)"import", (LONGINT)7);
Enter__48((CHAR*)"int", (LONGINT)4);
Enter__48((CHAR*)"long", (LONGINT)5);
Enter__48((CHAR*)"register", (LONGINT)9);
Enter__48((CHAR*)"return", (LONGINT)7);
Enter__48((CHAR*)"short", (LONGINT)6);
Enter__48((CHAR*)"signed", (LONGINT)7);
Enter__48((CHAR*)"sizeof", (LONGINT)7);
Enter__48((CHAR*)"static", (LONGINT)7);
Enter__48((CHAR*)"struct", (LONGINT)7);
Enter__48((CHAR*)"switch", (LONGINT)7);
Enter__48((CHAR*)"typedef", (LONGINT)8);
Enter__48((CHAR*)"union", (LONGINT)6);
Enter__48((CHAR*)"unsigned", (LONGINT)9);
Enter__48((CHAR*)"void", (LONGINT)5);
Enter__48((CHAR*)"volatile", (LONGINT)9);
Enter__48((CHAR*)"while", (LONGINT)6);
InitKeywords__47_s = _s.lnk;
Enter__49((CHAR*)"asm", (LONGINT)4);
Enter__49((CHAR*)"auto", (LONGINT)5);
Enter__49((CHAR*)"break", (LONGINT)6);
Enter__49((CHAR*)"case", (LONGINT)5);
Enter__49((CHAR*)"char", (LONGINT)5);
Enter__49((CHAR*)"const", (LONGINT)6);
Enter__49((CHAR*)"continue", (LONGINT)9);
Enter__49((CHAR*)"default", (LONGINT)8);
Enter__49((CHAR*)"do", (LONGINT)3);
Enter__49((CHAR*)"double", (LONGINT)7);
Enter__49((CHAR*)"else", (LONGINT)5);
Enter__49((CHAR*)"enum", (LONGINT)5);
Enter__49((CHAR*)"extern", (LONGINT)7);
Enter__49((CHAR*)"export", (LONGINT)7);
Enter__49((CHAR*)"float", (LONGINT)6);
Enter__49((CHAR*)"for", (LONGINT)4);
Enter__49((CHAR*)"fortran", (LONGINT)8);
Enter__49((CHAR*)"goto", (LONGINT)5);
Enter__49((CHAR*)"if", (LONGINT)3);
Enter__49((CHAR*)"import", (LONGINT)7);
Enter__49((CHAR*)"int", (LONGINT)4);
Enter__49((CHAR*)"long", (LONGINT)5);
Enter__49((CHAR*)"register", (LONGINT)9);
Enter__49((CHAR*)"return", (LONGINT)7);
Enter__49((CHAR*)"short", (LONGINT)6);
Enter__49((CHAR*)"signed", (LONGINT)7);
Enter__49((CHAR*)"sizeof", (LONGINT)7);
Enter__49((CHAR*)"static", (LONGINT)7);
Enter__49((CHAR*)"struct", (LONGINT)7);
Enter__49((CHAR*)"switch", (LONGINT)7);
Enter__49((CHAR*)"typedef", (LONGINT)8);
Enter__49((CHAR*)"union", (LONGINT)6);
Enter__49((CHAR*)"unsigned", (LONGINT)9);
Enter__49((CHAR*)"void", (LONGINT)5);
Enter__49((CHAR*)"volatile", (LONGINT)9);
Enter__49((CHAR*)"while", (LONGINT)6);
InitKeywords__48_s = _s.lnk;
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPC__h
#define OPC__h
@ -11,7 +11,7 @@
import void OPC_Align (LONGINT *adr, LONGINT base);
import void OPC_Andent (OPT_Struct typ);
import LONGINT OPC_Base (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);
@ -40,6 +40,7 @@ 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_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_TypeOf (OPT_Object ap);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
#include "Configuration.h"
#include "Console.h"
@ -14,8 +14,8 @@ typedef
static CHAR OPM_SourceFileName[256];
export INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_CharAlign, OPM_BoolAlign, OPM_SIntAlign, OPM_IntAlign, OPM_LIntAlign, OPM_SetAlign, OPM_RealAlign, OPM_LRealAlign, OPM_PointerAlign, OPM_ProcAlign, OPM_RecAlign, OPM_MaxSet;
export LONGINT OPM_MinSInt, OPM_MinInt, OPM_MinLInt, OPM_MaxSInt, OPM_MaxInt, OPM_MaxLInt, OPM_MaxIndex;
export INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_MaxSet;
export LONGINT OPM_MaxIndex;
export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
export BOOLEAN OPM_noerr;
export LONGINT OPM_curpos, OPM_errpos, OPM_breakpc;
@ -57,7 +57,6 @@ export void OPM_LogWNum (LONGINT i, LONGINT len);
export void OPM_LogWStr (CHAR *s, LONGINT s__len);
static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len);
export void OPM_Mark (INTEGER n, LONGINT pos);
static INTEGER OPM_Min (INTEGER a, INTEGER b);
export void OPM_NewSym (CHAR *modName, LONGINT modName__len);
export void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
export void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
@ -65,6 +64,8 @@ export BOOLEAN OPM_OpenPar (void);
export void OPM_RegisterNewSym (void);
static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt);
static void OPM_ShowLine (LONGINT pos);
export LONGINT OPM_SignedMaximum (LONGINT bytecount);
export LONGINT OPM_SignedMinimum (LONGINT bytecount);
export void OPM_SymRCh (CHAR *ch);
export LONGINT OPM_SymRInt (void);
export void OPM_SymRLReal (LONGREAL *lr);
@ -85,7 +86,7 @@ export void OPM_WriteString (CHAR *s, LONGINT s__len);
export void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
export BOOLEAN OPM_eofSF (void);
export void OPM_err (INTEGER n);
static LONGINT OPM_minus (LONGINT i);
static LONGINT OPM_minusop (LONGINT i);
static LONGINT OPM_power0 (LONGINT i, LONGINT j);
@ -117,50 +118,38 @@ static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt)
i = 1;
while (s[__X(i, s__len)] != 0x00) {
switch (s[__X(i, s__len)]) {
case 'e':
*opt = *opt ^ 0x0200;
break;
case 's':
*opt = *opt ^ 0x10;
break;
case 'm':
*opt = *opt ^ 0x0400;
break;
case 'x':
*opt = *opt ^ 0x01;
break;
case 'r':
*opt = *opt ^ 0x04;
break;
case 't':
*opt = *opt ^ 0x08;
break;
case 'a':
*opt = *opt ^ 0x80;
break;
case 'k':
*opt = *opt ^ 0x40;
break;
case 'p':
*opt = *opt ^ 0x20;
break;
case 'S':
*opt = *opt ^ 0x2000;
break;
case 'c':
*opt = *opt ^ 0x4000;
break;
case 'M':
*opt = *opt ^ 0x8000;
case 'e':
*opt = *opt ^ 0x0200;
break;
case 'f':
*opt = *opt ^ 0x010000;
break;
case 'F':
*opt = *opt ^ 0x020000;
case 'k':
*opt = *opt ^ 0x40;
break;
case 'V':
*opt = *opt ^ 0x040000;
case 'm':
*opt = *opt ^ 0x0400;
break;
case 'p':
*opt = *opt ^ 0x20;
break;
case 'r':
*opt = *opt ^ 0x04;
break;
case 's':
*opt = *opt ^ 0x10;
break;
case 't':
*opt = *opt ^ 0x08;
break;
case 'x':
*opt = *opt ^ 0x01;
break;
case 'B':
if (s[__X(i + 1, s__len)] != 0x00) {
@ -178,6 +167,19 @@ static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt)
__ASSERT(OPM_IntSize == 2 || OPM_IntSize == 4, 0);
__ASSERT(OPM_PointerSize == 4 || OPM_PointerSize == 8, 0);
__ASSERT(OPM_Alignment == 4 || OPM_Alignment == 8, 0);
Files_SetSearchPath((CHAR*)"", (LONGINT)1);
break;
case 'F':
*opt = *opt ^ 0x020000;
break;
case 'M':
*opt = *opt ^ 0x8000;
break;
case 'S':
*opt = *opt ^ 0x2000;
break;
case 'V':
*opt = *opt ^ 0x040000;
break;
default:
OPM_LogWStr((CHAR*)" warning: option ", (LONGINT)19);
@ -227,17 +229,17 @@ BOOLEAN OPM_OpenPar (void)
OPM_LogWLn();
OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" a - don\'t check ASSERTs at runtime, use this option in tested production code", (LONGINT)80);
OPM_LogWStr((CHAR*)" a - don't check ASSERTs at runtime, use this option in tested production code", (LONGINT)80);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" t - don\'t check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101);
OPM_LogWStr((CHAR*)" t - don't check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" S - don\'t call external assembler/compiler, only generate C code", (LONGINT)67);
OPM_LogWStr((CHAR*)" S - don't call external assembler/compiler, only generate C code", (LONGINT)67);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" c - don\'t call linker", (LONGINT)24);
OPM_LogWStr((CHAR*)" c - don't call linker", (LONGINT)24);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" f - don\'t use color output", (LONGINT)29);
OPM_LogWStr((CHAR*)" f - don't use color output", (LONGINT)29);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57);
OPM_LogWLn();
@ -540,14 +542,17 @@ void OPM_FPrintSet (LONGINT *fp, SET set)
void OPM_FPrintReal (LONGINT *fp, REAL real)
{
OPM_FPrint(&*fp, __VAL(LONGINT, real));
INTEGER i;
LONGINT l;
__GET((LONGINT)(SYSTEM_ADDRESS)&real, l, LONGINT);
OPM_FPrint(&*fp, l);
}
void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr)
{
LONGINT l, h;
__GET((LONGINT)(uintptr_t)&lr, l, LONGINT);
__GET((LONGINT)(uintptr_t)&lr + 4, h, LONGINT);
__GET((LONGINT)(SYSTEM_ADDRESS)&lr, l, LONGINT);
__GET((LONGINT)(SYSTEM_ADDRESS)&lr + 4, h, LONGINT);
OPM_FPrint(&*fp, l);
OPM_FPrint(&*fp, h);
}
@ -575,7 +580,7 @@ static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONG
__DEL(name);
}
static LONGINT OPM_minus (LONGINT i)
static LONGINT OPM_minusop (LONGINT i)
{
LONGINT _o_result;
_o_result = -i;
@ -603,103 +608,62 @@ static void OPM_VerboseListSizes (void)
OPM_LogWLn();
OPM_LogWStr((CHAR*)"CHAR ", (LONGINT)14);
OPM_LogWNum(OPM_CharSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_CharAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"BOOLEAN ", (LONGINT)14);
OPM_LogWNum(OPM_BoolSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_BoolAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"SHORTINT ", (LONGINT)14);
OPM_LogWNum(OPM_SIntSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_SIntAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"INTEGER ", (LONGINT)14);
OPM_LogWNum(OPM_IntSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_IntAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"LONGINT ", (LONGINT)14);
OPM_LogWNum(OPM_LIntSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_LIntAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"SET ", (LONGINT)14);
OPM_LogWNum(OPM_SetSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_SetAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"REAL ", (LONGINT)14);
OPM_LogWNum(OPM_RealSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_RealAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"LONGREAL ", (LONGINT)14);
OPM_LogWNum(OPM_LRealSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_LRealAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"PTR ", (LONGINT)14);
OPM_LogWNum(OPM_PointerSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_PointerAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"PROC ", (LONGINT)14);
OPM_LogWNum(OPM_ProcSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_ProcAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"RECORD ", (LONGINT)14);
OPM_LogWNum(OPM_RecSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_RecAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Min shortint ", (LONGINT)14);
OPM_LogWNum(OPM_MinSInt, ((LONGINT)(4)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Max shortint ", (LONGINT)14);
OPM_LogWNum(OPM_MaxSInt, ((LONGINT)(4)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Min integer ", (LONGINT)14);
OPM_LogWNum(OPM_MinInt, ((LONGINT)(4)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Max integer ", (LONGINT)14);
OPM_LogWNum(OPM_MaxInt, ((LONGINT)(4)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Min longint ", (LONGINT)14);
OPM_LogWNum(OPM_MinLInt, ((LONGINT)(4)));
OPM_LogWLn();
}
static INTEGER OPM_Min (INTEGER a, INTEGER b)
LONGINT OPM_SignedMaximum (LONGINT bytecount)
{
INTEGER _o_result;
if (a < b) {
_o_result = a;
return _o_result;
} else {
_o_result = b;
return _o_result;
}
__RETCHK;
LONGINT _o_result;
LONGINT result;
result = 1;
result = __LSH(result, __ASHL(bytecount, 3) - 1, LONGINT);
_o_result = result - 1;
return _o_result;
}
LONGINT OPM_SignedMinimum (LONGINT bytecount)
{
LONGINT _o_result;
_o_result = -OPM_SignedMaximum(bytecount) - 1;
return _o_result;
}
static void OPM_GetProperties (void)
{
LONGINT base;
OPM_ProcSize = OPM_PointerSize;
OPM_LIntSize = __ASHL(OPM_IntSize, 1);
OPM_SetSize = OPM_LIntSize;
OPM_CharAlign = OPM_Min(OPM_Alignment, OPM_CharSize);
OPM_BoolAlign = OPM_Min(OPM_Alignment, OPM_BoolSize);
OPM_SIntAlign = OPM_Min(OPM_Alignment, OPM_SIntSize);
OPM_RecAlign = OPM_Min(OPM_Alignment, OPM_RecSize);
OPM_RealAlign = OPM_Min(OPM_Alignment, OPM_RealSize);
OPM_LRealAlign = OPM_Min(OPM_Alignment, OPM_LRealSize);
OPM_PointerAlign = OPM_Min(OPM_Alignment, OPM_PointerSize);
OPM_ProcAlign = OPM_Min(OPM_Alignment, OPM_ProcSize);
OPM_IntAlign = OPM_Min(OPM_Alignment, OPM_IntSize);
OPM_LIntAlign = OPM_Min(OPM_Alignment, OPM_LIntSize);
OPM_SetAlign = OPM_Min(OPM_Alignment, OPM_SetSize);
base = -2;
OPM_MinSInt = __ASH(base, __ASHL(OPM_SIntSize, 3) - 2);
OPM_MaxSInt = OPM_minus(OPM_MinSInt + 1);
OPM_MinInt = __ASH(base, __ASHL(OPM_IntSize, 3) - 2);
OPM_MaxInt = OPM_minus(OPM_MinInt + 1);
OPM_MinLInt = __ASH(base, __ASHL(OPM_LIntSize, 3) - 2);
OPM_MaxLInt = OPM_minus(OPM_MinLInt + 1);
if (OPM_RealSize == 4) {
OPM_MaxReal = 3.40282346000000e+038;
} else if (OPM_RealSize == 8) {
@ -713,7 +677,7 @@ static void OPM_GetProperties (void)
OPM_MinReal = -OPM_MaxReal;
OPM_MinLReal = -OPM_MaxLReal;
OPM_MaxSet = __ASHL(OPM_SetSize, 3) - 1;
OPM_MaxIndex = OPM_MaxLInt;
OPM_MaxIndex = OPM_SignedMaximum(OPM_PointerSize);
if (OPM_Verbose) {
OPM_VerboseListSizes();
}
@ -875,7 +839,7 @@ void OPM_WriteInt (LONGINT i)
{
CHAR s[20];
LONGINT i1, k;
if (i == OPM_MinInt || i == OPM_MinLInt) {
if (i == OPM_SignedMinimum(OPM_IntSize) || i == OPM_SignedMinimum(OPM_LIntSize)) {
OPM_Write('(');
OPM_WriteInt(i + 1);
OPM_WriteString((CHAR*)"-1)", (LONGINT)4);
@ -908,13 +872,13 @@ void OPM_WriteReal (LONGREAL r, CHAR suffx)
CHAR s[32];
CHAR ch;
INTEGER i;
if ((((r < OPM_MaxLInt && r > OPM_MinLInt)) && r == (__ENTIER(r)))) {
if ((((r < OPM_SignedMaximum(OPM_LIntSize) && r > OPM_SignedMinimum(OPM_LIntSize))) && r == ((int)__ENTIER(r)))) {
if (suffx == 'f') {
OPM_WriteString((CHAR*)"(REAL)", (LONGINT)7);
} else {
OPM_WriteString((CHAR*)"(LONGREAL)", (LONGINT)11);
}
OPM_WriteInt(__ENTIER(r));
OPM_WriteInt((int)__ENTIER(r));
} else {
Texts_OpenWriter(&W, Texts_Writer__typ);
if (suffx == 'f') {

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPM__h
#define OPM__h
@ -6,8 +6,8 @@
#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_CharAlign, OPM_BoolAlign, OPM_SIntAlign, OPM_IntAlign, OPM_LIntAlign, OPM_SetAlign, OPM_RealAlign, OPM_LRealAlign, OPM_PointerAlign, OPM_ProcAlign, OPM_RecAlign, OPM_MaxSet;
import LONGINT OPM_MinSInt, OPM_MinInt, OPM_MinLInt, OPM_MaxSInt, OPM_MaxInt, OPM_MaxLInt, OPM_MaxIndex;
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 LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
import BOOLEAN OPM_noerr;
import LONGINT OPM_curpos, OPM_errpos, OPM_breakpc;
@ -38,6 +38,8 @@ 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 void OPM_SymRCh (CHAR *ch);
import LONGINT OPM_SymRInt (void);
import void OPM_SymRLReal (LONGREAL *lr);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
#include "OPB.h"
#include "OPM.h"
@ -438,10 +438,10 @@ static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned)
if (OPP_sym == 38) {
OPP_qualident(&id);
if (id->mode == 5) {
if (id->typ != *banned) {
*typ = id->typ;
} else {
if (id->typ == *banned) {
OPP_err(58);
} else {
*typ = id->typ;
}
} else {
OPP_err(52);
@ -1783,6 +1783,24 @@ void OPP_Module (OPT_Node *prog, SET opt)
if (OPP_sym == 63) {
OPS_Get(&OPP_sym);
} else {
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Unexpected symbol found when MODULE expected:", (LONGINT)46);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" sym: ", (LONGINT)15);
OPM_LogWNum(OPP_sym, ((LONGINT)(1)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)" OPS.name: ", (LONGINT)15);
OPM_LogWStr(OPS_name, ((LONGINT)(256)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)" OPS.str: ", (LONGINT)15);
OPM_LogWStr(OPS_str, ((LONGINT)(256)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)" OPS.numtyp: ", (LONGINT)15);
OPM_LogWNum(OPS_numtyp, ((LONGINT)(1)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)" OPS.intval: ", (LONGINT)15);
OPM_LogWNum(OPS_intval, ((LONGINT)(1)));
OPM_LogWLn();
OPP_err(16);
}
if (OPP_sym == 38) {

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPP__h
#define OPP__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin tspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
#include "SYSTEM.h"
#include "OPM.h"
@ -173,7 +173,7 @@ static void OPS_Number (void)
OPS_numtyp = 1;
if (n <= 2) {
while (i < n) {
OPS_intval = __ASHL(OPS_intval, 4) + (LONGINT)Ord__7(dig[i], 1);
OPS_intval = __ASHL(OPS_intval, 4) + (int)Ord__7(dig[i], 1);
i += 1;
}
} else {
@ -188,7 +188,7 @@ static void OPS_Number (void)
OPS_intval = -1;
}
while (i < n) {
OPS_intval = __ASHL(OPS_intval, 4) + (LONGINT)Ord__7(dig[i], 1);
OPS_intval = __ASHL(OPS_intval, 4) + (int)Ord__7(dig[i], 1);
i += 1;
}
} else {
@ -199,8 +199,8 @@ static void OPS_Number (void)
while (i < n) {
d = Ord__7(dig[i], 0);
i += 1;
if (OPS_intval <= __DIV(2147483647 - (LONGINT)d, 10)) {
OPS_intval = OPS_intval * 10 + (LONGINT)d;
if (OPS_intval <= __DIV(2147483647 - (int)d, 10)) {
OPS_intval = OPS_intval * 10 + (int)d;
} else {
OPS_err(203);
}
@ -325,7 +325,7 @@ void OPS_Get (SHORTINT *sym)
}
}
switch (OPS_ch) {
case '\"': case '\'':
case '"': case '\'':
OPS_Str(&s);
break;
case '#':

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin tspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
#ifndef OPS__h
#define OPS__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
#include "OPM.h"
#include "OPS.h"
@ -849,7 +849,7 @@ static void OPT_InConstant (LONGINT f, OPT_Const conval)
conval->intval = 0;
break;
default:
OPM_LogWStr((CHAR*)"unhandled case in OPT.InConstant(), f = ", (LONGINT)41);
OPM_LogWStr((CHAR*)"unhandled case in InConstant(), f = ", (LONGINT)37);
OPM_LogWNum(f, ((LONGINT)(0)));
OPM_LogWLn();
break;
@ -1072,7 +1072,7 @@ static void OPT_InStruct (OPT_Struct *typ)
OPT_InSign(mno, &(*typ)->BaseTyp, &(*typ)->link);
break;
default:
OPM_LogWStr((CHAR*)"unhandled case at OPT.InStruct, tag = ", (LONGINT)39);
OPM_LogWStr((CHAR*)"unhandled case at InStruct, tag = ", (LONGINT)35);
OPM_LogWNum(tag, ((LONGINT)(0)));
OPM_LogWLn();
break;
@ -1175,7 +1175,7 @@ static OPT_Object OPT_InObj (SHORTINT mno)
}
break;
default:
OPM_LogWStr((CHAR*)"unhandled case at OPT.InObj, tag = ", (LONGINT)36);
OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", (LONGINT)32);
OPM_LogWNum(tag, ((LONGINT)(0)));
OPM_LogWLn();
break;
@ -1464,14 +1464,14 @@ static void OPT_OutStr (OPT_Struct typ)
OPM_SymWInt(((LONGINT)(18)));
break;
default:
OPM_LogWStr((CHAR*)"unhandled case at OPT.OutStr, typ^.comp = ", (LONGINT)43);
OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.comp = ", (LONGINT)39);
OPM_LogWNum(typ->comp, ((LONGINT)(0)));
OPM_LogWLn();
break;
}
break;
default:
OPM_LogWStr((CHAR*)"unhandled case at OPT.OutStr, typ^.form = ", (LONGINT)43);
OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.form = ", (LONGINT)39);
OPM_LogWNum(typ->form, ((LONGINT)(0)));
OPM_LogWLn();
break;
@ -1536,7 +1536,7 @@ static void OPT_OutObj (OPT_Object obj)
OPT_FPrintErr(obj, 251);
break;
default:
OPM_LogWStr((CHAR*)"unhandled case at OPT.OutObj, obj^.history = ", (LONGINT)46);
OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj^.history = ", (LONGINT)42);
OPM_LogWNum(obj->history, ((LONGINT)(0)));
OPM_LogWLn();
break;
@ -1592,7 +1592,7 @@ static void OPT_OutObj (OPT_Object obj)
OPT_OutName((void*)obj->name, ((LONGINT)(256)));
break;
default:
OPM_LogWStr((CHAR*)"unhandled case at OPT.OutObj, obj.mode = ", (LONGINT)42);
OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj.mode = ", (LONGINT)38);
OPM_LogWNum(obj->mode, ((LONGINT)(0)));
OPM_LogWLn();
break;
@ -1809,6 +1809,7 @@ export void *OPT__init(void)
OPT_syslink = OPT_topScope->right;
OPT_universe = OPT_topScope;
OPT_topScope->right = NIL;
OPT_EnterTyp((CHAR*)"BOOLEAN", 2, OPM_BoolSize, &OPT_booltyp);
OPT_EnterTyp((CHAR*)"CHAR", 3, OPM_CharSize, &OPT_chartyp);
OPT_EnterTyp((CHAR*)"SET", 9, OPM_SetSize, &OPT_settyp);
OPT_EnterTyp((CHAR*)"REAL", 7, OPM_RealSize, &OPT_realtyp);
@ -1816,7 +1817,6 @@ export void *OPT__init(void)
OPT_EnterTyp((CHAR*)"LONGINT", 6, OPM_LIntSize, &OPT_linttyp);
OPT_EnterTyp((CHAR*)"LONGREAL", 8, OPM_LRealSize, &OPT_lrltyp);
OPT_EnterTyp((CHAR*)"SHORTINT", 4, OPM_SIntSize, &OPT_sinttyp);
OPT_EnterTyp((CHAR*)"BOOLEAN", 2, OPM_BoolSize, &OPT_booltyp);
OPT_EnterBoolConst((CHAR*)"FALSE", ((LONGINT)(0)));
OPT_EnterBoolConst((CHAR*)"TRUE", ((LONGINT)(1)));
OPT_EnterProc((CHAR*)"HALT", 0);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPT__h
#define OPT__h
@ -59,8 +59,7 @@ typedef
INTEGER ref, sysflag;
LONGINT n, size, align, txtpos;
BOOLEAN allocated, pbused, pvused;
char _prvt0[8];
LONGINT pbfp, pvfp;
char _prvt0[16];
OPT_Struct BaseTyp;
OPT_Object link, strobj;
} OPT_StrDesc;

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
#include "OPC.h"
#include "OPM.h"
@ -23,7 +23,7 @@ export LONGINT *OPV_ExitInfo__typ;
static void OPV_ActualPar (OPT_Node n, OPT_Object fp);
export void OPV_AdrAndSize (OPT_Object topScope);
static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc);
static void OPV_Convert (OPT_Node n, INTEGER form, INTEGER prec);
static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INTEGER prec);
static void OPV_DefineTDescs (OPT_Node n);
static void OPV_Entier (OPT_Node n, INTEGER prec);
static void OPV_GetTProcNum (OPT_Object obj);
@ -38,6 +38,7 @@ static LONGINT OPV_NaturalAlignment (LONGINT size, LONGINT max);
static void OPV_NewArr (OPT_Node d, OPT_Node x);
static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, INTEGER comp);
static BOOLEAN OPV_SideEffects (OPT_Node n);
static void OPV_SizeCast (LONGINT size);
static void OPV_Stamp (OPS_Name s);
static OPT_Object OPV_SuperProc (OPT_Node n);
static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported);
@ -82,10 +83,10 @@ void OPV_TypSize (OPT_Struct typ)
btyp = typ->BaseTyp;
if (btyp == NIL) {
offset = 0;
base = OPM_RecAlign;
base = OPC_SizeAlignment(OPM_RecSize);
} else {
OPV_TypSize(btyp);
offset = btyp->size - (LONGINT)__ASHR(btyp->sysflag, 8);
offset = btyp->size - (int)__ASHR(btyp->sysflag, 8);
base = btyp->align;
}
fld = typ->link;
@ -93,7 +94,7 @@ void OPV_TypSize (OPT_Struct typ)
btyp = fld->typ;
OPV_TypSize(btyp);
size = btyp->size;
fbase = OPC_Base(btyp);
fbase = OPC_BaseAlignment(btyp);
OPC_Align(&offset, fbase);
fld->adr = offset;
offset += size;
@ -107,7 +108,7 @@ void OPV_TypSize (OPT_Struct typ)
offset = 1;
}
if (OPM_RecSize == 0) {
base = OPV_NaturalAlignment(offset, OPM_RecAlign);
base = OPV_NaturalAlignment(offset, OPC_SizeAlignment(OPM_RecSize));
}
OPC_Align(&offset, base);
if ((typ->strobj == NIL && __MASK(typ->align, -65536) == 0)) {
@ -332,7 +333,7 @@ static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, IN
return _o_result;
break;
default:
OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence Nmop, subclass = ", (LONGINT)51);
OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence OPT.Nmop, subclass = ", (LONGINT)55);
OPM_LogWNum(subclass, ((LONGINT)(0)));
OPM_LogWLn();
break;
@ -402,7 +403,7 @@ static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, IN
return _o_result;
break;
default:
OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence Ndop, subclass = ", (LONGINT)51);
OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence OPT.Ndop, subclass = ", (LONGINT)55);
OPM_LogWNum(subclass, ((LONGINT)(0)));
OPM_LogWLn();
break;
@ -465,41 +466,26 @@ static void OPV_Entier (OPT_Node n, INTEGER prec)
}
}
static void OPV_Convert (OPT_Node n, INTEGER form, INTEGER prec)
static void OPV_SizeCast (LONGINT size)
{
INTEGER from;
if (size <= 4) {
OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
} else {
OPM_WriteString((CHAR*)"(SYSTEM_INT64)", (LONGINT)15);
}
}
static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INTEGER prec)
{
INTEGER from, to;
from = n->typ->form;
if (form == 9) {
to = newtype->form;
if (to == 9) {
OPM_WriteString((CHAR*)"__SETOF(", (LONGINT)9);
OPV_Entier(n, -1);
OPM_Write(')');
} else if (form == 6) {
if (from < 6) {
OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10);
}
OPV_Entier(n, 9);
} else if (form == 5) {
if (from < 5) {
OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
OPV_expr(n, 9);
} else {
if (__IN(2, OPM_opt)) {
OPM_WriteString((CHAR*)"__SHORT", (LONGINT)8);
if (OPV_SideEffects(n)) {
OPM_Write('F');
}
OPM_Write('(');
OPV_Entier(n, -1);
OPM_WriteString((CHAR*)", ", (LONGINT)3);
OPM_WriteInt(OPM_MaxInt + 1);
OPM_Write(')');
} else {
OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
OPV_Entier(n, 9);
}
}
} else if (form == 4) {
if (__IN(2, OPM_opt)) {
} else if (__IN(to, 0x70)) {
if ((newtype->size < n->typ->size && __IN(2, OPM_opt))) {
OPM_WriteString((CHAR*)"__SHORT", (LONGINT)8);
if (OPV_SideEffects(n)) {
OPM_Write('F');
@ -507,13 +493,15 @@ static void OPV_Convert (OPT_Node n, INTEGER form, INTEGER prec)
OPM_Write('(');
OPV_Entier(n, -1);
OPM_WriteString((CHAR*)", ", (LONGINT)3);
OPM_WriteInt(OPM_MaxSInt + 1);
OPM_WriteInt(OPM_SignedMaximum(newtype->size) + 1);
OPM_Write(')');
} else {
OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
if (newtype->size != n->typ->size) {
OPV_SizeCast(newtype->size);
}
OPV_Entier(n, 9);
}
} else if (form == 3) {
} else if (to == 3) {
if (__IN(2, OPM_opt)) {
OPM_WriteString((CHAR*)"__CHR", (LONGINT)6);
if (OPV_SideEffects(n)) {
@ -576,7 +564,7 @@ static void OPV_design (OPT_Node n, INTEGER prec)
OPT_Struct typ = NIL;
INTEGER class, designPrec, comp;
OPT_Node d = NIL, x = NIL;
INTEGER dims, i, _for__26;
INTEGER dims, i, _for__27;
comp = n->typ->comp;
obj = n->obj;
class = n->class;
@ -652,15 +640,15 @@ static void OPV_design (OPT_Node n, INTEGER prec)
}
x = x->left;
}
_for__26 = dims;
_for__27 = dims;
i = 1;
while (i <= _for__26) {
while (i <= _for__27) {
OPM_Write(')');
i += 1;
}
if (n->typ->comp == 3) {
OPM_Write(')');
while ((LONGINT)i < __ASHR(d->typ->size - 4, 2)) {
while ((int)i < __ASHR(d->typ->size - 4, 2)) {
OPM_WriteString((CHAR*)" * ", (LONGINT)4);
OPV_Len(d, i);
i += 1;
@ -795,7 +783,7 @@ static void OPV_ActualPar (OPT_Node n, OPT_Object fp)
}
if ((((mode == 2 && n->class == 11)) && n->subcl == 29)) {
OPV_expr(n->left, prec);
} else if ((((((form == 6 && n->class == 7)) && n->conval->intval <= OPM_MaxInt)) && n->conval->intval >= OPM_MinInt)) {
} else if ((((((form == 6 && n->class == 7)) && n->conval->intval <= OPM_SignedMaximum(OPM_IntSize))) && n->conval->intval >= OPM_SignedMinimum(OPM_IntSize))) {
OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12);
OPV_expr(n, prec);
OPM_WriteString((CHAR*)"))", (LONGINT)3);
@ -914,7 +902,7 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPM_Write(')');
break;
case 20:
OPV_Convert(l, form, exprPrec);
OPV_Convert(l, n->typ, exprPrec);
break;
case 21:
if (OPV_SideEffects(l)) {
@ -943,7 +931,7 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPM_Write(')');
break;
case 24:
OPM_WriteString((CHAR*)"(LONGINT)(uintptr_t)", (LONGINT)21);
OPM_WriteString((CHAR*)"(LONGINT)(SYSTEM_ADDRESS)", (LONGINT)26);
if (l->class == 1) {
OPC_CompleteIdent(l->obj);
} else {
@ -954,20 +942,16 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
}
break;
case 29:
if ((((__IN(n->typ->form, 0x6240) && __IN(l->typ->form, 0x6240))) && n->typ->size == l->typ->size) || !__IN(l->class, 0x17)) {
if (!__IN(l->class, 0x17) || (((__IN(n->typ->form, 0x6240) && __IN(l->typ->form, 0x6240))) && n->typ->size == l->typ->size)) {
OPM_Write('(');
OPC_Ident(n->typ->strobj);
OPM_Write(')');
if (__IN(n->typ->form, 0x6000) || __IN(l->typ->form, 0x6000)) {
OPM_WriteString((CHAR*)"(uintptr_t)", (LONGINT)12);
OPM_WriteString((CHAR*)"(SYSTEM_ADDRESS)", (LONGINT)17);
}
OPV_expr(l, exprPrec);
} else {
if (__IN(n->typ->form, 0x6000) || __IN(l->typ->form, 0x6000)) {
OPM_WriteString((CHAR*)"__VALP(", (LONGINT)8);
} else {
OPM_WriteString((CHAR*)"__VAL(", (LONGINT)7);
}
OPM_WriteString((CHAR*)"__VAL(", (LONGINT)7);
OPC_Ident(n->typ->strobj);
OPM_WriteString((CHAR*)", ", (LONGINT)3);
OPV_expr(l, -1);
@ -1326,7 +1310,7 @@ static void OPV_NewArr (OPT_Node d, OPT_Node x)
OPM_WriteInt(base->size);
OPM_WriteString((CHAR*)"))", (LONGINT)3);
OPM_WriteString((CHAR*)", ", (LONGINT)3);
OPM_WriteInt(OPC_Base(base));
OPM_WriteInt(OPC_BaseAlignment(base));
OPM_WriteString((CHAR*)", ", (LONGINT)3);
OPM_WriteInt(nofdim);
OPM_WriteString((CHAR*)", ", (LONGINT)3);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPV__h
#define OPV__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
typedef
@ -118,14 +118,14 @@ 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)(uintptr_t)((void*)malloc((size_t)size))
#define Platform_allocate(size) (LONGINT)(SYSTEM_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*)(uintptr_t)address)
#define Platform_free(address) free((void*)(SYSTEM_ADDRESS)address)
#define Platform_fstat(fd) fstat(fd, &s)
#define Platform_fsync(fd) fsync(fd)
#define Platform_ftruncate(fd, l) ftruncate(fd, l)
@ -138,13 +138,13 @@ extern void Heap_InitHeap();
#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*)(uintptr_t)(p), l)
#define Platform_readfile(fd, p, l) read(fd, (void*)(SYSTEM_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, (uintptr_t)h)
#define Platform_sethandler(s, h) SystemSetHandler(s, (SYSTEM_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
@ -161,7 +161,7 @@ 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*)(uintptr_t)(p), l)
#define Platform_writefile(fd, p, l) write(fd, (void*)(SYSTEM_ADDRESS)(p), l)
BOOLEAN Platform_TooManyFiles (INTEGER e)
{
@ -229,7 +229,7 @@ void Platform_Init (INTEGER argc, LONGINT argvadr)
Platform_ArgVecPtr av = NIL;
Platform_MainStackFrame = argvadr;
Platform_ArgCount = argc;
av = (Platform_ArgVecPtr)(uintptr_t)argvadr;
av = (Platform_ArgVecPtr)(SYSTEM_ADDRESS)argvadr;
Platform_ArgVector = (*av)[0];
Platform_HaltCode = -128;
Platform_HeapInitHeap();
@ -262,7 +262,7 @@ void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len)
{
Platform_ArgVec av = NIL;
if (n < Platform_ArgCount) {
av = (Platform_ArgVec)(uintptr_t)Platform_ArgVector;
av = (Platform_ArgVec)(SYSTEM_ADDRESS)Platform_ArgVector;
__COPY(*(*av)[__X(n, ((LONGINT)(1024)))], val, val__len);
}
}
@ -529,7 +529,7 @@ INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n)
INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n)
{
INTEGER _o_result;
*n = Platform_readfile(h, (LONGINT)(uintptr_t)b, b__len);
*n = Platform_readfile(h, (LONGINT)(SYSTEM_ADDRESS)b, b__len);
if (*n < 0) {
*n = 0;
_o_result = Platform_err();
@ -765,7 +765,7 @@ static void Platform_TestLittleEndian (void)
{
INTEGER i;
i = 1;
__GET((LONGINT)(uintptr_t)&i, Platform_LittleEndian, BOOLEAN);
__GET((LONGINT)(SYSTEM_ADDRESS)&i, Platform_LittleEndian, BOOLEAN);
}
__TDESC(Platform_FileIdentity, 1, 0) = {__TDFLDS("FileIdentity", 12), {-4}};

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef Platform__h
#define Platform__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
@ -58,7 +58,7 @@ INTEGER Reals_Expo (REAL x)
{
INTEGER _o_result;
INTEGER i;
__GET((LONGINT)(uintptr_t)&x + 2, i, INTEGER);
__GET((LONGINT)(SYSTEM_ADDRESS)&x + 2, i, INTEGER);
_o_result = __MASK(__ASHR(i, 7), -256);
return _o_result;
}
@ -66,17 +66,17 @@ INTEGER Reals_Expo (REAL x)
void Reals_SetExpo (REAL *x, INTEGER ex)
{
CHAR c;
__GET((LONGINT)(uintptr_t)x + 3, c, CHAR);
__PUT((LONGINT)(uintptr_t)x + 3, (CHAR)(__ASHL(__ASHR((int)c, 7), 7) + __MASK(__ASHR(ex, 1), -128)), CHAR);
__GET((LONGINT)(uintptr_t)x + 2, c, CHAR);
__PUT((LONGINT)(uintptr_t)x + 2, (CHAR)(__MASK((int)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR);
__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);
}
INTEGER Reals_ExpoL (LONGREAL x)
{
INTEGER _o_result;
INTEGER i;
__GET((LONGINT)(uintptr_t)&x + 6, i, INTEGER);
__GET((LONGINT)(SYSTEM_ADDRESS)&x + 6, i, INTEGER);
_o_result = __MASK(__ASHR(i, 4), -2048);
return _o_result;
}
@ -89,8 +89,8 @@ void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len)
}
k = 0;
if (n > 9) {
i = __ENTIER(x / (LONGREAL)(LONGREAL)1000000000);
j = __ENTIER(x - i * (LONGREAL)1000000000);
i = (int)__ENTIER(x / (LONGREAL)(LONGREAL)1000000000);
j = (int)__ENTIER(x - i * (LONGREAL)1000000000);
if (j < 0) {
j = 0;
}
@ -100,9 +100,9 @@ void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len)
k += 1;
}
} else {
i = __ENTIER(x);
i = (int)__ENTIER(x);
}
while (k < (LONGINT)n) {
while (k < (int)n) {
d[__X(k, d__len)] = (CHAR)(__MOD(i, 10) + 48);
i = __DIV(i, 10);
k += 1;
@ -134,7 +134,7 @@ static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LO
CHAR by;
i = 0;
l = b__len;
while ((LONGINT)i < l) {
while ((int)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));

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef Reals__h
#define Reals__h

View file

@ -35,7 +35,7 @@ void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0)
void SYSTEM_ENUMP(void *adr, LONGINT n, void (*P)())
{
while (n > 0) {
P((LONGINT)(uintptr_t)(*((void**)(adr))));
P((LONGINT)(SYSTEM_ADDRESS)(*((void**)(adr))));
adr = ((void**)adr) + 1;
n--;
}
@ -106,7 +106,7 @@ SYSTEM_PTR SYSTEM_NEWARR(LONGINT *typ, LONGINT elemsz, int elemalgn, int nofdim,
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 = (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++;}
@ -119,7 +119,7 @@ SYSTEM_PTR SYSTEM_NEWARR(LONGINT *typ, LONGINT elemsz, int elemalgn, int nofdim,
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 = (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;
@ -155,7 +155,7 @@ typedef void (*SystemSignalHandler)(INTEGER); // = Platform_SignalHandler
// (Ignore other signals)
}
void SystemSetHandler(int s, uintptr_t h) {
void SystemSetHandler(int s, SYSTEM_ADDRESS h) {
if (s >= 2 && s <= 4) {
int needtosetsystemhandler = handler[s-2] == 0;
handler[s-2] = (SystemSignalHandler)h;
@ -194,12 +194,12 @@ typedef void (*SystemSignalHandler)(INTEGER); // = Platform_SignalHandler
}
}
void SystemSetInterruptHandler(uintptr_t h) {
void SystemSetInterruptHandler(SYSTEM_ADDRESS h) {
EnsureConsoleCtrlHandler();
SystemInterruptHandler = (SystemSignalHandler)h;
}
void SystemSetQuitHandler(uintptr_t h) {
void SystemSetQuitHandler(SYSTEM_ADDRESS h) {
EnsureConsoleCtrlHandler();
SystemQuitHandler = (SystemSignalHandler)h;
}

View file

@ -1,28 +1,38 @@
#ifndef SYSTEM__h
#define SYSTEM__h
#ifndef _WIN32
// Building for a Unix/Linux based system
#include <string.h> // For memcpy ...
#include <stdint.h> // For uintptr_t ...
#if defined(_WIN64)
typedef long long SYSTEM_INT64;
typedef unsigned long long SYSTEM_CARD64;
#else
// Building for Windows platform with either mingw under cygwin, or the MS C compiler
#ifdef _WIN64
typedef unsigned long long size_t;
typedef unsigned long long uintptr_t;
#else
typedef unsigned int size_t;
typedef unsigned int uintptr_t;
#endif /* _WIN64 */
typedef unsigned int uint32_t;
void * __cdecl memcpy(void * dest, const void * source, size_t size);
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.
@ -70,6 +80,7 @@ typedef unsigned char U_SHORTINT;
#endif
typedef U_LONGINT SET;
typedef U_LONGINT U_SET;
// OS Memory allocation interfaces are in PlatformXXX.Mod
@ -96,10 +107,10 @@ extern LONGINT SYSTEM_ENTIER (double x);
// Signal handling in SYSTEM.c
#ifndef _WIN32
extern void SystemSetHandler(int s, uintptr_t h);
extern void SystemSetHandler(int s, SYSTEM_ADDRESS h);
#else
extern void SystemSetInterruptHandler(uintptr_t h);
extern void SystemSetQuitHandler (uintptr_t h);
extern void SystemSetInterruptHandler(SYSTEM_ADDRESS h);
extern void SystemSetQuitHandler (SYSTEM_ADDRESS h);
#endif
@ -122,20 +133,20 @@ static int __str_cmp(CHAR *x, CHAR *y){
#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*)(uintptr_t)Platform_OSAllocate(l*sizeof(t)),x,l*sizeof(t))
#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)(uintptr_t)x)
#define __DEL(x) Platform_OSFree((LONGINT)(SYSTEM_ADDRESS)x)
/* SYSTEM ops */
#define __VAL(t, x) ((t)(x))
#define __VALP(t, x) ((t)(uintptr_t)(x))
#define __VAL(t, x) (*(t*)&(x))
#define __GET(a, x, t) x= *(t*)(uintptr_t)(a)
#define __PUT(a, x, t) *(t*)(uintptr_t)(a)=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)))
@ -150,7 +161,7 @@ static int __str_cmp(CHAR *x, CHAR *y){
#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*)(uintptr_t)(d),(char*)(uintptr_t)(s),n)
#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)))
@ -211,7 +222,7 @@ extern void Heap_INCREF();
extern void Platform_Init(INTEGER argc, LONGINT argv);
extern void Heap_FINALL();
#define __INIT(argc, argv) static void *m; Platform_Init((INTEGER)argc, (LONGINT)(uintptr_t)&argv);
#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
@ -232,7 +243,7 @@ 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)(uintptr_t)t##__typ)
#define __NEW(p, t) p = Heap_NEWREC((LONGINT)(SYSTEM_ADDRESS)t##__typ)
#define __NEWARR SYSTEM_NEWARR
@ -263,20 +274,20 @@ extern SYSTEM_PTR SYSTEM_NEWARR(LONGINT*, LONGINT, int, int, int, ...);
#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)(uintptr_t)t##__typ; \
t##__desc.module = (LONGINT)(uintptr_t)m; \
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)(uintptr_t)&t##__desc.next); \
Heap_REGTYP(m, (LONGINT)(SYSTEM_ADDRESS)&t##__desc.next); \
SYSTEM_INHERIT(t##__typ, t0##__typ)
#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(LONGINT)(uintptr_t)typ##__typ)
#define __TYPEOF(p) ((LONGINT*)(uintptr_t)(*(((LONGINT*)(p))-1)))
#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)(uintptr_t)proc
#define __SEND(typ, num, funtyp, parlist) ((funtyp)((uintptr_t)*(typ-(__TPROC0OFF+num))))parlist
#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

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
@ -21,7 +21,7 @@ INTEGER Strings_Length (CHAR *s, LONGINT s__len)
INTEGER i;
__DUP(s, s__len, CHAR);
i = 0;
while (((LONGINT)i < s__len && s[__X(i, s__len)] != 0x00)) {
while (((int)i < s__len && s[__X(i, s__len)] != 0x00)) {
i += 1;
}
_o_result = i;
@ -36,11 +36,11 @@ void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__
n1 = Strings_Length(dest, dest__len);
n2 = Strings_Length(extra, extra__len);
i = 0;
while ((i < n2 && (LONGINT)(i + n1) < dest__len)) {
while ((i < n2 && (int)(i + n1) < dest__len)) {
dest[__X(i + n1, dest__len)] = extra[__X(i, extra__len)];
i += 1;
}
if ((LONGINT)(i + n1) < dest__len) {
if ((int)(i + n1) < dest__len) {
dest[__X(i + n1, dest__len)] = 0x00;
}
__DEL(extra);
@ -59,10 +59,10 @@ void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest,
Strings_Append(dest, dest__len, (void*)source, source__len);
return;
}
if ((LONGINT)(pos + n2) < dest__len) {
if ((int)(pos + n2) < dest__len) {
i = n1;
while (i >= pos) {
if ((LONGINT)(i + n2) < dest__len) {
if ((int)(i + n2) < dest__len) {
dest[__X(i + n2, dest__len)] = dest[__X(i, dest__len)];
}
i -= 1;
@ -91,7 +91,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 ((LONGINT)(i - n) < s__len) {
if ((int)(i - n) < s__len) {
s[__X(i - n, s__len)] = 0x00;
}
} else {
@ -121,7 +121,7 @@ void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n,
return;
}
i = 0;
while (((((LONGINT)(pos + i) <= source__len && source[__X(pos + i, source__len)] != 0x00)) && i < n)) {
while (((((int)(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)];
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef Strings__h
#define Strings__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
#include "Files.h"
#include "Modules.h"
@ -787,9 +787,9 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
(*S).s[__X(i, ((LONGINT)(64)))] = 0x00;
(*S).len = i;
(*S).class = 1;
} else if (ch == '\"') {
} else if (ch == '"') {
Texts_Read((void*)&*S, S__typ, &ch);
while ((((ch != '\"' && ch >= ' ')) && i != 63)) {
while ((((ch != '"' && ch >= ' ')) && i != 63)) {
(*S).s[__X(i, ((LONGINT)(64)))] = ch;
i += 1;
Texts_Read((void*)&*S, S__typ, &ch);
@ -839,7 +839,7 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
k -= 16;
}
while (j < i) {
k = __ASHL(k, 4) + (LONGINT)((int)d[__X(j, ((LONGINT)(32)))] - 48);
k = __ASHL(k, 4) + (int)((int)d[__X(j, ((LONGINT)(32)))] - 48);
j += 1;
}
if (neg) {
@ -929,7 +929,7 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
(*S).class = 3;
k = 0;
do {
k = k * 10 + (LONGINT)((int)d[__X(j, ((LONGINT)(32)))] - 48);
k = k * 10 + (int)((int)d[__X(j, ((LONGINT)(32)))] - 48);
j += 1;
} while (!(j == i));
if (neg) {
@ -1067,7 +1067,7 @@ void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n)
x0 = __DIV(x0, 10);
i += 1;
} while (!(x0 == 0));
while (n > (LONGINT)i) {
while (n > (int)i) {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
}
@ -1319,7 +1319,7 @@ void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER
} else {
Texts_Write(&*W, W__typ, ' ');
}
e = (int)__ASHR((LONGINT)(e - 1023) * 77, 8);
e = (int)__ASHR((int)(e - 1023) * 77, 8);
if (e >= 0) {
x = x / (LONGREAL)Reals_TenL(e);
} else {

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef Texts__h
#define Texts__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkamSf */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkamSf */
#include "SYSTEM.h"
#include "Configuration.h"
#include "Heap.h"

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
typedef
@ -25,7 +25,7 @@ export void *errors__init(void)
errors_errors[6][0] = 0x00;
errors_errors[7][0] = 0x00;
errors_errors[8][0] = 0x00;
__MOVE("\'=\' expected", errors_errors[9], 13);
__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);
@ -34,28 +34,28 @@ export void *errors__init(void)
__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);
__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("')' 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);
__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);
__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);
__MOVE("';' missing", errors_errors[39], 12);
errors_errors[40][0] = 0x00;
__MOVE("END missing", errors_errors[41], 12);
errors_errors[42][0] = 0x00;
@ -131,10 +131,10 @@ export void *errors__init(void)
__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("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);
@ -194,5 +194,6 @@ export void *errors__init(void)
__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;
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef errors__h
#define errors__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
#include "Configuration.h"
#include "Console.h"

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef extTools__h
#define extTools__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
#include "Console.h"
#include "Strings.h"
@ -252,7 +252,7 @@ export void *vt100__init(void)
__REGCMD("RCP", vt100_RCP);
__REGCMD("SCP", vt100_SCP);
/* BEGIN */
__COPY("", vt100_CSI, ((LONGINT)(5)));
__COPY("\033", vt100_CSI, ((LONGINT)(5)));
Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5)));
__ENDMOD;
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef vt100__h
#define vt100__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
@ -13,6 +13,6 @@ export void *Configuration__init(void)
__DEFMOD;
__REGMOD("Configuration", 0);
/* BEGIN */
__MOVE("1.95 [2016/08/24] for gcc LP64 on cygwin", Configuration_versionLong, 41);
__MOVE("1.95 [2016/08/23] for gcc LP64 on cygwin", Configuration_versionLong, 41);
__ENDMOD;
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef Configuration__h
#define Configuration__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
#include "Platform.h"
@ -21,7 +21,7 @@ export void Console_String (CHAR *s, LONGINT s__len);
void Console_Flush (void)
{
INTEGER error;
error = Platform_Write(((LONGINT)(1)), (LONGINT)(uintptr_t)Console_line, Console_pos);
error = Platform_Write(((LONGINT)(1)), (LONGINT)(SYSTEM_ADDRESS)Console_line, Console_pos);
Console_pos = 0;
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef Console__h
#define Console__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin tspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
#include "SYSTEM.h"
#include "Configuration.h"
#include "Console.h"
@ -257,7 +257,7 @@ static void Files_Flush (Files_Buffer buf)
if (buf->org != f->pos) {
error = Platform_Seek(f->fd, buf->org, Platform_SeekSet);
}
error = Platform_Write(f->fd, (LONGINT)(uintptr_t)buf->data, buf->size);
error = Platform_Write(f->fd, (LONGINT)(SYSTEM_ADDRESS)buf->data, buf->size);
if (error != 0) {
Files_Err((CHAR*)"error writing file", (LONGINT)19, f, error);
}
@ -656,7 +656,7 @@ void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x
} else {
min = n;
}
__MOVE((LONGINT)(uintptr_t)buf->data + offset, (LONGINT)(uintptr_t)x + xpos, min);
__MOVE((LONGINT)(SYSTEM_ADDRESS)buf->data + offset, (LONGINT)(SYSTEM_ADDRESS)x + xpos, min);
offset += min;
(*r).offset = offset;
xpos += min;
@ -721,7 +721,7 @@ void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT
} else {
min = n;
}
__MOVE((LONGINT)(uintptr_t)x + xpos, (LONGINT)(uintptr_t)buf->data + offset, min);
__MOVE((LONGINT)(SYSTEM_ADDRESS)x + xpos, (LONGINT)(SYSTEM_ADDRESS)buf->data + offset, min);
offset += min;
(*r).offset = offset;
if (offset > buf->size) {
@ -772,15 +772,15 @@ void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT
*res = 3;
return;
}
error = Platform_Read(fdold, (LONGINT)(uintptr_t)buf, ((LONGINT)(4096)), &n);
error = Platform_Read(fdold, (LONGINT)(SYSTEM_ADDRESS)buf, ((LONGINT)(4096)), &n);
while (n > 0) {
error = Platform_Write(fdnew, (LONGINT)(uintptr_t)buf, n);
error = Platform_Write(fdnew, (LONGINT)(SYSTEM_ADDRESS)buf, n);
if (error != 0) {
ignore = Platform_Close(fdold);
ignore = Platform_Close(fdnew);
Files_Err((CHAR*)"cannot move file", (LONGINT)17, NIL, error);
}
error = Platform_Read(fdold, (LONGINT)(uintptr_t)buf, ((LONGINT)(4096)), &n);
error = Platform_Read(fdold, (LONGINT)(SYSTEM_ADDRESS)buf, ((LONGINT)(4096)), &n);
}
ignore = Platform_Close(fdold);
ignore = Platform_Close(fdnew);
@ -838,7 +838,7 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *de
j += 1;
}
} else {
__MOVE((LONGINT)(uintptr_t)src, (LONGINT)(uintptr_t)dest, src__len);
__MOVE((LONGINT)(SYSTEM_ADDRESS)src, (LONGINT)(SYSTEM_ADDRESS)dest, src__len);
}
}
@ -858,14 +858,16 @@ void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x)
{
CHAR b[4];
Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
*x = ((LONGINT)((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((LONGINT)b[2], 16)) + __ASHL((LONGINT)b[3], 24);
*x = ((int)((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((int)b[2], 16)) + __ASHL((int)b[3], 24);
}
void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x)
{
CHAR b[4];
LONGINT l;
Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
*x = (SET)(((LONGINT)((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((LONGINT)b[2], 16)) + __ASHL((LONGINT)b[3], 24));
l = ((int)((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((int)b[2], 16)) + __ASHL((int)b[3], 24);
*x = (SET)l;
}
void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x)
@ -921,11 +923,11 @@ void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x)
n = 0;
Files_Read(&*R, R__typ, (void*)&ch);
while ((int)ch >= 128) {
n += __ASH((LONGINT)((int)ch - 128), s);
n += __ASH((int)((int)ch - 128), s);
s += 7;
Files_Read(&*R, R__typ, (void*)&ch);
}
n += __ASH((LONGINT)(__MASK((int)ch, -64) - __ASHL(__ASHR((int)ch, 6), 6)), s);
n += __ASH((int)(__MASK((int)ch, -64) - __ASHL(__ASHR((int)ch, 6), 6)), s);
*x = n;
}
@ -1006,7 +1008,7 @@ static void Files_Finalize (SYSTEM_PTR o)
{
Files_File f = NIL;
LONGINT res;
f = (Files_File)(uintptr_t)o;
f = (Files_File)(SYSTEM_ADDRESS)o;
if (f->fd >= 0) {
Files_CloseOSFile(f);
if (f->tempFile) {

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin tspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
#ifndef Files__h
#define Files__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin tskSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tskSfF */
#include "SYSTEM.h"
struct Heap__1 {
@ -101,7 +101,7 @@ export void Heap_Unlock (void);
extern void *Heap__init();
extern LONGINT Platform_MainStackFrame;
extern LONGINT Platform_OSAllocate(LONGINT size);
#define Heap_FetchAddress(pointer) (LONGINT)(uintptr_t)(*((void**)((uintptr_t)pointer)))
#define Heap_FetchAddress(pointer) (LONGINT)(SYSTEM_ADDRESS)(*((void**)((SYSTEM_ADDRESS)pointer)))
#define Heap_HeapModuleInit() Heap__init()
#define Heap_OSAllocate(size) Platform_OSAllocate(size)
#define Heap_PlatformHalt(code) Platform_Halt(code)
@ -134,7 +134,7 @@ SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs)
__COPY(name, m->name, ((LONGINT)(20)));
m->refcnt = 0;
m->enumPtrs = enumPtrs;
m->next = (Heap_Module)(uintptr_t)Heap_modules;
m->next = (Heap_Module)(SYSTEM_ADDRESS)Heap_modules;
Heap_modules = (SYSTEM_PTR)m;
_o_result = (void*)m;
return _o_result;
@ -315,7 +315,7 @@ SYSTEM_PTR Heap_NEWREC (LONGINT tag)
__PUT(adr + 8, 0, LONGINT);
Heap_allocated += blksz;
Heap_Unlock();
_o_result = (SYSTEM_PTR)(uintptr_t)(adr + 4);
_o_result = (SYSTEM_PTR)(SYSTEM_ADDRESS)(adr + 4);
return _o_result;
}
@ -326,12 +326,12 @@ SYSTEM_PTR Heap_NEWBLK (LONGINT size)
SYSTEM_PTR new;
Heap_Lock();
blksz = __ASHL(__ASHR(size + 31, 4), 4);
new = Heap_NEWREC((LONGINT)(uintptr_t)&blksz);
tag = ((LONGINT)(uintptr_t)new + blksz) - 12;
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)(uintptr_t)new - 4, tag, LONGINT);
__PUT((LONGINT)(SYSTEM_ADDRESS)new - 4, tag, LONGINT);
Heap_Unlock();
_o_result = new;
return _o_result;
@ -360,7 +360,7 @@ static void Heap_Mark (LONGINT q)
__GET(tag, offset, LONGINT);
fld = q + offset;
p = Heap_FetchAddress(fld);
__PUT(fld, (SYSTEM_PTR)(uintptr_t)n, SYSTEM_PTR);
__PUT(fld, (SYSTEM_PTR)(SYSTEM_ADDRESS)n, SYSTEM_PTR);
} else {
fld = q + offset;
n = Heap_FetchAddress(fld);
@ -369,7 +369,7 @@ static void Heap_Mark (LONGINT q)
if (!__ODD(tagbits)) {
__PUT(n - 4, tagbits + 1, LONGINT);
__PUT(q - 4, tag + 1, LONGINT);
__PUT(fld, (SYSTEM_PTR)(uintptr_t)p, SYSTEM_PTR);
__PUT(fld, (SYSTEM_PTR)(SYSTEM_ADDRESS)p, SYSTEM_PTR);
p = q;
q = n;
tag = tagbits;
@ -384,7 +384,7 @@ static void Heap_Mark (LONGINT q)
static void Heap_MarkP (SYSTEM_PTR p)
{
Heap_Mark((LONGINT)(uintptr_t)p);
Heap_Mark((LONGINT)(SYSTEM_ADDRESS)p);
}
static void Heap_Scan (void)
@ -553,7 +553,7 @@ static void Heap_Finalize (void)
} else {
prev->next = n->next;
}
(*n->finalize)((SYSTEM_PTR)(uintptr_t)n->obj);
(*n->finalize)((SYSTEM_PTR)(SYSTEM_ADDRESS)n->obj);
if (prev == NIL) {
n = Heap_fin;
} else {
@ -572,7 +572,7 @@ void Heap_FINALL (void)
while (Heap_fin != NIL) {
n = Heap_fin;
Heap_fin = Heap_fin->next;
(*n->finalize)((SYSTEM_PTR)(uintptr_t)n->obj);
(*n->finalize)((SYSTEM_PTR)(SYSTEM_ADDRESS)n->obj);
}
}
@ -589,9 +589,9 @@ static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len)
}
if (n == 0) {
nofcand = 0;
sp = (LONGINT)(uintptr_t)&frame;
sp = (LONGINT)(SYSTEM_ADDRESS)&frame;
stack0 = Heap_PlatformMainStackFrame();
inc = (LONGINT)(uintptr_t)&align.p - (LONGINT)(uintptr_t)&align;
inc = (LONGINT)(SYSTEM_ADDRESS)&align.p - (LONGINT)(SYSTEM_ADDRESS)&align;
if (sp > stack0) {
inc = -inc;
}
@ -622,7 +622,7 @@ void Heap_GC (BOOLEAN markStack)
LONGINT cand[10000];
if (Heap_lockdepth == 0 || (Heap_lockdepth == 1 && !markStack)) {
Heap_Lock();
m = (Heap_Module)(uintptr_t)Heap_modules;
m = (Heap_Module)(SYSTEM_ADDRESS)Heap_modules;
while (m != NIL) {
if (m->enumPtrs != NIL) {
(*m->enumPtrs)(Heap_MarkP);
@ -699,7 +699,7 @@ void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
{
Heap_FinNode f;
__NEW(f, Heap_FinDesc);
f->obj = (LONGINT)(uintptr_t)obj;
f->obj = (LONGINT)(SYSTEM_ADDRESS)obj;
f->finalize = finalize;
f->marked = 1;
f->next = Heap_fin;

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin tskSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tskSfF */
#ifndef Heap__h
#define Heap__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
#include "Console.h"
#include "Heap.h"

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef Modules__h
#define Modules__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
#include "OPM.h"
#include "OPS.h"
@ -34,7 +34,9 @@ export void OPB_In (OPT_Node *x, OPT_Node y);
export void OPB_Index (OPT_Node *x, OPT_Node y);
export void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ);
static BOOLEAN OPB_IntToBool (LONGINT i);
static OPT_Struct OPB_IntType (LONGINT size);
export void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y);
static LONGINT OPB_LongerSize (LONGINT i);
export void OPB_MOp (SHORTINT op, OPT_Node *x);
export OPT_Node OPB_NewBoolConst (BOOLEAN boolval);
export OPT_Node OPB_NewIntConst (LONGINT intval);
@ -51,6 +53,8 @@ export void OPB_Return (OPT_Node *x, OPT_Object proc);
export void OPB_SetElem (OPT_Node *x);
static void OPB_SetIntType (OPT_Node node);
export void OPB_SetRange (OPT_Node *x, OPT_Node y);
static LONGINT OPB_ShorterSize (LONGINT i);
static INTEGER OPB_SignedByteSize (LONGINT n);
export void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno);
export void OPB_StPar0 (OPT_Node *par0, INTEGER fctno);
export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno);
@ -90,8 +94,8 @@ OPT_Node OPB_NewLeaf (OPT_Object obj)
node = OPT_NewNode(9);
break;
default:
OPB_err(127);
node = OPT_NewNode(0);
OPB_err(127);
break;
}
node->obj = obj;
@ -220,21 +224,68 @@ OPT_Node OPB_EmptySet (void)
return _o_result;
}
static INTEGER OPB_SignedByteSize (LONGINT n)
{
INTEGER _o_result;
INTEGER b;
if (n < 0) {
n = -(n + 1);
}
b = 1;
while ((b < 8 && __ASH(n, -(__ASHL(b, 3) - 1)) != 0)) {
b += 1;
}
_o_result = b;
return _o_result;
}
static LONGINT OPB_ShorterSize (LONGINT i)
{
LONGINT _o_result;
if (i >= (int)OPM_LIntSize) {
_o_result = OPM_IntSize;
return _o_result;
} else {
_o_result = OPM_SIntSize;
return _o_result;
}
__RETCHK;
}
static LONGINT OPB_LongerSize (LONGINT i)
{
LONGINT _o_result;
if (i <= (int)OPM_SIntSize) {
_o_result = OPM_IntSize;
return _o_result;
} else {
_o_result = OPM_LIntSize;
return _o_result;
}
__RETCHK;
}
static OPT_Struct OPB_IntType (LONGINT size)
{
OPT_Struct _o_result;
OPT_Struct result = NIL;
if (size <= OPT_sinttyp->size) {
result = OPT_sinttyp;
} else if (size <= OPT_inttyp->size) {
result = OPT_inttyp;
} else {
result = OPT_linttyp;
}
if (size > OPT_linttyp->size) {
OPB_err(203);
}
_o_result = result;
return _o_result;
}
static void OPB_SetIntType (OPT_Node node)
{
LONGINT v;
v = node->conval->intval;
if ((OPM_MinSInt <= (LONGINT)v && (LONGINT)v <= OPM_MaxSInt)) {
node->typ = OPT_sinttyp;
} else if ((OPM_MinInt <= (LONGINT)v && (LONGINT)v <= OPM_MaxInt)) {
node->typ = OPT_inttyp;
} else if ((OPM_MinLInt <= v && v <= OPM_MaxLInt)) {
node->typ = OPT_linttyp;
} else {
OPB_err(203);
node->typ = OPT_sinttyp;
node->conval->intval = 1;
}
node->typ = OPB_IntType(OPB_SignedByteSize(node->conval->intval));
}
OPT_Node OPB_NewIntConst (LONGINT intval)
@ -378,16 +429,16 @@ void OPB_Field (OPT_Node *x, OPT_Object y)
}
}
static struct TypTest__57 {
static struct TypTest__61 {
OPT_Node *x;
OPT_Object *obj;
BOOLEAN *guard;
struct TypTest__57 *lnk;
} *TypTest__57_s;
struct TypTest__61 *lnk;
} *TypTest__61_s;
static void GTT__58 (OPT_Struct t0, OPT_Struct t1);
static void GTT__62 (OPT_Struct t0, OPT_Struct t1);
static void GTT__58 (OPT_Struct t0, OPT_Struct t1)
static void GTT__62 (OPT_Struct t0, OPT_Struct t1)
{
OPT_Node node = NIL;
OPT_Struct t = NIL;
@ -400,54 +451,54 @@ static void GTT__58 (OPT_Struct t0, OPT_Struct t1)
t1 = t1->BaseTyp;
}
if (t1 == t0 || t0->form == 0) {
if (*TypTest__57_s->guard) {
OPB_BindNodes(5, NIL, &*TypTest__57_s->x, NIL);
(*TypTest__57_s->x)->readonly = (*TypTest__57_s->x)->left->readonly;
if (*TypTest__61_s->guard) {
OPB_BindNodes(5, NIL, &*TypTest__61_s->x, NIL);
(*TypTest__61_s->x)->readonly = (*TypTest__61_s->x)->left->readonly;
} else {
node = OPT_NewNode(11);
node->subcl = 16;
node->left = *TypTest__57_s->x;
node->obj = *TypTest__57_s->obj;
*TypTest__57_s->x = node;
node->left = *TypTest__61_s->x;
node->obj = *TypTest__61_s->obj;
*TypTest__61_s->x = node;
}
} else {
OPB_err(85);
}
} else if (t0 != t1) {
OPB_err(85);
} else if (!*TypTest__57_s->guard) {
if ((*TypTest__57_s->x)->class == 5) {
} else if (!*TypTest__61_s->guard) {
if ((*TypTest__61_s->x)->class == 5) {
node = OPT_NewNode(11);
node->subcl = 16;
node->left = *TypTest__57_s->x;
node->obj = *TypTest__57_s->obj;
*TypTest__57_s->x = node;
node->left = *TypTest__61_s->x;
node->obj = *TypTest__61_s->obj;
*TypTest__61_s->x = node;
} else {
*TypTest__57_s->x = OPB_NewBoolConst(1);
*TypTest__61_s->x = OPB_NewBoolConst(1);
}
}
}
void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
{
struct TypTest__57 _s;
struct TypTest__61 _s;
_s.x = x;
_s.obj = &obj;
_s.guard = &guard;
_s.lnk = TypTest__57_s;
TypTest__57_s = &_s;
_s.lnk = TypTest__61_s;
TypTest__61_s = &_s;
if (OPB_NotVar(*x)) {
OPB_err(112);
} else if ((*x)->typ->form == 13) {
if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) {
OPB_err(85);
} else if (obj->typ->form == 13) {
GTT__58((*x)->typ->BaseTyp, obj->typ->BaseTyp);
GTT__62((*x)->typ->BaseTyp, obj->typ->BaseTyp);
} else {
OPB_err(86);
}
} else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) {
GTT__58((*x)->typ, obj->typ);
GTT__62((*x)->typ, obj->typ);
} else {
OPB_err(87);
}
@ -456,7 +507,7 @@ void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
} else {
(*x)->typ = OPT_booltyp;
}
TypTest__57_s = _s.lnk;
TypTest__61_s = _s.lnk;
}
void OPB_In (OPT_Node *x, OPT_Node y)
@ -469,7 +520,7 @@ void OPB_In (OPT_Node *x, OPT_Node y)
} else if ((__IN(f, 0x70) && y->typ->form == 9)) {
if ((*x)->class == 7) {
k = (*x)->conval->intval;
if (k < 0 || k > (LONGINT)OPM_MaxSet) {
if (k < 0 || k > (int)OPM_MaxSet) {
OPB_err(202);
} else if (y->class == 7) {
(*x)->conval->intval = OPB_BoolToInt(__IN(k, y->conval->setval));
@ -522,13 +573,13 @@ static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x)
x->intval = -1;
}
static struct MOp__28 {
struct MOp__28 *lnk;
} *MOp__28_s;
static struct MOp__30 {
struct MOp__30 *lnk;
} *MOp__30_s;
static OPT_Node NewOp__29 (SHORTINT op, OPT_Struct typ, OPT_Node z);
static OPT_Node NewOp__31 (SHORTINT op, OPT_Struct typ, OPT_Node z);
static OPT_Node NewOp__29 (SHORTINT op, OPT_Struct typ, OPT_Node z)
static OPT_Node NewOp__31 (SHORTINT op, OPT_Struct typ, OPT_Node z)
{
OPT_Node _o_result;
OPT_Node node = NIL;
@ -545,9 +596,9 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
INTEGER f;
OPT_Struct typ = NIL;
OPT_Node z = NIL;
struct MOp__28 _s;
_s.lnk = MOp__28_s;
MOp__28_s = &_s;
struct MOp__30 _s;
_s.lnk = MOp__30_s;
MOp__30_s = &_s;
z = *x;
if (z->class == 8 || z->class == 9) {
OPB_err(126);
@ -561,7 +612,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval));
z->obj = NIL;
} else {
z = NewOp__29(op, typ, z);
z = NewOp__31(op, typ, z);
}
} else {
OPB_err(98);
@ -589,7 +640,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
}
z->obj = NIL;
} else {
z = NewOp__29(op, typ, z);
z = NewOp__31(op, typ, z);
}
} else {
OPB_err(97);
@ -610,7 +661,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
}
z->obj = NIL;
} else {
z = NewOp__29(op, typ, z);
z = NewOp__31(op, typ, z);
}
} else {
OPB_err(111);
@ -622,7 +673,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->conval->intval = (int)__CAP((CHAR)z->conval->intval);
z->obj = NIL;
} else {
z = NewOp__29(op, typ, z);
z = NewOp__31(op, typ, z);
}
} else {
OPB_err(111);
@ -635,7 +686,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval));
z->obj = NIL;
} else {
z = NewOp__29(op, typ, z);
z = NewOp__31(op, typ, z);
}
} else {
OPB_err(111);
@ -648,7 +699,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
f = 10;
}
if (z->class < 7 || f == 10) {
z = NewOp__29(op, typ, z);
z = NewOp__31(op, typ, z);
} else {
OPB_err(127);
}
@ -657,7 +708,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
case 25:
if ((__IN(f, 0x70) && z->class == 7)) {
if ((0 <= z->conval->intval && z->conval->intval <= -1)) {
z = NewOp__29(op, typ, z);
z = NewOp__31(op, typ, z);
} else {
OPB_err(219);
}
@ -674,7 +725,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
}
}
*x = z;
MOp__28_s = _s.lnk;
MOp__30_s = _s.lnk;
}
static void OPB_CheckPtr (OPT_Node x, OPT_Node y)
@ -865,41 +916,13 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
case 4:
case 4: case 5: case 6:
if (__IN(g, 0x70)) {
x->typ = y->typ;
} else if (g == 7) {
x->typ = OPT_realtyp;
xval->realval = xval->intval;
} else if (g == 8) {
x->typ = OPT_lrltyp;
xval->realval = xval->intval;
} else {
OPB_err(100);
y->typ = x->typ;
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
case 5:
if (g == 4) {
y->typ = OPT_inttyp;
} else if (__IN(g, 0x70)) {
x->typ = y->typ;
} else if (g == 7) {
x->typ = OPT_realtyp;
xval->realval = xval->intval;
} else if (g == 8) {
x->typ = OPT_lrltyp;
xval->realval = xval->intval;
} else {
OPB_err(100);
y->typ = x->typ;
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
case 6:
if (__IN(g, 0x70)) {
y->typ = OPT_linttyp;
if (x->typ->size <= y->typ->size) {
x->typ = y->typ;
} else {
x->typ = OPB_IntType(x->typ->size);
}
} else if (g == 7) {
x->typ = OPT_realtyp;
xval->realval = xval->intval;
@ -1178,7 +1201,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
OPB_err(203);
r = (LONGREAL)1;
}
(*x)->conval->intval = __ENTIER(r);
(*x)->conval->intval = (int)__ENTIER(r);
OPB_SetIntType(*x);
}
}
@ -1196,15 +1219,15 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
(*x)->typ = typ;
}
static struct Op__38 {
static struct Op__40 {
INTEGER *f, *g;
struct Op__38 *lnk;
} *Op__38_s;
struct Op__40 *lnk;
} *Op__40_s;
static void NewOp__39 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y);
static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y);
static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y);
static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y);
static void NewOp__39 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
{
OPT_Node node = NIL;
node = OPT_NewNode(12);
@ -1215,29 +1238,29 @@ static void NewOp__39 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
*x = node;
}
static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y)
static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y)
{
BOOLEAN _o_result;
BOOLEAN ok, xCharArr, yCharArr;
xCharArr = (__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp->form == 3) || *Op__38_s->f == 10;
yCharArr = (__IN((*y)->typ->comp, 0x0c) && (*y)->typ->BaseTyp->form == 3) || *Op__38_s->g == 10;
if ((((xCharArr && *Op__38_s->g == 3)) && (*y)->class == 7)) {
xCharArr = (__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp->form == 3) || *Op__40_s->f == 10;
yCharArr = (__IN((*y)->typ->comp, 0x0c) && (*y)->typ->BaseTyp->form == 3) || *Op__40_s->g == 10;
if ((((xCharArr && *Op__40_s->g == 3)) && (*y)->class == 7)) {
OPB_CharToString(*y);
*Op__38_s->g = 10;
*Op__40_s->g = 10;
yCharArr = 1;
}
if ((((yCharArr && *Op__38_s->f == 3)) && (*x)->class == 7)) {
if ((((yCharArr && *Op__40_s->f == 3)) && (*x)->class == 7)) {
OPB_CharToString(*x);
*Op__38_s->f = 10;
*Op__40_s->f = 10;
xCharArr = 1;
}
ok = (xCharArr && yCharArr);
if (ok) {
if ((*Op__38_s->f == 10 && (*x)->conval->intval2 == 1)) {
if ((*Op__40_s->f == 10 && (*x)->conval->intval2 == 1)) {
(*x)->typ = OPT_chartyp;
(*x)->conval->intval = 0;
OPB_Index(&*y, OPB_NewIntConst(((LONGINT)(0))));
} else if ((*Op__38_s->g == 10 && (*y)->conval->intval2 == 1)) {
} else if ((*Op__40_s->g == 10 && (*y)->conval->intval2 == 1)) {
(*y)->typ = OPT_chartyp;
(*y)->conval->intval = 0;
OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0))));
@ -1254,11 +1277,11 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPT_Struct typ = NIL;
BOOLEAN do_;
LONGINT val;
struct Op__38 _s;
struct Op__40 _s;
_s.f = &f;
_s.g = &g;
_s.lnk = Op__38_s;
Op__38_s = &_s;
_s.lnk = Op__40_s;
Op__40_s = &_s;
z = *x;
if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) {
OPB_err(126);
@ -1276,15 +1299,8 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(100);
}
break;
case 4:
if (__IN(g, 0x01f0)) {
OPB_Convert(&z, y->typ);
} else {
OPB_err(100);
}
break;
case 5:
if (g == 4) {
case 4: case 5: case 6:
if ((__IN(g, 0x70) && y->typ->size < z->typ->size)) {
OPB_Convert(&y, z->typ);
} else if (__IN(g, 0x01f0)) {
OPB_Convert(&z, y->typ);
@ -1292,15 +1308,6 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(100);
}
break;
case 6:
if (__IN(g, 0x70)) {
OPB_Convert(&y, z->typ);
} else if (__IN(g, 0x0180)) {
OPB_Convert(&z, y->typ);
} else {
OPB_err(100);
}
break;
case 7:
if (__IN(g, 0x70)) {
OPB_Convert(&y, z->typ);
@ -1386,7 +1393,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp;
}
if (do_) {
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
}
break;
case 2:
@ -1405,7 +1412,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(102);
typ = OPT_undftyp;
}
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
break;
case 3:
do_ = 1;
@ -1428,7 +1435,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp;
}
if (do_) {
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
}
break;
case 4:
@ -1446,7 +1453,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(104);
typ = OPT_undftyp;
}
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
break;
case 5:
if (f == 2) {
@ -1456,7 +1463,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
} else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) {
} else {
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
}
} else if (f != 0) {
OPB_err(94);
@ -1479,7 +1486,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
}
if (do_) {
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
}
break;
case 7:
@ -1488,7 +1495,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp;
}
if ((!__IN(f, 0x70) || y->class != 7) || y->conval->intval != 0) {
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
}
break;
case 8:
@ -1499,7 +1506,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
} else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) {
} else {
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
}
} else if (f != 0) {
OPB_err(95);
@ -1507,16 +1514,16 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
break;
case 9: case 10:
if (__IN(f, 0x6bff) || strings__41(&z, &y)) {
if (__IN(f, 0x6bff) || strings__43(&z, &y)) {
typ = OPT_booltyp;
} else {
OPB_err(107);
typ = OPT_undftyp;
}
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
break;
case 11: case 12: case 13: case 14:
if (__IN(f, 0x01f9) || strings__41(&z, &y)) {
if (__IN(f, 0x01f9) || strings__43(&z, &y)) {
typ = OPT_booltyp;
} else {
OPM_LogWLn();
@ -1525,7 +1532,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(108);
typ = OPT_undftyp;
}
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
break;
default:
OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", (LONGINT)32);
@ -1535,7 +1542,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
}
*x = z;
Op__38_s = _s.lnk;
Op__40_s = _s.lnk;
}
void OPB_SetRange (OPT_Node *x, OPT_Node y)
@ -1546,13 +1553,13 @@ void OPB_SetRange (OPT_Node *x, OPT_Node y)
} else if ((__IN((*x)->typ->form, 0x70) && __IN(y->typ->form, 0x70))) {
if ((*x)->class == 7) {
k = (*x)->conval->intval;
if (0 > k || k > (LONGINT)OPM_MaxSet) {
if (0 > k || k > (int)OPM_MaxSet) {
OPB_err(202);
}
}
if (y->class == 7) {
l = y->conval->intval;
if (0 > l || l > (LONGINT)OPM_MaxSet) {
if (0 > l || l > (int)OPM_MaxSet) {
OPB_err(202);
}
}
@ -1582,7 +1589,7 @@ void OPB_SetElem (OPT_Node *x)
OPB_err(93);
} else if ((*x)->class == 7) {
k = (*x)->conval->intval;
if ((0 <= k && k <= (LONGINT)OPM_MaxSet)) {
if ((0 <= k && k <= (int)OPM_MaxSet)) {
(*x)->conval->setval = __SETOF(k);
} else {
OPB_err(202);
@ -1596,8 +1603,9 @@ void OPB_SetElem (OPT_Node *x)
static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
{
OPT_Struct y = NIL;
INTEGER f, g;
OPT_Struct y = NIL, p = NIL, q = NIL;
OPT_Struct p = NIL, q = NIL;
if (OPM_Verbose) {
OPM_LogWLn();
OPM_LogWStr((CHAR*)"PROCEDURE CheckAssign", (LONGINT)22);
@ -1627,31 +1635,20 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
case 0: case 10:
break;
case 1:
if (!__IN(g, 0x1a)) {
if (!((__IN(g, 0x7a) && y->size == 1))) {
OPB_err(113);
}
break;
case 2: case 3: case 4: case 9:
case 2: case 3: case 9:
if (g != f) {
OPB_err(113);
}
break;
case 5:
if (!__IN(g, 0x30)) {
case 4: case 5: case 6:
if (!__IN(g, 0x70) || x->size < y->size) {
OPB_err(113);
}
break;
case 6:
if (OPM_LIntSize == 4) {
if (!__IN(g, 0x70)) {
OPB_err(113);
}
} else {
if (!__IN(g, 0x70)) {
OPB_err(113);
}
}
break;
case 7:
if (!__IN(g, 0xf0)) {
OPB_err(113);
@ -1832,14 +1829,8 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
x = OPB_NewIntConst(((LONGINT)(0)));
x->typ = OPT_chartyp;
break;
case 4:
x = OPB_NewIntConst(OPM_MinSInt);
break;
case 5:
x = OPB_NewIntConst(OPM_MinInt);
break;
case 6:
x = OPB_NewIntConst(OPM_MinLInt);
case 4: case 5: case 6:
x = OPB_NewIntConst(OPM_SignedMinimum(x->typ->size));
break;
case 9:
x = OPB_NewIntConst(((LONGINT)(0)));
@ -1869,14 +1860,8 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
x = OPB_NewIntConst(((LONGINT)(255)));
x->typ = OPT_chartyp;
break;
case 4:
x = OPB_NewIntConst(OPM_MaxSInt);
break;
case 5:
x = OPB_NewIntConst(OPM_MaxInt);
break;
case 6:
x = OPB_NewIntConst(OPM_MaxLInt);
case 4: case 5: case 6:
x = OPB_NewIntConst(OPM_SignedMaximum(x->typ->size));
break;
case 9:
x = OPB_NewIntConst(OPM_MaxSet);
@ -1909,10 +1894,8 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 10:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if (f == 5) {
OPB_Convert(&x, OPT_sinttyp);
} else if (f == 6) {
OPB_Convert(&x, OPT_inttyp);
} else if ((__IN(f, 0x70) && x->typ->size > (int)OPM_SIntSize)) {
OPB_Convert(&x, OPB_IntType(OPB_ShorterSize(x->typ->size)));
} else if (f == 8) {
OPB_Convert(&x, OPT_realtyp);
} else {
@ -1922,10 +1905,8 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 11:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if (f == 4) {
OPB_Convert(&x, OPT_inttyp);
} else if (f == 5) {
OPB_Convert(&x, OPT_linttyp);
} else if ((__IN(f, 0x70) && x->typ->size < (int)OPM_LIntSize)) {
OPB_Convert(&x, OPB_IntType(OPB_LongerSize(x->typ->size)));
} else if (f == 7) {
OPB_Convert(&x, OPT_lrltyp);
} else if (f == 3) {
@ -1973,7 +1954,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if (__IN(f, 0x70)) {
if (f != 6) {
if (x->typ->size != (int)OPM_LIntSize) {
OPB_Convert(&x, OPT_linttyp);
}
} else {
@ -2011,9 +1992,9 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 24: case 25: case 28: case 31:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if ((x->class == 7 && __IN(f, 0x30))) {
} else if ((((x->class == 7 && __IN(f, 0x70))) && x->typ->size < OPT_linttyp->size)) {
OPB_Convert(&x, OPT_linttyp);
} else if (!__IN(f, 0x2040)) {
} else if (!((__IN(x->typ->form, 0x2070) && x->typ->size == (int)OPM_PointerSize))) {
OPB_err(111);
x->typ = OPT_linttyp;
}
@ -2062,13 +2043,13 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
*par0 = x;
}
static struct StPar1__52 {
struct StPar1__52 *lnk;
} *StPar1__52_s;
static struct StPar1__56 {
struct StPar1__56 *lnk;
} *StPar1__56_s;
static OPT_Node NewOp__53 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right);
static OPT_Node NewOp__57 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right);
static OPT_Node NewOp__53 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right)
static OPT_Node NewOp__57 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right)
{
OPT_Node _o_result;
OPT_Node node = NIL;
@ -2085,9 +2066,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
INTEGER f, L;
OPT_Struct typ = NIL;
OPT_Node p = NIL, t = NIL;
struct StPar1__52 _s;
_s.lnk = StPar1__52_s;
StPar1__52_s = &_s;
struct StPar1__56 _s;
_s.lnk = StPar1__56_s;
StPar1__56_s = &_s;
p = *par0;
f = x->typ->form;
switch (fctno) {
@ -2103,7 +2084,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
OPB_err(111);
}
}
p = NewOp__53(19, fctno, p, x);
p = NewOp__57(19, fctno, p, x);
p->typ = OPT_notyp;
}
break;
@ -2111,10 +2092,10 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if (__IN(f, 0x70)) {
if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval > (LONGINT)OPM_MaxSet))) {
if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval > (int)OPM_MaxSet))) {
OPB_err(202);
}
p = NewOp__53(19, fctno, p, x);
p = NewOp__57(19, fctno, p, x);
} else {
OPB_err(111);
}
@ -2123,7 +2104,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 17:
if (!__IN(f, 0x70) || x->class != 7) {
OPB_err(69);
} else if (f == 4) {
} else if (x->typ->size == 1) {
L = (int)x->conval->intval;
typ = p->typ;
while ((L > 0 && __IN(typ->comp, 0x0c))) {
@ -2139,7 +2120,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
p = p->left;
x->conval->intval += 1;
}
p = NewOp__53(12, 19, p, x);
p = NewOp__57(12, 19, p, x);
p->typ = OPT_linttyp;
} else {
p = x;
@ -2161,7 +2142,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
t = x;
x = p;
p = t;
p = NewOp__53(19, 18, p, x);
p = NewOp__57(19, 18, p, x);
} else {
OPB_err(111);
}
@ -2187,7 +2168,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
}
p->obj = NIL;
} else {
p = NewOp__53(12, 17, p, x);
p = NewOp__57(12, 17, p, x);
p->typ = OPT_linttyp;
}
} else {
@ -2218,9 +2199,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
OPB_err(111);
} else {
if (fctno == 22) {
p = NewOp__53(12, 27, p, x);
p = NewOp__57(12, 27, p, x);
} else {
p = NewOp__53(12, 28, p, x);
p = NewOp__57(12, 28, p, x);
}
p->typ = p->left->typ;
}
@ -2237,7 +2218,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
x = p;
p = t;
}
p = NewOp__53(19, fctno, p, x);
p = NewOp__57(19, fctno, p, x);
} else {
OPB_err(111);
}
@ -2247,7 +2228,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if (__IN(f, 0x70)) {
p = NewOp__53(12, 26, p, x);
p = NewOp__57(12, 26, p, x);
} else {
OPB_err(111);
}
@ -2257,6 +2238,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if (((x->class == 8 || x->class == 9) || __IN(f, 0x1401)) || x->typ->comp == 3) {
OPB_err(126);
}
if (x->typ->size < p->typ->size) {
OPB_err(-308);
}
t = OPT_NewNode(11);
t->subcl = 29;
t->left = x;
@ -2268,7 +2252,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if (__IN(f, 0x70)) {
p = NewOp__53(19, 30, p, x);
p = NewOp__57(19, 30, p, x);
} else {
OPB_err(111);
}
@ -2277,9 +2261,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 31:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if ((x->class == 7 && __IN(f, 0x30))) {
} else if ((((x->class == 7 && __IN(f, 0x70))) && x->typ->size < OPT_linttyp->size)) {
OPB_Convert(&x, OPT_linttyp);
} else if (!__IN(f, 0x2040)) {
} else if (!((__IN(x->typ->form, 0x2070) && x->typ->size == (int)OPM_PointerSize))) {
OPB_err(111);
x->typ = OPT_linttyp;
}
@ -2314,7 +2298,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
break;
}
*par0 = p;
StPar1__52_s = _s.lnk;
StPar1__56_s = _s.lnk;
}
void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
@ -2433,7 +2417,7 @@ static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpa
ftyp = ftyp->BaseTyp;
atyp = atyp->BaseTyp;
if ((fvarpar && ftyp == OPT_bytetyp)) {
if (!__IN(f, 0x0c) || !__IN(atyp->form, 0x1e)) {
if (!__IN(f, 0x0c) || !((__IN(atyp->form, 0x7e) && atyp->size == 1))) {
if (__IN(18, OPM_opt)) {
OPB_err(-301);
}
@ -2516,7 +2500,7 @@ void OPB_Param (OPT_Node ap, OPT_Object fp)
OPB_err(111);
}
} else if ((fp->typ == OPT_sysptrtyp && ap->typ->form == 13)) {
} else if ((ap->typ != fp->typ && !((fp->typ->form == 1 && __IN(ap->typ->form, 0x18))))) {
} else if ((ap->typ != fp->typ && !((fp->typ->form == 1 && ((__IN(ap->typ->form, 0x7e) && ap->typ->size == 1)))))) {
OPB_err(123);
} else if ((fp->typ->form == 13 && ap->class == 5)) {
OPB_err(123);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPB__h
#define OPB__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
#include "Configuration.h"
#include "OPM.h"
@ -16,12 +16,13 @@ static CHAR OPC_BodyNameExt[13];
export void OPC_Align (LONGINT *adr, LONGINT base);
export void OPC_Andent (OPT_Struct typ);
static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames);
export LONGINT OPC_Base (OPT_Struct typ);
export LONGINT OPC_BaseAlignment (OPT_Struct typ);
export OPT_Object OPC_BaseTProc (OPT_Object obj);
export void OPC_BegBlk (void);
export void OPC_BegStat (void);
static void OPC_CProcDefs (OPT_Object obj, INTEGER vis);
export void OPC_Case (LONGINT caseVal, INTEGER form);
static void OPC_CharacterLiteral (LONGINT c);
export void OPC_Cmp (INTEGER rel);
export void OPC_CompleteIdent (OPT_Object obj);
export void OPC_Constant (OPT_Const con, INTEGER form);
@ -73,8 +74,10 @@ static void OPC_PutBase (OPT_Struct typ);
static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt);
static void OPC_RegCmds (OPT_Object obj);
export void OPC_SetInclude (BOOLEAN exclude);
export LONGINT OPC_SizeAlignment (LONGINT size);
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause);
static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x);
static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l);
export void OPC_TDescDecl (OPT_Struct typ);
export void OPC_TypeDefs (OPT_Object obj, INTEGER vis);
export void OPC_TypeOf (OPT_Object ap);
@ -315,7 +318,7 @@ void OPC_Andent (OPT_Struct typ)
static BOOLEAN OPC_Undefined (OPT_Object obj)
{
BOOLEAN _o_result;
_o_result = (((obj->mnolev >= 0 && obj->linkadr != (LONGINT)(3 + OPM_currFile))) && obj->linkadr != 2) || obj->name[0] == 0x00;
_o_result = obj->name[0] == 0x00 || (((obj->mnolev >= 0 && obj->linkadr != (int)(3 + OPM_currFile))) && obj->linkadr != 2);
return _o_result;
}
@ -815,14 +818,15 @@ void OPC_TDescDecl (OPT_Struct typ)
OPC_Andent(typ);
OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1);
OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ));
OPM_Write('\"');
OPM_Write('"');
if (typ->strobj != NIL) {
OPM_WriteStringVar((void*)typ->strobj->name, ((LONGINT)(256)));
}
OPC_Str1((CHAR*)"\", #), {", (LONGINT)9, typ->size);
OPM_Write('"');
OPC_Str1((CHAR*)", #), {", (LONGINT)8, typ->size);
nofptrs = 0;
OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs);
OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (LONGINT)OPM_LIntSize));
OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (int)OPM_LIntSize));
OPC_EndStat();
}
@ -864,70 +868,37 @@ void OPC_Align (LONGINT *adr, LONGINT base)
}
}
LONGINT OPC_Base (OPT_Struct typ)
LONGINT OPC_SizeAlignment (LONGINT size)
{
LONGINT _o_result;
switch (typ->form) {
case 1:
_o_result = 1;
return _o_result;
break;
case 3:
_o_result = OPM_CharAlign;
return _o_result;
break;
case 2:
_o_result = OPM_BoolAlign;
return _o_result;
break;
case 4:
_o_result = OPM_SIntAlign;
return _o_result;
break;
case 5:
_o_result = OPM_IntAlign;
return _o_result;
break;
case 6:
_o_result = OPM_LIntAlign;
return _o_result;
break;
case 7:
_o_result = OPM_RealAlign;
return _o_result;
break;
case 8:
_o_result = OPM_LRealAlign;
return _o_result;
break;
case 9:
_o_result = OPM_SetAlign;
return _o_result;
break;
case 13:
_o_result = OPM_PointerAlign;
return _o_result;
break;
case 14:
_o_result = OPM_ProcAlign;
return _o_result;
break;
case 15:
if (typ->comp == 4) {
_o_result = __MASK(typ->align, -65536);
return _o_result;
} else {
_o_result = OPC_Base(typ->BaseTyp);
return _o_result;
}
break;
default:
OPM_LogWStr((CHAR*)"unhandled case in OPC.Base, typ^form = ", (LONGINT)40);
OPM_LogWNum(typ->form, ((LONGINT)(0)));
OPM_LogWLn();
break;
LONGINT alignment;
if (size < (int)OPM_Alignment) {
alignment = 1;
while (alignment < size) {
alignment = __ASHL(alignment, 1);
}
} else {
alignment = OPM_Alignment;
}
__RETCHK;
_o_result = alignment;
return _o_result;
}
LONGINT OPC_BaseAlignment (OPT_Struct typ)
{
LONGINT _o_result;
LONGINT alignment;
if (typ->form == 15) {
if (typ->comp == 4) {
alignment = __MASK(typ->align, -65536);
} else {
alignment = OPC_BaseAlignment(typ->BaseTyp);
}
} else {
alignment = OPC_SizeAlignment(typ->size);
}
_o_result = alignment;
return _o_result;
}
static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LONGINT *curAlign)
@ -938,11 +909,11 @@ static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LO
if ((*curAlign < align && gap - (adr - off) >= align)) {
gap -= (adr - off) + align;
OPC_BegStat();
if (align == (LONGINT)OPM_IntSize) {
if (align == (int)OPM_IntSize) {
OPM_WriteString((CHAR*)"INTEGER", (LONGINT)8);
} else if (align == (LONGINT)OPM_LIntSize) {
} else if (align == (int)OPM_LIntSize) {
OPM_WriteString((CHAR*)"LONGINT", (LONGINT)8);
} else if (align == (LONGINT)OPM_LRealSize) {
} else if (align == (int)OPM_LRealSize) {
OPM_WriteString((CHAR*)"LONGREAL", (LONGINT)9);
}
OPC_Str1((CHAR*)" _prvt#", (LONGINT)8, *n);
@ -981,7 +952,7 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
}
} else {
adr = *off;
fldAlign = OPC_Base(fld->typ);
fldAlign = OPC_BaseAlignment(fld->typ);
OPC_Align(&adr, fldAlign);
gap = fld->adr - adr;
if (fldAlign > *curAlign) {
@ -1007,7 +978,7 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
}
}
if (last) {
adr = typ->size - (LONGINT)__ASHR(typ->sysflag, 8);
adr = typ->size - (int)__ASHR(typ->sysflag, 8);
if (adr == 0) {
gap = 1;
} else {
@ -1170,10 +1141,10 @@ static void OPC_Include (CHAR *name, LONGINT name__len)
{
__DUP(name, name__len, CHAR);
OPM_WriteString((CHAR*)"#include ", (LONGINT)10);
OPM_Write('\"');
OPM_Write('"');
OPM_WriteStringVar((void*)name, name__len);
OPM_WriteString((CHAR*)".h", (LONGINT)3);
OPM_Write('\"');
OPM_Write('"');
OPM_WriteLn();
__DEL(name);
}
@ -1238,8 +1209,8 @@ void OPC_GenHdr (OPT_Node n)
static void OPC_GenHeaderMsg (void)
{
INTEGER i;
OPM_WriteString((CHAR*)"/*", (LONGINT)3);
OPM_WriteString((CHAR*)" voc ", (LONGINT)6);
OPM_WriteString((CHAR*)"/* ", (LONGINT)4);
OPM_WriteString((CHAR*)"voc", (LONGINT)4);
OPM_Write(' ');
OPM_WriteString(Configuration_versionLong, ((LONGINT)(41)));
OPM_Write(' ');
@ -1855,26 +1826,56 @@ void OPC_Cmp (INTEGER rel)
}
}
static void OPC_CharacterLiteral (LONGINT c)
{
if (c < 32 || c > 126) {
OPM_WriteString((CHAR*)"0x", (LONGINT)3);
OPM_WriteHex(c);
} else {
OPM_Write('\'');
if ((c == 92 || c == 39) || c == 63) {
OPM_Write('\\');
}
OPM_Write((CHAR)c);
OPM_Write('\'');
}
}
static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l)
{
LONGINT i;
INTEGER c;
__DUP(s, s__len, CHAR);
OPM_Write('"');
i = 0;
while (i < l) {
c = (int)s[__X(i, s__len)];
if (c < 32 || c > 126) {
OPM_Write('\\');
OPM_Write((CHAR)(48 + __ASHR(c, 6)));
c = __MASK(c, -64);
OPM_Write((CHAR)(48 + __ASHR(c, 3)));
c = __MASK(c, -8);
OPM_Write((CHAR)(48 + c));
} else {
if ((c == 92 || c == 34) || c == 63) {
OPM_Write('\\');
}
OPM_Write((CHAR)c);
}
i += 1;
}
OPM_Write('"');
__DEL(s);
}
void OPC_Case (LONGINT caseVal, INTEGER form)
{
CHAR ch;
OPM_WriteString((CHAR*)"case ", (LONGINT)6);
switch (form) {
case 3:
ch = (CHAR)caseVal;
if ((ch >= ' ' && ch <= '~')) {
OPM_Write('\'');
if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') {
OPM_Write('\\');
OPM_Write(ch);
} else {
OPM_Write(ch);
}
OPM_Write('\'');
} else {
OPM_WriteString((CHAR*)"0x", (LONGINT)3);
OPM_WriteHex(caseVal);
}
OPC_CharacterLiteral(caseVal);
break;
case 4: case 5: case 6:
OPM_WriteInt(caseVal);
@ -1932,8 +1933,7 @@ void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim)
void OPC_Constant (OPT_Const con, INTEGER form)
{
INTEGER i, len;
CHAR ch;
INTEGER i;
SET s;
LONGINT hex;
BOOLEAN skipLeading;
@ -1945,18 +1945,7 @@ void OPC_Constant (OPT_Const con, INTEGER form)
OPM_WriteInt(con->intval);
break;
case 3:
ch = (CHAR)con->intval;
if ((ch >= ' ' && ch <= '~')) {
OPM_Write('\'');
if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') {
OPM_Write('\\');
}
OPM_Write(ch);
OPM_Write('\'');
} else {
OPM_WriteString((CHAR*)"0x", (LONGINT)3);
OPM_WriteHex(con->intval);
}
OPC_CharacterLiteral(con->intval);
break;
case 4: case 5: case 6:
OPM_WriteInt(con->intval);
@ -1991,18 +1980,7 @@ void OPC_Constant (OPT_Const con, INTEGER form)
}
break;
case 10:
OPM_Write('\"');
len = (int)con->intval2 - 1;
i = 0;
while (i < len) {
ch = (*con->ext)[__X(i, ((LONGINT)(256)))];
if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') {
OPM_Write('\\');
}
OPM_Write(ch);
i += 1;
}
OPM_Write('\"');
OPC_StringLiteral(*con->ext, ((LONGINT)(256)), con->intval2 - 1);
break;
case 11:
OPM_WriteString((CHAR*)"NIL", (LONGINT)4);
@ -2015,74 +1993,74 @@ void OPC_Constant (OPT_Const con, INTEGER form)
}
}
static struct InitKeywords__47 {
static struct InitKeywords__48 {
SHORTINT *n;
struct InitKeywords__47 *lnk;
} *InitKeywords__47_s;
struct InitKeywords__48 *lnk;
} *InitKeywords__48_s;
static void Enter__48 (CHAR *s, LONGINT s__len);
static void Enter__49 (CHAR *s, LONGINT s__len);
static void Enter__48 (CHAR *s, LONGINT s__len)
static void Enter__49 (CHAR *s, LONGINT s__len)
{
INTEGER h;
__DUP(s, s__len, CHAR);
h = OPC_PerfectHash((void*)s, s__len);
OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__47_s->n;
__COPY(s, OPC_keytab[__X(*InitKeywords__47_s->n, ((LONGINT)(36)))], ((LONGINT)(9)));
*InitKeywords__47_s->n += 1;
OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__48_s->n;
__COPY(s, OPC_keytab[__X(*InitKeywords__48_s->n, ((LONGINT)(36)))], ((LONGINT)(9)));
*InitKeywords__48_s->n += 1;
__DEL(s);
}
static void OPC_InitKeywords (void)
{
SHORTINT n, i;
struct InitKeywords__47 _s;
struct InitKeywords__48 _s;
_s.n = &n;
_s.lnk = InitKeywords__47_s;
InitKeywords__47_s = &_s;
_s.lnk = InitKeywords__48_s;
InitKeywords__48_s = &_s;
n = 0;
i = 0;
while (i <= 104) {
OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1;
i += 1;
}
Enter__48((CHAR*)"asm", (LONGINT)4);
Enter__48((CHAR*)"auto", (LONGINT)5);
Enter__48((CHAR*)"break", (LONGINT)6);
Enter__48((CHAR*)"case", (LONGINT)5);
Enter__48((CHAR*)"char", (LONGINT)5);
Enter__48((CHAR*)"const", (LONGINT)6);
Enter__48((CHAR*)"continue", (LONGINT)9);
Enter__48((CHAR*)"default", (LONGINT)8);
Enter__48((CHAR*)"do", (LONGINT)3);
Enter__48((CHAR*)"double", (LONGINT)7);
Enter__48((CHAR*)"else", (LONGINT)5);
Enter__48((CHAR*)"enum", (LONGINT)5);
Enter__48((CHAR*)"extern", (LONGINT)7);
Enter__48((CHAR*)"export", (LONGINT)7);
Enter__48((CHAR*)"float", (LONGINT)6);
Enter__48((CHAR*)"for", (LONGINT)4);
Enter__48((CHAR*)"fortran", (LONGINT)8);
Enter__48((CHAR*)"goto", (LONGINT)5);
Enter__48((CHAR*)"if", (LONGINT)3);
Enter__48((CHAR*)"import", (LONGINT)7);
Enter__48((CHAR*)"int", (LONGINT)4);
Enter__48((CHAR*)"long", (LONGINT)5);
Enter__48((CHAR*)"register", (LONGINT)9);
Enter__48((CHAR*)"return", (LONGINT)7);
Enter__48((CHAR*)"short", (LONGINT)6);
Enter__48((CHAR*)"signed", (LONGINT)7);
Enter__48((CHAR*)"sizeof", (LONGINT)7);
Enter__48((CHAR*)"static", (LONGINT)7);
Enter__48((CHAR*)"struct", (LONGINT)7);
Enter__48((CHAR*)"switch", (LONGINT)7);
Enter__48((CHAR*)"typedef", (LONGINT)8);
Enter__48((CHAR*)"union", (LONGINT)6);
Enter__48((CHAR*)"unsigned", (LONGINT)9);
Enter__48((CHAR*)"void", (LONGINT)5);
Enter__48((CHAR*)"volatile", (LONGINT)9);
Enter__48((CHAR*)"while", (LONGINT)6);
InitKeywords__47_s = _s.lnk;
Enter__49((CHAR*)"asm", (LONGINT)4);
Enter__49((CHAR*)"auto", (LONGINT)5);
Enter__49((CHAR*)"break", (LONGINT)6);
Enter__49((CHAR*)"case", (LONGINT)5);
Enter__49((CHAR*)"char", (LONGINT)5);
Enter__49((CHAR*)"const", (LONGINT)6);
Enter__49((CHAR*)"continue", (LONGINT)9);
Enter__49((CHAR*)"default", (LONGINT)8);
Enter__49((CHAR*)"do", (LONGINT)3);
Enter__49((CHAR*)"double", (LONGINT)7);
Enter__49((CHAR*)"else", (LONGINT)5);
Enter__49((CHAR*)"enum", (LONGINT)5);
Enter__49((CHAR*)"extern", (LONGINT)7);
Enter__49((CHAR*)"export", (LONGINT)7);
Enter__49((CHAR*)"float", (LONGINT)6);
Enter__49((CHAR*)"for", (LONGINT)4);
Enter__49((CHAR*)"fortran", (LONGINT)8);
Enter__49((CHAR*)"goto", (LONGINT)5);
Enter__49((CHAR*)"if", (LONGINT)3);
Enter__49((CHAR*)"import", (LONGINT)7);
Enter__49((CHAR*)"int", (LONGINT)4);
Enter__49((CHAR*)"long", (LONGINT)5);
Enter__49((CHAR*)"register", (LONGINT)9);
Enter__49((CHAR*)"return", (LONGINT)7);
Enter__49((CHAR*)"short", (LONGINT)6);
Enter__49((CHAR*)"signed", (LONGINT)7);
Enter__49((CHAR*)"sizeof", (LONGINT)7);
Enter__49((CHAR*)"static", (LONGINT)7);
Enter__49((CHAR*)"struct", (LONGINT)7);
Enter__49((CHAR*)"switch", (LONGINT)7);
Enter__49((CHAR*)"typedef", (LONGINT)8);
Enter__49((CHAR*)"union", (LONGINT)6);
Enter__49((CHAR*)"unsigned", (LONGINT)9);
Enter__49((CHAR*)"void", (LONGINT)5);
Enter__49((CHAR*)"volatile", (LONGINT)9);
Enter__49((CHAR*)"while", (LONGINT)6);
InitKeywords__48_s = _s.lnk;
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPC__h
#define OPC__h
@ -11,7 +11,7 @@
import void OPC_Align (LONGINT *adr, LONGINT base);
import void OPC_Andent (OPT_Struct typ);
import LONGINT OPC_Base (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);
@ -40,6 +40,7 @@ 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_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_TypeOf (OPT_Object ap);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
#include "Configuration.h"
#include "Console.h"
@ -14,8 +14,8 @@ typedef
static CHAR OPM_SourceFileName[256];
export INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_CharAlign, OPM_BoolAlign, OPM_SIntAlign, OPM_IntAlign, OPM_LIntAlign, OPM_SetAlign, OPM_RealAlign, OPM_LRealAlign, OPM_PointerAlign, OPM_ProcAlign, OPM_RecAlign, OPM_MaxSet;
export LONGINT OPM_MinSInt, OPM_MinInt, OPM_MinLInt, OPM_MaxSInt, OPM_MaxInt, OPM_MaxLInt, OPM_MaxIndex;
export INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_MaxSet;
export LONGINT OPM_MaxIndex;
export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
export BOOLEAN OPM_noerr;
export LONGINT OPM_curpos, OPM_errpos, OPM_breakpc;
@ -57,7 +57,6 @@ export void OPM_LogWNum (LONGINT i, LONGINT len);
export void OPM_LogWStr (CHAR *s, LONGINT s__len);
static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len);
export void OPM_Mark (INTEGER n, LONGINT pos);
static INTEGER OPM_Min (INTEGER a, INTEGER b);
export void OPM_NewSym (CHAR *modName, LONGINT modName__len);
export void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
export void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
@ -65,6 +64,8 @@ export BOOLEAN OPM_OpenPar (void);
export void OPM_RegisterNewSym (void);
static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt);
static void OPM_ShowLine (LONGINT pos);
export LONGINT OPM_SignedMaximum (LONGINT bytecount);
export LONGINT OPM_SignedMinimum (LONGINT bytecount);
export void OPM_SymRCh (CHAR *ch);
export LONGINT OPM_SymRInt (void);
export void OPM_SymRLReal (LONGREAL *lr);
@ -85,7 +86,7 @@ export void OPM_WriteString (CHAR *s, LONGINT s__len);
export void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
export BOOLEAN OPM_eofSF (void);
export void OPM_err (INTEGER n);
static LONGINT OPM_minus (LONGINT i);
static LONGINT OPM_minusop (LONGINT i);
static LONGINT OPM_power0 (LONGINT i, LONGINT j);
@ -117,50 +118,38 @@ static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt)
i = 1;
while (s[__X(i, s__len)] != 0x00) {
switch (s[__X(i, s__len)]) {
case 'e':
*opt = *opt ^ 0x0200;
break;
case 's':
*opt = *opt ^ 0x10;
break;
case 'm':
*opt = *opt ^ 0x0400;
break;
case 'x':
*opt = *opt ^ 0x01;
break;
case 'r':
*opt = *opt ^ 0x04;
break;
case 't':
*opt = *opt ^ 0x08;
break;
case 'a':
*opt = *opt ^ 0x80;
break;
case 'k':
*opt = *opt ^ 0x40;
break;
case 'p':
*opt = *opt ^ 0x20;
break;
case 'S':
*opt = *opt ^ 0x2000;
break;
case 'c':
*opt = *opt ^ 0x4000;
break;
case 'M':
*opt = *opt ^ 0x8000;
case 'e':
*opt = *opt ^ 0x0200;
break;
case 'f':
*opt = *opt ^ 0x010000;
break;
case 'F':
*opt = *opt ^ 0x020000;
case 'k':
*opt = *opt ^ 0x40;
break;
case 'V':
*opt = *opt ^ 0x040000;
case 'm':
*opt = *opt ^ 0x0400;
break;
case 'p':
*opt = *opt ^ 0x20;
break;
case 'r':
*opt = *opt ^ 0x04;
break;
case 's':
*opt = *opt ^ 0x10;
break;
case 't':
*opt = *opt ^ 0x08;
break;
case 'x':
*opt = *opt ^ 0x01;
break;
case 'B':
if (s[__X(i + 1, s__len)] != 0x00) {
@ -178,6 +167,19 @@ static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt)
__ASSERT(OPM_IntSize == 2 || OPM_IntSize == 4, 0);
__ASSERT(OPM_PointerSize == 4 || OPM_PointerSize == 8, 0);
__ASSERT(OPM_Alignment == 4 || OPM_Alignment == 8, 0);
Files_SetSearchPath((CHAR*)"", (LONGINT)1);
break;
case 'F':
*opt = *opt ^ 0x020000;
break;
case 'M':
*opt = *opt ^ 0x8000;
break;
case 'S':
*opt = *opt ^ 0x2000;
break;
case 'V':
*opt = *opt ^ 0x040000;
break;
default:
OPM_LogWStr((CHAR*)" warning: option ", (LONGINT)19);
@ -227,17 +229,17 @@ BOOLEAN OPM_OpenPar (void)
OPM_LogWLn();
OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" a - don\'t check ASSERTs at runtime, use this option in tested production code", (LONGINT)80);
OPM_LogWStr((CHAR*)" a - don't check ASSERTs at runtime, use this option in tested production code", (LONGINT)80);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" t - don\'t check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101);
OPM_LogWStr((CHAR*)" t - don't check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" S - don\'t call external assembler/compiler, only generate C code", (LONGINT)67);
OPM_LogWStr((CHAR*)" S - don't call external assembler/compiler, only generate C code", (LONGINT)67);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" c - don\'t call linker", (LONGINT)24);
OPM_LogWStr((CHAR*)" c - don't call linker", (LONGINT)24);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" f - don\'t use color output", (LONGINT)29);
OPM_LogWStr((CHAR*)" f - don't use color output", (LONGINT)29);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57);
OPM_LogWLn();
@ -540,14 +542,17 @@ void OPM_FPrintSet (LONGINT *fp, SET set)
void OPM_FPrintReal (LONGINT *fp, REAL real)
{
OPM_FPrint(&*fp, __VAL(LONGINT, real));
INTEGER i;
LONGINT l;
__GET((LONGINT)(SYSTEM_ADDRESS)&real, l, LONGINT);
OPM_FPrint(&*fp, l);
}
void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr)
{
LONGINT l, h;
__GET((LONGINT)(uintptr_t)&lr, l, LONGINT);
__GET((LONGINT)(uintptr_t)&lr + 4, h, LONGINT);
__GET((LONGINT)(SYSTEM_ADDRESS)&lr, l, LONGINT);
__GET((LONGINT)(SYSTEM_ADDRESS)&lr + 4, h, LONGINT);
OPM_FPrint(&*fp, l);
OPM_FPrint(&*fp, h);
}
@ -575,7 +580,7 @@ static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONG
__DEL(name);
}
static LONGINT OPM_minus (LONGINT i)
static LONGINT OPM_minusop (LONGINT i)
{
LONGINT _o_result;
_o_result = -i;
@ -603,103 +608,62 @@ static void OPM_VerboseListSizes (void)
OPM_LogWLn();
OPM_LogWStr((CHAR*)"CHAR ", (LONGINT)14);
OPM_LogWNum(OPM_CharSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_CharAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"BOOLEAN ", (LONGINT)14);
OPM_LogWNum(OPM_BoolSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_BoolAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"SHORTINT ", (LONGINT)14);
OPM_LogWNum(OPM_SIntSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_SIntAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"INTEGER ", (LONGINT)14);
OPM_LogWNum(OPM_IntSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_IntAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"LONGINT ", (LONGINT)14);
OPM_LogWNum(OPM_LIntSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_LIntAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"SET ", (LONGINT)14);
OPM_LogWNum(OPM_SetSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_SetAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"REAL ", (LONGINT)14);
OPM_LogWNum(OPM_RealSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_RealAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"LONGREAL ", (LONGINT)14);
OPM_LogWNum(OPM_LRealSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_LRealAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"PTR ", (LONGINT)14);
OPM_LogWNum(OPM_PointerSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_PointerAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"PROC ", (LONGINT)14);
OPM_LogWNum(OPM_ProcSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_ProcAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"RECORD ", (LONGINT)14);
OPM_LogWNum(OPM_RecSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_RecAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Min shortint ", (LONGINT)14);
OPM_LogWNum(OPM_MinSInt, ((LONGINT)(4)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Max shortint ", (LONGINT)14);
OPM_LogWNum(OPM_MaxSInt, ((LONGINT)(4)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Min integer ", (LONGINT)14);
OPM_LogWNum(OPM_MinInt, ((LONGINT)(4)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Max integer ", (LONGINT)14);
OPM_LogWNum(OPM_MaxInt, ((LONGINT)(4)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Min longint ", (LONGINT)14);
OPM_LogWNum(OPM_MinLInt, ((LONGINT)(4)));
OPM_LogWLn();
}
static INTEGER OPM_Min (INTEGER a, INTEGER b)
LONGINT OPM_SignedMaximum (LONGINT bytecount)
{
INTEGER _o_result;
if (a < b) {
_o_result = a;
return _o_result;
} else {
_o_result = b;
return _o_result;
}
__RETCHK;
LONGINT _o_result;
LONGINT result;
result = 1;
result = __LSH(result, __ASHL(bytecount, 3) - 1, LONGINT);
_o_result = result - 1;
return _o_result;
}
LONGINT OPM_SignedMinimum (LONGINT bytecount)
{
LONGINT _o_result;
_o_result = -OPM_SignedMaximum(bytecount) - 1;
return _o_result;
}
static void OPM_GetProperties (void)
{
LONGINT base;
OPM_ProcSize = OPM_PointerSize;
OPM_LIntSize = __ASHL(OPM_IntSize, 1);
OPM_SetSize = OPM_LIntSize;
OPM_CharAlign = OPM_Min(OPM_Alignment, OPM_CharSize);
OPM_BoolAlign = OPM_Min(OPM_Alignment, OPM_BoolSize);
OPM_SIntAlign = OPM_Min(OPM_Alignment, OPM_SIntSize);
OPM_RecAlign = OPM_Min(OPM_Alignment, OPM_RecSize);
OPM_RealAlign = OPM_Min(OPM_Alignment, OPM_RealSize);
OPM_LRealAlign = OPM_Min(OPM_Alignment, OPM_LRealSize);
OPM_PointerAlign = OPM_Min(OPM_Alignment, OPM_PointerSize);
OPM_ProcAlign = OPM_Min(OPM_Alignment, OPM_ProcSize);
OPM_IntAlign = OPM_Min(OPM_Alignment, OPM_IntSize);
OPM_LIntAlign = OPM_Min(OPM_Alignment, OPM_LIntSize);
OPM_SetAlign = OPM_Min(OPM_Alignment, OPM_SetSize);
base = -2;
OPM_MinSInt = __ASH(base, __ASHL(OPM_SIntSize, 3) - 2);
OPM_MaxSInt = OPM_minus(OPM_MinSInt + 1);
OPM_MinInt = __ASH(base, __ASHL(OPM_IntSize, 3) - 2);
OPM_MaxInt = OPM_minus(OPM_MinInt + 1);
OPM_MinLInt = __ASH(base, __ASHL(OPM_LIntSize, 3) - 2);
OPM_MaxLInt = OPM_minus(OPM_MinLInt + 1);
if (OPM_RealSize == 4) {
OPM_MaxReal = 3.40282346000000e+038;
} else if (OPM_RealSize == 8) {
@ -713,7 +677,7 @@ static void OPM_GetProperties (void)
OPM_MinReal = -OPM_MaxReal;
OPM_MinLReal = -OPM_MaxLReal;
OPM_MaxSet = __ASHL(OPM_SetSize, 3) - 1;
OPM_MaxIndex = OPM_MaxLInt;
OPM_MaxIndex = OPM_SignedMaximum(OPM_PointerSize);
if (OPM_Verbose) {
OPM_VerboseListSizes();
}
@ -875,7 +839,7 @@ void OPM_WriteInt (LONGINT i)
{
CHAR s[20];
LONGINT i1, k;
if (i == OPM_MinInt || i == OPM_MinLInt) {
if (i == OPM_SignedMinimum(OPM_IntSize) || i == OPM_SignedMinimum(OPM_LIntSize)) {
OPM_Write('(');
OPM_WriteInt(i + 1);
OPM_WriteString((CHAR*)"-1)", (LONGINT)4);
@ -908,13 +872,13 @@ void OPM_WriteReal (LONGREAL r, CHAR suffx)
CHAR s[32];
CHAR ch;
INTEGER i;
if ((((r < OPM_MaxLInt && r > OPM_MinLInt)) && r == (__ENTIER(r)))) {
if ((((r < OPM_SignedMaximum(OPM_LIntSize) && r > OPM_SignedMinimum(OPM_LIntSize))) && r == ((int)__ENTIER(r)))) {
if (suffx == 'f') {
OPM_WriteString((CHAR*)"(REAL)", (LONGINT)7);
} else {
OPM_WriteString((CHAR*)"(LONGREAL)", (LONGINT)11);
}
OPM_WriteInt(__ENTIER(r));
OPM_WriteInt((int)__ENTIER(r));
} else {
Texts_OpenWriter(&W, Texts_Writer__typ);
if (suffx == 'f') {

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPM__h
#define OPM__h
@ -6,8 +6,8 @@
#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_CharAlign, OPM_BoolAlign, OPM_SIntAlign, OPM_IntAlign, OPM_LIntAlign, OPM_SetAlign, OPM_RealAlign, OPM_LRealAlign, OPM_PointerAlign, OPM_ProcAlign, OPM_RecAlign, OPM_MaxSet;
import LONGINT OPM_MinSInt, OPM_MinInt, OPM_MinLInt, OPM_MaxSInt, OPM_MaxInt, OPM_MaxLInt, OPM_MaxIndex;
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 LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
import BOOLEAN OPM_noerr;
import LONGINT OPM_curpos, OPM_errpos, OPM_breakpc;
@ -38,6 +38,8 @@ 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 void OPM_SymRCh (CHAR *ch);
import LONGINT OPM_SymRInt (void);
import void OPM_SymRLReal (LONGREAL *lr);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
#include "OPB.h"
#include "OPM.h"
@ -438,10 +438,10 @@ static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned)
if (OPP_sym == 38) {
OPP_qualident(&id);
if (id->mode == 5) {
if (id->typ != *banned) {
*typ = id->typ;
} else {
if (id->typ == *banned) {
OPP_err(58);
} else {
*typ = id->typ;
}
} else {
OPP_err(52);
@ -1783,6 +1783,24 @@ void OPP_Module (OPT_Node *prog, SET opt)
if (OPP_sym == 63) {
OPS_Get(&OPP_sym);
} else {
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Unexpected symbol found when MODULE expected:", (LONGINT)46);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" sym: ", (LONGINT)15);
OPM_LogWNum(OPP_sym, ((LONGINT)(1)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)" OPS.name: ", (LONGINT)15);
OPM_LogWStr(OPS_name, ((LONGINT)(256)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)" OPS.str: ", (LONGINT)15);
OPM_LogWStr(OPS_str, ((LONGINT)(256)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)" OPS.numtyp: ", (LONGINT)15);
OPM_LogWNum(OPS_numtyp, ((LONGINT)(1)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)" OPS.intval: ", (LONGINT)15);
OPM_LogWNum(OPS_intval, ((LONGINT)(1)));
OPM_LogWLn();
OPP_err(16);
}
if (OPP_sym == 38) {

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPP__h
#define OPP__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin tspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
#include "SYSTEM.h"
#include "OPM.h"
@ -173,7 +173,7 @@ static void OPS_Number (void)
OPS_numtyp = 1;
if (n <= 2) {
while (i < n) {
OPS_intval = __ASHL(OPS_intval, 4) + (LONGINT)Ord__7(dig[i], 1);
OPS_intval = __ASHL(OPS_intval, 4) + (int)Ord__7(dig[i], 1);
i += 1;
}
} else {
@ -188,7 +188,7 @@ static void OPS_Number (void)
OPS_intval = -1;
}
while (i < n) {
OPS_intval = __ASHL(OPS_intval, 4) + (LONGINT)Ord__7(dig[i], 1);
OPS_intval = __ASHL(OPS_intval, 4) + (int)Ord__7(dig[i], 1);
i += 1;
}
} else {
@ -199,8 +199,8 @@ static void OPS_Number (void)
while (i < n) {
d = Ord__7(dig[i], 0);
i += 1;
if (OPS_intval <= __DIV(2147483647 - (LONGINT)d, 10)) {
OPS_intval = OPS_intval * 10 + (LONGINT)d;
if (OPS_intval <= __DIV(2147483647 - (int)d, 10)) {
OPS_intval = OPS_intval * 10 + (int)d;
} else {
OPS_err(203);
}
@ -325,7 +325,7 @@ void OPS_Get (SHORTINT *sym)
}
}
switch (OPS_ch) {
case '\"': case '\'':
case '"': case '\'':
OPS_Str(&s);
break;
case '#':

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin tspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
#ifndef OPS__h
#define OPS__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
#include "OPM.h"
#include "OPS.h"
@ -849,7 +849,7 @@ static void OPT_InConstant (LONGINT f, OPT_Const conval)
conval->intval = 0;
break;
default:
OPM_LogWStr((CHAR*)"unhandled case in OPT.InConstant(), f = ", (LONGINT)41);
OPM_LogWStr((CHAR*)"unhandled case in InConstant(), f = ", (LONGINT)37);
OPM_LogWNum(f, ((LONGINT)(0)));
OPM_LogWLn();
break;
@ -1072,7 +1072,7 @@ static void OPT_InStruct (OPT_Struct *typ)
OPT_InSign(mno, &(*typ)->BaseTyp, &(*typ)->link);
break;
default:
OPM_LogWStr((CHAR*)"unhandled case at OPT.InStruct, tag = ", (LONGINT)39);
OPM_LogWStr((CHAR*)"unhandled case at InStruct, tag = ", (LONGINT)35);
OPM_LogWNum(tag, ((LONGINT)(0)));
OPM_LogWLn();
break;
@ -1175,7 +1175,7 @@ static OPT_Object OPT_InObj (SHORTINT mno)
}
break;
default:
OPM_LogWStr((CHAR*)"unhandled case at OPT.InObj, tag = ", (LONGINT)36);
OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", (LONGINT)32);
OPM_LogWNum(tag, ((LONGINT)(0)));
OPM_LogWLn();
break;
@ -1464,14 +1464,14 @@ static void OPT_OutStr (OPT_Struct typ)
OPM_SymWInt(((LONGINT)(18)));
break;
default:
OPM_LogWStr((CHAR*)"unhandled case at OPT.OutStr, typ^.comp = ", (LONGINT)43);
OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.comp = ", (LONGINT)39);
OPM_LogWNum(typ->comp, ((LONGINT)(0)));
OPM_LogWLn();
break;
}
break;
default:
OPM_LogWStr((CHAR*)"unhandled case at OPT.OutStr, typ^.form = ", (LONGINT)43);
OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.form = ", (LONGINT)39);
OPM_LogWNum(typ->form, ((LONGINT)(0)));
OPM_LogWLn();
break;
@ -1536,7 +1536,7 @@ static void OPT_OutObj (OPT_Object obj)
OPT_FPrintErr(obj, 251);
break;
default:
OPM_LogWStr((CHAR*)"unhandled case at OPT.OutObj, obj^.history = ", (LONGINT)46);
OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj^.history = ", (LONGINT)42);
OPM_LogWNum(obj->history, ((LONGINT)(0)));
OPM_LogWLn();
break;
@ -1592,7 +1592,7 @@ static void OPT_OutObj (OPT_Object obj)
OPT_OutName((void*)obj->name, ((LONGINT)(256)));
break;
default:
OPM_LogWStr((CHAR*)"unhandled case at OPT.OutObj, obj.mode = ", (LONGINT)42);
OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj.mode = ", (LONGINT)38);
OPM_LogWNum(obj->mode, ((LONGINT)(0)));
OPM_LogWLn();
break;
@ -1809,6 +1809,7 @@ export void *OPT__init(void)
OPT_syslink = OPT_topScope->right;
OPT_universe = OPT_topScope;
OPT_topScope->right = NIL;
OPT_EnterTyp((CHAR*)"BOOLEAN", 2, OPM_BoolSize, &OPT_booltyp);
OPT_EnterTyp((CHAR*)"CHAR", 3, OPM_CharSize, &OPT_chartyp);
OPT_EnterTyp((CHAR*)"SET", 9, OPM_SetSize, &OPT_settyp);
OPT_EnterTyp((CHAR*)"REAL", 7, OPM_RealSize, &OPT_realtyp);
@ -1816,7 +1817,6 @@ export void *OPT__init(void)
OPT_EnterTyp((CHAR*)"LONGINT", 6, OPM_LIntSize, &OPT_linttyp);
OPT_EnterTyp((CHAR*)"LONGREAL", 8, OPM_LRealSize, &OPT_lrltyp);
OPT_EnterTyp((CHAR*)"SHORTINT", 4, OPM_SIntSize, &OPT_sinttyp);
OPT_EnterTyp((CHAR*)"BOOLEAN", 2, OPM_BoolSize, &OPT_booltyp);
OPT_EnterBoolConst((CHAR*)"FALSE", ((LONGINT)(0)));
OPT_EnterBoolConst((CHAR*)"TRUE", ((LONGINT)(1)));
OPT_EnterProc((CHAR*)"HALT", 0);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPT__h
#define OPT__h
@ -59,8 +59,7 @@ typedef
INTEGER ref, sysflag;
LONGINT n, size, align, txtpos;
BOOLEAN allocated, pbused, pvused;
char _prvt0[8];
LONGINT pbfp, pvfp;
char _prvt0[16];
OPT_Struct BaseTyp;
OPT_Object link, strobj;
} OPT_StrDesc;

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
#include "OPC.h"
#include "OPM.h"
@ -23,7 +23,7 @@ export LONGINT *OPV_ExitInfo__typ;
static void OPV_ActualPar (OPT_Node n, OPT_Object fp);
export void OPV_AdrAndSize (OPT_Object topScope);
static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc);
static void OPV_Convert (OPT_Node n, INTEGER form, INTEGER prec);
static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INTEGER prec);
static void OPV_DefineTDescs (OPT_Node n);
static void OPV_Entier (OPT_Node n, INTEGER prec);
static void OPV_GetTProcNum (OPT_Object obj);
@ -38,6 +38,7 @@ static LONGINT OPV_NaturalAlignment (LONGINT size, LONGINT max);
static void OPV_NewArr (OPT_Node d, OPT_Node x);
static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, INTEGER comp);
static BOOLEAN OPV_SideEffects (OPT_Node n);
static void OPV_SizeCast (LONGINT size);
static void OPV_Stamp (OPS_Name s);
static OPT_Object OPV_SuperProc (OPT_Node n);
static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported);
@ -82,10 +83,10 @@ void OPV_TypSize (OPT_Struct typ)
btyp = typ->BaseTyp;
if (btyp == NIL) {
offset = 0;
base = OPM_RecAlign;
base = OPC_SizeAlignment(OPM_RecSize);
} else {
OPV_TypSize(btyp);
offset = btyp->size - (LONGINT)__ASHR(btyp->sysflag, 8);
offset = btyp->size - (int)__ASHR(btyp->sysflag, 8);
base = btyp->align;
}
fld = typ->link;
@ -93,7 +94,7 @@ void OPV_TypSize (OPT_Struct typ)
btyp = fld->typ;
OPV_TypSize(btyp);
size = btyp->size;
fbase = OPC_Base(btyp);
fbase = OPC_BaseAlignment(btyp);
OPC_Align(&offset, fbase);
fld->adr = offset;
offset += size;
@ -107,7 +108,7 @@ void OPV_TypSize (OPT_Struct typ)
offset = 1;
}
if (OPM_RecSize == 0) {
base = OPV_NaturalAlignment(offset, OPM_RecAlign);
base = OPV_NaturalAlignment(offset, OPC_SizeAlignment(OPM_RecSize));
}
OPC_Align(&offset, base);
if ((typ->strobj == NIL && __MASK(typ->align, -65536) == 0)) {
@ -332,7 +333,7 @@ static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, IN
return _o_result;
break;
default:
OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence Nmop, subclass = ", (LONGINT)51);
OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence OPT.Nmop, subclass = ", (LONGINT)55);
OPM_LogWNum(subclass, ((LONGINT)(0)));
OPM_LogWLn();
break;
@ -402,7 +403,7 @@ static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, IN
return _o_result;
break;
default:
OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence Ndop, subclass = ", (LONGINT)51);
OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence OPT.Ndop, subclass = ", (LONGINT)55);
OPM_LogWNum(subclass, ((LONGINT)(0)));
OPM_LogWLn();
break;
@ -465,41 +466,26 @@ static void OPV_Entier (OPT_Node n, INTEGER prec)
}
}
static void OPV_Convert (OPT_Node n, INTEGER form, INTEGER prec)
static void OPV_SizeCast (LONGINT size)
{
INTEGER from;
if (size <= 4) {
OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
} else {
OPM_WriteString((CHAR*)"(SYSTEM_INT64)", (LONGINT)15);
}
}
static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INTEGER prec)
{
INTEGER from, to;
from = n->typ->form;
if (form == 9) {
to = newtype->form;
if (to == 9) {
OPM_WriteString((CHAR*)"__SETOF(", (LONGINT)9);
OPV_Entier(n, -1);
OPM_Write(')');
} else if (form == 6) {
if (from < 6) {
OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10);
}
OPV_Entier(n, 9);
} else if (form == 5) {
if (from < 5) {
OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
OPV_expr(n, 9);
} else {
if (__IN(2, OPM_opt)) {
OPM_WriteString((CHAR*)"__SHORT", (LONGINT)8);
if (OPV_SideEffects(n)) {
OPM_Write('F');
}
OPM_Write('(');
OPV_Entier(n, -1);
OPM_WriteString((CHAR*)", ", (LONGINT)3);
OPM_WriteInt(OPM_MaxInt + 1);
OPM_Write(')');
} else {
OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
OPV_Entier(n, 9);
}
}
} else if (form == 4) {
if (__IN(2, OPM_opt)) {
} else if (__IN(to, 0x70)) {
if ((newtype->size < n->typ->size && __IN(2, OPM_opt))) {
OPM_WriteString((CHAR*)"__SHORT", (LONGINT)8);
if (OPV_SideEffects(n)) {
OPM_Write('F');
@ -507,13 +493,15 @@ static void OPV_Convert (OPT_Node n, INTEGER form, INTEGER prec)
OPM_Write('(');
OPV_Entier(n, -1);
OPM_WriteString((CHAR*)", ", (LONGINT)3);
OPM_WriteInt(OPM_MaxSInt + 1);
OPM_WriteInt(OPM_SignedMaximum(newtype->size) + 1);
OPM_Write(')');
} else {
OPM_WriteString((CHAR*)"(int)", (LONGINT)6);
if (newtype->size != n->typ->size) {
OPV_SizeCast(newtype->size);
}
OPV_Entier(n, 9);
}
} else if (form == 3) {
} else if (to == 3) {
if (__IN(2, OPM_opt)) {
OPM_WriteString((CHAR*)"__CHR", (LONGINT)6);
if (OPV_SideEffects(n)) {
@ -576,7 +564,7 @@ static void OPV_design (OPT_Node n, INTEGER prec)
OPT_Struct typ = NIL;
INTEGER class, designPrec, comp;
OPT_Node d = NIL, x = NIL;
INTEGER dims, i, _for__26;
INTEGER dims, i, _for__27;
comp = n->typ->comp;
obj = n->obj;
class = n->class;
@ -652,15 +640,15 @@ static void OPV_design (OPT_Node n, INTEGER prec)
}
x = x->left;
}
_for__26 = dims;
_for__27 = dims;
i = 1;
while (i <= _for__26) {
while (i <= _for__27) {
OPM_Write(')');
i += 1;
}
if (n->typ->comp == 3) {
OPM_Write(')');
while ((LONGINT)i < __ASHR(d->typ->size - 4, 2)) {
while ((int)i < __ASHR(d->typ->size - 4, 2)) {
OPM_WriteString((CHAR*)" * ", (LONGINT)4);
OPV_Len(d, i);
i += 1;
@ -795,7 +783,7 @@ static void OPV_ActualPar (OPT_Node n, OPT_Object fp)
}
if ((((mode == 2 && n->class == 11)) && n->subcl == 29)) {
OPV_expr(n->left, prec);
} else if ((((((form == 6 && n->class == 7)) && n->conval->intval <= OPM_MaxInt)) && n->conval->intval >= OPM_MinInt)) {
} else if ((((((form == 6 && n->class == 7)) && n->conval->intval <= OPM_SignedMaximum(OPM_IntSize))) && n->conval->intval >= OPM_SignedMinimum(OPM_IntSize))) {
OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12);
OPV_expr(n, prec);
OPM_WriteString((CHAR*)"))", (LONGINT)3);
@ -914,7 +902,7 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPM_Write(')');
break;
case 20:
OPV_Convert(l, form, exprPrec);
OPV_Convert(l, n->typ, exprPrec);
break;
case 21:
if (OPV_SideEffects(l)) {
@ -943,7 +931,7 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPM_Write(')');
break;
case 24:
OPM_WriteString((CHAR*)"(LONGINT)(uintptr_t)", (LONGINT)21);
OPM_WriteString((CHAR*)"(LONGINT)(SYSTEM_ADDRESS)", (LONGINT)26);
if (l->class == 1) {
OPC_CompleteIdent(l->obj);
} else {
@ -954,20 +942,16 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
}
break;
case 29:
if ((((__IN(n->typ->form, 0x6240) && __IN(l->typ->form, 0x6240))) && n->typ->size == l->typ->size) || !__IN(l->class, 0x17)) {
if (!__IN(l->class, 0x17) || (((__IN(n->typ->form, 0x6240) && __IN(l->typ->form, 0x6240))) && n->typ->size == l->typ->size)) {
OPM_Write('(');
OPC_Ident(n->typ->strobj);
OPM_Write(')');
if (__IN(n->typ->form, 0x6000) || __IN(l->typ->form, 0x6000)) {
OPM_WriteString((CHAR*)"(uintptr_t)", (LONGINT)12);
OPM_WriteString((CHAR*)"(SYSTEM_ADDRESS)", (LONGINT)17);
}
OPV_expr(l, exprPrec);
} else {
if (__IN(n->typ->form, 0x6000) || __IN(l->typ->form, 0x6000)) {
OPM_WriteString((CHAR*)"__VALP(", (LONGINT)8);
} else {
OPM_WriteString((CHAR*)"__VAL(", (LONGINT)7);
}
OPM_WriteString((CHAR*)"__VAL(", (LONGINT)7);
OPC_Ident(n->typ->strobj);
OPM_WriteString((CHAR*)", ", (LONGINT)3);
OPV_expr(l, -1);
@ -1326,7 +1310,7 @@ static void OPV_NewArr (OPT_Node d, OPT_Node x)
OPM_WriteInt(base->size);
OPM_WriteString((CHAR*)"))", (LONGINT)3);
OPM_WriteString((CHAR*)", ", (LONGINT)3);
OPM_WriteInt(OPC_Base(base));
OPM_WriteInt(OPC_BaseAlignment(base));
OPM_WriteString((CHAR*)", ", (LONGINT)3);
OPM_WriteInt(nofdim);
OPM_WriteString((CHAR*)", ", (LONGINT)3);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPV__h
#define OPV__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
typedef
@ -118,14 +118,14 @@ 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)(uintptr_t)((void*)malloc((size_t)size))
#define Platform_allocate(size) (LONGINT)(SYSTEM_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*)(uintptr_t)address)
#define Platform_free(address) free((void*)(SYSTEM_ADDRESS)address)
#define Platform_fstat(fd) fstat(fd, &s)
#define Platform_fsync(fd) fsync(fd)
#define Platform_ftruncate(fd, l) ftruncate(fd, l)
@ -138,13 +138,13 @@ extern void Heap_InitHeap();
#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*)(uintptr_t)(p), l)
#define Platform_readfile(fd, p, l) read(fd, (void*)(SYSTEM_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, (uintptr_t)h)
#define Platform_sethandler(s, h) SystemSetHandler(s, (SYSTEM_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
@ -161,7 +161,7 @@ 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*)(uintptr_t)(p), l)
#define Platform_writefile(fd, p, l) write(fd, (void*)(SYSTEM_ADDRESS)(p), l)
BOOLEAN Platform_TooManyFiles (INTEGER e)
{
@ -229,7 +229,7 @@ void Platform_Init (INTEGER argc, LONGINT argvadr)
Platform_ArgVecPtr av = NIL;
Platform_MainStackFrame = argvadr;
Platform_ArgCount = argc;
av = (Platform_ArgVecPtr)(uintptr_t)argvadr;
av = (Platform_ArgVecPtr)(SYSTEM_ADDRESS)argvadr;
Platform_ArgVector = (*av)[0];
Platform_HaltCode = -128;
Platform_HeapInitHeap();
@ -262,7 +262,7 @@ void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len)
{
Platform_ArgVec av = NIL;
if (n < Platform_ArgCount) {
av = (Platform_ArgVec)(uintptr_t)Platform_ArgVector;
av = (Platform_ArgVec)(SYSTEM_ADDRESS)Platform_ArgVector;
__COPY(*(*av)[__X(n, ((LONGINT)(1024)))], val, val__len);
}
}
@ -529,7 +529,7 @@ INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n)
INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n)
{
INTEGER _o_result;
*n = Platform_readfile(h, (LONGINT)(uintptr_t)b, b__len);
*n = Platform_readfile(h, (LONGINT)(SYSTEM_ADDRESS)b, b__len);
if (*n < 0) {
*n = 0;
_o_result = Platform_err();
@ -765,7 +765,7 @@ static void Platform_TestLittleEndian (void)
{
INTEGER i;
i = 1;
__GET((LONGINT)(uintptr_t)&i, Platform_LittleEndian, BOOLEAN);
__GET((LONGINT)(SYSTEM_ADDRESS)&i, Platform_LittleEndian, BOOLEAN);
}
__TDESC(Platform_FileIdentity, 1, 0) = {__TDFLDS("FileIdentity", 12), {-4}};

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef Platform__h
#define Platform__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
@ -58,7 +58,7 @@ INTEGER Reals_Expo (REAL x)
{
INTEGER _o_result;
INTEGER i;
__GET((LONGINT)(uintptr_t)&x + 2, i, INTEGER);
__GET((LONGINT)(SYSTEM_ADDRESS)&x + 2, i, INTEGER);
_o_result = __MASK(__ASHR(i, 7), -256);
return _o_result;
}
@ -66,17 +66,17 @@ INTEGER Reals_Expo (REAL x)
void Reals_SetExpo (REAL *x, INTEGER ex)
{
CHAR c;
__GET((LONGINT)(uintptr_t)x + 3, c, CHAR);
__PUT((LONGINT)(uintptr_t)x + 3, (CHAR)(__ASHL(__ASHR((int)c, 7), 7) + __MASK(__ASHR(ex, 1), -128)), CHAR);
__GET((LONGINT)(uintptr_t)x + 2, c, CHAR);
__PUT((LONGINT)(uintptr_t)x + 2, (CHAR)(__MASK((int)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR);
__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);
}
INTEGER Reals_ExpoL (LONGREAL x)
{
INTEGER _o_result;
INTEGER i;
__GET((LONGINT)(uintptr_t)&x + 6, i, INTEGER);
__GET((LONGINT)(SYSTEM_ADDRESS)&x + 6, i, INTEGER);
_o_result = __MASK(__ASHR(i, 4), -2048);
return _o_result;
}
@ -89,8 +89,8 @@ void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len)
}
k = 0;
if (n > 9) {
i = __ENTIER(x / (LONGREAL)(LONGREAL)1000000000);
j = __ENTIER(x - i * (LONGREAL)1000000000);
i = (int)__ENTIER(x / (LONGREAL)(LONGREAL)1000000000);
j = (int)__ENTIER(x - i * (LONGREAL)1000000000);
if (j < 0) {
j = 0;
}
@ -100,9 +100,9 @@ void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len)
k += 1;
}
} else {
i = __ENTIER(x);
i = (int)__ENTIER(x);
}
while (k < (LONGINT)n) {
while (k < (int)n) {
d[__X(k, d__len)] = (CHAR)(__MOD(i, 10) + 48);
i = __DIV(i, 10);
k += 1;
@ -134,7 +134,7 @@ static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LO
CHAR by;
i = 0;
l = b__len;
while ((LONGINT)i < l) {
while ((int)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));

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef Reals__h
#define Reals__h

View file

@ -35,7 +35,7 @@ void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0)
void SYSTEM_ENUMP(void *adr, LONGINT n, void (*P)())
{
while (n > 0) {
P((LONGINT)(uintptr_t)(*((void**)(adr))));
P((LONGINT)(SYSTEM_ADDRESS)(*((void**)(adr))));
adr = ((void**)adr) + 1;
n--;
}
@ -106,7 +106,7 @@ SYSTEM_PTR SYSTEM_NEWARR(LONGINT *typ, LONGINT elemsz, int elemalgn, int nofdim,
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 = (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++;}
@ -119,7 +119,7 @@ SYSTEM_PTR SYSTEM_NEWARR(LONGINT *typ, LONGINT elemsz, int elemalgn, int nofdim,
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 = (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;
@ -155,7 +155,7 @@ typedef void (*SystemSignalHandler)(INTEGER); // = Platform_SignalHandler
// (Ignore other signals)
}
void SystemSetHandler(int s, uintptr_t h) {
void SystemSetHandler(int s, SYSTEM_ADDRESS h) {
if (s >= 2 && s <= 4) {
int needtosetsystemhandler = handler[s-2] == 0;
handler[s-2] = (SystemSignalHandler)h;
@ -194,12 +194,12 @@ typedef void (*SystemSignalHandler)(INTEGER); // = Platform_SignalHandler
}
}
void SystemSetInterruptHandler(uintptr_t h) {
void SystemSetInterruptHandler(SYSTEM_ADDRESS h) {
EnsureConsoleCtrlHandler();
SystemInterruptHandler = (SystemSignalHandler)h;
}
void SystemSetQuitHandler(uintptr_t h) {
void SystemSetQuitHandler(SYSTEM_ADDRESS h) {
EnsureConsoleCtrlHandler();
SystemQuitHandler = (SystemSignalHandler)h;
}

View file

@ -1,28 +1,38 @@
#ifndef SYSTEM__h
#define SYSTEM__h
#ifndef _WIN32
// Building for a Unix/Linux based system
#include <string.h> // For memcpy ...
#include <stdint.h> // For uintptr_t ...
#if defined(_WIN64)
typedef long long SYSTEM_INT64;
typedef unsigned long long SYSTEM_CARD64;
#else
// Building for Windows platform with either mingw under cygwin, or the MS C compiler
#ifdef _WIN64
typedef unsigned long long size_t;
typedef unsigned long long uintptr_t;
#else
typedef unsigned int size_t;
typedef unsigned int uintptr_t;
#endif /* _WIN64 */
typedef unsigned int uint32_t;
void * __cdecl memcpy(void * dest, const void * source, size_t size);
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.
@ -70,6 +80,7 @@ typedef unsigned char U_SHORTINT;
#endif
typedef U_LONGINT SET;
typedef U_LONGINT U_SET;
// OS Memory allocation interfaces are in PlatformXXX.Mod
@ -96,10 +107,10 @@ extern LONGINT SYSTEM_ENTIER (double x);
// Signal handling in SYSTEM.c
#ifndef _WIN32
extern void SystemSetHandler(int s, uintptr_t h);
extern void SystemSetHandler(int s, SYSTEM_ADDRESS h);
#else
extern void SystemSetInterruptHandler(uintptr_t h);
extern void SystemSetQuitHandler (uintptr_t h);
extern void SystemSetInterruptHandler(SYSTEM_ADDRESS h);
extern void SystemSetQuitHandler (SYSTEM_ADDRESS h);
#endif
@ -122,20 +133,20 @@ static int __str_cmp(CHAR *x, CHAR *y){
#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*)(uintptr_t)Platform_OSAllocate(l*sizeof(t)),x,l*sizeof(t))
#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)(uintptr_t)x)
#define __DEL(x) Platform_OSFree((LONGINT)(SYSTEM_ADDRESS)x)
/* SYSTEM ops */
#define __VAL(t, x) ((t)(x))
#define __VALP(t, x) ((t)(uintptr_t)(x))
#define __VAL(t, x) (*(t*)&(x))
#define __GET(a, x, t) x= *(t*)(uintptr_t)(a)
#define __PUT(a, x, t) *(t*)(uintptr_t)(a)=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)))
@ -150,7 +161,7 @@ static int __str_cmp(CHAR *x, CHAR *y){
#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*)(uintptr_t)(d),(char*)(uintptr_t)(s),n)
#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)))
@ -211,7 +222,7 @@ extern void Heap_INCREF();
extern void Platform_Init(INTEGER argc, LONGINT argv);
extern void Heap_FINALL();
#define __INIT(argc, argv) static void *m; Platform_Init((INTEGER)argc, (LONGINT)(uintptr_t)&argv);
#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
@ -232,7 +243,7 @@ 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)(uintptr_t)t##__typ)
#define __NEW(p, t) p = Heap_NEWREC((LONGINT)(SYSTEM_ADDRESS)t##__typ)
#define __NEWARR SYSTEM_NEWARR
@ -263,20 +274,20 @@ extern SYSTEM_PTR SYSTEM_NEWARR(LONGINT*, LONGINT, int, int, int, ...);
#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)(uintptr_t)t##__typ; \
t##__desc.module = (LONGINT)(uintptr_t)m; \
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)(uintptr_t)&t##__desc.next); \
Heap_REGTYP(m, (LONGINT)(SYSTEM_ADDRESS)&t##__desc.next); \
SYSTEM_INHERIT(t##__typ, t0##__typ)
#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(LONGINT)(uintptr_t)typ##__typ)
#define __TYPEOF(p) ((LONGINT*)(uintptr_t)(*(((LONGINT*)(p))-1)))
#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)(uintptr_t)proc
#define __SEND(typ, num, funtyp, parlist) ((funtyp)((uintptr_t)*(typ-(__TPROC0OFF+num))))parlist
#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

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
@ -21,7 +21,7 @@ INTEGER Strings_Length (CHAR *s, LONGINT s__len)
INTEGER i;
__DUP(s, s__len, CHAR);
i = 0;
while (((LONGINT)i < s__len && s[__X(i, s__len)] != 0x00)) {
while (((int)i < s__len && s[__X(i, s__len)] != 0x00)) {
i += 1;
}
_o_result = i;
@ -36,11 +36,11 @@ void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__
n1 = Strings_Length(dest, dest__len);
n2 = Strings_Length(extra, extra__len);
i = 0;
while ((i < n2 && (LONGINT)(i + n1) < dest__len)) {
while ((i < n2 && (int)(i + n1) < dest__len)) {
dest[__X(i + n1, dest__len)] = extra[__X(i, extra__len)];
i += 1;
}
if ((LONGINT)(i + n1) < dest__len) {
if ((int)(i + n1) < dest__len) {
dest[__X(i + n1, dest__len)] = 0x00;
}
__DEL(extra);
@ -59,10 +59,10 @@ void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest,
Strings_Append(dest, dest__len, (void*)source, source__len);
return;
}
if ((LONGINT)(pos + n2) < dest__len) {
if ((int)(pos + n2) < dest__len) {
i = n1;
while (i >= pos) {
if ((LONGINT)(i + n2) < dest__len) {
if ((int)(i + n2) < dest__len) {
dest[__X(i + n2, dest__len)] = dest[__X(i, dest__len)];
}
i -= 1;
@ -91,7 +91,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 ((LONGINT)(i - n) < s__len) {
if ((int)(i - n) < s__len) {
s[__X(i - n, s__len)] = 0x00;
}
} else {
@ -121,7 +121,7 @@ void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n,
return;
}
i = 0;
while (((((LONGINT)(pos + i) <= source__len && source[__X(pos + i, source__len)] != 0x00)) && i < n)) {
while (((((int)(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)];
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef Strings__h
#define Strings__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
#include "Files.h"
#include "Modules.h"
@ -787,9 +787,9 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
(*S).s[__X(i, ((LONGINT)(64)))] = 0x00;
(*S).len = i;
(*S).class = 1;
} else if (ch == '\"') {
} else if (ch == '"') {
Texts_Read((void*)&*S, S__typ, &ch);
while ((((ch != '\"' && ch >= ' ')) && i != 63)) {
while ((((ch != '"' && ch >= ' ')) && i != 63)) {
(*S).s[__X(i, ((LONGINT)(64)))] = ch;
i += 1;
Texts_Read((void*)&*S, S__typ, &ch);
@ -839,7 +839,7 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
k -= 16;
}
while (j < i) {
k = __ASHL(k, 4) + (LONGINT)((int)d[__X(j, ((LONGINT)(32)))] - 48);
k = __ASHL(k, 4) + (int)((int)d[__X(j, ((LONGINT)(32)))] - 48);
j += 1;
}
if (neg) {
@ -929,7 +929,7 @@ void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ)
(*S).class = 3;
k = 0;
do {
k = k * 10 + (LONGINT)((int)d[__X(j, ((LONGINT)(32)))] - 48);
k = k * 10 + (int)((int)d[__X(j, ((LONGINT)(32)))] - 48);
j += 1;
} while (!(j == i));
if (neg) {
@ -1067,7 +1067,7 @@ void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n)
x0 = __DIV(x0, 10);
i += 1;
} while (!(x0 == 0));
while (n > (LONGINT)i) {
while (n > (int)i) {
Texts_Write(&*W, W__typ, ' ');
n -= 1;
}
@ -1319,7 +1319,7 @@ void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER
} else {
Texts_Write(&*W, W__typ, ' ');
}
e = (int)__ASHR((LONGINT)(e - 1023) * 77, 8);
e = (int)__ASHR((int)(e - 1023) * 77, 8);
if (e >= 0) {
x = x / (LONGREAL)Reals_TenL(e);
} else {

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef Texts__h
#define Texts__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkamSf */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkamSf */
#include "SYSTEM.h"
#include "Configuration.h"
#include "Heap.h"

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
typedef
@ -25,7 +25,7 @@ export void *errors__init(void)
errors_errors[6][0] = 0x00;
errors_errors[7][0] = 0x00;
errors_errors[8][0] = 0x00;
__MOVE("\'=\' expected", errors_errors[9], 13);
__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);
@ -34,28 +34,28 @@ export void *errors__init(void)
__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);
__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("')' 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);
__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);
__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);
__MOVE("';' missing", errors_errors[39], 12);
errors_errors[40][0] = 0x00;
__MOVE("END missing", errors_errors[41], 12);
errors_errors[42][0] = 0x00;
@ -131,10 +131,10 @@ export void *errors__init(void)
__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("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);
@ -194,5 +194,6 @@ export void *errors__init(void)
__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;
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef errors__h
#define errors__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
#include "Configuration.h"
#include "Console.h"

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef extTools__h
#define extTools__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h"
#include "Console.h"
#include "Strings.h"
@ -252,7 +252,7 @@ export void *vt100__init(void)
__REGCMD("RCP", vt100_RCP);
__REGCMD("SCP", vt100_SCP);
/* BEGIN */
__COPY("", vt100_CSI, ((LONGINT)(5)));
__COPY("\033", vt100_CSI, ((LONGINT)(5)));
Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5)));
__ENDMOD;
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef vt100__h
#define vt100__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#define LARGE
#include "SYSTEM.h"
@ -14,6 +14,6 @@ export void *Configuration__init(void)
__DEFMOD;
__REGMOD("Configuration", 0);
/* BEGIN */
__MOVE("1.95 [2016/08/24] for gcc LP64 on cygwin", Configuration_versionLong, 41);
__MOVE("1.95 [2016/08/23] for gcc LP64 on cygwin", Configuration_versionLong, 41);
__ENDMOD;
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef Configuration__h
#define Configuration__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#define LARGE
#include "SYSTEM.h"
#include "Platform.h"
@ -22,7 +22,7 @@ export void Console_String (CHAR *s, LONGINT s__len);
void Console_Flush (void)
{
INTEGER error;
error = Platform_Write(((LONGINT)(1)), (LONGINT)(uintptr_t)Console_line, Console_pos);
error = Platform_Write(((LONGINT)(1)), (LONGINT)(SYSTEM_ADDRESS)Console_line, Console_pos);
Console_pos = 0;
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef Console__h
#define Console__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin tspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
#define LARGE
#include "SYSTEM.h"
#include "Configuration.h"
@ -258,7 +258,7 @@ static void Files_Flush (Files_Buffer buf)
if (buf->org != f->pos) {
error = Platform_Seek(f->fd, buf->org, Platform_SeekSet);
}
error = Platform_Write(f->fd, (LONGINT)(uintptr_t)buf->data, buf->size);
error = Platform_Write(f->fd, (LONGINT)(SYSTEM_ADDRESS)buf->data, buf->size);
if (error != 0) {
Files_Err((CHAR*)"error writing file", (LONGINT)19, f, error);
}
@ -657,7 +657,7 @@ void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x
} else {
min = n;
}
__MOVE((LONGINT)(uintptr_t)buf->data + offset, (LONGINT)(uintptr_t)x + xpos, min);
__MOVE((LONGINT)(SYSTEM_ADDRESS)buf->data + offset, (LONGINT)(SYSTEM_ADDRESS)x + xpos, min);
offset += min;
(*r).offset = offset;
xpos += min;
@ -722,7 +722,7 @@ void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT
} else {
min = n;
}
__MOVE((LONGINT)(uintptr_t)x + xpos, (LONGINT)(uintptr_t)buf->data + offset, min);
__MOVE((LONGINT)(SYSTEM_ADDRESS)x + xpos, (LONGINT)(SYSTEM_ADDRESS)buf->data + offset, min);
offset += min;
(*r).offset = offset;
if (offset > buf->size) {
@ -773,15 +773,15 @@ void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT
*res = 3;
return;
}
error = Platform_Read(fdold, (LONGINT)(uintptr_t)buf, ((LONGINT)(4096)), &n);
error = Platform_Read(fdold, (LONGINT)(SYSTEM_ADDRESS)buf, ((LONGINT)(4096)), &n);
while (n > 0) {
error = Platform_Write(fdnew, (LONGINT)(uintptr_t)buf, n);
error = Platform_Write(fdnew, (LONGINT)(SYSTEM_ADDRESS)buf, n);
if (error != 0) {
ignore = Platform_Close(fdold);
ignore = Platform_Close(fdnew);
Files_Err((CHAR*)"cannot move file", (LONGINT)17, NIL, error);
}
error = Platform_Read(fdold, (LONGINT)(uintptr_t)buf, ((LONGINT)(4096)), &n);
error = Platform_Read(fdold, (LONGINT)(SYSTEM_ADDRESS)buf, ((LONGINT)(4096)), &n);
}
ignore = Platform_Close(fdold);
ignore = Platform_Close(fdnew);
@ -839,7 +839,7 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *de
j += 1;
}
} else {
__MOVE((LONGINT)(uintptr_t)src, (LONGINT)(uintptr_t)dest, src__len);
__MOVE((LONGINT)(SYSTEM_ADDRESS)src, (LONGINT)(SYSTEM_ADDRESS)dest, src__len);
}
}
@ -865,8 +865,10 @@ void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x)
void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x)
{
CHAR b[4];
LONGINT l;
Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4)));
*x = (SET)((((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((int)b[2], 16)) + __ASHL((int)b[3], 24));
l = (((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((int)b[2], 16)) + __ASHL((int)b[3], 24);
*x = (SET)l;
}
void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x)
@ -922,11 +924,11 @@ void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x)
n = 0;
Files_Read(&*R, R__typ, (void*)&ch);
while ((int)ch >= 128) {
n += __ASH((LONGINT)((int)ch - 128), s);
n += __ASH((SYSTEM_INT64)((int)ch - 128), s);
s += 7;
Files_Read(&*R, R__typ, (void*)&ch);
}
n += __ASH((LONGINT)(__MASK((int)ch, -64) - __ASHL(__ASHR((int)ch, 6), 6)), s);
n += __ASH((SYSTEM_INT64)(__MASK((int)ch, -64) - __ASHL(__ASHR((int)ch, 6), 6)), s);
*x = n;
}
@ -1007,7 +1009,7 @@ static void Files_Finalize (SYSTEM_PTR o)
{
Files_File f = NIL;
LONGINT res;
f = (Files_File)(uintptr_t)o;
f = (Files_File)(SYSTEM_ADDRESS)o;
if (f->fd >= 0) {
Files_CloseOSFile(f);
if (f->tempFile) {

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin tspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tspkaSfF */
#ifndef Files__h
#define Files__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin tskSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tskSfF */
#define LARGE
#include "SYSTEM.h"
@ -102,7 +102,7 @@ export void Heap_Unlock (void);
extern void *Heap__init();
extern LONGINT Platform_MainStackFrame;
extern LONGINT Platform_OSAllocate(LONGINT size);
#define Heap_FetchAddress(pointer) (LONGINT)(uintptr_t)(*((void**)((uintptr_t)pointer)))
#define Heap_FetchAddress(pointer) (LONGINT)(SYSTEM_ADDRESS)(*((void**)((SYSTEM_ADDRESS)pointer)))
#define Heap_HeapModuleInit() Heap__init()
#define Heap_OSAllocate(size) Platform_OSAllocate(size)
#define Heap_PlatformHalt(code) Platform_Halt(code)
@ -135,7 +135,7 @@ SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs)
__COPY(name, m->name, ((LONGINT)(20)));
m->refcnt = 0;
m->enumPtrs = enumPtrs;
m->next = (Heap_Module)(uintptr_t)Heap_modules;
m->next = (Heap_Module)(SYSTEM_ADDRESS)Heap_modules;
Heap_modules = (SYSTEM_PTR)m;
_o_result = (void*)m;
return _o_result;
@ -316,7 +316,7 @@ SYSTEM_PTR Heap_NEWREC (LONGINT tag)
__PUT(adr + 16, 0, LONGINT);
Heap_allocated += blksz;
Heap_Unlock();
_o_result = (SYSTEM_PTR)(uintptr_t)(adr + 8);
_o_result = (SYSTEM_PTR)(SYSTEM_ADDRESS)(adr + 8);
return _o_result;
}
@ -327,12 +327,12 @@ SYSTEM_PTR Heap_NEWBLK (LONGINT size)
SYSTEM_PTR new;
Heap_Lock();
blksz = __ASHL(__ASHR(size + 63, 5), 5);
new = Heap_NEWREC((LONGINT)(uintptr_t)&blksz);
tag = ((LONGINT)(uintptr_t)new + blksz) - 24;
new = Heap_NEWREC((LONGINT)(SYSTEM_ADDRESS)&blksz);
tag = ((LONGINT)(SYSTEM_ADDRESS)new + blksz) - 24;
__PUT(tag - 8, 0, LONGINT);
__PUT(tag, blksz, LONGINT);
__PUT(tag + 8, -8, LONGINT);
__PUT((LONGINT)(uintptr_t)new - 8, tag, LONGINT);
__PUT((LONGINT)(SYSTEM_ADDRESS)new - 8, tag, LONGINT);
Heap_Unlock();
_o_result = new;
return _o_result;
@ -361,7 +361,7 @@ static void Heap_Mark (LONGINT q)
__GET(tag, offset, LONGINT);
fld = q + offset;
p = Heap_FetchAddress(fld);
__PUT(fld, (SYSTEM_PTR)(uintptr_t)n, SYSTEM_PTR);
__PUT(fld, (SYSTEM_PTR)(SYSTEM_ADDRESS)n, SYSTEM_PTR);
} else {
fld = q + offset;
n = Heap_FetchAddress(fld);
@ -370,7 +370,7 @@ static void Heap_Mark (LONGINT q)
if (!__ODD(tagbits)) {
__PUT(n - 8, tagbits + 1, LONGINT);
__PUT(q - 8, tag + 1, LONGINT);
__PUT(fld, (SYSTEM_PTR)(uintptr_t)p, SYSTEM_PTR);
__PUT(fld, (SYSTEM_PTR)(SYSTEM_ADDRESS)p, SYSTEM_PTR);
p = q;
q = n;
tag = tagbits;
@ -385,7 +385,7 @@ static void Heap_Mark (LONGINT q)
static void Heap_MarkP (SYSTEM_PTR p)
{
Heap_Mark((LONGINT)(uintptr_t)p);
Heap_Mark((LONGINT)(SYSTEM_ADDRESS)p);
}
static void Heap_Scan (void)
@ -554,7 +554,7 @@ static void Heap_Finalize (void)
} else {
prev->next = n->next;
}
(*n->finalize)((SYSTEM_PTR)(uintptr_t)n->obj);
(*n->finalize)((SYSTEM_PTR)(SYSTEM_ADDRESS)n->obj);
if (prev == NIL) {
n = Heap_fin;
} else {
@ -573,7 +573,7 @@ void Heap_FINALL (void)
while (Heap_fin != NIL) {
n = Heap_fin;
Heap_fin = Heap_fin->next;
(*n->finalize)((SYSTEM_PTR)(uintptr_t)n->obj);
(*n->finalize)((SYSTEM_PTR)(SYSTEM_ADDRESS)n->obj);
}
}
@ -590,9 +590,9 @@ static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len)
}
if (n == 0) {
nofcand = 0;
sp = (LONGINT)(uintptr_t)&frame;
sp = (LONGINT)(SYSTEM_ADDRESS)&frame;
stack0 = Heap_PlatformMainStackFrame();
inc = (LONGINT)(uintptr_t)&align.p - (LONGINT)(uintptr_t)&align;
inc = (LONGINT)(SYSTEM_ADDRESS)&align.p - (LONGINT)(SYSTEM_ADDRESS)&align;
if (sp > stack0) {
inc = -inc;
}
@ -623,7 +623,7 @@ void Heap_GC (BOOLEAN markStack)
LONGINT cand[10000];
if (Heap_lockdepth == 0 || (Heap_lockdepth == 1 && !markStack)) {
Heap_Lock();
m = (Heap_Module)(uintptr_t)Heap_modules;
m = (Heap_Module)(SYSTEM_ADDRESS)Heap_modules;
while (m != NIL) {
if (m->enumPtrs != NIL) {
(*m->enumPtrs)(Heap_MarkP);
@ -700,7 +700,7 @@ void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
{
Heap_FinNode f;
__NEW(f, Heap_FinDesc);
f->obj = (LONGINT)(uintptr_t)obj;
f->obj = (LONGINT)(SYSTEM_ADDRESS)obj;
f->finalize = finalize;
f->marked = 1;
f->next = Heap_fin;

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin tskSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin tskSfF */
#ifndef Heap__h
#define Heap__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#define LARGE
#include "SYSTEM.h"
#include "Console.h"

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef Modules__h
#define Modules__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#define LARGE
#include "SYSTEM.h"
#include "OPM.h"
@ -35,7 +35,9 @@ export void OPB_In (OPT_Node *x, OPT_Node y);
export void OPB_Index (OPT_Node *x, OPT_Node y);
export void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ);
static BOOLEAN OPB_IntToBool (LONGINT i);
static OPT_Struct OPB_IntType (LONGINT size);
export void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y);
static LONGINT OPB_LongerSize (LONGINT i);
export void OPB_MOp (SHORTINT op, OPT_Node *x);
export OPT_Node OPB_NewBoolConst (BOOLEAN boolval);
export OPT_Node OPB_NewIntConst (LONGINT intval);
@ -52,6 +54,8 @@ export void OPB_Return (OPT_Node *x, OPT_Object proc);
export void OPB_SetElem (OPT_Node *x);
static void OPB_SetIntType (OPT_Node node);
export void OPB_SetRange (OPT_Node *x, OPT_Node y);
static LONGINT OPB_ShorterSize (LONGINT i);
static INTEGER OPB_SignedByteSize (LONGINT n);
export void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno);
export void OPB_StPar0 (OPT_Node *par0, INTEGER fctno);
export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno);
@ -91,8 +95,8 @@ OPT_Node OPB_NewLeaf (OPT_Object obj)
node = OPT_NewNode(9);
break;
default:
OPB_err(127);
node = OPT_NewNode(0);
OPB_err(127);
break;
}
node->obj = obj;
@ -221,21 +225,68 @@ OPT_Node OPB_EmptySet (void)
return _o_result;
}
static INTEGER OPB_SignedByteSize (LONGINT n)
{
INTEGER _o_result;
INTEGER b;
if (n < 0) {
n = -(n + 1);
}
b = 1;
while ((b < 8 && __ASH(n, -(__ASHL(b, 3) - 1)) != 0)) {
b += 1;
}
_o_result = b;
return _o_result;
}
static LONGINT OPB_ShorterSize (LONGINT i)
{
LONGINT _o_result;
if (i >= (SYSTEM_INT64)OPM_LIntSize) {
_o_result = OPM_IntSize;
return _o_result;
} else {
_o_result = OPM_SIntSize;
return _o_result;
}
__RETCHK;
}
static LONGINT OPB_LongerSize (LONGINT i)
{
LONGINT _o_result;
if (i <= (SYSTEM_INT64)OPM_SIntSize) {
_o_result = OPM_IntSize;
return _o_result;
} else {
_o_result = OPM_LIntSize;
return _o_result;
}
__RETCHK;
}
static OPT_Struct OPB_IntType (LONGINT size)
{
OPT_Struct _o_result;
OPT_Struct result = NIL;
if (size <= OPT_sinttyp->size) {
result = OPT_sinttyp;
} else if (size <= OPT_inttyp->size) {
result = OPT_inttyp;
} else {
result = OPT_linttyp;
}
if (size > OPT_linttyp->size) {
OPB_err(203);
}
_o_result = result;
return _o_result;
}
static void OPB_SetIntType (OPT_Node node)
{
LONGINT v;
v = node->conval->intval;
if ((OPM_MinSInt <= (LONGINT)v && (LONGINT)v <= OPM_MaxSInt)) {
node->typ = OPT_sinttyp;
} else if ((OPM_MinInt <= (LONGINT)v && (LONGINT)v <= OPM_MaxInt)) {
node->typ = OPT_inttyp;
} else if ((OPM_MinLInt <= v && v <= OPM_MaxLInt)) {
node->typ = OPT_linttyp;
} else {
OPB_err(203);
node->typ = OPT_sinttyp;
node->conval->intval = 1;
}
node->typ = OPB_IntType(OPB_SignedByteSize(node->conval->intval));
}
OPT_Node OPB_NewIntConst (LONGINT intval)
@ -379,16 +430,16 @@ void OPB_Field (OPT_Node *x, OPT_Object y)
}
}
static struct TypTest__57 {
static struct TypTest__61 {
OPT_Node *x;
OPT_Object *obj;
BOOLEAN *guard;
struct TypTest__57 *lnk;
} *TypTest__57_s;
struct TypTest__61 *lnk;
} *TypTest__61_s;
static void GTT__58 (OPT_Struct t0, OPT_Struct t1);
static void GTT__62 (OPT_Struct t0, OPT_Struct t1);
static void GTT__58 (OPT_Struct t0, OPT_Struct t1)
static void GTT__62 (OPT_Struct t0, OPT_Struct t1)
{
OPT_Node node = NIL;
OPT_Struct t = NIL;
@ -401,54 +452,54 @@ static void GTT__58 (OPT_Struct t0, OPT_Struct t1)
t1 = t1->BaseTyp;
}
if (t1 == t0 || t0->form == 0) {
if (*TypTest__57_s->guard) {
OPB_BindNodes(5, NIL, &*TypTest__57_s->x, NIL);
(*TypTest__57_s->x)->readonly = (*TypTest__57_s->x)->left->readonly;
if (*TypTest__61_s->guard) {
OPB_BindNodes(5, NIL, &*TypTest__61_s->x, NIL);
(*TypTest__61_s->x)->readonly = (*TypTest__61_s->x)->left->readonly;
} else {
node = OPT_NewNode(11);
node->subcl = 16;
node->left = *TypTest__57_s->x;
node->obj = *TypTest__57_s->obj;
*TypTest__57_s->x = node;
node->left = *TypTest__61_s->x;
node->obj = *TypTest__61_s->obj;
*TypTest__61_s->x = node;
}
} else {
OPB_err(85);
}
} else if (t0 != t1) {
OPB_err(85);
} else if (!*TypTest__57_s->guard) {
if ((*TypTest__57_s->x)->class == 5) {
} else if (!*TypTest__61_s->guard) {
if ((*TypTest__61_s->x)->class == 5) {
node = OPT_NewNode(11);
node->subcl = 16;
node->left = *TypTest__57_s->x;
node->obj = *TypTest__57_s->obj;
*TypTest__57_s->x = node;
node->left = *TypTest__61_s->x;
node->obj = *TypTest__61_s->obj;
*TypTest__61_s->x = node;
} else {
*TypTest__57_s->x = OPB_NewBoolConst(1);
*TypTest__61_s->x = OPB_NewBoolConst(1);
}
}
}
void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
{
struct TypTest__57 _s;
struct TypTest__61 _s;
_s.x = x;
_s.obj = &obj;
_s.guard = &guard;
_s.lnk = TypTest__57_s;
TypTest__57_s = &_s;
_s.lnk = TypTest__61_s;
TypTest__61_s = &_s;
if (OPB_NotVar(*x)) {
OPB_err(112);
} else if ((*x)->typ->form == 13) {
if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) {
OPB_err(85);
} else if (obj->typ->form == 13) {
GTT__58((*x)->typ->BaseTyp, obj->typ->BaseTyp);
GTT__62((*x)->typ->BaseTyp, obj->typ->BaseTyp);
} else {
OPB_err(86);
}
} else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) {
GTT__58((*x)->typ, obj->typ);
GTT__62((*x)->typ, obj->typ);
} else {
OPB_err(87);
}
@ -457,7 +508,7 @@ void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
} else {
(*x)->typ = OPT_booltyp;
}
TypTest__57_s = _s.lnk;
TypTest__61_s = _s.lnk;
}
void OPB_In (OPT_Node *x, OPT_Node y)
@ -470,7 +521,7 @@ void OPB_In (OPT_Node *x, OPT_Node y)
} else if ((__IN(f, 0x70) && y->typ->form == 9)) {
if ((*x)->class == 7) {
k = (*x)->conval->intval;
if (k < 0 || k > (LONGINT)OPM_MaxSet) {
if (k < 0 || k > (SYSTEM_INT64)OPM_MaxSet) {
OPB_err(202);
} else if (y->class == 7) {
(*x)->conval->intval = OPB_BoolToInt(__IN(k, y->conval->setval));
@ -523,13 +574,13 @@ static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x)
x->intval = -1;
}
static struct MOp__28 {
struct MOp__28 *lnk;
} *MOp__28_s;
static struct MOp__30 {
struct MOp__30 *lnk;
} *MOp__30_s;
static OPT_Node NewOp__29 (SHORTINT op, OPT_Struct typ, OPT_Node z);
static OPT_Node NewOp__31 (SHORTINT op, OPT_Struct typ, OPT_Node z);
static OPT_Node NewOp__29 (SHORTINT op, OPT_Struct typ, OPT_Node z)
static OPT_Node NewOp__31 (SHORTINT op, OPT_Struct typ, OPT_Node z)
{
OPT_Node _o_result;
OPT_Node node = NIL;
@ -546,9 +597,9 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
INTEGER f;
OPT_Struct typ = NIL;
OPT_Node z = NIL;
struct MOp__28 _s;
_s.lnk = MOp__28_s;
MOp__28_s = &_s;
struct MOp__30 _s;
_s.lnk = MOp__30_s;
MOp__30_s = &_s;
z = *x;
if (z->class == 8 || z->class == 9) {
OPB_err(126);
@ -562,7 +613,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval));
z->obj = NIL;
} else {
z = NewOp__29(op, typ, z);
z = NewOp__31(op, typ, z);
}
} else {
OPB_err(98);
@ -590,7 +641,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
}
z->obj = NIL;
} else {
z = NewOp__29(op, typ, z);
z = NewOp__31(op, typ, z);
}
} else {
OPB_err(97);
@ -611,7 +662,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
}
z->obj = NIL;
} else {
z = NewOp__29(op, typ, z);
z = NewOp__31(op, typ, z);
}
} else {
OPB_err(111);
@ -623,7 +674,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->conval->intval = (int)__CAP((CHAR)z->conval->intval);
z->obj = NIL;
} else {
z = NewOp__29(op, typ, z);
z = NewOp__31(op, typ, z);
}
} else {
OPB_err(111);
@ -636,7 +687,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval));
z->obj = NIL;
} else {
z = NewOp__29(op, typ, z);
z = NewOp__31(op, typ, z);
}
} else {
OPB_err(111);
@ -649,7 +700,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
f = 10;
}
if (z->class < 7 || f == 10) {
z = NewOp__29(op, typ, z);
z = NewOp__31(op, typ, z);
} else {
OPB_err(127);
}
@ -658,7 +709,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
case 25:
if ((__IN(f, 0x70) && z->class == 7)) {
if ((0 <= z->conval->intval && z->conval->intval <= -1)) {
z = NewOp__29(op, typ, z);
z = NewOp__31(op, typ, z);
} else {
OPB_err(219);
}
@ -675,7 +726,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
}
}
*x = z;
MOp__28_s = _s.lnk;
MOp__30_s = _s.lnk;
}
static void OPB_CheckPtr (OPT_Node x, OPT_Node y)
@ -866,41 +917,13 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
case 4:
case 4: case 5: case 6:
if (__IN(g, 0x70)) {
x->typ = y->typ;
} else if (g == 7) {
x->typ = OPT_realtyp;
xval->realval = xval->intval;
} else if (g == 8) {
x->typ = OPT_lrltyp;
xval->realval = xval->intval;
} else {
OPB_err(100);
y->typ = x->typ;
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
case 5:
if (g == 4) {
y->typ = OPT_inttyp;
} else if (__IN(g, 0x70)) {
x->typ = y->typ;
} else if (g == 7) {
x->typ = OPT_realtyp;
xval->realval = xval->intval;
} else if (g == 8) {
x->typ = OPT_lrltyp;
xval->realval = xval->intval;
} else {
OPB_err(100);
y->typ = x->typ;
__GUARDEQP(yval, OPT_ConstDesc) = *xval;
}
break;
case 6:
if (__IN(g, 0x70)) {
y->typ = OPT_linttyp;
if (x->typ->size <= y->typ->size) {
x->typ = y->typ;
} else {
x->typ = OPB_IntType(x->typ->size);
}
} else if (g == 7) {
x->typ = OPT_realtyp;
xval->realval = xval->intval;
@ -1197,15 +1220,15 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
(*x)->typ = typ;
}
static struct Op__38 {
static struct Op__40 {
INTEGER *f, *g;
struct Op__38 *lnk;
} *Op__38_s;
struct Op__40 *lnk;
} *Op__40_s;
static void NewOp__39 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y);
static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y);
static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y);
static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y);
static void NewOp__39 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
{
OPT_Node node = NIL;
node = OPT_NewNode(12);
@ -1216,29 +1239,29 @@ static void NewOp__39 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
*x = node;
}
static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y)
static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y)
{
BOOLEAN _o_result;
BOOLEAN ok, xCharArr, yCharArr;
xCharArr = (__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp->form == 3) || *Op__38_s->f == 10;
yCharArr = (__IN((*y)->typ->comp, 0x0c) && (*y)->typ->BaseTyp->form == 3) || *Op__38_s->g == 10;
if ((((xCharArr && *Op__38_s->g == 3)) && (*y)->class == 7)) {
xCharArr = (__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp->form == 3) || *Op__40_s->f == 10;
yCharArr = (__IN((*y)->typ->comp, 0x0c) && (*y)->typ->BaseTyp->form == 3) || *Op__40_s->g == 10;
if ((((xCharArr && *Op__40_s->g == 3)) && (*y)->class == 7)) {
OPB_CharToString(*y);
*Op__38_s->g = 10;
*Op__40_s->g = 10;
yCharArr = 1;
}
if ((((yCharArr && *Op__38_s->f == 3)) && (*x)->class == 7)) {
if ((((yCharArr && *Op__40_s->f == 3)) && (*x)->class == 7)) {
OPB_CharToString(*x);
*Op__38_s->f = 10;
*Op__40_s->f = 10;
xCharArr = 1;
}
ok = (xCharArr && yCharArr);
if (ok) {
if ((*Op__38_s->f == 10 && (*x)->conval->intval2 == 1)) {
if ((*Op__40_s->f == 10 && (*x)->conval->intval2 == 1)) {
(*x)->typ = OPT_chartyp;
(*x)->conval->intval = 0;
OPB_Index(&*y, OPB_NewIntConst(((LONGINT)(0))));
} else if ((*Op__38_s->g == 10 && (*y)->conval->intval2 == 1)) {
} else if ((*Op__40_s->g == 10 && (*y)->conval->intval2 == 1)) {
(*y)->typ = OPT_chartyp;
(*y)->conval->intval = 0;
OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0))));
@ -1255,11 +1278,11 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPT_Struct typ = NIL;
BOOLEAN do_;
LONGINT val;
struct Op__38 _s;
struct Op__40 _s;
_s.f = &f;
_s.g = &g;
_s.lnk = Op__38_s;
Op__38_s = &_s;
_s.lnk = Op__40_s;
Op__40_s = &_s;
z = *x;
if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) {
OPB_err(126);
@ -1277,15 +1300,8 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(100);
}
break;
case 4:
if (__IN(g, 0x01f0)) {
OPB_Convert(&z, y->typ);
} else {
OPB_err(100);
}
break;
case 5:
if (g == 4) {
case 4: case 5: case 6:
if ((__IN(g, 0x70) && y->typ->size < z->typ->size)) {
OPB_Convert(&y, z->typ);
} else if (__IN(g, 0x01f0)) {
OPB_Convert(&z, y->typ);
@ -1293,15 +1309,6 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(100);
}
break;
case 6:
if (__IN(g, 0x70)) {
OPB_Convert(&y, z->typ);
} else if (__IN(g, 0x0180)) {
OPB_Convert(&z, y->typ);
} else {
OPB_err(100);
}
break;
case 7:
if (__IN(g, 0x70)) {
OPB_Convert(&y, z->typ);
@ -1387,7 +1394,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp;
}
if (do_) {
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
}
break;
case 2:
@ -1406,7 +1413,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(102);
typ = OPT_undftyp;
}
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
break;
case 3:
do_ = 1;
@ -1429,7 +1436,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp;
}
if (do_) {
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
}
break;
case 4:
@ -1447,7 +1454,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(104);
typ = OPT_undftyp;
}
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
break;
case 5:
if (f == 2) {
@ -1457,7 +1464,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
} else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) {
} else {
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
}
} else if (f != 0) {
OPB_err(94);
@ -1480,7 +1487,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
}
if (do_) {
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
}
break;
case 7:
@ -1489,7 +1496,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp;
}
if ((!__IN(f, 0x70) || y->class != 7) || y->conval->intval != 0) {
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
}
break;
case 8:
@ -1500,7 +1507,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
} else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) {
} else {
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
}
} else if (f != 0) {
OPB_err(95);
@ -1508,16 +1515,16 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
break;
case 9: case 10:
if (__IN(f, 0x6bff) || strings__41(&z, &y)) {
if (__IN(f, 0x6bff) || strings__43(&z, &y)) {
typ = OPT_booltyp;
} else {
OPB_err(107);
typ = OPT_undftyp;
}
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
break;
case 11: case 12: case 13: case 14:
if (__IN(f, 0x01f9) || strings__41(&z, &y)) {
if (__IN(f, 0x01f9) || strings__43(&z, &y)) {
typ = OPT_booltyp;
} else {
OPM_LogWLn();
@ -1526,7 +1533,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(108);
typ = OPT_undftyp;
}
NewOp__39(op, typ, &z, y);
NewOp__41(op, typ, &z, y);
break;
default:
OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", (LONGINT)32);
@ -1536,7 +1543,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
}
*x = z;
Op__38_s = _s.lnk;
Op__40_s = _s.lnk;
}
void OPB_SetRange (OPT_Node *x, OPT_Node y)
@ -1547,13 +1554,13 @@ void OPB_SetRange (OPT_Node *x, OPT_Node y)
} else if ((__IN((*x)->typ->form, 0x70) && __IN(y->typ->form, 0x70))) {
if ((*x)->class == 7) {
k = (*x)->conval->intval;
if (0 > k || k > (LONGINT)OPM_MaxSet) {
if (0 > k || k > (SYSTEM_INT64)OPM_MaxSet) {
OPB_err(202);
}
}
if (y->class == 7) {
l = y->conval->intval;
if (0 > l || l > (LONGINT)OPM_MaxSet) {
if (0 > l || l > (SYSTEM_INT64)OPM_MaxSet) {
OPB_err(202);
}
}
@ -1583,7 +1590,7 @@ void OPB_SetElem (OPT_Node *x)
OPB_err(93);
} else if ((*x)->class == 7) {
k = (*x)->conval->intval;
if ((0 <= k && k <= (LONGINT)OPM_MaxSet)) {
if ((0 <= k && k <= (SYSTEM_INT64)OPM_MaxSet)) {
(*x)->conval->setval = __SETOF(k);
} else {
OPB_err(202);
@ -1597,8 +1604,9 @@ void OPB_SetElem (OPT_Node *x)
static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
{
OPT_Struct y = NIL;
INTEGER f, g;
OPT_Struct y = NIL, p = NIL, q = NIL;
OPT_Struct p = NIL, q = NIL;
if (OPM_Verbose) {
OPM_LogWLn();
OPM_LogWStr((CHAR*)"PROCEDURE CheckAssign", (LONGINT)22);
@ -1628,31 +1636,20 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
case 0: case 10:
break;
case 1:
if (!__IN(g, 0x1a)) {
if (!((__IN(g, 0x7a) && y->size == 1))) {
OPB_err(113);
}
break;
case 2: case 3: case 4: case 9:
case 2: case 3: case 9:
if (g != f) {
OPB_err(113);
}
break;
case 5:
if (!__IN(g, 0x30)) {
case 4: case 5: case 6:
if (!__IN(g, 0x70) || x->size < y->size) {
OPB_err(113);
}
break;
case 6:
if (OPM_LIntSize == 4) {
if (!__IN(g, 0x70)) {
OPB_err(113);
}
} else {
if (!__IN(g, 0x70)) {
OPB_err(113);
}
}
break;
case 7:
if (!__IN(g, 0xf0)) {
OPB_err(113);
@ -1833,14 +1830,8 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
x = OPB_NewIntConst(((LONGINT)(0)));
x->typ = OPT_chartyp;
break;
case 4:
x = OPB_NewIntConst(OPM_MinSInt);
break;
case 5:
x = OPB_NewIntConst(OPM_MinInt);
break;
case 6:
x = OPB_NewIntConst(OPM_MinLInt);
case 4: case 5: case 6:
x = OPB_NewIntConst(OPM_SignedMinimum(x->typ->size));
break;
case 9:
x = OPB_NewIntConst(((LONGINT)(0)));
@ -1870,14 +1861,8 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
x = OPB_NewIntConst(((LONGINT)(255)));
x->typ = OPT_chartyp;
break;
case 4:
x = OPB_NewIntConst(OPM_MaxSInt);
break;
case 5:
x = OPB_NewIntConst(OPM_MaxInt);
break;
case 6:
x = OPB_NewIntConst(OPM_MaxLInt);
case 4: case 5: case 6:
x = OPB_NewIntConst(OPM_SignedMaximum(x->typ->size));
break;
case 9:
x = OPB_NewIntConst(OPM_MaxSet);
@ -1910,10 +1895,8 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 10:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if (f == 5) {
OPB_Convert(&x, OPT_sinttyp);
} else if (f == 6) {
OPB_Convert(&x, OPT_inttyp);
} else if ((__IN(f, 0x70) && x->typ->size > (SYSTEM_INT64)OPM_SIntSize)) {
OPB_Convert(&x, OPB_IntType(OPB_ShorterSize(x->typ->size)));
} else if (f == 8) {
OPB_Convert(&x, OPT_realtyp);
} else {
@ -1923,10 +1906,8 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 11:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if (f == 4) {
OPB_Convert(&x, OPT_inttyp);
} else if (f == 5) {
OPB_Convert(&x, OPT_linttyp);
} else if ((__IN(f, 0x70) && x->typ->size < (SYSTEM_INT64)OPM_LIntSize)) {
OPB_Convert(&x, OPB_IntType(OPB_LongerSize(x->typ->size)));
} else if (f == 7) {
OPB_Convert(&x, OPT_lrltyp);
} else if (f == 3) {
@ -1974,7 +1955,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if (__IN(f, 0x70)) {
if (f != 6) {
if (x->typ->size != (SYSTEM_INT64)OPM_LIntSize) {
OPB_Convert(&x, OPT_linttyp);
}
} else {
@ -2012,9 +1993,9 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 24: case 25: case 28: case 31:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if ((x->class == 7 && __IN(f, 0x30))) {
} else if ((((x->class == 7 && __IN(f, 0x70))) && x->typ->size < OPT_linttyp->size)) {
OPB_Convert(&x, OPT_linttyp);
} else if (!__IN(f, 0x2040)) {
} else if (!((__IN(x->typ->form, 0x2070) && x->typ->size == (SYSTEM_INT64)OPM_PointerSize))) {
OPB_err(111);
x->typ = OPT_linttyp;
}
@ -2063,13 +2044,13 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
*par0 = x;
}
static struct StPar1__52 {
struct StPar1__52 *lnk;
} *StPar1__52_s;
static struct StPar1__56 {
struct StPar1__56 *lnk;
} *StPar1__56_s;
static OPT_Node NewOp__53 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right);
static OPT_Node NewOp__57 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right);
static OPT_Node NewOp__53 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right)
static OPT_Node NewOp__57 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right)
{
OPT_Node _o_result;
OPT_Node node = NIL;
@ -2086,9 +2067,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
INTEGER f, L;
OPT_Struct typ = NIL;
OPT_Node p = NIL, t = NIL;
struct StPar1__52 _s;
_s.lnk = StPar1__52_s;
StPar1__52_s = &_s;
struct StPar1__56 _s;
_s.lnk = StPar1__56_s;
StPar1__56_s = &_s;
p = *par0;
f = x->typ->form;
switch (fctno) {
@ -2104,7 +2085,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
OPB_err(111);
}
}
p = NewOp__53(19, fctno, p, x);
p = NewOp__57(19, fctno, p, x);
p->typ = OPT_notyp;
}
break;
@ -2112,10 +2093,10 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if (__IN(f, 0x70)) {
if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval > (LONGINT)OPM_MaxSet))) {
if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval > (SYSTEM_INT64)OPM_MaxSet))) {
OPB_err(202);
}
p = NewOp__53(19, fctno, p, x);
p = NewOp__57(19, fctno, p, x);
} else {
OPB_err(111);
}
@ -2124,7 +2105,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 17:
if (!__IN(f, 0x70) || x->class != 7) {
OPB_err(69);
} else if (f == 4) {
} else if (x->typ->size == 1) {
L = (int)x->conval->intval;
typ = p->typ;
while ((L > 0 && __IN(typ->comp, 0x0c))) {
@ -2140,7 +2121,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
p = p->left;
x->conval->intval += 1;
}
p = NewOp__53(12, 19, p, x);
p = NewOp__57(12, 19, p, x);
p->typ = OPT_linttyp;
} else {
p = x;
@ -2162,7 +2143,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
t = x;
x = p;
p = t;
p = NewOp__53(19, 18, p, x);
p = NewOp__57(19, 18, p, x);
} else {
OPB_err(111);
}
@ -2188,7 +2169,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
}
p->obj = NIL;
} else {
p = NewOp__53(12, 17, p, x);
p = NewOp__57(12, 17, p, x);
p->typ = OPT_linttyp;
}
} else {
@ -2219,9 +2200,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
OPB_err(111);
} else {
if (fctno == 22) {
p = NewOp__53(12, 27, p, x);
p = NewOp__57(12, 27, p, x);
} else {
p = NewOp__53(12, 28, p, x);
p = NewOp__57(12, 28, p, x);
}
p->typ = p->left->typ;
}
@ -2238,7 +2219,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
x = p;
p = t;
}
p = NewOp__53(19, fctno, p, x);
p = NewOp__57(19, fctno, p, x);
} else {
OPB_err(111);
}
@ -2248,7 +2229,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if (__IN(f, 0x70)) {
p = NewOp__53(12, 26, p, x);
p = NewOp__57(12, 26, p, x);
} else {
OPB_err(111);
}
@ -2258,6 +2239,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if (((x->class == 8 || x->class == 9) || __IN(f, 0x1401)) || x->typ->comp == 3) {
OPB_err(126);
}
if (x->typ->size < p->typ->size) {
OPB_err(-308);
}
t = OPT_NewNode(11);
t->subcl = 29;
t->left = x;
@ -2269,7 +2253,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if (__IN(f, 0x70)) {
p = NewOp__53(19, 30, p, x);
p = NewOp__57(19, 30, p, x);
} else {
OPB_err(111);
}
@ -2278,9 +2262,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 31:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if ((x->class == 7 && __IN(f, 0x30))) {
} else if ((((x->class == 7 && __IN(f, 0x70))) && x->typ->size < OPT_linttyp->size)) {
OPB_Convert(&x, OPT_linttyp);
} else if (!__IN(f, 0x2040)) {
} else if (!((__IN(x->typ->form, 0x2070) && x->typ->size == (SYSTEM_INT64)OPM_PointerSize))) {
OPB_err(111);
x->typ = OPT_linttyp;
}
@ -2315,7 +2299,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
break;
}
*par0 = p;
StPar1__52_s = _s.lnk;
StPar1__56_s = _s.lnk;
}
void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
@ -2434,7 +2418,7 @@ static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpa
ftyp = ftyp->BaseTyp;
atyp = atyp->BaseTyp;
if ((fvarpar && ftyp == OPT_bytetyp)) {
if (!__IN(f, 0x0c) || !__IN(atyp->form, 0x1e)) {
if (!__IN(f, 0x0c) || !((__IN(atyp->form, 0x7e) && atyp->size == 1))) {
if (__IN(18, OPM_opt)) {
OPB_err(-301);
}
@ -2517,7 +2501,7 @@ void OPB_Param (OPT_Node ap, OPT_Object fp)
OPB_err(111);
}
} else if ((fp->typ == OPT_sysptrtyp && ap->typ->form == 13)) {
} else if ((ap->typ != fp->typ && !((fp->typ->form == 1 && __IN(ap->typ->form, 0x18))))) {
} else if ((ap->typ != fp->typ && !((fp->typ->form == 1 && ((__IN(ap->typ->form, 0x7e) && ap->typ->size == 1)))))) {
OPB_err(123);
} else if ((fp->typ->form == 13 && ap->class == 5)) {
OPB_err(123);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPB__h
#define OPB__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#define LARGE
#include "SYSTEM.h"
#include "Configuration.h"
@ -17,12 +17,13 @@ static CHAR OPC_BodyNameExt[13];
export void OPC_Align (LONGINT *adr, LONGINT base);
export void OPC_Andent (OPT_Struct typ);
static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames);
export LONGINT OPC_Base (OPT_Struct typ);
export LONGINT OPC_BaseAlignment (OPT_Struct typ);
export OPT_Object OPC_BaseTProc (OPT_Object obj);
export void OPC_BegBlk (void);
export void OPC_BegStat (void);
static void OPC_CProcDefs (OPT_Object obj, INTEGER vis);
export void OPC_Case (LONGINT caseVal, INTEGER form);
static void OPC_CharacterLiteral (LONGINT c);
export void OPC_Cmp (INTEGER rel);
export void OPC_CompleteIdent (OPT_Object obj);
export void OPC_Constant (OPT_Const con, INTEGER form);
@ -74,8 +75,10 @@ static void OPC_PutBase (OPT_Struct typ);
static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt);
static void OPC_RegCmds (OPT_Object obj);
export void OPC_SetInclude (BOOLEAN exclude);
export LONGINT OPC_SizeAlignment (LONGINT size);
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause);
static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x);
static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l);
export void OPC_TDescDecl (OPT_Struct typ);
export void OPC_TypeDefs (OPT_Object obj, INTEGER vis);
export void OPC_TypeOf (OPT_Object ap);
@ -316,7 +319,7 @@ void OPC_Andent (OPT_Struct typ)
static BOOLEAN OPC_Undefined (OPT_Object obj)
{
BOOLEAN _o_result;
_o_result = (((obj->mnolev >= 0 && obj->linkadr != (LONGINT)(3 + OPM_currFile))) && obj->linkadr != 2) || obj->name[0] == 0x00;
_o_result = obj->name[0] == 0x00 || (((obj->mnolev >= 0 && obj->linkadr != (SYSTEM_INT64)(3 + OPM_currFile))) && obj->linkadr != 2);
return _o_result;
}
@ -816,14 +819,15 @@ void OPC_TDescDecl (OPT_Struct typ)
OPC_Andent(typ);
OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1);
OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ));
OPM_Write('\"');
OPM_Write('"');
if (typ->strobj != NIL) {
OPM_WriteStringVar((void*)typ->strobj->name, ((LONGINT)(256)));
}
OPC_Str1((CHAR*)"\", #), {", (LONGINT)9, typ->size);
OPM_Write('"');
OPC_Str1((CHAR*)", #), {", (LONGINT)8, typ->size);
nofptrs = 0;
OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs);
OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (LONGINT)OPM_LIntSize));
OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (SYSTEM_INT64)OPM_LIntSize));
OPC_EndStat();
}
@ -865,70 +869,37 @@ void OPC_Align (LONGINT *adr, LONGINT base)
}
}
LONGINT OPC_Base (OPT_Struct typ)
LONGINT OPC_SizeAlignment (LONGINT size)
{
LONGINT _o_result;
switch (typ->form) {
case 1:
_o_result = 1;
return _o_result;
break;
case 3:
_o_result = OPM_CharAlign;
return _o_result;
break;
case 2:
_o_result = OPM_BoolAlign;
return _o_result;
break;
case 4:
_o_result = OPM_SIntAlign;
return _o_result;
break;
case 5:
_o_result = OPM_IntAlign;
return _o_result;
break;
case 6:
_o_result = OPM_LIntAlign;
return _o_result;
break;
case 7:
_o_result = OPM_RealAlign;
return _o_result;
break;
case 8:
_o_result = OPM_LRealAlign;
return _o_result;
break;
case 9:
_o_result = OPM_SetAlign;
return _o_result;
break;
case 13:
_o_result = OPM_PointerAlign;
return _o_result;
break;
case 14:
_o_result = OPM_ProcAlign;
return _o_result;
break;
case 15:
if (typ->comp == 4) {
_o_result = __MASK(typ->align, -65536);
return _o_result;
} else {
_o_result = OPC_Base(typ->BaseTyp);
return _o_result;
}
break;
default:
OPM_LogWStr((CHAR*)"unhandled case in OPC.Base, typ^form = ", (LONGINT)40);
OPM_LogWNum(typ->form, ((LONGINT)(0)));
OPM_LogWLn();
break;
LONGINT alignment;
if (size < (SYSTEM_INT64)OPM_Alignment) {
alignment = 1;
while (alignment < size) {
alignment = __ASHL(alignment, 1);
}
} else {
alignment = OPM_Alignment;
}
__RETCHK;
_o_result = alignment;
return _o_result;
}
LONGINT OPC_BaseAlignment (OPT_Struct typ)
{
LONGINT _o_result;
LONGINT alignment;
if (typ->form == 15) {
if (typ->comp == 4) {
alignment = __MASK(typ->align, -65536);
} else {
alignment = OPC_BaseAlignment(typ->BaseTyp);
}
} else {
alignment = OPC_SizeAlignment(typ->size);
}
_o_result = alignment;
return _o_result;
}
static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LONGINT *curAlign)
@ -939,11 +910,11 @@ static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LO
if ((*curAlign < align && gap - (adr - off) >= align)) {
gap -= (adr - off) + align;
OPC_BegStat();
if (align == (LONGINT)OPM_IntSize) {
if (align == (SYSTEM_INT64)OPM_IntSize) {
OPM_WriteString((CHAR*)"INTEGER", (LONGINT)8);
} else if (align == (LONGINT)OPM_LIntSize) {
} else if (align == (SYSTEM_INT64)OPM_LIntSize) {
OPM_WriteString((CHAR*)"LONGINT", (LONGINT)8);
} else if (align == (LONGINT)OPM_LRealSize) {
} else if (align == (SYSTEM_INT64)OPM_LRealSize) {
OPM_WriteString((CHAR*)"LONGREAL", (LONGINT)9);
}
OPC_Str1((CHAR*)" _prvt#", (LONGINT)8, *n);
@ -982,7 +953,7 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
}
} else {
adr = *off;
fldAlign = OPC_Base(fld->typ);
fldAlign = OPC_BaseAlignment(fld->typ);
OPC_Align(&adr, fldAlign);
gap = fld->adr - adr;
if (fldAlign > *curAlign) {
@ -1008,7 +979,7 @@ static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *
}
}
if (last) {
adr = typ->size - (LONGINT)__ASHR(typ->sysflag, 8);
adr = typ->size - (SYSTEM_INT64)__ASHR(typ->sysflag, 8);
if (adr == 0) {
gap = 1;
} else {
@ -1171,10 +1142,10 @@ static void OPC_Include (CHAR *name, LONGINT name__len)
{
__DUP(name, name__len, CHAR);
OPM_WriteString((CHAR*)"#include ", (LONGINT)10);
OPM_Write('\"');
OPM_Write('"');
OPM_WriteStringVar((void*)name, name__len);
OPM_WriteString((CHAR*)".h", (LONGINT)3);
OPM_Write('\"');
OPM_Write('"');
OPM_WriteLn();
__DEL(name);
}
@ -1239,8 +1210,8 @@ void OPC_GenHdr (OPT_Node n)
static void OPC_GenHeaderMsg (void)
{
INTEGER i;
OPM_WriteString((CHAR*)"/*", (LONGINT)3);
OPM_WriteString((CHAR*)" voc ", (LONGINT)6);
OPM_WriteString((CHAR*)"/* ", (LONGINT)4);
OPM_WriteString((CHAR*)"voc", (LONGINT)4);
OPM_Write(' ');
OPM_WriteString(Configuration_versionLong, ((LONGINT)(41)));
OPM_Write(' ');
@ -1856,26 +1827,56 @@ void OPC_Cmp (INTEGER rel)
}
}
static void OPC_CharacterLiteral (LONGINT c)
{
if (c < 32 || c > 126) {
OPM_WriteString((CHAR*)"0x", (LONGINT)3);
OPM_WriteHex(c);
} else {
OPM_Write('\'');
if ((c == 92 || c == 39) || c == 63) {
OPM_Write('\\');
}
OPM_Write((CHAR)c);
OPM_Write('\'');
}
}
static void OPC_StringLiteral (CHAR *s, LONGINT s__len, LONGINT l)
{
LONGINT i;
INTEGER c;
__DUP(s, s__len, CHAR);
OPM_Write('"');
i = 0;
while (i < l) {
c = (int)s[__X(i, s__len)];
if (c < 32 || c > 126) {
OPM_Write('\\');
OPM_Write((CHAR)(48 + __ASHR(c, 6)));
c = __MASK(c, -64);
OPM_Write((CHAR)(48 + __ASHR(c, 3)));
c = __MASK(c, -8);
OPM_Write((CHAR)(48 + c));
} else {
if ((c == 92 || c == 34) || c == 63) {
OPM_Write('\\');
}
OPM_Write((CHAR)c);
}
i += 1;
}
OPM_Write('"');
__DEL(s);
}
void OPC_Case (LONGINT caseVal, INTEGER form)
{
CHAR ch;
OPM_WriteString((CHAR*)"case ", (LONGINT)6);
switch (form) {
case 3:
ch = (CHAR)caseVal;
if ((ch >= ' ' && ch <= '~')) {
OPM_Write('\'');
if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') {
OPM_Write('\\');
OPM_Write(ch);
} else {
OPM_Write(ch);
}
OPM_Write('\'');
} else {
OPM_WriteString((CHAR*)"0x", (LONGINT)3);
OPM_WriteHex(caseVal);
}
OPC_CharacterLiteral(caseVal);
break;
case 4: case 5: case 6:
OPM_WriteInt(caseVal);
@ -1933,8 +1934,7 @@ void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim)
void OPC_Constant (OPT_Const con, INTEGER form)
{
INTEGER i, len;
CHAR ch;
INTEGER i;
SET s;
LONGINT hex;
BOOLEAN skipLeading;
@ -1946,18 +1946,7 @@ void OPC_Constant (OPT_Const con, INTEGER form)
OPM_WriteInt(con->intval);
break;
case 3:
ch = (CHAR)con->intval;
if ((ch >= ' ' && ch <= '~')) {
OPM_Write('\'');
if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') {
OPM_Write('\\');
}
OPM_Write(ch);
OPM_Write('\'');
} else {
OPM_WriteString((CHAR*)"0x", (LONGINT)3);
OPM_WriteHex(con->intval);
}
OPC_CharacterLiteral(con->intval);
break;
case 4: case 5: case 6:
OPM_WriteInt(con->intval);
@ -1992,18 +1981,7 @@ void OPC_Constant (OPT_Const con, INTEGER form)
}
break;
case 10:
OPM_Write('\"');
len = (int)con->intval2 - 1;
i = 0;
while (i < len) {
ch = (*con->ext)[__X(i, ((LONGINT)(256)))];
if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') {
OPM_Write('\\');
}
OPM_Write(ch);
i += 1;
}
OPM_Write('\"');
OPC_StringLiteral(*con->ext, ((LONGINT)(256)), con->intval2 - 1);
break;
case 11:
OPM_WriteString((CHAR*)"NIL", (LONGINT)4);
@ -2016,74 +1994,74 @@ void OPC_Constant (OPT_Const con, INTEGER form)
}
}
static struct InitKeywords__47 {
static struct InitKeywords__48 {
SHORTINT *n;
struct InitKeywords__47 *lnk;
} *InitKeywords__47_s;
struct InitKeywords__48 *lnk;
} *InitKeywords__48_s;
static void Enter__48 (CHAR *s, LONGINT s__len);
static void Enter__49 (CHAR *s, LONGINT s__len);
static void Enter__48 (CHAR *s, LONGINT s__len)
static void Enter__49 (CHAR *s, LONGINT s__len)
{
INTEGER h;
__DUP(s, s__len, CHAR);
h = OPC_PerfectHash((void*)s, s__len);
OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__47_s->n;
__COPY(s, OPC_keytab[__X(*InitKeywords__47_s->n, ((LONGINT)(36)))], ((LONGINT)(9)));
*InitKeywords__47_s->n += 1;
OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__48_s->n;
__COPY(s, OPC_keytab[__X(*InitKeywords__48_s->n, ((LONGINT)(36)))], ((LONGINT)(9)));
*InitKeywords__48_s->n += 1;
__DEL(s);
}
static void OPC_InitKeywords (void)
{
SHORTINT n, i;
struct InitKeywords__47 _s;
struct InitKeywords__48 _s;
_s.n = &n;
_s.lnk = InitKeywords__47_s;
InitKeywords__47_s = &_s;
_s.lnk = InitKeywords__48_s;
InitKeywords__48_s = &_s;
n = 0;
i = 0;
while (i <= 104) {
OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1;
i += 1;
}
Enter__48((CHAR*)"asm", (LONGINT)4);
Enter__48((CHAR*)"auto", (LONGINT)5);
Enter__48((CHAR*)"break", (LONGINT)6);
Enter__48((CHAR*)"case", (LONGINT)5);
Enter__48((CHAR*)"char", (LONGINT)5);
Enter__48((CHAR*)"const", (LONGINT)6);
Enter__48((CHAR*)"continue", (LONGINT)9);
Enter__48((CHAR*)"default", (LONGINT)8);
Enter__48((CHAR*)"do", (LONGINT)3);
Enter__48((CHAR*)"double", (LONGINT)7);
Enter__48((CHAR*)"else", (LONGINT)5);
Enter__48((CHAR*)"enum", (LONGINT)5);
Enter__48((CHAR*)"extern", (LONGINT)7);
Enter__48((CHAR*)"export", (LONGINT)7);
Enter__48((CHAR*)"float", (LONGINT)6);
Enter__48((CHAR*)"for", (LONGINT)4);
Enter__48((CHAR*)"fortran", (LONGINT)8);
Enter__48((CHAR*)"goto", (LONGINT)5);
Enter__48((CHAR*)"if", (LONGINT)3);
Enter__48((CHAR*)"import", (LONGINT)7);
Enter__48((CHAR*)"int", (LONGINT)4);
Enter__48((CHAR*)"long", (LONGINT)5);
Enter__48((CHAR*)"register", (LONGINT)9);
Enter__48((CHAR*)"return", (LONGINT)7);
Enter__48((CHAR*)"short", (LONGINT)6);
Enter__48((CHAR*)"signed", (LONGINT)7);
Enter__48((CHAR*)"sizeof", (LONGINT)7);
Enter__48((CHAR*)"static", (LONGINT)7);
Enter__48((CHAR*)"struct", (LONGINT)7);
Enter__48((CHAR*)"switch", (LONGINT)7);
Enter__48((CHAR*)"typedef", (LONGINT)8);
Enter__48((CHAR*)"union", (LONGINT)6);
Enter__48((CHAR*)"unsigned", (LONGINT)9);
Enter__48((CHAR*)"void", (LONGINT)5);
Enter__48((CHAR*)"volatile", (LONGINT)9);
Enter__48((CHAR*)"while", (LONGINT)6);
InitKeywords__47_s = _s.lnk;
Enter__49((CHAR*)"asm", (LONGINT)4);
Enter__49((CHAR*)"auto", (LONGINT)5);
Enter__49((CHAR*)"break", (LONGINT)6);
Enter__49((CHAR*)"case", (LONGINT)5);
Enter__49((CHAR*)"char", (LONGINT)5);
Enter__49((CHAR*)"const", (LONGINT)6);
Enter__49((CHAR*)"continue", (LONGINT)9);
Enter__49((CHAR*)"default", (LONGINT)8);
Enter__49((CHAR*)"do", (LONGINT)3);
Enter__49((CHAR*)"double", (LONGINT)7);
Enter__49((CHAR*)"else", (LONGINT)5);
Enter__49((CHAR*)"enum", (LONGINT)5);
Enter__49((CHAR*)"extern", (LONGINT)7);
Enter__49((CHAR*)"export", (LONGINT)7);
Enter__49((CHAR*)"float", (LONGINT)6);
Enter__49((CHAR*)"for", (LONGINT)4);
Enter__49((CHAR*)"fortran", (LONGINT)8);
Enter__49((CHAR*)"goto", (LONGINT)5);
Enter__49((CHAR*)"if", (LONGINT)3);
Enter__49((CHAR*)"import", (LONGINT)7);
Enter__49((CHAR*)"int", (LONGINT)4);
Enter__49((CHAR*)"long", (LONGINT)5);
Enter__49((CHAR*)"register", (LONGINT)9);
Enter__49((CHAR*)"return", (LONGINT)7);
Enter__49((CHAR*)"short", (LONGINT)6);
Enter__49((CHAR*)"signed", (LONGINT)7);
Enter__49((CHAR*)"sizeof", (LONGINT)7);
Enter__49((CHAR*)"static", (LONGINT)7);
Enter__49((CHAR*)"struct", (LONGINT)7);
Enter__49((CHAR*)"switch", (LONGINT)7);
Enter__49((CHAR*)"typedef", (LONGINT)8);
Enter__49((CHAR*)"union", (LONGINT)6);
Enter__49((CHAR*)"unsigned", (LONGINT)9);
Enter__49((CHAR*)"void", (LONGINT)5);
Enter__49((CHAR*)"volatile", (LONGINT)9);
Enter__49((CHAR*)"while", (LONGINT)6);
InitKeywords__48_s = _s.lnk;
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPC__h
#define OPC__h
@ -12,7 +12,7 @@
import void OPC_Align (LONGINT *adr, LONGINT base);
import void OPC_Andent (OPT_Struct typ);
import LONGINT OPC_Base (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);
@ -41,6 +41,7 @@ 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_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_TypeOf (OPT_Object ap);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#define LARGE
#include "SYSTEM.h"
#include "Configuration.h"
@ -15,8 +15,8 @@ typedef
static CHAR OPM_SourceFileName[256];
export INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_CharAlign, OPM_BoolAlign, OPM_SIntAlign, OPM_IntAlign, OPM_LIntAlign, OPM_SetAlign, OPM_RealAlign, OPM_LRealAlign, OPM_PointerAlign, OPM_ProcAlign, OPM_RecAlign, OPM_MaxSet;
export LONGINT OPM_MinSInt, OPM_MinInt, OPM_MinLInt, OPM_MaxSInt, OPM_MaxInt, OPM_MaxLInt, OPM_MaxIndex;
export INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_MaxSet;
export LONGINT OPM_MaxIndex;
export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
export BOOLEAN OPM_noerr;
export LONGINT OPM_curpos, OPM_errpos, OPM_breakpc;
@ -58,7 +58,6 @@ export void OPM_LogWNum (LONGINT i, LONGINT len);
export void OPM_LogWStr (CHAR *s, LONGINT s__len);
static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len);
export void OPM_Mark (INTEGER n, LONGINT pos);
static INTEGER OPM_Min (INTEGER a, INTEGER b);
export void OPM_NewSym (CHAR *modName, LONGINT modName__len);
export void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
export void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
@ -66,6 +65,8 @@ export BOOLEAN OPM_OpenPar (void);
export void OPM_RegisterNewSym (void);
static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt);
static void OPM_ShowLine (LONGINT pos);
export LONGINT OPM_SignedMaximum (LONGINT bytecount);
export LONGINT OPM_SignedMinimum (LONGINT bytecount);
export void OPM_SymRCh (CHAR *ch);
export LONGINT OPM_SymRInt (void);
export void OPM_SymRLReal (LONGREAL *lr);
@ -86,7 +87,7 @@ export void OPM_WriteString (CHAR *s, LONGINT s__len);
export void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
export BOOLEAN OPM_eofSF (void);
export void OPM_err (INTEGER n);
static LONGINT OPM_minus (LONGINT i);
static LONGINT OPM_minusop (LONGINT i);
static LONGINT OPM_power0 (LONGINT i, LONGINT j);
@ -118,50 +119,38 @@ static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt)
i = 1;
while (s[__X(i, s__len)] != 0x00) {
switch (s[__X(i, s__len)]) {
case 'e':
*opt = *opt ^ 0x0200;
break;
case 's':
*opt = *opt ^ 0x10;
break;
case 'm':
*opt = *opt ^ 0x0400;
break;
case 'x':
*opt = *opt ^ 0x01;
break;
case 'r':
*opt = *opt ^ 0x04;
break;
case 't':
*opt = *opt ^ 0x08;
break;
case 'a':
*opt = *opt ^ 0x80;
break;
case 'k':
*opt = *opt ^ 0x40;
break;
case 'p':
*opt = *opt ^ 0x20;
break;
case 'S':
*opt = *opt ^ 0x2000;
break;
case 'c':
*opt = *opt ^ 0x4000;
break;
case 'M':
*opt = *opt ^ 0x8000;
case 'e':
*opt = *opt ^ 0x0200;
break;
case 'f':
*opt = *opt ^ 0x010000;
break;
case 'F':
*opt = *opt ^ 0x020000;
case 'k':
*opt = *opt ^ 0x40;
break;
case 'V':
*opt = *opt ^ 0x040000;
case 'm':
*opt = *opt ^ 0x0400;
break;
case 'p':
*opt = *opt ^ 0x20;
break;
case 'r':
*opt = *opt ^ 0x04;
break;
case 's':
*opt = *opt ^ 0x10;
break;
case 't':
*opt = *opt ^ 0x08;
break;
case 'x':
*opt = *opt ^ 0x01;
break;
case 'B':
if (s[__X(i + 1, s__len)] != 0x00) {
@ -179,6 +168,19 @@ static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt)
__ASSERT(OPM_IntSize == 2 || OPM_IntSize == 4, 0);
__ASSERT(OPM_PointerSize == 4 || OPM_PointerSize == 8, 0);
__ASSERT(OPM_Alignment == 4 || OPM_Alignment == 8, 0);
Files_SetSearchPath((CHAR*)"", (LONGINT)1);
break;
case 'F':
*opt = *opt ^ 0x020000;
break;
case 'M':
*opt = *opt ^ 0x8000;
break;
case 'S':
*opt = *opt ^ 0x2000;
break;
case 'V':
*opt = *opt ^ 0x040000;
break;
default:
OPM_LogWStr((CHAR*)" warning: option ", (LONGINT)19);
@ -228,17 +230,17 @@ BOOLEAN OPM_OpenPar (void)
OPM_LogWLn();
OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" a - don\'t check ASSERTs at runtime, use this option in tested production code", (LONGINT)80);
OPM_LogWStr((CHAR*)" a - don't check ASSERTs at runtime, use this option in tested production code", (LONGINT)80);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" t - don\'t check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101);
OPM_LogWStr((CHAR*)" t - don't check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" S - don\'t call external assembler/compiler, only generate C code", (LONGINT)67);
OPM_LogWStr((CHAR*)" S - don't call external assembler/compiler, only generate C code", (LONGINT)67);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" c - don\'t call linker", (LONGINT)24);
OPM_LogWStr((CHAR*)" c - don't call linker", (LONGINT)24);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" f - don\'t use color output", (LONGINT)29);
OPM_LogWStr((CHAR*)" f - don't use color output", (LONGINT)29);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57);
OPM_LogWLn();
@ -541,16 +543,17 @@ void OPM_FPrintSet (LONGINT *fp, SET set)
void OPM_FPrintReal (LONGINT *fp, REAL real)
{
OPM_FPrint(&*fp, __VAL(LONGINT, real));
INTEGER i;
LONGINT l;
__GET((LONGINT)(SYSTEM_ADDRESS)&real, i, INTEGER);
l = i;
OPM_FPrint(&*fp, l);
}
void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr)
{
LONGINT l, h;
__GET((LONGINT)(uintptr_t)&lr, l, LONGINT);
__GET((LONGINT)(uintptr_t)&lr + 4, h, LONGINT);
OPM_FPrint(&*fp, l);
OPM_FPrint(&*fp, h);
OPM_FPrint(&*fp, __VAL(LONGINT, lr));
}
static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align)
@ -576,7 +579,7 @@ static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONG
__DEL(name);
}
static LONGINT OPM_minus (LONGINT i)
static LONGINT OPM_minusop (LONGINT i)
{
LONGINT _o_result;
_o_result = -i;
@ -604,103 +607,62 @@ static void OPM_VerboseListSizes (void)
OPM_LogWLn();
OPM_LogWStr((CHAR*)"CHAR ", (LONGINT)14);
OPM_LogWNum(OPM_CharSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_CharAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"BOOLEAN ", (LONGINT)14);
OPM_LogWNum(OPM_BoolSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_BoolAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"SHORTINT ", (LONGINT)14);
OPM_LogWNum(OPM_SIntSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_SIntAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"INTEGER ", (LONGINT)14);
OPM_LogWNum(OPM_IntSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_IntAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"LONGINT ", (LONGINT)14);
OPM_LogWNum(OPM_LIntSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_LIntAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"SET ", (LONGINT)14);
OPM_LogWNum(OPM_SetSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_SetAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"REAL ", (LONGINT)14);
OPM_LogWNum(OPM_RealSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_RealAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"LONGREAL ", (LONGINT)14);
OPM_LogWNum(OPM_LRealSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_LRealAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"PTR ", (LONGINT)14);
OPM_LogWNum(OPM_PointerSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_PointerAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"PROC ", (LONGINT)14);
OPM_LogWNum(OPM_ProcSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_ProcAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"RECORD ", (LONGINT)14);
OPM_LogWNum(OPM_RecSize, ((LONGINT)(4)));
OPM_LogWNum(OPM_RecAlign, ((LONGINT)(5)));
OPM_LogWLn();
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Min shortint ", (LONGINT)14);
OPM_LogWNum(OPM_MinSInt, ((LONGINT)(4)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Max shortint ", (LONGINT)14);
OPM_LogWNum(OPM_MaxSInt, ((LONGINT)(4)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Min integer ", (LONGINT)14);
OPM_LogWNum(OPM_MinInt, ((LONGINT)(4)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Max integer ", (LONGINT)14);
OPM_LogWNum(OPM_MaxInt, ((LONGINT)(4)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Min longint ", (LONGINT)14);
OPM_LogWNum(OPM_MinLInt, ((LONGINT)(4)));
OPM_LogWLn();
}
static INTEGER OPM_Min (INTEGER a, INTEGER b)
LONGINT OPM_SignedMaximum (LONGINT bytecount)
{
INTEGER _o_result;
if (a < b) {
_o_result = a;
return _o_result;
} else {
_o_result = b;
return _o_result;
}
__RETCHK;
LONGINT _o_result;
LONGINT result;
result = 1;
result = __LSH(result, __ASHL(bytecount, 3) - 1, LONGINT);
_o_result = result - 1;
return _o_result;
}
LONGINT OPM_SignedMinimum (LONGINT bytecount)
{
LONGINT _o_result;
_o_result = -OPM_SignedMaximum(bytecount) - 1;
return _o_result;
}
static void OPM_GetProperties (void)
{
LONGINT base;
OPM_ProcSize = OPM_PointerSize;
OPM_LIntSize = __ASHL(OPM_IntSize, 1);
OPM_SetSize = OPM_LIntSize;
OPM_CharAlign = OPM_Min(OPM_Alignment, OPM_CharSize);
OPM_BoolAlign = OPM_Min(OPM_Alignment, OPM_BoolSize);
OPM_SIntAlign = OPM_Min(OPM_Alignment, OPM_SIntSize);
OPM_RecAlign = OPM_Min(OPM_Alignment, OPM_RecSize);
OPM_RealAlign = OPM_Min(OPM_Alignment, OPM_RealSize);
OPM_LRealAlign = OPM_Min(OPM_Alignment, OPM_LRealSize);
OPM_PointerAlign = OPM_Min(OPM_Alignment, OPM_PointerSize);
OPM_ProcAlign = OPM_Min(OPM_Alignment, OPM_ProcSize);
OPM_IntAlign = OPM_Min(OPM_Alignment, OPM_IntSize);
OPM_LIntAlign = OPM_Min(OPM_Alignment, OPM_LIntSize);
OPM_SetAlign = OPM_Min(OPM_Alignment, OPM_SetSize);
base = -2;
OPM_MinSInt = __ASH(base, __ASHL(OPM_SIntSize, 3) - 2);
OPM_MaxSInt = OPM_minus(OPM_MinSInt + 1);
OPM_MinInt = __ASH(base, __ASHL(OPM_IntSize, 3) - 2);
OPM_MaxInt = OPM_minus(OPM_MinInt + 1);
OPM_MinLInt = __ASH(base, __ASHL(OPM_LIntSize, 3) - 2);
OPM_MaxLInt = OPM_minus(OPM_MinLInt + 1);
if (OPM_RealSize == 4) {
OPM_MaxReal = 3.40282346000000e+038;
} else if (OPM_RealSize == 8) {
@ -714,7 +676,7 @@ static void OPM_GetProperties (void)
OPM_MinReal = -OPM_MaxReal;
OPM_MinLReal = -OPM_MaxLReal;
OPM_MaxSet = __ASHL(OPM_SetSize, 3) - 1;
OPM_MaxIndex = OPM_MaxLInt;
OPM_MaxIndex = OPM_SignedMaximum(OPM_PointerSize);
if (OPM_Verbose) {
OPM_VerboseListSizes();
}
@ -876,7 +838,7 @@ void OPM_WriteInt (LONGINT i)
{
CHAR s[20];
LONGINT i1, k;
if (i == OPM_MinInt || i == OPM_MinLInt) {
if (i == OPM_SignedMinimum(OPM_IntSize) || i == OPM_SignedMinimum(OPM_LIntSize)) {
OPM_Write('(');
OPM_WriteInt(i + 1);
OPM_WriteString((CHAR*)"-1)", (LONGINT)4);
@ -909,7 +871,7 @@ void OPM_WriteReal (LONGREAL r, CHAR suffx)
CHAR s[32];
CHAR ch;
INTEGER i;
if ((((r < OPM_MaxLInt && r > OPM_MinLInt)) && r == (__ENTIER(r)))) {
if ((((r < OPM_SignedMaximum(OPM_LIntSize) && r > OPM_SignedMinimum(OPM_LIntSize))) && r == (__ENTIER(r)))) {
if (suffx == 'f') {
OPM_WriteString((CHAR*)"(REAL)", (LONGINT)7);
} else {

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPM__h
#define OPM__h
@ -7,8 +7,8 @@
#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_CharAlign, OPM_BoolAlign, OPM_SIntAlign, OPM_IntAlign, OPM_LIntAlign, OPM_SetAlign, OPM_RealAlign, OPM_LRealAlign, OPM_PointerAlign, OPM_ProcAlign, OPM_RecAlign, OPM_MaxSet;
import LONGINT OPM_MinSInt, OPM_MinInt, OPM_MinLInt, OPM_MaxSInt, OPM_MaxInt, OPM_MaxLInt, OPM_MaxIndex;
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 LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
import BOOLEAN OPM_noerr;
import LONGINT OPM_curpos, OPM_errpos, OPM_breakpc;
@ -39,6 +39,8 @@ 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 void OPM_SymRCh (CHAR *ch);
import LONGINT OPM_SymRInt (void);
import void OPM_SymRLReal (LONGREAL *lr);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#define LARGE
#include "SYSTEM.h"
#include "OPB.h"
@ -439,10 +439,10 @@ static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned)
if (OPP_sym == 38) {
OPP_qualident(&id);
if (id->mode == 5) {
if (id->typ != *banned) {
*typ = id->typ;
} else {
if (id->typ == *banned) {
OPP_err(58);
} else {
*typ = id->typ;
}
} else {
OPP_err(52);
@ -1784,6 +1784,24 @@ void OPP_Module (OPT_Node *prog, SET opt)
if (OPP_sym == 63) {
OPS_Get(&OPP_sym);
} else {
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Unexpected symbol found when MODULE expected:", (LONGINT)46);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" sym: ", (LONGINT)15);
OPM_LogWNum(OPP_sym, ((LONGINT)(1)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)" OPS.name: ", (LONGINT)15);
OPM_LogWStr(OPS_name, ((LONGINT)(256)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)" OPS.str: ", (LONGINT)15);
OPM_LogWStr(OPS_str, ((LONGINT)(256)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)" OPS.numtyp: ", (LONGINT)15);
OPM_LogWNum(OPS_numtyp, ((LONGINT)(1)));
OPM_LogWLn();
OPM_LogWStr((CHAR*)" OPS.intval: ", (LONGINT)15);
OPM_LogWNum(OPS_intval, ((LONGINT)(1)));
OPM_LogWLn();
OPP_err(16);
}
if (OPP_sym == 38) {

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/24] for gcc LP64 on cygwin xtspkaSfF */
/* voc 1.95 [2016/08/23] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPP__h
#define OPP__h

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