OPT.c 50 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163
  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. typedef
  10. struct OPT_ConstDesc *OPT_Const;
  11. typedef
  12. OPS_String *OPT_ConstExt;
  13. typedef
  14. struct OPT_ConstDesc {
  15. OPT_ConstExt ext;
  16. INT64 intval;
  17. INT32 intval2;
  18. UINT64 setval;
  19. LONGREAL realval;
  20. } OPT_ConstDesc;
  21. typedef
  22. struct OPT_ExpCtxt {
  23. INT32 reffp;
  24. INT16 ref;
  25. INT8 nofm;
  26. INT8 locmno[64];
  27. } OPT_ExpCtxt;
  28. typedef
  29. struct OPT_StrDesc *OPT_Struct;
  30. typedef
  31. struct OPT_ObjDesc *OPT_Object;
  32. typedef
  33. struct OPT_ImpCtxt {
  34. INT32 nextTag, reffp;
  35. INT16 nofr, minr, nofm;
  36. BOOLEAN self;
  37. OPT_Struct ref[255];
  38. OPT_Object old[255];
  39. INT32 pvfp[255];
  40. INT8 glbmno[64];
  41. } OPT_ImpCtxt;
  42. typedef
  43. struct OPT_LinkDesc *OPT_Link;
  44. typedef
  45. struct OPT_LinkDesc {
  46. OPS_Name name;
  47. OPT_Link next;
  48. } OPT_LinkDesc;
  49. typedef
  50. struct OPT_NodeDesc *OPT_Node;
  51. typedef
  52. struct OPT_NodeDesc {
  53. OPT_Node left, right, link;
  54. INT8 class, subcl;
  55. BOOLEAN readonly;
  56. OPT_Struct typ;
  57. OPT_Object obj;
  58. OPT_Const conval;
  59. } OPT_NodeDesc;
  60. typedef
  61. struct OPT_ObjDesc {
  62. OPT_Object left, right, link, scope;
  63. OPS_Name name;
  64. BOOLEAN leaf;
  65. INT8 mode, mnolev, vis, history;
  66. BOOLEAN used, fpdone;
  67. INT32 fprint;
  68. OPT_Struct typ;
  69. OPT_Const conval;
  70. INT32 adr, linkadr;
  71. INT16 x;
  72. } OPT_ObjDesc;
  73. typedef
  74. struct OPT_StrDesc {
  75. INT8 form, comp, mno, extlev;
  76. INT16 ref, sysflag;
  77. INT32 n, size, align, txtpos;
  78. BOOLEAN allocated, pbused, pvused, fpdone, idfpdone;
  79. INT32 idfp, pbfp, pvfp;
  80. OPT_Struct BaseTyp;
  81. OPT_Object link, strobj;
  82. } OPT_StrDesc;
  83. export OPT_Object OPT_topScope;
  84. export OPT_Struct OPT_undftyp, OPT_niltyp, OPT_notyp, OPT_bytetyp, OPT_cpbytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_hinttyp, OPT_int8typ, OPT_int16typ, OPT_int32typ, OPT_int64typ, OPT_settyp, OPT_set32typ, OPT_set64typ, OPT_realtyp, OPT_lrltyp, OPT_stringtyp, OPT_adrtyp, OPT_sysptrtyp;
  85. export OPT_Object OPT_sintobj, OPT_intobj, OPT_lintobj, OPT_setobj;
  86. export INT8 OPT_nofGmod;
  87. export OPT_Object OPT_GlbMod[64];
  88. export OPS_Name OPT_SelfName;
  89. export BOOLEAN OPT_SYSimported;
  90. static OPT_Object OPT_universe, OPT_syslink;
  91. static OPT_ImpCtxt OPT_impCtxt;
  92. static OPT_ExpCtxt OPT_expCtxt;
  93. static INT32 OPT_nofhdfld;
  94. static BOOLEAN OPT_newsf, OPT_findpc, OPT_extsf, OPT_sfpresent, OPT_symExtended, OPT_symNew;
  95. static INT32 OPT_recno;
  96. export OPT_Link OPT_Links;
  97. export ADDRESS *OPT_ConstDesc__typ;
  98. export ADDRESS *OPT_ObjDesc__typ;
  99. export ADDRESS *OPT_StrDesc__typ;
  100. export ADDRESS *OPT_NodeDesc__typ;
  101. export ADDRESS *OPT_ImpCtxt__typ;
  102. export ADDRESS *OPT_ExpCtxt__typ;
  103. export ADDRESS *OPT_LinkDesc__typ;
  104. export void OPT_Align (INT32 *adr, INT32 base);
  105. export INT32 OPT_BaseAlignment (OPT_Struct typ);
  106. export void OPT_Close (void);
  107. export void OPT_CloseScope (void);
  108. static void OPT_DebugStruct (OPT_Struct btyp);
  109. static void OPT_EnterBoolConst (OPS_Name name, INT32 value);
  110. static void OPT_EnterProc (OPS_Name name, INT16 num);
  111. static void OPT_EnterTyp (OPS_Name name, INT8 form, INT16 size, OPT_Struct *res);
  112. static void OPT_EnterTypeAlias (OPS_Name name, OPT_Object *res);
  113. export void OPT_Export (BOOLEAN *ext, BOOLEAN *new);
  114. export void OPT_FPrintErr (OPT_Object obj, INT16 errcode);
  115. static void OPT_FPrintName (INT32 *fp, CHAR *name, ADDRESS name__len);
  116. export void OPT_FPrintObj (OPT_Object obj);
  117. static void OPT_FPrintSign (INT32 *fp, OPT_Struct result, OPT_Object par);
  118. export void OPT_FPrintStr (OPT_Struct typ);
  119. export void OPT_Find (OPT_Object *res);
  120. export void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res);
  121. export void OPT_FindImport (OPT_Object mod, OPT_Object *res);
  122. export void OPT_IdFPrint (OPT_Struct typ);
  123. export void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done);
  124. static void OPT_InConstant (INT32 f, OPT_Const conval);
  125. static OPT_Object OPT_InFld (void);
  126. static void OPT_InLinks (void);
  127. static void OPT_InMod (INT8 *mno);
  128. static void OPT_InName (CHAR *name, ADDRESS name__len);
  129. static OPT_Object OPT_InObj (INT8 mno);
  130. static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par);
  131. static void OPT_InStruct (OPT_Struct *typ);
  132. static OPT_Object OPT_InTProc (INT8 mno);
  133. static OPT_Struct OPT_InTyp (INT32 tag);
  134. export void OPT_Init (OPS_Name name, UINT32 opt);
  135. export void OPT_InitRecno (void);
  136. static void OPT_InitStruct (OPT_Struct *typ, INT8 form);
  137. export void OPT_Insert (OPS_Name name, OPT_Object *obj);
  138. export void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old);
  139. export INT16 OPT_IntSize (INT64 n);
  140. export OPT_Struct OPT_IntType (INT32 size);
  141. export OPT_Const OPT_NewConst (void);
  142. export OPT_ConstExt OPT_NewExt (void);
  143. export OPT_Node OPT_NewNode (INT8 class);
  144. export OPT_Object OPT_NewObj (void);
  145. export OPT_Struct OPT_NewStr (INT8 form, INT8 comp);
  146. export void OPT_OpenScope (INT8 level, OPT_Object owner);
  147. static void OPT_OutConstant (OPT_Object obj);
  148. static void OPT_OutFlds (OPT_Object fld, INT32 adr, BOOLEAN visible);
  149. static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr);
  150. static void OPT_OutLinks (void);
  151. static void OPT_OutMod (INT16 mno);
  152. static void OPT_OutName (CHAR *name, ADDRESS name__len);
  153. static void OPT_OutObj (OPT_Object obj);
  154. static void OPT_OutSign (OPT_Struct result, OPT_Object par);
  155. static void OPT_OutStr (OPT_Struct typ);
  156. static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj);
  157. export OPT_Struct OPT_SetType (INT32 size);
  158. export OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir);
  159. export INT32 OPT_SizeAlignment (INT32 size);
  160. export void OPT_TypSize (OPT_Struct typ);
  161. static void OPT_err (INT16 n);
  162. void OPT_InitRecno (void)
  163. {
  164. OPT_recno = 0;
  165. }
  166. static void OPT_err (INT16 n)
  167. {
  168. OPM_err(n);
  169. }
  170. INT16 OPT_IntSize (INT64 n)
  171. {
  172. INT16 bytes;
  173. if (n < 0) {
  174. n = -(n + 1);
  175. }
  176. bytes = 1;
  177. while ((bytes < 8 && __ASH(n, -(__ASHL(bytes, 3) - 1)) != 0)) {
  178. bytes += 1;
  179. }
  180. return bytes;
  181. }
  182. OPT_Struct OPT_IntType (INT32 size)
  183. {
  184. if (size <= OPT_int8typ->size) {
  185. return OPT_int8typ;
  186. }
  187. if (size <= OPT_int16typ->size) {
  188. return OPT_int16typ;
  189. }
  190. if (size <= OPT_int32typ->size) {
  191. return OPT_int32typ;
  192. }
  193. return OPT_int64typ;
  194. }
  195. OPT_Struct OPT_SetType (INT32 size)
  196. {
  197. if (size == OPT_set32typ->size) {
  198. return OPT_set32typ;
  199. }
  200. return OPT_set64typ;
  201. }
  202. OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir)
  203. {
  204. INT16 i;
  205. __ASSERT(x->form == 4, 0);
  206. __ASSERT(x->BaseTyp == OPT_undftyp, 0);
  207. __ASSERT(dir == 1 || dir == -1, 0);
  208. if (dir > 0) {
  209. if (x->size < OPT_sinttyp->size) {
  210. return OPT_sinttyp;
  211. }
  212. if (x->size < OPT_inttyp->size) {
  213. return OPT_inttyp;
  214. }
  215. if (x->size < OPT_linttyp->size) {
  216. return OPT_linttyp;
  217. }
  218. return OPT_int64typ;
  219. } else {
  220. if (x->size > OPT_linttyp->size) {
  221. return OPT_linttyp;
  222. }
  223. if (x->size > OPT_inttyp->size) {
  224. return OPT_inttyp;
  225. }
  226. if (x->size > OPT_sinttyp->size) {
  227. return OPT_sinttyp;
  228. }
  229. return OPT_int8typ;
  230. }
  231. __RETCHK;
  232. }
  233. void OPT_Align (INT32 *adr, INT32 base)
  234. {
  235. switch (base) {
  236. case 2:
  237. *adr += __MASK(*adr, -2);
  238. break;
  239. case 4:
  240. *adr += __MASK(-*adr, -4);
  241. break;
  242. case 8:
  243. *adr += __MASK(-*adr, -8);
  244. break;
  245. case 16:
  246. *adr += __MASK(-*adr, -16);
  247. break;
  248. default:
  249. break;
  250. }
  251. }
  252. INT32 OPT_SizeAlignment (INT32 size)
  253. {
  254. INT32 alignment;
  255. if (size < OPM_Alignment) {
  256. alignment = 1;
  257. while (alignment < size) {
  258. alignment = __ASHL(alignment, 1);
  259. }
  260. } else {
  261. alignment = OPM_Alignment;
  262. }
  263. return alignment;
  264. }
  265. INT32 OPT_BaseAlignment (OPT_Struct typ)
  266. {
  267. INT32 alignment;
  268. if (typ->form == 13) {
  269. if (typ->comp == 4) {
  270. alignment = __MASK(typ->align, -65536);
  271. } else {
  272. alignment = OPT_BaseAlignment(typ->BaseTyp);
  273. }
  274. } else {
  275. alignment = OPT_SizeAlignment(typ->size);
  276. }
  277. return alignment;
  278. }
  279. void OPT_TypSize (OPT_Struct typ)
  280. {
  281. INT16 f, c;
  282. INT32 offset, size, base, fbase, off0;
  283. OPT_Object fld = NIL;
  284. OPT_Struct btyp = NIL;
  285. if (typ == OPT_undftyp) {
  286. OPM_err(58);
  287. } else if (typ->size == -1) {
  288. f = typ->form;
  289. c = typ->comp;
  290. if (c == 4) {
  291. btyp = typ->BaseTyp;
  292. if (btyp == NIL) {
  293. offset = 0;
  294. base = 1;
  295. } else {
  296. OPT_TypSize(btyp);
  297. offset = btyp->size - __ASHR(btyp->sysflag, 8);
  298. base = btyp->align;
  299. }
  300. fld = typ->link;
  301. while ((fld != NIL && fld->mode == 4)) {
  302. btyp = fld->typ;
  303. OPT_TypSize(btyp);
  304. size = btyp->size;
  305. fbase = OPT_BaseAlignment(btyp);
  306. OPT_Align(&offset, fbase);
  307. fld->adr = offset;
  308. offset += size;
  309. if (fbase > base) {
  310. base = fbase;
  311. }
  312. fld = fld->link;
  313. }
  314. off0 = offset;
  315. if (offset == 0) {
  316. offset = 1;
  317. }
  318. OPT_Align(&offset, base);
  319. if ((typ->strobj == NIL && __MASK(typ->align, -65536) == 0)) {
  320. OPT_recno += 1;
  321. base += __ASHL(OPT_recno, 16);
  322. }
  323. typ->size = offset;
  324. typ->align = base;
  325. typ->sysflag = __MASK(typ->sysflag, -256) + (INT16)__ASHL(offset - off0, 8);
  326. } else if (c == 2) {
  327. OPT_TypSize(typ->BaseTyp);
  328. typ->size = typ->n * typ->BaseTyp->size;
  329. } else if (f == 11) {
  330. typ->size = OPM_AddressSize;
  331. if (typ->BaseTyp == OPT_undftyp) {
  332. OPM_Mark(128, typ->n);
  333. } else {
  334. OPT_TypSize(typ->BaseTyp);
  335. }
  336. } else if (f == 12) {
  337. typ->size = OPM_AddressSize;
  338. } else if (c == 3) {
  339. btyp = typ->BaseTyp;
  340. OPT_TypSize(btyp);
  341. if (btyp->comp == 3) {
  342. typ->size = btyp->size + 4;
  343. } else {
  344. typ->size = 8;
  345. }
  346. }
  347. }
  348. }
  349. OPT_Const OPT_NewConst (void)
  350. {
  351. OPT_Const const_ = NIL;
  352. __NEW(const_, OPT_ConstDesc);
  353. return const_;
  354. }
  355. OPT_Object OPT_NewObj (void)
  356. {
  357. OPT_Object obj = NIL;
  358. __NEW(obj, OPT_ObjDesc);
  359. return obj;
  360. }
  361. OPT_Struct OPT_NewStr (INT8 form, INT8 comp)
  362. {
  363. OPT_Struct typ = NIL;
  364. __NEW(typ, OPT_StrDesc);
  365. typ->form = form;
  366. typ->comp = comp;
  367. typ->ref = 255;
  368. if (form != 0) {
  369. typ->txtpos = OPM_errpos;
  370. }
  371. typ->size = -1;
  372. typ->BaseTyp = OPT_undftyp;
  373. return typ;
  374. }
  375. OPT_Node OPT_NewNode (INT8 class)
  376. {
  377. OPT_Node node = NIL;
  378. __NEW(node, OPT_NodeDesc);
  379. node->class = class;
  380. return node;
  381. }
  382. OPT_ConstExt OPT_NewExt (void)
  383. {
  384. OPT_ConstExt ext = NIL;
  385. ext = __NEWARR(NIL, 1, 1, 1, 0, 256);
  386. return ext;
  387. }
  388. void OPT_OpenScope (INT8 level, OPT_Object owner)
  389. {
  390. OPT_Object head = NIL;
  391. head = OPT_NewObj();
  392. head->mode = 12;
  393. head->mnolev = level;
  394. head->link = owner;
  395. if (owner != NIL) {
  396. owner->scope = head;
  397. }
  398. head->left = OPT_topScope;
  399. head->right = NIL;
  400. head->scope = NIL;
  401. OPT_topScope = head;
  402. }
  403. void OPT_CloseScope (void)
  404. {
  405. OPT_topScope = OPT_topScope->left;
  406. }
  407. void OPT_Init (OPS_Name name, UINT32 opt)
  408. {
  409. OPT_topScope = OPT_universe;
  410. OPT_OpenScope(0, NIL);
  411. OPT_SYSimported = 0;
  412. __MOVE(name, OPT_SelfName, 256);
  413. __MOVE(name, OPT_topScope->name, 256);
  414. OPT_GlbMod[0] = OPT_topScope;
  415. OPT_nofGmod = 1;
  416. OPT_newsf = __IN(4, opt, 32);
  417. OPT_findpc = __IN(8, opt, 32);
  418. OPT_extsf = OPT_newsf || __IN(9, opt, 32);
  419. OPT_sfpresent = 1;
  420. __NEW(OPT_Links, OPT_LinkDesc);
  421. __MOVE(name, OPT_Links->name, 256);
  422. }
  423. void OPT_Close (void)
  424. {
  425. INT16 i;
  426. OPT_CloseScope();
  427. i = 0;
  428. while (i < 64) {
  429. OPT_GlbMod[__X(i, 64)] = NIL;
  430. i += 1;
  431. }
  432. i = 14;
  433. while (i < 255) {
  434. OPT_impCtxt.ref[__X(i, 255)] = NIL;
  435. OPT_impCtxt.old[__X(i, 255)] = NIL;
  436. i += 1;
  437. }
  438. }
  439. void OPT_FindImport (OPT_Object mod, OPT_Object *res)
  440. {
  441. OPT_Object obj = NIL;
  442. obj = mod->scope;
  443. for (;;) {
  444. if (obj == NIL) {
  445. break;
  446. }
  447. if (__STRCMP(OPS_name, obj->name) < 0) {
  448. obj = obj->left;
  449. } else if (__STRCMP(OPS_name, obj->name) > 0) {
  450. obj = obj->right;
  451. } else {
  452. if ((obj->mode == 5 && obj->vis == 0)) {
  453. obj = NIL;
  454. } else {
  455. obj->used = 1;
  456. }
  457. break;
  458. }
  459. }
  460. *res = obj;
  461. }
  462. void OPT_Find (OPT_Object *res)
  463. {
  464. OPT_Object obj = NIL, head = NIL;
  465. head = OPT_topScope;
  466. for (;;) {
  467. obj = head->right;
  468. for (;;) {
  469. if (obj == NIL) {
  470. break;
  471. }
  472. if (__STRCMP(OPS_name, obj->name) < 0) {
  473. obj = obj->left;
  474. } else if (__STRCMP(OPS_name, obj->name) > 0) {
  475. obj = obj->right;
  476. } else {
  477. break;
  478. }
  479. }
  480. if (obj != NIL) {
  481. break;
  482. }
  483. head = head->left;
  484. if (head == NIL) {
  485. break;
  486. }
  487. }
  488. *res = obj;
  489. }
  490. void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res)
  491. {
  492. OPT_Object obj = NIL;
  493. while (typ != NIL) {
  494. obj = typ->link;
  495. while (obj != NIL) {
  496. if (__STRCMP(name, obj->name) < 0) {
  497. obj = obj->left;
  498. } else if (__STRCMP(name, obj->name) > 0) {
  499. obj = obj->right;
  500. } else {
  501. *res = obj;
  502. return;
  503. }
  504. }
  505. typ = typ->BaseTyp;
  506. }
  507. *res = NIL;
  508. }
  509. void OPT_Insert (OPS_Name name, OPT_Object *obj)
  510. {
  511. OPT_Object ob0 = NIL, ob1 = NIL;
  512. BOOLEAN left;
  513. INT8 mnolev;
  514. ob0 = OPT_topScope;
  515. ob1 = ob0->right;
  516. left = 0;
  517. for (;;) {
  518. if (ob1 != NIL) {
  519. if (__STRCMP(name, ob1->name) < 0) {
  520. ob0 = ob1;
  521. ob1 = ob0->left;
  522. left = 1;
  523. } else if (__STRCMP(name, ob1->name) > 0) {
  524. ob0 = ob1;
  525. ob1 = ob0->right;
  526. left = 0;
  527. } else {
  528. OPT_err(1);
  529. ob0 = ob1;
  530. ob1 = ob0->right;
  531. }
  532. } else {
  533. ob1 = OPT_NewObj();
  534. ob1->leaf = 1;
  535. if (left) {
  536. ob0->left = ob1;
  537. } else {
  538. ob0->right = ob1;
  539. }
  540. ob1->left = NIL;
  541. ob1->right = NIL;
  542. __COPY(name, ob1->name, 256);
  543. mnolev = OPT_topScope->mnolev;
  544. ob1->mnolev = mnolev;
  545. break;
  546. }
  547. }
  548. *obj = ob1;
  549. }
  550. static void OPT_FPrintName (INT32 *fp, CHAR *name, ADDRESS name__len)
  551. {
  552. INT16 i;
  553. CHAR ch;
  554. i = 0;
  555. do {
  556. ch = name[__X(i, name__len)];
  557. OPM_FPrint(&*fp, (INT16)ch);
  558. i += 1;
  559. } while (!(ch == 0x00));
  560. }
  561. static void OPT_DebugStruct (OPT_Struct btyp)
  562. {
  563. OPM_LogWLn();
  564. if (btyp == NIL) {
  565. OPM_LogWStr((CHAR*)"btyp is nil", 12);
  566. OPM_LogWLn();
  567. }
  568. OPM_LogWStr((CHAR*)"btyp^.strobji^.name = ", 23);
  569. OPM_LogWStr(btyp->strobj->name, 256);
  570. OPM_LogWLn();
  571. OPM_LogWStr((CHAR*)"btyp^.form = ", 14);
  572. OPM_LogWNum(btyp->form, 0);
  573. OPM_LogWLn();
  574. OPM_LogWStr((CHAR*)"btyp^.comp = ", 14);
  575. OPM_LogWNum(btyp->comp, 0);
  576. OPM_LogWLn();
  577. OPM_LogWStr((CHAR*)"btyp^.mno = ", 13);
  578. OPM_LogWNum(btyp->mno, 0);
  579. OPM_LogWLn();
  580. OPM_LogWStr((CHAR*)"btyp^.extlev = ", 16);
  581. OPM_LogWNum(btyp->extlev, 0);
  582. OPM_LogWLn();
  583. OPM_LogWStr((CHAR*)"btyp^.size = ", 14);
  584. OPM_LogWNum(btyp->size, 0);
  585. OPM_LogWLn();
  586. OPM_LogWStr((CHAR*)"btyp^.align = ", 15);
  587. OPM_LogWNum(btyp->align, 0);
  588. OPM_LogWLn();
  589. OPM_LogWStr((CHAR*)"btyp^.txtpos = ", 16);
  590. OPM_LogWNum(btyp->txtpos, 0);
  591. OPM_LogWLn();
  592. }
  593. static void OPT_FPrintSign (INT32 *fp, OPT_Struct result, OPT_Object par)
  594. {
  595. OPT_IdFPrint(result);
  596. OPM_FPrint(&*fp, result->idfp);
  597. while (par != NIL) {
  598. OPM_FPrint(&*fp, par->mode);
  599. OPT_IdFPrint(par->typ);
  600. OPM_FPrint(&*fp, par->typ->idfp);
  601. par = par->link;
  602. }
  603. }
  604. void OPT_IdFPrint (OPT_Struct typ)
  605. {
  606. OPT_Struct btyp = NIL;
  607. OPT_Object strobj = NIL;
  608. INT32 idfp;
  609. INT16 f, c;
  610. if (!typ->idfpdone) {
  611. typ->idfpdone = 1;
  612. idfp = 0;
  613. f = typ->form;
  614. OPM_FPrint(&idfp, f);
  615. if (__IN(f, 0x90, 32)) {
  616. OPM_FPrint(&idfp, typ->size);
  617. }
  618. c = typ->comp;
  619. OPM_FPrint(&idfp, c);
  620. btyp = typ->BaseTyp;
  621. strobj = typ->strobj;
  622. if ((strobj != NIL && strobj->name[0] != 0x00)) {
  623. OPT_FPrintName(&idfp, (void*)OPT_GlbMod[__X(typ->mno, 64)]->name, 256);
  624. OPT_FPrintName(&idfp, (void*)strobj->name, 256);
  625. }
  626. if ((f == 11 || (c == 4 && btyp != NIL)) || c == 3) {
  627. OPT_IdFPrint(btyp);
  628. OPM_FPrint(&idfp, btyp->idfp);
  629. } else if (c == 2) {
  630. OPT_IdFPrint(btyp);
  631. OPM_FPrint(&idfp, btyp->idfp);
  632. OPM_FPrint(&idfp, typ->n);
  633. } else if (f == 12) {
  634. OPT_FPrintSign(&idfp, btyp, typ->link);
  635. }
  636. typ->idfp = idfp;
  637. }
  638. }
  639. static struct FPrintStr__15 {
  640. INT32 *pbfp, *pvfp;
  641. struct FPrintStr__15 *lnk;
  642. } *FPrintStr__15_s;
  643. static void FPrintFlds__16 (OPT_Object fld, INT32 adr, BOOLEAN visible);
  644. static void FPrintHdFld__18 (OPT_Struct typ, OPT_Object fld, INT32 adr);
  645. static void FPrintTProcs__20 (OPT_Object obj);
  646. static void FPrintHdFld__18 (OPT_Struct typ, OPT_Object fld, INT32 adr)
  647. {
  648. INT32 i, j, n;
  649. OPT_Struct btyp = NIL;
  650. if (typ->comp == 4) {
  651. FPrintFlds__16(typ->link, adr, 0);
  652. } else if (typ->comp == 2) {
  653. btyp = typ->BaseTyp;
  654. n = typ->n;
  655. while (btyp->comp == 2) {
  656. n = btyp->n * n;
  657. btyp = btyp->BaseTyp;
  658. }
  659. if (btyp->form == 11 || btyp->comp == 4) {
  660. j = OPT_nofhdfld;
  661. FPrintHdFld__18(btyp, fld, adr);
  662. if (j != OPT_nofhdfld) {
  663. i = 1;
  664. while ((i < n && OPT_nofhdfld <= 2048)) {
  665. adr += btyp->size;
  666. FPrintHdFld__18(btyp, fld, adr);
  667. i += 1;
  668. }
  669. }
  670. }
  671. } else if (typ->form == 11 || __STRCMP(fld->name, "@ptr") == 0) {
  672. OPM_FPrint(&*FPrintStr__15_s->pvfp, 11);
  673. OPM_FPrint(&*FPrintStr__15_s->pvfp, adr);
  674. OPT_nofhdfld += 1;
  675. }
  676. }
  677. static void FPrintFlds__16 (OPT_Object fld, INT32 adr, BOOLEAN visible)
  678. {
  679. while ((fld != NIL && fld->mode == 4)) {
  680. if ((fld->vis != 0 && visible)) {
  681. OPM_FPrint(&*FPrintStr__15_s->pbfp, fld->vis);
  682. OPT_FPrintName(&*FPrintStr__15_s->pbfp, (void*)fld->name, 256);
  683. OPM_FPrint(&*FPrintStr__15_s->pbfp, fld->adr);
  684. OPT_FPrintStr(fld->typ);
  685. OPM_FPrint(&*FPrintStr__15_s->pbfp, fld->typ->pbfp);
  686. OPM_FPrint(&*FPrintStr__15_s->pvfp, fld->typ->pvfp);
  687. } else {
  688. FPrintHdFld__18(fld->typ, fld, fld->adr + adr);
  689. }
  690. fld = fld->link;
  691. }
  692. }
  693. static void FPrintTProcs__20 (OPT_Object obj)
  694. {
  695. if (obj != NIL) {
  696. FPrintTProcs__20(obj->left);
  697. if (obj->mode == 13) {
  698. if (obj->vis != 0) {
  699. OPM_FPrint(&*FPrintStr__15_s->pbfp, 13);
  700. OPM_FPrint(&*FPrintStr__15_s->pbfp, __ASHR(obj->adr, 16));
  701. OPT_FPrintSign(&*FPrintStr__15_s->pbfp, obj->typ, obj->link);
  702. OPT_FPrintName(&*FPrintStr__15_s->pbfp, (void*)obj->name, 256);
  703. }
  704. }
  705. FPrintTProcs__20(obj->right);
  706. }
  707. }
  708. void OPT_FPrintStr (OPT_Struct typ)
  709. {
  710. INT16 f, c;
  711. OPT_Struct btyp = NIL;
  712. OPT_Object strobj = NIL, bstrobj = NIL;
  713. INT32 pbfp, pvfp;
  714. struct FPrintStr__15 _s;
  715. _s.pbfp = &pbfp;
  716. _s.pvfp = &pvfp;
  717. _s.lnk = FPrintStr__15_s;
  718. FPrintStr__15_s = &_s;
  719. if (!typ->fpdone) {
  720. OPT_IdFPrint(typ);
  721. pbfp = typ->idfp;
  722. if (typ->sysflag != 0) {
  723. OPM_FPrint(&pbfp, typ->sysflag);
  724. }
  725. pvfp = pbfp;
  726. typ->pbfp = pbfp;
  727. typ->pvfp = pvfp;
  728. typ->fpdone = 1;
  729. f = typ->form;
  730. c = typ->comp;
  731. btyp = typ->BaseTyp;
  732. if (f == 11) {
  733. strobj = typ->strobj;
  734. bstrobj = btyp->strobj;
  735. if (((strobj == NIL || strobj->name[0] == 0x00) || bstrobj == NIL) || bstrobj->name[0] == 0x00) {
  736. OPT_FPrintStr(btyp);
  737. OPM_FPrint(&pbfp, btyp->pbfp);
  738. pvfp = pbfp;
  739. }
  740. } else if (f == 12) {
  741. } else if (__IN(c, 0x0c, 32)) {
  742. OPT_FPrintStr(btyp);
  743. OPM_FPrint(&pbfp, btyp->pvfp);
  744. pvfp = pbfp;
  745. } else {
  746. if (btyp != NIL) {
  747. OPT_FPrintStr(btyp);
  748. OPM_FPrint(&pbfp, btyp->pbfp);
  749. OPM_FPrint(&pvfp, btyp->pvfp);
  750. }
  751. OPM_FPrint(&pvfp, typ->size);
  752. OPM_FPrint(&pvfp, typ->align);
  753. OPM_FPrint(&pvfp, typ->n);
  754. OPT_nofhdfld = 0;
  755. FPrintFlds__16(typ->link, 0, 1);
  756. if (OPT_nofhdfld > 2048) {
  757. OPM_Mark(225, typ->txtpos);
  758. }
  759. FPrintTProcs__20(typ->link);
  760. OPM_FPrint(&pvfp, pbfp);
  761. strobj = typ->strobj;
  762. if (strobj == NIL || strobj->name[0] == 0x00) {
  763. pbfp = pvfp;
  764. }
  765. }
  766. typ->pbfp = pbfp;
  767. typ->pvfp = pvfp;
  768. }
  769. FPrintStr__15_s = _s.lnk;
  770. }
  771. void OPT_FPrintObj (OPT_Object obj)
  772. {
  773. INT32 fprint;
  774. INT16 f, m;
  775. REAL rval;
  776. OPT_ConstExt ext = NIL;
  777. if (!obj->fpdone) {
  778. fprint = 0;
  779. obj->fpdone = 1;
  780. OPM_FPrint(&fprint, obj->mode);
  781. if (obj->mode == 3) {
  782. f = obj->typ->form;
  783. OPM_FPrint(&fprint, f);
  784. switch (f) {
  785. case 2: case 3: case 4:
  786. OPM_FPrint(&fprint, obj->conval->intval);
  787. break;
  788. case 7:
  789. OPM_FPrintSet(&fprint, obj->conval->setval);
  790. break;
  791. case 5:
  792. rval = obj->conval->realval;
  793. OPM_FPrintReal(&fprint, rval);
  794. break;
  795. case 6:
  796. OPM_FPrintLReal(&fprint, obj->conval->realval);
  797. break;
  798. case 8:
  799. OPT_FPrintName(&fprint, (void*)*obj->conval->ext, 256);
  800. break;
  801. case 9:
  802. break;
  803. default:
  804. OPT_err(127);
  805. break;
  806. }
  807. } else if (obj->mode == 1) {
  808. OPM_FPrint(&fprint, obj->vis);
  809. OPT_FPrintStr(obj->typ);
  810. OPM_FPrint(&fprint, obj->typ->pbfp);
  811. } else if (__IN(obj->mode, 0x0480, 32)) {
  812. OPT_FPrintSign(&fprint, obj->typ, obj->link);
  813. } else if (obj->mode == 9) {
  814. OPT_FPrintSign(&fprint, obj->typ, obj->link);
  815. ext = obj->conval->ext;
  816. m = (INT16)(*ext)[0];
  817. f = 1;
  818. OPM_FPrint(&fprint, m);
  819. while (f <= m) {
  820. OPM_FPrint(&fprint, (INT16)(*ext)[__X(f, 256)]);
  821. f += 1;
  822. }
  823. } else if (obj->mode == 5) {
  824. OPT_FPrintStr(obj->typ);
  825. OPM_FPrint(&fprint, obj->typ->pbfp);
  826. }
  827. obj->fprint = fprint;
  828. }
  829. }
  830. void OPT_FPrintErr (OPT_Object obj, INT16 errcode)
  831. {
  832. INT16 i, j;
  833. CHAR ch;
  834. if (obj->mnolev != 0) {
  835. __COPY(OPT_GlbMod[__X(-obj->mnolev, 64)]->name, OPM_objname, 64);
  836. i = 0;
  837. while (OPM_objname[__X(i, 64)] != 0x00) {
  838. i += 1;
  839. }
  840. OPM_objname[__X(i, 64)] = '.';
  841. j = 0;
  842. i += 1;
  843. do {
  844. ch = obj->name[__X(j, 256)];
  845. OPM_objname[__X(i, 64)] = ch;
  846. j += 1;
  847. i += 1;
  848. } while (!(ch == 0x00));
  849. } else {
  850. __COPY(obj->name, OPM_objname, 64);
  851. }
  852. if (errcode == 249) {
  853. if (OPM_noerr) {
  854. OPT_err(errcode);
  855. }
  856. } else if (errcode == 253) {
  857. if ((((!OPT_symNew && !OPT_symExtended)) && !OPT_extsf)) {
  858. OPT_err(errcode);
  859. }
  860. OPT_symExtended = 1;
  861. } else {
  862. if ((!OPT_symNew && !OPT_newsf)) {
  863. OPT_err(errcode);
  864. }
  865. OPT_symNew = 1;
  866. }
  867. }
  868. void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old)
  869. {
  870. OPT_Object ob0 = NIL, ob1 = NIL;
  871. BOOLEAN left;
  872. if (*root == NIL) {
  873. *root = obj;
  874. *old = NIL;
  875. } else {
  876. ob0 = *root;
  877. ob1 = ob0->right;
  878. left = 0;
  879. if (__STRCMP(obj->name, ob0->name) < 0) {
  880. ob1 = ob0->left;
  881. left = 1;
  882. } else if (__STRCMP(obj->name, ob0->name) > 0) {
  883. ob1 = ob0->right;
  884. left = 0;
  885. } else {
  886. *old = ob0;
  887. return;
  888. }
  889. for (;;) {
  890. if (ob1 != NIL) {
  891. if (__STRCMP(obj->name, ob1->name) < 0) {
  892. ob0 = ob1;
  893. ob1 = ob1->left;
  894. left = 1;
  895. } else if (__STRCMP(obj->name, ob1->name) > 0) {
  896. ob0 = ob1;
  897. ob1 = ob1->right;
  898. left = 0;
  899. } else {
  900. *old = ob1;
  901. break;
  902. }
  903. } else {
  904. ob1 = obj;
  905. if (left) {
  906. ob0->left = ob1;
  907. } else {
  908. ob0->right = ob1;
  909. }
  910. ob1->left = NIL;
  911. ob1->right = NIL;
  912. *old = NIL;
  913. break;
  914. }
  915. }
  916. }
  917. }
  918. static void OPT_InName (CHAR *name, ADDRESS name__len)
  919. {
  920. INT16 i;
  921. CHAR ch;
  922. i = 0;
  923. do {
  924. OPM_SymRCh(&ch);
  925. name[__X(i, name__len)] = ch;
  926. i += 1;
  927. } while (!(ch == 0x00));
  928. }
  929. static void OPT_InMod (INT8 *mno)
  930. {
  931. OPT_Object head = NIL;
  932. OPS_Name name;
  933. INT32 mn;
  934. INT8 i;
  935. mn = OPM_SymRInt();
  936. if (mn == 0) {
  937. *mno = OPT_impCtxt.glbmno[0];
  938. } else {
  939. if (mn == 16) {
  940. OPT_InName((void*)name, 256);
  941. if ((__STRCMP(name, OPT_SelfName) == 0 && !OPT_impCtxt.self)) {
  942. OPT_err(154);
  943. }
  944. i = 0;
  945. while ((i < OPT_nofGmod && __STRCMP(name, OPT_GlbMod[__X(i, 64)]->name) != 0)) {
  946. i += 1;
  947. }
  948. if (i < OPT_nofGmod) {
  949. *mno = i;
  950. } else {
  951. head = OPT_NewObj();
  952. head->mode = 12;
  953. __COPY(name, head->name, 256);
  954. *mno = OPT_nofGmod;
  955. head->mnolev = -*mno;
  956. if (OPT_nofGmod < 64) {
  957. OPT_GlbMod[__X(*mno, 64)] = head;
  958. OPT_nofGmod += 1;
  959. } else {
  960. OPT_err(227);
  961. }
  962. }
  963. OPT_impCtxt.glbmno[__X(OPT_impCtxt.nofm, 64)] = *mno;
  964. OPT_impCtxt.nofm += 1;
  965. } else {
  966. *mno = OPT_impCtxt.glbmno[__X(-mn, 64)];
  967. }
  968. }
  969. }
  970. static void OPT_InLinks (void)
  971. {
  972. OPS_Name linkname;
  973. OPT_Link l = NIL;
  974. OPT_InName((void*)linkname, 256);
  975. while (linkname[0] != 0x00) {
  976. l = OPT_Links;
  977. while ((l != NIL && __STRCMP(l->name, linkname) != 0)) {
  978. l = l->next;
  979. }
  980. if (l == NIL) {
  981. l = OPT_Links;
  982. __NEW(OPT_Links, OPT_LinkDesc);
  983. OPT_Links->next = l;
  984. __MOVE(linkname, OPT_Links->name, 256);
  985. }
  986. OPT_InName((void*)linkname, 256);
  987. }
  988. }
  989. static void OPT_InConstant (INT32 f, OPT_Const conval)
  990. {
  991. CHAR ch;
  992. INT16 i;
  993. OPT_ConstExt ext = NIL;
  994. REAL rval;
  995. switch (f) {
  996. case 1: case 3: case 2:
  997. OPM_SymRCh(&ch);
  998. conval->intval = (INT16)ch;
  999. break;
  1000. case 4:
  1001. conval->intval = OPM_SymRInt();
  1002. break;
  1003. case 7:
  1004. OPM_SymRSet(&conval->setval);
  1005. break;
  1006. case 5:
  1007. OPM_SymRReal(&rval);
  1008. conval->realval = rval;
  1009. conval->intval = -1;
  1010. break;
  1011. case 6:
  1012. OPM_SymRLReal(&conval->realval);
  1013. conval->intval = -1;
  1014. break;
  1015. case 8:
  1016. ext = OPT_NewExt();
  1017. conval->ext = ext;
  1018. i = 0;
  1019. do {
  1020. OPM_SymRCh(&ch);
  1021. (*ext)[__X(i, 256)] = ch;
  1022. i += 1;
  1023. } while (!(ch == 0x00));
  1024. conval->intval2 = i;
  1025. conval->intval = -1;
  1026. break;
  1027. case 9:
  1028. conval->intval = 0;
  1029. break;
  1030. default:
  1031. OPM_LogWStr((CHAR*)"unhandled case in InConstant(), f = ", 37);
  1032. OPM_LogWNum(f, 0);
  1033. OPM_LogWLn();
  1034. break;
  1035. }
  1036. }
  1037. static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par)
  1038. {
  1039. OPT_Object last = NIL, new = NIL;
  1040. INT32 tag;
  1041. OPT_InStruct(&*res);
  1042. tag = OPM_SymRInt();
  1043. last = NIL;
  1044. while (tag != 18) {
  1045. new = OPT_NewObj();
  1046. new->mnolev = -mno;
  1047. if (last == NIL) {
  1048. *par = new;
  1049. } else {
  1050. last->link = new;
  1051. }
  1052. if (tag == 23) {
  1053. new->mode = 1;
  1054. } else {
  1055. new->mode = 2;
  1056. }
  1057. OPT_InStruct(&new->typ);
  1058. new->adr = OPM_SymRInt();
  1059. OPT_InName((void*)new->name, 256);
  1060. last = new;
  1061. tag = OPM_SymRInt();
  1062. }
  1063. }
  1064. static OPT_Object OPT_InFld (void)
  1065. {
  1066. INT32 tag;
  1067. OPT_Object obj = NIL;
  1068. tag = OPT_impCtxt.nextTag;
  1069. obj = OPT_NewObj();
  1070. if (tag <= 26) {
  1071. obj->mode = 4;
  1072. if (tag == 26) {
  1073. obj->vis = 2;
  1074. } else {
  1075. obj->vis = 1;
  1076. }
  1077. OPT_InStruct(&obj->typ);
  1078. OPT_InName((void*)obj->name, 256);
  1079. obj->adr = OPM_SymRInt();
  1080. } else {
  1081. obj->mode = 4;
  1082. if (tag == 27) {
  1083. __MOVE("@ptr", obj->name, 5);
  1084. } else {
  1085. __MOVE("@proc", obj->name, 6);
  1086. }
  1087. obj->typ = OPT_undftyp;
  1088. obj->vis = 0;
  1089. obj->adr = OPM_SymRInt();
  1090. }
  1091. return obj;
  1092. }
  1093. static OPT_Object OPT_InTProc (INT8 mno)
  1094. {
  1095. INT32 tag;
  1096. OPT_Object obj = NIL;
  1097. tag = OPT_impCtxt.nextTag;
  1098. obj = OPT_NewObj();
  1099. obj->mnolev = -mno;
  1100. if (tag == 29) {
  1101. obj->mode = 13;
  1102. obj->conval = OPT_NewConst();
  1103. obj->conval->intval = -1;
  1104. OPT_InSign(mno, &obj->typ, &obj->link);
  1105. obj->vis = 1;
  1106. OPT_InName((void*)obj->name, 256);
  1107. obj->adr = __ASHL(OPM_SymRInt(), 16);
  1108. } else {
  1109. obj->mode = 13;
  1110. __MOVE("@tproc", obj->name, 7);
  1111. obj->link = OPT_NewObj();
  1112. obj->typ = OPT_undftyp;
  1113. obj->vis = 0;
  1114. obj->adr = __ASHL(OPM_SymRInt(), 16);
  1115. }
  1116. return obj;
  1117. }
  1118. static OPT_Struct OPT_InTyp (INT32 tag)
  1119. {
  1120. if (tag == 4) {
  1121. return OPT_IntType(OPM_SymRInt());
  1122. } else if (tag == 7) {
  1123. return OPT_SetType(OPM_SymRInt());
  1124. } else {
  1125. return OPT_impCtxt.ref[__X(tag, 255)];
  1126. }
  1127. __RETCHK;
  1128. }
  1129. static void OPT_InStruct (OPT_Struct *typ)
  1130. {
  1131. INT8 mno;
  1132. INT16 ref;
  1133. INT32 tag;
  1134. OPS_Name name;
  1135. OPT_Struct t = NIL;
  1136. OPT_Object obj = NIL, last = NIL, fld = NIL, old = NIL, dummy = NIL;
  1137. tag = OPM_SymRInt();
  1138. if (tag != 34) {
  1139. *typ = OPT_InTyp(-tag);
  1140. } else {
  1141. ref = OPT_impCtxt.nofr;
  1142. OPT_impCtxt.nofr += 1;
  1143. if (ref < OPT_impCtxt.minr) {
  1144. OPT_impCtxt.minr = ref;
  1145. }
  1146. OPT_InMod(&mno);
  1147. OPT_InName((void*)name, 256);
  1148. obj = OPT_NewObj();
  1149. if (name[0] == 0x00) {
  1150. if (OPT_impCtxt.self) {
  1151. old = NIL;
  1152. } else {
  1153. __MOVE("@", obj->name, 2);
  1154. OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
  1155. obj->name[0] = 0x00;
  1156. }
  1157. *typ = OPT_NewStr(0, 1);
  1158. } else {
  1159. __MOVE(name, obj->name, 256);
  1160. OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
  1161. if (old != NIL) {
  1162. OPT_FPrintObj(old);
  1163. OPT_impCtxt.pvfp[__X(ref, 255)] = old->typ->pvfp;
  1164. if (OPT_impCtxt.self) {
  1165. *typ = OPT_NewStr(0, 1);
  1166. } else {
  1167. *typ = old->typ;
  1168. (*typ)->link = NIL;
  1169. (*typ)->sysflag = 0;
  1170. (*typ)->fpdone = 0;
  1171. (*typ)->idfpdone = 0;
  1172. }
  1173. } else {
  1174. *typ = OPT_NewStr(0, 1);
  1175. }
  1176. }
  1177. OPT_impCtxt.ref[__X(ref, 255)] = *typ;
  1178. OPT_impCtxt.old[__X(ref, 255)] = old;
  1179. (*typ)->ref = ref + 255;
  1180. (*typ)->mno = mno;
  1181. (*typ)->allocated = 1;
  1182. (*typ)->strobj = obj;
  1183. obj->mode = 5;
  1184. obj->typ = *typ;
  1185. obj->mnolev = -mno;
  1186. obj->vis = 0;
  1187. tag = OPM_SymRInt();
  1188. if (tag == 35) {
  1189. (*typ)->sysflag = (INT16)OPM_SymRInt();
  1190. tag = OPM_SymRInt();
  1191. }
  1192. switch (tag) {
  1193. case 36:
  1194. (*typ)->form = 11;
  1195. (*typ)->size = OPM_AddressSize;
  1196. (*typ)->n = 0;
  1197. OPT_InStruct(&(*typ)->BaseTyp);
  1198. break;
  1199. case 37:
  1200. (*typ)->form = 13;
  1201. (*typ)->comp = 2;
  1202. OPT_InStruct(&(*typ)->BaseTyp);
  1203. (*typ)->n = OPM_SymRInt();
  1204. OPT_TypSize(*typ);
  1205. break;
  1206. case 38:
  1207. (*typ)->form = 13;
  1208. (*typ)->comp = 3;
  1209. OPT_InStruct(&(*typ)->BaseTyp);
  1210. if ((*typ)->BaseTyp->comp == 3) {
  1211. (*typ)->n = (*typ)->BaseTyp->n + 1;
  1212. } else {
  1213. (*typ)->n = 0;
  1214. }
  1215. OPT_TypSize(*typ);
  1216. break;
  1217. case 39:
  1218. (*typ)->form = 13;
  1219. (*typ)->comp = 4;
  1220. OPT_InStruct(&(*typ)->BaseTyp);
  1221. if ((*typ)->BaseTyp == OPT_notyp) {
  1222. (*typ)->BaseTyp = NIL;
  1223. }
  1224. (*typ)->extlev = 0;
  1225. t = (*typ)->BaseTyp;
  1226. while (t != NIL) {
  1227. (*typ)->extlev += 1;
  1228. t = t->BaseTyp;
  1229. }
  1230. (*typ)->size = OPM_SymRInt();
  1231. (*typ)->align = OPM_SymRInt();
  1232. (*typ)->n = OPM_SymRInt();
  1233. OPT_impCtxt.nextTag = OPM_SymRInt();
  1234. last = NIL;
  1235. while ((OPT_impCtxt.nextTag >= 25 && OPT_impCtxt.nextTag <= 28)) {
  1236. fld = OPT_InFld();
  1237. fld->mnolev = -mno;
  1238. if (last != NIL) {
  1239. last->link = fld;
  1240. }
  1241. last = fld;
  1242. OPT_InsertImport(fld, &(*typ)->link, &dummy);
  1243. OPT_impCtxt.nextTag = OPM_SymRInt();
  1244. }
  1245. while (OPT_impCtxt.nextTag != 18) {
  1246. fld = OPT_InTProc(mno);
  1247. OPT_InsertImport(fld, &(*typ)->link, &dummy);
  1248. OPT_impCtxt.nextTag = OPM_SymRInt();
  1249. }
  1250. break;
  1251. case 40:
  1252. (*typ)->form = 12;
  1253. (*typ)->size = OPM_AddressSize;
  1254. OPT_InSign(mno, &(*typ)->BaseTyp, &(*typ)->link);
  1255. break;
  1256. default:
  1257. OPM_LogWStr((CHAR*)"unhandled case at InStruct, tag = ", 35);
  1258. OPM_LogWNum(tag, 0);
  1259. OPM_LogWLn();
  1260. break;
  1261. }
  1262. if (ref == OPT_impCtxt.minr) {
  1263. while (ref < OPT_impCtxt.nofr) {
  1264. t = OPT_InTyp(ref);
  1265. OPT_FPrintStr(t);
  1266. obj = t->strobj;
  1267. if (obj->name[0] != 0x00) {
  1268. OPT_FPrintObj(obj);
  1269. }
  1270. old = OPT_impCtxt.old[__X(ref, 255)];
  1271. if (old != NIL) {
  1272. t->strobj = old;
  1273. if (OPT_impCtxt.self) {
  1274. if (old->mnolev < 0) {
  1275. if (old->history != 5) {
  1276. if (old->fprint != obj->fprint) {
  1277. old->history = 2;
  1278. } else if (OPT_impCtxt.pvfp[__X(ref, 255)] != t->pvfp) {
  1279. old->history = 3;
  1280. }
  1281. }
  1282. } else if (old->fprint != obj->fprint) {
  1283. old->history = 2;
  1284. } else if (OPT_impCtxt.pvfp[__X(ref, 255)] != t->pvfp) {
  1285. old->history = 3;
  1286. } else if (old->vis == 0) {
  1287. old->history = 1;
  1288. } else {
  1289. old->history = 0;
  1290. }
  1291. } else {
  1292. if (OPT_impCtxt.pvfp[__X(ref, 255)] != t->pvfp) {
  1293. old->history = 5;
  1294. }
  1295. if (old->fprint != obj->fprint) {
  1296. OPT_FPrintErr(old, 249);
  1297. }
  1298. }
  1299. } else if (OPT_impCtxt.self) {
  1300. obj->history = 4;
  1301. } else {
  1302. obj->history = 1;
  1303. }
  1304. ref += 1;
  1305. }
  1306. OPT_impCtxt.minr = 255;
  1307. }
  1308. }
  1309. }
  1310. static OPT_Object OPT_InObj (INT8 mno)
  1311. {
  1312. INT16 i, s;
  1313. CHAR ch;
  1314. OPT_Object obj = NIL, old = NIL;
  1315. OPT_Struct typ = NIL;
  1316. INT32 tag;
  1317. OPT_ConstExt ext = NIL;
  1318. tag = OPT_impCtxt.nextTag;
  1319. if (tag == 19) {
  1320. OPT_InStruct(&typ);
  1321. obj = typ->strobj;
  1322. if (!OPT_impCtxt.self) {
  1323. obj->vis = 1;
  1324. }
  1325. } else {
  1326. obj = OPT_NewObj();
  1327. obj->mnolev = -mno;
  1328. obj->vis = 1;
  1329. if (tag <= 11) {
  1330. obj->mode = 3;
  1331. obj->conval = OPT_NewConst();
  1332. OPT_InConstant(tag, obj->conval);
  1333. obj->typ = OPT_InTyp(tag);
  1334. } else if (tag >= 31) {
  1335. obj->conval = OPT_NewConst();
  1336. obj->conval->intval = -1;
  1337. OPT_InSign(mno, &obj->typ, &obj->link);
  1338. switch (tag) {
  1339. case 31:
  1340. obj->mode = 7;
  1341. break;
  1342. case 32:
  1343. obj->mode = 10;
  1344. break;
  1345. case 33:
  1346. obj->mode = 9;
  1347. ext = OPT_NewExt();
  1348. obj->conval->ext = ext;
  1349. s = (INT16)OPM_SymRInt();
  1350. (*ext)[0] = (CHAR)s;
  1351. i = 1;
  1352. while (i <= s) {
  1353. OPM_SymRCh(&(*ext)[__X(i, 256)]);
  1354. i += 1;
  1355. }
  1356. break;
  1357. default:
  1358. OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", 32);
  1359. OPM_LogWNum(tag, 0);
  1360. OPM_LogWLn();
  1361. break;
  1362. }
  1363. } else if (tag == 20) {
  1364. obj->mode = 5;
  1365. OPT_InStruct(&obj->typ);
  1366. } else {
  1367. obj->mode = 1;
  1368. if (tag == 22) {
  1369. obj->vis = 2;
  1370. }
  1371. OPT_InStruct(&obj->typ);
  1372. }
  1373. OPT_InName((void*)obj->name, 256);
  1374. }
  1375. OPT_FPrintObj(obj);
  1376. if ((obj->mode == 1 && (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00))) {
  1377. OPM_FPrint(&OPT_impCtxt.reffp, obj->typ->ref - 255);
  1378. }
  1379. if (tag != 19) {
  1380. OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
  1381. if (OPT_impCtxt.self) {
  1382. if (old != NIL) {
  1383. if (old->vis == 0) {
  1384. old->history = 4;
  1385. } else {
  1386. OPT_FPrintObj(old);
  1387. if (obj->fprint != old->fprint) {
  1388. old->history = 2;
  1389. } else if (obj->typ->pvfp != old->typ->pvfp) {
  1390. old->history = 3;
  1391. } else {
  1392. old->history = 1;
  1393. }
  1394. }
  1395. } else {
  1396. obj->history = 4;
  1397. }
  1398. }
  1399. } else {
  1400. if (OPT_impCtxt.self) {
  1401. if (obj->vis == 0) {
  1402. obj->history = 4;
  1403. } else if (obj->history == 0) {
  1404. obj->history = 1;
  1405. }
  1406. }
  1407. }
  1408. return obj;
  1409. }
  1410. void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
  1411. {
  1412. OPT_Object obj = NIL;
  1413. INT8 mno;
  1414. OPS_Name aliasName__copy;
  1415. __DUPARR(aliasName, OPS_Name);
  1416. if (__STRCMP(name, "SYSTEM") == 0) {
  1417. OPT_SYSimported = 1;
  1418. OPT_Insert(aliasName, &obj);
  1419. obj->mode = 11;
  1420. obj->mnolev = 0;
  1421. obj->scope = OPT_syslink;
  1422. obj->typ = OPT_notyp;
  1423. } else {
  1424. OPT_impCtxt.nofr = 14;
  1425. OPT_impCtxt.minr = 255;
  1426. OPT_impCtxt.nofm = 0;
  1427. OPT_impCtxt.self = __STRCMP(aliasName, "@self") == 0;
  1428. OPT_impCtxt.reffp = 0;
  1429. if ((OPT_impCtxt.self && __IN(17, OPM_Options, 32))) {
  1430. OPM_DeleteSym((void*)name, 256);
  1431. *done = 0;
  1432. } else {
  1433. OPM_OldSym((void*)name, 256, &*done);
  1434. }
  1435. if (*done) {
  1436. OPT_InMod(&mno);
  1437. OPT_InLinks();
  1438. OPT_impCtxt.nextTag = OPM_SymRInt();
  1439. while (!OPM_eofSF()) {
  1440. obj = OPT_InObj(mno);
  1441. OPT_impCtxt.nextTag = OPM_SymRInt();
  1442. }
  1443. OPT_Insert(aliasName, &obj);
  1444. obj->mode = 11;
  1445. obj->scope = OPT_GlbMod[__X(mno, 64)]->right;
  1446. OPT_GlbMod[__X(mno, 64)]->link = obj;
  1447. obj->mnolev = -mno;
  1448. obj->typ = OPT_notyp;
  1449. OPM_CloseOldSym();
  1450. } else if (OPT_impCtxt.self) {
  1451. OPT_newsf = 1;
  1452. OPT_extsf = 1;
  1453. OPT_sfpresent = 0;
  1454. } else {
  1455. OPT_err(152);
  1456. }
  1457. }
  1458. }
  1459. static void OPT_OutName (CHAR *name, ADDRESS name__len)
  1460. {
  1461. INT16 i;
  1462. CHAR ch;
  1463. i = 0;
  1464. do {
  1465. ch = name[__X(i, name__len)];
  1466. OPM_SymWCh(ch);
  1467. i += 1;
  1468. } while (!(ch == 0x00));
  1469. }
  1470. static void OPT_OutMod (INT16 mno)
  1471. {
  1472. if (OPT_expCtxt.locmno[__X(mno, 64)] < 0) {
  1473. OPM_SymWInt(16);
  1474. OPT_expCtxt.locmno[__X(mno, 64)] = OPT_expCtxt.nofm;
  1475. OPT_expCtxt.nofm += 1;
  1476. OPT_OutName((void*)OPT_GlbMod[__X(mno, 64)]->name, 256);
  1477. } else {
  1478. OPM_SymWInt(-OPT_expCtxt.locmno[__X(mno, 64)]);
  1479. }
  1480. }
  1481. static void OPT_OutLinks (void)
  1482. {
  1483. OPT_Link l = NIL;
  1484. l = OPT_Links;
  1485. while (l != NIL) {
  1486. OPT_OutName((void*)l->name, 256);
  1487. l = l->next;
  1488. }
  1489. OPM_SymWCh(0x00);
  1490. }
  1491. static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr)
  1492. {
  1493. INT32 i, j, n;
  1494. OPT_Struct btyp = NIL;
  1495. if (typ->comp == 4) {
  1496. OPT_OutFlds(typ->link, adr, 0);
  1497. } else if (typ->comp == 2) {
  1498. btyp = typ->BaseTyp;
  1499. n = typ->n;
  1500. while (btyp->comp == 2) {
  1501. n = btyp->n * n;
  1502. btyp = btyp->BaseTyp;
  1503. }
  1504. if (btyp->form == 11 || btyp->comp == 4) {
  1505. j = OPT_nofhdfld;
  1506. OPT_OutHdFld(btyp, fld, adr);
  1507. if (j != OPT_nofhdfld) {
  1508. i = 1;
  1509. while ((i < n && OPT_nofhdfld <= 2048)) {
  1510. adr += btyp->size;
  1511. OPT_OutHdFld(btyp, fld, adr);
  1512. i += 1;
  1513. }
  1514. }
  1515. }
  1516. } else if (typ->form == 11 || __STRCMP(fld->name, "@ptr") == 0) {
  1517. OPM_SymWInt(27);
  1518. OPM_SymWInt(adr);
  1519. OPT_nofhdfld += 1;
  1520. }
  1521. }
  1522. static void OPT_OutFlds (OPT_Object fld, INT32 adr, BOOLEAN visible)
  1523. {
  1524. while ((fld != NIL && fld->mode == 4)) {
  1525. if ((fld->vis != 0 && visible)) {
  1526. if (fld->vis == 2) {
  1527. OPM_SymWInt(26);
  1528. } else {
  1529. OPM_SymWInt(25);
  1530. }
  1531. OPT_OutStr(fld->typ);
  1532. OPT_OutName((void*)fld->name, 256);
  1533. OPM_SymWInt(fld->adr);
  1534. } else {
  1535. OPT_OutHdFld(fld->typ, fld, fld->adr + adr);
  1536. }
  1537. fld = fld->link;
  1538. }
  1539. }
  1540. static void OPT_OutSign (OPT_Struct result, OPT_Object par)
  1541. {
  1542. OPT_OutStr(result);
  1543. while (par != NIL) {
  1544. if (par->mode == 1) {
  1545. OPM_SymWInt(23);
  1546. } else {
  1547. OPM_SymWInt(24);
  1548. }
  1549. OPT_OutStr(par->typ);
  1550. OPM_SymWInt(par->adr);
  1551. OPT_OutName((void*)par->name, 256);
  1552. par = par->link;
  1553. }
  1554. OPM_SymWInt(18);
  1555. }
  1556. static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj)
  1557. {
  1558. if (obj != NIL) {
  1559. OPT_OutTProcs(typ, obj->left);
  1560. if (obj->mode == 13) {
  1561. if ((((typ->BaseTyp != NIL && __ASHR(obj->adr, 16) < typ->BaseTyp->n)) && obj->vis == 0)) {
  1562. OPM_Mark(109, typ->txtpos);
  1563. }
  1564. if (obj->vis != 0) {
  1565. if (obj->vis != 0) {
  1566. OPM_SymWInt(29);
  1567. OPT_OutSign(obj->typ, obj->link);
  1568. OPT_OutName((void*)obj->name, 256);
  1569. OPM_SymWInt(__ASHR(obj->adr, 16));
  1570. } else {
  1571. OPM_SymWInt(30);
  1572. OPM_SymWInt(__ASHR(obj->adr, 16));
  1573. }
  1574. }
  1575. }
  1576. OPT_OutTProcs(typ, obj->right);
  1577. }
  1578. }
  1579. static void OPT_OutStr (OPT_Struct typ)
  1580. {
  1581. OPT_Object strobj = NIL;
  1582. if (typ->ref < OPT_expCtxt.ref) {
  1583. OPM_SymWInt(-typ->ref);
  1584. if (__IN(typ->ref, 0x90, 32)) {
  1585. OPM_SymWInt(typ->size);
  1586. }
  1587. } else {
  1588. OPM_SymWInt(34);
  1589. typ->ref = OPT_expCtxt.ref;
  1590. OPT_expCtxt.ref += 1;
  1591. if (OPT_expCtxt.ref >= 255) {
  1592. OPT_err(228);
  1593. }
  1594. OPT_OutMod(typ->mno);
  1595. strobj = typ->strobj;
  1596. if ((strobj != NIL && strobj->name[0] != 0x00)) {
  1597. OPT_OutName((void*)strobj->name, 256);
  1598. switch (strobj->history) {
  1599. case 2:
  1600. OPT_FPrintErr(strobj, 252);
  1601. break;
  1602. case 3:
  1603. OPT_FPrintErr(strobj, 251);
  1604. break;
  1605. case 5:
  1606. OPT_FPrintErr(strobj, 249);
  1607. break;
  1608. default:
  1609. break;
  1610. }
  1611. } else {
  1612. OPM_SymWCh(0x00);
  1613. }
  1614. if (typ->sysflag != 0) {
  1615. OPM_SymWInt(35);
  1616. OPM_SymWInt(typ->sysflag);
  1617. }
  1618. switch (typ->form) {
  1619. case 11:
  1620. OPM_SymWInt(36);
  1621. OPT_OutStr(typ->BaseTyp);
  1622. break;
  1623. case 12:
  1624. OPM_SymWInt(40);
  1625. OPT_OutSign(typ->BaseTyp, typ->link);
  1626. break;
  1627. case 13:
  1628. switch (typ->comp) {
  1629. case 2:
  1630. OPM_SymWInt(37);
  1631. OPT_OutStr(typ->BaseTyp);
  1632. OPM_SymWInt(typ->n);
  1633. break;
  1634. case 3:
  1635. OPM_SymWInt(38);
  1636. OPT_OutStr(typ->BaseTyp);
  1637. break;
  1638. case 4:
  1639. OPM_SymWInt(39);
  1640. if (typ->BaseTyp == NIL) {
  1641. OPT_OutStr(OPT_notyp);
  1642. } else {
  1643. OPT_OutStr(typ->BaseTyp);
  1644. }
  1645. OPM_SymWInt(typ->size);
  1646. OPM_SymWInt(typ->align);
  1647. OPM_SymWInt(typ->n);
  1648. OPT_nofhdfld = 0;
  1649. OPT_OutFlds(typ->link, 0, 1);
  1650. if (OPT_nofhdfld > 2048) {
  1651. OPM_Mark(223, typ->txtpos);
  1652. }
  1653. OPT_OutTProcs(typ, typ->link);
  1654. OPM_SymWInt(18);
  1655. break;
  1656. default:
  1657. OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.comp = ", 39);
  1658. OPM_LogWNum(typ->comp, 0);
  1659. OPM_LogWLn();
  1660. break;
  1661. }
  1662. break;
  1663. default:
  1664. OPM_LogWStr((CHAR*)"unhandled case at OutStr, typ^.form = ", 39);
  1665. OPM_LogWNum(typ->form, 0);
  1666. OPM_LogWLn();
  1667. break;
  1668. }
  1669. }
  1670. }
  1671. static void OPT_OutConstant (OPT_Object obj)
  1672. {
  1673. INT16 f;
  1674. REAL rval;
  1675. f = obj->typ->form;
  1676. OPM_SymWInt(f);
  1677. switch (f) {
  1678. case 2: case 3:
  1679. OPM_SymWCh((CHAR)obj->conval->intval);
  1680. break;
  1681. case 4:
  1682. OPM_SymWInt(obj->conval->intval);
  1683. OPM_SymWInt(obj->typ->size);
  1684. break;
  1685. case 7:
  1686. OPM_SymWSet(obj->conval->setval);
  1687. OPM_SymWInt(obj->typ->size);
  1688. break;
  1689. case 5:
  1690. rval = obj->conval->realval;
  1691. OPM_SymWReal(rval);
  1692. break;
  1693. case 6:
  1694. OPM_SymWLReal(obj->conval->realval);
  1695. break;
  1696. case 8:
  1697. OPT_OutName((void*)*obj->conval->ext, 256);
  1698. break;
  1699. case 9:
  1700. break;
  1701. default:
  1702. OPT_err(127);
  1703. break;
  1704. }
  1705. }
  1706. static void OPT_OutObj (OPT_Object obj)
  1707. {
  1708. INT16 i, j;
  1709. OPT_ConstExt ext = NIL;
  1710. if (obj != NIL) {
  1711. OPT_OutObj(obj->left);
  1712. if (__IN(obj->mode, 0x06ea, 32)) {
  1713. if (obj->history == 4) {
  1714. OPT_FPrintErr(obj, 250);
  1715. } else if (obj->vis != 0) {
  1716. switch (obj->history) {
  1717. case 0:
  1718. OPT_FPrintErr(obj, 253);
  1719. break;
  1720. case 1:
  1721. break;
  1722. case 2:
  1723. OPT_FPrintErr(obj, 252);
  1724. break;
  1725. case 3:
  1726. OPT_FPrintErr(obj, 251);
  1727. break;
  1728. default:
  1729. OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj^.history = ", 42);
  1730. OPM_LogWNum(obj->history, 0);
  1731. OPM_LogWLn();
  1732. break;
  1733. }
  1734. switch (obj->mode) {
  1735. case 3:
  1736. OPT_OutConstant(obj);
  1737. OPT_OutName((void*)obj->name, 256);
  1738. break;
  1739. case 5:
  1740. if (obj->typ->strobj == obj) {
  1741. OPM_SymWInt(19);
  1742. OPT_OutStr(obj->typ);
  1743. } else {
  1744. OPM_SymWInt(20);
  1745. OPT_OutStr(obj->typ);
  1746. OPT_OutName((void*)obj->name, 256);
  1747. }
  1748. break;
  1749. case 1:
  1750. if (obj->vis == 2) {
  1751. OPM_SymWInt(22);
  1752. } else {
  1753. OPM_SymWInt(21);
  1754. }
  1755. OPT_OutStr(obj->typ);
  1756. OPT_OutName((void*)obj->name, 256);
  1757. if (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00) {
  1758. OPM_FPrint(&OPT_expCtxt.reffp, obj->typ->ref);
  1759. }
  1760. break;
  1761. case 7:
  1762. OPM_SymWInt(31);
  1763. OPT_OutSign(obj->typ, obj->link);
  1764. OPT_OutName((void*)obj->name, 256);
  1765. break;
  1766. case 10:
  1767. OPM_SymWInt(32);
  1768. OPT_OutSign(obj->typ, obj->link);
  1769. OPT_OutName((void*)obj->name, 256);
  1770. break;
  1771. case 9:
  1772. OPM_SymWInt(33);
  1773. OPT_OutSign(obj->typ, obj->link);
  1774. ext = obj->conval->ext;
  1775. j = (INT16)(*ext)[0];
  1776. i = 1;
  1777. OPM_SymWInt(j);
  1778. while (i <= j) {
  1779. OPM_SymWCh((*ext)[__X(i, 256)]);
  1780. i += 1;
  1781. }
  1782. OPT_OutName((void*)obj->name, 256);
  1783. break;
  1784. default:
  1785. OPM_LogWStr((CHAR*)"unhandled case at OutObj, obj.mode = ", 38);
  1786. OPM_LogWNum(obj->mode, 0);
  1787. OPM_LogWLn();
  1788. break;
  1789. }
  1790. }
  1791. }
  1792. OPT_OutObj(obj->right);
  1793. }
  1794. }
  1795. void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
  1796. {
  1797. INT16 i;
  1798. INT8 nofmod;
  1799. BOOLEAN done;
  1800. OPT_symExtended = 0;
  1801. OPT_symNew = 0;
  1802. nofmod = OPT_nofGmod;
  1803. OPT_Import((CHAR*)"@self", OPT_SelfName, &done);
  1804. OPT_nofGmod = nofmod;
  1805. if (OPM_noerr) {
  1806. OPM_NewSym((void*)OPT_SelfName, 256);
  1807. if (OPM_noerr) {
  1808. OPM_SymWInt(16);
  1809. OPT_OutName((void*)OPT_SelfName, 256);
  1810. OPT_OutLinks();
  1811. OPT_expCtxt.reffp = 0;
  1812. OPT_expCtxt.ref = 14;
  1813. OPT_expCtxt.nofm = 1;
  1814. OPT_expCtxt.locmno[0] = 0;
  1815. i = 1;
  1816. while (i < 64) {
  1817. OPT_expCtxt.locmno[__X(i, 64)] = -1;
  1818. i += 1;
  1819. }
  1820. OPT_OutObj(OPT_topScope->right);
  1821. *ext = (OPT_sfpresent && OPT_symExtended);
  1822. *new = (!OPT_sfpresent || OPT_symNew) || __IN(17, OPM_Options, 32);
  1823. if ((((OPM_noerr && OPT_sfpresent)) && OPT_impCtxt.reffp != OPT_expCtxt.reffp)) {
  1824. *new = 1;
  1825. if (!OPT_extsf) {
  1826. OPT_err(155);
  1827. }
  1828. }
  1829. OPT_newsf = 0;
  1830. OPT_symNew = 0;
  1831. if (!OPM_noerr || OPT_findpc) {
  1832. OPM_DeleteSym((void*)OPT_SelfName, 256);
  1833. }
  1834. }
  1835. }
  1836. }
  1837. static void OPT_InitStruct (OPT_Struct *typ, INT8 form)
  1838. {
  1839. *typ = OPT_NewStr(form, 1);
  1840. (*typ)->ref = form;
  1841. (*typ)->size = 1;
  1842. (*typ)->allocated = 1;
  1843. (*typ)->strobj = OPT_NewObj();
  1844. (*typ)->pbfp = form;
  1845. (*typ)->pvfp = form;
  1846. (*typ)->fpdone = 1;
  1847. (*typ)->idfp = form;
  1848. (*typ)->idfpdone = 1;
  1849. }
  1850. static void OPT_EnterBoolConst (OPS_Name name, INT32 value)
  1851. {
  1852. OPT_Object obj = NIL;
  1853. OPS_Name name__copy;
  1854. __DUPARR(name, OPS_Name);
  1855. OPT_Insert(name, &obj);
  1856. obj->conval = OPT_NewConst();
  1857. obj->mode = 3;
  1858. obj->typ = OPT_booltyp;
  1859. obj->conval->intval = value;
  1860. }
  1861. static void OPT_EnterTyp (OPS_Name name, INT8 form, INT16 size, OPT_Struct *res)
  1862. {
  1863. OPT_Object obj = NIL;
  1864. OPT_Struct typ = NIL;
  1865. OPS_Name name__copy;
  1866. __DUPARR(name, OPS_Name);
  1867. OPT_Insert(name, &obj);
  1868. typ = OPT_NewStr(form, 1);
  1869. obj->mode = 5;
  1870. obj->typ = typ;
  1871. obj->vis = 1;
  1872. typ->strobj = obj;
  1873. typ->size = size;
  1874. typ->ref = form;
  1875. typ->allocated = 1;
  1876. typ->pbfp = form;
  1877. typ->pvfp = form;
  1878. typ->fpdone = 1;
  1879. typ->idfp = form;
  1880. typ->idfpdone = 1;
  1881. if (__IN(form, 0x90, 32)) {
  1882. OPM_FPrint(&typ->idfp, typ->size);
  1883. }
  1884. *res = typ;
  1885. }
  1886. static void OPT_EnterTypeAlias (OPS_Name name, OPT_Object *res)
  1887. {
  1888. OPT_Object obj = NIL;
  1889. OPS_Name name__copy;
  1890. __DUPARR(name, OPS_Name);
  1891. OPT_Insert(name, &obj);
  1892. obj->mode = 5;
  1893. obj->typ = NIL;
  1894. obj->vis = 1;
  1895. *res = obj;
  1896. }
  1897. static void OPT_EnterProc (OPS_Name name, INT16 num)
  1898. {
  1899. OPT_Object obj = NIL;
  1900. OPS_Name name__copy;
  1901. __DUPARR(name, OPS_Name);
  1902. OPT_Insert(name, &obj);
  1903. obj->mode = 8;
  1904. obj->typ = OPT_notyp;
  1905. obj->adr = num;
  1906. }
  1907. static void EnumPtrs(void (*P)(void*))
  1908. {
  1909. P(OPT_topScope);
  1910. P(OPT_undftyp);
  1911. P(OPT_niltyp);
  1912. P(OPT_notyp);
  1913. P(OPT_bytetyp);
  1914. P(OPT_cpbytetyp);
  1915. P(OPT_booltyp);
  1916. P(OPT_chartyp);
  1917. P(OPT_sinttyp);
  1918. P(OPT_inttyp);
  1919. P(OPT_linttyp);
  1920. P(OPT_hinttyp);
  1921. P(OPT_int8typ);
  1922. P(OPT_int16typ);
  1923. P(OPT_int32typ);
  1924. P(OPT_int64typ);
  1925. P(OPT_settyp);
  1926. P(OPT_set32typ);
  1927. P(OPT_set64typ);
  1928. P(OPT_realtyp);
  1929. P(OPT_lrltyp);
  1930. P(OPT_stringtyp);
  1931. P(OPT_adrtyp);
  1932. P(OPT_sysptrtyp);
  1933. P(OPT_sintobj);
  1934. P(OPT_intobj);
  1935. P(OPT_lintobj);
  1936. P(OPT_setobj);
  1937. __ENUMP(OPT_GlbMod, 64, P);
  1938. P(OPT_universe);
  1939. P(OPT_syslink);
  1940. __ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 3140, 1, P);
  1941. P(OPT_Links);
  1942. }
  1943. __TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 32), {0, -8}};
  1944. __TDESC(OPT_ObjDesc, 1, 6) = {__TDFLDS("ObjDesc", 304), {0, 4, 8, 12, 284, 288, -28}};
  1945. __TDESC(OPT_StrDesc, 1, 3) = {__TDFLDS("StrDesc", 56), {44, 48, 52, -16}};
  1946. __TDESC(OPT_NodeDesc, 1, 6) = {__TDFLDS("NodeDesc", 28), {0, 4, 8, 16, 20, 24, -28}};
  1947. __TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 3140), {16, 20, 24, 28, 32, 36, 40, 44, 48, 52, 56, 60, 64, 68, 72, 76,
  1948. 80, 84, 88, 92, 96, 100, 104, 108, 112, 116, 120, 124, 128, 132, 136, 140,
  1949. 144, 148, 152, 156, 160, 164, 168, 172, 176, 180, 184, 188, 192, 196, 200, 204,
  1950. 208, 212, 216, 220, 224, 228, 232, 236, 240, 244, 248, 252, 256, 260, 264, 268,
  1951. 272, 276, 280, 284, 288, 292, 296, 300, 304, 308, 312, 316, 320, 324, 328, 332,
  1952. 336, 340, 344, 348, 352, 356, 360, 364, 368, 372, 376, 380, 384, 388, 392, 396,
  1953. 400, 404, 408, 412, 416, 420, 424, 428, 432, 436, 440, 444, 448, 452, 456, 460,
  1954. 464, 468, 472, 476, 480, 484, 488, 492, 496, 500, 504, 508, 512, 516, 520, 524,
  1955. 528, 532, 536, 540, 544, 548, 552, 556, 560, 564, 568, 572, 576, 580, 584, 588,
  1956. 592, 596, 600, 604, 608, 612, 616, 620, 624, 628, 632, 636, 640, 644, 648, 652,
  1957. 656, 660, 664, 668, 672, 676, 680, 684, 688, 692, 696, 700, 704, 708, 712, 716,
  1958. 720, 724, 728, 732, 736, 740, 744, 748, 752, 756, 760, 764, 768, 772, 776, 780,
  1959. 784, 788, 792, 796, 800, 804, 808, 812, 816, 820, 824, 828, 832, 836, 840, 844,
  1960. 848, 852, 856, 860, 864, 868, 872, 876, 880, 884, 888, 892, 896, 900, 904, 908,
  1961. 912, 916, 920, 924, 928, 932, 936, 940, 944, 948, 952, 956, 960, 964, 968, 972,
  1962. 976, 980, 984, 988, 992, 996, 1000, 1004, 1008, 1012, 1016, 1020, 1024, 1028, 1032, 1036,
  1963. 1040, 1044, 1048, 1052, 1056, 1060, 1064, 1068, 1072, 1076, 1080, 1084, 1088, 1092, 1096, 1100,
  1964. 1104, 1108, 1112, 1116, 1120, 1124, 1128, 1132, 1136, 1140, 1144, 1148, 1152, 1156, 1160, 1164,
  1965. 1168, 1172, 1176, 1180, 1184, 1188, 1192, 1196, 1200, 1204, 1208, 1212, 1216, 1220, 1224, 1228,
  1966. 1232, 1236, 1240, 1244, 1248, 1252, 1256, 1260, 1264, 1268, 1272, 1276, 1280, 1284, 1288, 1292,
  1967. 1296, 1300, 1304, 1308, 1312, 1316, 1320, 1324, 1328, 1332, 1336, 1340, 1344, 1348, 1352, 1356,
  1968. 1360, 1364, 1368, 1372, 1376, 1380, 1384, 1388, 1392, 1396, 1400, 1404, 1408, 1412, 1416, 1420,
  1969. 1424, 1428, 1432, 1436, 1440, 1444, 1448, 1452, 1456, 1460, 1464, 1468, 1472, 1476, 1480, 1484,
  1970. 1488, 1492, 1496, 1500, 1504, 1508, 1512, 1516, 1520, 1524, 1528, 1532, 1536, 1540, 1544, 1548,
  1971. 1552, 1556, 1560, 1564, 1568, 1572, 1576, 1580, 1584, 1588, 1592, 1596, 1600, 1604, 1608, 1612,
  1972. 1616, 1620, 1624, 1628, 1632, 1636, 1640, 1644, 1648, 1652, 1656, 1660, 1664, 1668, 1672, 1676,
  1973. 1680, 1684, 1688, 1692, 1696, 1700, 1704, 1708, 1712, 1716, 1720, 1724, 1728, 1732, 1736, 1740,
  1974. 1744, 1748, 1752, 1756, 1760, 1764, 1768, 1772, 1776, 1780, 1784, 1788, 1792, 1796, 1800, 1804,
  1975. 1808, 1812, 1816, 1820, 1824, 1828, 1832, 1836, 1840, 1844, 1848, 1852, 1856, 1860, 1864, 1868,
  1976. 1872, 1876, 1880, 1884, 1888, 1892, 1896, 1900, 1904, 1908, 1912, 1916, 1920, 1924, 1928, 1932,
  1977. 1936, 1940, 1944, 1948, 1952, 1956, 1960, 1964, 1968, 1972, 1976, 1980, 1984, 1988, 1992, 1996,
  1978. 2000, 2004, 2008, 2012, 2016, 2020, 2024, 2028, 2032, 2036, 2040, 2044, 2048, 2052, -2044}};
  1979. __TDESC(OPT_ExpCtxt, 1, 0) = {__TDFLDS("ExpCtxt", 72), {-4}};
  1980. __TDESC(OPT_LinkDesc, 1, 1) = {__TDFLDS("LinkDesc", 260), {256, -8}};
  1981. export void *OPT__init(void)
  1982. {
  1983. __DEFMOD;
  1984. __MODULE_IMPORT(OPM);
  1985. __MODULE_IMPORT(OPS);
  1986. __REGMOD("OPT", EnumPtrs);
  1987. __REGCMD("Close", OPT_Close);
  1988. __REGCMD("CloseScope", OPT_CloseScope);
  1989. __REGCMD("InitRecno", OPT_InitRecno);
  1990. __INITYP(OPT_ConstDesc, OPT_ConstDesc, 0);
  1991. __INITYP(OPT_ObjDesc, OPT_ObjDesc, 0);
  1992. __INITYP(OPT_StrDesc, OPT_StrDesc, 0);
  1993. __INITYP(OPT_NodeDesc, OPT_NodeDesc, 0);
  1994. __INITYP(OPT_ImpCtxt, OPT_ImpCtxt, 0);
  1995. __INITYP(OPT_ExpCtxt, OPT_ExpCtxt, 0);
  1996. __INITYP(OPT_LinkDesc, OPT_LinkDesc, 0);
  1997. /* BEGIN */
  1998. OPT_topScope = NIL;
  1999. OPT_OpenScope(0, NIL);
  2000. OPM_errpos = 0;
  2001. OPT_InitStruct(&OPT_undftyp, 0);
  2002. OPT_undftyp->BaseTyp = OPT_undftyp;
  2003. OPT_InitStruct(&OPT_notyp, 10);
  2004. OPT_InitStruct(&OPT_stringtyp, 8);
  2005. OPT_InitStruct(&OPT_niltyp, 9);
  2006. OPT_EnterTyp((CHAR*)"BYTE", 1, 1, &OPT_bytetyp);
  2007. OPT_EnterTyp((CHAR*)"PTR", 11, -1, &OPT_sysptrtyp);
  2008. OPT_EnterTyp((CHAR*)"ADDRESS", 4, -1, &OPT_adrtyp);
  2009. OPT_EnterTyp((CHAR*)"INT8", 4, 1, &OPT_int8typ);
  2010. OPT_EnterTyp((CHAR*)"INT16", 4, 2, &OPT_int16typ);
  2011. OPT_EnterTyp((CHAR*)"INT32", 4, 4, &OPT_int32typ);
  2012. OPT_EnterTyp((CHAR*)"INT64", 4, 8, &OPT_int64typ);
  2013. OPT_EnterTyp((CHAR*)"SET32", 7, 4, &OPT_set32typ);
  2014. OPT_EnterTyp((CHAR*)"SET64", 7, 8, &OPT_set64typ);
  2015. OPT_EnterProc((CHAR*)"ADR", 21);
  2016. OPT_EnterProc((CHAR*)"CC", 22);
  2017. OPT_EnterProc((CHAR*)"LSH", 23);
  2018. OPT_EnterProc((CHAR*)"ROT", 24);
  2019. OPT_EnterProc((CHAR*)"GET", 25);
  2020. OPT_EnterProc((CHAR*)"PUT", 26);
  2021. OPT_EnterProc((CHAR*)"GETREG", 27);
  2022. OPT_EnterProc((CHAR*)"PUTREG", 28);
  2023. OPT_EnterProc((CHAR*)"BIT", 29);
  2024. OPT_EnterProc((CHAR*)"VAL", 30);
  2025. OPT_EnterProc((CHAR*)"NEW", 31);
  2026. OPT_EnterProc((CHAR*)"MOVE", 32);
  2027. OPT_syslink = OPT_topScope->right;
  2028. OPT_universe = OPT_topScope;
  2029. OPT_topScope->right = NIL;
  2030. OPT_EnterTyp((CHAR*)"BOOLEAN", 2, 1, &OPT_booltyp);
  2031. OPT_EnterTyp((CHAR*)"CHAR", 3, 1, &OPT_chartyp);
  2032. OPT_EnterTyp((CHAR*)"REAL", 5, 4, &OPT_realtyp);
  2033. OPT_EnterTyp((CHAR*)"LONGREAL", 6, 8, &OPT_lrltyp);
  2034. OPT_EnterTyp((CHAR*)"HUGEINT", 4, 8, &OPT_hinttyp);
  2035. OPT_EnterTyp((CHAR*)"BYTE@", 4, 1, &OPT_cpbytetyp);
  2036. OPT_EnterTypeAlias((CHAR*)"SHORTINT", &OPT_sintobj);
  2037. OPT_EnterTypeAlias((CHAR*)"INTEGER", &OPT_intobj);
  2038. OPT_EnterTypeAlias((CHAR*)"LONGINT", &OPT_lintobj);
  2039. OPT_EnterTypeAlias((CHAR*)"SET", &OPT_setobj);
  2040. OPT_EnterBoolConst((CHAR*)"FALSE", 0);
  2041. OPT_EnterBoolConst((CHAR*)"TRUE", 1);
  2042. OPT_EnterProc((CHAR*)"HALT", 0);
  2043. OPT_EnterProc((CHAR*)"NEW", 1);
  2044. OPT_EnterProc((CHAR*)"ABS", 2);
  2045. OPT_EnterProc((CHAR*)"CAP", 3);
  2046. OPT_EnterProc((CHAR*)"ORD", 4);
  2047. OPT_EnterProc((CHAR*)"ENTIER", 5);
  2048. OPT_EnterProc((CHAR*)"FLOOR", 12);
  2049. OPT_EnterProc((CHAR*)"ODD", 6);
  2050. OPT_EnterProc((CHAR*)"MIN", 7);
  2051. OPT_EnterProc((CHAR*)"MAX", 8);
  2052. OPT_EnterProc((CHAR*)"CHR", 9);
  2053. OPT_EnterProc((CHAR*)"SHORT", 10);
  2054. OPT_EnterProc((CHAR*)"LONG", 11);
  2055. OPT_EnterProc((CHAR*)"SIZE", 13);
  2056. OPT_EnterProc((CHAR*)"INC", 14);
  2057. OPT_EnterProc((CHAR*)"DEC", 15);
  2058. OPT_EnterProc((CHAR*)"INCL", 16);
  2059. OPT_EnterProc((CHAR*)"EXCL", 17);
  2060. OPT_EnterProc((CHAR*)"LEN", 18);
  2061. OPT_EnterProc((CHAR*)"COPY", 19);
  2062. OPT_EnterProc((CHAR*)"ASH", 20);
  2063. OPT_EnterProc((CHAR*)"ASSERT", 33);
  2064. OPT_impCtxt.ref[0] = OPT_undftyp;
  2065. OPT_impCtxt.ref[1] = OPT_bytetyp;
  2066. OPT_impCtxt.ref[2] = OPT_booltyp;
  2067. OPT_impCtxt.ref[3] = OPT_chartyp;
  2068. OPT_impCtxt.ref[4] = OPT_int32typ;
  2069. OPT_impCtxt.ref[5] = OPT_realtyp;
  2070. OPT_impCtxt.ref[6] = OPT_lrltyp;
  2071. OPT_impCtxt.ref[7] = OPT_settyp;
  2072. OPT_impCtxt.ref[8] = OPT_stringtyp;
  2073. OPT_impCtxt.ref[9] = OPT_niltyp;
  2074. OPT_impCtxt.ref[10] = OPT_notyp;
  2075. OPT_impCtxt.ref[11] = OPT_sysptrtyp;
  2076. __ENDMOD;
  2077. }