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

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

Browse source
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
Download patch file Download diff file Expand all files Collapse all files

4
bootstrap/unix-48/Configuration.c
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"
@ -13,6 +13,6 @@ export void *Configuration__init(void)
__DEFMOD;
__REGMOD("Configuration", 0);
/* 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;
}

2
bootstrap/unix-48/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 Configuration__h
#define Configuration__h

2
bootstrap/unix-48/Console.c
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 "Platform.h"

2
bootstrap/unix-48/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 Console__h
#define Console__h

2
bootstrap/unix-48/Files.c
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 "Configuration.h"
#include "Console.h"

2
bootstrap/unix-48/Files.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
#define Files__h

2
bootstrap/unix-48/Heap.c
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"
struct Heap__1 {

2
bootstrap/unix-48/Heap.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
#define Heap__h

2
bootstrap/unix-48/Modules.c
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 "Console.h"
#include "Heap.h"

2
bootstrap/unix-48/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 Modules__h
#define Modules__h

268
bootstrap/unix-48/OPB.c
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 "OPM.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_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);
@ -53,8 +51,6 @@ 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);
@ -224,68 +220,20 @@ OPT_Node OPB_EmptySet (void)
return _o_result;
}
static INTEGER OPB_SignedByteSize (LONGINT n)
static void OPB_SetIntType (OPT_Node node)
{
INTEGER _o_result;
INTEGER b;
if (n < 0) {
n = -(n + 1);
LONGINT n;
if (node->conval->intval >= 0) {
n = node->conval->intval;
} else {
n = -(node->conval->intval + 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)
{
node->typ = OPB_IntType(OPB_SignedByteSize(node->conval->intval));
node->typ = OPT_IntType(b);
}
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_Object *obj;
BOOLEAN *guard;
struct TypTest__61 *lnk;
} *TypTest__61_s;
struct TypTest__57 *lnk;
} *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_Struct t = NIL;
@ -451,54 +399,54 @@ static void GTT__62 (OPT_Struct t0, OPT_Struct t1)
t1 = t1->BaseTyp;
}
if (t1 == t0 || t0->form == 0) {
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;
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;
} else {
node = OPT_NewNode(11);
node->subcl = 16;
node->left = *TypTest__61_s->x;
node->obj = *TypTest__61_s->obj;
*TypTest__61_s->x = node;
node->left = *TypTest__57_s->x;
node->obj = *TypTest__57_s->obj;
*TypTest__57_s->x = node;
}
} else {
OPB_err(85);
}
} else if (t0 != t1) {
OPB_err(85);
} else if (!*TypTest__61_s->guard) {
if ((*TypTest__61_s->x)->class == 5) {
} else if (!*TypTest__57_s->guard) {
if ((*TypTest__57_s->x)->class == 5) {
node = OPT_NewNode(11);
node->subcl = 16;
node->left = *TypTest__61_s->x;
node->obj = *TypTest__61_s->obj;
*TypTest__61_s->x = node;
node->left = *TypTest__57_s->x;
node->obj = *TypTest__57_s->obj;
*TypTest__57_s->x = node;
} 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)
{
struct TypTest__61 _s;
struct TypTest__57 _s;
_s.x = x;
_s.obj = &obj;
_s.guard = &guard;
_s.lnk = TypTest__61_s;
TypTest__61_s = &_s;
_s.lnk = TypTest__57_s;
TypTest__57_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__62((*x)->typ->BaseTyp, obj->typ->BaseTyp);
GTT__58((*x)->typ->BaseTyp, obj->typ->BaseTyp);
} else {
OPB_err(86);
}
} 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 {
OPB_err(87);
}
@ -507,7 +455,7 @@ void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
} else {
(*x)->typ = OPT_booltyp;
}
TypTest__61_s = _s.lnk;
TypTest__57_s = _s.lnk;
}
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;
}
static struct MOp__30 {
struct MOp__30 *lnk;
} *MOp__30_s;
static struct MOp__28 {
struct MOp__28 *lnk;
} *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 node = NIL;
@ -596,9 +544,9 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
INTEGER f;
OPT_Struct typ = NIL;
OPT_Node z = NIL;
struct MOp__30 _s;
_s.lnk = MOp__30_s;
MOp__30_s = &_s;
struct MOp__28 _s;
_s.lnk = MOp__28_s;
MOp__28_s = &_s;
z = *x;
if (z->class == 8 || z->class == 9) {
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->obj = NIL;
} else {
z = NewOp__31(op, typ, z);
z = NewOp__29(op, typ, z);
}
} else {
OPB_err(98);
@ -640,7 +588,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
}
z->obj = NIL;
} else {
z = NewOp__31(op, typ, z);
z = NewOp__29(op, typ, z);
}
} else {
OPB_err(97);
@ -661,7 +609,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
}
z->obj = NIL;
} else {
z = NewOp__31(op, typ, z);
z = NewOp__29(op, typ, z);
}
} else {
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->obj = NIL;
} else {
z = NewOp__31(op, typ, z);
z = NewOp__29(op, typ, z);
}
} else {
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->obj = NIL;
} else {
z = NewOp__31(op, typ, z);
z = NewOp__29(op, typ, z);
}
} else {
OPB_err(111);
@ -699,7 +647,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
f = 10;
}
if (z->class < 7 || f == 10) {
z = NewOp__31(op, typ, z);
z = NewOp__29(op, typ, z);
} else {
OPB_err(127);
}
@ -708,7 +656,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__31(op, typ, z);
z = NewOp__29(op, typ, z);
} else {
OPB_err(219);
}
@ -725,7 +673,7 @@ void OPB_MOp (SHORTINT op, OPT_Node *x)
}
}
*x = z;
MOp__30_s = _s.lnk;
MOp__28_s = _s.lnk;
}
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) {
x->typ = y->typ;
} else {
x->typ = OPB_IntType(x->typ->size);
x->typ = OPT_IntType(x->typ->size);
}
} else if (g == 7) {
x->typ = OPT_realtyp;
@ -1178,7 +1126,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
if (__IN(g, 0x70)) {
if (f > g) {
OPB_SetIntType(*x);
if ((int)(*x)->typ->form > g) {
if ((*x)->typ->size > typ->size) {
OPB_err(203);
(*x)->conval->intval = 1;
}
@ -1219,15 +1167,15 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
(*x)->typ = typ;
}
static struct Op__40 {
static struct Op__38 {
INTEGER *f, *g;
struct Op__40 *lnk;
} *Op__40_s;
struct Op__38 *lnk;
} *Op__38_s;
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 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;
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;
}
static BOOLEAN strings__43 (OPT_Node *x, OPT_Node *y)
static BOOLEAN strings__41 (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__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)) {
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)) {
OPB_CharToString(*y);
*Op__40_s->g = 10;
*Op__38_s->g = 10;
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);
*Op__40_s->f = 10;
*Op__38_s->f = 10;
xCharArr = 1;
}
ok = (xCharArr && yCharArr);
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)->conval->intval = 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)->conval->intval = 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;
BOOLEAN do_;
LONGINT val;
struct Op__40 _s;
struct Op__38 _s;
_s.f = &f;
_s.g = &g;
_s.lnk = Op__40_s;
Op__40_s = &_s;
_s.lnk = Op__38_s;
Op__38_s = &_s;
z = *x;
if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) {
OPB_err(126);
@ -1393,7 +1341,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp;
}
if (do_) {
NewOp__41(op, typ, &z, y);
NewOp__39(op, typ, &z, y);
}
break;
case 2:
@ -1412,7 +1360,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(102);
typ = OPT_undftyp;
}
NewOp__41(op, typ, &z, y);
NewOp__39(op, typ, &z, y);
break;
case 3:
do_ = 1;
@ -1435,7 +1383,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp;
}
if (do_) {
NewOp__41(op, typ, &z, y);
NewOp__39(op, typ, &z, y);
}
break;
case 4:
@ -1453,7 +1401,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(104);
typ = OPT_undftyp;
}
NewOp__41(op, typ, &z, y);
NewOp__39(op, typ, &z, y);
break;
case 5:
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 {
NewOp__41(op, typ, &z, y);
NewOp__39(op, typ, &z, y);
}
} else if (f != 0) {
OPB_err(94);
@ -1486,7 +1434,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
}
if (do_) {
NewOp__41(op, typ, &z, y);
NewOp__39(op, typ, &z, y);
}
break;
case 7:
@ -1495,7 +1443,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__41(op, typ, &z, y);
NewOp__39(op, typ, &z, y);
}
break;
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 {
NewOp__41(op, typ, &z, y);
NewOp__39(op, typ, &z, y);
}
} else if (f != 0) {
OPB_err(95);
@ -1514,16 +1462,16 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
}
break;
case 9: case 10:
if (__IN(f, 0x6bff) || strings__43(&z, &y)) {
if (__IN(f, 0x6bff) || strings__41(&z, &y)) {
typ = OPT_booltyp;
} else {
OPB_err(107);
typ = OPT_undftyp;
}
NewOp__41(op, typ, &z, y);
NewOp__39(op, typ, &z, y);
break;
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;
} else {
OPM_LogWLn();
@ -1532,7 +1480,7 @@ void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y)
OPB_err(108);
typ = OPT_undftyp;
}
NewOp__41(op, typ, &z, y);
NewOp__39(op, typ, &z, y);
break;
default:
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;
Op__40_s = _s.lnk;
Op__38_s = _s.lnk;
}
void OPB_SetRange (OPT_Node *x, OPT_Node y)
@ -1894,8 +1842,13 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 10:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if ((__IN(f, 0x70) && x->typ->size > (int)OPM_SIntSize)) {
OPB_Convert(&x, OPB_IntType(OPB_ShorterSize(x->typ->size)));
} else if (__IN(f, 0x70)) {
typ = OPT_ShorterOrLongerType(x->typ, -1);
if (typ == NIL) {
OPB_err(111);
} else {
OPB_Convert(&x, typ);
}
} else if (f == 8) {
OPB_Convert(&x, OPT_realtyp);
} else {
@ -1905,8 +1858,13 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
case 11:
if (x->class == 8 || x->class == 9) {
OPB_err(126);
} else if ((__IN(f, 0x70) && x->typ->size < (int)OPM_LIntSize)) {
OPB_Convert(&x, OPB_IntType(OPB_LongerSize(x->typ->size)));
} else if (__IN(f, 0x70)) {
typ = OPT_ShorterOrLongerType(x->typ, 1);
if (typ == NIL) {
OPB_err(111);
} else {
OPB_Convert(&x, typ);
}
} else if (f == 7) {
OPB_Convert(&x, OPT_lrltyp);
} else if (f == 3) {
@ -2043,13 +2001,13 @@ void OPB_StPar0 (OPT_Node *par0, INTEGER fctno)
*par0 = x;
}
static struct StPar1__56 {
struct StPar1__56 *lnk;
} *StPar1__56_s;
static struct StPar1__52 {
struct StPar1__52 *lnk;
} *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 node = NIL;
@ -2066,9 +2024,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__56 _s;
_s.lnk = StPar1__56_s;
StPar1__56_s = &_s;
struct StPar1__52 _s;
_s.lnk = StPar1__52_s;
StPar1__52_s = &_s;
p = *par0;
f = x->typ->form;
switch (fctno) {
@ -2084,7 +2042,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
OPB_err(111);
}
}
p = NewOp__57(19, fctno, p, x);
p = NewOp__53(19, fctno, p, x);
p->typ = OPT_notyp;
}
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))) {
OPB_err(202);
}
p = NewOp__57(19, fctno, p, x);
p = NewOp__53(19, fctno, p, x);
} else {
OPB_err(111);
}
@ -2120,7 +2078,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
p = p->left;
x->conval->intval += 1;
}
p = NewOp__57(12, 19, p, x);
p = NewOp__53(12, 19, p, x);
p->typ = OPT_linttyp;
} else {
p = x;
@ -2142,7 +2100,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
t = x;
x = p;
p = t;
p = NewOp__57(19, 18, p, x);
p = NewOp__53(19, 18, p, x);
} else {
OPB_err(111);
}
@ -2168,7 +2126,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
}
p->obj = NIL;
} else {
p = NewOp__57(12, 17, p, x);
p = NewOp__53(12, 17, p, x);
p->typ = OPT_linttyp;
}
} else {
@ -2199,9 +2157,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
OPB_err(111);
} else {
if (fctno == 22) {
p = NewOp__57(12, 27, p, x);
p = NewOp__53(12, 27, p, x);
} else {
p = NewOp__57(12, 28, p, x);
p = NewOp__53(12, 28, p, x);
}
p->typ = p->left->typ;
}
@ -2218,7 +2176,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
x = p;
p = t;
}
p = NewOp__57(19, fctno, p, x);
p = NewOp__53(19, fctno, p, x);
} else {
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) {
OPB_err(126);
} else if (__IN(f, 0x70)) {
p = NewOp__57(12, 26, p, x);
p = NewOp__53(12, 26, p, x);
} else {
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) {
OPB_err(126);
} else if (__IN(f, 0x70)) {
p = NewOp__57(19, 30, p, x);
p = NewOp__53(19, 30, p, x);
} else {
OPB_err(111);
}
@ -2298,7 +2256,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno)
break;
}
*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)

2
bootstrap/unix-48/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 */
#ifndef OPB__h
#define OPB__h

