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

OPB little simplifications and ShorterSize/LongerSize functions.

Browse source
This commit is contained in:
David Brown 2016-08-20 18:53:28 +01:00
parent dd4de5aeed
commit e33255b08c
201 changed files with 1167 additions and 1123 deletions
Download patch file Download diff file Expand all files Collapse all files

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

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

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

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

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
#include "Platform.h" #include "Platform.h"

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

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

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

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

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

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

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin tskSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin tskSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
struct Heap__1 { struct Heap__1 {

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

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

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

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

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

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

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
#include "OPM.h" #include "OPM.h"
#include "OPS.h" #include "OPS.h"
@ -36,6 +36,7 @@ export void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ);
static BOOLEAN OPB_IntToBool (LONGINT i); static BOOLEAN OPB_IntToBool (LONGINT i);
static OPT_Struct OPB_IntType (LONGINT size); static OPT_Struct OPB_IntType (LONGINT size);
export void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y); export void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y);
static LONGINT OPB_LongerSize (LONGINT i);
export void OPB_MOp (SHORTINT op, OPT_Node *x); export void OPB_MOp (SHORTINT op, OPT_Node *x);
export OPT_Node OPB_NewBoolConst (BOOLEAN boolval); export OPT_Node OPB_NewBoolConst (BOOLEAN boolval);
export OPT_Node OPB_NewIntConst (LONGINT intval); export OPT_Node OPB_NewIntConst (LONGINT intval);
@ -52,6 +53,7 @@ export void OPB_Return (OPT_Node *x, OPT_Object proc);
export void OPB_SetElem (OPT_Node *x); export void OPB_SetElem (OPT_Node *x);
static void OPB_SetIntType (OPT_Node node); static void OPB_SetIntType (OPT_Node node);
export void OPB_SetRange (OPT_Node *x, OPT_Node y); export void OPB_SetRange (OPT_Node *x, OPT_Node y);
static LONGINT OPB_ShorterSize (LONGINT i);
static INTEGER OPB_SignedByteSize (LONGINT n); static INTEGER OPB_SignedByteSize (LONGINT n);
static LONGINT OPB_SignedMaximum (LONGINT bytecount); static LONGINT OPB_SignedMaximum (LONGINT bytecount);
static LONGINT OPB_SignedMinimum (LONGINT bytecount); static LONGINT OPB_SignedMinimum (LONGINT bytecount);
@ -224,6 +226,23 @@ OPT_Node OPB_EmptySet (void)
return _o_result; return _o_result;
} }
static LONGINT OPB_SignedMaximum (LONGINT bytecount)
{
LONGINT _o_result;
LONGINT result;
result = 1;
result = __LSH(result, __ASHL(bytecount, 3) - 1, LONGINT);
_o_result = result - 1;
return _o_result;
}
static LONGINT OPB_SignedMinimum (LONGINT bytecount)
{
LONGINT _o_result;
_o_result = -OPB_SignedMaximum(bytecount) - 1;
return _o_result;
}
static INTEGER OPB_SignedByteSize (LONGINT n) static INTEGER OPB_SignedByteSize (LONGINT n)
{ {
INTEGER _o_result; INTEGER _o_result;
@ -232,17 +251,39 @@ static INTEGER OPB_SignedByteSize (LONGINT n)
n = -(n + 1); n = -(n + 1);
} }
b = 1; b = 1;
while (b < 8) { while ((b < 8 && __ASH(n, -(__ASHL(b, 3) - 1)) != 0)) {
if (__ASH(n, -(__ASHL(b, 3) - 1)) == 0) {
_o_result = b;
return _o_result;
}
b += 1; b += 1;
} }
_o_result = 8; _o_result = b;
return _o_result; return _o_result;
} }
static LONGINT OPB_ShorterSize (LONGINT i)
{
LONGINT _o_result;
if (i >= (LONGINT)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 <= (LONGINT)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) static OPT_Struct OPB_IntType (LONGINT size)
{ {
OPT_Struct _o_result; OPT_Struct _o_result;
@ -407,16 +448,16 @@ void OPB_Field (OPT_Node *x, OPT_Object y)
} }
} }
static struct TypTest__61 { static struct TypTest__63 {
OPT_Node *x; OPT_Node *x;
OPT_Object *obj; OPT_Object *obj;
BOOLEAN *guard; BOOLEAN *guard;
struct TypTest__61 *lnk; struct TypTest__63 *lnk;
} *TypTest__61_s; } *TypTest__63_s;
static void GTT__62 (OPT_Struct t0, OPT_Struct t1); static void GTT__64 (OPT_Struct t0, OPT_Struct t1);
static void GTT__62 (OPT_Struct t0, OPT_Struct t1) static void GTT__64 (OPT_Struct t0, OPT_Struct t1)
{ {
OPT_Node node = NIL; OPT_Node node = NIL;
OPT_Struct t = NIL; OPT_Struct t = NIL;
@ -429,54 +470,54 @@ static void GTT__62 (OPT_Struct t0, OPT_Struct t1)
t1 = t1->BaseTyp; t1 = t1->BaseTyp;
} }
if (t1 == t0 || t0->form == 0) { if (t1 == t0 || t0->form == 0) {
if (*TypTest__61_s->guard) { if (*TypTest__63_s->guard) {
OPB_BindNodes(5, NIL, &*TypTest__61_s->x, NIL); OPB_BindNodes(5, NIL, &*TypTest__63_s->x, NIL);
(*TypTest__61_s->x)->readonly = (*TypTest__61_s->x)->left->readonly; (*TypTest__63_s->x)->readonly = (*TypTest__63_s->x)->left->readonly;
} else { } else {
node = OPT_NewNode(11); node = OPT_NewNode(11);
node->subcl = 16; node->subcl = 16;
node->left = *TypTest__61_s->x; node->left = *TypTest__63_s->x;
node->obj = *TypTest__61_s->obj; node->obj = *TypTest__63_s->obj;
*TypTest__61_s->x = node; *TypTest__63_s->x = node;
} }
} else { } else {
OPB_err(85); OPB_err(85);
} }
} else if (t0 != t1) { } else if (t0 != t1) {
OPB_err(85); OPB_err(85);
} else if (!*TypTest__61_s->guard) { } else if (!*TypTest__63_s->guard) {
if ((*TypTest__61_s->x)->class == 5) { if ((*TypTest__63_s->x)->class == 5) {
node = OPT_NewNode(11); node = OPT_NewNode(11);
node->subcl = 16; node->subcl = 16;
node->left = *TypTest__61_s->x; node->left = *TypTest__63_s->x;
node->obj = *TypTest__61_s->obj; node->obj = *TypTest__63_s->obj;
*TypTest__61_s->x = node; *TypTest__63_s->x = node;
} else { } else {
*TypTest__61_s->x = OPB_NewBoolConst(1); *TypTest__63_s->x = OPB_NewBoolConst(1);
} }
} }
} }
void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard) void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
{ {
struct TypTest__61 _s; struct TypTest__63 _s;
_s.x = x; _s.x = x;
_s.obj = &obj; _s.obj = &obj;
_s.guard = &guard; _s.guard = &guard;
_s.lnk = TypTest__61_s; _s.lnk = TypTest__63_s;
TypTest__61_s = &_s; TypTest__63_s = &_s;
if (OPB_NotVar(*x)) { if (OPB_NotVar(*x)) {
OPB_err(112); OPB_err(112);
} else if ((*x)->typ->form == 13) { } else if ((*x)->typ->form == 13) {
if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) { if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) {
OPB_err(85); OPB_err(85);
} else if (obj->typ->form == 13) { } else if (obj->typ->form == 13) {
GTT__62((*x)->typ->BaseTyp, obj->typ->BaseTyp); GTT__64((*x)->typ->BaseTyp, obj->typ->BaseTyp);
} else { } else {
OPB_err(86); OPB_err(86);
} }
} else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) { } else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) {
GTT__62((*x)->typ, obj->typ); GTT__64((*x)->typ, obj->typ);
} else { } else {
OPB_err(87); OPB_err(87);
} }
@ -485,7 +526,7 @@ void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
} else { } else {
(*x)->typ = OPT_booltyp; (*x)->typ = OPT_booltyp;
} }
TypTest__61_s = _s.lnk; TypTest__63_s = _s.lnk;
} }
void OPB_In (OPT_Node *x, OPT_Node y) void OPB_In (OPT_Node *x, OPT_Node y)
@ -551,13 +592,13 @@ static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x)
x->intval = -1; x->intval = -1;
} }
static struct MOp__29 { static struct MOp__30 {
struct MOp__29 *lnk; struct MOp__30 *lnk;
} *MOp__29_s; } *MOp__30_s;
static OPT_Node NewOp__30 (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__30 (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 _o_result;
OPT_Node node = NIL; OPT_Node node = NIL;
@ -574,9 +615,9 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
INTEGER f; INTEGER f;
OPT_Struct typ = NIL; OPT_Struct typ = NIL;
OPT_Node z = NIL; OPT_Node z = NIL;
struct MOp__29 _s; struct MOp__30 _s;
_s.lnk = MOp__29_s; _s.lnk = MOp__30_s;
MOp__29_s = &_s; MOp__30_s = &_s;
z = *x; z = *x;
if (z->class == 8 || z->class == 9) { if (z->class == 8 || z->class == 9) {
OPB_err(126); OPB_err(126);
@ -590,7 +631,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval)); z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval));
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__30(op, typ, z); z = NewOp__31(op, typ, z);
} }
} else { } else {
OPB_err(98); OPB_err(98);
@ -618,7 +659,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
} }
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__30(op, typ, z); z = NewOp__31(op, typ, z);
} }
} else { } else {
OPB_err(97); OPB_err(97);
@ -639,7 +680,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
} }
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__30(op, typ, z); z = NewOp__31(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -651,7 +692,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->conval->intval = (int)__CAP((CHAR)z->conval->intval); z->conval->intval = (int)__CAP((CHAR)z->conval->intval);
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__30(op, typ, z); z = NewOp__31(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -664,7 +705,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval)); z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval));
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__30(op, typ, z); z = NewOp__31(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -677,7 +718,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
f = 10; f = 10;
} }
if (z->class < 7 || f == 10) { if (z->class < 7 || f == 10) {
z = NewOp__30(op, typ, z); z = NewOp__31(op, typ, z);
} else { } else {
OPB_err(127); OPB_err(127);
} }
@ -686,7 +727,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
case 25: case 25:
if ((__IN(f, 0x70) && z->class == 7)) { if ((__IN(f, 0x70) && z->class == 7)) {
if ((0 <= z->conval->intval && z->conval->intval <= -1)) { if ((0 <= z->conval->intval && z->conval->intval <= -1)) {
z = NewOp__30(op, typ, z); z = NewOp__31(op, typ, z);
} else { } else {
OPB_err(219); OPB_err(219);
} }
@ -703,7 +744,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
} }
} }
*x = z; *x = z;
MOp__29_s = _s.lnk; MOp__30_s = _s.lnk;
} }
static void OPB_CheckPtr (OPT_Node x, OPT_Node y) static void OPB_CheckPtr (OPT_Node x, OPT_Node y)
@ -1197,15 +1238,15 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
(*x)->typ = typ; (*x)->typ = typ;
} }
static struct Op__39 { static struct Op__40 {
INTEGER *f, *g; INTEGER *f, *g;
struct Op__39 *lnk; struct Op__40 *lnk;
} *Op__39_s; } *Op__40_s;
static void NewOp__40 (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);
static BOOLEAN strings__42 (OPT_Node *x, OPT_Node *y); static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y);
static void NewOp__40 (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; OPT_Node node = NIL;
node = OPT_NewNode(12); node = OPT_NewNode(12);
@ -1216,29 +1257,29 @@ static void NewOp__40 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
*x = node; *x = node;
} }
static BOOLEAN strings__42 (OPT_Node *x, OPT_Node *y) static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y)
{ {
BOOLEAN _o_result; BOOLEAN _o_result;
BOOLEAN ok, xCharArr, yCharArr; BOOLEAN ok, xCharArr, yCharArr;
xCharArr = (__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp->form == 3) || *Op__39_s->f == 10; 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__39_s->g == 10; yCharArr = (__IN((*y)->typ->comp, 0x0c) && (*y)->typ->BaseTyp->form == 3) || *Op__40_s->g == 10;
if ((((xCharArr && *Op__39_s->g == 3)) && (*y)->class == 7)) { if ((((xCharArr && *Op__40_s->g == 3)) && (*y)->class == 7)) {
OPB_CharToString(*y); OPB_CharToString(*y);
*Op__39_s->g = 10; *Op__40_s->g = 10;
yCharArr = 1; yCharArr = 1;
} }
if ((((yCharArr && *Op__39_s->f == 3)) && (*x)->class == 7)) { if ((((yCharArr && *Op__40_s->f == 3)) && (*x)->class == 7)) {
OPB_CharToString(*x); OPB_CharToString(*x);
*Op__39_s->f = 10; *Op__40_s->f = 10;
xCharArr = 1; xCharArr = 1;
} }
ok = (xCharArr && yCharArr); ok = (xCharArr && yCharArr);
if (ok) { if (ok) {
if ((*Op__39_s->f == 10 && (*x)->conval->intval2 == 1)) { if ((*Op__40_s->f == 10 && (*x)->conval->intval2 == 1)) {
(*x)->typ = OPT_chartyp; (*x)->typ = OPT_chartyp;
(*x)->conval->intval = 0; (*x)->conval->intval = 0;
OPB_Index(&*y, OPB_NewIntConst(((LONGINT)(0)))); OPB_Index(&*y, OPB_NewIntConst(((LONGINT)(0))));
} else if ((*Op__39_s->g == 10 && (*y)->conval->intval2 == 1)) { } else if ((*Op__40_s->g == 10 && (*y)->conval->intval2 == 1)) {
(*y)->typ = OPT_chartyp; (*y)->typ = OPT_chartyp;
(*y)->conval->intval = 0; (*y)->conval->intval = 0;
OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0)))); OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0))));
@ -1255,11 +1296,11 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPT_Struct typ = NIL; OPT_Struct typ = NIL;
BOOLEAN do_; BOOLEAN do_;
LONGINT val; LONGINT val;
struct Op__39 _s; struct Op__40 _s;
_s.f = &f; _s.f = &f;
_s.g = &g; _s.g = &g;
_s.lnk = Op__39_s; _s.lnk = Op__40_s;
Op__39_s = &_s; Op__40_s = &_s;
z = *x; z = *x;
if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) { if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) {
OPB_err(126); OPB_err(126);
@ -1371,7 +1412,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp; typ = OPT_undftyp;
} }
if (do_) { if (do_) {
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
} }
break; break;
case 2: case 2:
@ -1390,7 +1431,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(102); OPB_err(102);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
break; break;
case 3: case 3:
do_ = 1; do_ = 1;
@ -1413,7 +1454,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp; typ = OPT_undftyp;
} }
if (do_) { if (do_) {
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
} }
break; break;
case 4: case 4:
@ -1431,7 +1472,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(104); OPB_err(104);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
break; break;
case 5: case 5:
if (f == 2) { if (f == 2) {
@ -1441,7 +1482,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
} }
} else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) { } else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) {
} else { } else {
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
} }
} else if (f != 0) { } else if (f != 0) {
OPB_err(94); OPB_err(94);
@ -1464,7 +1505,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
} }
} }
if (do_) { if (do_) {
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
} }
break; break;
case 7: case 7:
@ -1473,7 +1514,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp; typ = OPT_undftyp;
} }
if ((!__IN(f, 0x70) || y->class != 7) || y->conval->intval != 0) { if ((!__IN(f, 0x70) || y->class != 7) || y->conval->intval != 0) {
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
} }
break; break;
case 8: case 8:
@ -1484,7 +1525,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
} }
} else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) { } else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) {
} else { } else {
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
} }
} else if (f != 0) { } else if (f != 0) {
OPB_err(95); OPB_err(95);
@ -1492,16 +1533,16 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
} }
break; break;
case 9: case 10: case 9: case 10:
if (__IN(f, 0x6bff) || strings__42(&z, &y)) { if (__IN(f, 0x6bff) || strings__43(&z, &y)) {
typ = OPT_booltyp; typ = OPT_booltyp;
} else { } else {
OPB_err(107); OPB_err(107);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
break; break;
case 11: case 12: case 13: case 14: case 11: case 12: case 13: case 14:
if (__IN(f, 0x01f9) || strings__42(&z, &y)) { if (__IN(f, 0x01f9) || strings__43(&z, &y)) {
typ = OPT_booltyp; typ = OPT_booltyp;
} else { } else {
OPM_LogWLn(); OPM_LogWLn();
@ -1510,7 +1551,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(108); OPB_err(108);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
break; break;
default: default:
OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", (LONGINT)32); OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", (LONGINT)32);
@ -1520,7 +1561,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
} }
} }
*x = z; *x = z;
Op__39_s = _s.lnk; Op__40_s = _s.lnk;
} }
void OPB_SetRange (OPT_Node *x, OPT_Node y) void OPB_SetRange (OPT_Node *x, OPT_Node y)
@ -1613,7 +1654,7 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
case 0: case 10: case 0: case 10:
break; break;
case 1: case 1:
if (!__IN(g, 0x1a)) { if (!((__IN(g, 0x7a) && y->size == 1))) {
OPB_err(113); OPB_err(113);
} }
break; break;
@ -1725,23 +1766,6 @@ static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo)
{ {
} }
static LONGINT OPB_SignedMaximum (LONGINT bytecount)
{
LONGINT _o_result;
LONGINT result;
result = 1;
result = __LSH(result, __ASHL(bytecount, 3) - 1, LONGINT);
_o_result = result - 1;
return _o_result;
}
static LONGINT OPB_SignedMinimum (LONGINT bytecount)
{
LONGINT _o_result;
_o_result = -OPB_SignedMaximum(bytecount) - 1;
return _o_result;
}
void OPB_StPar0 (OPT_Node *par0, INTEGER fctno) void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
{ {
INTEGER f; INTEGER f;
@ -1889,10 +1913,8 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 10: case 10:
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); OPB_err(126);
} else if (f == 5) { } else if ((__IN(f, 0x70) && x->typ->size > (LONGINT)OPM_SIntSize)) {
OPB_Convert(&x, OPT_sinttyp); OPB_Convert(&x, OPB_IntType(OPB_ShorterSize(x->typ->size)));
} else if (f == 6) {
OPB_Convert(&x, OPT_inttyp);
} else if (f == 8) { } else if (f == 8) {
OPB_Convert(&x, OPT_realtyp); OPB_Convert(&x, OPT_realtyp);
} else { } else {
@ -1902,10 +1924,8 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 11: case 11:
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); OPB_err(126);
} else if (f == 4) { } else if ((__IN(f, 0x70) && x->typ->size < (LONGINT)OPM_LIntSize)) {
OPB_Convert(&x, OPT_inttyp); OPB_Convert(&x, OPB_IntType(OPB_LongerSize(x->typ->size)));
} else if (f == 5) {
OPB_Convert(&x, OPT_linttyp);
} else if (f == 7) { } else if (f == 7) {
OPB_Convert(&x, OPT_lrltyp); OPB_Convert(&x, OPT_lrltyp);
} else if (f == 3) { } else if (f == 3) {
@ -1953,7 +1973,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); OPB_err(126);
} else if (__IN(f, 0x70)) { } else if (__IN(f, 0x70)) {
if (f != 6) { if (x->typ->size != (LONGINT)OPM_LIntSize) {
OPB_Convert(&x, OPT_linttyp); OPB_Convert(&x, OPT_linttyp);
} }
} else { } else {
@ -1991,9 +2011,9 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 24: case 25: case 28: case 31: case 24: case 25: case 28: case 31:
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); 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); OPB_Convert(&x, OPT_linttyp);
} else if (!__IN(f, 0x2040)) { } else if (!((__IN(x->typ->form, 0x2070) && x->typ->size == (LONGINT)OPM_PointerSize))) {
OPB_err(111); OPB_err(111);
x->typ = OPT_linttyp; x->typ = OPT_linttyp;
} }
@ -2042,13 +2062,13 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
*par0 = x; *par0 = x;
} }
static struct StPar1__56 { static struct StPar1__58 {
struct StPar1__56 *lnk; struct StPar1__58 *lnk;
} *StPar1__56_s; } *StPar1__58_s;
static OPT_Node NewOp__57 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right); static OPT_Node NewOp__59 (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__59 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right)
{ {
OPT_Node _o_result; OPT_Node _o_result;
OPT_Node node = NIL; OPT_Node node = NIL;
@ -2065,9 +2085,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
INTEGER f, L; INTEGER f, L;
OPT_Struct typ = NIL; OPT_Struct typ = NIL;
OPT_Node p = NIL, t = NIL; OPT_Node p = NIL, t = NIL;
struct StPar1__56 _s; struct StPar1__58 _s;
_s.lnk = StPar1__56_s; _s.lnk = StPar1__58_s;
StPar1__56_s = &_s; StPar1__58_s = &_s;
p = *par0; p = *par0;
f = x->typ->form; f = x->typ->form;
switch (fctno) { switch (fctno) {
@ -2083,7 +2103,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
OPB_err(111); OPB_err(111);
} }
} }
p = NewOp__57(19, fctno, p, x); p = NewOp__59(19, fctno, p, x);
p->typ = OPT_notyp; p->typ = OPT_notyp;
} }
break; break;
@ -2094,7 +2114,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
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 > (LONGINT)OPM_MaxSet))) {
OPB_err(202); OPB_err(202);
} }
p = NewOp__57(19, fctno, p, x); p = NewOp__59(19, fctno, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2119,7 +2139,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
p = p->left; p = p->left;
x->conval->intval += 1; x->conval->intval += 1;
} }
p = NewOp__57(12, 19, p, x); p = NewOp__59(12, 19, p, x);
p->typ = OPT_linttyp; p->typ = OPT_linttyp;
} else { } else {
p = x; p = x;
@ -2141,7 +2161,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
t = x; t = x;
x = p; x = p;
p = t; p = t;
p = NewOp__57(19, 18, p, x); p = NewOp__59(19, 18, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2167,7 +2187,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
} }
p->obj = NIL; p->obj = NIL;
} else { } else {
p = NewOp__57(12, 17, p, x); p = NewOp__59(12, 17, p, x);
p->typ = OPT_linttyp; p->typ = OPT_linttyp;
} }
} else { } else {
@ -2198,9 +2218,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
OPB_err(111); OPB_err(111);
} else { } else {
if (fctno == 22) { if (fctno == 22) {
p = NewOp__57(12, 27, p, x); p = NewOp__59(12, 27, p, x);
} else { } else {
p = NewOp__57(12, 28, p, x); p = NewOp__59(12, 28, p, x);
} }
p->typ = p->left->typ; p->typ = p->left->typ;
} }
@ -2217,7 +2237,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
x = p; x = p;
p = t; p = t;
} }
p = NewOp__57(19, fctno, p, x); p = NewOp__59(19, fctno, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2227,7 +2247,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); OPB_err(126);
} else if (__IN(f, 0x70)) { } else if (__IN(f, 0x70)) {
p = NewOp__57(12, 26, p, x); p = NewOp__59(12, 26, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2251,7 +2271,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); OPB_err(126);
} else if (__IN(f, 0x70)) { } else if (__IN(f, 0x70)) {
p = NewOp__57(19, 30, p, x); p = NewOp__59(19, 30, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2260,9 +2280,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 31: case 31:
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); 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); OPB_Convert(&x, OPT_linttyp);
} else if (!__IN(f, 0x2040)) { } else if (!((__IN(x->typ->form, 0x2070) && x->typ->size == (LONGINT)OPM_PointerSize))) {
OPB_err(111); OPB_err(111);
x->typ = OPT_linttyp; x->typ = OPT_linttyp;
} }
@ -2297,7 +2317,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
break; break;
} }
*par0 = p; *par0 = p;
StPar1__56_s = _s.lnk; StPar1__58_s = _s.lnk;
} }
void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n) void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
@ -2416,7 +2436,7 @@ static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpa
ftyp = ftyp->BaseTyp; ftyp = ftyp->BaseTyp;
atyp = atyp->BaseTyp; atyp = atyp->BaseTyp;
if ((fvarpar && ftyp == OPT_bytetyp)) { 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)) { if (__IN(18, OPM_opt)) {
OPB_err(-301); OPB_err(-301);
} }
@ -2499,7 +2519,7 @@ void OPB_Param (OPT_Node ap, OPT_Object fp)
OPB_err(111); OPB_err(111);
} }
} else if ((fp->typ == OPT_sysptrtyp && ap->typ->form == 13)) { } 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); OPB_err(123);
} else if ((fp->typ->form == 13 && ap->class == 5)) { } else if ((fp->typ->form == 13 && ap->class == 5)) {
OPB_err(123); OPB_err(123);

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

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

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

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

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPC__h #ifndef OPC__h
#define OPC__h #define OPC__h

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
#include "Configuration.h" #include "Configuration.h"
#include "Console.h" #include "Console.h"
@ -550,7 +550,10 @@ void OPM_FPrintReal (LONGINT *fp, REAL real)
void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr) void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr)
{ {
LONGINT l, h; LONGINT l, h;
OPM_FPrint(&*fp, __VAL(LONGINT, lr)); __GET((LONGINT)(uintptr_t)&lr, l, LONGINT);
__GET((LONGINT)(uintptr_t)&lr + 4, h, LONGINT);
OPM_FPrint(&*fp, l);
OPM_FPrint(&*fp, h);
} }
static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align) static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align)

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPM__h #ifndef OPM__h
#define OPM__h #define OPM__h

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
#include "OPB.h" #include "OPB.h"
#include "OPM.h" #include "OPM.h"

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

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

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin tspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin tspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
#include "OPM.h" #include "OPM.h"

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

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

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
#include "OPM.h" #include "OPM.h"
#include "OPS.h" #include "OPS.h"

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPT__h #ifndef OPT__h
#define OPT__h #define OPT__h

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
#include "OPC.h" #include "OPC.h"
#include "OPM.h" #include "OPM.h"
@ -962,12 +962,8 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPM_WriteString((CHAR*)"(uintptr_t)", (LONGINT)12); OPM_WriteString((CHAR*)"(uintptr_t)", (LONGINT)12);
} }
OPV_expr(l, exprPrec); OPV_expr(l, exprPrec);
} else {
if (__IN(n->typ->form, 0x6000) || __IN(l->typ->form, 0x6000)) {
OPM_WriteString((CHAR*)"__VALP(", (LONGINT)8);
} else { } else {
OPM_WriteString((CHAR*)"__VAL(", (LONGINT)7); OPM_WriteString((CHAR*)"__VAL(", (LONGINT)7);
}
OPC_Ident(n->typ->strobj); OPC_Ident(n->typ->strobj);
OPM_WriteString((CHAR*)", ", (LONGINT)3); OPM_WriteString((CHAR*)", ", (LONGINT)3);
OPV_expr(l, -1); OPV_expr(l, -1);

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

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

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
typedef typedef

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

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

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

@ -1,15 +1,17 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len);
export void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len); export void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len);
export void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len); export void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len);
export void Reals_ConvertHL (LONGREAL y, CHAR *d, LONGINT d__len); export void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len);
export void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len); export void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len);
export INTEGER Reals_Expo (REAL x); export INTEGER Reals_Expo (REAL x);
export INTEGER Reals_ExpoL (LONGREAL x); export INTEGER Reals_ExpoL (LONGREAL x);
export void Reals_SetExpo (REAL *x, INTEGER ex);
export REAL Reals_Ten (INTEGER e); export REAL Reals_Ten (INTEGER e);
export LONGREAL Reals_TenL (INTEGER e); export LONGREAL Reals_TenL (INTEGER e);
static CHAR Reals_ToHex (INTEGER i); static CHAR Reals_ToHex (INTEGER i);
@ -55,17 +57,27 @@ LONGREAL Reals_TenL (INTEGER e)
INTEGER Reals_Expo (REAL x) INTEGER Reals_Expo (REAL x)
{ {
INTEGER _o_result; INTEGER _o_result;
_o_result = (int)__MASK(__ASHR((LONGINT)(__VAL(INTEGER, x)), 23), -256); INTEGER i;
__GET((LONGINT)(uintptr_t)&x + 2, i, INTEGER);
_o_result = __MASK(__ASHR(i, 7), -256);
return _o_result; return _o_result;
} }
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);
}
INTEGER Reals_ExpoL (LONGREAL x) INTEGER Reals_ExpoL (LONGREAL x)
{ {
INTEGER _o_result; INTEGER _o_result;
INTEGER i; INTEGER i;
LONGINT l; __GET((LONGINT)(uintptr_t)&x + 6, i, INTEGER);
__GET((LONGINT)(uintptr_t)&x + 4, l, LONGINT); _o_result = __MASK(__ASHR(i, 4), -2048);
_o_result = (int)__MASK(__ASHR(l, 20), -2048);
return _o_result; return _o_result;
} }
@ -115,34 +127,29 @@ static CHAR Reals_ToHex (INTEGER i)
__RETCHK; __RETCHK;
} }
typedef static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len)
CHAR (*pc4__3)[4];
void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len)
{ {
pc4__3 p = NIL;
INTEGER i; INTEGER i;
p = (pc4__3)(uintptr_t)((LONGINT)(uintptr_t)&y); LONGINT l;
CHAR by;
i = 0; i = 0;
while (i < 4) { l = b__len;
d[__X(__ASHL(i, 1), d__len)] = Reals_ToHex(__ASHR((int)(*p)[__X(i, ((LONGINT)(4)))], 4)); while ((LONGINT)i < l) {
d[__X(__ASHL(i, 1) + 1, d__len)] = Reals_ToHex(__MASK((int)(*p)[__X(i, ((LONGINT)(4)))], -16)); 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));
i += 1;
} }
} }
typedef void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len)
CHAR (*pc8__5)[8];
void Reals_ConvertHL (LONGREAL y, CHAR *d, LONGINT d__len)
{ {
pc8__5 p = NIL; Reals_BytesToHex((void*)&y, ((LONGINT)(4)), (void*)d, d__len * ((LONGINT)(1)));
INTEGER i; }
p = (pc8__5)(uintptr_t)((LONGINT)(uintptr_t)&y);
i = 0; void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len)
while (i < 8) { {
d[__X(__ASHL(i, 1), d__len)] = Reals_ToHex(__ASHR((int)(*p)[__X(i, ((LONGINT)(8)))], 4)); Reals_BytesToHex((void*)&x, ((LONGINT)(8)), (void*)d, d__len * ((LONGINT)(1)));
d[__X(__ASHL(i, 1) + 1, d__len)] = Reals_ToHex(__MASK((int)(*p)[__X(i, ((LONGINT)(8)))], -16));
}
} }

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#ifndef Reals__h #ifndef Reals__h
#define Reals__h #define Reals__h
@ -10,10 +10,11 @@
import void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len); import void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len);
import void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len); import void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len);
import void Reals_ConvertHL (LONGREAL y, CHAR *d, LONGINT d__len); import void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len);
import void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len); import void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len);
import INTEGER Reals_Expo (REAL x); import INTEGER Reals_Expo (REAL x);
import INTEGER Reals_ExpoL (LONGREAL x); import INTEGER Reals_ExpoL (LONGREAL x);
import void Reals_SetExpo (REAL *x, INTEGER ex);
import REAL Reals_Ten (INTEGER e); import REAL Reals_Ten (INTEGER e);
import LONGREAL Reals_TenL (INTEGER e); import LONGREAL Reals_TenL (INTEGER e);
import void *Reals__init(void); import void *Reals__init(void);

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

