#include int _imp_mainep(int _imp_argc, char **_imp_argv) { const int RELEASE = 10; const int YES = 1; const int NO = 0; const int USEIMP = YES; const int VMEB = NO; const _imp_string LADATE = "28 Jan 81"; // LASTALTERED int I; int J; int K; // PRODUCEDBYOLDPSFROMNRIMPPS8ON16/12/80 const char CLETT[(500) + 1] = 1, 43, 1, 45, 1, 40, 1, 41, 1, 44, 2, 201, 198, 6, 213, 206, 204, 197, 211, 211, 5, 215, 200, 201, 204, 197, 5, 213, 206, 212, 201, 204, 3, 198, 207, 210, 1, 61, 4, 210, 197, 193, 204, 7, 201, 206, 212, 197, 199, 197, 210, 8, 204, 207, 206, 199, 210, 197, 193, 204, 4, 204, 207, 206, 199, 11, 194, 217, 212, 197, 201, 206, 212, 197, 199, 197, 210, 6, 211, 212, 210, 201, 206, 199, 11, 200, 193, 204, 198, 201, 206, 212, 197, 199, 197, 210, 7, 210, 207, 213, 212, 201, 206, 197, 2, 198, 206, 3, 205, 193, 208, 8, 198, 213, 206, 195, 212, 201, 207, 206, 6, 210, 197, 195, 207, 210, 196, 4, 206, 193, 205, 197, 5, 193, 210, 210, 193, 217, 9, 193, 210, 210, 193, 217, 206, 193, 205, 197, 9, 207, 198, 208, 210, 207, 199, 210, 193, 205, 6, 207, 198, 198, 201, 204, 197, 6, 207, 198, 204, 201, 211, 212, 6, 198, 207, 210, 205, 193, 212, 4, 211, 208, 197, 195, 3, 206, 207, 212, 3, 193, 206, 196, 2, 207, 210, 1, 58, 6, 206, 207, 210, 205, 193, 204, 3, 207, 215, 206, 8, 197, 216, 212, 197, 210, 206, 193, 204, 9, 197, 216, 212, 210, 201, 206, 211, 201, 195, 8, 195, 207, 206, 211, 212, 193, 206, 212, 5, 195, 207, 206, 211, 212, 5, 197, 214, 197, 206, 212, 5, 211, 212, 193, 210, 212, 9, 212, 200, 197, 206, 211, 212, 193, 210, 212, 4, 212, 200, 197, 206, 9, 197, 204, 211, 197, 211, 212, 193, 210, 212, 4, 197, 204, 211, 197, 1, 95, 6, 211, 217, 211, 212, 197, 205, 7, 196, 217, 206, 193, 205, 201, 195, 2, 42, 61, 1, 42, 4, 80, 85, 84, 95, 5, 67, 78, 79, 80, 95, 2, 204, 61, 1, 60, 1, 62, 4, 40, 196, 210, 43, 2, 196, 210, 1, 194, 3, 212, 207, 211, 3, 204, 206, 194, 3, 216, 206, 194, 2, 208, 195, 3, 195, 212, 194, 2, 45, 62, 6, 210, 197, 212, 213, 210, 206, 6, 210, 197, 211, 213, 204, 212, 7, 205, 207, 206, 201, 212, 207, 210, 4, 211, 212, 207, 208, 6, 211, 201, 199, 206, 193, 204, 4, 197, 216, 201, 212, 8, 195, 207, 206, 212, 201, 206, 213, 197, 6, 198, 201, 206, 201, 211, 200, 5, 195, 217, 195, 204, 197, 6, 210, 197, 208, 197, 193, 212, 3, 197, 206, 196, 5, 210, 197, 193, 204, 211, 5, 194, 197, 199, 201, 206, 2, 207, 206, 6, 211, 215, 201, 212, 195, 200, 4, 204, 201, 211, 212, 7, 211, 208, 197, 195, 201, 193, 204, 14, 212, 210, 213, 211, 212, 197, 196, 208, 210, 207, 199, 210, 193, 205, 6, 205, 193, 201, 206, 197, 208, 7, 195, 207, 206, 212, 210, 207, 204, 7, 201, 206, 195, 204, 213, 196, 197; const int SYMBOL[(2213) - (1300) + 1] = 1307, 1303, 0, 1305, 2, 1307, 1000, 1319, 1312, 1001, 1357, 1824, 1315, 1003, 1020, 1319, 4, 1336, 6, 1329, 1323, 1001, 1014, 1325, 1003, 1329, 4, 1329, 6, 1336, 1336, 1010, 1028, 1319, 1011, 1350, 1343, 1343, 1010, 1028, 1307, 1011, 1343, 1350, 1348, 1026, 1307, 999, 1350, 1000, 1357, 1355, 1026, 1319, 999, 1357, 1000, 1365, 1363, 4, 1336, 1365, 6, 1365, 1000, 1372, 1370, 8, 1336, 999, 1372, 1000, 1377, 1375, 10, 1377, 13, 1401, 1384, 20, 1010, 1542, 1562, 1011, 1390, 26, 1010, 1542, 1562, 1011, 1401, 32, 1010, 1001, 36, 1336, 8, 1336, 8, 1336, 1011, 1408, 1406, 8, 1001, 999, 1408, 1000, 1415, 1411, 38, 1413, 43, 1415, 51, 1430, 1418, 43, 1420, 38, 1423, 60, 1408, 1425, 65, 1428, 77, 1925, 1430, 84, 1437, 1433, 96, 1437, 1031, 1415, 1437, 1444, 1440, 104, 1442, 107, 1444, 111, 1466, 1450, 1415, 1476, 1001, 1401, 1456, 120, 1466, 127, 1001, 1401, 1462, 1430, 1471, 1001, 1401, 1483, 1466, 127, 1001, 1401, 1471, 1469, 132, 1471, 1000, 1476, 1474, 127, 1476, 1000, 1483, 1479, 138, 1481, 127, 1483, 1000, 1493, 1491, 4, 1010, 1444, 1011, 1493, 6, 1493, 1000, 1502, 1500, 1030, 1010, 1444, 1011, 999, 1502, 1000, 1513, 1506, 148, 1016, 1508, 158, 1511, 165, 1018, 1513, 1016, 1518, 1516, 172, 1518, 1000, 1542, 1526, 172, 1001, 4, 1876, 1869, 6, 1535, 179, 1010, 1001, 1818, 1011, 4, 1001, 6, 1542, 1010, 1615, 1011, 4, 1001, 6, 1556, 1548, 1336, 1032, 1336, 1556, 1553, 4, 1542, 1562, 6, 1556, 184, 1542, 1562, 1560, 1037, 1336, 1562, 1000, 1573, 1567, 188, 1542, 1573, 1571, 192, 1542, 1580, 1573, 1000, 1580, 1578, 188, 1542, 999, 1580, 1000, 1587, 1585, 192, 1542, 999, 1587, 1000, 1595, 1591, 1033, 1336, 1593, 195, 1595, 1000, 1601, 1599, 179, 1008, 1601, 1015, 1606, 1604, 60, 1606, 197, 1615, 1613, 8, 1336, 195, 1336, 1606, 1615, 1000, 1624, 1620, 1476, 1001, 1401, 1624, 132, 1513, 1624, 1630, 1630, 1001, 1401, 1832, 1630, 1636, 1634, 8, 1624, 1636, 1000, 1652, 1646, 1476, 1010, 1001, 1401, 1840, 1011, 1652, 1006, 1652, 132, 1513, 1001, 1832, 1701, 1663, 1661, 8, 1010, 1001, 1401, 1840, 1011, 1652, 1663, 1000, 1674, 1666, 204, 1668, 208, 1670, 217, 1672, 227, 1674, 236, 1701, 1678, 1415, 1636, 1689, 120, 1476, 1010, 1001, 1401, 1011, 4, 1001, 6, 1006, 1701, 120, 132, 1513, 1010, 1001, 1832, 1011, 4, 1001, 6, 1006, 1711, 1709, 36, 1028, 1319, 1350, 1722, 1711, 1711, 1000, 1722, 1720, 8, 1012, 1028, 1319, 1350, 1722, 999, 1722, 1000, 1731, 1729, 4, 1028, 1319, 1350, 6, 1731, 1000, 1738, 1736, 8, 1009, 999, 1738, 1000, 1743, 1741, 242, 1743, 1000, 1749, 1747, 8, 1336, 1749, 1000, 1762, 1760, 8, 1001, 1401, 4, 1336, 195, 1336, 6, 999, 1762, 1000, 1769, 1767, 26, 1542, 1562, 1769, 1000, 1782, 1772, 1019, 1774, 1006, 1779, 1372, 1542, 1562, 1006, 1782, 1377, 1006, 1795, 1786, 248, 1034, 1789, 254, 1034, 1795, 264, 1010, 2060, 1011, 1801, 1801, 1799, 188, 2060, 1801, 1000, 1818, 1805, 269, 1034, 1813, 279, 1372, 1010, 1542, 1562, 1011, 1782, 1816, 279, 2060, 1818, 1000, 1824, 1822, 284, 1001, 1824, 1000, 1832, 1830, 284, 1001, 1357, 1824, 1832, 1000, 1840, 1840, 4, 1336, 195, 1336, 1606, 6, 1848, 1846, 36, 1028, 1319, 1350, 1848, 1000, 1858, 1852, 286, 1013, 1854, 208, 1856, 293, 1858, 1000, 1869, 1867, 1001, 36, 1336, 8, 1336, 8, 1336, 1869, 1000, 1876, 1874, 8, 1876, 999, 1876, 1000, 1916, 1882, 1415, 1476, 1001, 1401, 1889, 1415, 132, 1001, 1401, 1832, 1916, 1895, 120, 1466, 127, 1001, 1401, 1904, 120, 1010, 1001, 1401, 1011, 4, 1001, 6, 1916, 120, 132, 1010, 1001, 1401, 1832, 1916, 1011, 4, 1001, 6, 1925, 1923, 8, 1001, 1401, 1832, 999, 1925, 1000, 1932, 1930, 4, 1009, 6, 1932, 1000, 1950, 1936, 301, 1001, 1939, 304, 1001, 1942, 306, 1002, 1945, 1022, 1950, 1950, 311, 1009, 8, 1009, 1964, 1954, 1023, 1964, 1959, 1024, 317, 2003, 2008, 1964, 1025, 1005, 8, 1987, 1987, 1969, 320, 1001, 322, 1971, 2036, 1976, 4, 2036, 2025, 6, 1980, 324, 2036, 6, 1985, 4, 329, 2025, 6, 1987, 332, 2003, 1992, 320, 1001, 322, 1994, 2036, 1999, 4, 329, 2025, 6, 2003, 324, 1005, 6, 2008, 2006, 329, 2008, 1005, 2016, 2014, 8, 1005, 8, 1005, 2016, 1000, 2025, 2020, 0, 1005, 2023, 2, 1005, 2025, 1000, 2031, 2029, 0, 332, 2031, 1000, 2036, 2034, 36, 2036, 1000, 2051, 2041, 2031, 1300, 1003, 2044, 1001, 2016, 2049, 4, 2051, 2016, 6, 2051, 334, 2060, 2054, 338, 2056, 342, 2058, 346, 2060, 349, 2093, 2069, 1010, 1001, 1357, 1824, 1011, 1587, 1795, 2073, 353, 1001, 1357, 2075, 356, 2079, 363, 1033, 1336, 2082, 370, 1795, 2084, 378, 2089, 383, 1738, 1009, 1743, 2091, 390, 2093, 395, 2214, 2100, 1027, 1010, 2060, 1011, 1769, 2102, 1007, 2110, 1372, 1010, 1542, 1562, 1011, 1782, 1006, 2115, 404, 1035, 1801, 1006, 2120, 411, 1029, 1858, 1006, 2125, 417, 1036, 1762, 1006, 2130, 1377, 411, 1029, 1006, 2136, 1031, 1008, 1415, 1615, 1006, 2140, 424, 1502, 1006, 2144, 120, 1518, 1006, 2153, 1010, 1848, 1430, 1011, 1595, 1001, 1483, 1006, 2156, 1663, 1674, 2160, 428, 1601, 1006, 2164, 434, 1015, 1006, 2173, 440, 1021, 1738, 1009, 1731, 248, 1034, 1006, 2184, 443, 1001, 1401, 4, 1336, 195, 1336, 6, 1749, 1006, 2188, 450, 1006, 1017, 2193, 455, 127, 1001, 1006, 2197, 304, 1932, 1006, 2200, 463, 1006, 2204, 478, 1001, 1006, 2208, 485, 1003, 1006, 2212, 493, 1003, 1038, 2214, 1006; const int SS = 2093; // const char ITOETAB[(127) + 1] = 0x40, 0x40, 0x40, 0x40, 0x40, 0x40, 0x40, 0x40, 0x40, 0x40, 0x15, 0x40, 0x0C, 0x40, 0x40, 0x40, 0x40, 0x40, 0x40, 0x40, 0x40, 0x40, 0x40, 0x40, 0x40, 0x40, 0x40, 0x40, 0x40, 0x40, 0x40, 0x40, 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, 0x5F, 0x5A, 0x6A, 0x6D, 0x7C, 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, 0x40, 0xD0, 0x40, 0x40; const int OPC[(126) + 1] = 0, ' JCC', ' JAT', ' JAF', [LOW... HIGH] = 0, ' VAL', ' CYD', 'INCA', 'MODD', 'PRCL', ' J', ' JLK', 'CALL', ' ADB', ' SBB', 'DEBJ', ' CPB', ' SIG', ' MYB', ' VMY', 'CPIB', ' LCT', 'MPSR', 'CPSR', 'STCT', 'EXIT', 'ESEX', ' OUT', ' ACT', ' SL', 'SLSS', 'SLSD', 'SLSQ', ' ST', 'STUH', 'STXN', 'IDLE', ' SLD', ' SLB', 'TDEC', 'INCT', ' STD', ' STB', 'STLN', 'STSF', ' L', ' LSS', ' LSD', ' LSQ', 'RRTC', ' LUH', 'RALN', ' ASF', 'LDRL', ' LDA', 'LDTB', ' LDB', ' LD', ' LB', ' LLN', ' LXN', ' TCH', 'ANDS', ' ORS', 'NEQS', 'EXPA', ' AND', ' OR', ' NEQ', ' PK', ' INS', 'SUPK', ' EXP', 'COMA', ' DDV', 'DRDV', 'DMDV', 'SWEQ', 'SWNE', ' CPS', ' TTR', ' FLT', ' IDV', 'IRDV', 'IMDV', ' MVL', ' MV', 'CHOV', ' COM', ' FIX', ' RDV', 'RRDV', 'RDVD', ' UAD', ' USB', 'URSB', ' UCP', ' USH', ' ROT', ' SHS', ' SHZ', ' DAD', ' DSB', 'DRSB', ' DCP', ' DSH', ' DMY', 'DMYD', 'CBIN', ' IAD', ' ISB', 'IRSB', ' ICP', ' ISH', ' IMY', 'IMYD', 'CDEC', ' RAD', ' RSB', 'RRSB', ' RCP', ' RSC', ' RMY', 'RMYD'; const char ONECASE[(127) + 1] = 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 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, 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, 123, 124, 125, 126, 127; const int TSNAME[(62) + 1] = [LOW... HIGH] = 0x1000, 0x1001, [LOW... HIGH] = 0x1000, 0x1001, 0x1062, [LOW... HIGH] = 0x1001, 0x1062, [LOW... HIGH] = 0x1000, 0x52, 0x51, 0x62, [LOW... HIGH] = 0x1062, 0x1000, 0x31, 0x51, [LOW... HIGH] = 0x1062, 0x31, 0x1000, 0x51, 0x62, [LOW... HIGH] = 0x1000, 0x35, 0x1000, 0x1035, 0x31, 0x35, 0x1035, 0x33, 0, 0x1000, 0x31, 0x52, 0x51, 0x61, 0x72, 0x61, 0x72, 0x51, 0x62, 0x1051, 0x41, 0x1000; // static int FIXEDGLA[(11) + 1] = 0, 0x50000000, [LOW... HIGH] = 0, -1, 0, [LOW... HIGH] = 0; const char BYTES[(7) + 1] = [LOW... HIGH] = 0, 1, 2, 4, 8, 16; const char TRTAB[(255) + 1] = [LOW... HIGH] = 0, [LOW... HIGH] = 1, [LOW... HIGH] = 0, [LOW... HIGH] = 2, [LOW... HIGH] = 0, [LOW... HIGH] = 2, [LOW... HIGH] = 0, [LOW... HIGH] = 0; const int MAXLEVELS = 31; const int CONCOP = 13; const int FIXEDGLALEN = 48; const int JOBBERBIT = 0x40000000; // SETINJOBBERMODE const int CEBIT = 1; // SETINCOMPILERENVIRONMENT const int MAXDICT = 0x100; // SETFORMAXOFEVERYTHING // // THEPRINCIPALOPCODESAREHEREDEFINEDASTHEIRMNEMONICS(AMENDED) // 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 OUT = 0x3C; const int CPSR = 0x34; 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 SLD = 0x50; 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 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 IMYD = 0xEC; const int IDV = 0xAA; 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 RDV = 0xBA; const int RDDV = 0xBE; const int RMYD = 0xFC; const int RMY = 0xFA; // const int MVL = 0xB0; const int MV = 0xB2; const int SWEQ = 0xA0; const int SWNE = 0xA2; const int CPS = 0xA4; // // DEFINESOMEMNEMONICSFORTHEVISIBLEREGISTERS(XCEPTLNB) // 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 char LDCODE[(7) + 1] = 0, 0x78, 0x7C, 0x7E, 0, 48, 0, 0x7A; // const _imp_string MDEP = "S#NDIAG"; const _imp_string IOCPEP = "S#IOCP"; // EPFORIOCP const _imp_string AUXSTEP = "ICL9CEAUXST"; // DATAREFFORINDIRECTAUXST const int SNPT = 0x1006; // SPECIALNAMEPTYPE const int COMMALT = 2; const int ENDALT = 9; const int UNASSPAT = 0x81818181; const int DECALT = 8; // int DICTBASE; int CONSTPTR; int CONSTBTM; int DFHEAD; int CONSTHOLE; int WKFILEAD; int WKFILEK; int DUMMYFORMAT; int P1SIZE; int LEVELINF; int IOCPDISP; int PARMBITS1; int PARMBITS2; int PARMLET; // int ASL; int NNAMES; int ARSIZE; int CABUF; int PPCURR; int CONSTLIMIT; int OLDLINE; int LINE; int LENGTH; int NEXTP; int SNUM; int RLEVEL; int NMAX; int USTPTR; int PLABEL; int LEVEL; int CA; int LASTNAME; int CDCOUNT; int ASLCURBTM; int PARMDYNAMIC; // int FAULTY; int HIT; int INHCODE; int IMPS; int TTOPUT; int LIST; int PARMDIAG; int WARNFLAG; int PARMTRACE; int PARMLINE; int PARMOPT; int CTYPE; int DCOMP; int CPRMODE; int PARMCHK; int PARMARR; int ALLLONG; int PARMDBUG; int COMPILER; int LASTINST; int SMAP; int STACK; int AUXST; int PARMY; int BFFLAG; // int RBASE; int N; int FREEFORMAT; int PARMPROF; int EXITLAB; int CONTLAB; int Q; int R; int S; int NEST; int FNAME; int LDPTR; int GLACA; int GLACABUF; int GLACURR; int CREFHEAD; int SSTL; int QMAX; int STMTS; int LASTAT; int FILEADDR; int FILEPTR; int FILEEND; int FILESIZE; int LASTEND; int BIMSTR; int STLIMIT; int STRLINK; int RECTB; int ASLWARN; int IHEAD; // int MAXULAB; int SFLABEL; double CVALUE; double IMAX; double CTIME; _imp_string MAINEP; int LOGEPDISP; int EXPEPDISP; // static int *COMREG(int N); /* %begin block */ { // SOURCEFILEIFCLEAN FILEADDR = COMREG(46); PARMBITS1 = COMREG(27); PARMBITS2 = COMREG(28); WKFILEAD = COMREG(14); WKFILEK = INTEGER(WKFILEAD + 8) >> 10; if (FILEADDR <= 0) { FILESIZE = 64000; FILEADDR = 0; } else { FILEPTR = FILEADDR + INTEGER(FILEADDR + 4); FILEEND = FILEADDR + INTEGER(FILEADDR); FILESIZE = INTEGER(FILEADDR); } NNAMES = 255; if (FILESIZE > 10000) NNAMES = 511; if (PARMBITS1 & JOBBERBIT == 0) { if (FILESIZE > 32000) NNAMES = 1023; if (FILESIZE > 256 * 1024 || PARMBITS2 & MAXDICT != 0 || WKFILEK > 512) NNAMES = 2047; } ASL = 3 * NNAMES; // STAYWITHIN128KAUXSTACK if (ASL > 4095 && PARMBITS2 & MAXDICT == 0) ASL = 4095; ARSIZE = WKFILEK * 768 - 300; /* End of Begin/Rt/Fn/Map depth=1 */ }; /* TO DO: %ARRAYFORMAT DECLARATION */ ; char **A; /*pending name*/ recfm ASLIST[(ASL) + 1]; //(LISTF) int WORD[(NNAMES) + 1]; int TAGS[(NNAMES) + 1]; /*H imp80-switch.h:2313*/ int DVHEADS[(12) + 1]; static int FROMAR4(int PTR); static int FROMAR2(int PTR); static void TOAR8(int PTR, double VALUE); static void TOAR4(int PTR, int VALUE); static void TOAR2(int PTR, int VALUE); static void WARN(int N, int V); static void FAULT2(int N, int VAL, int IDEN); static void FAULT(int N, int VALUE); static _imp_string PRINTNAME(int N); static int MORESPACE(void); // integerfnspecNEWCELL static void INSERTATEND(int *S, int A, int B, int C); static void FROM12(int CELL, int *S1, int *S2); static void FROM123(int CELL, int *S1, int *S2, int *S3); static void POP(int *C, int *P, int *Q, int *R); static void PUSH(int *C, int S1, int S2, int S3); static int FIND(int LAB, int LIST); static void MLINK(int *CELL); static void REPLACE1(int CELL, int S1); static void REPLACE2(int CELL, int S2); static void REPLACE3(int CELL, int S3); static void REPLACE123(int CELL, int A1, int A2, int S3); static int FROM2(int CELL); static int FROM1(int CELL); static int FROM3(int CELL); static void BINSERT(int *T, int *B, int S1, int S2, int S3); static void CLEARLIST(int *HEAD); static _imp_string MESSAGE(int N); static void LPUT(int A, int B, int C, int D); static double CPUTIME(void); //*DELSTART static void NCODE(int START, int FINISH, int CA); static void PRINTLIST(int HEAD); static void PRHEX(int VALUE, int PLACES); static void CHECKASL(void); //*DELEND if (VMEB == NO) { auto void CONSOURCE(_imp_string FILE, int *AD); } // STARTOFCOMPILATION A = ; /* %begin block */ { //*********************************************************************** //*THISBLOCKINITIALISETHECOMPILERSCALARSANDARRAYS* //*WASORIGINALLYROUTINE'INITIALISE'.* //*THEINITIALISATIONOFTHECONSTANTLISTSWITHTHEVALUES* //*INPERMMAYBEOMITTEDINBATCHORCUT-DOWNVERSIONS.* //*********************************************************************** auto void READLINE(int MODE, int CHAR); auto int COMPARE(int P); auto void PNAME(int MODE); auto void CONST(int MODE); auto void TEXTTEXT(int EBCDIC); int CCSIZE; int DSIZE; int NEXT; int ATLINE1; int STARSTART; CCSIZE = 1000; DSIZE = 7 * NNAMES; int DISPLAY[(MAXLEVELS) + 1]; int SFS[(MAXLEVELS) + 1]; /*H imp80-switch.h:2313*/ char TLINE[(161) + (60) + 1]; char CC[(CCSIZE) + 1]; char LETT[(DSIZE + 20) + 1]; long int ATL0; long int ASYM0; const char ILETT[(500) + 1] = 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', 10, 'S', 'K', 'I', 'P', 'S', 'Y', 'M', 'B', 'O', 'L', 10, 'R', 'E', 'A', 'D', 'S', 'T', 'R', 'I', 'N', 'G', 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', 5, 'W', 'R', 'I', 'T', 'E', 7, 'N', 'E', 'W', 'P', 'A', 'G', 'E', 4, 'A', 'D', 'D', 'R', 6, 'A', 'R', 'C', 'S', 'I', 'N', 3, 'I', 'N', 'T', 5, 'I', 'N', 'T', 'P', 'T', 6, 'F', 'R', 'A', 'C', 'P', 'T', 5, 'P', 'R', 'I', 'N', 'T', 7, 'P', 'R', 'I', 'N', 'T', 'F', 'L', 4, 'R', 'E', 'A', 'L', 7, 'I', 'N', 'T', 'E', 'G', 'E', 'R', 3, 'M', 'O', 'D', 6, 'A', 'R', 'C', 'C', 'O', 'S', 4, 'S', 'Q', 'R', 'T', 3, 'L', 'O', 'G', 3, 'S', 'I', 'N', 3, 'C', 'O', 'S', 3, 'T', 'A', 'N', 3, 'E', 'X', 'P', 11, 'C', 'L', 'O', 'S', 'E', 'S', 'T', 'R', 'E', 'A', 'M', 11, 'B', 'Y', 'T', 'E', 'I', 'N', 'T', 'E', 'G', 'E', 'R', 8, 'E', 'V', 'E', 'N', 'T', 'I', 'N', 'F', 6, 'R', 'A', 'D', 'I', 'U', 'S', 6, 'A', 'R', 'C', 'T', 'A', 'N', 6, 'L', 'E', 'N', 'G', 'T', 'H', 11, 'P', 'R', 'I', 'N', 'T', 'S', 'T', 'R', 'I', 'N', 'G', 2, 'N', 'L', 8, 'L', 'O', 'N', 'G', 'R', 'E', 'A', 'L', 7, 'P', 'R', 'I', 'N', 'T', 'C', 'H', 6, 'R', 'E', 'A', 'D', 'C', 'H', 6, 'S', 'T', 'R', 'I', 'N', 'G', 8, 'R', 'E', 'A', 'D', 'I', 'T', 'E', 'M', 8, 'N', 'E', 'X', 'T', 'I', 'T', 'E', 'M', 6, 'C', 'H', 'A', 'R', 'N', 'O', 8, 'T', 'O', 'S', 'T', 'R', 'I', 'N', 'G', 10, 'F', 'R', 'O', 'M', 'S', 'T', 'R', 'I', 'N', 'G', 6, 'R', 'E', 'C', 'O', 'R', 'D', 5, 'A', 'R', 'R', 'A', 'Y', 10, 'S', 'E', 'T', 'M', 'A', 'R', 'G', 'I', 'N', 'S', 4, 'I', 'M', 'O', 'D', 2, 'P', 'I', 9, 'E', 'V', 'E', 'N', 'T', 'L', 'I', 'N', 'E', 11, 'L', 'O', 'N', 'G', 'I', 'N', 'T', 'E', 'G', 'E', 'R', 12, 'L', 'O', 'N', 'G', 'L', 'O', 'N', 'G', 'R', 'E', 'A', 'L', 9, 'L', 'E', 'N', 'G', 'T', 'H', 'E', 'N', 'I', 9, 'L', 'E', 'N', 'G', 'T', 'H', 'E', 'N', 'R', 8, 'S', 'H', 'O', 'R', 'T', 'E', 'N', 'I', 8, 'S', 'H', 'O', 'R', 'T', 'E', 'N', 'R', 6, 'N', 'E', 'X', 'T', 'C', 'H', 11, 'H', 'A', 'L', 'F', 'I', 'N', 'T', 'E', 'G', 'E', 'R', 8, 'P', 'P', 'R', 'O', 'F', 'I', 'L', 'E', 255; IMAX = (-1) >> 1; PLABEL = 24999; LETT[(0)] = 0; ATLINE1 = ADDR(TLINE[(1) + (60)]); INTEGER(ADDR(ATL0) + 4) = ATLINE1 - 1; INTEGER(ADDR(ATL0)) = 0x18000100; INTEGER(ADDR(ASYM0)) = 0x28000C00; INTEGER(ADDR(ASYM0) + 4) = ADDR(SYMBOL[(1300) - (1300)]) - 4 * 1300; N = 12; // LARGESTVALIDUSERLABEL MAXULAB = NNAMES + 16384; GLACURR = 0; GLACA = FIXEDGLALEN; GLACABUF = GLACA; PARMOPT = 1; PARMARR = 1; LASTINST = 0; PARMLINE = 1; PARMTRACE = 1; PARMDIAG = 1; LIST = 1; SFLABEL = 20999; PARMCHK = 1; EXITLAB = 0; CONTLAB = 0; CABUF = 0; PPCURR = 0; OLDLINE = 0; COMPILER = 0; RLEVEL = 0; NMAX = 0; USTPTR = 0; LEVEL = 0; CA = 0; LASTAT = 0; FAULTY = 0; WARNFLAG = 0; ALLLONG = 0; INHCODE = 0; DCOMP = 0; BFFLAG = 0; CPRMODE = 0; NEXT = 1; LDPTR = 0; IOCPDISP = 0; CREFHEAD = 0; AUXST = 0; RBASE = 10; LOGEPDISP = 0; EXPEPDISP = 0; STRLINK = 0; RECTB = 0; IHEAD = 0; SSTL = 0; STMTS = 1; SNUM = 0; LEVELINF = 0; CDCOUNT = 0; BIMSTR = 0; LOGEPDISP = 0; EXPEPDISP = 0; // DEFAULTMAINENTRY MAINEP = "S#GO"; DICTBASE = ADDR(LETT[(0)]); // // OPENOBJECTFILEHEREBEFOREMOREPAGESOFCOMPILERCODE // AREPAGEDINANDSUB-SYSTEMPAGESMOVEOUT // LPUT(0, 0, 0, 0); CTIME = CPUTIME(); I = COMREG(27); STLIMIT = 0x1F000; if (I >> 24 & 1 != 0) STLIMIT = COMREG(48) - 4096; if (I & 2 == 2) LIST = 0; if (I & 4 == 4) PARMDIAG = 0; if (I & 0x800000 != 0) PARMLINE = 0; if (I & 16 == 16) PARMCHK = 0; if (I & 32 == 32) PARMARR = 0; // USEMAPORPROFILEBITPROTEM PARMPROF = (I >> 15 & 1) | (I >> 7 & 1); PARMDYNAMIC = I >> 20 & 1; PARMLET = I >> 13 & 1; // PARMCODEORD DCOMP = I >> 14 & 1; PARMDBUG = I >> 18 & 1; if (I & 64 == 64) { PARMTRACE = 0; PARMDIAG = 0; } FREEFORMAT = I & 0x80000; STACK = I >> 3 & 1; // USEPARMZBITFORDUMPINGWKFILE SMAP = I >> 26 & 1; TTOPUT = COMREG(40); if (I & (1 << 16) != 0) { PARMARR = 0; PARMOPT = 0; PARMLINE = 0; PARMCHK = 0; PARMDIAG = 0; } // ALLOWNOTRACEONLYWITHOPT PARMTRACE = PARMTRACE | PARMOPT; // BITSETIFIMPSREQUESTED IMPS = I >> 23 & 1; // FORTESTING IMPS = 1; NEWLINES(3); SPACES(14); PRINTSTRING("ERCC. Imp"); if (IMPS != 0) PRINTSYMBOL('s'); PRINTSTRING(" Compiler Release"); WRITE(RELEASE, 1); PRINTSTRING(" Version ".LADATE); NEWLINES(3); WRITE(NNAMES, 5); WRITE(ASL, 5); NEWLINE(); ASLWARN = 0; ASLCURBTM = ASL - 240; CONSTLIMIT = 4 * ASLCURBTM - 8; for (I = ASLCURBTM; I != ASL - 1; I += 1) { ASLIST[(I + 1)] = I; } ASLIST[(ASLCURBTM)] = 0; ASLIST[(0)] = -1; ASLIST[(0)] = -1; ASLIST[(0)] = -1; ASLIST[(0)] = 0; for (I = 0; I != NNAMES; I += 1) { WORD[(I)] = 0; TAGS[(I)] = 0; } for (I = 0; I != 12; I += 1) { DVHEADS[(I)] = 0; } // // NOWDECLARETHESPECIALNAMESWHICHAREINARRAYILETT. // K = 0; NEXT = 1; I = ILETT[(0)]; while (I < 255) { for (J = I; J != 1; J += -1) { CC[(J)] = ILETT[(K + J)]; } CC[(I + 1)] = ';'; R = 2; Q = 1; PNAME(1); PUSH(TAGS[(LASTNAME)], SNPT << 16 | 0x8000, 0, SNUM << 16); SNUM = SNUM + 1; K = K + I + 1; I = ILETT[(K)]; } // COMREG(24) = 16; // RETURNCODE // DUMMYRECORDFORMAT DUMMYFORMAT = 0; DFHEAD = 0; PUSH(DFHEAD, 0, 0, 0); // FORBETTERERRORRECOVERY PUSH(DUMMYFORMAT, 0, 0, DFHEAD); LINE = 0; LENGTH = 0; Q = 1; R = 1; LEVEL = 1; do { if (Q >= LENGTH) { QMAX = 1; READLINE(0, 0); } WARNFLAG = 0; STARSTART = R; R = R + 3; OLDLINE = LINE; A = LINE >> 8; A = LINE & 255; R = R + 2; if (COMPARE(SS) == 0) { FAULT(100, ADDR(CC[(0)])); R = STARSTART; } else { if (R > ARSIZE) FAULT(102, 0); if (A == COMMALT) R = STARSTART; else { I = R - STARSTART; A = I >> 16; A = I >> 8 & 255; A = I & 255; if (A == DECALT && LEVEL > 1) { if (SFS[(LEVEL)] == 0) { TOAR4(DISPLAY[(LEVEL)], STARSTART); DISPLAY[(LEVEL)] = STARSTART + 6; // FLAGASUNLINKED } else A = 128; } //*DELSTART if (SMAP != 0) { NEWLINE(); WRITE(LINE, 5); WRITE(STARSTART, 5); NEWLINE(); J = 0; for (I = STARSTART; I != R - 1; I += 1) { WRITE(A, 5); J = J + 1; if (J >= 20) { NEWLINE(); J = 0; } } NEWLINE(); } //*DELEND // ENDOFPROGORFILE if (A == ENDALT && 1 <= A && A <= 2) break; if (LEVEL == 0) { FAULT(14, 0); break; } } } } while (1); TOAR8(R, 0); R = R + 8; if (R + NEXT > ARSIZE) FAULT(102, 0); P1SIZE = R; if (USEIMP == YES) { for (I = 0; I != NEXT; I += 1) { A = LETT[(I)]; } } else { /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); asm(); asm(); asm(); asm(); } DICTBASE = ADDR(A); R = R + NEXT + 1; goto BEND; void READLINE(int MODE, int CHAR) { auto void GETLINE(void); int DEL; int LL; int LP; LL = 0; LP = 0; Q = 1; LENGTH = 0; DEL = 0; NEXT: if (USEIMP == YES) { LP = LP + 1; if (LP > LL) { GETLINE(); LP = 1; } I = TLINE[(LP) + (60)]; if (MODE == 0) { if (I == '%') { DEL = 128; goto NEXT; } I = ONECASE[(I)]; if ('A' <= I && I <= 'Z') I = I | DEL; else { DEL = 0; if (I == ' ') goto NEXT; } LENGTH = LENGTH + 1; CC[(LENGTH)] = I; if (I == '\'' || I == 34) { MODE = 1; CHAR = I; } } else { LENGTH = LENGTH + 1; CC[(LENGTH)] = I; if (I == CHAR) MODE = 0; } if (!(I == NL())) goto NEXT; } else { /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); asm(); GETLINE(); /*to do*/ /*5*/ asm(); RLL1: /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ //'%' asm(); asm(); asm(); asm(); asm(); /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); asm(); RLL3: /*to do*/ /*5*/ // LOWERCASETOUPPER asm(); /*to do*/ /*5*/ //'A' asm(); /*to do*/ /*5*/ /*to do*/ /*5*/ //'Z' asm(); asm(); /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); RLL4: /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ //' ' asm(); asm(); asm(); /*to do*/ /*5*/ asm(); RLL5: /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ //'''' asm(); asm(); asm(); asm(); asm(); /*to do*/ /*5*/ /*to do*/ /*5*/ //'"' asm(); asm(); /*to do*/ /*5*/ asm(); RLL6: /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); RLL7: /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); RLL2: /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); RLL9: /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); RLL8: } if (CC[(LENGTH - 1)] == 'C' + 128) { LENGTH = LENGTH - 2; goto NEXT; } if (LENGTH > CCSIZE) FAULT(101, 0); return; void GETLINE(void) { auto void IOCP(int A, int B); const char ITOI[(255) + 1] = [LOW... HIGH] = 32, 10, [LOW... HIGH] = 32, 25, 26, [LOW... HIGH] = 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, [LOW... HIGH] = 26, 10, [LOW... HIGH] = 26, [LOW... HIGH] = 26, [LOW... HIGH] = 26, 92, 38, [LOW... HIGH] = 26, 35, [LOW... HIGH] = 26, [LOW... HIGH] = 26, [LOW... HIGH] = 26, 35, [LOW... HIGH] = 26, 94, [LOW... HIGH] = 26; int K; LL = 0; if (FILEADDR == 0) { // SOURCENOTA'CLEAN'FILE /* until (K==NL()) */ do { READSYMBOL(K); TLINE[(LL + 1) + (60)] = ITOI[(K)]; LL = LL + 1; } while (!(K == NL())); } else { if (FILEPTR >= FILEEND) { if (IHEAD != 0) { POP(IHEAD, FILEADDR, FILEPTR, FILEEND); GETLINE(); return; } _imp_signal(9, 1); } if (USEIMP == NO) { /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); goto OLIST; } IMP: || K == 0) */ do { // NEXTCHARFROMSORCEFILE K = BYTEINTEGER(FILEPTR); FILEPTR = FILEPTR + 1; TLINE[(LL + 1) + (60)] = ITOI[(K)]; LL = LL + 1; } while (!(K == NL() || K == 0)) ; OLIST: } // ifMODE=0andLL=1thenGETLINEandreturn // LINE=LINE+1unlessMODE=0andLENGTH>0 // COUNTALLLINES LINE = LINE + 1; if (LIST != 0) { if (MODE == 0 && LENGTH > 0) PRINTSTRING(" C"); else WRITE(LINE, 5); // SPACES(8) for (K = -7; K != 0; K += 1) { TLINE[(K) + (60)] = ' '; } if (MODE != 0) TLINE[(-7) + (60)] = '"'; TLINE[(-8) + (60)] = LL + 8; IOCP(15, ADDR(TLINE[(-8) + (60)])); } if (FREEFORMAT == 0 && LL > 73) { TLINE[(73) + (60)] = 10; LL = 73; } /* End of Begin/Rt/Fn/Map depth=3 */ }; /* End of Begin/Rt/Fn/Map depth=2 */ }; int COMPARE(int P) { int I; int J; int ITEM; int RA; int RL; int RP; int RQ; int RR; int RS; int MARKER; int SSL; int ALT; int PP; static int SAVECOMP; // FORCHECKINGDSIDEDCONDS /* TO DO: %SWITCH DECLARATION */ /*Q imp80-switch.h:4253*/ if (USEIMP == YES) { RP = SYMBOL[(P) - (1300)]; RL = LEVEL; P = P + 1; // ROUTINEREALLYSTARTSHERE PP = P; } else { /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); SUBENTRY: /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); asm(); asm(); asm(); } COMM: if (USEIMP == YES) { // RESETVALUESOFLINE&ARPTRS RQ = Q; RR = R; // SAVESTRINGLINK SSL = STRLINK; // FIRSTALTERNATIVETOBETRIED ALT = 1; // RATONEXTPHRASEALTERNATIVE RA = SYMBOL[(P) - (1300)]; RS = P; } else { /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); } UPR: R = R + 1; // SUCCESSONTONEXTITEM SUCC: if (USEIMP == YES) { // RS=NEXTALTERNATIVEMEANSTHAT RS = RS + 1; // THISALTHASBEENCOMPLETEDSO // EXITWITHHIT=1 if (RS == RA) goto FINI; // NEXTBRICKINTHECURRENTALT ITEM = SYMBOL[(RS) - (1300)]; if (ITEM < 999) goto LIT; } else { /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); } if (ITEM < 1300) goto BIP[ITEM]; // BRICKISAPHRASETYPE if (USEIMP == YES) { if (COMPARE(ITEM) == 0) goto FAIL; } else { /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ // RESULT=0FORFAIL asm(); asm(); asm(); asm(); asm(); asm(); asm(); /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); asm(); asm(); asm(); asm(); } goto SUCC; // BRICKISLITERAL LIT: if (USEIMP == YES) { // OBTAINCURRENTCHARACTER I = CC[(Q)]; if (!(I == CLETT[(ITEM + 1)])) goto FAIL; Q = Q + 1; K = CLETT[(ITEM)] + ITEM; ITEM = ITEM + 2; while (ITEM <= K) { if (!(CC[(Q)] == CLETT[(ITEM)])) goto FAIL; Q = Q + 1; ITEM = ITEM + 1; // CHECKITWITHLITERALDICTENTRY } } else { /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); } // MATCHEDSUCCESSFULLY goto SUCC; // FAILURE-NOTEPOSITIONREACHD FAIL: if (USEIMP == YES) { // TOTALFAILURENOALTTOTRY if (RA == RP) goto TFAIL; if (Q > QMAX) QMAX = Q; // RESETLINEANDA.R.POINTERS Q = RQ; // AVOIDGOINGVIAUPR: R = RR + 1; STRLINK = SSL; // MOVETONEXTALTOFPHRASE ALT = ALT + 1; RS = RA; RA = SYMBOL[(RA) - (1300)]; } else { /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); asm(); asm(); asm(); asm(); CPL1: asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); } goto SUCC; TFAIL: LEVEL = RL; if (USEIMP == YES) { return 0; } else { /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); } // REPEATEDPHRASE BIP_999: A = ALT; P = PP; goto COMM; // NULLALWAYSLAST&OK BIP_1000: FINI: A = ALT; if (USEIMP == YES) { return 1; } else { /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); } // PHRASENAME BIP_1001: // PHRASEOLDNAME BIP_1004: // OBTAINCURRENTCHARACTER I = CC[(Q)]; if (!(TRTAB[(I)] == 2)) goto FAIL; PNAME(ITEM - 1004); if (HIT == 1) goto SUCC; goto FAIL; // PHRASEINTEGERCONSTANT BIP_1002: // PHRASECONST BIP_1003: CONST(ITEM - 1003); if (HIT == 0) goto FAIL; goto SUCC; // PHRASEN BIP_1005: // OBTAINCURRENTCHARACTER I = CC[(Q)]; if (!('0' <= I && I <= '9')) goto FAIL; S = 0; while ('0' <= I && I <= '9') { S = 10 * S + (I & 15); Q = Q + 1; I = CC[(Q)]; } TOAR2(R, S); R = R + 2; goto SUCC; // PHRASES=SEPARATOR BIP_1006: // OBTAINCURRENTCHARACTER I = CC[(Q)]; if (I == NL()) goto SUCC; if (!(I == ';')) goto FAIL; Q = Q + 1; goto SUCC; BIP_1007: // PHRASECOMMENTTEXT // OBTAINCURRENTCHARACTER I = CC[(Q)]; J = I; if (I == ';' || I == NL()) goto TX; if (!(I == '!' || I == '|' || I == 'C' + 128 && CC[(Q + 1)] == 'O' + 128 && CC[(Q + 2)] == CC[(Q + 3)] && CC[(Q + 3)] == 'M' + 128 && CC[(Q + 4)] == 'E' + 128 && CC[(Q + 5)] == 'N' + 128 && CC[(Q + 6)] == 'T' + 128)) goto FAIL; Q = Q + 1 + 6 * (I >> 7); J = CC[(Q)]; do { if (J == NL() || J == ';') break; Q = Q + 1; J = CC[(Q)]; } while (1); TX: if (J == ';') Q = Q + 1; goto SUCC; // PHRASEBIGHOLE BIP_1008: TOAR4(R, 0); R = R + 4; goto SUCC; // PHRASEN255 BIP_1009: // OBTAINCURRENTCHARACTER I = CC[(Q)]; if (!('0' <= I && I <= '9')) goto FAIL; S = 0; while ('0' <= I && I <= '9') { S = 10 * S + (I & 15); Q = Q + 1; I = CC[(Q)]; } if (!(0 <= S && S <= 255)) goto FAIL; A = S; goto UPR; // PHRASEHOLE BIP_1010: MARKER = R; R = R + 2; goto SUCC; // PHRASEMARK BIP_1011: I = R - MARKER; A = I; A = I >> 8; goto SUCC; // PHRASEREADLINE? BIP_1012: // OBTAINCURRENTCHARACTER I = CC[(Q)]; while (I == NL()) { READLINE(0, 0); RQ = 1; I = CC[(Q)]; } if (R > ARSIZE) FAULT(102, 0); goto SUCC; // PHRASECHECKIMPS BIP_1013: if (!(IMPS == 1)) goto FAIL; goto SUCC; // PHRASEDUMMYAPP BIP_1014: A = 2; A = 2; R = R + 2; goto SUCC; // PHRASEDOWN=NEWTEXTLEVEL BIP_1015: LEVEL = LEVEL + 1; TOAR4(R, 0); DISPLAY[(LEVEL)] = R; SFS[(LEVEL)] = 0; R = R + 4; goto SUCC; // PHRASEUP1TEXTUALLEVEL BIP_1016: DISPLAY[(LEVEL)] = 0; while (SFS[(LEVEL)] != 0) { POP(SFS[(LEVEL)], I, J, K); // FINISHMISSING if (I == 1) FAULT2(53, K, 0); // repeatMISSING if (I == 2) FAULT2(13, K, 0); } LEVEL = LEVEL - 1; goto SUCC; // PHRASELISTON BIP_1017: LIST = 1; goto SUCC; // PHRASELISTOFF BIP_1018: LIST = 0; goto SUCC; // PHRASECOLONFORLABEL BIP_1019: if (!(CC[(Q - 1)] == ':')) goto FAIL; goto SUCC; // PHRASENOTECONST BIP_1020: if (CTYPE == 5) { TOAR4(S - 4, STRLINK); STRLINK = S - 4; } goto SUCC; // TRACEFORONCONDITIONS BIP_1021: PARMTRACE = 1; goto SUCC; // SETMNEMONIC BIP_1022: // OBTAINCURRENTCHARACTER I = CC[(Q)]; S = ' '; while ('A' <= I && I <= 'Z') { S = S << 8 | I; Q = Q + 1; I = CC[(Q)]; } if (!(I == '_' && S != ' ')) goto FAIL; Q = Q + 1; goto SUCC; // PRIMARYFORMATMNEMOINC BIP_1023: for (I = 7; I != 126; I += 1) { if (OPC[(I)] == S) goto PFND; } goto FAIL; PFND: if (8 <= I >> 3 && I >> 3 <= 11 && I & 7 <= 3) goto FAIL; A = 2 * I; goto UPR; // SECONDARYFORMATMNEMONIC BIP_1024: for (I = 64; I != 88; I += 8) { for (J = 0; J != 3; J += 1) { if (OPC[(I + J)] == S) goto SFND; } } goto FAIL; SFND: A = 2 * (I + J); goto UPR; // TERTIARYFORMATMNEMONIC BIP_1025: for (I = 3; I != 1; I += -1) { if (OPC[(I)] == S) { A = 2 * I; goto UPR; } } goto FAIL; // P(OP)=+,-,&,****,**,*,!!,!, BIP_1026: ////,/,>>,<<,.,\\, // OBTAINCURRENTCHARACTER I = CC[(Q)]; if (!(32 < I && I < 127 && X '80000000' >> ((I - 32) & 31) & 0x4237000A != 0)) goto FAIL; Q = Q + 1; if (I == '+') { A = 1; goto UPR; } if (I == '-') { A = 2; goto UPR; } if (I == '&') { A = 3; goto UPR; } J = CC[(Q)]; if (I == '*') { if (J != I) { A = 6; goto UPR; } if (CC[(Q + 1)] == I && I == CC[(Q + 2)]) { A = 4; Q = Q + 3; goto UPR; } A = 5; Q = Q + 1; goto UPR; } if (I == '/') { if (J != I) { A = 10; goto UPR; } A = 9; Q = Q + 1; goto UPR; } if (I == '!') { if (J != I) { A = 8; goto UPR; } A = 7; Q = Q + 1; goto UPR; } if (I == '.') { A = 13; goto UPR; } if (I == J && J == '<') { A = 12; Q = Q + 1; goto UPR; } if (I == J && J == '>') { A = 11; Q = Q + 1; goto UPR; } if (I == '\\') { if (J != I) { A = 15; goto UPR; } Q = Q + 1; A = 14; goto UPR; } goto FAIL; // PHRASECHECKUI BIP_1027: // OBTAINCURRENTCHARACTER I = CC[(Q)]; if (TRTAB[(I)] == 2 || I == '-') goto SUCC; if (0x80000000 >> (I & 31) & 0x14043000 != 0) goto SUCC; goto FAIL; // P(+'')=+,-,\,0 BIP_1028: // OBTAINCURRENTCHARACTER I = CC[(Q)]; if (I == '\\' || I == 0x7E) { A = 3; Q = Q + 1; goto UPR; } if (I == '-') { A = 2; Q = Q + 1; goto UPR; } if (I == '+') { A = 1; Q = Q + 1; goto UPR; } A = 4; goto UPR; // PHRASENOTECYCLE BIP_1029: TOAR4(R, 0); PUSH(SFS[(LEVEL)], 2, R, LINE); R = R + 4; goto SUCC; // P(,'')=',',0 BIP_1030: // // THISISVERYAWKWARDASITMEANSITISVERYTOHARDTOFIND // THEENDOFAPARAMETERLISTWITHOUTCHURNING.BYMAKINGTHISABIP // WECANPEEPAHEADFOR')'ANDFAILHERE. // // OBTAINCURRENTCHARACTER I = CC[(Q)]; if (I == ')') goto FAIL; if (I == ',') Q = Q + 1; goto SUCC; // PHRASECHECKTYPEIEENSURE BIP_1031: // FIRSTLETTERIS(B,H,I,L,R,S)& // 3RDLETTERIS(A,L,N,R,T) // OBTAINCURRENTCHARACTER I = CC[(Q)]; if (!(I > 128 && 0x80000000 >> (I & 31) & 0x20C83000 != 0 && 0x80000000 >> (CC[(Q + 2)] & 31) & 0x400A2800 != 0)) goto FAIL; goto SUCC; // PHRASECOMP1 BIP_1032: // PHRASECOMP2(IS2NDHALFOFDSIDED) BIP_1037: // OBTAINCURRENTCHARACTER I = CC[(Q)]; if (!(32 < I && I <= 92 && X '80000000' >> (I & 31) & 0x1004000E != 0)) goto FAIL; //'='=1,'>='=2,'>'=3 //'#'OR'\='=4,'<='=5,'<'=6 // 7UNUSED,'->'=8,'=='=9 //'##'OR'\=='=10 if (I == '=') { if (CC[(Q + 1)] == I) { J = 9; goto JOIN1; } J = 1; goto JOIN; } if (I == '#') { if (CC[(Q + 1)] == I) { J = 10; goto JOIN1; } J = 4; goto JOIN; } if (I == '\\' && CC[(Q + 1)] == '=') { Q = Q + 1; if (CC[(Q + 1)] == '=') { J = 10; goto JOIN1; } J = 4; goto JOIN; } if (I == '>') { if (CC[(Q + 1)] == '=') { J = 2; goto JOIN1; } J = 3; goto JOIN; } if (I == '<') { if (CC[(Q + 1)] == '=') { J = 5; goto JOIN1; } J = 6; goto JOIN; } if (I == '-' && CC[(Q + 1)] == '>') { J = 8; goto JOIN1; } goto FAIL; JOIN1: Q = Q + 1; JOIN: Q = Q + 1; A = J; if (ITEM == 1032) { SAVECOMP = J; goto UPR; } // SAVEJTOCHECKDSIDED // ILLEGALDSIDED if (SAVECOMP > 6 || J > 6) { Q = Q - 1; goto FAIL; } // NBOWNSWONTWORKIF goto UPR; // CONDEXPRSALLOWEDASTHE // CANBENESTED! // P(ASSOP)-==,=,<-,-> BIP_1033: // OBTAINCURRENTCHARACTER I = CC[(Q)]; if (I == '=') { if (CC[(Q + 1)] == '=') { A = 1; Q = Q + 2; goto UPR; } A = 2; Q = Q + 1; goto UPR; } if (I == '<' && CC[(Q + 1)] == '-') { A = 3; Q = Q + 2; goto UPR; } if (I == '-' && CC[(Q + 1)] == '>') { A = 4; Q = Q + 2; goto UPR; } goto FAIL; // NOTESTART BIP_1034: // HOLEFORFORWARDPTR TOAR4(R, 0); PUSH(SFS[(LEVEL)], 1, R, LINE); R = R + 4; goto SUCC; // NOTEFINISH BIP_1035: if (SFS[(LEVEL)] == 0) { FAULT2(51, 0, 0); goto SUCC; } POP(SFS[(LEVEL)], I, J, K); if (I == 2) FAULT2(59, K, 0); TOAR4(J, STARSTART); goto SUCC; // NOTEREPEAT BIP_1036: if (SFS[(LEVEL)] == 0) { FAULT2(1, 0, 0); goto SUCC; } POP(SFS[(LEVEL)], I, J, K); // STARTINSTEADOFCYCLE if (I == 1) FAULT2(52, K, 0); TOAR4(J, STARSTART); goto SUCC; // INCLUDE"FILE" BIP_1038: if (VMEB == YES) goto FAIL; I = CC[(Q)]; if (!(I == NL() || I == ';')) goto FAIL; if (I == ';') Q = Q + 1; if (!(CTYPE == 5)) goto FAIL; PUSH(IHEAD, FILEADDR, FILEPTR, FILEEND); CONSOURCE(STRING(ADDR(A)) // DEPARTSIFFAILS , FILEADDR); FILEPTR = FILEADDR + INTEGER(FILEADDR + 4); FILEEND = FILEADDR + INTEGER(FILEADDR); goto SUCC; /* End of Begin/Rt/Fn/Map depth=2 */ }; // OFROUTINE'COMPARE' void PNAME(int MODE) { //*********************************************************************** //*MODE=0FOROLDNAME(ALREADYINDICT),MODE=1FORNEWNAME* //*********************************************************************** const int HASH[(7) + 1] = 71, 47, 97, 79, 29, 37, 53, 59; int JJ; int KK; int LL; int FQ; int FS; int T; int S; int I; long int DRDES; long int ACCDES; HIT = 0; FQ = Q; FS = CC[(Q)]; if (!(TRTAB[(FS)] == 2 && '"' != CC[(Q + 1)] && CC[(Q + 1)] != '\'\'')) return; // 1STCHARMUSTBELETTER T = 1; LETT[(NEXT + 1)] = FS; JJ = 71 * FS; if (USEIMP == YES) { do { Q = Q + 1; I = CC[(Q)]; if (TRTAB[(I)] == 0) break; if (T <= 7) JJ = JJ + HASH[(T)]; T = T + 1; LETT[(NEXT + T)] = I; } while (1); } else { CYC: /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ // ITOACC asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); asm(); asm(); asm(); SKIP: /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); asm(); asm(); asm(); EXIT: } // INSERTLENGTH LETT[(NEXT)] = T; S = T + 1; // DICTIONARYOVERFLOW if (NEXT + S > DSIZE) FAULT(103, 0); JJ = (JJ + 113 * T) & NNAMES; if (USEIMP == YES) { for (KK = JJ; KK != NNAMES; KK += 1) { LL = WORD[(KK)]; // NAMENOTKNOWN if (LL == 0) goto HOLE; if (STRING(ADDR(LETT[(NEXT)])) == STRING(ADDR(LETT[(LL)]))) goto FND; } for (KK = 0; KK != JJ; KK += 1) { LL = WORD[(KK)]; // NAMENOTKNOWN if (LL == 0) goto HOLE; if (STRING(ADDR(LETT[(NEXT)])) == STRING(ADDR(LETT[(LL)]))) goto FND; } } else { /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); asm(); asm(); asm(); asm(); CYC1: /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); CYC2: /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); } // TOOMANYNAMES FAULT(104, 0); HOLE: if (MODE == 0) { Q = FQ; return; } WORD[(KK)] = NEXT; NEXT = NEXT + S; FND: LASTAT = FQ; HIT = 1; LASTNAME = KK; A = LASTNAME; A = LASTNAME >> 8; R = R + 2; LASTEND = Q; /* End of Begin/Rt/Fn/Map depth=2 */ }; void CONST(int MODE) { //*********************************************************************** //*SYNTAXCHECKANDEVALUATEALLTHEFORMSOFIMPCONSTANT* //*MODE=0FORINTEGERCONSTANTS#0FORANYSORTOFCONSTANT* //*********************************************************************** int Z; int DOTSEEN; int EBCDIC; int FS; int CPREC; int RR; int S; int T; int SS; long double X; long double CVALUE; long double DUMMY; const long double TEN = R '41A00000000000000000000000000000'; CPREC = 5; RR = R; R = R + 1; DOTSEEN = 0; HIT = 0; CVALUE = 0; DUMMY = 0; FS = CC[(Q)]; S = 0; if ('0' <= FS && FS <= '9') goto N; if (FS == '.' && MODE == 0 && '0' <= CC[(Q + 1)] && CC[(Q + 1)] <= '9') goto DOT; // 1DIDTMIN CTYPE = 1; EBCDIC = 0; if (FS == '\'\'') goto QUOTE; if (FS == 34) goto STR2; if (!(CC[(Q + 1)] == '\'\'')) goto NOTQUOTE; Q = Q + 2; if (FS == 'X') goto HEX; if (FS == 'M') goto MULT; if (FS == 'B') goto BIN; if (FS == 'R' && MODE == 0) goto RHEX; if (FS == 'K') goto OCT; if (FS == 'C') { EBCDIC = 1; goto MULT; } if (FS == 'D' && MODE == 0) { CPREC = 7; if ('0' <= CC[(Q)] && CC[(Q)] <= '9') goto N; if (CC[(Q)] == '.') goto DOT; } Q = Q - 2; return; // SINGLECHBETWEENQUOTES QUOTE: if (CC[(Q + 2)] == '\'\'') { S = CC[(Q + 1)]; Q = Q + 3; if (S != '\'\'') goto IEND; if (CC[(Q)] == '\'\'') { Q = Q + 1; goto IEND; } } // NOTVALID return; // CHECKFORE"...." NOTQUOTE: if (!(FS == 'E' && CC[(Q + 1)] == '"')) return; EBCDIC = 1; Q = Q + 1; // DOUBLEQUOTEDSTRING STR2: A = 0x35; TEXTTEXT(EBCDIC); CTYPE = 5; return; // HEXCONSTANTS HEX: T = 0; do { I = CC[(Q)]; Q = Q + 1; if (I == '\'\'') break; T = T + 1; if (!('0' <= I && I <= '9' || 'A' <= I && I <= 'F' && T < 17)) return; if (T == 9) { SS = S; S = 0; } S = (S << 4) + (I & 15) + 9 * (I >> 6); } while (1); if (T > 8) { Z = 4 * (T - 8); S = S | (SS << Z); SS = SS >> (32 - Z); CPREC = 6; } IEND: if (CPREC == 6) { TOAR4(R, SS); R = R + 4; } if (CPREC == 5 && 0 <= S && S <= 0x7FFF) { CPREC = 4; TOAR2(R, S); R = R + 2; } else { TOAR4(R, S); R = R + 4; } if (!(MODE != 0 && CPREC == 6)) HIT = 1; A = CPREC << 4 | CTYPE; return; // REALHEXCONSTANTS RHEX: T = 0; do { I = CC[(Q)]; Q = Q + 1; if (T & 7 == 0 && T != 0) { TOAR4(R, S); R = R + 4; S = 0; } if (I == '\'\'') break; T = T + 1; if (!('0' <= I && I <= '9' || 'A' <= I && I <= 'F')) return; S = (S << 4) + (I & 15) + 9 * (I >> 6); } while (1); if (!(T == 8 || T == 16 || T == 32)) return; if (T == 32) CPREC = 7; else CPREC = 4 + T / 8; A = CPREC << 4 | 2; HIT = 1; return; // OCTALCONSTANTS OCT: T = 0; do { I = CC[(Q)]; Q = Q + 1; T = T + 1; if (I == '\'\'') break; if (!('0' <= I && I <= '7' && T < 12)) return; S = S << 3 | (I & 7); } while (1); goto IEND; // MULTIPLECONSTANTS MULT: T = 0; do { I = CC[(Q)]; Q = Q + 1; T = T + 1; if (I == '\'\'') { if (CC[(Q)] != '\'\'') break; else Q = Q + 1; } if (T >= 5) return; if (EBCDIC != 0) I = ITOETAB[(I)]; S = S << 8 | I; } while (1); goto IEND; // BINARYCONST BIN: T = 0; do { I = CC[(Q)]; Q = Q + 1; T = T + 1; if (I == '\'\'') break; if (!('0' <= I && I <= '1' && T < 33)) return; S = S << 1 | I & 1; } while (1); goto IEND; // CONSTANTSTARTSWITHDIGIT N: I = CC[(Q)]; do { CVALUE = TEN * CVALUE + (I & 15); // ONTONEXTCHAR Q = Q + 1; I = CC[(Q)]; } while (!(I < '0' || I > '9')); if (!(MODE == 0 && I == '.')) goto ALPHA; DOT: Q = Q + 1; X = TEN; I = CC[(Q)]; // CONSTANTHASDECIMALPOINT DOTSEEN = 1; while ('0' <= I && I <= '9') { CVALUE = CVALUE + (I & 15) / X; X = TEN * X; Q = Q + 1; I = CC[(Q)]; } // TESTFOREXPONENT ALPHA: if (MODE == 0 && CC[(Q)] == '@') { Q = Q + 1; X = CVALUE; Z = 1; I = CC[(Q)]; if (I == '-') Z = -1; if (I == '+' || I == '-') Q = Q + 1; CONST(2); if (HIT == 0) return; HIT = 0; R = RR + 1; // EXPONENTMUSTBEHALFINTEGER if (A >> 4 != 4) return; S = FROMAR2(R + 1) * Z; if (S == -99) CVALUE = 0; else { if (USEIMP == NO) { /*to do*/ /*5*/ // MASKOUTREALOVERFLOW asm(); } while (S > 0) { S = S - 1; CVALUE = CVALUE * TEN; if (USEIMP == NO) { /*to do*/ /*5*/ asm(); } } while (S < 0 && CVALUE != 0) { S = S + 1; CVALUE = CVALUE / TEN; } } } // SEEIFITISINTEGER if (FS == 'D') { I = CC[(Q)]; if (I == '\'') Q = Q + 1; else return; // ENSURENOTTAKENASINTEGER DOTSEEN = 1; } if (DOTSEEN == 1 || CVALUE > IMAX || FRACPT(CVALUE) != 0) CTYPE = 2; else { CTYPE = 1; S = INT(CVALUE); } if (CTYPE == 1) goto IEND; // NO32BITREALCONSTS if (CPREC == 5) CPREC = 6; if (CPREC == 6) { if (USEIMP == NO) { // SOFTWAREROUNDINMCCODEONLY /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); asm(); asm(); asm(); asm(); } } TOAR8(R, CVALUE); R = R + 8; if (CPREC == 7) { TOAR8(R, LONGREAL(ADDR(CVALUE) + 8)); R = R + 8; } A = (CPREC << 4) + CTYPE; HIT = 1; FAIL: /* End of Begin/Rt/Fn/Map depth=2 */ }; void TEXTTEXT(int EBCDIC) { //*********************************************************************** //*PROCESSESTEXTBETWEENDOUBLEQUOTESANDSTORESINISOOREBCDIC* //*********************************************************************** int J; int II; const int QU = '"'; I = CC[(Q)]; S = R + 4; R = R + 5; HIT = 0; // FAILUNLESSINITIALQUOTE if (!(I == QU)) return; Q = Q + 1; do { I = CC[(Q)]; if (EBCDIC != 0) II = ITOETAB[(I)]; else II = I; A = II; R = R + 1; if (I == QU) { Q = Q + 1; if (CC[(Q)] != QU) break; } if (I == 10) READLINE(1, QU); else Q = Q + 1; if (R - S > 256) FAULT(106, 0); } while (1); R = R - 1; J = R - S - 1; A = J; HIT = 1; /* End of Begin/Rt/Fn/Map depth=2 */ }; BEND: /* End of Begin/Rt/Fn/Map depth=1 */ }; // OFBLOCKCONTAININGPASS1 if (LEVEL > 1) FAULT(15, 0); I = 0; NEWLINE(); if (FAULTY == 0) { WRITE(LINE, 5); PRINTSTRING(" LINES ANALYSED IN"); WRITE(INT(1000 * (CPUTIME() - CTIME)), 5); PRINTSTRING(" MSECS - SIZE="); WRITE(P1SIZE, 5); if (LINE > 90 && LIST != 0) NEWPAGE(); else NEWLINE(); } else { PRINTSTRING("CODE GENERATION NOT ATTEMPTED\n"); COMREG(24) = 8; COMREG(47) = FAULTY; exit(0); } /* %begin block */ { //*********************************************************************** //*SECONDORCODEGENERATINGPASS* //*********************************************************************** int REGISTER[(7) + 1]; int GRUSE[(7) + 1]; /*H imp80-switch.h:2313*/ int GRAT[(7) + 1]; /*H imp80-switch.h:2313*/ int GRINF1[(7) + 1]; /*H imp80-switch.h:2313*/ int GRINF2[(7) + 1]; /*H imp80-switch.h:2313*/ int OLINK[(7) + 1]; /*H imp80-switch.h:2313*/ char CODE[(268) + 1]; char GLABUF[(268) + 1]; /*H imp80-switch.h:2313*/ int PLABS[(31) + 1]; int DESADS[(31) + 1]; /*H imp80-switch.h:2313*/ int PLINK[(31) + 1]; /*H imp80-switch.h:2313*/ int SET[(MAXLEVELS) + 1]; int STACKBASE[(MAXLEVELS) + 1]; /*H imp80-switch.h:2313*/ int RAL[(MAXLEVELS) + 1]; /*H imp80-switch.h:2313*/ int FLAG[(MAXLEVELS) + 1]; /*H imp80-switch.h:2313*/ int L[(MAXLEVELS) + 1]; /*H imp80-switch.h:2313*/ int M[(MAXLEVELS) + 1]; /*H imp80-switch.h:2313*/ int NMDECS[(MAXLEVELS) + 1]; /*H imp80-switch.h:2313*/ int ONWORD[(MAXLEVELS) + 1]; /*H imp80-switch.h:2313*/ int ONINF[(MAXLEVELS) + 1]; /*H imp80-switch.h:2313*/ int JUMP[(MAXLEVELS) + 1]; /*H imp80-switch.h:2313*/ int LABEL[(MAXLEVELS) + 1]; /*H imp80-switch.h:2313*/ int JROUND[(MAXLEVELS) + 1]; /*H imp80-switch.h:2313*/ int DIAGINF[(MAXLEVELS) + 1]; /*H imp80-switch.h:2313*/ int DISPLAY[((MAXLEVELS) - (0) + 1)]; //$define DISPLAY[N0] DISPLAY[(N0)-(0)] /*H imp80-switch.h:2313*/ int AUXSBASE[(MAXLEVELS) + 1]; /*H imp80-switch.h:2313*/ int NAMES[(MAXLEVELS) + 1]; /*H imp80-switch.h:2313*/ int AVLWSP[(4) + 1][(MAXLEVELS) + 1]; /* TO DO: %ARRAYFORMAT DECLARATION */ ; int **CTABLE; auto void CNOP(int I, int J); auto void PCLOD(int FROM, int TO); auto void PCONST(int X); auto void PSF1(int OPCODE, int K, int N); auto void PF1(int OPCODE, int KP, int KPP, int N); auto void PSORLF1(int OPCODE, int KP, int KPP, int N); auto void PF2(int OPCODE, int H, int Q, int N, int MASK, int FILLER); auto void PF3(int OPCODE, int MASK, int KPPP, int N); auto void NOTECREF(int CA, int VAL); auto int PARAMDES(int PREC); auto int MAPDES(int PREC); auto int SPECIALCONSTS(int WHICH); auto void STORECONST(int *D, int L, int AD); auto void DUMPCONSTS(void); auto void PLANT(int VALUE); auto void PLUG(int I, int J, int K, int BYTES); auto void CODEOUT(void); auto void PROLOGUE(void); auto void EPILOGUE(void); auto void COMPILEASTMNT(void); auto void CSS(int P); auto void LOADDATA(void); auto void ABORT(void); //*DELSTART auto void PRINTUSE(void); //*DELEND for (I = 0; I != 7; I += 1) { REGISTER[(I)] = 0; GRUSE[(I)] = 0; GRINF1[(I)] = 0; GRAT[(I)] = 0; GRINF2[(I)] = 0; } for (I = 0; I != MAXLEVELS; I += 1) { SET[(I)] = 0; STACKBASE[(I)] = 0; RAL[(I)] = 0; JUMP[(I)] = 0; JROUND[(I)] = 0; LABEL[(I)] = 0; FLAG[(I)] = 0; L[(I)] = 0; M[(I)] = 0; DIAGINF[(I)] = 0; DISPLAY[(I)] = 0; ONWORD[(I)] = 0; ONINF[(I)] = 0; NAMES[(I)] = -1; for (J = 0; J != 4; J += 1) { AVLWSP[(J)][(I)] = 0; } } CTABLE = ; CONSTHOLE = 0; PROLOGUE(); LINE = 0; NEXTP = 1; LEVEL = 1; STMTS = 0; RLEVEL = 0; RBASE = 0; while (A | A != 0) { COMPILEASTMNT(); } LINE = 99999; EPILOGUE(); LOADDATA(); exit(0); void COMPILEASTMNT(void) { int I; //*DELSTART if (DCOMP != 0 && CA > CABUF) { CODEOUT(); PRINTUSE(); } //*DELEND I = NEXTP; NEXTP = NEXTP + (A << 16) + (A << 8) + A; LINE = (A << 8) + A; STMTS = STMTS + 1; CSS(I + 5); // CHECKASLifLINE&7=0 PRINTSTRING("CODE GENERATION NOT ATTEMPTED\n"); /* End of Begin/Rt/Fn/Map depth=2 */ }; void LOADDATA(void) { //*********************************************************************** //*PASSINFORMATIONTOLPUTTOENABLEITTOGENERATETHE* //*LOADERDATAANDCOMPLETETHEPROGRAMFILE.* //*********************************************************************** int LANGFLAG; int PARMS; GLACA = (GLACA + 7) & (-8); USTPTR = (USTPTR + 7) & (-8); CODEOUT(); CNOP(0, 8); DUMPCONSTS(); if (PARMTRACE == 0) LANGFLAG = 6; else LANGFLAG = 1; LANGFLAG = LANGFLAG << 24; PARMS = (PARMDIAG << 1 | PARMLINE) << 1 | PARMTRACE; // LANGRLSE&MAINPROG FIXEDGLA[(4)] = LANGFLAG | 1 << 16 | (CPRMODE & 1) << 8 | PARMS; I = GLACA - GLACABUF; if (INHCODE == 0) { if (!(I == 0)) LPUT(2, I, GLACABUF, ADDR(GLABUF[(0)])); // BACKOFGLAP LPUT(2, FIXEDGLALEN, 0, ADDR(FIXEDGLA[(0)]) // FRONTOFGLAP ); // RELOCATEGLASTADDRESS LPUT(19, 2, 8, 5); // RELOCATECODESTADDRESS LPUT(19, 2, 12, 4); I = 0xE2E2E2E2; LPUT(4, 4, SSTL, ADDR(I)); // } SSTL = (SSTL + 11) & (-8); PRINTSTRING("\nCODE"); WRITE(CA, 6); PRINTSTRING(" BYTES GLAP"); WRITE(GLACA, 3); PRINTSTRING("+"); WRITE(USTPTR, 1); PRINTSTRING(" BYTES DIAG TABLES"); WRITE(SSTL, 3); PRINTSTRING(" 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(" BYTES"); // MARKERFORCOMPTOPRINT NEWLINE(); PRINTCH(13); // SUMMARY if (FAULTY == 0) { WRITE(STMTS, 7); PRINTSTRING(" STATEMENTS COMPILED IN"); WRITE(INT(1000 * (CPUTIME() - CTIME)), 5); PRINTSTRING(" MSECS"); COMREG(47) = STMTS; // NOOFSTMTSFORCOMPER } else { PRINTSTRING("PROGRAM CONTAINS"); WRITE(FAULTY, 2); PRINTSTRING(" FAULT"); if (FAULTY > 1) PRINTSYMBOL('S'); COMREG(47) = FAULTY; // NOOFFAULTSFORCOMPER } NEWLINES(2); NEWLINE(); I = 0; if (FAULTY != 0) I = 8; COMREG(24) = I; if (INHCODE == 0) LPUT(7, 24, 0, ADDR(REGISTER[(0)])); // SUMMARYINFO..REGISTERASBUF PPROFILE(); exit(0); /* End of Begin/Rt/Fn/Map depth=2 */ }; // //*********************************************************************** //*IMPCODEPLANTINGROUTINES* //*CODEANDGLAPAREPUTINTOTHEBUFFERS'CODE,GLABUF(0:268)'* //*BYANUMBEROFTRIVIALROUTINES.LPUTISCALLEDTOADDTHE* //*BUFFERTOTHEOUTPUTFILE.THEBUFFERSAREBASICALLY0:255* //*WITHA12-BYTEMARGINTOMINIMISETHENUMBEROFTESTSFOR* //*THEBUFFERFULLCONDITION* //** //*PPCURR(GLACURR)ISTHEBUFFERPOINTER* //*CA(GLACA)ISTHERELATIVEADDRESSOFTHENEXTBYTE* //*CABUF(GLACABUF)ISCA(GLACA)FORSTARTOFBUFFER* //*********************************************************************** //*DELSTART void RECODE(int S, int F, int AD) { if (S != F) { PRINTSTRING("\nCODE FOR LINE"); WRITE(LINE, 5); NCODE(S, F, AD); } /* End of Begin/Rt/Fn/Map depth=2 */ }; //*DELEND void CODEOUT(void) { if (PPCURR > 0) { //*DELSTART if (DCOMP != 0) RECODE(ADDR(CODE[(0)]), ADDR(CODE[(PPCURR)]), CABUF); //*DELEND if (INHCODE == 0) LPUT(1, PPCURR, CABUF, ADDR(CODE[(0)])); PPCURR = 0; CABUF = CA; } /* End of Begin/Rt/Fn/Map depth=2 */ }; void PLANT(int HALFWORD) { //*********************************************************************** //*ADDAHALFWORDOFBINARYTOTHEBUFFER* //*********************************************************************** if (USEIMP == YES) { CODE[(PPCURR)] = HALFWORD >> 8; CODE[(PPCURR + 1)] = HALFWORD; PPCURR = PPCURR + 2; } else { /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); asm(); asm(); asm(); asm(); } CA = CA + 2; if (PPCURR >= 256) CODEOUT(); /* End of Begin/Rt/Fn/Map depth=2 */ }; void PCONST(int WORD) { //*********************************************************************** //*ADDAWORDOFBINARYTOTHEBUFFER* //*********************************************************************** int I; if (USEIMP == YES) { for (I = 24; I != 0; I += -8) { CODE[(PPCURR)] = WORD >> I & 255; PPCURR = PPCURR + 1; } } else { /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); asm(); asm(); asm(); asm(); } CA = CA + 4; if (PPCURR >= 256) CODEOUT(); /* End of Begin/Rt/Fn/Map depth=2 */ }; void PSF1(int OPCODE, int K, int N) { //*********************************************************************** //*PLANTTHEHALFWORDFORMSOFPRIMARYFORMATNRINSTRNS* //*IFNISTOOLARGEFORTHESHORTFORMPF1ISCALLEDTOPLANT* //*THECORRESPONDINGLONGFORM* //*********************************************************************** int KPP; // ABORTunless0<=K<=2andOPCODE&1=0 if (K == 0 && -64 <= N && N <= 63 || K != 0 && 0 <= N && N <= 511) { if (K != 0) N = N / 4; if (USEIMP == YES) { CODE[(PPCURR)] = OPCODE | K >> 1; CODE[(PPCURR + 1)] = (K & 1) << 7 | N & 127; PPCURR = PPCURR + 2; } else { /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); } CA = CA + 2; if (PPCURR >= 256) CODEOUT(); } else { if (K == 0) KPP = 0; else KPP = 2; PF1(OPCODE, K >> 1 << 1, KPP, N); } /* End of Begin/Rt/Fn/Map depth=2 */ }; void PF1(int OPCODE, int KP, int KPP, int N) { //*********************************************************************** //*PLANTTHENORMALFORMSOFPRIMARYFORMATINSTRNS(IETHOSE* //*WHICHDONOTDEPENDONTHESIZEOFN)* //*********************************************************************** int INC; // ABORTunless0<=KP<=3and0<=KPP<=7andOPCODE&1=0 INC = 2; if (KPP == PC) { if (N < 0) { N = N & 0x7FFFFFFF; NOTECREF(CA, N); } N = (N - CA) / 2; } if ((1 << KPP) & 0b101100 != 0) N = N / 4; if (USEIMP == YES) { 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 { /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); } if (KPP <= 5) INC = 4; PPCURR = PPCURR + INC; CA = CA + INC; if (PPCURR >= 256) CODEOUT(); /* End of Begin/Rt/Fn/Map depth=2 */ }; void PSORLF1(int OPCODE, int KP, int KPP, int N) { //*********************************************************************** //*ASPF1BUTCUTVALIDFORMSTOSHORTFORM* //*********************************************************************** 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 (USEIMP == YES) { CODE[(PPCURR)] = OPCODE | KP >> 1; CODE[(PPCURR + 1)] = (KP & 1) << 7 | (N & 127); } else { /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); } } else { if (KPP == PC) { if (N < 0) { N = N & 0x7FFFFFFF; NOTECREF(CA, N); } N = (N - CA) / 2; } if ((1 << KPP) & 0b101100 != 0) N = N / 4; if (USEIMP == YES) { 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 { /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); } if (KPP <= 5) INC = 4; } CA = CA + INC; PPCURR = PPCURR + INC; if (PPCURR >= 256) CODEOUT(); /* End of Begin/Rt/Fn/Map depth=2 */ }; void PF2(int OPCODE, int H, int Q, int N, int MASK, int FILLER) { //*********************************************************************** //*PLANTSECONDARY(STORETOSTORE)FORMATINSTRNS* //*THESEMAYBE16OR32BITDEPENDINGONQ* //*********************************************************************** // ABORTunless0<=H<=1and0<=Q<=1and0<=N<=127 !andOPCODE&1=0 PLANT(OPCODE << 8 | H << 8 | Q << 7 | N); if (Q != 0) PLANT(MASK << 8 | FILLER); /* End of Begin/Rt/Fn/Map depth=2 */ }; void PF3(int OPCODE, int MASK, int KPPP, int N) { //*********************************************************************** //*PLANTTHETERTIARY(JUMP)FORMATINSTRUCTIONS* //*********************************************************************** // ABORTunless0<=MASK<=15and0<=KPPP<=7andOPCODE&1=0 if (KPPP == PC) { if (N < 0) { N = N & 0x7FFFFFFF; NOTECREF(CA, N); } 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(); /* End of Begin/Rt/Fn/Map depth=2 */ }; void NOTECREF(int CA, int N) { //*********************************************************************** //*NOTETHATA(PC+N)INSTRUCTIONHASNRELATIVETOCONSTTABLE* //*NOTREATIVETOCODE.REMEMBERTHEADDRESSOFTHEINSTRUCTION* //*SOTHATANLPUT(18)CORRECTIONCANBEMADEATENDOFCOMPILATION* //*********************************************************************** /*pending name*/ recfm *CELL; //(LISTF) CELL = ASLIST[(CREFHEAD)]; if (CREFHEAD == 0 || CELL != 0) { PUSH(CREFHEAD, CA, 0, 0); return; } if (CELL == 0) CELL = CA; else CELL = CA; /* End of Begin/Rt/Fn/Map depth=2 */ }; void PCLOD(int FROM, int TO) { //*********************************************************************** //*PLANTASERIESOFINTRUNSFROMARRAYFIXEDCODE* //*********************************************************************** int I; // constintegerarrayFIXEDCODE(0:127) // cycleI=FROM,1,TO // PCONST(FIXEDCODE(I)) // repeat /* End of Begin/Rt/Fn/Map depth=2 */ }; void CNOP(int I, int J) { while (CA & (J - 1) != I) PSF1(JUNC, 0, 1); /* End of Begin/Rt/Fn/Map depth=2 */ }; void PGLA(int BDRY, int L, int INFADR) { int I; int J; J = GLACA; GLACA = (J + BDRY - 1) & (-BDRY); // COMPLETETHEROUNDING GLACURR = GLACURR + GLACA - J; if (L + GLACURR > 256) { if (INHCODE == 0) LPUT(2, GLACURR, GLACABUF, ADDR(GLABUF[(0)])); GLACURR = 0; GLACABUF = GLACA; } for (I = 0; I != L - 1; I += 1) { GLABUF[(GLACURR + I)] = BYTEINTEGER(I + INFADR); } GLACA = GLACA + L; GLACURR = GLACURR + L; /* End of Begin/Rt/Fn/Map depth=2 */ }; void PLUG(int AREA, int AT, int VALUE, int BYTES) { //*********************************************************************** //*WRITEUPTOONEWORDINTOOBJECTFILEOUTOFSEQUENCE* //*********************************************************************** int *WCABUF; int I; int RELAD; int BUFAD; WCABUF = CABUF; BUFAD = ADDR(CODE[(0)]); if (AREA == 2) { WCABUF = GLACABUF; BUFAD = ADDR(GLABUF[(0)]); } RELAD = AT - WCABUF; if (0 <= RELAD && RELAD <= 256 && AREA <= 3) { for (I = 0; I != BYTES - 1; I += 1) { BYTEINTEGER(RELAD + BUFAD + I) = VALUE >> ((BYTES - 1 - I) << 3); } } else { if (RELAD == -2) CODEOUT(); if (INHCODE == 0) LPUT(AREA, BYTES, AT, ADDR(VALUE) + 4 - BYTES); //*DELSTART if (DCOMP == 1 && 1 == AREA) NCODE(ADDR(VALUE) + 4 - BYTES, ADDR(VALUE) + 4, AT); //*DELEND } /* End of Begin/Rt/Fn/Map depth=2 */ }; int PARAMDES(int PREC) { //*********************************************************************** //*SETUPBNDEDL=1DESRIPTORFORPASSINGVARIABLEBYREFERENCE* //*ONLYTHETOPHALFISSETUP* //*********************************************************************** int K; int DES; K = DESADS[(PREC)]; if (!(K == 0)) return K; if (PREC == 4) DES = 0x58000002; else DES = PREC << 27 | 1; STORECONST(K, 4, ADDR(DES)); DESADS[(PREC)] = K; return K; /* End of Begin/Rt/Fn/Map depth=2 */ }; int MAPDES(int PREC) { //*********************************************************************** //*SETUP8BITZEROADDRESSUNSCALEDBCIDESCRTRFORMAPPING* //*********************************************************************** int K; int DES0; int DES1; K = DESADS[(PREC + 8)]; if (!(K == 0)) return K; if (PREC == 4) DES0 = 0x58000002; else DES0 = 0x03000000 | PREC << 27; DES1 = 0; STORECONST(K, 8, ADDR(DES0)); DESADS[(PREC + 8)] = K; return K; /* End of Begin/Rt/Fn/Map depth=2 */ }; int SPECIALCONSTS(int WHICH) { //*********************************************************************** //*PUTSCERTAINSPECIALCONSTANTSINTOTHECONSTANTTABLEON* //*DEMANDANDREMEMBERSTHEIRPOSNTOAVOIDSEARCHONG* //*********************************************************************** const int SCS[(5) + 1] = 0x40800000, 0, 0x41100000, 0, 1, 0; int K; K = DESADS[(WHICH + 16)]; if (!(K == 0)) return K; STORECONST(K, 8, ADDR(SCS[(2 * WHICH)])); DESADS[(WHICH + 16)] = K; return K; /* End of Begin/Rt/Fn/Map depth=2 */ }; void STORECONST(int *D, int L, int AD) { //*********************************************************************** //*PUTTHECONSTANTVALOFLENGTH'L'INTOTHECONSTANTTABLE* //*ACHECKISMADETOSEEIFTHECONSTANTHASALREADY* //*BEENINSERTEDINWHICHCASETHEOLDCOPYISREUSED* //*********************************************************************** int I; int J; int K; int C1; int C2; int C3; int C4; int LP; LP = L / 4; C2 = 0; C3 = 0; C4 = 0; for (I = 0; I != L - 1; I += 1) { BYTEINTEGER(ADDR(C1) + I) = BYTEINTEGER(AD + I); } if (PARMOPT != 0) goto SKIP; // AFTERSTRINGSINCTABLE K = CONSTBTM; if (L == 4) { if (USEIMP == YES) { while (K < CONSTPTR) { if (CTABLE == C1 && CONSTHOLE != K) { D = 4 * K | 0x80000000; return; } K = K + 1; } } else { /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); asm(); AGN1: /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ /*to do*/ /*5*/ asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); asm(); } } else { J = CONSTPTR - LP; while (K <= J) { if (CTABLE == C1 && CTABLE == C2 && CONSTHOLE < K || CONSTHOLE >= K + LP) { if (L == 8 || CTABLE == C3 && CTABLE == C4) { D = 4 * K | 0x80000000; return; } } K = K + 2; } } SKIP: if (L == 4 && CONSTHOLE != 0) { CTABLE = C1; D = 4 * CONSTHOLE | 0x80000000; CONSTHOLE = 0; return; } if (L > 4 && CONSTPTR & 1 != 0) { CONSTHOLE = CONSTPTR; CONSTPTR = CONSTPTR + 1; } D = 4 * CONSTPTR | 0x80000000; CTABLE = C1; CTABLE = C2; if (L == 16) { CTABLE = C3; CTABLE = C4; } CONSTPTR = CONSTPTR + LP; if (CONSTPTR > CONSTLIMIT) FAULT(107, 0); /* End of Begin/Rt/Fn/Map depth=2 */ }; void GETENV(int *HEAD) { //*********************************************************************** //*SAVEACOPYOFTHEREGISTERSTATEFORFUTUREREFERENCE* //*********************************************************************** int I; int USE; for (I = 0; I != 7; I += 1) { // MAINUSEONLY USE = GRUSE[(I)] & 0xFF; if (USE != 0) PUSH(HEAD, GRINF1[(I)], GRAT[(I)], I << 8 | USE); } /* End of Begin/Rt/Fn/Map depth=2 */ }; void RESTORE(int HEAD) { //*********************************************************************** //*RESETTHEREGISTERSTOENVIRONMENTINLISTHEADEDBY'HEAD'* //*********************************************************************** int I; int R; int USE; int INF; int AT; for (I = 0; I != 7; I += 1) { if (REGISTER[(I)] >= 0) { GRUSE[(I)] = 0; GRINF1[(I)] = 0; } } while (HEAD != 0) { POP(HEAD, INF, AT, I); R = I >> 8; USE = I & 255; if (REGISTER[(R)] >= 0) { GRUSE[(R)] = USE; GRINF1[(R)] = INF; } GRAT[(R)] = AT; } /* End of Begin/Rt/Fn/Map depth=2 */ }; void RELOCATE(int GLARAD, int VALUE, int AREA) { //*********************************************************************** //*PLANTSAWORDINTHEGLA(IFGLARAD<0)ANDARRANGESTO* //*RELOCATEITRELATIVETOANAREA(CODE=1,GLA=2,CST=4,GST=5* //*IFTHERELOCATIONISRELATIVETOSYMBOLTABLESTHEWORD* //*CANNOTBERELOCATEDTILLSIZEOFTHECODE(ORGLA)ISKNOWN* //*********************************************************************** if (GLARAD < 0) { PGLA(4, 4, ADDR(VALUE)); GLARAD = GLACA - 4; } LPUT(19, 2, GLARAD, AREA); /* End of Begin/Rt/Fn/Map depth=2 */ }; void GXREF(_imp_string NAME, int MODE, int XTRA, int AT) { //*********************************************************************** //*ASKLPUTTOARRANGEFORADOUBLEWORDAT'AT'INTHEGLA* //*TOCONTAINADESCRIPTORFORNAME'NAME'.* //*MODE=0STATICCODEXREF* //*MODE=1DYNAMICCODEXREF* //*MODE=2DATAXREFXTRA=MINIMIUMLENGTH* //*********************************************************************** int LPUTNO; if (MODE == 2) LPUTNO = 15; else LPUTNO = MODE + 12; LPUT(LPUTNO, XTRA, AT, ADDR(NAME)); /* End of Begin/Rt/Fn/Map depth=2 */ }; void CXREF(_imp_string NAME, int MODE, int XTRA, int *AT) { //*********************************************************************** //*CREATEAZEROEDAREAINTHEGLAANDCALLGXREFTOGET* //*ITFILLEDATLOADTIMEWITHINFORMATIONONANEXTERNALOBJECT* //*PARAMETERSAREASFORGXREF.* //*********************************************************************** int Z1; int Z2; Z1 = 0; Z2 = 0; PGLA(8, 8, ADDR(Z1) // 2ZEROWORDS ); AT = GLACA - 8; GXREF(NAME, MODE, XTRA, AT); /* End of Begin/Rt/Fn/Map depth=2 */ }; void CODEDES(int *AT) { //*********************************************************************** //*PUTACODEDESCRIPTORINTOTHEPLTFORUSEBYDEFINEEP* //*********************************************************************** int DESC1; int DESC2; DESC1 = 0xE1000000; DESC2 = 0; if (CDCOUNT == 0) { FIXEDGLA[(0)] = DESC1; AT = 0; } else { PGLA(8, 8, ADDR(DESC1)); AT = GLACA - 8; } CDCOUNT = CDCOUNT + 1; /* End of Begin/Rt/Fn/Map depth=2 */ }; void DEFINEEP(_imp_string NAME, int ADR, int AT, int MAIN) { //*********************************************************************** //*ANEPCONSISTSOFACODEDESCRIPTORINTHEGLA(PLT)OF* //*FILECONTAININGTHEEP.LPUTISTOLDABOUTTHISANDTHELOADER* //*ARRANGESTOPUTADESCRIPTOR-DESCRIPTORTOTHECODE-DESC* //*INTHEGLAOFANYFILEREFERENCESTHISEP.THISFIRSTWORD* //*OFICLSPLTISTHEMAINEPANDWEMIMICTHISASFARASPOSS* //*********************************************************************** if (AT == 0) FIXEDGLA[(1)] = ADR; else PLUG(2, AT + 4, ADR, 4); RELOCATE(AT + 4, ADR, 1); if (NAME != "") LPUT(11, MAIN << 31 | 2, AT, ADDR(NAME)); /* End of Begin/Rt/Fn/Map depth=2 */ }; void PROLOGUE(void) { //*********************************************************************** //*GENERATESTHESUBROUTINETHATALWAYSAREREQUIREDONTOTHE* //*FRONTOFTHEOBJECTPROGRAMWHERETHEYAREDIRECTLYADDRESABLE* //*********************************************************************** auto int STRINGIN(int POS); auto void ERREXIT(int A, int B, int C); int I; int K; int L; int STCA; I = 0xC2C2C2C2; LPUT(4, 4, 0, ADDR(I)); SSTL = 4; for (I = 0; I != 31; I += 1) { PLABS[(I)] = 0; PLINK[(I)] = 0; DESADS[(I)] = 0; } // // GENERATETHEFIXED-FLOATCONSTANTSTHATMAYBENEEDED // PLABS[(1)] = CA; for (I = 0; I != 1; I += 1) { PCONST(UNASSPAT); } // // GENERATETHERUNTIMEERRORROUTINE:- // MDIAGSFORNRISroutineMDIAGS(intPC,LNB,ERROR,XTRA) // PCISADUMMY(SEGFIELDONLYUSED)EXCEPTAFTERCONTINGENCY // ONENTRYTOTHISSUBROUTINEERROR&XTRAAREINACCAS64BITINTEGER // ENTRYHASBEENBYJLKSORETURNADDRESSSTACKED // // RTFPRCL4TOPLANTPARAMS // JLK+1STACKDUMMYPC // STLNTOSLNBASSECONDPARAMETER // STTOSERRORNOASTHIRDPARAM // LXN(LNB+4)POINTERTOGLA // RALN9TOSTOREDLNB // CALL((XNB+10))VIAXREF=DESCRIPTOR-DESCRIPTOR // JTOSBACKAFTERAMONITOR // PLABS[(2)] = CA; PSF1(PRCL, 0, 4); PSF1(JLK, 0, 1); PF1(STLN, 0, TOS, 0); PF1(ST, 0, TOS, 0); PSF1(LXN, 1, 16); PSF1(RALN, 0, 9); PF1(CALL, 2, XNB, 40); PF1(JUNC, 0, TOS, 0); // // SUBROUTINETOCALLDEBUGROUTINE(S#IMPMON)LINENOINACC // // PRCL4 // STTOS // LXN(LNB+4) // RALN6 // CALL((XNB+IMPMONEPDISP)) // JUNCTOS // if (PARMDBUG != 0) { PLABS[(3)] = CA; CXREF("S#IMPMON", PARMDYNAMIC, 2, K); PSF1(PRCL, 0, 4); PF1(ST, 0, TOS, 0); PSF1(LXN, 1, 16); PSF1(RALN, 0, 6); PF1(CALL, 2, XNB, K); PF1(JUNC, 0, TOS, 0); } // // SUBROUTINETOADVANCESTACKFRONTBYBWORDSANDFILLWITHUNASSIGNED // // JAT12,*+13BISZERO // LSSTOS // STSFTOS // LDTBSTRINGDECRIPTORSETUPDESCRIPTORFORMVL // LDATOS // ASFBADVANCEBYBWORDS // MYB4CHANGEBTOBYTES // LDBBANDMOVETOBOUNDFIELD // MVLL=DRANDFILLWITHX80S // STTOS // JTOSRETURN // if (PARMCHK == 1) { // ONLYREQUIREDWITHCHKING CNOP(0, 4); K = CA; PCONST(0x58000000); PLABS[(4)] = CA; PF3(JAT, 12, 0, 13); PF1(LSS, 0, TOS, 0); PF1(STSF, 0, TOS, 0); PF1(LDTB, 0, PC, K); PF1(LDA, 0, TOS, 0); PF1(ASF, 0, BREG, 0); PSF1(MYB, 0, 4); PF1(LDB, 0, BREG, 0); PF2(MVL, 1, 1, 0, 0, UNASSPAT & 255); PF1(ST, 0, TOS, 0); PF1(JUNC, 0, TOS, 0); } // // SOMEERRORROUTINES // // UNASSIGNEDVARIABLE if (PARMOPT != 0) ERREXIT(5, 0x801, 0); // SWITCHLABELUNSET ERREXIT(6, 0x504, 0); // ILLEGEALEXPONENTIATION ERREXIT(7, 0x505, 1); // EXCESSBLOCKS if (PARMOPT != 0) ERREXIT(8, 0x201, 0); // CAPACITYEXCEEDED ERREXIT(9, 0x601, 0); // NORESULT ERREXIT(10, 21, 0); // CYCLENOTVALID if (PARMOPT != 0) ERREXIT(11, 0x501, 0); // RESFAILS ERREXIT(12, 0x701, 0); // WRONGNOOFPARAMS if (PARMOPT != 0) ERREXIT(13, 36, 0); // // PUTTHESTRINGSONTOTHEFRONTOFCONSTANTAREA // CTABLE = 0x18000001; CTABLE = 4; STCA = 8; L = ADDR(CTABLE); // INCASENOSTRINGS CONSTPTR = 2; while (STRLINK != 0) { I = STRLINK; STRLINK = FROMAR4(I); TOAR4(I, STRINGIN(I + 4) // CHANGELINKTOSTRINGADDR ); } STRLINK = 0x80000000; CONSTBTM = CONSTPTR; if (PARMOPT != 0) { CTABLE = 'IDIA'; CONSTPTR = CONSTPTR + 1; } GXREF(MDEP, PARMDYNAMIC, 2, 40); if (PARMPROF != 0) { // ALLOCATEPROFILECOUNTAREA I = 0x38000001 + LINE; K = 8; PARMPROF = GLACA; PGLA(4, 8, ADDR(I)); K = 0; for (I = 0; I != LINE; I += 1) { PGLA(4, 4, ADDR(K)); } LINE = 0; } LEVEL = 1; for (I = 0; I != 31; I += 1) { if (PLINK[(I)] != 0) CLEARLIST(PLINK[(I)]); } return; int STRINGIN(int POS) { //*********************************************************************** //*PUTASTRINGINTOTHECONSTANTAREACHECKINGFORDUPLICATES* //*********************************************************************** int J; int K; int IND; int HD; /*pending name*/ recfm *CELL; //(LISTF) K = A; if (K == 0) return 0; IND = K & 31; HD = PLINK[(IND)]; while (HD != 0) { CELL = ASLIST[(HD)]; if (CELL == K && STRING(L + CELL) == STRING(ADDR(A))) return CELL - 4; HD = CELL; } HD = STCA; BYTEINTEGER(L + STCA) = K; STCA = STCA + 1; for (J = POS + 1; J != POS + K; J += 1) { BYTEINTEGER(L + STCA) = A; STCA = STCA + 1; } CONSTPTR = ((STCA + 7) & (-8)) >> 2; PUSH(PLINK[(IND)], K, HD, 0); return HD - 4; /* End of Begin/Rt/Fn/Map depth=3 */ }; void ERREXIT(int LAB, int ERRNO, int MODE) { //*********************************************************************** //*MODE=0FORDUMMY(ZERO)XTRA-MODE=1XTRAINBREG* //*********************************************************************** PLABS[(LAB)] = CA; if (MODE == 0) PSF1(LSS, 0, 0); else PF1(LSS, 0, BREG, 0); PSF1(LUH, 0, ERRNO); PSF1(JLK, 0, (PLABS[(2)] - CA) / 2); /* End of Begin/Rt/Fn/Map depth=3 */ }; /* End of Begin/Rt/Fn/Map depth=2 */ }; void CSS(int P) { auto void MERGEINFO(void); auto void REDUCEENV(int *HEAD); auto void ENTERJUMP(int MASK, int STAD, int FLAG); auto int ENTERLAB(int M, int FLAG); auto void REMOVELAB(int LAB); auto void CEND(int KKK); auto int CCOND(int CTO, int A, int B); auto void CHECKSTOF(void); auto int REVERSE(int MASK); auto void SETLINE(void); auto int SETXORYNB(int WHICH, int RLEVEL); auto int XORYNB(int USE, int INF); auto void GETINACC(int ACC, int SIZE, int AC, int AREA, int DISP); auto int AREACODE(void); auto int AREACODE2(int BS); auto void CUI(int CODE); auto void ASSIGN(int A, int B); auto void CSTART(int CCRES, int MODE); auto void CCYCBODY(int UA, int ELAB, int CLAB); auto void CLOOP(int ALT, int MARKC, int MARKUI); auto void CIFTHEN(int MARKIU, int MARKC, int MARKUI, int MARKE, int MARKR, int SKIP); auto void CREATEAH(int MODE); auto void TORP(int *HEAD, int *BOT, int *NOPS); auto int INTEXP(int *VALUE); auto int CONSTEXP(int PRECTYPE); auto void CSEXP(int REG, int MODE); auto void CSTREXP(int A, int B); auto void CRES(int LAB); auto void EXPOP(int A, int B, int C, int D); auto void TESTAPP(int *NUM); auto void SKIPEXP(void); auto void SKIPAPP(void); auto void NOAPP(void); auto int DOPEVECTOR(int A, int B, int MODE, int ID, int *C, int *D); auto void DECLAREARRAYS(int A, int B); auto void DECLARESCALARS(int A, int B); auto void MAKEDECS(int Q); auto void SAVEAUXSTACK(void); auto void RESETAUXSTACK(void); auto void CRSPEC(int M); auto void CFPLIST(int *A, int *B); auto void CFPDEL(void); auto void CLT(void); auto void CQN(int P); auto void GETWSP(int *PLACE, int SIZE); auto void RETURNWSP(int PLACE, int SIZE); auto int TSEXP(int *VALUE); auto void CRCALL(int RTNAME); auto void NAMEOP(int Z, int REG, int SIZE, int NAMEP); auto void CNAME(int Z, int REG); auto void CANAME(int Z, int BS, int DP); auto void CSNAME(int Z, int REG); auto void TESTASS(int REG, int TYPE, int SIZE); auto void COPYTAG(int KK); auto void REDUCETAG(void); auto void REPLACETAG(int KK); auto void RTJUMP(int CODE, int *L); auto void STORETAG(int KK, int SLINK); auto void UNPACK(void); auto void PACK(int *PTYPE); auto void DIAGPOINTER(int LEVEL); auto void RDISPLAY(int KK); auto void RHEAD(int KK); auto void ODDALIGN(void); auto int PTROFFSET(int RLEV); auto void PPJ(int MASK, int N); auto void CRFORMAT(int *OPHEAD); auto int DISPLACEMENT(int LINK); auto int COPYRECORDTAG(int *SUBS); auto void SAVEIRS(void); auto void COPYDR(void); auto void BOOTOUT(int REG); auto void CHANGERD(int REG); auto void FORGET(int REG); auto void REMEMBER(void); auto void NOTEASSMENT(int REG, int ASSOP, int VAR); /* TO DO: %SWITCH DECLARATION */ /*Q imp80-switch.h:4253*/ int SNDISP; int ACC; int K; int KFORM; int STNAME; int MIDCELL; int TCELL; int NUMMOD; int JJ; int JJJ; int KK; int QQ; int MARKER; int REPORTUI; int XDISP; int MASK; int BASE; int AREA; int ACCESS; int DISP; int EXTRN; int CURRINST; int VALUE; int STRINGL; int PTYPE; int I; int J; int OLDI; int USEBITS; int TWSPHEAD; int KKK; int STRFNRES; int MARKIU; int MARKUI; int MARKC; int MARKE; int MARKR; int LITL; int ROUT; int NAM; int ARR; int PREC; int TYPE; /*pending name*/ recfm EXPOPND; //(RD) // RESULTRECORDFOREXPOP CURRINST = 0; TWSPHEAD = 0; int SGRUSE[(7) + 1]; int SGRINF[(7) + 1]; /*H imp80-switch.h:2313*/ goto SW[A]; // INCLUDESOMETHING SW_23: // REDUNDANTSEP SW_24: // SW_2: CSSEXIT: LASTINST = CURRINST; while (TWSPHEAD != 0) { POP(TWSPHEAD, JJ, KK, QQ); RETURNWSP(JJ, KK); } return; //(UI)(S) SW_1: if (!(LEVEL >= 2)) FAULT(57, 0); MARKER = P + 1 + (A << 8) + A; P = P + 3; if (A == 1) goto LABFND; if (A == 2) { SETLINE(); CUI(0); goto CSSEXIT; } MARKE = 0; MARKR = 0; MARKUI = P; MARKIU = MARKER + 1; MARKC = MARKIU + 1; if (A == 3) { CIFTHEN(MARKIU, MARKC, MARKUI, 0, 0, NO); goto CSSEXIT; } CLOOP(A, MARKC + 2, MARKUI); goto CSSEXIT; // 1STOFUIANDNOAPP LABFND: if (!(A == 1 && A == 2)) goto SWITCH; // NOENAMSEORASSNMNT if (!(A == 2 && A == 2)) goto SWITCH; JJ = ENTERLAB(FROMAR2(P + 3), 0); goto CSSEXIT; // cycle SW_5: if (!(LEVEL >= 2)) FAULT(57, 0); if (A == 2) { // OPENCYCLE CLOOP(0, P + 1, 0); } else { CLOOP(6, P + 6, P + 1); } goto CSSEXIT; // // REPEAT SW_6: goto CSSEXIT; //'%CONTROL'(CONST) SW_22: J = FROMAR4(P + 2); CODEOUT(); DCOMP = J >> 28; goto CSSEXIT; // //(iu)(COND)then(UI)(ELSE'') SW_3: MARKIU = P + 1; MARKC = MARKIU + 3; //! FROMAR2(P+2) MARKR = P + 2 + (A << 8) + A; MARKE = 0; if (A == 3) { MARKE = MARKR + 1 + FROMAR2(MARKR + 1); MARKUI = MARKR + 3; } CIFTHEN(MARKIU, MARKC, MARKUI, MARKE, MARKR, NO); goto CSSEXIT; SW_4: //'%FINISH(ELSE')(S) goto CSSEXIT; SWITCH: /* %begin block */ { // SWITCHLABEL int HEAD; int BASEPT; int NAPS; int FNAME; int BITS[(2) + 1]; FORGET(-1); FNAME = FROMAR2(P + 3); if (!(A == 1 && A == 1)) { FAULT2(5, 0, FNAME); goto BEND; } // 1STOFUI+APP P = P + 3; TESTAPP(NAPS); P = P + 6; if (!(INTEXP(JJ) == 0)) { FAULT2(41, 0, 0); goto BEND; } // UNLESSEXPRESSIONEVALUATESAND if (!(NAPS == 1)) { FAULT2(21, NAPS - 1, FNAME); goto BEND; } // NORESTOFAPP if (!(A == 2 && 2 == A)) { FAULT2(5, 0, FNAME); goto BEND; } // NOENAMEORRESTOFASSIGMENT COPYTAG(FNAME); HEAD = K; if (OLDI != LEVEL || TYPE != 6) { FAULT(4, FNAME); goto BEND; } // EXTRACTTABLEADDR,LB&UB FROM123(HEAD, BASEPT, KKK, KK); // KPOINTSTOBITLIST MLINK(HEAD); if (KKK <= JJ && JJ <= KK) goto INBD; FAULT2(50, JJ, FNAME); goto BEND; INBD: Q = JJ - KKK; while (Q >= 96) { MLINK(HEAD); Q = Q - 96; } // // ASLIST(HEAD)ISTHESTARTOF96BITENTRYINTHEBITLIST // CHECKBITNOQTOSEEIFLABELALREADYSETANDTHENSETBITQ // FROM123(HEAD, BITS[(0)], BITS[(1)], BITS[(2)]); // RIGHTWORD QQ = Q >> 5; // BITINWORD Q = Q & 31; JJJ = 1 << Q; if (!(BITS[(QQ)] & JJJ == 0)) FAULT2(6, JJ, FNAME); BITS[(QQ)] = BITS[(QQ)] | JJJ; REPLACE123(HEAD, BITS[(0)], BITS[(1)], BITS[(2)]); // // OPTIMISED(ARR=2)SWITCHESBASEPTPOINTSTOTHE // ZEROETHNOTTHEFIRSTELEMENT // // RESETLBIFDESCTOELEMNT0 if (ARR == 2) KKK = 0; // RELPOSITIONOFLABEL QQ = BASEPT + (JJ - KKK) * 4; // OVERWRITETHEWORDINTABLE PLUG(2, QQ, CA, 4); // RELOCATION(BYHDOFCODE)INTACT BEND: /* End of Begin/Rt/Fn/Map depth=3 */ }; goto CSSEXIT; //(wu)(SC)(COND)(RESTOFWU) SW_7: if (!(LEVEL >= 2)) FAULT(57, 0); // TOWHILE/UNTIL MARKIU = P + 1; // TO(SC)(COND) MARKC = MARKIU + 3; CLOOP(A + 3, MARKC, MARKIU + 1 + FROMAR2(MARKIU + 1)); goto CSSEXIT; // // SIMPLEDECLN SW_8: if (!(LEVEL >= 2)) FAULT(57, 0); if (NMDECS[(LEVEL)] & 1 != 0) FAULT(40, 0); QQ = P; P = P + 5; CLT(); ROUT = 0; LITL = 0; if (A != 1) { // ARRAYDECLARATIONS if (TYPE == 5 && ACC == 0) FAULT(70, 0); NAM = 0; SETLINE(); // QQ=1FORARRAYFORMATS QQ = 2 - A; P = P + 2; DECLAREARRAYS(QQ, 0); } else { if (A == 128) { // NOTLINKED&SHUFFLED CQN(P + 1); P = P + 2; DECLARESCALARS(1, 0); } } goto CSSEXIT; // // end SW_9: /* %begin block */ { /* TO DO: %SWITCH DECLARATION */ /*Q imp80-switch.h:4253*/ goto S[A]; // ENDOFPROGRAM S_1: // ENDOFFILE S_2: if (CPRMODE == 0) CPRMODE = 2; if (!(LEVEL + CPRMODE == 3)) FAULT(15, 0); if (!(A == CPRMODE)) FAULT(56, 0); CEND(CPRMODE); goto BEND; // ENDOFLIST S_3: LIST = 0; goto BEND; // END S_4: CEND(FLAG[(LEVEL)]); BEND: /* End of Begin/Rt/Fn/Map depth=3 */ }; goto CSSEXIT; // SW_11: /* %begin block */ { int MARKER1; int KK; int KKK; _imp_string XNAME; P = P + 1; MARKER1 = FROMAR2(P) //(SEX)(RT)(SPEC'')(NAME)(FPP) + P; // KKONNAME AGN: Q = P; KK = FROMAR2(MARKER1 + 5); EXTRN = A; LITL = EXTRN & 3; if (A == 1) { // P='%SPEC' // 0FORROUTINESPEC P = P + 3; CRSPEC(1 - (EXTRN >> 2)); // 1FOREXTERNAL(ETC)SPEC goto BEND; } COPYTAG(KK); if (OLDI == LEVEL) { // FLAGASFILEOFROUTINES if (CPRMODE == 0) CPRMODE = 2; // if (CPRMODE == 2 && LEVEL == 1) { if (EXTRN == 3) EXTRN = 2; XNAME = STRING(DICTBASE + WORD[(KK)]); if (EXTRN == 1) XNAME = "S#".XNAME; if (EXTRN == 4) XNAME = ""; // CODEDESCRIPTORRELADDR JJ = MIDCELL; if (EXTRN != 4) USEBITS = 2; DEFINEEP(XNAME, CA, JJ, 0); if (JJ != 0) PSF1(INCA, 0, -JJ); } else { // EXTERNALSINPRGMORWRNGLEVEL if (!(EXTRN == 4)) FAULT(55, KK); EXTRN = 4; } if (A == 1) KKK = LITL << 14 | 0x1000; else { // FIGUREOUTPTYPEFORFNS&MAPS ROUT = 1; P = P + 4; CLT(); ARR = 0; NAM = 0; // SETNAMEARRAYBITFORMAPS if (A == 2) NAM = 2; // ANDSTOREPTYPEINKKK PACK(KKK); } } if (!(OLDI == LEVEL && J == 15 && PTYPE == KKK)) { P = Q + 3; CRSPEC(0); P = Q; goto AGN; } // DEALWITHroutinespecFOLLOWED PTYPE = PTYPE | (EXTRN & 3) << 14; // BYexternalroutine /* %begin block */ { int PTR; int PTYPEP; int CNT; int PP; // BODYGIVENSOUPDATETAGSINFO J = 0; REPLACETAG(KK); JJ = K; PLABEL = PLABEL - 1; if (!(COMPILER == 1 || CPRMODE == 2 && LEVEL == 1)) { if (JROUND[(LEVEL + 1)] == 0) { // NOTJUMPOUTSTANDING JROUND[(LEVEL + 1)] = PLABEL; ENTERJUMP(15, PLABEL, 0); } } PTYPEP = PTYPE; P = MARKER1 + 7; RHEAD(KK); N = 20; CNT = 1; while (A == 1) { // WHILESOME(MORE)FPPART PP = P + 1 + FROMAR2(P + 1); P = P + 3; CFPDEL(); PTR = P; /* Deferred: until (A == 2) */ do { // CYCLEDOWNNAMELIST if (JJ != 0) { // EXTRACTPTYPEXTRAINFO FROM12(JJ, J, JJJ); if (!(J >> 16 == PTYPE && PTYPE != 5 || JJJ >> 16 == ACC)) FAULT2(9, CNT, KK); // MOREFPSTHANINSPEC } else FAULT2(8, 0, KK); PTR = PTR + 3; CNT = CNT + 1; MLINK(JJ); } while (!(A == 2)); DECLARESCALARS(0, 0); P = PP; // UNTILNOMOREFP-PART } // TOWORDBOUNDARYAFTERALLSYSTEM N = (N + 3) & (-4); // STANDARDPARAMETERSHAVEBEENDECLARED if (!(JJ == 0)) FAULT2(10, 0, KK); PTYPE = PTYPEP; // STRFNSRESULTPARAMISSTACKED if (PTYPE & 0xF0F == 5) N = N + 8; // ASXTRAPARMJUSTBEFOREDISPLAY RDISPLAY(KK); MAKEDECS(MARKER1 + 1); /* End of Begin/Rt/Fn/Map depth=4 */ }; BEND: /* End of Begin/Rt/Fn/Map depth=3 */ }; goto CSSEXIT; // // REALS(LN) SW_13: if (!(CPRMODE == 0)) FAULT(58, 0); ALLLONG = A & 1; goto CSSEXIT; // // begin SW_14: /* %begin block */ { PTYPE = 0; if (LEVEL == 1 && RLEVEL == 0 && CPRMODE == 0) { CODEDES(JJ); DEFINEEP(MAINEP, CA, JJ, 1); RLEVEL = 1; RBASE = 1; L[(1)] = 0; M[(1)] = 0; DIAGINF[(1)] = 0; AUXSBASE[(1)] = 0; CPRMODE = 1; N = 24; NMAX = N; FORGET(-1); DIAGPOINTER(LEVEL + 1); // // THECODEPLANTEDISASFOLLOWS:- // STD(LNB+3)SAVEDESCRIPTOGTOGLA(PLT) // LXN(LNB+4)TOGLA(PLT) // STLN(XNB+5)SAVELNBFORSTOPSEQUENCE // ASF1FORREPORTWORD // PSF1(STD, 1, 12); PSF1(LXN, 1, 16); PF1(STLN, 0, XNB, 20); // PSF1(ASF,0,1) // // THENEXT8INSTRUCTIONSAREREQUIREDTOSETSF6WORDSINFRONTOFLNB // ANASF1WORKSASWELLEXCEPTFORK-STANDALONEWHENTHEREMAYBE // AUSELESSREDUNDANTDESCRIPTORONTHESTACK // PF1(STLN, 0, TOS, 0); PF1(LSS, 0, TOS, 0); PSF1(IAD, 0, 24); PF1(STSF, 0, TOS, 0); PF1(ISB, 0, TOS, 0); PSF1(ISH, 0, -2); PF1(ST, 0, BREG, 0); PF1(ASF, 0, BREG, 0); // // // SETTHEPROGRAMMASKTOMASKOUTUNDERFLOWANDALLOWALLOTHERINTS // // MPSRX'40C0' // PF1(MPSR, 0, 0, 0x40C0); PTYPE = 1; // SO'ENTERED FROM LINE'ISOK } else SETLINE(); RHEAD(-1); RDISPLAY(-1); MAKEDECS(P + 1); /* End of Begin/Rt/Fn/Map depth=3 */ }; goto CSSEXIT; // SW_15: //'%ON'(EVENT'')(N)(NLIST)'%START' if (!(LEVEL >= 2)) FAULT(57, 0); if (NMDECS[(LEVEL)] & 1 != 0) FAULT(40, 0); // NOMOREDECSANDINONCOND NMDECS[(LEVEL)] = NMDECS[(LEVEL)] | 0x11; if (STACK == 0) { SAVEAUXSTACK(); DISP = AUXSBASE[(LEVEL)]; // SAVETOPOFAUXSTACK PSF1(LSS, 2, DISP); PSF1(ST, 1, DISP + 12); } GRUSE[(ACCR)] = 0; PSF1(CPSR, 1, N + 8); PLABEL = PLABEL - 1; JJJ = PLABEL; // JUMPROUNDONBODY ENTERJUMP(15, JJJ, 0b10); // // SETUPABITMASKINJJ P = P + 2; JJ = 0; /* Deferred: until (A == 2) */ do { // UNTILNOMORENLIST KK = A; if (!(1 <= KK && KK <= 14)) FAULT2(26, KK, 0); JJ = JJ | 1 << (KK - 1); P = P + 2; } while (!(A == 2)); KK = CA; PGLA(4, 4, ADDR(CA)); // ENTRYADDRESSINPLT RELOCATE(GLACA - 4, KK, 1); ONWORD[(LEVEL)] = JJ << 18 | (GLACA - 4); FORGET(-1); // STOREEVENT,SUBEVENT&LINE PSF1(ST, 1, N); PSF1(MPSR, 1, N + 8); ONINF[(LEVEL)] = N; N = N + 12; if (STACK == 0) { // RESETAUXSTACKTOP PSF1(LSS, 1, DISP + 12); PSF1(ST, 2, DISP); } CSTART(0, 3); // NOTINONCOND NMDECS[(LEVEL)] = NMDECS[(LEVEL)] ^ 0x10; // REPLACEENVIRONMENT JJ = ENTERLAB(JJJ, 0b111); goto CSSEXIT; SW_16: if (!(LEVEL >= 2)) FAULT(57, 0); /* %begin block */ { // switch(SWITCHLIST) int Q; int RANGE; int KKK; int KK; int LB; int PP; int D0; int D1; int OPHEAD; int V; int ARRP; int R; Q = P; ARRP = 1; if (PARMOPT == 0) ARRP = 2; /* Deferred: until (A == 2) */ do { // UNTILNO'REST OF SW LIST' P = P + 3; while (A == 1) P = P + 3; // TOP(+'') P = P + 4; // EXTRACTLOWERBOUND KKK = INTEXP(LB); P = P + 3; // EXTRACTUPPERBOUND KKK = KKK | INTEXP(KK); RANGE = (KK - LB + 1); if (RANGE <= 0 || KKK != 0) { FAULT2(38, 1 - RANGE, FROMAR2(Q + 1)); LB = 0; KK = 10; RANGE = 11; } // ZEROETHELEMENTOFFFRONT if (GLACA + 8 - 4 * LB < 0) ARRP = 1; // WORDLABELARRAY PTYPE = 0x56 + (ARRP << 8); PP = P; P = Q + 1; /* Deferred: until (A == 2) */ do { // DOWNNAMELIST K = FROMAR2(P); P = P + 3; OPHEAD = 0; R = LB; // // SETUPABITLIST(96BITSPERCELL)TOCHECKFORSWITCHLABELS // SETTWICE // do { PUSH(OPHEAD, 0, 0, 0); R = R + 96; } while (!(R > KK)); // // FORCHECKINGMODEUSEABOUNDEDWORDDESCRIPTORANDWORDSIZE // ENTRIESPRESETTO"SW LABEL NOT SET".OPTIMISINGUSEBCIWORD // ARRAYSWITHBASESETTOZEROETHELEMENT // FIRSTTABLEENTRY D1 = (GLACA + 15) & (-8); // SCALEDWORDDES D0 = 0x28000000 | RANGE; if (ARRP == 2) { // SETBCIBIT if (!(LB == 0)) D0 = D0 | 0x01000000; D1 = D1 - 4 * LB; } PGLA(8, 8, ADDR(D0)); // WORDPLTDISP SNDISP = (GLACA >> 2) - 2; // RELOCATERELATIVETOGLA RELOCATE(GLACA - 4, D1, 2); PUSH(OPHEAD, D1, LB, KK); KFORM = 0; ACC = 4; J = 1; STORETAG(K, OPHEAD); // // THETABLEWILLCONSISTOFRELATIVEDISPLACEMENTSFROMTHETABLEHEAD // TOTHELABELPOSN.SETALLTOGOTOPLAB(6)INITIALLY // V = PLABS[(6)]; for (KKK = LB; KKK != KK; KKK += 1) { // PLABS(6)RELOCATEDBYHDOFCODE RELOCATE(-1, V, 1); } // FORANYMORENAMESINNAMELIST } while (!(A == 2)); Q = PP; P = Q; // UNTILA(Q)=2 } while (!(A == 2)); /* End of Begin/Rt/Fn/Map depth=3 */ }; goto CSSEXIT; // SW_17: LIST = 1; goto CSSEXIT; // //'%OWN'(TYPE)(OWNDEC) SW_12: /* %begin block */ { //*********************************************************************** //*INITIALISEDDECLARATIONGOINTOTHEGLAORGLASYMBOLTABLES* //*EXCEPTFORCONSTARRAYSWHICHGOINTOTHECODESYMBOLTABLES* //*STRINGSANDARRAYSHAVEAHEADERINTHEGLA.LPUTARRANGES* //*FORTHELOADERTORELOCATETHEHEADERS.* //*EXTERNALSAREIDENTICALWITHOWNBUTALSOHAVEADATAEPDEFN* //*INTHELOADDATASOTHEYCANBEFOUNDATLOADTIME* //*EXTRINSICSHAVEADATAREFERENCEANDADUMMYHEADERINTHEGLA* //*THELOADERUSESTHEFORMERTORELOCATETHELATTER.* //*********************************************************************** auto void CLEAR(int L); auto void STAG(int J, int DATALEN); auto void XTRACTCONST(int CONTYPE, int CONPREC); auto void INITSPACE(int A, int B); int LENGTH; int BP; int PP; int SIGN; int CBASE; int MODE; int UICONST; int ICONST; int TAGDISP; int EPTYPE; int EPDISP; int AH1; int AH2; int AH3; int AH4; int AD; int FNAM; int FINF; int SPOINT; int CONSTSFOUND; int CPREC; int EXTRN; int NNAMES; int MARK; int LPUTP; int MARKER1; int LB; int CTYPE; int CONSTP; int FORMAT; int PTSIZE; int DIMEN; int SACC; int TYPEP; double RCONST; double LRCONST; static double ZERO = 0; _imp_string SCONST; _imp_string NAMTXT; int *STPTR; // NORMALCASEGLASYMBOLTABLES LPUTP = 5; STPTR = USTPTR; // FAULT(40,0)ifNMDECS&1#0 EXTRN = A; // CONST&CONSTANT->0 if (EXTRN >= 4) EXTRN = 0; LITL = EXTRN; if (LITL <= 1) LITL = LITL ^ 1; KFORM = 0; SNDISP = 0; CONSTSFOUND = 0; if (EXTRN == 0) { LPUTP = 4; STPTR = SSTL; } P = P + 3; CBASE = 0; // MODE=1FORNORMALOWNS MODE = A; // MODE=2FOROWNRECORDS if (MODE > 1) goto RECORD; // MODE=3FOROWNRECORDARRAYS CLT(); if (A == 1) CQN(P + 1); else { ARR = 1; NAM = 0; } if (TYPE == 5 && ACC == 0 && 0 == NAM) { FAULT(70, 0); ACC = 2; } ROUT = 0; PACK(PTYPE); if (ARR != 0 && NAM == 0) goto NONSCALAR; P = P + 1; /* Deferred: until (A == 2) */ do { // UNTILNULL MARK = P + 1 + FROMAR2(P + 1); NNAMES = 1; // PPONFIRSTNAME'' PP = P + 3; P = PP + 2; while (A == 1) { NNAMES = NNAMES + 1; P = P + 3; } // PONCONST'' P = P + 1; // // OBTAINTHEINITIALCONSTANT,ITSTYPE(CTYPE)ANDSIGN(SIGN) // ICONST = 0; UICONST = 0; RCONST = 0; LRCONST = 0; SCONST = ""; SIGN = 3; CTYPE = TYPE; CONSTSFOUND = 0; CPREC = PREC; if (NAM != 0) { CTYPE = 1; CPREC = 5; } // if (A == 1) { // CONSTANTGIVEN P = P + 1; XTRACTCONST(CTYPE, CPREC); } // do { // DOWN J = 0; K = FROMAR2(PP); NAMTXT = STRING(DICTBASE + WORD[(K)]); if (NAM != 0) { // OWNNAMESANDARRAYNAMES // NOEXTRINSICNAMES if (EXTRN == 3) FAULT2(46, 0, K); UICONST = 0xFFFF | PREC << 27; PGLA(8, ACC, ADDR(UICONST)); TAGDISP = GLACA - ACC; EPDISP = TAGDISP; } else { if (TYPE == 5) { // STRING QQ = STPTR; AD = ADDR(SCONST); if (EXTRN == 3) { // EXTRINSICSTRINGS // DUMMYSTRINGHEADER AH3 = 0; AH2 = PREC << 27 | ACC; } else { // O/PSTRING if (INHCODE == 0) LPUT(LPUTP, ACC, QQ, AD); STPTR = (STPTR + ACC + 3) & (-4); AH3 = QQ; AH2 = 3 << 27 | ACC; } PGLA(8, 8, ADDR(AH2)); TAGDISP = GLACA - 8; if (EXTRN == 3) GXREF(NAMTXT, 2, 2 << 24 | ACC, TAGDISP + 4); else RELOCATE(TAGDISP + 4, AH3, LPUTP); // DATAINGLASYMBOLTABLES EPTYPE = 5; EPDISP = QQ; } else { // INTEGER&REAL if (EXTRN == 3) { // EXTRINSICS // EXTRINSICSVIAPTR PTYPE = PTYPE | 1 << 10; AH2 = PREC << 27; AH3 = 0; PGLA(8, 8, ADDR(AH2)); TAGDISP = GLACA - 8; GXREF(NAMTXT, 2, 2 << 24 | ACC, TAGDISP + 4); } else { // OWN,EXTERNAL&CONST if (TYPE == 2) { AD = ADDR(RCONST); } else { // INTEGERVARIABLES AD = ADDR(ICONST) + 4 - ACC; } // PUTCONSTANTINTOGLA if (EXTRN != 0) PGLA(ACC, ACC, AD); // OFFSETOFVARFORTAGS TAGDISP = GLACA - ACC; // ANDFORENTRYDEFN EPDISP = TAGDISP; // DATAINADRESSABLEGLA EPTYPE = 2; } } } STAG(TAGDISP, ACC); if (EXTRN == 0 && 0 == NAM) { // CONST=LITERAL REPLACE2(TAGS[(K)], INTEGER(AD & (-4)) // BYTES! ); if (PREC == 6) REPLACE3(TAGS[(K)], INTEGER(AD + 4)); if (PREC == 7) REPLACE3(TAGS[(K)], CONSTP); } PP = PP + 3; NNAMES = NNAMES - 1; } while (!(NNAMES == 0)); P = MARK; } while (!(A == 2)); goto BEND; //'%RECORD' RECORD: //*********************************************************************** //*NOINITIALISATIONOFOWNRECORDSALLOWEDSOTHEYAREALL* //*CLEAREDTOZERO.* //*********************************************************************** // TOFORMATNAME MARKER1 = P + 1 + FROMAR2(P + 1); FNAM = FROMAR2(MARKER1); COPYTAG(FNAM); FINF = TCELL; if (PTYPE != 4) { FAULT(62, FNAM); goto BEND; } PTYPE = 0x133 | LITL << 14; KFORM = FINF; UNPACK(); if (MODE == 3) { FORMAT = 2 - A; P = P + 2; goto RECIN; } // SIZEOFRECORDFROMFORMAT P = P + 1; BP = ACC; PTYPE = 0x33; J = 0; if (A != 3) { CQN(P - 1); PACK(PTYPE); } // SIZEOFHOLEFORPOINTER P = P + 1; PTSIZE = ACC; /* Deferred: until (A == 2) */ do { P = P + 1; K = FROMAR2(P); NAMTXT = STRING(DICTBASE + WORD[(K)]); if (NAM != 0) { // OWNNAMESANDARRAYNAMES // NOEXTRINSICNAMES if (EXTRN == 3) FAULT2(46, 0, K); UICONST = 0xFFFF | PREC << 27; PGLA(8, PTSIZE, ADDR(UICONST)); EPTYPE = 2; TAGDISP = GLACA - PTSIZE; EPDISP = TAGDISP; } else { if (EXTRN == 3) { // EXTRINISIC // FORCENAM=1(IEVIAPOINTER) PTYPE = PTYPE | 0x400; AH2 = 0x18000000 + BP; AH3 = 0; PGLA(8, 8, ADDR(AH2)); TAGDISP = GLACA - 8; // RELOCATEBYEXTERNAL GXREF(NAMTXT, 2, 2 << 24 | BP, TAGDISP + 4); } else { EPDISP = (GLACA + 15) & (-8); AH3 = EPDISP; // TOPWORDOFDESRCIPTOR AH2 = 0x18000000 + BP; PGLA(8, 4, ADDR(AH2) // ADDED18MAR76TOFIXBUG ); // PUTDISPINTOGLA RELOCATE(-1, AH3, 2); // ANDRELOCATERELAPPROPIATEAREA TAGDISP = EPDISP; // DATAINGLATABLES EPTYPE = 2; I = 0; ICONST = 0; while (I < BP) { PGLA(4, 4, ADDR(ICONST)); I = I + 4; } } } // ACCTOSIZEOFRECORD ACC = BP; STAG(TAGDISP, BP); P = P + 2; } while (!(A == 2)); goto BEND; // OWNANDOWNRECORDARRAYS NONSCALAR: //*********************************************************************** //*OWNARRAYSCANBEINITIALISEDBUTONLYONEARRAYCANBE* //*DECLAREDINASTATEMENT.(THANKHEAVENS!)* //*OWNRECORDARRAYSARECLEAREDTOZERO* //*********************************************************************** P = P + 1; FORMAT = 2 - A; RECIN: PP = P + 1; P = P + 3; NNAMES = 1; K = FROMAR2(PP); NAMTXT = STRING(DICTBASE + WORD[(K)]); if (TYPE >= 3) BP = ACC; else BP = BYTES[(PREC)]; SACC = ACC; TYPEP = PTYPE; AH4 = 12 + DOPEVECTOR(TYPE, BP, 0, K, QQ, LB); // DVDISP(+TOPBITFLAG) SNDISP = AH4 - 12; // BUMDOPEVECTOR if (SNDISP == -1) SNDISP = 0; // ASWORDDISPLACEMENT SNDISP = (SNDISP & 0x3FFFF) >> 2; // SAVENOOFDIMENESIONS DIMEN = J; ACC = SACC; PTYPE = TYPEP; UNPACK(); if (LB == 0 && J == 1 && TYPE <= 3) { ARR = 2; PACK(PTYPE); } // NOOFELEMENTS LENGTH = QQ / BP; SPOINT = STPTR; if (MODE != 3 && FORMAT == 0) { // NOTARECORDARRAY if (A == 1) { P = P + 1; INITSPACE(QQ, LENGTH); } } if (CONSTSFOUND == 0) { // NOCONSTANTSGIVEN // SOCLEARANAREATOZERO CONSTSFOUND = LENGTH; if (!(LENGTH < 1 || EXTRN == 3 || FORMAT != 0)) CLEAR(QQ); } else { if (EXTRN == 3 || FORMAT != 0) FAULT2(49, 0, K); } if (EXTRN == 3) EPDISP = 0; else EPDISP = SPOINT; // // OUTPUTANARRAYHEADINTOTHEGLARELATIVETOTHESTARTOFTHESYMBOL- // TABLESINWHICHTHEARRAYRESIDES. // // RESETDIMENSIONSAFTERINITTING J = DIMEN; if (TYPE <= 2) AH1 = PREC << 27 | LENGTH; else AH1 = 3 << 27 | 1 << 25 | QQ; // SETBCIIFBASETOBESHIFTED AH1 = AH1 | (1 - PARMARR) << 24; if (PREC == 4) AH1 = 0x58000002; AH2 = EPDISP; // DVDESPTR=WORDCHKD AH3 = 5 << 27 | 3 * J; if (TYPE <= 3 && PARMARR == 0 && 0 == FORMAT && PARMCHK == 0 && J == 1) AH2 = AH2 - BP * LB; PGLA(8, 16, ADDR(AH1)); TAGDISP = GLACA - 16; if (EXTRN == 3) { // EXTRINSICARRAYS // RELOCATEADDR(A(FIRST)) GXREF(NAMTXT, 2, 2 << 24 | QQ, TAGDISP + 4); } else { // RELOCATEADDR(A(FIRST)) RELOCATE(TAGDISP + 4, AH2, LPUTP); } // RELOCATEDVPOINTER RELOCATE(TAGDISP + 12, AH4, 1); AH4 = (AH4 << 1 >> 3) | 0x80000000; NOTECREF(AH4 | (TAGDISP + 12) >> 2 << 16, (AH4 & 0xFFFF) << 2); // DATAINGLASYMBOLTABLES EPTYPE = 5; STAG(TAGDISP, QQ); goto BEND; void INITSPACE(int SIZE, int NELS) { //*********************************************************************** //*PISTOFIRSTENTRYFORCONSTLIST* //*MAPSPACEONTOWORKFILEENDTOGIVESANEERRORMESSAGEIF* //*THEREWASNOTENOUGHSPACE* //*********************************************************************** int RF; int I; int K; int ELSIZE; int AD; int SPP; int LENGTH; int SAVER; int WSIZE; int WRIT; char **SP; if (SIZE > 4096) WSIZE = 4096; else WSIZE = SIZE; /* TO DO: %ARRAYFORMAT DECLARATION */ ; SAVER = R; R = R + WSIZE + 256; if (R > ARSIZE) FAULT(102, 0); SP = ; if (TYPE == 1) AD = ADDR(ICONST) + 4 - ACC; if (TYPE == 2) AD = ADDR(RCONST); if (TYPE == 5) AD = ADDR(SCONST); SPP = 0; WRIT = 0; ELSIZE = SIZE / NELS; /* Deferred: until (A == 2) */ do { XTRACTCONST(TYPE, PREC); if (A == 1) { // REPITITIONFACTOR P = P + 1; if (INTEXP(RF) != 0) { FAULT(44, CONSTSFOUND); RF = 1; } P = P + 1; } else { RF = 1; P = P + 2; } if (RF <= 0) FAULT(44, CONSTSFOUND); for (I = RF; I != 1; I += -1) { for (K = 0; K != ELSIZE - 1; K += 1) { if (CONSTSFOUND <= NELS) { SP = BYTEINTEGER(AD + K); SPP = SPP + 1; } } CONSTSFOUND = CONSTSFOUND + 1; if (SPP >= 4096) { // EMPTYBUFFER if (INHCODE == 0) LPUT(LPUTP, SPP, STPTR + WRIT, ADDR(SP)); WRIT = WRIT + SPP; SPP = 0; } } // UNTILP=null } while (!(A == 2)); if (CONSTSFOUND != NELS) FAULT(45, CONSTSFOUND); STPTR = (STPTR + 3) & (-4); LENGTH = (SIZE + 3) & (-4); if (INHCODE == 0) LPUT(LPUTP, LENGTH - WRIT, STPTR + WRIT, ADDR(SP)); STPTR = STPTR + LENGTH; R = SAVER; /* End of Begin/Rt/Fn/Map depth=4 */ }; void CLEAR(int LENGTH) { STPTR = (STPTR + 3) & (-4); LENGTH = (LENGTH + 3) & (-4); if (INHCODE == 0) LPUT(LPUTP, LENGTH, STPTR, 0); STPTR = STPTR + LENGTH; /* End of Begin/Rt/Fn/Map depth=4 */ }; void STAG(int J, int DATALEN) { if (EXTRN == 2) LPUT(14, EPTYPE << 24 | DATALEN, EPDISP, ADDR(NAMTXT)); RBASE = CBASE; STORETAG(K, J); RBASE = RLEVEL; /* End of Begin/Rt/Fn/Map depth=4 */ }; void XTRACTCONST(int CONTYPE, int CONPREC) { //*********************************************************************** //*PPOINTSTOP<+'> OF <+'>ANDISUPDATED* //*THECONSTISCONVERTEDTOREQUIREDFORMANDIFINTEGER* //*ISLEFTINICONST,IFREALINRCONSTANDIFSTRINGINSCONST* //*********************************************************************** int LENGTH; int STYPE; int SPREC; int SACC; int CPREC; int MODE; int I; // MAYBECHANGEDIFCONSTISEXPR STYPE = PTYPE; SACC = ACC; if (CONTYPE == 5) { CTYPE = 5; if (A == 4 && A == 2 && A == 0x35 && A == 2) { SCONST = STRING(ADDR(A)); LENGTH = A; P = P + A + 9; } else { FAULT(44, CONSTSFOUND); SCONST = ""; LENGTH = 0; P = P - 3; SKIPEXP(); } } else { MODE = CONPREC << 4 | CONTYPE; if (CONPREC < 5) MODE = CONTYPE | 0x50; CONSTP = CONSTEXP(MODE); // CANTEVALUATEEXPT if (CONSTP == 0) { FAULT(41, 0); CONSTP = ADDR(ZERO); } CTYPE = TYPE; CPREC = PREC; if (CTYPE == 1) { ICONST = INTEGER(CONSTP); if (CONPREC == 6) { UICONST = ICONST; ICONST = INTEGER(CONSTP + 4); } } else { RCONST = LONGREAL(CONSTP); if (CONPREC == 7) { // LONGLONGSUNALIGNEDINAR for (I = 0; I != 15; I += 1) { BYTEINTEGER(ADDR(RCONST) + I) = BYTEINTEGER(CONSTP + I); } } } } PTYPE = STYPE; UNPACK(); ACC = SACC; // // FAULTANYOBVIOUSERRORSIE:- // CONSTANTFOREXTRINSICORINCOMPATIBLETYPEORSTRINGTOOLONG // if (EXTRN == 3 || CTYPE == 5 && LENGTH >= ACC || CONTYPE == 1 && CONPREC == 3 && ICONST > 255 || CONPREC == 4 && ICONST > 0xFFFF) FAULT(44, CONSTSFOUND); /* End of Begin/Rt/Fn/Map depth=4 */ }; BEND: /* End of Begin/Rt/Fn/Map depth=3 */ }; goto CSSEXIT; SW_18: ABORT(); SW_10: /* %begin block */ { // record(RDECLN) //*********************************************************************** //*RECORDSAREALLOCATEDATCOMPILETIMEWHENPOSSIBLE* //*SEECRFORMATFORACTIONONRECORDFORMATDECLARATIONS* //*********************************************************************** int MODE; int RECL; int ALLOC; int FNAM; int FINF; int NAME; int OPHEAD; P = P + 1; MODE = A; SNDISP = 0; if (MODE == 1) { // DEALWITHFORMAT NAME = FROMAR2(P + 1); P = P + 3; CRFORMAT(OPHEAD); K = NAME; PTYPE = 4; J = 0; KFORM = OPHEAD; STORETAG(K, OPHEAD); goto BEND; } P = P + 1; MARKER = P + FROMAR2(P); // FORMATNAME FNAM = FROMAR2(MARKER); COPYTAG(FNAM); FINF = TCELL; if (TYPE != 4) { FINF = DUMMYFORMAT; ACC = 4; FAULT(62, FNAM); } RECL = ACC; if (MODE == 2) { //'%RECORDSPEC' COPYTAG(FROMAR2(P + 2)); if (A == 1 && TYPE == 4) { // SPECFORFORMATELEMENT P = P + 5; Q = DISPLACEMENT(TCELL); UNPACK(); } if (TYPE == 3 && NAM == 1 && FROM3(TCELL) & 0xFFFF == 0) { REPLACE3(TCELL, FINF | K << 16); REPLACE2(TCELL, SNDISP << 16 | RECL); } else FAULT(63, 0); } else { // RECORDDECLARATION if (!(LEVEL >= 2)) FAULT(57, 0); if (NMDECS[(LEVEL)] & 1 != 0) FAULT(40, 0); TYPE = 3; PREC = 3; ROUT = 0; if (A == 1) { // SIMPLERECORDANDRECORDNAMES ALLOC = ACC; CQN(P + 3); ACC = ALLOC; P = P + 4; DECLARESCALARS(1, FINF); } else { // ARRAYSOFRECORDS NAM = 0; // Q=1FORARRAYFORMAT Q = 2 - A; P = P + 4; SETLINE(); DECLAREARRAYS(Q, FINF); } } BEND: /* End of Begin/Rt/Fn/Map depth=3 */ }; goto CSSEXIT; // SW_19: //'*'(UCI)(S) if (!(LEVEL >= 2)) FAULT(57, 0); /* %begin block */ { auto void CIND(void); int FNAME; int ALT; int OPCODE; int FORM; int H; int Q; int MASK; int FILLER; /* TO DO: %SWITCH DECLARATION */ /*Q imp80-switch.h:4253*/ /* TO DO: %SWITCH DECLARATION */ /*N imp80-switch.h:2793*/ /* TO DO: %SWITCH DECLARATION */ /*N imp80-switch.h:2793*/ /* TO DO: %SWITCH DECLARATION */ /*N imp80-switch.h:2793*/ ALT = A; P = P + 2; OPCODE = CALL; goto SW[ALT]; SW_1: SW_2: FNAME = FROMAR2(P); COPYTAG(FNAME); if (!(ROUT == NAM && NAM == 0 && ARR == 0 && PREC > 4 && I == RBASE && TYPE != 7)) FAULT(33, FNAME); if (ALT == 1) PSF1(ST, 1, K); else GETINACC(ACCR, BYTES[(PREC)] >> 2, 0, LNB, K); goto EXIT; // PUT(HEXHALFWORD) SW_3: TYPE = A; PREC = TYPE >> 4; TYPE = TYPE & 7; if (!(TYPE == 1 && PREC < 6)) FAULT(32, 0); if (PREC == 5) P = P + 2; PLANT(FROMAR2(P + 1)); goto EXIT; // CNOP SW_5: CNOP(A, A); goto EXIT; // ASSEMBLER SW_4: // FORM=PRIMARY,SECONDARYOR3RY FORM = A; OPCODE = A; P = P + 2; goto F[FORM]; // ALLPRIMARYFORMATINSTRUCTIONS F_1: ALT = A; P = P + 1; goto POP[ALT]; // LABELNAME POP_1: FNAME = FROMAR2(P); P = P + 2; ENTERJUMP(OPCODE << 24 | 3 << 23, FNAME, 0); goto EXIT; // DIRECTSYMBOLIC POP_2: CIND(); POPI: PSORLF1(OPCODE, ACCESS, AREA, DISP); goto EXIT; // INDIRECTSYMBOLIC POP_3: CIND(); ACCESS = 4 - A; P = P + 1; goto POPI; // DRSYMBOLICALLYMODIFIED POP_4: CIND(); ACCESS = 1; goto POPI; //(DR)&(DR+B) POP_5: ACCESS = 4 - A; AREA = 7; DISP = 0; P = P + 1; goto POPI; // B POP_6: ACCESS = 0; AREA = 7; DISP = 0; goto POPI; // SECONDARY(STORE-TOSTORE)FORMAT F_2: MASK = 0; FILLER = 0; Q = 0; FNAME = 0; H = 2 - A; if (H == 0) { FNAME = FROMAR2(P + 1) - 1; P = P + 2; } if (!(0 <= FNAME && FNAME <= 127)) FAULT(32, 0); ALT = A; P = P + 2; if (ALT == 1) { Q = 1; MASK = FROMAR2(P); FILLER = FROMAR2(P + 2); P = P + 4; if (!(0 <= MASK | FILLER && MASK | FILLER <= 255)) FAULT(32, 0); } PF2(OPCODE, H, Q, FNAME, MASK, FILLER); goto EXIT; // TERTIARYFORMAT F_3: MASK = FROMAR2(P); ALT = A; if (!(0 <= MASK && MASK <= 15)) FAULT(32, 0); P = P + 3; goto TOP[ALT]; // LABEL TOP_1: FNAME = FROMAR2(P); P = P + 2; ENTERJUMP(OPCODE << 24 | MASK << 21, FNAME, 0); goto EXIT; // SYMBOLICOPERAND TOP_2: CIND(); if (AREA >= 6) FAULT(32, 0); if (AREA == LNB || AREA == XNB || AREA == CTB) DISP = DISP / 4; TOPI: PF3(OPCODE, MASK, AREA, DISP); goto EXIT; //(DR)&(DR+B) TOP_3: DISP = 0; AREA = 8 - A; P = P + 1; goto TOPI; //(DR+N) TOP_4: DISP = FROMAR2(P); P = P + 2; AREA = 1; goto TOPI; void CIND(void) { //*********************************************************************** //*COMPILEASYMBOLICOPERANDBYSETTINGACCESS,AREA&DISP* //*********************************************************************** int ALT; int AFN; int FN0; int FN1; int FN2; int FN3; int JJ; int D; int CTYPE; int CPREC; /* TO DO: %SWITCH DECLARATION */ /*Q imp80-switch.h:4253*/ AFN = ADDR(FN0); ALT = A; ACCESS = 0; P = P + 1; goto SW[ALT]; //(=')(PLUS')(ICONST) SW_1: // PAST(='') P = P + 1; D = A; CTYPE = A; CPREC = CTYPE >> 4; CTYPE = CTYPE & 7; if (CPREC == 4) FN0 = FROMAR2(P + 2); else { for (JJ = 0; JJ != BYTES[(CPREC)] - 1; JJ += 1) { BYTEINTEGER(AFN + JJ) = A; } } P = P + 2 + BYTES[(CPREC)]; if (D == 2) { if (CTYPE == 2) FN0 = FN0 ^ 0x80000000; else { if (CPREC == 6) LONGINTEGER(AFN) = -LONGINTEGER(AFN); else FN0 = -FN0; } } CNST: if (!(CTYPE == 1 && CPREC <= 5 && X 'FFFE0000' <= FN0 && FN0 <= 0x1FFFF)) goto LIT; AREA = 0; DISP = FN0; return; LIT: if (!(1 <= CTYPE && CTYPE <= 2 && 5 <= CPREC && CPREC <= 7)) FAULT(32, 0); STORECONST(DISP, BYTES[(CPREC)], AFN); AREA = PC; ACCESS = 0; return; //(NAME)(OPTINC) SW_2: FN0 = FROMAR2(P); P = P + 2; COPYTAG(FN0); if (LITL == 1 && ARR == 0) { CTYPE = TYPE; CPREC = PREC; ALT = TAGS[(FN0)]; FROM123(ALT, D, FN0, FN1); if (CPREC == 7) AFN = FN1; goto CNST; } if (TYPE >= 6 || TYPE == 4 || ROUT == 1 && NAM == 0) { FAULT(33, FN0); return; } if (ROUT == 1) K = FROM1(K); AREA = LNB; if (I != RBASE) AREA = SETXORYNB(XNB, I); ALT = A; D = FROMAR2(P + 1); if (ALT == 1) K = K + D; if (ALT == 2) K = K - D; P = P + 1; if (ALT <= 2) P = P + 2; DISP = K; return; //'('(REG)(OPTINC)')' SW_3: AREA = A + 1; ALT = A; P = P + 2; DISP = 0; D = FROMAR2(P); if (ALT == 1) DISP = D; if (ALT == 2) FAULT(32, 0); if (AREA == PC) DISP = CA + 2 * DISP; else DISP = 4 * DISP; if (!(ALT == 3)) P = P + 2; return; //'%TOS' SW_4: AREA = 6; DISP = 0; /* End of Begin/Rt/Fn/Map depth=4 */ }; EXIT: GRUSE[(ACCR)] = 0; GRUSE[(DR)] = 0; GRUSE[(BREG)] = 0; if (OPCODE == CALL || OPCODE == LXN || OPCODE == JLK || OPCODE == OUT) GRUSE[(XNB)] = 0; if (OPCODE == CALL || OPCODE == LCT || OPCODE == JLK || OPCODE == OUT) GRUSE[(CTB)] = 0; /* End of Begin/Rt/Fn/Map depth=3 */ }; goto CSSEXIT; SW_20: //'%TRUSTEDPROGRAM' if (PARMARR == 0 && PARMCHK == 0) COMPILER = 1; goto CSSEXIT; //'%MAINEP'(NAME) SW_21: KK = FROMAR2(P + 1); if (!(CPRMODE == 0)) FAULT(58, 0); MAINEP = STRING(DICTBASE + WORD[(KK)]); goto CSSEXIT; void CRFORMAT(int *OPHEAD) { //*********************************************************************** //*CONVERTSARECORDFORMATSTATEMENTTOALISTHEADEDBYOPHEAD* //*FORMATOFANENTRY.* //*S1=SUBNAME<<20!PTYPE<<4!J* //*S2,S3=416BITDISPLACEMENTSD2,ACC,D1,KFORM* //*NORMALLYD1=RECORDRELATIVEDISPLACEMENTANDACC=LMAX(STRINGS)* //*FORARRAYSD2=FIRSTELEMENTDISPLACEMENTANDD1=DISPLACEMENT* //*OFRECORDRELATIVEARRAYHEADINTHEGLA* //*KFORMISONLYUSEDFORRECORDSANDPOINTSTOTHEFORMAT* //*ONEXITACCHASTHERECORDSIZEROUNDEDUPTOTHEBOUNDARY* //*REQUIREDBYITSLARGESTCOMPONENT* //*********************************************************************** int D1; int D2; int NLIST; int FORM; int RL; int MRL; int UNSCAL; int SC; int DESC; int FN; int INC; int Q; int R; int A0; int A1; int A2; int DV; int RFD; int LB; int OB; int TYPEP; int SACC; /* TO DO: %SWITCH DECLARATION */ /*Q imp80-switch.h:4253*/ auto void SN(int Q); auto void ROUND(void); NLIST = 0; OPHEAD = 0; FORM = 0; ACC = 0; OB = 0; // INCCOUNTSDOWNRECORD MRL = 0; INC = 0; NEXT: ROUT = 0; LITL = 0; NAM = 0; RFD = A; if (RFD <= 2) { P = P + 1; CLT(); } goto RFEL[RFD]; //(TYPE)(QNAME'')(NAMELIST) RFEL_1: CQN(P); P = P + 1; PACK(PTYPE); D2 = 0; RL = 3; if (NAM == 0 && 3 <= PREC && PREC <= 4) RL = PREC - 3; AGN: ROUND(); J = 0; /* Deferred: until (A == 2) */ do { D1 = INC; SN(P); P = P + 3; INC = INC + ACC; } while (!(A == 2)); // EXTRA2FORRECORDSTOSKIPFORMAT P = P + (RFD >> 2 << 1); TRYEND: if (A == 2) goto END; P = P + 1; goto NEXT; //(TYPE)array(NAMELIST)(BPAIR) RFEL_2: RFEL2: Q = P; ARR = 1; PACK(PTYPE); if (TYPE <= 2) { UNSCAL = 0; SC = PREC; } else { UNSCAL = 1; SC = 3; } if (PREC == 4) DESC = 0x58000002; else DESC = SC << 27 | UNSCAL << 25 | (1 - PARMARR) << 24; /* Deferred: until (A == 2) */ do { // UNTILNULL do P = P + 3; while (!(A == 2)) TYPEP = PTYPE; SACC = ACC; DV = DOPEVECTOR(TYPE, ACC, 0, FROMAR2(Q), R, LB) + 12; // DOPEVECTORINTOSHAREABLES.T. ACC = SACC; PTYPE = TYPEP; UNPACK(); if (TYPE == 5 || TYPE == 1 && PREC == 3) RL = 0; else RL = 3; ROUND(); /* Deferred: until (A == 2) */ do { // HEADINTOGLAFOREACHARRAY A0 = R; if (UNSCAL == 0) A0 = A0 / ACC; // STRINGDESCRIPTORS! if (PREC == 4) A0 = 0; A0 = A0 | DESC; A1 = INC; if (TYPE <= 3 && PARMARR == 0 && 0 == PARMCHK && J == 1) A1 = A1 - LB * ACC; A2 = 5 << 27 | 3 * J; PGLA(4, 16, ADDR(A0)); D1 = GLACA - 16; // RELOCATEDVPOINTER RELOCATE(D1 + 12, DV, 1); NOTECREF(0x80000000 | (DV << 1 >> 3) | (D1 + 12) >> 2 << 16, (DV & 0xFFFF) << 2); D2 = INC; SN(Q); INC = INC + R; Q = Q + 3; } while (!(A == 2)); P = P + 1; Q = P; } while (!(A == 2)); if (RFD == 5) P = P + 2; goto TRYEND; // record(array)name RFEL_3: TYPE = 3; PREC = 3; NAM = 1; ARR = 2 - A; P = P + 2; PACK(PTYPE); D2 = 0; RL = 3; ACC = 8 + 8 * ARR; FORM = 0; goto AGN; // RECORDSINRECORDS RFEL_4: // RECORDARRAYSINRECORDS RFEL_5: Q = P + FROMAR2(P + 1) + 1; FN = FROMAR2(Q); // COPYFORMATTAG&SETACC COPYTAG(FN); if (!(PTYPE == 4)) FAULT(62, FN); TYPE = 3; PREC = 3; FORM = TCELL; if (RFD == 4) { PTYPE = 0x33; P = P + 3; D2 = 0; RL = 3; goto AGN; } P = P + 3; goto RFEL2; // FINISHOFF END: RL = MRL; ROUND(); // SIZEROUNDEDAPPROPRIATELY ACC = INC; if (!(INC <= 0x7FFF)) FAULT(98, 0); CLEARLIST(NLIST); return; void SN(int Q) { //*********************************************************************** //*CHECKTHESUBNAMEHASNOTBEENUSEDBEFOREINTHISFORMAT* //*ANDENTERITWITHITSDESCRIPTORSINTOTHELIST.* //*********************************************************************** FNAME = FROMAR2(Q); if (!(FIND(FNAME, NLIST) == -1)) FAULT2 (61, 0, FNAME); BINSERT(OPHEAD, OB, FNAME << 20 | PTYPE << 4 | J, D2 << 16 | ACC, D1 << 16 | FORM); PUSH(NLIST, 0, FNAME, 0); /* End of Begin/Rt/Fn/Map depth=4 */ }; void ROUND(void) { if (RL > MRL) MRL = RL; while (INC & RL != 0) INC = INC + 1; /* End of Begin/Rt/Fn/Map depth=4 */ }; /* End of Begin/Rt/Fn/Map depth=3 */ }; // OFROUTINECRFORMAT int DISPLACEMENT(int LINK) { //*********************************************************************** //*SEARCHAFORMATLISTFORASUBNAME* //*A(P)HASENAME--LINKISHEADOFRFORMATLIST.RESULTISDISP* //*FROMSTARTOFRECORD* //*********************************************************************** /*pending name*/ /*pending name*/ /*pending name*/ recfm *FCELL; recfm *PCELL; recfm *LCELL; //(LISTF) int RR; int II; int ENAME; int CELL; ENAME = (A << 8) + A; CELL = 0; if (LINK != 0) { // CHKRECORDSPECNOTOMITTED // ONTOFORMATTAGCELL FCELL = ASLIST[(LINK)]; // LINKTOSIDECHAIN LINK = FCELL & 0x7FFF; CELL = LINK; II = -1; ACC = -1; while (LINK > 0) { LCELL = ASLIST[(LINK)]; if (LCELL >> 20 == ENAME) { // RIGHTSUBNAMELOCATED TCELL = LINK; RR = LCELL; SNDISP = LCELL; K = LCELL; J = RR & 15; PTYPE = RR >> 4 & 0xFFFF; ACC = SNDISP & 0xFFFF; SNDISP = (SNDISP & 0xFFFF0000) / 0x10000; KFORM = K & 0xFFFF; K = K >> 16; if (LINK != CELL) { // NOTTOPCELLOFFORMAT PCELL = LCELL; LCELL = CELL; FCELL = FCELL & 0xFFFF0000 | LINK; } // ARRANGINGLISTWITHTHISSUBNAME // ATTHETOP return K; } PCELL = LCELL; LINK = LCELL; } } FAULT(65, ENAME); if (CELL > 0) PUSH(ASLIST[(CELL)], ENAME << 20 | 7 << 4, 0, 0); PTYPE = 7; TCELL = 0; return -1; /* End of Begin/Rt/Fn/Map depth=3 */ }; int COPYRECORDTAG(int *SUBS) { //*********************************************************************** //*PRODUCEPTYPEETCFORACOMPOUNDNAMEBYCHAININGDOWNONE* //*ONEORMORERECORDFORMATLISTS.ONEXITRESULT=0IFNO* //*SUBNAMEFOUNDORSUBNAMEISOFTYPERECORDWITHNOFURTHER* //*SUBNAMEATTACHED.RESULT#0IFBONE-FIDESUBNAMELOCATED* //*ONENTRYKFORMHASPOINTERTOTHE(FIRST)FORMATLISTAND* //*PPOINTSTOTHEA.R.ENTRYFOR(FIRST)ENAME* //*********************************************************************** int Q; int FNAME; SUBS = 0; do { FNAME = KFORM; P = P + 2; SKIPAPP(); // NO(FURTHER)ENAME if (A == 2 || FNAME <= 0) return 0; SUBS = SUBS + 1; P = P + 1; Q = DISPLACEMENT(FNAME); UNPACK(); } while (!(TYPE != 3)); // GIVES0IFSUBNAMENOTKNOWN return Q + 1; /* End of Begin/Rt/Fn/Map depth=3 */ }; void CRNAME(int Z, int REG, int MODE, int BS, int AR, int DP, int *NAMEP) { //*********************************************************************** //*DEALWITHRECORDELEMENTNAMES.ZASFORCNAME.CLINK=TAGS(RN)* //*MODE=ACCESSFORRECORD(NOTTHEELEMENT!)* //*ONEXITBASE,AREA&DISPPOINTTOREQUIREDELEMENT* //*RECURSIVECALLISNEEDEDTODEALWITHRECORDSINRECORDS* //*DEPTHSHEWSRECURSIVELEVELS-NEEDEDTOAVOIDMISSETTING* //*REGISTERINUSEIFRECORDNAMEINRECORDHASTHESAMENAMEAS* //*AGENUINERECORDNAME.* //*********************************************************************** int DEPTH; int FNAME; auto void CENAME(int MODE, int FNAME, int BS, int AR, int DP, int XD); DEPTH = 0; // POINTERTOFORMAT FNAME = KFORM; if (ARR == 0 || Z == 6 && A == 2) { // SIMPLERECORD if (A == 2) P = P + 3; else NOAPP(); CENAME(MODE, FNAME, BS, AR, DP, 0); } else { CANAME(ARR, BS, DP); CENAME(ACCESS, FNAME, BASE, AREA, DISP, 0); } return; // void CENAME(int MODE, int FNAME, int BS, int AR, int DP, int XD) { //*********************************************************************** //*FINDSOUTABOUTSUBNAMEANDACTSACCORDINGLY.MOSTLYACTION* //*CONSISTSOFUPPINGXDBYOFFSETOFTHESUBNAMEBUTISVERY* //*HAIRYFORRECORDSINRECORDSETC* //*MODEISACCESSFORTHERECORD* //*********************************************************************** auto void FETCHRAD(void); auto void LOCALISE(int SIZE); int Q; int QQ; int D; int C; int W; DEPTH = DEPTH + 1; if (A == 2) { // ENAMEMISSING ACCESS = MODE; AREA = AR; XDISP = XD; // FORPOINTER BASE = BS; DISP = DP; if (Z < 14) { // NOTARECORDOPERATION if (!(3 <= Z && Z <= 4 || Z == 6)) { // ADDR(RECORD) FAULT(64, 0); BASE = RBASE; AREA = -1; DISP = 0; ACCESS = 0; PTYPE = 1; UNPACK(); } } return; } // FINDOUTABOUTSUBNAME P = P + 1; // TCELLPOINTSTOCELLHOLDING Q = DISPLACEMENT(FNAME); // INFOABOUTTHESUBNAME UNPACK(); if (Q == -1 && -1 == ACC || PTYPE == 7) { // WRONGSUBNAME(HASBEENFAULTED) P = P + 2; SKIPAPP(); P = P - 3; ACCESS = 0; BASE = RBASE; DISP = 0; AREA = -1; return; } // NAMEP=-1UNALTERED! NAMEP = (A << 8 | A) << 16 | NAMEP; // ARRAYSINCLUDINGRECORDARRAYS if (ARR == 1) goto AE; if (A == 2) P = P + 3; else NOAPP(); if (TYPE <= 2 || TYPE == 5 || TYPE == 3 && A == 2 && 3 <= Z && Z <= 4 || Z == 6) { ACCESS = MODE + 4 + 4 * NAM; BASE = BS; AREA = AR; DISP = DP; XDISP = XD + Q; return; } // // NOWCODINGBECOMESHAIRY:-STILLLEFTARE // A)RECORDSINRECORDSQPOINTSTOSECONDARYRECORD // B)RECORDNAMESINRECORDSQHASOFF-SETOFAPOINTER // C)RECORDARRAYNAMESINRECORDSQHASOFF-SETAHEADERINRECORD // D)RECORDARRAYSINRECORDSNOTYETALLOWED // QWOULDHAVEOFF-SETOFARECORDRELATIVEHEADERINTHEGLA // XD = XD + Q; NAMEP = -1; if (NAM == 1) { if (MODE == 0) { DP = DP + XD; XD = 0; MODE = 2; } else { // PICKUPRECNAMEDESCR&STCK LOCALISE(8); AR = AREA; DP = DISP; BS = BASE; } } CENAME(MODE, KFORM, BS, AR, DP, XD); return; // ARRAYSANDARRAYNAMESASELEMEN AE: FROM123(TCELL, Q, SNDISP, K); ACC = SNDISP & 0xFFFF; SNDISP = (SNDISP & 0xFFFF0000) / 0x10000; KFORM = K & 0xFFFF; K = K >> 16; C = ACC; D = SNDISP; Q = K; QQ = KFORM; if (Z == 6 || Z == 12 && A == 2) { //'GET ARRAYHEAD'CALL P = P + 3; if (NAM == 1) { ACCESS = MODE + 8; BASE = BS; AREA = AR; DISP = DP; XDISP = XD + Q; return; } // // PASSINGANARRAYINARECORDBYNAMEMUSTCONSTRUCTPROPERARRAYHEAD // FROMTHERECORDRELATIVEONEATQ(GLA) // NAMEP = -1; FETCHRAD(); AREA = -1; DISP = Q; BASE = 0; ACCESS = 0; CREATEAH(1); } else { // ARRAYELEMENTSINRECORDS NAMEP = -1; if (NAM == 1) { // ARRAYNAMES-FULLHEADINRECORD XD = XD + Q; // MOVEHEADUNDERLNB LOCALISE(16); // ARRAYMODESETSDISP,AREA&BASE CANAME(3, BASE, DISP); } else { // ARRAYRELATIVEHEADINGLA if (MODE == 0 || MODE == 2) { if (MODE == 0) W = DP - 4; else W = DP + 4; } else { // RECORDADDRTOACC FETCHRAD(); GETWSP(W, 1); PSF1(ST, 1, W); XD = 0; BS = RBASE; } // RECORDRELARRAYACCESS CANAME(3, 0, Q); // CANRETURNACCESS=1OR3ONLY if (PARMARR == 0 && 0 == PARMCHK && ACCESS == 3 && PREC == 3 || TYPE >= 3) { PSORLF1(ADB, 0, AREACODE2(BS), W); if (!(XD == 0)) PSF1(ADB, 0, XD); GRUSE[(BREG)] = 0; } else { GETINACC(DR, 2, 0, AREACODE(), Q); PSORLF1(INCA, 0, AREACODE2(BS), W); if (ACCESS == 1) { ACCESS = 2; AREA = 7; XD = XD + NUMMOD * BYTES[(PREC)]; } if (!(XD == 0)) PSF1(INCA, 0, XD); FORGET(DR); // ANDACCESS=2OR3ONLY AREA = 7; DISP = 0; if (TYPE == 3 && A == 1) { // WILLBEAFURTHERCALL // ONROUTINECENAME GETWSP(DISP, 2); PSF1(STD, 1, DISP); AREA = LNB; BASE = RBASE; } } } if (TYPE == 3) CENAME(ACCESS, QQ, BASE, AREA, DISP, 0); } return; void FETCHRAD(void) { //*********************************************************************** //*SETACCTO32BITADDRESSOFRECORD.* //*********************************************************************** ACCESS = MODE + 4; AREA = AR; BASE = BS; DISP = DP; XDISP = XD; NAMEOP(4, ACCR, 4, -1); /* End of Begin/Rt/Fn/Map depth=5 */ }; void LOCALISE(int SIZE) { //*********************************************************************** //*REMOVESADESCRIPTORORARRAYHEADFROMARECORDANDSTORES* //*ITINATEMPORARYUNDERLNB.* //*********************************************************************** int HOLE; ACCESS = MODE + 4; AREA = AR; BASE = BS; DISP = DP; XDISP = XD; NAMEOP(2, ACCR, SIZE, -1); GETWSP(HOLE, SIZE >> 2); PSF1(ST, 1, HOLE); MODE = 2; AREA = LNB; BASE = RBASE; DISP = HOLE; XD = 0; /* End of Begin/Rt/Fn/Map depth=5 */ }; // OFROUTINELOCALISE /* End of Begin/Rt/Fn/Map depth=4 */ }; // OFROUTINECENAME /* End of Begin/Rt/Fn/Map depth=3 */ }; // OFROUTINECRNAME void CSTREXP(int MODE, int REG) { //*********************************************************************** //*PLANTIN-LINECODEFORCONCATENATION.AWORKAREAUNDER* //*BASEREGISTERCOVERISUSUALLYREQUIRED.THECURRENTLENGTH* //*OFSTRINGINTHEWORKAREAISKEPTINAREGISTER(BREG)* //*WHICHISPROTECTEDTHROUGHTHENORMALINTERMEDIATE-RESULT* //*MECHANISMS.* //*ONENTRY:-* //*MODE=0NORMAL.WKAREANOTUSEDFORONEOPERANDEXPSSNS* //*MODE=1STRINGMUSTGOTOWORKAREA* //*(ANDTOCOME)* //*MODE=3CONCATENATEINTOLHSOF=ASSNMNT(E.G.A=B.C)* //*MODE=4OPTIMISES=S.TBYNOTCOPYINGS* //*2**4BITOFMODEISSETIFWK-AREANOTTOBEFREEDONEXIT* //*ONEXIT:-* //*BASE,DISP&INDEXDEFINERESULT* //*VALUE#0ifRESULTINAWORKAREA(CCONDMUSTKNOW)* //*STRINGLSETIFSTRINGLENGTHKNOWN.STRFNRESDEFINESLENREG* //*********************************************************************** int PP; int WKAREA; int DOTS; int REXP; int ERR; int CLEN; int KEEPWA; int FNAM; auto int STROP(int REG); KEEPWA = MODE & 16; MODE = MODE & 15; PP = P; STRINGL = 0; FNAM = 0; WKAREA = 0; //=0ifONEOPERANDEXP REXP = 2 - A; if (!(A == 4 && REXP == 0 && MODE == 0)) goto NORMAL; if (A == 2) goto SIMPLE; if (!(A == 1)) goto NORMAL; // COPYTAG(FROMAR2(P+5)) // ifPTYPE=SNPTthenPTYPE=TSNAME(K) //->NORMALunlessROUT=0 // BEWAREOFMAP=FN //->NORMALifPARMARR=1and(ARR#0orA(P+7)=1) SIMPLE: P = P + 4; ERR = STROP(REG); if (!(ERR == 0)) goto ERROR; VALUE = WKAREA; P = P + 1; STRFNRES = 0; return; ERROR: FAULT2(ERR, 0, FNAM); BASE = RBASE; DISP = 0; VALUE = 0; ACCESS = 0; P = PP; SKIPEXP(); return; // LENGTHOFCONSTANTPART NORMAL: CLEN = 0; P = P + 3; ERR = 72; if (!(A == 4)) goto ERROR; P = P + 1; // GETNEXTOPERAND GETWSP(WKAREA, 268); // NOOPERATORSYET DOTS = 0; NEXT: STRINGL = 0; // GETNEXTOPERAND ERR = STROP(DR); if (!(ERR == 0)) goto ERROR; if (REGISTER[(ACCR)] != 0) BOOTOUT(ACCR); // BYTEDISPFROMLNB PSF1(LB, 0, WKAREA); // TOSUBROUTINE19OR20 PPJ(0, 19 + DOTS); // NOMOREOPERATIONS if (A == 2) goto TIDY; // CONCATENATE ERR = 72; if (!(A == CONCOP)) goto ERROR; DOTS = DOTS | 1; P = P + 2; goto NEXT; // FINISHOFF TIDY: VALUE = WKAREA; // PASTRESTOFEXPRN P = P + 1; if (KEEPWA == 0) RETURNWSP(WKAREA, 268); STRINGL = 0; return; int STROP(int REG) { //*********************************************************************** //*DEALSWITHOPERANDFORCONCATENATION.RETURNRESULT=0FOR* //*VALIDOPERANDOTHERWISEANERRORNUMBER.* //*********************************************************************** int CTYPE; int VAL; int MODE; // ALTERNATIVEOFOPERAND MODE = A; if (MODE > 2) return 75; if (MODE != 1) { // GETCONSTTYPE&LOSEAMCKFLAGS CTYPE = A; if (CTYPE == 0x35) { STRINGL = A; DISP = FROMAR4(P + 2); P = P + STRINGL + 7; } else return 71; PF1(LDRL, 0, PC, STRLINK); if (DISP != 0) PSF1(INCA, 0, DISP); if (STRINGL != 1) { //((DR)) if (STRINGL <= 63) PSF1(LDB, 0, STRINGL); else PF1(LDB, 2, 7, 0); } GRUSE[(DR)] = 0; if (REG == ACCR) COPYDR(); } else { // MUSTCHECKFIRST P = P + 1; // SINCECNAMEONLYLOADSSTRINGS REDUCETAG(); // ANDLONGINTSTODR! if (5 != TYPE && TYPE != 7) { FNAM = FROMAR2(P); return 71; } CNAME(2, REG); STRINGL = 0; if (ROUT != 0 && NAM <= 1) { // WASFUNCTIONNOTMAP if (WKAREA == 0 && KEEPWA != 0) WKAREA = STRFNRES; else RETURNWSP(STRFNRES, 268); } } return 0; /* End of Begin/Rt/Fn/Map depth=4 */ }; // OFINTEGERFNSTROP /* End of Begin/Rt/Fn/Map depth=3 */ }; // OFROUTINECSTREXP void CRES(int LAB) { //********************************************************************** //*COMPILESARESOLUTIONE.GA->B.(C).D.(E).FANDJUMPSTOLAB* //*ONFAILURE.(LAB=0FORUNCONDITIONALRESOLUTIONTOPERMON* //*FAILURE).* //*THEMETHODISTOCALLASUBROUTINEPASSING3PARAMS:-* //*P1POINTSTOLHS(A)* //*P2STRINGTOCONTAINFRAGMENT(PASSEDBYNAME)* //*P3THEEXPRESSIONPASSEDASDESCRIPTOR* //*SUBROUTINETRIESTOPERFORMTHERESOLUTIONANDSETSTHE* //*CONDITIONCODE=8IFITSUCCEEDS.* //** //*ONENTRYLHSISDEFINEDBYDESCRIPTORREG.* //*PPOINTSTOP(+') OF RHS DEFINED AS (+')(OPERAND)(RESTOFEXP)* //** //$THEROUTINEISCOMPACTBUTDIFFICULTTOFOLLOW(ORALTER)* //*THETIMEINPERMISLARGESOITISNOTWORTHWHILETOPERSUE* //*CODEEFFICIENCYTOOINDUSTRIOUSLY.* //********************************************************************** int P1; int P2; int SEXPRN; int W; int LAST; int ERR; int FNAM; /*pending name*/ recfm R; //(RD) //=1WHENENDOFEXPRNSNFOUND LAST = 0; FNAM = 0; // RESOLUTION(BRKTD)EXPRESSNS SEXPRN = 0; // NORMALCRESFAULT ERR = 74; // TOFIRSTCHAR PSF1(INCA, 0, 1); P1 = P; P = P + 3; // LHSMUSTBEASTRING if (A == 4) goto RES; // BUTTHISCHECKEDBEFORECALL ERR = 72; ERROR: FAULT2(ERR, 0, FNAM); P = P1; SKIPEXP(); return; // TOP(OPERAND) RES: P = P + 1; PSF1(PRCL, 0, 4); if (SEXPRN == 0) W = STD; else W = ST; PF1(W, 0, TOS, 0); if (A == 3) { PSF1(LSD, 0, 0); GRUSE[(ACCR)] = 0; } else { // BOMITTED // P(OPERAND)=NAME if (!(A == 1)) goto ERROR; P = P + 1; P2 = P; CNAME(3, ACCR); if (TYPE != 5) { ERR = 71; FNAM = FROMAR2(P2); goto ERROR; } if (A != CONCOP) { ERR = 72; goto ERROR; } P = P + 2; } // B(ORDUMMY)TOP2 PF1(ST, 0, TOS, 0); // P(OPERAND)='('(EXPR)')' if (!(A == 3)) goto ERROR; SEXPRN = SEXPRN + 1; P = P + 1; // TOREGISTERDR CSTREXP(0, DR); // PF1(STD, 0, TOS, 0); PSF1(RALN, 0, 11); PPJ(-1, 16); // DEALWITHCC#8IERESLNFAILED if (LAB != 0) ENTERJUMP(7, LAB, 0b11); else PPJ(7, 12); // if (A == 2) goto END; if (A != CONCOP) { ERR = 72; goto ERROR; } if (!(A == 1)) goto ERROR; P2 = P + 1; P = P2 + 1; do { P = P + 3; SKIPAPP(); } while (!(A == 2)) if (A == 1) { P = P2; goto RES; } P1 = P + 1; REGISTER[(ACCR)] = 1; OLINK[(ACCR)] = ADDR(R); R = 1; R = ACCR; R = 9; P = P2 + 2; CNAME(1, DR); if (R != 9) PF1(LSD, 0, TOS, 0); REGISTER[(ACCR)] = 0; PF1(STUH, 0, BREG, 0); PF1(LUH, 0, BREG, 0); PF2(MVL, 0, 0, 0, 0, 0); // ASSNMNTCHECK(Q.V) if (ROUT != 0 || NAM != 0) PPJ(0, 18); PF2(MV, 1, 1, 0, 0, UNASSPAT & 255); GRUSE[(ACCR)] = 0; if (PARMARR == 1) { PSF1(USH, 0, 8); PSF1(USH, 0, -40); PPJ(36, 9); } P = P1; END: P = P + 1; /* End of Begin/Rt/Fn/Map depth=3 */ }; void SAVEAUXSTACK(void) { //*********************************************************************** //*COPYAUXSTACKDESCRPTR&POINTERINTOCURRENTSTACKFRAME* //*FIVEWORDSAREUSEDFORTHISPURPOSE:-* //*1&2HOLDAUXSTACKDESCRIPTOR* //*3HOLDSVALUEATBLKENTRYFORUSEATEXIT* //*4HOLDSSTACKTOPVALUEAFTERALLARRAYDECLNS(FORons)* //*5HOLDSTACKLIMITFORCHECKINGATARRAYDECLARATIONS* //*THELATTERISOMITTEDINPARM=OPT* //*********************************************************************** int XYNB; int DR0; int DR1; if (AUXST == 0) { // FIRSTREFPUTREFINPLT DR0 = 0x30000001; DR1 = 0; PGLA(8, 8, ADDR(DR0)); AUXST = GLACA - 8; GXREF(AUXSTEP, 2, 0x02000008, AUXST + 4); } if (AUXSBASE[(LEVEL)] == 0) { XYNB = SETXORYNB(-1, -1); PF1(LD, 2, XYNB, AUXST); if (PARMOPT != 0) { // PICKUPSTACKTOP PF1(LSS, 1, 0, 2); PSF1(ST, 1, N + 16); } PF1(LSS, 2, 7, 0); PSF1(STD, 1, N); PSF1(ST, 1, N + 8); AUXSBASE[(LEVEL)] = N; N = N + 16; if (PARMOPT != 0) N = N + 4; GRUSE[(DR)] = 0; GRUSE[(ACCR)] = 11; GRINF1[(ACCR)] = 0; } /* End of Begin/Rt/Fn/Map depth=3 */ }; void RESETAUXSTACK(void) { //*********************************************************************** //*IFANYARRAYSHAVEBEENPUTONTHEAUXSTACKTHENUNDECLARE* //*********************************************************************** if (AUXSBASE[(LEVEL)] != 0) { PSF1(LB, 1, AUXSBASE[(LEVEL)] + 8); PSF1(STB, 2, AUXSBASE[(LEVEL)]); GRUSE[(BREG)] = 0; } /* End of Begin/Rt/Fn/Map depth=3 */ }; void RTEXIT(void) { //*********************************************************************** //*THISROUTINECOMPILESCODEFORROUTINEEXIT(IE'%RETURN')* //*********************************************************************** RESETAUXSTACK(); PSF1(EXIT, 0, -0x40); /* End of Begin/Rt/Fn/Map depth=3 */ }; void CLAIMSTFRAME(int AT, int VALUE) { //*********************************************************************** //*FILLASFINSTNINRTENTRYSEQUENCETOCLAIMTHESTACKFRAME* //*********************************************************************** int INSTR; int WK; // BYTESCLAIMEDBYENTRYSEQ WK = AT >> 18; // ADRROFASFINSTRN AT = AT & 0x3FFFF; INSTR = (ASF + 12 * PARMCHK) << 24 | 3 << 23 | (VALUE - WK + 3) >> 2; PLUG(1, AT, INSTR, 4); /* End of Begin/Rt/Fn/Map depth=3 */ }; void CEND(int KKK) { //*********************************************************************** //*DEALWITHALLOCCURENCESOF'%END'* //*KKK=PTYPE(>=X'1000')FORROUTINES,FNSANDMAPS* //*KKK=0FORENDSOF'%BEGIN'BLOCKS* //*KKK=1FOR'%ENDOFPROGRAM'* //*endofprogramISREALLYTWOENDS.THEFIRSTISTHEUSERS* //*ANDTHESECONDISPERMS.KKK=2FORARECURSIVECALLOFCEND* //*ONENDOFPROGRAMTODEALWITHTHEendCORRESPONDINGTO* //*THEbeginCOMPILEDINTHEINITIALISATIONSEQUENCE* //*********************************************************************** int KP; int JJ; int BIT; auto void DTABLE(int LEVEL); if (!(KKK == 2)) SETLINE(); FORGET(-1); BIT = 1 << LEVEL; // // NOWPLANTANERROREXITFORFNSANDMAPS-CONTROLSHOULDBERETURNED // VIAresult=ANSHOULDNEVVERREACHTHEendINSTRUCTION // // RUNFAULT11 if (KKK & 0x3FFF > 0x1000 && COMPILER == 0 && LASTINST == 0) PPJ(15, 10); // WORKSPACEPOINTER if (N > NMAX) NMAX = N; // // CLEAROUTTHELABELLISTFAULTINGLABELSWITHJUMPSOUTSTANDING // ASNOTSETANDCOMMENTINGONLABELSNOTUSED // while (LABEL[(LEVEL)] != 0) { POP(LABEL[(LEVEL)], I, J, KP); I = I >> 24; if (J & 0xFFFF != 0) { J = J & 0xFFFF; if (0 < KP && KP <= MAXULAB) FAULT2(11, FROM3(J), KP); CLEARLIST(J); } else { if (I == 0 && KP < MAXULAB) WARN(3, KP); } } // for (JJ = 0; JJ != 4; JJ += 1) { // RELEASETEMPORARYLOCATIONS CLEARLIST(AVLWSP[(JJ)][(LEVEL)]); } // // OUTPUTDIAGNOSTICTABLES DTABLE(LEVEL); // // CLEARDECLARATIONS-POPUPANYGLOBALNAMESTHATWEREREDECLARED // DESTROYSIDECHAINSFORROUTINES,FORMATSANDSWITCHES // // // NOWCLAIMTHESTACKFRAMEBYFILINGTHEASFINTHEBLOCKENTRYCODING // NMAX = (NMAX + 7) & (-8); if (KKK == 2) return; if (KKK >= 0x1000 || KKK == 1) CLAIMSTFRAME(SET[(RLEVEL)], NMAX); // // NOWPLANTTHEBLOCKEXITSEQUENCE // if (KKK & 0x3FFF == 0x1000 && LASTINST == 0) RTEXIT(); // stopATendofprogram if (KKK == 1 && LASTINST == 0) PPJ(15, 21); if (KKK == 0) { // BEGINBLOCKEXIT if (PARMTRACE == 1) { // RESTOREDIAGSPOINTERS PSF1(LD, 1, 12); DIAGPOINTER(LEVEL - 1); PSF1(STD, 1, 12); } if (STACK != 0) { JJ = NMDECS[(LEVEL)] >> 14; if (JJ != 0) { // ARRAYSTOBEUNDECLARED PF1(STSF, 0, TOS, 0); PF1(LSS, 0, TOS, 0); PSF1(ISB, 1, JJ); PSF1(USH, 0, -2); PF1(ST, 0, TOS, 0); PF1(ASF, 0, TOS, 0); GRUSE[(ACCR)] = 0; } } else RESETAUXSTACK(); } // // RETURNTOPREVIOUSLEVELPROVIDEDTHEREISAVALIDONE! // 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 >= 0x1000) { RLEVEL = RLEVEL - 1; RBASE = RLEVEL; } // // RESTOREINFORMATIONABOUTTHE(NEW)CURRENTLEVEL // POP(LEVELINF, KP, N, KP); if (KKK >= 0x1000) NMAX = N >> 16; N = N & 0x7FFF; // ROUNDAGAINFOR'ENDOFPROGRAM' if (KKK == 2) CEND(KKK); // // COMPLETETHEJUMPAROUNDALLNON-EXTERNALROUTINESEXCEPTWHEN // trustedprogramISINOPERATION. // if (ASLWARN != 0) { ASLWARN = 0; EPILOGUE(); } if (KKK >= 0x1000 && COMPILER == 0 && RLEVEL > 0 || CPRMODE != 2) { JJ = NEXTP + 6; if (!(A == 11 && A == 2)) { JJ = ENTERLAB(JROUND[(LEVEL + 1)], 0); JROUND[(LEVEL + 1)] = 0; } } return; // // LAYOUTOFDIAGNOSICTABLES //*********************** // // THEBOUNDFIELDOFPLTDESCRIPTORSTOREDAT(LNB+3&LNB+4)IF // USEDTOCONTAINADISPLACEMENTRELATIVETOTHESTARTOFSSTOFTHE // DIAGNOSTICTABLESFORTHEBLOCKORROUTINEBEINGEXECUTED. // AZEROBOUNDMEANSNODIAGNOSTICREQUESTED.(NBTHISMAYMEANADUMMY // FIRSTWORDINTHESST). // THEABSOLUTEADDRESSOFTHESSTFORTHECURRENTCODESEGMENTWILL // ALWAYSBEFOUNDINTHESTANDARD10WORDSOFTHEGLA/PLT // // FORMOFTHETABLES:- // // WORD0=LINEOFRTINSOURCEPROG<<16!LINENOPOSN(FROMLNB) // WORD1=(12LANGDEPENDENTBITS)<<18!ENVIRONMENT //(TOP2BITSOFLANGDEPENDENTHASLITLFROMPTYPE) //(BOTTOM4BITSHAVETEXTUALLEVEL) // WORD2=DISPLAYPOSN(FROMLNB)<<16!RTTYPEINFO // WORD3=ZEROFORBLKSORSTRING(<=11BYTES)BEINGTHE // RTNAME.THISWILLTAKEWORDS4AND5IFNEEDED // WORD6=LANGUAGEDEPENDENTINFO.IMPONCONDITIONSETC // // THERESTISMADEUPOFVARIABLEENTRIESANDTHESECTIONISTERMINATEDBY // AWORDOFX'FFFFFFFF' // // EACHVARIABLEENTRYCONSISTSOFTHEVARIABLEWORDFOLLOWEDBY // THEVARIABLENAMEASASTRING.THEWORDCONSISTSOF // BITS2**31TO2**20TYPEINFORMATION(MAYBELANGUAGEDEPENDENT // BIT2**19=0UNDERLNB=1INGLA // BITS2**18TO2**0DISPLACEMENTFROMLNB(GLA)INBYTES // // // THEENVIRONMENTISAPOINTER(RELATIVETOSST)OFTHENEXTOUTERMOST // BLOCKORAPOINTERTOGLOBALOWNS,EXTERNALORCOMMONAREAS // AZEROMEANSNOENCLOSINGBLOCK.WORD1=WORD3=0ISAN // IMPMAINPROGRAMANDWILLTERMINATETHEDIAGNOSTICS. // void DTABLE(int LEVEL) { //*********************************************************************** //*THISROUTINELOOKSATTHEDECLARATIONSFORTHECURRENTLEVEL&* //*SETSUPTHESEGMENTOFSHARABLESYMBOLTABLESTODESCRIBETHEM.* //*FORMAINPROGRAMSOREXTERNALROUTINESTHE'GLOBAL'VARIABLES* //*(IFANY)AREALSOINCLUDED.* //*********************************************************************** _imp_string RTNAME; _imp_string LOCALNAME; /*pending name*/ recfm *LCELL; //(LISTF) const int LARRROUT = 0xF300; int DPTR; int LNUM; int ML; int KK; int JJ; int Q; int DEND; int BIT; int S1; int S2; int S3; int S4; int LANGD; int II; int DD[(500) + 1]; // BUFFERFORSEGMENTOFSST // // FILLALLOUTSTANDINGREFERENCESTOTHISDIAGSBLOCK // BIT = 1 << LEVEL; // GETLITLFROMPTYPE LANGD = KKK >> 14 << 30 | LEVEL << 18; while (RAL[(LEVEL)] != 0) { POP(RAL[(LEVEL)], Q, JJ, KK); PLUG(Q, JJ, KK | SSTL, 4); } if (PARMTRACE != 0) PUSH(RAL[(LEVEL - 1)], 4, SSTL + 4, LANGD); DD[(0)] = L[(LEVEL)] << 16 | (DIAGINF[(LEVEL)]); DD[(1)] = LANGD; DD[(2)] = DISPLAY[(RLEVEL)] << 16 | FLAG[(LEVEL)] & 0x3FFF; // ROUTINENAME(=0FORbegin) ML = M[(LEVEL)]; // LENGTHOFTHENAME LNUM = BYTEINTEGER(DICTBASE + ML); DPTR = 4; DEND = 0; if (LNUM == 0) DD[(3)] = 0; else { Q = DICTBASE + ML; // FORRTSMOVEIN1ST32CHARS RTNAME = STRING(Q); LNUM = BYTEINTEGER(ADDR(RTNAME)); STRING(ADDR(DD[(3)])) = RTNAME; // ANDUPDATEPOINTERPAST // ACTUALNOOFCHARS DPTR = DPTR + (LNUM >> 2); } // ONCONDITIONWORD DD[(DPTR)] = ONWORD[(LEVEL)]; DPTR = DPTR + 1; JJ = NAMES[(LEVEL)]; while (0 <= JJ && JJ < 0x3FFF) { LCELL = ASLIST[(TAGS[(JJ)])]; // OBTAINNEXTNAMEFORMDECLNS if (LCELL & 0xF000 == 0) WARN(2, JJ); // // GETONLYTHEMINIMUMOFDETALSNECESSARY // S1 = LCELL; S2 = LCELL; S3 = LCELL; S4 = LCELL; LCELL = ASL; ASL = TAGS[(JJ)]; TAGS[(JJ)] = S4 & 0x3FFFF; PTYPE = S1 >> 16; TYPE = PTYPE & 15; I = S1 >> 4 & 15; J = S1 & 15; K = S3 >> 16; // // ALLOWOWNS(LITL=0)ANDEXTERNALS(=2)NOTCONSTS(=1)OREXTRINSIC(=3) // if (PARMDIAG != 0 && PTYPE & 0x7300 <= 0x200 && DPTR < 497 && TYPE == 1 || TYPE == 2 || TYPE == 5) { // ADDRESSOFNAME Q = DICTBASE + WORD[(JJ)]; // GLAORLNBBIT if (I == 0) II = 1; else II = 0; DD[(DPTR)] = PTYPE << 20 | II << 18 | K; // TEXTOFNAMEFROMDICTIONARY LOCALNAME = STRING(Q); LNUM = BYTEINTEGER(ADDR(LOCALNAME)); STRING(ADDR(DD[(DPTR)]) + 4) = LOCALNAME; // MOVEINNAME DPTR = DPTR + ((LNUM + 8) >> 2); } if (J == 15 && S2 != 0) FAULT2(28, 0, JJ); // SPEC&CALLEDBUTNOBODYGIVEN if (PTYPE & 0x3000 != 0 || TYPE == 4 || TYPE == 6) CLEARLIST(K); else { if (I != 0 && K > 511 && PTYPE & LARRROUT == 0 && TYPE != 7) WARN(5, JJ); } JJ = S4 >> 18; } //'END OF SEGMENT'MARK DD[(DPTR)] = -1; DPTR = (DPTR << 2) + 4; if (PARMTRACE == 1) { LPUT(4, DPTR, SSTL, ADDR(DD[(0)]) // ADDTOSHARABLESYMTABS ); SSTL = SSTL + DPTR; } /* End of Begin/Rt/Fn/Map depth=4 */ }; // OFROUTINEDTABLE /* End of Begin/Rt/Fn/Map depth=3 */ }; void MAKEDECS(int Q) { //*********************************************************************** //*QISTOARENTRYFORHEADOFLINKEDDECLARATIONS* //*********************************************************************** int QQ; int HEAD; int PRIO; int COUNT; int SL; int *THEAD; /*pending name*/ recfm *CELL; //(LISTF) SL = LINE; QQ = FROMAR4(Q); HEAD = 0; COUNT = 0; while (QQ != 0) { COUNT = COUNT + 1; // LINEISADECLARATION if (!(A == 8)) ABORT(); P = QQ + 10; CLT(); if (PREC == 3 || A != 1 || A != 3) { if (A == 1) INSERTATEND(HEAD, 0xFFFF, QQ, 0); } else { PRIO = PREC << 4 | TYPE; THEAD = HEAD; do { CELL = ASLIST[(THEAD)]; if (THEAD == 0 || PRIO < CELL) { PUSH(THEAD, PRIO, QQ, 0); break; } THEAD = CELL; } while (1); } QQ = FROMAR4(QQ + 6); } // // NOWMAKETHEORDEREEDDECLARATIONS // FIRSTGRABTWOTEMPORARIESIFSPACEISLIKELYTOBETIGHT // if (COUNT >= 7) { // ADIUBLEWORD GETWSP(QQ, 2); if (AVLWSP[(1)][(LEVEL)] == 0) GETWSP(QQ, 1); } while (HEAD != 0) { POP(HEAD, PRIO, QQ, COUNT); LINE = FROMAR2(QQ + 3); P = QQ + 10; CLT(); ROUT = 0; LITL = 0; CQN(P + 1); P = P + 2; DECLARESCALARS(1, 0); } LINE = SL; /* End of Begin/Rt/Fn/Map depth=3 */ }; void DECLARESCALARS(int PERMIT, int XTRA) { //*********************************************************************** //*THISROUTINEDECLARESALISTOFSCALARSFROMINFORMATION* //*INTHEGLOBALVARIABLESROUT,NAM,ARR,PREC,TYPE&ACC.ITWORKS* //*OUTROUNDINGFACTORSFORITSELF.* //*PPOINTSTOTHENAMELISTONENTRYANDISUPDATED.* //*********************************************************************** int INC; int Q; int SCHAIN; int DMADE; int NPARMS; int D0; int SCALNAME; int TYPEP; PACK(PTYPE); J = 0; INC = ACC; DMADE = 0; SNDISP = 0; if (PTYPE == 0x33) INC = (INC + 3) & (-4); if (NAM != 0 && ROUT == 0 && ARR == 0) INC = 8; if (NAM > 0 && ARR > 0) INC = 16; if (PTYPE == 0x35 && ACC == 0) FAULT(70, 0); if (PERMIT != 0 && INC == 8 || INC == 16) ODDALIGN(); if (PTYPE == 0x33 || PTYPE == 0x35 && PERMIT != 0) { D0 = 0x18000000 + ACC; STORECONST(Q, 4, ADDR(D0)); PF1(LDTB, 0, PC, Q); GRUSE[(DR)] = 0; } if (PTYPE == 0x35) { INC = 8; if (PERMIT != 0) { PF1(STSF, 0, TOS, 0); PF1(LDA, 0, TOS, 0); } } N = (N + 3) & (-4); if (PTYPE == 0x33) { PSF1(LDA, 1, PTROFFSET(RBASE)); PSF1(INCA, 0, N + 8); } /* Deferred: until (A == 2) */ do { // DOWNTHENAMELIST DMADE = DMADE + 1; SCALNAME = FROMAR2(P); // BYTEPARAMS if (PTYPE == 0x31 && PERMIT == 0) N = N + 3; if (PTYPE == 0x41 && PERMIT == 0) N = N + 2; SCHAIN = N; KFORM = XTRA; if (ROUT == 1) { // CHANGEDBYCFPLIST! TYPEP = PTYPE; Q = P; // TOFPP do P = P + 3; while (!(A == 2)) CFPLIST(SCHAIN, NPARMS); P = Q; J = 13; // NOOFPARAMSOFFORMAL KFORM = NPARMS; // DISPLACEMENTTOMIDCELL ACC = N; PTYPE = TYPEP; UNPACK(); } P = P + 3; if (PTYPE == 0x33) { PSF1(STD, 1, N); N = N + 8; SCHAIN = N; if (A == 1) PSF1(INCA, 0, INC + 8); } if (PTYPE == 0x35 && PERMIT != 0) { PSF1(STD, 1, N); if (A == 1) PSF1(INCA, 0, (ACC + 3) & (-4)); else { Q = ((ACC + 3) >> 2) * DMADE; PSF1(ASF + 12 * PARMCHK, 0, Q); if (PARMCHK != 0) PPJ(0, 4); } } STORETAG(SCALNAME, SCHAIN); N = N + INC; } while (!(A == 2)); // NOROUNDINGAMONGPARAMS if (PERMIT != 0) N = (N + 3) & (-4); /* End of Begin/Rt/Fn/Map depth=3 */ }; int DOPEVECTOR(int TYPEP, int ELSIZE, int MODE, int IDEN, int *ASIZE, int *LB) { //*********************************************************************** //*CONSTRUCTSTHEDOPE-VECTORFORACONSTANTARRAYINTHE* //*SHAREABLESYMBOLTABLESANDRETURNSITSDISPLACEMENTASRESULT* //*EVENTUALLYALLNONDYNAMICDOPEVECTORSSHOULDGOVIAHERE* //*PISTOALT(MUSTBE1!)OFP* //*DOPEVECTORCONSISTSOF:-* //*DESRIPTOR(SCALEDWORD)POINTINGATFIRSTTRIPLEBND=3*ND* //*SIZE(INBYTESOFENTIREARRAY)FORSTACKADJUSTMENT* //*ANDNDTRIPLESEACHCONSISTINGOF:-* //*LBI-THELOWERBOUNDOFTHEITHDIMENSION* //*MI-THESTRIDEFORTHEITHDIMENSION* //*CBITHEUPPERCHECK=(UBI-LBI+1)*MI* //*WHEREM1=1(SCALEDARRAYS)ORTHEELEMENTSIZEAND* //*MI=M(I-1)*RANGE(I-1)* //*MODE=0DVMUSTBECONST,MODE#0CANBEDYNAMIC* //*PTOALT(ALWAYS=1)OFP(BPAIR)* //*********************************************************************** int I; int JJ; int K; int ND; int D; int UNSCAL; int M0; int HEAD; int NOPS; int TYPEPP; int PIN; int PTR; /*pending name*/ recfm *LCELL; //(LISTF) int LBH[(12) + 1]; int LBB[(12) + 1]; /*H imp80-switch.h:2313*/ int UBH[(12) + 1]; /*H imp80-switch.h:2313*/ int UBB[(12) + 1]; /*H imp80-switch.h:2313*/ int DV[(39) + 1]; // ENOUGHFOR12DIMENSIONS ND = 0; NOPS = 0; TYPEPP = 0; PIN = P; if (TYPEP > 2 || TYPEP == 1 && PREC == 4) { UNSCAL = 1; M0 = ELSIZE; } else { UNSCAL = 0; M0 = 1; } /* Deferred: until (A == 2) */ do { ND = ND + 1; P = P + 4; LBH[(ND)] = 0; LBB[(ND)] = 0; UBB[(ND)] = 0; UBH[(ND)] = 0; TORP(LBH[(ND)], LBB[(ND)], NOPS); P = P + 3; TYPEPP = TYPEPP | TYPE; TORP(UBH[(ND)], UBB[(ND)], NOPS); TYPEPP = TYPEPP | TYPE; } while (!(A == 2)); P = P + 1; if (!(TYPEPP == 1 && NOPS & 0x40040000 == 0)) goto NONCONST; // // NOWONECANWORKOUTANDFILLINTHETRIPLES // PTR = 1; for (D = ND; D != 1; D += -1) { K = 3 * D; EXPOP(LBH[(PTR)], ACCR, NOPS, 0x251); if (!(EXPOPND <= 1 && EXPOPND == 0x51)) { EXPOPND = 0; FAULT(41, 0); } DV[(K)] = EXPOPND; DV[(K + 1)] = M0; EXPOP(UBH[(PTR)], ACCR, NOPS, 0x251); if (!(EXPOPND <= 1 && EXPOPND == 0x51)) { EXPOPND = 10; FAULT(41, 0); } JJ = EXPOPND; M0 = M0 * (JJ - DV[(K)] + 1); if (!(JJ >= DV[(K)])) FAULT2(38, 1 - M0, IDEN); DV[(K + 2)] = M0; PTR = PTR + 1; } // if (UNSCAL == 0) M0 = M0 * ELSIZE; if (ND == 1) LB = DV[(3)]; ASIZE = M0; DV[(2)] = ASIZE; DV[(1)] = 12; // DESPTRFORDV DV[(0)] = 5 << 27 | 3 * ND; K = 3 * ND + 2; // DIMENSIONALITYFORDECLN J = ND; HEAD = DVHEADS[(ND)]; while (HEAD != 0) { LCELL = ASLIST[(HEAD)]; if (LCELL == ASIZE && LCELL == DV[(5)]) { for (D = 0; D != K; D += 1) { if (!(DV[(D)] == CTABLE)) goto ON; } return 0x80000000 | 4 * LCELL; } ON: HEAD = LCELL; } 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 += 1) { CTABLE = DV[(D)]; CONSTPTR = CONSTPTR + 1; } if (CONSTPTR > CONSTLIMIT) FAULT(107, 0); WAYOUT: for (D = ND; D != 1; D += -1) { ASLIST[(LBB[(D)])] = ASL; ASL = LBH[(D)]; ASLIST[(UBB[(D)])] = ASL; ASL = UBH[(D)]; } return I; // NOTACONSTDV NONCONST: J = ND; I = -1; LB = 0; ASIZE = ELSIZE; if (MODE == 0) FAULT(41, 0); else P = PIN; goto WAYOUT; /* End of Begin/Rt/Fn/Map depth=3 */ }; void DECLAREARRAYS(int FORMAT, int FINF) { //*********************************************************************** //*FORMAT=1FOR'ARRAYFORMAT'=0OTHERWISE* //*FINF>0FORRECORDFORMATINFORMATION=0OTHERWISE* //*PISATPIN* //** //*P=* //*P='('':'*')'* //** //*ARRAYSWITHCONSTANTBOUNDSHAVETHEIRD-VINTHESST* //*ALLOTHERARRAYSHAVEADOPEVECTORAMONGTHELOCALSANDGET* //*THEIRSPACEOFFTHESTACKATRUNTIME* //*BOTHSORTSOFARRAYSHAVEAFOURWORDHEADANDD-VTOEMAS* //*SYSTEMSTANDARDS* //*********************************************************************** auto void CLAIMAS(void); int DVDISP; int PP; int DVF; int ELSIZE; int TOTSIZE; int D0; int D1; int PTYPEP; int ARRP; int NN; int ND; int II; int JJ; int QQ; int R; int CDV; int UNSCAL; int DESC; int SC; int LWB; int PTYPEPP; int JJJ; int JJJJ; int ADJ; if (STACK != 0 && FLAG[(LEVEL)] == 0 && 0 == NMDECS[(LEVEL)] >> 14) { PSF1(STSF, 1, N); NMDECS[(LEVEL)] = NMDECS[(LEVEL)] | (N << 14); N = N + 4; } if (STACK == 0) SAVEAUXSTACK(); ARRP = 2 * FORMAT + 1; ARR = ARRP; PACK(PTYPEP); ELSIZE = ACC; if (TYPE > 2 || TYPE == 1 && PREC == 4) { UNSCAL = 1; SC = 3; } else { UNSCAL = 0; SC = PREC; } // ARRAYDESCRIPTORSKELETON DESC = SC << 27 | UNSCAL << 25 | (1 - PARMARR) << 24; if (PREC == 4) DESC = 0x58000002; // NOOFNAMESINNAMELIST START: NN = 1; P = P + 1; PP = P; CDV = 0; PTYPEPP = PTYPEP; while (A == 1) { P = P + 3; NN = NN + 1; } P = P + 3; DVDISP = DOPEVECTOR(TYPE, ELSIZE, 1, FROMAR2(PP), TOTSIZE, LWB); ND = J; if (!(DVDISP == -1)) goto CONSTDV; // NORMALCASE-PLANTCODETOSETUPDOPE-VECTORATRUNTIME DVF = 0; TOTSIZE = 0xFFFF; // DVDISPISD-VPOSITION DVDISP = N; // CLAIMSPACEFORTHED-V N = N + 12 * ND + 12; // TOOMANYDIMENSIONS if (ND > 12) FAULT(37, 0); // DESCPTRFORDV D0 = 5 << 27 | 3 * ND; D1 = 12; STORECONST(JJ, 8, ADDR(D0)); PF1(LD, 0, PC, JJ); PSF1(STD, 1, DVDISP); GRUSE[(DR)] = 0; if (UNSCAL == 0) JJ = 1; else JJ = ELSIZE; // M1THEFIRSTMULTIPLIER PSF1(LSS, 0, JJ); GRUSE[(ACCR)] = 0; for (II = ND; II != 1; II += -1) { P = P + 1; // TRIPLEFORIITHDIMENSION QQ = DVDISP + 12 * II; // STOREMULTIPLIER PSF1(ST, 1, QQ + 4); // LOWERBOUND CSEXP(ACCR, 0x51); if (ND == 1 && PTYPEP & 7 <= 3 && FORMAT == 0 && GRUSE[(ACCR)] == 5 && GRINF1[(ACCR)] == 0) PTYPEPP = PTYPEPP + 256; // STOREDINDV PSF1(ST, 1, QQ); // UPPERBOUND CSEXP(ACCR, 0x51); PSF1(ISB, 1, QQ); GRUSE[(ACCR)] = 0; if (COMPILER == 0 || PARMARR != 0) { // JUMPUNLESSNEGATIVE PF3(JAF, 6, 0, 3); // SETUP-1(ENSURES0ELEMENTS PSF1(LSS, 0, -1); } // CONVERTEDTORANGE PSF1(IAD, 0, 1); // RANGE*MULTIPLIER PSF1(IMY, 1, QQ + 4); // ANDSTOREDINDV PSF1(ST, 1, QQ + 8); } P = P + 1; if (UNSCAL == 0 && ELSIZE != 1) PSF1(IMY, 0, ELSIZE); PSF1(ST, 1, DVDISP + 8); // DVNOTAVAILABLEATCOMPILETIME SNDISP = 0; goto DECL; // ONEDIMENSION-CONSTANTBOUNDS CONSTDV: DVF = 1; CDV = 1; if (ND == 1 && LWB == 0 && PTYPEP & 15 <= 3 && FORMAT == 0) PTYPEPP = PTYPEP + 256; // SETARR=2IFLWB=ZERO SNDISP = (DVDISP & 0xFFFFFF) >> 2; // MAKEDECLN-BOTHWAYS DECL: J = ND; ODDALIGN(); PTYPE = PTYPEPP; UNPACK(); if (DVF != 0) { // ARRAYISSTRINGOFLOCALS R = TOTSIZE; if (UNSCAL == 0) R = R / ELSIZE; D0 = DESC; if (!(PREC == 4)) D0 = D0 | R; STORECONST(D1, 4, ADDR(D0)); PF1(LB, 0, PC, D1); } else { STORECONST(D1, 4, ADDR(DESC)); PF1(LB, 0, PC, D1); if (!(PREC == 4)) PSF1(ADB, 1, DVDISP + 20); } if (DVF != 0) QQ = PC; else QQ = LNB; PSORLF1(LDRL, 0, QQ, DVDISP); GRUSE[(BREG)] = 0; GRUSE[(DR)] = 0; for (JJJ = 0; JJJ != NN - 1; JJJ += 1) { // DOWNNAMELIST // ARRAYBOUND PSF1(STB, 1, N + 16 * JJJ); // DVPOINTER PSF1(STD, 1, N + 8 + 16 * JJJ); } if (PARMARR == 0 && PARMCHK == 0 && ND == 1 && TYPE <= 3 && PTYPEPP & 0xF00 != 0x200) ADJ = 1; else ADJ = 0; for (JJJ = 0; JJJ != NN - 1; JJJ += 1) { // DOWNNAMELIST if (ADJ != 0) { // ADJUSTDESC if (STACK != 0) { // ARRAYONAUTOMATICSTACK // CURRENTSFTOB PF1(STSF, 0, BREG, 0); if (DVF != 0) PSF1(SBB, 0, LWB * ELSIZE); else { if (ELSIZE == 1) PSF1(SBB, 1, DVDISP + 12); else { PSF1(SLB, 1, DVDISP + 12); PSF1(MYB, 0, ELSIZE); PF1(SLB, 0, TOS, 0); PF1(SBB, 0, TOS, 0); } } PSF1(STB, 1, N + 4); GRUSE[(BREG)] = 0; } else { // ARRAYONAUXSTACK if (DVF != 0) { // CONSTDOPEVECTOR if (!(GRUSE[(ACCR)] == 11)) { PSF1(LSS, 2, AUXSBASE[(LEVEL)]); GRUSE[(ACCR)] = 11; GRINF1[(ACCR)] = 0; } JJJJ = LWB * ELSIZE - GRINF1[(ACCR)]; if (!(JJJJ == 0)) PSF1(ISB, 0, JJJJ); GRINF1[(ACCR)] = LWB * ELSIZE; } else { // DYNAMICARRAYS if (GRUSE[(ACCR)] == 11 && GRINF1[(ACCR)] == 0 && ELSIZE == 1) PSF1(ISB, 1, DVDISP + 12); else { PSF1(LSS, 1, DVDISP + 12); if (!(ELSIZE == 1)) PSF1(IMY, 0, ELSIZE); PSF1(IRSB, 2, AUXSBASE[(LEVEL)]); } GRUSE[(ACCR)] = 0; } PSF1(ST, 1, N + 4); } } else { // NOADJUSTMENTOFDESCRPT if (STACK != 0) PSF1(STSF, 1, N + 4); else { if (!(GRUSE[(ACCR)] == 11 && GRINF1[(ACCR)] == 0)) PSF1(LSS, 2, AUXSBASE[(LEVEL)]); PSF1(ST, 1, N + 4); GRUSE[(ACCR)] = 11; GRINF1[(ACCR)] = 0; } } // RESETACCAFTERDVCMPLD ACC = ELSIZE; // FORMATINFORMATION KFORM = FINF; K = FROMAR2(PP + 3 * JJJ); STORETAG(K, N); if (FORMAT == 0) CLAIMAS(); N = N + 16; } // PASTRESTOFARRAYLIST P = P + 1; if (A == 1) goto START; return; void CLAIMAS(void) { //*********************************************************************** //*CLAIMTHESPACEFORANARRAYFROMSTACKORAUXSTACK* //*********************************************************************** int T; int B; int D; int ADJMENT; if (STACK == 1) { // FROMAUTOMATICSTACK if (CDV == 1) { // CONSTANTBOUNDS T = (TOTSIZE + 3) / 4; // ASFORLB PSF1(ASF + 12 * PARMCHK, 0, T); if (PARMCHK != 0) PPJ(0, 4); } else { // DYNAMICBOUNDS if (PARMCHK == 0 && PTYPEP & 7 <= 2 && ELSIZE == 4 || ELSIZE == 8) { // SIZEINELEMENTSWORD PSF1(ASF, 1, DVDISP + 20); if (ELSIZE == 8) PSF1(ASF, 1, DVDISP + 20); } else { // ARRAYSIZEBYTES PSF1(LSS, 1, DVDISP + 8); if (ELSIZE & 3 != 0) PSF1(IAD, 0, 3); // ARRAYSIZEWORDS PSF1(USH, 0, -2); PF1(ST, 0, BREG, 0); FORGET(BREG); if (PARMCHK != 0) PPJ(0, 4); else PF1(ASF, 0, BREG, 0); } } CHECKSTOF(); } else { if (!(GRUSE[(ACCR)] == 11 && GRINF1[(ACCR)] == 0 || CDV == 1)) { PSF1(LSS, 2, AUXSBASE[(LEVEL)]); GRUSE[(ACCR)] = 11; GRINF1[(ACCR)] = 0; } if (CDV == 1) { ADJMENT = ((TOTSIZE + 7) & (-8)) + GRINF1[(ACCR)]; if (ADJMENT < 0x1FFFF) { B = 0; D = ADJMENT; } else { STORECONST(D, 4, ADDR(ADJMENT)); B = PC; } if (ADJ == 1 && JJJ != NN - 1 && PARMOPT == 0) GRINF1[(ACCR)] = ADJMENT; else { GRINF1[(ACCR)] = 0; if (!(B == D && D == 0)) PSORLF1(IAD, 0, B, D); } } else { B = LNB; D = DVDISP + 8; PSF1(IAD, 1, D); if (!(ELSIZE & 7 == 0)) { PSF1(IAD, 0, 7); PSF1(AND, 0, -8); } GRINF1[(ACCR)] = 0; } if (JJJ == NN - 1 || ADJ == 1 && CDV == 0) PSF1(ST, 2, AUXSBASE[(LEVEL)]); if (PARMOPT != 0) { PSF1(ICP, 1, AUXSBASE[(LEVEL)] + 16); PPJ(2, 8); } if (PARMCHK != 0) { PF1(LDTB, 0, PC, PARAMDES(3)); PSORLF1(LDB, 0, B, D); PSF1(LDA, 1, N + 4); PF2(MVL, 1, 1, 0, 0, UNASSPAT & 255); GRUSE[(DR)] = 0; } } /* End of Begin/Rt/Fn/Map depth=4 */ }; /* End of Begin/Rt/Fn/Map depth=3 */ }; // routineTESTNST //!*********************************************************************** //!*SEEIFNAME'K'HASBEENDECLAREDBEFOREATTHISLEVEL* //!*********************************************************************** // FNAME=K // FAULT(7,FNAME)ifFROM1(TAGS(FNAME))>>8&15=LEVEL // end void CLT(void) { //*********************************************************************** //*DEALWITHPHRASETYPEANDSETPREC,TYPE&ACC* //*ONLYPROBLEMISSTRINGWHICHHASOPTIONALMAXLENGTHALSO* //*PONPHRASETYPEATENTRY-TONEXTPHRASEATEXIT.* //*********************************************************************** const char TYPEFLAG[(10) - (1) + 1] = X '51', 0x52, 0, 0x31, 0x35, 0x41, 0, 0x62, 0x61, 0x72; int ALT; ALT = A; TYPE = TYPEFLAG[(ALT) - (1)]; if (TYPE == 0) { P = P + 1; TYPE = TYPEFLAG[(A + 7) - (1)]; } PREC = TYPE >> 4; TYPE = TYPE & 7; // DEALWITH'%REALSLONG' if (TYPE == 2 && ALLLONG != 0 && PREC <= 5) PREC = 6; ACC = BYTES[(PREC)]; if (TYPE == 5) { // P='%STRING' if (A == 1) { // MAXLENGTHGIVEN P = P + 2; ACC = A + 1; } else { ACC = 0; P = P + 1; } } P = P + 1; /* End of Begin/Rt/Fn/Map depth=3 */ }; void CQN(int P) { //*********************************************************************** //*SETNAM,ARR&ACCFROMALTERNATIVEOFPHRASE * //* P='%ARRAYNAME','%NAME',* //*PPOINTSTOTHEANALYSISRECORDENTRYASISNOTUPDATED* //*********************************************************************** int I; I = A; NAM = 0; ARR = 0; // ARRAYNAMES if (I == 1) { ARR = 1; ACC = 16; } // ARRAYNAMES&NAMES if (I <= 2) NAM = 1; // NAMESUSE8-BYTEDESCRIPTOR if (I == 2) ACC = 8; /* End of Begin/Rt/Fn/Map depth=3 */ }; void CRSPEC(int M) { //*********************************************************************** //*MODE=0FORNORMALROUTINESPEC* //*MODE=1FOREXTERNAL(ETC)ROUTINESPECSXREFNEEDED* //*PONENTRYTOP(RT)IN(RT)(MARK)(spec'')(NAME)(FPP)* //*********************************************************************** int KK; int JJ; int TYPEP; int OPHEAD; int NPARMS; _imp_string XNAME; LITL = EXTRN & 3; if (A == 1) { // P=routine TYPEP = LITL << 14 | 0x1000; // IGNORINGALTOFP(SPEC'') P = P + 2; } else { // P= ROUT = 1; ARR = 0; P = P + 1; CLT(); NAM = 0; // 2FORMAP0FORFN if (A == 2) NAM = 2; PACK(TYPEP); // AGAINIGNORINGALTOFP(SPEC'') P = P + 2; } // PASTHOLEFORDECLINKS P = P + 4; KK = FROMAR2(P); JJ = 0; P = P + 2; CFPLIST(OPHEAD, NPARMS); if (M == 1) { XNAME = STRING(DICTBASE + WORD[(KK)]); if (EXTRN == 1) XNAME = "S#".XNAME; // ststem&external=STATIC CXREF(XNAME, PARMDYNAMIC | (EXTRN / 3), 2, JJ); // dynamic=DYNAMIC } if (M == 0 && RLEVEL == 0) CODEDES(JJ); J = 15 - M; PTYPE = TYPEP; KFORM = NPARMS; SNDISP = JJ >> 16; ACC = JJ & 0xFFFF; STORETAG(KK, OPHEAD); /* End of Begin/Rt/Fn/Map depth=3 */ }; void CFPLIST(int *OPHEAD, int *NPARMS) { //*********************************************************************** //*COMPILEAFORMALPARAMETERPARTINTOALISTOFPARAMETERTYPES* //*P(FPP)='('*')',0.* //** //*THELISTOFPARAMETERLOOKSLIKE:-* //*S1=PTYPEFORPARAM<<16!DIMENSION(DIMENDEDUCEDLATER)* //*S2=ACC<<16!SPARE* //*S3=0(RESERVEDFORFPPOFRTS)* //** //*ONENTRYPISATALTOFFPP(WHICHMAYBENULL)* //*********************************************************************** int OPBOT; int PP; OPHEAD = 0; OPBOT = 0; // ZEROPARAMETERSASYET NPARMS = 0; while (A == 1) { // WHILESOME(MORE)FPS // TONEXTFPDEL PP = P + 1 + FROMAR2(P + 1); // TOALTOFFPDEL P = P + 3; // GETTYPE&ACCFORNEXTGROUP CFPDEL(); /* Deferred: until (A == 2) */ do { // DOWNFOREACHDEL BINSERT(OPHEAD, OPBOT, PTYPE << 16, ACC << 16, 0); NPARMS = NPARMS + 1; P = P + 3; } while (!(A == 2)); P = PP; } P = P + 1; /* End of Begin/Rt/Fn/Map depth=3 */ }; void CFPDEL(void) { //*********************************************************************** //*SETUPPTYPE&ACCFORAFORMALPARAMETERDEFINITION* //*P=, * //* 'record'<%ARRAY'>'%NAME'.* //*(RT)(name'')(NAMELIST)(FPP),* //*'%NAME'.* //*********************************************************************** /* TO DO: %SWITCH DECLARATION */ /*Q imp80-switch.h:4253*/ int FPALT; FPALT = A; P = P + 1; KFORM = 0; LITL = 0; goto FP[FPALT]; //(TYPE)(qname'') FP_1: ROUT = 0; CLT(); CQN(P); if (TYPE == 5 && ACC == 0) FAULT(70, 0); P = P + 1; goto PK; // RECORD(array'')name FP_2: ARR = 2 - A; ROUT = 0; ACC = 8 + 8 * ARR; TYPE = 3; PREC = 3; NAM = 1; P = P + 1; goto PK; //(RT)(name'')(NAMELIST)(FPP) FP_3: ROUT = 1; NAM = 1; ARR = 0; if (A == 1) { // RT=rouitne TYPE = 0; PREC = 0; P = P + 2; } else { // RT=(TYPE)(FM) P = P + 1; CLT(); NAM = 1; // 1FORFN3FORMAP if (A == 2) NAM = 3; // PAST(name'')WHICHISIGNORED P = P + 2; } ACC = 16; goto PK; // name FP_4: ACC = 8; NAM = 1; ROUT = 0; TYPE = 0; ARR = 0; PREC = 0; PK: PACK(PTYPE); /* End of Begin/Rt/Fn/Map depth=3 */ }; void DIAGPOINTER(int LEVEL) { if (PARMTRACE != 0) { PUSH(RAL[(LEVEL)], 1, CA, LDB << 24 | 3 << 23); PF1(LDB, 0, 0, 0); GRUSE[(DR)] = 0; } /* End of Begin/Rt/Fn/Map depth=3 */ }; void RHEAD(int KK) { //*********************************************************************** //*COMPILESCODEFORBLOCKANDROUTINEENTRY* //*KKISTHERT/FN/MAPNAME(=-1FORbeginBLOCKS)* //*********************************************************************** 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; ONINF[(LEVEL)] = 0; ONWORD[(LEVEL)] = 0; if (KK >= 0) { RLEVEL = RLEVEL + 1; RBASE = RLEVEL; } if (LEVEL == MAXLEVELS) FAULT(34, 0); if (LEVEL > MAXLEVELS) FAULT(105, 0); if (KK >= 0 && RLEVEL > 1) { // ROUTINEENTRY // LISTOFJUMPS COPYTAG(KK); JJ = K; J = MIDCELL; if (J == 0 && LEVEL > 2) { // REPLACE'NOT USED'BIT REPLACE1(TAGS[(KK)], FROM1(TAGS[(KK)]) & 0xFFFF3FFF); } // // NOWFILLANYJUMPSTOTHISROUTINEPLANTEDSINCE // THEROUTINESPECWASCOMPILED.SEEALSO'RT JUMP' // while (J != 0) { POP(J, INSRN, AT, W1); W3 = CA - AT; if (INSRN >> 25 == CALL >> 1) W3 = W3 / 2; INSRN = INSRN + W3; PLUG(1, AT, INSRN, 4); } // NOTEADDRFORFUTURECALLS REPLACE2(TAGS[(KK)], CA); } if (KK >= 0 && RLEVEL == 1) { DIAGPOINTER(LEVEL); PSF1(STD, 1, 12); } if (KK < 0) W3 = 0; else W3 = WORD[(KK)]; L[(LEVEL)] = LINE; M[(LEVEL)] = W3; // CURRENTBLOCKTYPEMARKER FLAG[(LEVEL)] = PTYPE; /* End of Begin/Rt/Fn/Map depth=3 */ }; void RDISPLAY(int KK) { //*********************************************************************** //*SETUPORCOPYTHEDISPLAY(AWORDARRAYCONTAININGCOPIESOF* //*LNBFORTHEGLOBALLEVELS.THEHIGHESTLEVELENTRYISTOTHE* //*GLA(PLT)FOROWNSANDISALSOKEPTIN(LNB+4)INCASEWEWISH* //*TOMOVETOREAD-ONLYPLTS.ONINTERNALCALLSTHELNBFORTHE* //*NEXTMOSTGLOBALLEVELISSTACKEDASANEXTRAPARAMETER* //*********************************************************************** int W1; int W2; int STACK; int OP; int INC; if (KK >= 0 || LEVEL == 2) { // DISPLAYNEEDED STACK = 0; DISPLAY[(RLEVEL)] = N; GRUSE[(XNB)] = 0; GRUSE[(CTB)] = 0; GRUSE[(BREG)] = 0; if (LEVEL != 2) { // PF1(LXN,0,TOS,0) GRUSE[(XNB)] = 4; GRINF1[(XNB)] = RLEVEL - 1; GRAT[(XNB)] = CA; // COPYPLTDESCRIPTOR PF1(LD, 0, XNB, 12); DIAGPOINTER(LEVEL); PSF1(STD, 1, 12); W1 = RLEVEL - 1; W2 = DISPLAY[(W1)]; if (W1 == 1) { PF1(STXN, 0, TOS, 0); 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; } } } // STTOS if (STACK != 0) PF1(ST, 0, TOS, 0); PF1(STLN, 0, TOS, 0); N = N + 4; } // // IFINDIAGNOSTICMODEPLANTCODETOSAVETHELINE&ROUTINENOOF // THECALLINGROUTINEANDSETUPTHENEWBLOCK/ROUTINEIDENTNO. // if (PARMTRACE != 0) { // M'IDIA' if (PARMOPT != 0) PF1(LSS, 0, PC, 4 * CONSTBTM | 0x80000000); if (KK >= 0 || LEVEL == 2) { if (PARMOPT != 0) { PSF1(SLSS, 0, LINE); N = N + 4; } else PSF1(LSS, 0, LINE); PF1(ST, 0, TOS, 0); } else { if (PARMOPT != 0) { PSF1(ST, 1, N); N = N + 4; } PSF1(LSS, 0, LINE); PSF1(ST, 1, N); // UPDATEBNDFIELD PSF1(LD, 1, 12); DIAGPOINTER(LEVEL); PSF1(STD, 1, 12); } DIAGINF[(LEVEL)] = N; N = N + 4; // NEEDEDFORbeginBLOCKS GRUSE[(ACCR)] = 0; } if (PARMOPT != 0 && KK >= 0 && LEVEL == 2) { PF1(STSF, 0, BREG, 0); PF1(STLN, 0, TOS, 0); PF1(SBB, 0, TOS, 0); PSF1(CPB, 0, N); PPJ(7, 13); } // // CLAIM(THERESTOF)THESTACKFRAME // if (KK >= 0 || LEVEL == 2) { SET[(RLEVEL)] = N << 18 | CA; NMAX = N; // ASFORLB PF1(ASF + 12 * PARMCHK, 0, 0, 0); if (PARMCHK != 0) PPJ(0, 4); } // if (KK >= 0 && PARMCHK != 0) { // CHECKFORSTACKO''FLOW CHECKSTOF(); } // TOCALLDBUGPACKAGE if (PARMDBUG != 0) SETLINE(); /* End of Begin/Rt/Fn/Map depth=3 */ }; void CHECKSTOF(void) { //*********************************************************************** //*CHECKTHESTACKFOROVERFLOW(LEAVING4KMARGINFORMDIAG* //*********************************************************************** if (PARMOPT != 0) { // // STSFTOSGETSTACKPOINTER // LSSTOS // USH+14 // USH-15LOSESEGMENTNO // ICPX'1F800'CHECKWITHINSEGADDRESS // SHIFTEDDOWN1PLACE // JCC2,EXCESSBLKS // PF1(STSF, 0, TOS, 0); PF1(LSS, 0, TOS, 0); PSF1(USH, 0, 14); PSF1(USH, 0, -15); PF1(ICP, 0, 0, STLIMIT >> 1); PPJ(2, 8); } /* End of Begin/Rt/Fn/Map depth=3 */ }; // OFROUTINERHEAD void CIOCP(int N, int REG) { //*********************************************************************** //*COMPILESACALLONIOCPENTRYPOINTNO'N'* //*2NDPARAMETERISALREADINTHEACCWHICHIS32BITS* //*********************************************************************** int XYNB; int OP1; int OP2; if (IOCPDISP == 0) CXREF(IOCPEP, PARMDYNAMIC, 2, IOCPDISP); if (REGISTER[(BREG)] != 0) BOOTOUT(BREG); if (REG == ACCR) { OP1 = LUH; OP2 = ST; } else { OP1 = LDTB; OP2 = STD; } PSF1(OP1, 0, N); PSF1(PRCL, 0, 4); PF1(OP2, 0, TOS, 0); // TOPLT XYNB = SETXORYNB(-1, -1); PSF1(RALN, 0, 7); PF1(CALL, 2, XYNB, IOCPDISP); FORGET(-1); /* End of Begin/Rt/Fn/Map depth=3 */ }; void CUI(int CODE) { //*********************************************************************** //*COMPILEANUNCONDITIONALINSTRNWHEREEVERITOCCURS* //*CODE=0UNCONDITIOALLY,=1AFTERthen,=2AFTERelse* //*********************************************************************** int MARKER; int J; int LNAME; int TYPEP; int PRECP; int GWRDD; int LWB; int XYNB; int ARRP; int ALT; /* TO DO: %SWITCH DECLARATION */ /*Q imp80-switch.h:4253*/ REPORTUI = 0; ALT = A; goto SW[ALT]; //(NAME)(APP)(ASSMNT?) SW_1: P = P + 1; MARKER = P + FROMAR2(P); if (A == 1) { J = P + 2; P = MARKER + 2; ASSIGN(A, J); } else { P = P + 2; CNAME(0, 0); P = P + 1; } AUI: J = A; P = P + 1; if (J == 1) CUI(CODE); return; //->(NAME)(APP) SW_2: NMDECS[(LEVEL)] = NMDECS[(LEVEL)] | 1; if (CODE == 0) CURRINST = 1; LNAME = FROMAR2(P + 1); J = A; P = P + 4; if (J == 2) { // SIMPLELABEL ENTERJUMP(15, LNAME, 0); REPORTUI = 1; } else { // SWITCHLABELS COPYTAG(LNAME); ARRP = ARR; // BYTEDISPOFDESCRIPTORINPLT GWRDD = SNDISP << 2; if (!(OLDI == LEVEL && TYPE == 6)) { FAULT(4, LNAME); P = P - 1; SKIPAPP(); return; } // GETLOWERBOUND LWB = FROM2(K); CSEXP(BREG, 0x51); if (ARRP == 1) PSF1(SBB, 0, LWB); // TOPLT XYNB = SETXORYNB(-1, -1); // JUMPINDIRECTVIAWORDARRAY PF1(JUNC, 3, XYNB, GWRDD); // OF32BITRELOCATEDADDRESSES REPORTUI = 1; FORGET(-1); } return; // RETURN SW_3: if (!(FLAG[(LEVEL)] & 0x3FFF == 0x1000)) FAULT(30, 0); P = P + 1; RET: RTEXIT(); REPORTUI = 1; if (CODE == 0) CURRINST = 1; return; // result(ASSOP)(EXPR) SW_4: PTYPE = FLAG[(LEVEL)] & 0x3FFF; UNPACK(); if (PTYPE > 0x1000 && A != 3) { // ASSOP#'->' if (A == 1 && NAM != 0 && A == 4 && A == 1) { P = P + 7; TYPEP = TYPE; PRECP = PREC; CNAME(4, ACCR); if (!(A == 2)) FAULT(81, 0); P = P + 1; if (!(TYPEP == TYPE && PRECP == PREC)) FAULT(83, 0); goto RET; } if (A == 2) { // ASSOP='=' P = P + 2; // MAPSHAVEINTEGERRESULTS if (NAM != 0) TYPE = 1; if (TYPE == 5) { CSTREXP(0, ACCR); // RESULTDESCRPT PSF1(LD, 1, DISPLAY[(RBASE)] - 8); PF1(IAD, 0, PC, SPECIALCONSTS(2)); PF2(MV, 1, 1, 0, 0, UNASSPAT & 255); PSF1(LDB, 2, DISPLAY[(RBASE)] - 8); COPYDR(); } else { if (PREC < 5) PREC = 5; if (NAM == 0) KK = PREC << 4 | TYPE; else KK = 0x51; CSEXP(ACCR, KK); } goto RET; } } FAULT(31, 0); // IGNORESPURIOUSRESULT P = P + 2; SKIPEXP(); return; // monitor(AUI) SW_5: // ERR=0&EXTRA=0 PSF1(LSD, 0, 0); // TOERRORROUTINE PPJ(0, 2); P = P + 1; goto AUI; // stop SW_6: PPJ(0, 21); P = P + 1; if (CODE == 0) CURRINST = 1; REPORTUI = 1; return; //'%SIGNAL'(EVENT'')(N)(OPEXPR) SW_7: PSF1(PRCL, 0, 4); // STACKDUMMYPC PSF1(JLK, 0, 1); if (NMDECS[(LEVEL)] & 16 != 0) { // INAN'ON'GROUP if (FLAG[(LEVEL)] <= 2) { // INABEGINBLOCK // SORESETDIAGPOINTER PSF1(LD, 1, 12); // TONEXTOUTERBLOCK DIAGPOINTER(LEVEL - 1); PSF1(STD, 1, 12); PF1(STLN, 0, TOS, 0); } else { //''ONINART/FN/MAP // GETPREVIOUSLNB PSF1(LSS, 1, 0); // ANDSTACKTHAT PF1(ST, 0, TOS, 0); } } else PF1(STLN, 0, TOS, 0); GRUSE[(ACCR)] = 0; // EVENTNO J = A; if (!(1 <= J && J <= 15)) FAULT2(26, J, 0); if (A == 1) { // SUBEVENTSPECIFIED P = P + 4; CSEXP(ACCR, 0x51); PF1(AND, 0, 0, 255); PF1(OR, 0, 0, 256 * J); } else PF1(LSS, 0, 0, 256 * J); PSF1(SLSS, 0, 0); PF1(ST, 0, TOS, 0); // TOPLT XYNB = SETXORYNB(-1, -1); PSF1(RALN, 0, 9); PF1(CALL, 2, XYNB, 40); if (CODE == 0) CURRINST = 1; REPORTUI = 1; return; // exit SW_8: // continue SW_9: // 0FOREXIT1FORCONTINUE ALT = ALT & 7; if (EXITLAB == 0) { FAULT2(54 + ALT, 0, 0); return; } KK = INTEGER(ADDR(EXITLAB) + 4 * ALT); ENTERJUMP(15, KK, 0b10); REPORTUI = 1; if (CODE == 0) CURRINST = 1; /* End of Begin/Rt/Fn/Map depth=3 */ }; void CIFTHEN(int MARKIU, int MARKC, int MARKUI, int MARKE, int MARKR, int SKIP) { //*********************************************************************** //*THISROUTINECOMPILESCONDITIONALEXPRESSIONS.ITREQUIRESTHE* //*FOLLOWINGPARAMETERSTOBESETTOTHEIRA.R.ENTRY.* //*MARKIUTOTHEENTRYFORP(iu)* //*MARKCTOTHEENTRYFORP(COND)* //*MARKUITOTHEENTRYFOR(FIRSTOCCURRENCEOF)P(UI)* //*MARKETOTHEENTRYFORP(ELSE'')-=0FORBACKWARDSCONDITION* //*MARKRTOENTRYFORP(RESTOFIU)-=0FORBACKWARDSCONDITION* //*********************************************************************** int ALTUI; int CCRES; int ELRES; int THENLAB; int ELSELAB; int USERLAB; int REPORT; int START; int ELSEALT; int K; const int NULLELSE = 4; /* TO DO: %SWITCH DECLARATION */ /*Q imp80-switch.h:4253*/ if (!(SKIP == YES)) SETLINE(); // ALTOFIU1=if,2=unless MARKIU = A; PLABEL = PLABEL - 1; THENLAB = PLABEL; // NOSTARTINCONDITIONYET START = 0; // MEANSNOELSECLAUSE ELSELAB = 0; P = MARKC; //'%START'OR'%THENSTART' if (MARKR > 0 && A <= 2) START = 1; if (MARKE != 0 && LEVEL < 2 && START == 0) FAULT(57, 0); USERLAB = -1; if (START != 0) ALTUI = 0; else ALTUI = A; // UI=SIMPLELABEL if (ALTUI == 2 && A == 2) USERLAB = FROMAR2(MARKUI + 1); if (8 <= ALTUI && ALTUI <= 9 && EXITLAB != 0) { // VALIDEXIT if (ALTUI == 8) USERLAB = EXITLAB; else USERLAB = CONTLAB; } // if (SKIP == YES) { // NOCODENEEDED if (START != 0) { P = MARKR + 1; // NOCODE CSTART(2, 1); MARKE = P; } // NOCODEFORELSE CCRES = 1; goto ELSE; } // if (USERLAB >= 0) { // FIRSTUIIS'->'