Include int size in .sym files, fix __IN for out of range values, better naming.

This commit is contained in:
David Brown 2016-08-30 19:01:24 +01:00
parent a33e38cf6c
commit b3c71fb2f0
205 changed files with 1353 additions and 1325 deletions

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/26] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/30] 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/26] for gcc LP64 on cygwin", Configuration_versionLong, 41); __MOVE("1.95 [2016/08/30] for gcc LP64 on cygwin", Configuration_versionLong, 41);
__ENDMOD; __ENDMOD;
} }

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/26] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/30] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
#include "OPM.h" #include "OPM.h"
#include "OPS.h" #include "OPS.h"
@ -34,9 +34,7 @@ export void OPB_In (OPT_Node *x, OPT_Node y);
export void OPB_Index (OPT_Node *x, OPT_Node y); export void OPB_Index (OPT_Node *x, OPT_Node y);
export void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ); 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);
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,8 +51,6 @@ 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);
export void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno); export void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno);
export void OPB_StPar0 (OPT_Node *par0, INTEGER fctno); export void OPB_StPar0 (OPT_Node *par0, INTEGER fctno);
export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno); export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno);
@ -224,68 +220,20 @@ OPT_Node OPB_EmptySet (void)
return _o_result; return _o_result;
} }
static INTEGER OPB_SignedByteSize (LONGINT n) static void OPB_SetIntType (OPT_Node node)
{ {
INTEGER _o_result;
INTEGER b; INTEGER b;
if (n < 0) { LONGINT n;
n = -(n + 1); if (node->conval->intval >= 0) {
n = node->conval->intval;
} else {
n = -(node->conval->intval + 1);
} }
b = 1; b = 1;
while ((b < 8 && __ASH(n, -(__ASHL(b, 3) - 1)) != 0)) { while ((b < 8 && __ASH(n, -(__ASHL(b, 3) - 1)) != 0)) {
b += 1; b += 1;
} }
_o_result = b; node->typ = OPT_IntType(b);
return _o_result;
}
static LONGINT OPB_ShorterSize (LONGINT i)
{
LONGINT _o_result;
if (i >= (int)OPM_LIntSize) {
_o_result = OPM_IntSize;
return _o_result;
} else {
_o_result = OPM_SIntSize;
return _o_result;
}
__RETCHK;
}
static LONGINT OPB_LongerSize (LONGINT i)
{
LONGINT _o_result;
if (i <= (int)OPM_SIntSize) {
_o_result = OPM_IntSize;
return _o_result;
} else {
_o_result = OPM_LIntSize;
return _o_result;
}
__RETCHK;
}
static OPT_Struct OPB_IntType (LONGINT size)
{
OPT_Struct _o_result;
OPT_Struct result = NIL;
if (size <= OPT_sinttyp->size) {
result = OPT_sinttyp;
} else if (size <= OPT_inttyp->size) {
result = OPT_inttyp;
} else {
result = OPT_linttyp;
}
if (size > OPT_linttyp->size) {
OPB_err(203);
}
_o_result = result;
return _o_result;
}
static void OPB_SetIntType (OPT_Node node)
{
node->typ = OPB_IntType(OPB_SignedByteSize(node->conval->intval));
} }
OPT_Node OPB_NewIntConst (LONGINT intval) OPT_Node OPB_NewIntConst (LONGINT intval)
@ -429,16 +377,16 @@ void OPB_Field (OPT_Node *x, OPT_Object y)
} }
} }
static struct TypTest__61 { static struct TypTest__57 {
OPT_Node *x; OPT_Node *x;
OPT_Object *obj; OPT_Object *obj;
BOOLEAN *guard; BOOLEAN *guard;
struct TypTest__61 *lnk; struct TypTest__57 *lnk;
} *TypTest__61_s; } *TypTest__57_s;
static void GTT__62 (OPT_Struct t0, OPT_Struct t1); static void GTT__58 (OPT_Struct t0, OPT_Struct t1);
static void GTT__62 (OPT_Struct t0, OPT_Struct t1) static void GTT__58 (OPT_Struct t0, OPT_Struct t1)
{ {
OPT_Node node = NIL; OPT_Node node = NIL;
OPT_Struct t = NIL; OPT_Struct t = NIL;
@ -451,54 +399,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__57_s->guard) {
OPB_BindNodes(5, NIL, &*TypTest__61_s->x, NIL); OPB_BindNodes(5, NIL, &*TypTest__57_s->x, NIL);
(*TypTest__61_s->x)->readonly = (*TypTest__61_s->x)->left->readonly; (*TypTest__57_s->x)->readonly = (*TypTest__57_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__57_s->x;
node->obj = *TypTest__61_s->obj; node->obj = *TypTest__57_s->obj;
*TypTest__61_s->x = node; *TypTest__57_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__57_s->guard) {
if ((*TypTest__61_s->x)->class == 5) { if ((*TypTest__57_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__57_s->x;
node->obj = *TypTest__61_s->obj; node->obj = *TypTest__57_s->obj;
*TypTest__61_s->x = node; *TypTest__57_s->x = node;
} else { } else {
*TypTest__61_s->x = OPB_NewBoolConst(1); *TypTest__57_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__57 _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__57_s;
TypTest__61_s = &_s; TypTest__57_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__58((*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__58((*x)->typ, obj->typ);
} else { } else {
OPB_err(87); OPB_err(87);
} }
@ -507,7 +455,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__57_s = _s.lnk;
} }
void OPB_In (OPT_Node *x, OPT_Node y) void OPB_In (OPT_Node *x, OPT_Node y)
@ -573,13 +521,13 @@ static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x)
x->intval = -1; x->intval = -1;
} }
static struct MOp__30 { static struct MOp__28 {
struct MOp__30 *lnk; struct MOp__28 *lnk;
} *MOp__30_s; } *MOp__28_s;
static OPT_Node NewOp__31 (SHORTINT op, OPT_Struct typ, OPT_Node z); static OPT_Node NewOp__29 (SHORTINT op, OPT_Struct typ, OPT_Node z);
static OPT_Node NewOp__31 (SHORTINT op, OPT_Struct typ, OPT_Node z) static OPT_Node NewOp__29 (SHORTINT op, OPT_Struct typ, OPT_Node z)
{ {
OPT_Node _o_result; OPT_Node _o_result;
OPT_Node node = NIL; OPT_Node node = NIL;
@ -596,9 +544,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__30 _s; struct MOp__28 _s;
_s.lnk = MOp__30_s; _s.lnk = MOp__28_s;
MOp__30_s = &_s; MOp__28_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);
@ -612,7 +560,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__31(op, typ, z); z = NewOp__29(op, typ, z);
} }
} else { } else {
OPB_err(98); OPB_err(98);
@ -640,7 +588,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
} }
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__31(op, typ, z); z = NewOp__29(op, typ, z);
} }
} else { } else {
OPB_err(97); OPB_err(97);
@ -661,7 +609,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
} }
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__31(op, typ, z); z = NewOp__29(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -673,7 +621,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__31(op, typ, z); z = NewOp__29(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -686,7 +634,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__31(op, typ, z); z = NewOp__29(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -699,7 +647,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__31(op, typ, z); z = NewOp__29(op, typ, z);
} else { } else {
OPB_err(127); OPB_err(127);
} }
@ -708,7 +656,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__31(op, typ, z); z = NewOp__29(op, typ, z);
} else { } else {
OPB_err(219); OPB_err(219);
} }
@ -725,7 +673,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
} }
} }
*x = z; *x = z;
MOp__30_s = _s.lnk; MOp__28_s = _s.lnk;
} }
static void OPB_CheckPtr (OPT_Node x, OPT_Node y) static void OPB_CheckPtr (OPT_Node x, OPT_Node y)
@ -921,7 +869,7 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
if (x->typ->size <= y->typ->size) { if (x->typ->size <= y->typ->size) {
x->typ = y->typ; x->typ = y->typ;
} else { } else {
x->typ = OPB_IntType(x->typ->size); x->typ = OPT_IntType(x->typ->size);
} }
} else if (g == 7) { } else if (g == 7) {
x->typ = OPT_realtyp; x->typ = OPT_realtyp;
@ -1178,7 +1126,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
if (__IN(g, 0x70)) { if (__IN(g, 0x70)) {
if (f > g) { if (f > g) {
OPB_SetIntType(*x); OPB_SetIntType(*x);
if ((int)(*x)->typ->form > g) { if ((*x)->typ->size > typ->size) {
OPB_err(203); OPB_err(203);
(*x)->conval->intval = 1; (*x)->conval->intval = 1;
} }
@ -1219,15 +1167,15 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
(*x)->typ = typ; (*x)->typ = typ;
} }
static struct Op__40 { static struct Op__38 {
INTEGER *f, *g; INTEGER *f, *g;
struct Op__40 *lnk; struct Op__38 *lnk;
} *Op__40_s; } *Op__38_s;
static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y); static void NewOp__39 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y);
static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y); static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y);
static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y) static void NewOp__39 (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);
@ -1238,29 +1186,29 @@ static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
*x = node; *x = node;
} }
static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y) static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y)
{ {
BOOLEAN _o_result; BOOLEAN _o_result;
BOOLEAN ok, xCharArr, yCharArr; BOOLEAN ok, xCharArr, yCharArr;
xCharArr = (__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp->form == 3) || *Op__40_s->f == 10; xCharArr = (__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp->form == 3) || *Op__38_s->f == 10;
yCharArr = (__IN((*y)->typ->comp, 0x0c) && (*y)->typ->BaseTyp->form == 3) || *Op__40_s->g == 10; yCharArr = (__IN((*y)->typ->comp, 0x0c) && (*y)->typ->BaseTyp->form == 3) || *Op__38_s->g == 10;
if ((((xCharArr && *Op__40_s->g == 3)) && (*y)->class == 7)) { if ((((xCharArr && *Op__38_s->g == 3)) && (*y)->class == 7)) {
OPB_CharToString(*y); OPB_CharToString(*y);
*Op__40_s->g = 10; *Op__38_s->g = 10;
yCharArr = 1; yCharArr = 1;
} }
if ((((yCharArr && *Op__40_s->f == 3)) && (*x)->class == 7)) { if ((((yCharArr && *Op__38_s->f == 3)) && (*x)->class == 7)) {
OPB_CharToString(*x); OPB_CharToString(*x);
*Op__40_s->f = 10; *Op__38_s->f = 10;
xCharArr = 1; xCharArr = 1;
} }
ok = (xCharArr && yCharArr); ok = (xCharArr && yCharArr);
if (ok) { if (ok) {
if ((*Op__40_s->f == 10 && (*x)->conval->intval2 == 1)) { if ((*Op__38_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__40_s->g == 10 && (*y)->conval->intval2 == 1)) { } else if ((*Op__38_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))));
@ -1277,11 +1225,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__40 _s; struct Op__38 _s;
_s.f = &f; _s.f = &f;
_s.g = &g; _s.g = &g;
_s.lnk = Op__40_s; _s.lnk = Op__38_s;
Op__40_s = &_s; Op__38_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);
@ -1393,7 +1341,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp; typ = OPT_undftyp;
} }
if (do_) { if (do_) {
NewOp__41(op, typ, &z, y); NewOp__39(op, typ, &z, y);
} }
break; break;
case 2: case 2:
@ -1412,7 +1360,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__41(op, typ, &z, y); NewOp__39(op, typ, &z, y);
break; break;
case 3: case 3:
do_ = 1; do_ = 1;
@ -1435,7 +1383,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp; typ = OPT_undftyp;
} }
if (do_) { if (do_) {
NewOp__41(op, typ, &z, y); NewOp__39(op, typ, &z, y);
} }
break; break;
case 4: case 4:
@ -1453,7 +1401,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__41(op, typ, &z, y); NewOp__39(op, typ, &z, y);
break; break;
case 5: case 5:
if (f == 2) { if (f == 2) {
@ -1463,7 +1411,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__41(op, typ, &z, y); NewOp__39(op, typ, &z, y);
} }
} else if (f != 0) { } else if (f != 0) {
OPB_err(94); OPB_err(94);
@ -1486,7 +1434,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
} }
} }
if (do_) { if (do_) {
NewOp__41(op, typ, &z, y); NewOp__39(op, typ, &z, y);
} }
break; break;
case 7: case 7:
@ -1495,7 +1443,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__41(op, typ, &z, y); NewOp__39(op, typ, &z, y);
} }
break; break;
case 8: case 8:
@ -1506,7 +1454,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__41(op, typ, &z, y); NewOp__39(op, typ, &z, y);
} }
} else if (f != 0) { } else if (f != 0) {
OPB_err(95); OPB_err(95);
@ -1514,16 +1462,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__43(&z, &y)) { if (__IN(f, 0x6bff) || strings__41(&z, &y)) {
typ = OPT_booltyp; typ = OPT_booltyp;
} else { } else {
OPB_err(107); OPB_err(107);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__41(op, typ, &z, y); NewOp__39(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__43(&z, &y)) { if (__IN(f, 0x01f9) || strings__41(&z, &y)) {
typ = OPT_booltyp; typ = OPT_booltyp;
} else { } else {
OPM_LogWLn(); OPM_LogWLn();
@ -1532,7 +1480,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__41(op, typ, &z, y); NewOp__39(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);
@ -1542,7 +1490,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
} }
} }
*x = z; *x = z;
Op__40_s = _s.lnk; Op__38_s = _s.lnk;
} }
void OPB_SetRange (OPT_Node *x, OPT_Node y) void OPB_SetRange (OPT_Node *x, OPT_Node y)
@ -1894,8 +1842,13 @@ 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 ((__IN(f, 0x70) && x->typ->size > (int)OPM_SIntSize)) { } else if (__IN(f, 0x70)) {
OPB_Convert(&x, OPB_IntType(OPB_ShorterSize(x->typ->size))); typ = OPT_ShorterOrLongerType(x->typ, -1);
if (typ == NIL) {
OPB_err(111);
} else {
OPB_Convert(&x, typ);
}
} else if (f == 8) { } else if (f == 8) {
OPB_Convert(&x, OPT_realtyp); OPB_Convert(&x, OPT_realtyp);
} else { } else {
@ -1905,8 +1858,13 @@ 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 ((__IN(f, 0x70) && x->typ->size < (int)OPM_LIntSize)) { } else if (__IN(f, 0x70)) {
OPB_Convert(&x, OPB_IntType(OPB_LongerSize(x->typ->size))); typ = OPT_ShorterOrLongerType(x->typ, 1);
if (typ == NIL) {
OPB_err(111);
} else {
OPB_Convert(&x, typ);
}
} 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) {
@ -2043,13 +2001,13 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
*par0 = x; *par0 = x;
} }
static struct StPar1__56 { static struct StPar1__52 {
struct StPar1__56 *lnk; struct StPar1__52 *lnk;
} *StPar1__56_s; } *StPar1__52_s;
static OPT_Node NewOp__57 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right); static OPT_Node NewOp__53 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right);
static OPT_Node NewOp__57 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right) static OPT_Node NewOp__53 (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 +2024,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__52 _s;
_s.lnk = StPar1__56_s; _s.lnk = StPar1__52_s;
StPar1__56_s = &_s; StPar1__52_s = &_s;
p = *par0; p = *par0;
f = x->typ->form; f = x->typ->form;
switch (fctno) { switch (fctno) {
@ -2084,7 +2042,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__53(19, fctno, p, x);
p->typ = OPT_notyp; p->typ = OPT_notyp;
} }
break; break;
@ -2095,7 +2053,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval > (int)OPM_MaxSet))) { if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval > (int)OPM_MaxSet))) {
OPB_err(202); OPB_err(202);
} }
p = NewOp__57(19, fctno, p, x); p = NewOp__53(19, fctno, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2120,7 +2078,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__53(12, 19, p, x);
p->typ = OPT_linttyp; p->typ = OPT_linttyp;
} else { } else {
p = x; p = x;
@ -2142,7 +2100,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__53(19, 18, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2168,7 +2126,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__53(12, 17, p, x);
p->typ = OPT_linttyp; p->typ = OPT_linttyp;
} }
} else { } else {
@ -2199,9 +2157,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__53(12, 27, p, x);
} else { } else {
p = NewOp__57(12, 28, p, x); p = NewOp__53(12, 28, p, x);
} }
p->typ = p->left->typ; p->typ = p->left->typ;
} }
@ -2218,7 +2176,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__53(19, fctno, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2228,7 +2186,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__53(12, 26, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2252,7 +2210,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__53(19, 30, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2298,7 +2256,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
break; break;
} }
*par0 = p; *par0 = p;
StPar1__56_s = _s.lnk; StPar1__52_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)

