123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601 |
- /* 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"
- #include "OPT.h"
- static INT16 OPB_exp;
- static INT64 OPB_maxExp;
- export void OPB_Assign (OPT_Node *x, OPT_Node y);
- static void OPB_BindNodes (INT8 class, OPT_Struct typ, OPT_Node *x, OPT_Node y);
- static INT16 OPB_BoolToInt (BOOLEAN b);
- export void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp);
- static void OPB_CharToString (OPT_Node n);
- static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode);
- static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo);
- export void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames);
- static void OPB_CheckProc (OPT_Struct x, OPT_Object y);
- static void OPB_CheckPtr (OPT_Node x, OPT_Node y);
- static void OPB_CheckRealType (INT16 f, INT16 nr, OPT_Const x);
- static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp);
- static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y);
- export void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y);
- static void OPB_Convert (OPT_Node *x, OPT_Struct typ);
- export void OPB_DeRef (OPT_Node *x);
- static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar);
- export OPT_Node OPB_EmptySet (void);
- export void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc);
- export void OPB_Field (OPT_Node *x, OPT_Object y);
- export void OPB_In (OPT_Node *x, OPT_Node y);
- export void OPB_Index (OPT_Node *x, OPT_Node y);
- export void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ);
- static BOOLEAN OPB_IntToBool (INT64 i);
- export void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y);
- export void OPB_MOp (INT8 op, OPT_Node *x);
- export OPT_Node OPB_NewBoolConst (BOOLEAN boolval);
- export OPT_Node OPB_NewIntConst (INT64 intval);
- export OPT_Node OPB_NewLeaf (OPT_Object obj);
- export OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ);
- export OPT_Node OPB_NewString (OPS_String str, INT64 len);
- export OPT_Node OPB_Nil (void);
- static BOOLEAN OPB_NotVar (OPT_Node x);
- export void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y);
- export void OPB_OptIf (OPT_Node *x);
- export void OPB_Param (OPT_Node ap, OPT_Object fp);
- export void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar);
- export void OPB_Return (OPT_Node *x, OPT_Object proc);
- export void OPB_SetElem (OPT_Node *x);
- static void OPB_SetIntType (OPT_Node node);
- export void OPB_SetRange (OPT_Node *x, OPT_Node y);
- static void OPB_SetSetType (OPT_Node node);
- export void OPB_StFct (OPT_Node *par0, INT8 fctno, INT16 parno);
- export void OPB_StPar0 (OPT_Node *par0, INT16 fctno);
- export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno);
- export void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n);
- export void OPB_StaticLink (INT8 dlev);
- export void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard);
- static void OPB_err (INT16 n);
- static INT64 OPB_log (INT64 x);
- static void OPB_err (INT16 n)
- {
- OPM_err(n);
- }
- OPT_Node OPB_NewLeaf (OPT_Object obj)
- {
- OPT_Node node = NIL;
- switch (obj->mode) {
- case 1:
- node = OPT_NewNode(0);
- node->readonly = (obj->vis == 2 && obj->mnolev < 0);
- break;
- case 2:
- node = OPT_NewNode(1);
- break;
- case 3:
- node = OPT_NewNode(7);
- node->conval = OPT_NewConst();
- __GUARDEQP(node->conval, OPT_ConstDesc) = *obj->conval;
- break;
- case 5:
- node = OPT_NewNode(8);
- break;
- case 6: case 7: case 8: case 9: case 10:
- node = OPT_NewNode(9);
- break;
- default:
- node = OPT_NewNode(0);
- OPB_err(127);
- break;
- }
- node->obj = obj;
- node->typ = obj->typ;
- return node;
- }
- void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y)
- {
- OPT_Node node = NIL;
- node = OPT_NewNode(class);
- node->typ = OPT_notyp;
- node->left = *x;
- node->right = y;
- *x = node;
- }
- void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y)
- {
- if (*x == NIL) {
- *x = y;
- } else {
- (*last)->link = y;
- }
- while (y->link != NIL) {
- y = y->link;
- }
- *last = y;
- }
- static INT16 OPB_BoolToInt (BOOLEAN b)
- {
- if (b) {
- return 1;
- } else {
- return 0;
- }
- __RETCHK;
- }
- static BOOLEAN OPB_IntToBool (INT64 i)
- {
- return i != 0;
- }
- OPT_Node OPB_NewBoolConst (BOOLEAN boolval)
- {
- OPT_Node x = NIL;
- x = OPT_NewNode(7);
- x->typ = OPT_booltyp;
- x->conval = OPT_NewConst();
- x->conval->intval = OPB_BoolToInt(boolval);
- return x;
- }
- void OPB_OptIf (OPT_Node *x)
- {
- OPT_Node if_ = NIL, pred = NIL;
- if_ = (*x)->left;
- while (if_->left->class == 7) {
- if (OPB_IntToBool(if_->left->conval->intval)) {
- *x = if_->right;
- return;
- } else if (if_->link == NIL) {
- *x = (*x)->right;
- return;
- } else {
- if_ = if_->link;
- (*x)->left = if_;
- }
- }
- pred = if_;
- if_ = if_->link;
- while (if_ != NIL) {
- if (if_->left->class == 7) {
- if (OPB_IntToBool(if_->left->conval->intval)) {
- pred->link = NIL;
- (*x)->right = if_->right;
- return;
- } else {
- if_ = if_->link;
- pred->link = if_;
- }
- } else {
- pred = if_;
- if_ = if_->link;
- }
- }
- }
- OPT_Node OPB_Nil (void)
- {
- OPT_Node x = NIL;
- x = OPT_NewNode(7);
- x->typ = OPT_niltyp;
- x->conval = OPT_NewConst();
- x->conval->intval = 0;
- return x;
- }
- OPT_Node OPB_EmptySet (void)
- {
- OPT_Node x = NIL;
- x = OPT_NewNode(7);
- x->typ = OPT_settyp;
- x->conval = OPT_NewConst();
- x->conval->setval = 0x0;
- return x;
- }
- static void OPB_SetIntType (OPT_Node node)
- {
- node->typ = OPT_IntType(OPT_IntSize(node->conval->intval));
- }
- static void OPB_SetSetType (OPT_Node node)
- {
- INT32 i32;
- __GET((ADDRESS)&node->conval->setval + 4, i32, INT32);
- if (i32 == 0) {
- node->typ = OPT_set32typ;
- } else {
- node->typ = OPT_set64typ;
- }
- }
- OPT_Node OPB_NewIntConst (INT64 intval)
- {
- OPT_Node x = NIL;
- x = OPT_NewNode(7);
- x->conval = OPT_NewConst();
- x->conval->intval = intval;
- OPB_SetIntType(x);
- return x;
- }
- OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ)
- {
- OPT_Node x = NIL;
- x = OPT_NewNode(7);
- x->conval = OPT_NewConst();
- x->conval->realval = realval;
- x->typ = typ;
- x->conval->intval = -1;
- return x;
- }
- OPT_Node OPB_NewString (OPS_String str, INT64 len)
- {
- OPT_Node x = NIL;
- x = OPT_NewNode(7);
- x->conval = OPT_NewConst();
- x->typ = OPT_stringtyp;
- x->conval->intval = -1;
- x->conval->intval2 = OPM_Longint(len);
- x->conval->ext = OPT_NewExt();
- __MOVE(str, *x->conval->ext, 256);
- return x;
- }
- static void OPB_CharToString (OPT_Node n)
- {
- CHAR ch;
- n->typ = OPT_stringtyp;
- ch = (CHAR)n->conval->intval;
- n->conval->ext = OPT_NewExt();
- if (ch == 0x00) {
- n->conval->intval2 = 1;
- } else {
- n->conval->intval2 = 2;
- (*n->conval->ext)[1] = 0x00;
- }
- (*n->conval->ext)[0] = ch;
- n->conval->intval = -1;
- n->obj = NIL;
- }
- static void OPB_BindNodes (INT8 class, OPT_Struct typ, OPT_Node *x, OPT_Node y)
- {
- OPT_Node node = NIL;
- node = OPT_NewNode(class);
- node->typ = typ;
- node->left = *x;
- node->right = y;
- *x = node;
- }
- static BOOLEAN OPB_NotVar (OPT_Node x)
- {
- return (x->class >= 7 && ((x->class != 11 || x->subcl != 29) || x->left->class >= 7));
- }
- void OPB_DeRef (OPT_Node *x)
- {
- OPT_Object strobj = NIL, bstrobj = NIL;
- OPT_Struct typ = NIL, btyp = NIL;
- typ = (*x)->typ;
- if ((*x)->class >= 7) {
- OPB_err(78);
- } else if (typ->form == 11) {
- if (typ == OPT_sysptrtyp) {
- OPB_err(57);
- }
- btyp = typ->BaseTyp;
- strobj = typ->strobj;
- bstrobj = btyp->strobj;
- if ((((((strobj != NIL && strobj->name[0] != 0x00)) && bstrobj != NIL)) && bstrobj->name[0] != 0x00)) {
- btyp->pbused = 1;
- }
- OPB_BindNodes(3, btyp, &*x, NIL);
- } else {
- OPB_err(84);
- }
- }
- void OPB_Index (OPT_Node *x, OPT_Node y)
- {
- INT16 f;
- OPT_Struct typ = NIL;
- f = y->typ->form;
- if ((*x)->class >= 7) {
- OPB_err(79);
- } else if (f != 4 || __IN(y->class, 0x0300, 32)) {
- OPB_err(80);
- y->typ = OPT_inttyp;
- }
- if ((*x)->typ->comp == 2) {
- typ = (*x)->typ->BaseTyp;
- if ((y->class == 7 && (y->conval->intval < 0 || y->conval->intval >= (INT64)(*x)->typ->n))) {
- OPB_err(81);
- }
- } else if ((*x)->typ->comp == 3) {
- typ = (*x)->typ->BaseTyp;
- if ((y->class == 7 && y->conval->intval < 0)) {
- OPB_err(81);
- }
- } else {
- OPB_err(82);
- typ = OPT_undftyp;
- }
- OPB_BindNodes(4, typ, &*x, y);
- (*x)->readonly = (*x)->left->readonly;
- }
- void OPB_Field (OPT_Node *x, OPT_Object y)
- {
- if ((*x)->class >= 7) {
- OPB_err(77);
- }
- if ((y != NIL && __IN(y->mode, 0x2010, 32))) {
- OPB_BindNodes(2, y->typ, &*x, NIL);
- (*x)->obj = y;
- (*x)->readonly = (*x)->left->readonly || (y->vis == 2 && y->mnolev < 0);
- } else {
- OPB_err(83);
- (*x)->typ = OPT_undftyp;
- }
- }
- static struct TypTest__58 {
- OPT_Node *x;
- OPT_Object *obj;
- BOOLEAN *guard;
- struct TypTest__58 *lnk;
- } *TypTest__58_s;
- static void GTT__59 (OPT_Struct t0, OPT_Struct t1);
- static void GTT__59 (OPT_Struct t0, OPT_Struct t1)
- {
- OPT_Node node = NIL;
- OPT_Struct t = NIL;
- t = t0;
- while ((((t != NIL && t != t1)) && t != OPT_undftyp)) {
- t = t->BaseTyp;
- }
- if (t != t1) {
- while ((((t1 != NIL && t1 != t0)) && t1 != OPT_undftyp)) {
- t1 = t1->BaseTyp;
- }
- if (t1 == t0 || t0->form == 0) {
- if (*TypTest__58_s->guard) {
- OPB_BindNodes(5, NIL, &*TypTest__58_s->x, NIL);
- (*TypTest__58_s->x)->readonly = (*TypTest__58_s->x)->left->readonly;
- } else {
- node = OPT_NewNode(11);
- node->subcl = 16;
- node->left = *TypTest__58_s->x;
- node->obj = *TypTest__58_s->obj;
- *TypTest__58_s->x = node;
- }
- } else {
- OPB_err(85);
- }
- } else if (t0 != t1) {
- OPB_err(85);
- } else if (!*TypTest__58_s->guard) {
- if ((*TypTest__58_s->x)->class == 5) {
- node = OPT_NewNode(11);
- node->subcl = 16;
- node->left = *TypTest__58_s->x;
- node->obj = *TypTest__58_s->obj;
- *TypTest__58_s->x = node;
- } else {
- *TypTest__58_s->x = OPB_NewBoolConst(1);
- }
- }
- }
- void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
- {
- struct TypTest__58 _s;
- _s.x = x;
- _s.obj = &obj;
- _s.guard = &guard;
- _s.lnk = TypTest__58_s;
- TypTest__58_s = &_s;
- if (OPB_NotVar(*x)) {
- OPB_err(112);
- } else if ((*x)->typ->form == 11) {
- if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) {
- OPB_err(85);
- } else if (obj->typ->form == 11) {
- GTT__59((*x)->typ->BaseTyp, obj->typ->BaseTyp);
- } else {
- OPB_err(86);
- }
- } else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) {
- GTT__59((*x)->typ, obj->typ);
- } else {
- OPB_err(87);
- }
- if (guard) {
- (*x)->typ = obj->typ;
- } else {
- (*x)->typ = OPT_booltyp;
- }
- TypTest__58_s = _s.lnk;
- }
- void OPB_In (OPT_Node *x, OPT_Node y)
- {
- INT16 f;
- INT64 k;
- f = (*x)->typ->form;
- if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) {
- OPB_err(126);
- } else if ((f == 4 && y->typ->form == 7)) {
- if ((*x)->class == 7) {
- k = (*x)->conval->intval;
- if (k < 0 || k >= (INT64)__ASHL(y->typ->size, 3)) {
- OPB_err(202);
- } else if (y->class == 7) {
- (*x)->conval->intval = OPB_BoolToInt(__IN(k, y->conval->setval, 64));
- (*x)->obj = NIL;
- } else {
- OPB_BindNodes(12, OPT_booltyp, &*x, y);
- (*x)->subcl = 15;
- }
- } else {
- OPB_BindNodes(12, OPT_booltyp, &*x, y);
- (*x)->subcl = 15;
- }
- } else {
- OPB_err(92);
- }
- (*x)->typ = OPT_booltyp;
- }
- static INT64 OPB_log (INT64 x)
- {
- OPB_exp = 0;
- if (x > 0) {
- while (!__ODD(x)) {
- x = __ASHR(x, 1);
- OPB_exp += 1;
- }
- }
- return x;
- }
- static void OPB_CheckRealType (INT16 f, INT16 nr, OPT_Const x)
- {
- LONGREAL min, max, r;
- if (f == 5) {
- min = OPM_MinReal;
- max = OPM_MaxReal;
- } else {
- min = OPM_MinLReal;
- max = OPM_MaxLReal;
- }
- r = __ABS(x->realval);
- if (r > max || r < min) {
- OPB_err(nr);
- x->realval = (LONGREAL)1;
- } else if (f == 5) {
- x->realval = x->realval;
- }
- x->intval = -1;
- }
- static struct MOp__28 {
- struct MOp__28 *lnk;
- } *MOp__28_s;
- static OPT_Node NewOp__29 (INT8 op, OPT_Struct typ, OPT_Node z);
- static OPT_Node NewOp__29 (INT8 op, OPT_Struct typ, OPT_Node z)
- {
- OPT_Node node = NIL;
- node = OPT_NewNode(11);
- node->subcl = op;
- node->typ = typ;
- node->left = z;
- return node;
- }
- void OPB_MOp (INT8 op, OPT_Node *x)
- {
- INT16 f;
- OPT_Struct typ = NIL;
- OPT_Node z = NIL;
- struct MOp__28 _s;
- _s.lnk = MOp__28_s;
- MOp__28_s = &_s;
- z = *x;
- if (z->class == 8 || z->class == 9) {
- OPB_err(126);
- } else {
- typ = z->typ;
- f = typ->form;
- switch (op) {
- case 33:
- if (f == 2) {
- if (z->class == 7) {
- z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval));
- z->obj = NIL;
- } else {
- z = NewOp__29(op, typ, z);
- }
- } else {
- OPB_err(98);
- }
- break;
- case 6:
- if (!__IN(f, 0x70, 32)) {
- OPB_err(96);
- }
- break;
- case 7:
- if (__IN(f, 0xf0, 32)) {
- if (z->class == 7) {
- if (f == 4) {
- if (z->conval->intval == (-9223372036854775807LL-1)) {
- OPB_err(203);
- } else {
- z->conval->intval = -z->conval->intval;
- OPB_SetIntType(z);
- }
- } else if (__IN(f, 0x60, 32)) {
- z->conval->realval = -z->conval->realval;
- } else {
- if (z->typ->size == 8) {
- z->conval->setval = ~z->conval->setval;
- } else {
- z->conval->setval = z->conval->setval ^ 0xffffffff;
- }
- }
- z->obj = NIL;
- } else {
- z = NewOp__29(op, typ, z);
- }
- } else {
- OPB_err(97);
- }
- break;
- case 21:
- if (__IN(f, 0x70, 32)) {
- if (z->class == 7) {
- if (f == 4) {
- if (z->conval->intval == (-9223372036854775807LL-1)) {
- OPB_err(203);
- } else {
- z->conval->intval = __ABS(z->conval->intval);
- OPB_SetIntType(z);
- }
- } else {
- z->conval->realval = __ABS(z->conval->realval);
- }
- z->obj = NIL;
- } else {
- z = NewOp__29(op, typ, z);
- }
- } else {
- OPB_err(111);
- }
- break;
- case 22:
- if (f == 3) {
- if (z->class == 7) {
- z->conval->intval = (INT16)__CAP((CHAR)z->conval->intval);
- z->obj = NIL;
- } else {
- z = NewOp__29(op, typ, z);
- }
- } else {
- OPB_err(111);
- z->typ = OPT_chartyp;
- }
- break;
- case 23:
- if (f == 4) {
- if (z->class == 7) {
- z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval));
- z->obj = NIL;
- } else {
- z = NewOp__29(op, typ, z);
- }
- } else {
- OPB_err(111);
- }
- z->typ = OPT_booltyp;
- break;
- case 24:
- if ((((z->class == 7 && f == 3)) && z->conval->intval >= 32)) {
- OPB_CharToString(z);
- f = 8;
- }
- if (z->class < 7 || f == 8) {
- z = NewOp__29(op, typ, z);
- } else {
- OPB_err(127);
- }
- z->typ = OPT_adrtyp;
- break;
- case 25:
- if ((f == 4 && z->class == 7)) {
- if ((0 <= z->conval->intval && z->conval->intval <= -1)) {
- z = NewOp__29(op, typ, z);
- } else {
- OPB_err(219);
- }
- } else {
- OPB_err(69);
- }
- z->typ = OPT_booltyp;
- break;
- default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.MOp, op = ", 33);
- OPM_LogWNum(op, 0);
- OPM_LogWLn();
- break;
- }
- }
- *x = z;
- MOp__28_s = _s.lnk;
- }
- static void OPB_CheckPtr (OPT_Node x, OPT_Node y)
- {
- INT16 g;
- OPT_Struct p = NIL, q = NIL, t = NIL;
- g = y->typ->form;
- if (g == 11) {
- p = x->typ->BaseTyp;
- q = y->typ->BaseTyp;
- if ((p->comp == 4 && q->comp == 4)) {
- if (p->extlev < q->extlev) {
- t = p;
- p = q;
- q = t;
- }
- while ((((p != q && p != NIL)) && p != OPT_undftyp)) {
- p = p->BaseTyp;
- }
- if (p == NIL) {
- OPB_err(100);
- }
- } else {
- OPB_err(100);
- }
- } else if (g != 9) {
- OPB_err(100);
- }
- }
- void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames)
- {
- OPT_Struct ft = NIL, at = NIL;
- while (fp != NIL) {
- if (ap != NIL) {
- ft = fp->typ;
- at = ap->typ;
- while ((ft->comp == 3 && at->comp == 3)) {
- ft = ft->BaseTyp;
- at = at->BaseTyp;
- }
- if (ft != at) {
- if ((ft->form == 12 && at->form == 12)) {
- if (ft->BaseTyp == at->BaseTyp) {
- OPB_CheckParameters(ft->link, at->link, 0);
- } else {
- OPB_err(117);
- }
- } else {
- OPB_err(115);
- }
- }
- if (fp->mode != ap->mode || (checkNames && __STRCMP(fp->name, ap->name) != 0)) {
- OPB_err(115);
- }
- ap = ap->link;
- } else {
- OPB_err(116);
- }
- fp = fp->link;
- }
- if (ap != NIL) {
- OPB_err(116);
- }
- }
- static void OPB_CheckProc (OPT_Struct x, OPT_Object y)
- {
- if (__IN(y->mode, 0x04c0, 32)) {
- if (y->mode == 6) {
- if (y->mnolev == 0) {
- y->mode = 7;
- } else {
- OPB_err(73);
- }
- }
- if (x->BaseTyp == y->typ) {
- OPB_CheckParameters(x->link, y->link, 0);
- } else {
- OPB_err(117);
- }
- } else {
- OPB_err(113);
- }
- }
- static struct ConstOp__13 {
- OPT_Node *x;
- INT16 *f;
- OPT_Const *xval, *yval;
- struct ConstOp__13 *lnk;
- } *ConstOp__13_s;
- static INT16 ConstCmp__14 (void);
- static INT16 ConstCmp__14 (void)
- {
- INT16 res;
- switch (*ConstOp__13_s->f) {
- case 0:
- res = 9;
- break;
- case 1: case 3: case 4:
- if ((*ConstOp__13_s->xval)->intval < (*ConstOp__13_s->yval)->intval) {
- res = 11;
- } else if ((*ConstOp__13_s->xval)->intval > (*ConstOp__13_s->yval)->intval) {
- res = 13;
- } else {
- res = 9;
- }
- break;
- case 5: case 6:
- if ((*ConstOp__13_s->xval)->realval < (*ConstOp__13_s->yval)->realval) {
- res = 11;
- } else if ((*ConstOp__13_s->xval)->realval > (*ConstOp__13_s->yval)->realval) {
- res = 13;
- } else {
- res = 9;
- }
- break;
- case 2:
- if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) {
- res = 10;
- } else {
- res = 9;
- }
- break;
- case 7:
- if ((*ConstOp__13_s->xval)->setval != (*ConstOp__13_s->yval)->setval) {
- res = 10;
- } else {
- res = 9;
- }
- break;
- case 8:
- if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) < 0) {
- res = 11;
- } else if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) > 0) {
- res = 13;
- } else {
- res = 9;
- }
- break;
- case 9: case 11: case 12:
- if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) {
- res = 10;
- } else {
- res = 9;
- }
- break;
- default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstCmp, f = ", 37);
- OPM_LogWNum(*ConstOp__13_s->f, 0);
- OPM_LogWLn();
- break;
- }
- (*ConstOp__13_s->x)->typ = OPT_booltyp;
- return res;
- }
- static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
- {
- INT16 f, g;
- OPT_Const xval = NIL, yval = NIL;
- INT64 xv, yv;
- BOOLEAN temp;
- struct ConstOp__13 _s;
- _s.x = &x;
- _s.f = &f;
- _s.xval = &xval;
- _s.yval = &yval;
- _s.lnk = ConstOp__13_s;
- ConstOp__13_s = &_s;
- f = x->typ->form;
- g = y->typ->form;
- xval = x->conval;
- yval = y->conval;
- if (f != g) {
- switch (f) {
- case 3:
- if (g == 8) {
- OPB_CharToString(x);
- } else {
- OPB_err(100);
- y->typ = x->typ;
- __GUARDEQP(yval, OPT_ConstDesc) = *xval;
- }
- break;
- case 4:
- if (g == 4) {
- if (x->typ->size <= y->typ->size) {
- x->typ = y->typ;
- } else {
- x->typ = OPT_IntType(x->typ->size);
- }
- } else if (g == 5) {
- x->typ = OPT_realtyp;
- xval->realval = xval->intval;
- } else if (g == 6) {
- x->typ = OPT_lrltyp;
- xval->realval = xval->intval;
- } else {
- OPB_err(100);
- y->typ = x->typ;
- __GUARDEQP(yval, OPT_ConstDesc) = *xval;
- }
- break;
- case 5:
- if (g == 4) {
- y->typ = x->typ;
- yval->realval = yval->intval;
- } else if (g == 6) {
- x->typ = OPT_lrltyp;
- } else {
- OPB_err(100);
- y->typ = x->typ;
- __GUARDEQP(yval, OPT_ConstDesc) = *xval;
- }
- break;
- case 6:
- if (g == 4) {
- y->typ = x->typ;
- yval->realval = yval->intval;
- } else if (g == 5) {
- y->typ = OPT_lrltyp;
- } else {
- OPB_err(100);
- y->typ = x->typ;
- __GUARDEQP(yval, OPT_ConstDesc) = *xval;
- }
- break;
- case 8:
- if (g == 3) {
- OPB_CharToString(y);
- g = 8;
- } else {
- OPB_err(100);
- y->typ = x->typ;
- __GUARDEQP(yval, OPT_ConstDesc) = *xval;
- }
- break;
- case 9:
- if (!__IN(g, 0x1800, 32)) {
- OPB_err(100);
- }
- break;
- case 11:
- OPB_CheckPtr(x, y);
- break;
- case 12:
- if (g != 9) {
- OPB_err(100);
- }
- break;
- default:
- OPB_err(100);
- y->typ = x->typ;
- __GUARDEQP(yval, OPT_ConstDesc) = *xval;
- break;
- }
- f = x->typ->form;
- }
- switch (op) {
- case 1:
- if (f == 4) {
- xv = xval->intval;
- yv = yval->intval;
- if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807LL, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807LL-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807LL-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807LL-1))) && yv != (-9223372036854775807LL-1))) && -xv <= __DIV(9223372036854775807LL, -yv))) {
- xval->intval = xv * yv;
- OPB_SetIntType(x);
- } else {
- OPB_err(204);
- }
- } else if (__IN(f, 0x60, 32)) {
- temp = __ABS(yval->realval) <= (LONGREAL)1;
- if (temp || __ABS(xval->realval) <= 1.79769296342094e+308 / (LONGREAL)__ABS(yval->realval)) {
- xval->realval = xval->realval * yval->realval;
- OPB_CheckRealType(f, 204, xval);
- } else {
- OPB_err(204);
- }
- } else if (f == 7) {
- xval->setval = (xval->setval & yval->setval);
- OPB_SetSetType(x);
- } else if (f != 0) {
- OPB_err(101);
- }
- break;
- case 2:
- if (f == 4) {
- if (yval->intval != 0) {
- xval->realval = xval->intval / (REAL)yval->intval;
- OPB_CheckRealType(5, 205, xval);
- } else {
- OPB_err(205);
- xval->realval = (LONGREAL)1;
- }
- x->typ = OPT_realtyp;
- } else if (__IN(f, 0x60, 32)) {
- temp = __ABS(yval->realval) >= (LONGREAL)1;
- if (temp || __ABS(xval->realval) <= 1.79769296342094e+308 * __ABS(yval->realval)) {
- xval->realval = xval->realval / yval->realval;
- OPB_CheckRealType(f, 205, xval);
- } else {
- OPB_err(205);
- }
- } else if (f == 7) {
- xval->setval = xval->setval ^ yval->setval;
- OPB_SetSetType(x);
- } else if (f != 0) {
- OPB_err(102);
- }
- break;
- case 3:
- if (f == 4) {
- if (yval->intval != 0) {
- xval->intval = __DIV(xval->intval, yval->intval);
- OPB_SetIntType(x);
- } else {
- OPB_err(205);
- }
- } else if (f != 0) {
- OPB_err(103);
- }
- break;
- case 4:
- if (f == 4) {
- if (yval->intval != 0) {
- xval->intval = __MOD(xval->intval, yval->intval);
- OPB_SetIntType(x);
- } else {
- OPB_err(205);
- }
- } else if (f != 0) {
- OPB_err(104);
- }
- break;
- case 5:
- if (f == 2) {
- xval->intval = OPB_BoolToInt((OPB_IntToBool(xval->intval) && OPB_IntToBool(yval->intval)));
- } else {
- OPB_err(94);
- }
- break;
- case 6:
- if (f == 4) {
- temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807LL - yval->intval);
- if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807LL-1) - yval->intval)) {
- xval->intval += yval->intval;
- OPB_SetIntType(x);
- } else {
- OPB_err(206);
- }
- } else if (__IN(f, 0x60, 32)) {
- temp = (yval->realval >= (LONGREAL)0 && xval->realval <= 1.79769296342094e+308 - yval->realval);
- if (temp || (yval->realval < (LONGREAL)0 && xval->realval >= -1.79769296342094e+308 - yval->realval)) {
- xval->realval = xval->realval + yval->realval;
- OPB_CheckRealType(f, 206, xval);
- } else {
- OPB_err(206);
- }
- } else if (f == 7) {
- xval->setval = xval->setval | yval->setval;
- OPB_SetSetType(x);
- } else if (f != 0) {
- OPB_err(105);
- }
- break;
- case 7:
- if (f == 4) {
- if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807LL-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807LL + yval->intval)) {
- xval->intval -= yval->intval;
- OPB_SetIntType(x);
- } else {
- OPB_err(207);
- }
- } else if (__IN(f, 0x60, 32)) {
- temp = (yval->realval >= (LONGREAL)0 && xval->realval >= -1.79769296342094e+308 + yval->realval);
- if (temp || (yval->realval < (LONGREAL)0 && xval->realval <= 1.79769296342094e+308 + yval->realval)) {
- xval->realval = xval->realval - yval->realval;
- OPB_CheckRealType(f, 207, xval);
- } else {
- OPB_err(207);
- }
- } else if (f == 7) {
- xval->setval = (xval->setval & ~yval->setval);
- OPB_SetSetType(x);
- } else if (f != 0) {
- OPB_err(106);
- }
- break;
- case 8:
- if (f == 2) {
- xval->intval = OPB_BoolToInt(OPB_IntToBool(xval->intval) || OPB_IntToBool(yval->intval));
- } else {
- OPB_err(95);
- }
- break;
- case 9:
- xval->intval = OPB_BoolToInt(ConstCmp__14() == 9);
- break;
- case 10:
- xval->intval = OPB_BoolToInt(ConstCmp__14() != 9);
- break;
- case 11:
- if (__IN(f, 0x0a84, 32)) {
- OPB_err(108);
- } else {
- xval->intval = OPB_BoolToInt(ConstCmp__14() == 11);
- }
- break;
- case 12:
- if (__IN(f, 0x0a84, 32)) {
- OPB_err(108);
- } else {
- xval->intval = OPB_BoolToInt(ConstCmp__14() != 13);
- }
- break;
- case 13:
- if (__IN(f, 0x0a84, 32)) {
- OPB_err(108);
- } else {
- xval->intval = OPB_BoolToInt(ConstCmp__14() == 13);
- }
- break;
- case 14:
- if (__IN(f, 0x0a84, 32)) {
- OPB_err(108);
- } else {
- xval->intval = OPB_BoolToInt(ConstCmp__14() != 11);
- }
- break;
- default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstOp, op = ", 37);
- OPM_LogWNum(op, 0);
- OPM_LogWLn();
- break;
- }
- ConstOp__13_s = _s.lnk;
- }
- static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
- {
- OPT_Node node = NIL;
- INT16 f, g;
- INT64 k;
- LONGREAL r;
- f = (*x)->typ->form;
- g = typ->form;
- if ((*x)->class == 7) {
- if ((((f == 7 && g == 7)) && (*x)->typ->size > typ->size)) {
- OPB_SetSetType(*x);
- if ((*x)->typ->size > typ->size) {
- OPB_err(203);
- (*x)->conval->setval = 0x0;
- }
- } else if (f == 4) {
- if (g == 4) {
- if ((*x)->typ->size > typ->size) {
- OPB_SetIntType(*x);
- if ((*x)->typ->size > typ->size) {
- OPB_err(203);
- (*x)->conval->intval = 1;
- }
- }
- } else if (__IN(g, 0x60, 32)) {
- (*x)->conval->realval = (*x)->conval->intval;
- (*x)->conval->intval = -1;
- } else {
- k = (*x)->conval->intval;
- if (0 > k || k > 255) {
- OPB_err(220);
- }
- }
- } else if (__IN(f, 0x60, 32)) {
- if (__IN(g, 0x60, 32)) {
- OPB_CheckRealType(g, 203, (*x)->conval);
- } else {
- r = (*x)->conval->realval;
- if (r < -9.22337203685478e+018 || r > 9.22337203685478e+018) {
- OPB_err(203);
- r = (LONGREAL)1;
- }
- (*x)->conval->intval = (INT32)__ENTIER(r);
- OPB_SetIntType(*x);
- }
- }
- (*x)->obj = NIL;
- } else if (((((*x)->class == 11 && (*x)->subcl == 20)) && ((INT16)(*x)->left->typ->form < f || f > g))) {
- if ((*x)->left->typ == typ) {
- *x = (*x)->left;
- }
- } else {
- node = OPT_NewNode(11);
- node->subcl = 20;
- node->left = *x;
- *x = node;
- }
- (*x)->typ = typ;
- }
- static struct Op__38 {
- INT16 *f, *g;
- struct Op__38 *lnk;
- } *Op__38_s;
- static void NewOp__39 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y);
- static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y);
- static void NewOp__39 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
- {
- OPT_Node node = NIL;
- node = OPT_NewNode(12);
- node->subcl = op;
- node->typ = typ;
- node->left = *x;
- node->right = y;
- *x = node;
- }
- static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y)
- {
- BOOLEAN ok, xCharArr, yCharArr;
- xCharArr = (__IN((*x)->typ->comp, 0x0c, 32) && (*x)->typ->BaseTyp->form == 3) || *Op__38_s->f == 8;
- yCharArr = (__IN((*y)->typ->comp, 0x0c, 32) && (*y)->typ->BaseTyp->form == 3) || *Op__38_s->g == 8;
- if ((((xCharArr && *Op__38_s->g == 3)) && (*y)->class == 7)) {
- OPB_CharToString(*y);
- *Op__38_s->g = 8;
- yCharArr = 1;
- }
- if ((((yCharArr && *Op__38_s->f == 3)) && (*x)->class == 7)) {
- OPB_CharToString(*x);
- *Op__38_s->f = 8;
- xCharArr = 1;
- }
- ok = (xCharArr && yCharArr);
- if (ok) {
- if ((*Op__38_s->f == 8 && (*x)->conval->intval2 == 1)) {
- (*x)->typ = OPT_chartyp;
- (*x)->conval->intval = 0;
- OPB_Index(&*y, OPB_NewIntConst(0));
- } else if ((*Op__38_s->g == 8 && (*y)->conval->intval2 == 1)) {
- (*y)->typ = OPT_chartyp;
- (*y)->conval->intval = 0;
- OPB_Index(&*x, OPB_NewIntConst(0));
- }
- }
- return ok;
- }
- void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
- {
- INT16 f, g;
- OPT_Node t = NIL, z = NIL;
- OPT_Struct typ = NIL;
- BOOLEAN do_;
- INT64 val;
- struct Op__38 _s;
- _s.f = &f;
- _s.g = &g;
- _s.lnk = Op__38_s;
- Op__38_s = &_s;
- z = *x;
- if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) {
- OPB_err(126);
- } else if ((z->class == 7 && y->class == 7)) {
- OPB_ConstOp(op, z, y);
- z->obj = NIL;
- } else {
- if (z->typ != y->typ) {
- g = y->typ->form;
- switch (z->typ->form) {
- case 3:
- if (z->class == 7) {
- OPB_CharToString(z);
- } else {
- OPB_err(100);
- }
- break;
- case 4:
- if ((g == 4 && y->typ->size < z->typ->size)) {
- OPB_Convert(&y, z->typ);
- } else if (__IN(g, 0x70, 32)) {
- OPB_Convert(&z, y->typ);
- } else {
- OPB_err(100);
- }
- break;
- case 7:
- if ((g == 7 && y->typ->size < z->typ->size)) {
- OPB_Convert(&y, z->typ);
- } else if (g == 7) {
- OPB_Convert(&z, y->typ);
- } else {
- OPB_err(100);
- }
- break;
- case 5:
- if (g == 4) {
- OPB_Convert(&y, z->typ);
- } else if (__IN(g, 0x60, 32)) {
- OPB_Convert(&z, y->typ);
- } else {
- OPB_err(100);
- }
- break;
- case 6:
- if (__IN(g, 0x70, 32)) {
- OPB_Convert(&y, z->typ);
- } else if (__IN(g, 0x60, 32)) {
- OPB_Convert(&y, z->typ);
- } else {
- OPB_err(100);
- }
- break;
- case 9:
- if (!__IN(g, 0x1800, 32)) {
- OPB_err(100);
- }
- break;
- case 11:
- OPB_CheckPtr(z, y);
- break;
- case 12:
- if (g != 9) {
- OPB_err(100);
- }
- break;
- case 8:
- break;
- case 13:
- if (z->typ->comp == 4) {
- OPB_err(100);
- }
- break;
- default:
- OPB_err(100);
- break;
- }
- }
- typ = z->typ;
- f = typ->form;
- g = y->typ->form;
- switch (op) {
- case 1:
- do_ = 1;
- if (f == 4) {
- if (z->class == 7) {
- val = z->conval->intval;
- if (val == 1) {
- do_ = 0;
- z = y;
- } else if (val == 0) {
- do_ = 0;
- } else if (OPB_log(val) == 1) {
- t = y;
- y = z;
- z = t;
- op = 17;
- y->typ = OPT_sinttyp;
- y->conval->intval = OPB_exp;
- y->obj = NIL;
- }
- } else if (y->class == 7) {
- val = y->conval->intval;
- if (val == 1) {
- do_ = 0;
- } else if (val == 0) {
- do_ = 0;
- z = y;
- } else if (OPB_log(val) == 1) {
- op = 17;
- y->typ = OPT_sinttyp;
- y->conval->intval = OPB_exp;
- y->obj = NIL;
- }
- }
- } else if (!__IN(f, 0xe1, 32)) {
- OPB_err(105);
- typ = OPT_undftyp;
- }
- if (do_) {
- NewOp__39(op, typ, &z, y);
- }
- break;
- case 2:
- if (f == 4) {
- if ((y->class == 7 && y->conval->intval == 0)) {
- OPB_err(205);
- }
- OPB_Convert(&z, OPT_realtyp);
- OPB_Convert(&y, OPT_realtyp);
- typ = OPT_realtyp;
- } else if (__IN(f, 0x60, 32)) {
- if ((y->class == 7 && y->conval->realval == (LONGREAL)0)) {
- OPB_err(205);
- }
- } else if ((f != 7 && f != 0)) {
- OPB_err(102);
- typ = OPT_undftyp;
- }
- NewOp__39(op, typ, &z, y);
- break;
- case 3:
- do_ = 1;
- if (f == 4) {
- if (y->class == 7) {
- val = y->conval->intval;
- if (val == 0) {
- OPB_err(205);
- } else if (val == 1) {
- do_ = 0;
- } else if (OPB_log(val) == 1) {
- op = 17;
- y->typ = OPT_sinttyp;
- y->conval->intval = -OPB_exp;
- y->obj = NIL;
- }
- }
- } else if (f != 0) {
- OPB_err(103);
- typ = OPT_undftyp;
- }
- if (do_) {
- NewOp__39(op, typ, &z, y);
- }
- break;
- case 4:
- if (f == 4) {
- if (y->class == 7) {
- if (y->conval->intval == 0) {
- OPB_err(205);
- } else if (OPB_log(y->conval->intval) == 1) {
- op = 18;
- y->conval->intval = __ASH(-1, OPB_exp);
- y->obj = NIL;
- }
- }
- } else if (f != 0) {
- OPB_err(104);
- typ = OPT_undftyp;
- }
- NewOp__39(op, typ, &z, y);
- break;
- case 5:
- if (f == 2) {
- if (z->class == 7) {
- if (OPB_IntToBool(z->conval->intval)) {
- z = y;
- }
- } else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) {
- } else {
- NewOp__39(op, typ, &z, y);
- }
- } else if (f != 0) {
- OPB_err(94);
- z->typ = OPT_undftyp;
- }
- break;
- case 6:
- if (!__IN(f, 0xf1, 32)) {
- OPB_err(105);
- typ = OPT_undftyp;
- }
- do_ = 1;
- if (f == 4) {
- if ((z->class == 7 && z->conval->intval == 0)) {
- do_ = 0;
- z = y;
- }
- if ((y->class == 7 && y->conval->intval == 0)) {
- do_ = 0;
- }
- }
- if (do_) {
- NewOp__39(op, typ, &z, y);
- }
- break;
- case 7:
- if (!__IN(f, 0xf1, 32)) {
- OPB_err(106);
- typ = OPT_undftyp;
- }
- if ((f != 4 || y->class != 7) || y->conval->intval != 0) {
- NewOp__39(op, typ, &z, y);
- }
- break;
- case 8:
- if (f == 2) {
- if (z->class == 7) {
- if (!OPB_IntToBool(z->conval->intval)) {
- z = y;
- }
- } else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) {
- } else {
- NewOp__39(op, typ, &z, y);
- }
- } else if (f != 0) {
- OPB_err(95);
- z->typ = OPT_undftyp;
- }
- break;
- case 9: case 10:
- if (__IN(f, 0x1aff, 32) || strings__41(&z, &y)) {
- typ = OPT_booltyp;
- } else {
- OPB_err(107);
- typ = OPT_undftyp;
- }
- NewOp__39(op, typ, &z, y);
- break;
- case 11: case 12: case 13: case 14:
- if (__IN(f, 0x79, 32) || strings__41(&z, &y)) {
- typ = OPT_booltyp;
- } else {
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"ELSE in Op()", 13);
- OPM_LogWLn();
- OPB_err(108);
- typ = OPT_undftyp;
- }
- NewOp__39(op, typ, &z, y);
- break;
- default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", 32);
- OPM_LogWNum(op, 0);
- OPM_LogWLn();
- break;
- }
- }
- *x = z;
- Op__38_s = _s.lnk;
- }
- void OPB_SetRange (OPT_Node *x, OPT_Node y)
- {
- INT64 k, l;
- if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) {
- OPB_err(126);
- } else if (((*x)->typ->form == 4 && y->typ->form == 4)) {
- if ((*x)->class == 7) {
- k = (*x)->conval->intval;
- if (0 > k || k > 63) {
- OPB_err(202);
- }
- }
- if (y->class == 7) {
- l = y->conval->intval;
- if (0 > l || l > 63) {
- OPB_err(202);
- }
- }
- if (((*x)->class == 7 && y->class == 7)) {
- if (k <= l) {
- (*x)->conval->setval = __SETRNG(k, l, 32);
- OPB_SetSetType(*x);
- } else {
- OPB_err(201);
- (*x)->conval->setval = __SETRNG(l, k, 32);
- }
- (*x)->obj = NIL;
- } else {
- OPB_BindNodes(10, OPT_settyp, &*x, y);
- }
- } else {
- OPB_err(93);
- }
- (*x)->typ = OPT_settyp;
- }
- void OPB_SetElem (OPT_Node *x)
- {
- INT64 k;
- if ((*x)->class == 8 || (*x)->class == 9) {
- OPB_err(126);
- } else if ((*x)->typ->form != 4) {
- OPB_err(93);
- } else if ((*x)->class == 7) {
- k = (*x)->conval->intval;
- if ((0 <= k && k <= 63)) {
- (*x)->conval->setval = 0x0;
- (*x)->conval->setval |= __SETOF(k,64);
- } else {
- OPB_err(202);
- }
- OPB_SetSetType(*x);
- (*x)->obj = NIL;
- } else {
- OPB_Convert(&*x, OPT_settyp);
- (*x)->typ = OPT_settyp;
- }
- }
- static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
- {
- OPT_Struct y = NIL;
- INT16 f, g;
- OPT_Struct p = NIL, q = NIL;
- y = ynode->typ;
- f = x->form;
- g = y->form;
- if (ynode->class == 8 || (ynode->class == 9 && f != 12)) {
- OPB_err(126);
- }
- switch (f) {
- case 0: case 8:
- break;
- case 1:
- if (!((__IN(g, 0x1a, 32) && y->size == 1))) {
- OPB_err(113);
- }
- break;
- case 2: case 3:
- if (g != f) {
- OPB_err(113);
- }
- break;
- case 4: case 7:
- if (g != f || x->size < y->size) {
- OPB_err(113);
- }
- break;
- case 5:
- if (!__IN(g, 0x30, 32)) {
- OPB_err(113);
- }
- break;
- case 6:
- if (!__IN(g, 0x70, 32)) {
- OPB_err(113);
- }
- break;
- case 11:
- if ((x == y || g == 9) || (x == OPT_sysptrtyp && g == 11)) {
- } else if (g == 11) {
- p = x->BaseTyp;
- q = y->BaseTyp;
- if ((p->comp == 4 && q->comp == 4)) {
- while ((((q != p && q != NIL)) && q != OPT_undftyp)) {
- q = q->BaseTyp;
- }
- if (q == NIL) {
- OPB_err(113);
- }
- } else {
- OPB_err(113);
- }
- } else {
- OPB_err(113);
- }
- break;
- case 12:
- if (ynode->class == 9) {
- OPB_CheckProc(x, ynode->obj);
- } else if (x == y || g == 9) {
- } else {
- OPB_err(113);
- }
- break;
- case 10: case 9:
- OPB_err(113);
- break;
- case 13:
- x->pvused = 1;
- if (x->comp == 2) {
- if ((ynode->class == 7 && g == 3)) {
- OPB_CharToString(ynode);
- y = ynode->typ;
- g = 8;
- }
- if (x == y) {
- } else if ((((y->comp == 2 && y->BaseTyp == x->BaseTyp)) && y->n <= x->n)) {
- } else if ((y->comp == 3 && y->BaseTyp == x->BaseTyp)) {
- } else if (x->BaseTyp == OPT_chartyp) {
- if (g == 8) {
- if (ynode->conval->intval2 > x->n) {
- OPB_err(114);
- }
- } else {
- OPB_err(113);
- }
- } else {
- OPB_err(113);
- }
- } else if (x->comp == 4) {
- if (x == y) {
- } else if (y->comp == 4) {
- q = y->BaseTyp;
- while ((((q != NIL && q != x)) && q != OPT_undftyp)) {
- q = q->BaseTyp;
- }
- if (q == NIL) {
- OPB_err(113);
- }
- } else {
- OPB_err(113);
- }
- } else {
- OPB_err(113);
- }
- break;
- default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.CheckAssign, f = ", 40);
- OPM_LogWNum(f, 0);
- OPM_LogWLn();
- break;
- }
- if ((((((ynode->class == 7 && g < f)) && __IN(g, 0x30, 32))) && __IN(f, 0x70, 32))) {
- OPB_Convert(&ynode, x);
- }
- }
- static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo)
- {
- }
- void OPB_StPar0 (OPT_Node *par0, INT16 fctno)
- {
- INT16 f;
- OPT_Struct typ = NIL;
- OPT_Node x = NIL;
- x = *par0;
- f = x->typ->form;
- switch (fctno) {
- case 0:
- if ((f == 4 && x->class == 7)) {
- if ((0 <= x->conval->intval && x->conval->intval <= 255)) {
- OPB_BindNodes(28, OPT_notyp, &x, x);
- } else {
- OPB_err(218);
- }
- } else {
- OPB_err(69);
- }
- x->typ = OPT_notyp;
- break;
- case 1:
- typ = OPT_notyp;
- if (OPB_NotVar(x)) {
- OPB_err(112);
- } else if (f == 11) {
- if (x->readonly) {
- OPB_err(76);
- }
- f = x->typ->BaseTyp->comp;
- if (__IN(f, 0x1c, 32)) {
- if (f == 3) {
- typ = x->typ->BaseTyp;
- }
- OPB_BindNodes(19, OPT_notyp, &x, NIL);
- x->subcl = 1;
- } else {
- OPB_err(111);
- }
- } else {
- OPB_err(111);
- }
- x->typ = typ;
- break;
- case 2:
- OPB_MOp(21, &x);
- break;
- case 3:
- OPB_MOp(22, &x);
- break;
- case 4:
- if (x->class == 8 || x->class == 9) {
- OPB_err(126);
- } else if (f == 3) {
- OPB_Convert(&x, OPT_inttyp);
- } else {
- OPB_err(111);
- }
- x->typ = OPT_inttyp;
- break;
- case 5:
- if (x->class == 8 || x->class == 9) {
- OPB_err(126);
- } else if (__IN(f, 0x60, 32)) {
- OPB_Convert(&x, OPT_linttyp);
- } else {
- OPB_err(111);
- }
- x->typ = OPT_linttyp;
- break;
- case 12:
- if (x->class == 8 || x->class == 9) {
- OPB_err(126);
- } else if (__IN(f, 0x60, 32)) {
- OPB_Convert(&x, OPT_inttyp);
- } else {
- OPB_err(111);
- }
- x->typ = OPT_inttyp;
- break;
- case 6:
- OPB_MOp(23, &x);
- break;
- case 7:
- if (x->class == 8) {
- switch (f) {
- case 2:
- x = OPB_NewBoolConst(0);
- break;
- case 3:
- x = OPB_NewIntConst(0);
- x->typ = OPT_chartyp;
- break;
- case 4:
- x = OPB_NewIntConst(OPM_SignedMinimum(x->typ->size));
- break;
- case 7:
- x = OPB_NewIntConst(0);
- x->typ = OPT_inttyp;
- break;
- case 5:
- x = OPB_NewRealConst(OPM_MinReal, OPT_realtyp);
- break;
- case 6:
- x = OPB_NewRealConst(OPM_MinLReal, OPT_lrltyp);
- break;
- default:
- OPB_err(111);
- break;
- }
- } else {
- OPB_err(110);
- }
- break;
- case 8:
- if (x->class == 8) {
- switch (f) {
- case 2:
- x = OPB_NewBoolConst(1);
- break;
- case 3:
- x = OPB_NewIntConst(255);
- x->typ = OPT_chartyp;
- break;
- case 4:
- x = OPB_NewIntConst(OPM_SignedMaximum(x->typ->size));
- break;
- case 7:
- x = OPB_NewIntConst(__ASHL(x->typ->size, 3) - 1);
- x->typ = OPT_inttyp;
- break;
- case 5:
- x = OPB_NewRealConst(OPM_MaxReal, OPT_realtyp);
- break;
- case 6:
- x = OPB_NewRealConst(OPM_MaxLReal, OPT_lrltyp);
- break;
- default:
- OPB_err(111);
- break;
- }
- } else {
- OPB_err(110);
- }
- break;
- case 9:
- if (x->class == 8 || x->class == 9) {
- OPB_err(126);
- } else if (__IN(f, 0x11, 32)) {
- OPB_Convert(&x, OPT_chartyp);
- } else {
- OPB_err(111);
- x->typ = OPT_chartyp;
- }
- break;
- case 10:
- if (x->class == 8 || x->class == 9) {
- OPB_err(126);
- } else if (f == 4) {
- typ = OPT_ShorterOrLongerType(x->typ, -1);
- if (typ == NIL) {
- OPB_err(111);
- } else {
- OPB_Convert(&x, typ);
- }
- } else if (f == 6) {
- OPB_Convert(&x, OPT_realtyp);
- } else {
- OPB_err(111);
- }
- break;
- case 11:
- if (x->class == 8 || x->class == 9) {
- OPB_err(126);
- } else if (f == 4) {
- typ = OPT_ShorterOrLongerType(x->typ, 1);
- if (typ == NIL) {
- OPB_err(111);
- } else {
- OPB_Convert(&x, typ);
- }
- } else if (f == 5) {
- OPB_Convert(&x, OPT_lrltyp);
- } else if (f == 3) {
- OPB_Convert(&x, OPT_linttyp);
- } else {
- OPB_err(111);
- }
- break;
- case 14: case 15:
- if (OPB_NotVar(x)) {
- OPB_err(112);
- } else if (f != 4) {
- OPB_err(111);
- } else if (x->readonly) {
- OPB_err(76);
- }
- break;
- case 16: case 17:
- if (OPB_NotVar(x)) {
- OPB_err(112);
- } else if (x->typ->form != 7) {
- OPB_err(111);
- x->typ = OPT_settyp;
- } else if (x->readonly) {
- OPB_err(76);
- }
- break;
- case 18:
- if (!__IN(x->typ->comp, 0x0c, 32)) {
- OPB_err(131);
- }
- break;
- case 19:
- if ((x->class == 7 && f == 3)) {
- OPB_CharToString(x);
- f = 8;
- }
- if (x->class == 8 || x->class == 9) {
- OPB_err(126);
- } else if (((!__IN(x->typ->comp, 0x0c, 32) || x->typ->BaseTyp->form != 3) && f != 8)) {
- OPB_err(111);
- }
- break;
- case 20:
- if (x->class == 8 || x->class == 9) {
- OPB_err(126);
- } else if (f == 4) {
- if (x->typ->size < OPT_linttyp->size) {
- OPB_Convert(&x, OPT_linttyp);
- }
- } else {
- OPB_err(111);
- x->typ = OPT_linttyp;
- }
- break;
- case 21:
- OPB_CheckLeaf(x, 0);
- OPB_MOp(24, &x);
- break;
- case 13:
- if (x->class != 8) {
- OPB_err(110);
- x = OPB_NewIntConst(1);
- } else if (__IN(f, 0x18fe, 32) || __IN(x->typ->comp, 0x14, 32)) {
- OPT_TypSize(x->typ);
- x->typ->pvused = 1;
- x = OPB_NewIntConst(x->typ->size);
- } else {
- OPB_err(111);
- x = OPB_NewIntConst(1);
- }
- break;
- case 22:
- OPB_MOp(25, &x);
- break;
- case 23: case 24:
- if (x->class == 8 || x->class == 9) {
- OPB_err(126);
- } else if (!__IN(f, 0x9a, 32)) {
- OPB_err(111);
- }
- break;
- case 25: case 26: case 29: case 32:
- if (x->class == 8 || x->class == 9) {
- OPB_err(126);
- } else if ((((x->class == 7 && f == 4)) && x->typ->size < OPT_adrtyp->size)) {
- OPB_Convert(&x, OPT_adrtyp);
- } else if (!((__IN(x->typ->form, 0x0810, 32) && x->typ->size == OPM_AddressSize))) {
- OPB_err(111);
- x->typ = OPT_adrtyp;
- }
- break;
- case 27: case 28:
- if ((f == 4 && x->class == 7)) {
- if (x->conval->intval < 0 || x->conval->intval > -1) {
- OPB_err(220);
- }
- } else {
- OPB_err(69);
- }
- break;
- case 30:
- if (x->class != 8) {
- OPB_err(110);
- } else if (__IN(f, 0x0501, 32) || x->typ->comp == 3) {
- OPB_err(111);
- }
- break;
- case 31:
- if (OPB_NotVar(x)) {
- OPB_err(112);
- } else if (f == 11) {
- } else {
- OPB_err(111);
- }
- break;
- case 33:
- if (x->class == 8 || x->class == 9) {
- OPB_err(126);
- x = OPB_NewBoolConst(0);
- } else if (f != 2) {
- OPB_err(120);
- x = OPB_NewBoolConst(0);
- } else {
- OPB_MOp(33, &x);
- }
- break;
- default:
- OPM_LogWStr((CHAR*)"unhandled case in OPB.StPar0, fctno = ", 39);
- OPM_LogWNum(fctno, 0);
- OPM_LogWLn();
- break;
- }
- *par0 = x;
- }
- static struct StPar1__53 {
- struct StPar1__53 *lnk;
- } *StPar1__53_s;
- static OPT_Node NewOp__54 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right);
- static OPT_Node NewOp__54 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right)
- {
- OPT_Node node = NIL;
- node = OPT_NewNode(class);
- node->subcl = subcl;
- node->left = left;
- node->right = right;
- return node;
- }
- void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
- {
- INT16 f, L;
- OPT_Struct typ = NIL;
- OPT_Node p = NIL, t = NIL;
- struct StPar1__53 _s;
- _s.lnk = StPar1__53_s;
- StPar1__53_s = &_s;
- p = *par0;
- f = x->typ->form;
- switch (fctno) {
- case 14: case 15:
- if (x->class == 8 || x->class == 9) {
- OPB_err(126);
- p->typ = OPT_notyp;
- } else {
- if (x->typ != p->typ) {
- if ((f == 4 && (x->class == 7 || (p->typ->form == 4 && x->typ->size <= p->typ->size)))) {
- OPB_Convert(&x, p->typ);
- } else {
- OPB_err(111);
- }
- }
- p = NewOp__54(19, fctno, p, x);
- p->typ = OPT_notyp;
- }
- break;
- case 16: case 17:
- if (x->class == 8 || x->class == 9) {
- OPB_err(126);
- } else if (f == 4) {
- if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval >= (INT64)__ASHL(p->typ->size, 3)))) {
- OPB_err(202);
- }
- p = NewOp__54(19, fctno, p, x);
- } else {
- OPB_err(111);
- }
- p->typ = OPT_notyp;
- break;
- case 18:
- if (!(f == 4) || x->class != 7) {
- OPB_err(69);
- } else if (x->typ->size == 1) {
- L = OPM_Integer(x->conval->intval);
- typ = p->typ;
- while ((L > 0 && __IN(typ->comp, 0x0c, 32))) {
- typ = typ->BaseTyp;
- L -= 1;
- }
- if (L != 0 || !__IN(typ->comp, 0x0c, 32)) {
- OPB_err(132);
- } else {
- x->obj = NIL;
- if (typ->comp == 3) {
- while (p->class == 4) {
- p = p->left;
- x->conval->intval += 1;
- }
- p = NewOp__54(12, 19, p, x);
- p->typ = OPT_linttyp;
- } else {
- p = x;
- p->conval->intval = typ->n;
- OPB_SetIntType(p);
- }
- }
- } else {
- OPB_err(132);
- }
- break;
- case 19:
- if (OPB_NotVar(x)) {
- OPB_err(112);
- } else if ((__IN(x->typ->comp, 0x0c, 32) && x->typ->BaseTyp->form == 3)) {
- if (x->readonly) {
- OPB_err(76);
- }
- t = x;
- x = p;
- p = t;
- p = NewOp__54(19, 19, p, x);
- } else {
- OPB_err(111);
- }
- p->typ = OPT_notyp;
- break;
- case 20:
- if (x->class == 8 || x->class == 9) {
- OPB_err(126);
- } else if (f == 4) {
- if ((p->class == 7 && x->class == 7)) {
- if (-OPB_maxExp > x->conval->intval || x->conval->intval > OPB_maxExp) {
- OPB_err(208);
- p->conval->intval = 1;
- } else if (x->conval->intval >= 0) {
- if (__ABS(p->conval->intval) <= __DIV(9223372036854775807LL, (INT64)__ASH(1, x->conval->intval))) {
- p->conval->intval = p->conval->intval * (INT64)__ASH(1, x->conval->intval);
- } else {
- OPB_err(208);
- p->conval->intval = 1;
- }
- } else {
- p->conval->intval = __ASH(p->conval->intval, x->conval->intval);
- }
- p->obj = NIL;
- } else {
- p = NewOp__54(12, 17, p, x);
- p->typ = p->left->typ;
- }
- } else {
- OPB_err(111);
- }
- break;
- case 1:
- if (x->class == 8 || x->class == 9) {
- OPB_err(126);
- } else if (p->typ->comp == 3) {
- if (f == 4) {
- if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) {
- OPB_err(63);
- }
- } else {
- OPB_err(111);
- }
- p->right = x;
- p->typ = p->typ->BaseTyp;
- } else {
- OPB_err(64);
- }
- break;
- case 23: case 24:
- if (x->class == 8 || x->class == 9) {
- OPB_err(126);
- } else if (f != 4) {
- OPB_err(111);
- } else {
- if (fctno == 23) {
- p = NewOp__54(12, 27, p, x);
- } else {
- p = NewOp__54(12, 28, p, x);
- }
- p->typ = p->left->typ;
- }
- break;
- case 25: case 26: case 27: case 28:
- if (x->class == 8 || x->class == 9) {
- OPB_err(126);
- } else if (__IN(f, 0x18ff, 32)) {
- if (fctno == 25 || fctno == 27) {
- if (OPB_NotVar(x)) {
- OPB_err(112);
- }
- t = x;
- x = p;
- p = t;
- }
- p = NewOp__54(19, fctno, p, x);
- } else {
- OPB_err(111);
- }
- p->typ = OPT_notyp;
- break;
- case 29:
- if (x->class == 8 || x->class == 9) {
- OPB_err(126);
- } else if (f == 4) {
- p = NewOp__54(12, 26, p, x);
- } else {
- OPB_err(111);
- }
- p->typ = OPT_booltyp;
- break;
- case 30:
- if (((x->class == 8 || x->class == 9) || __IN(f, 0x0501, 32)) || x->typ->comp == 3) {
- OPB_err(126);
- }
- OPT_TypSize(x->typ);
- OPT_TypSize(p->typ);
- if ((x->class != 7 && x->typ->size < p->typ->size)) {
- OPB_err(-308);
- }
- if ((((x->class == 7 && x->typ->form == 4)) && p->typ->form == 4)) {
- OPB_Convert(&x, p->typ);
- } else {
- t = OPT_NewNode(11);
- t->subcl = 29;
- t->left = x;
- x = t;
- x->typ = p->typ;
- }
- p = x;
- break;
- case 31:
- if (x->class == 8 || x->class == 9) {
- OPB_err(126);
- } else if (f == 4) {
- p = NewOp__54(19, 31, p, x);
- } else {
- OPB_err(111);
- }
- p->typ = OPT_notyp;
- break;
- case 32:
- if (x->class == 8 || x->class == 9) {
- OPB_err(126);
- } else if ((((x->class == 7 && f == 4)) && x->typ->size < OPT_adrtyp->size)) {
- OPB_Convert(&x, OPT_adrtyp);
- } else if (!((__IN(x->typ->form, 0x0810, 32) && x->typ->size == OPM_AddressSize))) {
- OPB_err(111);
- x->typ = OPT_adrtyp;
- }
- p->link = x;
- break;
- case 33:
- if ((f == 4 && x->class == 7)) {
- if ((0 <= x->conval->intval && x->conval->intval <= 255)) {
- OPB_BindNodes(28, OPT_notyp, &x, x);
- x->conval = OPT_NewConst();
- x->conval->intval = OPM_errpos;
- OPB_Construct(15, &p, x);
- p->conval = OPT_NewConst();
- p->conval->intval = OPM_errpos;
- OPB_Construct(20, &p, NIL);
- OPB_OptIf(&p);
- if (p == NIL) {
- } else if (p->class == 28) {
- OPB_err(99);
- } else {
- p->subcl = 33;
- }
- } else {
- OPB_err(218);
- }
- } else {
- OPB_err(69);
- }
- break;
- default:
- OPB_err(64);
- break;
- }
- *par0 = p;
- StPar1__53_s = _s.lnk;
- }
- void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n)
- {
- OPT_Node node = NIL;
- INT16 f;
- OPT_Node p = NIL;
- p = *par0;
- f = x->typ->form;
- if (fctno == 1) {
- if (x->class == 8 || x->class == 9) {
- OPB_err(126);
- } else if (p->typ->comp != 3) {
- OPB_err(64);
- } else if (f == 4) {
- if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) {
- OPB_err(63);
- }
- node = p->right;
- while (node->link != NIL) {
- node = node->link;
- }
- node->link = x;
- p->typ = p->typ->BaseTyp;
- } else {
- OPB_err(111);
- }
- } else if ((fctno == 32 && n == 2)) {
- if (x->class == 8 || x->class == 9) {
- OPB_err(126);
- } else if (f == 4) {
- node = OPT_NewNode(19);
- node->subcl = 32;
- node->right = p;
- node->left = p->link;
- p->link = x;
- p = node;
- } else {
- OPB_err(111);
- }
- p->typ = OPT_notyp;
- } else {
- OPB_err(64);
- }
- *par0 = p;
- }
- void OPB_StFct (OPT_Node *par0, INT8 fctno, INT16 parno)
- {
- INT16 dim;
- OPT_Node x = NIL, p = NIL;
- p = *par0;
- if (fctno <= 20) {
- if ((fctno == 1 && p->typ != OPT_notyp)) {
- if (p->typ->comp == 3) {
- OPB_err(65);
- }
- p->typ = OPT_notyp;
- } else if (fctno <= 13) {
- if (parno < 1) {
- OPB_err(65);
- }
- } else {
- if (((fctno == 14 || fctno == 15) && parno == 1)) {
- OPB_BindNodes(19, OPT_notyp, &p, OPB_NewIntConst(1));
- p->subcl = fctno;
- p->right->typ = p->left->typ;
- } else if ((fctno == 18 && parno == 1)) {
- if (p->typ->comp == 3) {
- dim = 0;
- while (p->class == 4) {
- p = p->left;
- dim += 1;
- }
- OPB_BindNodes(12, OPT_linttyp, &p, OPB_NewIntConst(dim));
- p->subcl = 19;
- } else {
- p = OPB_NewIntConst(p->typ->n);
- }
- } else if (parno < 2) {
- OPB_err(65);
- }
- }
- } else if (fctno == 33) {
- if (parno == 1) {
- x = NIL;
- OPB_BindNodes(28, OPT_notyp, &x, OPB_NewIntConst(0));
- x->conval = OPT_NewConst();
- x->conval->intval = OPM_errpos;
- OPB_Construct(15, &p, x);
- p->conval = OPT_NewConst();
- p->conval->intval = OPM_errpos;
- OPB_Construct(20, &p, NIL);
- OPB_OptIf(&p);
- if (p == NIL) {
- } else if (p->class == 28) {
- OPB_err(99);
- } else {
- p->subcl = 33;
- }
- } else if (parno < 1) {
- OPB_err(65);
- }
- } else {
- if ((parno < 1 || (fctno > 22 && parno < 2)) || (fctno == 32 && parno < 3)) {
- OPB_err(65);
- }
- }
- *par0 = p;
- }
- static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar)
- {
- INT16 f;
- f = atyp->comp;
- ftyp = ftyp->BaseTyp;
- atyp = atyp->BaseTyp;
- if ((fvarpar && ftyp == OPT_bytetyp)) {
- if (!__IN(f, 0x0c, 32) || !((__IN(atyp->form, 0x1e, 32) && atyp->size == 1))) {
- if (__IN(18, OPM_Options, 32)) {
- OPB_err(-301);
- }
- }
- } else if (__IN(f, 0x0c, 32)) {
- if (ftyp->comp == 3) {
- OPB_DynArrParCheck(ftyp, atyp, fvarpar);
- } else if (ftyp != atyp) {
- if ((((!fvarpar && ftyp->form == 11)) && atyp->form == 11)) {
- ftyp = ftyp->BaseTyp;
- atyp = atyp->BaseTyp;
- if ((ftyp->comp == 4 && atyp->comp == 4)) {
- while ((((ftyp != atyp && atyp != NIL)) && atyp != OPT_undftyp)) {
- atyp = atyp->BaseTyp;
- }
- if (atyp == NIL) {
- OPB_err(113);
- }
- } else {
- OPB_err(66);
- }
- } else {
- OPB_err(66);
- }
- }
- } else {
- OPB_err(67);
- }
- }
- static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp)
- {
- if (fp->typ->form == 11) {
- if ((*x)->class == 3) {
- *x = (*x)->left;
- } else {
- OPB_err(71);
- }
- }
- }
- void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar)
- {
- if (((*x)->obj != NIL && __IN((*x)->obj->mode, 0x22c0, 32))) {
- *fpar = (*x)->obj->link;
- if ((*x)->obj->mode == 13) {
- OPB_CheckReceiver(&(*x)->left, *fpar);
- *fpar = (*fpar)->link;
- }
- } else if (((((*x)->class != 8 && (*x)->typ != NIL)) && (*x)->typ->form == 12)) {
- *fpar = (*x)->typ->link;
- } else {
- OPB_err(121);
- *fpar = NIL;
- (*x)->typ = OPT_undftyp;
- }
- }
- void OPB_Param (OPT_Node ap, OPT_Object fp)
- {
- OPT_Struct q = NIL;
- if (fp->typ->form != 0) {
- if (fp->mode == 2) {
- if (OPB_NotVar(ap)) {
- OPB_err(122);
- } else {
- OPB_CheckLeaf(ap, 0);
- }
- if (ap->readonly) {
- OPB_err(76);
- }
- if (fp->typ->comp == 3) {
- OPB_DynArrParCheck(fp->typ, ap->typ, 1);
- } else if ((fp->typ->comp == 4 && ap->typ->comp == 4)) {
- q = ap->typ;
- while ((((q != fp->typ && q != NIL)) && q != OPT_undftyp)) {
- q = q->BaseTyp;
- }
- if (q == NIL) {
- OPB_err(111);
- }
- } else if ((fp->typ == OPT_sysptrtyp && ap->typ->form == 11)) {
- } else if ((ap->typ != fp->typ && !((((fp->typ->form == 1 && __IN(ap->typ->form, 0x1e, 32))) && ap->typ->size == 1)))) {
- OPB_err(123);
- } else if ((fp->typ->form == 11 && ap->class == 5)) {
- OPB_err(123);
- }
- } else if (fp->typ->comp == 3) {
- if ((ap->class == 7 && ap->typ->form == 3)) {
- OPB_CharToString(ap);
- }
- if ((ap->typ->form == 8 && fp->typ->BaseTyp->form == 3)) {
- } else if (ap->class >= 7) {
- OPB_err(59);
- } else {
- OPB_DynArrParCheck(fp->typ, ap->typ, 0);
- }
- } else {
- OPB_CheckAssign(fp->typ, ap);
- }
- }
- }
- void OPB_StaticLink (INT8 dlev)
- {
- OPT_Object scope = NIL;
- scope = OPT_topScope;
- while (dlev > 0) {
- dlev -= 1;
- scope->link->conval->setval |= __SETOF(3,64);
- scope = scope->left;
- }
- }
- void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp)
- {
- OPT_Struct typ = NIL;
- OPT_Node p = NIL;
- INT8 lev;
- if ((*x)->class == 9) {
- typ = (*x)->typ;
- lev = (*x)->obj->mnolev;
- if (lev > 0) {
- OPB_StaticLink(OPT_topScope->mnolev - lev);
- }
- if ((*x)->obj->mode == 10) {
- OPB_err(121);
- }
- } else if (((*x)->class == 2 && (*x)->obj->mode == 13)) {
- typ = (*x)->typ;
- (*x)->class = 9;
- p = (*x)->left;
- (*x)->left = NIL;
- p->link = apar;
- apar = p;
- fp = (*x)->obj->link;
- } else {
- typ = (*x)->typ->BaseTyp;
- }
- OPB_BindNodes(13, typ, &*x, apar);
- (*x)->obj = fp;
- }
- void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc)
- {
- OPT_Node x = NIL;
- x = OPT_NewNode(18);
- x->typ = OPT_notyp;
- x->obj = proc;
- x->left = *procdec;
- x->right = stat;
- *procdec = x;
- }
- void OPB_Return (OPT_Node *x, OPT_Object proc)
- {
- OPT_Node node = NIL;
- if (proc == NIL) {
- if (*x != NIL) {
- OPB_err(124);
- }
- } else {
- if (*x != NIL) {
- OPB_CheckAssign(proc->typ, *x);
- } else if (proc->typ != OPT_notyp) {
- OPB_err(124);
- }
- }
- node = OPT_NewNode(26);
- node->typ = OPT_notyp;
- node->obj = proc;
- node->left = *x;
- *x = node;
- }
- void OPB_Assign (OPT_Node *x, OPT_Node y)
- {
- OPT_Node z = NIL;
- if ((*x)->class >= 7) {
- OPB_err(56);
- }
- OPB_CheckAssign((*x)->typ, y);
- if ((*x)->readonly) {
- OPB_err(76);
- }
- if ((*x)->typ->comp == 4) {
- if ((*x)->class == 5) {
- z = (*x)->left;
- } else {
- z = *x;
- }
- if ((z->class == 3 && z->left->class == 5)) {
- z->left = z->left->left;
- }
- if (((*x)->typ->strobj != NIL && (z->class == 3 || z->class == 1))) {
- OPB_BindNodes(6, (*x)->typ, &z, NIL);
- *x = z;
- }
- } else if (((((((*x)->typ->comp == 2 && (*x)->typ->BaseTyp == OPT_chartyp)) && y->typ->form == 8)) && y->conval->intval2 == 1)) {
- y->typ = OPT_chartyp;
- y->conval->intval = 0;
- OPB_Index(&*x, OPB_NewIntConst(0));
- }
- OPB_BindNodes(19, OPT_notyp, &*x, y);
- (*x)->subcl = 0;
- }
- void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ)
- {
- OPT_Node node = NIL;
- node = OPT_NewNode(14);
- node->typ = typ;
- node->conval = OPT_NewConst();
- node->conval->intval = typ->txtpos;
- if (*inittd == NIL) {
- *inittd = node;
- } else {
- (*last)->link = node;
- }
- *last = node;
- }
- export void *OPB__init(void)
- {
- __DEFMOD;
- __MODULE_IMPORT(OPM);
- __MODULE_IMPORT(OPS);
- __MODULE_IMPORT(OPT);
- __REGMOD("OPB", 0);
- /* BEGIN */
- OPB_maxExp = OPB_log(4611686018427387904LL);
- OPB_maxExp = OPB_exp;
- __ENDMOD;
- }
|