123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163 |
- /* voc 2.1.0 [2017/07/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
- #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_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);
- 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) + (INT16)__ASHL(offset - off0, 8);
- } 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);
- 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, 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;
- 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;
- 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) {
- 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 = (INT16)OPM_SymRInt();
- 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;
- tag = OPT_impCtxt.nextTag;
- 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) {
- 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 = (INT16)OPM_SymRInt();
- (*ext)[0] = (CHAR)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();
- break;
- }
- } else if (tag == 20) {
- obj->mode = 5;
- OPT_InStruct(&obj->typ);
- } else {
- obj->mode = 1;
- if (tag == 22) {
- obj->vis = 2;
- }
- OPT_InStruct(&obj->typ);
- }
- OPT_InName((void*)obj->name, 256);
- }
- 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((CHAR)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_OutObj (OPT_Object obj)
- {
- INT16 i, j;
- OPT_ConstExt ext = NIL;
- if (obj != NIL) {
- OPT_OutObj(obj->left);
- if (__IN(obj->mode, 0x06ea, 32)) {
- 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, 3140, 1, P);
- P(OPT_Links);
- }
- __TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 32), {0, -8}};
- __TDESC(OPT_ObjDesc, 1, 6) = {__TDFLDS("ObjDesc", 304), {0, 4, 8, 12, 284, 288, -28}};
- __TDESC(OPT_StrDesc, 1, 3) = {__TDFLDS("StrDesc", 56), {44, 48, 52, -16}};
- __TDESC(OPT_NodeDesc, 1, 6) = {__TDFLDS("NodeDesc", 28), {0, 4, 8, 16, 20, 24, -28}};
- __TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 3140), {16, 20, 24, 28, 32, 36, 40, 44, 48, 52, 56, 60, 64, 68, 72, 76,
- 80, 84, 88, 92, 96, 100, 104, 108, 112, 116, 120, 124, 128, 132, 136, 140,
- 144, 148, 152, 156, 160, 164, 168, 172, 176, 180, 184, 188, 192, 196, 200, 204,
- 208, 212, 216, 220, 224, 228, 232, 236, 240, 244, 248, 252, 256, 260, 264, 268,
- 272, 276, 280, 284, 288, 292, 296, 300, 304, 308, 312, 316, 320, 324, 328, 332,
- 336, 340, 344, 348, 352, 356, 360, 364, 368, 372, 376, 380, 384, 388, 392, 396,
- 400, 404, 408, 412, 416, 420, 424, 428, 432, 436, 440, 444, 448, 452, 456, 460,
- 464, 468, 472, 476, 480, 484, 488, 492, 496, 500, 504, 508, 512, 516, 520, 524,
- 528, 532, 536, 540, 544, 548, 552, 556, 560, 564, 568, 572, 576, 580, 584, 588,
- 592, 596, 600, 604, 608, 612, 616, 620, 624, 628, 632, 636, 640, 644, 648, 652,
- 656, 660, 664, 668, 672, 676, 680, 684, 688, 692, 696, 700, 704, 708, 712, 716,
- 720, 724, 728, 732, 736, 740, 744, 748, 752, 756, 760, 764, 768, 772, 776, 780,
- 784, 788, 792, 796, 800, 804, 808, 812, 816, 820, 824, 828, 832, 836, 840, 844,
- 848, 852, 856, 860, 864, 868, 872, 876, 880, 884, 888, 892, 896, 900, 904, 908,
- 912, 916, 920, 924, 928, 932, 936, 940, 944, 948, 952, 956, 960, 964, 968, 972,
- 976, 980, 984, 988, 992, 996, 1000, 1004, 1008, 1012, 1016, 1020, 1024, 1028, 1032, 1036,
- 1040, 1044, 1048, 1052, 1056, 1060, 1064, 1068, 1072, 1076, 1080, 1084, 1088, 1092, 1096, 1100,
- 1104, 1108, 1112, 1116, 1120, 1124, 1128, 1132, 1136, 1140, 1144, 1148, 1152, 1156, 1160, 1164,
- 1168, 1172, 1176, 1180, 1184, 1188, 1192, 1196, 1200, 1204, 1208, 1212, 1216, 1220, 1224, 1228,
- 1232, 1236, 1240, 1244, 1248, 1252, 1256, 1260, 1264, 1268, 1272, 1276, 1280, 1284, 1288, 1292,
- 1296, 1300, 1304, 1308, 1312, 1316, 1320, 1324, 1328, 1332, 1336, 1340, 1344, 1348, 1352, 1356,
- 1360, 1364, 1368, 1372, 1376, 1380, 1384, 1388, 1392, 1396, 1400, 1404, 1408, 1412, 1416, 1420,
- 1424, 1428, 1432, 1436, 1440, 1444, 1448, 1452, 1456, 1460, 1464, 1468, 1472, 1476, 1480, 1484,
- 1488, 1492, 1496, 1500, 1504, 1508, 1512, 1516, 1520, 1524, 1528, 1532, 1536, 1540, 1544, 1548,
- 1552, 1556, 1560, 1564, 1568, 1572, 1576, 1580, 1584, 1588, 1592, 1596, 1600, 1604, 1608, 1612,
- 1616, 1620, 1624, 1628, 1632, 1636, 1640, 1644, 1648, 1652, 1656, 1660, 1664, 1668, 1672, 1676,
- 1680, 1684, 1688, 1692, 1696, 1700, 1704, 1708, 1712, 1716, 1720, 1724, 1728, 1732, 1736, 1740,
- 1744, 1748, 1752, 1756, 1760, 1764, 1768, 1772, 1776, 1780, 1784, 1788, 1792, 1796, 1800, 1804,
- 1808, 1812, 1816, 1820, 1824, 1828, 1832, 1836, 1840, 1844, 1848, 1852, 1856, 1860, 1864, 1868,
- 1872, 1876, 1880, 1884, 1888, 1892, 1896, 1900, 1904, 1908, 1912, 1916, 1920, 1924, 1928, 1932,
- 1936, 1940, 1944, 1948, 1952, 1956, 1960, 1964, 1968, 1972, 1976, 1980, 1984, 1988, 1992, 1996,
- 2000, 2004, 2008, 2012, 2016, 2020, 2024, 2028, 2032, 2036, 2040, 2044, 2048, 2052, -2044}};
- __TDESC(OPT_ExpCtxt, 1, 0) = {__TDFLDS("ExpCtxt", 72), {-4}};
- __TDESC(OPT_LinkDesc, 1, 1) = {__TDFLDS("LinkDesc", 260), {256, -8}};
- 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", 21);
- OPT_EnterProc((CHAR*)"CC", 22);
- OPT_EnterProc((CHAR*)"LSH", 23);
- OPT_EnterProc((CHAR*)"ROT", 24);
- OPT_EnterProc((CHAR*)"GET", 25);
- OPT_EnterProc((CHAR*)"PUT", 26);
- OPT_EnterProc((CHAR*)"GETREG", 27);
- OPT_EnterProc((CHAR*)"PUTREG", 28);
- OPT_EnterProc((CHAR*)"BIT", 29);
- OPT_EnterProc((CHAR*)"VAL", 30);
- OPT_EnterProc((CHAR*)"NEW", 31);
- OPT_EnterProc((CHAR*)"MOVE", 32);
- 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*)"FLOOR", 12);
- 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", 13);
- OPT_EnterProc((CHAR*)"INC", 14);
- OPT_EnterProc((CHAR*)"DEC", 15);
- OPT_EnterProc((CHAR*)"INCL", 16);
- OPT_EnterProc((CHAR*)"EXCL", 17);
- OPT_EnterProc((CHAR*)"LEN", 18);
- OPT_EnterProc((CHAR*)"COPY", 19);
- OPT_EnterProc((CHAR*)"ASH", 20);
- OPT_EnterProc((CHAR*)"ASSERT", 33);
- 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;
- }
|