View file

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

View file

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

View file

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

View file

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

View file

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

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/26] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/30] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
#include "OPB.h" #include "OPB.h"
#include "OPM.h" #include "OPM.h"
@ -24,7 +24,7 @@ export LONGINT *OPP__1__typ;
static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar); static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar);
static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned); static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned);
static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq); static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq);
static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab); static void OPP_CaseLabelList (OPT_Node *lab, OPT_Struct LabelTyp, INTEGER *n, OPP_CaseTable tab);
static void OPP_CheckMark (SHORTINT *vis); static void OPP_CheckMark (SHORTINT *vis);
static void OPP_CheckSym (INTEGER s); static void OPP_CheckSym (INTEGER s);
static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_); static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_);
@ -1163,7 +1163,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
ProcedureDeclaration__16_s = _s.lnk; ProcedureDeclaration__16_s = _s.lnk;
} }
static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab) static void OPP_CaseLabelList (OPT_Node *lab, OPT_Struct LabelTyp, INTEGER *n, OPP_CaseTable tab)
{ {
OPT_Node x = NIL, y = NIL, lastlab = NIL; OPT_Node x = NIL, y = NIL, lastlab = NIL;
INTEGER i, f; INTEGER i, f;
@ -1180,10 +1180,10 @@ static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP
xval = 1; xval = 1;
} }
if (__IN(f, 0x70)) { if (__IN(f, 0x70)) {
if (LabelForm < f) { if (!__IN(LabelTyp->form, 0x70) || LabelTyp->size < x->typ->size) {
OPP_err(60); OPP_err(60);
} }
} else if (LabelForm != f) { } else if ((int)LabelTyp->form != f) {
OPP_err(60); OPP_err(60);
} }
if (OPP_sym == 21) { if (OPP_sym == 21) {
@ -1262,7 +1262,7 @@ static void CasePart__31 (OPT_Node *x)
n = 0; n = 0;
for (;;) { for (;;) {
if (OPP_sym < 40) { if (OPP_sym < 40) {
OPP_CaseLabelList(&lab, (*x)->typ->form, &n, tab); OPP_CaseLabelList(&lab, (*x)->typ, &n, tab);
OPP_CheckSym(20); OPP_CheckSym(20);
OPP_StatSeq(&y); OPP_StatSeq(&y);
OPB_Construct(17, &lab, y); OPB_Construct(17, &lab, y);
@ -1471,7 +1471,7 @@ static void OPP_StatSeq (OPT_Node *stat)
SetPos__35(z); SetPos__35(z);
OPB_Link(&*stat, &last, z); OPB_Link(&*stat, &last, z);
y = OPB_NewLeaf(t); y = OPB_NewLeaf(t);
} else if (y->typ->form < 4 || y->typ->form > x->left->typ->form) { } else if (!__IN(y->typ->form, 0x70) || y->typ->size > x->left->typ->size) {
OPP_err(113); OPP_err(113);
} }
OPB_Link(&*stat, &last, x); OPB_Link(&*stat, &last, x);

View file

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

View file

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

View file

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

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/26] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/30] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
#include "OPM.h" #include "OPM.h"
#include "OPS.h" #include "OPS.h"
@ -84,11 +84,11 @@ typedef
export void (*OPT_typSize)(OPT_Struct); export void (*OPT_typSize)(OPT_Struct);
export OPT_Object OPT_topScope; export OPT_Object OPT_topScope;
export OPT_Struct OPT_undftyp, OPT_bytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_ainttyp, OPT_int8typ, OPT_int16typ, OPT_int32typ, OPT_int64typ, OPT_realtyp, OPT_lrltyp, OPT_settyp, OPT_stringtyp, OPT_niltyp, OPT_notyp, OPT_sysptrtyp; export OPT_Struct OPT_undftyp, OPT_bytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_ainttyp, OPT_int8typ, OPT_int16typ, OPT_int32typ, OPT_int64typ, OPT_realtyp, OPT_lrltyp, OPT_settyp, OPT_stringtyp, OPT_niltyp, OPT_notyp, OPT_sysptrtyp;
static OPT_Object OPT_LIntObj;
export SHORTINT OPT_nofGmod; export SHORTINT OPT_nofGmod;
export OPT_Object OPT_GlbMod[64]; export OPT_Object OPT_GlbMod[64];
export OPS_Name OPT_SelfName; export OPS_Name OPT_SelfName;
export BOOLEAN OPT_SYSimported; export BOOLEAN OPT_SYSimported;
static OPT_Struct OPT_IntTypes[20];
static OPT_Object OPT_universe, OPT_syslink; static OPT_Object OPT_universe, OPT_syslink;
static OPT_ImpCtxt OPT_impCtxt; static OPT_ImpCtxt OPT_impCtxt;
static OPT_ExpCtxt OPT_expCtxt; static OPT_ExpCtxt OPT_expCtxt;
@ -106,7 +106,6 @@ export void OPT_Close (void);
export void OPT_CloseScope (void); export void OPT_CloseScope (void);
static void OPT_DebugStruct (OPT_Struct btyp); static void OPT_DebugStruct (OPT_Struct btyp);
static void OPT_EnterBoolConst (OPS_Name name, LONGINT value); static void OPT_EnterBoolConst (OPS_Name name, LONGINT value);
static void OPT_EnterDerivedType (OPS_Name name, OPT_Struct typ, OPT_Object *obj);
static void OPT_EnterProc (OPS_Name name, INTEGER num); static void OPT_EnterProc (OPS_Name name, INTEGER num);
static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct *res); static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct *res);
export void OPT_Export (BOOLEAN *ext, BOOLEAN *new); export void OPT_Export (BOOLEAN *ext, BOOLEAN *new);
@ -128,10 +127,12 @@ static OPT_Object OPT_InObj (SHORTINT mno);
static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par); static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par);
static void OPT_InStruct (OPT_Struct *typ); static void OPT_InStruct (OPT_Struct *typ);
static OPT_Object OPT_InTProc (SHORTINT mno); static OPT_Object OPT_InTProc (SHORTINT mno);
static OPT_Struct OPT_InTyp (LONGINT tag);
export void OPT_Init (OPS_Name name, SET opt); export void OPT_Init (OPS_Name name, SET opt);
static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form); static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form);
export void OPT_Insert (OPS_Name name, OPT_Object *obj); export void OPT_Insert (OPS_Name name, OPT_Object *obj);
export void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old); export void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old);
export OPT_Struct OPT_IntType (LONGINT size);
export OPT_Const OPT_NewConst (void); export OPT_Const OPT_NewConst (void);
export OPT_ConstExt OPT_NewExt (void); export OPT_ConstExt OPT_NewExt (void);
export OPT_Node OPT_NewNode (SHORTINT class); export OPT_Node OPT_NewNode (SHORTINT class);
@ -147,6 +148,7 @@ static void OPT_OutObj (OPT_Object obj);
static void OPT_OutSign (OPT_Struct result, OPT_Object par); static void OPT_OutSign (OPT_Struct result, OPT_Object par);
static void OPT_OutStr (OPT_Struct typ); static void OPT_OutStr (OPT_Struct typ);
static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj); static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj);
export OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INTEGER dir);
static void OPT_err (INTEGER n); static void OPT_err (INTEGER n);
@ -155,6 +157,34 @@ static void OPT_err (INTEGER n)
OPM_err(n); OPM_err(n);
} }
OPT_Struct OPT_IntType (LONGINT size)
{
OPT_Struct _o_result;
INTEGER i;
i = 1;
while ((OPT_IntTypes[__X(i, ((LONGINT)(20)))]->size < size && OPT_IntTypes[__X(i + 1, ((LONGINT)(20)))] != NIL)) {
i += 1;
}
_o_result = OPT_IntTypes[__X(i, ((LONGINT)(20)))];
return _o_result;
}
OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INTEGER dir)
{
OPT_Struct _o_result;
INTEGER i;
__ASSERT(__IN(x->form, 0x70), 0);
__ASSERT(dir == 1 || dir == -1, 0);
__ASSERT(x->BaseTyp == OPT_undftyp, 0);
i = 0;
while ((OPT_IntTypes[__X(i, ((LONGINT)(20)))] != x && i < 20)) {
i += 1;
}
__ASSERT(i < 19, 0);
_o_result = OPT_IntTypes[__X(i + dir, ((LONGINT)(20)))];
return _o_result;
}
OPT_Const OPT_NewConst (void) OPT_Const OPT_NewConst (void)
{ {
OPT_Const _o_result; OPT_Const _o_result;
@ -467,21 +497,21 @@ void OPT_IdFPrint (OPT_Struct typ)
} }
} }
static struct FPrintStr__13 { static struct FPrintStr__12 {
LONGINT *pbfp, *pvfp; LONGINT *pbfp, *pvfp;
struct FPrintStr__13 *lnk; struct FPrintStr__12 *lnk;
} *FPrintStr__13_s; } *FPrintStr__12_s;
static void FPrintFlds__14 (OPT_Object fld, LONGINT adr, BOOLEAN visible); static void FPrintFlds__13 (OPT_Object fld, LONGINT adr, BOOLEAN visible);
static void FPrintHdFld__16 (OPT_Struct typ, OPT_Object fld, LONGINT adr); static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr);
static void FPrintTProcs__18 (OPT_Object obj); static void FPrintTProcs__17 (OPT_Object obj);
static void FPrintHdFld__16 (OPT_Struct typ, OPT_Object fld, LONGINT adr) static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr)
{ {
LONGINT i, j, n; LONGINT i, j, n;
OPT_Struct btyp = NIL; OPT_Struct btyp = NIL;
if (typ->comp == 4) { if (typ->comp == 4) {
FPrintFlds__14(typ->link, adr, 0); FPrintFlds__13(typ->link, adr, 0);
} else if (typ->comp == 2) { } else if (typ->comp == 2) {
btyp = typ->BaseTyp; btyp = typ->BaseTyp;
n = typ->n; n = typ->n;
@ -491,53 +521,53 @@ static void FPrintHdFld__16 (OPT_Struct typ, OPT_Object fld, LONGINT adr)
} }
if (btyp->form == 13 || btyp->comp == 4) { if (btyp->form == 13 || btyp->comp == 4) {
j = OPT_nofhdfld; j = OPT_nofhdfld;
FPrintHdFld__16(btyp, fld, adr); FPrintHdFld__15(btyp, fld, adr);
if (j != OPT_nofhdfld) { if (j != OPT_nofhdfld) {
i = 1; i = 1;
while ((i < n && OPT_nofhdfld <= 2048)) { while ((i < n && OPT_nofhdfld <= 2048)) {
adr += btyp->size; adr += btyp->size;
FPrintHdFld__16(btyp, fld, adr); FPrintHdFld__15(btyp, fld, adr);
i += 1; i += 1;
} }
} }
} }
} else if (typ->form == 13 || __STRCMP(fld->name, "@ptr") == 0) { } else if (typ->form == 13 || __STRCMP(fld->name, "@ptr") == 0) {
OPM_FPrint(&*FPrintStr__13_s->pvfp, ((LONGINT)(13))); OPM_FPrint(&*FPrintStr__12_s->pvfp, ((LONGINT)(13)));
OPM_FPrint(&*FPrintStr__13_s->pvfp, adr); OPM_FPrint(&*FPrintStr__12_s->pvfp, adr);
OPT_nofhdfld += 1; OPT_nofhdfld += 1;
} }
} }
static void FPrintFlds__14 (OPT_Object fld, LONGINT adr, BOOLEAN visible) static void FPrintFlds__13 (OPT_Object fld, LONGINT adr, BOOLEAN visible)
{ {
while ((fld != NIL && fld->mode == 4)) { while ((fld != NIL && fld->mode == 4)) {
if ((fld->vis != 0 && visible)) { if ((fld->vis != 0 && visible)) {
OPM_FPrint(&*FPrintStr__13_s->pbfp, fld->vis); OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->vis);
OPT_FPrintName(&*FPrintStr__13_s->pbfp, (void*)fld->name, ((LONGINT)(256))); OPT_FPrintName(&*FPrintStr__12_s->pbfp, (void*)fld->name, ((LONGINT)(256)));
OPM_FPrint(&*FPrintStr__13_s->pbfp, fld->adr); OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->adr);
OPT_FPrintStr(fld->typ); OPT_FPrintStr(fld->typ);
OPM_FPrint(&*FPrintStr__13_s->pbfp, fld->typ->pbfp); OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->typ->pbfp);
OPM_FPrint(&*FPrintStr__13_s->pvfp, fld->typ->pvfp); OPM_FPrint(&*FPrintStr__12_s->pvfp, fld->typ->pvfp);
} else { } else {
FPrintHdFld__16(fld->typ, fld, fld->adr + adr); FPrintHdFld__15(fld->typ, fld, fld->adr + adr);
} }
fld = fld->link; fld = fld->link;
} }
} }
static void FPrintTProcs__18 (OPT_Object obj) static void FPrintTProcs__17 (OPT_Object obj)
{ {
if (obj != NIL) { if (obj != NIL) {
FPrintTProcs__18(obj->left); FPrintTProcs__17(obj->left);
if (obj->mode == 13) { if (obj->mode == 13) {
if (obj->vis != 0) { if (obj->vis != 0) {
OPM_FPrint(&*FPrintStr__13_s->pbfp, ((LONGINT)(13))); OPM_FPrint(&*FPrintStr__12_s->pbfp, ((LONGINT)(13)));
OPM_FPrint(&*FPrintStr__13_s->pbfp, __ASHR(obj->adr, 16)); OPM_FPrint(&*FPrintStr__12_s->pbfp, __ASHR(obj->adr, 16));
OPT_FPrintSign(&*FPrintStr__13_s->pbfp, obj->typ, obj->link); OPT_FPrintSign(&*FPrintStr__12_s->pbfp, obj->typ, obj->link);
OPT_FPrintName(&*FPrintStr__13_s->pbfp, (void*)obj->name, ((LONGINT)(256))); OPT_FPrintName(&*FPrintStr__12_s->pbfp, (void*)obj->name, ((LONGINT)(256)));
} }
} }
FPrintTProcs__18(obj->right); FPrintTProcs__17(obj->right);
} }
} }
@ -547,11 +577,11 @@ void OPT_FPrintStr (OPT_Struct typ)
OPT_Struct btyp = NIL; OPT_Struct btyp = NIL;
OPT_Object strobj = NIL, bstrobj = NIL; OPT_Object strobj = NIL, bstrobj = NIL;
LONGINT pbfp, pvfp; LONGINT pbfp, pvfp;
struct FPrintStr__13 _s; struct FPrintStr__12 _s;
_s.pbfp = &pbfp; _s.pbfp = &pbfp;
_s.pvfp = &pvfp; _s.pvfp = &pvfp;
_s.lnk = FPrintStr__13_s; _s.lnk = FPrintStr__12_s;
FPrintStr__13_s = &_s; FPrintStr__12_s = &_s;
if (!typ->fpdone) { if (!typ->fpdone) {
OPT_IdFPrint(typ); OPT_IdFPrint(typ);
pbfp = typ->idfp; pbfp = typ->idfp;
@ -588,11 +618,11 @@ void OPT_FPrintStr (OPT_Struct typ)
OPM_FPrint(&pvfp, typ->align); OPM_FPrint(&pvfp, typ->align);
OPM_FPrint(&pvfp, typ->n); OPM_FPrint(&pvfp, typ->n);
OPT_nofhdfld = 0; OPT_nofhdfld = 0;
FPrintFlds__14(typ->link, ((LONGINT)(0)), 1); FPrintFlds__13(typ->link, ((LONGINT)(0)), 1);
if (OPT_nofhdfld > 2048) { if (OPT_nofhdfld > 2048) {
OPM_Mark(225, typ->txtpos); OPM_Mark(225, typ->txtpos);
} }
FPrintTProcs__18(typ->link); FPrintTProcs__17(typ->link);
OPM_FPrint(&pvfp, pbfp); OPM_FPrint(&pvfp, pbfp);
strobj = typ->strobj; strobj = typ->strobj;
if (strobj == NIL || strobj->name[0] == 0x00) { if (strobj == NIL || strobj->name[0] == 0x00) {
@ -602,7 +632,7 @@ void OPT_FPrintStr (OPT_Struct typ)
typ->pbfp = pbfp; typ->pbfp = pbfp;
typ->pvfp = pvfp; typ->pvfp = pvfp;
} }
FPrintStr__13_s = _s.lnk; FPrintStr__12_s = _s.lnk;
} }
void OPT_FPrintObj (OPT_Object obj) void OPT_FPrintObj (OPT_Object obj)
@ -946,6 +976,19 @@ static OPT_Object OPT_InTProc (SHORTINT mno)
return _o_result; return _o_result;
} }
static OPT_Struct OPT_InTyp (LONGINT tag)
{
OPT_Struct _o_result;
if (__IN(tag, 0x70)) {
_o_result = OPT_IntType(OPM_SymRInt());
return _o_result;
} else {
_o_result = OPT_impCtxt.ref[__X(tag, ((LONGINT)(255)))];
return _o_result;
}
__RETCHK;
}
static void OPT_InStruct (OPT_Struct *typ) static void OPT_InStruct (OPT_Struct *typ)
{ {
SHORTINT mno; SHORTINT mno;
@ -956,7 +999,7 @@ static void OPT_InStruct (OPT_Struct *typ)
OPT_Object obj = NIL, last = NIL, fld = NIL, old = NIL, dummy = NIL; OPT_Object obj = NIL, last = NIL, fld = NIL, old = NIL, dummy = NIL;
tag = OPM_SymRInt(); tag = OPM_SymRInt();
if (tag != 34) { if (tag != 34) {
*typ = OPT_impCtxt.ref[__X(-tag, ((LONGINT)(255)))]; *typ = OPT_InTyp(-tag);
} else { } else {
ref = OPT_impCtxt.nofr; ref = OPT_impCtxt.nofr;
OPT_impCtxt.nofr += 1; OPT_impCtxt.nofr += 1;
@ -1081,7 +1124,7 @@ static void OPT_InStruct (OPT_Struct *typ)
} }
if (ref == OPT_impCtxt.minr) { if (ref == OPT_impCtxt.minr) {
while (ref < OPT_impCtxt.nofr) { while (ref < OPT_impCtxt.nofr) {
t = OPT_impCtxt.ref[__X(ref, ((LONGINT)(255)))]; t = OPT_InTyp(ref);
OPT_FPrintStr(t); OPT_FPrintStr(t);
obj = t->strobj; obj = t->strobj;
if (obj->name[0] != 0x00) { if (obj->name[0] != 0x00) {
@ -1150,9 +1193,9 @@ static OPT_Object OPT_InObj (SHORTINT mno)
obj->vis = 1; obj->vis = 1;
if (tag <= 13) { if (tag <= 13) {
obj->mode = 3; obj->mode = 3;
obj->typ = OPT_impCtxt.ref[__X(tag, ((LONGINT)(255)))];
obj->conval = OPT_NewConst(); obj->conval = OPT_NewConst();
OPT_InConstant(tag, obj->conval); OPT_InConstant(tag, obj->conval);
obj->typ = OPT_InTyp(tag);
} else if (tag >= 31) { } else if (tag >= 31) {
obj->conval = OPT_NewConst(); obj->conval = OPT_NewConst();
obj->conval->intval = -1; obj->conval->intval = -1;
@ -1396,6 +1439,9 @@ static void OPT_OutStr (OPT_Struct typ)
OPT_Object strobj = NIL; OPT_Object strobj = NIL;
if (typ->ref < OPT_expCtxt.ref) { if (typ->ref < OPT_expCtxt.ref) {
OPM_SymWInt(-typ->ref); OPM_SymWInt(-typ->ref);
if (__IN(typ->ref, 0x70)) {
OPM_SymWInt(typ->size);
}
} else { } else {
OPM_SymWInt(((LONGINT)(34))); OPM_SymWInt(((LONGINT)(34)));
typ->ref = OPT_expCtxt.ref; typ->ref = OPT_expCtxt.ref;
@ -1493,6 +1539,7 @@ static void OPT_OutConstant (OPT_Object obj)
break; break;
case 4: case 5: case 6: case 4: case 5: case 6:
OPM_SymWInt(obj->conval->intval); OPM_SymWInt(obj->conval->intval);
OPM_SymWInt(obj->typ->size);
break; break;
case 9: case 9:
OPM_SymWSet(obj->conval->setval); OPM_SymWSet(obj->conval->setval);
@ -1699,15 +1746,6 @@ static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct
*res = typ; *res = typ;
} }
static void OPT_EnterDerivedType (OPS_Name name, OPT_Struct typ, OPT_Object *obj)
{
OPS_Name name__copy;
__DUPARR(name, OPS_Name);
OPT_Insert(name, &*obj);
(*obj)->mode = 5;
(*obj)->typ = typ;
}
static void OPT_EnterProc (OPS_Name name, INTEGER num) static void OPT_EnterProc (OPS_Name name, INTEGER num)
{ {
OPT_Object obj = NIL; OPT_Object obj = NIL;
@ -1741,8 +1779,8 @@ static void EnumPtrs(void (*P)(void*))
P(OPT_niltyp); P(OPT_niltyp);
P(OPT_notyp); P(OPT_notyp);
P(OPT_sysptrtyp); P(OPT_sysptrtyp);
P(OPT_LIntObj);
__ENUMP(OPT_GlbMod, 64, P); __ENUMP(OPT_GlbMod, 64, P);
__ENUMP(OPT_IntTypes, 20, P);
P(OPT_universe); P(OPT_universe);
P(OPT_syslink); P(OPT_syslink);
__ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 3140, 1, P); __ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 3140, 1, P);
@ -1811,7 +1849,7 @@ export void *OPT__init(void)
OPT_InitStruct(&OPT_niltyp, 11); OPT_InitStruct(&OPT_niltyp, 11);
OPT_EnterTyp((CHAR*)"BYTE", 1, OPM_ByteSize, &OPT_bytetyp); OPT_EnterTyp((CHAR*)"BYTE", 1, OPM_ByteSize, &OPT_bytetyp);
OPT_EnterTyp((CHAR*)"PTR", 13, OPM_PointerSize, &OPT_sysptrtyp); OPT_EnterTyp((CHAR*)"PTR", 13, OPM_PointerSize, &OPT_sysptrtyp);
OPT_EnterTyp((CHAR*)"ADRINT", 5, OPM_LIntSize, &OPT_ainttyp); OPT_EnterTyp((CHAR*)"ADRINT", 5, OPM_PointerSize, &OPT_ainttyp);
OPT_EnterTyp((CHAR*)"INT8", 5, 1, &OPT_int8typ); OPT_EnterTyp((CHAR*)"INT8", 5, 1, &OPT_int8typ);
OPT_EnterTyp((CHAR*)"INT16", 5, 2, &OPT_int16typ); OPT_EnterTyp((CHAR*)"INT16", 5, 2, &OPT_int16typ);
OPT_EnterTyp((CHAR*)"INT32", 5, 4, &OPT_int32typ); OPT_EnterTyp((CHAR*)"INT32", 5, 4, &OPT_int32typ);
@ -1839,7 +1877,6 @@ export void *OPT__init(void)
OPT_EnterTyp((CHAR*)"LONGINT", 6, OPM_LIntSize, &OPT_linttyp); OPT_EnterTyp((CHAR*)"LONGINT", 6, OPM_LIntSize, &OPT_linttyp);
OPT_EnterTyp((CHAR*)"LONGREAL", 8, OPM_LRealSize, &OPT_lrltyp); OPT_EnterTyp((CHAR*)"LONGREAL", 8, OPM_LRealSize, &OPT_lrltyp);
OPT_EnterTyp((CHAR*)"SHORTINT", 4, OPM_SIntSize, &OPT_sinttyp); OPT_EnterTyp((CHAR*)"SHORTINT", 4, OPM_SIntSize, &OPT_sinttyp);
OPT_EnterDerivedType((CHAR*)"LINT", OPT_int64typ, &OPT_LIntObj);
OPT_EnterBoolConst((CHAR*)"FALSE", ((LONGINT)(0))); OPT_EnterBoolConst((CHAR*)"FALSE", ((LONGINT)(0)));
OPT_EnterBoolConst((CHAR*)"TRUE", ((LONGINT)(1))); OPT_EnterBoolConst((CHAR*)"TRUE", ((LONGINT)(1)));
OPT_EnterProc((CHAR*)"HALT", 0); OPT_EnterProc((CHAR*)"HALT", 0);
@ -1877,5 +1914,12 @@ export void *OPT__init(void)
OPT_impCtxt.ref[11] = OPT_niltyp; OPT_impCtxt.ref[11] = OPT_niltyp;
OPT_impCtxt.ref[12] = OPT_notyp; OPT_impCtxt.ref[12] = OPT_notyp;
OPT_impCtxt.ref[13] = OPT_sysptrtyp; OPT_impCtxt.ref[13] = OPT_sysptrtyp;
OPT_IntTypes[1] = OPT_sinttyp;
OPT_IntTypes[2] = OPT_inttyp;
OPT_IntTypes[3] = OPT_linttyp;
OPT_IntTypes[5] = OPT_int8typ;
OPT_IntTypes[6] = OPT_int16typ;
OPT_IntTypes[7] = OPT_int32typ;
OPT_IntTypes[8] = OPT_int64typ;
__ENDMOD; __ENDMOD;
} }

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/26] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/30] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPT__h #ifndef OPT__h
#define OPT__h #define OPT__h
@ -92,12 +92,14 @@ import void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done);
import void OPT_Init (OPS_Name name, SET opt); import void OPT_Init (OPS_Name name, SET opt);
import void OPT_Insert (OPS_Name name, OPT_Object *obj); import void OPT_Insert (OPS_Name name, OPT_Object *obj);
import void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old); import void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old);
import OPT_Struct OPT_IntType (LONGINT size);
import OPT_Const OPT_NewConst (void); import OPT_Const OPT_NewConst (void);
import OPT_ConstExt OPT_NewExt (void); import OPT_ConstExt OPT_NewExt (void);
import OPT_Node OPT_NewNode (SHORTINT class); import OPT_Node OPT_NewNode (SHORTINT class);
import OPT_Object OPT_NewObj (void); import OPT_Object OPT_NewObj (void);
import OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp); import OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp);
import void OPT_OpenScope (SHORTINT level, OPT_Object owner); import void OPT_OpenScope (SHORTINT level, OPT_Object owner);
import OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INTEGER dir);
import void *OPT__init(void); import void *OPT__init(void);

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