2
bootstrap/unix-48/OPC.c
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 "Configuration.h"
#include "OPM.h"

2
bootstrap/unix-48/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 */
#ifndef OPC__h
#define OPC__h

2
bootstrap/unix-48/OPM.c
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 "Configuration.h"
#include "Console.h"

2
bootstrap/unix-48/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 OPM__h
#define OPM__h

14
bootstrap/unix-48/OPP.c
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 "OPB.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_ArrayType (OPT_Struct *typ, OPT_Struct *banned);
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_CheckSym (INTEGER s);
static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_);
@ -1163,7 +1163,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
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;
INTEGER i, f;
@ -1180,10 +1180,10 @@ static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP
xval = 1;
}
if (__IN(f, 0x70)) {
if (LabelForm < f) {
if (!__IN(LabelTyp->form, 0x70) || LabelTyp->size < x->typ->size) {
OPP_err(60);
}
} else if (LabelForm != f) {
} else if ((int)LabelTyp->form != f) {
OPP_err(60);
}
if (OPP_sym == 21) {
@ -1262,7 +1262,7 @@ static void CasePart__31 (OPT_Node *x)
n = 0;
for (;;) {
if (OPP_sym < 40) {
OPP_CaseLabelList(&lab, (*x)->typ->form, &n, tab);
OPP_CaseLabelList(&lab, (*x)->typ, &n, tab);
OPP_CheckSym(20);
OPP_StatSeq(&y);
OPB_Construct(17, &lab, y);
@ -1471,7 +1471,7 @@ static void OPP_StatSeq (OPT_Node *stat)
SetPos__35(z);
OPB_Link(&*stat, &last, z);
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);
}
OPB_Link(&*stat, &last, x);

2
bootstrap/unix-48/OPP.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 OPP__h
#define OPP__h

2
bootstrap/unix-48/OPS.c
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 "OPM.h"

2
bootstrap/unix-48/OPS.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
#define OPS__h

144
bootstrap/unix-48/OPT.c
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 "OPM.h"
#include "OPS.h"
@ -84,11 +84,11 @@ typedef
export void (*OPT_typSize)(OPT_Struct);
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;
static OPT_Object OPT_LIntObj;
export SHORTINT OPT_nofGmod;
export OPT_Object OPT_GlbMod[64];
export OPS_Name OPT_SelfName;
export BOOLEAN OPT_SYSimported;
static OPT_Struct OPT_IntTypes[20];
static OPT_Object OPT_universe, OPT_syslink;
static OPT_ImpCtxt OPT_impCtxt;
static OPT_ExpCtxt OPT_expCtxt;
@ -106,7 +106,6 @@ export void OPT_Close (void);
export void OPT_CloseScope (void);
static void OPT_DebugStruct (OPT_Struct btyp);
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_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct *res);
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_InStruct (OPT_Struct *typ);
static OPT_Object OPT_InTProc (SHORTINT mno);
static OPT_Struct OPT_InTyp (LONGINT tag);
export void OPT_Init (OPS_Name name, SET opt);
static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form);
export void OPT_Insert (OPS_Name name, OPT_Object *obj);
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_ConstExt OPT_NewExt (void);
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_OutStr (OPT_Struct typ);
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);
@ -155,6 +157,34 @@ static void OPT_err (INTEGER 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 _o_result;
@ -467,21 +497,21 @@ void OPT_IdFPrint (OPT_Struct typ)
}
}
static struct FPrintStr__13 {
static struct FPrintStr__12 {
LONGINT *pbfp, *pvfp;
struct FPrintStr__13 *lnk;
} *FPrintStr__13_s;
struct FPrintStr__12 *lnk;
} *FPrintStr__12_s;
static void FPrintFlds__14 (OPT_Object fld, LONGINT adr, BOOLEAN visible);
static void FPrintHdFld__16 (OPT_Struct typ, OPT_Object fld, LONGINT adr);
static void FPrintTProcs__18 (OPT_Object obj);
static void FPrintFlds__13 (OPT_Object fld, LONGINT adr, BOOLEAN visible);
static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr);
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;
OPT_Struct btyp = NIL;
if (typ->comp == 4) {
FPrintFlds__14(typ->link, adr, 0);
FPrintFlds__13(typ->link, adr, 0);
} else if (typ->comp == 2) {
btyp = typ->BaseTyp;
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) {
j = OPT_nofhdfld;
FPrintHdFld__16(btyp, fld, adr);
FPrintHdFld__15(btyp, fld, adr);
if (j != OPT_nofhdfld) {
i = 1;
while ((i < n && OPT_nofhdfld <= 2048)) {
adr += btyp->size;
FPrintHdFld__16(btyp, fld, adr);
FPrintHdFld__15(btyp, fld, adr);
i += 1;
}
}
}
} else if (typ->form == 13 || __STRCMP(fld->name, "@ptr") == 0) {
OPM_FPrint(&*FPrintStr__13_s->pvfp, ((LONGINT)(13)));
OPM_FPrint(&*FPrintStr__13_s->pvfp, adr);
OPM_FPrint(&*FPrintStr__12_s->pvfp, ((LONGINT)(13)));
OPM_FPrint(&*FPrintStr__12_s->pvfp, adr);
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)) {
if ((fld->vis != 0 && visible)) {
OPM_FPrint(&*FPrintStr__13_s->pbfp, fld->vis);
OPT_FPrintName(&*FPrintStr__13_s->pbfp, (void*)fld->name, ((LONGINT)(256)));
OPM_FPrint(&*FPrintStr__13_s->pbfp, fld->adr);
OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->vis);
OPT_FPrintName(&*FPrintStr__12_s->pbfp, (void*)fld->name, ((LONGINT)(256)));
OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->adr);
OPT_FPrintStr(fld->typ);
OPM_FPrint(&*FPrintStr__13_s->pbfp, fld->typ->pbfp);
OPM_FPrint(&*FPrintStr__13_s->pvfp, fld->typ->pvfp);
OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->typ->pbfp);
OPM_FPrint(&*FPrintStr__12_s->pvfp, fld->typ->pvfp);
} else {
FPrintHdFld__16(fld->typ, fld, fld->adr + adr);
FPrintHdFld__15(fld->typ, fld, fld->adr + adr);
}
fld = fld->link;
}
}
static void FPrintTProcs__18 (OPT_Object obj)
static void FPrintTProcs__17 (OPT_Object obj)
{
if (obj != NIL) {
FPrintTProcs__18(obj->left);
FPrintTProcs__17(obj->left);
if (obj->mode == 13) {
if (obj->vis != 0) {
OPM_FPrint(&*FPrintStr__13_s->pbfp, ((LONGINT)(13)));
OPM_FPrint(&*FPrintStr__13_s->pbfp, __ASHR(obj->adr, 16));
OPT_FPrintSign(&*FPrintStr__13_s->pbfp, obj->typ, obj->link);
OPT_FPrintName(&*FPrintStr__13_s->pbfp, (void*)obj->name, ((LONGINT)(256)));
OPM_FPrint(&*FPrintStr__12_s->pbfp, ((LONGINT)(13)));
OPM_FPrint(&*FPrintStr__12_s->pbfp, __ASHR(obj->adr, 16));
OPT_FPrintSign(&*FPrintStr__12_s->pbfp, obj->typ, obj->link);
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_Object strobj = NIL, bstrobj = NIL;
LONGINT pbfp, pvfp;
struct FPrintStr__13 _s;
struct FPrintStr__12 _s;
_s.pbfp = &pbfp;
_s.pvfp = &pvfp;
_s.lnk = FPrintStr__13_s;
FPrintStr__13_s = &_s;
_s.lnk = FPrintStr__12_s;
FPrintStr__12_s = &_s;
if (!typ->fpdone) {
OPT_IdFPrint(typ);
pbfp = typ->idfp;
@ -588,11 +618,11 @@ void OPT_FPrintStr (OPT_Struct typ)
OPM_FPrint(&pvfp, typ->align);
OPM_FPrint(&pvfp, typ->n);
OPT_nofhdfld = 0;
FPrintFlds__14(typ->link, ((LONGINT)(0)), 1);
FPrintFlds__13(typ->link, ((LONGINT)(0)), 1);
if (OPT_nofhdfld > 2048) {
OPM_Mark(225, typ->txtpos);
}
FPrintTProcs__18(typ->link);
FPrintTProcs__17(typ->link);
OPM_FPrint(&pvfp, pbfp);
strobj = typ->strobj;
if (strobj == NIL || strobj->name[0] == 0x00) {
@ -602,7 +632,7 @@ void OPT_FPrintStr (OPT_Struct typ)
typ->pbfp = pbfp;
typ->pvfp = pvfp;
}
FPrintStr__13_s = _s.lnk;
FPrintStr__12_s = _s.lnk;
}
void OPT_FPrintObj (OPT_Object obj)
@ -946,6 +976,19 @@ static OPT_Object OPT_InTProc (SHORTINT mno)
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)
{
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;
tag = OPM_SymRInt();
if (tag != 34) {
*typ = OPT_impCtxt.ref[__X(-tag, ((LONGINT)(255)))];
*typ = OPT_InTyp(-tag);
} else {
ref = OPT_impCtxt.nofr;
OPT_impCtxt.nofr += 1;
@ -1081,7 +1124,7 @@ static void OPT_InStruct (OPT_Struct *typ)
}
if (ref == OPT_impCtxt.minr) {
while (ref < OPT_impCtxt.nofr) {
t = OPT_impCtxt.ref[__X(ref, ((LONGINT)(255)))];
t = OPT_InTyp(ref);
OPT_FPrintStr(t);
obj = t->strobj;
if (obj->name[0] != 0x00) {
@ -1150,9 +1193,9 @@ static OPT_Object OPT_InObj (SHORTINT mno)
obj->vis = 1;
if (tag <= 13) {
obj->mode = 3;
obj->typ = OPT_impCtxt.ref[__X(tag, ((LONGINT)(255)))];
obj->conval = OPT_NewConst();
OPT_InConstant(tag, obj->conval);
obj->typ = OPT_InTyp(tag);
} else if (tag >= 31) {
obj->conval = OPT_NewConst();
obj->conval->intval = -1;
@ -1396,6 +1439,9 @@ static void OPT_OutStr (OPT_Struct typ)
OPT_Object strobj = NIL;
if (typ->ref < OPT_expCtxt.ref) {
OPM_SymWInt(-typ->ref);
if (__IN(typ->ref, 0x70)) {
OPM_SymWInt(typ->size);
}
} else {
OPM_SymWInt(((LONGINT)(34)));
typ->ref = OPT_expCtxt.ref;
@ -1493,6 +1539,7 @@ static void OPT_OutConstant (OPT_Object obj)
break;
case 4: case 5: case 6:
OPM_SymWInt(obj->conval->intval);
OPM_SymWInt(obj->typ->size);
break;
case 9:
OPM_SymWSet(obj->conval->setval);
@ -1699,15 +1746,6 @@ static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct
*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)
{
OPT_Object obj = NIL;
@ -1741,8 +1779,8 @@ static void EnumPtrs(void (*P)(void*))
P(OPT_niltyp);
P(OPT_notyp);
P(OPT_sysptrtyp);
P(OPT_LIntObj);
__ENUMP(OPT_GlbMod, 64, P);
__ENUMP(OPT_IntTypes, 20, P);
P(OPT_universe);
P(OPT_syslink);
__ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 3140, 1, P);
@ -1811,7 +1849,7 @@ export void *OPT__init(void)
OPT_InitStruct(&OPT_niltyp, 11);
OPT_EnterTyp((CHAR*)"BYTE", 1, OPM_ByteSize, &OPT_bytetyp);
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*)"INT16", 5, 2, &OPT_int16typ);
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*)"LONGREAL", 8, OPM_LRealSize, &OPT_lrltyp);
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*)"TRUE", ((LONGINT)(1)));
OPT_EnterProc((CHAR*)"HALT", 0);
@ -1877,5 +1914,12 @@ export void *OPT__init(void)
OPT_impCtxt.ref[11] = OPT_niltyp;
OPT_impCtxt.ref[12] = OPT_notyp;
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;
}

4
bootstrap/unix-48/OPT.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 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_Insert (OPS_Name name, OPT_Object *obj);
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_ConstExt OPT_NewExt (void);
import OPT_Node OPT_NewNode (SHORTINT class);
import OPT_Object OPT_NewObj (void);
import OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp);
import void OPT_OpenScope (SHORTINT level, OPT_Object owner);
import OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INTEGER dir);
import void *OPT__init(void);

