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