@ -60,12 +60,6 @@ typedef float REAL;
typedef double LONGREAL; typedef double LONGREAL;
typedef void* SYSTEM_PTR; typedef void* SYSTEM_PTR;
// Unsigned variants are for use by shift and rotate macros.
typedef unsigned char U_SYSTEM_BYTE;
typedef unsigned char U_CHAR;
typedef unsigned char U_SHORTINT;
// For 32 bit builds, the size of LONGINT depends on a make option: // For 32 bit builds, the size of LONGINT depends on a make option:
#if (__SIZEOF_POINTER__ == 8) || defined(LARGE) || defined(_WIN64) #if (__SIZEOF_POINTER__ == 8) || defined(LARGE) || defined(_WIN64)
@ -80,9 +74,20 @@ typedef unsigned char U_SHORTINT;
typedef unsigned long U_LONGINT; typedef unsigned long U_LONGINT;
#endif #endif
// Unsigned variants are for use by shift and rotate macros.
typedef unsigned char U_SYSTEM_BYTE;
typedef unsigned char U_CHAR;
typedef unsigned char U_SHORTINT;
typedef U_LONGINT SET; typedef U_LONGINT SET;
typedef U_LONGINT U_SET; typedef U_LONGINT U_SET;
typedef SYSTEM_CARD8 U_SYSTEM_INT8;
typedef SYSTEM_CARD16 U_SYSTEM_INT16;
typedef SYSTEM_CARD32 U_SYSTEM_INT32;
typedef SYSTEM_CARD64 U_SYSTEM_INT64;
// OS Memory allocation interfaces are in PlatformXXX.Mod // OS Memory allocation interfaces are in PlatformXXX.Mod
@ -178,7 +183,7 @@ static int __str_cmp(CHAR *x, CHAR *y){
#define __ABSFD(x) SYSTEM_ABSD((double)(x)) #define __ABSFD(x) SYSTEM_ABSD((double)(x))
#define __CAP(ch) ((CHAR)((ch)&0x5f)) #define __CAP(ch) ((CHAR)((ch)&0x5f))
#define __ODD(x) ((x)&1) #define __ODD(x) ((x)&1)
#define __IN(x, s) (((s)>>(x))&1) #define __IN(x, s) ((x)>=0 && (x)<(8*sizeof(SET)) && ((((U_SET)(s))>>(x))&1))
#define __SETOF(x) ((SET)1<<(x)) #define __SETOF(x) ((SET)1<<(x))
#define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h))) #define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h)))
#define __MASK(x, m) ((x)&~(m)) #define __MASK(x, m) ((x)&~(m))

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/26] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/30] 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/26] for gcc LP64 on cygwin", Configuration_versionLong, 41); __MOVE("1.95 [2016/08/30] for gcc LP64 on cygwin", Configuration_versionLong, 41);
__ENDMOD; __ENDMOD;
} }

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/26] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/30] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
#include "OPM.h" #include "OPM.h"
#include "OPS.h" #include "OPS.h"
@ -34,9 +34,7 @@ export void OPB_In (OPT_Node *x, OPT_Node y);
export void OPB_Index (OPT_Node *x, OPT_Node y); export void OPB_Index (OPT_Node *x, OPT_Node y);
export void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ); 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);
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,8 +51,6 @@ 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);
export void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno); export void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno);
export void OPB_StPar0 (OPT_Node *par0, INTEGER fctno); export void OPB_StPar0 (OPT_Node *par0, INTEGER fctno);
export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno); export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno);
@ -224,68 +220,20 @@ OPT_Node OPB_EmptySet (void)
return _o_result; return _o_result;
} }
static INTEGER OPB_SignedByteSize (LONGINT n) static void OPB_SetIntType (OPT_Node node)
{ {
INTEGER _o_result;
INTEGER b; INTEGER b;
if (n < 0) { LONGINT n;
n = -(n + 1); if (node->conval->intval >= 0) {
n = node->conval->intval;
} else {
n = -(node->conval->intval + 1);
} }
b = 1; b = 1;
while ((b < 8 && __ASH(n, -(__ASHL(b, 3) - 1)) != 0)) { while ((b < 8 && __ASH(n, -(__ASHL(b, 3) - 1)) != 0)) {
b += 1; b += 1;
} }
_o_result = b; node->typ = OPT_IntType(b);
return _o_result;
}
static LONGINT OPB_ShorterSize (LONGINT i)
{
LONGINT _o_result;
if (i >= (int)OPM_LIntSize) {
_o_result = OPM_IntSize;
return _o_result;
} else {
_o_result = OPM_SIntSize;
return _o_result;
}
__RETCHK;
}
static LONGINT OPB_LongerSize (LONGINT i)
{
LONGINT _o_result;
if (i <= (int)OPM_SIntSize) {
_o_result = OPM_IntSize;
return _o_result;
} else {
_o_result = OPM_LIntSize;
return _o_result;
}
__RETCHK;
}
static OPT_Struct OPB_IntType (LONGINT size)
{
OPT_Struct _o_result;
OPT_Struct result = NIL;
if (size <= OPT_sinttyp->size) {
result = OPT_sinttyp;
} else if (size <= OPT_inttyp->size) {
result = OPT_inttyp;
} else {
result = OPT_linttyp;
}
if (size > OPT_linttyp->size) {
OPB_err(203);
}
_o_result = result;
return _o_result;
}
static void OPB_SetIntType (OPT_Node node)
{
node->typ = OPB_IntType(OPB_SignedByteSize(node->conval->intval));
} }
OPT_Node OPB_NewIntConst (LONGINT intval) OPT_Node OPB_NewIntConst (LONGINT intval)
@ -429,16 +377,16 @@ void OPB_Field (OPT_Node *x, OPT_Object y)
} }
} }
static struct TypTest__61 { static struct TypTest__57 {
OPT_Node *x; OPT_Node *x;
OPT_Object *obj; OPT_Object *obj;
BOOLEAN *guard; BOOLEAN *guard;
struct TypTest__61 *lnk; struct TypTest__57 *lnk;
} *TypTest__61_s; } *TypTest__57_s;
static void GTT__62 (OPT_Struct t0, OPT_Struct t1); static void GTT__58 (OPT_Struct t0, OPT_Struct t1);
static void GTT__62 (OPT_Struct t0, OPT_Struct t1) static void GTT__58 (OPT_Struct t0, OPT_Struct t1)
{ {
OPT_Node node = NIL; OPT_Node node = NIL;
OPT_Struct t = NIL; OPT_Struct t = NIL;
@ -451,54 +399,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__57_s->guard) {
OPB_BindNodes(5, NIL, &*TypTest__61_s->x, NIL); OPB_BindNodes(5, NIL, &*TypTest__57_s->x, NIL);
(*TypTest__61_s->x)->readonly = (*TypTest__61_s->x)->left->readonly; (*TypTest__57_s->x)->readonly = (*TypTest__57_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__57_s->x;
node->obj = *TypTest__61_s->obj; node->obj = *TypTest__57_s->obj;
*TypTest__61_s->x = node; *TypTest__57_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__57_s->guard) {
if ((*TypTest__61_s->x)->class == 5) { if ((*TypTest__57_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__57_s->x;
node->obj = *TypTest__61_s->obj; node->obj = *TypTest__57_s->obj;
*TypTest__61_s->x = node; *TypTest__57_s->x = node;
} else { } else {
*TypTest__61_s->x = OPB_NewBoolConst(1); *TypTest__57_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__57 _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__57_s;
TypTest__61_s = &_s; TypTest__57_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__58((*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__58((*x)->typ, obj->typ);
} else { } else {
OPB_err(87); OPB_err(87);
} }
@ -507,7 +455,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__57_s = _s.lnk;
} }
void OPB_In (OPT_Node *x, OPT_Node y) void OPB_In (OPT_Node *x, OPT_Node y)
@ -573,13 +521,13 @@ static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x)
x->intval = -1; x->intval = -1;
} }
static struct MOp__30 { static struct MOp__28 {
struct MOp__30 *lnk; struct MOp__28 *lnk;
} *MOp__30_s; } *MOp__28_s;
static OPT_Node NewOp__31 (SHORTINT op, OPT_Struct typ, OPT_Node z); static OPT_Node NewOp__29 (SHORTINT op, OPT_Struct typ, OPT_Node z);
static OPT_Node NewOp__31 (SHORTINT op, OPT_Struct typ, OPT_Node z) static OPT_Node NewOp__29 (SHORTINT op, OPT_Struct typ, OPT_Node z)
{ {
OPT_Node _o_result; OPT_Node _o_result;
OPT_Node node = NIL; OPT_Node node = NIL;
@ -596,9 +544,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__30 _s; struct MOp__28 _s;
_s.lnk = MOp__30_s; _s.lnk = MOp__28_s;
MOp__30_s = &_s; MOp__28_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);
@ -612,7 +560,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__31(op, typ, z); z = NewOp__29(op, typ, z);
} }
} else { } else {
OPB_err(98); OPB_err(98);
@ -640,7 +588,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
} }
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__31(op, typ, z); z = NewOp__29(op, typ, z);
} }
} else { } else {
OPB_err(97); OPB_err(97);
@ -661,7 +609,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
} }
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__31(op, typ, z); z = NewOp__29(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -673,7 +621,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__31(op, typ, z); z = NewOp__29(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -686,7 +634,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__31(op, typ, z); z = NewOp__29(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -699,7 +647,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__31(op, typ, z); z = NewOp__29(op, typ, z);
} else { } else {
OPB_err(127); OPB_err(127);
} }
@ -708,7 +656,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__31(op, typ, z); z = NewOp__29(op, typ, z);
} else { } else {
OPB_err(219); OPB_err(219);
} }
@ -725,7 +673,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
} }
} }
*x = z; *x = z;
MOp__30_s = _s.lnk; MOp__28_s = _s.lnk;
} }
static void OPB_CheckPtr (OPT_Node x, OPT_Node y) static void OPB_CheckPtr (OPT_Node x, OPT_Node y)
@ -921,7 +869,7 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
if (x->typ->size <= y->typ->size) { if (x->typ->size <= y->typ->size) {
x->typ = y->typ; x->typ = y->typ;
} else { } else {
x->typ = OPB_IntType(x->typ->size); x->typ = OPT_IntType(x->typ->size);
} }
} else if (g == 7) { } else if (g == 7) {
x->typ = OPT_realtyp; x->typ = OPT_realtyp;
@ -1178,7 +1126,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
if (__IN(g, 0x70)) { if (__IN(g, 0x70)) {
if (f > g) { if (f > g) {
OPB_SetIntType(*x); OPB_SetIntType(*x);
if ((int)(*x)->typ->form > g) { if ((*x)->typ->size > typ->size) {
OPB_err(203); OPB_err(203);
(*x)->conval->intval = 1; (*x)->conval->intval = 1;
} }
@ -1219,15 +1167,15 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
(*x)->typ = typ; (*x)->typ = typ;
} }
static struct Op__40 { static struct Op__38 {
INTEGER *f, *g; INTEGER *f, *g;
struct Op__40 *lnk; struct Op__38 *lnk;
} *Op__40_s; } *Op__38_s;
static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y); static void NewOp__39 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y);
static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y); static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y);
static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y) static void NewOp__39 (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);
@ -1238,29 +1186,29 @@ static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
*x = node; *x = node;
} }
static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y) static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y)
{ {
BOOLEAN _o_result; BOOLEAN _o_result;
BOOLEAN ok, xCharArr, yCharArr; BOOLEAN ok, xCharArr, yCharArr;
xCharArr = (__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp->form == 3) || *Op__40_s->f == 10; xCharArr = (__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp->form == 3) || *Op__38_s->f == 10;
yCharArr = (__IN((*y)->typ->comp, 0x0c) && (*y)->typ->BaseTyp->form == 3) || *Op__40_s->g == 10; yCharArr = (__IN((*y)->typ->comp, 0x0c) && (*y)->typ->BaseTyp->form == 3) || *Op__38_s->g == 10;
if ((((xCharArr && *Op__40_s->g == 3)) && (*y)->class == 7)) { if ((((xCharArr && *Op__38_s->g == 3)) && (*y)->class == 7)) {
OPB_CharToString(*y); OPB_CharToString(*y);
*Op__40_s->g = 10; *Op__38_s->g = 10;
yCharArr = 1; yCharArr = 1;
} }
if ((((yCharArr && *Op__40_s->f == 3)) && (*x)->class == 7)) { if ((((yCharArr && *Op__38_s->f == 3)) && (*x)->class == 7)) {
OPB_CharToString(*x); OPB_CharToString(*x);
*Op__40_s->f = 10; *Op__38_s->f = 10;
xCharArr = 1; xCharArr = 1;
} }
ok = (xCharArr && yCharArr); ok = (xCharArr && yCharArr);
if (ok) { if (ok) {
if ((*Op__40_s->f == 10 && (*x)->conval->intval2 == 1)) { if ((*Op__38_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__40_s->g == 10 && (*y)->conval->intval2 == 1)) { } else if ((*Op__38_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))));
@ -1277,11 +1225,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__40 _s; struct Op__38 _s;
_s.f = &f; _s.f = &f;
_s.g = &g; _s.g = &g;
_s.lnk = Op__40_s; _s.lnk = Op__38_s;
Op__40_s = &_s; Op__38_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);
@ -1393,7 +1341,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp; typ = OPT_undftyp;
} }
if (do_) { if (do_) {
NewOp__41(op, typ, &z, y); NewOp__39(op, typ, &z, y);
} }
break; break;
case 2: case 2:
@ -1412,7 +1360,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__41(op, typ, &z, y); NewOp__39(op, typ, &z, y);
break; break;
case 3: case 3:
do_ = 1; do_ = 1;
@ -1435,7 +1383,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp; typ = OPT_undftyp;
} }
if (do_) { if (do_) {
NewOp__41(op, typ, &z, y); NewOp__39(op, typ, &z, y);
} }
break; break;
case 4: case 4:
@ -1453,7 +1401,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__41(op, typ, &z, y); NewOp__39(op, typ, &z, y);
break; break;
case 5: case 5:
if (f == 2) { if (f == 2) {
@ -1463,7 +1411,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__41(op, typ, &z, y); NewOp__39(op, typ, &z, y);
} }
} else if (f != 0) { } else if (f != 0) {
OPB_err(94); OPB_err(94);
@ -1486,7 +1434,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
} }
} }
if (do_) { if (do_) {
NewOp__41(op, typ, &z, y); NewOp__39(op, typ, &z, y);
} }
break; break;
case 7: case 7:
@ -1495,7 +1443,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__41(op, typ, &z, y); NewOp__39(op, typ, &z, y);
} }
break; break;
case 8: case 8:
@ -1506,7 +1454,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__41(op, typ, &z, y); NewOp__39(op, typ, &z, y);
} }
} else if (f != 0) { } else if (f != 0) {
OPB_err(95); OPB_err(95);
@ -1514,16 +1462,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__43(&z, &y)) { if (__IN(f, 0x6bff) || strings__41(&z, &y)) {
typ = OPT_booltyp; typ = OPT_booltyp;
} else { } else {
OPB_err(107); OPB_err(107);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__41(op, typ, &z, y); NewOp__39(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__43(&z, &y)) { if (__IN(f, 0x01f9) || strings__41(&z, &y)) {
typ = OPT_booltyp; typ = OPT_booltyp;
} else { } else {
OPM_LogWLn(); OPM_LogWLn();
@ -1532,7 +1480,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__41(op, typ, &z, y); NewOp__39(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);
@ -1542,7 +1490,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
} }
} }
*x = z; *x = z;
Op__40_s = _s.lnk; Op__38_s = _s.lnk;
} }
void OPB_SetRange (OPT_Node *x, OPT_Node y) void OPB_SetRange (OPT_Node *x, OPT_Node y)
@ -1894,8 +1842,13 @@ 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 ((__IN(f, 0x70) && x->typ->size > (int)OPM_SIntSize)) { } else if (__IN(f, 0x70)) {
OPB_Convert(&x, OPB_IntType(OPB_ShorterSize(x->typ->size))); typ = OPT_ShorterOrLongerType(x->typ, -1);
if (typ == NIL) {
OPB_err(111);
} else {
OPB_Convert(&x, typ);
}
} else if (f == 8) { } else if (f == 8) {
OPB_Convert(&x, OPT_realtyp); OPB_Convert(&x, OPT_realtyp);
} else { } else {
@ -1905,8 +1858,13 @@ 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 ((__IN(f, 0x70) && x->typ->size < (int)OPM_LIntSize)) { } else if (__IN(f, 0x70)) {
OPB_Convert(&x, OPB_IntType(OPB_LongerSize(x->typ->size))); typ = OPT_ShorterOrLongerType(x->typ, 1);
if (typ == NIL) {
OPB_err(111);
} else {
OPB_Convert(&x, typ);
}
} 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) {
@ -2043,13 +2001,13 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
*par0 = x; *par0 = x;
} }
static struct StPar1__56 { static struct StPar1__52 {
struct StPar1__56 *lnk; struct StPar1__52 *lnk;
} *StPar1__56_s; } *StPar1__52_s;
static OPT_Node NewOp__57 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right); static OPT_Node NewOp__53 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right);
static OPT_Node NewOp__57 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right) static OPT_Node NewOp__53 (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 +2024,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__52 _s;
_s.lnk = StPar1__56_s; _s.lnk = StPar1__52_s;
StPar1__56_s = &_s; StPar1__52_s = &_s;
p = *par0; p = *par0;
f = x->typ->form; f = x->typ->form;
switch (fctno) { switch (fctno) {
@ -2084,7 +2042,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__53(19, fctno, p, x);
p->typ = OPT_notyp; p->typ = OPT_notyp;
} }
break; break;
@ -2095,7 +2053,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval > (int)OPM_MaxSet))) { if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval > (int)OPM_MaxSet))) {
OPB_err(202); OPB_err(202);
} }
p = NewOp__57(19, fctno, p, x); p = NewOp__53(19, fctno, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2120,7 +2078,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__53(12, 19, p, x);
p->typ = OPT_linttyp; p->typ = OPT_linttyp;
} else { } else {
p = x; p = x;
@ -2142,7 +2100,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__53(19, 18, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2168,7 +2126,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__53(12, 17, p, x);
p->typ = OPT_linttyp; p->typ = OPT_linttyp;
} }
} else { } else {
@ -2199,9 +2157,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__53(12, 27, p, x);
} else { } else {
p = NewOp__57(12, 28, p, x); p = NewOp__53(12, 28, p, x);
} }
p->typ = p->left->typ; p->typ = p->left->typ;
} }
@ -2218,7 +2176,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__53(19, fctno, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2228,7 +2186,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__53(12, 26, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2252,7 +2210,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__53(19, 30, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2298,7 +2256,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
break; break;
} }
*par0 = p; *par0 = p;
StPar1__56_s = _s.lnk; StPar1__52_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)