@ -134,10 +134,7 @@ static int __str_cmp(CHAR *x, CHAR *y){
/* SYSTEM ops */ /* SYSTEM ops */
//#define __VAL(t, x) ((t)(x))
//#define __VALP(t, x) ((t)(uintptr_t)(x))
#define __VAL(t, x) (*(t*)&(x)) #define __VAL(t, x) (*(t*)&(x))
#define __VALP(t, x) (*(t*)&(x))
#define __GET(a, x, t) x= *(t*)(uintptr_t)(a) #define __GET(a, x, t) x= *(t*)(uintptr_t)(a)

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

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

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

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

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
#include "Files.h" #include "Files.h"
#include "Modules.h" #include "Modules.h"

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

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

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

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

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
typedef typedef

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
#include "Platform.h" #include "Platform.h"

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

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

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

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

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

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

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin tskSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin tskSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
struct Heap__1 { struct Heap__1 {

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

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

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

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

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

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

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
#include "OPM.h" #include "OPM.h"
#include "OPS.h" #include "OPS.h"
@ -36,6 +36,7 @@ export void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ);
static BOOLEAN OPB_IntToBool (LONGINT i); static BOOLEAN OPB_IntToBool (LONGINT i);
static OPT_Struct OPB_IntType (LONGINT size); static OPT_Struct OPB_IntType (LONGINT size);
export void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y); export void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y);
static LONGINT OPB_LongerSize (LONGINT i);
export void OPB_MOp (SHORTINT op, OPT_Node *x); export void OPB_MOp (SHORTINT op, OPT_Node *x);
export OPT_Node OPB_NewBoolConst (BOOLEAN boolval); export OPT_Node OPB_NewBoolConst (BOOLEAN boolval);
export OPT_Node OPB_NewIntConst (LONGINT intval); export OPT_Node OPB_NewIntConst (LONGINT intval);
@ -52,6 +53,7 @@ export void OPB_Return (OPT_Node *x, OPT_Object proc);
export void OPB_SetElem (OPT_Node *x); export void OPB_SetElem (OPT_Node *x);
static void OPB_SetIntType (OPT_Node node); static void OPB_SetIntType (OPT_Node node);
export void OPB_SetRange (OPT_Node *x, OPT_Node y); export void OPB_SetRange (OPT_Node *x, OPT_Node y);
static LONGINT OPB_ShorterSize (LONGINT i);
static INTEGER OPB_SignedByteSize (LONGINT n); static INTEGER OPB_SignedByteSize (LONGINT n);
static LONGINT OPB_SignedMaximum (LONGINT bytecount); static LONGINT OPB_SignedMaximum (LONGINT bytecount);
static LONGINT OPB_SignedMinimum (LONGINT bytecount); static LONGINT OPB_SignedMinimum (LONGINT bytecount);
@ -224,6 +226,23 @@ OPT_Node OPB_EmptySet (void)
return _o_result; return _o_result;
} }
static LONGINT OPB_SignedMaximum (LONGINT bytecount)
{
LONGINT _o_result;
LONGINT result;
result = 1;
result = __LSH(result, __ASHL(bytecount, 3) - 1, LONGINT);
_o_result = result - 1;
return _o_result;
}
static LONGINT OPB_SignedMinimum (LONGINT bytecount)
{
LONGINT _o_result;
_o_result = -OPB_SignedMaximum(bytecount) - 1;
return _o_result;
}
static INTEGER OPB_SignedByteSize (LONGINT n) static INTEGER OPB_SignedByteSize (LONGINT n)
{ {
INTEGER _o_result; INTEGER _o_result;
@ -232,17 +251,39 @@ static INTEGER OPB_SignedByteSize (LONGINT n)
n = -(n + 1); n = -(n + 1);
} }
b = 1; b = 1;
while (b < 8) { while ((b < 8 && __ASH(n, -(__ASHL(b, 3) - 1)) != 0)) {
if (__ASH(n, -(__ASHL(b, 3) - 1)) == 0) {
_o_result = b;
return _o_result;
}
b += 1; b += 1;
} }
_o_result = 8; _o_result = b;
return _o_result; return _o_result;
} }
static LONGINT OPB_ShorterSize (LONGINT i)
{
LONGINT _o_result;
if (i >= (LONGINT)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 <= (LONGINT)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) static OPT_Struct OPB_IntType (LONGINT size)
{ {
OPT_Struct _o_result; OPT_Struct _o_result;
@ -407,16 +448,16 @@ void OPB_Field (OPT_Node *x, OPT_Object y)
} }
} }
static struct TypTest__61 { static struct TypTest__63 {
OPT_Node *x; OPT_Node *x;
OPT_Object *obj; OPT_Object *obj;
BOOLEAN *guard; BOOLEAN *guard;
struct TypTest__61 *lnk; struct TypTest__63 *lnk;
} *TypTest__61_s; } *TypTest__63_s;
static void GTT__62 (OPT_Struct t0, OPT_Struct t1); static void GTT__64 (OPT_Struct t0, OPT_Struct t1);
static void GTT__62 (OPT_Struct t0, OPT_Struct t1) static void GTT__64 (OPT_Struct t0, OPT_Struct t1)
{ {
OPT_Node node = NIL; OPT_Node node = NIL;
OPT_Struct t = NIL; OPT_Struct t = NIL;
@ -429,54 +470,54 @@ static void GTT__62 (OPT_Struct t0, OPT_Struct t1)
t1 = t1->BaseTyp; t1 = t1->BaseTyp;
} }
if (t1 == t0 || t0->form == 0) { if (t1 == t0 || t0->form == 0) {
if (*TypTest__61_s->guard) { if (*TypTest__63_s->guard) {
OPB_BindNodes(5, NIL, &*TypTest__61_s->x, NIL); OPB_BindNodes(5, NIL, &*TypTest__63_s->x, NIL);
(*TypTest__61_s->x)->readonly = (*TypTest__61_s->x)->left->readonly; (*TypTest__63_s->x)->readonly = (*TypTest__63_s->x)->left->readonly;
} else { } else {
node = OPT_NewNode(11); node = OPT_NewNode(11);
node->subcl = 16; node->subcl = 16;
node->left = *TypTest__61_s->x; node->left = *TypTest__63_s->x;
node->obj = *TypTest__61_s->obj; node->obj = *TypTest__63_s->obj;
*TypTest__61_s->x = node; *TypTest__63_s->x = node;
} }
} else { } else {
OPB_err(85); OPB_err(85);
} }
} else if (t0 != t1) { } else if (t0 != t1) {
OPB_err(85); OPB_err(85);
} else if (!*TypTest__61_s->guard) { } else if (!*TypTest__63_s->guard) {
if ((*TypTest__61_s->x)->class == 5) { if ((*TypTest__63_s->x)->class == 5) {
node = OPT_NewNode(11); node = OPT_NewNode(11);
node->subcl = 16; node->subcl = 16;
node->left = *TypTest__61_s->x; node->left = *TypTest__63_s->x;
node->obj = *TypTest__61_s->obj; node->obj = *TypTest__63_s->obj;
*TypTest__61_s->x = node; *TypTest__63_s->x = node;
} else { } else {
*TypTest__61_s->x = OPB_NewBoolConst(1); *TypTest__63_s->x = OPB_NewBoolConst(1);
} }
} }
} }
void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard) void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
{ {
struct TypTest__61 _s; struct TypTest__63 _s;
_s.x = x; _s.x = x;
_s.obj = &obj; _s.obj = &obj;
_s.guard = &guard; _s.guard = &guard;
_s.lnk = TypTest__61_s; _s.lnk = TypTest__63_s;
TypTest__61_s = &_s; TypTest__63_s = &_s;
if (OPB_NotVar(*x)) { if (OPB_NotVar(*x)) {
OPB_err(112); OPB_err(112);
} else if ((*x)->typ->form == 13) { } else if ((*x)->typ->form == 13) {
if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) { if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) {
OPB_err(85); OPB_err(85);
} else if (obj->typ->form == 13) { } else if (obj->typ->form == 13) {
GTT__62((*x)->typ->BaseTyp, obj->typ->BaseTyp); GTT__64((*x)->typ->BaseTyp, obj->typ->BaseTyp);
} else { } else {
OPB_err(86); OPB_err(86);
} }
} else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) { } else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) {
GTT__62((*x)->typ, obj->typ); GTT__64((*x)->typ, obj->typ);
} else { } else {
OPB_err(87); OPB_err(87);
} }
@ -485,7 +526,7 @@ void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
} else { } else {
(*x)->typ = OPT_booltyp; (*x)->typ = OPT_booltyp;
} }
TypTest__61_s = _s.lnk; TypTest__63_s = _s.lnk;
} }
void OPB_In (OPT_Node *x, OPT_Node y) void OPB_In (OPT_Node *x, OPT_Node y)
@ -551,13 +592,13 @@ static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x)
x->intval = -1; x->intval = -1;
} }
static struct MOp__29 { static struct MOp__30 {
struct MOp__29 *lnk; struct MOp__30 *lnk;
} *MOp__29_s; } *MOp__30_s;
static OPT_Node NewOp__30 (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__30 (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 _o_result;
OPT_Node node = NIL; OPT_Node node = NIL;
@ -574,9 +615,9 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
INTEGER f; INTEGER f;
OPT_Struct typ = NIL; OPT_Struct typ = NIL;
OPT_Node z = NIL; OPT_Node z = NIL;
struct MOp__29 _s; struct MOp__30 _s;
_s.lnk = MOp__29_s; _s.lnk = MOp__30_s;
MOp__29_s = &_s; MOp__30_s = &_s;
z = *x; z = *x;
if (z->class == 8 || z->class == 9) { if (z->class == 8 || z->class == 9) {
OPB_err(126); OPB_err(126);
@ -590,7 +631,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval)); z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval));
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__30(op, typ, z); z = NewOp__31(op, typ, z);
} }
} else { } else {
OPB_err(98); OPB_err(98);
@ -618,7 +659,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
} }
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__30(op, typ, z); z = NewOp__31(op, typ, z);
} }
} else { } else {
OPB_err(97); OPB_err(97);
@ -639,7 +680,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
} }
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__30(op, typ, z); z = NewOp__31(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -651,7 +692,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->conval->intval = (int)__CAP((CHAR)z->conval->intval); z->conval->intval = (int)__CAP((CHAR)z->conval->intval);
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__30(op, typ, z); z = NewOp__31(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -664,7 +705,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval)); z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval));
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__30(op, typ, z); z = NewOp__31(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -677,7 +718,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
f = 10; f = 10;
} }
if (z->class < 7 || f == 10) { if (z->class < 7 || f == 10) {
z = NewOp__30(op, typ, z); z = NewOp__31(op, typ, z);
} else { } else {
OPB_err(127); OPB_err(127);
} }
@ -686,7 +727,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
case 25: case 25:
if ((__IN(f, 0x70) && z->class == 7)) { if ((__IN(f, 0x70) && z->class == 7)) {
if ((0 <= z->conval->intval && z->conval->intval <= -1)) { if ((0 <= z->conval->intval && z->conval->intval <= -1)) {
z = NewOp__30(op, typ, z); z = NewOp__31(op, typ, z);
} else { } else {
OPB_err(219); OPB_err(219);
} }
@ -703,7 +744,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
} }
} }
*x = z; *x = z;
MOp__29_s = _s.lnk; MOp__30_s = _s.lnk;
} }
static void OPB_CheckPtr (OPT_Node x, OPT_Node y) static void OPB_CheckPtr (OPT_Node x, OPT_Node y)
@ -1197,15 +1238,15 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
(*x)->typ = typ; (*x)->typ = typ;
} }
static struct Op__39 { static struct Op__40 {
INTEGER *f, *g; INTEGER *f, *g;
struct Op__39 *lnk; struct Op__40 *lnk;
} *Op__39_s; } *Op__40_s;
static void NewOp__40 (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);
static BOOLEAN strings__42 (OPT_Node *x, OPT_Node *y); static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y);
static void NewOp__40 (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; OPT_Node node = NIL;
node = OPT_NewNode(12); node = OPT_NewNode(12);
@ -1216,29 +1257,29 @@ static void NewOp__40 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
*x = node; *x = node;
} }
static BOOLEAN strings__42 (OPT_Node *x, OPT_Node *y) static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y)
{ {
BOOLEAN _o_result; BOOLEAN _o_result;
BOOLEAN ok, xCharArr, yCharArr; BOOLEAN ok, xCharArr, yCharArr;
xCharArr = (__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp->form == 3) || *Op__39_s->f == 10; 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__39_s->g == 10; yCharArr = (__IN((*y)->typ->comp, 0x0c) && (*y)->typ->BaseTyp->form == 3) || *Op__40_s->g == 10;
if ((((xCharArr && *Op__39_s->g == 3)) && (*y)->class == 7)) { if ((((xCharArr && *Op__40_s->g == 3)) && (*y)->class == 7)) {
OPB_CharToString(*y); OPB_CharToString(*y);
*Op__39_s->g = 10; *Op__40_s->g = 10;
yCharArr = 1; yCharArr = 1;
} }
if ((((yCharArr && *Op__39_s->f == 3)) && (*x)->class == 7)) { if ((((yCharArr && *Op__40_s->f == 3)) && (*x)->class == 7)) {
OPB_CharToString(*x); OPB_CharToString(*x);
*Op__39_s->f = 10; *Op__40_s->f = 10;
xCharArr = 1; xCharArr = 1;
} }
ok = (xCharArr && yCharArr); ok = (xCharArr && yCharArr);
if (ok) { if (ok) {
if ((*Op__39_s->f == 10 && (*x)->conval->intval2 == 1)) { if ((*Op__40_s->f == 10 && (*x)->conval->intval2 == 1)) {
(*x)->typ = OPT_chartyp; (*x)->typ = OPT_chartyp;
(*x)->conval->intval = 0; (*x)->conval->intval = 0;
OPB_Index(&*y, OPB_NewIntConst(((LONGINT)(0)))); OPB_Index(&*y, OPB_NewIntConst(((LONGINT)(0))));
} else if ((*Op__39_s->g == 10 && (*y)->conval->intval2 == 1)) { } else if ((*Op__40_s->g == 10 && (*y)->conval->intval2 == 1)) {
(*y)->typ = OPT_chartyp; (*y)->typ = OPT_chartyp;
(*y)->conval->intval = 0; (*y)->conval->intval = 0;
OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0)))); OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0))));
@ -1255,11 +1296,11 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPT_Struct typ = NIL; OPT_Struct typ = NIL;
BOOLEAN do_; BOOLEAN do_;
LONGINT val; LONGINT val;
struct Op__39 _s; struct Op__40 _s;
_s.f = &f; _s.f = &f;
_s.g = &g; _s.g = &g;
_s.lnk = Op__39_s; _s.lnk = Op__40_s;
Op__39_s = &_s; Op__40_s = &_s;
z = *x; z = *x;
if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) { if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) {
OPB_err(126); OPB_err(126);
@ -1371,7 +1412,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp; typ = OPT_undftyp;
} }
if (do_) { if (do_) {
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
} }
break; break;
case 2: case 2:
@ -1390,7 +1431,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(102); OPB_err(102);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
break; break;
case 3: case 3:
do_ = 1; do_ = 1;
@ -1413,7 +1454,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp; typ = OPT_undftyp;
} }
if (do_) { if (do_) {
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
} }
break; break;
case 4: case 4:
@ -1431,7 +1472,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(104); OPB_err(104);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
break; break;
case 5: case 5:
if (f == 2) { if (f == 2) {
@ -1441,7 +1482,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
} }
} else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) { } else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) {
} else { } else {
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
} }
} else if (f != 0) { } else if (f != 0) {
OPB_err(94); OPB_err(94);
@ -1464,7 +1505,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
} }
} }
if (do_) { if (do_) {
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
} }
break; break;
case 7: case 7:
@ -1473,7 +1514,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp; typ = OPT_undftyp;
} }
if ((!__IN(f, 0x70) || y->class != 7) || y->conval->intval != 0) { if ((!__IN(f, 0x70) || y->class != 7) || y->conval->intval != 0) {
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
} }
break; break;
case 8: case 8:
@ -1484,7 +1525,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
} }
} else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) { } else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) {
} else { } else {
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
} }
} else if (f != 0) { } else if (f != 0) {
OPB_err(95); OPB_err(95);
@ -1492,16 +1533,16 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
} }
break; break;
case 9: case 10: case 9: case 10:
if (__IN(f, 0x6bff) || strings__42(&z, &y)) { if (__IN(f, 0x6bff) || strings__43(&z, &y)) {
typ = OPT_booltyp; typ = OPT_booltyp;
} else { } else {
OPB_err(107); OPB_err(107);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
break; break;
case 11: case 12: case 13: case 14: case 11: case 12: case 13: case 14:
if (__IN(f, 0x01f9) || strings__42(&z, &y)) { if (__IN(f, 0x01f9) || strings__43(&z, &y)) {
typ = OPT_booltyp; typ = OPT_booltyp;
} else { } else {
OPM_LogWLn(); OPM_LogWLn();
@ -1510,7 +1551,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(108); OPB_err(108);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
break; break;
default: default:
OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", (LONGINT)32); OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", (LONGINT)32);
@ -1520,7 +1561,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
} }
} }
*x = z; *x = z;
Op__39_s = _s.lnk; Op__40_s = _s.lnk;
} }
void OPB_SetRange (OPT_Node *x, OPT_Node y) void OPB_SetRange (OPT_Node *x, OPT_Node y)
@ -1613,7 +1654,7 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
case 0: case 10: case 0: case 10:
break; break;
case 1: case 1:
if (!__IN(g, 0x1a)) { if (!((__IN(g, 0x7a) && y->size == 1))) {
OPB_err(113); OPB_err(113);
} }
break; break;
@ -1725,23 +1766,6 @@ static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo)
{ {
} }
static LONGINT OPB_SignedMaximum (LONGINT bytecount)
{
LONGINT _o_result;
LONGINT result;
result = 1;
result = __LSH(result, __ASHL(bytecount, 3) - 1, LONGINT);
_o_result = result - 1;
return _o_result;
}
static LONGINT OPB_SignedMinimum (LONGINT bytecount)
{
LONGINT _o_result;
_o_result = -OPB_SignedMaximum(bytecount) - 1;
return _o_result;
}
void OPB_StPar0 (OPT_Node *par0, INTEGER fctno) void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
{ {
INTEGER f; INTEGER f;
@ -1889,10 +1913,8 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 10: case 10:
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); OPB_err(126);
} else if (f == 5) { } else if ((__IN(f, 0x70) && x->typ->size > (LONGINT)OPM_SIntSize)) {
OPB_Convert(&x, OPT_sinttyp); OPB_Convert(&x, OPB_IntType(OPB_ShorterSize(x->typ->size)));
} else if (f == 6) {
OPB_Convert(&x, OPT_inttyp);
} else if (f == 8) { } else if (f == 8) {
OPB_Convert(&x, OPT_realtyp); OPB_Convert(&x, OPT_realtyp);
} else { } else {
@ -1902,10 +1924,8 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 11: case 11:
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); OPB_err(126);
} else if (f == 4) { } else if ((__IN(f, 0x70) && x->typ->size < (LONGINT)OPM_LIntSize)) {
OPB_Convert(&x, OPT_inttyp); OPB_Convert(&x, OPB_IntType(OPB_LongerSize(x->typ->size)));
} else if (f == 5) {
OPB_Convert(&x, OPT_linttyp);
} else if (f == 7) { } else if (f == 7) {
OPB_Convert(&x, OPT_lrltyp); OPB_Convert(&x, OPT_lrltyp);
} else if (f == 3) { } else if (f == 3) {
@ -1953,7 +1973,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); OPB_err(126);
} else if (__IN(f, 0x70)) { } else if (__IN(f, 0x70)) {
if (f != 6) { if (x->typ->size != (LONGINT)OPM_LIntSize) {
OPB_Convert(&x, OPT_linttyp); OPB_Convert(&x, OPT_linttyp);
} }
} else { } else {
@ -1991,9 +2011,9 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 24: case 25: case 28: case 31: case 24: case 25: case 28: case 31:
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); 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); OPB_Convert(&x, OPT_linttyp);
} else if (!__IN(f, 0x2040)) { } else if (!((__IN(x->typ->form, 0x2070) && x->typ->size == (LONGINT)OPM_PointerSize))) {
OPB_err(111); OPB_err(111);
x->typ = OPT_linttyp; x->typ = OPT_linttyp;
} }
@ -2042,13 +2062,13 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
*par0 = x; *par0 = x;
} }
static struct StPar1__56 { static struct StPar1__58 {
struct StPar1__56 *lnk; struct StPar1__58 *lnk;
} *StPar1__56_s; } *StPar1__58_s;
static OPT_Node NewOp__57 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right); static OPT_Node NewOp__59 (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__59 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right)
{ {
OPT_Node _o_result; OPT_Node _o_result;
OPT_Node node = NIL; OPT_Node node = NIL;
@ -2065,9 +2085,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
INTEGER f, L; INTEGER f, L;
OPT_Struct typ = NIL; OPT_Struct typ = NIL;
OPT_Node p = NIL, t = NIL; OPT_Node p = NIL, t = NIL;
struct StPar1__56 _s; struct StPar1__58 _s;
_s.lnk = StPar1__56_s; _s.lnk = StPar1__58_s;
StPar1__56_s = &_s; StPar1__58_s = &_s;
p = *par0; p = *par0;
f = x->typ->form; f = x->typ->form;
switch (fctno) { switch (fctno) {
@ -2083,7 +2103,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
OPB_err(111); OPB_err(111);
} }
} }
p = NewOp__57(19, fctno, p, x); p = NewOp__59(19, fctno, p, x);
p->typ = OPT_notyp; p->typ = OPT_notyp;
} }
break; break;
@ -2094,7 +2114,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
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 > (LONGINT)OPM_MaxSet))) {
OPB_err(202); OPB_err(202);
} }
p = NewOp__57(19, fctno, p, x); p = NewOp__59(19, fctno, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2119,7 +2139,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
p = p->left; p = p->left;
x->conval->intval += 1; x->conval->intval += 1;
} }
p = NewOp__57(12, 19, p, x); p = NewOp__59(12, 19, p, x);
p->typ = OPT_linttyp; p->typ = OPT_linttyp;
} else { } else {
p = x; p = x;
@ -2141,7 +2161,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
t = x; t = x;
x = p; x = p;
p = t; p = t;
p = NewOp__57(19, 18, p, x); p = NewOp__59(19, 18, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2167,7 +2187,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
} }
p->obj = NIL; p->obj = NIL;
} else { } else {
p = NewOp__57(12, 17, p, x); p = NewOp__59(12, 17, p, x);
p->typ = OPT_linttyp; p->typ = OPT_linttyp;
} }
} else { } else {
@ -2198,9 +2218,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
OPB_err(111); OPB_err(111);
} else { } else {
if (fctno == 22) { if (fctno == 22) {
p = NewOp__57(12, 27, p, x); p = NewOp__59(12, 27, p, x);
} else { } else {
p = NewOp__57(12, 28, p, x); p = NewOp__59(12, 28, p, x);
} }
p->typ = p->left->typ; p->typ = p->left->typ;
} }
@ -2217,7 +2237,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
x = p; x = p;
p = t; p = t;
} }
p = NewOp__57(19, fctno, p, x); p = NewOp__59(19, fctno, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2227,7 +2247,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); OPB_err(126);
} else if (__IN(f, 0x70)) { } else if (__IN(f, 0x70)) {
p = NewOp__57(12, 26, p, x); p = NewOp__59(12, 26, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2251,7 +2271,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); OPB_err(126);
} else if (__IN(f, 0x70)) { } else if (__IN(f, 0x70)) {
p = NewOp__57(19, 30, p, x); p = NewOp__59(19, 30, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2260,9 +2280,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 31: case 31:
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); 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); OPB_Convert(&x, OPT_linttyp);
} else if (!__IN(f, 0x2040)) { } else if (!((__IN(x->typ->form, 0x2070) && x->typ->size == (LONGINT)OPM_PointerSize))) {
OPB_err(111); OPB_err(111);
x->typ = OPT_linttyp; x->typ = OPT_linttyp;
} }
@ -2297,7 +2317,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
break; break;
} }
*par0 = p; *par0 = p;
StPar1__56_s = _s.lnk; StPar1__58_s = _s.lnk;
} }
void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n) void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
@ -2416,7 +2436,7 @@ static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpa
ftyp = ftyp->BaseTyp; ftyp = ftyp->BaseTyp;
atyp = atyp->BaseTyp; atyp = atyp->BaseTyp;
if ((fvarpar && ftyp == OPT_bytetyp)) { 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)) { if (__IN(18, OPM_opt)) {
OPB_err(-301); OPB_err(-301);
} }
@ -2499,7 +2519,7 @@ void OPB_Param (OPT_Node ap, OPT_Object fp)
OPB_err(111); OPB_err(111);
} }
} else if ((fp->typ == OPT_sysptrtyp && ap->typ->form == 13)) { } 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); OPB_err(123);
} else if ((fp->typ->form == 13 && ap->class == 5)) { } else if ((fp->typ->form == 13 && ap->class == 5)) {
OPB_err(123); OPB_err(123);

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

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

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

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

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPC__h #ifndef OPC__h
#define OPC__h #define OPC__h

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
#include "Configuration.h" #include "Configuration.h"
#include "Console.h" #include "Console.h"
@ -550,7 +550,10 @@ void OPM_FPrintReal (LONGINT *fp, REAL real)
void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr) void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr)
{ {
LONGINT l, h; LONGINT l, h;
OPM_FPrint(&*fp, __VAL(LONGINT, lr)); __GET((LONGINT)(uintptr_t)&lr, l, LONGINT);
__GET((LONGINT)(uintptr_t)&lr + 4, h, LONGINT);
OPM_FPrint(&*fp, l);
OPM_FPrint(&*fp, h);
} }
static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align) static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align)

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPM__h #ifndef OPM__h
#define OPM__h #define OPM__h

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
#include "OPB.h" #include "OPB.h"
#include "OPM.h" #include "OPM.h"

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

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

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin tspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin tspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
#include "OPM.h" #include "OPM.h"

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

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

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
#include "OPM.h" #include "OPM.h"
#include "OPS.h" #include "OPS.h"

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPT__h #ifndef OPT__h
#define OPT__h #define OPT__h

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
#include "OPC.h" #include "OPC.h"
#include "OPM.h" #include "OPM.h"
@ -962,12 +962,8 @@ static void OPV_expr (OPT_Node n, INTEGER prec)
OPM_WriteString((CHAR*)"(uintptr_t)", (LONGINT)12); OPM_WriteString((CHAR*)"(uintptr_t)", (LONGINT)12);
} }
OPV_expr(l, exprPrec); OPV_expr(l, exprPrec);
} else {
if (__IN(n->typ->form, 0x6000) || __IN(l->typ->form, 0x6000)) {
OPM_WriteString((CHAR*)"__VALP(", (LONGINT)8);
} else { } else {
OPM_WriteString((CHAR*)"__VAL(", (LONGINT)7); OPM_WriteString((CHAR*)"__VAL(", (LONGINT)7);
}
OPC_Ident(n->typ->strobj); OPC_Ident(n->typ->strobj);
OPM_WriteString((CHAR*)", ", (LONGINT)3); OPM_WriteString((CHAR*)", ", (LONGINT)3);
OPV_expr(l, -1); OPV_expr(l, -1);

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

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

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
typedef typedef

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

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

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

@ -1,15 +1,17 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len);
export void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len); export void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len);
export void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len); export void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len);
export void Reals_ConvertHL (LONGREAL y, CHAR *d, LONGINT d__len); export void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len);
export void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len); export void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len);
export INTEGER Reals_Expo (REAL x); export INTEGER Reals_Expo (REAL x);
export INTEGER Reals_ExpoL (LONGREAL x); export INTEGER Reals_ExpoL (LONGREAL x);
export void Reals_SetExpo (REAL *x, INTEGER ex);
export REAL Reals_Ten (INTEGER e); export REAL Reals_Ten (INTEGER e);
export LONGREAL Reals_TenL (INTEGER e); export LONGREAL Reals_TenL (INTEGER e);
static CHAR Reals_ToHex (INTEGER i); static CHAR Reals_ToHex (INTEGER i);
@ -55,17 +57,27 @@ LONGREAL Reals_TenL (INTEGER e)
INTEGER Reals_Expo (REAL x) INTEGER Reals_Expo (REAL x)
{ {
INTEGER _o_result; INTEGER _o_result;
_o_result = (int)__MASK(__ASHR((LONGINT)(__VAL(INTEGER, x)), 23), -256); INTEGER i;
__GET((LONGINT)(uintptr_t)&x + 2, i, INTEGER);
_o_result = __MASK(__ASHR(i, 7), -256);
return _o_result; return _o_result;
} }
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);
}
INTEGER Reals_ExpoL (LONGREAL x) INTEGER Reals_ExpoL (LONGREAL x)
{ {
INTEGER _o_result; INTEGER _o_result;
INTEGER i; INTEGER i;
LONGINT l; __GET((LONGINT)(uintptr_t)&x + 6, i, INTEGER);
__GET((LONGINT)(uintptr_t)&x + 4, l, LONGINT); _o_result = __MASK(__ASHR(i, 4), -2048);
_o_result = (int)__MASK(__ASHR(l, 20), -2048);
return _o_result; return _o_result;
} }
@ -115,34 +127,29 @@ static CHAR Reals_ToHex (INTEGER i)
__RETCHK; __RETCHK;
} }
typedef static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len)
CHAR (*pc4__3)[4];
void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len)
{ {
pc4__3 p = NIL;
INTEGER i; INTEGER i;
p = (pc4__3)(uintptr_t)((LONGINT)(uintptr_t)&y); LONGINT l;
CHAR by;
i = 0; i = 0;
while (i < 4) { l = b__len;
d[__X(__ASHL(i, 1), d__len)] = Reals_ToHex(__ASHR((int)(*p)[__X(i, ((LONGINT)(4)))], 4)); while ((LONGINT)i < l) {
d[__X(__ASHL(i, 1) + 1, d__len)] = Reals_ToHex(__MASK((int)(*p)[__X(i, ((LONGINT)(4)))], -16)); 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));
i += 1;
} }
} }
typedef void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len)
CHAR (*pc8__5)[8];
void Reals_ConvertHL (LONGREAL y, CHAR *d, LONGINT d__len)
{ {
pc8__5 p = NIL; Reals_BytesToHex((void*)&y, ((LONGINT)(4)), (void*)d, d__len * ((LONGINT)(1)));
INTEGER i; }
p = (pc8__5)(uintptr_t)((LONGINT)(uintptr_t)&y);
i = 0; void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len)
while (i < 8) { {
d[__X(__ASHL(i, 1), d__len)] = Reals_ToHex(__ASHR((int)(*p)[__X(i, ((LONGINT)(8)))], 4)); Reals_BytesToHex((void*)&x, ((LONGINT)(8)), (void*)d, d__len * ((LONGINT)(1)));
d[__X(__ASHL(i, 1) + 1, d__len)] = Reals_ToHex(__MASK((int)(*p)[__X(i, ((LONGINT)(8)))], -16));
}
} }

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#ifndef Reals__h #ifndef Reals__h
#define Reals__h #define Reals__h
@ -10,10 +10,11 @@
import void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len); import void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len);
import void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len); import void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len);
import void Reals_ConvertHL (LONGREAL y, CHAR *d, LONGINT d__len); import void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len);
import void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len); import void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len);
import INTEGER Reals_Expo (REAL x); import INTEGER Reals_Expo (REAL x);
import INTEGER Reals_ExpoL (LONGREAL x); import INTEGER Reals_ExpoL (LONGREAL x);
import void Reals_SetExpo (REAL *x, INTEGER ex);
import REAL Reals_Ten (INTEGER e); import REAL Reals_Ten (INTEGER e);
import LONGREAL Reals_TenL (INTEGER e); import LONGREAL Reals_TenL (INTEGER e);
import void *Reals__init(void); import void *Reals__init(void);

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