2
bootstrap/unix-48/OPV.c
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 "OPC.h"
#include "OPM.h"

2
bootstrap/unix-48/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 */
#ifndef OPV__h
#define OPV__h

2
bootstrap/unix-48/Platform.c
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"
typedef

2
bootstrap/unix-48/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 Platform__h
#define Platform__h

2
bootstrap/unix-48/Reals.c
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"

2
bootstrap/unix-48/Reals.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
#define Reals__h

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

@ -60,12 +60,6 @@ typedef float REAL;
typedef double LONGREAL;
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:
#if (__SIZEOF_POINTER__ == 8) || defined(LARGE) || defined(_WIN64)
@ -80,9 +74,20 @@ typedef unsigned char U_SHORTINT;
typedef unsigned long U_LONGINT;
#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 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
@ -178,7 +183,7 @@ static int __str_cmp(CHAR *x, CHAR *y){
#define __ABSFD(x) SYSTEM_ABSD((double)(x))
#define __CAP(ch) ((CHAR)((ch)&0x5f))
#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 __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h)))
#define __MASK(x, m) ((x)&~(m))

2
bootstrap/unix-48/Strings.c
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"

2
bootstrap/unix-48/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 Strings__h
#define Strings__h

2
bootstrap/unix-48/Texts.c
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 "Files.h"
#include "Modules.h"

2
bootstrap/unix-48/Texts.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
#define Texts__h

2
bootstrap/unix-48/Vishap.c
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 "Configuration.h"
#include "Heap.h"

2
bootstrap/unix-48/errors.c
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"
typedef

2
bootstrap/unix-48/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 */
#ifndef errors__h
#define errors__h

2
bootstrap/unix-48/extTools.c
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 "Configuration.h"
#include "Console.h"

2
bootstrap/unix-48/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 */
#ifndef extTools__h
#define extTools__h

2
bootstrap/unix-48/vt100.c
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 "Console.h"
#include "Strings.h"

2
bootstrap/unix-48/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 */
#ifndef vt100__h
#define vt100__h