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

Tidy (#41)

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

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

* Show enlistment branch in makefiles

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

* Common code for MIN and MAX of integer types.

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

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

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

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

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

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

* OPB little simplifications and ShorterSize/LongerSize functions.

* Add test for alignment computability

* Replace alignment constants with calculated alignment.

* typ.size aware OPV.Convert

* Add SYSTEM_INT64 and make tests name independent.

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

* Replace uses of uintptr_t and size_t with SYSTEM_ADDRESS.

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

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

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

* Add debug for intermittent failure only on OpenBSD.

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

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

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

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