@ -134,10 +134,7 @@ static int __str_cmp(CHAR *x, CHAR *y){
/* SYSTEM ops */ /* SYSTEM ops */
//#define __VAL(t, x) ((t)(x))
//#define __VALP(t, x) ((t)(uintptr_t)(x))
#define __VAL(t, x) (*(t*)&(x)) #define __VAL(t, x) (*(t*)&(x))
#define __VALP(t, x) (*(t*)&(x))
#define __GET(a, x, t) x= *(t*)(uintptr_t)(a) #define __GET(a, x, t) x= *(t*)(uintptr_t)(a)

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

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

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

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

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
#include "Files.h" #include "Files.h"
#include "Modules.h" #include "Modules.h"

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

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

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

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

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
typedef typedef

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

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

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

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

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

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

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

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

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

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

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

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

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

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

2
bootstrap/unix-88/Console.c
View file

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

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

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

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin tspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin tspkaSfF */
#define LARGE #define LARGE
#include "SYSTEM.h" #include "SYSTEM.h"
#include "Configuration.h" #include "Configuration.h"

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

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

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin tskSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin tskSfF */
#define LARGE #define LARGE
#include "SYSTEM.h" #include "SYSTEM.h"

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

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

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

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

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

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

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#define LARGE #define LARGE
#include "SYSTEM.h" #include "SYSTEM.h"
#include "OPM.h" #include "OPM.h"
@ -37,6 +37,7 @@ export void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ);
static BOOLEAN OPB_IntToBool (LONGINT i); static BOOLEAN OPB_IntToBool (LONGINT i);
static OPT_Struct OPB_IntType (LONGINT size); static OPT_Struct OPB_IntType (LONGINT size);
export void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y); export void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y);
static LONGINT OPB_LongerSize (LONGINT i);
export void OPB_MOp (SHORTINT op, OPT_Node *x); export void OPB_MOp (SHORTINT op, OPT_Node *x);
export OPT_Node OPB_NewBoolConst (BOOLEAN boolval); export OPT_Node OPB_NewBoolConst (BOOLEAN boolval);
export OPT_Node OPB_NewIntConst (LONGINT intval); export OPT_Node OPB_NewIntConst (LONGINT intval);
@ -53,6 +54,7 @@ export void OPB_Return (OPT_Node *x, OPT_Object proc);
export void OPB_SetElem (OPT_Node *x); export void OPB_SetElem (OPT_Node *x);
static void OPB_SetIntType (OPT_Node node); static void OPB_SetIntType (OPT_Node node);
export void OPB_SetRange (OPT_Node *x, OPT_Node y); export void OPB_SetRange (OPT_Node *x, OPT_Node y);
static LONGINT OPB_ShorterSize (LONGINT i);
static INTEGER OPB_SignedByteSize (LONGINT n); static INTEGER OPB_SignedByteSize (LONGINT n);
static LONGINT OPB_SignedMaximum (LONGINT bytecount); static LONGINT OPB_SignedMaximum (LONGINT bytecount);
static LONGINT OPB_SignedMinimum (LONGINT bytecount); static LONGINT OPB_SignedMinimum (LONGINT bytecount);
@ -225,6 +227,23 @@ OPT_Node OPB_EmptySet (void)
return _o_result; return _o_result;
} }
static LONGINT OPB_SignedMaximum (LONGINT bytecount)
{
LONGINT _o_result;
LONGINT result;
result = 1;
result = __LSH(result, __ASHL(bytecount, 3) - 1, LONGINT);
_o_result = result - 1;
return _o_result;
}
static LONGINT OPB_SignedMinimum (LONGINT bytecount)
{
LONGINT _o_result;
_o_result = -OPB_SignedMaximum(bytecount) - 1;
return _o_result;
}
static INTEGER OPB_SignedByteSize (LONGINT n) static INTEGER OPB_SignedByteSize (LONGINT n)
{ {
INTEGER _o_result; INTEGER _o_result;
@ -233,17 +252,39 @@ static INTEGER OPB_SignedByteSize (LONGINT n)
n = -(n + 1); n = -(n + 1);
} }
b = 1; b = 1;
while (b < 8) { while ((b < 8 && __ASH(n, -(__ASHL(b, 3) - 1)) != 0)) {
if (__ASH(n, -(__ASHL(b, 3) - 1)) == 0) {
_o_result = b;
return _o_result;
}
b += 1; b += 1;
} }
_o_result = 8; _o_result = b;
return _o_result; return _o_result;
} }
static LONGINT OPB_ShorterSize (LONGINT i)
{
LONGINT _o_result;
if (i >= (LONGINT)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 <= (LONGINT)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) static OPT_Struct OPB_IntType (LONGINT size)
{ {
OPT_Struct _o_result; OPT_Struct _o_result;
@ -408,16 +449,16 @@ void OPB_Field (OPT_Node *x, OPT_Object y)
} }
} }
static struct TypTest__61 { static struct TypTest__63 {
OPT_Node *x; OPT_Node *x;
OPT_Object *obj; OPT_Object *obj;
BOOLEAN *guard; BOOLEAN *guard;
struct TypTest__61 *lnk; struct TypTest__63 *lnk;
} *TypTest__61_s; } *TypTest__63_s;
static void GTT__62 (OPT_Struct t0, OPT_Struct t1); static void GTT__64 (OPT_Struct t0, OPT_Struct t1);
static void GTT__62 (OPT_Struct t0, OPT_Struct t1) static void GTT__64 (OPT_Struct t0, OPT_Struct t1)
{ {
OPT_Node node = NIL; OPT_Node node = NIL;
OPT_Struct t = NIL; OPT_Struct t = NIL;
@ -430,54 +471,54 @@ static void GTT__62 (OPT_Struct t0, OPT_Struct t1)
t1 = t1->BaseTyp; t1 = t1->BaseTyp;
} }
if (t1 == t0 || t0->form == 0) { if (t1 == t0 || t0->form == 0) {
if (*TypTest__61_s->guard) { if (*TypTest__63_s->guard) {
OPB_BindNodes(5, NIL, &*TypTest__61_s->x, NIL); OPB_BindNodes(5, NIL, &*TypTest__63_s->x, NIL);
(*TypTest__61_s->x)->readonly = (*TypTest__61_s->x)->left->readonly; (*TypTest__63_s->x)->readonly = (*TypTest__63_s->x)->left->readonly;
} else { } else {
node = OPT_NewNode(11); node = OPT_NewNode(11);
node->subcl = 16; node->subcl = 16;
node->left = *TypTest__61_s->x; node->left = *TypTest__63_s->x;
node->obj = *TypTest__61_s->obj; node->obj = *TypTest__63_s->obj;
*TypTest__61_s->x = node; *TypTest__63_s->x = node;
} }
} else { } else {
OPB_err(85); OPB_err(85);
} }
} else if (t0 != t1) { } else if (t0 != t1) {
OPB_err(85); OPB_err(85);
} else if (!*TypTest__61_s->guard) { } else if (!*TypTest__63_s->guard) {
if ((*TypTest__61_s->x)->class == 5) { if ((*TypTest__63_s->x)->class == 5) {
node = OPT_NewNode(11); node = OPT_NewNode(11);
node->subcl = 16; node->subcl = 16;
node->left = *TypTest__61_s->x; node->left = *TypTest__63_s->x;
node->obj = *TypTest__61_s->obj; node->obj = *TypTest__63_s->obj;
*TypTest__61_s->x = node; *TypTest__63_s->x = node;
} else { } else {
*TypTest__61_s->x = OPB_NewBoolConst(1); *TypTest__63_s->x = OPB_NewBoolConst(1);
} }
} }
} }
void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard) void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
{ {
struct TypTest__61 _s; struct TypTest__63 _s;
_s.x = x; _s.x = x;
_s.obj = &obj; _s.obj = &obj;
_s.guard = &guard; _s.guard = &guard;
_s.lnk = TypTest__61_s; _s.lnk = TypTest__63_s;
TypTest__61_s = &_s; TypTest__63_s = &_s;
if (OPB_NotVar(*x)) { if (OPB_NotVar(*x)) {
OPB_err(112); OPB_err(112);
} else if ((*x)->typ->form == 13) { } else if ((*x)->typ->form == 13) {
if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) { if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) {
OPB_err(85); OPB_err(85);
} else if (obj->typ->form == 13) { } else if (obj->typ->form == 13) {
GTT__62((*x)->typ->BaseTyp, obj->typ->BaseTyp); GTT__64((*x)->typ->BaseTyp, obj->typ->BaseTyp);
} else { } else {
OPB_err(86); OPB_err(86);
} }
} else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) { } else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) {
GTT__62((*x)->typ, obj->typ); GTT__64((*x)->typ, obj->typ);
} else { } else {
OPB_err(87); OPB_err(87);
} }
@ -486,7 +527,7 @@ void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
} else { } else {
(*x)->typ = OPT_booltyp; (*x)->typ = OPT_booltyp;
} }
TypTest__61_s = _s.lnk; TypTest__63_s = _s.lnk;
} }
void OPB_In (OPT_Node *x, OPT_Node y) void OPB_In (OPT_Node *x, OPT_Node y)
@ -552,13 +593,13 @@ static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x)
x->intval = -1; x->intval = -1;
} }
static struct MOp__29 { static struct MOp__30 {
struct MOp__29 *lnk; struct MOp__30 *lnk;
} *MOp__29_s; } *MOp__30_s;
static OPT_Node NewOp__30 (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__30 (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 _o_result;
OPT_Node node = NIL; OPT_Node node = NIL;
@ -575,9 +616,9 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
INTEGER f; INTEGER f;
OPT_Struct typ = NIL; OPT_Struct typ = NIL;
OPT_Node z = NIL; OPT_Node z = NIL;
struct MOp__29 _s; struct MOp__30 _s;
_s.lnk = MOp__29_s; _s.lnk = MOp__30_s;
MOp__29_s = &_s; MOp__30_s = &_s;
z = *x; z = *x;
if (z->class == 8 || z->class == 9) { if (z->class == 8 || z->class == 9) {
OPB_err(126); OPB_err(126);
@ -591,7 +632,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval)); z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval));
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__30(op, typ, z); z = NewOp__31(op, typ, z);
} }
} else { } else {
OPB_err(98); OPB_err(98);
@ -619,7 +660,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
} }
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__30(op, typ, z); z = NewOp__31(op, typ, z);
} }
} else { } else {
OPB_err(97); OPB_err(97);
@ -640,7 +681,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
} }
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__30(op, typ, z); z = NewOp__31(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -652,7 +693,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->conval->intval = (int)__CAP((CHAR)z->conval->intval); z->conval->intval = (int)__CAP((CHAR)z->conval->intval);
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__30(op, typ, z); z = NewOp__31(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -665,7 +706,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval)); z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval));
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__30(op, typ, z); z = NewOp__31(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -678,7 +719,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
f = 10; f = 10;
} }
if (z->class < 7 || f == 10) { if (z->class < 7 || f == 10) {
z = NewOp__30(op, typ, z); z = NewOp__31(op, typ, z);
} else { } else {
OPB_err(127); OPB_err(127);
} }
@ -687,7 +728,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
case 25: case 25:
if ((__IN(f, 0x70) && z->class == 7)) { if ((__IN(f, 0x70) && z->class == 7)) {
if ((0 <= z->conval->intval && z->conval->intval <= -1)) { if ((0 <= z->conval->intval && z->conval->intval <= -1)) {
z = NewOp__30(op, typ, z); z = NewOp__31(op, typ, z);
} else { } else {
OPB_err(219); OPB_err(219);
} }
@ -704,7 +745,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
} }
} }
*x = z; *x = z;
MOp__29_s = _s.lnk; MOp__30_s = _s.lnk;
} }
static void OPB_CheckPtr (OPT_Node x, OPT_Node y) static void OPB_CheckPtr (OPT_Node x, OPT_Node y)
@ -1198,15 +1239,15 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
(*x)->typ = typ; (*x)->typ = typ;
} }
static struct Op__39 { static struct Op__40 {
INTEGER *f, *g; INTEGER *f, *g;
struct Op__39 *lnk; struct Op__40 *lnk;
} *Op__39_s; } *Op__40_s;
static void NewOp__40 (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);
static BOOLEAN strings__42 (OPT_Node *x, OPT_Node *y); static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y);
static void NewOp__40 (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; OPT_Node node = NIL;
node = OPT_NewNode(12); node = OPT_NewNode(12);
@ -1217,29 +1258,29 @@ static void NewOp__40 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
*x = node; *x = node;
} }
static BOOLEAN strings__42 (OPT_Node *x, OPT_Node *y) static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y)
{ {
BOOLEAN _o_result; BOOLEAN _o_result;
BOOLEAN ok, xCharArr, yCharArr; BOOLEAN ok, xCharArr, yCharArr;
xCharArr = (__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp->form == 3) || *Op__39_s->f == 10; 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__39_s->g == 10; yCharArr = (__IN((*y)->typ->comp, 0x0c) && (*y)->typ->BaseTyp->form == 3) || *Op__40_s->g == 10;
if ((((xCharArr && *Op__39_s->g == 3)) && (*y)->class == 7)) { if ((((xCharArr && *Op__40_s->g == 3)) && (*y)->class == 7)) {
OPB_CharToString(*y); OPB_CharToString(*y);
*Op__39_s->g = 10; *Op__40_s->g = 10;
yCharArr = 1; yCharArr = 1;
} }
if ((((yCharArr && *Op__39_s->f == 3)) && (*x)->class == 7)) { if ((((yCharArr && *Op__40_s->f == 3)) && (*x)->class == 7)) {
OPB_CharToString(*x); OPB_CharToString(*x);
*Op__39_s->f = 10; *Op__40_s->f = 10;
xCharArr = 1; xCharArr = 1;
} }
ok = (xCharArr && yCharArr); ok = (xCharArr && yCharArr);
if (ok) { if (ok) {
if ((*Op__39_s->f == 10 && (*x)->conval->intval2 == 1)) { if ((*Op__40_s->f == 10 && (*x)->conval->intval2 == 1)) {
(*x)->typ = OPT_chartyp; (*x)->typ = OPT_chartyp;
(*x)->conval->intval = 0; (*x)->conval->intval = 0;
OPB_Index(&*y, OPB_NewIntConst(((LONGINT)(0)))); OPB_Index(&*y, OPB_NewIntConst(((LONGINT)(0))));
} else if ((*Op__39_s->g == 10 && (*y)->conval->intval2 == 1)) { } else if ((*Op__40_s->g == 10 && (*y)->conval->intval2 == 1)) {
(*y)->typ = OPT_chartyp; (*y)->typ = OPT_chartyp;
(*y)->conval->intval = 0; (*y)->conval->intval = 0;
OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0)))); OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0))));
@ -1256,11 +1297,11 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPT_Struct typ = NIL; OPT_Struct typ = NIL;
BOOLEAN do_; BOOLEAN do_;
LONGINT val; LONGINT val;
struct Op__39 _s; struct Op__40 _s;
_s.f = &f; _s.f = &f;
_s.g = &g; _s.g = &g;
_s.lnk = Op__39_s; _s.lnk = Op__40_s;
Op__39_s = &_s; Op__40_s = &_s;
z = *x; z = *x;
if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) { if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) {
OPB_err(126); OPB_err(126);
@ -1372,7 +1413,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp; typ = OPT_undftyp;
} }
if (do_) { if (do_) {
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
} }
break; break;
case 2: case 2:
@ -1391,7 +1432,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(102); OPB_err(102);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
break; break;
case 3: case 3:
do_ = 1; do_ = 1;
@ -1414,7 +1455,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp; typ = OPT_undftyp;
} }
if (do_) { if (do_) {
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
} }
break; break;
case 4: case 4:
@ -1432,7 +1473,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(104); OPB_err(104);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
break; break;
case 5: case 5:
if (f == 2) { if (f == 2) {
@ -1442,7 +1483,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
} }
} else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) { } else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) {
} else { } else {
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
} }
} else if (f != 0) { } else if (f != 0) {
OPB_err(94); OPB_err(94);
@ -1465,7 +1506,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
} }
} }
if (do_) { if (do_) {
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
} }
break; break;
case 7: case 7:
@ -1474,7 +1515,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp; typ = OPT_undftyp;
} }
if ((!__IN(f, 0x70) || y->class != 7) || y->conval->intval != 0) { if ((!__IN(f, 0x70) || y->class != 7) || y->conval->intval != 0) {
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
} }
break; break;
case 8: case 8:
@ -1485,7 +1526,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
} }
} else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) { } else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) {
} else { } else {
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
} }
} else if (f != 0) { } else if (f != 0) {
OPB_err(95); OPB_err(95);
@ -1493,16 +1534,16 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
} }
break; break;
case 9: case 10: case 9: case 10:
if (__IN(f, 0x6bff) || strings__42(&z, &y)) { if (__IN(f, 0x6bff) || strings__43(&z, &y)) {
typ = OPT_booltyp; typ = OPT_booltyp;
} else { } else {
OPB_err(107); OPB_err(107);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
break; break;
case 11: case 12: case 13: case 14: case 11: case 12: case 13: case 14:
if (__IN(f, 0x01f9) || strings__42(&z, &y)) { if (__IN(f, 0x01f9) || strings__43(&z, &y)) {
typ = OPT_booltyp; typ = OPT_booltyp;
} else { } else {
OPM_LogWLn(); OPM_LogWLn();
@ -1511,7 +1552,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(108); OPB_err(108);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__40(op, typ, &z, y); NewOp__41(op, typ, &z, y);
break; break;
default: default:
OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", (LONGINT)32); OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", (LONGINT)32);
@ -1521,7 +1562,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
} }
} }
*x = z; *x = z;
Op__39_s = _s.lnk; Op__40_s = _s.lnk;
} }
void OPB_SetRange (OPT_Node *x, OPT_Node y) void OPB_SetRange (OPT_Node *x, OPT_Node y)
@ -1614,7 +1655,7 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
case 0: case 10: case 0: case 10:
break; break;
case 1: case 1:
if (!__IN(g, 0x1a)) { if (!((__IN(g, 0x7a) && y->size == 1))) {
OPB_err(113); OPB_err(113);
} }
break; break;
@ -1726,23 +1767,6 @@ static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo)
{ {
} }
static LONGINT OPB_SignedMaximum (LONGINT bytecount)
{
LONGINT _o_result;
LONGINT result;
result = 1;
result = __LSH(result, __ASHL(bytecount, 3) - 1, LONGINT);
_o_result = result - 1;
return _o_result;
}
static LONGINT OPB_SignedMinimum (LONGINT bytecount)
{
LONGINT _o_result;
_o_result = -OPB_SignedMaximum(bytecount) - 1;
return _o_result;
}
void OPB_StPar0 (OPT_Node *par0, INTEGER fctno) void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
{ {
INTEGER f; INTEGER f;
@ -1890,10 +1914,8 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 10: case 10:
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); OPB_err(126);
} else if (f == 5) { } else if ((__IN(f, 0x70) && x->typ->size > (LONGINT)OPM_SIntSize)) {
OPB_Convert(&x, OPT_sinttyp); OPB_Convert(&x, OPB_IntType(OPB_ShorterSize(x->typ->size)));
} else if (f == 6) {
OPB_Convert(&x, OPT_inttyp);
} else if (f == 8) { } else if (f == 8) {
OPB_Convert(&x, OPT_realtyp); OPB_Convert(&x, OPT_realtyp);
} else { } else {
@ -1903,10 +1925,8 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 11: case 11:
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); OPB_err(126);
} else if (f == 4) { } else if ((__IN(f, 0x70) && x->typ->size < (LONGINT)OPM_LIntSize)) {
OPB_Convert(&x, OPT_inttyp); OPB_Convert(&x, OPB_IntType(OPB_LongerSize(x->typ->size)));
} else if (f == 5) {
OPB_Convert(&x, OPT_linttyp);
} else if (f == 7) { } else if (f == 7) {
OPB_Convert(&x, OPT_lrltyp); OPB_Convert(&x, OPT_lrltyp);
} else if (f == 3) { } else if (f == 3) {
@ -1954,7 +1974,7 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); OPB_err(126);
} else if (__IN(f, 0x70)) { } else if (__IN(f, 0x70)) {
if (f != 6) { if (x->typ->size != (LONGINT)OPM_LIntSize) {
OPB_Convert(&x, OPT_linttyp); OPB_Convert(&x, OPT_linttyp);
} }
} else { } else {
@ -1992,9 +2012,9 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 24: case 25: case 28: case 31: case 24: case 25: case 28: case 31:
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); 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); OPB_Convert(&x, OPT_linttyp);
} else if (!__IN(f, 0x2040)) { } else if (!((__IN(x->typ->form, 0x2070) && x->typ->size == (LONGINT)OPM_PointerSize))) {
OPB_err(111); OPB_err(111);
x->typ = OPT_linttyp; x->typ = OPT_linttyp;
} }
@ -2043,13 +2063,13 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
*par0 = x; *par0 = x;
} }
static struct StPar1__56 { static struct StPar1__58 {
struct StPar1__56 *lnk; struct StPar1__58 *lnk;
} *StPar1__56_s; } *StPar1__58_s;
static OPT_Node NewOp__57 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right); static OPT_Node NewOp__59 (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__59 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right)
{ {
OPT_Node _o_result; OPT_Node _o_result;
OPT_Node node = NIL; OPT_Node node = NIL;
@ -2066,9 +2086,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
INTEGER f, L; INTEGER f, L;
OPT_Struct typ = NIL; OPT_Struct typ = NIL;
OPT_Node p = NIL, t = NIL; OPT_Node p = NIL, t = NIL;
struct StPar1__56 _s; struct StPar1__58 _s;
_s.lnk = StPar1__56_s; _s.lnk = StPar1__58_s;
StPar1__56_s = &_s; StPar1__58_s = &_s;
p = *par0; p = *par0;
f = x->typ->form; f = x->typ->form;
switch (fctno) { switch (fctno) {
@ -2084,7 +2104,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
OPB_err(111); OPB_err(111);
} }
} }
p = NewOp__57(19, fctno, p, x); p = NewOp__59(19, fctno, p, x);
p->typ = OPT_notyp; p->typ = OPT_notyp;
} }
break; break;
@ -2095,7 +2115,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
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 > (LONGINT)OPM_MaxSet))) {
OPB_err(202); OPB_err(202);
} }
p = NewOp__57(19, fctno, p, x); p = NewOp__59(19, fctno, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2120,7 +2140,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
p = p->left; p = p->left;
x->conval->intval += 1; x->conval->intval += 1;
} }
p = NewOp__57(12, 19, p, x); p = NewOp__59(12, 19, p, x);
p->typ = OPT_linttyp; p->typ = OPT_linttyp;
} else { } else {
p = x; p = x;
@ -2142,7 +2162,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
t = x; t = x;
x = p; x = p;
p = t; p = t;
p = NewOp__57(19, 18, p, x); p = NewOp__59(19, 18, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2168,7 +2188,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
} }
p->obj = NIL; p->obj = NIL;
} else { } else {
p = NewOp__57(12, 17, p, x); p = NewOp__59(12, 17, p, x);
p->typ = OPT_linttyp; p->typ = OPT_linttyp;
} }
} else { } else {
@ -2199,9 +2219,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
OPB_err(111); OPB_err(111);
} else { } else {
if (fctno == 22) { if (fctno == 22) {
p = NewOp__57(12, 27, p, x); p = NewOp__59(12, 27, p, x);
} else { } else {
p = NewOp__57(12, 28, p, x); p = NewOp__59(12, 28, p, x);
} }
p->typ = p->left->typ; p->typ = p->left->typ;
} }
@ -2218,7 +2238,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
x = p; x = p;
p = t; p = t;
} }
p = NewOp__57(19, fctno, p, x); p = NewOp__59(19, fctno, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2228,7 +2248,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); OPB_err(126);
} else if (__IN(f, 0x70)) { } else if (__IN(f, 0x70)) {
p = NewOp__57(12, 26, p, x); p = NewOp__59(12, 26, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2252,7 +2272,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); OPB_err(126);
} else if (__IN(f, 0x70)) { } else if (__IN(f, 0x70)) {
p = NewOp__57(19, 30, p, x); p = NewOp__59(19, 30, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2261,9 +2281,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
case 31: case 31:
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); 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); OPB_Convert(&x, OPT_linttyp);
} else if (!__IN(f, 0x2040)) { } else if (!((__IN(x->typ->form, 0x2070) && x->typ->size == (LONGINT)OPM_PointerSize))) {
OPB_err(111); OPB_err(111);
x->typ = OPT_linttyp; x->typ = OPT_linttyp;
} }
@ -2298,7 +2318,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
break; break;
} }
*par0 = p; *par0 = p;
StPar1__56_s = _s.lnk; StPar1__58_s = _s.lnk;
} }
void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n) void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n)
@ -2417,7 +2437,7 @@ static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpa
ftyp = ftyp->BaseTyp; ftyp = ftyp->BaseTyp;
atyp = atyp->BaseTyp; atyp = atyp->BaseTyp;
if ((fvarpar && ftyp == OPT_bytetyp)) { 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)) { if (__IN(18, OPM_opt)) {
OPB_err(-301); OPB_err(-301);
} }
@ -2500,7 +2520,7 @@ void OPB_Param (OPT_Node ap, OPT_Object fp)
OPB_err(111); OPB_err(111);
} }
} else if ((fp->typ == OPT_sysptrtyp && ap->typ->form == 13)) { } 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); OPB_err(123);
} else if ((fp->typ->form == 13 && ap->class == 5)) { } else if ((fp->typ->form == 13 && ap->class == 5)) {
OPB_err(123); OPB_err(123);

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

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

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

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

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPC__h #ifndef OPC__h
#define OPC__h #define OPC__h

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#define LARGE #define LARGE
#include "SYSTEM.h" #include "SYSTEM.h"
#include "Configuration.h" #include "Configuration.h"
@ -552,10 +552,7 @@ void OPM_FPrintReal (LONGINT *fp, REAL real)
void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr) void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr)
{ {
LONGINT l, h; LONGINT l, h;
__GET((LONGINT)(uintptr_t)&lr, l, LONGINT); OPM_FPrint(&*fp, __VAL(LONGINT, lr));
__GET((LONGINT)(uintptr_t)&lr + 4, h, LONGINT);
OPM_FPrint(&*fp, l);
OPM_FPrint(&*fp, h);
} }
static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align) static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align)

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPM__h #ifndef OPM__h
#define OPM__h #define OPM__h

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

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

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

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

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

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/16] for gcc LP64 on cygwin tspkaSfF */ /* voc 1.95 [2016/08/20] for gcc LP64 on cygwin tspkaSfF */
#define LARGE #define LARGE
#include "SYSTEM.h" #include "SYSTEM.h"
#include "OPM.h" #include "OPM.h"

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

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

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