View file

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

View file

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

View file

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

View file

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

View file

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

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/26] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/30] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
#include "OPB.h" #include "OPB.h"
#include "OPM.h" #include "OPM.h"
@ -24,7 +24,7 @@ export LONGINT *OPP__1__typ;
static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar); static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar);
static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned); static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned);
static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq); static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq);
static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab); static void OPP_CaseLabelList (OPT_Node *lab, OPT_Struct LabelTyp, INTEGER *n, OPP_CaseTable tab);
static void OPP_CheckMark (SHORTINT *vis); static void OPP_CheckMark (SHORTINT *vis);
static void OPP_CheckSym (INTEGER s); static void OPP_CheckSym (INTEGER s);
static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_); static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_);
@ -1163,7 +1163,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
ProcedureDeclaration__16_s = _s.lnk; ProcedureDeclaration__16_s = _s.lnk;
} }
static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab) static void OPP_CaseLabelList (OPT_Node *lab, OPT_Struct LabelTyp, INTEGER *n, OPP_CaseTable tab)
{ {
OPT_Node x = NIL, y = NIL, lastlab = NIL; OPT_Node x = NIL, y = NIL, lastlab = NIL;
INTEGER i, f; INTEGER i, f;
@ -1180,10 +1180,10 @@ static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP
xval = 1; xval = 1;
} }
if (__IN(f, 0x70)) { if (__IN(f, 0x70)) {
if (LabelForm < f) { if (!__IN(LabelTyp->form, 0x70) || LabelTyp->size < x->typ->size) {
OPP_err(60); OPP_err(60);
} }
} else if (LabelForm != f) { } else if ((int)LabelTyp->form != f) {
OPP_err(60); OPP_err(60);
} }
if (OPP_sym == 21) { if (OPP_sym == 21) {
@ -1262,7 +1262,7 @@ static void CasePart__31 (OPT_Node *x)
n = 0; n = 0;
for (;;) { for (;;) {
if (OPP_sym < 40) { if (OPP_sym < 40) {
OPP_CaseLabelList(&lab, (*x)->typ->form, &n, tab); OPP_CaseLabelList(&lab, (*x)->typ, &n, tab);
OPP_CheckSym(20); OPP_CheckSym(20);
OPP_StatSeq(&y); OPP_StatSeq(&y);
OPB_Construct(17, &lab, y); OPB_Construct(17, &lab, y);
@ -1471,7 +1471,7 @@ static void OPP_StatSeq (OPT_Node *stat)
SetPos__35(z); SetPos__35(z);
OPB_Link(&*stat, &last, z); OPB_Link(&*stat, &last, z);
y = OPB_NewLeaf(t); y = OPB_NewLeaf(t);
} else if (y->typ->form < 4 || y->typ->form > x->left->typ->form) { } else if (!__IN(y->typ->form, 0x70) || y->typ->size > x->left->typ->size) {
OPP_err(113); OPP_err(113);
} }
OPB_Link(&*stat, &last, x); OPB_Link(&*stat, &last, x);

View file

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

View file

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

View file

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

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/26] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/30] for gcc LP64 on cygwin xtspkaSfF */
#include "SYSTEM.h" #include "SYSTEM.h"
#include "OPM.h" #include "OPM.h"
#include "OPS.h" #include "OPS.h"
@ -84,11 +84,11 @@ typedef
export void (*OPT_typSize)(OPT_Struct); export void (*OPT_typSize)(OPT_Struct);
export OPT_Object OPT_topScope; export OPT_Object OPT_topScope;
export OPT_Struct OPT_undftyp, OPT_bytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_ainttyp, OPT_int8typ, OPT_int16typ, OPT_int32typ, OPT_int64typ, OPT_realtyp, OPT_lrltyp, OPT_settyp, OPT_stringtyp, OPT_niltyp, OPT_notyp, OPT_sysptrtyp; export OPT_Struct OPT_undftyp, OPT_bytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_ainttyp, OPT_int8typ, OPT_int16typ, OPT_int32typ, OPT_int64typ, OPT_realtyp, OPT_lrltyp, OPT_settyp, OPT_stringtyp, OPT_niltyp, OPT_notyp, OPT_sysptrtyp;
static OPT_Object OPT_LIntObj;
export SHORTINT OPT_nofGmod; export SHORTINT OPT_nofGmod;
export OPT_Object OPT_GlbMod[64]; export OPT_Object OPT_GlbMod[64];
export OPS_Name OPT_SelfName; export OPS_Name OPT_SelfName;
export BOOLEAN OPT_SYSimported; export BOOLEAN OPT_SYSimported;
static OPT_Struct OPT_IntTypes[20];
static OPT_Object OPT_universe, OPT_syslink; static OPT_Object OPT_universe, OPT_syslink;
static OPT_ImpCtxt OPT_impCtxt; static OPT_ImpCtxt OPT_impCtxt;
static OPT_ExpCtxt OPT_expCtxt; static OPT_ExpCtxt OPT_expCtxt;
@ -106,7 +106,6 @@ export void OPT_Close (void);
export void OPT_CloseScope (void); export void OPT_CloseScope (void);
static void OPT_DebugStruct (OPT_Struct btyp); static void OPT_DebugStruct (OPT_Struct btyp);
static void OPT_EnterBoolConst (OPS_Name name, LONGINT value); static void OPT_EnterBoolConst (OPS_Name name, LONGINT value);
static void OPT_EnterDerivedType (OPS_Name name, OPT_Struct typ, OPT_Object *obj);
static void OPT_EnterProc (OPS_Name name, INTEGER num); static void OPT_EnterProc (OPS_Name name, INTEGER num);
static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct *res); static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct *res);
export void OPT_Export (BOOLEAN *ext, BOOLEAN *new); export void OPT_Export (BOOLEAN *ext, BOOLEAN *new);
@ -128,10 +127,12 @@ static OPT_Object OPT_InObj (SHORTINT mno);
static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par); static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par);
static void OPT_InStruct (OPT_Struct *typ); static void OPT_InStruct (OPT_Struct *typ);
static OPT_Object OPT_InTProc (SHORTINT mno); static OPT_Object OPT_InTProc (SHORTINT mno);
static OPT_Struct OPT_InTyp (LONGINT tag);
export void OPT_Init (OPS_Name name, SET opt); export void OPT_Init (OPS_Name name, SET opt);
static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form); static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form);
export void OPT_Insert (OPS_Name name, OPT_Object *obj); export void OPT_Insert (OPS_Name name, OPT_Object *obj);
export void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old); export void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old);
export OPT_Struct OPT_IntType (LONGINT size);
export OPT_Const OPT_NewConst (void); export OPT_Const OPT_NewConst (void);
export OPT_ConstExt OPT_NewExt (void); export OPT_ConstExt OPT_NewExt (void);
export OPT_Node OPT_NewNode (SHORTINT class); export OPT_Node OPT_NewNode (SHORTINT class);
@ -147,6 +148,7 @@ static void OPT_OutObj (OPT_Object obj);
static void OPT_OutSign (OPT_Struct result, OPT_Object par); static void OPT_OutSign (OPT_Struct result, OPT_Object par);
static void OPT_OutStr (OPT_Struct typ); static void OPT_OutStr (OPT_Struct typ);
static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj); static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj);
export OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INTEGER dir);
static void OPT_err (INTEGER n); static void OPT_err (INTEGER n);
@ -155,6 +157,34 @@ static void OPT_err (INTEGER n)
OPM_err(n); OPM_err(n);
} }
OPT_Struct OPT_IntType (LONGINT size)
{
OPT_Struct _o_result;
INTEGER i;
i = 1;
while ((OPT_IntTypes[__X(i, ((LONGINT)(20)))]->size < size && OPT_IntTypes[__X(i + 1, ((LONGINT)(20)))] != NIL)) {
i += 1;
}
_o_result = OPT_IntTypes[__X(i, ((LONGINT)(20)))];
return _o_result;
}
OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INTEGER dir)
{
OPT_Struct _o_result;
INTEGER i;
__ASSERT(__IN(x->form, 0x70), 0);
__ASSERT(dir == 1 || dir == -1, 0);
__ASSERT(x->BaseTyp == OPT_undftyp, 0);
i = 0;
while ((OPT_IntTypes[__X(i, ((LONGINT)(20)))] != x && i < 20)) {
i += 1;
}
__ASSERT(i < 19, 0);
_o_result = OPT_IntTypes[__X(i + dir, ((LONGINT)(20)))];
return _o_result;
}
OPT_Const OPT_NewConst (void) OPT_Const OPT_NewConst (void)
{ {
OPT_Const _o_result; OPT_Const _o_result;
@ -467,21 +497,21 @@ void OPT_IdFPrint (OPT_Struct typ)
} }
} }
static struct FPrintStr__13 { static struct FPrintStr__12 {
LONGINT *pbfp, *pvfp; LONGINT *pbfp, *pvfp;
struct FPrintStr__13 *lnk; struct FPrintStr__12 *lnk;
} *FPrintStr__13_s; } *FPrintStr__12_s;
static void FPrintFlds__14 (OPT_Object fld, LONGINT adr, BOOLEAN visible); static void FPrintFlds__13 (OPT_Object fld, LONGINT adr, BOOLEAN visible);
static void FPrintHdFld__16 (OPT_Struct typ, OPT_Object fld, LONGINT adr); static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr);
static void FPrintTProcs__18 (OPT_Object obj); static void FPrintTProcs__17 (OPT_Object obj);
static void FPrintHdFld__16 (OPT_Struct typ, OPT_Object fld, LONGINT adr) static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr)
{ {
LONGINT i, j, n; LONGINT i, j, n;
OPT_Struct btyp = NIL; OPT_Struct btyp = NIL;
if (typ->comp == 4) { if (typ->comp == 4) {
FPrintFlds__14(typ->link, adr, 0); FPrintFlds__13(typ->link, adr, 0);
} else if (typ->comp == 2) { } else if (typ->comp == 2) {
btyp = typ->BaseTyp; btyp = typ->BaseTyp;
n = typ->n; n = typ->n;
@ -491,53 +521,53 @@ static void FPrintHdFld__16 (OPT_Struct typ, OPT_Object fld, LONGINT adr)
} }
if (btyp->form == 13 || btyp->comp == 4) { if (btyp->form == 13 || btyp->comp == 4) {
j = OPT_nofhdfld; j = OPT_nofhdfld;
FPrintHdFld__16(btyp, fld, adr); FPrintHdFld__15(btyp, fld, adr);
if (j != OPT_nofhdfld) { if (j != OPT_nofhdfld) {
i = 1; i = 1;
while ((i < n && OPT_nofhdfld <= 2048)) { while ((i < n && OPT_nofhdfld <= 2048)) {
adr += btyp->size; adr += btyp->size;
FPrintHdFld__16(btyp, fld, adr); FPrintHdFld__15(btyp, fld, adr);
i += 1; i += 1;
} }
} }
} }
} else if (typ->form == 13 || __STRCMP(fld->name, "@ptr") == 0) { } else if (typ->form == 13 || __STRCMP(fld->name, "@ptr") == 0) {
OPM_FPrint(&*FPrintStr__13_s->pvfp, ((LONGINT)(13))); OPM_FPrint(&*FPrintStr__12_s->pvfp, ((LONGINT)(13)));
OPM_FPrint(&*FPrintStr__13_s->pvfp, adr); OPM_FPrint(&*FPrintStr__12_s->pvfp, adr);
OPT_nofhdfld += 1; OPT_nofhdfld += 1;
} }
} }
static void FPrintFlds__14 (OPT_Object fld, LONGINT adr, BOOLEAN visible) static void FPrintFlds__13 (OPT_Object fld, LONGINT adr, BOOLEAN visible)
{ {
while ((fld != NIL && fld->mode == 4)) { while ((fld != NIL && fld->mode == 4)) {
if ((fld->vis != 0 && visible)) { if ((fld->vis != 0 && visible)) {
OPM_FPrint(&*FPrintStr__13_s->pbfp, fld->vis); OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->vis);
OPT_FPrintName(&*FPrintStr__13_s->pbfp, (void*)fld->name, ((LONGINT)(256))); OPT_FPrintName(&*FPrintStr__12_s->pbfp, (void*)fld->name, ((LONGINT)(256)));
OPM_FPrint(&*FPrintStr__13_s->pbfp, fld->adr); OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->adr);
OPT_FPrintStr(fld->typ); OPT_FPrintStr(fld->typ);
OPM_FPrint(&*FPrintStr__13_s->pbfp, fld->typ->pbfp); OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->typ->pbfp);
OPM_FPrint(&*FPrintStr__13_s->pvfp, fld->typ->pvfp); OPM_FPrint(&*FPrintStr__12_s->pvfp, fld->typ->pvfp);
} else { } else {
FPrintHdFld__16(fld->typ, fld, fld->adr + adr); FPrintHdFld__15(fld->typ, fld, fld->adr + adr);
} }
fld = fld->link; fld = fld->link;
} }
} }
static void FPrintTProcs__18 (OPT_Object obj) static void FPrintTProcs__17 (OPT_Object obj)
{ {
if (obj != NIL) { if (obj != NIL) {
FPrintTProcs__18(obj->left); FPrintTProcs__17(obj->left);
if (obj->mode == 13) { if (obj->mode == 13) {
if (obj->vis != 0) { if (obj->vis != 0) {
OPM_FPrint(&*FPrintStr__13_s->pbfp, ((LONGINT)(13))); OPM_FPrint(&*FPrintStr__12_s->pbfp, ((LONGINT)(13)));
OPM_FPrint(&*FPrintStr__13_s->pbfp, __ASHR(obj->adr, 16)); OPM_FPrint(&*FPrintStr__12_s->pbfp, __ASHR(obj->adr, 16));
OPT_FPrintSign(&*FPrintStr__13_s->pbfp, obj->typ, obj->link); OPT_FPrintSign(&*FPrintStr__12_s->pbfp, obj->typ, obj->link);
OPT_FPrintName(&*FPrintStr__13_s->pbfp, (void*)obj->name, ((LONGINT)(256))); OPT_FPrintName(&*FPrintStr__12_s->pbfp, (void*)obj->name, ((LONGINT)(256)));
} }
} }
FPrintTProcs__18(obj->right); FPrintTProcs__17(obj->right);
} }
} }
@ -547,11 +577,11 @@ void OPT_FPrintStr (OPT_Struct typ)
OPT_Struct btyp = NIL; OPT_Struct btyp = NIL;
OPT_Object strobj = NIL, bstrobj = NIL; OPT_Object strobj = NIL, bstrobj = NIL;
LONGINT pbfp, pvfp; LONGINT pbfp, pvfp;
struct FPrintStr__13 _s; struct FPrintStr__12 _s;
_s.pbfp = &pbfp; _s.pbfp = &pbfp;
_s.pvfp = &pvfp; _s.pvfp = &pvfp;
_s.lnk = FPrintStr__13_s; _s.lnk = FPrintStr__12_s;
FPrintStr__13_s = &_s; FPrintStr__12_s = &_s;
if (!typ->fpdone) { if (!typ->fpdone) {
OPT_IdFPrint(typ); OPT_IdFPrint(typ);
pbfp = typ->idfp; pbfp = typ->idfp;
@ -588,11 +618,11 @@ void OPT_FPrintStr (OPT_Struct typ)
OPM_FPrint(&pvfp, typ->align); OPM_FPrint(&pvfp, typ->align);
OPM_FPrint(&pvfp, typ->n); OPM_FPrint(&pvfp, typ->n);
OPT_nofhdfld = 0; OPT_nofhdfld = 0;
FPrintFlds__14(typ->link, ((LONGINT)(0)), 1); FPrintFlds__13(typ->link, ((LONGINT)(0)), 1);
if (OPT_nofhdfld > 2048) { if (OPT_nofhdfld > 2048) {
OPM_Mark(225, typ->txtpos); OPM_Mark(225, typ->txtpos);
} }
FPrintTProcs__18(typ->link); FPrintTProcs__17(typ->link);
OPM_FPrint(&pvfp, pbfp); OPM_FPrint(&pvfp, pbfp);
strobj = typ->strobj; strobj = typ->strobj;
if (strobj == NIL || strobj->name[0] == 0x00) { if (strobj == NIL || strobj->name[0] == 0x00) {
@ -602,7 +632,7 @@ void OPT_FPrintStr (OPT_Struct typ)
typ->pbfp = pbfp; typ->pbfp = pbfp;
typ->pvfp = pvfp; typ->pvfp = pvfp;
} }
FPrintStr__13_s = _s.lnk; FPrintStr__12_s = _s.lnk;
} }
void OPT_FPrintObj (OPT_Object obj) void OPT_FPrintObj (OPT_Object obj)
@ -946,6 +976,19 @@ static OPT_Object OPT_InTProc (SHORTINT mno)
return _o_result; return _o_result;
} }
static OPT_Struct OPT_InTyp (LONGINT tag)
{
OPT_Struct _o_result;
if (__IN(tag, 0x70)) {
_o_result = OPT_IntType(OPM_SymRInt());
return _o_result;
} else {
_o_result = OPT_impCtxt.ref[__X(tag, ((LONGINT)(255)))];
return _o_result;
}
__RETCHK;
}
static void OPT_InStruct (OPT_Struct *typ) static void OPT_InStruct (OPT_Struct *typ)
{ {
SHORTINT mno; SHORTINT mno;
@ -956,7 +999,7 @@ static void OPT_InStruct (OPT_Struct *typ)
OPT_Object obj = NIL, last = NIL, fld = NIL, old = NIL, dummy = NIL; OPT_Object obj = NIL, last = NIL, fld = NIL, old = NIL, dummy = NIL;
tag = OPM_SymRInt(); tag = OPM_SymRInt();
if (tag != 34) { if (tag != 34) {
*typ = OPT_impCtxt.ref[__X(-tag, ((LONGINT)(255)))]; *typ = OPT_InTyp(-tag);
} else { } else {
ref = OPT_impCtxt.nofr; ref = OPT_impCtxt.nofr;
OPT_impCtxt.nofr += 1; OPT_impCtxt.nofr += 1;
@ -1081,7 +1124,7 @@ static void OPT_InStruct (OPT_Struct *typ)
} }
if (ref == OPT_impCtxt.minr) { if (ref == OPT_impCtxt.minr) {
while (ref < OPT_impCtxt.nofr) { while (ref < OPT_impCtxt.nofr) {
t = OPT_impCtxt.ref[__X(ref, ((LONGINT)(255)))]; t = OPT_InTyp(ref);
OPT_FPrintStr(t); OPT_FPrintStr(t);
obj = t->strobj; obj = t->strobj;
if (obj->name[0] != 0x00) { if (obj->name[0] != 0x00) {
@ -1150,9 +1193,9 @@ static OPT_Object OPT_InObj (SHORTINT mno)
obj->vis = 1; obj->vis = 1;
if (tag <= 13) { if (tag <= 13) {
obj->mode = 3; obj->mode = 3;
obj->typ = OPT_impCtxt.ref[__X(tag, ((LONGINT)(255)))];
obj->conval = OPT_NewConst(); obj->conval = OPT_NewConst();
OPT_InConstant(tag, obj->conval); OPT_InConstant(tag, obj->conval);
obj->typ = OPT_InTyp(tag);
} else if (tag >= 31) { } else if (tag >= 31) {
obj->conval = OPT_NewConst(); obj->conval = OPT_NewConst();
obj->conval->intval = -1; obj->conval->intval = -1;
@ -1396,6 +1439,9 @@ static void OPT_OutStr (OPT_Struct typ)
OPT_Object strobj = NIL; OPT_Object strobj = NIL;
if (typ->ref < OPT_expCtxt.ref) { if (typ->ref < OPT_expCtxt.ref) {
OPM_SymWInt(-typ->ref); OPM_SymWInt(-typ->ref);
if (__IN(typ->ref, 0x70)) {
OPM_SymWInt(typ->size);
}
} else { } else {
OPM_SymWInt(((LONGINT)(34))); OPM_SymWInt(((LONGINT)(34)));
typ->ref = OPT_expCtxt.ref; typ->ref = OPT_expCtxt.ref;
@ -1493,6 +1539,7 @@ static void OPT_OutConstant (OPT_Object obj)
break; break;
case 4: case 5: case 6: case 4: case 5: case 6:
OPM_SymWInt(obj->conval->intval); OPM_SymWInt(obj->conval->intval);
OPM_SymWInt(obj->typ->size);
break; break;
case 9: case 9:
OPM_SymWSet(obj->conval->setval); OPM_SymWSet(obj->conval->setval);
@ -1699,15 +1746,6 @@ static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct
*res = typ; *res = typ;
} }
static void OPT_EnterDerivedType (OPS_Name name, OPT_Struct typ, OPT_Object *obj)
{
OPS_Name name__copy;
__DUPARR(name, OPS_Name);
OPT_Insert(name, &*obj);
(*obj)->mode = 5;
(*obj)->typ = typ;
}
static void OPT_EnterProc (OPS_Name name, INTEGER num) static void OPT_EnterProc (OPS_Name name, INTEGER num)
{ {
OPT_Object obj = NIL; OPT_Object obj = NIL;
@ -1741,8 +1779,8 @@ static void EnumPtrs(void (*P)(void*))
P(OPT_niltyp); P(OPT_niltyp);
P(OPT_notyp); P(OPT_notyp);
P(OPT_sysptrtyp); P(OPT_sysptrtyp);
P(OPT_LIntObj);
__ENUMP(OPT_GlbMod, 64, P); __ENUMP(OPT_GlbMod, 64, P);
__ENUMP(OPT_IntTypes, 20, P);
P(OPT_universe); P(OPT_universe);
P(OPT_syslink); P(OPT_syslink);
__ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 3140, 1, P); __ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 3140, 1, P);
@ -1811,7 +1849,7 @@ export void *OPT__init(void)
OPT_InitStruct(&OPT_niltyp, 11); OPT_InitStruct(&OPT_niltyp, 11);
OPT_EnterTyp((CHAR*)"BYTE", 1, OPM_ByteSize, &OPT_bytetyp); OPT_EnterTyp((CHAR*)"BYTE", 1, OPM_ByteSize, &OPT_bytetyp);
OPT_EnterTyp((CHAR*)"PTR", 13, OPM_PointerSize, &OPT_sysptrtyp); OPT_EnterTyp((CHAR*)"PTR", 13, OPM_PointerSize, &OPT_sysptrtyp);
OPT_EnterTyp((CHAR*)"ADRINT", 5, OPM_LIntSize, &OPT_ainttyp); OPT_EnterTyp((CHAR*)"ADRINT", 5, OPM_PointerSize, &OPT_ainttyp);
OPT_EnterTyp((CHAR*)"INT8", 5, 1, &OPT_int8typ); OPT_EnterTyp((CHAR*)"INT8", 5, 1, &OPT_int8typ);
OPT_EnterTyp((CHAR*)"INT16", 5, 2, &OPT_int16typ); OPT_EnterTyp((CHAR*)"INT16", 5, 2, &OPT_int16typ);
OPT_EnterTyp((CHAR*)"INT32", 5, 4, &OPT_int32typ); OPT_EnterTyp((CHAR*)"INT32", 5, 4, &OPT_int32typ);
@ -1839,7 +1877,6 @@ export void *OPT__init(void)
OPT_EnterTyp((CHAR*)"LONGINT", 6, OPM_LIntSize, &OPT_linttyp); OPT_EnterTyp((CHAR*)"LONGINT", 6, OPM_LIntSize, &OPT_linttyp);
OPT_EnterTyp((CHAR*)"LONGREAL", 8, OPM_LRealSize, &OPT_lrltyp); OPT_EnterTyp((CHAR*)"LONGREAL", 8, OPM_LRealSize, &OPT_lrltyp);
OPT_EnterTyp((CHAR*)"SHORTINT", 4, OPM_SIntSize, &OPT_sinttyp); OPT_EnterTyp((CHAR*)"SHORTINT", 4, OPM_SIntSize, &OPT_sinttyp);
OPT_EnterDerivedType((CHAR*)"LINT", OPT_int64typ, &OPT_LIntObj);
OPT_EnterBoolConst((CHAR*)"FALSE", ((LONGINT)(0))); OPT_EnterBoolConst((CHAR*)"FALSE", ((LONGINT)(0)));
OPT_EnterBoolConst((CHAR*)"TRUE", ((LONGINT)(1))); OPT_EnterBoolConst((CHAR*)"TRUE", ((LONGINT)(1)));
OPT_EnterProc((CHAR*)"HALT", 0); OPT_EnterProc((CHAR*)"HALT", 0);
@ -1877,5 +1914,12 @@ export void *OPT__init(void)
OPT_impCtxt.ref[11] = OPT_niltyp; OPT_impCtxt.ref[11] = OPT_niltyp;
OPT_impCtxt.ref[12] = OPT_notyp; OPT_impCtxt.ref[12] = OPT_notyp;
OPT_impCtxt.ref[13] = OPT_sysptrtyp; OPT_impCtxt.ref[13] = OPT_sysptrtyp;
OPT_IntTypes[1] = OPT_sinttyp;
OPT_IntTypes[2] = OPT_inttyp;
OPT_IntTypes[3] = OPT_linttyp;
OPT_IntTypes[5] = OPT_int8typ;
OPT_IntTypes[6] = OPT_int16typ;
OPT_IntTypes[7] = OPT_int32typ;
OPT_IntTypes[8] = OPT_int64typ;
__ENDMOD; __ENDMOD;
} }

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/26] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/30] for gcc LP64 on cygwin xtspkaSfF */
#ifndef OPT__h #ifndef OPT__h
#define OPT__h #define OPT__h
@ -92,12 +92,14 @@ import void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done);
import void OPT_Init (OPS_Name name, SET opt); import void OPT_Init (OPS_Name name, SET opt);
import void OPT_Insert (OPS_Name name, OPT_Object *obj); import void OPT_Insert (OPS_Name name, OPT_Object *obj);
import void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old); import void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old);
import OPT_Struct OPT_IntType (LONGINT size);
import OPT_Const OPT_NewConst (void); import OPT_Const OPT_NewConst (void);
import OPT_ConstExt OPT_NewExt (void); import OPT_ConstExt OPT_NewExt (void);
import OPT_Node OPT_NewNode (SHORTINT class); import OPT_Node OPT_NewNode (SHORTINT class);
import OPT_Object OPT_NewObj (void); import OPT_Object OPT_NewObj (void);
import OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp); import OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp);
import void OPT_OpenScope (SHORTINT level, OPT_Object owner); import void OPT_OpenScope (SHORTINT level, OPT_Object owner);
import OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INTEGER dir);
import void *OPT__init(void); import void *OPT__init(void);

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

