mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-05 23:22:25 +00:00
2261 lines
53 KiB
C
2261 lines
53 KiB
C
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
|
|
|
|
#define SHORTINT INT8
|
|
#define INTEGER INT16
|
|
#define LONGINT INT32
|
|
#define SET UINT32
|
|
|
|
#include "SYSTEM.h"
|
|
#include "OPM.h"
|
|
#include "OPS.h"
|
|
|
|
typedef
|
|
struct OPT_ConstDesc *OPT_Const;
|
|
|
|
typedef
|
|
OPS_String *OPT_ConstExt;
|
|
|
|
typedef
|
|
struct OPT_ConstDesc {
|
|
OPT_ConstExt ext;
|
|
INT64 intval;
|
|
INT32 intval2;
|
|
UINT64 setval;
|
|
LONGREAL realval;
|
|
} OPT_ConstDesc;
|
|
|
|
typedef
|
|
struct OPT_ExpCtxt {
|
|
INT32 reffp;
|
|
INT16 ref;
|
|
INT8 nofm;
|
|
INT8 locmno[64];
|
|
} OPT_ExpCtxt;
|
|
|
|
typedef
|
|
struct OPT_StrDesc *OPT_Struct;
|
|
|
|
typedef
|
|
struct OPT_ObjDesc *OPT_Object;
|
|
|
|
typedef
|
|
struct OPT_ImpCtxt {
|
|
INT32 nextTag, reffp;
|
|
INT16 nofr, minr, nofm;
|
|
BOOLEAN self;
|
|
OPT_Struct ref[255];
|
|
OPT_Object old[255];
|
|
INT32 pvfp[255];
|
|
INT8 glbmno[64];
|
|
} OPT_ImpCtxt;
|
|
|
|
typedef
|
|
struct OPT_LinkDesc *OPT_Link;
|
|
|
|
typedef
|
|
struct OPT_LinkDesc {
|
|
OPS_Name name;
|
|
OPT_Link next;
|
|
} OPT_LinkDesc;
|
|
|
|
typedef
|
|
struct OPT_NodeDesc *OPT_Node;
|
|
|
|
typedef
|
|
struct OPT_NodeDesc {
|
|
OPT_Node left, right, link;
|
|
INT8 class, subcl;
|
|
BOOLEAN readonly;
|
|
OPT_Struct typ;
|
|
OPT_Object obj;
|
|
OPT_Const conval;
|
|
} OPT_NodeDesc;
|
|
|
|
typedef
|
|
struct OPT_ObjDesc {
|
|
OPT_Object left, right, link, scope;
|
|
OPS_Name name;
|
|
BOOLEAN leaf;
|
|
INT8 mode, mnolev, vis, history;
|
|
BOOLEAN used, fpdone;
|
|
INT32 fprint;
|
|
OPT_Struct typ;
|
|
OPT_Const conval;
|
|
INT32 adr, linkadr;
|
|
INT16 x;
|
|
OPT_ConstExt comment;
|
|
} OPT_ObjDesc;
|
|
|
|
typedef
|
|
struct OPT_StrDesc {
|
|
INT8 form, comp, mno, extlev;
|
|
INT16 ref, sysflag;
|
|
INT32 n, size, align, txtpos;
|
|
BOOLEAN allocated, pbused, pvused, fpdone, idfpdone;
|
|
INT32 idfp, pbfp, pvfp;
|
|
OPT_Struct BaseTyp;
|
|
OPT_Object link, strobj;
|
|
} OPT_StrDesc;
|
|
|
|
|
|
export OPT_Object OPT_topScope;
|
|
export OPT_Struct OPT_undftyp, OPT_niltyp, OPT_notyp, OPT_bytetyp, OPT_cpbytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_hinttyp, OPT_int8typ, OPT_int16typ, OPT_int32typ, OPT_int64typ, OPT_settyp, OPT_set32typ, OPT_set64typ, OPT_realtyp, OPT_lrltyp, OPT_stringtyp, OPT_adrtyp, OPT_sysptrtyp;
|
|
export OPT_Object OPT_sintobj, OPT_intobj, OPT_lintobj, OPT_setobj;
|
|
export INT8 OPT_nofGmod;
|
|
export OPT_Object OPT_GlbMod[64];
|
|
export OPS_Name OPT_SelfName;
|
|
export BOOLEAN OPT_SYSimported;
|
|
static OPT_Object OPT_universe, OPT_syslink;
|
|
static OPT_ImpCtxt OPT_impCtxt;
|
|
static OPT_ExpCtxt OPT_expCtxt;
|
|
static INT32 OPT_nofhdfld;
|
|
static BOOLEAN OPT_newsf, OPT_findpc, OPT_extsf, OPT_sfpresent, OPT_symExtended, OPT_symNew;
|
|
static INT32 OPT_recno;
|
|
export OPT_Link OPT_Links;
|
|
|
|
export ADDRESS *OPT_ConstDesc__typ;
|
|
export ADDRESS *OPT_ObjDesc__typ;
|
|
export ADDRESS *OPT_StrDesc__typ;
|
|
export ADDRESS *OPT_NodeDesc__typ;
|
|
export ADDRESS *OPT_ImpCtxt__typ;
|
|
export ADDRESS *OPT_ExpCtxt__typ;
|
|
export ADDRESS *OPT_LinkDesc__typ;
|
|
|
|
export void OPT_Align (INT32 *adr, INT32 base);
|
|
export INT32 OPT_BaseAlignment (OPT_Struct typ);
|
|
export void OPT_Close (void);
|
|
export void OPT_CloseScope (void);
|
|
static void OPT_DebugStruct (OPT_Struct btyp);
|
|
static void OPT_EnterBoolConst (OPS_Name name, INT32 value);
|
|
static void OPT_EnterProc (OPS_Name name, INT16 num);
|
|
static void OPT_EnterTyp (OPS_Name name, INT8 form, INT16 size, OPT_Struct *res);
|
|
static void OPT_EnterTypeAlias (OPS_Name name, OPT_Object *res);
|
|
export void OPT_Export (BOOLEAN *ext, BOOLEAN *new);
|
|
export void OPT_FPrintErr (OPT_Object obj, INT16 errcode);
|
|
static void OPT_FPrintName (INT32 *fp, CHAR *name, ADDRESS name__len);
|
|
export void OPT_FPrintObj (OPT_Object obj);
|
|
static void OPT_FPrintSign (INT32 *fp, OPT_Struct result, OPT_Object par);
|
|
export void OPT_FPrintStr (OPT_Struct typ);
|
|
export void OPT_Find (OPT_Object *res);
|
|
export void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res);
|
|
export void OPT_FindImport (OPT_Object mod, OPT_Object *res);
|
|
export void OPT_IdFPrint (OPT_Struct typ);
|
|
export void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done);
|
|
static void OPT_InConstant (INT32 f, OPT_Const conval);
|
|
static OPT_Object OPT_InFld (void);
|
|
static void OPT_InLinks (void);
|
|
static void OPT_InMod (INT8 *mno);
|
|
static void OPT_InName (CHAR *name, ADDRESS name__len);
|
|
static OPT_Object OPT_InObj (INT8 mno);
|
|
static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par);
|
|
static void OPT_InStruct (OPT_Struct *typ);
|
|
static OPT_Object OPT_InTProc (INT8 mno);
|
|
static OPT_Struct OPT_InTyp (INT32 tag);
|
|
export void OPT_Init (OPS_Name name, UINT32 opt);
|
|
export void OPT_InitRecno (void);
|
|
static void OPT_InitStruct (OPT_Struct *typ, INT8 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 INT16 OPT_IntSize (INT64 n);
|
|
export OPT_Struct OPT_IntType (INT32 size);
|
|
export OPT_Const OPT_NewConst (void);
|
|
export OPT_ConstExt OPT_NewExt (void);
|
|
export OPT_Node OPT_NewNode (INT8 class);
|
|
export OPT_Object OPT_NewObj (void);
|
|
export OPT_Struct OPT_NewStr (INT8 form, INT8 comp);
|
|
export void OPT_OpenScope (INT8 level, OPT_Object owner);
|
|
static void OPT_OutConstant (OPT_Object obj);
|
|
static void OPT_OutFlds (OPT_Object fld, INT32 adr, BOOLEAN visible);
|
|
static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr);
|
|
static void OPT_OutLinks (void);
|
|
static void OPT_OutMod (INT16 mno);
|
|
static void OPT_OutName (CHAR *name, ADDRESS name__len);
|
|
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);
|
|
static void OPT_OutTruncatedName (CHAR *text, ADDRESS text__len);
|
|
export OPT_Struct OPT_SetType (INT32 size);
|
|
export OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir);
|
|
export INT32 OPT_SizeAlignment (INT32 size);
|
|
export void OPT_TypSize (OPT_Struct typ);
|
|
static void OPT_err (INT16 n);
|
|
|
|
|
|
void OPT_InitRecno (void)
|
|
{
|
|
OPT_recno = 0;
|
|
}
|
|
|
|
static void OPT_err (INT16 n)
|
|
{
|
|
OPM_err(n);
|
|
}
|
|
|
|
INT16 OPT_IntSize (INT64 n)
|
|
{
|
|
INT16 bytes;
|
|
if (n < 0) {
|
|
n = -(n + 1);
|
|
}
|
|
bytes = 1;
|
|
while ((bytes < 8 && __ASH(n, -(__ASHL(bytes, 3) - 1)) != 0)) {
|
|
bytes += 1;
|
|
}
|
|
return bytes;
|
|
}
|
|
|
|
OPT_Struct OPT_IntType (INT32 size)
|
|
{
|
|
if (size <= OPT_int8typ->size) {
|
|
return OPT_int8typ;
|
|
}
|
|
if (size <= OPT_int16typ->size) {
|
|
return OPT_int16typ;
|
|
}
|
|
if (size <= OPT_int32typ->size) {
|
|
return OPT_int32typ;
|
|
}
|
|
return OPT_int64typ;
|
|
}
|
|
|
|
OPT_Struct OPT_SetType (INT32 size)
|
|
{
|
|
if (size == OPT_set32typ->size) {
|
|
return OPT_set32typ;
|
|
}
|
|
return OPT_set64typ;
|
|
}
|
|
|
|
OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir)
|
|
{
|
|
INT16 i;
|
|
__ASSERT(x->form == 4, 0);
|
|
__ASSERT(x->BaseTyp == OPT_undftyp, 0);
|
|
__ASSERT(dir == 1 || dir == -1, 0);
|
|
if (dir > 0) {
|
|
if (x->size < OPT_sinttyp->size) {
|
|
return OPT_sinttyp;
|
|
}
|
|
if (x->size < OPT_inttyp->size) {
|
|
return OPT_inttyp;
|
|
}
|
|
if (x->size < OPT_linttyp->size) {
|
|
return OPT_linttyp;
|
|
}
|
|
return OPT_int64typ;
|
|
} else {
|
|
if (x->size > OPT_linttyp->size) {
|
|
return OPT_linttyp;
|
|
}
|
|
if (x->size > OPT_inttyp->size) {
|
|
return OPT_inttyp;
|
|
}
|
|
if (x->size > OPT_sinttyp->size) {
|
|
return OPT_sinttyp;
|
|
}
|
|
return OPT_int8typ;
|
|
}
|
|
__RETCHK;
|
|
}
|
|
|
|
void OPT_Align (INT32 *adr, INT32 base)
|
|
{
|
|
switch (base) {
|
|
case 2:
|
|
*adr += __MASK(*adr, -2);
|
|
break;
|
|
case 4:
|
|
*adr += __MASK(-*adr, -4);
|
|
break;
|
|
case 8:
|
|
*adr += __MASK(-*adr, -8);
|
|
break;
|
|
case 16:
|
|
*adr += __MASK(-*adr, -16);
|
|
break;
|
|
default:
|
|
break;
|
|
}
|
|
}
|
|
|
|
INT32 OPT_SizeAlignment (INT32 size)
|
|
{
|
|
INT32 alignment;
|
|
if (size < OPM_Alignment) {
|
|
alignment = 1;
|
|
while (alignment < size) {
|
|
alignment = __ASHL(alignment, 1);
|
|
}
|
|
} else {
|
|
alignment = OPM_Alignment;
|
|
}
|
|
return alignment;
|
|
}
|
|
|
|
INT32 OPT_BaseAlignment (OPT_Struct typ)
|
|
{
|
|
INT32 alignment;
|
|
if (typ->form == 13) {
|
|
if (typ->comp == 4) {
|
|
alignment = __MASK(typ->align, -65536);
|
|
} else {
|
|
alignment = OPT_BaseAlignment(typ->BaseTyp);
|
|
}
|
|
} else {
|
|
alignment = OPT_SizeAlignment(typ->size);
|
|
}
|
|
return alignment;
|
|
}
|
|
|
|
void OPT_TypSize (OPT_Struct typ)
|
|
{
|
|
INT16 f, c;
|
|
INT32 offset, size, base, fbase, off0;
|
|
OPT_Object fld = NIL;
|
|
OPT_Struct btyp = NIL;
|
|
if (typ == OPT_undftyp) {
|
|
OPM_err(58);
|
|
} else if (typ->size == -1) {
|
|
f = typ->form;
|
|
c = typ->comp;
|
|
if (c == 4) {
|
|
btyp = typ->BaseTyp;
|
|
if (btyp == NIL) {
|
|
offset = 0;
|
|
base = 1;
|
|
} else {
|
|
OPT_TypSize(btyp);
|
|
offset = btyp->size - __ASHR(btyp->sysflag, 8);
|
|
base = btyp->align;
|
|
}
|
|
fld = typ->link;
|
|
while ((fld != NIL && fld->mode == 4)) {
|
|
btyp = fld->typ;
|
|
OPT_TypSize(btyp);
|
|
size = btyp->size;
|
|
fbase = OPT_BaseAlignment(btyp);
|
|
OPT_Align(&offset, fbase);
|
|
fld->adr = offset;
|
|
offset += size;
|
|
if (fbase > base) {
|
|
base = fbase;
|
|
}
|
|
fld = fld->link;
|
|
}
|
|
off0 = offset;
|
|
if (offset == 0) {
|
|
offset = 1;
|
|
}
|
|
OPT_Align(&offset, base);
|
|
if ((typ->strobj == NIL && __MASK(typ->align, -65536) == 0)) {
|
|
OPT_recno += 1;
|
|
base += __ASHL(OPT_recno, 16);
|
|
}
|
|
typ->size = offset;
|
|
typ->align = base;
|
|
typ->sysflag = __MASK(typ->sysflag, -256) + __SHORT(__ASHL(offset - off0, 8), 32768);
|
|
} else if (c == 2) {
|
|
OPT_TypSize(typ->BaseTyp);
|
|
typ->size = typ->n * typ->BaseTyp->size;
|
|
} else if (f == 11) {
|
|
typ->size = OPM_AddressSize;
|
|
if (typ->BaseTyp == OPT_undftyp) {
|
|
OPM_Mark(128, typ->n);
|
|
} else {
|
|
OPT_TypSize(typ->BaseTyp);
|
|
}
|
|
} else if (f == 12) {
|
|
typ->size = OPM_AddressSize;
|
|
} else if (c == 3) {
|
|
btyp = typ->BaseTyp;
|
|
OPT_TypSize(btyp);
|
|
if (btyp->comp == 3) {
|
|
typ->size = btyp->size + 4;
|
|
} else {
|
|
typ->size = 8;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
OPT_Const OPT_NewConst (void)
|
|
{
|
|
OPT_Const const_ = NIL;
|
|
__NEW(const_, OPT_ConstDesc);
|
|
return const_;
|
|
}
|
|
|
|
OPT_Object OPT_NewObj (void)
|
|
{
|
|
OPT_Object obj = NIL;
|
|
__NEW(obj, OPT_ObjDesc);
|
|
obj->typ = NIL;
|
|
obj->conval = NIL;
|
|
obj->comment = NIL;
|
|
obj->name[0] = 0x00;
|
|
return obj;
|
|
}
|
|
|
|
OPT_Struct OPT_NewStr (INT8 form, INT8 comp)
|
|
{
|
|
OPT_Struct typ = NIL;
|
|
__NEW(typ, OPT_StrDesc);
|
|
typ->form = form;
|
|
typ->comp = comp;
|
|
typ->ref = 255;
|
|
if (form != 0) {
|
|
typ->txtpos = OPM_errpos;
|
|
}
|
|
typ->size = -1;
|
|
typ->BaseTyp = OPT_undftyp;
|
|
return typ;
|
|
}
|
|
|
|
OPT_Node OPT_NewNode (INT8 class)
|
|
{
|
|
OPT_Node node = NIL;
|
|
__NEW(node, OPT_NodeDesc);
|
|
node->class = class;
|
|
return node;
|
|
}
|
|
|
|
OPT_ConstExt OPT_NewExt (void)
|
|
{
|
|
OPT_ConstExt ext = NIL;
|
|
ext = __NEWARR(NIL, 1, 1, 1, 0, ((INT64)(256)));
|
|
return ext;
|
|
}
|
|
|
|
void OPT_OpenScope (INT8 level, OPT_Object owner)
|
|
{
|
|
OPT_Object head = NIL;
|
|
head = OPT_NewObj();
|
|
head->mode = 12;
|
|
head->mnolev = level;
|
|
head->link = owner;
|
|
if (owner != NIL) {
|
|
owner->scope = head;
|
|
}
|
|
head->left = OPT_topScope;
|
|
head->right = NIL;
|
|
head->scope = NIL;
|
|
OPT_topScope = head;
|
|
}
|
|
|
|
void OPT_CloseScope (void)
|
|
{
|
|
OPT_topScope = OPT_topScope->left;
|
|
}
|
|
|
|
void OPT_Init (OPS_Name name, UINT32 opt)
|
|
{
|
|
OPT_topScope = OPT_universe;
|
|
OPT_OpenScope(0, NIL);
|
|
OPT_SYSimported = 0;
|
|
__MOVE(name, OPT_SelfName, 256);
|
|
__MOVE(name, OPT_topScope->name, 256);
|
|
OPT_GlbMod[0] = OPT_topScope;
|
|
OPT_nofGmod = 1;
|
|
OPT_newsf = __IN(4, opt, 32);
|
|
OPT_findpc = __IN(8, opt, 32);
|
|
OPT_extsf = OPT_newsf || __IN(9, opt, 32);
|
|
OPT_sfpresent = 1;
|
|
__NEW(OPT_Links, OPT_LinkDesc);
|
|
__MOVE(name, OPT_Links->name, 256);
|
|
}
|
|
|
|
void OPT_Close (void)
|
|
{
|
|
INT16 i;
|
|
OPT_CloseScope();
|
|
i = 0;
|
|
while (i < 64) {
|
|
OPT_GlbMod[__X(i, 64)] = NIL;
|
|
i += 1;
|
|
}
|
|
i = 14;
|
|
while (i < 255) {
|
|
OPT_impCtxt.ref[__X(i, 255)] = NIL;
|
|
OPT_impCtxt.old[__X(i, 255)] = NIL;
|
|
i += 1;
|
|
}
|
|
}
|
|
|
|
void OPT_FindImport (OPT_Object mod, OPT_Object *res)
|
|
{
|
|
OPT_Object obj = NIL;
|
|
obj = mod->scope;
|
|
for (;;) {
|
|
if (obj == NIL) {
|
|
break;
|
|
}
|
|
if (__STRCMP(OPS_name, obj->name) < 0) {
|
|
obj = obj->left;
|
|
} else if (__STRCMP(OPS_name, obj->name) > 0) {
|
|
obj = obj->right;
|
|
} else {
|
|
if ((obj->mode == 5 && obj->vis == 0)) {
|
|
obj = NIL;
|
|
} else {
|
|
obj->used = 1;
|
|
}
|
|
break;
|
|
}
|
|
}
|
|
*res = obj;
|
|
}
|
|
|
|
void OPT_Find (OPT_Object *res)
|
|
{
|
|
OPT_Object obj = NIL, head = NIL;
|
|
head = OPT_topScope;
|
|
for (;;) {
|
|
obj = head->right;
|
|
for (;;) {
|
|
if (obj == NIL) {
|
|
break;
|
|
}
|
|
if (__STRCMP(OPS_name, obj->name) < 0) {
|
|
obj = obj->left;
|
|
} else if (__STRCMP(OPS_name, obj->name) > 0) {
|
|
obj = obj->right;
|
|
} else {
|
|
break;
|
|
}
|
|
}
|
|
if (obj != NIL) {
|
|
break;
|
|
}
|
|
head = head->left;
|
|
if (head == NIL) {
|
|
break;
|
|
}
|
|
}
|
|
*res = obj;
|
|
}
|
|
|
|
void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res)
|
|
{
|
|
OPT_Object obj = NIL;
|
|
while (typ != NIL) {
|
|
obj = typ->link;
|
|
while (obj != NIL) {
|
|
if (__STRCMP(name, obj->name) < 0) {
|
|
obj = obj->left;
|
|
} else if (__STRCMP(name, obj->name) > 0) {
|
|
obj = obj->right;
|
|
} else {
|
|
*res = obj;
|
|
return;
|
|
}
|
|
}
|
|
typ = typ->BaseTyp;
|
|
}
|
|
*res = NIL;
|
|
}
|
|
|
|
void OPT_Insert (OPS_Name name, OPT_Object *obj)
|
|
{
|
|
OPT_Object ob0 = NIL, ob1 = NIL;
|
|
BOOLEAN left;
|
|
INT8 mnolev;
|
|
CHAR commentText[256];
|
|
INT16 j;
|
|
ob0 = OPT_topScope;
|
|
ob1 = ob0->right;
|
|
left = 0;
|
|
for (;;) {
|
|
if (ob1 != NIL) {
|
|
if (__STRCMP(name, ob1->name) < 0) {
|
|
ob0 = ob1;
|
|
ob1 = ob0->left;
|
|
left = 1;
|
|
} else if (__STRCMP(name, ob1->name) > 0) {
|
|
ob0 = ob1;
|
|
ob1 = ob0->right;
|
|
left = 0;
|
|
} else {
|
|
OPT_err(1);
|
|
ob0 = ob1;
|
|
ob1 = ob0->right;
|
|
}
|
|
} else {
|
|
ob1 = OPT_NewObj();
|
|
ob1->leaf = 1;
|
|
if (left) {
|
|
ob0->left = ob1;
|
|
} else {
|
|
ob0->right = ob1;
|
|
}
|
|
ob1->left = NIL;
|
|
ob1->right = NIL;
|
|
__COPY(name, ob1->name, 256);
|
|
mnolev = OPT_topScope->mnolev;
|
|
ob1->mnolev = mnolev;
|
|
OPM_GetComment((void*)commentText, 256);
|
|
if (commentText[0] != 0x00) {
|
|
ob1->comment = __NEWARR(NIL, 1, 1, 1, 0, ((INT64)(256)));
|
|
j = 0;
|
|
while ((j < 255 && commentText[__X(j, 256)] != 0x00)) {
|
|
(*ob1->comment)[__X(j, 256)] = commentText[__X(j, 256)];
|
|
j += 1;
|
|
}
|
|
(*ob1->comment)[__X(j, 256)] = 0x00;
|
|
}
|
|
break;
|
|
}
|
|
}
|
|
*obj = ob1;
|
|
}
|
|
|
|
static void OPT_FPrintName (INT32 *fp, CHAR *name, ADDRESS name__len)
|
|
{
|
|
INT16 i;
|
|
CHAR ch;
|
|
i = 0;
|
|
do {
|
|
ch = name[__X(i, name__len)];
|
|
OPM_FPrint(&*fp, (INT16)ch);
|
|
i += 1;
|
|
} while (!(ch == 0x00));
|
|
}
|
|
|
|
static void OPT_DebugStruct (OPT_Struct btyp)
|
|
{
|
|
OPM_LogWLn();
|
|
if (btyp == NIL) {
|
|
OPM_LogWStr((CHAR*)"btyp is nil", 12);
|
|
OPM_LogWLn();
|
|
}
|
|
OPM_LogWStr((CHAR*)"btyp^.strobji^.name = ", 23);
|
|
OPM_LogWStr(btyp->strobj->name, 256);
|
|
OPM_LogWLn();
|
|
OPM_LogWStr((CHAR*)"btyp^.form = ", 14);
|
|
OPM_LogWNum(btyp->form, 0);
|
|
OPM_LogWLn();
|
|
OPM_LogWStr((CHAR*)"btyp^.comp = ", 14);
|
|
OPM_LogWNum(btyp->comp, 0);
|
|
OPM_LogWLn();
|
|
OPM_LogWStr((CHAR*)"btyp^.mno = ", 13);
|
|
OPM_LogWNum(btyp->mno, 0);
|
|
OPM_LogWLn();
|
|
OPM_LogWStr((CHAR*)"btyp^.extlev = ", 16);
|
|
OPM_LogWNum(btyp->extlev, 0);
|
|
OPM_LogWLn();
|
|
OPM_LogWStr((CHAR*)"btyp^.size = ", 14);
|
|
OPM_LogWNum(btyp->size, 0);
|
|
OPM_LogWLn();
|
|
OPM_LogWStr((CHAR*)"btyp^.align = ", 15);
|
|
OPM_LogWNum(btyp->align, 0);
|
|
OPM_LogWLn();
|
|
OPM_LogWStr((CHAR*)"btyp^.txtpos = ", 16);
|
|
OPM_LogWNum(btyp->txtpos, 0);
|
|
OPM_LogWLn();
|
|
}
|
|
|
|
static void OPT_FPrintSign (INT32 *fp, OPT_Struct result, OPT_Object par)
|
|
{
|
|
OPT_IdFPrint(result);
|
|
OPM_FPrint(&*fp, result->idfp);
|
|
while (par != NIL) {
|
|
OPM_FPrint(&*fp, par->mode);
|
|
OPT_IdFPrint(par->typ);
|
|
OPM_FPrint(&*fp, par->typ->idfp);
|
|
par = par->link;
|
|
}
|
|
}
|
|
|
|
void OPT_IdFPrint (OPT_Struct typ)
|
|
{
|
|
OPT_Struct btyp = NIL;
|
|
OPT_Object strobj = NIL;
|
|
INT32 idfp;
|
|
INT16 f, c;
|
|
if (!typ->idfpdone) {
|
|
typ->idfpdone = 1;
|
|
idfp = 0;
|
|
f = typ->form;
|
|
OPM_FPrint(&idfp, f);
|
|
if (__IN(f, 0x90, 32)) {
|
|
OPM_FPrint(&idfp, typ->size);
|
|
}
|
|
c = typ->comp;
|
|
OPM_FPrint(&idfp, c);
|
|
btyp = typ->BaseTyp;
|
|
strobj = typ->strobj;
|
|
if ((strobj != NIL && strobj->name[0] != 0x00)) {
|
|
OPT_FPrintName(&idfp, (void*)OPT_GlbMod[__X(typ->mno, 64)]->name, 256);
|
|
OPT_FPrintName(&idfp, (void*)strobj->name, 256);
|
|
}
|
|
if ((f == 11 || (c == 4 && btyp != NIL)) || c == 3) {
|
|
OPT_IdFPrint(btyp);
|
|
OPM_FPrint(&idfp, btyp->idfp);
|
|
} else if (c == 2) {
|
|
OPT_IdFPrint(btyp);
|
|
OPM_FPrint(&idfp, btyp->idfp);
|
|
OPM_FPrint(&idfp, typ->n);
|
|
} else if (f == 12) {
|
|
OPT_FPrintSign(&idfp, btyp, typ->link);
|
|
}
|
|
typ->idfp = idfp;
|
|
}
|
|
}
|
|
|
|
static struct FPrintStr__15 {
|
|
INT32 *pbfp, *pvfp;
|
|
struct FPrintStr__15 *lnk;
|
|
} *FPrintStr__15_s;
|
|
|
|
static void FPrintFlds__16 (OPT_Object fld, INT32 adr, BOOLEAN visible);
|
|
static void FPrintHdFld__18 (OPT_Struct typ, OPT_Object fld, INT32 adr);
|
|
static void FPrintTProcs__20 (OPT_Object obj);
|
|
|
|
static void FPrintHdFld__18 (OPT_Struct typ, OPT_Object fld, INT32 adr)
|
|
{
|
|
INT32 i, j, n;
|
|
OPT_Struct btyp = NIL;
|
|
if (typ->comp == 4) {
|
|
FPrintFlds__16(typ->link, adr, 0);
|
|
} else if (typ->comp == 2) {
|
|
btyp = typ->BaseTyp;
|
|
n = typ->n;
|
|
while (btyp->comp == 2) {
|
|
n = btyp->n * n;
|
|
btyp = btyp->BaseTyp;
|
|
}
|
|
if (btyp->form == 11 || btyp->comp == 4) {
|
|
j = OPT_nofhdfld;
|
|
FPrintHdFld__18(btyp, fld, adr);
|
|
if (j != OPT_nofhdfld) {
|
|
i = 1;
|
|
while ((i < n && OPT_nofhdfld <= 2048)) {
|
|
adr += btyp->size;
|
|
FPrintHdFld__18(btyp, fld, adr);
|
|
i += 1;
|
|
}
|
|
}
|
|
}
|
|
} else if (typ->form == 11 || __STRCMP(fld->name, "@ptr") == 0) {
|
|
OPM_FPrint(&*FPrintStr__15_s->pvfp, 11);
|
|
OPM_FPrint(&*FPrintStr__15_s->pvfp, adr);
|
|
OPT_nofhdfld += 1;
|
|
}
|
|
}
|
|
|
|
static void FPrintFlds__16 (OPT_Object fld, INT32 adr, BOOLEAN visible)
|
|
{
|
|
while ((fld != NIL && fld->mode == 4)) {
|
|
if ((fld->vis != 0 && visible)) {
|
|
OPM_FPrint(&*FPrintStr__15_s->pbfp, fld->vis);
|
|
OPT_FPrintName(&*FPrintStr__15_s->pbfp, (void*)fld->name, 256);
|
|
OPM_FPrint(&*FPrintStr__15_s->pbfp, fld->adr);
|
|
OPT_FPrintStr(fld->typ);
|
|
OPM_FPrint(&*FPrintStr__15_s->pbfp, fld->typ->pbfp);
|
|
OPM_FPrint(&*FPrintStr__15_s->pvfp, fld->typ->pvfp);
|
|
} else {
|
|
FPrintHdFld__18(fld->typ, fld, fld->adr + adr);
|
|
}
|
|
fld = fld->link;
|
|
}
|
|
}
|
|
|
|
static void FPrintTProcs__20 (OPT_Object obj)
|
|
{
|
|
if (obj != NIL) {
|
|
FPrintTProcs__20(obj->left);
|
|
if (obj->mode == 13) {
|
|
if (obj->vis != 0) {
|
|
OPM_FPrint(&*FPrintStr__15_s->pbfp, 13);
|
|
OPM_FPrint(&*FPrintStr__15_s->pbfp, __ASHR(obj->adr, 16));
|
|
OPT_FPrintSign(&*FPrintStr__15_s->pbfp, obj->typ, obj->link);
|
|
OPT_FPrintName(&*FPrintStr__15_s->pbfp, (void*)obj->name, 256);
|
|
}
|
|
}
|
|
FPrintTProcs__20(obj->right);
|
|
}
|
|
}
|
|
|
|
void OPT_FPrintStr (OPT_Struct typ)
|
|
{
|
|
INT16 f, c;
|
|
OPT_Struct btyp = NIL;
|
|
OPT_Object strobj = NIL, bstrobj = NIL;
|
|
INT32 pbfp, pvfp;
|
|
struct FPrintStr__15 _s;
|
|
_s.pbfp = &pbfp;
|
|
_s.pvfp = &pvfp;
|
|
_s.lnk = FPrintStr__15_s;
|
|
FPrintStr__15_s = &_s;
|
|
if (!typ->fpdone) {
|
|
OPT_IdFPrint(typ);
|
|
pbfp = typ->idfp;
|
|
if (typ->sysflag != 0) {
|
|
OPM_FPrint(&pbfp, typ->sysflag);
|
|
}
|
|
pvfp = pbfp;
|
|
typ->pbfp = pbfp;
|
|
typ->pvfp = pvfp;
|
|
typ->fpdone = 1;
|
|
f = typ->form;
|
|
c = typ->comp;
|
|
btyp = typ->BaseTyp;
|
|
if (f == 11) {
|
|
strobj = typ->strobj;
|
|
bstrobj = btyp->strobj;
|
|
if (((strobj == NIL || strobj->name[0] == 0x00) || bstrobj == NIL) || bstrobj->name[0] == 0x00) {
|
|
OPT_FPrintStr(btyp);
|
|
OPM_FPrint(&pbfp, btyp->pbfp);
|
|
pvfp = pbfp;
|
|
}
|
|
} else if (f == 12) {
|
|
} else if (__IN(c, 0x0c, 32)) {
|
|
OPT_FPrintStr(btyp);
|
|
OPM_FPrint(&pbfp, btyp->pvfp);
|
|
pvfp = pbfp;
|
|
} else {
|
|
if (btyp != NIL) {
|
|
OPT_FPrintStr(btyp);
|
|
OPM_FPrint(&pbfp, btyp->pbfp);
|
|
OPM_FPrint(&pvfp, btyp->pvfp);
|
|
}
|
|
OPM_FPrint(&pvfp, typ->size);
|
|
OPM_FPrint(&pvfp, typ->align);
|
|
OPM_FPrint(&pvfp, typ->n);
|
|
OPT_nofhdfld = 0;
|
|
FPrintFlds__16(typ->link, 0, 1);
|
|
if (OPT_nofhdfld > 2048) {
|
|
OPM_Mark(225, typ->txtpos);
|
|
}
|
|
FPrintTProcs__20(typ->link);
|
|
OPM_FPrint(&pvfp, pbfp);
|
|
strobj = typ->strobj;
|
|
if (strobj == NIL || strobj->name[0] == 0x00) {
|
|
pbfp = pvfp;
|
|
}
|
|
}
|
|
typ->pbfp = pbfp;
|
|
typ->pvfp = pvfp;
|
|
}
|
|
FPrintStr__15_s = _s.lnk;
|
|
}
|
|
|
|
void OPT_FPrintObj (OPT_Object obj)
|
|
{
|
|
INT32 fprint;
|
|
INT16 f, m;
|
|
REAL rval;
|
|
OPT_ConstExt ext = NIL;
|
|
if (!obj->fpdone) {
|
|
fprint = 0;
|
|
obj->fpdone = 1;
|
|
OPM_FPrint(&fprint, obj->mode);
|
|
if (obj->mode == 3) {
|
|
f = obj->typ->form;
|
|
OPM_FPrint(&fprint, f);
|
|
switch (f) {
|
|
case 2: case 3: case 4:
|
|
OPM_FPrint(&fprint, obj->conval->intval);
|
|
break;
|
|
case 7:
|
|
OPM_FPrintSet(&fprint, obj->conval->setval);
|
|
break;
|
|
case 5:
|
|
rval = obj->conval->realval;
|
|
OPM_FPrintReal(&fprint, rval);
|
|
break;
|
|
case 6:
|
|
OPM_FPrintLReal(&fprint, obj->conval->realval);
|
|
break;
|
|
case 8:
|
|
OPT_FPrintName(&fprint, (void*)*obj->conval->ext, 256);
|
|
break;
|
|
case 9:
|
|
break;
|
|
default:
|
|
OPT_err(127);
|
|
break;
|
|
}
|
|
} else if (obj->mode == 1) {
|
|
OPM_FPrint(&fprint, obj->vis);
|
|
OPT_FPrintStr(obj->typ);
|
|
OPM_FPrint(&fprint, obj->typ->pbfp);
|
|
} else if (__IN(obj->mode, 0x0480, 32)) {
|
|
OPT_FPrintSign(&fprint, obj->typ, obj->link);
|
|
} else if (obj->mode == 9) {
|
|
OPT_FPrintSign(&fprint, obj->typ, obj->link);
|
|
ext = obj->conval->ext;
|
|
m = (INT16)(*ext)[0];
|
|
f = 1;
|
|
OPM_FPrint(&fprint, m);
|
|
while (f <= m) {
|
|
OPM_FPrint(&fprint, (INT16)(*ext)[__X(f, 256)]);
|
|
f += 1;
|
|
}
|
|
} else if (obj->mode == 5) {
|
|
OPT_FPrintStr(obj->typ);
|
|
OPM_FPrint(&fprint, obj->typ->pbfp);
|
|
}
|
|
obj->fprint = fprint;
|
|
}
|
|
}
|
|
|
|
void OPT_FPrintErr (OPT_Object obj, INT16 errcode)
|
|
{
|
|
INT16 i, j;
|
|
CHAR ch;
|
|
if (obj->mnolev != 0) {
|
|
__COPY(OPT_GlbMod[__X(-obj->mnolev, 64)]->name, OPM_objname, 64);
|
|
i = 0;
|
|
while (OPM_objname[__X(i, 64)] != 0x00) {
|
|
i += 1;
|
|
}
|
|
OPM_objname[__X(i, 64)] = '.';
|
|
j = 0;
|
|
i += 1;
|
|
do {
|
|
ch = obj->name[__X(j, 256)];
|
|
OPM_objname[__X(i, 64)] = ch;
|
|
j += 1;
|
|
i += 1;
|
|
} while (!(ch == 0x00));
|
|
} else {
|
|
__COPY(obj->name, OPM_objname, 64);
|
|
}
|
|
if (errcode == 249) {
|
|
if (OPM_noerr) {
|
|
OPT_err(errcode);
|
|
}
|
|
} else if (errcode == 253) {
|
|
if ((((!OPT_symNew && !OPT_symExtended)) && !OPT_extsf)) {
|
|
OPT_err(errcode);
|
|
}
|
|
OPT_symExtended = 1;
|
|
} else {
|
|
if ((!OPT_symNew && !OPT_newsf)) {
|
|
OPT_err(errcode);
|
|
}
|
|
OPT_symNew = 1;
|
|
}
|
|
}
|
|
|
|
void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old)
|
|
{
|
|
OPT_Object ob0 = NIL, ob1 = NIL;
|
|
BOOLEAN left;
|
|
if (*root == NIL) {
|
|
*root = obj;
|
|
*old = NIL;
|
|
} else {
|
|
ob0 = *root;
|
|
ob1 = ob0->right;
|
|
left = 0;
|
|
if (__STRCMP(obj->name, ob0->name) < 0) {
|
|
ob1 = ob0->left;
|
|
left = 1;
|
|
} else if (__STRCMP(obj->name, ob0->name) > 0) {
|
|
ob1 = ob0->right;
|
|
left = 0;
|
|
} else {
|
|
*old = ob0;
|
|
return;
|
|
}
|
|
for (;;) {
|
|
if (ob1 != NIL) {
|
|
if (__STRCMP(obj->name, ob1->name) < 0) {
|
|
ob0 = ob1;
|
|
ob1 = ob1->left;
|
|
left = 1;
|
|
} else if (__STRCMP(obj->name, ob1->name) > 0) {
|
|
ob0 = ob1;
|
|
ob1 = ob1->right;
|
|
left = 0;
|
|
} else {
|
|
*old = ob1;
|
|
break;
|
|
}
|
|
} else {
|
|
ob1 = obj;
|
|
if (left) {
|
|
ob0->left = ob1;
|
|
} else {
|
|
ob0->right = ob1;
|
|
}
|
|
ob1->left = NIL;
|
|
ob1->right = NIL;
|
|
*old = NIL;
|
|
break;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
static void OPT_InName (CHAR *name, ADDRESS name__len)
|
|
{
|
|
INT16 i;
|
|
CHAR ch;
|
|
i = 0;
|
|
do {
|
|
OPM_SymRCh(&ch);
|
|
name[__X(i, name__len)] = ch;
|
|
i += 1;
|
|
} while (!(ch == 0x00));
|
|
}
|
|
|
|
static void OPT_InMod (INT8 *mno)
|
|
{
|
|
OPT_Object head = NIL;
|
|
OPS_Name name;
|
|
INT32 mn;
|
|
INT8 i;
|
|
mn = OPM_SymRInt();
|
|
if (mn == 0) {
|
|
*mno = OPT_impCtxt.glbmno[0];
|
|
} else {
|
|
if (mn == 16) {
|
|
OPT_InName((void*)name, 256);
|
|
if ((__STRCMP(name, OPT_SelfName) == 0 && !OPT_impCtxt.self)) {
|
|
OPT_err(154);
|
|
}
|
|
i = 0;
|
|
while ((i < OPT_nofGmod && __STRCMP(name, OPT_GlbMod[__X(i, 64)]->name) != 0)) {
|
|
i += 1;
|
|
}
|
|
if (i < OPT_nofGmod) {
|
|
*mno = i;
|
|
} else {
|
|
head = OPT_NewObj();
|
|
head->mode = 12;
|
|
__COPY(name, head->name, 256);
|
|
*mno = OPT_nofGmod;
|
|
head->mnolev = -*mno;
|
|
if (OPT_nofGmod < 64) {
|
|
OPT_GlbMod[__X(*mno, 64)] = head;
|
|
OPT_nofGmod += 1;
|
|
} else {
|
|
OPT_err(227);
|
|
}
|
|
}
|
|
OPT_impCtxt.glbmno[__X(OPT_impCtxt.nofm, 64)] = *mno;
|
|
OPT_impCtxt.nofm += 1;
|
|
} else {
|
|
*mno = OPT_impCtxt.glbmno[__X(-mn, 64)];
|
|
}
|
|
}
|
|
}
|
|
|
|
static void OPT_InLinks (void)
|
|
{
|
|
OPS_Name linkname;
|
|
OPT_Link l = NIL;
|
|
OPT_InName((void*)linkname, 256);
|
|
while (linkname[0] != 0x00) {
|
|
l = OPT_Links;
|
|
while ((l != NIL && __STRCMP(l->name, linkname) != 0)) {
|
|
l = l->next;
|
|
}
|
|
if (l == NIL) {
|
|
l = OPT_Links;
|
|
__NEW(OPT_Links, OPT_LinkDesc);
|
|
OPT_Links->next = l;
|
|
__MOVE(linkname, OPT_Links->name, 256);
|
|
}
|
|
OPT_InName((void*)linkname, 256);
|
|
}
|
|
}
|
|
|
|
static void OPT_InConstant (INT32 f, OPT_Const conval)
|
|
{
|
|
CHAR ch;
|
|
INT16 i;
|
|
OPT_ConstExt ext = NIL;
|
|
REAL rval;
|
|
switch (f) {
|
|
case 1: case 3: case 2:
|
|
OPM_SymRCh(&ch);
|
|
conval->intval = (INT16)ch;
|
|
break;
|
|
case 4:
|
|
conval->intval = OPM_SymRInt();
|
|
break;
|
|
case 7:
|
|
OPM_SymRSet(&conval->setval);
|
|
break;
|
|
case 5:
|
|
OPM_SymRReal(&rval);
|
|
conval->realval = rval;
|
|
conval->intval = -1;
|
|
break;
|
|
case 6:
|
|
OPM_SymRLReal(&conval->realval);
|
|
conval->intval = -1;
|
|
break;
|
|
case 8:
|
|
ext = OPT_NewExt();
|
|
conval->ext = ext;
|
|
i = 0;
|
|
do {
|
|
OPM_SymRCh(&ch);
|
|
(*ext)[__X(i, 256)] = ch;
|
|
i += 1;
|
|
} while (!(ch == 0x00));
|
|
conval->intval2 = i;
|
|
conval->intval = -1;
|
|
break;
|
|
case 9:
|
|
conval->intval = 0;
|
|
break;
|
|
default:
|
|
OPM_LogWStr((CHAR*)"unhandled case in InConstant(), f = ", 37);
|
|
OPM_LogWNum(f, 0);
|
|
OPM_LogWLn();
|
|
break;
|
|
}
|
|
}
|
|
|
|
static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par)
|
|
{
|
|
OPT_Object last = NIL, new = NIL;
|
|
INT32 tag;
|
|
OPT_InStruct(&*res);
|
|
tag = OPM_SymRInt();
|
|
last = NIL;
|
|
while (tag != 18) {
|
|
if (tag < 0 || tag > 100) {
|
|
OPM_LogWStr((CHAR*)"ERROR: Invalid tag value in InSign: ", 37);
|
|
OPM_LogWNum(tag, 0);
|
|
OPM_LogWLn();
|
|
OPM_err(155);
|
|
return;
|
|
}
|
|
new = OPT_NewObj();
|
|
new->mnolev = -mno;
|
|
if (last == NIL) {
|
|
*par = new;
|
|
} else {
|
|
last->link = new;
|
|
}
|
|
if (tag == 23) {
|
|
new->mode = 1;
|
|
} else {
|
|
new->mode = 2;
|
|
}
|
|
OPT_InStruct(&new->typ);
|
|
new->adr = OPM_SymRInt();
|
|
OPT_InName((void*)new->name, 256);
|
|
last = new;
|
|
tag = OPM_SymRInt();
|
|
}
|
|
}
|
|
|
|
static OPT_Object OPT_InFld (void)
|
|
{
|
|
INT32 tag;
|
|
OPT_Object obj = NIL;
|
|
tag = OPT_impCtxt.nextTag;
|
|
obj = OPT_NewObj();
|
|
if (tag <= 26) {
|
|
obj->mode = 4;
|
|
if (tag == 26) {
|
|
obj->vis = 2;
|
|
} else {
|
|
obj->vis = 1;
|
|
}
|
|
OPT_InStruct(&obj->typ);
|
|
OPT_InName((void*)obj->name, 256);
|
|
obj->adr = OPM_SymRInt();
|
|
} else {
|
|
obj->mode = 4;
|
|
if (tag == 27) {
|
|
__MOVE("@ptr", obj->name, 5);
|
|
} else {
|
|
__MOVE("@proc", obj->name, 6);
|
|
}
|
|
obj->typ = OPT_undftyp;
|
|
obj->vis = 0;
|
|
obj->adr = OPM_SymRInt();
|
|
}
|
|
return obj;
|
|
}
|
|
|
|
static OPT_Object OPT_InTProc (INT8 mno)
|
|
{
|
|
INT32 tag;
|
|
OPT_Object obj = NIL;
|
|
tag = OPT_impCtxt.nextTag;
|
|
obj = OPT_NewObj();
|
|
obj->mnolev = -mno;
|
|
if (tag == 29) {
|
|
obj->mode = 13;
|
|
obj->conval = OPT_NewConst();
|
|
obj->conval->intval = -1;
|
|
OPT_InSign(mno, &obj->typ, &obj->link);
|
|
obj->vis = 1;
|
|
OPT_InName((void*)obj->name, 256);
|
|
obj->adr = __ASHL(OPM_SymRInt(), 16);
|
|
} else {
|
|
obj->mode = 13;
|
|
__MOVE("@tproc", obj->name, 7);
|
|
obj->link = OPT_NewObj();
|
|
obj->typ = OPT_undftyp;
|
|
obj->vis = 0;
|
|
obj->adr = __ASHL(OPM_SymRInt(), 16);
|
|
}
|
|
return obj;
|
|
}
|
|
|
|
static OPT_Struct OPT_InTyp (INT32 tag)
|
|
{
|
|
if (tag == 4) {
|
|
return OPT_IntType(OPM_SymRInt());
|
|
} else if (tag == 7) {
|
|
return OPT_SetType(OPM_SymRInt());
|
|
} else {
|
|
return OPT_impCtxt.ref[__X(tag, 255)];
|
|
}
|
|
__RETCHK;
|
|
}
|
|
|
|
static void OPT_InStruct (OPT_Struct *typ)
|
|
{
|
|
INT8 mno;
|
|
INT16 ref;
|
|
INT32 tag;
|
|
OPS_Name name;
|
|
OPT_Struct t = NIL;
|
|
OPT_Object obj = NIL, last = NIL, fld = NIL, old = NIL, dummy = NIL;
|
|
tag = OPM_SymRInt();
|
|
if (tag != 34) {
|
|
*typ = OPT_InTyp(-tag);
|
|
} else {
|
|
ref = OPT_impCtxt.nofr;
|
|
OPT_impCtxt.nofr += 1;
|
|
if (ref < OPT_impCtxt.minr) {
|
|
OPT_impCtxt.minr = ref;
|
|
}
|
|
OPT_InMod(&mno);
|
|
OPT_InName((void*)name, 256);
|
|
obj = OPT_NewObj();
|
|
if (name[0] == 0x00) {
|
|
if (OPT_impCtxt.self) {
|
|
old = NIL;
|
|
} else {
|
|
__MOVE("@", obj->name, 2);
|
|
OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
|
|
obj->name[0] = 0x00;
|
|
}
|
|
*typ = OPT_NewStr(0, 1);
|
|
} else {
|
|
__MOVE(name, obj->name, 256);
|
|
OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
|
|
if (old != NIL) {
|
|
OPT_FPrintObj(old);
|
|
OPT_impCtxt.pvfp[__X(ref, 255)] = old->typ->pvfp;
|
|
if (OPT_impCtxt.self) {
|
|
*typ = OPT_NewStr(0, 1);
|
|
} else {
|
|
*typ = old->typ;
|
|
(*typ)->link = NIL;
|
|
(*typ)->sysflag = 0;
|
|
(*typ)->fpdone = 0;
|
|
(*typ)->idfpdone = 0;
|
|
}
|
|
} else {
|
|
*typ = OPT_NewStr(0, 1);
|
|
}
|
|
}
|
|
OPT_impCtxt.ref[__X(ref, 255)] = *typ;
|
|
OPT_impCtxt.old[__X(ref, 255)] = old;
|
|
(*typ)->ref = ref + 255;
|
|
(*typ)->mno = mno;
|
|
(*typ)->allocated = 1;
|
|
(*typ)->strobj = obj;
|
|
obj->mode = 5;
|
|
obj->typ = *typ;
|
|
obj->mnolev = -mno;
|
|
obj->vis = 0;
|
|
tag = OPM_SymRInt();
|
|
if (tag == 35) {
|
|
(*typ)->sysflag = __SHORTF(OPM_SymRInt(), 32768);
|
|
tag = OPM_SymRInt();
|
|
}
|
|
switch (tag) {
|
|
case 36:
|
|
(*typ)->form = 11;
|
|
(*typ)->size = OPM_AddressSize;
|
|
(*typ)->n = 0;
|
|
OPT_InStruct(&(*typ)->BaseTyp);
|
|
break;
|
|
case 37:
|
|
(*typ)->form = 13;
|
|
(*typ)->comp = 2;
|
|
OPT_InStruct(&(*typ)->BaseTyp);
|
|
(*typ)->n = OPM_SymRInt();
|
|
OPT_TypSize(*typ);
|
|
break;
|
|
case 38:
|
|
(*typ)->form = 13;
|
|
(*typ)->comp = 3;
|
|
OPT_InStruct(&(*typ)->BaseTyp);
|
|
if ((*typ)->BaseTyp->comp == 3) {
|
|
(*typ)->n = (*typ)->BaseTyp->n + 1;
|
|
} else {
|
|
(*typ)->n = 0;
|
|
}
|
|
OPT_TypSize(*typ);
|
|
break;
|
|
case 39:
|
|
(*typ)->form = 13;
|
|
(*typ)->comp = 4;
|
|
OPT_InStruct(&(*typ)->BaseTyp);
|
|
if ((*typ)->BaseTyp == OPT_notyp) {
|
|
(*typ)->BaseTyp = NIL;
|
|
}
|
|
(*typ)->extlev = 0;
|
|
t = (*typ)->BaseTyp;
|
|
while (t != NIL) {
|
|
(*typ)->extlev += 1;
|
|
t = t->BaseTyp;
|
|
}
|
|
(*typ)->size = OPM_SymRInt();
|
|
(*typ)->align = OPM_SymRInt();
|
|
(*typ)->n = OPM_SymRInt();
|
|
OPT_impCtxt.nextTag = OPM_SymRInt();
|
|
last = NIL;
|
|
while ((OPT_impCtxt.nextTag >= 25 && OPT_impCtxt.nextTag <= 28)) {
|
|
fld = OPT_InFld();
|
|
fld->mnolev = -mno;
|
|
if (last != NIL) {
|
|
last->link = fld;
|
|
}
|
|
last = fld;
|
|
OPT_InsertImport(fld, &(*typ)->link, &dummy);
|
|
OPT_impCtxt.nextTag = OPM_SymRInt();
|
|
}
|
|
while (OPT_impCtxt.nextTag != 18) {
|
|
fld = OPT_InTProc(mno);
|
|
OPT_InsertImport(fld, &(*typ)->link, &dummy);
|
|
OPT_impCtxt.nextTag = OPM_SymRInt();
|
|
}
|
|
break;
|
|
case 40:
|
|
(*typ)->form = 12;
|
|
(*typ)->size = OPM_AddressSize;
|
|
OPT_InSign(mno, &(*typ)->BaseTyp, &(*typ)->link);
|
|
break;
|
|
default:
|
|
OPM_LogWStr((CHAR*)"unhandled case at InStruct, tag = ", 35);
|
|
OPM_LogWNum(tag, 0);
|
|
OPM_LogWLn();
|
|
break;
|
|
}
|
|
if (ref == OPT_impCtxt.minr) {
|
|
while (ref < OPT_impCtxt.nofr) {
|
|
t = OPT_InTyp(ref);
|
|
OPT_FPrintStr(t);
|
|
obj = t->strobj;
|
|
if (obj->name[0] != 0x00) {
|
|
OPT_FPrintObj(obj);
|
|
}
|
|
old = OPT_impCtxt.old[__X(ref, 255)];
|
|
if (old != NIL) {
|
|
t->strobj = old;
|
|
if (OPT_impCtxt.self) {
|
|
if (old->mnolev < 0) {
|
|
if (old->history != 5) {
|
|
if (old->fprint != obj->fprint) {
|
|
old->history = 2;
|
|
} else if (OPT_impCtxt.pvfp[__X(ref, 255)] != t->pvfp) {
|
|
old->history = 3;
|
|
}
|
|
}
|
|
} else if (old->fprint != obj->fprint) {
|
|
old->history = 2;
|
|
} else if (OPT_impCtxt.pvfp[__X(ref, 255)] != t->pvfp) {
|
|
old->history = 3;
|
|
} else if (old->vis == 0) {
|
|
old->history = 1;
|
|
} else {
|
|
old->history = 0;
|
|
}
|
|
} else {
|
|
if (OPT_impCtxt.pvfp[__X(ref, 255)] != t->pvfp) {
|
|
old->history = 5;
|
|
}
|
|
if (old->fprint != obj->fprint) {
|
|
OPT_FPrintErr(old, 249);
|
|
}
|
|
}
|
|
} else if (OPT_impCtxt.self) {
|
|
obj->history = 4;
|
|
} else {
|
|
obj->history = 1;
|
|
}
|
|
ref += 1;
|
|
}
|
|
OPT_impCtxt.minr = 255;
|
|
}
|
|
}
|
|
}
|
|
|
|
static OPT_Object OPT_InObj (INT8 mno)
|
|
{
|
|
INT16 i, s;
|
|
CHAR ch;
|
|
OPT_Object obj = NIL, old = NIL;
|
|
OPT_Struct typ = NIL;
|
|
INT32 tag;
|
|
OPT_ConstExt ext = NIL;
|
|
OPS_Name commentText;
|
|
BOOLEAN hasComment;
|
|
INT16 j;
|
|
INT32 len;
|
|
tag = OPT_impCtxt.nextTag;
|
|
hasComment = 0;
|
|
while (tag == 41) {
|
|
len = OPM_SymRInt();
|
|
if (len < 0) {
|
|
len = 0;
|
|
}
|
|
if (len > 255) {
|
|
len = 255;
|
|
}
|
|
i = 0;
|
|
while (i < len) {
|
|
OPM_SymRCh(&commentText[__X(i, 256)]);
|
|
i += 1;
|
|
}
|
|
commentText[__X(i, 256)] = 0x00;
|
|
hasComment = 1;
|
|
tag = OPM_SymRInt();
|
|
}
|
|
OPT_impCtxt.nextTag = tag;
|
|
if (tag < 0 || tag > 50) {
|
|
OPM_LogWStr((CHAR*)"ERROR: Invalid tag in InObj: ", 30);
|
|
OPM_LogWNum(tag, 0);
|
|
OPM_LogWLn();
|
|
OPM_err(155);
|
|
return NIL;
|
|
}
|
|
if (tag == 19) {
|
|
OPT_InStruct(&typ);
|
|
obj = typ->strobj;
|
|
if (!OPT_impCtxt.self) {
|
|
obj->vis = 1;
|
|
}
|
|
} else {
|
|
obj = OPT_NewObj();
|
|
obj->mnolev = -mno;
|
|
obj->vis = 1;
|
|
if (tag <= 11) {
|
|
obj->mode = 3;
|
|
obj->conval = OPT_NewConst();
|
|
OPT_InConstant(tag, obj->conval);
|
|
obj->typ = OPT_InTyp(tag);
|
|
} else if ((tag >= 31 && tag <= 33)) {
|
|
obj->conval = OPT_NewConst();
|
|
obj->conval->intval = -1;
|
|
OPT_InSign(mno, &obj->typ, &obj->link);
|
|
switch (tag) {
|
|
case 31:
|
|
obj->mode = 7;
|
|
break;
|
|
case 32:
|
|
obj->mode = 10;
|
|
break;
|
|
case 33:
|
|
obj->mode = 9;
|
|
ext = OPT_NewExt();
|
|
obj->conval->ext = ext;
|
|
s = __SHORTF(OPM_SymRInt(), 32768);
|
|
(*ext)[0] = __CHR(s);
|
|
i = 1;
|
|
while (i <= s) {
|
|
OPM_SymRCh(&(*ext)[__X(i, 256)]);
|
|
i += 1;
|
|
}
|
|
break;
|
|
default:
|
|
OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", 32);
|
|
OPM_LogWNum(tag, 0);
|
|
OPM_LogWLn();
|
|
OPM_err(155);
|
|
return NIL;
|
|
break;
|
|
}
|
|
} else if (tag == 20) {
|
|
obj->mode = 5;
|
|
OPT_InStruct(&obj->typ);
|
|
} else if (tag == 21 || tag == 22) {
|
|
obj->mode = 1;
|
|
if (tag == 22) {
|
|
obj->vis = 2;
|
|
}
|
|
OPT_InStruct(&obj->typ);
|
|
} else {
|
|
OPM_LogWStr((CHAR*)"ERROR: Unexpected tag in InObj: ", 33);
|
|
OPM_LogWNum(tag, 0);
|
|
OPM_LogWLn();
|
|
OPM_err(155);
|
|
return NIL;
|
|
}
|
|
OPT_InName((void*)obj->name, 256);
|
|
}
|
|
if ((hasComment && obj != NIL)) {
|
|
obj->comment = __NEWARR(NIL, 1, 1, 1, 0, ((INT64)(256)));
|
|
j = 0;
|
|
while ((((j < 255 && j < len)) && commentText[__X(j, 256)] != 0x00)) {
|
|
(*obj->comment)[__X(j, 256)] = commentText[__X(j, 256)];
|
|
j += 1;
|
|
}
|
|
(*obj->comment)[__X(j, 256)] = 0x00;
|
|
}
|
|
OPT_FPrintObj(obj);
|
|
if ((obj->mode == 1 && (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00))) {
|
|
OPM_FPrint(&OPT_impCtxt.reffp, obj->typ->ref - 255);
|
|
}
|
|
if (tag != 19) {
|
|
OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
|
|
if (OPT_impCtxt.self) {
|
|
if (old != NIL) {
|
|
if (old->vis == 0) {
|
|
old->history = 4;
|
|
} else {
|
|
OPT_FPrintObj(old);
|
|
if (obj->fprint != old->fprint) {
|
|
old->history = 2;
|
|
} else if (obj->typ->pvfp != old->typ->pvfp) {
|
|
old->history = 3;
|
|
} else {
|
|
old->history = 1;
|
|
}
|
|
}
|
|
} else {
|
|
obj->history = 4;
|
|
}
|
|
}
|
|
} else {
|
|
if (OPT_impCtxt.self) {
|
|
if (obj->vis == 0) {
|
|
obj->history = 4;
|
|
} else if (obj->history == 0) {
|
|
obj->history = 1;
|
|
}
|
|
}
|
|
}
|
|
return obj;
|
|
}
|
|
|
|
void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
|
|
{
|
|
OPT_Object obj = NIL;
|
|
INT8 mno;
|
|
OPS_Name aliasName__copy;
|
|
__DUPARR(aliasName, OPS_Name);
|
|
if (__STRCMP(name, "SYSTEM") == 0) {
|
|
OPT_SYSimported = 1;
|
|
OPT_Insert(aliasName, &obj);
|
|
obj->mode = 11;
|
|
obj->mnolev = 0;
|
|
obj->scope = OPT_syslink;
|
|
obj->typ = OPT_notyp;
|
|
} else {
|
|
OPT_impCtxt.nofr = 14;
|
|
OPT_impCtxt.minr = 255;
|
|
OPT_impCtxt.nofm = 0;
|
|
OPT_impCtxt.self = __STRCMP(aliasName, "@self") == 0;
|
|
OPT_impCtxt.reffp = 0;
|
|
if ((OPT_impCtxt.self && __IN(17, OPM_Options, 32))) {
|
|
OPM_DeleteSym((void*)name, 256);
|
|
*done = 0;
|
|
} else {
|
|
OPM_OldSym((void*)name, 256, &*done);
|
|
}
|
|
if (*done) {
|
|
OPT_InMod(&mno);
|
|
OPT_InLinks();
|
|
OPT_impCtxt.nextTag = OPM_SymRInt();
|
|
while (!OPM_eofSF()) {
|
|
obj = OPT_InObj(mno);
|
|
OPT_impCtxt.nextTag = OPM_SymRInt();
|
|
}
|
|
OPT_Insert(aliasName, &obj);
|
|
obj->mode = 11;
|
|
obj->scope = OPT_GlbMod[__X(mno, 64)]->right;
|
|
OPT_GlbMod[__X(mno, 64)]->link = obj;
|
|
obj->mnolev = -mno;
|
|
obj->typ = OPT_notyp;
|
|
OPM_CloseOldSym();
|
|
} else if (OPT_impCtxt.self) {
|
|
OPT_newsf = 1;
|
|
OPT_extsf = 1;
|
|
OPT_sfpresent = 0;
|
|
} else {
|
|
OPT_err(152);
|
|
}
|
|
}
|
|
}
|
|
|
|
static void OPT_OutName (CHAR *name, ADDRESS name__len)
|
|
{
|
|
INT16 i;
|
|
CHAR ch;
|
|
i = 0;
|
|
do {
|
|
ch = name[__X(i, name__len)];
|
|
OPM_SymWCh(ch);
|
|
i += 1;
|
|
} while (!(ch == 0x00));
|
|
}
|
|
|
|
static void OPT_OutMod (INT16 mno)
|
|
{
|
|
if (OPT_expCtxt.locmno[__X(mno, 64)] < 0) {
|
|
OPM_SymWInt(16);
|
|
OPT_expCtxt.locmno[__X(mno, 64)] = OPT_expCtxt.nofm;
|
|
OPT_expCtxt.nofm += 1;
|
|
OPT_OutName((void*)OPT_GlbMod[__X(mno, 64)]->name, 256);
|
|
} else {
|
|
OPM_SymWInt(-OPT_expCtxt.locmno[__X(mno, 64)]);
|
|
}
|
|
}
|
|
|
|
static void OPT_OutLinks (void)
|
|
{
|
|
OPT_Link l = NIL;
|
|
l = OPT_Links;
|
|
while (l != NIL) {
|
|
OPT_OutName((void*)l->name, 256);
|
|
l = l->next;
|
|
}
|
|
OPM_SymWCh(0x00);
|
|
}
|
|
|
|
static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr)
|
|
{
|
|
INT32 i, j, n;
|
|
OPT_Struct btyp = NIL;
|
|
if (typ->comp == 4) {
|
|
OPT_OutFlds(typ->link, adr, 0);
|
|
} else if (typ->comp == 2) {
|
|
btyp = typ->BaseTyp;
|
|
n = typ->n;
|
|
while (btyp->comp == 2) {
|
|
n = btyp->n * n;
|
|
btyp = btyp->BaseTyp;
|
|
}
|
|
if (btyp->form == 11 || btyp->comp == 4) {
|
|
j = OPT_nofhdfld;
|
|
OPT_OutHdFld(btyp, fld, adr);
|
|
if (j != OPT_nofhdfld) {
|
|
i = 1;
|
|
while ((i < n && OPT_nofhdfld <= 2048)) {
|
|
adr += btyp->size;
|
|
OPT_OutHdFld(btyp, fld, adr);
|
|
i += 1;
|
|
}
|
|
}
|
|
}
|
|
} else if (typ->form == 11 || __STRCMP(fld->name, "@ptr") == 0) {
|
|
OPM_SymWInt(27);
|
|
OPM_SymWInt(adr);
|
|
OPT_nofhdfld += 1;
|
|
}
|
|
}
|
|
|
|
static void OPT_OutFlds (OPT_Object fld, INT32 adr, BOOLEAN visible)
|
|
{
|
|
while ((fld != NIL && fld->mode == 4)) {
|
|
if ((fld->vis != 0 && visible)) {
|
|
if (fld->vis == 2) {
|
|
OPM_SymWInt(26);
|
|
} else {
|
|
OPM_SymWInt(25);
|
|
}
|
|
OPT_OutStr(fld->typ);
|
|
OPT_OutName((void*)fld->name, 256);
|
|
OPM_SymWInt(fld->adr);
|
|
} else {
|
|
OPT_OutHdFld(fld->typ, fld, fld->adr + adr);
|
|
}
|
|
fld = fld->link;
|
|
}
|
|
}
|
|
|
|
static void OPT_OutSign (OPT_Struct result, OPT_Object par)
|
|
{
|
|
OPT_OutStr(result);
|
|
while (par != NIL) {
|
|
if (par->mode == 1) {
|
|
OPM_SymWInt(23);
|
|
} else {
|
|
OPM_SymWInt(24);
|
|
}
|
|
OPT_OutStr(par->typ);
|
|
OPM_SymWInt(par->adr);
|
|
OPT_OutName((void*)par->name, 256);
|
|
par = par->link;
|
|
}
|
|
OPM_SymWInt(18);
|
|
}
|
|
|
|
static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj)
|
|
{
|
|
if (obj != NIL) {
|
|
OPT_OutTProcs(typ, obj->left);
|
|
if (obj->mode == 13) {
|
|
if ((((typ->BaseTyp != NIL && __ASHR(obj->adr, 16) < typ->BaseTyp->n)) && obj->vis == 0)) {
|
|
OPM_Mark(109, typ->txtpos);
|
|
}
|
|
if (obj->vis != 0) {
|
|
if (obj->vis != 0) {
|
|
OPM_SymWInt(29);
|
|
OPT_OutSign(obj->typ, obj->link);
|
|
OPT_OutName((void*)obj->name, 256);
|
|
OPM_SymWInt(__ASHR(obj->adr, 16));
|
|
} else {
|
|
OPM_SymWInt(30);
|
|
OPM_SymWInt(__ASHR(obj->adr, 16));
|
|
}
|
|
}
|
|
}
|
|
OPT_OutTProcs(typ, obj->right);
|
|
}
|
|
}
|
|
|
|
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, 0x90, 32)) {
|
|
OPM_SymWInt(typ->size);
|
|
}
|
|
} else {
|
|
OPM_SymWInt(34);
|
|
typ->ref = OPT_expCtxt.ref;
|
|
OPT_expCtxt.ref += 1;
|
|
if (OPT_expCtxt.ref >= 255) {
|
|
OPT_err(228);
|
|
}
|
|
OPT_OutMod(typ->mno);
|
|
strobj = typ->strobj;
|
|
if ((strobj != NIL && strobj->name[0] != 0x00)) {
|
|
OPT_OutName((void*)strobj->name, 256);
|
|
switch (strobj->history) {
|
|
case 2:
|
|
OPT_FPrintErr(strobj, 252);
|
|
break;
|
|
case 3:
|
|
OPT_FPrintErr(strobj, 251);
|
|
break;
|
|
case 5:
|
|
OPT_FPrintErr(strobj, 249);
|
|
break;
|
|
default:
|
|
break;
|
|
}
|
|
} else {
|
|
OPM_SymWCh(0x00);
|
|
}
|
|
if (typ->sysflag != 0) {
|
|
OPM_SymWInt(35);
|
|
OPM_SymWInt(typ->sysflag);
|
|
}
|
|
switch (typ->form) {
|
|
case 11:
|
|
OPM_SymWInt(36);
|
|
OPT_OutStr(typ->BaseTyp);
|
|
break;
|
|
case 12:
|
|
OPM_SymWInt(40);
|
|
OPT_OutSign(typ->BaseTyp, typ->link);
|
|
break;
|
|
case 13:
|
|
switch (typ->comp) {
|
|
case 2:
|
|
OPM_SymWInt(37);
|
|
OPT_OutStr(typ->BaseTyp);
|
|
OPM_SymWInt(typ->n);
|
|
break;
|
|
case 3:
|
|
OPM_SymWInt(38);
|
|
OPT_OutStr(typ->BaseTyp);
|
|
break;
|
|
case 4:
|
|
OPM_SymWInt(39);
|
|
if (typ->BaseTyp == NIL) {
|
|
OPT_OutStr(OPT_notyp);
|
|
} else {
|
|
OPT_OutStr(typ->BaseTyp);
|
|
}
|
|
OPM_SymWInt(typ->size);
|
|
OPM_SymWInt(typ->align);
|
|
OPM_SymWInt(typ->n);
|
|
OPT_nofhdfld = 0;
|
|
OPT_OutFlds(typ->link, 0, 1);
|
|
if (OPT_nofhdfld > 2048) {
|
|
OPM_Mark(223, typ->txtpos);
|
|
}
|
|
OPT_OutTProcs(typ, typ->link);
|
|
OPM_SymWInt(18);
|
|
break;
|
|
default:
|
|
OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.comp = ", 39);
|
|
OPM_LogWNum(typ->comp, 0);
|
|
OPM_LogWLn();
|
|
break;
|
|
}
|
|
break;
|
|
default:
|
|
OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.form = ", 39);
|
|
OPM_LogWNum(typ->form, 0);
|
|
OPM_LogWLn();
|
|
break;
|
|
}
|
|
}
|
|
}
|
|
|
|
static void OPT_OutConstant (OPT_Object obj)
|
|
{
|
|
INT16 f;
|
|
REAL rval;
|
|
f = obj->typ->form;
|
|
OPM_SymWInt(f);
|
|
switch (f) {
|
|
case 2: case 3:
|
|
OPM_SymWCh(__CHR(obj->conval->intval));
|
|
break;
|
|
case 4:
|
|
OPM_SymWInt(obj->conval->intval);
|
|
OPM_SymWInt(obj->typ->size);
|
|
break;
|
|
case 7:
|
|
OPM_SymWSet(obj->conval->setval);
|
|
OPM_SymWInt(obj->typ->size);
|
|
break;
|
|
case 5:
|
|
rval = obj->conval->realval;
|
|
OPM_SymWReal(rval);
|
|
break;
|
|
case 6:
|
|
OPM_SymWLReal(obj->conval->realval);
|
|
break;
|
|
case 8:
|
|
OPT_OutName((void*)*obj->conval->ext, 256);
|
|
break;
|
|
case 9:
|
|
break;
|
|
default:
|
|
OPT_err(127);
|
|
break;
|
|
}
|
|
}
|
|
|
|
static void OPT_OutTruncatedName (CHAR *text, ADDRESS text__len)
|
|
{
|
|
INT16 i;
|
|
__DUP(text, text__len, CHAR);
|
|
i = 0;
|
|
while ((i < 255 && text[__X(i, text__len)] != 0x00)) {
|
|
OPM_SymWCh(text[__X(i, text__len)]);
|
|
i += 1;
|
|
}
|
|
OPM_SymWCh(0x00);
|
|
__DEL(text);
|
|
}
|
|
|
|
static void OPT_OutObj (OPT_Object obj)
|
|
{
|
|
INT16 i, j;
|
|
OPT_ConstExt ext = NIL;
|
|
INT16 k, l;
|
|
if (obj != NIL) {
|
|
OPT_OutObj(obj->left);
|
|
if (__IN(obj->mode, 0x06ea, 32)) {
|
|
if (obj->comment != NIL) {
|
|
OPM_SymWInt(41);
|
|
k = 0;
|
|
while ((k < 255 && (*obj->comment)[__X(k, 256)] != 0x00)) {
|
|
k += 1;
|
|
}
|
|
OPM_SymWInt(k);
|
|
l = 0;
|
|
while (l < k) {
|
|
OPM_SymWCh((*obj->comment)[__X(l, 256)]);
|
|
l += 1;
|
|
}
|
|
}
|
|
if (obj->history == 4) {
|
|
OPT_FPrintErr(obj, 250);
|
|
} else if (obj->vis != 0) {
|
|
switch (obj->history) {
|
|
case 0:
|
|
OPT_FPrintErr(obj, 253);
|
|
break;
|
|
case 1:
|
|
break;
|
|
case 2:
|
|
OPT_FPrintErr(obj, 252);
|
|
break;
|
|
case 3:
|
|
OPT_FPrintErr(obj, 251);
|
|
break;
|
|
default:
|
|
OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj^.history = ", 42);
|
|
OPM_LogWNum(obj->history, 0);
|
|
OPM_LogWLn();
|
|
break;
|
|
}
|
|
switch (obj->mode) {
|
|
case 3:
|
|
OPT_OutConstant(obj);
|
|
OPT_OutName((void*)obj->name, 256);
|
|
break;
|
|
case 5:
|
|
if (obj->typ->strobj == obj) {
|
|
OPM_SymWInt(19);
|
|
OPT_OutStr(obj->typ);
|
|
} else {
|
|
OPM_SymWInt(20);
|
|
OPT_OutStr(obj->typ);
|
|
OPT_OutName((void*)obj->name, 256);
|
|
}
|
|
break;
|
|
case 1:
|
|
if (obj->vis == 2) {
|
|
OPM_SymWInt(22);
|
|
} else {
|
|
OPM_SymWInt(21);
|
|
}
|
|
OPT_OutStr(obj->typ);
|
|
OPT_OutName((void*)obj->name, 256);
|
|
if (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00) {
|
|
OPM_FPrint(&OPT_expCtxt.reffp, obj->typ->ref);
|
|
}
|
|
break;
|
|
case 7:
|
|
OPM_SymWInt(31);
|
|
OPT_OutSign(obj->typ, obj->link);
|
|
OPT_OutName((void*)obj->name, 256);
|
|
break;
|
|
case 10:
|
|
OPM_SymWInt(32);
|
|
OPT_OutSign(obj->typ, obj->link);
|
|
OPT_OutName((void*)obj->name, 256);
|
|
break;
|
|
case 9:
|
|
OPM_SymWInt(33);
|
|
OPT_OutSign(obj->typ, obj->link);
|
|
ext = obj->conval->ext;
|
|
j = (INT16)(*ext)[0];
|
|
i = 1;
|
|
OPM_SymWInt(j);
|
|
while (i <= j) {
|
|
OPM_SymWCh((*ext)[__X(i, 256)]);
|
|
i += 1;
|
|
}
|
|
OPT_OutName((void*)obj->name, 256);
|
|
break;
|
|
default:
|
|
OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj.mode = ", 38);
|
|
OPM_LogWNum(obj->mode, 0);
|
|
OPM_LogWLn();
|
|
break;
|
|
}
|
|
}
|
|
}
|
|
OPT_OutObj(obj->right);
|
|
}
|
|
}
|
|
|
|
void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
|
|
{
|
|
INT16 i;
|
|
INT8 nofmod;
|
|
BOOLEAN done;
|
|
OPT_symExtended = 0;
|
|
OPT_symNew = 0;
|
|
nofmod = OPT_nofGmod;
|
|
OPT_Import((CHAR*)"@self", OPT_SelfName, &done);
|
|
OPT_nofGmod = nofmod;
|
|
if (OPM_noerr) {
|
|
OPM_NewSym((void*)OPT_SelfName, 256);
|
|
if (OPM_noerr) {
|
|
OPM_SymWInt(16);
|
|
OPT_OutName((void*)OPT_SelfName, 256);
|
|
OPT_OutLinks();
|
|
OPT_expCtxt.reffp = 0;
|
|
OPT_expCtxt.ref = 14;
|
|
OPT_expCtxt.nofm = 1;
|
|
OPT_expCtxt.locmno[0] = 0;
|
|
i = 1;
|
|
while (i < 64) {
|
|
OPT_expCtxt.locmno[__X(i, 64)] = -1;
|
|
i += 1;
|
|
}
|
|
OPT_OutObj(OPT_topScope->right);
|
|
*ext = (OPT_sfpresent && OPT_symExtended);
|
|
*new = (!OPT_sfpresent || OPT_symNew) || __IN(17, OPM_Options, 32);
|
|
if ((((OPM_noerr && OPT_sfpresent)) && OPT_impCtxt.reffp != OPT_expCtxt.reffp)) {
|
|
*new = 1;
|
|
if (!OPT_extsf) {
|
|
OPT_err(155);
|
|
}
|
|
}
|
|
OPT_newsf = 0;
|
|
OPT_symNew = 0;
|
|
if (!OPM_noerr || OPT_findpc) {
|
|
OPM_DeleteSym((void*)OPT_SelfName, 256);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
static void OPT_InitStruct (OPT_Struct *typ, INT8 form)
|
|
{
|
|
*typ = OPT_NewStr(form, 1);
|
|
(*typ)->ref = form;
|
|
(*typ)->size = 1;
|
|
(*typ)->allocated = 1;
|
|
(*typ)->strobj = OPT_NewObj();
|
|
(*typ)->pbfp = form;
|
|
(*typ)->pvfp = form;
|
|
(*typ)->fpdone = 1;
|
|
(*typ)->idfp = form;
|
|
(*typ)->idfpdone = 1;
|
|
}
|
|
|
|
static void OPT_EnterBoolConst (OPS_Name name, INT32 value)
|
|
{
|
|
OPT_Object obj = NIL;
|
|
OPS_Name name__copy;
|
|
__DUPARR(name, OPS_Name);
|
|
OPT_Insert(name, &obj);
|
|
obj->conval = OPT_NewConst();
|
|
obj->mode = 3;
|
|
obj->typ = OPT_booltyp;
|
|
obj->conval->intval = value;
|
|
}
|
|
|
|
static void OPT_EnterTyp (OPS_Name name, INT8 form, INT16 size, OPT_Struct *res)
|
|
{
|
|
OPT_Object obj = NIL;
|
|
OPT_Struct typ = NIL;
|
|
OPS_Name name__copy;
|
|
__DUPARR(name, OPS_Name);
|
|
OPT_Insert(name, &obj);
|
|
typ = OPT_NewStr(form, 1);
|
|
obj->mode = 5;
|
|
obj->typ = typ;
|
|
obj->vis = 1;
|
|
typ->strobj = obj;
|
|
typ->size = size;
|
|
typ->ref = form;
|
|
typ->allocated = 1;
|
|
typ->pbfp = form;
|
|
typ->pvfp = form;
|
|
typ->fpdone = 1;
|
|
typ->idfp = form;
|
|
typ->idfpdone = 1;
|
|
if (__IN(form, 0x90, 32)) {
|
|
OPM_FPrint(&typ->idfp, typ->size);
|
|
}
|
|
*res = typ;
|
|
}
|
|
|
|
static void OPT_EnterTypeAlias (OPS_Name name, OPT_Object *res)
|
|
{
|
|
OPT_Object obj = NIL;
|
|
OPS_Name name__copy;
|
|
__DUPARR(name, OPS_Name);
|
|
OPT_Insert(name, &obj);
|
|
obj->mode = 5;
|
|
obj->typ = NIL;
|
|
obj->vis = 1;
|
|
*res = obj;
|
|
}
|
|
|
|
static void OPT_EnterProc (OPS_Name name, INT16 num)
|
|
{
|
|
OPT_Object obj = NIL;
|
|
OPS_Name name__copy;
|
|
__DUPARR(name, OPS_Name);
|
|
OPT_Insert(name, &obj);
|
|
obj->mode = 8;
|
|
obj->typ = OPT_notyp;
|
|
obj->adr = num;
|
|
}
|
|
|
|
static void EnumPtrs(void (*P)(void*))
|
|
{
|
|
P(OPT_topScope);
|
|
P(OPT_undftyp);
|
|
P(OPT_niltyp);
|
|
P(OPT_notyp);
|
|
P(OPT_bytetyp);
|
|
P(OPT_cpbytetyp);
|
|
P(OPT_booltyp);
|
|
P(OPT_chartyp);
|
|
P(OPT_sinttyp);
|
|
P(OPT_inttyp);
|
|
P(OPT_linttyp);
|
|
P(OPT_hinttyp);
|
|
P(OPT_int8typ);
|
|
P(OPT_int16typ);
|
|
P(OPT_int32typ);
|
|
P(OPT_int64typ);
|
|
P(OPT_settyp);
|
|
P(OPT_set32typ);
|
|
P(OPT_set64typ);
|
|
P(OPT_realtyp);
|
|
P(OPT_lrltyp);
|
|
P(OPT_stringtyp);
|
|
P(OPT_adrtyp);
|
|
P(OPT_sysptrtyp);
|
|
P(OPT_sintobj);
|
|
P(OPT_intobj);
|
|
P(OPT_lintobj);
|
|
P(OPT_setobj);
|
|
__ENUMP(OPT_GlbMod, 64, P);
|
|
P(OPT_universe);
|
|
P(OPT_syslink);
|
|
__ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 5184, 1, P);
|
|
P(OPT_Links);
|
|
}
|
|
|
|
__TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 40), {0, -16}};
|
|
__TDESC(OPT_ObjDesc, 1, 7) = {__TDFLDS("ObjDesc", 344), {0, 8, 16, 24, 304, 312, 336, -64}};
|
|
__TDESC(OPT_StrDesc, 1, 3) = {__TDFLDS("StrDesc", 72), {48, 56, 64, -32}};
|
|
__TDESC(OPT_NodeDesc, 1, 6) = {__TDFLDS("NodeDesc", 56), {0, 8, 16, 32, 40, 48, -56}};
|
|
__TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 5184), {16, 24, 32, 40, 48, 56, 64, 72, 80, 88, 96, 104, 112, 120, 128, 136,
|
|
144, 152, 160, 168, 176, 184, 192, 200, 208, 216, 224, 232, 240, 248, 256, 264,
|
|
272, 280, 288, 296, 304, 312, 320, 328, 336, 344, 352, 360, 368, 376, 384, 392,
|
|
400, 408, 416, 424, 432, 440, 448, 456, 464, 472, 480, 488, 496, 504, 512, 520,
|
|
528, 536, 544, 552, 560, 568, 576, 584, 592, 600, 608, 616, 624, 632, 640, 648,
|
|
656, 664, 672, 680, 688, 696, 704, 712, 720, 728, 736, 744, 752, 760, 768, 776,
|
|
784, 792, 800, 808, 816, 824, 832, 840, 848, 856, 864, 872, 880, 888, 896, 904,
|
|
912, 920, 928, 936, 944, 952, 960, 968, 976, 984, 992, 1000, 1008, 1016, 1024, 1032,
|
|
1040, 1048, 1056, 1064, 1072, 1080, 1088, 1096, 1104, 1112, 1120, 1128, 1136, 1144, 1152, 1160,
|
|
1168, 1176, 1184, 1192, 1200, 1208, 1216, 1224, 1232, 1240, 1248, 1256, 1264, 1272, 1280, 1288,
|
|
1296, 1304, 1312, 1320, 1328, 1336, 1344, 1352, 1360, 1368, 1376, 1384, 1392, 1400, 1408, 1416,
|
|
1424, 1432, 1440, 1448, 1456, 1464, 1472, 1480, 1488, 1496, 1504, 1512, 1520, 1528, 1536, 1544,
|
|
1552, 1560, 1568, 1576, 1584, 1592, 1600, 1608, 1616, 1624, 1632, 1640, 1648, 1656, 1664, 1672,
|
|
1680, 1688, 1696, 1704, 1712, 1720, 1728, 1736, 1744, 1752, 1760, 1768, 1776, 1784, 1792, 1800,
|
|
1808, 1816, 1824, 1832, 1840, 1848, 1856, 1864, 1872, 1880, 1888, 1896, 1904, 1912, 1920, 1928,
|
|
1936, 1944, 1952, 1960, 1968, 1976, 1984, 1992, 2000, 2008, 2016, 2024, 2032, 2040, 2048, 2056,
|
|
2064, 2072, 2080, 2088, 2096, 2104, 2112, 2120, 2128, 2136, 2144, 2152, 2160, 2168, 2176, 2184,
|
|
2192, 2200, 2208, 2216, 2224, 2232, 2240, 2248, 2256, 2264, 2272, 2280, 2288, 2296, 2304, 2312,
|
|
2320, 2328, 2336, 2344, 2352, 2360, 2368, 2376, 2384, 2392, 2400, 2408, 2416, 2424, 2432, 2440,
|
|
2448, 2456, 2464, 2472, 2480, 2488, 2496, 2504, 2512, 2520, 2528, 2536, 2544, 2552, 2560, 2568,
|
|
2576, 2584, 2592, 2600, 2608, 2616, 2624, 2632, 2640, 2648, 2656, 2664, 2672, 2680, 2688, 2696,
|
|
2704, 2712, 2720, 2728, 2736, 2744, 2752, 2760, 2768, 2776, 2784, 2792, 2800, 2808, 2816, 2824,
|
|
2832, 2840, 2848, 2856, 2864, 2872, 2880, 2888, 2896, 2904, 2912, 2920, 2928, 2936, 2944, 2952,
|
|
2960, 2968, 2976, 2984, 2992, 3000, 3008, 3016, 3024, 3032, 3040, 3048, 3056, 3064, 3072, 3080,
|
|
3088, 3096, 3104, 3112, 3120, 3128, 3136, 3144, 3152, 3160, 3168, 3176, 3184, 3192, 3200, 3208,
|
|
3216, 3224, 3232, 3240, 3248, 3256, 3264, 3272, 3280, 3288, 3296, 3304, 3312, 3320, 3328, 3336,
|
|
3344, 3352, 3360, 3368, 3376, 3384, 3392, 3400, 3408, 3416, 3424, 3432, 3440, 3448, 3456, 3464,
|
|
3472, 3480, 3488, 3496, 3504, 3512, 3520, 3528, 3536, 3544, 3552, 3560, 3568, 3576, 3584, 3592,
|
|
3600, 3608, 3616, 3624, 3632, 3640, 3648, 3656, 3664, 3672, 3680, 3688, 3696, 3704, 3712, 3720,
|
|
3728, 3736, 3744, 3752, 3760, 3768, 3776, 3784, 3792, 3800, 3808, 3816, 3824, 3832, 3840, 3848,
|
|
3856, 3864, 3872, 3880, 3888, 3896, 3904, 3912, 3920, 3928, 3936, 3944, 3952, 3960, 3968, 3976,
|
|
3984, 3992, 4000, 4008, 4016, 4024, 4032, 4040, 4048, 4056, 4064, 4072, 4080, 4088, -4088}};
|
|
__TDESC(OPT_ExpCtxt, 1, 0) = {__TDFLDS("ExpCtxt", 72), {-8}};
|
|
__TDESC(OPT_LinkDesc, 1, 1) = {__TDFLDS("LinkDesc", 264), {256, -16}};
|
|
|
|
export void *OPT__init(void)
|
|
{
|
|
__DEFMOD;
|
|
__MODULE_IMPORT(OPM);
|
|
__MODULE_IMPORT(OPS);
|
|
__REGMOD("OPT", EnumPtrs);
|
|
__REGCMD("Close", OPT_Close);
|
|
__REGCMD("CloseScope", OPT_CloseScope);
|
|
__REGCMD("InitRecno", OPT_InitRecno);
|
|
__INITYP(OPT_ConstDesc, OPT_ConstDesc, 0);
|
|
__INITYP(OPT_ObjDesc, OPT_ObjDesc, 0);
|
|
__INITYP(OPT_StrDesc, OPT_StrDesc, 0);
|
|
__INITYP(OPT_NodeDesc, OPT_NodeDesc, 0);
|
|
__INITYP(OPT_ImpCtxt, OPT_ImpCtxt, 0);
|
|
__INITYP(OPT_ExpCtxt, OPT_ExpCtxt, 0);
|
|
__INITYP(OPT_LinkDesc, OPT_LinkDesc, 0);
|
|
/* BEGIN */
|
|
OPT_topScope = NIL;
|
|
OPT_OpenScope(0, NIL);
|
|
OPM_errpos = 0;
|
|
OPT_InitStruct(&OPT_undftyp, 0);
|
|
OPT_undftyp->BaseTyp = OPT_undftyp;
|
|
OPT_InitStruct(&OPT_notyp, 10);
|
|
OPT_InitStruct(&OPT_stringtyp, 8);
|
|
OPT_InitStruct(&OPT_niltyp, 9);
|
|
OPT_EnterTyp((CHAR*)"BYTE", 1, 1, &OPT_bytetyp);
|
|
OPT_EnterTyp((CHAR*)"PTR", 11, -1, &OPT_sysptrtyp);
|
|
OPT_EnterTyp((CHAR*)"ADDRESS", 4, -1, &OPT_adrtyp);
|
|
OPT_EnterTyp((CHAR*)"INT8", 4, 1, &OPT_int8typ);
|
|
OPT_EnterTyp((CHAR*)"INT16", 4, 2, &OPT_int16typ);
|
|
OPT_EnterTyp((CHAR*)"INT32", 4, 4, &OPT_int32typ);
|
|
OPT_EnterTyp((CHAR*)"INT64", 4, 8, &OPT_int64typ);
|
|
OPT_EnterTyp((CHAR*)"SET32", 7, 4, &OPT_set32typ);
|
|
OPT_EnterTyp((CHAR*)"SET64", 7, 8, &OPT_set64typ);
|
|
OPT_EnterProc((CHAR*)"ADR", 20);
|
|
OPT_EnterProc((CHAR*)"CC", 21);
|
|
OPT_EnterProc((CHAR*)"LSH", 22);
|
|
OPT_EnterProc((CHAR*)"ROT", 23);
|
|
OPT_EnterProc((CHAR*)"GET", 24);
|
|
OPT_EnterProc((CHAR*)"PUT", 25);
|
|
OPT_EnterProc((CHAR*)"GETREG", 26);
|
|
OPT_EnterProc((CHAR*)"PUTREG", 27);
|
|
OPT_EnterProc((CHAR*)"BIT", 28);
|
|
OPT_EnterProc((CHAR*)"VAL", 29);
|
|
OPT_EnterProc((CHAR*)"NEW", 30);
|
|
OPT_EnterProc((CHAR*)"MOVE", 31);
|
|
OPT_syslink = OPT_topScope->right;
|
|
OPT_universe = OPT_topScope;
|
|
OPT_topScope->right = NIL;
|
|
OPT_EnterTyp((CHAR*)"BOOLEAN", 2, 1, &OPT_booltyp);
|
|
OPT_EnterTyp((CHAR*)"CHAR", 3, 1, &OPT_chartyp);
|
|
OPT_EnterTyp((CHAR*)"REAL", 5, 4, &OPT_realtyp);
|
|
OPT_EnterTyp((CHAR*)"LONGREAL", 6, 8, &OPT_lrltyp);
|
|
OPT_EnterTyp((CHAR*)"HUGEINT", 4, 8, &OPT_hinttyp);
|
|
OPT_EnterTyp((CHAR*)"BYTE@", 4, 1, &OPT_cpbytetyp);
|
|
OPT_EnterTypeAlias((CHAR*)"SHORTINT", &OPT_sintobj);
|
|
OPT_EnterTypeAlias((CHAR*)"INTEGER", &OPT_intobj);
|
|
OPT_EnterTypeAlias((CHAR*)"LONGINT", &OPT_lintobj);
|
|
OPT_EnterTypeAlias((CHAR*)"SET", &OPT_setobj);
|
|
OPT_EnterBoolConst((CHAR*)"FALSE", 0);
|
|
OPT_EnterBoolConst((CHAR*)"TRUE", 1);
|
|
OPT_EnterProc((CHAR*)"HALT", 0);
|
|
OPT_EnterProc((CHAR*)"NEW", 1);
|
|
OPT_EnterProc((CHAR*)"ABS", 2);
|
|
OPT_EnterProc((CHAR*)"CAP", 3);
|
|
OPT_EnterProc((CHAR*)"ORD", 4);
|
|
OPT_EnterProc((CHAR*)"ENTIER", 5);
|
|
OPT_EnterProc((CHAR*)"ODD", 6);
|
|
OPT_EnterProc((CHAR*)"MIN", 7);
|
|
OPT_EnterProc((CHAR*)"MAX", 8);
|
|
OPT_EnterProc((CHAR*)"CHR", 9);
|
|
OPT_EnterProc((CHAR*)"SHORT", 10);
|
|
OPT_EnterProc((CHAR*)"LONG", 11);
|
|
OPT_EnterProc((CHAR*)"SIZE", 12);
|
|
OPT_EnterProc((CHAR*)"INC", 13);
|
|
OPT_EnterProc((CHAR*)"DEC", 14);
|
|
OPT_EnterProc((CHAR*)"INCL", 15);
|
|
OPT_EnterProc((CHAR*)"EXCL", 16);
|
|
OPT_EnterProc((CHAR*)"LEN", 17);
|
|
OPT_EnterProc((CHAR*)"COPY", 18);
|
|
OPT_EnterProc((CHAR*)"ASH", 19);
|
|
OPT_EnterProc((CHAR*)"ASSERT", 32);
|
|
OPT_impCtxt.ref[0] = OPT_undftyp;
|
|
OPT_impCtxt.ref[1] = OPT_bytetyp;
|
|
OPT_impCtxt.ref[2] = OPT_booltyp;
|
|
OPT_impCtxt.ref[3] = OPT_chartyp;
|
|
OPT_impCtxt.ref[4] = OPT_int32typ;
|
|
OPT_impCtxt.ref[5] = OPT_realtyp;
|
|
OPT_impCtxt.ref[6] = OPT_lrltyp;
|
|
OPT_impCtxt.ref[7] = OPT_settyp;
|
|
OPT_impCtxt.ref[8] = OPT_stringtyp;
|
|
OPT_impCtxt.ref[9] = OPT_niltyp;
|
|
OPT_impCtxt.ref[10] = OPT_notyp;
|
|
OPT_impCtxt.ref[11] = OPT_sysptrtyp;
|
|
__ENDMOD;
|
|
}
|