OPB.c 57 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601
  1. /* voc 2.1.0 [2017/07/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
  2. #define SHORTINT INT8
  3. #define INTEGER INT16
  4. #define LONGINT INT32
  5. #define SET UINT32
  6. #include "SYSTEM.h"
  7. #include "OPM.h"
  8. #include "OPS.h"
  9. #include "OPT.h"
  10. static INT16 OPB_exp;
  11. static INT64 OPB_maxExp;
  12. export void OPB_Assign (OPT_Node *x, OPT_Node y);
  13. static void OPB_BindNodes (INT8 class, OPT_Struct typ, OPT_Node *x, OPT_Node y);
  14. static INT16 OPB_BoolToInt (BOOLEAN b);
  15. export void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp);
  16. static void OPB_CharToString (OPT_Node n);
  17. static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode);
  18. static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo);
  19. export void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames);
  20. static void OPB_CheckProc (OPT_Struct x, OPT_Object y);
  21. static void OPB_CheckPtr (OPT_Node x, OPT_Node y);
  22. static void OPB_CheckRealType (INT16 f, INT16 nr, OPT_Const x);
  23. static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp);
  24. static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y);
  25. export void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y);
  26. static void OPB_Convert (OPT_Node *x, OPT_Struct typ);
  27. export void OPB_DeRef (OPT_Node *x);
  28. static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar);
  29. export OPT_Node OPB_EmptySet (void);
  30. export void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc);
  31. export void OPB_Field (OPT_Node *x, OPT_Object y);
  32. export void OPB_In (OPT_Node *x, OPT_Node y);
  33. export void OPB_Index (OPT_Node *x, OPT_Node y);
  34. export void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ);
  35. static BOOLEAN OPB_IntToBool (INT64 i);
  36. export void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y);
  37. export void OPB_MOp (INT8 op, OPT_Node *x);
  38. export OPT_Node OPB_NewBoolConst (BOOLEAN boolval);
  39. export OPT_Node OPB_NewIntConst (INT64 intval);
  40. export OPT_Node OPB_NewLeaf (OPT_Object obj);
  41. export OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ);
  42. export OPT_Node OPB_NewString (OPS_String str, INT64 len);
  43. export OPT_Node OPB_Nil (void);
  44. static BOOLEAN OPB_NotVar (OPT_Node x);
  45. export void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y);
  46. export void OPB_OptIf (OPT_Node *x);
  47. export void OPB_Param (OPT_Node ap, OPT_Object fp);
  48. export void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar);
  49. export void OPB_Return (OPT_Node *x, OPT_Object proc);
  50. export void OPB_SetElem (OPT_Node *x);
  51. static void OPB_SetIntType (OPT_Node node);
  52. export void OPB_SetRange (OPT_Node *x, OPT_Node y);
  53. static void OPB_SetSetType (OPT_Node node);
  54. export void OPB_StFct (OPT_Node *par0, INT8 fctno, INT16 parno);
  55. export void OPB_StPar0 (OPT_Node *par0, INT16 fctno);
  56. export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno);
  57. export void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n);
  58. export void OPB_StaticLink (INT8 dlev);
  59. export void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard);
  60. static void OPB_err (INT16 n);
  61. static INT64 OPB_log (INT64 x);
  62. static void OPB_err (INT16 n)
  63. {
  64. OPM_err(n);
  65. }
  66. OPT_Node OPB_NewLeaf (OPT_Object obj)
  67. {
  68. OPT_Node node = NIL;
  69. switch (obj->mode) {
  70. case 1:
  71. node = OPT_NewNode(0);
  72. node->readonly = (obj->vis == 2 && obj->mnolev < 0);
  73. break;
  74. case 2:
  75. node = OPT_NewNode(1);
  76. break;
  77. case 3:
  78. node = OPT_NewNode(7);
  79. node->conval = OPT_NewConst();
  80. __GUARDEQP(node->conval, OPT_ConstDesc) = *obj->conval;
  81. break;
  82. case 5:
  83. node = OPT_NewNode(8);
  84. break;
  85. case 6: case 7: case 8: case 9: case 10:
  86. node = OPT_NewNode(9);
  87. break;
  88. default:
  89. node = OPT_NewNode(0);
  90. OPB_err(127);
  91. break;
  92. }
  93. node->obj = obj;
  94. node->typ = obj->typ;
  95. return node;
  96. }
  97. void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y)
  98. {
  99. OPT_Node node = NIL;
  100. node = OPT_NewNode(class);
  101. node->typ = OPT_notyp;
  102. node->left = *x;
  103. node->right = y;
  104. *x = node;
  105. }
  106. void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y)
  107. {
  108. if (*x == NIL) {
  109. *x = y;
  110. } else {
  111. (*last)->link = y;
  112. }
  113. while (y->link != NIL) {
  114. y = y->link;
  115. }
  116. *last = y;
  117. }
  118. static INT16 OPB_BoolToInt (BOOLEAN b)
  119. {
  120. if (b) {
  121. return 1;
  122. } else {
  123. return 0;
  124. }
  125. __RETCHK;
  126. }
  127. static BOOLEAN OPB_IntToBool (INT64 i)
  128. {
  129. return i != 0;
  130. }
  131. OPT_Node OPB_NewBoolConst (BOOLEAN boolval)
  132. {
  133. OPT_Node x = NIL;
  134. x = OPT_NewNode(7);
  135. x->typ = OPT_booltyp;
  136. x->conval = OPT_NewConst();
  137. x->conval->intval = OPB_BoolToInt(boolval);
  138. return x;
  139. }
  140. void OPB_OptIf (OPT_Node *x)
  141. {
  142. OPT_Node if_ = NIL, pred = NIL;
  143. if_ = (*x)->left;
  144. while (if_->left->class == 7) {
  145. if (OPB_IntToBool(if_->left->conval->intval)) {
  146. *x = if_->right;
  147. return;
  148. } else if (if_->link == NIL) {
  149. *x = (*x)->right;
  150. return;
  151. } else {
  152. if_ = if_->link;
  153. (*x)->left = if_;
  154. }
  155. }
  156. pred = if_;
  157. if_ = if_->link;
  158. while (if_ != NIL) {
  159. if (if_->left->class == 7) {
  160. if (OPB_IntToBool(if_->left->conval->intval)) {
  161. pred->link = NIL;
  162. (*x)->right = if_->right;
  163. return;
  164. } else {
  165. if_ = if_->link;
  166. pred->link = if_;
  167. }
  168. } else {
  169. pred = if_;
  170. if_ = if_->link;
  171. }
  172. }
  173. }
  174. OPT_Node OPB_Nil (void)
  175. {
  176. OPT_Node x = NIL;
  177. x = OPT_NewNode(7);
  178. x->typ = OPT_niltyp;
  179. x->conval = OPT_NewConst();
  180. x->conval->intval = 0;
  181. return x;
  182. }
  183. OPT_Node OPB_EmptySet (void)
  184. {
  185. OPT_Node x = NIL;
  186. x = OPT_NewNode(7);
  187. x->typ = OPT_settyp;
  188. x->conval = OPT_NewConst();
  189. x->conval->setval = 0x0;
  190. return x;
  191. }
  192. static void OPB_SetIntType (OPT_Node node)
  193. {
  194. node->typ = OPT_IntType(OPT_IntSize(node->conval->intval));
  195. }
  196. static void OPB_SetSetType (OPT_Node node)
  197. {
  198. INT32 i32;
  199. __GET((ADDRESS)&node->conval->setval + 4, i32, INT32);
  200. if (i32 == 0) {
  201. node->typ = OPT_set32typ;
  202. } else {
  203. node->typ = OPT_set64typ;
  204. }
  205. }
  206. OPT_Node OPB_NewIntConst (INT64 intval)
  207. {
  208. OPT_Node x = NIL;
  209. x = OPT_NewNode(7);
  210. x->conval = OPT_NewConst();
  211. x->conval->intval = intval;
  212. OPB_SetIntType(x);
  213. return x;
  214. }
  215. OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ)
  216. {
  217. OPT_Node x = NIL;
  218. x = OPT_NewNode(7);
  219. x->conval = OPT_NewConst();
  220. x->conval->realval = realval;
  221. x->typ = typ;
  222. x->conval->intval = -1;
  223. return x;
  224. }
  225. OPT_Node OPB_NewString (OPS_String str, INT64 len)
  226. {
  227. OPT_Node x = NIL;
  228. x = OPT_NewNode(7);
  229. x->conval = OPT_NewConst();
  230. x->typ = OPT_stringtyp;
  231. x->conval->intval = -1;
  232. x->conval->intval2 = OPM_Longint(len);
  233. x->conval->ext = OPT_NewExt();
  234. __MOVE(str, *x->conval->ext, 256);
  235. return x;
  236. }
  237. static void OPB_CharToString (OPT_Node n)
  238. {
  239. CHAR ch;
  240. n->typ = OPT_stringtyp;
  241. ch = (CHAR)n->conval->intval;
  242. n->conval->ext = OPT_NewExt();
  243. if (ch == 0x00) {
  244. n->conval->intval2 = 1;
  245. } else {
  246. n->conval->intval2 = 2;
  247. (*n->conval->ext)[1] = 0x00;
  248. }
  249. (*n->conval->ext)[0] = ch;
  250. n->conval->intval = -1;
  251. n->obj = NIL;
  252. }
  253. static void OPB_BindNodes (INT8 class, OPT_Struct typ, OPT_Node *x, OPT_Node y)
  254. {
  255. OPT_Node node = NIL;
  256. node = OPT_NewNode(class);
  257. node->typ = typ;
  258. node->left = *x;
  259. node->right = y;
  260. *x = node;
  261. }
  262. static BOOLEAN OPB_NotVar (OPT_Node x)
  263. {
  264. return (x->class >= 7 && ((x->class != 11 || x->subcl != 29) || x->left->class >= 7));
  265. }
  266. void OPB_DeRef (OPT_Node *x)
  267. {
  268. OPT_Object strobj = NIL, bstrobj = NIL;
  269. OPT_Struct typ = NIL, btyp = NIL;
  270. typ = (*x)->typ;
  271. if ((*x)->class >= 7) {
  272. OPB_err(78);
  273. } else if (typ->form == 11) {
  274. if (typ == OPT_sysptrtyp) {
  275. OPB_err(57);
  276. }
  277. btyp = typ->BaseTyp;
  278. strobj = typ->strobj;
  279. bstrobj = btyp->strobj;
  280. if ((((((strobj != NIL && strobj->name[0] != 0x00)) && bstrobj != NIL)) && bstrobj->name[0] != 0x00)) {
  281. btyp->pbused = 1;
  282. }
  283. OPB_BindNodes(3, btyp, &*x, NIL);
  284. } else {
  285. OPB_err(84);
  286. }
  287. }
  288. void OPB_Index (OPT_Node *x, OPT_Node y)
  289. {
  290. INT16 f;
  291. OPT_Struct typ = NIL;
  292. f = y->typ->form;
  293. if ((*x)->class >= 7) {
  294. OPB_err(79);
  295. } else if (f != 4 || __IN(y->class, 0x0300, 32)) {
  296. OPB_err(80);
  297. y->typ = OPT_inttyp;
  298. }
  299. if ((*x)->typ->comp == 2) {
  300. typ = (*x)->typ->BaseTyp;
  301. if ((y->class == 7 && (y->conval->intval < 0 || y->conval->intval >= (INT64)(*x)->typ->n))) {
  302. OPB_err(81);
  303. }
  304. } else if ((*x)->typ->comp == 3) {
  305. typ = (*x)->typ->BaseTyp;
  306. if ((y->class == 7 && y->conval->intval < 0)) {
  307. OPB_err(81);
  308. }
  309. } else {
  310. OPB_err(82);
  311. typ = OPT_undftyp;
  312. }
  313. OPB_BindNodes(4, typ, &*x, y);
  314. (*x)->readonly = (*x)->left->readonly;
  315. }
  316. void OPB_Field (OPT_Node *x, OPT_Object y)
  317. {
  318. if ((*x)->class >= 7) {
  319. OPB_err(77);
  320. }
  321. if ((y != NIL && __IN(y->mode, 0x2010, 32))) {
  322. OPB_BindNodes(2, y->typ, &*x, NIL);
  323. (*x)->obj = y;
  324. (*x)->readonly = (*x)->left->readonly || (y->vis == 2 && y->mnolev < 0);
  325. } else {
  326. OPB_err(83);
  327. (*x)->typ = OPT_undftyp;
  328. }
  329. }
  330. static struct TypTest__58 {
  331. OPT_Node *x;
  332. OPT_Object *obj;
  333. BOOLEAN *guard;
  334. struct TypTest__58 *lnk;
  335. } *TypTest__58_s;
  336. static void GTT__59 (OPT_Struct t0, OPT_Struct t1);
  337. static void GTT__59 (OPT_Struct t0, OPT_Struct t1)
  338. {
  339. OPT_Node node = NIL;
  340. OPT_Struct t = NIL;
  341. t = t0;
  342. while ((((t != NIL && t != t1)) && t != OPT_undftyp)) {
  343. t = t->BaseTyp;
  344. }
  345. if (t != t1) {
  346. while ((((t1 != NIL && t1 != t0)) && t1 != OPT_undftyp)) {
  347. t1 = t1->BaseTyp;
  348. }
  349. if (t1 == t0 || t0->form == 0) {
  350. if (*TypTest__58_s->guard) {
  351. OPB_BindNodes(5, NIL, &*TypTest__58_s->x, NIL);
  352. (*TypTest__58_s->x)->readonly = (*TypTest__58_s->x)->left->readonly;
  353. } else {
  354. node = OPT_NewNode(11);
  355. node->subcl = 16;
  356. node->left = *TypTest__58_s->x;
  357. node->obj = *TypTest__58_s->obj;
  358. *TypTest__58_s->x = node;
  359. }
  360. } else {
  361. OPB_err(85);
  362. }
  363. } else if (t0 != t1) {
  364. OPB_err(85);
  365. } else if (!*TypTest__58_s->guard) {
  366. if ((*TypTest__58_s->x)->class == 5) {
  367. node = OPT_NewNode(11);
  368. node->subcl = 16;
  369. node->left = *TypTest__58_s->x;
  370. node->obj = *TypTest__58_s->obj;
  371. *TypTest__58_s->x = node;
  372. } else {
  373. *TypTest__58_s->x = OPB_NewBoolConst(1);
  374. }
  375. }
  376. }
  377. void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
  378. {
  379. struct TypTest__58 _s;
  380. _s.x = x;
  381. _s.obj = &obj;
  382. _s.guard = &guard;
  383. _s.lnk = TypTest__58_s;
  384. TypTest__58_s = &_s;
  385. if (OPB_NotVar(*x)) {
  386. OPB_err(112);
  387. } else if ((*x)->typ->form == 11) {
  388. if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) {
  389. OPB_err(85);
  390. } else if (obj->typ->form == 11) {
  391. GTT__59((*x)->typ->BaseTyp, obj->typ->BaseTyp);
  392. } else {
  393. OPB_err(86);
  394. }
  395. } else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) {
  396. GTT__59((*x)->typ, obj->typ);
  397. } else {
  398. OPB_err(87);
  399. }
  400. if (guard) {
  401. (*x)->typ = obj->typ;
  402. } else {
  403. (*x)->typ = OPT_booltyp;
  404. }
  405. TypTest__58_s = _s.lnk;
  406. }
  407. void OPB_In (OPT_Node *x, OPT_Node y)
  408. {
  409. INT16 f;
  410. INT64 k;
  411. f = (*x)->typ->form;
  412. if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) {
  413. OPB_err(126);
  414. } else if ((f == 4 && y->typ->form == 7)) {
  415. if ((*x)->class == 7) {
  416. k = (*x)->conval->intval;
  417. if (k < 0 || k >= (INT64)__ASHL(y->typ->size, 3)) {
  418. OPB_err(202);
  419. } else if (y->class == 7) {
  420. (*x)->conval->intval = OPB_BoolToInt(__IN(k, y->conval->setval, 64));
  421. (*x)->obj = NIL;
  422. } else {
  423. OPB_BindNodes(12, OPT_booltyp, &*x, y);
  424. (*x)->subcl = 15;
  425. }
  426. } else {
  427. OPB_BindNodes(12, OPT_booltyp, &*x, y);
  428. (*x)->subcl = 15;
  429. }
  430. } else {
  431. OPB_err(92);
  432. }
  433. (*x)->typ = OPT_booltyp;
  434. }
  435. static INT64 OPB_log (INT64 x)
  436. {
  437. OPB_exp = 0;
  438. if (x > 0) {
  439. while (!__ODD(x)) {
  440. x = __ASHR(x, 1);
  441. OPB_exp += 1;
  442. }
  443. }
  444. return x;
  445. }
  446. static void OPB_CheckRealType (INT16 f, INT16 nr, OPT_Const x)
  447. {
  448. LONGREAL min, max, r;
  449. if (f == 5) {
  450. min = OPM_MinReal;
  451. max = OPM_MaxReal;
  452. } else {
  453. min = OPM_MinLReal;
  454. max = OPM_MaxLReal;
  455. }
  456. r = __ABS(x->realval);
  457. if (r > max || r < min) {
  458. OPB_err(nr);
  459. x->realval = (LONGREAL)1;
  460. } else if (f == 5) {
  461. x->realval = x->realval;
  462. }
  463. x->intval = -1;
  464. }
  465. static struct MOp__28 {
  466. struct MOp__28 *lnk;
  467. } *MOp__28_s;
  468. static OPT_Node NewOp__29 (INT8 op, OPT_Struct typ, OPT_Node z);
  469. static OPT_Node NewOp__29 (INT8 op, OPT_Struct typ, OPT_Node z)
  470. {
  471. OPT_Node node = NIL;
  472. node = OPT_NewNode(11);
  473. node->subcl = op;
  474. node->typ = typ;
  475. node->left = z;
  476. return node;
  477. }
  478. void OPB_MOp (INT8 op, OPT_Node *x)
  479. {
  480. INT16 f;
  481. OPT_Struct typ = NIL;
  482. OPT_Node z = NIL;
  483. struct MOp__28 _s;
  484. _s.lnk = MOp__28_s;
  485. MOp__28_s = &_s;
  486. z = *x;
  487. if (z->class == 8 || z->class == 9) {
  488. OPB_err(126);
  489. } else {
  490. typ = z->typ;
  491. f = typ->form;
  492. switch (op) {
  493. case 33:
  494. if (f == 2) {
  495. if (z->class == 7) {
  496. z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval));
  497. z->obj = NIL;
  498. } else {
  499. z = NewOp__29(op, typ, z);
  500. }
  501. } else {
  502. OPB_err(98);
  503. }
  504. break;
  505. case 6:
  506. if (!__IN(f, 0x70, 32)) {
  507. OPB_err(96);
  508. }
  509. break;
  510. case 7:
  511. if (__IN(f, 0xf0, 32)) {
  512. if (z->class == 7) {
  513. if (f == 4) {
  514. if (z->conval->intval == (-9223372036854775807LL-1)) {
  515. OPB_err(203);
  516. } else {
  517. z->conval->intval = -z->conval->intval;
  518. OPB_SetIntType(z);
  519. }
  520. } else if (__IN(f, 0x60, 32)) {
  521. z->conval->realval = -z->conval->realval;
  522. } else {
  523. if (z->typ->size == 8) {
  524. z->conval->setval = ~z->conval->setval;
  525. } else {
  526. z->conval->setval = z->conval->setval ^ 0xffffffff;
  527. }
  528. }
  529. z->obj = NIL;
  530. } else {
  531. z = NewOp__29(op, typ, z);
  532. }
  533. } else {
  534. OPB_err(97);
  535. }
  536. break;
  537. case 21:
  538. if (__IN(f, 0x70, 32)) {
  539. if (z->class == 7) {
  540. if (f == 4) {
  541. if (z->conval->intval == (-9223372036854775807LL-1)) {
  542. OPB_err(203);
  543. } else {
  544. z->conval->intval = __ABS(z->conval->intval);
  545. OPB_SetIntType(z);
  546. }
  547. } else {
  548. z->conval->realval = __ABS(z->conval->realval);
  549. }
  550. z->obj = NIL;
  551. } else {
  552. z = NewOp__29(op, typ, z);
  553. }
  554. } else {
  555. OPB_err(111);
  556. }
  557. break;
  558. case 22:
  559. if (f == 3) {
  560. if (z->class == 7) {
  561. z->conval->intval = (INT16)__CAP((CHAR)z->conval->intval);
  562. z->obj = NIL;
  563. } else {
  564. z = NewOp__29(op, typ, z);
  565. }
  566. } else {
  567. OPB_err(111);
  568. z->typ = OPT_chartyp;
  569. }
  570. break;
  571. case 23:
  572. if (f == 4) {
  573. if (z->class == 7) {
  574. z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval));
  575. z->obj = NIL;
  576. } else {
  577. z = NewOp__29(op, typ, z);
  578. }
  579. } else {
  580. OPB_err(111);
  581. }
  582. z->typ = OPT_booltyp;
  583. break;
  584. case 24:
  585. if ((((z->class == 7 && f == 3)) && z->conval->intval >= 32)) {
  586. OPB_CharToString(z);
  587. f = 8;
  588. }
  589. if (z->class < 7 || f == 8) {
  590. z = NewOp__29(op, typ, z);
  591. } else {
  592. OPB_err(127);
  593. }
  594. z->typ = OPT_adrtyp;
  595. break;
  596. case 25:
  597. if ((f == 4 && z->class == 7)) {
  598. if ((0 <= z->conval->intval && z->conval->intval <= -1)) {
  599. z = NewOp__29(op, typ, z);
  600. } else {
  601. OPB_err(219);
  602. }
  603. } else {
  604. OPB_err(69);
  605. }
  606. z->typ = OPT_booltyp;
  607. break;
  608. default:
  609. OPM_LogWStr((CHAR*)"unhandled case in OPB.MOp, op = ", 33);
  610. OPM_LogWNum(op, 0);
  611. OPM_LogWLn();
  612. break;
  613. }
  614. }
  615. *x = z;
  616. MOp__28_s = _s.lnk;
  617. }
  618. static void OPB_CheckPtr (OPT_Node x, OPT_Node y)
  619. {
  620. INT16 g;
  621. OPT_Struct p = NIL, q = NIL, t = NIL;
  622. g = y->typ->form;
  623. if (g == 11) {
  624. p = x->typ->BaseTyp;
  625. q = y->typ->BaseTyp;
  626. if ((p->comp == 4 && q->comp == 4)) {
  627. if (p->extlev < q->extlev) {
  628. t = p;
  629. p = q;
  630. q = t;
  631. }
  632. while ((((p != q && p != NIL)) && p != OPT_undftyp)) {
  633. p = p->BaseTyp;
  634. }
  635. if (p == NIL) {
  636. OPB_err(100);
  637. }
  638. } else {
  639. OPB_err(100);
  640. }
  641. } else if (g != 9) {
  642. OPB_err(100);
  643. }
  644. }
  645. void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames)
  646. {
  647. OPT_Struct ft = NIL, at = NIL;
  648. while (fp != NIL) {
  649. if (ap != NIL) {
  650. ft = fp->typ;
  651. at = ap->typ;
  652. while ((ft->comp == 3 && at->comp == 3)) {
  653. ft = ft->BaseTyp;
  654. at = at->BaseTyp;
  655. }
  656. if (ft != at) {
  657. if ((ft->form == 12 && at->form == 12)) {
  658. if (ft->BaseTyp == at->BaseTyp) {
  659. OPB_CheckParameters(ft->link, at->link, 0);
  660. } else {
  661. OPB_err(117);
  662. }
  663. } else {
  664. OPB_err(115);
  665. }
  666. }
  667. if (fp->mode != ap->mode || (checkNames && __STRCMP(fp->name, ap->name) != 0)) {
  668. OPB_err(115);
  669. }
  670. ap = ap->link;
  671. } else {
  672. OPB_err(116);
  673. }
  674. fp = fp->link;
  675. }
  676. if (ap != NIL) {
  677. OPB_err(116);
  678. }
  679. }
  680. static void OPB_CheckProc (OPT_Struct x, OPT_Object y)
  681. {
  682. if (__IN(y->mode, 0x04c0, 32)) {
  683. if (y->mode == 6) {
  684. if (y->mnolev == 0) {
  685. y->mode = 7;
  686. } else {
  687. OPB_err(73);
  688. }
  689. }
  690. if (x->BaseTyp == y->typ) {
  691. OPB_CheckParameters(x->link, y->link, 0);
  692. } else {
  693. OPB_err(117);
  694. }
  695. } else {
  696. OPB_err(113);
  697. }
  698. }
  699. static struct ConstOp__13 {
  700. OPT_Node *x;
  701. INT16 *f;
  702. OPT_Const *xval, *yval;
  703. struct ConstOp__13 *lnk;
  704. } *ConstOp__13_s;
  705. static INT16 ConstCmp__14 (void);
  706. static INT16 ConstCmp__14 (void)
  707. {
  708. INT16 res;
  709. switch (*ConstOp__13_s->f) {
  710. case 0:
  711. res = 9;
  712. break;
  713. case 1: case 3: case 4:
  714. if ((*ConstOp__13_s->xval)->intval < (*ConstOp__13_s->yval)->intval) {
  715. res = 11;
  716. } else if ((*ConstOp__13_s->xval)->intval > (*ConstOp__13_s->yval)->intval) {
  717. res = 13;
  718. } else {
  719. res = 9;
  720. }
  721. break;
  722. case 5: case 6:
  723. if ((*ConstOp__13_s->xval)->realval < (*ConstOp__13_s->yval)->realval) {
  724. res = 11;
  725. } else if ((*ConstOp__13_s->xval)->realval > (*ConstOp__13_s->yval)->realval) {
  726. res = 13;
  727. } else {
  728. res = 9;
  729. }
  730. break;
  731. case 2:
  732. if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) {
  733. res = 10;
  734. } else {
  735. res = 9;
  736. }
  737. break;
  738. case 7:
  739. if ((*ConstOp__13_s->xval)->setval != (*ConstOp__13_s->yval)->setval) {
  740. res = 10;
  741. } else {
  742. res = 9;
  743. }
  744. break;
  745. case 8:
  746. if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) < 0) {
  747. res = 11;
  748. } else if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) > 0) {
  749. res = 13;
  750. } else {
  751. res = 9;
  752. }
  753. break;
  754. case 9: case 11: case 12:
  755. if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) {
  756. res = 10;
  757. } else {
  758. res = 9;
  759. }
  760. break;
  761. default:
  762. OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstCmp, f = ", 37);
  763. OPM_LogWNum(*ConstOp__13_s->f, 0);
  764. OPM_LogWLn();
  765. break;
  766. }
  767. (*ConstOp__13_s->x)->typ = OPT_booltyp;
  768. return res;
  769. }
  770. static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
  771. {
  772. INT16 f, g;
  773. OPT_Const xval = NIL, yval = NIL;
  774. INT64 xv, yv;
  775. BOOLEAN temp;
  776. struct ConstOp__13 _s;
  777. _s.x = &x;
  778. _s.f = &f;
  779. _s.xval = &xval;
  780. _s.yval = &yval;
  781. _s.lnk = ConstOp__13_s;
  782. ConstOp__13_s = &_s;
  783. f = x->typ->form;
  784. g = y->typ->form;
  785. xval = x->conval;
  786. yval = y->conval;
  787. if (f != g) {
  788. switch (f) {
  789. case 3:
  790. if (g == 8) {
  791. OPB_CharToString(x);
  792. } else {
  793. OPB_err(100);
  794. y->typ = x->typ;
  795. __GUARDEQP(yval, OPT_ConstDesc) = *xval;
  796. }
  797. break;
  798. case 4:
  799. if (g == 4) {
  800. if (x->typ->size <= y->typ->size) {
  801. x->typ = y->typ;
  802. } else {
  803. x->typ = OPT_IntType(x->typ->size);
  804. }
  805. } else if (g == 5) {
  806. x->typ = OPT_realtyp;
  807. xval->realval = xval->intval;
  808. } else if (g == 6) {
  809. x->typ = OPT_lrltyp;
  810. xval->realval = xval->intval;
  811. } else {
  812. OPB_err(100);
  813. y->typ = x->typ;
  814. __GUARDEQP(yval, OPT_ConstDesc) = *xval;
  815. }
  816. break;
  817. case 5:
  818. if (g == 4) {
  819. y->typ = x->typ;
  820. yval->realval = yval->intval;
  821. } else if (g == 6) {
  822. x->typ = OPT_lrltyp;
  823. } else {
  824. OPB_err(100);
  825. y->typ = x->typ;
  826. __GUARDEQP(yval, OPT_ConstDesc) = *xval;
  827. }
  828. break;
  829. case 6:
  830. if (g == 4) {
  831. y->typ = x->typ;
  832. yval->realval = yval->intval;
  833. } else if (g == 5) {
  834. y->typ = OPT_lrltyp;
  835. } else {
  836. OPB_err(100);
  837. y->typ = x->typ;
  838. __GUARDEQP(yval, OPT_ConstDesc) = *xval;
  839. }
  840. break;
  841. case 8:
  842. if (g == 3) {
  843. OPB_CharToString(y);
  844. g = 8;
  845. } else {
  846. OPB_err(100);
  847. y->typ = x->typ;
  848. __GUARDEQP(yval, OPT_ConstDesc) = *xval;
  849. }
  850. break;
  851. case 9:
  852. if (!__IN(g, 0x1800, 32)) {
  853. OPB_err(100);
  854. }
  855. break;
  856. case 11:
  857. OPB_CheckPtr(x, y);
  858. break;
  859. case 12:
  860. if (g != 9) {
  861. OPB_err(100);
  862. }
  863. break;
  864. default:
  865. OPB_err(100);
  866. y->typ = x->typ;
  867. __GUARDEQP(yval, OPT_ConstDesc) = *xval;
  868. break;
  869. }
  870. f = x->typ->form;
  871. }
  872. switch (op) {
  873. case 1:
  874. if (f == 4) {
  875. xv = xval->intval;
  876. yv = yval->intval;
  877. 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))) {
  878. xval->intval = xv * yv;
  879. OPB_SetIntType(x);
  880. } else {
  881. OPB_err(204);
  882. }
  883. } else if (__IN(f, 0x60, 32)) {
  884. temp = __ABS(yval->realval) <= (LONGREAL)1;
  885. if (temp || __ABS(xval->realval) <= 1.79769296342094e+308 / (LONGREAL)__ABS(yval->realval)) {
  886. xval->realval = xval->realval * yval->realval;
  887. OPB_CheckRealType(f, 204, xval);
  888. } else {
  889. OPB_err(204);
  890. }
  891. } else if (f == 7) {
  892. xval->setval = (xval->setval & yval->setval);
  893. OPB_SetSetType(x);
  894. } else if (f != 0) {
  895. OPB_err(101);
  896. }
  897. break;
  898. case 2:
  899. if (f == 4) {
  900. if (yval->intval != 0) {
  901. xval->realval = xval->intval / (REAL)yval->intval;
  902. OPB_CheckRealType(5, 205, xval);
  903. } else {
  904. OPB_err(205);
  905. xval->realval = (LONGREAL)1;
  906. }
  907. x->typ = OPT_realtyp;
  908. } else if (__IN(f, 0x60, 32)) {
  909. temp = __ABS(yval->realval) >= (LONGREAL)1;
  910. if (temp || __ABS(xval->realval) <= 1.79769296342094e+308 * __ABS(yval->realval)) {
  911. xval->realval = xval->realval / yval->realval;
  912. OPB_CheckRealType(f, 205, xval);
  913. } else {
  914. OPB_err(205);
  915. }
  916. } else if (f == 7) {
  917. xval->setval = xval->setval ^ yval->setval;
  918. OPB_SetSetType(x);
  919. } else if (f != 0) {
  920. OPB_err(102);
  921. }
  922. break;
  923. case 3:
  924. if (f == 4) {
  925. if (yval->intval != 0) {
  926. xval->intval = __DIV(xval->intval, yval->intval);
  927. OPB_SetIntType(x);
  928. } else {
  929. OPB_err(205);
  930. }
  931. } else if (f != 0) {
  932. OPB_err(103);
  933. }
  934. break;
  935. case 4:
  936. if (f == 4) {
  937. if (yval->intval != 0) {
  938. xval->intval = __MOD(xval->intval, yval->intval);
  939. OPB_SetIntType(x);
  940. } else {
  941. OPB_err(205);
  942. }
  943. } else if (f != 0) {
  944. OPB_err(104);
  945. }
  946. break;
  947. case 5:
  948. if (f == 2) {
  949. xval->intval = OPB_BoolToInt((OPB_IntToBool(xval->intval) && OPB_IntToBool(yval->intval)));
  950. } else {
  951. OPB_err(94);
  952. }
  953. break;
  954. case 6:
  955. if (f == 4) {
  956. temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807LL - yval->intval);
  957. if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807LL-1) - yval->intval)) {
  958. xval->intval += yval->intval;
  959. OPB_SetIntType(x);
  960. } else {
  961. OPB_err(206);
  962. }
  963. } else if (__IN(f, 0x60, 32)) {
  964. temp = (yval->realval >= (LONGREAL)0 && xval->realval <= 1.79769296342094e+308 - yval->realval);
  965. if (temp || (yval->realval < (LONGREAL)0 && xval->realval >= -1.79769296342094e+308 - yval->realval)) {
  966. xval->realval = xval->realval + yval->realval;
  967. OPB_CheckRealType(f, 206, xval);
  968. } else {
  969. OPB_err(206);
  970. }
  971. } else if (f == 7) {
  972. xval->setval = xval->setval | yval->setval;
  973. OPB_SetSetType(x);
  974. } else if (f != 0) {
  975. OPB_err(105);
  976. }
  977. break;
  978. case 7:
  979. if (f == 4) {
  980. if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807LL-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807LL + yval->intval)) {
  981. xval->intval -= yval->intval;
  982. OPB_SetIntType(x);
  983. } else {
  984. OPB_err(207);
  985. }
  986. } else if (__IN(f, 0x60, 32)) {
  987. temp = (yval->realval >= (LONGREAL)0 && xval->realval >= -1.79769296342094e+308 + yval->realval);
  988. if (temp || (yval->realval < (LONGREAL)0 && xval->realval <= 1.79769296342094e+308 + yval->realval)) {
  989. xval->realval = xval->realval - yval->realval;
  990. OPB_CheckRealType(f, 207, xval);
  991. } else {
  992. OPB_err(207);
  993. }
  994. } else if (f == 7) {
  995. xval->setval = (xval->setval & ~yval->setval);
  996. OPB_SetSetType(x);
  997. } else if (f != 0) {
  998. OPB_err(106);
  999. }
  1000. break;
  1001. case 8:
  1002. if (f == 2) {
  1003. xval->intval = OPB_BoolToInt(OPB_IntToBool(xval->intval) || OPB_IntToBool(yval->intval));
  1004. } else {
  1005. OPB_err(95);
  1006. }
  1007. break;
  1008. case 9:
  1009. xval->intval = OPB_BoolToInt(ConstCmp__14() == 9);
  1010. break;
  1011. case 10:
  1012. xval->intval = OPB_BoolToInt(ConstCmp__14() != 9);
  1013. break;
  1014. case 11:
  1015. if (__IN(f, 0x0a84, 32)) {
  1016. OPB_err(108);
  1017. } else {
  1018. xval->intval = OPB_BoolToInt(ConstCmp__14() == 11);
  1019. }
  1020. break;
  1021. case 12:
  1022. if (__IN(f, 0x0a84, 32)) {
  1023. OPB_err(108);
  1024. } else {
  1025. xval->intval = OPB_BoolToInt(ConstCmp__14() != 13);
  1026. }
  1027. break;
  1028. case 13:
  1029. if (__IN(f, 0x0a84, 32)) {
  1030. OPB_err(108);
  1031. } else {
  1032. xval->intval = OPB_BoolToInt(ConstCmp__14() == 13);
  1033. }
  1034. break;
  1035. case 14:
  1036. if (__IN(f, 0x0a84, 32)) {
  1037. OPB_err(108);
  1038. } else {
  1039. xval->intval = OPB_BoolToInt(ConstCmp__14() != 11);
  1040. }
  1041. break;
  1042. default:
  1043. OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstOp, op = ", 37);
  1044. OPM_LogWNum(op, 0);
  1045. OPM_LogWLn();
  1046. break;
  1047. }
  1048. ConstOp__13_s = _s.lnk;
  1049. }
  1050. static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
  1051. {
  1052. OPT_Node node = NIL;
  1053. INT16 f, g;
  1054. INT64 k;
  1055. LONGREAL r;
  1056. f = (*x)->typ->form;
  1057. g = typ->form;
  1058. if ((*x)->class == 7) {
  1059. if ((((f == 7 && g == 7)) && (*x)->typ->size > typ->size)) {
  1060. OPB_SetSetType(*x);
  1061. if ((*x)->typ->size > typ->size) {
  1062. OPB_err(203);
  1063. (*x)->conval->setval = 0x0;
  1064. }
  1065. } else if (f == 4) {
  1066. if (g == 4) {
  1067. if ((*x)->typ->size > typ->size) {
  1068. OPB_SetIntType(*x);
  1069. if ((*x)->typ->size > typ->size) {
  1070. OPB_err(203);
  1071. (*x)->conval->intval = 1;
  1072. }
  1073. }
  1074. } else if (__IN(g, 0x60, 32)) {
  1075. (*x)->conval->realval = (*x)->conval->intval;
  1076. (*x)->conval->intval = -1;
  1077. } else {
  1078. k = (*x)->conval->intval;
  1079. if (0 > k || k > 255) {
  1080. OPB_err(220);
  1081. }
  1082. }
  1083. } else if (__IN(f, 0x60, 32)) {
  1084. if (__IN(g, 0x60, 32)) {
  1085. OPB_CheckRealType(g, 203, (*x)->conval);
  1086. } else {
  1087. r = (*x)->conval->realval;
  1088. if (r < -9.22337203685478e+018 || r > 9.22337203685478e+018) {
  1089. OPB_err(203);
  1090. r = (LONGREAL)1;
  1091. }
  1092. (*x)->conval->intval = (INT32)__ENTIER(r);
  1093. OPB_SetIntType(*x);
  1094. }
  1095. }
  1096. (*x)->obj = NIL;
  1097. } else if (((((*x)->class == 11 && (*x)->subcl == 20)) && ((INT16)(*x)->left->typ->form < f || f > g))) {
  1098. if ((*x)->left->typ == typ) {
  1099. *x = (*x)->left;
  1100. }
  1101. } else {
  1102. node = OPT_NewNode(11);
  1103. node->subcl = 20;
  1104. node->left = *x;
  1105. *x = node;
  1106. }
  1107. (*x)->typ = typ;
  1108. }
  1109. static struct Op__38 {
  1110. INT16 *f, *g;
  1111. struct Op__38 *lnk;
  1112. } *Op__38_s;
  1113. static void NewOp__39 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y);
  1114. static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y);
  1115. static void NewOp__39 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
  1116. {
  1117. OPT_Node node = NIL;
  1118. node = OPT_NewNode(12);
  1119. node->subcl = op;
  1120. node->typ = typ;
  1121. node->left = *x;
  1122. node->right = y;
  1123. *x = node;
  1124. }
  1125. static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y)
  1126. {
  1127. BOOLEAN ok, xCharArr, yCharArr;
  1128. xCharArr = (__IN((*x)->typ->comp, 0x0c, 32) && (*x)->typ->BaseTyp->form == 3) || *Op__38_s->f == 8;
  1129. yCharArr = (__IN((*y)->typ->comp, 0x0c, 32) && (*y)->typ->BaseTyp->form == 3) || *Op__38_s->g == 8;
  1130. if ((((xCharArr && *Op__38_s->g == 3)) && (*y)->class == 7)) {
  1131. OPB_CharToString(*y);
  1132. *Op__38_s->g = 8;
  1133. yCharArr = 1;
  1134. }
  1135. if ((((yCharArr && *Op__38_s->f == 3)) && (*x)->class == 7)) {
  1136. OPB_CharToString(*x);
  1137. *Op__38_s->f = 8;
  1138. xCharArr = 1;
  1139. }
  1140. ok = (xCharArr && yCharArr);
  1141. if (ok) {
  1142. if ((*Op__38_s->f == 8 && (*x)->conval->intval2 == 1)) {
  1143. (*x)->typ = OPT_chartyp;
  1144. (*x)->conval->intval = 0;
  1145. OPB_Index(&*y, OPB_NewIntConst(0));
  1146. } else if ((*Op__38_s->g == 8 && (*y)->conval->intval2 == 1)) {
  1147. (*y)->typ = OPT_chartyp;
  1148. (*y)->conval->intval = 0;
  1149. OPB_Index(&*x, OPB_NewIntConst(0));
  1150. }
  1151. }
  1152. return ok;
  1153. }
  1154. void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
  1155. {
  1156. INT16 f, g;
  1157. OPT_Node t = NIL, z = NIL;
  1158. OPT_Struct typ = NIL;
  1159. BOOLEAN do_;
  1160. INT64 val;
  1161. struct Op__38 _s;
  1162. _s.f = &f;
  1163. _s.g = &g;
  1164. _s.lnk = Op__38_s;
  1165. Op__38_s = &_s;
  1166. z = *x;
  1167. if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) {
  1168. OPB_err(126);
  1169. } else if ((z->class == 7 && y->class == 7)) {
  1170. OPB_ConstOp(op, z, y);
  1171. z->obj = NIL;
  1172. } else {
  1173. if (z->typ != y->typ) {
  1174. g = y->typ->form;
  1175. switch (z->typ->form) {
  1176. case 3:
  1177. if (z->class == 7) {
  1178. OPB_CharToString(z);
  1179. } else {
  1180. OPB_err(100);
  1181. }
  1182. break;
  1183. case 4:
  1184. if ((g == 4 && y->typ->size < z->typ->size)) {
  1185. OPB_Convert(&y, z->typ);
  1186. } else if (__IN(g, 0x70, 32)) {
  1187. OPB_Convert(&z, y->typ);
  1188. } else {
  1189. OPB_err(100);
  1190. }
  1191. break;
  1192. case 7:
  1193. if ((g == 7 && y->typ->size < z->typ->size)) {
  1194. OPB_Convert(&y, z->typ);
  1195. } else if (g == 7) {
  1196. OPB_Convert(&z, y->typ);
  1197. } else {
  1198. OPB_err(100);
  1199. }
  1200. break;
  1201. case 5:
  1202. if (g == 4) {
  1203. OPB_Convert(&y, z->typ);
  1204. } else if (__IN(g, 0x60, 32)) {
  1205. OPB_Convert(&z, y->typ);
  1206. } else {
  1207. OPB_err(100);
  1208. }
  1209. break;
  1210. case 6:
  1211. if (__IN(g, 0x70, 32)) {
  1212. OPB_Convert(&y, z->typ);
  1213. } else if (__IN(g, 0x60, 32)) {
  1214. OPB_Convert(&y, z->typ);
  1215. } else {
  1216. OPB_err(100);
  1217. }
  1218. break;
  1219. case 9:
  1220. if (!__IN(g, 0x1800, 32)) {
  1221. OPB_err(100);
  1222. }
  1223. break;
  1224. case 11:
  1225. OPB_CheckPtr(z, y);
  1226. break;
  1227. case 12:
  1228. if (g != 9) {
  1229. OPB_err(100);
  1230. }
  1231. break;
  1232. case 8:
  1233. break;
  1234. case 13:
  1235. if (z->typ->comp == 4) {
  1236. OPB_err(100);
  1237. }
  1238. break;
  1239. default:
  1240. OPB_err(100);
  1241. break;
  1242. }
  1243. }
  1244. typ = z->typ;
  1245. f = typ->form;
  1246. g = y->typ->form;
  1247. switch (op) {
  1248. case 1:
  1249. do_ = 1;
  1250. if (f == 4) {
  1251. if (z->class == 7) {
  1252. val = z->conval->intval;
  1253. if (val == 1) {
  1254. do_ = 0;
  1255. z = y;
  1256. } else if (val == 0) {
  1257. do_ = 0;
  1258. } else if (OPB_log(val) == 1) {
  1259. t = y;
  1260. y = z;
  1261. z = t;
  1262. op = 17;
  1263. y->typ = OPT_sinttyp;
  1264. y->conval->intval = OPB_exp;
  1265. y->obj = NIL;
  1266. }
  1267. } else if (y->class == 7) {
  1268. val = y->conval->intval;
  1269. if (val == 1) {
  1270. do_ = 0;
  1271. } else if (val == 0) {
  1272. do_ = 0;
  1273. z = y;
  1274. } else if (OPB_log(val) == 1) {
  1275. op = 17;
  1276. y->typ = OPT_sinttyp;
  1277. y->conval->intval = OPB_exp;
  1278. y->obj = NIL;
  1279. }
  1280. }
  1281. } else if (!__IN(f, 0xe1, 32)) {
  1282. OPB_err(105);
  1283. typ = OPT_undftyp;
  1284. }
  1285. if (do_) {
  1286. NewOp__39(op, typ, &z, y);
  1287. }
  1288. break;
  1289. case 2:
  1290. if (f == 4) {
  1291. if ((y->class == 7 && y->conval->intval == 0)) {
  1292. OPB_err(205);
  1293. }
  1294. OPB_Convert(&z, OPT_realtyp);
  1295. OPB_Convert(&y, OPT_realtyp);
  1296. typ = OPT_realtyp;
  1297. } else if (__IN(f, 0x60, 32)) {
  1298. if ((y->class == 7 && y->conval->realval == (LONGREAL)0)) {
  1299. OPB_err(205);
  1300. }
  1301. } else if ((f != 7 && f != 0)) {
  1302. OPB_err(102);
  1303. typ = OPT_undftyp;
  1304. }
  1305. NewOp__39(op, typ, &z, y);
  1306. break;
  1307. case 3:
  1308. do_ = 1;
  1309. if (f == 4) {
  1310. if (y->class == 7) {
  1311. val = y->conval->intval;
  1312. if (val == 0) {
  1313. OPB_err(205);
  1314. } else if (val == 1) {
  1315. do_ = 0;
  1316. } else if (OPB_log(val) == 1) {
  1317. op = 17;
  1318. y->typ = OPT_sinttyp;
  1319. y->conval->intval = -OPB_exp;
  1320. y->obj = NIL;
  1321. }
  1322. }
  1323. } else if (f != 0) {
  1324. OPB_err(103);
  1325. typ = OPT_undftyp;
  1326. }
  1327. if (do_) {
  1328. NewOp__39(op, typ, &z, y);
  1329. }
  1330. break;
  1331. case 4:
  1332. if (f == 4) {
  1333. if (y->class == 7) {
  1334. if (y->conval->intval == 0) {
  1335. OPB_err(205);
  1336. } else if (OPB_log(y->conval->intval) == 1) {
  1337. op = 18;
  1338. y->conval->intval = __ASH(-1, OPB_exp);
  1339. y->obj = NIL;
  1340. }
  1341. }
  1342. } else if (f != 0) {
  1343. OPB_err(104);
  1344. typ = OPT_undftyp;
  1345. }
  1346. NewOp__39(op, typ, &z, y);
  1347. break;
  1348. case 5:
  1349. if (f == 2) {
  1350. if (z->class == 7) {
  1351. if (OPB_IntToBool(z->conval->intval)) {
  1352. z = y;
  1353. }
  1354. } else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) {
  1355. } else {
  1356. NewOp__39(op, typ, &z, y);
  1357. }
  1358. } else if (f != 0) {
  1359. OPB_err(94);
  1360. z->typ = OPT_undftyp;
  1361. }
  1362. break;
  1363. case 6:
  1364. if (!__IN(f, 0xf1, 32)) {
  1365. OPB_err(105);
  1366. typ = OPT_undftyp;
  1367. }
  1368. do_ = 1;
  1369. if (f == 4) {
  1370. if ((z->class == 7 && z->conval->intval == 0)) {
  1371. do_ = 0;
  1372. z = y;
  1373. }
  1374. if ((y->class == 7 && y->conval->intval == 0)) {
  1375. do_ = 0;
  1376. }
  1377. }
  1378. if (do_) {
  1379. NewOp__39(op, typ, &z, y);
  1380. }
  1381. break;
  1382. case 7:
  1383. if (!__IN(f, 0xf1, 32)) {
  1384. OPB_err(106);
  1385. typ = OPT_undftyp;
  1386. }
  1387. if ((f != 4 || y->class != 7) || y->conval->intval != 0) {
  1388. NewOp__39(op, typ, &z, y);
  1389. }
  1390. break;
  1391. case 8:
  1392. if (f == 2) {
  1393. if (z->class == 7) {
  1394. if (!OPB_IntToBool(z->conval->intval)) {
  1395. z = y;
  1396. }
  1397. } else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) {
  1398. } else {
  1399. NewOp__39(op, typ, &z, y);
  1400. }
  1401. } else if (f != 0) {
  1402. OPB_err(95);
  1403. z->typ = OPT_undftyp;
  1404. }
  1405. break;
  1406. case 9: case 10:
  1407. if (__IN(f, 0x1aff, 32) || strings__41(&z, &y)) {
  1408. typ = OPT_booltyp;
  1409. } else {
  1410. OPB_err(107);
  1411. typ = OPT_undftyp;
  1412. }
  1413. NewOp__39(op, typ, &z, y);
  1414. break;
  1415. case 11: case 12: case 13: case 14:
  1416. if (__IN(f, 0x79, 32) || strings__41(&z, &y)) {
  1417. typ = OPT_booltyp;
  1418. } else {
  1419. OPM_LogWLn();
  1420. OPM_LogWStr((CHAR*)"ELSE in Op()", 13);
  1421. OPM_LogWLn();
  1422. OPB_err(108);
  1423. typ = OPT_undftyp;
  1424. }
  1425. NewOp__39(op, typ, &z, y);
  1426. break;
  1427. default:
  1428. OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", 32);
  1429. OPM_LogWNum(op, 0);
  1430. OPM_LogWLn();
  1431. break;
  1432. }
  1433. }
  1434. *x = z;
  1435. Op__38_s = _s.lnk;
  1436. }
  1437. void OPB_SetRange (OPT_Node *x, OPT_Node y)
  1438. {
  1439. INT64 k, l;
  1440. if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) {
  1441. OPB_err(126);
  1442. } else if (((*x)->typ->form == 4 && y->typ->form == 4)) {
  1443. if ((*x)->class == 7) {
  1444. k = (*x)->conval->intval;
  1445. if (0 > k || k > 63) {
  1446. OPB_err(202);
  1447. }
  1448. }
  1449. if (y->class == 7) {
  1450. l = y->conval->intval;
  1451. if (0 > l || l > 63) {
  1452. OPB_err(202);
  1453. }
  1454. }
  1455. if (((*x)->class == 7 && y->class == 7)) {
  1456. if (k <= l) {
  1457. (*x)->conval->setval = __SETRNG(k, l, 32);
  1458. OPB_SetSetType(*x);
  1459. } else {
  1460. OPB_err(201);
  1461. (*x)->conval->setval = __SETRNG(l, k, 32);
  1462. }
  1463. (*x)->obj = NIL;
  1464. } else {
  1465. OPB_BindNodes(10, OPT_settyp, &*x, y);
  1466. }
  1467. } else {
  1468. OPB_err(93);
  1469. }
  1470. (*x)->typ = OPT_settyp;
  1471. }
  1472. void OPB_SetElem (OPT_Node *x)
  1473. {
  1474. INT64 k;
  1475. if ((*x)->class == 8 || (*x)->class == 9) {
  1476. OPB_err(126);
  1477. } else if ((*x)->typ->form != 4) {
  1478. OPB_err(93);
  1479. } else if ((*x)->class == 7) {
  1480. k = (*x)->conval->intval;
  1481. if ((0 <= k && k <= 63)) {
  1482. (*x)->conval->setval = 0x0;
  1483. (*x)->conval->setval |= __SETOF(k,64);
  1484. } else {
  1485. OPB_err(202);
  1486. }
  1487. OPB_SetSetType(*x);
  1488. (*x)->obj = NIL;
  1489. } else {
  1490. OPB_Convert(&*x, OPT_settyp);
  1491. (*x)->typ = OPT_settyp;
  1492. }
  1493. }
  1494. static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
  1495. {
  1496. OPT_Struct y = NIL;
  1497. INT16 f, g;
  1498. OPT_Struct p = NIL, q = NIL;
  1499. y = ynode->typ;
  1500. f = x->form;
  1501. g = y->form;
  1502. if (ynode->class == 8 || (ynode->class == 9 && f != 12)) {
  1503. OPB_err(126);
  1504. }
  1505. switch (f) {
  1506. case 0: case 8:
  1507. break;
  1508. case 1:
  1509. if (!((__IN(g, 0x1a, 32) && y->size == 1))) {
  1510. OPB_err(113);
  1511. }
  1512. break;
  1513. case 2: case 3:
  1514. if (g != f) {
  1515. OPB_err(113);
  1516. }
  1517. break;
  1518. case 4: case 7:
  1519. if (g != f || x->size < y->size) {
  1520. OPB_err(113);
  1521. }
  1522. break;
  1523. case 5:
  1524. if (!__IN(g, 0x30, 32)) {
  1525. OPB_err(113);
  1526. }
  1527. break;
  1528. case 6:
  1529. if (!__IN(g, 0x70, 32)) {
  1530. OPB_err(113);
  1531. }
  1532. break;
  1533. case 11:
  1534. if ((x == y || g == 9) || (x == OPT_sysptrtyp && g == 11)) {
  1535. } else if (g == 11) {
  1536. p = x->BaseTyp;
  1537. q = y->BaseTyp;
  1538. if ((p->comp == 4 && q->comp == 4)) {
  1539. while ((((q != p && q != NIL)) && q != OPT_undftyp)) {
  1540. q = q->BaseTyp;
  1541. }
  1542. if (q == NIL) {
  1543. OPB_err(113);
  1544. }
  1545. } else {
  1546. OPB_err(113);
  1547. }
  1548. } else {
  1549. OPB_err(113);
  1550. }
  1551. break;
  1552. case 12:
  1553. if (ynode->class == 9) {
  1554. OPB_CheckProc(x, ynode->obj);
  1555. } else if (x == y || g == 9) {
  1556. } else {
  1557. OPB_err(113);
  1558. }
  1559. break;
  1560. case 10: case 9:
  1561. OPB_err(113);
  1562. break;
  1563. case 13:
  1564. x->pvused = 1;
  1565. if (x->comp == 2) {
  1566. if ((ynode->class == 7 && g == 3)) {
  1567. OPB_CharToString(ynode);
  1568. y = ynode->typ;
  1569. g = 8;
  1570. }
  1571. if (x == y) {
  1572. } else if ((((y->comp == 2 && y->BaseTyp == x->BaseTyp)) && y->n <= x->n)) {
  1573. } else if ((y->comp == 3 && y->BaseTyp == x->BaseTyp)) {
  1574. } else if (x->BaseTyp == OPT_chartyp) {
  1575. if (g == 8) {
  1576. if (ynode->conval->intval2 > x->n) {
  1577. OPB_err(114);
  1578. }
  1579. } else {
  1580. OPB_err(113);
  1581. }
  1582. } else {
  1583. OPB_err(113);
  1584. }
  1585. } else if (x->comp == 4) {
  1586. if (x == y) {
  1587. } else if (y->comp == 4) {
  1588. q = y->BaseTyp;
  1589. while ((((q != NIL && q != x)) && q != OPT_undftyp)) {
  1590. q = q->BaseTyp;
  1591. }
  1592. if (q == NIL) {
  1593. OPB_err(113);
  1594. }
  1595. } else {
  1596. OPB_err(113);
  1597. }
  1598. } else {
  1599. OPB_err(113);
  1600. }
  1601. break;
  1602. default:
  1603. OPM_LogWStr((CHAR*)"unhandled case in OPB.CheckAssign, f = ", 40);
  1604. OPM_LogWNum(f, 0);
  1605. OPM_LogWLn();
  1606. break;
  1607. }
  1608. if ((((((ynode->class == 7 && g < f)) && __IN(g, 0x30, 32))) && __IN(f, 0x70, 32))) {
  1609. OPB_Convert(&ynode, x);
  1610. }
  1611. }
  1612. static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo)
  1613. {
  1614. }
  1615. void OPB_StPar0 (OPT_Node *par0, INT16 fctno)
  1616. {
  1617. INT16 f;
  1618. OPT_Struct typ = NIL;
  1619. OPT_Node x = NIL;
  1620. x = *par0;
  1621. f = x->typ->form;
  1622. switch (fctno) {
  1623. case 0:
  1624. if ((f == 4 && x->class == 7)) {
  1625. if ((0 <= x->conval->intval && x->conval->intval <= 255)) {
  1626. OPB_BindNodes(28, OPT_notyp, &x, x);
  1627. } else {
  1628. OPB_err(218);
  1629. }
  1630. } else {
  1631. OPB_err(69);
  1632. }
  1633. x->typ = OPT_notyp;
  1634. break;
  1635. case 1:
  1636. typ = OPT_notyp;
  1637. if (OPB_NotVar(x)) {
  1638. OPB_err(112);
  1639. } else if (f == 11) {
  1640. if (x->readonly) {
  1641. OPB_err(76);
  1642. }
  1643. f = x->typ->BaseTyp->comp;
  1644. if (__IN(f, 0x1c, 32)) {
  1645. if (f == 3) {
  1646. typ = x->typ->BaseTyp;
  1647. }
  1648. OPB_BindNodes(19, OPT_notyp, &x, NIL);
  1649. x->subcl = 1;
  1650. } else {
  1651. OPB_err(111);
  1652. }
  1653. } else {
  1654. OPB_err(111);
  1655. }
  1656. x->typ = typ;
  1657. break;
  1658. case 2:
  1659. OPB_MOp(21, &x);
  1660. break;
  1661. case 3:
  1662. OPB_MOp(22, &x);
  1663. break;
  1664. case 4:
  1665. if (x->class == 8 || x->class == 9) {
  1666. OPB_err(126);
  1667. } else if (f == 3) {
  1668. OPB_Convert(&x, OPT_inttyp);
  1669. } else {
  1670. OPB_err(111);
  1671. }
  1672. x->typ = OPT_inttyp;
  1673. break;
  1674. case 5:
  1675. if (x->class == 8 || x->class == 9) {
  1676. OPB_err(126);
  1677. } else if (__IN(f, 0x60, 32)) {
  1678. OPB_Convert(&x, OPT_linttyp);
  1679. } else {
  1680. OPB_err(111);
  1681. }
  1682. x->typ = OPT_linttyp;
  1683. break;
  1684. case 12:
  1685. if (x->class == 8 || x->class == 9) {
  1686. OPB_err(126);
  1687. } else if (__IN(f, 0x60, 32)) {
  1688. OPB_Convert(&x, OPT_inttyp);
  1689. } else {
  1690. OPB_err(111);
  1691. }
  1692. x->typ = OPT_inttyp;
  1693. break;
  1694. case 6:
  1695. OPB_MOp(23, &x);
  1696. break;
  1697. case 7:
  1698. if (x->class == 8) {
  1699. switch (f) {
  1700. case 2:
  1701. x = OPB_NewBoolConst(0);
  1702. break;
  1703. case 3:
  1704. x = OPB_NewIntConst(0);
  1705. x->typ = OPT_chartyp;
  1706. break;
  1707. case 4:
  1708. x = OPB_NewIntConst(OPM_SignedMinimum(x->typ->size));
  1709. break;
  1710. case 7:
  1711. x = OPB_NewIntConst(0);
  1712. x->typ = OPT_inttyp;
  1713. break;
  1714. case 5:
  1715. x = OPB_NewRealConst(OPM_MinReal, OPT_realtyp);
  1716. break;
  1717. case 6:
  1718. x = OPB_NewRealConst(OPM_MinLReal, OPT_lrltyp);
  1719. break;
  1720. default:
  1721. OPB_err(111);
  1722. break;
  1723. }
  1724. } else {
  1725. OPB_err(110);
  1726. }
  1727. break;
  1728. case 8:
  1729. if (x->class == 8) {
  1730. switch (f) {
  1731. case 2:
  1732. x = OPB_NewBoolConst(1);
  1733. break;
  1734. case 3:
  1735. x = OPB_NewIntConst(255);
  1736. x->typ = OPT_chartyp;
  1737. break;
  1738. case 4:
  1739. x = OPB_NewIntConst(OPM_SignedMaximum(x->typ->size));
  1740. break;
  1741. case 7:
  1742. x = OPB_NewIntConst(__ASHL(x->typ->size, 3) - 1);
  1743. x->typ = OPT_inttyp;
  1744. break;
  1745. case 5:
  1746. x = OPB_NewRealConst(OPM_MaxReal, OPT_realtyp);
  1747. break;
  1748. case 6:
  1749. x = OPB_NewRealConst(OPM_MaxLReal, OPT_lrltyp);
  1750. break;
  1751. default:
  1752. OPB_err(111);
  1753. break;
  1754. }
  1755. } else {
  1756. OPB_err(110);
  1757. }
  1758. break;
  1759. case 9:
  1760. if (x->class == 8 || x->class == 9) {
  1761. OPB_err(126);
  1762. } else if (__IN(f, 0x11, 32)) {
  1763. OPB_Convert(&x, OPT_chartyp);
  1764. } else {
  1765. OPB_err(111);
  1766. x->typ = OPT_chartyp;
  1767. }
  1768. break;
  1769. case 10:
  1770. if (x->class == 8 || x->class == 9) {
  1771. OPB_err(126);
  1772. } else if (f == 4) {
  1773. typ = OPT_ShorterOrLongerType(x->typ, -1);
  1774. if (typ == NIL) {
  1775. OPB_err(111);
  1776. } else {
  1777. OPB_Convert(&x, typ);
  1778. }
  1779. } else if (f == 6) {
  1780. OPB_Convert(&x, OPT_realtyp);
  1781. } else {
  1782. OPB_err(111);
  1783. }
  1784. break;
  1785. case 11:
  1786. if (x->class == 8 || x->class == 9) {
  1787. OPB_err(126);
  1788. } else if (f == 4) {
  1789. typ = OPT_ShorterOrLongerType(x->typ, 1);
  1790. if (typ == NIL) {
  1791. OPB_err(111);
  1792. } else {
  1793. OPB_Convert(&x, typ);
  1794. }
  1795. } else if (f == 5) {
  1796. OPB_Convert(&x, OPT_lrltyp);
  1797. } else if (f == 3) {
  1798. OPB_Convert(&x, OPT_linttyp);
  1799. } else {
  1800. OPB_err(111);
  1801. }
  1802. break;
  1803. case 14: case 15:
  1804. if (OPB_NotVar(x)) {
  1805. OPB_err(112);
  1806. } else if (f != 4) {
  1807. OPB_err(111);
  1808. } else if (x->readonly) {
  1809. OPB_err(76);
  1810. }
  1811. break;
  1812. case 16: case 17:
  1813. if (OPB_NotVar(x)) {
  1814. OPB_err(112);
  1815. } else if (x->typ->form != 7) {
  1816. OPB_err(111);
  1817. x->typ = OPT_settyp;
  1818. } else if (x->readonly) {
  1819. OPB_err(76);
  1820. }
  1821. break;
  1822. case 18:
  1823. if (!__IN(x->typ->comp, 0x0c, 32)) {
  1824. OPB_err(131);
  1825. }
  1826. break;
  1827. case 19:
  1828. if ((x->class == 7 && f == 3)) {
  1829. OPB_CharToString(x);
  1830. f = 8;
  1831. }
  1832. if (x->class == 8 || x->class == 9) {
  1833. OPB_err(126);
  1834. } else if (((!__IN(x->typ->comp, 0x0c, 32) || x->typ->BaseTyp->form != 3) && f != 8)) {
  1835. OPB_err(111);
  1836. }
  1837. break;
  1838. case 20:
  1839. if (x->class == 8 || x->class == 9) {
  1840. OPB_err(126);
  1841. } else if (f == 4) {
  1842. if (x->typ->size < OPT_linttyp->size) {
  1843. OPB_Convert(&x, OPT_linttyp);
  1844. }
  1845. } else {
  1846. OPB_err(111);
  1847. x->typ = OPT_linttyp;
  1848. }
  1849. break;
  1850. case 21:
  1851. OPB_CheckLeaf(x, 0);
  1852. OPB_MOp(24, &x);
  1853. break;
  1854. case 13:
  1855. if (x->class != 8) {
  1856. OPB_err(110);
  1857. x = OPB_NewIntConst(1);
  1858. } else if (__IN(f, 0x18fe, 32) || __IN(x->typ->comp, 0x14, 32)) {
  1859. OPT_TypSize(x->typ);
  1860. x->typ->pvused = 1;
  1861. x = OPB_NewIntConst(x->typ->size);
  1862. } else {
  1863. OPB_err(111);
  1864. x = OPB_NewIntConst(1);
  1865. }
  1866. break;
  1867. case 22:
  1868. OPB_MOp(25, &x);
  1869. break;
  1870. case 23: case 24:
  1871. if (x->class == 8 || x->class == 9) {
  1872. OPB_err(126);
  1873. } else if (!__IN(f, 0x9a, 32)) {
  1874. OPB_err(111);
  1875. }
  1876. break;
  1877. case 25: case 26: case 29: case 32:
  1878. if (x->class == 8 || x->class == 9) {
  1879. OPB_err(126);
  1880. } else if ((((x->class == 7 && f == 4)) && x->typ->size < OPT_adrtyp->size)) {
  1881. OPB_Convert(&x, OPT_adrtyp);
  1882. } else if (!((__IN(x->typ->form, 0x0810, 32) && x->typ->size == OPM_AddressSize))) {
  1883. OPB_err(111);
  1884. x->typ = OPT_adrtyp;
  1885. }
  1886. break;
  1887. case 27: case 28:
  1888. if ((f == 4 && x->class == 7)) {
  1889. if (x->conval->intval < 0 || x->conval->intval > -1) {
  1890. OPB_err(220);
  1891. }
  1892. } else {
  1893. OPB_err(69);
  1894. }
  1895. break;
  1896. case 30:
  1897. if (x->class != 8) {
  1898. OPB_err(110);
  1899. } else if (__IN(f, 0x0501, 32) || x->typ->comp == 3) {
  1900. OPB_err(111);
  1901. }
  1902. break;
  1903. case 31:
  1904. if (OPB_NotVar(x)) {
  1905. OPB_err(112);
  1906. } else if (f == 11) {
  1907. } else {
  1908. OPB_err(111);
  1909. }
  1910. break;
  1911. case 33:
  1912. if (x->class == 8 || x->class == 9) {
  1913. OPB_err(126);
  1914. x = OPB_NewBoolConst(0);
  1915. } else if (f != 2) {
  1916. OPB_err(120);
  1917. x = OPB_NewBoolConst(0);
  1918. } else {
  1919. OPB_MOp(33, &x);
  1920. }
  1921. break;
  1922. default:
  1923. OPM_LogWStr((CHAR*)"unhandled case in OPB.StPar0, fctno = ", 39);
  1924. OPM_LogWNum(fctno, 0);
  1925. OPM_LogWLn();
  1926. break;
  1927. }
  1928. *par0 = x;
  1929. }
  1930. static struct StPar1__53 {
  1931. struct StPar1__53 *lnk;
  1932. } *StPar1__53_s;
  1933. static OPT_Node NewOp__54 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right);
  1934. static OPT_Node NewOp__54 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right)
  1935. {
  1936. OPT_Node node = NIL;
  1937. node = OPT_NewNode(class);
  1938. node->subcl = subcl;
  1939. node->left = left;
  1940. node->right = right;
  1941. return node;
  1942. }
  1943. void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
  1944. {
  1945. INT16 f, L;
  1946. OPT_Struct typ = NIL;
  1947. OPT_Node p = NIL, t = NIL;
  1948. struct StPar1__53 _s;
  1949. _s.lnk = StPar1__53_s;
  1950. StPar1__53_s = &_s;
  1951. p = *par0;
  1952. f = x->typ->form;
  1953. switch (fctno) {
  1954. case 14: case 15:
  1955. if (x->class == 8 || x->class == 9) {
  1956. OPB_err(126);
  1957. p->typ = OPT_notyp;
  1958. } else {
  1959. if (x->typ != p->typ) {
  1960. if ((f == 4 && (x->class == 7 || (p->typ->form == 4 && x->typ->size <= p->typ->size)))) {
  1961. OPB_Convert(&x, p->typ);
  1962. } else {
  1963. OPB_err(111);
  1964. }
  1965. }
  1966. p = NewOp__54(19, fctno, p, x);
  1967. p->typ = OPT_notyp;
  1968. }
  1969. break;
  1970. case 16: case 17:
  1971. if (x->class == 8 || x->class == 9) {
  1972. OPB_err(126);
  1973. } else if (f == 4) {
  1974. if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval >= (INT64)__ASHL(p->typ->size, 3)))) {
  1975. OPB_err(202);
  1976. }
  1977. p = NewOp__54(19, fctno, p, x);
  1978. } else {
  1979. OPB_err(111);
  1980. }
  1981. p->typ = OPT_notyp;
  1982. break;
  1983. case 18:
  1984. if (!(f == 4) || x->class != 7) {
  1985. OPB_err(69);
  1986. } else if (x->typ->size == 1) {
  1987. L = OPM_Integer(x->conval->intval);
  1988. typ = p->typ;
  1989. while ((L > 0 && __IN(typ->comp, 0x0c, 32))) {
  1990. typ = typ->BaseTyp;
  1991. L -= 1;
  1992. }
  1993. if (L != 0 || !__IN(typ->comp, 0x0c, 32)) {
  1994. OPB_err(132);
  1995. } else {
  1996. x->obj = NIL;
  1997. if (typ->comp == 3) {
  1998. while (p->class == 4) {
  1999. p = p->left;
  2000. x->conval->intval += 1;
  2001. }
  2002. p = NewOp__54(12, 19, p, x);
  2003. p->typ = OPT_linttyp;
  2004. } else {
  2005. p = x;
  2006. p->conval->intval = typ->n;
  2007. OPB_SetIntType(p);
  2008. }
  2009. }
  2010. } else {
  2011. OPB_err(132);
  2012. }
  2013. break;
  2014. case 19:
  2015. if (OPB_NotVar(x)) {
  2016. OPB_err(112);
  2017. } else if ((__IN(x->typ->comp, 0x0c, 32) && x->typ->BaseTyp->form == 3)) {
  2018. if (x->readonly) {
  2019. OPB_err(76);
  2020. }
  2021. t = x;
  2022. x = p;
  2023. p = t;
  2024. p = NewOp__54(19, 19, p, x);
  2025. } else {
  2026. OPB_err(111);
  2027. }
  2028. p->typ = OPT_notyp;
  2029. break;
  2030. case 20:
  2031. if (x->class == 8 || x->class == 9) {
  2032. OPB_err(126);
  2033. } else if (f == 4) {
  2034. if ((p->class == 7 && x->class == 7)) {
  2035. if (-OPB_maxExp > x->conval->intval || x->conval->intval > OPB_maxExp) {
  2036. OPB_err(208);
  2037. p->conval->intval = 1;
  2038. } else if (x->conval->intval >= 0) {
  2039. if (__ABS(p->conval->intval) <= __DIV(9223372036854775807LL, (INT64)__ASH(1, x->conval->intval))) {
  2040. p->conval->intval = p->conval->intval * (INT64)__ASH(1, x->conval->intval);
  2041. } else {
  2042. OPB_err(208);
  2043. p->conval->intval = 1;
  2044. }
  2045. } else {
  2046. p->conval->intval = __ASH(p->conval->intval, x->conval->intval);
  2047. }
  2048. p->obj = NIL;
  2049. } else {
  2050. p = NewOp__54(12, 17, p, x);
  2051. p->typ = p->left->typ;
  2052. }
  2053. } else {
  2054. OPB_err(111);
  2055. }
  2056. break;
  2057. case 1:
  2058. if (x->class == 8 || x->class == 9) {
  2059. OPB_err(126);
  2060. } else if (p->typ->comp == 3) {
  2061. if (f == 4) {
  2062. if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) {
  2063. OPB_err(63);
  2064. }
  2065. } else {
  2066. OPB_err(111);
  2067. }
  2068. p->right = x;
  2069. p->typ = p->typ->BaseTyp;
  2070. } else {
  2071. OPB_err(64);
  2072. }
  2073. break;
  2074. case 23: case 24:
  2075. if (x->class == 8 || x->class == 9) {
  2076. OPB_err(126);
  2077. } else if (f != 4) {
  2078. OPB_err(111);
  2079. } else {
  2080. if (fctno == 23) {
  2081. p = NewOp__54(12, 27, p, x);
  2082. } else {
  2083. p = NewOp__54(12, 28, p, x);
  2084. }
  2085. p->typ = p->left->typ;
  2086. }
  2087. break;
  2088. case 25: case 26: case 27: case 28:
  2089. if (x->class == 8 || x->class == 9) {
  2090. OPB_err(126);
  2091. } else if (__IN(f, 0x18ff, 32)) {
  2092. if (fctno == 25 || fctno == 27) {
  2093. if (OPB_NotVar(x)) {
  2094. OPB_err(112);
  2095. }
  2096. t = x;
  2097. x = p;
  2098. p = t;
  2099. }
  2100. p = NewOp__54(19, fctno, p, x);
  2101. } else {
  2102. OPB_err(111);
  2103. }
  2104. p->typ = OPT_notyp;
  2105. break;
  2106. case 29:
  2107. if (x->class == 8 || x->class == 9) {
  2108. OPB_err(126);
  2109. } else if (f == 4) {
  2110. p = NewOp__54(12, 26, p, x);
  2111. } else {
  2112. OPB_err(111);
  2113. }
  2114. p->typ = OPT_booltyp;
  2115. break;
  2116. case 30:
  2117. if (((x->class == 8 || x->class == 9) || __IN(f, 0x0501, 32)) || x->typ->comp == 3) {
  2118. OPB_err(126);
  2119. }
  2120. OPT_TypSize(x->typ);
  2121. OPT_TypSize(p->typ);
  2122. if ((x->class != 7 && x->typ->size < p->typ->size)) {
  2123. OPB_err(-308);
  2124. }
  2125. if ((((x->class == 7 && x->typ->form == 4)) && p->typ->form == 4)) {
  2126. OPB_Convert(&x, p->typ);
  2127. } else {
  2128. t = OPT_NewNode(11);
  2129. t->subcl = 29;
  2130. t->left = x;
  2131. x = t;
  2132. x->typ = p->typ;
  2133. }
  2134. p = x;
  2135. break;
  2136. case 31:
  2137. if (x->class == 8 || x->class == 9) {
  2138. OPB_err(126);
  2139. } else if (f == 4) {
  2140. p = NewOp__54(19, 31, p, x);
  2141. } else {
  2142. OPB_err(111);
  2143. }
  2144. p->typ = OPT_notyp;
  2145. break;
  2146. case 32:
  2147. if (x->class == 8 || x->class == 9) {
  2148. OPB_err(126);
  2149. } else if ((((x->class == 7 && f == 4)) && x->typ->size < OPT_adrtyp->size)) {
  2150. OPB_Convert(&x, OPT_adrtyp);
  2151. } else if (!((__IN(x->typ->form, 0x0810, 32) && x->typ->size == OPM_AddressSize))) {
  2152. OPB_err(111);
  2153. x->typ = OPT_adrtyp;
  2154. }
  2155. p->link = x;
  2156. break;
  2157. case 33:
  2158. if ((f == 4 && x->class == 7)) {
  2159. if ((0 <= x->conval->intval && x->conval->intval <= 255)) {
  2160. OPB_BindNodes(28, OPT_notyp, &x, x);
  2161. x->conval = OPT_NewConst();
  2162. x->conval->intval = OPM_errpos;
  2163. OPB_Construct(15, &p, x);
  2164. p->conval = OPT_NewConst();
  2165. p->conval->intval = OPM_errpos;
  2166. OPB_Construct(20, &p, NIL);
  2167. OPB_OptIf(&p);
  2168. if (p == NIL) {
  2169. } else if (p->class == 28) {
  2170. OPB_err(99);
  2171. } else {
  2172. p->subcl = 33;
  2173. }
  2174. } else {
  2175. OPB_err(218);
  2176. }
  2177. } else {
  2178. OPB_err(69);
  2179. }
  2180. break;
  2181. default:
  2182. OPB_err(64);
  2183. break;
  2184. }
  2185. *par0 = p;
  2186. StPar1__53_s = _s.lnk;
  2187. }
  2188. void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n)
  2189. {
  2190. OPT_Node node = NIL;
  2191. INT16 f;
  2192. OPT_Node p = NIL;
  2193. p = *par0;
  2194. f = x->typ->form;
  2195. if (fctno == 1) {
  2196. if (x->class == 8 || x->class == 9) {
  2197. OPB_err(126);
  2198. } else if (p->typ->comp != 3) {
  2199. OPB_err(64);
  2200. } else if (f == 4) {
  2201. if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) {
  2202. OPB_err(63);
  2203. }
  2204. node = p->right;
  2205. while (node->link != NIL) {
  2206. node = node->link;
  2207. }
  2208. node->link = x;
  2209. p->typ = p->typ->BaseTyp;
  2210. } else {
  2211. OPB_err(111);
  2212. }
  2213. } else if ((fctno == 32 && n == 2)) {
  2214. if (x->class == 8 || x->class == 9) {
  2215. OPB_err(126);
  2216. } else if (f == 4) {
  2217. node = OPT_NewNode(19);
  2218. node->subcl = 32;
  2219. node->right = p;
  2220. node->left = p->link;
  2221. p->link = x;
  2222. p = node;
  2223. } else {
  2224. OPB_err(111);
  2225. }
  2226. p->typ = OPT_notyp;
  2227. } else {
  2228. OPB_err(64);
  2229. }
  2230. *par0 = p;
  2231. }
  2232. void OPB_StFct (OPT_Node *par0, INT8 fctno, INT16 parno)
  2233. {
  2234. INT16 dim;
  2235. OPT_Node x = NIL, p = NIL;
  2236. p = *par0;
  2237. if (fctno <= 20) {
  2238. if ((fctno == 1 && p->typ != OPT_notyp)) {
  2239. if (p->typ->comp == 3) {
  2240. OPB_err(65);
  2241. }
  2242. p->typ = OPT_notyp;
  2243. } else if (fctno <= 13) {
  2244. if (parno < 1) {
  2245. OPB_err(65);
  2246. }
  2247. } else {
  2248. if (((fctno == 14 || fctno == 15) && parno == 1)) {
  2249. OPB_BindNodes(19, OPT_notyp, &p, OPB_NewIntConst(1));
  2250. p->subcl = fctno;
  2251. p->right->typ = p->left->typ;
  2252. } else if ((fctno == 18 && parno == 1)) {
  2253. if (p->typ->comp == 3) {
  2254. dim = 0;
  2255. while (p->class == 4) {
  2256. p = p->left;
  2257. dim += 1;
  2258. }
  2259. OPB_BindNodes(12, OPT_linttyp, &p, OPB_NewIntConst(dim));
  2260. p->subcl = 19;
  2261. } else {
  2262. p = OPB_NewIntConst(p->typ->n);
  2263. }
  2264. } else if (parno < 2) {
  2265. OPB_err(65);
  2266. }
  2267. }
  2268. } else if (fctno == 33) {
  2269. if (parno == 1) {
  2270. x = NIL;
  2271. OPB_BindNodes(28, OPT_notyp, &x, OPB_NewIntConst(0));
  2272. x->conval = OPT_NewConst();
  2273. x->conval->intval = OPM_errpos;
  2274. OPB_Construct(15, &p, x);
  2275. p->conval = OPT_NewConst();
  2276. p->conval->intval = OPM_errpos;
  2277. OPB_Construct(20, &p, NIL);
  2278. OPB_OptIf(&p);
  2279. if (p == NIL) {
  2280. } else if (p->class == 28) {
  2281. OPB_err(99);
  2282. } else {
  2283. p->subcl = 33;
  2284. }
  2285. } else if (parno < 1) {
  2286. OPB_err(65);
  2287. }
  2288. } else {
  2289. if ((parno < 1 || (fctno > 22 && parno < 2)) || (fctno == 32 && parno < 3)) {
  2290. OPB_err(65);
  2291. }
  2292. }
  2293. *par0 = p;
  2294. }
  2295. static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar)
  2296. {
  2297. INT16 f;
  2298. f = atyp->comp;
  2299. ftyp = ftyp->BaseTyp;
  2300. atyp = atyp->BaseTyp;
  2301. if ((fvarpar && ftyp == OPT_bytetyp)) {
  2302. if (!__IN(f, 0x0c, 32) || !((__IN(atyp->form, 0x1e, 32) && atyp->size == 1))) {
  2303. if (__IN(18, OPM_Options, 32)) {
  2304. OPB_err(-301);
  2305. }
  2306. }
  2307. } else if (__IN(f, 0x0c, 32)) {
  2308. if (ftyp->comp == 3) {
  2309. OPB_DynArrParCheck(ftyp, atyp, fvarpar);
  2310. } else if (ftyp != atyp) {
  2311. if ((((!fvarpar && ftyp->form == 11)) && atyp->form == 11)) {
  2312. ftyp = ftyp->BaseTyp;
  2313. atyp = atyp->BaseTyp;
  2314. if ((ftyp->comp == 4 && atyp->comp == 4)) {
  2315. while ((((ftyp != atyp && atyp != NIL)) && atyp != OPT_undftyp)) {
  2316. atyp = atyp->BaseTyp;
  2317. }
  2318. if (atyp == NIL) {
  2319. OPB_err(113);
  2320. }
  2321. } else {
  2322. OPB_err(66);
  2323. }
  2324. } else {
  2325. OPB_err(66);
  2326. }
  2327. }
  2328. } else {
  2329. OPB_err(67);
  2330. }
  2331. }
  2332. static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp)
  2333. {
  2334. if (fp->typ->form == 11) {
  2335. if ((*x)->class == 3) {
  2336. *x = (*x)->left;
  2337. } else {
  2338. OPB_err(71);
  2339. }
  2340. }
  2341. }
  2342. void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar)
  2343. {
  2344. if (((*x)->obj != NIL && __IN((*x)->obj->mode, 0x22c0, 32))) {
  2345. *fpar = (*x)->obj->link;
  2346. if ((*x)->obj->mode == 13) {
  2347. OPB_CheckReceiver(&(*x)->left, *fpar);
  2348. *fpar = (*fpar)->link;
  2349. }
  2350. } else if (((((*x)->class != 8 && (*x)->typ != NIL)) && (*x)->typ->form == 12)) {
  2351. *fpar = (*x)->typ->link;
  2352. } else {
  2353. OPB_err(121);
  2354. *fpar = NIL;
  2355. (*x)->typ = OPT_undftyp;
  2356. }
  2357. }
  2358. void OPB_Param (OPT_Node ap, OPT_Object fp)
  2359. {
  2360. OPT_Struct q = NIL;
  2361. if (fp->typ->form != 0) {
  2362. if (fp->mode == 2) {
  2363. if (OPB_NotVar(ap)) {
  2364. OPB_err(122);
  2365. } else {
  2366. OPB_CheckLeaf(ap, 0);
  2367. }
  2368. if (ap->readonly) {
  2369. OPB_err(76);
  2370. }
  2371. if (fp->typ->comp == 3) {
  2372. OPB_DynArrParCheck(fp->typ, ap->typ, 1);
  2373. } else if ((fp->typ->comp == 4 && ap->typ->comp == 4)) {
  2374. q = ap->typ;
  2375. while ((((q != fp->typ && q != NIL)) && q != OPT_undftyp)) {
  2376. q = q->BaseTyp;
  2377. }
  2378. if (q == NIL) {
  2379. OPB_err(111);
  2380. }
  2381. } else if ((fp->typ == OPT_sysptrtyp && ap->typ->form == 11)) {
  2382. } else if ((ap->typ != fp->typ && !((((fp->typ->form == 1 && __IN(ap->typ->form, 0x1e, 32))) && ap->typ->size == 1)))) {
  2383. OPB_err(123);
  2384. } else if ((fp->typ->form == 11 && ap->class == 5)) {
  2385. OPB_err(123);
  2386. }
  2387. } else if (fp->typ->comp == 3) {
  2388. if ((ap->class == 7 && ap->typ->form == 3)) {
  2389. OPB_CharToString(ap);
  2390. }
  2391. if ((ap->typ->form == 8 && fp->typ->BaseTyp->form == 3)) {
  2392. } else if (ap->class >= 7) {
  2393. OPB_err(59);
  2394. } else {
  2395. OPB_DynArrParCheck(fp->typ, ap->typ, 0);
  2396. }
  2397. } else {
  2398. OPB_CheckAssign(fp->typ, ap);
  2399. }
  2400. }
  2401. }
  2402. void OPB_StaticLink (INT8 dlev)
  2403. {
  2404. OPT_Object scope = NIL;
  2405. scope = OPT_topScope;
  2406. while (dlev > 0) {
  2407. dlev -= 1;
  2408. scope->link->conval->setval |= __SETOF(3,64);
  2409. scope = scope->left;
  2410. }
  2411. }
  2412. void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp)
  2413. {
  2414. OPT_Struct typ = NIL;
  2415. OPT_Node p = NIL;
  2416. INT8 lev;
  2417. if ((*x)->class == 9) {
  2418. typ = (*x)->typ;
  2419. lev = (*x)->obj->mnolev;
  2420. if (lev > 0) {
  2421. OPB_StaticLink(OPT_topScope->mnolev - lev);
  2422. }
  2423. if ((*x)->obj->mode == 10) {
  2424. OPB_err(121);
  2425. }
  2426. } else if (((*x)->class == 2 && (*x)->obj->mode == 13)) {
  2427. typ = (*x)->typ;
  2428. (*x)->class = 9;
  2429. p = (*x)->left;
  2430. (*x)->left = NIL;
  2431. p->link = apar;
  2432. apar = p;
  2433. fp = (*x)->obj->link;
  2434. } else {
  2435. typ = (*x)->typ->BaseTyp;
  2436. }
  2437. OPB_BindNodes(13, typ, &*x, apar);
  2438. (*x)->obj = fp;
  2439. }
  2440. void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc)
  2441. {
  2442. OPT_Node x = NIL;
  2443. x = OPT_NewNode(18);
  2444. x->typ = OPT_notyp;
  2445. x->obj = proc;
  2446. x->left = *procdec;
  2447. x->right = stat;
  2448. *procdec = x;
  2449. }
  2450. void OPB_Return (OPT_Node *x, OPT_Object proc)
  2451. {
  2452. OPT_Node node = NIL;
  2453. if (proc == NIL) {
  2454. if (*x != NIL) {
  2455. OPB_err(124);
  2456. }
  2457. } else {
  2458. if (*x != NIL) {
  2459. OPB_CheckAssign(proc->typ, *x);
  2460. } else if (proc->typ != OPT_notyp) {
  2461. OPB_err(124);
  2462. }
  2463. }
  2464. node = OPT_NewNode(26);
  2465. node->typ = OPT_notyp;
  2466. node->obj = proc;
  2467. node->left = *x;
  2468. *x = node;
  2469. }
  2470. void OPB_Assign (OPT_Node *x, OPT_Node y)
  2471. {
  2472. OPT_Node z = NIL;
  2473. if ((*x)->class >= 7) {
  2474. OPB_err(56);
  2475. }
  2476. OPB_CheckAssign((*x)->typ, y);
  2477. if ((*x)->readonly) {
  2478. OPB_err(76);
  2479. }
  2480. if ((*x)->typ->comp == 4) {
  2481. if ((*x)->class == 5) {
  2482. z = (*x)->left;
  2483. } else {
  2484. z = *x;
  2485. }
  2486. if ((z->class == 3 && z->left->class == 5)) {
  2487. z->left = z->left->left;
  2488. }
  2489. if (((*x)->typ->strobj != NIL && (z->class == 3 || z->class == 1))) {
  2490. OPB_BindNodes(6, (*x)->typ, &z, NIL);
  2491. *x = z;
  2492. }
  2493. } else if (((((((*x)->typ->comp == 2 && (*x)->typ->BaseTyp == OPT_chartyp)) && y->typ->form == 8)) && y->conval->intval2 == 1)) {
  2494. y->typ = OPT_chartyp;
  2495. y->conval->intval = 0;
  2496. OPB_Index(&*x, OPB_NewIntConst(0));
  2497. }
  2498. OPB_BindNodes(19, OPT_notyp, &*x, y);
  2499. (*x)->subcl = 0;
  2500. }
  2501. void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ)
  2502. {
  2503. OPT_Node node = NIL;
  2504. node = OPT_NewNode(14);
  2505. node->typ = typ;
  2506. node->conval = OPT_NewConst();
  2507. node->conval->intval = typ->txtpos;
  2508. if (*inittd == NIL) {
  2509. *inittd = node;
  2510. } else {
  2511. (*last)->link = node;
  2512. }
  2513. *last = node;
  2514. }
  2515. export void *OPB__init(void)
  2516. {
  2517. __DEFMOD;
  2518. __MODULE_IMPORT(OPM);
  2519. __MODULE_IMPORT(OPS);
  2520. __MODULE_IMPORT(OPT);
  2521. __REGMOD("OPB", 0);
  2522. /* BEGIN */
  2523. OPB_maxExp = OPB_log(4611686018427387904LL);
  2524. OPB_maxExp = OPB_exp;
  2525. __ENDMOD;
  2526. }