@ -60,12 +60,6 @@ typedef float REAL;
typedef double LONGREAL; typedef double LONGREAL;
typedef void* SYSTEM_PTR; typedef void* SYSTEM_PTR;
// Unsigned variants are for use by shift and rotate macros.
typedef unsigned char U_SYSTEM_BYTE;
typedef unsigned char U_CHAR;
typedef unsigned char U_SHORTINT;
// For 32 bit builds, the size of LONGINT depends on a make option: // For 32 bit builds, the size of LONGINT depends on a make option:
#if (__SIZEOF_POINTER__ == 8) || defined(LARGE) || defined(_WIN64) #if (__SIZEOF_POINTER__ == 8) || defined(LARGE) || defined(_WIN64)
@ -80,9 +74,20 @@ typedef unsigned char U_SHORTINT;
typedef unsigned long U_LONGINT; typedef unsigned long U_LONGINT;
#endif #endif
// Unsigned variants are for use by shift and rotate macros.
typedef unsigned char U_SYSTEM_BYTE;
typedef unsigned char U_CHAR;
typedef unsigned char U_SHORTINT;
typedef U_LONGINT SET; typedef U_LONGINT SET;
typedef U_LONGINT U_SET; typedef U_LONGINT U_SET;
typedef SYSTEM_CARD8 U_SYSTEM_INT8;
typedef SYSTEM_CARD16 U_SYSTEM_INT16;
typedef SYSTEM_CARD32 U_SYSTEM_INT32;
typedef SYSTEM_CARD64 U_SYSTEM_INT64;
// OS Memory allocation interfaces are in PlatformXXX.Mod // OS Memory allocation interfaces are in PlatformXXX.Mod
@ -178,7 +183,7 @@ static int __str_cmp(CHAR *x, CHAR *y){
#define __ABSFD(x) SYSTEM_ABSD((double)(x)) #define __ABSFD(x) SYSTEM_ABSD((double)(x))
#define __CAP(ch) ((CHAR)((ch)&0x5f)) #define __CAP(ch) ((CHAR)((ch)&0x5f))
#define __ODD(x) ((x)&1) #define __ODD(x) ((x)&1)
#define __IN(x, s) (((s)>>(x))&1) #define __IN(x, s) ((x)>=0 && (x)<(8*sizeof(SET)) && ((((U_SET)(s))>>(x))&1))
#define __SETOF(x) ((SET)1<<(x)) #define __SETOF(x) ((SET)1<<(x))
#define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h))) #define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h)))
#define __MASK(x, m) ((x)&~(m)) #define __MASK(x, m) ((x)&~(m))

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/26] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/30] 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/26] for gcc LP64 on cygwin", Configuration_versionLong, 41); __MOVE("1.95 [2016/08/30] for gcc LP64 on cygwin", Configuration_versionLong, 41);
__ENDMOD; __ENDMOD;
} }

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/26] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/30] for gcc LP64 on cygwin xtspkaSfF */
#define LARGE #define LARGE
#include "SYSTEM.h" #include "SYSTEM.h"
#include "OPM.h" #include "OPM.h"
@ -35,9 +35,7 @@ export void OPB_In (OPT_Node *x, OPT_Node y);
export void OPB_Index (OPT_Node *x, OPT_Node y); export void OPB_Index (OPT_Node *x, OPT_Node y);
export void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ); 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);
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);
@ -54,8 +52,6 @@ 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);
export void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno); export void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno);
export void OPB_StPar0 (OPT_Node *par0, INTEGER fctno); export void OPB_StPar0 (OPT_Node *par0, INTEGER fctno);
export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno); export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno);
@ -225,68 +221,20 @@ OPT_Node OPB_EmptySet (void)
return _o_result; return _o_result;
} }
static INTEGER OPB_SignedByteSize (LONGINT n) static void OPB_SetIntType (OPT_Node node)
{ {
INTEGER _o_result;
INTEGER b; INTEGER b;
if (n < 0) { LONGINT n;
n = -(n + 1); if (node->conval->intval >= 0) {
n = node->conval->intval;
} else {
n = -(node->conval->intval + 1);
} }
b = 1; b = 1;
while ((b < 8 && __ASH(n, -(__ASHL(b, 3) - 1)) != 0)) { while ((b < 8 && __ASH(n, -(__ASHL(b, 3) - 1)) != 0)) {
b += 1; b += 1;
} }
_o_result = b; node->typ = OPT_IntType(b);
return _o_result;
}
static LONGINT OPB_ShorterSize (LONGINT i)
{
LONGINT _o_result;
if (i >= (SYSTEM_INT64)OPM_LIntSize) {
_o_result = OPM_IntSize;
return _o_result;
} else {
_o_result = OPM_SIntSize;
return _o_result;
}
__RETCHK;
}
static LONGINT OPB_LongerSize (LONGINT i)
{
LONGINT _o_result;
if (i <= (SYSTEM_INT64)OPM_SIntSize) {
_o_result = OPM_IntSize;
return _o_result;
} else {
_o_result = OPM_LIntSize;
return _o_result;
}
__RETCHK;
}
static OPT_Struct OPB_IntType (LONGINT size)
{
OPT_Struct _o_result;
OPT_Struct result = NIL;
if (size <= OPT_sinttyp->size) {
result = OPT_sinttyp;
} else if (size <= OPT_inttyp->size) {
result = OPT_inttyp;
} else {
result = OPT_linttyp;
}
if (size > OPT_linttyp->size) {
OPB_err(203);
}
_o_result = result;
return _o_result;
}
static void OPB_SetIntType (OPT_Node node)
{
node->typ = OPB_IntType(OPB_SignedByteSize(node->conval->intval));
} }
OPT_Node OPB_NewIntConst (LONGINT intval) OPT_Node OPB_NewIntConst (LONGINT intval)
@ -430,16 +378,16 @@ void OPB_Field (OPT_Node *x, OPT_Object y)
} }
} }
static struct TypTest__61 { static struct TypTest__57 {
OPT_Node *x; OPT_Node *x;
OPT_Object *obj; OPT_Object *obj;
BOOLEAN *guard; BOOLEAN *guard;
struct TypTest__61 *lnk; struct TypTest__57 *lnk;
} *TypTest__61_s; } *TypTest__57_s;
static void GTT__62 (OPT_Struct t0, OPT_Struct t1); static void GTT__58 (OPT_Struct t0, OPT_Struct t1);
static void GTT__62 (OPT_Struct t0, OPT_Struct t1) static void GTT__58 (OPT_Struct t0, OPT_Struct t1)
{ {
OPT_Node node = NIL; OPT_Node node = NIL;
OPT_Struct t = NIL; OPT_Struct t = NIL;
@ -452,54 +400,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__57_s->guard) {
OPB_BindNodes(5, NIL, &*TypTest__61_s->x, NIL); OPB_BindNodes(5, NIL, &*TypTest__57_s->x, NIL);
(*TypTest__61_s->x)->readonly = (*TypTest__61_s->x)->left->readonly; (*TypTest__57_s->x)->readonly = (*TypTest__57_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__57_s->x;
node->obj = *TypTest__61_s->obj; node->obj = *TypTest__57_s->obj;
*TypTest__61_s->x = node; *TypTest__57_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__57_s->guard) {
if ((*TypTest__61_s->x)->class == 5) { if ((*TypTest__57_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__57_s->x;
node->obj = *TypTest__61_s->obj; node->obj = *TypTest__57_s->obj;
*TypTest__61_s->x = node; *TypTest__57_s->x = node;
} else { } else {
*TypTest__61_s->x = OPB_NewBoolConst(1); *TypTest__57_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__57 _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__57_s;
TypTest__61_s = &_s; TypTest__57_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__58((*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__58((*x)->typ, obj->typ);
} else { } else {
OPB_err(87); OPB_err(87);
} }
@ -508,7 +456,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__57_s = _s.lnk;
} }
void OPB_In (OPT_Node *x, OPT_Node y) void OPB_In (OPT_Node *x, OPT_Node y)
@ -574,13 +522,13 @@ static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x)
x->intval = -1; x->intval = -1;
} }
static struct MOp__30 { static struct MOp__28 {
struct MOp__30 *lnk; struct MOp__28 *lnk;
} *MOp__30_s; } *MOp__28_s;
static OPT_Node NewOp__31 (SHORTINT op, OPT_Struct typ, OPT_Node z); static OPT_Node NewOp__29 (SHORTINT op, OPT_Struct typ, OPT_Node z);
static OPT_Node NewOp__31 (SHORTINT op, OPT_Struct typ, OPT_Node z) static OPT_Node NewOp__29 (SHORTINT op, OPT_Struct typ, OPT_Node z)
{ {
OPT_Node _o_result; OPT_Node _o_result;
OPT_Node node = NIL; OPT_Node node = NIL;
@ -597,9 +545,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__30 _s; struct MOp__28 _s;
_s.lnk = MOp__30_s; _s.lnk = MOp__28_s;
MOp__30_s = &_s; MOp__28_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);
@ -613,7 +561,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__31(op, typ, z); z = NewOp__29(op, typ, z);
} }
} else { } else {
OPB_err(98); OPB_err(98);
@ -641,7 +589,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
} }
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__31(op, typ, z); z = NewOp__29(op, typ, z);
} }
} else { } else {
OPB_err(97); OPB_err(97);
@ -662,7 +610,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
} }
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__31(op, typ, z); z = NewOp__29(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -674,7 +622,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__31(op, typ, z); z = NewOp__29(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -687,7 +635,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__31(op, typ, z); z = NewOp__29(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -700,7 +648,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__31(op, typ, z); z = NewOp__29(op, typ, z);
} else { } else {
OPB_err(127); OPB_err(127);
} }
@ -709,7 +657,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__31(op, typ, z); z = NewOp__29(op, typ, z);
} else { } else {
OPB_err(219); OPB_err(219);
} }
@ -726,7 +674,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
} }
} }
*x = z; *x = z;
MOp__30_s = _s.lnk; MOp__28_s = _s.lnk;
} }
static void OPB_CheckPtr (OPT_Node x, OPT_Node y) static void OPB_CheckPtr (OPT_Node x, OPT_Node y)
@ -922,7 +870,7 @@ static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y)
if (x->typ->size <= y->typ->size) { if (x->typ->size <= y->typ->size) {
x->typ = y->typ; x->typ = y->typ;
} else { } else {
x->typ = OPB_IntType(x->typ->size); x->typ = OPT_IntType(x->typ->size);
} }
} else if (g == 7) { } else if (g == 7) {
x->typ = OPT_realtyp; x->typ = OPT_realtyp;
@ -1179,7 +1127,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
if (__IN(g, 0x70)) { if (__IN(g, 0x70)) {
if (f > g) { if (f > g) {
OPB_SetIntType(*x); OPB_SetIntType(*x);
if ((int)(*x)->typ->form > g) { if ((*x)->typ->size > typ->size) {
OPB_err(203); OPB_err(203);
(*x)->conval->intval = 1; (*x)->conval->intval = 1;
} }
@ -1220,15 +1168,15 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
(*x)->typ = typ; (*x)->typ = typ;
} }
static struct Op__40 { static struct Op__38 {
INTEGER *f, *g; INTEGER *f, *g;
struct Op__40 *lnk; struct Op__38 *lnk;
} *Op__40_s; } *Op__38_s;
static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y); static void NewOp__39 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y);
static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y); static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y);
static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y) static void NewOp__39 (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);
@ -1239,29 +1187,29 @@ static void NewOp__41 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
*x = node; *x = node;
} }
static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y) static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y)
{ {
BOOLEAN _o_result; BOOLEAN _o_result;
BOOLEAN ok, xCharArr, yCharArr; BOOLEAN ok, xCharArr, yCharArr;
xCharArr = (__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp->form == 3) || *Op__40_s->f == 10; xCharArr = (__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp->form == 3) || *Op__38_s->f == 10;
yCharArr = (__IN((*y)->typ->comp, 0x0c) && (*y)->typ->BaseTyp->form == 3) || *Op__40_s->g == 10; yCharArr = (__IN((*y)->typ->comp, 0x0c) && (*y)->typ->BaseTyp->form == 3) || *Op__38_s->g == 10;
if ((((xCharArr && *Op__40_s->g == 3)) && (*y)->class == 7)) { if ((((xCharArr && *Op__38_s->g == 3)) && (*y)->class == 7)) {
OPB_CharToString(*y); OPB_CharToString(*y);
*Op__40_s->g = 10; *Op__38_s->g = 10;
yCharArr = 1; yCharArr = 1;
} }
if ((((yCharArr && *Op__40_s->f == 3)) && (*x)->class == 7)) { if ((((yCharArr && *Op__38_s->f == 3)) && (*x)->class == 7)) {
OPB_CharToString(*x); OPB_CharToString(*x);
*Op__40_s->f = 10; *Op__38_s->f = 10;
xCharArr = 1; xCharArr = 1;
} }
ok = (xCharArr && yCharArr); ok = (xCharArr && yCharArr);
if (ok) { if (ok) {
if ((*Op__40_s->f == 10 && (*x)->conval->intval2 == 1)) { if ((*Op__38_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__40_s->g == 10 && (*y)->conval->intval2 == 1)) { } else if ((*Op__38_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))));
@ -1278,11 +1226,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__40 _s; struct Op__38 _s;
_s.f = &f; _s.f = &f;
_s.g = &g; _s.g = &g;
_s.lnk = Op__40_s; _s.lnk = Op__38_s;
Op__40_s = &_s; Op__38_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);
@ -1394,7 +1342,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp; typ = OPT_undftyp;
} }
if (do_) { if (do_) {
NewOp__41(op, typ, &z, y); NewOp__39(op, typ, &z, y);
} }
break; break;
case 2: case 2:
@ -1413,7 +1361,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__41(op, typ, &z, y); NewOp__39(op, typ, &z, y);
break; break;
case 3: case 3:
do_ = 1; do_ = 1;
@ -1436,7 +1384,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp; typ = OPT_undftyp;
} }
if (do_) { if (do_) {
NewOp__41(op, typ, &z, y); NewOp__39(op, typ, &z, y);
} }
break; break;
case 4: case 4:
@ -1454,7 +1402,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__41(op, typ, &z, y); NewOp__39(op, typ, &z, y);
break; break;
case 5: case 5:
if (f == 2) { if (f == 2) {
@ -1464,7 +1412,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__41(op, typ, &z, y); NewOp__39(op, typ, &z, y);
} }
} else if (f != 0) { } else if (f != 0) {
OPB_err(94); OPB_err(94);
@ -1487,7 +1435,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
} }
} }
if (do_) { if (do_) {
NewOp__41(op, typ, &z, y); NewOp__39(op, typ, &z, y);
} }
break; break;
case 7: case 7:
@ -1496,7 +1444,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__41(op, typ, &z, y); NewOp__39(op, typ, &z, y);
} }
break; break;
case 8: case 8:
@ -1507,7 +1455,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__41(op, typ, &z, y); NewOp__39(op, typ, &z, y);
} }
} else if (f != 0) { } else if (f != 0) {
OPB_err(95); OPB_err(95);
@ -1515,16 +1463,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__43(&z, &y)) { if (__IN(f, 0x6bff) || strings__41(&z, &y)) {
typ = OPT_booltyp; typ = OPT_booltyp;
} else { } else {
OPB_err(107); OPB_err(107);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__41(op, typ, &z, y); NewOp__39(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__43(&z, &y)) { if (__IN(f, 0x01f9) || strings__41(&z, &y)) {
typ = OPT_booltyp; typ = OPT_booltyp;
} else { } else {
OPM_LogWLn(); OPM_LogWLn();
@ -1533,7 +1481,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__41(op, typ, &z, y); NewOp__39(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);
@ -1543,7 +1491,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
} }
} }
*x = z; *x = z;
Op__40_s = _s.lnk; Op__38_s = _s.lnk;
} }
void OPB_SetRange (OPT_Node *x, OPT_Node y) void OPB_SetRange (OPT_Node *x, OPT_Node y)
@ -1895,8 +1843,13 @@ 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 ((__IN(f, 0x70) && x->typ->size > (SYSTEM_INT64)OPM_SIntSize)) { } else if (__IN(f, 0x70)) {
OPB_Convert(&x, OPB_IntType(OPB_ShorterSize(x->typ->size))); typ = OPT_ShorterOrLongerType(x->typ, -1);
if (typ == NIL) {
OPB_err(111);
} else {
OPB_Convert(&x, typ);
}
} else if (f == 8) { } else if (f == 8) {
OPB_Convert(&x, OPT_realtyp); OPB_Convert(&x, OPT_realtyp);
} else { } else {
@ -1906,8 +1859,13 @@ 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 ((__IN(f, 0x70) && x->typ->size < (SYSTEM_INT64)OPM_LIntSize)) { } else if (__IN(f, 0x70)) {
OPB_Convert(&x, OPB_IntType(OPB_LongerSize(x->typ->size))); typ = OPT_ShorterOrLongerType(x->typ, 1);
if (typ == NIL) {
OPB_err(111);
} else {
OPB_Convert(&x, typ);
}
} 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) {
@ -2044,13 +2002,13 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
*par0 = x; *par0 = x;
} }
static struct StPar1__56 { static struct StPar1__52 {
struct StPar1__56 *lnk; struct StPar1__52 *lnk;
} *StPar1__56_s; } *StPar1__52_s;
static OPT_Node NewOp__57 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right); static OPT_Node NewOp__53 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right);
static OPT_Node NewOp__57 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right) static OPT_Node NewOp__53 (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;
@ -2067,9 +2025,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__52 _s;
_s.lnk = StPar1__56_s; _s.lnk = StPar1__52_s;
StPar1__56_s = &_s; StPar1__52_s = &_s;
p = *par0; p = *par0;
f = x->typ->form; f = x->typ->form;
switch (fctno) { switch (fctno) {
@ -2085,7 +2043,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__53(19, fctno, p, x);
p->typ = OPT_notyp; p->typ = OPT_notyp;
} }
break; break;
@ -2096,7 +2054,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval > (SYSTEM_INT64)OPM_MaxSet))) { if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval > (SYSTEM_INT64)OPM_MaxSet))) {
OPB_err(202); OPB_err(202);
} }
p = NewOp__57(19, fctno, p, x); p = NewOp__53(19, fctno, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2121,7 +2079,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__53(12, 19, p, x);
p->typ = OPT_linttyp; p->typ = OPT_linttyp;
} else { } else {
p = x; p = x;
@ -2143,7 +2101,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__53(19, 18, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2169,7 +2127,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__53(12, 17, p, x);
p->typ = OPT_linttyp; p->typ = OPT_linttyp;
} }
} else { } else {
@ -2200,9 +2158,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__53(12, 27, p, x);
} else { } else {
p = NewOp__57(12, 28, p, x); p = NewOp__53(12, 28, p, x);
} }
p->typ = p->left->typ; p->typ = p->left->typ;
} }
@ -2219,7 +2177,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__53(19, fctno, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2229,7 +2187,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__53(12, 26, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2253,7 +2211,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__53(19, 30, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2299,7 +2257,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
break; break;
} }
*par0 = p; *par0 = p;
StPar1__56_s = _s.lnk; StPar1__52_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)

