#include int _imp_mainep(int _imp_argc, char **_imp_argv) { const int Yes = 1; const int No = 0; const int Allowcodelist = Yes; const int Includehandcode = No; const int Vmeb = No; int I; int J; int K; const int Symbol[980 /*1300:2279*/] = { 1305, 1305, 1001, 1018, 1305, 1313, 1311, 44, 1001, 1018, 999, 1313, 1000, 1324, 1318, 1001, 1044, 1356, 1320, 1003, 1324, 40, 1324, 41, 1349, 1343, 201, 198, 1454, 212, 200, 197, 206, 1010, 1038, 1313, 1011, 1349, 197, 204, 211, 197, 1324, 1349, 1010, 1038, 1313, 1011, 1349, 1356, 1354, 1039, 1313, 999, 1356, 1000, 1374, 1365, 1030, 1041, 1010, 1324, 1011, 1374, 1042, 1372, 40, 1010, 1763, 1011, 1779, 41, 1374, 1000, 1383, 1381, 44, 1010, 1324, 1011, 999, 1383, 1000, 1400, 1391, 1041, 1010, 1324, 1011, 1374, 1042, 1398, 40, 1010, 1763, 1011, 1779, 41, 1400, 1000, 1412, 1406, 212, 210, 213, 197, 1412, 198, 193, 204, 211, 197, 1435, 1417, 193, 206, 196, 1420, 207, 210, 1425, 201, 205, 208, 204, 1431, 197, 209, 213, 201, 214, 1435, 197, 209, 214, 1443, 1441, 206, 207, 212, 1471, 1443, 1471, 1447, 1447, 1435, 1447, 1454, 1452, 1412, 1435, 999, 1454, 1000, 1471, 1469, 201, 198, 1454, 212, 200, 197, 206, 1443, 197, 204, 211, 197, 1454, 1471, 1443, 1486, 1476, 1324, 1967, 1324, 1480, 1001, 1045, 1356, 1482, 1400, 1486, 40, 1454, 41, 1510, 1495, 201, 206, 212, 197, 199, 197, 210, 1500, 210, 197, 193, 204, 1508, 194, 207, 207, 204, 197, 193, 206, 1510, 1000, 1523, 1521, 59, 1601, 214, 193, 204, 213, 197, 1013, 1012, 1523, 1000, 1553, 1532, 204, 193, 194, 197, 204, 1026, 1300, 1541, 211, 215, 201, 212, 195, 200, 1043, 1300, 1550, 211, 212, 210, 201, 206, 199, 1028, 1300, 1553, 1486, 1553, 1578, 1562, 193, 210, 210, 193, 217, 1021, 1300, 1575, 208, 210, 207, 195, 197, 196, 213, 210, 197, 1022, 1300, 1623, 1578, 1017, 1300, 1586, 1584, 40, 1001, 1586, 41, 1586, 1000, 1593, 1591, 1593, 1001, 999, 1593, 1000, 1601, 1596, 44, 1601, 41, 1014, 58, 40, 1614, 1612, 195, 207, 205, 205, 197, 206, 212, 1005, 999, 1614, 1000, 1623, 1621, 59, 1601, 1013, 1523, 999, 1623, 1000, 1644, 1642, 59, 195, 207, 205, 205, 197, 206, 212, 1010, 40, 1001, 1586, 41, 1649, 1661, 1011, 1040, 1644, 1000, 1649, 1647, 58, 1649, 1000, 1661, 1659, 1644, 214, 193, 204, 213, 197, 1013, 1012, 1661, 1000, 1669, 1667, 1644, 1013, 1669, 1661, 1669, 1000, 1696, 1677, 204, 193, 194, 197, 204, 1718, 1685, 211, 215, 201, 212, 195, 200, 1718, 1693, 211, 212, 210, 201, 206, 199, 1718, 1696, 1486, 1696, 1718, 1704, 193, 210, 210, 193, 217, 1718, 1715, 208, 210, 207, 195, 197, 196, 213, 210, 197, 1718, 1718, 1017, 1718, 1722, 1722, 1001, 1722, 1729, 1727, 44, 1001, 999, 1729, 1000, 1737, 1733, 1001, 1383, 1737, 40, 1737, 41, 1754, 1752, 201, 198, 1454, 212, 200, 197, 206, 1729, 197, 204, 211, 197, 1737, 1754, 1729, 1763, 1761, 44, 1010, 1737, 1011, 999, 1763, 1000, 1779, 1766, 1008, 1770, 1001, 1356, 1035, 1773, 1324, 1035, 1776, 1454, 1035, 1779, 1737, 1035, 1788, 1786, 1593, 1010, 1763, 1011, 999, 1788, 1000, 1803, 1796, 1020, 1356, 58, 61, 1803, 1454, 1803, 1019, 1356, 58, 61, 1814, 1324, 1814, 1812, 1025, 1004, 1020, 1356, 58, 61, 999, 1814, 1000, 1825, 1823, 1025, 1004, 1019, 1356, 58, 61, 999, 1825, 1000, 1847, 1838, 211, 212, 197, 208, 1324, 213, 206, 212, 201, 204, 1324, 1845, 215, 200, 201, 204, 197, 1454, 1847, 1000, 1855, 1853, 44, 1324, 1825, 999, 1855, 1000, 1864, 1862, 44, 1324, 58, 1324, 999, 1864, 1000, 1876, 1868, 1017, 1300, 1876, 193, 210, 210, 193, 217, 1021, 1918, 1881, 1881, 1300, 1887, 1881, 1887, 1885, 44, 1876, 1887, 1000, 1897, 1890, 1897, 1897, 1041, 1324, 58, 1324, 1855, 1042, 1907, 1907, 1041, 1038, 1002, 58, 1038, 1002, 1907, 1042, 1918, 1916, 44, 1038, 1002, 58, 1038, 1002, 1907, 1918, 1000, 1923, 1923, 1300, 1897, 1923, 1929, 1927, 44, 1918, 1929, 1000, 1967, 1954, 208, 210, 207, 195, 197, 196, 213, 210, 197, 1022, 1033, 1010, 1001, 1018, 1578, 1015, 1510, 1614, 59, 1601, 1011, 2006, 2111, 1963, 193, 210, 210, 193, 217, 1021, 1024, 1876, 1967, 1017, 1023, 1300, 2006, 1970, 61, 1973, 62, 61, 1975, 62, 1978, 60, 62, 1981, 60, 61, 1983, 60, 1985, 35, 1988, 197, 209, 1991, 199, 197, 1994, 199, 212, 1997, 206, 197, 2000, 204, 197, 2003, 204, 212, 2006, 92, 61, 2015, 2013, 1029, 1001, 58, 1034, 2006, 2015, 1000, 2035, 2018, 2172, 2023, 198, 207, 210, 2035, 2033, 201, 198, 1454, 212, 200, 197, 206, 2006, 2088, 2035, 1040, 2050, 2050, 1010, 1004, 1356, 58, 61, 1324, 1825, 1011, 1847, 196, 207, 2006, 2078, 2070, 2053, 2172, 2058, 198, 207, 210, 2035, 2068, 201, 198, 1454, 212, 200, 197, 206, 2006, 2088, 2070, 1000, 2078, 2076, 1601, 2006, 2015, 1036, 2078, 1015, 2088, 2086, 194, 197, 199, 201, 206, 1015, 2088, 2050, 2106, 2096, 194, 197, 199, 201, 206, 2070, 2101, 198, 207, 210, 2035, 2104, 2172, 2151, 2106, 2151, 2111, 2109, 1001, 2111, 1000, 2151, 2120, 193, 204, 199, 207, 204, 2106, 1016, 2131, 197, 216, 212, 197, 210, 206, 193, 204, 2106, 1016, 2141, 198, 207, 210, 212, 210, 193, 206, 2106, 1016, 2147, 194, 197, 199, 201, 206, 2151, 1037, 1013, 2050, 2162, 2160, 197, 204, 211, 197, 1013, 2006, 2162, 2162, 1000, 2172, 2170, 194, 197, 199, 201, 206, 2070, 2172, 2050, 2186, 2177, 1025, 1004, 1788, 2180, 1001, 1356, 2186, 199, 207, 212, 207, 1737, 2280, 2190, 2015, 1006, 2198, 197, 206, 196, 1016, 1007, 2151, 1006, 2207, 195, 207, 205, 205, 197, 206, 212, 1005, 2211, 1486, 1929, 1006, 2219, 194, 197, 199, 201, 206, 2070, 1006, 2237, 211, 215, 201, 212, 195, 200, 1027, 1001, 1018, 1031, 58, 61, 1010, 1737, 1011, 1754, 1006, 2245, 207, 215, 206, 1032, 1486, 1864, 1006, 2251, 1029, 1001, 58, 1034, 2186, 2253, 59, 2261, 195, 207, 196, 197, 207, 206, 1006, 2270, 195, 207, 196, 197, 207, 198, 198, 1006, 2280, 208, 210, 207, 199, 210, 193, 205, 1001, 1006}; const int Ss = 2186; const int Lastsname = 66; static int Snnno[68 /*0:67*/]; const unsigned char Tsname[67 /*0:66*/] = {2, [1 ... 3] = 1, 0, [5 ... 12] = 2, 1, 2, [15 ... 24] = 0, 1, 2, [27 ... 32] = 0, 1, 0, 0, 2, [37 ... 39] = 0, 1, 2, 0, 0, 3, [45 ... 47] = 0, 1, 1, [50 ... 66] = 0}; const int Bytes[5 /*0:4*/] = {0, 4, 8, 4, 8}; const int Sizecode[6 /*0:5*/] = {0, 5, 6, 5, 5, 3}; static int Fixedgla[14 /*0:13*/] = { 0, [1 ... 3] = 0, -1, 0, [6 ... 11] = 0, 0x30000000, 0}; const unsigned char Trtab[256 /*0:255*/] = { [0 ... 47] = 0, [48 ... 57] = 1, [58 ... 64] = 0, [65 ... 90] = 2, [91 ... 96] = 0, [97 ... 122] = 2, [123 ... 127] = 0, [128 ... 255] = 0}; const int Grmap[5 /*0:4*/] = {0, 1, 3, 5, 7}; const unsigned char Itoetab[256 /*0:255*/] = { 0x00, 0x01, 0x02, 0x03, 0x37, 0x2D, 0x2E, 0x2F, 0x16, 0x05, 0x25, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F, 0x10, 0x11, 0x12, 0x13, 0x3C, 0x3D, 0x32, 0x26, 0x18, 0x19, 0x3F, 0x27, 0x1C, 0x1D, 0x1E, 0x1F, 0x40, 0x4F, 0x7F, 0x7B, 0x5B, 0x6C, 0x50, 0x7D, 0x4D, 0x5D, 0x5C, 0x4E, 0x6B, 0x60, 0x4B, 0x61, 0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7, 0xF8, 0xF9, 0x7A, 0x5E, 0x4C, 0x7E, 0x6E, 0x6F, 0x7C, 0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7, 0xC8, 0xC9, 0xD1, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6, 0xD7, 0xD8, 0xD9, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6, 0xE7, 0xE8, 0xE9, 0x4A, 0xE0, 0x5A, 0x5F, 0x6D, 0x79, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88, 0x89, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97, 0x98, 0x99, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, 0xA7, 0xA8, 0xA9, 0xC0, 0x6A, 0xD0, 0xA1, 0x07, 0x20, 0x21, 0x22, 0x23, 0x24, 0x15, 0x06, 0x17, 0x28, 0x29, 0x2A, 0x2B, 0x2C, 0x09, 0x0A, 0x1B, 0x30, 0x31, 0x1A, 0x33, 0x34, 0x35, 0x36, 0x08, 0x38, 0x39, 0x3A, 0x3B, 0x04, 0x14, 0x3E, 0xE1, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, 0x51, 0x52, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x80, 0x8A, 0x8B, 0x8C, 0x8D, 0x8E, 0x8F, 0x90, 0x9A, 0x9B, 0x9C, 0x9D, 0x9E, 0x9F, 0xA0, 0xAA, 0xAB, 0xAC, 0xAd, 0xAE, 0xAf, 0xB0, 0xB1, 0xB2, 0xB3, 0xB4, 0xB5, 0xB6, 0xB7, 0xB8, 0xB9, 0xBA, 0xBB, 0xBC, 0xBD, 0xBE, 0xBF, 0xCa, 0xCB, 0xCc, 0xCD, 0xCE, 0xCf, 0xDA, 0xDB, 0xDC, 0xDd, 0xDE, 0xDF, 0xEA, 0xEB, 0xEC, 0xED, 0xEE, 0xEF, 0xFA, 0xFB, 0xFC, 0xFD, 0xFE, 0xFF}; const int Maxlevels = 31; const int Unasspat = 0x81818181; const int Jobberbit = 0x40000000; const int Cebit = 1; const int Maxdict = 0x100; const int Lb = 0x7A; const int Slb = 0x52; const int Stb = 0x5A; const int Adb = 0x20; const int Cpb = 0x26; const int Myb = 0x2A; const int Sbb = 0x22; const int Cpib = 0x2E; const int Ld = 0x78; const int Lda = 0x72; const int Inca = 0x14; const int Std = 0x58; const int Ldb = 0x76; const int Ldtb = 0x74; const int Ldrl = 0x70; const int Cyd = 0x12; const int Modd = 0x16; const int Stln = 0x5C; const int Asf = 0x6E; const int St = 0x48; const int Raln = 0x6C; const int Lxn = 0x7E; const int Lln = 0x7C; const int Lss = 0x62; const int Slss = 0x42; const int Mpsr = 0x32; const int Stsf = 0x5E; const int Luh = 0x6A; const int Stuh = 0x4A; const int Lsd = 0x64; const int Slsd = 0x44; const int Prcl = 0x18; const int Lsq = 0x66; const int Slsq = 0x46; const int Stxn = 0x4C; const int Lct = 0x30; const int Stct = 0x36; const int Junc = 0x1A; const int Jlk = 0x1C; const int Call = 0x1E; const int Exit = 0x38; const int Jcc = 2; const int Jat = 4; const int Jaf = 6; const int Debj = 0x24; const int Cpsr = 0x34; const int Esex = 0x3A; const int Iad = 0xE0; const int Icp = 0xE6; const int Ush = 0xC8; const int Isb = 0xE2; const int Irsb = 0xE4; const int Or = 0x8C; const int Ucp = 0xC6; const int Imy = 0xEA; const int Imdv = 0xAE; const int And = 0x8A; const int Ish = 0xE8; const int Neq = 0x8E; const int Rad = 0xF0; const int Rsb = 0xF2; const int Rrsb = 0xF4; const int Flt = 0xA8; const int Rrdv = 0xBC; const int Rsc = 0xF8; const int Fix = 0xB8; const int Rmy = 0xFA; const int Rcp = 0xF6; const int Mvl = 0xB0; const int Mv = 0xB2; const unsigned char Ocode[49 /*-1:47*/] = { 0x1E, 0x1C, [2 ... 15] = 2, 0x1A, [17 ... 32] = 4, [33 ... 48] = 6}; const int Accr = 0; const int Dr = 1; const int Lnb = 2; const int Xnb = 3; const int Pc = 4; const int Ctb = 5; const int Tos = 6; const int Breg = 7; const unsigned char Ldcode[8 /*0:7*/] = {0, 0x78, 0x7C, 0x7E, 0, 48, 0, 0x7A}; const _imp_string255 Defaultmainep = _imp_str_literal("S#GO"); const _imp_string255 Mdep = _imp_str_literal("S#NDIAG"); const _imp_string255 Sigep = _imp_str_literal("S#SIGNAL"); const _imp_string255 Auxstep = _imp_str_literal("ICL9CEAUXST"); const int Labbyname = 1; const int Swbyname = 2; const int Snpt = 0x1006; int Rpptr; int Kychar1; int Kychar2; int Levelinf; int Rpbase; int Aslmax; int Auxst; int Cdcount; int Freeformat; int Pass2inf; int P1size; int Dictbase; int Asl; int Nnames; int Arsize; int Cabuf; int Ppcurr; int Crefhead; int Consthole; int Constptr; int Constbtm; int Constlimit; int Aslcurbtm; int Length; int Nextp; int N0; int Snum; int Rlevel; int Nmax; int Ustptr; int Plabel; int Level; int Ca; int Rr; int Type; int Lastname; int Stlimit; int Ebcdic; int Faulty; int Hit; int Inhcode; int Ttoput; int List; int Adflag; int Parmline; int Parmtrce; int Parmdiag; int Parmopt; int Ctype; int Dcomp; int Cprmode; int Parmchk; int Parmarr; int Qflag; int Smap; int Parmdynamic; double Cvalue; double Imax; int Mask; int Next; int N; int Item; int Logepdisp; int Expepdisp; int Codepdisp; int P; int Q; int R; int Strlink; int Line; int S; int T; int U; int V; int Nest; int Fname; int Glaca; int Glacabuf; int Glacurr; int Sstl; int Qmax; int Lastline; int Lastat; int Slines; int Fileaddr; int Fileptr; int Fileend; int Filesize; int Lastend; int Parmbits1; int Parmbits2; int Wkfilead; int Wkfilesegs; int Glarelocs; extern int *Comreg(int N); typedef struct Listf { int S1; int S2; int S3; int Link; } Listf; { Fileaddr = *Comreg(46); Parmbits1 = *Comreg(27); Parmbits2 = *Comreg(28); Wkfilead = *Comreg(14); Wkfilesegs = *Integer(Wkfilead + 8) >> 18; if (Fileaddr == 0) Filesize = 32000 * (Fileaddr + 2); else { Fileptr = Fileaddr + *Integer(Fileaddr + 4); Fileend = Fileaddr + *Integer(Fileaddr); Filesize = *Integer(Fileaddr); } Arsize = Wkfilesegs << 16; Nnames = 511; if ((Parmbits1 & Jobberbit) == 0) { if (Filesize > 32000) Nnames = 1023; if ((Parmbits2 & Maxdict) != 0 || Wkfilesegs > 2) Nnames = 2047; } if ((Parmbits2 & Cebit) == 0 || (Parmbits1 & Jobberbit) != 0) { Newlines(3); Spaces(5); Printstring(_imp_str_literal("EDINBURGH ALGOL 60M COMPILER ")); Printstring(_imp_str_literal(" VERSION 60")); Newlines(3); } Asl = 3 * Nnames; if (Asl > 4095) Asl = 4095; Aslmax = Asl; } Listf Aslist[Asl + 1]; int Set[32 /*0:31*/]; int Stackbase[32 /*0:31*/]; int Ral[32 /*0:31*/]; int Flag[32 /*0:31*/]; int L[32 /*0:31*/]; int M[32 /*0:31*/]; int Nmdecs[32 /*0:31*/]; int Jround[32 /*0:31*/]; int Names[32 /*0:31*/]; unsigned char Ccf[(Filesize + 7) + 1]; unsigned char Cc; int Af[Arsize + 1]; int A; int Cclines; int Wrd[Nnames + 1]; int Tags[Nnames + 1]; extern void Lput(int A, int B, int C, int D); void Warn(int N, int V); void Fault(int N, int Value); void Printname(int N); void Clearlist(int Head); void Binsert(int T, int B, int S1, int S2, int S3); void From123(int Cell, int S1, int S2, int S3); void Pop(int C, int P, int Q, int R); int Morespace(void); void Push(int C, int S1, int S2, int S3); int Find(int Lab, int List); void Mlink(int Cell); _imp_string255 Mainep; void Prhex(int Value, int Places); #if 0 /* Vmeb==Yes */ extern void Faultmk(int Onoff); #endif #if 1 /* Allowcodelist==Yes */ extern void Ncode(int A, int B, int C); #endif Cc = &Array(Wkfilead + (*Integer(Wkfilead + 8) >> 1), Ccf); Cclines = &Array(Wkfilead + *Integer(Wkfilead + 4), Af); A = &Array(Addr(Cc(0)) + 4096, Af); { void Compare(void); void Pname(int Mode); int Const(int Mode); void Texttext(void); void Readprg(void); const unsigned char Ilett[534 /*0:533*/] = { 3, 'A', 'B', 'S', 4, 'I', 'A', 'B', 'S', 4, 'S', 'I', 'G', 'N', 6, 'E', 'N', 'T', 'I', 'E', 'R', 11, 'C', 'L', 'O', 'S', 'E', 'S', 'T', 'R', 'E', 'A', 'M', 4, 'S', 'Q', 'R', 'T', 3, 'S', 'I', 'N', 3, 'C', 'O', 'S', 6, 'A', 'R', 'C', 'T', 'A', 'N', 2, 'L', 'N', 3, 'E', 'X', 'P', 7, 'M', 'A', 'X', 'R', 'E', 'A', 'L', 7, 'M', 'I', 'N', 'R', 'E', 'A', 'L', 6, 'M', 'A', 'X', 'I', 'N', 'T', 7, 'E', 'P', 'S', 'I', 'L', 'O', 'N', 5, 'F', 'A', 'U', 'L', 'T', 4, 'S', 'T', 'O', 'P', 8, 'I', 'N', 'S', 'Y', 'M', 'B', 'O', 'L', 9, 'O', 'U', 'T', 'S', 'Y', 'M', 'B', 'O', 'L', 6, 'I', 'N', 'R', 'E', 'A', 'L', 7, 'O', 'U', 'T', 'R', 'E', 'A', 'L', 9, 'I', 'N', 'I', 'N', 'T', 'E', 'G', 'E', 'R', 13, 'O', 'U', 'T', 'T', 'E', 'R', 'M', 'I', 'N', 'A', 'T', 'O', 'R', 10, 'O', 'U', 'T', 'I', 'N', 'T', 'E', 'G', 'E', 'R', 9, 'O', 'U', 'T', 'S', 'T', 'R', 'I', 'N', 'G', 6, 'L', 'E', 'N', 'G', 'T', 'H', 7, 'C', 'P', 'U', 'T', 'I', 'M', 'E', 11, 'S', 'E', 'L', 'E', 'C', 'T', 'I', 'N', 'P', 'U', 'T', 12, 'S', 'E', 'L', 'E', 'C', 'T', 'O', 'U', 'T', 'P', 'U', 'T', 7, 'N', 'E', 'W', 'L', 'I', 'N', 'E', 5, 'S', 'P', 'A', 'C', 'E', 8, 'N', 'E', 'W', 'L', 'I', 'N', 'E', 'S', 6, 'S', 'P', 'A', 'C', 'E', 'S', 10, 'N', 'E', 'X', 'T', 'S', 'Y', 'M', 'B', 'O', 'L', 11, 'P', 'R', 'I', 'N', 'T', 'S', 'Y', 'M', 'B', 'O', 'L', 10, 'R', 'E', 'A', 'D', 'S', 'Y', 'M', 'B', 'O', 'L', 4, 'R', 'E', 'A', 'D', 7, 'N', 'E', 'W', 'P', 'A', 'G', 'E', 5, 'P', 'R', 'I', 'N', 'T', 11, 'P', 'R', 'I', 'N', 'T', 'S', 'T', 'R', 'I', 'N', 'G', 4, 'C', 'O', 'D', 'E', 8, 'R', 'E', 'A', 'D', '1', '9', '0', '0', 9, 'P', 'R', 'I', 'N', 'T', '1', '9', '0', '0', 6, 'O', 'U', 'T', 'P', 'U', 'T', 11, 'R', 'E', 'A', 'D', 'B', 'O', 'O', 'L', 'E', 'A', 'N', 12, 'W', 'R', 'I', 'T', 'E', 'B', 'O', 'O', 'L', 'E', 'A', 'N', 9, 'W', 'R', 'I', 'T', 'E', 'T', 'E', 'X', 'T', 8, 'C', 'O', 'P', 'Y', 'T', 'E', 'X', 'T', 6, 'R', 'E', 'A', 'D', 'C', 'H', 6, 'N', 'E', 'X', 'T', 'C', 'H', 7, 'P', 'R', 'I', 'N', 'T', 'C', 'H', 6, 'S', 'K', 'I', 'P', 'C', 'H', 7, 'M', 'O', 'N', 'I', 'T', 'O', 'R', 6, 'O', 'P', 'E', 'N', 'D', 'A', 6, 'O', 'P', 'E', 'N', 'S', 'Q', 7, 'C', 'L', 'O', 'S', 'E', 'D', 'A', 7, 'C', 'L', 'O', 'S', 'E', 'S', 'Q', 5, 'P', 'U', 'T', 'D', 'A', 5, 'G', 'E', 'T', 'D', 'A', 5, 'P', 'U', 'T', 'S', 'Q', 5, 'G', 'E', 'T', 'S', 'Q', 6, 'R', 'W', 'N', 'D', 'S', 'Q', 6, 'I', 'N', 'C', 'H', 'A', 'R', 7, 'O', 'U', 'T', 'C', 'H', 'A', 'R', 10, 'P', 'A', 'P', 'E', 'R', 'T', 'H', 'R', 'O', 'W', 8, 'P', 'U', 'T', 'A', 'R', 'R', 'A', 'Y', 8, 'G', 'E', 'T', 'A', 'R', 'R', 'A', 'Y', 255}; const unsigned char Itype[68 /*0:67*/] = {0, 130, [2 ... 4] = 129, 128, [6 ... 13] = 130, 129, 130, [16 ... 25] = 128, 129, 130, [28 ... 33] = 128, 129, [35 ... 36] = 128, 130, [38 ... 40] = 128, 129, 130, [43 ... 44] = 128, 131, [46 ... 48] = 128, [49 ... 50] = 129, [51 ... 67] = 128}; int I; int J; int Ll; int Dsize; int Savq; int Analfail; Dsize = 8 * Nnames; int Ntype[Nnames + 1]; int Dposn[Nnames + 1]; unsigned char Lett[(Dsize + 20) + 1]; Cabuf = 0; Ppcurr = 0; Pass2inf = 0; Line = 1; Rlevel = 0; Nmax = 0; Ustptr = 0; Level = 0; Ca = 0; Lastat = 0; Faulty = 0; Adflag = 0; Strlink = 0; Dcomp = 0; Cprmode = 0; Consthole = 0; Crefhead = 0; Next = 1; Dictbase = Addr(Lett(0)); Logepdisp = 0; Expepdisp = 0; Codepdisp = 0; Imax = (-1) >> 1; Plabel = 24999; Sstl = 0; Lastline = 1; Snum = 0; Cdcount = 0; Rpptr = 0; Lett(0) = 0; N0 = 14; N = 12; Glaca = N0 << 2; Glacabuf = Glaca; Glarelocs = 0; Glacurr = 0; Parmopt = 1; Parmarr = 1; Parmline = 1; Parmtrce = 1; Parmdiag = 1; Inhcode = 0; List = 1; Parmchk = 1; Levelinf = 0; I = Parmbits1; Ebcdic = Parmbits1 >> 22 & 1; Stlimit = 0x1F000; if ((I >> 24 & 1) != 0) Stlimit = *Comreg(48); Freeformat = I & 0x80000; Qflag = I & 1; if ((I & 2) != 0) List = 0; if ((I & 0x800000) != 0) Parmline = 0; if ((I & 4) != 0) Parmdiag = 0; if ((I & 16) != 0) Parmchk = 0; if ((I & 32) != 0) Parmarr = 0; Parmdynamic = I >> 20 & 1; #if 1 /* Allowcodelist==Yes */ Dcomp = I >> 14 & 1; #endif Ttoput = *Comreg(40); Smap = I >> 7 & 1; if ((I & 64) != 0) { Parmtrce = 0; Parmdiag = 0; } if ((I & (1 << 16)) != 0) { Parmarr = 0; Parmopt = 0; Parmline = 0; Parmchk = 0; Parmdiag = 0; } Mainep = Defaultmainep; if (Qflag == 0) { Kychar1 = '%'; Kychar2 = ' '; } else { Kychar1 = '\''; Kychar2 = '\''; } for (I = 0; I <= Maxlevels; I++) { Set(I) = 0; Stackbase(I) = 0; Ral(I) = 0; Flag(I) = 0; L(I) = 0; M(I) = 0; Jround(I) = 0; Names(I) = -1; } #if 1 /* Includehandcode==No */ for (I = 0; I <= Nnames; I++) { Wrd(I) = 0; Tags(I) = 0; Ntype(I) = 0; } #else { asm("LB NNAMES"); asm("ADB 1"); asm("MYB 4"); asm("ADB X'18000000'"); asm("LDA WRD+4"); asm("LDTB %B"); asm("MVL %L=%DR,0,0"); asm("LDA TAGS+4"); asm("LDTB %B"); asm("MVL %L=%DR,0,0"); asm("LDA NTYPE+4"); asm("LDTB %B"); asm("MVL %L=%DR,0,0"); } #endif Aslcurbtm = Asl - 240; Constlimit = 4 * Aslcurbtm - 8; for (I = Aslcurbtm; I <= Asl - 1; I++) Aslist(I + 1).Link = I; Aslist(Aslcurbtm).Link = 0; Aslist(0).S1 = -1; Aslist(0).S2 = -1; Aslist(0).S3 = -1; Aslist(0).Link = 0; K = 0; Ll = 1; I = Ilett(0); while (I < 255) { for (J = 1; J <= I; J++) { Cc(J) = Ilett(J + K); } Cc(J + 1) = ';'; R = 2; Q = 1; Pname(1); Ntype(Lastname) = Itype(Ll) << 8; Dposn(Lastname) = -1; Snnno(Ll) = Lastname; Ll = Ll + 1; K = K + I + 1; I = Ilett(K); } Snum = Ll - 1; Lastat = -2; Lput(0, 1, 1, Addr(Lett(1))); Readprg(); Length = Length + 5; Cc(Length) = ';'; Cc(Length + 1) = 'C' + 128; Cc(Length + 2) = 'E' + 128; Cc(Length + 3) = 'N' + 128; Cc(Length + 4) = 'D' + 128; Cc(Length + 5) = ';'; Length = Length + 5; Lastline = Line; I = (Addr(Cclines(Lastline + 1)) + 15) & (-16); J = Addr(Cc(0)); if (I > J) Fault(102, 0); #if 1 /* Includehandcode==No */ for (K = 0; K <= Length; K++) Byteinteger(I + K) = Cc(K); #else { asm("LDTB X'18000000';"); asm("LDB LENGTH"); asm("LDA J;"); asm("CYD 0"); asm("LDA I"); asm("MV %L=%DR"); } #endif Cc = &Array(I, Ccf); Newlines(2); I = (Addr(Cc(Length)) + 4095) >> 12 << 12; J = Addr(Cclines(0)) + 16 * 4096 * Wkfilesegs; if (J > I) I = J; A = &Array(I, Af); Arsize = ((Wkfilead + (Wkfilesegs << 18) - I) >> 2) - 512; Slines = Line; Q = 1; Qmax = 1; Line = 1; for (R = 0; R <= 7; R++) A(R) = 0; Stackbase(1) = 5; R = 8; Level = 1; do { Savq = Q; Qmax = Q; P = Ss; while (Cclines(Line + 1) <= Q) Line = Line + 1; Rr = R; A(R + 1) = Line; R = R + 2; Analfail = 0; Compare(); if (R > Arsize) Fault(102, 0); if (Hit == 0) { Q = Savq; Fault(100, Analfail); R = Rr; } else { A(Rr) = R - Rr; if (Level == 0) { Fault(14, 0); break; } } } while (Q < Length - 6); if (Level > 1 || (Jround(1) & 255) != 0) Fault(15, 0); A(R) = 0; R = R + 1; A(R) = 0; R = R + 1; P1size = R; Dictbase = Addr(A(R)); R = R + ((Next + 7) >> 2); Rpptr = (R + 256) & (-256); Rpbase = Rpptr; if (Rpbase > Arsize) Fault(102, 0); #if 1 /* Includehandcode==No */ for (I = 0; I <= Next; I++) Byteinteger(Dictbase + I) = Lett(I); #else { asm("LDTB X'18000000'"); asm("LDB NEXT"); asm("LDA LETT+4"); asm("CYD 0"); asm("LDA DICTBASE"); asm("MV %L=%DR"); } #endif goto Bend; const int Keychk[26 /*65:90*/] = { 0x0014400A, 0x08020028, 0x00020030, 0x00820003, 0x0014814F, 0x8002002A, 0x08021005, 0, 0x040C0025, 0, 0, 0x88001009, 0, 0x08020003, 0x00004203, 0x000240A8, 0, 0x08000004, 0x00001214, 0x01024005, 0x00040008, 0x80000008, 0x01000008, 0, [24 ... 25] = 0}; const unsigned char Ulined[128 /*0:127*/] = { 0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09, 0x0A, 0x0B, 0x0C, 0x0D, 0x0C, 0x0F, 0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x18, 0x19, 0x1A, 0x1B, 0x1C, 0x1D, 0x1C, 0x1F, 0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27, 0x28, 0x29, 0x2A, 0x2B, 0x2C, 0x2D, 0x2C, 0x2F, 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x3A, 0x3B, 0x3C, 0x3D, 0x3C, 0x3F, 0x40, 0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7, 0xC8, 0xC9, 0xCa, 0xCB, 0xCc, 0xCD, 0xCE, 0xCf, 0xD0, 0xD1, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6, 0xD7, 0xD8, 0xD9, 0xDA, 0x5B, 0x5C, 0x5D, 0x5E, 0x5F, 0x60, 0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7, 0xC8, 0xC9, 0xCa, 0xCB, 0xCc, 0xCD, 0xCE, 0xCf, 0xD0, 0xD1, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6, 0xD7, 0xD8, 0xD9, 0xDA, 0x7B, 0x7C, 0x7D, 0x7E, 0x7F}; void Readprg(void) { void Getline(void); int Del; unsigned char Bline[182 /*-20:161*/]; const int Nbasics = 8; const int Maxsize = 11; const int Bassym[10 /*0:9*/] = {'<', '[', '>', ']', '(', 123, ')', 125, '-', '_'}; int Word[13 /*0:12*/]; int Size; int Letterflag; int Ll; int Lp; int I; int J; int Bld0; int Bld1; Ll = 0; Lp = 0; Length = -4; Del = 0; if (List != 0) Printstring(_imp_str_literal(" LINE\n")); for (K = -20; K <= 0; K++) Bline(K) = ' '; Bld0 = 0x180000A1; Bld1 = Addr(Bline(1)); L2: Lp = Lp + 1; if (Lp > Ll) { Getline(); Lp = 1; if (Bline(1) == 25) return; } I = Tline(Lp); if (10 != I && I <= 31 || I > 126) goto L2; if (I == '\'' && Qflag != 0) { Letterflag = 1; Size = 0; for (;;) { Lp = Lp + 1; if (Lp > Ll) { Getline(); Lp = 1; } I = Tline(Lp); if (I == '\'') break; if (33 <= I && I <= 126) { Size = Size + 1; Word(Size) = I; if (Trtab(I) != 2) Letterflag = 0; Cc(Length + Size + 4) = Ulined(I); if (Size > Maxsize) break; } else { if (I == 10) { Line = Line + 1; Cclines(Line) = Length + Size + 6; } if (I == 25) goto Cods; } } if (Letterflag == 1 && 0 < Size && Size < Maxsize) { I = Keychk(Word(1) & 0x5F); if ((I & 0x80000000 >> ((Word(2) - 1) & 31)) == 0 || (I & 1 << (Size - 2)) == 0) goto Cods; Length = Length + Size; I = Cc(Length + 4); goto L2; } if (Size == 1) { I = Word(1); if (I == '/') { Cc(Length + 5) = 'D' + 128; Cc(Length + 6) = 'I' + 128; Cc(Length + 7) = 'V' + 128; Length = Length + 3; goto L2; } for (J = 0; J <= Nbasics; J += 2) if (I == Bassym(J)) { Cc(Length + 5) = Bassym(J + 1); Length = Length + 1; goto L2; } } if (Size == 2) { if (Word(1) == '1' && Word(2) == '0') { Length = Length + 1; Cc(Length + 4) = '&'; goto L2; } if (Word(1) == '*' && '*' == Word(2)) { Length = Length + 2; Cc(Length + 3) = '*'; Cc(Length + 4) = '*'; goto L2; } } Cods: Length = Length + 1; Cc(Length + 4) = '\''; if (Size > 0) for (I = 1; I <= Size; I++) { Length = Length + 1; J = Word(I); Cc(Length + 4) = J; } if (Tline(Lp) == '\'') Lp = Lp - 1; goto L2; } if (Qflag == 0) { if (I == '%') { Del = 128; goto L2; } if (Trtab(I) != 2) Del = 0; if (Del != 0) I = Ulined(I); } if (I == ' ') goto L2; if (I == Nl) { Line = Line + 1; Cclines(Line) = Length + 5; goto L2; } Length = Length + 1; Cc(Length + 4) = I; goto L2; void Getline(void) { extern void Iocp(int Ep, int N); extern void Sim2(int Ep, int R1, int R2, int R3); int K; int Pu; int St; int Ls; const unsigned char Itoi[256 /*0:255*/] = {[0 ... 9] = 32, 10, [11 ... 24] = 32, 25, 26, [27 ... 31] = 32, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124, 125, 126, 32, [128 ... 132] = 26, 10, [134 ... 143] = 26, [144 ... 159] = 26, [160 ... 173] = 26, 92, 38, [176 ... 186] = 26, 35, [188 ... 191] = 26, [192 ... 207] = 26, [208 ... 216] = 26, 35, [218 ... 222] = 26, 94, [224 ... 255] = 26}; Ll = 0; if (Fileaddr == 0) { Sim2(0, Addr(Bline(1)), 0, K); Ll = K; #if 1 /* Includehandcode==No */ for (K = 1; K <= Ll; K++) Bline(K) = Itoi(Bline(K)); #else { asm("LD BLD0"); asm("LDB LL"); asm("LSS ITOI+4"); asm("LUH X'18000100'"); asm("TTR %L=%DR"); } #endif if (Bline(1) == 25) { Tline(1) = 25; Tline(2) = 10; return; } } else { if (Fileptr >= Fileend) { Bline(1) = 25; Tline(1) = 25; Tline(2) = 10; Ll = 2; return; } #if 0 /* Includehandcode==Yes */ { asm("LDA FILEPTR"); asm("LB FILEEND"); asm("SBB FILEPTR"); asm("ADB X'18000000'"); asm("LDTB %B"); asm("SWNE %L=%DR,0,10"); asm("JCC 8,"); asm("CYD 0"); asm("STUH %B"); asm("IAD 1"); asm("ST %B"); asm("ISB FILEPTR"); asm("ST LL"); asm("LDA FILEPTR"); asm("STB FILEPTR"); asm("LDB LL"); asm("CYD 0"); asm("LDA BLD1"); asm("STD %TOS"); asm("MV %L=%DR,0,0"); asm("LD %TOS"); asm("LSS ITOI+4"); asm("LUH X'18000100'"); asm("TTR %L=%DR"); goto Olist; } #endif Imp:; do { K = *Byteinteger(Fileptr); Fileptr = Fileptr + 1; Bline(Ll + 1) = Itoi(K); Ll = Ll + 1; } while (K != Nl && K != 0); Olist:; } if (List != 0) { #if 1 /* Includehandcode==No */ { Write(Line, 5); Bline(-5) = Ll + 4; Iocp(15, Addr(Bline(-5))); } #else { asm("LSS LINE"); asm("CDEC 0"); asm("DSH 9"); asm("LDTB X'18000006'"); asm("LDA BLD1"); asm("INCA -11"); asm("CPB %B"); asm("SUPK %L=6,0,32"); asm("INCA -6"); asm("LDB 6"); asm("ANDS %L=6,0,63"); Bline(-11) = Ll + 10; Iocp(15, Addr(Bline(-11))); } #endif Newline(); } if (Freeformat == 0 && Ll > 73) { Bline(73) = 10; Ll = 73; } Pu = 1; St = 1; Ls = 0; #if 1 /* Includehandcode==No */ { if (Qflag == 1) do { K = Bline(Pu); Pu = Pu + 1; if (K != ' ') { Tline(St) = K; St = St + 1; } } while (K != 10); else do { K = Bline(Pu); Pu = Pu + 1; if (K != ' ' || (Ls >= 'A' && Ls <= 'Z')) { Tline(St) = K; St = St + 1; Ls = K; } } while (K != 10); Ll = St - 1; } #else { asm("LD BLD0"); asm("LDB LL"); asm("SWEQ %L=%DR,0,32"); asm("CYD =0"); asm("LDA TLINE+4"); asm("INCA =1"); asm("MV %L=%DR"); asm("INCA =-2;"); asm("LSS =32"); Back: asm("ICP (%DR)"); asm("JCC 7,"); asm("INCA =-1"); asm("J "); Out: asm("LSS =10"); asm("INCA =1"); asm("ST (%DR)"); asm("STD ST"); asm("LSS LS"); asm("ISB TLINE+4"); asm("ST LL"); } #endif } } void Compare(void) { void Up(void); double Align; int Ra; int Rl; int Rp; int Rq; int Rr; int Ssl; int Sc; int Rs; int Marker; int Alt; int Pp; int I; int J; int Failno; const int Opmask[8 /*0:7*/] = {0, 0x00350000, 2, [3 ... 5] = 0, 0x08008000, 0}; static int Bip_sw; static void *Bip[47 /*999:1045*/] = { &&Bip_999, &&Bip_1000, &&Bip_1001, &&Bip_1002, &&Bip_1003, &&Bip_1004, &&Bip_1005, &&Bip_1006, &&Bip_1007, &&Bip_1008, &&Bip_1009, &&Bip_1010, &&Bip_1011, &&Bip_1012, &&Bip_1013, &&Bip_1014, &&Bip_1015, &&Bip_1016, &&Bip_1017, &&Bip_1018, &&Bip_1019, &&Bip_1020, &&Bip_1021, &&Bip_1022, &&Bip_1023, &&Bip_1024, &&Bip_1025, &&Bip_1026, &&Bip_1027, &&Bip_1028, &&Bip_1029, &&Bip_1030, &&Bip_1031, &&Bip_1032, &&Bip_1033, &&Bip_1034, &&Bip_1035, &&Bip_1036, &&Bip_1037, &&Bip_1038, &&Bip_1039, &&Bip_1040, &&Bip_1041, &&Bip_1042, &&Bip_1043, &&Bip_1044, &&Bip_1045, }; #if 0 /* Includehandcode==Yes */ { I = Addr(Symbol(1300)) - 4*1300;asm("LSS I"); asm("LUH X'28001000'"); asm("ST ALIGN"); asm("JLK 2"); asm("EXIT -64"); } #endif Subentry:; Rp = Symbol(P); Rl = Level; if (P == Ss) { I = Cc(Q); if (Trtab(I) != 2 && I != 'F' + 128 && I != 'G' + 128 && (I != 'I' + 128 || Cc(Q + 1) != 'F' + 128)) { Rq = Q; Rr = R; Ssl = Strlink; Alt = 2; Sc = Line; P = P + 1; Rs = Symbol(P); Ra = Symbol(Rs); goto Upr; } } P = P + 1; Pp = P; goto Comm; Bip_999:; A(Rr) = Alt; P = Pp; Comm:; #if 1 /* Includehandcode==No */ { Rq = Q; Rr = R; Ssl = Strlink; Sc = Line; } #else { asm("LSQ Q"); asm("ST RQ"); } #endif Alt = 1; #if 1 /* Includehandcode==No */ { Rs = P; Ra = Symbol(P); } #else { asm("LB P"); asm("STB RS"); asm("LSS (ALIGN+%B)"); asm("ST RA"); } #endif Upr: R = R + 1; Succ:; #if 1 /* Includehandcode==No */ { Rs = Rs + 1; if (Rs != Ra) goto Nextbr; } #else { asm("LB RS"); asm("ADB 1"); asm("CPB RA"); asm("JCC 7,"); } #endif Bip_1000:; A(Rr) = Alt; Hit = 1; #if 1 /* Includehandcode==No */ return; #else asm("J %TOS"); #endif Nextbr:; #if 1 /* Includehandcode==No */ { Item = Symbol(Rs); if (Item < 999) { if (Cc(Q) == Item) { Q = Q + 1; goto Succ; } goto Fail1; } if (Item < 1300) goto *Bip[Bip_sw = (Item)-999]; P = Item; Compare(); } #else { asm("STB RS"); asm("LSS (ALIGN+%B)"); asm("ICP 999"); asm("JCC 10,"); asm("LB Q"); asm("ICP (CC+%B)"); asm("JCC 7,"); asm("ADB 1"); asm("STB Q"); asm("J "); Notlit:; asm("ICP 1300"); asm("JCC 10,"); asm("ST ITEM"); goto *Bip[Bip_sw = (Item)-999]; Notbip:; asm("ST P"); asm("LSQ RA"); asm("SLSQ RR"); asm("SLSQ MARKER"); asm("ST %TOS"); asm("JLK "); asm("LSQ %TOS"); asm("ST MARKER"); asm("LSQ %TOS"); asm("ST RR"); asm("LSQ %TOS"); asm("ST RA"); } #endif if (Hit != 0) goto Succ; goto Fail; Fail1: Failno = 1; Fail:; if (Ra == Rp) { Hit = 0; if (Level != Rl) { if (Level > Rl) Up(); Level = Rl; } #if 1 /* Includehandcode==No */ return; #else asm("J %TOS"); #endif } #if 1 /* Includehandcode==No */ if (Q > Qmax) { Qmax = Q; Analfail = Failno; } #else { asm("LSS Q"); asm("ICP QMAX"); asm("JCC 12,"); asm("ST QMAX"); asm("LSS FAILNO"); asm("ST ANALFAIL"); } #endif Mcl1:; #if 1 /* Includehandcode==No */ { Q = Rq; R = Rr; Line = Sc; Strlink = Ssl; Rs = Ra; Ra = Symbol(Ra); } #else { asm("LSQ RQ"); asm("ST Q"); asm("LB RA"); asm("STB RS"); asm("LSS (ALIGN+%B)"); asm("ST RA"); } #endif Alt = Alt + 1; goto Upr; Bip_1001:; Bip_1004:; if (Lastat == Q) { A(R) = Lastname; Q = Lastend; goto Upr; } if (Trtab(Cc(Q)) != 2) goto Fail1; Pname(Item - 1004); if (Hit == 1) goto Succ; Failno = 2; goto Fail; Bip_1002:; Bip_1003:; Failno = Const(Item - 1003); if (Hit == 0) goto Fail; if (Ctype == 2) { A(R) = 2; A(R + 1) = *Integer(Addr(Cvalue)); A(R + 2) = *Integer(Addr(Cvalue) + 4); R = R + 3; } else { A(R) = 1; A(R + 1) = S; R = R + 2; } goto Succ; Bip_1005:; S = 0; I = Cc(Q); while (I != ';') { if ((I & 128) != 0) S = 1; Q = Q + 1; I = Cc(Q); } if (S != 0) Warn(1, 0); Q = Q + 1; goto Succ; Bip_1006:; J = Q - 5; if (Cc(J + 4) == 'N' + 128 && Cc(J + 3) == 'I' + 128 && Cc(J + 2) == 'G' + 128 && Cc(J + 1) == 'E' + 128 && Cc(J) == 'B' + 128) goto Sep; I = Cc(Q); if (I == ';') { Q = Q + 1; goto Sep; } if (I == 'E' + 128 && Cc(Q + 1) == 'N' + 128 && Cc(Q + 2) == 'D' + 128) goto Sep; goto Fail1; Sep:; if (Jround(Level) != 0 && (Jround(Level) & 255) == 0) Up(); goto Succ; Bip_1007:; S = 0; for (;;) { while (';' != Cc(Q) && Cc(Q) != 'E' + 128) { if (Cc(Q) > 128 && S == 0) { S = 1; Warn(1, 0); } Q = Q + 1; } if (Cc(Q) == ';') goto Succ; if (Cc(Q + 1) == 'N' + 128 && Cc(Q + 2) == 'D' + 128) goto Succ; if (Cc(Q + 1) == 'L' + 128 && Cc(Q + 2) == 'S' + 128 && Cc(Q + 3) == 'E' + 128) goto Succ; Q = Q + 1; } Bip_1008:; Texttext(); if (Hit == 0) goto Fail1; goto Upr; Bip_1009:; Bip_1012:; U = R; V = 1; R = R + 1; if (Trtab(Cc(Q)) != 2) goto Fail1; Pname(Item - 1012); if (Hit == 0) { Failno = 2; goto Fail; } for (;;) { J = Cc(Q); Q = Q + 1; if (J != ',') break; I = Cc(Q); Pname(Item - 1012); if (Hit == 0) break; V = V + 1; } Q = Q - 1; A(U) = V; goto Succ; Bip_1010:; Marker = R; goto Upr; Bip_1011:; A(Marker) = R - Marker; goto Succ; Bip_1013:; while (Cclines(Line + 1) <= Q) Line = Line + 1; A(R) = Line; goto Upr; Bip_1014:; I = Cc(Q); if (Trtab(I) != 2) goto Fail1; while (Trtab(Cc(Q)) == 2) Q = Q + 1; goto Succ; Bip_1015:; if (Level >= 2) A(Set(Level)) = A(Set(Level)) + 0x1000; Level = Level + 1; Jround(Level) = 0; Ral(Level) = R; A(R) = 0; R = R + 1; Flag(Level) = R; A(R) = 0; R = R + 1; L(Level) = R; A(R) = 0; R = R + 1; M(Level) = R; A(R) = 0; R = R + 1; Nmdecs(Level) = R; A(R) = 0; R = R + 1; Stackbase(Level) = R; A(R) = 0; R = R + 1; Set(Level) = R; A(R) = 0; R = R + 1; goto Succ; Bip_1016:; if ((Jround(Level) & 255) != 0) { Jround(Level) = Jround(Level) - 1; goto Succ; } Up(); goto Succ; Bip_1017:; Type = A(R - 2); if (Type != 4) goto Succ; goto Fail1; Bip_1018:; I = A(R - 1); J = Ntype(I); if ((J & 31) == Level) if (Type != (J >> 8 & 255) || (Type < 128 && Type != 38)) { Failno = 4; goto Fail; } else { if (J != 0) Push(Tags(I), J, Dposn(I), 0); Ntype(I) = Type << 8 | Level | Names(Level) << 16; Dposn(I) = R - 1; Names(Level) = I; } goto Succ; Bip_1019:; if (1 <= (Ntype(Lastname) >> 8 & 7) && (Ntype(Lastname) >> 8 & 7) <= 2) goto Succ; if (Ntype(Lastname) == 0) Failno = 2; else Failno = 10; goto Fail; Bip_1020:; if ((Ntype(Lastname) >> 8 & 7) == 3) goto Succ; if (Ntype(Lastname) == 0) Failno = 2; else Failno = 10; goto Fail; Bip_1021:; Type = A(R - 2) + 32; if (Type == 36) Type = 34; goto Succ; Bip_1022:; Type = (A(R - 2) & 3) + 128; goto Succ; Bip_1023:; if (Level <= 1) { Qmax = Q - 1; Failno = 9; goto Fail; } A(Flag(Level)) = R - Flag(Level) - 1; A(R) = 0; Flag(Level) = R; R = R + 1; goto Succ; Bip_1024:; if (Level <= 1) { Failno = 9; goto Fail; } A(L(Level)) = R - L(Level) - 1; A(R) = 0; L(Level) = R; R = R + 1; goto Succ; Bip_1025:; if (Trtab(Cc(Q)) != 2) goto Fail1; I = Q; while (';' != Cc(I) && Cc(I) != ':') I = I + 1; if (Cc(I) == ':' && Cc(I + 1) == '=') goto Succ; goto Fail1; Bip_1026:; Pass2inf = Pass2inf | Labbyname; Type = 6; goto Succ; Bip_1043:; Pass2inf = Pass2inf | Swbyname; Bip_1027:; Type = 38; goto Succ; Bip_1028:; Type = 5; goto Succ; Bip_1029:; I = Q; while (Trtab(Cc(I)) != 0) I = I + 1; if (Cc(I) == ':' && Cc(I + 1) != '=') { if (Cc(I + 1) != 'C' + 128 || Cc(I + 2) != 'O' + 128 || Cc(I + 3) != 'M' + 128) goto Succ; Q = I + 1; goto Fail1; } goto Fail1; Bip_1030:; if ((Ntype(Lastname) >> 8 & 32) == 0) goto Notarr; if (Cc(Q) == '[' || (Cc(Q) == '(' && Cc(Q + 1) == '/')) goto Succ; I = Dposn(Lastname); A(I) = A(I) | 0x10000; goto Succ; Notarr:; if (Cc(Q) == '[' || (Cc(Q) == '(' && Cc(Q + 1) == '/')) { Failno = 3; Qmax = Q - 1; } else Failno = 1; goto Fail; Bip_1031:; if (Level <= 1) { Failno = 9; goto Fail; } A(M(Level)) = R - M(Level) - 2; A(R) = 0; M(Level) = R; R = R + 1; goto Succ; Bip_1032:; if (Level <= 1) { Failno = 9; goto Fail; } A(Nmdecs(Level)) = R - Nmdecs(Level); A(R) = 0; Nmdecs(Level) = R; R = R + 1; goto Succ; Bip_1033:; A(Stackbase(Level)) = R - Stackbase(Level) - 1; A(R) = 0; Stackbase(Level) = R; R = R + 1; goto Succ; Bip_1034:; if (Level <= 1) { Failno = 9; goto Fail; } A(Ral(Level)) = R - Ral(Level) - 2; A(R) = 0; Ral(Level) = R; I = Level - 1; while (I >= 2) { A(Set(I)) = A(Set(I)) + 1; I = I - 1; } R = R + 1; goto Succ; Bip_1035:; I = Cc(Q); if (I == ')' || I == ',') goto Succ; goto Fail1; Bip_1036:; I = Cc(Q); if (Level <= 1) goto Fail; if (I != ';' && I != 'E' + 128 && Cc(Q - 1) != 'N' + 128) goto Fail1; Jround(Rl) = Jround(Rl) + 1; goto Succ; Bip_1037:; Jround(Level) = Jround(Level) + 256; goto Succ; Bip_1038:; I = Cc(Q); if (I == '-') { A(R) = 2; Q = Q + 1; } else A(R) = 3; if (I == '+') Q = Q + 1; goto Upr; Bip_1039:; I = Cc(Q); if ((Opmask(I >> 5) & 0x80000000 >> (I & 31)) == 0) goto Fail1; Q = Q + 1; if (I == '-') { A(R) = 4; goto Upr; } if (I == '+') { A(R) = 3; goto Upr; } J = Cc(Q); if (I == '*') { if (J != '*') { A(R) = 5; goto Upr; } Q = Q + 1; A(R) = 2; goto Upr; } if (I == '/') { A(R) = 6; goto Upr; } if (I == '^') { A(R) = 1; goto Upr; } if (I == 'D' + 128 && J == 'I' + 128 && Cc(Q + 1) == 'V' + 128) { Q = Q + 2; A(R) = 7; goto Upr; } if (I == 'P' + 128 && J == 'O' + 128 && Cc(Q + 1) == 'W' + 128 && Cc(Q + 2) == 'E' + 128 && Cc(Q + 3) == 'R' + 128) { Q = Q + 4; A(R) = 8; goto Upr; } goto Fail1; Bip_1040:; if (Cc(Q) == ';') goto Succ; goto Fail1; Bip_1041:; I = Cc(Q); if (I == '[') { Q = Q + 1; goto Succ; } if (I != '(' || Cc(Q + 1) != '/') goto Fail1; Q = Q + 2; goto Succ; Bip_1042:; I = Cc(Q); if (I == ']') { Q = Q + 1; goto Succ; } if (I != '/' || Cc(Q + 1) != ')') goto Fail1; Q = Q + 2; goto Succ; Bip_1044:; if ((Ntype(Lastname) >> 8 & 7) != 3 || (Ntype(Lastname) & 31) != Level) goto Succ; Failno = 10; goto Fail; Bip_1045:; if (1 > (Ntype(Lastname) >> 8 & 7) || (Ntype(Lastname) >> 8 & 7) > 2 || (Ntype(Lastname) & 31) != Level) goto Succ; Failno = 10; goto Fail; void Up(void) { I = Names(Level); while (0 <= I && I <= Nnames) { J = Ntype(I); Ntype(I) = 0; if (Tags(I) != 0) Pop(Tags(I), Ntype(I), Dposn(I), Item); I = J >> 16; } Names(Level) = -1; Level = Level - 1; } } void Pname(int Mode) { const int Hash[8 /*0:7*/] = {71, 47, 97, 79, 29, 37, 53, 59}; int Jj; int Kk; int Ll; int Fq; int Fs; int S; int Tt; int I; #if 0 /* Includehandcode==Yes */ { long long int Drdes;long long int Accdes; } #endif Hit = 0; Fq = Q; Fs = Cc(Q); if (Trtab(Fs) != 2) return; Tt = 1; Lett(Next + 1) = Fs; Jj = 71 * Fs; #if 1 /* Includehandcode==No */ for (;;) { Q = Q + 1; I = Cc(Q); if (Trtab(I) == 0) break; if (Tt <= 7) Jj = Jj + Hash(Tt) * I; Tt = Tt + 1; Lett(Next + Tt) = I; } #else { Cyc:; asm("LB Q"); asm("ADB 1"); asm("STB Q"); asm("LB (CC+%B)"); asm("LSS (TRTAB+%B)"); asm("JAT 4,"); asm("STB I"); asm("LSS %B;"); asm("LB TT"); asm("CPB 7"); asm("JCC 2,"); asm("IMY (HASH+%B)"); asm("IAD JJ"); asm("ST JJ"); Skip:; asm("ADB 1"); asm("STB TT"); asm("LSS I"); asm("ADB NEXT"); asm("ST (LETT+%B)"); asm("J "); Exit:; } #endif Lett(Next) = Tt; T = Tt; S = T + 1; if (Next + S > Dsize) Fault(103, 0); Jj = (Jj + 113 * Tt) & Nnames; #if 1 /* Includehandcode==No */ { for (Kk = Jj; Kk <= Nnames; Kk++) { Ll = Wrd(Kk); if (Ll == 0) goto Hole; if (*String(Addr(Lett(Next))) == *String(Addr(Lett(Ll)))) goto Fnd; } for (Kk = 0; Kk <= Jj; Kk++) { Ll = Wrd(Kk); if (Ll == 0) goto Hole; if (*String(Addr(Lett(Next))) == *String(Addr(Lett(Ll)))) goto Fnd; } } #else { asm("LDTB X'18000000'"); asm("LDB S"); asm("LDA LETT+4"); asm("STD DRDES"); asm("INCA NEXT"); asm("STD ACCDES"); asm("LB JJ"); Cyc1:; asm("STB KK"); asm("LB (WRD+%B)"); asm("JAT 12,"); asm("LSD ACCDES"); asm("LD DRDES"); asm("INCA %B"); asm("CPS %L=%DR"); asm("JCC 8,"); asm("LB KK"); asm("CPIB NNAMES"); asm("JCC 7,"); asm("LB 0"); Cyc2:; asm("STB KK"); asm("LB (WRD+%B)"); asm("JAT 12,"); asm("LSD ACCDES"); asm("LD DRDES"); asm("INCA %B"); asm("CPS %L=%DR"); asm("JCC 8,"); asm("LB KK"); asm("CPIB JJ"); asm("JCC 7,"); } #endif Fault(104, 0); Hole: if (Mode == 0) goto Xit; Wrd(Kk) = Next; Next = Next + S; Fnd: Lastat = Fq; Hit = 1; Lastname = Kk; A(R) = Lastname; R = R + 1; Lastend = Q; Xit:; } int Const(int Mode) { int Z; int I; long double X; long double Cv; const long double Ten = 0; Cv = 0; I = Cc(Q); Ctype = 1; Hit = 0; S = 0; if ('0' <= I && I <= '9') goto N; if (I == '.' && Mode == 0) goto Dot; if ((I == '&' || I == '@') && Mode == 0) { Cv = 1; goto Alpha; } return (1); Oflow: return (8); N: I = I & 15; Cv = Ten * Cv + I; Q = Q + 1; I = Cc(Q); if ('0' <= I && I <= '9') goto N; if (Mode != 0 || I != '.') goto Alpha; Dot: Q = Q + 1; X = Ten; Ctype = 2; I = Cc(Q); if ('0' > I || I > '9') return (5); while ('0' <= I && I <= '9') { Cv = Cv + ((I & 15) / X); X = Ten * X; Q = Q + 1; I = Cc(Q); } Alpha:; if (Mode != 0 || (I != '&' && I != '@')) goto Fix; Q = Q + 1; X = Cv; Ctype = 2; Z = 1; if ('+' == Cc(Q) || Cc(Q) == '-') { if (Cc(Q) == '-') Z = -1; Q = Q + 1; } I = Const(2); if (Hit == 0) return (6); S = S * Z; Hit = 0; Ctype = 2; if (S == -99) Cv = 0; else { Cv = X; #if 0 /* Includehandcode==Yes */ { asm("MPSR X'8080';"); } #endif while (S > 0) { S = S - 1; #if 0 /* Includehandcode==Yes */ { Cv = Cv*Ten;asm("JAT 15,;"); } #else Cv = Cv * Ten; #endif } while (S < 0 && Cv != 0) { S = S + 1; Cv = Cv / Ten; } } Fix:; #if 1 /* Includehandcode==No */ Cvalue = Cv; #else { asm("LSD X'7F00000000000000'"); asm("AND CV"); asm("SLSD X'0080000000000000'"); asm("AND CV+8"); asm("LUH %TOS"); asm("RAD CV"); asm("STUH CVALUE"); } #endif if (Ctype != 1) { Hit = 1; return (0); } if (Cvalue <= Imax) { S = Int(Cvalue); Ctype = 1; Hit = 1; return (0); } return (7); } void Texttext(void) { const int Txt1 = '<'; int S; int J; int Br; int First; int Last; int I; int Aar; S = R; R = R + 2; Br = 1; Hit = 0; I = Cc(Q); if ((I != Txt1 || Qflag != 0) && I != 123) return; First = I; Last = First + 2; Q = Q + 1; J = 0; Aar = Addr(A(R)); do { I = Cc(Q); if (I == First) Br = Br + 1; if (I == Last) Br = Br - 1; if (I > 128 && Cc(Q - 1) < 128) { Byteinteger(Aar + J) = Kychar1; J = J + 1; } if (I < 128 && Cc(Q - 1) > 128) { Byteinteger(Aar + J) = Kychar2; J = J + 1; } Byteinteger(Aar + J) = I; J = J + 1; Q = Q + 1; if (Q > Length) Fault(106, 0); } while (Br != 0); if (J > 256) { Warn(5, 0); J = 256; } J = J - 1; R = R + ((J + 3) >> 2); A(S + 1) = J; A(S) = Strlink; Strlink = S; Hit = 1; } Bend:; } if (Level > 1) Fault(15, 0); I = 0; Newline(); if (Faulty == 0) { Write(Lastline - 1, 5); Printstring(_imp_str_literal(" LINES ANALYSED\n")); } else { Printstring(_imp_str_literal("\nCODE GENERATION NOT ATTEMPTED\n")); Comreg(24) = 8; Comreg(47) = Faulty; exit(0); } { void Cnop(int I, int J); void Pclod(int From, int To); void Pconst(int X); void Psf1(int Opcode, int K, int N); void Pf1(int Opcode, int Kp, int Kpp, int N); void Psorlf1(int Opcode, int Kp, int Kpp, int N); void Pf2(int Opcode, int H, int Q, int N, int Mask, int Filler); void Pf3(int Opcode, int Mask, int Kppp, int N); void Plant(int Value); void Plug(int I, int J, int K); void Codeout(void); void Notecref(int Ca); int Paramdes(int Prec); int Specialconsts(int Which); void Storeconst(int D, int L, int C1, int C2); void Dumpconsts(void); void Prologue(void); void Epilogue(void); void Css(int P); void Abort(void); #if 1 /* Allowcodelist==Yes */ { void Recode(int Start, int Finish, int Ca); void Printuse(void); } #endif int Register[8 /*0:7*/]; int Olink[8 /*0:7*/]; int Gruse[8 /*0:7*/]; int Grat[8 /*0:7*/]; int Grinf[8 /*0:7*/]; unsigned char Code[269 /*0:268*/]; unsigned char Glabuf[269 /*0:268*/]; int Desads[32 /*0:31*/]; int Plabs[32 /*0:31*/]; int Plink[32 /*0:31*/]; int Auxsbase[32 /*0:31*/]; int Label[32 /*0:31*/]; int Diaginf[32 /*0:31*/]; int Display[32 /*0:31*/]; int Avlwsp[4 /*1:4*/][32 /*0:31*/]; int Cf[(12 * Nnames) + 1]; int Ctable; for (I = 0; I <= 7; I++) { Register(I) = 0; Gruse(I) = 0; Grat(I) = 0; Grinf(I) = 0; } for (I = 0; I <= Maxlevels; I++) { Names(I) = -1; Diaginf(I) = 0; Display(I) = 0; Auxsbase(I) = 0; Label(I) = 0; Nmdecs(I) = 0; if (I <= 12) Dvheads(I) = 0; for (J = 1; J <= 4; J++) Avlwsp(J, I) = 0; } Ctable = &Array(Addr(Aslist(1)), Cf); Line = 0; Prologue(); Nextp = 8; Level = 1; Rlevel = 0; for (;;) { if (Allowcodelist == Yes && Dcomp != 0 && Ca > Cabuf) { Codeout(); Printuse(); } I = Nextp; Nextp = Nextp + A(Nextp); Line = A(I + 1); if (Line == 0) break; Css(I + 2); } if (Faulty == 0 && 0 == Cprmode) { Line = Lastline - 1; Fault(57, 0); } Line = 9999; Epilogue(); Glaca = (Glaca + 7) & (-8); Ustptr = (Ustptr + 7) & (-8); Cnop(0, 8); Codeout(); I = (Parmdiag << 1 | Parmline) << 1 | Parmtrce; Fixedgla(4) = (6 - Parmtrce) << 24 | 1 << 16 | (Cprmode & 1) << 8 | I; I = Glaca - Glacabuf; if (Inhcode == 0) { if (I != 0) Lput(2, I, Glacabuf, Addr(Glabuf(0))); Glacabuf = Glaca; Glacurr = 0; Lput(2, N0 << 2, 0, Addr(Fixedgla(0))); I = 0xE2E2E2E2; Lput(4, 4, Sstl, Addr(I)); Lput(19, 2, 12, 4); Lput(19, 2, 8, 5); } Dumpconsts(); Sstl = (Sstl + 11) & (-8); Newline(); #if 0 /* Vmeb==Yes */ Faultmk(8); #endif Printstring(_imp_str_literal("CODE")); Write(Ca, 6); Printstring(_imp_str_literal(" BYTES GLAP")); Write(Glaca, 3); Printstring(_imp_str_literal("+")); Write(Ustptr, 1); Printstring(_imp_str_literal(" BYTES DIAG TABLES")); Write(Sstl, 3); Printstring(_imp_str_literal(" BYTES\nTOTAL")); Register(0) = Ca; Register(1) = Glaca; Register(2) = 0; Register(3) = Sstl; Register(4) = Ustptr; K = Ca + Glaca + Sstl + Ustptr; Register(5) = K; Write(K, 5); Printstring(_imp_str_literal(" BYTES")); Newline(); if (Faulty == 0) { Write(Lastline - 1, 7); Printstring(_imp_str_literal(" LINES COMPILED")); Comreg(47) = Lastline - 1; } else { Printstring(_imp_str_literal("PROGRAM CONTAINS")); Write(Faulty, 2); Printstring(_imp_str_literal(" FAULT")); if (Faulty > 1) Printsymbol('S'); Comreg(47) = Faulty; } Newlines(2); I = 0; if (Faulty != 0) I = 8; Comreg(24) = I; if (Inhcode == 0) Lput(7, 24, 0, Addr(Register(0))); exit(0); void Abort(void) { Printstring( '\n**************** ABORT******************** ABORT *******'); #if 1 /* Allowcodelist==Yes */ { if (Ca != Cabuf) Recode(Addr(Code(0)), Addr(Code(Ppcurr)), Cabuf); Printuse(); } #endif _imp_monitor(); exit(0); } #if 1 /* Allowcodelist==Yes */ void Recode(int S, int F, int Ad) { if (S != F) { #if 0 /* Vmeb==Yes */ Faultmk(4); #endif Printstring(_imp_str_literal("\nCODE FOR LINE")); Write(Line, 5); Ncode(S, F, Ad); #if 0 /* Vmeb==Yes */ Faultmk(1); #endif } } #endif void Codeout(void) { if (Ppcurr > 0) { if (Allowcodelist == Yes && Dcomp != 0) Recode(Addr(Code(0)), Addr(Code(Ppcurr)), Cabuf); if (Inhcode == 0) Lput(1, Ppcurr, Cabuf, Addr(Code(0))); Ppcurr = 0; Cabuf = Ca; } } void Plant(int Halfword) { #if 1 /* Includehandcode==No */ { Code(Ppcurr) = Halfword >> 8; Code(Ppcurr + 1) = Halfword; Ppcurr = Ppcurr + 2; } #else { asm("LDA CODE+4"); asm("LDTB X'58000002'"); asm("LB PPCURR"); asm("LSS HALFWORD"); asm("ST (%DR+%B)"); asm("ADB 2"); asm("STB PPCURR"); } #endif Ca = Ca + 2; if (Ppcurr >= 256) Codeout(); } void Pconst(int Word) { int I; if (Includehandcode == N0) for (I = 24; I >= 0; I -= 8) { Code(Ppcurr) = Word >> I & 255; Ppcurr = Ppcurr + 1; } else { asm("LDA CODE+4"); asm("LDTB X'58000004'"); asm("LSS WORD"); asm("LB PPCURR"); asm("ST (%DR+%B)"); asm("ADB 4"); asm("STB PPCURR"); } Ca = Ca + 4; if (Ppcurr >= 256) Codeout(); } void Psf1(int Opcode, int K, int N) { int Kpp; if ((K == 0 && -64 <= N && N <= 63) || (K != 0 && 0 <= N && N <= 511)) { if (K != 0) N = N / 4; #if 1 /* Includehandcode==No */ { Code(Ppcurr) = Opcode | K >> 1; Code(Ppcurr + 1) = (K & 1) << 7 | N & 127; Ppcurr = Ppcurr + 2; } #else { asm("LSS OPCODE"); asm("USH 1"); asm("OR K"); asm("USH 7"); asm("SLSS N"); asm("AND 127"); asm("LB PPCURR"); asm("OR %TOS"); asm("LDA CODE+4"); asm("LDTB X'58000002'"); asm("ST (%DR+%B)"); asm("ADB 2"); asm("STB PPCURR"); } #endif Ca = Ca + 2; if (Ppcurr >= 256) Codeout(); } else { if (K == 0) Kpp = 0; else Kpp = 2; Pf1(Opcode, K >> 1 << 1, Kpp, N); } } void Pf1(int Opcode, int Kp, int Kpp, int N) { int Inc; Inc = 2; if (Kpp == Pc) { if (N < 0) { N = N & 0x7FFFFFFF; Notecref(Ca); } N = (N - Ca) / 2; } if (((1 << Kpp) & 0b101100) != 0) N = N / 4; #if 1 /* Includehandcode==No */ { Code(Ppcurr) = Opcode | 1; Code(Ppcurr + 1) = 0x80 | Kp << 5 | Kpp << 2 | (N >> 16 & 3); Code(Ppcurr + 2) = N >> 8 & 255; Code(Ppcurr + 3) = N & 255; } #else { asm("LSS OPCODE"); asm("USH 1"); asm("OR 3"); asm("USH 2"); asm("OR KP"); asm("USH 3"); asm("OR KPP"); asm("USH 18"); asm("SLSS N"); asm("AND X'3FFFF'"); asm("OR %TOS"); asm("LDTB X'58000004'"); asm("LDA CODE+4"); asm("LB PPCURR"); asm("ST (%DR+%B)"); } #endif if (Kpp <= 5) Inc = 4; Ppcurr = Ppcurr + Inc; Ca = Ca + Inc; if (Ppcurr >= 256) Codeout(); } void Psorlf1(int Opcode, int Kp, int Kpp, int N) { int Inc; Inc = 2; if ((Kpp == 0 && 0 == Kp && -64 <= N && N <= 63) || (Kpp == Lnb && (Kp & 1) == 0 && 0 <= N && N <= 511)) { if (Kpp == Lnb) Kp = 1 + (Kp >> 1); if (Kp != 0) N = N / 4; #if 1 /* Includehandcode==No */ { Code(Ppcurr) = Opcode | Kp >> 1; Code(Ppcurr + 1) = (Kp & 1) << 7 | (N & 127); } #else { asm("LSS OPCODE"); asm("USH 1"); asm("OR KP"); asm("USH 7"); asm("SLSS N"); asm("AND 127"); asm("LB PPCURR"); asm("OR %TOS"); asm("LDA CODE+4"); asm("LDTB X'58000002'"); asm("ST (%DR+%B)"); } #endif } else { if (Kpp == Pc) { if (N < 0) { N = N & 0x7FFFFFFF; Notecref(Ca); } N = (N - Ca) / 2; } if (((1 << Kpp) & 0b101100) != 0) N = N / 4; #if 1 /* Includehandcode==No */ { Code(Ppcurr) = Opcode | 1; Code(Ppcurr + 1) = ((4 | Kp) << 3 | Kpp) << 2 | (N >> 16 & 3); Code(Ppcurr + 2) = N >> 8 & 255; Code(Ppcurr + 3) = N & 255; } #else { asm("LSS OPCODE"); asm("USH 1"); asm("OR 3"); asm("USH 2"); asm("OR KP"); asm("USH 3"); asm("OR KPP"); asm("USH 18"); asm("SLSS N"); asm("AND X'3FFFF'"); asm("OR %TOS"); asm("LDTB X'58000004'"); asm("LDA CODE+4"); asm("LB PPCURR"); asm("ST (%DR+%B)"); } #endif if (Kpp <= 5) Inc = 4; } Ca = Ca + Inc; Ppcurr = Ppcurr + Inc; if (Ppcurr >= 256) Codeout(); } void Pf2(int Opcode, int H, int Q, int N, int Mask, int Filler) { Plant(Opcode << 8 | H << 8 | Q << 7 | N); if (Q != 0) Plant(Mask << 8 | Filler); } void Pf3(int Opcode, int Mask, int Kppp, int N) { if (Kppp == Pc) { if (N < 0) { N = N & 0x7FFFFFFF; Notecref(Ca); } N = (N - Ca) / 2; } Code(Ppcurr) = Opcode | Mask >> 3 & 1; Code(Ppcurr + 1) = (Mask & 7) << 5 | Kppp << 2 | (N >> 16 & 3); Ppcurr = Ppcurr + 2; Ca = Ca + 2; if (Kppp <= 5) { Code(Ppcurr) = N >> 8 & 255; Code(Ppcurr + 1) = N & 255; Ppcurr = Ppcurr + 2; Ca = Ca + 2; } if (Ppcurr >= 256) Codeout(); } void Notecref(int Ca) { Listf *Cell; Cell = &Aslist(Crefhead); if (Crefhead == 0 || Cell->S3 != 0) { Push(Crefhead, Ca, 0, 0); return; } if (Cell->S2 == 0) Cell->S2 = Ca; else Cell->S3 = Ca; } void Pclod(int From, int To) { int I; int T; int B; const int Fixedcode[128 /*0:127*/] = { 0x7B985398, 0x18041C01, 0x5D984998, 0x5B987E84, 0x6C091FCc, 0x000A1B98, 'FREE', 0, 0x0580000B, 0x63985F98, 0x73986F9C, 0x2A04779C, 0xB1800081, 0x49981B98, 0x00000000, 0x5F98E398, 0xE87EE001, 0x43986F98, 0x49981B98, 0, 0x49987998, 0x180463A0, 0x000443A0, 0x0002420A, 0x43DC4998, 0x7E846C09, 0x1FCC000A, 'FREE', 'FREE', 'FREE', 'FREE', 'FREE', 'FREE', 'FREE', 'FREE', 'FREE', 'FREE', 0x5D98738C, 0x00051414, 0x59986C0A, 0x338040C0, 0, 0x7E807F8C, 0x00046485, 0x499879Cc, 0x000C63DC, 0x48866289, 0xE8658A07, 0xE79C0240, 0x00320280, 0x00188A03, 0xEA044285, 0x8B81FFFF, 0xEB98499C, 0xE08649DC, 0xE7A00002, 0x02400044, 0x779C7398, 0x12007286, 0xB3006685, 0x38006201, 0xE81BE089, 0x48858B81, 0xFFFF499C, 0xEA08E086, 0x49DCE7A0, 0x00020240, 0x002D2201, 0x63E80009, 0xA80049E8, 0x00050783, 0xFFFA6685, 0x38006201, 0xE81BE489, 0x48858B81, 0xFFFF499C, 0xEA04E086, 0x49DCE7A0, 0x00020240, 0x00152201, 0x65E80009, 0, 0xF837F849, 0x5B98B99C, 0x2A04E99C, 0x32117B98, 0x49E80005, 0x0783FFF1, 0x66853800, 0, 0x7B987998, 0x5B985998, 0x45980440, 0x00350600, 0x00074598, 0x06200030, 0x65981B98, 0x45984998, 0x0440001A, 0xF837F849, 0xB99C2A04, 0x26400340, 0x00037A40, 0xE99C4B9C, 0x02E0000E, 0x6E7E499C, 0x6201A800, 0x07800005, 0x6E7E1B98, 0x5998FB98, 0x247E1B98, 0x65984598, 0x18044998, 0x7E846C07, 'FREE', 0xFB981804, 0x49987E84, 0x6C071A01, 0x5D984998, 0x5B98359C, 0x20105B98, 0x4D983798, 0x7DA00004, 'FREE', 0x31987F98, 0x33987B98, 0x61987D98, 0x3A001A01}; B = (To - From + 1) * 4; if ((Fixedcode(To) & 0xFFFF) == 0x1A01) B = B - 2; if (Ppcurr + B >= 256) Codeout(); T = Addr(Fixedcode(From)); #if 1 /* Includehandcode==No */ for (I = 0; I <= B - 1; I++) { Code(Ppcurr) = *Byteinteger(T + I); Ppcurr = Ppcurr + 1; } #else { asm("LDTB X'18000000'"); asm("LDB B"); asm("LDA T"); asm("CYD 0"); asm("LDA CODE+4"); asm("INCA PPCURR"); asm("MV %L=%DR"); Ppcurr = Ppcurr + B; } #endif Ca = Ca + B; } void Cnop(int I, int J) { while ((Ca & (J - 1)) != I) Plant(0x1A01); } void Pgla(int Bdry, int L, int Infadr) { int I; int J; J = Glaca; Glaca = (J + Bdry - 1) & (-Bdry); Glacurr = Glacurr + Glaca - J; if (L + Glacurr > 256) { if (Inhcode == 0) Lput(2, Glacurr, Glacabuf, Addr(Glabuf(0))); Glacurr = 0; Glacabuf = Glaca; } #if 1 /* Includehandcode==No */ for (I = 0; I <= L - 1; I++) Glabuf(Glacurr + I) = *Byteinteger(I + Infadr); #else { asm("LDTB X'58000004'"); asm("LDB L"); asm("LDA INFADR"); asm("CYD 0"); asm("LDA GLACURR"); asm("INCA GLABUF+4"); asm("MV %L=%DR"); } #endif Glacurr = Glacurr + L; Glaca = Glaca + L; } void Plug(int Area, int At, int Value) { int Relad; int Bufad; if (Area == 2) { Bufad = Addr(Glabuf(0)); Relad = At - Glacabuf; } else { Bufad = Addr(Code(0)); Relad = At - Cabuf; } if (Relad >= 0 && Area <= 2) #if 1 /* Includehandcode==No */ for (I = 0; I <= 3; I++) Byteinteger(Relad + Bufad + I) = Value >> ((3 - I) << 3); #else { asm("LDA RELAD"); asm("INCA BUFAD"); asm("LSS VALUE"); asm("LDTB X'58000004'"); asm("ST (%DR)"); } #endif else { if (Relad == -2) Codeout(); if (Inhcode == 0) Lput(Area, 4, At, Addr(Value)); if (Allowcodelist == Yes && Dcomp != 0 && Area == 1) Ncode(Addr(Value), Addr(Value) + 4, At); } } int Paramdes(int Type) { int K; int Des; int Prec; Prec = Sizecode(Type); K = Desads(Prec); if (K != 0) return (K); Des = Prec << 27 | 1; Storeconst(K, 4, Des, 0); Desads(Prec) = K; return (K); } int Specialconsts(int Which) { const int Scs[6 /*0:5*/] = {0x40800000, 0, 0x41100000, 0, 0xE5000000, 0xE5000001}; int K; K = Desads(Which + 16); if (K != 0) return (K); Storeconst(K, 8, Scs(2 * Which), Scs(2 * Which + 1)); Desads(Which + 16) = K; return (K); } void Storeconst(int D, int L, int C1, int C2) { int I; int J; int K; int Lp; Lp = L / 4; if (Parmopt != 0) goto Skip; K = Constbtm; if (L == 4) #if 1 /* Includehandcode==No */ while (K < Constptr) { if (Ctable(K) == C1 && Consthole != K) { D = 4 * K | 0x80000000; return; } K = K + 1; } #else { asm("LD CTABLE"); asm("LB K"); asm("SBB 1"); asm("LSS C1"); Agn1:; asm("ADB 1"); asm("CPB CONSTPTR"); asm("JCC 10,"); asm("ICP (%DR+%B)"); asm("JCC 7,"); asm("CPB CONSTHOLE"); asm("JCC 8,"); asm("LSS %B"); asm("IMY 4"); asm("OR X'80000000'"); asm("ST (D)"); asm("EXIT -64"); } #endif else { J = Constptr - Lp; #if 1 /* Includehandcode==No */ while (K <= J) { if (Ctable(K) == C1 && Ctable(K + 1) == C2 && (Consthole < K || Consthole >= K + Lp)) { D = 4 * K | 0x80000000; return; } K = K + 2; } #else { asm("LD CTABLE"); asm("LB K"); Agn2a:; asm("LSS C1"); Agn2:; asm("CPB J"); asm("JCC 2,"); asm("ICP (%DR+%B)"); asm("JCC 8,"); asm("ADB 2"); asm("J "); On2:; asm("STB K"); asm("ADB 1"); asm("LSS (%DR+%B)"); asm("ICP C2"); asm("JCC 8,"); Back2:; asm("ADB 1"); asm("J "); On2a:; asm("LSS K"); asm("ICP CONSTHOLE"); asm("JCC 8,"); asm("CPB CONSTHOLE"); asm("JCC 8,"); asm("IMY 4"); asm("OR X'80000000'"); asm("ST (D)"); asm("EXIT -64"); } #endif } Skip:; if (L == 4 && Consthole != 0) { Ctable(Consthole) = C1; D = 4 * Consthole | 0x80000000; Consthole = 0; return; } if (L > 4 && (Constptr & 1) != 0) { Consthole = Constptr; Constptr = Constptr + 1; } D = 4 * Constptr | 0x80000000; Ctable(Constptr) = C1; Ctable(Constptr + 1) = C2; Constptr = Constptr + Lp; if (Constptr > Constlimit) Fault(107, 0); } void Getenv(int Head) { int I; int J; for (J = 0; J <= 4; J++) { I = Grmap(J); if (Gruse(I) > 1) Push(Head, Grinf(I), Grat(I), I << 8 | Gruse(I)); } } void Restore(int Head) { int I; int J; int R; int Use; int Inf; int At; for (J = 0; J <= 4; J++) { I = Grmap(J); Gruse(I) = 0; Grinf(I) = 0; } while (Head != 0) { Pop(Head, Inf, At, I); R = I >> 8; Use = I & 255; Gruse(R) = Use; Grinf(R) = Inf; Grat(R) = At; } } void Relocate(int Glarad, int Value, int Area) { if (Glarad < 0) { Pgla(4, 4, Addr(Value)); Glarad = Glaca - 4; } Lput(19, 2, Glarad, Area); } void Gxref(_imp_string255 Name, int Mode, int Xtra, int At) { int Lputno; if (Mode == 2) Lputno = 15; else Lputno = Mode + 12; Lput(Lputno, Xtra, At, Addr(Name)); } void Cxref(_imp_string255 Name, int Mode, int Xtra, int At) { int Z1; int Z2; Z1 = 0; Z2 = 0; Pgla(4, 8, Addr(Z1)); At = Glaca - 8; Gxref(Name, Mode, Xtra, At); } void Codedes(int At) { int Desc1; int Desc2; Desc1 = 0xE1000000; Desc2 = 0; if (Cdcount == 0) { Fixedgla(0) = Desc1; At = 0; } else { Pgla(4, 8, Addr(Desc1)); At = Glaca - 8; } Cdcount = Cdcount + 1; } void Defineep(_imp_string255 Name, int Adr, int At, int Main) { if (At == 0) Fixedgla(1) = Adr; else Plug(2, At + 4, Adr); Relocate(At + 4, Adr, 1); if (Name != _imp_str_literal("")) Lput(11, Main << 31 | 2, At, Addr(Name)); } void Prologue(void) { int Stringin(int Pos); void Errexit(int A, int B, int C); int I; int J; int K; int L; int Stca; J = 0xC2C2C2C2; Lput(4, 4, 0, Addr(J)); for (I = 0; I <= 31; I++) { Desads(I) = 0; Plabs(I) = 0; Plink(I) = 0; } Sstl = 4; Plabs(1) = Ca; for (I = 0; I <= 1; I++) Pconst(Unasspat); Plabs(2) = Ca; Pclod(0, 5); if (Parmchk == 1) { Cnop(0, 4); I = Ca; Pconst(0x18000000); Plabs(3) = Ca; Pf1(Ldtb, 0, Pc, I); Pclod(8, 13); } Plabs(4) = Ca; Pclod(15, 18); if (Parmchk != 0) Errexit(5, 0x801, 0); if (Parmopt != 0) Errexit(7, 0x505, 0); if (Parmopt != 0) Errexit(8, 0x201, 0); Errexit(9, 22, 0); if (Parmopt != 0) Errexit(10, 36, 0); Ctable(0) = 0x18000100; Ctable(1) = 4; Stca = 8; L = Addr(Ctable(0)); Constptr = 2; while (Strlink != 0) { I = Strlink; Strlink = A(I); A(I) = Stringin(I + 1); } Strlink = 0x80000000; Constbtm = Constptr; Ctable(Constptr) = 'ADIA'; Constptr = Constptr + 1; for (I = 0; I <= 31; I++) if (Plink(I) != 0) Clearlist(Plink(I)); Gxref(Mdep, 0, 2, 40); Gxref(Auxstep, 2, 0x02000008, 52); Auxst = 48; for (I = 0; I <= Nnames; I++) Tags(I) = 0; for (I = 0; I <= Maxlevels; I++) Ral(I) = 0; J = Snum; Snum = 0; Level = 0; for (I = 1; I <= J; I++) { A(R) = 13; A(R + 1) = Snnno(I); Css(R); } Level = 1; return; int Stringin(int Pos) { int J; int K; int Ind; int Hd; int Ad; int Sym; Listf *Cell; K = A(Pos); if (K == 0) return (0); Ind = K & 31; Hd = Plink(Ind); while (Hd != 0) { if (K > 255) break; Cell = &Aslist(Hd); if (Cell->S1 == K && *String(L + Cell->S2) == *String(Addr(A(Pos)))) return (Cell->S2 - 4); Hd = Cell->Link; } Hd = Stca; Ad = Addr(A(Pos)) + 3; Byteinteger(L + Stca) = K; Stca = Stca + 1; for (J = Ad + 1; J <= Ad + K; J++) { Sym = *Byteinteger(J) & 127; if (Ebcdic != 0) Sym = Itoetab(Sym); Byteinteger(L + Stca) = Sym; Stca = Stca + 1; } Constptr = ((Stca + 7) & (-8)) >> 2; Push(Plink(Ind), K, Hd, 0); return (Hd - 4); } void Errexit(int Lab, int Errno, int Mode) { Plabs(Lab) = Ca; if (Mode == 0) Plant(0x6200); Psf1(Slss, 0, Errno); Psf1(Jlk, 0, (Plabs(2) - Ca) / 2); } } void Epilogue(void) { void Fill(int Lab); if (Plink(13) == 0) goto P14; Fill(13); Pclod(42, 56); Pf1(Ldtb, 0, Pc, Paramdes(5)); Pclod(57, 80); Pf1(Rad, 0, Pc, Specialconsts(0)); Pclod(82, 88); Pf1(Junc, 0, 0, (Plabs(8) - Ca) / 2); P14:; if (Plink(14) == 0) goto P15; Fill(14); if (Logepdisp == 0) Cxref(_imp_str_literal("S#ILOG"), Parmdynamic, 2, Logepdisp); if (Expepdisp == 0) Cxref(_imp_str_literal("S#IEXP"), Parmdynamic, 2, Expepdisp); Pclod(90, 113); Pf1(Call, 2, Xnb, Logepdisp); Pclod(115, 117); Pf1(Call, 2, Xnb, Expepdisp); Pf1(Junc, 0, Tos, 0); Pf1(Junc, 0, 0, (Plabs(7) - Ca) / 2); P15:; if (Plink(15) == 0) goto P16; Fill(15); Pclod(20, 26); P16:; if (Plink(16) == 0) goto P17; Fill(16); Cxref(_imp_str_literal("S#STOP"), Parmdynamic, 2, J); Pconst(0x18047E84); Plant(0x6C05); Pf1(Call, 2, Xnb, J); P17:; if (Plink(17) == 0) goto P18; Cnop(0, 4); Pconst('IMP'); Fill(17); Pf1(Lxn, 0, Breg, 0); Pf3(Jaf, 12, 0, 3); Pf1(Junc, 0, Tos, 0); Pf1(Icp, 0, 0, 'AE'); Pf3(Jcc, 8, 0, -3); Pf1(Icp, 0, Pc, Ca - 20); Pf3(Jcc, 8, 0, -4); Pf1(Slb, 0, Tos, 0); Pf1(Junc, 0, Breg, 0); P18:; return; void Fill(int Lab) { int At; int Instrn; int Spare; while (Plink(Lab) != 0) { Pop(Plink(Lab), At, Instrn, Spare); Instrn = Instrn | (Ca - At) >> 1; Plug(1, At, Instrn); } Plabs(Lab) = Ca; } } void Dumpconsts(void) { void Doit(int Val); int I; int J; int K; int Disp; if (Constptr != 0) Lput(1, Constptr * 4, Ca, Addr(Ctable(0))); if (Allowcodelist == Yes && Dcomp != 0) { #if 0 /* Vmeb==Yes */ Faultmk(4); #endif Printstring(_imp_str_literal("\nCONSTANT TABLE")); I = 0; for (;;) { Newline(); Prhex(Ca + 4 * I, 5); for (J = 0; J <= 7; J++) { Spaces(2); Prhex(Ctable(I + J), 8); } Space(); for (J = 0; J <= 31; J++) { K = *Byteinteger(Addr(Ctable(I)) + J); if (K < 31 || K > 95) K = 32; Printsymbol(K); } I = I + 8; if (I >= Constptr) break; } Newline(); #if 0 /* Vmeb==Yes */ Faultmk(1); #endif } Disp = Ca / 2; while (Crefhead != 0) { Pop(Crefhead, I, J, K); Doit(I); if (J != 0) Doit(J); if (K != 0) Doit(K); } Ca = Ca + 4 * ((Constptr + 1) & (-2)); Disp = 2 * Disp; while (Glarelocs != 0) { Pop(Glarelocs, I, J, K); J = J + Disp; Lput(2, 4, I, Addr(J)); } return; void Doit(int Val) { int I; int J; if (Val > 0) Lput(18, 0, Val, Disp); else { I = (Val >> 16 & 0x7FFF) << 2; J = 4 * (Val & 0xFFFF) + Ca; Plug(2, I, J); } } } void Css(int P) { void Mergeinfo(void); void Reduceenv(int Head); void Enterjump(int Mask, int Stad, int Flag); void Enterlab(int M, int Flag, int Level); void Cend(int Kkk); void Resetauxstack(void); void Saveauxstack(int Arrs); void Cbpair(int Lb, int Ub); void Ccond(void); void Setline(void); void Cforstmnt(void); void Cstmnt(void); void Cui(void); void Gotolab(int Mode); void Cde(int Mode); void Csde(int Mode); void Ccmpndstmnt(void); void Cblk(int Blktype); void Etorp(int A, int B, int C); void Torp(int Head, int Nops, int Mode); void Setuse(int R, int U, int I); void Csexp(int Reg, int Mode, int Nme); void Saveirs(void); void Bootout(int Mode); void Expop(int A, int B, int C, int D); void Testapp(int Num); void Skipexp(int Mode); void Skipsexp(int Mode); void Skipapp(void); int Dopevector(int A, int B, int C, int D); void Makedecs(int P, int K); void Declareowns(void); void Declarearrays(void); void Declarescalars(void); void Declarelab(void); void Declareproc(void); void Declareswitch(void); void Clabel(void); void Colabel(void); void Getwsp(int Place, int Size); void Returnwsp(int Place, int Size); void Gthunks(int A, int B); int Checkfprocs(int A, int B); void Crcall(int A); void Callthunks(int A, int Reg, int B, int C); void Fetchstring(int Reg); void Cname(int Z, int Reg); void Caname(int Z, int Bs, int Dp); void Csname(int Z, int Reg); void Copytag(int Kk); void Reducetag(void); void Replacetag(int Kk); void Rtjump(int Code, int Rt); void Storetag(int Kk, int Slink); void Unpack(void); void Pack(int Ptype); void Rhead(int Kk); void Rdisplay(int Kk); void Oddalign(void); int Ptroffset(int Rlev); void Ppj(int Mask, int N); void Remember(void); int Reverse(int Mask); int Areacode(void); int Setxorynb(int Which, int L); int Xorynb(int Use, int Lev); void Getinacc(int A, int B, int C, int D, int E); void Noapp(void); void Diagpointer(int L); void Copydr(void); void Changerd(int Reg); void Testass(int Reg); void Noteassment(int Reg, int Var); static int Sw_sw; static void *Sw[13 /*1:13*/] = { &&Sw_1, &&Sw_2, &&Sw_3, &&Sw_4, &&Sw_5, &&Sw_6, &&Sw_7, &&Sw_8, &&Sw_9, &&Sw_10, &&Sw_11, &&Sw_12, &&Sw_13, }; typedef struct Rd { unsigned char Uptype; unsigned char Ptype; unsigned char Xb; unsigned char Flag; int D; int Xtra; } Rd; int Twsphead; int Sndisp; int Acc; int K; int Kform; int Tcell; int Jj; int Jjj; int Kk; int Base; int Disp; int Area; int Access; int Ptype; int I; int J; int Oldi; int Usebits; int Rout; int Nam; int Arr; int Type; int Sgruse[8 /*0:7*/]; int Sgrinf[8 /*0:7*/]; Twsphead = 0; goto *Sw[Sw_sw = (A(P)) - 1]; Sw_1:; if (Parmline != 0) Setline(); if (Level <= 1) { Fault(57, 0); return; } Nmdecs(Level) = Nmdecs(Level) | 1; P = P + 1; Cstmnt(); Cssexit:; while (Twsphead != 0) { Pop(Twsphead, Jj, Kk, Jjj); Returnwsp(Jj, Kk); } return; Sw_2:; if (Parmline != 0) Setline(); if (A(P + 1) == 1) Fault(47, 0); Cend(Flag(Level)); return; Sw_4:; if (A(P + 2) != 1) goto Vdec; if (Nmdecs(Level) != 0) Fault(40, 0); { Listf *Lcell; int Pname; int Extrn; int Q; int Pp; int Ptypep; int Parn; int Disp; int Typep; int Link; int Np; int Linep; int Pe; int Pl; int Ophead; int Avhead; int Opbot; P = P + 1; Pp = P; Pname = A(P + 4); Extrn = P + 3 + A(P + 3); Pl = Extrn; while (A(Extrn) == 1) Extrn = Extrn + 3; Pe = Extrn + 1; Extrn = A(Pe); if (Level == 1 && Cprmode == 0) { Cprmode = 2; Makedecs(0, -1); } Copytag(Pname); Q = K; Linep = Sndisp; P = Pp; if (Rout != 1 || Oldi != Level) Declareproc(); P = Pp; if (Extrn <= 3 || J == 14) goto L99; if (Level == 1) { if (Cprmode == 0) Cprmode = 2; if (Cprmode != 2) Fault(105, Pname); Jj = Aslist(Q).S1; Defineep(*String(Dictbase + Wrd(Pname)), Ca, Jj, 0); if (Jj != 0) Psf1(Inca, 0, -Jj); Diagpointer(Level + 1); } Copytag(Pname); Link = K; Q = Acc; Jj = Link; Np = Aslist(Link).S2; Plabel = Plabel - 1; if (Cprmode != 2 || Level != 1) { Jround(Level + 1) = Plabel; Enterjump(15, Plabel, 0); } Ptypep = Ptype; Rhead(Pname); Lcell = &Aslist(Tags(Pname)); Lcell->S1 = Lcell->S1 & 0xFFFFFFF0; Mlink(Link); Avhead = 0; while (Link != 0) { From123(Link, Typep, Parn, Disp); J = Parn >> 16; Ptype = Typep; if ((Ptype & 0xF00) > 0x100) Ptype = Ptype & 0xF0FF | 0x100; Type = Ptype & 7; K = Parn & 0xFFFF; Acc = 0; Kform = Link; if (Type <= 3 && Ptype < 4096) Acc = Bytes(Type); if (Ptype >= 4096) { Ophead = 0; Opbot = 0; Jj = J; while (Jj > 0) { Binsert(Ophead, Opbot, Aslist(Jj).S1, Aslist(Jj).S2, Aslist(Jj).S3); Mlink(Jj); } J = 0; Aslist(Ophead).S1 = (Disp & 0xFFFF); Disp = Ophead; } Storetag(K, Disp & 0xFFFF); if ((Ptype & 0xFF0) == 0x10) Push(Avhead, Disp, Sizecode(Ptype & 7), 0); Mlink(Link); } N = Q; Q = Pp + 6; Ptype = Ptypep; Rdisplay(Pname); while (Avhead != 0) { Pop(Avhead, Disp, Jj, Jjj); Saveauxstack(1); Plant(0x1804); Psf1(Lsq, 1, Disp & 0xFFFF); Plant(0x4998); Plant(0x7A00 | Jj); Plant(0x6C09); Ppj(-1, 13); Psf1(St, 1, Disp & 0xFFFF); } if (Np > 0) Q = Q + 3 * Np - 1; Makedecs(Q, Ptypep); P = Pl; Colabel(); if (Extrn == 5) { P = Pe + 1; Line = A(P); P = P + 1; if (Parmline != 0) Setline(); Cstmnt(); Cend(Flag(Level)); } L99:; } goto Cssexit; Vdec:; Sw_7:; if (Nmdecs(Level) != 0) Fault(40, 0); return; Sw_5:; { int Corb; int Sigepno; Corb = A(P + 1); Ptype = 0; if (Level == 1 && Rlevel == 0) { Rlevel = 1; if (Cprmode != 0) Fault(105, 0); Codedes(Jj); Defineep(Mainep, Ca, Jj, 1); L(1) = 0; M(1) = 0; Diaginf(1) = 0; Auxsbase(1) = 0; Cprmode = 1; N = 24; Nmax = N; #if 1 /* Includehandcode==No */ for (I = 0; I <= 7; I++) Gruse(I) = 0; #else { asm("LSQ 0"); asm("LCT GRUSE+4"); asm("ST (%CTB+0)"); asm("ST (%CTB+4)"); } #endif Diagpointer(Level + 1); Cxref(Sigep, Parmdynamic, 2, Jj); Psf1(Lxn, 1, 16); Pf1(Stln, 0, Xnb, 20); Psf1(Asf, 0, 1); Psf1(Prcl, 0, 4); if ((Parmbits1 & Jobberbit) != 0) Sigepno = 9; else Sigepno = 0; Psf1(Lss, 0, Sigepno); Pf1(St, 0, Tos, 0); Psf1(Jlk, 0, 3); Ppj(15, 15); Pf1(Ldtb, 0, Pc, Paramdes(1)); Pclod(37, 40); Pf1(Call, 2, Xnb, Jj); Ptype = 1; Rhead(-1); Rdisplay(-1); if (Corb == 1) { P = P + 2; while (A(P) == 1) P = P + 1; P = P + 1; Colabel(); if (Parmline != 0) Setline(); Nmdecs(Level) = Nmdecs(Level) | 1; Cstmnt(); } else Makedecs(P + 2, -1); } else { P = P + 2; if (Corb == 1) Ccmpndstmnt(); else { Rhead(-1); Rdisplay(-1); Makedecs(P, -1); } } } goto Cssexit; Sw_6:; if (Nmdecs(Level) != 0) Fault(40, 0); { int N; int Dis; int Rep; int I; int Pl; int Flag; int Swname; int J; Swname = A(P + 1) & 0xFFFF; Copytag(Swname); Rep = 0; N = Kform; if (Arr == 1) { Dis = (K & 0xFFFF) * 4; P = P + 4; Plabel = Plabel - 1; Pl = Plabel; Flag = 0b10; Enterjump(15, Pl, Flag); for (I = 0; I <= N - 1; I++) { J = Ca - Dis; Plug(1, Dis + 4 * I, J); #if 1 /* Includehandcode==No */ for (J = 0; J <= 7; J++) Gruse(J) = 0; #else { asm("LSQ 0"); asm("LCT GRUSE+4"); asm("ST (%CTB+0)"); asm("ST (%CTB+4)"); } #endif Cde(2); P = P + 2; } Enterlab(Pl, 0b110, Level); } } goto Cssexit; Sw_8:; P = P + 1; Clabel(); Css(P); Sw_3:; return; Sw_10:; Sw_11:; #if 1 /* Allowcodelist==Yes */ { Codeout(); Dcomp = (A(P) - 1) & 1; } #endif return; Sw_13:; Q = A(P + 1); Push(Tags(Q), Snpt << 16 | 0x8000, 0, Snum << 16); Snum = Snum + 1; return; Sw_9:; Nmdecs(Level) = Nmdecs(Level) | 1; return; Sw_12:; if (Cprmode != 0) Fault(40, 0); Q = A(P + 1); Mainep = *String(Dictbase + Wrd(Q)); return; void Declareowns(void) { void Clear(int L); void Stag(int J); int Length; int Bp; int Pp; int Iconst1; int Iconst2; int Tagdisp; int Ah1; int Ah2; int Ah3; int Ah4; int Ad; int Nnames; int Ptypep; int Ptypepp; int Lb; int Aparm; if ((Nmdecs(Level) & 1) != 0) Fault(40, 0); P = P + 3; Nam = 0; Arr = A(P) - 1; Rout = 0; Iconst1 = 0; Iconst2 = 0; Type = A(P - 1); if (Type == 4) Type = 2; Acc = Bytes(Type); P = P + 2; Pack(Ptype); Ptypep = Ptype; if (Arr != 0) goto Nonscalar; do { J = 0; K = A(P); Kform = 0; Ad = Addr(Iconst1); Pgla(Acc, Acc, Ad); Tagdisp = Glaca - Acc; Stag(Tagdisp); P = P + 2; } while (A(P - 1) != 2); return; Nonscalar:; P = P + 1; Pp = P; Nnames = 1; Aparm = A(P); while (A(P + 1) == 1) { Aparm = Aparm | A(P); P = P + 2; Nnames = Nnames + 1; } Aparm = 1 - (Aparm >> 16); P = P + 2; Bp = Acc; Ptypepp = Ptypep; Ah4 = Dopevector(Bp, Aparm, Length, Lb) + 12; if (Lb == 0 && J == 1) Ptypepp = Ptypepp + 16; do { K = A(Pp) & 0xFFFF; Ustptr = (Ustptr + 3) & (-4); if (Type == 2) Ah1 = 6; else Ah1 = 5; Ah1 = Ah1 << 27 | Length; Ah2 = Ustptr; Ah3 = 5 << 27 | 3 * J; Clear(Length); Pgla(8, 16, Addr(Ah1)); Tagdisp = Glaca - 16; Relocate(Tagdisp + 4, Ah2, 5); Relocate(Tagdisp + 12, Ah4, 1); Notecref(((Ah4 << 1 >> 3) | 0x80000000) | (Tagdisp + 12) >> 2 << 16); Ptype = Ptypepp; Kform = 0; Stag(Tagdisp); Pp = Pp + 2; Nnames = Nnames - 1; } while (Nnames != 0); if (A(P) == 1) { P = P + 2; goto Nonscalar; } return; void Clear(int Length) { Length = (Length + 3) & (-4); if (Inhcode == 0) Lput(5, Length, Ustptr, 0); Ustptr = Ustptr + Length; } void Stag(int J) { int Rl; Rl = Rlevel; Sndisp = 0; Rlevel = 0; Storetag(K, J); Rlevel = Rl; } } void Makedecs(int Pp, int Kk) { void Downlist(int Q, int Ln, int Inc, void Dec(void)); int Saveline; int Q; int Qq; int Arrs; int Intlabs; int Labparams; int Innerblks; Saveline = Line; Arrs = Auxsbase(Level) | A(Pp + 2); Labparams = Pass2inf & (Labbyname | Swbyname); Innerblks = A(Pp + 6) >> 12; Intlabs = A(Pp) | A(Pp + 6) & 0xFFF; if (Level == 2 && (Intlabs != 0 && (Innerblks | Labparams) != 0)) Saveauxstack(Arrs); Downlist(Pp + 1, 1, 2, Declarescalars); Downlist(Pp + 4, 1, 1, Declareowns); Downlist(Pp, 0, 3, Declarelab); Q = Pp + 3; Qq = A(Q); if (Qq != 0) { Cnop(0, 4); Plabel = Plabel - 1; Enterjump(15, Plabel, 0b10); Downlist(Q, 1, 3, Declareswitch); Enterlab(Plabel, 0, Level); } Downlist(Pp + 5, 2, 2, Declareproc); Q = Pp + 2; Downlist(Q, 2, 2, Declarearrays); Line = Saveline; Q = Auxsbase(Level) & 0x3FFFF; if (Q != 0) if (Arrs != 0) if (Intlabs != 0 && (Innerblks | Labparams) != 0) { if (A(Pp + 2) == 0) Psf1(Lss, 2, Q); Psf1(St, 1, Q + 12); } else Auxsbase(Level) = Auxsbase(Level - 1); if (Kk > 0 || Level == 2) if (Intlabs != 0 && (Innerblks | Labparams) != 0) { Psf1(Stsf, 1, N); Stackbase(Rlevel) = N; N = N + 4; } else Stackbase(Rlevel) = -1; return; void Downlist(int Q, int Ln, int Inc, void Declare(void)) { int Qq; Qq = A(Q); while (Qq != 0) { Q = Q + Qq - 1; if (Ln == 0) Line = Saveline; else Line = A(Q - Ln); P = Q; Declare(); Q = Q + Inc; Qq = A(Q); } } } void Declarelab(void) { K = A(P + 2); Ptype = 6; Sndisp = 0; Kform = 0; J = 0; Acc = 0; Storetag(K, 0); } void Declareswitch(void) { int I; int N; int Mark; int D0; int D1; int Simple; int Swname; Swname = A(P + 2) & 0xFFFF; N = 0; Simple = 1; Mark = P + 3; do { N = N + 1; if (A(Mark + 2) != 2 || A(Mark + 3) != 1 || A(Mark + 5) != 3) Simple = 0; if (Simple != 0) { Copytag(A(Mark + 4)); if (Oldi != Level || Ptype != 6) Simple = 0; } Mark = Mark + 1 + A(Mark + 1); } while (A(Mark) == 1); if (Simple == 0) D0 = 5 << 27 | N; else D0 = 0xE0 << 24 | (2 * N); D1 = Ca; Pgla(4, 8, Addr(D0)); Relocate(Glaca - 4, D1, 1); Sndisp = (Glaca >> 2) - 2; Kform = N; J = 1; K = Swname; Acc = 4; Ptype = (Simple + 1) << 4 | 6; Storetag(K, Ca >> 2); Mark = P + 3; for (I = 1; I <= N; I++) { if (Simple == 0) Pconst(0); else Enterjump(15, A(Mark + 4), 0); Mark = Mark + 1 + A(Mark + 1); } } void Declareproc(void) { void Cfp(void); void Cfparams(int Ophead, int Opbot, int Np); void Cvallist(int Ophead, int Mode); void Ccomment(void); void Ctypelist(int Ophead, int Mode); void Checkfps(int Ophead, int Mode); int Pname; int Typep; int Inc; int I; int N; int Cell; int Np; int Link; int Extrn; int Opbot; int Ophead; int Rthead; int Epname; int Sline; Sline = Line; Ophead = 0; Np = 0; Opbot = 0; Typep = 4096 + (A(P) & 3); P = P + 1; Pname = A(P + 3); P = P + 4; Inc = 1; Cfparams(Ophead, Opbot, Np); P = P + 8; Cvallist(Ophead, 0); Ctypelist(Ophead, 0); do P = P + 1; while (A(P) != 2); P = P + 1; while (A(P) == 1) P = P + 3; Extrn = A(P + 1); Line = Sline; Checkfps(Ophead, 0); J = 15; I = 0; if (Extrn <= 3) { J = 14; Epname = Pname; if (A(P + 2) == 1) Epname = A(P + 3); Cxref(*String(Dictbase + Wrd(Epname)), Parmdynamic, 2, I); } else if (Level == 1) Codedes(I); Push(Ophead, I, Np, 0); K = Pname; Sndisp = Line; Acc = Inc; Kform = 0; Ptype = Typep; Storetag(K, Ophead); return; void Cfparams(int Ophead, int Opbot, int Np) { while (A(P) == 1) { P = P + Inc; Np = Np + 1; K = A(P); if (Ophead != 0 && Find(K, Ophead) >= 0) Fault(7, K); else Binsert(Ophead, Opbot, 256, K, 0); P = P + 1; Inc = 2; } } void Cvallist(int Ophead, int Mode) { if (A(P) == 1) { do P = P + 1; while (A(P) != 2 && Mode == 0); P = P + 1; Line = A(P); N = A(P + 1); P = P + 2; for (I = 1; I <= N; I++) { K = A(P); Cell = Find(K, Ophead); if (Cell > 0) Aslist(Cell).S1 = 0; else Fault(8, K); P = P + 1; } } else P = P + 1; } void Ctypelist(int Ophead, int Mode) { int Cell; int Pin; int Accp; Listf *Lc; Pin = P; while (A(P) == 1) { do P = P + 1; while (A(P) != 2 && Mode == 0); P = P + 1; Line = A(P); P = P + 1; Cfp(); P = P + 1; do { K = A(P) & 0xFFFF; Cell = Find(K, Ophead); if (Cell >= 0) Lc = &Aslist(Cell); if (Cell < 0 || (Lc->S1 & 0xF0FF) != 0) Fault(9, K); else { I = Lc->S1; Lc->S1 = Ptype | I; if (Ptype >= 4096 && Mode == 0) { Ccomment(); Lc->S2 = Rthead << 16 | Lc->S2; } if (Ptype < 6 && I != 0) Accp = 8; else Accp = Acc; Lc->S3 = Accp; } P = P + 2; } while (A(P - 1) != 2); if (Ptype >= 4096 && Mode == 0) if (A(P) == 2) P = P + 1; else P = P + 1 + A(P + 1); } } void Checkfps(int Ophead, int Mode) { Listf *Lc; Inc = 20; Link = Ophead; while (Link > 0) { Lc = &Aslist(Link); Ptype = Lc->S1; J = Lc->S2; I = Lc->S3; Unpack(); if (Type == 6 && Nam == 0) { Lc->S1 = Ptype + 256; Nam = 1; Warn(3, J); } if (Nam == 0 && 0 == Mode && Extrn == 3) Fault(10, J); if (Mode == 0 && 2 <= Extrn && Extrn <= 3 && Rout == 0 && 1 <= Type && Type <= 3 && Nam != 0) { Nam = Extrn; Lc->S1 = Ptype + 256 * (Extrn - 1); } if (Ptype == 0 || Ptype == 256 || (Rout == 1 && Nam == 0) || (Mode == 0 && Extrn == 3 && (Type == 6 || (Type == 5 && Ebcdic == 0)))) Fault(10, J); J = 0; if (Nam == 1 && (Arr == 0 || Type == 6) && Rout == 0 && Type != 5) J = 1; Lc->S3 = Inc | J << 16; Inc = Inc + I; Link = Lc->Link; } } void Ccomment(void) { int Nnp; int Pp; int Linep; int Ptypep; int Accp; int Rtbot; Nnp = 0; Pp = P; Ptypep = Ptype; Accp = Acc; Linep = Line; Rthead = 0; Rtbot = 0; while (A(P + 1) == 1) P = P + 2; P = P + 2; if (A(P) == 1) { Inc = 2; Cfparams(Rthead, Rtbot, Nnp); P = P + 1; Cvallist(Rthead, 1); Ctypelist(Rthead, 1); Line = Linep; Checkfps(Rthead, 1); } Push(Rthead, 0, Nnp, 0); P = Pp; Ptype = Ptypep; Acc = Accp; } void Cfp(void) { static int Alt_sw; static void *Alt[7 /*1:7*/] = { &&Alt_1, &&Alt_2, &&Alt_3, &&Alt_4, &&Alt_5, &&Alt_6, &&Alt_7, }; goto *Alt[Alt_sw = (A(P)) - 1]; Alt_1:; Ptype = 6; goto Sac; Alt_2:; Ptype = 22; goto Sac; Alt_3:; Ptype = 5; goto Sac; Alt_4:; Type = A(P + 1); P = P + 2; goto *Alt[Alt_sw = (A(P) + 4) - 1]; Alt_5:; Arr = 1; Rout = 0; Nam = 0; P = P + 1; Acc = 16; if (Type == 4) Type = 2; Pack(Ptype); return; Alt_6:; Rout = 1; Nam = 0; Arr = 0; Acc = 16; Type = Type & 3; P = P + 1; Pack(Ptype); return; Alt_7:; Ptype = Type; Acc = Bytes(Ptype); P = P + 1; return; Sac: Acc = 8; P = P + 1; } } void Declarescalars(void) { int Inc; Type = A(P); Rout = 0; Nam = 0; Arr = 0; P = P + 4; Pack(Ptype); J = 0; Inc = 4; Acc = Bytes(Type); if (Rout == 0 && Arr == 0) Inc = Bytes(Type); if ((N & 7) == 0 && (Inc == 8 || Inc == 16)) Oddalign(); do { K = A(P); Sndisp = 0; Kform = 0; Storetag(K, N); N = N + Inc; P = P + 2; } while (A(P - 1) != 2); } void Declarearrays(void) { void Claimas(void); int Dvdisp; int Pp; int Dvf; int Elsize; int Totsize; int R; int Lbnd; int Ptypepp; int Ptypep; int Arrp; int Nn; int Nd; int Ii; int Jj; int Qq; int Cdv; int D0; int D1; int Desc; int Aparm; if (Parmline != 0) Setline(); Saveauxstack(1); Type = A(P); if (Type == 4) Type = 2; Nam = 0; Rout = 0; Adflag = 1; P = P + 5; Arrp = 1; Arr = Arrp; Pack(Ptypep); Elsize = Bytes(Type); Desc = Sizecode(Type) << 27; Start: Nn = 1; Aparm = A(P); Pp = P; Cdv = 0; Ptypepp = Ptypep; while (A(P + 1) == 1) { P = P + 2; Aparm = Aparm | A(P); Nn = Nn + 1; } Aparm = 1 - (Aparm >> 16); P = P + 2; if (A(P) == 1) goto Constdv; Nd = 0; Jj = P; Dvf = 0; Totsize = 0xFFFF; do { P = P + 1; Nd = Nd + 1; Skipexp(0); Skipexp(0); } while (A(P) != 2); P = Jj; Dvdisp = N; N = N + 12 * Nd + 12; if (Nd > 12) Fault(37, 0); D0 = 5 << 27 | 3 * Nd; D1 = 12; Storeconst(Jj, 8, D0, D1); Pf1(Ld, 0, Pc, Jj); Psf1(Std, 1, Dvdisp); Gruse(Dr) = 0; Plant(0x6201); Gruse(Accr) = 5; Grinf(Accr) = 1; for (Ii = Nd; Ii >= 1; Ii--) { P = P + 1; Qq = Dvdisp + 12 * Ii; Psf1(St, 1, Qq + 4); if (Nd <= 2 && Parmarr == 0 && A(P) == 2 && A(P + 2) == 3 && A(P + 3) == 2 && A(P + 4) == 1 && A(P + 6) == 2 && 0 <= A(P + 5) && A(P + 5) <= Aparm && Ii == Nd) { Plant(0x6200); Gruse(Accr) = 0; P = P + 7; Ptypepp = Ptypepp + 16; } else Csexp(Accr, 1, 0); Psf1(St, 1, Qq); Csexp(Accr, 1, 0); Psf1(Isb, 1, Qq); Pf3(Jaf, 6, 0, 3); Plant(0x627F); Plant(0xE001); Psf1(Imy, 1, Qq + 4); Psf1(St, 1, Qq + 8); Gruse(Accr) = 0; } Psf1(Imy, 0, Elsize); Psf1(St, 1, Dvdisp + 8); P = P + 1; goto Decl; Constdv:; Dvf = 1; P = P + 1; Cdv = 1; Dvdisp = Dopevector(Elsize, Aparm, Totsize, Lbnd); Nd = J; if (Lbnd == 0 && Nd <= 2) Ptypepp = Ptypepp + 16; Decl:; if ((N & 7) == 0) Oddalign(); Ptype = Ptypepp; J = Nd; for (Jjj = 0; Jjj <= Nn - 1; Jjj++) { if (Dvf != 0) { R = Totsize / Elsize; D0 = Desc | R; Storeconst(D1, 4, D0, 0); Pf1(Ldtb, 0, Pc, D1); } else { Storeconst(D1, 4, Desc, 0); Pf1(Ldtb, 0, Pc, D1); Psf1(Ldb, 1, Dvdisp + 20); } Psf1(Std, 1, N); Gruse(Dr) = 0; Psf1(Lss, 2, Auxsbase(Level) & 0x3FFFF); Psf1(St, 1, N + 4); if (Dvf != 0) Qq = Pc; else Qq = Lnb; Psorlf1(Ldrl, 0, Qq, Dvdisp); Psf1(Std, 1, N + 8); Sndisp = 0; Gruse(Dr) = 0; Gruse(Accr) = 0; Acc = Elsize; Kform = 0; K = A(2 * Jjj + Pp) & 0xFFFF; Storetag(K, N); N = N + 16; Claimas(); } P = P + 1; if (A(P - 1) == 1) { P = P + 2; goto Start; } Adflag = 0; return; void Claimas(void) { int D; if (Cdv == 1) { Totsize = (Totsize + 3) & (-4); if (Totsize < 0x1FFFF) Psf1(Lss, 0, Totsize); else { Storeconst(D, 4, Totsize, 0); Pf1(Lss, 0, Pc, D); } } else Psf1(Lss, 1, Dvdisp + 8); Gruse(Accr) = 0; Grinf(Accr) = 0; if (Parmchk != 0) { Plant(0x4998); Psf1(Lb, 2, Auxsbase(Level) & 0x3FFFF); Plant(0xE19C); Gruse(Breg) = 0; Grinf(Breg) = 0; } else Psf1(Iad, 2, Auxsbase(Level) & 0x3FFFF); Plant(0x49DC); if (Parmopt != 0) { Pf1(Icp, 1, 0, 2); Ppj(2, 8); } if (Parmchk != 0) { Pf1(Ldtb, 0, Pc, Paramdes(5)); Plant(0x7798); Plant(0x739C); Pf2(Mvl, 1, 1, 0, 0, Unasspat & 255); } } } int Dopevector(int Elsize, int Aparm, int Asize, int Lb) { int I; int Jj; int K; int Nd; int D; int Pp; int M0; int Head; Listf *Lcell; int Dv[40 /*0:39*/]; Nd = 0; Pp = P; do { Nd = Nd + 1; P = P + 7; } while (A(P) != 2); P = Pp; M0 = 1; for (D = Nd; D >= 1; D--) { Cbpair(I, Jj); K = 3 * D; if (Parmarr == 0 && D == Nd && Nd <= 2 && 1 <= I && I <= Aparm) I = 0; Dv(K) = I; Dv(K + 1) = M0; M0 = M0 * (Jj - I + 1); Dv(K + 2) = M0; } P = P + 1; Asize = M0 * Elsize; Dv(2) = Asize; Dv(1) = 12; Dv(0) = 5 << 27 | 3 * Nd; Lb = Dv(3 * Nd); J = Nd; K = 3 * Nd + 2; Head = Dvheads(Nd); while (Head != 0) { Lcell = &Aslist(Head); if (Lcell->S2 == Asize && Lcell->S3 == Dv(5)) { for (D = 0; D <= K; D++) if (Dv(D) != Ctable(D + Lcell->S1)) goto On; return (0x80000000 | 4 * Lcell->S1); } On:; Head = Lcell->Link; } if ((Constptr & 1) != 0) { Consthole = Constptr; Constptr = Constptr + 1; } I = 4 * Constptr | 0x80000000; Push(Dvheads(Nd), Constptr, Asize, Dv(5)); for (D = 0; D <= K; D++) { Ctable(Constptr) = Dv(D); Constptr = Constptr + 1; } if (Constptr > Constlimit) Fault(107, 0); return (I); } void Rtjump(int Code, int Link) { int Dp; if (J == 15) { Push(Link, Code << 24 | 3 << 23, Ca, 0); Pconst(0x01800000 | Code << 24); } else { Dp = Link - Ca; if (Code == Call) Dp = Dp / 2 + 1; Psf1(Code, 0, Dp); } } void Diagpointer(int Level) { if (Parmtrce != 0) { Push(Ral(Level), 1, Ca, Ldb << 24 | 3 << 23); Pconst(0x77800000); Gruse(Dr) = 0; } Plant(0x5883); } void Cend(int Kkk) { int Kp; int Wk; int Jj; int Kk; int Bit; void Dtable(int Level); if (N > Nmax) Nmax = N; while (Label(Level) != 0) { Pop(Label(Level), I, J, Kp); if ((J & 0xFFFF) != 0) { J = J & 0xFFFF; Clearlist(J); } } while (Twsphead != 0) { Pop(Twsphead, Jj, Kk, Bit); Returnwsp(Jj, Kk); } for (J = 1; J <= 4; J++) { if (Avlwsp(J, Level) != 0) Clearlist(Avlwsp(J, Level)); } Dtable(Level); Nmax = (Nmax + 7) & (-8); if (Kkk == 2) return; Jj = Set(Rlevel); if (Kkk >= 4096 || Kkk == 1) { Wk = Jj >> 18; Jj = Jj & 0x3FFFF; Kp = (Asf + 12 * Parmchk) << 24 | 3 << 23 | (Nmax - Wk + 3) >> 2; Plug(1, Jj, Kp); } if (Kkk >= 4096) { Jj = Kkk & 7; if (Jj != 0) { if (Jj == 2) Kp = 2; else Kp = 1; if (Gruse(Accr) != 10 || Wrd(Grinf(Accr)) != M(Level)) { Getinacc(Accr, Kp, 0, Lnb, Set(Rlevel) >> 18); if (Parmchk != 0) { Type = Jj; Testass(Accr); } } } Resetauxstack(); Plant(0x3840); } if (Kkk <= 0) { Jj = Auxsbase(Level - 1); if (Jj != Auxsbase(Level)) Resetauxstack(); if (Parmtrce == 1 && Kkk != -3) { Plant(0x7883); Diagpointer(Level - 1); } } if (Kkk >= 0) #if 1 /* Includehandcode==No */ for (Jj = 0; Jj <= 7; Jj++) Gruse(Jj) = 0; #else { asm("LSQ 0"); asm("LCT GRUSE+4"); asm("ST (%CTB+0)"); asm("ST (%CTB+4)"); } #endif if (Level <= 2 && (Level != 2 || Cprmode != 2)) if (Kkk == 1 && Level == 2) Kkk = 2; else { Fault(14, 0); exit(0); } Level = Level - 1; if (Kkk >= 4096) Rlevel = Rlevel - 1; Pop(Levelinf, Jj, N, Bit); if (Kkk >= 4096) Nmax = N >> 16; N = N & 0x7FFF; if (Kkk == 2) { Ppj(15, 16); Cend(Kkk); } if (Kkk >= 4096 && (Rlevel != 0 || Cprmode != 2)) Enterlab(Jround(Level + 1), 0, Level); return; void Dtable(int Level) { _imp_string255 Rtname; _imp_string255 Localname; int Dptr; int Lnum; int Ml; int Kk; int Jj; int Q; int S1; int S2; int S3; int S4; Listf *Lcell; int Dd[1001 /*0:1000*/]; while (Ral(Level) != 0) { Pop(Ral(Level), Q, Jj, Kk); if (Kkk == -3) Push(Ral(Level - 1), Q, Jj, Kk); else Plug(Q, Jj, Kk | Sstl); } if (Kkk == -3) return; if (Parmtrce != 0) Push(Ral(Level - 1), 4, Sstl + 4, Ebcdic << 29); Dd(0) = L(Level) << 16 | (Diaginf(Level) + 4); Dd(1) = Ebcdic << 29; Dd(2) = Display(Rlevel) << 16 | Flag(Level); Ml = M(Level); Lnum = *Byteinteger(Dictbase + Ml); Dptr = 4; if (Lnum == 0) Dd(3) = 0; else { Q = Dictbase + Ml; Rtname = *String(Q); String(Addr(Dd(3))) = Rtname; Lnum = *Byteinteger(Addr(Rtname)); Dptr = Dptr + (Lnum >> 2); } if (Kkk > 4096 && Parmdiag != 0) { Type = Kkk & 7; Dd(Dptr) = Sizecode(Type) << 24 | Type << 20 | Set(Rlevel) >> 18; Localname = Rtname; Lnum = *Byteinteger(Addr(Localname)); String(Addr(Dd(Dptr)) + 4) = Localname; Dptr = Dptr + ((Lnum + 8) >> 2); } Jj = Names(Level); while (0 <= Jj && Jj < 0x3FFF) { Lcell = &Aslist(Tags(Jj)); S1 = Lcell->S1; S2 = Lcell->S2; S3 = Lcell->S3; S4 = Lcell->Link; Lcell->Link = Asl; Asl = Tags(Jj); Tags(Jj) = S4 & 0x3FFFF; if ((S1 & 0xC000) == 0) Warn(2, Jj); Ptype = S1 >> 16; if (Ptype == 6 && (S2 & 0xFFFF) != 0) Fault(12, Jj); if ((Ptype & 0xF000) != 0) { K = S3 >> 16; Pop(K, Kk, Kk, Kk); while (K > 0) { Kk = Aslist(K).S2 >> 16; if (Aslist(K).S1 >= 4096) Clearlist(Kk); Pop(K, Kk, Kk, Kk); } } if (Parmdiag != 0 && Dptr < 997 && 1 <= (Ptype & 0xF00F) && (Ptype & 0xF00F) <= 5) { if (Ptype == 5) Nam = 1; else Nam = Ptype >> 8 & 3; Type = Ptype & 7; Arr = Ptype >> 4 & 3; Q = Dictbase + Wrd(Jj); if ((S1 >> 4 & 15) == 0) I = 1; else I = 0; Dd(Dptr) = Nam << 30 | Arr << 28 | Sizecode(Type) << 24 | Type << 20 | I << 18 | S3 >> 16; Localname = *String(Q); Lnum = *Byteinteger(Addr(Localname)); String(Addr(Dd(Dptr)) + 4) = Localname; Dptr = Dptr + ((Lnum + 8) >> 2); } Jj = S4 >> 18; } Dd(Dptr) = -1; Dptr = (Dptr << 2) + 4; if (Parmtrce == 1 && Kkk != -3) { Lput(4, Dptr, Sstl, Addr(Dd(0))); Sstl = Sstl + Dptr; } } } void Saveauxstack(int Arrs) { if (Auxsbase(Level) == 0) { if ((N & 7) == 0) Oddalign(); Area = -1; Base = 0; Getinacc(Dr, 2, 2, Areacode, Auxst); Plant(0x63DC); Gruse(Accr) = 0; Psf1(Std, 1, N); Psf1(St, 1, N + 8); if (Arrs == 0) Psf1(St, 1, N + 12); Auxsbase(Level) = Rlevel << 18 | N; N = N + 16; } } void Resetauxstack(void) { if (Auxsbase(Level) >> 18 == Rlevel) { Psf1(Lb, 1, (Auxsbase(Level) & 0x3FFFF) + 8); Psf1(Stb, 2, Auxsbase(Level) & 0x3FFFF); Gruse(Breg) = 0; } } void Rhead(int Kk) { int W1; int W3; int Insrn; int At; Push(Levelinf, 0, Nmax << 16 | N, 0); Level = Level + 1; Nmdecs(Level) = 0; Auxsbase(Level) = 0; Names(Level) = -1; Diaginf(Level) = Diaginf(Level - 1); if (Kk >= 0) Rlevel = Rlevel + 1; if (Level == Maxlevels) Fault(34, 0); if (Level > Maxlevels) Fault(108, 0); if (Kk >= 0 && Level > 2) { Copytag(Kk); Jj = K; if (J == 15) { J = Aslist(Jj).S1; if (J == 0 && Level > 2) { W1 = Tags(Kk); Aslist(W1).S1 = (Aslist(W1).S1 & 0xFFFF3FFF); } while (0 < J && J <= Aslmax) { Pop(J, Insrn, At, W1); if (0 >= At || At >= Ca) break; W3 = Ca - At; if (Insrn >> 25 == Call >> 1) W3 = W3 / 2 + 1; Insrn = Insrn + W3; Plug(1, At, Insrn); } Aslist(Jj).S1 = (Ca); } } if (Kk < 0) W3 = 0; else W3 = Wrd(Kk); L(Level) = Line; M(Level) = W3; Flag(Level) = Ptype; } void Rdisplay(int Kk) { int W1; int W2; int Stack; int Op; int Inc; if (Kk >= 0 || Level == 2) { Stack = 0; Display(Rlevel) = N; if (Level != 2) { Pf1(Lxn, 0, Tos, 0); Gruse(Xnb) = 4; Grinf(Xnb) = Rlevel - 1; Gruse(Ctb) = 0; Pconst(0x798C0003); Diagpointer(Level); W1 = Rlevel - 1; W2 = Display(W1); if (W1 == 1) { Plant(0x4D98); N = N + 4; } else while (W1 > 0) { Op = Lss; Inc = 1; if (W1 >= 2) { Op = Lsd; Inc = 2; } if (W1 >= 4) { Op = Lsq; Inc = 4; } Pf1(Op + Stack, 0, Xnb, W2); Stack = -32; N = N + 4 * Inc; W2 = W2 + 4 * Inc; W1 = W1 - Inc; } } if (Stack != 0) Plant(0x4998); Plant(0x5D98); N = N + 4; } if (Parmtrce != 0) { Diaginf(Level) = N; Pf1(Lss, 0, Pc, 4 * Constbtm | 0x80000000); if (Kk >= 0 || Level == 2) { Psf1(Slss, 0, Line); Plant(0x4998); } else { Psf1(St, 1, Diaginf(Level)); Psf1(Lss, 0, Line); Psf1(St, 1, Diaginf(Level) + 4); Plant(0x7883); Diagpointer(Level); } N = N + 8; Gruse(Accr) = 0; } if (Parmopt != 0 && Kk >= 0 && Level == 2) { Plant(0x5F9C); Plant(0x5D98); Plant(0x2398); Psf1(Cpb, 0, N); Ppj(7, 10); } if (Kk >= 0 || Level == 2) { Set(Rlevel) = N << 18 | Ca; Nmax = N; Pconst((Asf + 12 * Parmchk) << 24 | 0x01800000); if (Parmchk != 0) Ppj(0, 3); if (Kk >= 0 && (Ptype & 7) != 0) N = N + 8; } if (Kk >= 0 && Parmopt != 0) { Pconst(0x5F986398); Pconst(0xC80EC871); Pconst(0xE7800000 | Stlimit >> 1); Ppj(2, 8); } } void Clabel(void) { int Lname; int T; int Use; Lname = A(P); if (Level > 1) { T = Tags(Lname); Use = Aslist(T).S1; if (Use >> 16 != 6 || Aslist(T).S3 != 0) Fault(2, Lname); else Enterlab(Lname, 0, Use >> 8 & 63); } P = P + 2; } void Colabel(void) { while (A(P) == 1) { P = P + 1; Clabel(); } P = P + 1; } void Cblk(int Blktype) { int I; int Oldlev; int Kk; Kk = 0; for (I = P; I <= P + 5; I++) Kk = Kk + A(I); if (Kk == 0) Blktype = -3; Ptype = Blktype; Oldlev = Level; Rhead(-1); if (Blktype == -3) Auxsbase(Level) = Auxsbase(Level - 1); else { Rdisplay(-1); Makedecs(P, -1); } for (;;) { I = Nextp; Nextp = Nextp + A(Nextp); if (Allowcodelist == Yes && Dcomp != 0 && Ca > Cabuf) { Codeout(); Printuse(); } Line = A(I + 1); P = I + 2; while (A(P) == 8) { P = P + 1; Clabel(); } if (A(P) == 2 && Level == Oldlev + 1) { if (Parmline != 0) Setline(); Cend(Blktype); break; } else Css(P); } P = P + 1; } void Ccmpndstmnt(void) { int I; int Oldlevel; Oldlevel = Level; while (A(P) == 1) P = P + 1; P = P + 1; Colabel(); if (Parmline != 0) Setline(); Cstmnt(); for (;;) { I = Nextp; Nextp = Nextp + A(Nextp); if (Allowcodelist == Yes && Dcomp != 0 && Ca > Cabuf) { Codeout(); Printuse(); } Line = A(I + 1); P = I + 2; while (A(P) == 8) { P = P + 1; Clabel(); } if (Level == Oldlevel && A(P) == 2) break; Css(P); } P = P + 1; } void Cforstmnt(void) { void Cforlistel(void); void Intofor(void); void Cforbody(void); int Forname; int Forliste; int Fortype; int Forptype; int Fpl; int Fp; int Fcmplx; int Fbp; Fbp = P + 2 + A(P + 2); Forliste = A(Fbp); if (Forliste == 2) { Fbp = Fbp + 1; while (A(Fbp) == 1) Fbp = Fbp + 3; Fbp = Fbp + 1; } Forname = A(P + 3); Fp = P + 3; P = Fp + 1; Copytag(Forname); Fcmplx = Rout | Nam | Arr | Parmchk | (Type / 7); if (((1 > Type || Type > 2) && Type != 7) || Arr != Rout || Rout != 0 || A(P) != 3) Fault(25, Forname); if ((1 > Type || Type > 2) && Type != 7) { Type = 1; Ptype = 1; } Fortype = Type; Forptype = Ptype; if (A(P) != 3) { Skipapp(); P = P - 1; } Plabel = Plabel - 1; Fpl = Plabel; do { P = P + 1; Cforlistel(); } while (Forliste != 2 && A(P) != 2); if (Forliste != 2) { P = P + 1; Cforbody(); } return; void Cforlistel(void) { int Pp; int Falt; int Qq; int Fexitpl; int Stepp; int Steptmp; int Steprp; int Controlrp; int Cnststep; int Stepval; int Copcode; int Cxtra; int Stephead; int Asshead; int Ophead; int Nops; int Nse; int Opbot; int Assbot; int Stepbot; int Fetype; int Rr; int Finacc; int Finarea; int Findisp; int Finbase; int Rrr; int Cpi; static int Faltno_sw; static void *Faltno[3 /*1:3*/] = { &&Faltno_1, &&Faltno_2, &&Faltno_3, }; Ophead = 0; Cnststep = 0; Stepval = 0; Asshead = 0; Stephead = 0; Nse = 0; Cpi = 0; Stepbot = 0; Opbot = 0; Assbot = 0; Plabel = Plabel - 1; Qq = Plabel; Plabel = Plabel - 1; Fexitpl = Plabel; Rr = Rpptr; Controlrp = Fortype << 16 | Fcmplx << 8 | 2; Nops = 1; Etorp(Ophead, Nops, Fortype); Rrr = Rpptr - 3; A(Rrr) = 99; A(Rrr + 1) = Rpptr; A(Rpptr) = Forptype << 16 | 2; A(Rpptr + 1) = Fp; A(Rpptr + 2) = Tags(Forname); A(Rpptr + 3) = 31; Rpptr = Rpptr + 6; Falt = A(P); Fetype = Type; P = P + 1; goto *Faltno[Faltno_sw = (Falt)-1]; Faltno_1:; if (A(P) == 2 && A(P + 3) == 2 && A(P + 4) == 1 && A(P + 5) != 0 && A(P + 6) == 2) { Cnststep = 1; Stepval = A(P + 5); if (A(P + 2) == 2) Stepval = -Stepval; P = P + 7; Steprp = 1 << 16 | 1; Steptmp = Stepval; if (Fcmplx == 0 && Fortype == Fetype) Nse = 1; if (Nse == Fortype && Fortype == 1 && Parmopt == 0 && A(P) == 2 && A(P + 1 + A(P + 1)) == 2) { if (A(P + 3) == 2 && A(P + 4) == 1) { Findisp = A(P + 5); Finacc = 0; Finarea = 0; Finbase = 0; if (A(P + 2) == 2) Findisp = -Findisp; if (Imod(Findisp) >> 18 == 0) goto Cpib; } if (A(P + 3) == 1 && A(P + 5) == 3) { Copytag(A(P + 4)); if ((Ptype & 0xFEFF) == 1) { Finacc = Ptype >> 7; Finarea = -1; Findisp = K; Finbase = I; goto Cpib; } } } } else { Getwsp(Steptmp, Fortype); Steprp = Fortype << 16 | Lnb << 12 | 7; } Stepp = P; if (Cnststep == 0) { Nops = Nops + 1; Etorp(Stephead, Nops, Fortype); A(Rpptr - 3) = Steprp; A(Rpptr - 2) = Steptmp; A(Rpptr) = 31; Rpptr = Rpptr + 3; } if (Nse != 0) { A(Rrr + 6) = 30; A(Rrr) = 12; A(Rrr + 1) = Qq | 1 << 16; } else { A(Rpptr) = 12; A(Rpptr + 1) = Qq; Rpptr = Rpptr + 3; } Copcode = 27; Cxtra = 5; if (Stepval < 0) Cxtra = 2; if (Nse == 0) { A(Rpptr) = Controlrp; A(Rpptr + 1) = Fp; Rpptr = Rpptr + 3; } Nops = Nops + 3; Etorp(Asshead, Nops, Fortype); Rpptr = Rpptr - 3; if (Cnststep == 0) Copcode = 16; A(Rpptr) = Copcode; A(Rpptr + 1) = Cxtra; Rpptr = Rpptr + 3; if (Cnststep == 0) { A(Rpptr) = Steprp; A(Rpptr + 1) = Steptmp; Rpptr = Rpptr + 3; A(Rpptr) = 14; A(Rpptr + 3) = 19; Rpptr = Rpptr + 6; } A(Rpptr) = 100; Rpptr = Rpptr + 3; Pp = P; Expop(Rr, Accr, Nops, Fortype); P = Pp; Rpptr = Rr; if (Copcode == 16) { if (Cnststep != 0 && Stepval < 0) Mask = 18; else Mask = 17; if (Fortype == 1) Mask = Mask + 4; } Enterjump(Mask, Fexitpl, 0b10); Comm: Intofor(); if (Cpi != 0) { P = Fp; Csexp(Breg, 1, 2); } else { P = Stepp; Nops = 1; if (Cnststep == 0) { Etorp(Ophead, Nops, Fortype); Rpptr = Rpptr - 3; } A(Rpptr) = Steprp; A(Rpptr + 1) = Steptmp; Rpptr = Rpptr + 3; if (Cnststep == 0) { A(Rpptr) = 30; Rpptr = Rpptr + 3; } A(Rpptr) = Controlrp; A(Rpptr + 1) = Fp; Rpptr = Rpptr + 3; A(Rpptr) = 15; Rpptr = Rpptr + 3; if (Nse == 0) { A(Rpptr) = Forptype << 16 | 2; A(Rpptr + 1) = Fp; A(Rpptr + 2) = Tags(Forname); A(Rpptr + 3) = 31; Rpptr = Rpptr + 6; } A(Rpptr) = 100; Rpptr = Rpptr + 3; Expop(Rr, Accr, Nops, Fortype); } Rpptr = Rr; Enterjump(15, Qq, 0); Enterlab(Fexitpl, 0b111, Level); P = Pp; return; Cpib:; Pp = P + 7; Cpi = 1; A(Rrr) = Steprp; A(Rrr + 1) = Steptmp; A(Rrr + 3) = 16; A(Rrr + 6) = 100; Expop(Rr, Breg, Nops, Fortype); Access = Finacc; Area = Finarea; Base = Finbase; Enterlab(Qq, 0, Level); if (Stepval == 1) { Psorlf1(Cpib, Access, Areacode, Findisp); if (Stepval >= 0) Mask = 10; else Mask = 12; } else { Psf1(Adb, 0, Stepval); Psorlf1(Cpb, Access, Areacode, Findisp); if (Stepval >= 0) Mask = 2; else Mask = 4; } if (Finacc != 0) Gruse(Xnb) = 0; Gruse(Breg) = 0; Copytag(Forname); Access = 0; Area = -1; Base = I; Psorlf1(Stb, Access, Areacode, K); Noteassment(Breg, Forname); Enterjump(Mask, Fexitpl, 0b10); P = Pp; goto Comm; Faltno_2:; Enterlab(Qq, 0, Level); A(Rpptr) = 100; Rpptr = Rpptr + 3; Pp = P; Expop(Rr, -1, Nops, Fortype | 16); Rpptr = Rr; P = Pp; Ccond(); Enterjump(Mask, Fexitpl, 0b11); Intofor(); Enterjump(15, Qq, 0); Enterlab(Fexitpl, 0b111, Level); return; Faltno_3:; Pp = P; A(Rpptr) = 100; Rpptr = Rpptr + 3; Expop(Rr, -1, Nops, Fortype | 16); P = Pp; Rpptr = Rr; Intofor(); } void Intofor(void) { int I; if (Forliste != 2) { Enterjump(0, Fpl, 0); #if 1 /* Includehandcode==No */ for (I = 0; I <= 7; I++) Gruse(I) = 0; #else { asm("LSQ 0"); asm("LCT GRUSE+4"); asm("ST (%CTB+0)"); asm("ST (%CTB+4)"); } #endif } else { P = P + 1; Cforbody(); } } void Cforbody(void) { int Fbalt; int I; int Pl; int Rad; if (Forliste != 2) { Plabel = Plabel - 1; Pl = Plabel; Enterjump(15, Pl, 0b10); Enterlab(Fpl, 0, Level); Rad = N; N = Rad + 4; Plant(0x6398); Psf1(St, 1, Rad); } Ptype = -3; I = P; Rhead(-1); Auxsbase(Level) = Auxsbase(Level - 1); Colabel(); Fbalt = A(P); P = P + 1; if (Fbalt == 1) { Cblk(-2); if (A(P) == 1) Fault(47, 0); } else Cstmnt(); Cend(Flag(Level)); if (Forliste != 2) { Psf1(Junc, 1, Rad); Enterlab(Pl, 0b111, Level); } } } void Cstmnt(void) { static int Alt_sw; static void *Alt[4 /*1:4*/] = { &&Alt_1, &&Alt_2, &&Alt_3, &&Alt_4, }; static int Ualt_sw; static void *Ualt[4 /*1:4*/] = { &&Ualt_1, &&Ualt_2, &&Ualt_3, &&Ualt_4, }; int Salt; int Pl1; int Pl2; int Corb; int Pp; int Lnam; int Currline; Currline = Line; Pp = P; goto *Alt[Alt_sw = (A(P)) - 1]; Alt_1:; P = P + 1; Cui(); return; Alt_2:; Cforstmnt(); return; Alt_3:; P = P + 1; Ccond(); Plabel = Plabel - 1; Pl1 = Plabel; if (A(P) == 2 && A(P + 1) == 3 && A(P + 2) == 3 && A(P + 3) == 2 && A(P + 4) == 1 && A(P + 6) == 3) { Lnam = A(P + 5); Copytag(Lnam); if (Ptype == 6 && Oldi == Level) { Enterjump(Reverse(Mask), Lnam, 0); P = P + 7; if (A(P) != 1) return; Pl2 = Pl1; goto Uon; } } Enterjump(Mask, Pl1, 0b10); Colabel(); Salt = A(P); P = P + 1; goto *Ualt[Ualt_sw = (Salt)-1]; Ualt_1:; Corb = A(P); P = P + 1; if (Corb == 1) Ccmpndstmnt(); else Cblk(-2); goto Uback; Ualt_2:; P = P - 1; Cforstmnt(); goto Uback; Ualt_3:; Cui(); goto Uback; Ualt_4:; Uback:; if (A(P) != 1) { Enterlab(Pl1, 0b11, Level); return; } if (Salt == 2) Fault(47, 0); Plabel = Plabel - 1; Pl2 = Plabel; Enterjump(15, Pl2, 0b10); Enterlab(Pl1, 0b111, Level); Uon: Line = A(P + 1); P = P + 2; Colabel(); Salt = A(P); P = P + 1; if (Parmline != 0 && Line != Currline) Setline(); if (Salt != 1) Cstmnt(); else { Corb = A(P); P = P + 1; if (Corb == 1) Ccmpndstmnt(); else Cblk(-1); } Enterlab(Pl2, 0b11, Level); return; Alt_4:; Warn(4, 0); } void Cui(void) { static int Alt_sw; static void *Alt[3 /*1:3*/] = { &&Alt_1, &&Alt_2, &&Alt_3, }; int Ophead; int Nops; int Bot; int Typep; int Lpalt; int Lpnam; int Storeop; int Jj; int Kk; int Lp; int Rr; Listf *Lcell; goto *Alt[Alt_sw = (A(P)) - 1]; Alt_1:; Rr = Rpptr; Nops = 0; Lpnam = A(P + 1); Tcell = Tags(Lpnam); Lcell = &Aslist(Tcell); Typep = Lcell->S1 >> 16 & 7; Storeop = 31; Lpalt = A(P + 2); if ((Lpalt == 1 && Typep != 3) || (Lpalt == 2 && Typep >= 3)) { if (Lpalt == 1) Fault(24, A(P + 1)); else Fault(42, A(P + 1)); Typep = 4 - Lpalt; } A(P + 2) = A(P + 1); P = P + 2; goto On; Agn: Lpnam = A(P); Tcell = Tags(Lpnam); Lcell = &Aslist(Tcell); On: Bot = Rpptr; Ptype = Lcell->S1 >> 16; if ((Ptype & 7) != Typep) Fault(29, Lpnam); if ((Ptype & 0xF0) != 0) { Cname(1, Accr); if (A(P) == 1) { Jj = Tags(A(P + 1)); if ((Aslist(Jj).S1 & 0xF0000F) == 0x200001) { A(Rpptr) = 0x51 << 16 | Breg << 12 | 9; Register(Breg) = 1; Olink(Breg) = Addr(A(Rpptr)); } else { Plant(0x5B98); A(Rpptr) = 0x51 << 16 | Tos << 12 | 8; } A(Rpptr + 1) = 0; } else { Getwsp(Kk, 1); A(Rpptr) = 0x51 << 16 | Breg << 12 | 9; A(Rpptr + 1) = Kk; Register(Breg) = 2; Olink(Breg) = Addr(A(Rpptr)); } A(Rpptr + 3) = 32; A(Rpptr + 4) = Lpnam; Rpptr = Rpptr + 6; } else { Jj = Ptype << 16 | 2; Kk = P; if ((Ptype & 0xF000) != 0) { I = Lcell->S1 >> 4 & 15; for (Lp = Level; Lp >= 1; Lp--) if (Wrd(Lpnam) == M(Lp)) { Jj = (Ptype & 7) << 16 | (I + 1) << 8 | 6; Kk = Set(I + 1) >> 18; break; } if (Lp <= 1 || A(P + 1) != 3) Fault(29, Lpnam); } A(Rpptr) = Jj; A(Rpptr + 1) = Kk; A(Rpptr + 2) = Tcell; A(Rpptr + 3) = Storeop; A(Rpptr + 4) = A(P); Rpptr = Rpptr + 6; P = P + 1; if (A(P) == 3) P = P + 1; else Skipapp(); } if (Storeop == 30) Jj = 99; else Jj = 100; A(Rpptr) = Jj; A(Rpptr + 1) = Bot - 9; Rpptr = Rpptr + 3; Storeop = 30; Nops = Nops + 1; if (A(P) == 1) { P = P + 1; goto Agn; } P = P + 1; Etorp(Ophead, Nops, Typep); A(Rpptr - 3) = 99; A(Rpptr - 2) = Bot; Lp = P; Expop(Ophead, -1, Nops, Typep | 16); P = Lp; Rpptr = Rr; return; Alt_2:; P = P + 1; Cname(0, 0); return; Alt_3:; P = P + 1; Cde(0); } void Gotolab(int Mode) { void Resetstack(void); int Lnam; int Sb; int B; int D; int Pp; int F; int Ssn; int Range; int Arrp; int Levelp; int Xynb; Lnam = A(P); P = P + 1; Pp = P; Copytag(Lnam); Range = Kform; Arrp = Arr; Levelp = Oldi; B = I; D = K; Ssn = Sndisp << 2; if (A(P) == 2) { F = 22; goto Error; } if (Arrp >= 1 && Mode != 3 && A(P) == 3) { F = 18; goto Error; } if (Type != 6 || Rout == 1) { F = 11; goto Error; } Sb = Stackbase(B); if (Arrp >= 1) goto Switch; if (Sb < 0 && B != Rlevel && Nam == 0) Abort(); if (A(P) == 1) { F = 4; goto Error; } P = P + 1; if (Nam == 1) { Callthunks(0, -1, B, D); return; } Resetstack(); Enterjump(15, Lnam, 0); return; Error: Fault(F, Lnam); P = Pp; Skipapp(); return; Switch:; P = P + 1; if (Mode != 3) P = P + 1; if (Nam == 1) { if (Mode != 3) Csexp(Accr, 1, 0); Callthunks(0, -1, B, D); } else { if (Mode != 3) Csexp(Breg, 1, 0); else Plant(0x499C); Register(Breg) = 1; Xynb = Setxorynb(-1, -1); Plant(0x2201); if (Arrp == 2) { Resetstack(); goto Not2960; Plant(0x2A04); Pf1(Adb, 0, Xynb, Ssn + 4); Plant(0x1B9C); Not2960:; Plant(0x2A02); Pf1(Junc, 3, Xynb, Ssn); } else { Pf1(Lb, 3, Xynb, Ssn); Pf1(Adb, 0, Xynb, Ssn + 4); if (B != Rlevel) Psf1(Lln, 1, Ptroffset(B)); Plant(0x1B9C); } Register(Breg) = 0; Gruse(Breg) = 0; } if (Mode != 3) { if (A(P) == 1) { F = 18; goto Error; } P = P + 1; } return; void Resetstack(void) { int I; if (Parmtrce == 0 || B != Rlevel || Levelp == Level) goto Next; for (I = Level; I >= Levelp + 1; I--) { if (Flag(I) != -3) goto Reset; } goto Next; Reset:; Plant(0x7883); Gruse(Dr) = 0; Diagpointer(Levelp); Next:; Disp = Auxsbase(Levelp); if (Disp != 0 && (Disp != Auxsbase(Level) || Mode != 0)) { Area = -1; Base = Disp >> 18; Disp = Disp & 0x3FFFF; Getinacc(Accr, 1, 0, Areacode, Disp + 12); Psorlf1(St, 2, Area, Disp); } if (Sb > 0 && (B != Rlevel || Mode != 0)) { if (B != Rlevel) Psf1(Lln, 1, Ptroffset(B)); Psf1(Lss, 1, Sb); Ppj(0, 4); } } } void Csde(int Mode) { int Pp; int Plusalt; int Opalt; Pp = P; P = P + 1; if (Mode != 5) if (A(Pp) == 2) Cde(Mode); else Gotolab(Mode); else { Plusalt = A(P); Opalt = A(P + 1); if (Plusalt != 3 || Opalt == 2) goto Error; P = P + 2; if (Opalt == 3) Cde(5); else Gotolab(5); if (A(P) != 2) goto Error; P = P + 1; } return; Error: Fault(5, 0); P = Pp; Skipexp(0); } void Cde(int Mode) { int R; int Pl1; int Pl2; if (A(P) == 2) { P = P + 1; Csde(Mode); return; } P = P + 1; Ccond(); Plabel = Plabel - 1; Pl1 = Plabel; Enterjump(Mask, Pl1, 0b11); R = 0; Csde(Mode); Plabel = Plabel - 1; Pl2 = Plabel; if (R != 0) Enterjump(15, Pl2, 0b11); Enterlab(Pl1, 0b110, Level); Cde(Mode); Enterlab(Pl2, 0b11, Level); } void Ccond(void) { int Pp; int Exphead; int Nops; int Rr; Rr = Rpptr; Nops = 0; Etorp(Exphead, Nops, 4); Pp = P; Expop(Exphead, Accr, Nops, 3); P = Pp; if (Nest >= 0) Mask = 20; Rpptr = Rr; } void Csexp(int Reg, int Mode, int Nme) { int Exphead; int Nops; int Pp; int Rr; int Ename; int T; Rr = Rpptr; if (Nme == 2) { Ename = A(P); T = Tags(Ename); Ptype = Aslist(T).S1 >> 16; if ((Ptype & 7) == Mode) { Cname(2, Reg); return; } if (Ptype == Snpt) Reducetag(); else Type = Ptype & 7; if (Mode == 3 && Type != 3) Fault(24, Ename); if (Mode < 3 && Type == 3) Fault(42, Ename); Exphead = Rpptr; A(Rpptr) = Ptype << 16 | 2; A(Rpptr + 1) = P; A(Rpptr + 3) = 100; Rpptr = Rpptr + 6; Nops = 1; } else { Nops = 0; Etorp(Exphead, Nops, Mode); } Pp = P; Expop(Exphead, Reg, Nops, Mode); P = Pp; Rpptr = Rr; } void Etorp(int Head, int Nops, int Mode) { int Typep; int Tmode; int Bhead; int Ehead1; int Ehead2; int Rr; if (A(P) == 2) { P = P + 1; Torp(Head, Nops, Mode); } else { P = P + 1; Rr = Rpptr; Head = Rr; Rpptr = Rpptr + 3; if (Mode >= 3) Tmode = 3; else Tmode = 0; Etorp(Bhead, Nops, 4); Torp(Ehead1, Nops, Tmode); Typep = Ptype; Ehead2 = 0; Etorp(Ehead2, Nops, Tmode); if (Typep != 1) Ptype = 2; if (Tmode == 3) Ptype = 3; A(Rr) = 99; A(Rr + 1) = Rpptr; A(Rpptr) = Ptype << 16 | 4; A(Rpptr + 1) = (Bhead - Rpbase) << 16 | (Ehead1 - Rpbase); A(Rpptr + 2) = Ehead2; A(Rpptr + 3) = 100; Rpptr = Rpptr + 6; Nops = Nops | 0x80000000; } } void Torp(int Head, int Nops, int Mode) { static int Operand_sw; static void *Operand[12 /*1:12*/] = { &&Operand_1, &&Operand_2, &&Operand_3, &&Operand_default, &&Operand_default, &&Operand_default, &&Operand_default, &&Operand_default, &&Operand_9, &&Operand_10, &&Operand_11, &&Operand_12, }; int Rphead; int Passhead; int Savehead; int Rpbot; int Passbot; int Savebot; int Real; int Bool; int Opseen; int Complex; int Operator; int Opprec; int Opnd; int C; int D; int Pp; int Rptype; int Rpinf; int Xtra; int Opmask; int Opstk; int Oppstk; const int Opinf[13 /*1:13*/] = {[0 ... 1] = 0x519, 0x30F, 0x310, 0x413, 0x415, 0x414, 0x519, 0x416, 0x312, 0x217, [11 ... 12] = 0x111}; Opstk = 0; Oppstk = 0; Passhead = 0; Rphead = 0; Opseen = 0; Savehead = 0; Real = 0; Opmask = 0; Bool = 0; Rpbot = 0; Savebot = 0; Passbot = 0; Pp = P; Head = Rpptr; if (Mode == 3 || Mode == 4) Bool = 8; Nextb: P = P + 1; C = A(P); if (2 == C && Bool == 0) { Opmask = 1 << 21; Nops = Nops + 1; Opseen = 1; Opstk = 11; Oppstk = 3; } if (Bool != 0 && C == 1) { Opmask = Opmask | 1 << 22; Nops = Nops + 1; Opseen = 1; while (5 <= (Oppstk & 31)) { A(Rpptr) = Opstk & 31; Rpptr = Rpptr + 3; Opstk = Opstk >> 5; Oppstk = Oppstk >> 5; } Opstk = Opstk << 5 | 10; Oppstk = Oppstk << 5 | 5; } Nextopnd: Opnd = A(P + 1); P = P + 2; Complex = 0; Xtra = 0; goto *Operand[Operand_sw = (Bool + Opnd) - 1]; Operand_1:; Operand_10:; C = A(P); D = Tags(C); Ptype = Aslist(D).S1 >> 16; if (Ptype == 0xFFFF) Ptype = 7; if (Ptype == Snpt) Ptype = 0x1000 + Tsname(Aslist(D).S3 >> 16); Type = Ptype & 7; if ((Ptype & 0xFFF0) != 0 || Parmchk == 1) Complex = 1; if ((Ptype & 0xF000) != 0) Opmask = Opmask | 0x80000000; if (Adflag != 0) { Reducetag(); if (Oldi == Level && Sndisp != 'FP') Fault(27, C); } if (Type == 2) Real = 1; Rptype = 2; Rpinf = P; if (Bool == 0) { if (Ptype == 7) { Ptype = 1; Unpack(); } if (Type >= 3) { Fault(42, C); Rptype = 0; Ptype = 1; } } else { if (Ptype == 7) { Ptype = 3; Unpack(); } if (Type != 3) { Fault(24, C); Rptype = 0; Ptype = 3; } } P = P + 1; if (A(P) == 3) P = P + 1; else Skipapp(); P = P + 1; Ins: A(Rpptr) = Ptype << 16 | Complex << 8 | Rptype; A(Rpptr + 1) = Rpinf; A(Rpptr + 2) = Xtra; Rpptr = Rpptr + 3; goto Op; Operand_2:; C = A(P); Rptype = 1; if (C == 2) { Ptype = 2; Rpinf = A(P + 1); Xtra = A(P + 2); P = P + 4; Real = 1; } else { D = A(P + 1); if (D >> 17 == 0) Rptype = 0; Rpinf = D; P = P + 3; Ptype = 1; } goto Ins; Operand_9:; Etorp(Passhead, Nops, 0); Rpptr = Rpptr - 3; C = A(P); P = P + 1; if (C > 7) C = C - 7; Etorp(Savehead, Nops, 0); if (Mode == 4 && Opseen == 0 && A(P) == 2) D = 27; else D = 26; A(Rpptr - 3) = D; A(Rpptr - 2) = C; P = P + 1; goto Op; Operand_11:; C = A(P); P = P + 2; Ptype = 3; Rptype = 0; Rpinf = C - 2; goto Ins; Operand_3:; Operand_12:; Etorp(Passhead, Nops, 3 * (Bool >> 3)); Rpptr = Rpptr - 3; if (Type == 2) Real = 1; P = P + 1; Op:; if (A(P - 1) == 2) goto Eoe; Operator = A(P); Opprec = Opinf(Operator + Bool); Operator = Opprec & 63; if (Operator == 21) Real = 1; Opprec = Opprec >> 8; Opmask = Opmask | 1 << (Operator + 5); Nops = Nops + 1; Opseen = 1; while (Opprec <= (Oppstk & 31)) { A(Rpptr) = Opstk & 31; Rpptr = Rpptr + 3; Opstk = Opstk >> 5; Oppstk = Oppstk >> 5; } Opstk = Opstk << 5 | Operator; Oppstk = Oppstk << 5 | Opprec; if (Bool == 0) goto Nextopnd; goto Nextb; Eoe:; while (Opstk != 0) { A(Rpptr) = Opstk & 31; Rpptr = Rpptr + 3; Opstk = Opstk >> 5; } A(Rpptr) = 100; Rpptr = Rpptr + 3; if (Bool != 0) Ptype = 3; else Ptype = 1 + Real; Type = Ptype; if (Real == 1) Opmask = Opmask | 1 << 26; Nops = Nops | Opmask; goto Operand_skip; Operand_default: fprintf(stderr, "Switch label 'Operand(%d):' not set in %s", Operand_sw + 1, __PRETTY_FUNCTION__); exit(1) /* or %signal ... */; Operand_skip:; } void Expop(int Inhead, int Reg, int Nops, int Mode) { int Operand[2 /*1:2*/]; Rd *Opnd1; Rd *Opnd2; Rd *Opnd3; Listf *Lcell; int C; int D; int Kk; int Jj; int Opcode; int Comm; int Xtra; int Stptr; int Rdform; int Evalreg; int Pp; int Pt; int Jjj; int Loadreg; void Float(Rd Opnd); void Typechk(int Mode); void Fix(Rd Opnd, int Mode); void Ctop(int A); void Put(void); void Starstar(void); void Rexp(void); void Load(Rd Opnd, int Reg, int Mode); const int Mcinst[23 /*10:32*/] = { 0x8E8E, 0xF4F4E4E4, [2 ... 4] = 0, 0xF0F0E0E0, 0xF2F4E2E4, 0x8E8E, 0x8C8C, 0xFAFAEAEA, 0xAAAC, 0xBABC0000, 0x8A8A, 0x8C00, 0, 0xFA00EA00, [16 ... 17] = 0xF6F6E6E6, 0x2C002C00, 0x02000200, [20 ... 22] = 0x48004800}; const unsigned char Fcomp[28 /*1:28*/] = { 8, 10, 2, 7, 12, 4, 7, 8, 12, 4, 7, 10, 2, 7, 16, 34, 17, 32, 33, 18, 32, 16, 33, 18, 32, 34, 17, 32}; static int Sw_sw; static void *Sw[23 /*10:32*/] = { &&Sw_10, &&Sw_11, &&Sw_12, &&Sw_13, &&Sw_14, &&Sw_15, &&Sw_16, &&Sw_17, &&Sw_18, &&Sw_19, &&Sw_20, &&Sw_21, &&Sw_22, &&Sw_23, &&Sw_24, &&Sw_25, &&Sw_26, &&Sw_27, &&Sw_28, &&Sw_29, &&Sw_30, &&Sw_31, &&Sw_32, }; Stptr = 0; Rdform = Mode & 16; Evalreg = Accr; if (Reg == Breg && (Nops & 0xFEE00000) == 0) Evalreg = Breg; if (Reg == Breg && Breg != Evalreg && Register(Breg) > 0) Bootout(Breg); Next: C = A(Inhead); Xtra = A(Inhead + 1); if (C == 99) { Inhead = Xtra; goto Next; } if (C == 100) goto Finish; Jj = C & 255; D = Inhead; Inhead = Inhead + 3; if (10 <= Jj) goto Operator; Opnd1 = Record(Addr(A(D))); if ((Opnd1->Flag == 2 && Opnd1->Xb != 0) || Opnd1->Flag == 4) { Jj = Evalreg; if (Jj == Breg && Register(Accr) == 1) Jj = Accr; Load(*Opnd1, Jj, 0); } Stk(Stptr) = Addr(*Opnd1); Stptr = Stptr + 1; goto Next; Operator:; Stptr = Stptr - 1; if (Jj >= 15) { Operand(2) = Stk(Stptr); Stptr = Stptr - 1; } Operand(1) = Stk(Stptr); Opcode = Mcinst(Jj); Comm = 1; Opnd1 = Record(Operand(1)); Opnd2 = Opnd1; if (Jj > 14) { Opnd2 = Record(Operand(2)); if ((Opcode & 0x00FF00FF) != 0) { C = Opcode; if ((Opnd1->Ptype & 7) == 2 || (Opnd2->Ptype & 7) == 2) C = C >> 16; if (C >> 8 == 0 || ((C & 255) != 0 && Opnd2->Flag == 9)) { Comm = 2; Opnd3 = Opnd1; Opnd1 = Opnd2; Opnd2 = Opnd3; } } } if (Opnd1->Flag < 2 && 2 > Opnd2->Flag) Ctop(Jj); if (Jj == 0) goto Stres; if ((Opnd1->Ptype & 7) != (Opnd2->Ptype & 7) && ((1 << Jj) & 0xCC098000) != 0) Typechk((Jj + 2) >> 5); goto *Sw[Sw_sw = (Jj)-10]; Sw_10:; Load(*Opnd1, Evalreg, 2); Plant(0x8E7F); Gruse(Accr) = 0; Suse: Olink(Evalreg) = Operand(Comm); Stres: Stk(Stptr) = Operand(Comm); Stptr = Stptr + 1; goto Next; Sw_11:; Load(*Opnd1, Evalreg, 2); if (Type == 2) Opcode = Opcode >> 16; Psf1(Opcode & 255, 0, 0); Gruse(Accr) = 0; goto Suse; Sw_12:; if (Xtra >> 16 != 0) Load(*Opnd1, Evalreg, 2); Enterlab(Xtra & 0xFFFF, 0, Level); goto Suse; Sw_13:; if ((Opnd1->Ptype & 7) == 1) Float(*Opnd1); Fix(*Opnd1, Xtra); goto Suse; Sw_14:; Load(*Opnd1, Evalreg, 2); if (Type == 2) { C = 63; D = 0; } else { C = 31; D = 4; } Pf3(Jat, D, 0, 5); Psf1(Ush, 0, -C); Psf1(Ush, 0, 1); Psf1(Irsb, 0, 1); Gruse(Accr) = 0; if (Type == 2) { if (Register(Breg) == 0) { Plant(0x4B9C); Gruse(Breg) = 0; } else Plant(0x3211); } Opnd1->Ptype = 1; Opnd1->Xb = Accr << 4; Opnd1->Flag = 9; Opnd1->D = 0; goto Suse; Sw_15:; Binop: if (Opnd1->Flag != 9 || Opnd1->Xb >> 4 != Evalreg) Load(*Opnd1, Evalreg, 2); if (Opnd2->Flag <= 4) Load(*Opnd2, Evalreg, 1); Put(); if (Jj != 17) goto Suse; Plant(0x8E7F); goto Suse; Sw_16:; goto Binop; Sw_17:; Sw_18:; Sw_22:; if ((Opnd1->Ptype & 7) == 3 && 3 == (Opnd2->Ptype & 7)) goto Binop; Fault(24, 0); F25: Jj = 15; Opcode = Mcinst(15); goto Binop; F26: Fault(26, 0); goto F25; Sw_23:; Load(*Opnd1, Evalreg, 2); Plant(0x8E7F); Sw_24:; Sw_19:; goto Binop; Sw_20:; if ((Opnd1->Ptype & 7) != 1 || 1 != (Opnd2->Ptype & 7)) goto F26; goto Binop; Sw_21:; Typechk(2); goto Binop; Sw_25:; if ((Opnd2->Ptype & 7) == 2 && (Opnd1->Ptype & 7) == 1) Float(*Opnd1); if ((Opnd2->Ptype & 7) == 1) { Starstar(); goto Suse; } Rexp(); Comm = 2; goto Suse; Sw_26:; Sw_27:; if (Opnd1->Flag <= 1 && Opnd1->D == 0 && Jj == 27) goto Z1; if (Opnd2->Flag <= 1 && Opnd2->D == 0 && Jj == 27) goto Z2; Load(*Opnd1, Evalreg, 2); Load(*Opnd2, Evalreg, 1); if (Jj == 26) { Put(); Plant(0x6200); Gruse(Accr) = 0; Loadreg = Accr; } else { Put(); Loadreg = -1; } Mask = Reverse(Fcomp(Xtra + 7 * (Comm - 1))); Register(Evalreg) = 0; if (Loadreg == -1) { Nest = -1; return; } Pf3(Jcc, Mask, 0, 3); Plant(0x627F); Opnd1->Ptype = 3; Opnd1->Xb = Accr << 4; Opnd1->Flag = 9; Opnd1->D = 0; Type = 3; Register(Accr) = 1; goto Suse; Z1: Opnd3 = Opnd2; goto Z3; Z2: Opnd3 = Opnd1; Z3: Load(*Opnd3, Accr, 2); Mask = Reverse(Fcomp(Xtra + 7 * Comm + 7)); if (Type == 1) Mask = Mask + 4; Nest = -1; Register(Accr) = 0; return; Sw_28:; C = Opnd2->D >> 16; D = Opnd2->D & 31; if (Opnd1->Flag == 9 && Opnd1->Xb >> 4 == Accr) { Plant(0x4998); Changerd(Accr); Register(Accr) = 0; } if (C == D) { Base = Opnd2->Xtra >> 18; Area = -1; Getinacc(Dr, 2, 0, Areacode, (Opnd2->Xtra & 0x1FFFF) + 8); } Load(*Opnd1, Evalreg, 0); Area = Opnd1->Xb >> 4; Access = Opnd1->Xb & 15; if (C == D && Register(Breg) >= 1 && (Opnd1->Flag != 9 || Area != Breg)) { Opnd3 = Record(Olink(Breg)); Opnd3->D = 0; Register(Breg) = 2; Bootout(Breg); } if (C == 1 && D == 2 && Parmarr == 0) { if (Xtra != 2) Plant(0x23DC); Opcode = Adb << 8; } Access = Opnd1->Xb & 15; Area = Opnd1->Xb >> 4; Psorlf1(Opcode >> 8 & 255, Access, Area, Opnd1->D); Gruse(Breg) = 0; if (D == 1 || (D == 2 && Parmarr == 0)) Loadreg = Breg; else { Loadreg = Accr; if (C == D) Getinacc(Accr, 1, 0, 7, 0); else Plant(0xE19C); if (C == 1) { Plant(0x499C); Register(Accr) = 0; Loadreg = Breg; } } Register(Loadreg) = 1; Opnd1->Flag = 9; Opnd1->Xb = Loadreg << 4; Olink(Loadreg) = Operand(Comm); if (C == 1) goto Stres; goto Next; Sw_29:; Abort(); Sw_30:; Sw_31:; Pp = Opnd2->D; Pt = Opnd2->Ptype; D = Opnd2->Flag; if (Opnd1->Flag != 9 || Opnd1->Xb >> 4 != Accr) Load(*Opnd1, Accr, 2); if (D == 2) if (Opnd2->Ptype <= 3 && Opnd2->Uptype == 0) { Lcell = &Aslist(Opnd2->Xtra); D = Lcell->S3 >> 16; Area = -1; C = 0; Base = Lcell->S1 >> 4 & 15; if (Base == Rlevel) Jjj = Lnb; else Jjj = Areacode; } else { P = Pp; Cname(1, 0); D = Disp; C = Access; if (Area < 0) Area = Areacode; Jjj = Area; } else { if (D == 6) { C = 0; Base = Opnd2->Xb; Area = -1; Jjj = Areacode; } else { Area = Opnd2->Xb >> 4; Jjj = Area; Access = Opnd2->Xb & 15; C = Access; } D = Pp; } if (Opnd1->Flag != 9) Load(*Opnd1, Accr, 2); Psorlf1(St, C, Jjj, D); if (Opnd2->Flag == 2) Noteassment(Accr, A(Pp)); else Setuse(Accr, 10, Xtra); if (Jj == 31) Register(Evalreg) = 0; Comm = 1; goto Suse; Sw_32:; C = Tags(Xtra); Lcell = &Aslist(C); D = Lcell->S1; Jjj = D >> 4 & 15; D = D >> 16 & 15; C = Lcell->S3 >> 16; if (D == 2 && (Opnd1->Ptype & 7) == 1) Float(*Opnd1); if (D == 1 && (Opnd1->Ptype & 7) == 2) Fix(*Opnd1, 0); if (Opnd1->Flag != 9 || Opnd1->Xb >> 4 != Accr) Load(*Opnd1, Accr, 2); if (Gruse(Dr) == 7 && Grinf(Dr) == Xtra) { if (7 <= Opnd2->Flag && Opnd2->Flag <= 8) { Access = 1; if (Opnd2->Flag == 7) { Area = Lnb; Disp = Opnd2->D; } else { Area = Tos; Disp = 0; } } else { if (Opnd2->Flag != 9 || Opnd2->Xb >> 4 != Breg) Load(*Opnd2, Breg, 2); Access = 3; Area = 7; Disp = 0; } Pf1(St, Access, Area, Disp); } else { if (Opnd2->Flag != 9 || Opnd2->Xb >> 4 != Breg) Load(*Opnd2, Breg, 2); Area = -1; Base = Jjj; if (Base == Rlevel) Area = Lnb; else Area = Areacode; Pf1(St, 3, Area, C); } Register(Breg) = 0; Gruse(Dr) = 7; Grinf(Dr) = Xtra; Comm = 1; goto Stres; Finish:; Opnd1 = Record(Stk(Stptr - 1)); if ((Opnd1->Ptype & 7) == 1 && Mode == 2) Float(*Opnd1); if ((Opnd1->Ptype & 7) == 2 && Mode == 1) Fix(*Opnd1, 0); if (Rdform == 0 && (Opnd1->Flag != 9 || Opnd1->Xb >> 4 != Reg)) Load(*Opnd1, Reg, 2); Ptype = Opnd1->Ptype; Type = Ptype & 7; Nest = -1; if (Opnd1->Flag == 9) { Nest = Opnd1->Xb >> 4; Register(Nest) = 0; } return; void Load(Rd Opnd, int Reg, int Mode) { int J; int K; int C; int D; int Head1; int Head2; static int Sw_sw; static void *Sw[10 /*0:9*/] = { &&Sw_0, &&Sw_1, &&Sw_2, &&Sw_default, &&Sw_4, &&Sw_default, &&Sw_6, &&Sw_7, &&Sw_8, &&Sw_9, }; Ptype = Opnd.Ptype; Type = Ptype & 7; K = Opnd.Flag; if (Mode == 2 || 2 <= K && K <= 4 || (K < 2 && Mode == 1)) goto *Sw[Sw_sw = K]; return; Sw_0: Litconst:; Area = 0; Access = 0; Disp = Opnd.D; if (Mode == 2) { if (Gruse(Reg) == 5 && Grinf(Reg) == Disp && Type == 1) if (Register(Reg) != 0) Bootout(Reg); else Getinacc(Reg, Bytes(Type) >> 2, Access, Area, Disp); if (Type == 1) { Gruse(Reg) = 5; Grinf(Reg) = Disp; } goto Lded; } Opnd.Flag = 7; Opnd.Xb = Area << 4 | Access; Opnd.D = Disp; return; Sw_1:; if (Opnd.D == 0 && 0 == Opnd.Xtra) goto Litconst; if (Type == 1 && Imod(Opnd.D) >> 17 == 0) goto Litconst; Storeconst(Disp, Bytes(Type), Opnd.D, Opnd.Xtra); if (Mode != 2) { Opnd.Flag = 7; Area = Pc; Opnd.Xb = Area << 4; Access = 0; Opnd.D = Disp; return; } if (Gruse(Reg) == 6 && Grinf(Reg) == Disp) if (Register(Reg) != 0) Bootout(Reg); else Getinacc(Reg, Bytes(Type) >> 2, 0, Pc, Disp); Gruse(Reg) = 6; Grinf(Reg) = Disp; goto Lded; Sw_2:; P = Opnd.D; if (Mode == 2 || Opnd.Xb != 0) goto Load; Cname(5, Reg); if (Nest >= 0) goto Lded; Opnd.Ptype = Ptype; Opnd.Flag = 7; Opnd.Xb = Area << 4 | Access; Opnd.D = Disp; return; Load: Cname(2, Reg); Lded: Register(Reg) = 1; Olink(Reg) = Addr(Opnd); Opnd.Flag = 9; Opnd.D = 0; Opnd.Xb = Reg << 4; return; Sw_4:; C = Type; Head1 = (Opnd.D >> 16) + Rpbase; Head2 = (Opnd.D & 0xFFFF) + Rpbase; Saveirs(); Expop(Head1, Accr, 2, 3); if (Nest >= 0) Mask = 20; Plabel = Plabel - 1; J = Plabel; Enterjump(Mask, J, 0b11); Expop(Head2, Reg, 2, C); if (Reg >= 0) D = Reg; else D = Nest; Plabel = Plabel - 1; Enterjump(15, Plabel, 0b11); Head1 = Opnd.Xtra; Enterlab(J, 0b111, Level); J = Plabel; Expop(Head1, D, 2, C); Enterlab(J, 0b11, Level); Gruse(D) = 0; Olink(Reg) = Addr(Opnd); Opnd.Ptype = C; Register(D) = 1; Opnd.Flag = 9; Opnd.Xb = Reg << 4; Opnd.D = 0; return; Sw_6:; Abort(); Sw_7:; Area = Opnd.Xb >> 4; Access = Opnd.Xb & 15; Disp = Opnd.D; Pickup: Getinacc(Reg, Bytes(Type) >> 2, Access, Area, Disp); goto Lded; Sw_8:; Area = Tos; Access = 0; Disp = 0; goto Pickup; Sw_9:; if (Opnd.Xb >> 4 == Reg) goto Lded; if (Reg != Accr) { if (Register(Breg) != 0) Bootout(Breg); Plant(0x499C); Gruse(Breg) = Gruse(Accr); Grinf(Breg) = Grinf(Accr); } else { Getinacc(Accr, 1, 0, 7, 0); Gruse(Accr) = Gruse(Breg); Grinf(Accr) = Grinf(Breg); } Register(Opnd.Xb >> 4) = 0; Opnd.Xb = Reg << 4; Register(Reg) = 1; Olink(Reg) = Addr(Opnd); goto Sw_skip; Sw_default: fprintf(stderr, "Switch label 'Sw(%d):' not set in %s", Sw_sw, __PRETTY_FUNCTION__); exit(1) /* or %signal ... */; Sw_skip:; } void Put(void) { int Code; Code = Opcode; if ((Opnd2->Ptype & 7) == 2) Code = Code >> 16; if (Comm == 1) Code = Code >> 8; Code = Code & 255; if (Evalreg == Breg) Code = Code - 0xC0; Area = Opnd2->Xb >> 4; Access = Opnd2->Xb & 15; Disp = Opnd2->D; Psorlf1(Code, Access, Area, Disp); if (Jj != 27) Gruse(Evalreg) = 0; Olink(Evalreg) = Operand(Comm); } void Ctop(int Flag) { int Val1; int Val2; int Typep; int Op; double Rval1; double Rval2; double X; static int Sw_sw; static void *Sw[19 /*10:28*/] = { &&Sw_10, &&Sw_11, &&Sw_12, &&Sw_13, &&Sw_14, &&Sw_15, &&Sw_16, &&Sw_17, &&Sw_18, &&Sw_19, &&Sw_20, &&Sw_21, &&Sw_22, &&Sw_23, &&Sw_24, &&Sw_25, &&Sw_26, &&Sw_27, &&Sw_28, }; Op = Flag; Typep = Opnd1->Ptype | Opnd2->Ptype; if (Op > 28 || Typep >= 3) return; if (Opnd1->Ptype == 2) { Integer(Addr(Rval1)) = Opnd1->D; Integer(Addr(Rval1) + 4) = Opnd1->Xtra; if (Mod(Rval1) < Imax) Val1 = Int(Rval1); } else { Val1 = Opnd1->D; Rval1 = Val1; } if (Opnd2->Ptype == 2) { Integer(Addr(Rval2)) = Opnd2->D; Integer(Addr(Rval2) + 4) = Opnd2->Xtra; if (Mod(Rval2) < Imax) Val2 = Int(Rval2); } else { Val2 = Opnd2->D; Rval2 = Val2; } goto *Sw[Sw_sw = (Op)-10]; Intend:; Flag = 0; Opnd1->Ptype = 1; if (0 <= Val1 && Val1 <= 4095) Opnd1->Flag = 0; else Opnd1->Flag = 1; Opnd1->D = Val1; return; Sw_11:; if (Typep == 1) { Val1 = -Val1; goto Intend; } Rval1 = -Rval1; goto Realend; Sw_13:; if (Mod(Rval1) > Imax) return; Val1 = Int(Rval1); goto Intend; Realend:; Opnd1->Flag = 1; Opnd1->D = *Integer(Addr(Rval1)); Opnd1->Xtra = *Integer(Addr(Rval1) + 4); Flag = 0; Opnd1->Ptype = 2; return; Sw_14:; Val1 = 0; if (Rval1 > 0) Val1 = 1; if (Rval1 < 0) Val1 = -1; goto Intend; Sw_15:; if (Typep == 1) { Val1 = Val1 + Val2; goto Intend; } Rval1 = Rval1 + Rval2; goto Realend; Sw_16:; if (Typep == 1) { Val1 = Val1 - Val2; goto Intend; } Rval1 = Rval1 - Rval2; goto Realend; Sw_19:; Sw_28:; if (Typep == 1) { Val1 = Val1 * Val2; goto Intend; } Rval1 = Rval1 * Rval2; goto Realend; Sw_21:; if (Rval2 == 0) return; Rval1 = Rval1 / Rval2; goto Realend; Sw_20:; if (Val2 == 0 || Typep != 1) return; Val1 = Val1 / Val2; goto Intend; Sw_25:; if (Rval1 <= 0) return; if (Typep == 1 && 32 > Val2 && Val2 > 0) { X = REXP(Rval1, Val2); if (Mod(X) > Imax) return; Val1 = Int(X); goto Intend; } if (Opnd2->Ptype == 1 && 63 > Imod(Val2)) { Rval1 = REXP(Rval1, Val2); goto Realend; } Sw_10:; Sw_12:; Sw_17:; Sw_18:; Sw_22:; Sw_23:; Sw_24:; Sw_26:; Sw_27:; } void Float(Rd Opnd1) { if (Opnd1.Flag <= 1) { Cvalue = Opnd1.D; Opnd1.D = *Integer(Addr(Cvalue)); Opnd1.Xtra = *Integer(Addr(Cvalue) + 4); Opnd1.Flag = 1; } else { Load(Opnd1, Accr, 2); Plant(0xA800); Gruse(Accr) = 0; } Opnd1.Ptype = 2; Type = 2; } void Typechk(int Mode) { int Pt1; int Pt2; Pt1 = Opnd1->Ptype & 7; Pt2 = Opnd2->Ptype & 7; if (Mode != 2 && Pt1 == 1 && 1 == Pt2) return; if (Mode == 1) if (Pt2 == 1 && Pt1 == 2) { Fix(*Opnd1, 0); return; } else if (Pt2 == 1) Float(*Opnd2); if (Pt1 == 1) Float(*Opnd1); } void Fix(Rd Opnd, int Mode) { if (Opnd.Flag == 1) { Integer(Addr(Cvalue)) = Opnd.D; Integer(Addr(Cvalue) + 4) = Opnd.Xtra; if (Mod(Cvalue) < Imax) { Opnd.D = Int(Cvalue); Type = 1; Opnd.Ptype = 1; return; } } Load(Opnd, Accr, 2); if (Register(Breg) != 0) Bootout(Breg); if (Mode == 0) Pf1(Rad, 0, Pc, Specialconsts(0)); Pclod(100 - Parmopt, 103); Gruse(Accr) = 0; Gruse(Breg) = 0; Opnd.Ptype = 1; Type = 1; } void Starstar(void) { int Typep; int Work; int C; int Expwork; int Value; Ptype = Opnd1->Ptype; Type = Ptype & 7; Typep = Type; if (Typep == 2) Opcode = Opcode >> 16; Opcode = (Opcode >> 8) & 255; Value = 0; if (Opnd2->Flag == 0 && 1 <= Opnd2->D && Opnd2->D <= 63 * Type) Value = Opnd2->D; Load(*Opnd1, Accr, 1); if (2 <= Value && Value <= 4) { if (Opnd1->Flag == 9 || (Opnd1->Xb & 3) != 0) { if (Opnd1->Flag != 9) Load(*Opnd1, Accr, 2); Plant(0x4998); if (Value == 3) Plant(0x4998); Plant(Opcode << 8 | 0x198); if (Value == 4) Plant(0x4998); if (Value > 2) Plant(Opcode << 8 | 0x198); } else { Getinacc(Accr, Bytes(Typep) >> 2, Access, Area, Disp); for (C = 2; C <= Value; C++) Psorlf1(Opcode, Access, Area, Disp); Opnd1->Flag = 9; Opnd1->Xb = Accr << 4; Opnd1->D = 0; Register(Accr) = 1; } Gruse(Accr) = 0; return; } else Load(*Opnd1, Accr, 2); Getwsp(Work, Bytes(Type) >> 2); if (Typep == 2) Getwsp(Expwork, 1); Psf1(St, 1, Work); Plabel = Plabel - 1; Load(*Opnd2, Breg, 2); if (Parmopt != 0) { if (Typep == 1 && Value == 0) Ppj(30, 7); Pf3(Jat, 13, 0, 4); Ppj(16, 7); } if (Typep == 2) Psf1(Stb, 1, Expwork); if (Typep == 1) Plant(0x6201); else Pf1(0x60, 0, Pc, Specialconsts(1)); if (Value == 0) { Enterjump(28, Plabel, 0b11); if (Typep == 2) { Pf3(Jat, 13, 0, 4); Plant(0x5200); Plant(0x2398); } } C = Ca; Psf1(Opcode, 1, Work); Psf1(Debj, 0, (C - Ca) / 2); if (Value == 0 && Typep == 2) { Psf1(Lb, 1, Expwork); Enterjump(46, Plabel, 0b11); Pf1(Rrdv, 0, Pc, Specialconsts(1)); } Type = Typep; Register(Breg) = 0; Gruse(Breg) = 0; Gruse(Accr) = 0; Opnd1->Ptype = +Type; Opnd1->Xb = 0; Opnd1->D = Accr; Enterlab(Plabel, 0b11, Level); } void Rexp(void) { if (Register(Breg) > 0) Bootout(Breg); if (Opnd1->Flag != 8) Load(*Opnd1, Accr, 2); Load(*Opnd2, Accr, 2); Ppj(0, 14); } } void Reduceenv(int Head) { int I; int J; int K; int Reg; int Use; Listf *Lcell; int *Ohead; Ohead = &Head; while (*Ohead != 0) { Lcell = &Aslist(*Ohead); K = Lcell->S3; Reg = K >> 8; Use = K & 255; if (Use != Gruse(Reg) || Lcell->S1 != Grinf(Reg)) Pop(*Ohead, I, J, K); else Ohead = &Lcell->Link; } } int Reverse(int Mask) { if (Mask > 15) Mask = Mask ^ 0x30; else Mask = Mask ^ 15; return (Mask); } void Enterlab(int Lab, int Flags, int Levl) { int Cell; int At; int Envhead; int Jumphead; int Instrn; int L; int Oldcell; Listf *Lcell; if (Parmopt != 0) Flags = Flags & 1; if (Lab <= Nnames) Cell = Tags(Lab); else { Cell = Label(Levl); Oldcell = 0; while (Cell > 0) { if (Aslist(Cell).S1 == Lab) break; Oldcell = Cell; Cell = Aslist(Cell).Link; } } if (Cell <= 0) { if ((Flags & 1) == 0) { Push(Label(Levl), Lab, 0, Level << 24 | Ca); #if 1 /* Includehandcode==No */ for (L = 0; L <= 7; L++) Gruse(L) = 0; #else { asm("LSQ 0"); asm("LCT GRUSE+4"); asm("ST (%CTB+0)"); asm("ST (%CTB+4)"); } #endif } return; } Lcell = &Aslist(Cell); if ((Lcell->S3 & 0xFFFFFF) != 0) { Fault(2, Lab); return; } Lcell->S3 = Level << 24 | Ca; Jumphead = Lcell->S2; Envhead = Jumphead >> 16; Jumphead = Jumphead & 0xFFFF; if ((Flags & 2) == 0) { #if 1 /* Includehandcode==No */ for (L = 0; L <= 7; L++) Gruse(L) = 0; #else { asm("LSQ 0"); asm("LCT GRUSE+4"); asm("ST (%CTB+0)"); asm("ST (%CTB+4)"); } #endif if (Envhead != 0) Clearlist(Envhead); } else { if ((Flags & 4) == 0) Remember(); Restore(Envhead); Envhead = 0; if ((Flags & 4) == 0) Mergeinfo(); } while (Jumphead != 0) { Pop(Jumphead, At, Instrn, L); if (L < Level) Fault(12, Lab); Plug(1, At, Instrn | (Ca - At) / 2); } Lcell->S2 = 0; if (Lab > Nnames) if (Oldcell != 0) Pop(Aslist(Oldcell).Link, At, At, At); else Pop(Label(Levl), At, At, At); } void Enterjump(int Mask, int Lab, int Flags) { int At; int Cell; int J; int Jj; int Labaddr; int I; int Envhead; int Oldenv; int Jcode; int Levl; Listf *Lcell; if (Parmopt != 0) Flags = Flags & 1; Envhead = 0; At = Ca; Levl = Level; if (Lab < 21000) Flags = Flags & 0xFE; if (Lab <= Nnames) { Cell = Tags(Lab); Levl = Aslist(Cell).S1 >> 8 & 63; Flags = Flags & 0xFD; } else { Cell = Label(Levl); while (Cell != 0) { if (Aslist(Cell).S1 == Lab) break; Cell = Aslist(Cell).Link; } } Jcode = Ocode(Mask); if (Cell <= 0) goto Firstref; Lcell = &Aslist(Cell); Labaddr = Lcell->S3 & 0xFFFFFF; if (Labaddr == 0) goto Notyetset; I = (Labaddr - Ca) / 2; if (Lcell->S3 >> 24 > Level) Fault(12, Lab); if (Jcode > 6) Psf1(Jcode, 0, I); else Pf3(Jcode, Mask & 15, 0, I); return; Firstref:; if (Lab > Nnames && (Flags & 2) != 0) Getenv(Envhead); Push(Label(Levl), Lab, Envhead << 16, 0); Cell = Label(Levl); Lcell = &Aslist(Cell); goto Code; Notyetset:; if (Lab > Nnames && (Flags & 2) != 0) { I = Lcell->S2; Oldenv = I >> 16; Reduceenv(Oldenv); Lcell->S2 = Oldenv << 16 | I & 0xFFFF; } Code:; if (Jcode > 6) I = Jcode << 24 | 3 << 23; else I = Jcode << 24 | (Mask & 15) << 21; J = Lcell->S2; Jj = J & 0xFFFF; Push(Jj, Ca, I, Level); Lcell->S2 = J & 0xFFFF0000 | Jj; Pconst(I); } void Mergeinfo(void) { int I; int J; for (J = 0; J <= 4; J++) { I = Grmap(J); if (Sgruse(I) != Gruse(I) || Sgrinf(I) != Grinf(I)) Gruse(I) = 0; } } void Remember(void) { int I; int J; for (J = 0; J <= 4; J++) { I = Grmap(J); Sgruse(I) = Gruse(I); Sgrinf(I) = Grinf(I); } } void Csname(int Z, int Reg) { static int Adhoc_sw; static void *Adhoc[7 /*1:7*/] = { &&Adhoc_1, &&Adhoc_2, &&Adhoc_3, &&Adhoc_4, &&Adhoc_5, &&Adhoc_6, &&Adhoc_7, }; const int Sninfo[67 /*0:66*/] = {0x11010024, 0x11020024, 0x11030024, 0x11050024, 0x80190000, [5 ... 7] = 0x80010000, [8 ... 10] = 0x80010000, 0x80000000, [12 ... 14] = 0x80000000, 0x802D0000, 0x10040001, 0x80060000, 0x800A0000, 0x800E0000, 0x80030000, 0x801B0000, 0x80110000, 0x80130000, 0x80160000, 0x80110000, 0x80000000, 0x80190000, 0x80190000, [29 ... 30] = 0x80000000, 0x80190000, 0x80190000, 0x80000000, 0x80190000, 0x801E0000, [36 ... 37] = 0x80000000, 0x80200000, 0x80110000, 0x11060024, 0x80000000, 0x80200000, 0x80010000, 0x80000000, 0x80240000, [46 ... 47] = 0x80110000, 0x80000000, 0x80000000, 0x80190000, 0x80000000, 0x10070001, [53 ... 56] = 0x80190000, [57 ... 58] = 0x80260000, [59 ... 60] = 0x802A0000, 0x80190000, 0x80060000, 0x800A0000, 0x80000000, [65 ... 66] = 0x80260000}; const int Snparams[48 /*0:47*/] = { 0, 1, 2, 2, 1, 2, 0x13, 1, 5, 0x101, 0x13, 1, 5, 1, 0x12, 1, 0x102, 0x11, 5, 0x12, 1, 1, 0x12, 1, 5, 0x11, 1, 0x12, 1, 0x101, 0x11, 0x101, 3, 2, 1, 1, 1, 3, 3, 1, 0x101, 0x110, 2, 1, 0x110, 2, 5, 2}; const _imp_string255 Snxrefs[67 /*0:66*/] = { _imp_str_literal("ABS"), _imp_str_literal("IABS"), _imp_str_literal("SIGN"), _imp_str_literal("INTPT"), _imp_str_literal("CLOSESTREAM"), _imp_str_literal("ISQRT"), _imp_str_literal("ISIN"), _imp_str_literal("ICOS"), _imp_str_literal("AARCTAN"), _imp_str_literal("ILOG"), _imp_str_literal("IEXP"), _imp_str_literal("MAXREAL"), _imp_str_literal("MINREAL"), _imp_str_literal("MAXINT"), _imp_str_literal("EPSILON"), _imp_str_literal("AFAULT"), _imp_str_literal("STOP"), _imp_str_literal("INSYMBOL"), _imp_str_literal("OUTSYMBOL"), _imp_str_literal("INREAL"), _imp_str_literal("OUTREAL"), _imp_str_literal("ININTEGER"), _imp_str_literal("OUTTERMINATOR"), _imp_str_literal("OUTINTEGER"), _imp_str_literal("OUTSTRING"), _imp_str_literal("LENGTH"), _imp_str_literal("CPUTIME"), _imp_str_literal("ASELIN"), _imp_str_literal("ASELOU"), _imp_str_literal("ALGNWL"), _imp_str_literal("ALGSPC"), _imp_str_literal("ALGNLS"), _imp_str_literal("ALGSPS"), _imp_str_literal("ANXTSY"), _imp_str_literal("APRSYM"), _imp_str_literal("ARDSYM"), _imp_str_literal("ALREAD"), _imp_str_literal("ALGPTH"), _imp_str_literal("PRINT"), _imp_str_literal("PRSTNG"), _imp_str_literal("AICODE"), _imp_str_literal("READ1900"), _imp_str_literal("PRINT1900"), _imp_str_literal("OUTPUT"), _imp_str_literal("READBOOLEAN"), _imp_str_literal("WRITEBOOLEAN"), _imp_str_literal("WRITETEXT"), _imp_str_literal("COPYTEXT"), _imp_str_literal("ALRDCH"), _imp_str_literal("ALNXCH"), _imp_str_literal("ALPRCH"), _imp_str_literal("ALSKCH"), _imp_str_literal("ALGMON"), _imp_str_literal("OPENDA"), _imp_str_literal("OPENSQ"), _imp_str_literal("CLOSEDA"), _imp_str_literal("CLOSESQ"), _imp_str_literal("PUTDA"), _imp_str_literal("GETDA"), _imp_str_literal("PUTSQ"), _imp_str_literal("GETSQ"), _imp_str_literal("RWNDSQ"), _imp_str_literal("INSYMBOL"), _imp_str_literal("OUTSYMBOL"), _imp_str_literal("ALGPTH"), _imp_str_literal("PUTARRAY"), _imp_str_literal("GETARRAY")}; const long long int One = 1; const long long int Coded = 0xC007C18E03068000; int Errno; int Flag; int Pointer; int Ophead; int Opbot; int Pin; int Snno; int Snname; int Naps; int Snptype; int Jj; int Xtra; int B; int D; int Sninf; int P0; _imp_string255 Refname; Snname = A(P); Snno = K; if (Ebcdic == 0 || (One << Snno & Coded) == 0) Refname = _imp_str_literal("S#"); else Refname = _imp_str_literal("S#E"); Refname = _imp_join(Refname, Snxrefs(Snno)); Testapp(Naps); Pin = P; P = P + 1; Snptype = Tsname(Snno); Sninf = Sninfo(Snno); Xtra = Sninf & 0xFFFF; Pointer = (Sninf >> 16) & 255; Flag = Sninf >> 24; if (Z == 13 && (Flag & 0x80) == 0) { Flag = 0x80; if (Snno == 1) Pointer = 25; else Pointer = 1; if (Snno == 16 || Snno == 52) Pointer = 0; if (Snno == 40) Pointer = 16; } if ((Flag & 0x80) != 0) { Cxref(Refname, Parmdynamic, 2, Jj); if (Snno == 9) Logepdisp = Jj; if (Snno == 10) Expepdisp = Jj; Ophead = 0; P0 = Snparams(Pointer); Push(Ophead, Jj, P0 & 15, P0 >> 4); Opbot = Ophead; K = Ophead; Jj = 1; D = 64; P0 = P0 & 15; while (Jj <= P0) { Ptype = Snparams(Pointer + Jj); if (Ptype == 2) Acc = 8; else Acc = 4; D = ((D & 0xFFFF) + Acc - 1) & (-Acc); if ((Ptype & 0xF0) == 0) D = D | (Ptype & 0xF00) << 8; Binsert(Ophead, Opbot, Ptype, Snname, D); D = D + Acc; Jj = Jj + 1; } I = 9; J = 14; Kform = 0; Oldi = 0; Ptype = Snptype + 4096; Usebits = 3; Replacetag(Snname); P = Pin; Cname(Z, Reg); return; } if (Naps != (Flag & 3)) { Errno = 19; goto Errexit; } Jj = 1 << Z; if ((Jj & Xtra) == 0 && 0 != Z) { Errno = 23; goto Errexit; } Errno = 22; goto *Adhoc[Adhoc_sw = (Pointer)-1]; Adhoc_1:; Adhoc_2:; B = 3 - Pointer; if (A(P) != 2) goto Errexit; D = A(P + 2); P = P + 3; if (2 > D || D > 3) goto Errexit; Csexp(Accr, B, D); if (Reg < 0) Reg = Nest; if (Snno == 1) { Pf3(Jat, 5, 0, 3); Psf1(Irsb, 0, 0); } else { Pf3(Jat, 1, 0, 3); Psf1(Rrsb, 0, 0); } Gruse(Accr) = 0; goto Okexit; Adhoc_3:; Adhoc_5:; if (A(P) != 2) goto Errexit; D = A(P + 2); P = P + 3; if (2 > D || D > 3) goto Errexit; Csexp(Accr, 2, D); Register(Accr) = 1; Ophead = Rpptr; A(Rpptr) = 2 << 16 | 9; A(Rpptr + 1) = 0; A(Rpptr + 3) = 16 - Snno; A(Rpptr + 4) = 1; A(Rpptr + 6) = 100; Rpptr = Rpptr + 9; P0 = P; Expop(Ophead, Accr, 1, 1); P = P0; Rpptr = Ophead; goto Okexit; Adhoc_4:; Ppj(15, 16); goto Okexit; Adhoc_6:; if (A(P) != 2) goto Errexit; if (A(P + 2) == 2) goto Conam; if (A(P + 2) != 1) goto Errexit; B = A(P + 5); D = B >> 16 & 255; B = B >> 24; if (A(P + 4) == 2) { if (B == 'E' && D == 'L') { B = Nl; goto Cod; } if (B == 'S' && 'S' == D) { B = '%'; goto Cod; } } if (A(P + 4) != 1) goto Errexit; if (B == '_') B = ' '; if (B == '\\') B = Nl; P = P - 1; Cod: if (Ebcdic != 0) B = Itoetab(B); Getinacc(Accr, 1, 0, 0, B); Gruse(Accr) = 5; Grinf(Accr) = B; P = P + 6; goto Okexit; Conam:; P = P + 3; Saveirs(); Cname(2, Accr); if (Type != 5) goto Errexit; if (Codepdisp == 0) Cxref(Refname, Parmdynamic, 2, Codepdisp); Plant(0x1804); Plant(0x4998); Psf1(Lxn, 1, 16); Plant(0x6C07); Pf1(Call, 2, Xnb, Codepdisp); #if 1 /* Includehandcode==No */ for (Jj = 0; Jj <= 7; Jj++) Gruse(Jj) = 0; #else { asm("LSQ 0"); asm("LCT GRUSE+4"); asm("ST (%CTB+0)"); asm("ST (%CTB+4)"); } #endif goto Okexit; Adhoc_7:; Plant(0x6200); Plant(0x4998); Ppj(0, 2); Okexit:; P = P + 1; Ptype = Snptype; return; Errexit:; Fault(Errno, Snname); P = Pin + 1; Skipapp(); P = P - 1; return; } void Callthunks(int Z, int Reg, int B, int D) { Base = B; Area = -1; Getinacc(Dr, 2, 0, Areacode, D); if (Z == 1 && Parmarr != 0) { Pf3(Jcc, 14, 0, 4); Ppj(43, 9); } if (Z == 0) { Psf1(Modd, 0, 0); return; } if (Z != 1) Getinacc(Reg, Bytes(Type) >> 2, 2, 7, 0); } void Caname(int Z, int Bs, int Dp) { int Head1; int Head2; int Head3; int Nops; int Ptypep; int Kk; int Pp; int Jj; int Typep; int Arrname; int Q; int Elsize; int Arrp; int Params; Pp = P; Typep = Type; Arrp = Ptype >> 4 & 15; Jj = J; Ptypep = Ptype; Elsize = Bytes(Type); Arrname = A(P); Params = A(P + 1); Testapp(Q); if (Jj == 0) { Aslist(Tcell).S1 = (Aslist(Tcell).S1 | Q); Jj = Q; Kform = Aslist(Tcell).S3 & 0xFFFF; if (Kform != 0) Aslist(Kform).S2 = (Q << 16 | Aslist(Kform).S2); } if (Jj == Q && Params == 1) { P = Pp + 3; if (Arrp == 2 && Jj == 1) { Csexp(Breg, 1, 0); P = P + 1; } else { Head3 = 0; Nops = 0; Head1 = Rpptr; for (Kk = 1; Kk <= Jj; Kk++) { Etorp(Head2, Nops, 1); Rpptr = Rpptr - 3; if (Type == 2) { A(Rpptr) = 13; A(Rpptr + 1) = 0; Rpptr = Rpptr + 3; } P = P + 2; } P = P - 1; for (Kk = Jj; Kk >= 1; Kk--) { Nops = (Nops + 1) | 1 << 24; A(Rpptr) = 0x51 << 16; A(Rpptr + 1) = Kk << 16 | Jj; A(Rpptr + 2) = Bs << 18 | Dp; A(Rpptr + 3) = 28; A(Rpptr + 4) = Arrp; Rpptr = Rpptr + 6; } A(Rpptr) = 100; Rpptr = Rpptr + 3; Pp = P; Expop(Head1, Breg, Nops, 5); P = Pp; Rpptr = Head1; } Base = Bs; Disp = Dp; Access = 3; Area = -1; } else { Fault(18, Arrname); Base = Bs; Disp = Dp; Access = 3; Area = -1; P = P + 1; Skipapp(); } Acc = Elsize; Ptype = Ptypep; J = Jj; } void Cname(int Z, int Reg) { int Jj; int Kk; int Rr; int Levelp; int Dispp; int Namep; int Fname; static int Sw_sw; static void *Sw[8 /*0:7*/] = { &&Sw_0, &&Sw_1, &&Sw_2, &&Sw_3, &&Sw_4, &&Sw_5, &&Sw_6, &&Sw_7, }; static int Mod_sw; static void *Mod[8 /*0:7*/] = { &&Mod_default, &&Mod_1, &&Mod_2, &&Mod_3, &&Mod_default, &&Mod_5, &&Mod_6, &&Mod_7, }; Listf *Lcell; Fname = A(P); Namep = Fname; Tcell = Tags(Fname); if (Tcell <= 0) { Fault(16, Fname); I = Level; J = 0; K = Fname; Kform = 0; Sndisp = 0; Acc = 4; Ptype = 7; Storetag(K, N); N = N + 4; Copytag(Fname); Levelp = I; Dispp = K; } else { Lcell = &Aslist(Tcell); Kk = Lcell->S1; Lcell->S1 = Kk | 0x8000; Ptype = Kk >> 16; Type = Ptype & 7; Oldi = Kk >> 8 & 15; I = Kk >> 4 & 15; Levelp = I; J = Kk & 15; K = Lcell->S3 >> 16; Dispp = K; } Jj = J; if (Jj == 15) Jj = 0; if (Type == 7) goto Notset; if ((Z == 0 || Z == 13) && Ptype >> 12 == 0) { Fault(17, Fname); goto Notset; } if (Z == 12) goto Arrhead; if (Z == 13) goto Rtname; if (Ptype >> 12 != 0) goto Rtcall; goto *Sw[Sw_sw = Type]; Sw_6:; Sw_0:; Sw_4:; Illegaltype:; Fault(5, Fname); Sw_7:; Notset: P = P + 1; Nest = 0; Base = I; Disp = K; Access = 0; Ptype = 1; Type = 1; Skipapp(); return; Arrhead:; Base = I; Access = 0; Disp = K; Area = -1; Noapp(); return; Rtname:; if (Ptype == Snpt) { Csname(Z, Reg); P = P + 1; return; } Disp = Aslist(K).S1; Base = I; if ((Ptype & 0x100) != 0) { Area = -1; Getinacc(Reg, 4, 0, Areacode, Disp); } else if (J == 14) { Getinacc(Reg, 2, 0, 0, 0); Pf1(Luh, 0, Setxorynb(-1, -1), Disp); } else { if (Base == 0 && Cprmode == 2) { Plant(0x7883); if (Disp != 0) Psf1(Inca, 0, Disp); Gruse(Dr) = 0; Getinacc(Accr, 2, 0, 0, 0); } else { Psf1(Jlk, 0, 1); Rtjump(Lda, Aslist(K).S1); Plant(0x1598); Storeconst(Jj, 4, 0xE1000000, 0); Pf1(Ldtb, 0, Pc, Jj); Gruse(Dr) = 0; Getinacc(Accr, 1, 0, Lnb, Ptroffset(Base)); Psf1(Luh, 0, 0); } Plant(0x5998); Plant(0x6B98); } Noapp(); return; Rtcall:; if (Type == 0 && Z != 0) { Fault(23, Fname); goto Notset; } if (Ptype == Snpt) { Csname(Z, Reg); return; } Crcall(K); if (Ptype == 0x1000 || Ptype == 0x1100) return; if (Z != 0 && Z != 2 && Z != 5) { Base = 0; Access = 0; Area = -1; Disp = 0; } if (Reg == Breg) Plant(0x499C); return; Sw_5:; if (Z != 2) goto Illegaltype; Base = I; Area = -1; Getinacc(Reg, 2, 0, Areacode, K); Noapp(); return; Sw_1:; Sw_2:; Sw_3:; if ((Ptype & 0xF0) == 0) { Base = I; Disp = K; Access = 0; Area = -1; if (A(P + 1) == 3) P = P + 1; else Noapp(); } else { Caname(Z, I, K); Ptype = Ptype & 0xF0FF; Type = Ptype & 7; if (Gruse(Dr) == 7 && Grinf(Dr) == Namep) Area = 7; } Kk = Z; if (Z == 5) Kk = 2; Nam = Ptype >> 8 & 15; goto *Mod[Mod_sw = Nam << 2 | Kk & 3]; Mod_1:; if ((Ptype & 0xF0) == 0) if (Base == Rlevel) Area = Lnb; else Area = Areacode; return; Mod_6:; Callthunks(2, Reg, Base, Disp); if (Parmchk != 0) Testass(Reg); Nest = Reg; return; Mod_2:; if (Base == Rlevel && Area < 0) Area = Lnb; else Area = Areacode; if (Access == 0 && Gruse(Reg) == 9 && Grinf(Reg) == Namep) if (Register(Reg) == 0 || Z != 5) { if (Register(Reg) > 0) Bootout(Reg); Nest = Reg; return; } if (Parmchk == 0 && Z == 5) { Nest = -1; return; } Getinacc(Reg, Bytes(Type) >> 2, Access, Area, Disp); if (Access == 3) { Gruse(Dr) = 7; Grinf(Dr) = Namep; } if (Access == 0) { Gruse(Reg) = 9; Grinf(Reg) = Namep; } if (Parmchk == 1) { if (Reg == Breg) Jj = Cpb; else Jj = Ucp; Pf1(Jj, 0, Pc, Plabs(1)); Pconst(Jcc << 24 | 8 << 21 | ((Plabs(5) - Ca) / 2) & 0x3FFFF); } Nest = Reg; return; Mod_7:; Getinacc(Reg, 2, 0, Areacode, Disp); return; Mod_3:; if (Access == 3) { if (Area != 7) Getinacc(Dr, 2, 0, Areacode, Disp); Plant(0x179C); Gruse(Dr) = 0; if (Reg != Dr) Copydr(); } else if (Reg != Dr) { Getinacc(Accr, 1, 0, Lnb, Ptroffset(Base)); Psf1(Iad, 0, Disp); Pf1(Luh, 0, Pc, Paramdes(Type)); } else { Getinacc(Dr, 2, 0, Pc, Paramdes(Type)); Psf1(Lda, 1, Ptroffset(Base)); Psf1(Inca, 0, Disp); } Nest = Reg; return; Mod_5:; Callthunks(1, -1, Base, Disp); Disp = 0; Access = 2; Area = 7; goto Mod_skip; Mod_default: fprintf(stderr, "Switch label 'Mod(%d):' not set in %s", Mod_sw, __PRETTY_FUNCTION__); exit(1) /* or %signal ... */; Mod_skip:; } void Noapp(void) { P = P + 1; if (A(P) == 3) P = P + 1; else { Fault(19, A(P - 1)); Skipapp(); } } void Gthunks(int Ptypep, int Pname) { int Typep; int Apalt; int D; int Topreg; int Pl; int Nostore; int Ctype; int Iconst; int Ad; int D1; int D2; double Rconst; static int Partype_sw; static void *Partype[8 /*0:7*/] = { &&Partype_0, &&Partype_1, &&Partype_2, &&Partype_3, &&Partype_4, &&Partype_5, &&Partype_6, &&Partype_7, }; Apalt = A(P); Nostore = 0; Typep = Ptypep & 7; Topreg = 15; if (Apalt == 2 && A(P + 2) == 3) { Copytag(A(P + 1)); if (Rout == 0 && Type == Typep && (Arr == 0 || Type == 6)) { Base = I; Area = -1; if (Nam == 1) { Getinacc(Accr, 2, 0, Areacode, K); return; } if (Typep <= 3) { P = P + 1; Cname(3, Accr); return; } } } if (Apalt == 3 && A(P + 1) == 2 && A(P + 2 + A(P + 2)) == 2 && A(P + 4) == 2 && 1 <= Typep && Typep <= 2 && Parmopt == 0) { Ctype = A(P + 5); Iconst = 0; Rconst = 0; if (Ctype == 1) { Iconst = A(P + 6); Rconst = Iconst; } else { Integer(Addr(Rconst)) = A(P + 6); Integer(Addr(Rconst) + 4) = A(P + 7); if (Typep == 1) Iconst = Int(Rconst); } if (A(P + 3) == 2) { Iconst = -Iconst; Rconst = -Rconst; } if (Typep == 1) Ad = Addr(Iconst); else Ad = Addr(Rconst); Storeconst(D2, Bytes(Typep), *Integer(Ad), *Integer(Ad + 4)); D2 = D2 & 0x7FFFFFFF; D1 = (Sizecode(Typep) << 27) + 1; Pgla(4, 8, Addr(D1)); D = Glaca - 8; Relocate(D + 4, D2, 1); Push(Glarelocs, D + 4, D2, 0); Area = -1; Base = 0; Getinacc(Accr, 2, 0, Areacode, D); return; } if (Register(Accr) != 0) Bootout(Accr); Plabel = Plabel - 1; Pl = Plabel; Enterjump(0, Pl, 0b11); Pclod(118, 122); #if 1 /* Includehandcode==No */ for (D = 0; D <= 7; D++) Gruse(D) = 0; #else { asm("LSQ 0"); asm("LCT GRUSE+4"); asm("ST (%CTB+0)"); asm("ST (%CTB+4)"); } #endif goto *Partype[Partype_sw = Typep]; Partype_0:; Partype_4:; Partype_5:; Partype_7:; Error:; Fault(22, Pname); return; Partype_3:; if (Apalt != 2 && Apalt != 4) goto Error; goto Com; Partype_1:; Partype_2:; if (2 > Apalt || Apalt > 3) goto Error; Com:; if (Apalt == 2) { Copytag(A(P + 1)); if (Rout == 0 && Type == Typep) { P = P + 1; Cname(3, Dr); goto Thunksend; } } P = P + 1; Csexp(Accr, Typep, Apalt); Getwsp(D, Bytes(Typep) >> 2); Psf1(St, 1, D); Pf1(Ldtb, 0, Pc, Paramdes(Typep)); Psf1(Lda, 1, Ptroffset(Rlevel)); Psf1(Inca, 0, D); Nostore = 4; Thunksend:; Pclod(124, 127); Passdes: Enterlab(Pl, 0b111, Level); Getwsp(D, 2); Plant(0x6398); Psf1(St, 1, D); Psf1(Stln, 1, D + 4); Psf1(Lss, 1, Ptroffset(Rlevel)); Psf1(Iad, 0, D); Pf1(Luh, 0, Pc, Specialconsts(2) + Nostore); Gruse(Accr) = 0; return; Partype_6:; if ((Ptypep & 255) > 16) { if (Apalt != 2 || A(P + 2) != 3) goto Error; P = P + 1; Gotolab(3); goto Passdes; } if (Apalt == 3 || Apalt == 5) { P = P + 1; Cde(11 - (Apalt << 1)); goto Passdes; } if (Apalt != 2) goto Error; P = P + 1; Gotolab(1); goto Passdes; } void Fetchstring(int Reg) { int I; if (A(P) == 1) { I = A(P + 1) + Ebcdic; Pf1(Ldrl, 0, Pc, Strlink); if (I != 0) Psf1(Inca, 0, I); if (Ebcdic != 0) Psf1(Ldb, 0, A(P + 2)); if (Reg != Dr) Copydr(); } else { P = P + 1; Cname(2, Reg); } } int Checkfprocs(int Acthead, int Formalhead) { int Nps; int Fptype; int Aptype; Nps = Aslist(Formalhead).S2; if (0 <= Nps && Nps != Aslist(Acthead).S2) return (1); while (Nps > 0) { Mlink(Acthead); Mlink(Formalhead); Aptype = Aslist(Acthead).S1; Fptype = Aslist(Formalhead).S1; if (Fptype != Aptype && ((Aptype & 0xF00) == 0 || (Fptype & 0xF00) == 0 || (Aptype & 0xF0FF) != (Fptype & 0xF0FF))) return (1); Nps = Nps - 1; } return (0); } void Crcall(int Clink) { int Ii; int Pxtra; int Dlink; int Jjj; int Nparms; int Pt; int Lp; int Psize; int Iii; int Rdisp; int Rtname; int Tl; int Moveptr; int Pp; int Pnam; int Np; int Alt; int Jj; Listf *Lcell; Jjj = J; Lp = I; Dlink = Clink; Tl = Oldi; Lcell = &Aslist(Clink); Rtname = A(P); Pt = Ptype; Testapp(Nparms); P = P + 1; Rdisp = Lcell->S1; if (Lcell->S2 != Nparms) { Fault(19, Rtname); Skipapp(); return; } if ((Register(Accr) | Register(Breg)) != 0) Saveirs(); Plant(0x1804); P = P + 1; Moveptr = 5; if (Nparms == 0) goto Entryseq; Np = 0; Pp = P - 2; Nextparm: Clink = Lcell->Link; Np = Np + 1; P = Pp + 1; if (Clink == 0) goto Entryseq; Lcell = &Aslist(Clink); Psize = Lcell->S3 >> 16; Pnam = Lcell->S2; Pxtra = Pnam >> 16; Pnam = Pnam & 0xFFF; Ptype = Lcell->S1; P = Pp + 2; Pp = P + A(P); P = P + 1; Rout = Ptype >> 12; Nam = Ptype >> 8 & 15; Arr = Ptype >> 4 & 15; Type = Ptype & 15; Ii = Type; Alt = A(P); if (Psize <= 0 && (((Rout | Arr) != 0 && Alt != 2) || (Type == 5 && Alt > 2) || (Nam == 2 && Alt != 2) || ((Ptype & 0xF0F0) != 0 && Type <= 2 && (Alt == 1 || Alt > 3)) || ((Ptype & 0xF0FF) == 3 && (Alt & 1) == 1) || ((Ptype & 0xF0FF) <= 2 && (Alt == 1 || Alt >= 4)))) { Fault(22, Pnam); goto Nextparm; } if (Rout == 1) { Ii = Ptype; P = P + 1; Cname(13, Accr); if (Ptype >> 12 != 0 && ((Ii & 15) != (Ptype & 15) || Checkfprocs(K, Pxtra) != 0)) Fault(21, Pnam); P = P + 1; Moveptr = Moveptr + 4; Stuff: Register(Accr) = 3; goto Nextparm; } if (Arr == 0 && (Nam == 2 || (Nam == 3 && Alt == 2))) { P = P + 1; Cname(3, Accr); if (Ii != (Ptype & 7) || (Ptype & 0xF00) != 0) Fault(22, Pnam); Moveptr = Moveptr + 2; goto Stuff; } if (Psize > 0) { Gthunks(Ptype, Pnam); Moveptr = Moveptr + 2; goto Stuff; } if (Arr == 1) { Iii = Nam; if (A(P) == 2 && A(P + 2) == 3) { P = P + 1; Cname(12, Accr); Type = Ptype & 7; if ((Ptype & 0xF0) == 0) Fault(22, Pnam); if (Iii == 3) Jj = 2; else Jj = 4; Getinacc(Accr, Jj, 0, Areacode, Disp); if (Arr != 0 && (Ii == 0 || Ii == Type || (Iii == 0 && Ii != 3 && 3 != Type))) { if (Ii != 0) { if (Pxtra == 0) { Pxtra = J; Lcell->S2 = Pxtra << 16 | Pnam; } if (J == 0) { Fname = A(P - 2); J = Pxtra; Ii = Tags(Fname); Aslist(Ii).S1 = (Aslist(Ii).S1 | Pxtra); } if (0 != J && J != Pxtra && Iii != 3) Fault(20, Pnam); } Moveptr = Moveptr + Jj; goto Stuff; } } Fault(22, Pnam); goto Nextparm; } if (Type == 5) { Fetchstring(Accr); if (Type != 5) Fault(22, Pnam); Moveptr = Moveptr + 2; goto Stuff; } if (Type <= 3) { P = P + 1; Iii = Nam; Csexp(Accr, Type, Alt); Jj = Bytes(Ii) >> 2; if (Iii == 0) Moveptr = Moveptr + Jj; else { Getwsp(Iii, Jj); Psf1(St, 1, Iii); Psf1(Lss, 0, Iii); Psf1(Iad, 1, Ptroffset(Rlevel)); Pf1(Luh, 0, Pc, Paramdes(Ii)); Gruse(Accr) = 0; Moveptr = Moveptr + 2; } goto Stuff; } goto Nextparm; Entryseq:; if (Register(Accr) == 3) { Plant(0x4998); Register(Accr) = 0; } Ptype = Pt; J = Jjj; if (Jjj == 14) { Ii = Setxorynb(-1, -1); Psf1(Raln, 0, Moveptr); Pf1(Call, 2, Ii, Rdisp); } else if ((Ptype & 0x100) == 0) if (Lp == 0) { Plant(0x7883); if (Rdisp != 0) Psf1(Inca, 0, Rdisp); Psf1(Raln, 0, Moveptr); Plant(0x1FDC); } else { Ii = Setxorynb(Xnb, Lp); Psf1(Raln, 0, Moveptr); Rtjump(Call, Aslist(Dlink).S1); } else { Area = -1; Base = Lp; Area = Areacode; Getinacc(Dr, 2, 0, Area, Rdisp); Psorlf1(Lb, 0, Area, Rdisp + 12); Psorlf1(Lss, 0, Area, Rdisp + 8); Psf1(Raln, 0, Moveptr); Ppj(0, 17); Plant(0x1FDC); } #if 1 /* Includehandcode==No */ for (Ii = 0; Ii <= 7; Ii++) Gruse(Ii) = 0; #else { asm("LSQ 0"); asm("LCT GRUSE+4"); asm("ST (%CTB+0)"); asm("ST (%CTB+4)"); } #endif } void Skipexp(int Mode) { int Alt; int Pin; Pin = P; Alt = A(P); P = P + 1; if (Alt == 2) Skipsexp(Mode); else { Skipexp(1); Skipsexp(Mode); Skipexp(Mode); } } void Skipsexp(int Mode) { int Bop; int Pin; int J; static int Alt_sw; static void *Alt[8 /*1:8*/] = { &&Alt_1, &&Alt_2, &&Alt_3, &&Alt_default, &&Alt_5, &&Alt_6, &&Alt_7, &&Alt_8, }; Pin = P; do { Bop = A(P + 2); P = P + 3; goto *Alt[Alt_sw = (Bop + (Mode << 2)) - 1]; Alt_1:; Alt_6:; P = P + 1; Skipapp(); goto End; Alt_2:; P = P + A(P) + 1; goto End; Alt_7:; P = P + 1; goto End; Alt_3:; Alt_8:; Skipexp(Mode); goto End; Alt_5:; Skipexp(0); P = P + 1; Skipexp(0); End:; Bop = A(P); if (Mode != 0) P = P + 1; } while (Bop == 1); if (Mode == 0) P = P + 1; goto Alt_skip; Alt_default: fprintf(stderr, "Switch label 'Alt(%d):' not set in %s", Alt_sw + 1, __PRETTY_FUNCTION__); exit(1) /* or %signal ... */; Alt_skip:; } void Skipapp(void) { int Alt; int Pin; Pin = P; Alt = A(P); if (Alt != 3) if (Alt == 2) { P = P + 1 + A(P + 1); while (A(P) == 1) P = A(P + 2) + P + 2; } else while (A(P) == 1) { P = P + 1; P = P + A(P); } P = P + 1; } void Testapp(int Num) { int Pp; int Q; Q = 0; Pp = P; P = P + 1; if (A(P) == 2) { Q = 1; P = P + 1 + A(P + 1); while (A(P) == 1) { Q = Q + 1; P = P + 2 + A(P + 2); } } else while (A(P) == 1) { P = P + 1; Q = Q + 1; P = P + A(P); } P = Pp; Num = Q; } void Testass(int Reg) { int Opcode; if (Reg == Breg) Opcode = Cpb; else Opcode = Ucp; Pf1(Opcode, 0, Pc, Plabs(1)); Pconst(Jcc << 24 | 8 << 21 | ((Plabs(5) - Ca) / 2) & 0x3FFFF); } void Cbpair(int Lb, int Ub) { int Kk; int Kkk; int Jj; int Bp; P = P + 1; Kk = 0; for (Jj = 1; Jj <= 2; Jj++) { Kkk = Kk; if (A(P) == 2) Kk = -1; else Kk = 1; Bp = A(P + 2); Kk = Kk * Bp; P = P + 3; } if (Kkk > Kk) { Fault(43, 0); Kk = Kkk; } Lb = Kkk; Ub = Kk; } void Getwsp(int Place, int Size) { int J; int K; int L; if (Size > 4) Size = 0; Pop(Avlwsp(Size, Level), J, K, L); if (K <= 0) { if (Size > 1 && (N & 7) == 0) Oddalign(); K = N; if (Size == 0) N = N + 268; else N = N + (Size << 2); } Place = K; if (Size != 0) Push(Twsphead, K, Size, 0); } void Returnwsp(int Place, int Size) { if (Size > 4) Size = 0; Push(Avlwsp(Size, Level), 0, Place, 0); } void Setline(void) { Pconst(0x63800000 | Line); Psf1(St, 1, Diaginf(Level) + 4); Gruse(Accr) = 5; Grinf(Accr) = Line; } void Setuse(int R, int U, int I) { Gruse(R) = U; Grinf(R) = I; Grat(R) = Ca; } void Saveirs(void) { if (Register(Breg) >= 1) Bootout(Breg); if (Register(Accr) >= 1) Bootout(Accr); if (Register(Dr) >= 1) Bootout(Dr); } void Bootout(int Reg) { const unsigned char Bootcode[8 /*0:7*/] = {0x48, 0x58, 0x5C, [3 ... 6] = 0, 0x5A}; int Code; int Rr; Rd *R; Code = Bootcode(Reg); Rr = Register(Reg); R = Record(Olink(Reg)); if (Rr == 2) { if (R->D == 0) Getwsp(R->D, Bytes(R->Ptype & 7) >> 2); Psf1(Code, 1, R->D); R->Flag = 7; R->Xb = Lnb << 4; } else { if (Reg != Accr && (Register(Accr) == 1 || Register(Accr) == 3)) Bootout(Accr); Plant(Code << 8 | 0x198); if (Rr == 1) { R->Flag = 8; R->Xb = Tos << 4; } } Register(Reg) = 0; } void Copydr(void) { if (Register(Accr) != 0) Bootout(Accr); Psf1(Cyd, 0, 0); Gruse(Accr) = 0; } void Changerd(int Reg) { int I; int Rr; Rd Nameopnd; Rr = Register(Reg); Opnd = Record(Olink(Reg)); if (Rr == 1) { Opnd.Flag = 8; Opnd.Xb = Tos << 4; } if (Rr == 2) { Opnd.Flag = 7; Opnd.Xb = Lnb << 4; } } void Storetag(int Kk, int Slink) { int Q; int Qq; int Qqq; int I; Listf *Lcell; Q = Tags(Kk); if ((Aslist(Q).S1 >> 8 & 63) == Level) Fault(7, Kk); else { Q = Ptype << 16 | Level << 8 | Rlevel << 4 | J; Qqq = Slink << 16 | Kform; Qq = Sndisp << 16 | Acc; I = Asl; if (I == 0) I = Morespace; Lcell = &Aslist(I); Asl = Lcell->Link; Lcell->Link = Tags(Kk) | Names(Level) << 18; Lcell->S1 = Q; Lcell->S2 = Qq; Lcell->S3 = Qqq; Tags(Kk) = I; Names(Level) = Kk; } } void Copytag(int Kk) { int Qq; int Qqq; Listf *Lcell; Tcell = Tags(Kk); if (Tcell == 0) { Type = 7; Ptype = 7; Rout = 0; Nam = 0; Arr = 0; Acc = 4; I = -1; J = -1; K = -1; Oldi = -1; Kform = 0; Sndisp = 0; } else { Lcell = &Aslist(Tcell); Kk = Lcell->S1; Lcell->S1 = Kk | 0x8000; Qq = Lcell->S2; Qqq = Lcell->S3; Ptype = Kk >> 16; Usebits = Kk >> 14 & 3; Oldi = Kk >> 8 & 63; I = Kk >> 4 & 15; J = Kk & 15; Sndisp = Qq / 0x10000; Acc = Qq & 0xFFFF; K = Qqq / 0x10000; Kform = Qqq & 0xFFFF; Type = Ptype & 15; Arr = Ptype >> 4 & 15; Nam = Ptype >> 8 & 15; Rout = Ptype >> 12; } } void Reducetag(void) { Copytag(A(P)); if (Ptype == Snpt) { Ptype = Tsname(K); Unpack(); Rout = 1; } } void Replacetag(int Kk) { int P; int Q; P = Tags(Kk); Q = Ptype << 16 | Usebits << 14 | Oldi << 8 | I << 4 | J; Aslist(P).S1 = (Q); Aslist(P).S3 = (K << 16 | Kform); } void Unpack(void) { Type = Ptype & 15; Arr = Ptype >> 4 & 15; Nam = Ptype >> 8 & 15; Rout = Ptype >> 12; } void Pack(int Ptype) { Ptype = Rout << 12 | Nam << 8 | Arr << 4 | Type; } void Ppj(int Mask, int N) { int Val; int Instrn; int Code; Code = Ocode(Mask); Instrn = Code << 24; Val = Plabs(N); if (Code > 6) Instrn = Instrn | 3 << 23; else Instrn = Instrn | (Mask & 15) << 21; if (Val > 0) Instrn = Instrn | ((Val - Ca) / 2) & 0x3FFFF; else Push(Plink(N), Ca, Instrn, 0); Pconst(Instrn); if (Code > 6) #if 1 /* Includehandcode==No */ for (Val = 0; Val <= 7; Val++) Gruse(Val) = 0; #else { asm("LSQ 0"); asm("LCT GRUSE+4"); asm("ST (%CTB+0)"); asm("ST (%CTB+4)"); } #endif } int Xorynb(int Use, int Inf) { if (Gruse(Xnb) == Use && Grinf(Xnb) == Inf) { Grat(Xnb) = Ca; return (Xnb); } if (Gruse(Ctb) == Use && Grinf(Ctb) == Inf) { Grat(Ctb) = Ca; return (Ctb); } if ((Gruse(Xnb) | Gruse(Ctb)) == 0) { if (Use == 3) return (Ctb); return (Xnb); } if (Gruse(Xnb) == 0) return (Xnb); if (Gruse(Ctb) == 0) return (Ctb); if (Grat(Xnb) < Grat(Ctb)) return (Xnb); return (Ctb); } int Setxorynb(int Which, int Rlev) { int Use; int Inf; int Offset; if (-1 > Rlev || Rlev > Rlevel) Abort(); if (Rlev <= 0) { Use = 3; Inf = 0; } else { Use = 4; Inf = Rlev; } if (Which <= 0) Which = Xorynb(Use, Inf); if (Gruse(Which) == Use && Grinf(Which) == Inf) { Grat(Which) = Ca; return (Which); } Offset = Ptroffset(Rlev); Psf1(Ldcode(Which), 1, Offset); Gruse(Which) = Use; Grinf(Which) = Inf; Grat(Which) = Ca; return (Which); } void Oddalign(void) { if ((N & 7) == 0) { Returnwsp(N, 1); N = N + 4; } } int Ptroffset(int Rlev) { if (Rlev <= 0) return (16); return (Display(Rlevel) + ((Rlev - 1) << 2)); } int Areacode(void) { if (Area < 0) { if (Base == Rlevel) { Area = Lnb; return (Lnb); } Area = Setxorynb(-1, Base); } return (Area); } void Noteassment(int Reg, int Var) { int I; int Nam; I = Tags(Var); Nam = Aslist(I).S1 >> 24 & 15; for (I = 0; I <= 7; I += 7) if (Gruse(I) == 9 && (Grinf(I) == Var || Nam != 0)) Gruse(I) = 0; if (Nam == 0 && Gruse(Reg) <= 3) { Gruse(Reg) = 9; Grinf(Reg) = Var; } } void Getinacc(int Reg, int Size, int Access, int Area, int Disp) { int Opcode; const int Getcode[8 /*0:7*/] = {0x62, 0x76, [2 ... 6] = 0, 0x7A}; Opcode = Getcode(Reg) + (Size & 6); if (Register(Reg) > 0) if (Register(Reg) == 2) Bootout(Reg); else { if (Reg != Accr && (Register(Accr) == 1 || Register(Accr) == 3)) Bootout(Accr); Changerd(Reg); Register(Reg) = 0; if (Reg == Accr) Opcode = Opcode - 32; else Opcode = Opcode - 40; } Psorlf1(Opcode, Access, Area, Disp); if (Access >= 2) Gruse(Dr) = 0; Gruse(Reg) = 0; } } #if 1 /* Allowcodelist==Yes */ void Printuse(void) { const _imp_string255 Regs[8 /*0:7*/] = { _imp_str_literal("ACC"), _imp_str_literal(" DR"), _imp_str_literal("LNB"), _imp_str_literal("XNB"), _imp_str_literal(" PC"), _imp_str_literal("LTB"), _imp_str_literal("TOS"), _imp_str_literal(" B")}; const _imp_string255 Uses[16 /*0:15*/] = { _imp_str_literal(" NOT KNOWN "), _imp_str_literal(" I-RESULT "), _imp_str_literal(" TEMPORARY "), _imp_str_literal(" PLTBASE "), _imp_str_literal(" NAMEBASE "), _imp_str_literal(" LIT CONST "), _imp_str_literal(" TAB CONST "), _imp_str_literal(" DESC FOR "), _imp_str_literal(" RECD BASE "), _imp_str_literal(" LOCAL VAR "), _imp_str_literal(" FN RESULT "), [11 ... 13] = _imp_str_literal(" ??? "), _imp_str_literal(" SST BASE "), _imp_str_literal(" RT PARAM ")}; const _imp_string255 State[5 /*-1:3*/] = { _imp_str_literal(" LOCKED "), _imp_str_literal(" FREE "), _imp_str_literal(" I-RESULT "), _imp_str_literal(" TEMPORARY "), _imp_str_literal(" RT-PARAM ")}; int I; for (I = 0; I <= 7; I++) if ((Register(I) | Gruse(I)) != 0) { Printstring(_imp_join(Regs(I), _imp_join(State(Register(I)), _imp_join(_imp_str_literal(" USE = "), Uses(Gruse(I)))))); if (7 <= Gruse(I) && Gruse(I) <= 10) Printname(Grinf(I)); else Write(Grinf(I), 1); Newline(); } } #endif } void Message(int N) { const unsigned char Word[266 /*0:265*/] = { 0, 2, 1, 2, 4, 5, 4, 6, 7, 8, 4, 5, 1, 7, 9, 10, 7, 7, 4, 5, 0, 8, 12, 7, 9, 14, 9, 12, 16, 18, 0, 10, 16, 21, 23, 0, 11, 1, 8, 4, 0, 12, 1, 8, 25, 0, 14, 27, 28, 29, 0, 15, 30, 29, 0, 0, 16, 7, 8, 4, 0, 17, 8, 32, 7, 0, 18, 34, 35, 36, 37, 19, 34, 35, 36, 39, 20, 41, 43, 34, 44, 21, 41, 32, 8, 46, 22, 47, 16, 8, 48, 23, 32, 7, 9, 10, 24, 50, 9, 52, 10, 25, 54, 50, 55, 0, 26, 57, 58, 8, 60, 27, 62, 9, 43, 63, 29, 12, 7, 9, 64, 34, 27, 28, 67, 0, 35, 27, 28, 32, 67, 37, 43, 27, 28, 68, 40, 70, 71, 0, 0, 42, 52, 50, 9, 10, 43, 43, 73, 74, 0, 47, 75, 77, 0, 0, 48, 78, 79, 9, 80, 57, 81, 30, 0, 0, 71, 82, 84, 0, 0, 72, 7, 8, 9, 85, 73, 87, 82, 0, 0, 74, 7, 89, 9, 85, 75, 91, 93, 95, 0, 76, 82, 96, 0, 0, 77, 60, 98, 27, 100, 78, 101, 98, 27, 100, 79, 70, 71, 0, 0, 80, 102, 103, 0, 0, 98, 105, 0, 0, 0, 99, 105, 0, 0, 0, 102, 108, 27, 110, 0, 103, 111, 27, 112, 0, 104, 27, 28, 111, 0, 105, 113, 115, 116, 32, 106, 118, 119, 27, 112, 107, 120, 121, 0, 0, 108, 27, 28, 67, 0, 127, 122, 0, 0, 0}; const int Lett[125 /*0:124*/] = { 0, 0x30222B00, 0x25D60B13, 0x13EF9000, 0x4CB40000, 0x52E91940, 0x4EE9A0D0, 0x382D2800, 0x39F40000, 0x25C00000, 0x171094E7, 0x38000000, 0x25D60B13, 0x10000000, 0x582CA97F, 0x3133A000, 0x40320B4B, 0x50B20000, 0x4E051A4D, 0x2461A25F, 0x38000000, 0x25C37CA5, 0x14746640, 0x4E051A4D, 0x24A40000, 0x04632CE7, 0x244C2800, 0x51EF0000, 0x342EC800, 0x15C49800, 0x35339A5D, 0x1C000000, 0x424F1949, 0x56450000, 0x5E4F71C0, 0x39E00000, 0x3CC00000, 0x4EA298E5, 0x26149800, 0x40320B4B, 0x50B29800, 0x40320B4B, 0x52491800, 0x06520E40, 0x112D2BA7, 0x25EE0000, 0x582C4900, 0x0474A858, 0x40B26A69, 0x50A40000, 0x58324845, 0x30A00000, 0x09EF6143, 0x38000000, 0x19F20000, 0x25C37CA5, 0x14740000, 0x11360000, 0x3E05905D, 0x12600000, 0x25D429CB, 0x48000000, 0x31E30B00, 0x09F57100, 0x30A6A403, 0x4A9F6267, 0x50000000, 0x30B62B26, 0x112D2BA7, 0x25EE9800, 0x10A36380, 0x35338303, 0x0CA40000, 0x25D3490A, 0x3EB40000, 0x258C29C3, 0x30000000, 0x15932800, 0x4EA20000, 0x0D019000, 0x4E8D7500, 0x08A74B80, 0x55C118CB, 0x4281130A, 0x4F2D13D8, 0x1123A25F, 0x3832C800, 0x4EA298E5, 0x26140000, 0x05922849, 0x64000000, 0x4E15925F, 0x56600000, 0x10A34B43, 0x30000000, 0x41E97500, 0x17107B8B, 0x3A800000, 0x0DEE9D03, 0x3A800000, 0x30323940, 0x48A16000, 0x53302800, 0x35336869, 0x0D000000, 0x04849167, 0x4C224B13, 0x53200000, 0x5DF25993, 0x30A00000, 0x4DA16300, 0x382D2CC0, 0x31EE3800, 0x424F3C83, 0x34000000, 0x5D344000, 0x17142C9D, 0x05800000, 0x4E924B8E, 0x0DEE9D00, 0x066C0000, 0x15B0A640, 0x4CA5F859, 0x1DECFB43, 0x3AA16000}; int I; int J; int K; int M; int Q; int S; Printstring(_imp_str_literal(" (")); I = -4; do I = I + 5; while (N != Word(I) && I != 261); for (J = 1; J <= 4; J++) { K = Word(I + J); if (K == 0) break; if (J != 1) Space(); do { M = Lett(K); S = 26; do { Q = M >> S & 31; if (Q == 31) Q = -32; if (Q != 0) Printsymbol(Q + 64); S = S - 5; } while (S >= 0); K = K + 1; } while ((M & 1) != 0); } Printstring(_imp_str_literal(") ")); } void Fault(int N, int Fname) { int I; int J; int Qp; Qp = Q; Newline(); #if 0 /* Vmeb==Yes */ Faultmk(2); #endif if (N == 100) { while (Cclines(Line + 1) <= Qmax) Line = Line + 1; Printstring(_imp_str_literal("* FAILED TO ANALYSE LINE ")); Write(Line, 2); if (Fname != 0) Message(Fname + 70); Newline(); Spaces(5); Faulty = Faulty + 1; T = 0; J = 0; S = 0; do { I = J; J = Cc(Q); if (J > 128 && I < 128) { Space(); Printsymbol(Kychar1); T = T + 2; } if (I > 128 && J < 128) { Printsymbol(Kychar2); T = T + 1; } T = T + 1; if (Q == Qmax) { S = T; if (S >= 115) Printsymbol('!'); } Printsymbol(J); Q = Q + 1; } while ((J != ';' || Q <= Qmax) && Q != Length && (Cc(Q) != 'E' + 128 || Cc(Q + 1) != 'N' + 128 || Cc(Q + 2) != 'D' + 128) && (Cc(Q) != 'B' + 128 || Cc(Q + 1) != 'E' + 128 || Cc(Q + 2) != 'G' + 128 || Cc(Q + 3) != 'I' + 128 || Cc(Q + 4) != 'N' + 128 || Q <= Qmax)); if (I > 128) { Printsymbol(Kychar2); T = T + 1; } if (Q == Qmax) S = T + 1; if (S < 115) { Newline(); Spaces(S + 4); Printsymbol('!'); } Newline(); } else { Printstring(_imp_str_literal("*")); Write(Line, 4); I = 3; if (List == 0) I = 3 * Level; Spaces(I); Parmopt = 1; Faulty = Faulty + 1; Inhcode = 1; Printstring(_imp_str_literal("FAULT")); Write(N, 2); Message(N); if (N > 100) { Printstring(_imp_str_literal(" DISASTER\n\n")); exit(0); } if (Fname != 0) Printname(Fname); } #if 0 /* Vmeb==Yes */ { Newline();Faultmk(1); } #elif /* Ttoput>=0 */ { Q = Qp; Selectoutput(Ttoput); Ttoput = Ttoput | 0x80000000; Fault(N, Fname); Faulty = Faulty - 1; Newline(); Selectoutput(82); Ttoput = Ttoput & 0xFFFF; } } void Warn(int N, int V) { const _imp_string255 Mess[5 /*1:5*/] = { _imp_str_literal(" KEYWORD IN COMMENT"), _imp_str_literal(" NAME ? NOT USED "), _imp_str_literal(" LAB ? PASSED BY NAME!"), _imp_str_literal(" DUMMY STMNT COMPILED"), _imp_str_literal(" STRING CNST TRUNCATED")}; _imp_string255 T; _imp_string255 S; if (_imp_cond_resolve(Mess(N), S, _imp_str_literal("?"), T)) S = _imp_join(S, _imp_join(String(Dictbase + Wrd(V)), T)); else S = Mess(N); Printstring(_imp_join(_imp_str_literal("\n? WARNING :- "), _imp_join(S, _imp_str_literal(" AT LINE NO")))); Write(Line, 1); } void Printname(int N) { int V; int K; Space(); V = Wrd(N); K = *Byteinteger(Dictbase + V); if (K == 0) Printstring(_imp_str_literal("???")); else Printstring(*String(Dictbase + V)); } void Prhex(int Value, int Places) { const unsigned char Hex[16 /*0:15*/] = {'0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F'}; int I; for (I = (Places << 2) - 4; I >= 0; I -= 4) Printsymbol(Hex(Value >> I & 15)); } int Morespace(void) { int I; int N; N = Aslcurbtm - 1; Aslcurbtm = Aslcurbtm - (Nnames + 1) / 8; if (Aslcurbtm <= 1) Aslcurbtm = 1; Constlimit = 4 * Aslcurbtm - 8; if (Aslcurbtm >= N || Constptr > Constlimit) Fault(107, 0); for (I = Aslcurbtm; I <= N - 1; I++) Aslist(I + 1).Link = I; Aslist(Aslcurbtm).Link = 0; Asl = N; return (N); } void Push(int Cell, int S1, int S2, int S3) { Listf *Lcell; int I; I = Asl; if (I == 0) I = Morespace; #if 1 /* Includehandcode==No */ { Lcell = &Aslist(I); Asl = Lcell->Link; Lcell->Link = Cell; Cell = I; Lcell->S1 = S1; Lcell->S2 = S2; Lcell->S3 = S3; } #else { asm("LB I"); asm("MYB 16"); asm("ADB ASLIST+4"); asm("LCT %B"); asm("LSS (%CTB+3)"); asm("ST ASL"); asm("LB I"); asm("LSS (CELL)"); asm("STB (%DR)"); asm("LUH S3"); asm("LUH S1"); asm("ST (%CTB+0)"); } #endif } void Pop(int Cell, int S1, int S2, int S3) { Listf *Lcell; int I; #if 1 /* Includehandcode==No */ { I = Cell; Lcell = &Aslist(I); S1 = Lcell->S1; S2 = Lcell->S2; S3 = Lcell->S3; if (I != 0) { Cell = Lcell->Link; Lcell->Link = Asl; Asl = I; } } #else { asm("LB (CELL)"); asm("STB I"); asm("MYB 16"); asm("ADB ASLIST+4"); asm("LCT %B"); asm("LSD (%CTB+0)"); asm("STUH (S1)"); asm("LB I"); asm("ST (S2)"); asm("LSD (%CTB+2)"); asm("STUH (S3)"); asm("JAT 12,"); asm("ST (CELL)"); asm("LSS ASL"); asm("ST (%CTB+3)"); asm("STB ASL"); } #endif End:; } void Binsert(int Top, int Bot, int S1, int S2, int S3) { int I; Listf *Lcell; I = Asl; if (I == 0) I = Morespace; Lcell = &Aslist(I); Asl = Lcell->Link; Lcell->S1 = S1; Lcell->S2 = S2; Lcell->S3 = S3; Lcell->Link = 0; J = Bot; if (J == 0) { Bot = I; Top = Bot; } else { Aslist(J).Link = I; Bot = I; } } void Mlink(int Cell) { Cell = Aslist(Cell).Link; } int Find(int Lab, int List) { while (List != 0) { if (Lab == Aslist(List).S2) return (List); List = Aslist(List).Link; } return (-1); } void From123(int Cell, int S1, int S2, int S3) { Listf *Lcell; Lcell = &Aslist(Cell); S1 = Lcell->S1; S2 = Lcell->S2; S3 = Lcell->S3; } void Clearlist(int Ophead) { int I; int J; I = Ophead; J = I; while (I != 0) { J = I; I = Aslist(J).Link; } if (J != 0) { Aslist(J).Link = Asl; Asl = Ophead; Ophead = 0; } } exit(0); return (1); }