#include static const _imp_string Version = _imp_str_literal("4.12"); static const int Gbase = 426; static const int Gmax = 512; static short Phrase[124 /*132:255*/] = { 326, 137, 219, 0, 386, 164, 242, 246, 216, 210, 229, 98, 378, 183, 310, 292, 268, 259, 349, 221, 367, 364, 410, 413, 416, 419, 422, 391, 405, 199, 236, 158, 382, 357, 0, 278, 285, 307, 302, 318, 321, 346, 341, 370, 425, 426, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 7, 40, 49, 96, 0}; static const unsigned char Atomic[26 /*105:130*/] = {14, 9, 4, 20, 6, 110, 111, 30, 3, 80, 59, 59, 13, 4, 13, 59, 43, 73, 79, 72, 71, 4, 2, 2, 4, 2}; static short Gram[513 /*0:512*/] = { 0, -32765, 4, 5, 511, 8198, 4, -32748, -32747, -32741, -32740, -32739, -32738, -32737, 15, -32736, -32750, 511, -32257, 15, 27, 22, -32744, 511, 8217, -32747, 511, 511, 511, 27, 33, 37, 36, 8226, -32750, 511, 16, 8230, -32737, 511, -32726, 511, 43, 44, -32725, -32721, 27, -32725, 44, -32708, -32706, -32698, -32689, -32688, -32687, -32741, -32675, -32686, -32741, 66, -32706, 511, -32698, -32695, -32257, 27, -24482, -24482, -32673, 511, 71, -32694, -32695, 511, -32695, -32257, 77, -32681, 511, 89, -32257, 4187, -32685, 84, -32685, -32695, 511, -32695, 27, -32703, 73, -32695, 511, 8219, 8219, 12315, 97, 27, -32657, -32647, -32655, -32654, -32647, -32660, -32653, -32651, -32646, 122, -32645, -32649, 120, -32644, 121, -32643, 126, -32645, 119, -32641, 128, -24576, 8192, 129, 130, 0, 8192, 8192, 8192, 8192, 131, 132, 133, 134, 114, 115, 135, -32649, 123, -32768, -32622, -32621, -32620, -32624, -32619, 150, -32623, 8344, 8192, 126, 125, 154, -32613, 0, -32612, 0, 157, 0, 20480, 150, -32607, -32606, 163, 4096, 4608, 2048, -32594, -32768, -32768, -32594, -32594, -32593, -32593, -32591, -32591, 177, 178, -32589, 0, 180, 181, 0, 182, 0, 175, -32594, -32768, -32768, -32594, -32594, -32594, -32574, -32574, -32573, -32573, 195, 196, 197, 0, 198, 194, -32564, -32564, -32562, -32562, 206, -32561, 0, 208, 0, 209, 204, -32555, -32768, 0, 214, 12503, 0, 8409, -32552, 0, -24576, 8192, -32542, 223, -32541, -32540, 174, 0, 215, 0, -32532, -32536, 241, -32529, -24576, -32533, 8192, -32533, -32533, 8192, -24576, 8192, 0, 243, -32526, -32768, 243, -32520, 249, 250, 254, -32516, 0, -32518, 250, 8447, 256, -32510, 0, 0, -32507, 262, 4608, 2311, 264, 18697, -32501, 0, 10240, -32498, 271, 272, 273, 274, 125, 16659, -32491, 0, 8192, -32768, -32486, -32485, 0, 215, 8476, 0, -32768, -32768, -32478, -32477, 0, 215, 284, -32468, -32474, 8487, -32474, -32467, -32468, -32468, 0, 8489, 8488, 8495, -32466, -32462, 0, 8496, 8500, -32461, 0, -32452, 8504, -32457, -32451, -32452, 0, 8506, 8505, 8511, -32450, 0, 8514, -32447, -32443, 0, 8515, -32434, -32440, 8521, -32440, -32430, -32429, -32429, 0, 8527, -32428, -32428, 0, 8522, 8523, 8527, 8534, -32427, -32423, 0, 8535, 8539, -32422, 0, 350, -24223, -24222, 0, 355, 351, -24223, 0, 8550, 359, 8552, 361, 8554, 363, 8192, 365, 4462, 0, 368, -32401, 0, 371, 4468, 373, 12662, -32392, 377, 371, 0, 379, 8572, -32390, 0, 383, 8576, 385, 8407, -32380, 0, -32378, 8448, 388, -32768, -32768, -32370, -32370, -32369, -32369, 399, 401, -32366, 0, 0, 403, 404, 398, 406, 4503, -32359, 377, 406, 411, 4508, 365, 414, 4511, 411, 417, 4514, 414, 420, 4517, 417, 423, 4520, 420, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}; static unsigned char Gclass[513 /*0:512*/] = { 255, 114, 116, 1, 89, 162, 2, 53, 54, 49, 50, 51, 52, 57, 142, 1, 118, 117, 13, 142, 152, 152, 6, 117, 142, 118, 117, 13, 59, 144, 59, 152, 83, 164, 6, 117, 128, 164, 4, 13, 1, 13, 56, 59, 56, 4, 2, 56, 59, 34, 35, 28, 29, 10, 11, 33, 42, 19, 48, 133, 35, 13, 28, 12, 119, 133, 28, 29, 11, 13, 150, 5, 12, 119, 12, 119, 133, 35, 13, 150, 119, 165, 15, 83, 4, 12, 119, 12, 133, 5, 10, 10, 119, 83, 150, 165, 1, 138, 63, 62, 61, 60, 64, 75, 74, 77, 78, 76, 94, 109, 20, 20, 95, 20, 109, 94, 109, 20, 95, 83, 161, 101, 101, 143, 159, 137, 163, 166, 101, 153, 153, 153, 102, 102, 102, 109, 94, 23, 8, 22, 21, 24, 73, 143, 15, 83, 141, 90, 91, 101, 112, 0, 4, 0, 153, 133, 147, 102, 86, 87, 88, 147, 146, 140, 70, 67, 68, 69, 71, 74, 75, 76, 77, 78, 101, 94, 0, 101, 153, 137, 153, 102, 102, 70, 67, 68, 69, 72, 71, 74, 75, 76, 77, 78, 94, 101, 145, 153, 102, 74, 75, 76, 77, 78, 94, 0, 101, 161, 153, 102, 80, 81, 115, 1, 147, 2, 134, 105, 0, 82, 145, 99, 100, 1, 32, 79, 149, 150, 151, 86, 87, 88, 43, 84, 45, 83, 43, 45, 83, 84, 83, 82, 139, 4, 2, 139, 53, 51, 59, 152, 4, 0, 59, 139, 164, 97, 4, 0, 136, 99, 100, 148, 140, 46, 140, 46, 0, 140, 99, 100, 132, 137, 46, 108, 132, 46, 0, 132, 83, 1, 9, 145, 147, 167, 106, 84, 83, 1, 9, 145, 132, 168, 43, 45, 167, 36, 38, 39, 40, 0, 170, 169, 167, 36, 38, 0, 169, 167, 36, 0, 43, 168, 37, 41, 40, 0, 172, 171, 168, 37, 0, 168, 37, 41, 0, 171, 43, 45, 168, 36, 38, 39, 40, 0, 174, 39, 40, 0, 173, 174, 172, 168, 36, 38, 0, 173, 168, 36, 0, 151, 30, 31, 0, 151, 151, 30, 0, 137, 6, 147, 4, 147, 126, 147, 1, 147, 127, 59, 4, 0, 1, 147, 113, 147, 4, 2, 98, 97, 152, 175, 4, 0, 1, 162, 113, 162, 59, 139, 4, 164, 59, 70, 69, 74, 75, 76, 77, 78, 94, 95, 0, 159, 101, 153, 102, 1, 147, 4, 127, 98, 1, 147, 107, 1, 147, 107, 1, 147, 107, 1, 147, 107, 1, 147, 107, 124, 125, 147, 107, 147, 107, 147, 107, 147, 127, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}; static const short Kdict[507 /*32:538*/] = { 0, 511, 131, 527, 131, 131, 531, 131, 535, 539, 543, 551, 555, 559, 575, 579, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 591, 594, 599, 619, 635, 131, 131, 652, 724, 752, 840, 876, 1020, 128, 128, 1084, 128, 128, 1296, 1320, 1344, 1384, 1408, 128, 1460, 1824, 2056, 2080, 128, 2112, 128, 128, 128, 131, 2127, 131, 131, 2151, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 2155, 131, 131, -32351, -16119, 16679, 16743, 18734, 16614, 16385, 16386, -16282, 16489, 17128, 16388, -32322, -15576, 17195, 16392, 21710, -32465, 19369, 16550, 16387, 16397, -32196, -32451, 18542, 18798, 16804, -32323, -14138, 18670, 19284, -32195, -32450, 18606, 16868, 18862, -30642, 10578, 11457, -31922, -32429, 16823, 8912, 67, 16951, 9921, 69, -32429, 16887, 8912, 67, 17079, 68, 18910, -32187, 10841, 69, 16896, 9415, 78, 17393, -30070, -32177, 8665, 8908, 16394, -31027, 78, -31533, 84, -32183, 10194, 76, 17386, 10958, 69, 18135, 84, 16512, 8909, 10830, 16391, 16384, -32055, 10073, 9921, 8649, 16704, 9153, 10190, 8915, 17322, -28340, -31026, -31530, 88, -32055, 8916, 10066, 9793, 16768, 84, 18071, 10053, 84, 16399, 68, -32433, 21873, 70, -31034, -31540, 80, -32059, 10194, 10567, 9921, 22001, 9938, 22065, 10697, 84, 17904, 9801, 69, 21937, 8915, 19171, -31039, -31543, -32306, 10575, 16395, -32429, 17143, 8912, 67, 17207, 9422, 9299, 19106, 10700, 69, 17623, -26042, 10830, 9157, 10565, -28607, -29626, -30643, -31794, -32301, -15243, 17528, 8912, 67, 23416, 9921, 69, -32301, -15179, 17592, 8912, 67, 23480, 10305, -32301, -14734, 18040, 8912, 67, 24306, 78, -32301, -14798, 17976, 8912, 67, 24370, 10578, 11457, -31922, -32429, 18163, 8912, 67, 23539, 9921, 69, -32301, -14539, 18232, 8912, 67, 23608, 18204, -32183, 10063, 71, 17024, 10835, 17840, 10305, -32429, 16631, 8912, 67, 16695, -32319, 10831, 18464, 8909, -32301, -16201, 16568, 8912, 67, 17015, -32050, -32302, 10071, 16448, 18975, 19219, -31291, 8914, 9412, 8387, 8916, -32301, -15694, 17080, 8912, 67, 24050, 9938, 16832, -31419, 10959, 9428, 8910, -32301, -15886, 16888, 8912, 67, 24114, -29759, -30909, -31408, -32173, 10964, 10066, 17495, 9813, 7892, -32451, 17430, 17045, 8389, 84, 19041, 10575, 68, -32088, 10182, 9938, 10817, 21810, 21521, 76, -27455, -28474, -29491, -30642, -32301, -10123, 22648, -31540, -32178, 8912, 67, 23672, 10575, 8397, 76, 18032, 10063, 71, 17968, 9921, 69, -32301, -10059, 22712, 8912, 67, 23736, 10305, -32301, -9614, 23160, 8912, 67, 24178, 78, -32301, -9678, 23096, 8912, 67, 24242, 10578, 11457, -31922, -32429, 23283, 8912, 67, 23795, 9921, 69, -32301, -9419, 23352, 8912, 67, 23864, -25656, -26167, -26672, -31532, -32041, 10713, 8916, 77, 16640, 10825, 9283, 16825, -28223, -28593, 9426, 9166, -29144, -30015, -31034, -32051, 8398, 8909, -12107, 20664, 10305, -32301, -11662, 21112, 8912, 67, 24498, 78, -32301, -11726, 21048, 8912, 67, 23922, 10578, 11457, 8398, 8909, -11467, 21304, 20496, 80, 17751, 10834, 16396, 8645, -8206, 24567, 10055, 9793, 17688, 10575, 84, 16960, -32184, 10962, 69, 17559, 10053, 16389, 78, -32180, 9428, 76, 18397, 10693, 83, 18268, 9416, 8908, 18333, -32067, -32292, -15771, 17005, 17252, 18734, 16402, 16649}; static const int Ss0 = 250; static const int Ss1 = 251; static const int Ss2 = 252; static const int Ss3 = 253; static const int Ss4 = 254; static const int Null = 512; static const int Transp = 18; static const int Phrases = 132; static const int Equivs = 105; static const int Directives = 86; static const int Anapp = 160; static const int Global = 0; static const int Iconst = 83; static const int Rconst = 84; static const int Sconst = 82; static const int Lb = 1; static const int Rb = 2; static const int Pre1 = 49; static const int Pre2 = 57; static const int Own1 = 53; static const int Own2 = 51; static const int Set1 = 60; static const int Set2 = 64; static const int Check1 = 66; static const int Check2 = 72; static const int Def1 = 60; static const int Def2 = 79; static const int Ident = 59; static const int Switch = 80; static const int Comment = 7; static const int Termin = 13; static const int Appep = 153; static const int Pagesize = 64; static const int Stx = 2; static const int Page = 12; int _imp_mainep(int _imp_argc, char **_imp_argv) { static const int Prim = 2; static const int Prog = 1; static const int Report = 3; static const int Obj = 2; static const int Listing = 1; static const int Eop = 87; static const int Eof = 86; static const int Textlimit = 255; static const unsigned char Cmap[16 /*0:15*/] = {0, 67, 68, 81, 65, 83, 80, 73, 72, 71, 79, 69, 70, 66, 0, 0}; static const int String = 16; static const int Record = 17; static const int Special = 55; static const int Rfn = 65; static const int Uline = 18; static const int Nullstring = 401; static int Permin = 1; static int Diag = 0; static int Control = 0; static int Bpt = 0; static short Buffer[401 /*1:401*/]; static const int Mcode = 38; auto void Fault(int N); static int Mark = ' '; static int File = 0; static const int Dictend = 2750; int Dict[2751 /*0:2750*/]; static const int Maxlab = 80; unsigned char Labinf[80 /*1:80*/]; int List; int Lreals; int Stats; static int Code = 0; int Lines; int Linenum; int Lit; int Litpos; int Limit; int Digit; int Oldsym; int Label; int X; static int Sym = 0; int Atom1; int Atom2; int Subatom; int Last; int Sstype; int Symtype; int Type; int Vartype; static int Pos = 0; int Atompos; int Dup; int Out; int Prefix; int Sprefix; int Constint; int Otype; int Dectype; static int Cnest[11 /*0:10*/]; static unsigned char Line[73 /*1:73*/]; static const int Reclen = -300; int Ref[300 /*-300:-1*/]; int Co[300 /*-300:-1*/]; int Sub[300 /*-300:-1*/]; int Loc[300 /*-300:-1*/]; int Ss; int A; int P; int Faulty; int Ftype; int Glimit; int Tlimit; int Tmax; int Tbase; int Dp; int Relocate; int App; short *Papp; int Eilab; static int Margin = 0; int Inhibit; void Send(void) { int J; if (Bpt <= 0) return; if (Bpt >= Litpos) Fault(22); if (!Faulty) { Selectoutput(Obj); for (J = 1; J <= Bpt; J++) Printsymbol(Buffer[J]); Selectoutput(Listing); } Bpt = 0; } void Put(int N) { Code++; if (Bpt > 71) Send(); Bpt++; Buffer[Bpt] = N; } void Addr(int N) { int V; V = N / 10; if (V) Addr(V); Put(N - V * 10 + '0'); } void Op(int C, int A) { Put(C); Addr(A); } void Printname(int N) { int D; int Flag; void Unpack(int V) { int J; int N; int C; for (J = 24; J >= 0; J -= 6) { C = ((unsigned)V >> J) & 63; if (C) { C += 32; if (Flag) { if (Flag < 0) Put(C); else Printsymbol(C); Flag++; } } } } if (N < 0) { N = -N; Flag = -13; } else Flag = 1; D = Dict[N]; for (D = N - (D & 255); D <= N - ((unsigned)D >> 11 & 3); D++) Unpack(Dict[D - 2]); } void Fault(int N) { int Errorpos; int Stream; int Spacing; int Pos2; static int Fm_sw; static void *Fm[26 /*-1:24*/] = { &&Fm_default, &&Fm_0, &&Fm_1, &&Fm_2, &&Fm_3, &&Fm_4, &&Fm_5, &&Fm_6, &&Fm_7, &&Fm_8, &&Fm_9, &&Fm_10, &&Fm_11, &&Fm_12, &&Fm_13, &&Fm_14, &&Fm_15, &&Fm_16, &&Fm_17, &&Fm_18, &&Fm_default, &&Fm_20, &&Fm_21, &&Fm_22, &&Fm_23, &&Fm_24, }; Stream = Report; Selectoutput(Report); if (Dup) Atompos = Dup; Errorpos = Atompos; if (Errorpos == Pos && N > 1) Errorpos = 0; Faulty++; Spacing = Margin + Errorpos + 8 - 2; for (;;) { if (Pos > 0 && (List != 0 || Stream == Report)) { if (Stream != Report) { Write(Linenum, 4); Space(); } Pos2 = Pos; for (Pos = 1; Pos <= Pos2; Pos++) { if (Pos == Errorpos && Stream == Report) Printsymbol('|'); Printsymbol(Line[Pos]); } Sym = Line[Pos]; } if (Sym != Nl) Newline(); Printsymbol('*'); if (Stream == Report) { Write(Linenum, 4); Space(); } else { Space(); if (Errorpos) { Spaces(Spacing - 1); Printstring(_imp_str_literal("! ")); } } goto *Fm[Fm_sw = (N) - -1]; Fm_24: Printstring(_imp_str_literal("COMPILER ERROR!")); goto F; Fm_20: Printstring(_imp_str_literal("TEXT TOO LONG")); goto F; Fm_21: Printstring(_imp_str_literal("TOO MANY NAMES")); goto F; Fm_22: Printstring(_imp_str_literal("TOO MANY LONG NAMES")); goto F; Fm_23: Printstring(_imp_str_literal("PROGRAM TOO COMPLEX")); goto F; Fm_18: Printstring(_imp_str_literal("ACCESS")); if (Stream == Report) Faulty--; goto F; Fm_0: Printstring(_imp_str_literal("FORM")); goto F; Fm_1: Printstring(_imp_str_literal("ATOM")); goto F; Fm_2: Printstring(_imp_str_literal("TYPE")); goto F; Fm_3: Printstring(_imp_str_literal("NAME")); goto F; Fm_4: Printstring(_imp_str_literal("SIZE")); goto F; Fm_5: Printstring(_imp_str_literal("CONTEXT")); goto F; Fm_6: Printstring(_imp_str_literal("MATCH")); goto F; Fm_7: Printstring(_imp_str_literal("COPY")); goto F; Fm_8: Printstring(_imp_str_literal("SPEC")); goto F; Fm_9: Printstring(_imp_str_literal("%END")); goto Miss; Fm_10: Printstring(_imp_str_literal("%CYCLE")); goto Miss; Fm_11: Printstring(_imp_str_literal("%REPEAT")); goto Miss; Fm_12: Printsymbol('"'); Printname(X); Printsymbol('"'); goto Miss; Fm_13: Printstring(_imp_str_literal("%START")); goto Miss; Fm_14: Printstring(_imp_str_literal("%FINISH")); goto Miss; Fm_15: Printstring(_imp_str_literal("ORDER")); goto F; Fm_16: Printstring(_imp_str_literal("BOUNDS")); goto F; Fm_17: Printstring(_imp_str_literal("RESULT")); Miss: Printstring(_imp_str_literal(" MISSING")); F: Newline(); if (Stream == Listing) break; Stream = Listing; Selectoutput(Listing); } if (Sym != Nl) { Margin += Pos; Spaces(Margin + 8); } Pos = 0; Out = 0; if (N >= 20) _imp_signal(0, 10, 0, _imp_str_literal("")); goto Fm_skip; Fm_default: fprintf(stderr, "\nSwitch label 'Fm(%d):' not set in %s\n", Fm_sw + -1, __PRETTY_FUNCTION__); fflush(stderr); abort(); Fm_skip:; } void Cgen(int N) { int J; int M; int L; M = N; N = abs(M); if (!((unsigned)N >> 16)) L = 4; else L = 8; Put('N'); Put(L + 1 + '0'); Put(','); Put('Y'); for (J = (L - 1) * 4; J >= 0; J -= 4) Put((((unsigned)N >> J) & 15) + 'A'); if (M < 0) Put('U'); Lit = Code; } int Eval(int P) { static const unsigned char Basis[5 /*86:90*/] = {3, 1, 8, 4, 0}; int N; int J; int B; int S; int L; int Mod; N = 0; if (P < 0) return (Dict[-P]); L = Buffer[P]; if (L == 0 || L == 1) return (0); B = Buffer[P - 1]; if (L < 0) return (B); B = Basis[B]; Mod = 'A'; if (B == 8) Mod = 0; for (J = P - 2; J >= P - L; J--) { S = Buffer[J] - Mod; if (!B) N = N * 10; else N = N << B; N += S; } return (N); } void Compileblock(int Level, int Blocktype, int *Fpp) { int J; int K; int Xx; int Count; int Access = 0; int Fp; int Format; int Achain; int Oldlabel; int Aparm; int Oldtbase; int Oldtlimit; static int Spec = 1; Oldtbase = Tbase; Tbase = Tmax; Oldtlimit = Tlimit; Oldlabel = Label; Inhibit = Inhibit << 1; void Deflab(int L) { Inhibit = Inhibit | 1; Put(':'); Addr(L); Access = 1; } void Analysess(int Cont) { int Class; int Lim; static int Tag = 0; static int Delim = '"'; static int Quote = 0; static int Key = 0; void Declareiden(void) { int Extra; int Ff; int *Flag; if (Subatom) { Flag = &Dict[Subatom]; Tag = Dict[Subatom - 1]; if (*Flag & 1024) { if ((Tag & 15) == 3) { if (Dectype == 3) *Flag = *Flag ^ 1024; return; } if (Dectype == (Tag & (~128)) || Dectype == 1) if ((7 <= (Tag & 15) && (Tag & 15) <= 10 && Spec > 0) || (Tag & 15) == 4 || Dectype == 1) { *Flag = *Flag ^ 1024; Dectype = Tag & (~128); return; } } if (!Dup) Dup = Atompos; if (!Dectype) return; } Extra = Dp; Tag = Dectype; Ff = 0; if (!Dectype) { Tag = 3; Ff = 1024; } else Ff = Ff | Sprefix << 13; if ((Tag & 15) >= 7) { if (Sstype == 2 && (Tag & 15) <= 10) Ff = Ff | 1024; Constint = 0; if (11 == (Tag & 15) || (Tag & 15) == 13) if (Sprefix == 1 || Sprefix == 2) Dict[Dp] = App; else { Aparm = 1; Dict[Dp] = Achain; Achain = Dp; } else Dict[Dp] = 0; Dp++; Ff = Ff | 256; if (Spec < 0 && Sprefix < 3) Ff = Ff | 1024; } if ((Tag & 0x70) == 0x50) { Dict[Dp] = Format; Dp++; Ff = Ff | 512; } if ((Tag & 15) == 6) { Dict[Dp] = 0; Dp++; } if (Sprefix > 3 || Permin != 0) Tag = Tag | 128; if (Constint) { Dict[Dp] = 0; Dp++; Tag = (Tag & 0xFFF0) + 5; } Extra -= Dp; Dict[Dp] = Tag; Type = (unsigned)Tag >> 4 & 7; Dp++; Dict[Dp] = Ff | (Dp - Tmax - 2) | Extra << 11; Subatom = Dp; Tmax = Dp + 1; X = Dp; } void Readsym(void) { if (Sym < 32) { Linenum++; Atompos = 0; Pos = 0; Margin = 0; if (!List) { Write(Linenum, 5); if (Quote) Printsymbol('"'); else { Printsymbol(Mark); Mark = ' '; } Space(); } Symtype = 1; } for (;;) { for (;;) { Readsymbol(Sym); if (Sym == Page) { if (!Quote) { Lines = 0; continue; } Lines = Pagesize; } if (!List) Printsymbol(Sym); if (Pos < 73) { Pos++; Line[Pos] = Sym; } if (Quote) return; if (Sym != ' ') break; Symtype = 1; } if (Sym != '%') break; Symtype = 2; } if (Sym < 32) { Symtype = 0; Mark = '+'; } else { if ('A' + 32 <= Sym && Sym <= 'Z' + 32) Sym -= 32; Key = Kdict[Sym]; if ((Key & 3) != 0 || Symtype != 2) Symtype = (Key & 3) - 2; } } void Lookup(int P) { int Old; int New; int L; int Disp; int D; int Size; int First; Count = 0; Size = Dp - Tmax + 1; First = Dict[Tmax]; while (P > Lim) { Count--; P--; D = Dict[P]; Disp = (D & 255) + 2; L = (unsigned)D >> 11 & 3; Old = P - Disp; X = P; P = Old; if (Size + L - Disp == 0 && Dict[Old] == First) { New = Tmax; for (;;) { New++; Old++; if (New == Dp) { Otype = (unsigned)D >> 13; Tag = Dict[X - 1]; Atom2 = Cmap[Tag & 15]; Subatom = X; Vartype = (unsigned)Tag >> 4 & 7; if (Vartype == 0 && Atom2 == 68) Atom2 = 66; if (Atom2 == Iconst) { Atom1 = Atom2; Subatom = -Old; } if (D & 256) { *Papp = abs(Dict[Old]); if (!*Papp) if (11 <= (Tag & 15) && (Tag & 15) <= 12) { *Papp = Phrase[Anapp]; Aparm = (Old << 3) + 1; } else { Ftype = 8; if (Spec < 0) return; Atom1 = 0; Atom2 = 0; } Old++; } else *Papp = App; Format = 0; if (D & 512) if (Atom2 == Rfn) Format = Subatom; else { Format = Dict[Dict[Old] - 2]; Atom2 += 7; } if (Spec >= 0) Dict[X - 1] = Dict[X - 1] | 128; if (Lim > Tmax) Subatom = Count; return; } if (Dict[New] != Dict[Old]) break; } } } } void Codedigit(void) { if (!Limit) { Digit = Sym; if (Digit == '\'') { Quote = 0; Readsym(); if (Sym != '\'') { Digit = -1; return; } Quote = 1; } Readsym(); } else { if ('0' <= Sym && Sym <= '9' || 'A' <= Sym && Sym <= 'F') { if (Sym <= '9') Digit = Sym - '0'; else Digit = Sym - 'A' + 10; if (Digit <= Limit) { Digit += 'A'; Readsym(); return; } } Digit = 0; Quote = 0; if (Sym == '\'') if (Limit != 9) { Digit = -1; Readsym(); } } } void Codeatom(void) { int Tp; void Tput(int S) { if (S < 32) Pos = 0; if (Tp == Textlimit) Fault(20); Tp++; Buffer[Litpos - Tp] = S; } int *Ss; int Dtype; int Xtype; int Srmod; int Slen; int Prefix; int J; int K; int L; int S; int Lp; static const unsigned char Basesym[4 /*1:4*/] = {'X', 'M', 'B', 'K'}; static const short Baseinf[4 /*1:4*/] = {0x590F, 0x5800, 0x5701, 0x5607}; static const short Sps = 117; static const unsigned char Specsub[11 /*117:127*/] = {8, 9, 10, 7, 105, 104, 25, 24, 72, 73, 1}; static const short Pvalue[11 /*0:10*/] = { 0, [1 ... 2] = 0x1827, 0x1067, [4 ... 5] = 0x0127, 0x10A7, 0x00A7, 0x2418, 0x4418, 0x2218}; static const short Satoms[12 /*1:12*/] = {0x0035, 0x3835, 0x3238, 0x0032, 0x3835, 0x0033, 0x3835, 0x0033, 0x3835, 0x3835, 0x3238, 0x0032}; static const unsigned char Sclass[12 /*1:12*/] = {109, 2, 9, 118, 1, 11, 12, 111, 110, 112, 8, 117}; static const int Xsps = 109; static const int Xmod[8 /*109:116*/] = {17, 18, 27, 28, 97, 98, 107, 108}; Lp = Litpos; Atompos = Pos; Last = Atom1; if (Quote) { Tp = 0; Tput((unsigned)Quote >> 8); Tput(Quote & 255); for (;;) { Readsym(); if (Sym == Delim) { Quote = 0; Readsym(); if (Sym != Delim) break; Quote = 1; } Tput(Sym); } Buffer[Litpos] = Tp; Litpos = Litpos - Tp - 1; } Slen = 0; Xtype = 0; Srmod = 0; Prefix = 0; for (;;) { Atom1 = 0; Atom2 = 0; Subatom = 0; Tag = 0; if (!Symtype) { Atom1 = Termin; return; } if (Symtype == -1) if ((Last != 0 || Out != 0) && Last != 8) { Limit = 9; Digit = 'Z'; Newbase: Atom1 = Iconst; Atom2 = Iconst; for (;;) { Litpos--; Buffer[Litpos] = Digit; Codedigit(); if (Digit <= 0) if (Limit == 9 && Sym == '.' && Atom1 == Iconst) { Digit = '.'; Atom1 = Rconst; Atom2 = Rconst; Lp--; Readsym(); } else { if (Limit != 9 && Digit == 0) Atom1 = 0; Buffer[Lp] = Lp - Litpos; Litpos--; Subatom = Lp; if (Litpos <= 0) Fault(23); return; } } } if (Symtype < 0) { Dp = Tmax; Oldsym = Sym; for (;;) { Ss = &Dict[Dp]; *Ss = Sym - 32; Readsym(); if (Symtype >= 0) break; Oldsym = 0; *Ss = (*Ss << 6) + (Sym - 32); Readsym(); if (Symtype >= 0) break; *Ss = (*Ss << 6) + (Sym - 32); Readsym(); if (Symtype >= 0) break; *Ss = (*Ss << 6) + (Sym - 32); Readsym(); if (Symtype >= 0) break; *Ss = (*Ss << 6) + (Sym - 32); Readsym(); if (Symtype >= 0) break; Dp++; } if (Sym == '\'' && Oldsym != 0) { Delim = '\''; for (J = 1; J <= 4; J++) if (Oldsym == Basesym[J]) { Quote = 1; K = Baseinf[J]; Digit = (unsigned)K >> 8; Limit = K & 255; Readsym(); goto Newbase; } } Dp++; if (Dp >= Tlimit) Fault(21); Atom1 = Ident; Atom2 = Ident; Lim = Tbase; Lookup(Tmax); return; } if (Sym == '\'' || Sym == '"') { Delim = Sym; Quote = 1; Atom1 = Sconst; Atom2 = Iconst; Readsym(); Subatom = Sym; if (Subatom == Delim) Quote = 0; Readsym(); if (Subatom == Delim) { if (Sym != Delim) { Subatom = Nullstring; return; } Quote = 1; Readsym(); } if (Sym == Delim) { Quote = 0; Readsym(); if (Sym != Delim) { Litpos -= 2; Buffer[Litpos + 2] = -1; Buffer[Litpos + 1] = Subatom; Subatom = Litpos + 2; return; } } Quote = (Subatom << 8) + Sym; Atom2 = Sconst; Subatom = Litpos; return; } Dp = (unsigned)Key >> 2; Readsym(); for (;;) { S = Kdict[Dp]; if (S & 0x4000) break; if ((S & 127) != Sym || Symtype < 0) { if (S >= 0) { Atompos = Pos; return; } Dp++; } else { K = (unsigned)S >> 7 & 127; Readsym(); if (S > 0) { if (K) { if (K != Sym || Symtype < 0) { Atompos = Pos; return; } Readsym(); } K = 1; } Dp += K; } } Atom1 = S & 63; Subatom = (unsigned)S >> 6 & 255; if (Atom1) break; L = Pvalue[Subatom]; if (L) { if ((Prefix & L & 63) != 0 || (Last != 0 && (L & 1) != 0)) return; Prefix = Prefix | (unsigned)L >> 6; if (Subatom <= 7) Xtype = Subatom; } Atompos = Pos; } if (S < 0) Atom2 = Kdict[Dp + 1] & 63; if (Atom1 == String || Atom1 == Record) { Dtype = Atom1; Codeatom(); if (Dtype == String) { if (Atom1 != Iconst) { Atom1 = 0; return; } Slen = Eval(Subatom); if (0 >= Slen || Slen > Textlimit) { Atom1 = 0; Ftype = 4; return; } Srmod = 0x40; } else { if (Atom2 == Ident) { Lim = Global; Lookup(Tbase); } if (Atom2 != Rfn) { Ftype = 3; Atom1 = 0; Atom2 = 0; return; } Srmod = 0x50; } Codeatom(); if (Atom1 != Rb) { Atom1 = 0; return; } if (Symtype == 2) { Codeatom(); if (Atom1 != Special && Atom2 != Special) { Atom1 = 0; Atom2 = 0; return; } if (Subatom == 127) Subatom = 1; } else Subatom = 5; if (Dtype == Record && Subatom >= 11) { Atom1 = 0; return; } K = Satoms[Subatom]; Atom1 = K & 255; Atom2 = (unsigned)K >> 8 & 255; Subatom = Sclass[Subatom]; } else if (Pre1 > Atom1 || Atom1 > Pre2) { if (Prefix) Atom1 = 0; return; } if (Subatom >= Sps) { Spec = -1; Subatom = Specsub[Subatom]; } else if (Subatom >= Xsps) { if (Xtype != 6) { Atom1 = 0; Atom2 = 0; return; } Xtype = 3; Subatom = Xmod[Subatom]; if (Srmod) Srmod -= 0x10; } if (Prefix & 64) if (Atom1 != Own1 && Atom1 != Own2) { if (Xtype <= 3) { Atom1 = 0; return; } } else { Atom1++; Out = (unsigned)(Subatom + Srmod) >> 4; if (!(Subatom & 1)) { Out = 1; } else if (Xtype == 2 && ((Subatom + Srmod) & 0x70) <= 0x30) Constint = 1; if (Xtype == 3) Out = 15; } if ((Subatom & 0x70) == 0x60) Subatom += Lreals; Subatom = Subatom + (Slen << 8) + Srmod + ((unsigned)Prefix >> 3 & 0x70); Dectype = Subatom; Sprefix = Xtype; Prefix = 0; } int Gapp(void) { static const int Psep = 129; static const int Pcall = 130; int L; int P; int Type; int Next; int C; int Class(int T) { static const unsigned char Exps[8 /*0:7*/] = {0, [1 ... 3] = 147, 140, 0, [6 ... 7] = 146}; static const unsigned char Parmmap[16 /*0:15*/] = {0, 0, 137, 0, 0, 0, 0, 122, 176, 177, 123, 0, 159, 0, 0, 0}; static const unsigned char Tmod[8 /*0:7*/] = {0, [1 ... 3] = 8, 4, 0, 9, 9}; Type = (unsigned)T >> 4; if ((T & 15) == 1) { Type = Tmod[Type]; return (Exps[(unsigned)T >> 4]); } if (!Type) Type = 10; return (Parmmap[T & 15]); } void Setgcell(int C, int Gc, int Len) { C = C << 9; if (Gc != Pcall) C += L; while (L != Glimit) { L++; if (Gram[L] == C && Gclass[L] == Gc && ((Tag & 0x70) != 0x40 || Gram[L - 1] == Len)) return; } if ((Tag & 0x70) == 0x40) { Glimit++; Gram[Glimit] = Len; } Glimit++; Gram[Glimit] = C; Gclass[Glimit] = Gc; L = Glimit; if (Diag & 4) { Printstring(_imp_str_literal("SET")); Write(L, 3); Write(C, 3); Write(Gc, 3); Write(Len, 3); Newline(); } } if (Tbase == Tmax) return (Null); L = Gbase; P = Tmax; Setgcell(0, Pcall, 0); for (;;) { P--; Next = P - (Dict[P] & 255) - 2; Tag = Dict[P - 1]; C = Class(Tag & 127); Setgcell(Type, C, (unsigned)Tag >> 8 & 255); if (Next <= Tbase) break; P = Next; Setgcell(0, Psep, 0); } Setgcell(0, Lb, 0); if (Glimit >= Gmax) Fault(23); return (L); } void Hex(int N) { int J; int K; for (J = 1; J <= 4; J++) { K = (unsigned)N >> 12; N = N << 4; if (K > 9) K = K - 10 + 'A'; else K += '0'; Printsymbol(K); } } void Analyse(int G) { static int Dir_sw; static void *Dir[17 /*86:102*/] = { &&Dir_86, &&Dir_87, &&Dir_88, &&Dir_89, &&Dir_90, &&Dir_91, &&Dir_default, &&Dir_default, &&Dir_94, &&Dir_95, &&Dir_default, &&Dir_97, &&Dir_98, &&Dir_99, &&Dir_100, &&Dir_101, &&Dir_102, }; int Extend; int Ambig; int Sublock; int Downlock; int J; int K; int L; int N; int A1; int Node; int Newtype; int T; void Reorder(void) { int *X; int *Y; int R; K = 0; while (N < 0) { R = Ref[N]; J = Co[N]; if ((Loc[N] & 0xFF) > Transp) { X = &K; R = R & 0x6000; while (*X) { Y = &Ref[*X]; if ((*Y & 0x6000) <= R) break; *Y = *Y - 0x2000; X = &Co[*X]; } Co[N] = *X; *X = N; } N = J; } if (Diag & 8) { Printstring(_imp_str_literal("REORDER N =")); Write(N, 3); Newline(); } } void Show(int Z) { Write(Z, 3); Printstring(_imp_str_literal(" [")); Hex(Ref[Z]); Space(); Hex(Co[Z]); Space(); Hex(Sub[Z]); Space(); Hex(Loc[Z]); Printsymbol(']'); Newline(); } Extend = 0; Sublock = 0; Downlock = 0; A = 0; A1 = 0; N = 0; Node = 0; Ambig = 0; P = Reclen; L1: J = Gram[G]; K = Gclass[G]; if (!K) goto Eop; Newtype = (unsigned)J >> 9 & 15; if (!Newtype) Newtype = Type; if (Diag & 1) { Write(G, 4); Write(K, 3); Write(Atom1, 3); Write(Atom2, 3); Write(Subatom, 3); Write(Type, 2); Write(Format, 3); Newline(); } if (K >= Phrases) { P++; if (P == A) { Ftype = 4; goto Error; } Ref[P] = J; Co[P] = N; Loc[P] = (Type << 8) + K; Type = Newtype; if (Diag & 8) Show(P); N = -P; G = Phrase[K]; goto L1; } Class = K; if (Class >= Equivs) Class = Atomic[Class]; if (Class >= Directives) goto *Dir[Dir_sw = (Class)-86]; if (Atom2 == Ident && (Def1 <= Class && Class <= Def2 || Class == Iconst)) { Lim = Global; Lookup(Tbase); } if (Set1 <= Class && Class <= Set2 && (Otype != 2 || Atom2 == 68 || Atom2 == 70)) { Class += 7; Type = (unsigned)Tag >> 4 & 7; } Newtype = Type; if (Class == Atom1 || Class == Atom2) { if (Class == Ident) { Declareiden(); if (Newtype == 15) Type = 15; } if (Check1 <= Class && Class <= Check2) { if (Vartype != Type) if (Vartype > 3 || (Type != 8 && Type != 9)) if (Vartype < 6 || Type != 9) if (Type != 10) { Ftype = 2; goto Alt; } Ftype = 0; } Entry: A--; if (A == P) { Ftype = 4; goto Error; } Ref[A] = J; Co[A] = N; Loc[A] = (Type << 8) + K; Type = Newtype; Sub[A] = Subatom; if (Diag & 8) Show(A); if ((J & 511) == 511) goto Done; if (!Ambig) goto Next; G = Ambig; Ambig = 0; goto L1; } Alt: G++; if (J < 0) goto L1; Next: if (Node == A1) { Extend = 0; Sublock = 0; Downlock = 0; if (Node == A) goto Error; A1 = A; if (Class < Directives) Codeatom(); } Node--; N = Node; if (Extend) { K = Loc[N] & 255; if (K) { J = Ref[N]; Type = (unsigned)Loc[N] >> 8; N = Co[N]; goto Entry; } } goto Skip; Eop: Reorder(); N = -N; Sub[N] = K; Skip:; G = Ref[N] & 511; if (!G) goto Eop; Type = (unsigned)Loc[N] >> 8; goto L1; Dir_89:; if (Atom1 != 3) goto Error; Done: N = A; Reorder(); Ss = K; if (!Dup) return; Ftype = 7; Error:; while (Nl != Sym && Sym != ';') { Quote = 0; Readsym(); } if (!Ftype) if (Atom1 == Ident && Lim == Global) Ftype = 3; else if (!Atom1) Ftype = 1; else if (Sconst <= Atom1 && Atom1 <= Rconst) { Ftype = 2; if (Type == 15) Ftype = 5; } Fault(Ftype); Quote = 0; Symtype = 0; Dectype = 0; Prefix = 0; Sprefix = 0; Constint = 0; return; Dir_86:; if (Type > 3 && Type != 8) goto Alt; Dcont:; G = J & 511; if (!G) goto Eop; goto L1; Dir_87:; if (Type < 6 || Type == 8 || Type == 15) goto Alt; goto Dcont; Dir_88:; if (Type != 4) goto Alt; goto Dcont; Dir_90:; if ((Blocktype & 15) != 8) { if (Diag >= 0 || (Blocktype & 15) != 9) goto Dalt; } Type = (unsigned)Blocktype >> 4 & 7; if (Type <= 3) Type = 8; else if (Type >= 6) Type = 9; goto Dcont; Dir_91:; if ((Blocktype & 15) != 9) goto Dalt; Type = (unsigned)Blocktype >> 4 & 7; goto Dcont; Dir_94:; if (Sublock) goto Dcont; if (Atom1 != Uline) goto Alt; if (Symtype != -2) goto Error; L = Format; Codeatom(); Atom2 = 0; if (L <= 0) { Ftype = 8; goto Error; } Lim = Dict[L]; Lookup(L); if (!Atom2) { Ftype = 3; goto Error; } Sublock = 1; goto Dcont; Dir_95:; if (Atom1 != Lb) goto Alt; goto Dcont; Dir_97:; *Papp = App; L = Phrase[152 + (Aparm & 7)]; if (Aparm & 0xFFF8) Dict[(unsigned)Aparm >> 3] = L; while (Achain) { T = Achain; Achain = Dict[T]; Dict[T] = L; } goto Dcont; Dir_98:; if ((Aparm & 7) == 6) { Ftype = 4; goto Error; } Aparm++; goto Dcont; Dir_99:; Ambig = J & 511; goto Alt; Dir_100:; if (A1 != A) Extend = 1; A1--; K = 0; goto Entry; Dir_101:; Dict[Tlimit - 2] = Aparm; Dict[Tlimit - 1] = Format; if (Node != A1) goto Dcont; Tlimit -= 2; if (Tlimit <= Tmax) Fault(23); goto Dcont; Dir_102:; if (Downlock) goto Dcont; Downlock = 1; Aparm = Dict[Tlimit]; Format = Dict[Tlimit + 1]; if (Node == A1) Tlimit += 2; goto Dcont; Dalt: Ftype = 5; goto Alt; goto Dir_skip; Dir_default: fprintf(stderr, "\nSwitch label 'Dir(%d):' not set in %s\n", Dir_sw + 86, __PRETTY_FUNCTION__); fflush(stderr); abort(); Dir_skip:; } Format = 0; Aparm = 0; Relocate = 0; Litpos = 400; Ss = 0; Dectype = 0; Dup = 0; Constint = 0; Prefix = 0; Sprefix = 0; Achain = 0; Ftype = 0; Mark = ' '; if (!Cont) { Margin += Pos; if (!Symtype) { Pos = 0; Readsym(); } Atom1 = 0; if (Symtype == 0 || Sym == '!') { Skip: while (Symtype) Readsym(); return; } Codeatom(); if (Atom1 == Comment) goto Skip; Stats++; if (!Permin) Op('O', Linenum); if (Atom1 == Mcode && Subatom == 1) { Codeatom(); if (Atom2 == Ident) { Lim = Global; Lookup(Tbase); } if (Atom2 != Iconst) Fault(0); Cgen(Eval(Subatom)); Put('P'); return; } Type = 0; if (Atom1 == Ident && (Sym == ':' || Atom2 == Switch)) { Dectype = 3; Sstype = 0; Analyse(Phrase[Ss0]); } else if (Dectype != 0 || Out != 0) { Type = Out; Sstype = 1; Analyse(Phrase[Ss1]); } else { Sstype = 3; Analyse(Phrase[Ss3]); } return; } Codeatom(); if (Cont > 0) { Sstype = 2; Analyse(Phrase[Ss2]); J = Gapp(); if (0 != abs(*Fpp) && abs(*Fpp) != J) Fault(6); *Fpp = J * Spec; } else { Fp = Tmax; Sstype = 4; Analyse(Phrase[Ss4]); if (Ss != 0 && Tmax > Fp) { J = Tlimit + Tbase - Tmax - 1; if (J <= Tmax) Fault(21); *Fpp = Tlimit - 1; Dict[*Fpp] = J; Relocate = J - Fp; for (K = J; K <= *Fpp - 1; K++) { Dict[K] = Dict[Fp]; Fp++; } Tlimit = J; } } } void Compiless(void) { static const unsigned char Rcomp[8 /*33:40*/] = {34, 33, 35, 36, 38, 37, 39, 40}; static const unsigned char Comp[8 /*33:40*/] = {'>', '<', '=', '#', ')', '(', 116, 107}; static const unsigned char Conop[3 /*82:84*/] = {'\'', 'N', 'D'}; static const unsigned char Opcode[10 /*1:10*/] = {'*', '/', '&', '!', '%', '[', ']', '.', '\\', 120}; static int C_sw; static void *C[130 /*1:130*/] = { &&C_1, &&C_2, &&C_3, &&C_4, &&C_5, &&C_6, &&C_7, &&C_8, &&C_9, &&C_10, &&C_11, &&C_12, &&C_13, &&C_14, &&C_15, &&C_16, &&C_17, &&C_18, &&C_19, &&C_20, &&C_21, &&C_22, &&C_23, &&C_24, &&C_25, &&C_26, &&C_27, &&C_28, &&C_29, &&C_30, &&C_31, &&C_32, &&C_33, &&C_34, &&C_35, &&C_36, &&C_37, &&C_38, &&C_39, &&C_40, &&C_41, &&C_42, &&C_43, &&C_44, &&C_45, &&C_46, &&C_default, &&C_default, &&C_49, &&C_50, &&C_51, &&C_52, &&C_53, &&C_54, &&C_default, &&C_56, &&C_57, &&C_default, &&C_default, &&C_60, &&C_61, &&C_62, &&C_63, &&C_64, &&C_65, &&C_66, &&C_67, &&C_68, &&C_69, &&C_70, &&C_71, &&C_72, &&C_73, &&C_74, &&C_75, &&C_76, &&C_77, &&C_78, &&C_79, &&C_80, &&C_81, &&C_82, &&C_83, &&C_84, &&C_default, &&C_default, &&C_default, &&C_default, &&C_default, &&C_default, &&C_default, &&C_default, &&C_default, &&C_default, &&C_default, &&C_default, &&C_default, &&C_default, &&C_default, &&C_default, &&C_default, &&C_default, &&C_default, &&C_default, &&C_105, &&C_106, &&C_107, &&C_108, &&C_109, &&C_110, &&C_111, &&C_112, &&C_113, &&C_114, &&C_115, &&C_116, &&C_117, &&C_118, &&C_119, &&C_default, &&C_default, &&C_122, &&C_123, &&C_124, &&C_125, &&C_126, &&C_127, &&C_128, &&C_129, &&C_130, }; static int D_sw; static void *D[8 /*50:57*/] = { &&D_50, &&D_51, &&D_52, &&D_53, &&D_54, &&D_default, &&D_56, &&D_57, }; unsigned char *Mm; int *M; int L; int Dim; int K; static int Owndef = 0; static int Bpsize = 0; int Callpending; int Predpending; int Predop; int Globalnot; int Localnot; int Clast; int Cmod; int Ops; int Bit; int Clevel; int Double; int Plab; int Looplab; int Ulab; int Conds; int Else; int Lit1; int Lit2; int Startt; int Next; int Class; int Dclass; int Link; void Aop(int C, int A) { Put(C); if (A < 0) { A = -A; Put('-'); } else A = A / 2; Addr(A); } void Extra(int N) { Put(','); Addr(N); } void Def(int N) { int K; N += Relocate; Aop('$', N); Printname(-N); K = Dict[N - 1]; Extra(K & 127); Extra((unsigned)K >> 8 & 255); Extra((unsigned)Dict[N] >> 13 & 7); if ((K & 0x70) == 0x50 && (K & 127) != 84) Aop(',', Dict[N - 2]); } void Call(void) { int P; Callpending = 1; Aop('@', X); P = X; if (Dict[X] & 512) P--; if (abs(Dict[P - 2]) == Null) { Put('E'); Callpending = 0; } else Predpending = Predpending << 1; } void Setsize(void) { Bpsize = Lit1 - Lit2 + 1; if (Bpsize <= 0) { Atompos = 0; Fault(4); Bpsize = 1; } Put('B' + 32); Addr(Bpsize); } void Poplab(int Mode) { int L; if (Label > Oldlabel) { L = Labinf[(unsigned)Label >> 2]; if ((L ^ Mode) & 1) { Label -= 4; Plab = Label; if (L & 4) Eilab = Plab + 1; if ((L & 3) == 3) Plab++; if (!(L & 8)) Plab = 0; return; } } if (!Mode) Mode = 13; else Mode = 10; Fault(Mode); Access = 1; } void Cend(void) { int L; int T; int Lim; int Flag; if (X == 88) { Stats = 0; Linenum = 0; List = List & 1; Dectype = 0; Selectinput(Prog); Permin = 0; return; } Atompos = 0; Flag = Sym; if (Level == 1 && X != Eop && File == 2) { Dectype = Eop; Fault(5); } Lim = Tbase; if (X == Eop || X == Eof) { X -= Eof; if (X != Level) Fault(5); Put(';'); while (Level > 1) { Fault(9); Level--; } Lim = Global; } else { if (Level <= 1 && File == 2) Fault(5); Put(';'); } while (Label > Oldlabel) { L = Labinf[(unsigned)Label >> 2]; if ((L & 7) == 2) L = 11; else L = 14; Label -= 4; Fault(L); } if (Access != 0 && 8 <= (Blocktype & 15) && (Blocktype & 15) <= 10) Fault(17); X = Tmax - 1; while (X > Lim) { T = Dict[X]; if ((Dict[X - 1] & 128) == 0 && 0 == List && (T & 0x400) == 0) if (!(Control & 0x1000)) { if (Flag != Nl) { Margin += Pos; Newline(); Flag = 0; } Printstring(_imp_str_literal("? ")); Printname(X); Printstring(_imp_str_literal(" UNUSED\n")); } if (T & 0x400) Fault(12); X = X - (T & 255) - 3; } Printsymbol(11); if (!Flag) Spaces(Margin + 8); } if (Label < 4 || Label > Maxlab << 2) Fault(24); if (Access == 0 && Sstype == 3 && 33 != (Loc[-1] & 255) && (Loc[-1] & 255) != 34) { if (!(Control & 0x1000)) Fault(18); Access = 1; } Conds = 0; Dim = 0; Predpending = 0; Predop = 0; Startt = 0; Plab = 0; Ulab = 0; Looplab = 0; Else = 0; Eilab = 0; Lit1 = 0; Lit2 = 0; Next = Ss; Link = 0; Lit = 0; Dclass = 0; Top: for (;;) { X = Sub[Next]; if (X >= 0 || Next > P) break; if (Co[Next]) { Sub[Next] = Link; Link = Next; } Next = X; } Class = Loc[Next] & 255; if (Diag & 2) { Printstring(_imp_str_literal("C =")); Write(Class, 3); Printstring(_imp_str_literal(" X =")); Write(X, 3); Printstring(_imp_str_literal(" NEXT =")); Write(Next, 3); Newline(); } Next = Co[Next]; if (Class < Pre1) goto *C[C_sw = (X)-1]; if (Class == Appep) goto Cont; if (Class != Ident) goto *C[C_sw = (Class)-1]; goto *D[D_sw = (Dclass)-50]; Acont: Access = 0; C_112:; Cont: for (;;) { if (Next) goto Top; if (!Link) goto Return; Next = Co[Link]; Link = Sub[Link]; } C_9:; if (Class == 45) { if (Lit == Code) { Lit1 = ~Lit1; Lit++; } } else X = 10; C_1:; C_2:; C_3:; C_4:; C_5:; C_6:; C_7:; C_8:; Put(Opcode[X]); goto Cont; C_46: Put('Q'); goto Cont; C_10: Put('M'); goto Acont; C_11: if (Class != 44) Put('+'); goto Cont; C_12: if (Class != 43) Put('-'); else { if (Lit == Code) { Lit1 = -Lit1; Lit++; } Put('U'); } goto Cont; C_13: Put('X'); goto Cont; C_14: Put('Y' + 32); Diag = Lit1; goto Cont; C_15: Put('Z' + 32); Control = Lit1; goto Cont; C_16: Put('V'); goto Acont; C_17: if (Blocktype != 7) if (Diag >= 0 || (Blocktype & 15) != 8) Fault(5); Put('R'); goto Acont; C_18: Put('T'); goto Predt; C_19: Put('K'); Predt: if (Blocktype != 10) Fault(5); goto Acont; C_20: Put(101); goto Acont; C_44: Lit2 = 0; if (Inhibit & 1) Fault(15); Inhibit = Inhibit | 1; for (;;) { if (!Next) break; X = Sub[Next]; if ((X < 0 && Next <= P) || (Loc[Next] & 255) != Iconst) break; Next = Co[Next]; Lit1 = Eval(X); if (0 > Lit1 || Lit1 > 15) { Fault(16); Lit1 = 0; } Lit2 = Lit2 | (1 << Lit1); } if (!Lit2) Fault(16); Startt = 1 + 8; Op(111, Lit2); Op(',', Label); goto Cont; C_21: Put('S' + 32); goto Acont; C_22: List = List & 2; goto Cont; C_23: List = List | 1; goto Cont; C_24: Lreals = 16; goto Cont; C_25: Lreals = 0; goto Cont; C_109: Put('S'); goto Cont; C_45: Put('Z'); goto Cont; C_26:; C_27:; L = Label; while (L > Oldlabel) { if ((Labinf[(unsigned)L >> 2] & 7) == 2) { if (X == 26) { Mm = &Labinf[(unsigned)L >> 2]; *Mm = *Mm | 8; L -= 2; X = 'F'; } else X = 113; Op(X, L - 2); goto Acont; } L -= 4; } Fault(10); goto Cont; C_31: Ulab = Label + 3; Op(117, Ulab); C_30: Looplab = Label + 2; Deflab(Looplab); C_28:; C_29:; if (Else) Eilab = Plab; Inhibit = Inhibit | 1; Conds = 1; Double = 0; Startt = ((unsigned)(X - 26) >> 1) + 8; Globalnot = 0; Clast = 1; Cmod = 0; Clevel = 1; Ops = 1; Localnot = X & 1; Plab = Label; Cnest[0] = Plab; Cnest[1] = Plab; goto Cont; C_32: Localnot = Localnot ^ 1; goto Cont; C_79:; Call(); Predop = 4; if (!Callpending) goto Pac; Predpending = Predpending | 2; goto Cont; C_108: Put('C'); Pac: X = 35; Conds--; goto Cop; C_33:; C_34:; C_35:; C_36:; C_37:; C_38:; Conds--; if (Next) { Put(126); Double = 1; Bit = 1; goto Andop; } if (Double) { Double = 0; X = Rcomp[X]; } Put('?'); Cop: Localnot = (Localnot ^ Globalnot) & 1; if (Localnot) X = X ^ 7; if (Clast) { if (Ops & 1) X = X ^ 7; Op(Comp[X + Predop], Cnest[Clevel]); } else { while (Cmod & 1) { Cmod = (unsigned)Cmod >> 1; Ops = (unsigned)Ops >> 1; Clevel--; Globalnot = (unsigned)Globalnot >> 1; } Cmod = (unsigned)Cmod >> 1; Ops = (unsigned)Ops >> 1; Clevel--; Globalnot = (unsigned)Globalnot >> 1; if (Ops & 1) X = X ^ 7; Op(Comp[X + Predop], Cnest[Clevel]); if (Label != Cnest[Clevel]) Deflab(Label); Label = Cnest[Clevel]; } Clast = 0; Localnot = 0; Predop = 0; if (Conds <= 0 && Ulab != 0) Deflab(Ulab); if (Double) Put('"'); goto Cont; C_39:; C_40:; Bit = X & 1; Andop: Conds++; Localnot = (Localnot ^ Globalnot) & 1; Bit = Bit ^ Localnot; if (Bit == (Ops & 1)) { if (Clast) { Cmod = Cmod << 1; Cnest[Clevel + 1] = Cnest[Clevel]; Clevel++; Ops = Ops << 1 | Bit; Globalnot = Globalnot << 1 | Localnot; } } else { Cmod = Cmod << 1; if (Clast) { Label += 4; Clevel++; Cnest[Clevel] = Label; } else { Cmod = Cmod | 1; if (((unsigned)Ops >> 1 & 1) == Bit) L = Cnest[Clevel - 1]; else { Label += 4; L = Label; } Clevel++; Cnest[Clevel] = L; } Ops = Ops << 1 | Bit; Globalnot = Globalnot << 1 | Localnot; } Clast = 1; Localnot = 0; if (!Double) goto Cont; goto Cop; C_119:; if (!Startt) { Startt = 2; Deflab(Label + 2); } Label += 4; if ((unsigned)Label >> 2 > Maxlab) Fault(23); Labinf[(unsigned)Label >> 2] = Startt + Else; Looplab = 0; Plab = 0; Else = 0; Eilab = 0; goto Cont; C_41: Op('B', Label - 2); Access = 0; C_42: Poplab(X & 1); goto Cont; C_43:; if (!Plab) Poplab(0); if (Plab & 1) { Fault(5); goto Return; } if (Access) Op('F', Plab + 1); Deflab(Plab); Plab++; Startt = 3 + 8; Else = 4; goto Cont; C_54: Owndef = 0; Out = 0; C_51:; C_52:; C_53:; C_56:; if ((Inhibit & 1) != 0 && Spec > 0) Fault(15); C_50:; C_57:; Dclass = Class; goto Cont; C_60:; C_61:; C_67:; C_68:; C_74:; C_75:; C_122:; C_123:; C_124:; C_125:; C_77:; C_63:; C_70:; C_62:; C_69:; C_76:; Aop('@', X); goto Cont; C_65:; C_66:; goto Cont; C_71:; C_72:; C_73:; C_78:; C_64:; Call(); goto Cont; C_83: Lit2 = Lit1; Lit1 = Eval(X); if (X < 0) { Cgen(Lit1); goto Cont; } C_82:; C_84:; L = Buffer[X]; if (L <= 0 && Class == Iconst) { Op('N', 3); L = Buffer[X - 1]; Put(','); Put('Z'); X = L / 10; Put(X + 'A'); Put(L - X * 10 + 'A'); } else { L = abs(L); Op(Conop[Class], L); if (L > 0) { int X2; Put(','); X2 = X; for (X = X2 - 1; X >= X2 - L; X--) Put(Buffer[X]); } } Lit = Code; goto Cont; C_105: Put('.'); goto Cont; C_106: Put('V' + 32); goto Cont; C_126: Put('F' + 32); Startt = 2 + 8; Plab = Label; Looplab = Plab + 2; Deflab(Looplab); goto Cont; C_113:; if (!Sprefix) Dim++; else Setsize(); goto Cont; C_116: Aop('L', X); Access = 1; Inhibit = Inhibit | 1; goto Cont; C_80: Inhibit = Inhibit | 1; Aop('W', X); goto Acont; C_114: Inhibit = Inhibit | 1; Access = 1; Aop('_', X); L = Dict[X - 2]; K = Dict[L]; if (K > Lit1 || Lit1 > Dict[L - 1]) { Fault(16); goto Cont; } K -= Lit1; L -= (unsigned)K >> 4; K = 1 << (K & 15); M = &Dict[L - 2]; if (*M & K) Fault(7); *M = *M | K; goto Cont; C_81: Inhibit = Inhibit | 1; C_115: Aop('J', X); goto Acont; C_128: if (!Lit1) Lit1 = Bpsize; Bpsize = Bpsize - Lit1 + 1; if (Lit1 <= 0) goto Of; goto Cont; C_129: Put('P' + 32); goto Cont; C_130: Put('P' + 32); Put('E'); Predpending = (unsigned)Predpending >> 1; if (Predpending & 1) { Predpending--; goto Pac; } goto Cont; C_107: Put('I' + 32); goto Cont; C_118: if (Dclass != 54) { Bpsize--; if (Bpsize <= 0) { Of: Atompos = 0; Fault(16); Out = 0; goto Return; } } Osep: Put('A'); if (Owndef > 1) Extra(Owndef); Owndef = 0; Lit1 = 0; goto Cont; C_117: if (Out) Bpsize--; Out = 0; if (!Bpsize) goto Osep; Bpsize = 0; if (Buffer[Bpt] == 'A' || Lit == Code) goto Of; Put('I'); goto Cont; C_110:; C_111:; goto Cont; C_127: Put('A' + 32); goto Cont; D_54: Owndef++; if (Constint) Dict[X - 2] = Lit1; goto Ddd; D_57:; if (Lit == Code) { Put('W' + 32); Dict[X - 2] = Tlimit - 1; Dict[Tlimit - 1] = Lit2; Dict[Tlimit - 2] = Lit1; if (Lit1 < Lit2) { Atompos = 0; Fault(4); Lit1 = Lit2; } K = Lit1 - Lit2 + 1; K = (unsigned)(K + 15) >> 4; Tlimit = Tlimit - K - 3; if (Tlimit <= Tmax) Fault(23); for (L = Tlimit; L <= Tlimit + K; L++) Dict[L] = 0; } D_50:; if (Dclass == 50 && Dectype != 84 && Spec >= 0 && Level != 0) Op('F', 0); D_56:; D_53:; Ddd: Def(X); goto Cont; D_51:; if (Dim) { Op('D' + 32, Dim); Dim = 0; } Def(X); Put('H' + 32); if ((Dict[X - 1] & 15) != 13) Put('C' + 32); goto Cont; D_52: Def(X); Out = Type; if (Type == 15) Bpsize = 1; goto Cont; C_49:; if (X == 15) { Put('H'); Xx = Nullstring; } else Cend(); Return:; if (Looplab) Op('B', Looplab); if (Eilab != 0 && Eilab != Plab) Deflab(Eilab); if (Plab) Deflab(Plab); goto D_skip; D_default: fprintf(stderr, "\nSwitch label 'D(%d):' not set in %s\n", D_sw + 50, __PRETTY_FUNCTION__); fflush(stderr); abort(); D_skip:; goto C_skip; C_default: fprintf(stderr, "\nSwitch label 'C(%d):' not set in %s\n", C_sw + 1, __PRETTY_FUNCTION__); fflush(stderr); abort(); C_skip:; } if (!Blocktype) { Analysess(-1); Xx = X - 2; Op('G', 2); if (Ss) Compiless(); Op('G', 2); goto L9; } if ((Blocktype & 15) != 15) { Analysess(1); if (Spec < 0) K = 0; else K = 1; Op('G', K); if (Ss) Compiless(); Op('G', K); if (!K) goto L9; } Access = 1; for (;;) { Analysess(0); Xx = X - 2; if (Ss) Compiless(); if (Dectype == 84) Compileblock(0, 0, Dict[Xx]); if (Dectype == 85 || Dectype == Eop || Dectype == Eof) break; if (7 <= (Dectype & 15) && (Dectype & 15) <= 10 || Dectype == 15) { if ((Dectype & 0x70) == 0x50) Xx--; if (Level == 0 && Dectype == 15) if (!File) File = 2; else Fault(5); if (Spec > 0 && Sprefix > 3 && Sprefix != 7) if (Level) Fault(15); else File = 1; Compileblock(Level + 1, Dectype, Dict[Xx]); if (Dectype == Eop || Dectype == Eof) { Pos = 0; break; } } } if (Blocktype != 15 && Level != 0) Deflab(0); L9: Spec = 1; Tmax = Tbase; Tbase = Oldtbase; Label = Oldlabel; if (Blocktype) Tlimit = Oldtlimit; Inhibit = (unsigned)Inhibit >> 1; } void Summarise(int Stream) { Selectoutput(Stream); if (!Faulty) { Write(Stats, 5); Printstring(_imp_str_literal(" STATEMENTS COMPILED\n")); } else { Printstring(_imp_str_literal("PROGRAM CONTAINS")); Write(Faulty, 1); Printstring(_imp_str_literal(" FAULT")); if (Faulty != 1) Printsymbol('S'); Newline(); } Closeoutput(); } Openinput(Prim, _imp_str_literal("interdata/prims.imp")); Openinput(Prog, _imp_str_literal("interdata/test.imp")); Openoutput(Report, _imp_str_literal("interdata/test.rpt")); Openoutput(Obj, _imp_str_literal("interdata/test.icd")); Openoutput(Listing, _imp_str_literal("interdata/test.lis")); Selectoutput(Listing); Selectinput(Prim); Newline(); Spaces(5); Printstring(_imp_str_literal("EDINBURGH C.S. IMP COMPILER VERSION ")); Printstring(Version); Newlines(2); Control = 0; Cgen(Control); Put('Z' + 32); List = 2; Code = 0; Lreals = 0; Faulty = 0; Out = 0; Symtype = 0; Papp = &Phrase[Appep]; App = *Papp; Stats = 0; Linenum = 0; Buffer[Nullstring] = 0; Tlimit = Dictend - 1; Glimit = Gbase; Label = 4; Tmax = Global; Tbase = Global; X = 0; Atom1 = 0; Last = 0; Inhibit = 0; Compileblock(0, 15, Dict[Tlimit]); Put(';'); Put(4); Send(); Summarise(Listing); if (Faulty) _imp_signal(15, 1, 0, _imp_str_literal("")); exit(0); return (1); }