View file

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

View file

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

View file

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

View file

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

View file

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

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/26] for gcc LP64 on cygwin xtspkaSfF */ /* voc 1.95 [2016/08/30] for gcc LP64 on cygwin xtspkaSfF */
#define LARGE #define LARGE
#include "SYSTEM.h" #include "SYSTEM.h"
#include "OPB.h" #include "OPB.h"
@ -25,7 +25,7 @@ export LONGINT *OPP__1__typ;
static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar); static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar);
static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned); static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned);
static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq); static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq);
static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab); static void OPP_CaseLabelList (OPT_Node *lab, OPT_Struct LabelTyp, INTEGER *n, OPP_CaseTable tab);
static void OPP_CheckMark (SHORTINT *vis); static void OPP_CheckMark (SHORTINT *vis);
static void OPP_CheckSym (INTEGER s); static void OPP_CheckSym (INTEGER s);
static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_); static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_);
@ -1164,7 +1164,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
ProcedureDeclaration__16_s = _s.lnk; ProcedureDeclaration__16_s = _s.lnk;
} }
static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab) static void OPP_CaseLabelList (OPT_Node *lab, OPT_Struct LabelTyp, INTEGER *n, OPP_CaseTable tab)
{ {
OPT_Node x = NIL, y = NIL, lastlab = NIL; OPT_Node x = NIL, y = NIL, lastlab = NIL;
INTEGER i, f; INTEGER i, f;
@ -1181,10 +1181,10 @@ static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP
xval = 1; xval = 1;
} }
if (__IN(f, 0x70)) { if (__IN(f, 0x70)) {
if (LabelForm < f) { if (!__IN(LabelTyp->form, 0x70) || LabelTyp->size < x->typ->size) {
OPP_err(60); OPP_err(60);
} }
} else if (LabelForm != f) { } else if ((int)LabelTyp->form != f) {
OPP_err(60); OPP_err(60);
} }
if (OPP_sym == 21) { if (OPP_sym == 21) {
@ -1263,7 +1263,7 @@ static void CasePart__31 (OPT_Node *x)
n = 0; n = 0;
for (;;) { for (;;) {
if (OPP_sym < 40) { if (OPP_sym < 40) {
OPP_CaseLabelList(&lab, (*x)->typ->form, &n, tab); OPP_CaseLabelList(&lab, (*x)->typ, &n, tab);
OPP_CheckSym(20); OPP_CheckSym(20);
OPP_StatSeq(&y); OPP_StatSeq(&y);
OPB_Construct(17, &lab, y); OPB_Construct(17, &lab, y);
@ -1472,7 +1472,7 @@ static void OPP_StatSeq (OPT_Node *stat)
SetPos__35(z); SetPos__35(z);
OPB_Link(&*stat, &last, z); OPB_Link(&*stat, &last, z);
y = OPB_NewLeaf(t); y = OPB_NewLeaf(t);
} else if (y->typ->form < 4 || y->typ->form > x->left->typ->form) { } else if (!__IN(y->typ->form, 0x70) || y->typ->size > x->left->typ->size) {
OPP_err(113); OPP_err(113);
} }
OPB_Link(&*stat, &last, x); OPB_Link(&*stat, &last, x);

View file

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

View file

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

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/08/26] for gcc LP64 on cygwin tspkaSfF */ /* voc 1.95 [2016/08/30] 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