#include $define unless(cond) if (!(cond)) $define until(cond) while(!(cond)) imp80: parsed "/dev/stdin" successfully extern void SELECTINPUT(int STREAM); extern void SELECTOUTPUT(int STREAM); extern void NEWLINE(void); extern void SPACE(void); extern void SKIPSYMBOL(void); extern void READSTRING(_imp_string *S); extern void NEWLINES(int N); extern void SPACES(int N); extern int NEXTSYMBOL(void); extern void PRINTSYMBOL(int SYMBOL); extern void READSYMBOL(void **SYMBOL); extern void READ(void **NUMBER); extern void WRITE(int VALUE, int PLACES); extern void NEWPAGE(void); extern int ADDR(void **VARIABLE); extern double ARCSIN(double X); extern int INT(double X); extern int INTPT(double X); extern double FRACPT(double X); extern void PRINT(double NUMBER, int BEFORE, int AFTER); extern void PRINTFL(double NUMBER, int PLACES); extern float *REAL(int VARADDR); extern int *INTEGER(int VARADDR); extern double MOD(double X); extern double ARCCOS(double X); extern double SQRT(double X); extern double LOG(double X); extern double SIN(double X); extern double COS(double X); extern double TAN(double X); extern double EXP(double X); extern void CLOSESTREAM(int STREAM); extern char *BYTEINTEGER(int VARADDR); extern int EVENTINF(void); extern double RADIUS(double X, double Y); extern double ARCTAN(double X, double Y); extern char *LENGTH(_imp_string *S); extern void PRINTSTRING(_imp_string STR); extern int NL(void); extern double *LONGREAL(int VARADDR); extern void PRINTCH(int CHARACTER); extern void READCH(void **CHARACTER); extern _imp_string *STRING(int VARADDR); extern void READITEM(_imp_string *ITEM); extern _imp_string NEXTITEM(void); extern char *CHARNO(_imp_string *STR, int CHARREQD); extern _imp_string TOSTRING(int CH); extern _imp_string SUBSTRING(_imp_string STR, int FIRST, int LAST); //externalrecord(*)mapspecRECORD(integerRECADDR) //externalarraymapspecARRAY(integerA1ADDR,arraynameFORMAT) extern int SIZEOF(void **X); extern int IMOD(int VALUE); extern double PI(void); extern int EVENTLINE(void); extern long int *LONGINTEGER(int ADR); extern long double *LONGLONGREAL(int ADR); extern long int LENGTHENI(int VAL); extern long double LENGTHENR(double VAL); extern int SHORTENI(long int VAL); extern double SHORTENR(long double VAL); extern int NEXTCH(void); extern unsigned short int *HALFINTEGER(int ADDR); extern void PPROFILE(void); extern double FLOAT(int VALUE); extern long int LINT(long double X); extern long int LINTPT(long double X); extern short int *SHORTINTEGER(int N); extern int TRUNC(double X); //endoffile /*5*/; /*5*/; 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)-(0)+1] ; $define CLETT[N0] CLETT[(N0)-(0)] = 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] ; $define SYMBOL[N0] SYMBOL[(N0)-(1300)] = 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)-(0)+1] ; $define ITOETAB[N0] ITOETAB[(N0)-(0)] = X'40', 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)-(0)+1] ; $define OPC[N0] OPC[(N0)-(0)] = 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)-(0)+1] ; $define ONECASE[N0] ONECASE[(N0)-(0)] = 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)-(0)+1] ; $define TSNAME[N0] TSNAME[(N0)-(0)] = [ 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)-(0)+1] ; $define FIXEDGLA[N0] FIXEDGLA[(N0)-(0)] = 0, 0x50000000, [ LOW ... HIGH ] = 0, -1, 0, [ LOW ... HIGH ] = 0; const char BYTES[(7)-(0)+1] ; $define BYTES[N0] BYTES[(N0)-(0)] = [ LOW ... HIGH ] = 0, 1, 2, 4, 8, 16; const char TRTAB[(255)-(0)+1] ; $define TRTAB[N0] TRTAB[(N0)-(0)] = [ 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)-(0)+1] ; $define LDCODE[N0] LDCODE[(N0)-(0)] = 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 */ FILEADDR = COMREG(46); //SOURCEFILEIFCLEAN 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; if (ASL > 4095 && PARMBITS2 & MAXDICT == 0) ASL = 4095; //STAYWITHIN128KAUXSTACK ARSIZE = WKFILEK * 768 - 300; } /* End of Begin/Rt/Fn/Map depth=1 */; /* TO DO: %ARRAYFORMAT DECLARATION */; char **A; /*pending name*/recfm ASLIST[(ASL)-(0)+1] ; $define ASLIST[N0] ASLIST[(N0)-(0)] //(LISTF) int WORD[(NNAMES)-(0)+1] ; $define WORD[N0] WORD[(N0)-(0)] int TAGS[(NNAMES)-(0)+1] ; $define TAGS[N0] TAGS[(N0)-(0)] /*H imp80-switch.h:2313*/ int DVHEADS[(12)-(0)+1] ; $define DVHEADS[N0] DVHEADS[(N0)-(0)] 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)-(0)+1] ; $define DISPLAY[N0] DISPLAY[(N0)-(0)] int SFS[(MAXLEVELS)-(0)+1] ; $define SFS[N0] SFS[(N0)-(0)] /*H imp80-switch.h:2313*/ char TLINE[(161)-(-60)+1] ; $define TLINE[N0] TLINE[(N0)-(-60)] char CC[(CCSIZE)-(0)+1] ; $define CC[N0] CC[(N0)-(0)] char LETT[(DSIZE + 20)-(0)+1] ; $define LETT[N0] LETT[(N0)-(0)] long int ATL0; long int ASYM0; const char ILETT[(500)-(0)+1] ; $define ILETT[N0] ILETT[(N0)-(0)] = 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]); INTEGER(ADDR(ATL0) + 4) = ATLINE1 - 1; INTEGER(ADDR(ATL0) ) = 0x18000100; INTEGER(ADDR(ASYM0) ) = 0x28000C00; INTEGER(ADDR(ASYM0) + 4) = ADDR(SYMBOL[1300]) - 4 * 1300; N = 12; MAXULAB = NNAMES + 16384; //LARGESTVALIDUSERLABEL 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; MAINEP = "S#GO"; //DEFAULTMAINENTRY 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; PARMPROF = (I >> 15 & 1) | (I >> 7 & 1); //USEMAPORPROFILEBITPROTEM PARMDYNAMIC = I >> 20 & 1; PARMLET = I >> 13 & 1; DCOMP = I >> 14 & 1; //PARMCODEORD PARMDBUG = I >> 18 & 1; if (I & 64 == 64) { PARMTRACE = 0; PARMDIAG = 0; } FREEFORMAT = I & 0x80000; STACK = I >> 3 & 1; SMAP = I >> 26 & 1; //USEPARMZBITFORDUMPINGWKFILE TTOPUT = COMREG(40); if (I & (1 << 16) != 0) { PARMARR = 0; PARMOPT = 0; PARMLINE = 0; PARMCHK = 0; PARMDIAG = 0; } PARMTRACE = PARMTRACE | PARMOPT; //ALLOWNOTRACEONLYWITHOPT IMPS = I >> 23 & 1; //BITSETIFIMPSREQUESTED IMPS = 1; //FORTESTING 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 DUMMYFORMAT = 0; //DUMMYRECORDFORMAT DFHEAD = 0; PUSH(DFHEAD, 0, 0, 0); PUSH(DUMMYFORMAT, 0, 0, DFHEAD); //FORBETTERERRORRECOVERY 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; } else A = 128; //FLAGASUNLINKED } //*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 if (A == ENDALT && 1 <= A && A <= 2) break; //ENDOFPROGORFILE 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 { asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; } 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]; 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; } unless (I == NL() ) goto NEXT; } else { asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; GETLINE(); asm(/*to do*/)/*5*/; RLL1: asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; //'%' asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; RLL3: asm(/*to do*/)/*5*/; //LOWERCASETOUPPER asm(/*to do*/)/*5*/; //'A' asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; //'Z' asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; RLL4: asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; //' ' asm(/*to do*/)/*5*/; RLL5: asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; //'''' asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; //'"' asm(/*to do*/)/*5*/; RLL6: asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; RLL7: asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; RLL2: asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; RLL9: asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; 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)-(0)+1] ; $define ITOI[N0] ITOI[(N0)-(0)] = [ 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 ) */ do { READSYMBOL(K); TLINE[LL + 1] = 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) { asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; goto OLIST; } IMP: || K == 0) */ do { K = BYTEINTEGER(FILEPTR); //NEXTCHARFROMSORCEFILE FILEPTR = FILEPTR + 1; TLINE[LL + 1] = ITOI[K]; LL = LL + 1; } while (! (K == NL() || K == 0) ); OLIST: } //ifMODE=0andLL=1thenGETLINEandreturn //LINE=LINE+1unlessMODE=0andLENGTH>0 LINE = LINE + 1; //COUNTALLLINES 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] = ' '; } if (MODE != 0) TLINE[-7] = '"'; TLINE[-8] = LL + 8; IOCP(15, ADDR(TLINE[-8]) ); } if (FREEFORMAT == 0 && LL > 73) { TLINE[73] = 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]; RL = LEVEL; P = P + 1; PP = P; //ROUTINEREALLYSTARTSHERE } else { asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; SUBENTRY: asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; } COMM: if (USEIMP == YES) { RQ = Q; //RESETVALUESOFLINE&ARPTRS RR = R; SSL = STRLINK; //SAVESTRINGLINK ALT = 1; //FIRSTALTERNATIVETOBETRIED RA = SYMBOL[P]; //RATONEXTPHRASEALTERNATIVE RS = P; } else { asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; } UPR: R = R + 1; SUCC: //SUCCESSONTONEXTITEM if (USEIMP == YES) { RS = RS + 1; //RS=NEXTALTERNATIVEMEANSTHAT //THISALTHASBEENCOMPLETEDSO //EXITWITHHIT=1 if (RS == RA) goto FINI; ITEM = SYMBOL[RS]; //NEXTBRICKINTHECURRENTALT if (ITEM < 999) goto LIT; } else { asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; } if (ITEM < 1300) goto BIP[ITEM]; //BRICKISAPHRASETYPE if (USEIMP == YES) { if (COMPARE(ITEM) == 0) goto FAIL; } else { asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; //RESULT=0FORFAIL asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; } goto SUCC; LIT: //BRICKISLITERAL if (USEIMP == YES) { I = CC[ Q]; //OBTAINCURRENTCHARACTER unless (I == CLETT[ITEM + 1]) goto FAIL; Q = Q + 1; K = CLETT[ITEM] + ITEM; ITEM = ITEM + 2; while (ITEM <= K) { unless (CC[ Q] == CLETT[ITEM]) goto FAIL; Q = Q + 1; ITEM = ITEM + 1; }//CHECKITWITHLITERALDICTENTRY } else { asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; } goto SUCC; //MATCHEDSUCCESSFULLY FAIL: //FAILURE-NOTEPOSITIONREACHD if (USEIMP == YES) { if (RA == RP) goto TFAIL; //TOTALFAILURENOALTTOTRY if ( Q > QMAX) QMAX = Q; Q = RQ; //RESETLINEANDA.R.POINTERS R = RR + 1; //AVOIDGOINGVIAUPR: STRLINK = SSL; ALT = ALT + 1; //MOVETONEXTALTOFPHRASE RS = RA; RA = SYMBOL[RA]; } else { asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; CPL1: asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; } goto SUCC; TFAIL: LEVEL = RL; if (USEIMP == YES) { return 0; } else { asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; } BIP_999://REPEATEDPHRASE A = ALT; P = PP; goto COMM; BIP_1000:FINI: //NULLALWAYSLAST&OK A = ALT; if (USEIMP == YES) { return 1; } else { asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; } BIP_1001://PHRASENAME BIP_1004://PHRASEOLDNAME I = CC[ Q]; //OBTAINCURRENTCHARACTER unless (TRTAB[I] == 2) goto FAIL; PNAME(ITEM - 1004); if (HIT == 1) goto SUCC; goto FAIL; BIP_1002://PHRASEINTEGERCONSTANT BIP_1003://PHRASECONST CONST(ITEM - 1003); if (HIT == 0) goto FAIL; goto SUCC; BIP_1005://PHRASEN I = CC[ Q]; //OBTAINCURRENTCHARACTER unless ('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; BIP_1006://PHRASES=SEPARATOR I = CC[ Q]; //OBTAINCURRENTCHARACTER if (I == NL() ) goto SUCC; unless (I == ';') goto FAIL; Q = Q + 1; goto SUCC; BIP_1007: //PHRASECOMMENTTEXT I = CC[ Q]; //OBTAINCURRENTCHARACTER J = I; if (I == ';' || I == NL() ) goto TX; unless (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; BIP_1008://PHRASEBIGHOLE TOAR4(R, 0); R = R + 4; goto SUCC; BIP_1009://PHRASEN255 I = CC[ Q]; //OBTAINCURRENTCHARACTER unless ('0' <= I && I <= '9') goto FAIL; S = 0; while ('0' <= I && I <= '9') { S = 10 * S + (I & 15); Q = Q + 1; I = CC[ Q]; } unless (0 <= S && S <= 255) goto FAIL; A = S; goto UPR; BIP_1010://PHRASEHOLE MARKER = R; R = R + 2; goto SUCC; BIP_1011://PHRASEMARK I = R - MARKER; A = I; A = I >> 8; goto SUCC; BIP_1012://PHRASEREADLINE? I = CC[ Q]; //OBTAINCURRENTCHARACTER while (I == NL() ) { READLINE(0, 0); RQ = 1; I = CC[ Q]; } if (R > ARSIZE) FAULT(102, 0); goto SUCC; BIP_1013://PHRASECHECKIMPS unless (IMPS == 1) goto FAIL; goto SUCC; BIP_1014://PHRASEDUMMYAPP A = 2; A = 2; R = R + 2; goto SUCC; BIP_1015://PHRASEDOWN=NEWTEXTLEVEL LEVEL = LEVEL + 1; TOAR4(R, 0); DISPLAY[ LEVEL] = R; SFS[ LEVEL] = 0; R = R + 4; goto SUCC; BIP_1016://PHRASEUP1TEXTUALLEVEL DISPLAY[ LEVEL] = 0; while (SFS[ LEVEL] != 0) { POP(SFS[ LEVEL], I, J, K); if (I == 1) FAULT2(53, K, 0); //FINISHMISSING if (I == 2) FAULT2(13, K, 0); //repeatMISSING } LEVEL = LEVEL - 1; goto SUCC; BIP_1017://PHRASELISTON LIST = 1; goto SUCC; BIP_1018://PHRASELISTOFF LIST = 0; goto SUCC; BIP_1019://PHRASECOLONFORLABEL unless (CC[ Q - 1] == ':') goto FAIL; goto SUCC; BIP_1020://PHRASENOTECONST if (CTYPE == 5) { TOAR4(S - 4, STRLINK); STRLINK = S - 4; } goto SUCC; BIP_1021://TRACEFORONCONDITIONS PARMTRACE = 1; goto SUCC; BIP_1022://SETMNEMONIC I = CC[ Q]; //OBTAINCURRENTCHARACTER S = ' '; while ('A' <= I && I <= 'Z') { S = S << 8 | I; Q = Q + 1; I = CC[ Q]; } unless (I == '_' && S != ' ') goto FAIL; Q = Q + 1; goto SUCC; BIP_1023://PRIMARYFORMATMNEMOINC 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; BIP_1024://SECONDARYFORMATMNEMONIC 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; BIP_1025://TERTIARYFORMATMNEMONIC for (I = 3; I != 1; I += -1) { if (OPC[I] == S) { A = 2 * I; goto UPR; } }goto FAIL; BIP_1026://P(OP)=+,-,&,****,**,*,!!,!, ////,/,>>,<<,.,\\,\ I = CC[ Q]; //OBTAINCURRENTCHARACTER unless (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; BIP_1027://PHRASECHECKUI I = CC[ Q]; //OBTAINCURRENTCHARACTER if (TRTAB[I] == 2 || I == '-') goto SUCC; if (0x80000000 >> (I & 31) & 0x14043000 != 0) goto SUCC; goto FAIL; BIP_1028://P(+'')=+,-,\,0 I = CC[ Q]; //OBTAINCURRENTCHARACTER 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; BIP_1029://PHRASENOTECYCLE TOAR4(R, 0); PUSH(SFS[ LEVEL], 2, R, LINE); R = R + 4; goto SUCC; BIP_1030://P(,'')=',',0 // //THISISVERYAWKWARDASITMEANSITISVERYTOHARDTOFIND //THEENDOFAPARAMETERLISTWITHOUTCHURNING.BYMAKINGTHISABIP //WECANPEEPAHEADFOR')'ANDFAILHERE. // I = CC[ Q]; //OBTAINCURRENTCHARACTER if (I == ')') goto FAIL; if (I == ',') Q = Q + 1; goto SUCC; BIP_1031://PHRASECHECKTYPEIEENSURE //FIRSTLETTERIS(B,H,I,L,R,S)& //3RDLETTERIS(A,L,N,R,T) I = CC[ Q]; //OBTAINCURRENTCHARACTER unless (I > 128 && 0x80000000 >> (I & 31) & 0x20C83000 != 0 && 0x80000000 >> (CC[ Q + 2] & 31) & 0x400A2800 != 0) goto FAIL; goto SUCC; BIP_1032://PHRASECOMP1 BIP_1037://PHRASECOMP2(IS2NDHALFOFDSIDED) I = CC[ Q]; //OBTAINCURRENTCHARACTER unless (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 if (SAVECOMP > 6 || J > 6) { Q = Q - 1; goto FAIL; }//ILLEGALDSIDED goto UPR; //NBOWNSWONTWORKIF //CONDEXPRSALLOWEDASTHE //CANBENESTED! BIP_1033://P(ASSOP)-==,=,<-,-> I = CC[ Q]; //OBTAINCURRENTCHARACTER 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; BIP_1034://NOTESTART TOAR4(R, 0); //HOLEFORFORWARDPTR PUSH(SFS[ LEVEL], 1, R, LINE); R = R + 4; goto SUCC; BIP_1035://NOTEFINISH 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; BIP_1036://NOTEREPEAT if (SFS[ LEVEL] == 0) { FAULT2(1, 0, 0); goto SUCC; } POP(SFS[ LEVEL], I, J, K); if (I == 1) FAULT2(52, K, 0); //STARTINSTEADOFCYCLE TOAR4(J, STARSTART); goto SUCC; BIP_1038://INCLUDE"FILE" if (VMEB == YES) goto FAIL; I = CC[ Q]; unless (I == NL() || I == ';') goto FAIL; if (I == ';') Q = Q + 1; unless (CTYPE == 5) goto FAIL; PUSH(IHEAD, FILEADDR, FILEPTR, FILEEND); CONSOURCE(STRING(ADDR(A) ) , FILEADDR); //DEPARTSIFFAILS 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)-(0)+1] ; $define HASH[N0] HASH[(N0)-(0)] = 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]; unless (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: asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; //ITOACC asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; SKIP: asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; EXIT: } LETT[NEXT] = T; //INSERTLENGTH S = T + 1; if (NEXT + S > DSIZE) FAULT(103, 0); //DICTIONARYOVERFLOW JJ = (JJ + 113 * T) & NNAMES; if (USEIMP == YES) { for (KK = JJ; KK != NNAMES; KK += 1) { LL = WORD[KK]; if (LL == 0) goto HOLE; //NAMENOTKNOWN if (STRING(ADDR(LETT[NEXT]) ) == STRING(ADDR(LETT[LL]) ) ) goto FND; } for (KK = 0; KK != JJ; KK += 1) { LL = WORD[KK]; if (LL == 0) goto HOLE; //NAMENOTKNOWN if (STRING(ADDR(LETT[NEXT]) ) == STRING(ADDR(LETT[LL]) ) ) goto FND; } } else { asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; CYC1: asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; CYC2: asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; } FAULT(104, 0); //TOOMANYNAMES 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; unless (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; QUOTE: //SINGLECHBETWEENQUOTES if (CC[ Q + 2] == '\'\'') { S = CC[ Q + 1]; Q = Q + 3; if (S != '\'\'') goto IEND; if (CC[ Q] == '\'\'') { Q = Q + 1; goto IEND; } } return; //NOTVALID NOTQUOTE: //CHECKFORE"...." unless (FS == 'E' && CC[ Q + 1] == '"') return; EBCDIC = 1; Q = Q + 1; STR2: //DOUBLEQUOTEDSTRING A = 0x35; TEXTTEXT(EBCDIC); CTYPE = 5; return; HEX: T = 0; //HEXCONSTANTS do { I = CC[ Q]; Q = Q + 1; if (I == '\'\'') break; T = T + 1; unless ('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; } unless (MODE != 0 && CPREC == 6) HIT = 1; A = CPREC << 4 | CTYPE; return; RHEX: //REALHEXCONSTANTS 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; unless ('0' <= I && I <= '9' || 'A' <= I && I <= 'F') return; S = (S << 4) + (I & 15) + 9 * (I >> 6); } while (1); unless (T == 8 || T == 16 || T == 32) return; if (T == 32) CPREC = 7; else CPREC = 4 + T / 8; A = CPREC << 4 | 2; HIT = 1; return; OCT: //OCTALCONSTANTS T = 0; do { I = CC[ Q]; Q = Q + 1; T = T + 1; if (I == '\'\'') break; unless ('0' <= I && I <= '7' && T < 12) return; S = S << 3 | (I & 7); } while (1); goto IEND; MULT: T = 0; //MULTIPLECONSTANTS 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; BIN: T = 0; //BINARYCONST do { I = CC[ Q]; Q = Q + 1; T = T + 1; if (I == '\'\'') break; unless ('0' <= I && I <= '1' && T < 33) return; S = S << 1 | I & 1; } while (1); goto IEND; N: //CONSTANTSTARTSWITHDIGIT I = CC[ Q]; do { CVALUE = TEN * CVALUE + (I & 15); Q = Q + 1; I = CC[ Q]; //ONTONEXTCHAR } while (! (I < '0' || I > '9') ); unless (MODE == 0 && I == '.') goto ALPHA; DOT: Q = Q + 1; X = TEN; I = CC[ Q]; DOTSEEN = 1; //CONSTANTHASDECIMALPOINT while ('0' <= I && I <= '9') { CVALUE = CVALUE + (I & 15) / X; X = TEN * X; Q = Q + 1; I = CC[ Q]; } ALPHA: //TESTFOREXPONENT 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; if (A >> 4 != 4) return; //EXPONENTMUSTBEHALFINTEGER S = FROMAR2(R + 1) * Z; if (S == -99) CVALUE = 0; else { if (USEIMP == NO) { asm(/*to do*/)/*5*/; //MASKOUTREALOVERFLOW } while (S > 0) { S = S - 1; CVALUE = CVALUE * TEN; if (USEIMP == NO) { asm(/*to do*/)/*5*/; } } 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; DOTSEEN = 1; //ENSURENOTTAKENASINTEGER } if (DOTSEEN == 1 || CVALUE > IMAX || FRACPT(CVALUE) != 0) CTYPE = 2; else { CTYPE = 1; S = INT(CVALUE); } if (CTYPE == 1) goto IEND; if (CPREC == 5) CPREC = 6; //NO32BITREALCONSTS if (CPREC == 6) { if (USEIMP == NO) { //SOFTWAREROUNDINMCCODEONLY asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; } } 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; unless (I == QU) return; //FAILUNLESSINITIALQUOTE 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)-(0)+1] ; $define REGISTER[N0] REGISTER[(N0)-(0)] int GRUSE[(7)-(0)+1] ; $define GRUSE[N0] GRUSE[(N0)-(0)] /*H imp80-switch.h:2313*/int GRAT[(7)-(0)+1] ; $define GRAT[N0] GRAT[(N0)-(0)] /*H imp80-switch.h:2313*/int GRINF1[(7)-(0)+1] ; $define GRINF1[N0] GRINF1[(N0)-(0)] /*H imp80-switch.h:2313*/int GRINF2[(7)-(0)+1] ; $define GRINF2[N0] GRINF2[(N0)-(0)] /*H imp80-switch.h:2313*/int OLINK[(7)-(0)+1] ; $define OLINK[N0] OLINK[(N0)-(0)] /*H imp80-switch.h:2313*/ char CODE[(268)-(0)+1] ; $define CODE[N0] CODE[(N0)-(0)] char GLABUF[(268)-(0)+1] ; $define GLABUF[N0] GLABUF[(N0)-(0)] /*H imp80-switch.h:2313*/ int PLABS[(31)-(0)+1] ; $define PLABS[N0] PLABS[(N0)-(0)] int DESADS[(31)-(0)+1] ; $define DESADS[N0] DESADS[(N0)-(0)] /*H imp80-switch.h:2313*/int PLINK[(31)-(0)+1] ; $define PLINK[N0] PLINK[(N0)-(0)] /*H imp80-switch.h:2313*/ int SET[(MAXLEVELS)-(0)+1] ; $define SET[N0] SET[(N0)-(0)] int STACKBASE[(MAXLEVELS)-(0)+1] ; $define STACKBASE[N0] STACKBASE[(N0)-(0)] /*H imp80-switch.h:2313*/int RAL[(MAXLEVELS)-(0)+1] ; $define RAL[N0] RAL[(N0)-(0)] /*H imp80-switch.h:2313*/int FLAG[(MAXLEVELS)-(0)+1] ; $define FLAG[N0] FLAG[(N0)-(0)] /*H imp80-switch.h:2313*/int L[(MAXLEVELS)-(0)+1] ; $define L[N0] L[(N0)-(0)] /*H imp80-switch.h:2313*/int M[(MAXLEVELS)-(0)+1] ; $define M[N0] M[(N0)-(0)] /*H imp80-switch.h:2313*/int NMDECS[(MAXLEVELS)-(0)+1] ; $define NMDECS[N0] NMDECS[(N0)-(0)] /*H imp80-switch.h:2313*/int ONWORD[(MAXLEVELS)-(0)+1] ; $define ONWORD[N0] ONWORD[(N0)-(0)] /*H imp80-switch.h:2313*/int ONINF[(MAXLEVELS)-(0)+1] ; $define ONINF[N0] ONINF[(N0)-(0)] /*H imp80-switch.h:2313*/int JUMP[(MAXLEVELS)-(0)+1] ; $define JUMP[N0] JUMP[(N0)-(0)] /*H imp80-switch.h:2313*/int LABEL[(MAXLEVELS)-(0)+1] ; $define LABEL[N0] LABEL[(N0)-(0)] /*H imp80-switch.h:2313*/int JROUND[(MAXLEVELS)-(0)+1] ; $define JROUND[N0] JROUND[(N0)-(0)] /*H imp80-switch.h:2313*/int DIAGINF[(MAXLEVELS)-(0)+1] ; $define DIAGINF[N0] DIAGINF[(N0)-(0)] /*H imp80-switch.h:2313*/int DISPLAY[(MAXLEVELS)-(0)+1] ; //$define DISPLAY[N0] DISPLAY[(N0)-(0)] /*H imp80-switch.h:2313*/int AUXSBASE[(MAXLEVELS)-(0)+1] ; $define AUXSBASE[N0] AUXSBASE[(N0)-(0)] /*H imp80-switch.h:2313*/int NAMES[(MAXLEVELS)-(0)+1] ; $define NAMES[N0] NAMES[(N0)-(0)] /*H imp80-switch.h:2313*/ int AVLWSP[(4)-(0)+1][(MAXLEVELS)-(0)+1] ; $define AVLWSP[N0][N1] AVLWSP[(N0)-(0)][(N1)-(0)] /* 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; FIXEDGLA[4] = LANGFLAG | 1 << 16 | ( CPRMODE & 1) << 8 | PARMS; //LANGRLSE&MAINPROG I = GLACA - GLACABUF; if (INHCODE == 0) { unless (I == 0) LPUT(2, I, GLACABUF, ADDR(GLABUF[0]) ); //BACKOFGLAP LPUT(2, FIXEDGLALEN, 0, ADDR(FIXEDGLA[0]) ); //FRONTOFGLAP LPUT(19, 2, 8, 5); //RELOCATEGLASTADDRESS LPUT(19, 2, 12, 4); //RELOCATECODESTADDRESS 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"); NEWLINE(); PRINTCH(13); //MARKERFORCOMPTOPRINT //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 { asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; } 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 { asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; } 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 { asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; } 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 { asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; } 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 { asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; } } 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 { asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; } 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); GLACURR = GLACURR + GLACA - J; //COMPLETETHEROUNDING 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]; unless (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]; unless (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)-(0)+1] ; $define SCS[N0] SCS[(N0)-(0)] = 0x40800000, 0, 0x41100000, 0, 1, 0; int K; K = DESADS[WHICH + 16]; unless (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; K = CONSTBTM; //AFTERSTRINGSINCTABLE if (L == 4) { if (USEIMP == YES) { while (K < CONSTPTR) { if (CTABLE == C1 && CONSTHOLE != K) { D = 4 * K | 0x80000000; return; } K = K + 1; } } else { asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; AGN1: asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; asm(/*to do*/)/*5*/; } } 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) { USE = GRUSE[I] & 0xFF; //MAINUSEONLY 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 // if (PARMOPT != 0) ERREXIT(5, 0x801, 0); //UNASSIGNEDVARIABLE ERREXIT(6, 0x504, 0); //SWITCHLABELUNSET ERREXIT(7, 0x505, 1); //ILLEGEALEXPONENTIATION if (PARMOPT != 0) ERREXIT(8, 0x201, 0); //EXCESSBLOCKS ERREXIT(9, 0x601, 0); //CAPACITYEXCEEDED ERREXIT(10, 21, 0); //NORESULT if (PARMOPT != 0) ERREXIT(11, 0x501, 0); //CYCLENOTVALID ERREXIT(12, 0x701, 0); //RESFAILS if (PARMOPT != 0) ERREXIT(13, 36, 0); //WRONGNOOFPARAMS // //PUTTHESTRINGSONTOTHEFRONTOFCONSTANTAREA // CTABLE = 0x18000001; CTABLE = 4; STCA = 8; L = ADDR(CTABLE); CONSTPTR = 2; //INCASENOSTRINGS 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)-(0)+1] ; $define SGRUSE[N0] SGRUSE[(N0)-(0)] int SGRINF[(7)-(0)+1] ; $define SGRINF[N0] SGRINF[(N0)-(0)] /*H imp80-switch.h:2313*/ goto SW[A]; SW_23://INCLUDESOMETHING SW_24://REDUNDANTSEP SW_2:// CSSEXIT: LASTINST = CURRINST; while (TWSPHEAD != 0) { POP(TWSPHEAD, JJ, KK, QQ); RETURNWSP(JJ, KK); } return; SW_1://(UI)(S) unless ( 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; LABFND: unless (A == 1 && A == 2) goto SWITCH; //1STOFUIANDNOAPP unless (A == 2 && A == 2) goto SWITCH; //NOENAMSEORASSNMNT JJ = ENTERLAB(FROMAR2(P + 3) , 0); goto CSSEXIT; SW_5://cycle unless ( LEVEL >= 2) FAULT(57, 0); if (A == 2) { //OPENCYCLE CLOOP(0, P + 1, 0); } else { CLOOP(6, P + 6, P + 1); } goto CSSEXIT; // SW_6://REPEAT goto CSSEXIT; SW_22://'%CONTROL'(CONST) J = FROMAR4(P + 2); CODEOUT(); DCOMP = J >> 28; goto CSSEXIT; // SW_3://(iu)(COND)then(UI)(ELSE'') MARKIU = P + 1; MARKC = MARKIU + 3; MARKR = P + 2 + (A << 8) + A; //!FROMAR2(P+2) 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)-(0)+1] ; $define BITS[N0] BITS[(N0)-(0)] FORGET(-1); FNAME = FROMAR2(P + 3); unless (A == 1 && A == 1) { FAULT2(5, 0, FNAME); goto BEND; } //1STOFUI+APP P = P + 3; TESTAPP(NAPS); P = P + 6; unless (INTEXP(JJ) == 0) { FAULT2(41, 0, 0); goto BEND; } //UNLESSEXPRESSIONEVALUATESAND unless (NAPS == 1) { FAULT2(21, NAPS - 1, FNAME); goto BEND; } //NORESTOFAPP unless (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; } FROM123(HEAD, BASEPT, KKK, KK); //EXTRACTTABLEADDR,LB&UB MLINK(HEAD); //KPOINTSTOBITLIST 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]); QQ = Q >> 5; //RIGHTWORD Q = Q & 31; JJJ = 1 << Q; //BITINWORD unless (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 // if (ARR == 2) KKK = 0; //RESETLBIFDESCTOELEMNT0 QQ = BASEPT + (JJ - KKK) * 4; //RELPOSITIONOFLABEL PLUG(2, QQ, CA, 4); //OVERWRITETHEWORDINTABLE //RELOCATION(BYHDOFCODE)INTACT BEND: } /* End of Begin/Rt/Fn/Map depth=3 */; goto CSSEXIT; SW_7://(wu)(SC)(COND)(RESTOFWU) unless ( LEVEL >= 2) FAULT(57, 0); MARKIU = P + 1; //TOWHILE/UNTIL MARKC = MARKIU + 3; //TO(SC)(COND) CLOOP(A + 3, MARKC, MARKIU + 1 + FROMAR2( MARKIU + 1) ); goto CSSEXIT; // SW_8://SIMPLEDECLN unless ( 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 = 2 - A; P = P + 2; //QQ=1FORARRAYFORMATS DECLAREARRAYS(QQ, 0); } else { if (A == 128) { //NOTLINKED&SHUFFLED CQN(P + 1); P = P + 2; DECLARESCALARS(1, 0); } } goto CSSEXIT; // SW_9://end { /* %begin block */ /* TO DO: %SWITCH DECLARATION */ /*Q imp80-switch.h:4253*/ goto S[A]; S_1://ENDOFPROGRAM S_2://ENDOFFILE if ( CPRMODE == 0) CPRMODE = 2; unless ( LEVEL + CPRMODE == 3) FAULT(15, 0); unless (A == CPRMODE) FAULT(56, 0); CEND( CPRMODE); goto BEND; S_3://ENDOFLIST LIST = 0; goto BEND; S_4://END 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) + P; //(SEX)(RT)(SPEC'')(NAME)(FPP) AGN: Q = P; KK = FROMAR2(MARKER1 + 5); //KKONNAME EXTRN = A; LITL = EXTRN & 3; if (A == 1) { //P='%SPEC' P = P + 3; CRSPEC(1 - (EXTRN >> 2)); //0FORROUTINESPEC //1FOREXTERNAL(ETC)SPEC goto BEND; } COPYTAG(KK); if (OLDI == LEVEL) { if ( CPRMODE == 0) CPRMODE = 2; //FLAGASFILEOFROUTINES // 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 = ""; JJ = MIDCELL; //CODEDESCRIPTORRELADDR if (EXTRN != 4) USEBITS = 2; DEFINEEP(XNAME, CA, JJ, 0); if (JJ != 0) PSF1(INCA, 0, -JJ); } else { //EXTERNALSINPRGMORWRNGLEVEL unless (EXTRN == 4) FAULT(55, KK); EXTRN = 4; } if (A == 1) KKK = LITL << 14 | 0x1000; else { ROUT = 1; P = P + 4; //FIGUREOUTPTYPEFORFNS&MAPS CLT(); ARR = 0; NAM = 0; if (A == 2) NAM = 2; //SETNAMEARRAYBITFORMAPS PACK(KKK); //ANDSTOREPTYPEINKKK } } unless (OLDI == LEVEL && J == 15 && PTYPE == KKK) { P = Q + 3; CRSPEC(0); P = Q; goto AGN; } PTYPE = PTYPE | (EXTRN & 3) << 14; //DEALWITHroutinespecFOLLOWED //BYexternalroutine { /* %begin block */ int PTR; int PTYPEP; int CNT; int PP; J = 0; REPLACETAG(KK); //BODYGIVENSOUPDATETAGSINFO JJ = K; PLABEL = PLABEL - 1; unless ( 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) { FROM12(JJ, J, JJJ); //EXTRACTPTYPEXTRAINFO unless (J >> 16 == PTYPE && PTYPE != 5 || JJJ >> 16 == ACC) FAULT2(9, CNT, KK); } else FAULT2(8, 0, KK); //MOREFPSTHANINSPEC PTR = PTR + 3; CNT = CNT + 1; MLINK(JJ); } while (! (A == 2) ); DECLARESCALARS(0, 0); P = PP; }//UNTILNOMOREFP-PART N = (N + 3) & (-4); //TOWORDBOUNDARYAFTERALLSYSTEM //STANDARDPARAMETERSHAVEBEENDECLARED unless (JJ == 0) FAULT2(10, 0, KK); PTYPE = PTYPEP; if ( PTYPE & 0xF0F == 5) N = N + 8; //STRFNSRESULTPARAMISSTACKED //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; // SW_13://REALS(LN) unless ( CPRMODE == 0) FAULT(58, 0); ALLLONG = A & 1; goto CSSEXIT; // SW_14://begin { /* %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; } else SETLINE(); //SO'ENTERED FROM LINE'ISOK RHEAD(-1); RDISPLAY(-1); MAKEDECS(P + 1); } /* End of Begin/Rt/Fn/Map depth=3 */; goto CSSEXIT; // SW_15: //'%ON'(EVENT'')(N)(NLIST)'%START' unless ( LEVEL >= 2) FAULT(57, 0); if (NMDECS[ LEVEL] & 1 != 0) FAULT(40, 0); NMDECS[ LEVEL] = NMDECS[ LEVEL] | 0x11; //NOMOREDECSANDINONCOND if (STACK == 0) { SAVEAUXSTACK(); DISP = AUXSBASE[ LEVEL]; PSF1(LSS, 2, DISP); //SAVETOPOFAUXSTACK PSF1(ST, 1, DISP + 12); } GRUSE[ACCR] = 0; PSF1(CPSR, 1, N + 8); PLABEL = PLABEL - 1; JJJ = PLABEL; ENTERJUMP(15, JJJ, 0b10); //JUMPROUNDONBODY // P = P + 2; JJ = 0; //SETUPABITMASKINJJ /* Deferred: until (A == 2) */ do { //UNTILNOMORENLIST KK = A; unless (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) ); RELOCATE(GLACA - 4, KK, 1); //ENTRYADDRESSINPLT ONWORD[ LEVEL] = JJ << 18 | (GLACA - 4); FORGET(-1); PSF1(ST, 1, N); //STOREEVENT,SUBEVENT&LINE PSF1(MPSR, 1, N + 8); ONINF[ LEVEL] = N; N = N + 12; if (STACK == 0) { PSF1(LSS, 1, DISP + 12); //RESETAUXSTACKTOP PSF1(ST, 2, DISP); } CSTART(0, 3); NMDECS[ LEVEL] = NMDECS[ LEVEL] ^ 0x10; //NOTINONCOND JJ = ENTERLAB(JJJ, 0b111); //REPLACEENVIRONMENT goto CSSEXIT; SW_16: unless ( 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; P = P + 4; //TOP(+'') KKK = INTEXP(LB); //EXTRACTLOWERBOUND P = P + 3; KKK = KKK | INTEXP(KK); //EXTRACTUPPERBOUND RANGE = (KK - LB + 1); if (RANGE <= 0 || KKK != 0) { FAULT2(38, 1 - RANGE, FROMAR2(Q + 1) ); LB = 0; KK = 10; RANGE = 11; } if (GLACA + 8 - 4 * LB < 0) ARRP = 1; //ZEROETHELEMENTOFFFRONT PTYPE = 0x56 + (ARRP << 8); //WORDLABELARRAY 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 D1 = (GLACA + 15) & (-8); //FIRSTTABLEENTRY D0 = 0x28000000 | RANGE; //SCALEDWORDDES if (ARRP == 2) { unless (LB == 0) D0 = D0 | 0x01000000; //SETBCIBIT D1 = D1 - 4 * LB; } PGLA(8, 8, ADDR(D0) ); SNDISP = (GLACA >> 2) - 2; //WORDPLTDISP RELOCATE(GLACA - 4, D1, 2); //RELOCATERELATIVETOGLA 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) { RELOCATE(-1, V, 1); //PLABS(6)RELOCATEDBYHDOFCODE } } while (! (A == 2) );//FORANYMORENAMESINNAMELIST Q = PP; P = Q; } while (! (A == 2) );//UNTILA(Q)=2 } /* End of Begin/Rt/Fn/Map depth=3 */; goto CSSEXIT; // SW_17: LIST = 1; goto CSSEXIT; // SW_12://'%OWN'(TYPE)(OWNDEC) { /* %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; LPUTP = 5; STPTR = USTPTR; //NORMALCASEGLASYMBOLTABLES //FAULT(40,0)ifNMDECS&1#0 EXTRN = A; if ( EXTRN >= 4) EXTRN = 0; //CONST&CONSTANT->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 = A; //MODE=1FORNORMALOWNS if (MODE > 1) goto RECORD; //MODE=2FOROWNRECORDS CLT(); //MODE=3FOROWNRECORDARRAYS 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; PP = P + 3; P = PP + 2; //PPONFIRSTNAME'' while (A == 1) { NNAMES = NNAMES + 1; P = P + 3; } P = P + 1; //PONCONST'' // //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 if ( EXTRN == 3) FAULT2(46, 0, K); //NOEXTRINSICNAMES 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 AH3 = 0; AH2 = PREC << 27 | ACC; //DUMMYSTRINGHEADER } else { if (INHCODE == 0) LPUT(LPUTP, ACC, QQ, AD); //O/PSTRING 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); EPTYPE = 5; EPDISP = QQ; //DATAINGLASYMBOLTABLES } else { //INTEGER&REAL if ( EXTRN == 3) { //EXTRINSICS PTYPE = PTYPE | 1 << 10; //EXTRINSICSVIAPTR 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; } if ( EXTRN != 0) PGLA(ACC, ACC, AD); //PUTCONSTANTINTOGLA TAGDISP = GLACA - ACC; //OFFSETOFVARFORTAGS EPDISP = TAGDISP; //ANDFORENTRYDEFN EPTYPE = 2; //DATAINADRESSABLEGLA } } } 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.* //*********************************************************************** MARKER1 = P + 1 + FROMAR2(P + 1); //TOFORMATNAME 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; } P = P + 1; BP = ACC; //SIZEOFRECORDFROMFORMAT PTYPE = 0x33; J = 0; if (A != 3) { CQN(P - 1); PACK( PTYPE); } P = P + 1; PTSIZE = ACC; //SIZEOFHOLEFORPOINTER /* Deferred: until (A == 2) */ do { P = P + 1; K = FROMAR2(P); NAMTXT = STRING(DICTBASE + WORD[K]); if (NAM != 0) { //OWNNAMESANDARRAYNAMES if ( EXTRN == 3) FAULT2(46, 0, K); //NOEXTRINSICNAMES UICONST = 0xFFFF | PREC << 27; PGLA(8, PTSIZE, ADDR(UICONST) ); EPTYPE = 2; TAGDISP = GLACA - PTSIZE; EPDISP = TAGDISP; } else { if ( EXTRN == 3) { //EXTRINISIC PTYPE = PTYPE | 0x400; //FORCENAM=1(IEVIAPOINTER) AH2 = 0x18000000 + BP; AH3 = 0; PGLA(8, 8, ADDR(AH2) ); TAGDISP = GLACA - 8; GXREF(NAMTXT, 2, 2 << 24 | BP, TAGDISP + 4); //RELOCATEBYEXTERNAL } else { EPDISP = (GLACA + 15) & (-8); AH3 = EPDISP; AH2 = 0x18000000 + BP; //TOPWORDOFDESRCIPTOR PGLA(8, 4, ADDR(AH2) ); //ADDED18MAR76TOFIXBUG RELOCATE(-1, AH3, 2); //PUTDISPINTOGLA TAGDISP = EPDISP; //ANDRELOCATERELAPPROPIATEAREA EPTYPE = 2; //DATAINGLATABLES I = 0; ICONST = 0; while (I < BP) { PGLA(4, 4, ADDR(ICONST) ); I = I + 4; } } } ACC = BP; //ACCTOSIZEOFRECORD STAG(TAGDISP, BP); P = P + 2; } while (! (A == 2) ); goto BEND; NONSCALAR: //OWNANDOWNRECORDARRAYS //*********************************************************************** //*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); SNDISP = AH4 - 12; //DVDISP(+TOPBITFLAG) if (SNDISP == -1) SNDISP = 0; //BUMDOPEVECTOR SNDISP = (SNDISP & 0x3FFFF) >> 2; //ASWORDDISPLACEMENT DIMEN = J; //SAVENOOFDIMENESIONS ACC = SACC; PTYPE = TYPEP; UNPACK(); if (LB == 0 && J == 1 && TYPE <= 3) { ARR = 2; PACK( PTYPE); } LENGTH = QQ / BP; //NOOFELEMENTS SPOINT = STPTR; if (MODE != 3 && FORMAT == 0) { //NOTARECORDARRAY if (A == 1) { P = P + 1; INITSPACE(QQ, LENGTH); } } if (CONSTSFOUND == 0) { //NOCONSTANTSGIVEN //SOCLEARANAREATOZERO CONSTSFOUND = LENGTH; unless (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. // J = DIMEN; //RESETDIMENSIONSAFTERINITTING if (TYPE <= 2) AH1 = PREC << 27 | LENGTH; else AH1 = 3 << 27 | 1 << 25 | QQ; AH1 = AH1 | (1 - PARMARR) << 24; //SETBCIIFBASETOBESHIFTED if (PREC == 4) AH1 = 0x58000002; AH2 = EPDISP; AH3 = 5 << 27 | 3 * J; //DVDESPTR=WORDCHKD 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 GXREF(NAMTXT, 2, 2 << 24 | QQ, TAGDISP + 4); //RELOCATEADDR(A(FIRST)) } else { RELOCATE(TAGDISP + 4, AH2, LPUTP); //RELOCATEADDR(A(FIRST)) } RELOCATE(TAGDISP + 12, AH4, 1); //RELOCATEDVPOINTER AH4 = (AH4 << 1 >> 3) | 0x80000000; NOTECREF(AH4 | (TAGDISP + 12) >> 2 << 16, (AH4 & 0xFFFF) << 2); EPTYPE = 5; //DATAINGLASYMBOLTABLES 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; } } } while (! (A == 2) );//UNTILP=null 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; STYPE = PTYPE; SACC = ACC; //MAYBECHANGEDIFCONSTISEXPR 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); if (CONSTP == 0) { FAULT(41, 0); CONSTP = ADDR(ZERO); }//CANTEVALUATEEXPT 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); FNAM = FROMAR2(MARKER); //FORMATNAME 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 unless ( 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 = 2 - A; P = P + 4; //Q=1FORARRAYFORMAT SETLINE(); DECLAREARRAYS( Q, FINF); } } BEND: } /* End of Begin/Rt/Fn/Map depth=3 */; goto CSSEXIT; // SW_19: //'*'(UCI)(S) unless ( 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); unless (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; SW_3://PUT(HEXHALFWORD) TYPE = A; PREC = TYPE >> 4; TYPE = TYPE & 7; unless (TYPE == 1 && PREC < 6) FAULT(32, 0); if (PREC == 5) P = P + 2; PLANT(FROMAR2(P + 1) ); goto EXIT; SW_5://CNOP CNOP(A, A); goto EXIT; SW_4://ASSEMBLER FORM = A; //FORM=PRIMARY,SECONDARYOR3RY OPCODE = A; P = P + 2; goto F[FORM]; F_1://ALLPRIMARYFORMATINSTRUCTIONS ALT = A; P = P + 1; goto POP[ALT]; POP_1://LABELNAME FNAME = FROMAR2(P); P = P + 2; ENTERJUMP(OPCODE << 24 | 3 << 23, FNAME, 0); goto EXIT; POP_2://DIRECTSYMBOLIC CIND(); POPI: PSORLF1(OPCODE, ACCESS, AREA, DISP); goto EXIT; POP_3://INDIRECTSYMBOLIC CIND(); ACCESS = 4 - A; P = P + 1; goto POPI; POP_4://DRSYMBOLICALLYMODIFIED CIND(); ACCESS = 1; goto POPI; POP_5://(DR)&(DR+B) ACCESS = 4 - A; AREA = 7; DISP = 0; P = P + 1; goto POPI; POP_6://B ACCESS = 0; AREA = 7; DISP = 0; goto POPI; F_2://SECONDARY(STORE-TOSTORE)FORMAT MASK = 0; FILLER = 0; Q = 0; FNAME = 0; H = 2 - A; if (H == 0) { FNAME = FROMAR2(P + 1) - 1; P = P + 2; } unless (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; unless (0 <= MASK | FILLER && MASK | FILLER <= 255) FAULT(32, 0); } PF2(OPCODE, H, Q, FNAME, MASK, FILLER); goto EXIT; F_3://TERTIARYFORMAT MASK = FROMAR2(P); ALT = A; unless (0 <= MASK && MASK <= 15) FAULT(32, 0); P = P + 3; goto TOP[ALT]; TOP_1://LABEL FNAME = FROMAR2(P); P = P + 2; ENTERJUMP(OPCODE << 24 | MASK << 21, FNAME, 0); goto EXIT; TOP_2://SYMBOLICOPERAND 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; TOP_3://(DR)&(DR+B) DISP = 0; AREA = 8 - A; P = P + 1; goto TOPI; TOP_4://(DR+N) 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]; SW_1://(=')(PLUS')(ICONST) P = P + 1; //PAST(='') 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: unless (CTYPE == 1 && CPREC <= 5 && X'FFFE0000' <= FN0 && FN0 <= 0x1FFFF) goto LIT; AREA = 0; DISP = FN0; return; LIT: unless (1 <= CTYPE && CTYPE <= 2 && 5 <= CPREC && CPREC <= 7) FAULT(32, 0); STORECONST(DISP, BYTES[CPREC], AFN); AREA = PC; ACCESS = 0; return; SW_2://(NAME)(OPTINC) 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; SW_3://'('(REG)(OPTINC)')' 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; unless (ALT == 3) P = P + 2; return; SW_4://'%TOS' 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; SW_21://'%MAINEP'(NAME) KK = FROMAR2(P + 1); unless ( 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; MRL = 0; INC = 0; //INCCOUNTSDOWNRECORD NEXT: ROUT = 0; LITL = 0; NAM = 0; RFD = A; if (RFD <= 2) { P = P + 1; CLT(); } goto RFEL[RFD]; RFEL_1://(TYPE)(QNAME'')(NAMELIST) 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) ); P = P + (RFD >> 2 << 1); //EXTRA2FORRECORDSTOSKIPFORMAT TRYEND: if (A == 2) goto END; P = P + 1; goto NEXT; RFEL_2:RFEL2: //(TYPE)array(NAMELIST)(BPAIR) 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; until (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; if (PREC == 4) A0 = 0; //STRINGDESCRIPTORS! 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; RELOCATE(D1 + 12, DV, 1); //RELOCATEDVPOINTER 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; RFEL_3://record(array)name 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; RFEL_4://RECORDSINRECORDS RFEL_5://RECORDARRAYSINRECORDS Q = P + FROMAR2(P + 1) + 1; FN = FROMAR2(Q); COPYTAG(FN); //COPYFORMATTAG&SETACC unless ( 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; END: //FINISHOFF RL = MRL; ROUND(); ACC = INC; //SIZEROUNDEDAPPROPRIATELY unless (INC <= 0x7FFF) FAULT(98, 0); CLEARLIST(NLIST); return; void SN(int Q) { //*********************************************************************** //*CHECKTHESUBNAMEHASNOTBEENUSEDBEFOREINTHISFORMAT* //*ANDENTERITWITHITSDESCRIPTORSINTOTHELIST.* //*********************************************************************** FNAME = FROMAR2(Q); unless (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*/recfm *FCELL; /*pending name*/recfm *PCELL; /*pending name*/recfm *LCELL; //(LISTF) int RR; int II; int ENAME; int CELL; ENAME = (A << 8) + A; CELL = 0; if (LINK != 0) { //CHKRECORDSPECNOTOMITTED FCELL = ASLIST[LINK]; //ONTOFORMATTAGCELL LINK = FCELL & 0x7FFF; //LINKTOSIDECHAIN 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(); if (A == 2 || FNAME <= 0) return 0; //NO(FURTHER)ENAME SUBS = SUBS + 1; P = P + 1; Q = DISPLACEMENT(FNAME); UNPACK(); } while (! (TYPE != 3) ); return Q + 1; //GIVES0IFSUBNAMENOTKNOWN } /* 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; FNAME = KFORM; //POINTERTOFORMAT 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; BASE = BS; DISP = DP; //FORPOINTER if (Z < 14) { //NOTARECORDOPERATION unless (3 <= Z && Z <= 4 || Z == 6) { //ADDR(RECORD) FAULT(64, 0); BASE = RBASE; AREA = -1; DISP = 0; ACCESS = 0; PTYPE = 1; UNPACK(); } } return; } P = P + 1; //FINDOUTABOUTSUBNAME Q = DISPLACEMENT(FNAME); //TCELLPOINTSTOCELLHOLDING UNPACK(); //INFOABOUTTHESUBNAME 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 = (A << 8 | A) << 16 | NAMEP; //NAMEP=-1UNALTERED! if (ARR == 1) goto AE; //ARRAYSINCLUDINGRECORDARRAYS 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 { LOCALISE(8); //PICKUPRECNAMEDESCR&STCK AR = AREA; DP = DISP; BS = BASE; } } CENAME(MODE, KFORM, BS, AR, DP, XD); return; AE: //ARRAYSANDARRAYNAMESASELEMEN 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; LOCALISE(16); //MOVEHEADUNDERLNB CANAME(3, BASE, DISP); //ARRAYMODESETSDISP,AREA&BASE } else { //ARRAYRELATIVEHEADINGLA if (MODE == 0 || MODE == 2) { if (MODE == 0) W = DP - 4; else W = DP + 4; } else { FETCHRAD(); //RECORDADDRTOACC GETWSP(W, 1); PSF1(ST, 1, W); XD = 0; BS = RBASE; } CANAME(3, 0, Q); //RECORDRELARRAYACCESS //CANRETURNACCESS=1OR3ONLY if (PARMARR == 0 && 0 == PARMCHK && ACCESS == 3 && PREC == 3 || TYPE >= 3) { PSORLF1(ADB, 0, AREACODE2(BS) , W); unless (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]; } unless (XD == 0) PSF1(INCA, 0, XD); FORGET(DR); AREA = 7; DISP = 0; //ANDACCESS=2OR3ONLY 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; REXP = 2 - A; //=0ifONEOPERANDEXP unless (A == 4 && REXP == 0 && MODE == 0) goto NORMAL; if (A == 2) goto SIMPLE; unless (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); unless (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; NORMAL: CLEN = 0; P = P + 3; //LENGTHOFCONSTANTPART ERR = 72; unless (A == 4) goto ERROR; P = P + 1; GETWSP(WKAREA, 268); //GETNEXTOPERAND DOTS = 0; //NOOPERATORSYET NEXT: STRINGL = 0; ERR = STROP(DR); //GETNEXTOPERAND unless (ERR == 0) goto ERROR; if (REGISTER[ACCR] != 0) BOOTOUT(ACCR); PSF1(LB, 0, WKAREA); //BYTEDISPFROMLNB PPJ(0, 19 + DOTS); //TOSUBROUTINE19OR20 if (A == 2) goto TIDY; //NOMOREOPERATIONS ERR = 72; unless (A == CONCOP) goto ERROR; //CONCATENATE DOTS = DOTS | 1; P = P + 2; goto NEXT; TIDY: //FINISHOFF VALUE = WKAREA; P = P + 1; //PASTRESTOFEXPRN if (KEEPWA == 0) RETURNWSP(WKAREA, 268); STRINGL = 0; return; int STROP(int REG) { //*********************************************************************** //*DEALSWITHOPERANDFORCONCATENATION.RETURNRESULT=0FOR* //*VALIDOPERANDOTHERWISEANERRORNUMBER.* //*********************************************************************** int CTYPE; int VAL; int MODE; MODE = A; //ALTERNATIVEOFOPERAND if (MODE > 2) return 75; if (MODE != 1) { CTYPE = A; //GETCONSTTYPE&LOSEAMCKFLAGS 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) { if (STRINGL <= 63) PSF1(LDB, 0, STRINGL); else PF1(LDB, 2, 7, 0); //((DR)) } GRUSE[DR] = 0; if (REG == ACCR) COPYDR(); } else { P = P + 1; //MUSTCHECKFIRST REDUCETAG(); //SINCECNAMEONLYLOADSSTRINGS //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) LAST = 0; FNAM = 0; //=1WHENENDOFEXPRNSNFOUND SEXPRN = 0; //RESOLUTION(BRKTD)EXPRESSNS ERR = 74; //NORMALCRESFAULT PSF1(INCA, 0, 1); //TOFIRSTCHAR P1 = P; P = P + 3; if (A == 4) goto RES; //LHSMUSTBEASTRING //BUTTHISCHECKEDBEFORECALL ERR = 72; ERROR: FAULT2(ERR, 0, FNAM); P = P1; SKIPEXP(); return; RES: P = P + 1; //TOP(OPERAND) 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 unless (A == 1) goto ERROR; //P(OPERAND)=NAME 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; } PF1(ST, 0, TOS, 0); //B(ORDUMMY)TOP2 unless (A == 3) goto ERROR; //P(OPERAND)='('(EXPR)')' SEXPRN = SEXPRN + 1; P = P + 1; CSTREXP(0, DR); //TOREGISTERDR // 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; } unless (A == 1) goto ERROR; P2 = P + 1; P = P2 + 1; do { P = P + 3; SKIPAPP(); }until (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); if (ROUT != 0 || NAM != 0) PPJ(0, 18); //ASSNMNTCHECK(Q.V) 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) { PF1(LSS, 1, 0, 2); //PICKUPSTACKTOP 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; WK = AT >> 18; //BYTESCLAIMEDBYENTRYSEQ AT = AT & 0x3FFFF; //ADRROFASFINSTRN 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); unless (KKK == 2) SETLINE(); FORGET(-1); BIT = 1 << LEVEL; // //NOWPLANTANERROREXITFORFNSANDMAPS-CONTROLSHOULDBERETURNED //VIAresult=ANSHOULDNEVVERREACHTHEendINSTRUCTION // if (KKK & 0x3FFF > 0x1000 && COMPILER == 0 && LASTINST == 0) PPJ(15, 10); //RUNFAULT11 if (N > NMAX) NMAX = N; //WORKSPACEPOINTER // //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) { CLEARLIST(AVLWSP[JJ][ LEVEL]); //RELEASETEMPORARYLOCATIONS } // DTABLE( LEVEL); //OUTPUTDIAGNOSTICTABLES // //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(); if (KKK == 1 && LASTINST == 0) PPJ(15, 21); //stopATendofprogram 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! // unless ( 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; if (KKK == 2) CEND(KKK); //ROUNDAGAINFOR'ENDOFPROGRAM' // //COMPLETETHEJUMPAROUNDALLNON-EXTERNALROUTINESEXCEPTWHEN //trustedprogramISINOPERATION. // if (ASLWARN != 0) { ASLWARN = 0; EPILOGUE(); } if (KKK >= 0x1000 && COMPILER == 0 && RLEVEL > 0 || CPRMODE != 2) { JJ = NEXTP + 6; unless (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)-(0)+1] ; $define DD[N0] DD[(N0)-(0)] //BUFFERFORSEGMENTOFSST // //FILLALLOUTSTANDINGREFERENCESTOTHISDIAGSBLOCK // BIT = 1 << LEVEL; LANGD = KKK >> 14 << 30 | LEVEL << 18; //GETLITLFROMPTYPE 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; ML = M[LEVEL]; //ROUTINENAME(=0FORbegin) LNUM = BYTEINTEGER(DICTBASE + ML); //LENGTHOFTHENAME DPTR = 4; DEND = 0; if (LNUM == 0) DD[3] = 0; else { Q = DICTBASE + ML; RTNAME = STRING(Q); //FORRTSMOVEIN1ST32CHARS LNUM = BYTEINTEGER(ADDR(RTNAME) ); STRING(ADDR(DD[3]) ) = RTNAME; //ANDUPDATEPOINTERPAST DPTR = DPTR + (LNUM >> 2); //ACTUALNOOFCHARS } DD[DPTR] = ONWORD[LEVEL]; //ONCONDITIONWORD 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) { Q = DICTBASE + WORD[JJ]; //ADDRESSOFNAME if (I == 0) II = 1; else II = 0; //GLAORLNBBIT DD[DPTR] = PTYPE << 20 | II << 18 | K; LOCALNAME = STRING(Q); //TEXTOFNAMEFROMDICTIONARY 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; } DD[DPTR] = -1; //'END OF SEGMENT'MARK 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; unless (A == 8) ABORT(); //LINEISADECLARATION 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) { GETWSP(QQ, 2); //ADIUBLEWORD 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); if ( PTYPE == 0x31 && PERMIT == 0) N = N + 3; //BYTEPARAMS if ( PTYPE == 0x41 && PERMIT == 0) N = N + 2; SCHAIN = N; KFORM = XTRA; if (ROUT == 1) { TYPEP = PTYPE; //CHANGEDBYCFPLIST! Q = P; do P = P + 3; until (A == 2) //TOFPP CFPLIST(SCHAIN, NPARMS); P = Q; J = 13; KFORM = NPARMS; //NOOFPARAMSOFFORMAL ACC = N; //DISPLACEMENTTOMIDCELL 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) ); if (PERMIT != 0) N = (N + 3) & (-4); //NOROUNDINGAMONGPARAMS } /* 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)-(0)+1] ; $define LBH[N0] LBH[(N0)-(0)] int LBB[(12)-(0)+1] ; $define LBB[N0] LBB[(N0)-(0)] /*H imp80-switch.h:2313*/int UBH[(12)-(0)+1] ; $define UBH[N0] UBH[(N0)-(0)] /*H imp80-switch.h:2313*/int UBB[(12)-(0)+1] ; $define UBB[N0] UBB[(N0)-(0)] /*H imp80-switch.h:2313*/ int DV[(39)-(0)+1] ; $define DV[N0] DV[(N0)-(0)] //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; unless (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); unless (EXPOPND <= 1 && EXPOPND == 0x51) { EXPOPND = 0; FAULT(41, 0); } DV[K] = EXPOPND; DV[K + 1] = M0; EXPOP(UBH[PTR], ACCR, NOPS, 0x251); unless (EXPOPND <= 1 && EXPOPND == 0x51) { EXPOPND = 10; FAULT(41, 0); } JJ = EXPOPND; M0 = M0 * (JJ - DV[K] + 1); unless (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; DV[0] = 5 << 27 | 3 * ND; //DESPTRFORDV K = 3 * ND + 2; J = ND; //DIMENSIONALITYFORDECLN HEAD = DVHEADS[ND]; while (HEAD != 0) { LCELL = ASLIST[HEAD]; if (LCELL == ASIZE && LCELL == DV[5]) { for (D = 0; D != K; D += 1) { unless (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; NONCONST: //NOTACONSTDV 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; } DESC = SC << 27 | UNSCAL << 25 | (1 - PARMARR) << 24; //ARRAYDESCRIPTORSKELETON if (PREC == 4) DESC = 0x58000002; START: NN = 1; P = P + 1; //NOOFNAMESINNAMELIST 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; unless (DVDISP == -1) goto CONSTDV; //NORMALCASE-PLANTCODETOSETUPDOPE-VECTORATRUNTIME DVF = 0; TOTSIZE = 0xFFFF; DVDISP = N; //DVDISPISD-VPOSITION N = N + 12 * ND + 12; //CLAIMSPACEFORTHED-V if (ND > 12) FAULT(37, 0); //TOOMANYDIMENSIONS D0 = 5 << 27 | 3 * ND; D1 = 12; //DESCPTRFORDV 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; PSF1(LSS, 0, JJ); //M1THEFIRSTMULTIPLIER GRUSE[ACCR] = 0; for (II = ND; II != 1; II += -1) { P = P + 1; QQ = DVDISP + 12 * II; //TRIPLEFORIITHDIMENSION PSF1(ST, 1, QQ + 4); //STOREMULTIPLIER CSEXP(ACCR, 0x51); //LOWERBOUND if (ND == 1 && PTYPEP & 7 <= 3 && FORMAT == 0 && GRUSE[ACCR] == 5 && GRINF1[ACCR] == 0) PTYPEPP = PTYPEPP + 256; PSF1(ST, 1, QQ); //STOREDINDV CSEXP(ACCR, 0x51); //UPPERBOUND PSF1(ISB, 1, QQ); GRUSE[ACCR] = 0; if ( COMPILER == 0 || PARMARR != 0) { PF3(JAF, 6, 0, 3); //JUMPUNLESSNEGATIVE PSF1(LSS, 0, -1); //SETUP-1(ENSURES0ELEMENTS } PSF1(IAD, 0, 1); //CONVERTEDTORANGE PSF1(IMY, 1, QQ + 4); //RANGE*MULTIPLIER PSF1(ST, 1, QQ + 8); //ANDSTOREDINDV } P = P + 1; if (UNSCAL == 0 && ELSIZE != 1) PSF1(IMY, 0, ELSIZE); PSF1(ST, 1, DVDISP + 8); SNDISP = 0; //DVNOTAVAILABLEATCOMPILETIME goto DECL; CONSTDV: //ONEDIMENSION-CONSTANTBOUNDS DVF = 1; CDV = 1; if (ND == 1 && LWB == 0 && PTYPEP & 15 <= 3 && FORMAT == 0) PTYPEPP = PTYPEP + 256; //SETARR=2IFLWB=ZERO SNDISP = (DVDISP & 0xFFFFFF) >> 2; DECL: //MAKEDECLN-BOTHWAYS J = ND; ODDALIGN(); PTYPE = PTYPEPP; UNPACK(); if (DVF != 0) { //ARRAYISSTRINGOFLOCALS R = TOTSIZE; if (UNSCAL == 0) R = R / ELSIZE; D0 = DESC; unless (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); unless (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 PSF1(STB, 1, N + 16 * JJJ); //ARRAYBOUND PSF1(STD, 1, N + 8 + 16 * JJJ); //DVPOINTER } 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 PF1(STSF, 0, BREG, 0); //CURRENTSFTOB 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 unless (GRUSE[ACCR] == 11) { PSF1(LSS, 2, AUXSBASE[ LEVEL]); GRUSE[ACCR] = 11; GRINF1[ACCR] = 0; } JJJJ = LWB * ELSIZE - GRINF1[ACCR]; unless (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); unless (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 { unless (GRUSE[ACCR] == 11 && GRINF1[ACCR] == 0) PSF1(LSS, 2, AUXSBASE[ LEVEL]); PSF1(ST, 1, N + 4); GRUSE[ACCR] = 11; GRINF1[ACCR] = 0; } } ACC = ELSIZE; //RESETACCAFTERDVCMPLD KFORM = FINF; //FORMATINFORMATION K = FROMAR2(PP + 3 * JJJ); STORETAG(K, N); if (FORMAT == 0) CLAIMAS(); N = N + 16; } P = P + 1; //PASTRESTOFARRAYLIST 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; PSF1(ASF + 12 * PARMCHK, 0, T); //ASFORLB if (PARMCHK != 0) PPJ(0, 4); } else { //DYNAMICBOUNDS if (PARMCHK == 0 && PTYPEP & 7 <= 2 && ELSIZE == 4 || ELSIZE == 8) { PSF1(ASF, 1, DVDISP + 20); //SIZEINELEMENTSWORD if (ELSIZE == 8) PSF1(ASF, 1, DVDISP + 20); } else { PSF1(LSS, 1, DVDISP + 8); //ARRAYSIZEBYTES if (ELSIZE & 3 != 0) PSF1(IAD, 0, 3); PSF1(USH, 0, -2); //ARRAYSIZEWORDS PF1(ST, 0, BREG, 0); FORGET(BREG); if (PARMCHK != 0) PPJ(0, 4); else PF1(ASF, 0, BREG, 0); } } CHECKSTOF(); } else { unless (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; unless (B == D && D == 0) PSORLF1(IAD, 0, B, D); } } else { B = LNB; D = DVDISP + 8; PSF1(IAD, 1, D); unless (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] ; $define TYPEFLAG[N0] TYPEFLAG[(N0)-(1)] = X'51', 0x52, 0, 0x31, 0x35, 0x41, 0, 0x62, 0x61, 0x72; int ALT; ALT = A; TYPE = TYPEFLAG[ALT]; if (TYPE == 0) { P = P + 1; TYPE = TYPEFLAG[A + 7]; } PREC = TYPE >> 4; TYPE = TYPE & 7; if (TYPE == 2 && ALLLONG != 0 && PREC <= 5) PREC = 6; //DEALWITH'%REALSLONG' 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; if (I == 1) { ARR = 1; ACC = 16; }//ARRAYNAMES if (I <= 2) NAM = 1; //ARRAYNAMES&NAMES if (I == 2) ACC = 8; //NAMESUSE8-BYTEDESCRIPTOR } /* 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; P = P + 2; //IGNORINGALTOFP(SPEC'') } else { //P= ROUT = 1; ARR = 0; P = P + 1; CLT(); NAM = 0; if (A == 2) NAM = 2; //2FORMAP0FORFN PACK(TYPEP); P = P + 2; //AGAINIGNORINGALTOFP(SPEC'') } P = P + 4; //PASTHOLEFORDECLINKS 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; CXREF(XNAME, PARMDYNAMIC | (EXTRN / 3), 2, JJ); //ststem&external=STATIC //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; NPARMS = 0; //ZEROPARAMETERSASYET while (A == 1) { //WHILESOME(MORE)FPS PP = P + 1 + FROMAR2(P + 1); //TONEXTFPDEL P = P + 3; //TOALTOFFPDEL CFPDEL(); //GETTYPE&ACCFORNEXTGROUP /* 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]; FP_1://(TYPE)(qname'') ROUT = 0; CLT(); CQN(P); if (TYPE == 5 && ACC == 0) FAULT(70, 0); P = P + 1; goto PK; FP_2://RECORD(array'')name ARR = 2 - A; ROUT = 0; ACC = 8 + 8 * ARR; TYPE = 3; PREC = 3; NAM = 1; P = P + 1; goto PK; FP_3://(RT)(name'')(NAMELIST)(FPP) ROUT = 1; NAM = 1; ARR = 0; if (A == 1) { //RT=rouitne TYPE = 0; PREC = 0; P = P + 2; } else { P = P + 1; CLT(); //RT=(TYPE)(FM) NAM = 1; if (A == 2) NAM = 3; //1FORFN3FORMAP P = P + 2; //PAST(name'')WHICHISIGNORED } ACC = 16; goto PK; FP_4://name 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 COPYTAG(KK); JJ = K; //LISTOFJUMPS 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); } REPLACE2(TAGS[KK], CA); //NOTEADDRFORFUTURECALLS } 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; FLAG[ LEVEL] = PTYPE; //CURRENTBLOCKTYPEMARKER } /* 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; PF1(LD, 0, XNB, 12); //COPYPLTDESCRIPTOR 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; } } } if (STACK != 0) PF1(ST, 0, TOS, 0); //STTOS PF1(STLN, 0, TOS, 0); N = N + 4; } // //IFINDIAGNOSTICMODEPLANTCODETOSAVETHELINE&ROUTINENOOF //THECALLINGROUTINEANDSETUPTHENEWBLOCK/ROUTINEIDENTNO. // if (PARMTRACE != 0) { if (PARMOPT != 0) PF1(LSS, 0, PC, 4 * CONSTBTM | 0x80000000); //M'IDIA' 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); PSF1(LD, 1, 12); //UPDATEBNDFIELD DIAGPOINTER( LEVEL); PSF1(STD, 1, 12); } DIAGINF[ LEVEL] = N; N = N + 4; GRUSE[ACCR] = 0; //NEEDEDFORbeginBLOCKS } 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; PF1(ASF + 12 * PARMCHK, 0, 0, 0); //ASFORLB if (PARMCHK != 0) PPJ(0, 4); } // if (KK >= 0 && PARMCHK != 0) { CHECKSTOF(); //CHECKFORSTACKO''FLOW } if (PARMDBUG != 0) SETLINE(); //TOCALLDBUGPACKAGE } /* 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); XYNB = SETXORYNB(-1, -1); //TOPLT 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]; SW_1://(NAME)(APP)(ASSMNT?) 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; SW_2://->(NAME)(APP) 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; GWRDD = SNDISP << 2; //BYTEDISPOFDESCRIPTORINPLT unless (OLDI == LEVEL && TYPE == 6) { FAULT(4, LNAME); P = P - 1; SKIPAPP(); return; } LWB = FROM2(K); //GETLOWERBOUND CSEXP(BREG, 0x51); if (ARRP == 1) PSF1(SBB, 0, LWB); XYNB = SETXORYNB(-1, -1); //TOPLT PF1(JUNC, 3, XYNB, GWRDD); //JUMPINDIRECTVIAWORDARRAY //OF32BITRELOCATEDADDRESSES REPORTUI = 1; FORGET(-1); } return; SW_3://RETURN unless (FLAG[ LEVEL] & 0x3FFF == 0x1000) FAULT(30, 0); P = P + 1; RET: RTEXIT(); REPORTUI = 1; if (CODE == 0) CURRINST = 1; return; SW_4://result(ASSOP)(EXPR) 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); unless (A == 2) FAULT(81, 0); P = P + 1; unless (TYPEP == TYPE && PRECP == PREC) FAULT(83, 0); goto RET; } if (A == 2) { //ASSOP='=' P = P + 2; if (NAM != 0) TYPE = 1; //MAPSHAVEINTEGERRESULTS if (TYPE == 5) { CSTREXP(0, ACCR); PSF1(LD, 1, DISPLAY[RBASE] - 8); //RESULTDESCRPT 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); P = P + 2; SKIPEXP(); //IGNORESPURIOUSRESULT return; SW_5://monitor(AUI) PSF1(LSD, 0, 0); //ERR=0&EXTRA=0 PPJ(0, 2); //TOERRORROUTINE P = P + 1; goto AUI; SW_6://stop PPJ(0, 21); P = P + 1; if (CODE == 0) CURRINST = 1; REPORTUI = 1; return; SW_7://'%SIGNAL'(EVENT'')(N)(OPEXPR) PSF1(PRCL, 0, 4); PSF1(JLK, 0, 1); //STACKDUMMYPC if (NMDECS[ LEVEL] & 16 != 0) { //INAN'ON'GROUP if (FLAG[ LEVEL] <= 2) { //INABEGINBLOCK PSF1(LD, 1, 12); //SORESETDIAGPOINTER DIAGPOINTER( LEVEL - 1); //TONEXTOUTERBLOCK PSF1(STD, 1, 12); PF1(STLN, 0, TOS, 0); } else { //''ONINART/FN/MAP PSF1(LSS, 1, 0); //GETPREVIOUSLNB PF1(ST, 0, TOS, 0); //ANDSTACKTHAT } } else PF1(STLN, 0, TOS, 0); GRUSE[ACCR] = 0; J = A; //EVENTNO unless (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); XYNB = SETXORYNB(-1, -1); //TOPLT PSF1(RALN, 0, 9); PF1(CALL, 2, XYNB, 40); if (CODE == 0) CURRINST = 1; REPORTUI = 1; return; SW_8://exit SW_9://continue ALT = ALT & 7; //0FOREXIT1FORCONTINUE 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*/ unless (SKIP == YES) SETLINE(); MARKIU = A; //ALTOFIU1=if,2=unless PLABEL = PLABEL - 1; THENLAB = PLABEL; START = 0; //NOSTARTINCONDITIONYET ELSELAB = 0; //MEANSNOELSECLAUSE P = MARKC; if (MARKR > 0 && A <= 2) START = 1; //'%START'OR'%THENSTART' if (MARKE != 0 && LEVEL < 2 && START == 0) FAULT(57, 0); USERLAB = -1; if (START != 0) ALTUI = 0; else ALTUI = A; if (ALTUI == 2 && A == 2) USERLAB = FROMAR2(MARKUI + 1); //UI=SIMPLELABEL 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; CSTART(2, 1); //NOCODE MARKE = P; } CCRES = 1; //NOCODEFORELSE goto ELSE; } // if (USERLAB >= 0) { //FIRSTUIIS'->'