#include <perms.h>
// Edinburgh IMP77 Compiler - Version 8.4
//
// 1 ! Currently throwing a syntax error if more than one %OWN variable declared in one statement
// 2 %CONTROL X'10000000' ; ! Decode
// _imp_control(0); /* %control is a compiler directive and does not generate code. */
// 3
// 4 ! There are two places where errors are generated when compiling the clean source of this
// 5 ! compiler. Since it should probably be expected to be able to compile itself, these errors
// 6 ! are almost certainly bogus and a result of some difference in the sparc compiler used to
// 7 ! compile this. I have commented out those two error reports (look for '{' and 'erroneous')
// 8 ! and when that is done the source does compile and the output looks plausible.
// 9
// 10 ! I've supplied a recode and an lput which were missing from the allimpc1 source, and modified
// 11 ! lput to output all the generated code and data, not just the code that recode outputs.
// 12 ! Successive runs with no source changes produce *slightly* different output in the 'D' psect.
// 13 ! This is either due to something time-related, or more likely, an unassigned variable.
// 14 ! (It's not time-related as this code doesn't access CPU TIME, TIME, or DATE functions)
// 15
// 16 ! Using the sparc compiler solves the problems that arose using other Imp77 compilers
// 17 ! on little-endian machines like the Vax and X86. Also the x86 compilers do not
// 18 ! support both 32 bit integers and 16 bit integers.
// 19
// 20 ! The Imp to C translator *ought* to be able to compile and run this if the
// 21 ! mips C compiler is used as it too is big-endian. Mips code runs under emulation
// 22 ! on the X86 linux transparently.
// 23
// 24 ! Note the compile-time warnings, Warning: value truncated to 16 bits signed at line 215
// 25 ! - this is because %SHORTINTEGER is a signed 16 bit quantity but some of the data
// 26 ! in the tables is initialised with *unsigned* 16 bit data in excess of 32767. These
// 27 ! constants could be replaced in the source with the negative literal values that
// 28 ! would allow the source to compile without warnings. This has not yet been done.
// 29
// 30 %BEGIN
int main(int argc, char **argv) { /*%begin*/
_imp_initialise(argc, argv);
// 31
// 32 %constinteger debug=0
// 33 %owninteger com2 = 20000 ;! free memory size?
static int COM2 = 20000;
// 34 %owninteger com24 = 0 ;! exit code I think
static int COM24 = 0;
// 35
// 36 %integerfn com(%integer idx)
int COM(int IDX) {
// 37 %if idx=24 %then %result = com24
if (IDX != 24) goto L_0001;
return COM24;
L_0001:;
// 38 %if idx=2 %then %result = com2
if (IDX != 2) goto L_0002;
return COM2;
L_0002:;
// 39 %stop
_imp_stop(0);
// 40 %end
} /* end of COM */
// 41
// 42 %routine setcom(%integer idx, val)
void SETCOM(int IDX, int VAL) {
// 43 %if idx=24 %then com24=val %and %return
if (IDX != 24) goto L_0003;
COM24 = VAL;
return;
L_0003:;
// 44 %if idx=2 %then com2 =val %and %return
if (IDX != 2) goto L_0004;
COM2 = VAL;
return;
L_0004:;
// 45 %stop
_imp_stop(0);
// 46 %end
} /* end of SETCOM */
// 47
// 48 %routine set short integer(%integer address, %short value)
void SETSHORTINTEGER(int ADDRESS, short int VALUE) {
// 49 short integer(address) = value
*_imp_SHORTINTEGER(ADDRESS) = VALUE;
// 50 %end
return;
} /* end of SETSHORTINTEGER */
// 51
// 52
// 53 %INTEGER I,J,K,SS
int I;
int J;
int K;
int SS;
// 54 %OWNBYTEINTEGERARRAY CLETT(1: 425)= 1,
static unsigned char CLETT[425] = {
1, 43, 1, 45, 1, 92, 1, 40, 1, 41, 1, 33, 1, 44, 2, 42, 42, 2, 33, 33, 1, 42, 2,
47, 47, 1, 47, 1, 38, 2, 62, 62, 2, 60, 60, 1, 46, 1, 63, 2, 201, 198, 6, 213, 206, 204,
197, 211, 211, 7, 201, 206, 212, 197, 199, 197, 210, 4, 210, 197, 193, 204, 4, 194, 217, 212, 197, 5, 211,
200, 207, 210, 212, 4, 204, 207, 206, 199, 6, 211, 212, 210, 201, 206, 199, 7, 210, 207, 213, 212, 201, 206,
197, 2, 198, 206, 3, 205, 193, 208, 4, 206, 193, 205, 197, 6, 210, 197, 195, 207, 210, 196, 4, 211, 212,
207, 208, 7, 195, 207, 205, 208, 201, 204, 197, 6, 201, 199, 206, 207, 210, 197, 2, 207, 206, 3, 207, 198,
198, 5, 193, 210, 210, 193, 217, 3, 193, 206, 196, 2, 207, 210, 2, 61, 61, 1, 61, 2, 60, 45, 2,
45, 62, 4, 211, 208, 197, 195, 6, 206, 207, 210, 205, 193, 204, 6, 214, 197, 195, 212, 207, 210, 1, 58,
2, 62, 61, 1, 62, 1, 35, 2, 60, 61, 1, 60, 2, 92, 61, 4, 197, 204, 211, 197, 1, 95, 6,
211, 217, 211, 212, 197, 205, 8, 197, 216, 212, 197, 210, 206, 193, 204, 5, 195, 204, 193, 201, 205, 7, 210,
197, 204, 197, 193, 211, 197, 1, 80, 3, 80, 85, 84, 1, 64, 9, 208, 210, 201, 206, 212, 212, 197, 216,
212, 6, 210, 197, 212, 213, 210, 206, 7, 210, 197, 211, 213, 204, 212, 61, 7, 205, 207, 206, 201, 212, 207,
210, 5, 211, 212, 193, 210, 212, 7, 209, 213, 197, 210, 201, 197, 211, 5, 195, 217, 195, 204, 197, 6, 210,
197, 208, 197, 193, 212, 4, 212, 200, 197, 206, 3, 197, 206, 196, 7, 195, 207, 205, 205, 197, 206, 212, 5,
210, 197, 193, 204, 211, 5, 194, 197, 199, 201, 206, 2, 207, 198, 7, 208, 210, 207, 199, 210, 193, 205, 6,
211, 215, 201, 212, 195, 200, 8, 210, 197, 199, 201, 211, 212, 197, 210, 3, 207, 215, 206, 5, 205, 195, 207,
196, 197, 5, 198, 193, 213, 204, 212, 4, 198, 201, 204, 197, 6, 196, 197, 198, 201, 206, 197, 1, 210, 7,
211, 208, 197, 195, 201, 193, 204, 4, 204, 201, 211, 212, 7, 195, 207, 206, 212, 210, 207, 204, 6, 198, 201,
206, 201, 211, 200, 6, 198, 207, 210, 205, 193, 212};
// 55+ 43, 1, 45, 1, 92, 1, 40, 1, 41, 1, 33, 1, 44, 2,
// 56+ 42, 42, 2, 33, 33, 1, 42, 2, 47, 47, 1, 47, 1, 38,
// 57+ 2, 62, 62, 2, 60, 60, 1, 46, 1, 63, 2, 201, 198, 6,
// 58+ 213, 206, 204, 197, 211, 211, 7, 201, 206, 212, 197, 199, 197, 210,
// 59+ 4, 210, 197, 193, 204, 4, 194, 217, 212, 197, 5, 211, 200, 207,
// 60+ 210, 212, 4, 204, 207, 206, 199, 6, 211, 212, 210, 201, 206, 199,
// 61+ 7, 210, 207, 213, 212, 201, 206, 197, 2, 198, 206, 3, 205, 193,
// 62+ 208, 4, 206, 193, 205, 197, 6, 210, 197, 195, 207, 210, 196, 4,
// 63+ 211, 212, 207, 208, 7, 195, 207, 205, 208, 201, 204, 197, 6, 201,
// 64+ 199, 206, 207, 210, 197, 2, 207, 206, 3, 207, 198, 198, 5, 193,
// 65+ 210, 210, 193, 217, 3, 193, 206, 196, 2, 207, 210, 2, 61, 61,
// 66+ 1, 61, 2, 60, 45, 2, 45, 62, 4, 211, 208, 197, 195, 6,
// 67+ 206, 207, 210, 205, 193, 204, 6, 214, 197, 195, 212, 207, 210, 1,
// 68+ 58, 2, 62, 61, 1, 62, 1, 35, 2, 60, 61, 1, 60, 2,
// 69+ 92, 61, 4, 197, 204, 211, 197, 1, 95, 6, 211, 217, 211, 212,
// 70+ 197, 205, 8, 197, 216, 212, 197, 210, 206, 193, 204, 5, 195, 204,
// 71+ 193, 201, 205, 7, 210, 197, 204, 197, 193, 211, 197, 1, 80, 3,
// 72+ 80, 85, 84, 1, 64, 9, 208, 210, 201, 206, 212, 212, 197, 216,
// 73+ 212, 6, 210, 197, 212, 213, 210, 206, 7, 210, 197, 211, 213, 204,
// 74+ 212, 61, 7, 205, 207, 206, 201, 212, 207, 210, 5, 211, 212, 193,
// 75+ 210, 212, 7, 209, 213, 197, 210, 201, 197, 211, 5, 195, 217, 195,
// 76+ 204, 197, 6, 210, 197, 208, 197, 193, 212, 4, 212, 200, 197, 206,
// 77+ 3, 197, 206, 196, 7, 195, 207, 205, 205, 197, 206, 212, 5, 210,
// 78+ 197, 193, 204, 211, 5, 194, 197, 199, 201, 206, 2, 207, 198, 7,
// 79+ 208, 210, 207, 199, 210, 193, 205, 6, 211, 215, 201, 212, 195, 200,
// 80+ 8, 210, 197, 199, 201, 211, 212, 197, 210, 3, 207, 215, 206, 5,
// 81+ 205, 195, 207, 196, 197, 5, 198, 193, 213, 204, 212, 4, 198, 201,
// 82+ 204, 197, 6, 196, 197, 198, 201, 206, 197, 1, 210, 7, 211, 208,
// 83+ 197, 195, 201, 193, 204, 4, 204, 201, 211, 212, 7, 195, 207, 206,
// 84+ 212, 210, 207, 204, 6, 198, 201, 206, 201, 211, 200, 6, 198, 207,
// 85+ 210, 205, 193, 212;
// 86 %OWNSHORTINTEGERARRAY SYMBOL(1300: 2148)= 1309,
static short int SYMBOL[849] = {
1309, 1303, 1, 1305, 3, 1307, 5, 1309, 1000, 1316, 1312, 1, 1314, 3, 1316, 1000, 1335, 1321, 1001,
1342, 1706, 1323, 1003, 1329, 7, 1300, 1316, 1335, 9, 1335, 11, 1300, 1316, 1335, 11, 1342, 1340, 1361,
1316, 1335, 1342, 1000, 1352, 1350, 7, 1300, 1316, 1335, 1352, 9, 1352, 1000, 1361, 1359, 13, 1300, 1316,
1335, 1352, 1361, 1000, 1388, 1364, 15, 1366, 1, 1368, 3, 1370, 18, 1372, 11, 1374, 21, 1376, 23,
1378, 26, 1380, 28, 1382, 30, 1384, 33, 1386, 36, 1388, 1000, 1393, 1391, 38, 1393, 1000, 1398, 1396,
13, 1398, 1000, 1403, 1401, 40, 1403, 43, 1420, 1406, 50, 1408, 58, 1411, 63, 50, 1414, 68, 50,
1417, 74, 58, 1420, 79, 1883, 1426, 1423, 86, 1426, 1403, 1426, 1431, 1429, 94, 1431, 97, 1445, 1435,
1420, 1467, 1438, 1403, 1472, 1441, 1462, 101, 1445, 106, 1462, 101, 1450, 1448, 1005, 1450, 1001, 1457, 1453,
113, 1455, 118, 1457, 126, 1462, 1460, 133, 1462, 136, 1467, 1465, 140, 1467, 1000, 1472, 1470, 101, 1472,
1000, 1484, 1477, 101, 140, 101, 1480, 140, 101, 1482, 101, 1484, 1000, 1493, 1491, 7, 1431, 1009, 1493,
9, 1493, 1000, 1501, 1499, 1393, 1431, 1009, 1493, 1501, 1000, 1520, 1513, 1010, 1300, 1316, 1335, 1669, 1300,
1316, 1335, 1520, 1011, 1520, 7, 1010, 1501, 1528, 1011, 9, 1528, 1526, 1669, 1300, 1316, 1335, 1528, 1000,
1539, 1533, 146, 1501, 1539, 1537, 150, 1501, 1546, 1539, 1000, 1546, 1544, 146, 1501, 1539, 1546, 1000, 1553,
1551, 150, 1501, 1546, 1553, 1000, 1562, 1560, 1562, 1300, 1316, 1335, 1388, 1562, 1000, 1571, 1565, 153, 1567,
156, 1569, 158, 1571, 161, 1576, 1574, 164, 1576, 1000, 1581, 1579, 74, 1581, 169, 1588, 1586, 13, 1714,
1581, 1588, 1000, 1599, 1592, 1472, 1009, 1596, 1467, 140, 1599, 1599, 176, 1613, 1607, 1607, 1009, 7, 1714,
1581, 9, 1607, 1613, 1611, 13, 1599, 1613, 1000, 1618, 1618, 1009, 1635, 1618, 1624, 1622, 13, 1613, 1624,
1000, 1635, 1629, 1001, 1723, 1006, 1635, 140, 1001, 1635, 1890, 1004, 1644, 1644, 7, 1309, 1003, 183, 1309,
1003, 9, 1651, 1649, 13, 1005, 1644, 1651, 1000, 1661, 1659, 13, 1005, 1644, 161, 1445, 1651, 1661, 1000,
1669, 1667, 13, 1009, 1635, 1661, 1669, 1000, 1686, 1672, 156, 1674, 185, 1676, 188, 1678, 190, 1680, 192,
1682, 195, 1684, 197, 1686, 161, 1694, 1689, 1006, 1694, 1398, 1501, 1528, 1006, 1700, 1698, 200, 1902, 1700,
1000, 1706, 1704, 205, 1001, 1706, 1000, 1714, 1712, 205, 1001, 1342, 1706, 1714, 1000, 1723, 1723, 1300, 1316,
1335, 183, 1300, 1316, 1335, 1730, 1728, 156, 1300, 1003, 1730, 1000, 1737, 1733, 207, 1735, 214, 1737, 1000,
1742, 1740, 223, 1742, 229, 1747, 1745, 140, 1747, 106, 1757, 1755, 1393, 1403, 1467, 140, 1599, 1747, 1757,
1000, 1764, 1762, 1431, 1009, 1493, 1764, 1000, 1772, 1768, 1001, 1857, 1772, 195, 1445, 188, 1785, 1780, 1005,
7, 1005, 13, 1005, 9, 1785, 1764, 7, 1005, 9, 1792, 1789, 1764, 1883, 1792, 1005, 1792, 1805, 1799,
7, 1005, 13, 1005, 9, 1803, 7, 1005, 9, 1805, 1000, 1811, 1809, 13, 1003, 1811, 1000, 1817, 1814,
1764, 1817, 1005, 1883, 1857, 1823, 1012, 1005, 13, 1005, 1828, 1013, 1005, 13, 1785, 1835, 1014, 1005, 13,
1005, 13, 1811, 1839, 1015, 1811, 1805, 1844, 1016, 1005, 13, 1811, 1849, 1017, 1772, 13, 1811, 1854, 1018,
1772, 13, 1772, 1857, 1019, 1005, 1863, 1861, 1, 1005, 1863, 1000, 1883, 1872, 21, 1005, 13, 1895, 1001,
1342, 1706, 1876, 161, 237, 1005, 1879, 1002, 1817, 1883, 239, 205, 1003, 1890, 1888, 7, 1005, 9, 1890,
1000, 1895, 1893, 156, 1895, 1000, 1902, 1898, 243, 1900, 156, 1902, 1000, 1943, 1910, 1010, 1001, 1342, 1706,
1011, 1553, 1918, 161, 1001, 7, 1300, 1316, 1335, 9, 1921, 161, 1445, 1924, 245, 1008, 1926, 255, 1931,
262, 1300, 1316, 1335, 1933, 113, 1936, 270, 113, 1938, 278, 1940, 270, 1943, 284, 1457, 2149, 1949, 1010,
1902, 1011, 1686, 1967, 292, 1001, 1342, 1706, 156, 1300, 1316, 1335, 13, 1300, 1316, 1335, 13, 1300, 1316,
1335, 1006, 1970, 298, 1006, 1973, 1445, 183, 1985, 1398, 1010, 1501, 1528, 305, 1011, 1010, 1902, 1011, 1694,
1006, 1988, 11, 1007, 1992, 1403, 1588, 1006, 1995, 310, 1006, 2004, 1010, 1730, 1420, 1011, 1571, 1001, 1484,
1006, 2007, 314, 1007, 2011, 322, 1576, 1006, 2014, 328, 1006, 2019, 310, 334, 337, 1006, 2026, 1001, 7,
1309, 1003, 9, 183, 2032, 345, 1009, 1635, 1661, 1006, 2036, 1450, 284, 1006, 2040, 352, 1001, 1006, 2044,
361, 1403, 1624, 2050, 1737, 1742, 352, 1001, 1006, 2053, 365, 1006, 2057, 68, 86, 1006, 2061, 21, 1863,
1006, 2069, 371, 1005, 1644, 161, 1445, 1651, 1006, 2074, 310, 334, 377, 1006, 2079, 310, 334, 365, 1006,
2084, 382, 118, 389, 1006, 2090, 164, 1001, 1706, 1484, 1006, 2095, 391, 101, 1001, 1006, 2098, 399, 1006,
2103, 310, 334, 399, 1006, 2107, 404, 1003, 1006, 2111, 412, 1694, 1006, 2120, 106, 419, 1001, 7, 1757,
1747, 9, 1006, 2129, 106, 1010, 1588, 1011, 7, 1001, 9, 1006, 2136, 1010, 1420, 101, 1011, 1009, 1006,
2147, 106, 164, 1010, 1001, 1700, 1011, 7, 1001, 9, 1006, 2149, 1006};
// 87+ 1303, 1, 1305, 3, 1307, 5, 1309, 1000, 1316, 1312,
// 88+ 1, 1314, 3, 1316, 1000, 1335, 1321, 1001, 1342, 1706,
// 89+ 1323, 1003, 1329, 7, 1300, 1316, 1335, 9, 1335, 11,
// 90+ 1300, 1316, 1335, 11, 1342, 1340, 1361, 1316, 1335, 1342,
// 91+ 1000, 1352, 1350, 7, 1300, 1316, 1335, 1352, 9, 1352,
// 92+ 1000, 1361, 1359, 13, 1300, 1316, 1335, 1352, 1361, 1000,
// 93+ 1388, 1364, 15, 1366, 1, 1368, 3, 1370, 18, 1372,
// 94+ 11, 1374, 21, 1376, 23, 1378, 26, 1380, 28, 1382,
// 95+ 30, 1384, 33, 1386, 36, 1388, 1000, 1393, 1391, 38,
// 96+ 1393, 1000, 1398, 1396, 13, 1398, 1000, 1403, 1401, 40,
// 97+ 1403, 43, 1420, 1406, 50, 1408, 58, 1411, 63, 50,
// 98+ 1414, 68, 50, 1417, 74, 58, 1420, 79, 1883, 1426,
// 99+ 1423, 86, 1426, 1403, 1426, 1431, 1429, 94, 1431, 97,
// 100+ 1445, 1435, 1420, 1467, 1438, 1403, 1472, 1441, 1462, 101,
// 101+ 1445, 106, 1462, 101, 1450, 1448, 1005, 1450, 1001, 1457,
// 102+ 1453, 113, 1455, 118, 1457, 126, 1462, 1460, 133, 1462,
// 103+ 136, 1467, 1465, 140, 1467, 1000, 1472, 1470, 101, 1472,
// 104+ 1000, 1484, 1477, 101, 140, 101, 1480, 140, 101, 1482,
// 105+ 101, 1484, 1000, 1493, 1491, 7, 1431, 1009, 1493, 9,
// 106+ 1493, 1000, 1501, 1499, 1393, 1431, 1009, 1493, 1501, 1000,
// 107+ 1520, 1513, 1010, 1300, 1316, 1335, 1669, 1300, 1316, 1335,
// 108+ 1520, 1011, 1520, 7, 1010, 1501, 1528, 1011, 9, 1528,
// 109+ 1526, 1669, 1300, 1316, 1335, 1528, 1000, 1539, 1533, 146,
// 110+ 1501, 1539, 1537, 150, 1501, 1546, 1539, 1000, 1546, 1544,
// 111+ 146, 1501, 1539, 1546, 1000, 1553, 1551, 150, 1501, 1546,
// 112+ 1553, 1000, 1562, 1560, 1562, 1300, 1316, 1335, 1388, 1562,
// 113+ 1000, 1571, 1565, 153, 1567, 156, 1569, 158, 1571, 161,
// 114+ 1576, 1574, 164, 1576, 1000, 1581, 1579, 74, 1581, 169,
// 115+ 1588, 1586, 13, 1714, 1581, 1588, 1000, 1599, 1592, 1472,
// 116+ 1009, 1596, 1467, 140, 1599, 1599, 176, 1613, 1607, 1607,
// 117+ 1009, 7, 1714, 1581, 9, 1607, 1613, 1611, 13, 1599,
// 118+ 1613, 1000, 1618, 1618, 1009, 1635, 1618, 1624, 1622, 13,
// 119+ 1613, 1624, 1000, 1635, 1629, 1001, 1723, 1006, 1635, 140,
// 120+ 1001, 1635, 1890, 1004, 1644, 1644, 7, 1309, 1003, 183,
// 121+ 1309, 1003, 9, 1651, 1649, 13, 1005, 1644, 1651, 1000,
// 122+ 1661, 1659, 13, 1005, 1644, 161, 1445, 1651, 1661, 1000,
// 123+ 1669, 1667, 13, 1009, 1635, 1661, 1669, 1000, 1686, 1672,
// 124+ 156, 1674, 185, 1676, 188, 1678, 190, 1680, 192, 1682,
// 125+ 195, 1684, 197, 1686, 161, 1694, 1689, 1006, 1694, 1398,
// 126+ 1501, 1528, 1006, 1700, 1698, 200, 1902, 1700, 1000, 1706,
// 127+ 1704, 205, 1001, 1706, 1000, 1714, 1712, 205, 1001, 1342,
// 128+ 1706, 1714, 1000, 1723, 1723, 1300, 1316, 1335, 183, 1300,
// 129+ 1316, 1335, 1730, 1728, 156, 1300, 1003, 1730, 1000, 1737,
// 130+ 1733, 207, 1735, 214, 1737, 1000, 1742, 1740, 223, 1742,
// 131+ 229, 1747, 1745, 140, 1747, 106, 1757, 1755, 1393, 1403,
// 132+ 1467, 140, 1599, 1747, 1757, 1000, 1764, 1762, 1431, 1009,
// 133+ 1493, 1764, 1000, 1772, 1768, 1001, 1857, 1772, 195, 1445,
// 134+ 188, 1785, 1780, 1005, 7, 1005, 13, 1005, 9, 1785,
// 135+ 1764, 7, 1005, 9, 1792, 1789, 1764, 1883, 1792, 1005,
// 136+ 1792, 1805, 1799, 7, 1005, 13, 1005, 9, 1803, 7,
// 137+ 1005, 9, 1805, 1000, 1811, 1809, 13, 1003, 1811, 1000,
// 138+ 1817, 1814, 1764, 1817, 1005, 1883, 1857, 1823, 1012, 1005,
// 139+ 13, 1005, 1828, 1013, 1005, 13, 1785, 1835, 1014, 1005,
// 140+ 13, 1005, 13, 1811, 1839, 1015, 1811, 1805, 1844, 1016,
// 141+ 1005, 13, 1811, 1849, 1017, 1772, 13, 1811, 1854, 1018,
// 142+ 1772, 13, 1772, 1857, 1019, 1005, 1863, 1861, 1, 1005,
// 143+ 1863, 1000, 1883, 1872, 21, 1005, 13, 1895, 1001, 1342,
// 144+ 1706, 1876, 161, 237, 1005, 1879, 1002, 1817, 1883, 239,
// 145+ 205, 1003, 1890, 1888, 7, 1005, 9, 1890, 1000, 1895,
// 146+ 1893, 156, 1895, 1000, 1902, 1898, 243, 1900, 156, 1902,
// 147+ 1000, 1943, 1910, 1010, 1001, 1342, 1706, 1011, 1553, 1918,
// 148+ 161, 1001, 7, 1300, 1316, 1335, 9, 1921, 161, 1445,
// 149+ 1924, 245, 1008, 1926, 255, 1931, 262, 1300, 1316, 1335,
// 150+ 1933, 113, 1936, 270, 113, 1938, 278, 1940, 270, 1943,
// 151+ 284, 1457, 2149, 1949, 1010, 1902, 1011, 1686, 1967, 292,
// 152+ 1001, 1342, 1706, 156, 1300, 1316, 1335, 13, 1300, 1316,
// 153+ 1335, 13, 1300, 1316, 1335, 1006, 1970, 298, 1006, 1973,
// 154+ 1445, 183, 1985, 1398, 1010, 1501, 1528, 305, 1011, 1010,
// 155+ 1902, 1011, 1694, 1006, 1988, 11, 1007, 1992, 1403, 1588,
// 156+ 1006, 1995, 310, 1006, 2004, 1010, 1730, 1420, 1011, 1571,
// 157+ 1001, 1484, 1006, 2007, 314, 1007, 2011, 322, 1576, 1006,
// 158+ 2014, 328, 1006, 2019, 310, 334, 337, 1006, 2026, 1001,
// 159+ 7, 1309, 1003, 9, 183, 2032, 345, 1009, 1635, 1661,
// 160+ 1006, 2036, 1450, 284, 1006, 2040, 352, 1001, 1006, 2044,
// 161+ 361, 1403, 1624, 2050, 1737, 1742, 352, 1001, 1006, 2053,
// 162+ 365, 1006, 2057, 68, 86, 1006, 2061, 21, 1863, 1006,
// 163+ 2069, 371, 1005, 1644, 161, 1445, 1651, 1006, 2074, 310,
// 164+ 334, 377, 1006, 2079, 310, 334, 365, 1006, 2084, 382,
// 165+ 118, 389, 1006, 2090, 164, 1001, 1706, 1484, 1006, 2095,
// 166+ 391, 101, 1001, 1006, 2098, 399, 1006, 2103, 310, 334,
// 167+ 399, 1006, 2107, 404, 1003, 1006, 2111, 412, 1694, 1006,
// 168+ 2120, 106, 419, 1001, 7, 1757, 1747, 9, 1006, 2129,
// 169+ 106, 1010, 1588, 1011, 7, 1001, 9, 1006, 2136, 1010,
// 170+ 1420, 101, 1011, 1009, 1006, 2147, 106, 164, 1010, 1001,
// 171+ 1700, 1011, 7, 1001, 9, 1006, 2149, 1006;
// 172 SS= 1943
SS = 1943;
// 173 %OWNBYTEINTEGERARRAY OPC(0:120)=0,
static unsigned char OPC[121] = {
0, 8, 9, 16, 17, 18, 19, 32, 33, 34, 35, 48, 49, 50, 51, 36, 52, 0, 69, 70, 71,
84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 104, 105, 106, 107, 108, 109, 110, 111, 120,
121, 122, 123, 124, 125, 126, 127, 0, 112, 96, 80, 78, 79, 76, 75, 74, 73, 72, 68, 67, 66,
65, 64, 0, 144, 152, 134, 135, 0, 145, 146, 148, 149, 150, 151, 156, 158, 157, 159, 130, 132, 133,
0, 136, 137, 138, 139, 140, 141, 142, 143, 0, 208, 209, 210, 212, 213, 214, 215, 216, 220, 221, 222,
223, 211, 0, 241, 242, 243, 248, 249, 250, 251, 252, 253, 0, 10, 4, 128};
// 174+ 8,9,X'10',X'11',X'12',
// 175+ X'13',X'20',X'21',X'22',X'23',
// 176+ X'30',X'31',X'32',X'33',X'24',
// 177+ X'34',0,X'45',X'46',X'47',
// 178+ X'54',X'55',X'56',X'57',X'58',X'59',X'5A',X'5B',X'5C',
// 179+ X'5D',X'5E',X'5F',X'68',X'69',X'6A',
// 180+ X'6B',X'6C',X'6D',X'6E',X'6F',
// 181+ X'78',X'79',X'7A',X'7B',X'7C',
// 182+ X'7D',X'7E',X'7F',0,X'70',
// 183+ X'60',X'50',X'4E',X'4F',X'4C',
// 184+ X'4B',X'4A',X'49',X'48',X'44',
// 185+ X'43',X'42',X'41',X'40',0,
// 186+ X'90',X'98',X'86',X'87',0,
// 187+ X'91',X'92',X'94',X'95',X'96',
// 188+ X'97',X'9C',X'9E',X'9D',X'9F',
// 189+ X'82',X'84',X'85',0,X'88',
// 190+ X'89',X'8A',X'8B',X'8C',X'8D',
// 191+ X'8E',X'8F',0,X'D0',X'D1',
// 192+ X'D2',X'D4',X'D5',X'D6',X'D7',
// 193+ X'D8',X'DC',X'DD',X'DE',X'DF',
// 194+ X'D3',0,X'F1',X'F2',X'F3',
// 195+ X'F8',X'F9',X'FA',X'FB',X'FC',
// 196+ X'FD',0,10,4,X'80';
// 197 %OWNINTEGERARRAY NEM(0:120)=M'CNOP',
static int NEM[121] = {1129205584, 4805451, 5460811, 19536, 19534, 19540, 19523, 5001284, 5000772,
5002308, 4997956, 5001285, 5000773, 5002309, 4997957, 18500, 18501, 0,
4342092, 4342612, 16963, 78, 17228, 79, 88, 76, 67,
65, 83, 77, 68, 16716, 21324, 19524, 17220, 16708,
21316, 19780, 17476, 16727, 21335, 19525, 17221, 16709, 21317,
19781, 17477, 16725, 21333, 0, 5461061, 5461060, 21332, 4412996,
4412994, 19784, 21320, 16712, 17224, 19528, 17752, 18755, 5461059,
19521, 5461064, 0, 5461069, 19533, 4347976, 1113082949, 0, 21581,
5068361, 20041, 4410441, 20297, 22601, 5456982, 4736086, 5522518, 4410179,
20547, 5722692, 5391428, 0, 5460556, 5459020, 5460545, 5459009, 1397900364,
1397507148, 1397900353, 1397507137, 0, 5460816, 5068366, 5068355, 20035, 4410435,
20291, 22595, 5002064, 21586, 5526100, 17732, 1162104139, 5068378, 0,
5068367, 1346454347, 1431195723, 5914960, 17232, 16720, 21328, 19792, 17488,
0, 5461571, 5460045, 4801612};
// 198+ M'ISK',M'SSK',M'LP',M'LN',M'LT',
// 199+ M'LC',M'LPD',M'LND',M'LTD',M'LCD',
// 200+ M'LPE',M'LNE',M'LTE',M'LCE',M'HD',
// 201+ M'HE',0,M'BAL',M'BCT',M'BC',
// 202+ 'N',M'CL','O','X','L','C','A','S','M','D',
// 203+ M'AL',M'SL',M'LD',M'CD',M'AD',
// 204+ M'SD',M'MD',M'DD',M'AW',M'SW',
// 205+ M'LE',M'CE',M'AE',M'SE',M'ME',
// 206+ M'DE',M'AU',M'SU',0,M'STE',
// 207+ M'STD',M'ST',M'CVD',M'CVB',M'MH',
// 208+ M'SH',M'AH',M'CH',M'LH',M'EX',
// 209+ M'IC',M'STC',M'LA',M'STH',0,
// 210+ M'STM',M'LM',M'BXH',M'BXLE',0,
// 211+ M'TM',M'MVI',M'NI',M'CLI',M'OI',
// 212+ M'XI',M'SDV',M'HDV',M'TDV',M'CKC',
// 213+ M'PC',M'WRD',M'RDD',0,M'SRL',
// 214+ M'SLL',M'SRA',M'SLA',M'SRDL',M'SLDL',
// 215+ M'SRDA',M'SLDA',0,M'SSP',M'MVN',
// 216+ M'MVC',M'NC',M'CLC',M'OC',M'XC',
// 217+ M'LSP',M'TR',M'TRT',M'ED',M'EDMK',
// 218+ M'MVZ',0,M'MVO',M'PACK',M'UNPK',
// 219+ M'ZAP',M'CP',M'AP',M'SP',M'MP',
// 220+ M'DP',0,M'SVC',M'SPM',M'IDL';
// 221 %OWNSHORTINTEGERARRAY CLODS(0:88)= %C
static short int CLODS[89] = {
4, 20685, 28, 22733, 92, 4, 20731, 60, 17916, 76, 6, 22560, 8192, 1568, 35104,
24, 5634, 0, 8, 20656, 0, 19120, 16386, 16827, 7, 21693, 84, 4, 22557, 36,
37376, 4097, 11, 1296, 10278, 28269, 72, 27245, 40, 11046, 18352, 4116, 27181, 48, 4,
36867, 45056, 16827, 16, 5, 16640, 0, 22764, 186, 1534, 5, 36942, 45072, 39118, 53248,
1534, 7, 36942, 45072, 39119, 0, 39001, 61460, 1534, 5, 16640, 255, 35072, 24, 5648,
6, 16640, 4, 22973, 68, 18208, 49236, 6, 24576, 45120, 16640, 12, 20480, 45128};
// 222+ 4,X'50CD',X'001C',X'58CD',X'5C',
// 223+ 4,X'50FB',X'003C',X'45FC',X'4C',
// 224+ 6,X'5820',X'2000',X'0620',
// 225+ X'8920',24,X'1602',0,
// 226+ 8,X'50B0',0,X'4AB0',X'4002',
// 227+ X'41BB',X'7',X'54BD',84,
// 228+ 4,X'581D',36,X'9200',X'1001',
// 229+ 11,X'0510',X'2826',X'6E6D',X'48',
// 230+ X'6A6D',X'28',X'2B26',X'47B0',
// 231+ X'1014',X'6A2D',X'30',
// 232+ 4, X'9003',X'B000',X'41BB',X'10',
// 233+ 5, X'4100',0,X'58EC',186,X'5FE',
// 234+ 5, X'904E',X'B010',X'98CE',
// 235+ X'D000',X'5FE',
// 236+ 7, X'904E',X'B010',X'98CF',0,
// 237+ X'9859',X'F014',X'5FE',
// 238+ 5,X'4100',255,X'8900',X'18',X'1610',
// 239+ 6,X'4100',4,X'59BD',X'44',
// 240+ X'4720',X'C054',
// 241+ 6,X'6000',X'B040',X'4100',12,X'5000',X'B048'
// 242 %OWNBYTEINTEGERARRAY TSNAME (0:50)=0(8),
static unsigned char TSNAME[51] = {[0 ... 7] = 0,
1,
[9 ... 13] = 0,
1,
26,
1,
1,
26,
[19 ... 20] = 0,
2,
1,
[23 ... 30] = 26,
3,
9,
17,
[34 ... 35] = 26,
1,
0,
1,
26,
[40 ... 41] = 0,
5,
[43 ... 50] = 0};
// 243+ 1,0(5),1,26,1,1,26,0(2),2,1,26(8),
// 244+ 3,9,17,26(2),1,0,1,26,0(2),5,0(8)
// 245 NEWLINES(3); SPACES(30)
_imp_NEWLINES(3);
_imp_SPACES(30);
// 246 print string("E.R.C.C. IMP(SYS1) COMPILER ")
_imp_PRINTSTRING(_imp_str_literal("E.R.C.C. IMP(SYS1) COMPILER "));
// 247 print string(" RELEASE 5 ALL-IMP VERSION")
_imp_PRINTSTRING(_imp_str_literal(" RELEASE 5 ALL-IMP VERSION"));
// 248 print string(" DATED 1/5/70")
_imp_PRINTSTRING(_imp_str_literal(" DATED 1/5/70"));
// 249 NEWLINES(3)
_imp_NEWLINES(3);
// 250 %OWNBYTEINTEGERARRAY BYTES(0:3)=4,1,2,8;
static unsigned char BYTES[4] = {4, 1, 2, 8};
// 251 %OWNBYTEINTEGERARRAY PRECEDENCE (1:12)=0,3,3,3,3,4,4,4,4,5,5,5;
static unsigned char PRECEDENCE[12] = {0, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5};
// 252 %OWNBYTEINTEGERARRAY TYPEFLAG(1:6)=1,2,
static unsigned char TYPEFLAG[6] = {1, 2, 9, 17, 26, 5};
// 253+ B'1001',B'10001',B'11010',5;
// 254 %OWNINTEGER MASK1=X'0F0F0F0F'
static int MASK1 = 252645135;
// 255 %OWNINTEGER MASK2=X'0F0F0F0F'
static int MASK2 = 252645135;
// 256 %OWNSHORTINTEGER MAXLEVELS=11
static short int MAXLEVELS = 11;
// 257 %OWNINTEGER CODER=12
static int CODER = 12;
// 258 %OWNINTEGER LINK =15
static int LINK = 15;
// 259 %OWNINTEGER WSPR =11
static int WSPR = 11;
// 260 %OWNINTEGER GLA =13
static int GLA = 13;
// 261 %SHORTINTEGER CCSIZE,ARSIZE,DSIZE,NROUTS
short int CCSIZE;
short int ARSIZE;
short int DSIZE;
short int NROUTS;
auto void SIZES(void);
// 262 %ROUTINESPEC SIZES
// 263 %INTEGER ASL,NNAMES
int ASL;
int NNAMES;
// 264 %INTEGER CABUF,PPCURR,QPREAL,OLDLINE
int CABUF;
int PPCURR;
int QPREAL;
int OLDLINE;
// 265 %INTEGER LINE,LENGTH,LENGTHP,N0,NUM,SNUM
int LINE;
int LENGTH;
int LENGTHP;
int N0;
int NUM;
int SNUM;
// 266 %INTEGER RLEVEL,NMAX,OWNLINK,CONSTPTR
int RLEVEL;
int NMAX;
int OWNLINK;
int CONSTPTR;
// 267 %INTEGER PLABEL,LEVEL,CA,MARKER1,MARKER2,LABSET
int PLABEL;
int LEVEL;
int CA;
int MARKER1;
int MARKER2;
int LABSET;
// 268 %INTEGER R13,RP13,SIGFIGS
int R13;
int RP13;
int SIGFIGS;
// 269 %BYTEINTEGER AFLAG,FFLAG,CHECKS,SBFLAG
unsigned char AFLAG;
unsigned char FFLAG;
unsigned char CHECKS;
unsigned char SBFLAG;
// 270 %BYTEINTEGER FAULTY,MONE,HIT,QU,PERM,MCSWITCH,LIST,ALLLONG
unsigned char FAULTY;
unsigned char MONE;
unsigned char HIT;
unsigned char QU;
unsigned char PERM;
unsigned char MCSWITCH;
unsigned char LIST;
unsigned char ALLLONG;
// 271 %BYTEINTEGER LINENOS,DIAGS1,DIAGS2,CHECKSP
unsigned char LINENOS;
unsigned char DIAGS1;
unsigned char DIAGS2;
unsigned char CHECKSP;
// 272 %BYTEINTEGER CTYPE,DCOMP,COMPILER,CPRMODE
unsigned char CTYPE;
unsigned char DCOMP;
unsigned char COMPILER;
unsigned char CPRMODE;
// 273 %BYTEINTEGER UNASS,PRINTMAP
unsigned char UNASS;
unsigned char PRINTMAP;
// 274 %LONGREAL CVALUE,IMAX
double CVALUE;
double IMAX;
// 275 %INTEGER MASK,RBASE,SFLABEL
int MASK;
int RBASE;
int SFLABEL;
// 276 %INTEGER NEXT,N,NR,ITEM,STRINST
int NEXT;
int N;
int NR;
int ITEM;
int STRINST;
// 277 %INTEGER P,Q,R,S,T,U,V,NEST,FNAME
int P;
int Q;
int R;
int S;
int T;
int U;
int V;
int NEST;
int FNAME;
// 278 %INTEGER XREFLINK,LDPTR
int XREFLINK;
int LDPTR;
// 279 %SHORTINTEGER NEPS,EPLINK
short int NEPS;
short int EPLINK;
// 280 %INTEGER SSTL,QMAX,STMTS
int SSTL;
int QMAX;
int STMTS;
// 281 %INTEGERARRAY REGISTER(0:15)
int REGISTER[16];
// 282 %INTEGERARRAY ST(0:1300)
int ST[1301];
// 283 %INTEGER %ARRAY SET,CODEBASE,FREG,RAL(0:MAXLEVELS)
int SET[MAXLEVELS + 1];
int CODEBASE[MAXLEVELS + 1];
int FREG[MAXLEVELS + 1];
int RAL[MAXLEVELS + 1];
// 284 %SHORTINTEGERARRAY CYCLE,JUMP,NAME,LABEL,FLAG,SBR,WSP,%C
short int CYCLE[MAXLEVELS + 1];
short int JUMP[MAXLEVELS + 1];
short int NAME[MAXLEVELS + 1];
short int LABEL[MAXLEVELS + 1];
short int FLAG[MAXLEVELS + 1];
short int SBR[MAXLEVELS + 1];
short int WSP[MAXLEVELS + 1];
short int L[MAXLEVELS + 1];
short int M[MAXLEVELS + 1];
short int LWSP[MAXLEVELS + 1];
short int MDARR[MAXLEVELS + 1];
short int RNEXT[MAXLEVELS + 1];
short int NMDECS[MAXLEVELS + 1];
short int STRWSP[MAXLEVELS + 1];
// 285+ L,M,LWSP,MDARR,RNEXT,NMDECS,STRWSP(0:MAXLEVELS)
// 286 %SHORTINTEGERARRAY CODE(0:192)
short int CODE[193];
// 287 %SHORTINTEGERARRAY PAGENOS(0:50)
short int PAGENOS[51];
// 288 %INTEGERARRAY UVARREG(5:8)
int UVARREG[4];
// 289 SIZES
SIZES();
// 290 %BYTEINTEGERARRAY CC(0:CCSIZE),ASLIST(0:ASL),LETT(0:DSIZE+20)
unsigned char CC[CCSIZE + 1];
unsigned char ASLIST[ASL + 1];
unsigned char LETT[DSIZE + 20 + 1];
// 291 %SHORTINTEGERARRAY RA(0:NROUTS),A(-2:ARSIZE)
short int RA[NROUTS + 1];
short int A[ARSIZE + 2 + 1];
// 292 %SHORTINTEGERARRAY WORD,TAGS(0:NNAMES)
short int WORD[NNAMES + 1];
short int TAGS[NNAMES + 1];
auto void CNOP(int I, int J);
auto void PCONST(int X);
auto void PSI(int OPCODE, int J, int BASE, int DISP);
auto void PSS(int OPCODE, int N, int BASE, int DISP, int P, int Q);
auto void PRX(int OPCODE, int R1, int R2, int BASE, int DISP);
auto void PACLOD(int PTR, int AT, int VALUE);
auto void PCLOD(int PTR);
auto void PLANT(int VALUE);
auto void PRR(int OPCODE, int R1, int R2);
// 293 {%SYSTEMINTEGERFNSPEC COM(%INTEGER N)
// 294 {%SYSTEMROUTINESPEC SET COM(%INTEGER I,J)
// 295 {%SYSTEMROUTINESPEC IOCP(%INTEGER A,B)
// 296 %ROUTINESPEC CNOP(%INTEGER I,J)
// 297 %ROUTINESPEC PCONST(%INTEGER X)
// 298 %ROUTINESPEC PSI(%INTEGER OPCODE,J,BASE,DISP)
// 299 %ROUTINESPEC PSS(%INTEGER OPCODE,N,BASE,DISP,P,Q)
// 300 %ROUTINESPEC PRX(%INTEGER OPCODE,R1,R2,BASE,DISP)
// 301 %ROUTINESPEC PACLOD(%INTEGER PTR,AT,VALUE)
// 302 %ROUTINESPEC PCLOD(%INTEGER PTR)
// 303 %ROUTINESPEC PLANT(%INTEGER VALUE)
// 304 %ROUTINESPEC PRR (%INTEGER OPCODE,R1,R2)
// 305 %EXTERNALROUTINESPEC LPUT(%INTEGER A,B,C,D)
extern void LPUT(int A, int B, int C, int D);
auto void PLUG(int J, int K);
auto void PRHEX(int VALUE, int PLACES);
auto void INITIALISE(void);
auto void PSYM(int X);
auto void COMPARE(void);
auto void PNAME(void);
auto void CONST(unsigned char MODE);
auto void CONSTLIST(void);
auto void TEXTTEXT(void);
auto void FROMAR8(int PTR, double *VALUE);
auto void FROMAR4(int PTR, int *VALUE);
auto void TOAR8(int PTR, double VALUE);
auto void TOAR4(int PTR, int VALUE);
auto void CSS(int P);
auto void FAULT(unsigned char N);
auto void FINALISE(void);
auto void PRINTNAME(int N);
// 306 %ROUTINESPEC PLUG(%INTEGER J,K)
// 307 %ROUTINESPEC PRHEX(%INTEGER VALUE,PLACES)
// 308 %ROUTINESPEC INITIALISE
// 309 %ROUTINESPEC PSYM(%INTEGER X)
// 310 %ROUTINESPEC COMPARE
// 311 %ROUTINESPEC PNAME
// 312 %ROUTINESPEC CONST(%BYTEINTEGER MODE)
// 313 %ROUTINESPEC CONSTLIST
// 314 %ROUTINESPEC TEXTTEXT
// 315 %ROUTINESPEC FROMAR8(%INTEGER PTR,%LONGREALNAME VALUE)
// 316 %ROUTINESPEC FROMAR4(%INTEGER PTR,%INTEGERNAME VALUE)
// 317 %ROUTINESPEC TOAR8(%INTEGER PTR,%LONGREAL VALUE)
// 318 %ROUTINESPEC TOAR4(%INTEGER PTR,VALUE)
// 319 %ROUTINESPEC CSS(%INTEGER P)
// 320 %ROUTINESPEC FAULT(%BYTEINTEGER N)
// 321 %ROUTINESPEC FINALISE
// 322 %ROUTINESPEC PRINT NAME (%INTEGER N)
// 323
// 324 ! Using an alternative RECODE extracted from PSR's IMPI interpreter.
// 325 %EXTERNALROUTINESPEC RECODE (%INTEGER START,FINISH,CA)
extern void RECODE(int START, int FINISH, int CA);
auto void READLINE(unsigned char N);
// 326
// 327 %ROUTINESPEC READ LINE(%BYTEINTEGER N)
// 328 %on %event 9 {,18} %start
if (!_imp_on_event(9)) goto L_0005;
// 329 %if 0=0 {event_event = 9} {TEMP UNTIL RECORD FIELDS WORKING} %then ->INEND
if (0 != 0) goto L_0006;
goto U_1000;
L_0006:;
// 330 ! %if event_event = 18 %then ->SUBSCHAR
// 331 ! I need to find out which characters were being substituted!
// 332 ! %signal %event event
// 333 %finish
L_0005:;
// 334 ! START OF COMPILATION
// 335 INITIALISE
INITIALISE();
// 336 LPUT(0,1,1,ADDR(LETT(1)))
LPUT(0, 1, 1, _imp_ADDR(/*?*/ &LETT[1]));
// 337 L8: READLINE(0); Q=1
U_1001:;
READLINE(0);
Q = 1;
// 338 L5: R=1; P=SS
U_1002:;
R = 1;
P = SS;
// 339 OLDLINE=LINE; COMPARE
OLDLINE = LINE;
COMPARE();
// 340 FAULT(102) %IF R>ARSIZE
if (R <= ARSIZE) goto L_0007;
FAULT(102);
L_0007:;
// 341 ->L6 %IF HIT=0
if (HIT != 0) goto L_0008;
goto U_1003;
L_0008:;
// 342 STMTS=STMTS+1
STMTS = STMTS + 1;
// 343 CSS(1)
CSS(1);
// 344 %IF DCOMP#0 %AND CA>CABUF %THEN %START
if (DCOMP == 0) goto L_0009;
if (CA <= CABUF) goto L_0009;
// 345 RECODE(ADDR(CODE(0)),ADDR(CODE(PPCURR)),CABUF)
RECODE(_imp_ADDR(/*?*/ &CODE[0]), _imp_ADDR(/*?*/ &CODE[PPCURR]), CABUF);
// 346 NEWLINE
_imp_NEWLINE();
// 347 LPUT(1,CA-CABUF,CABUF,ADDR(CODE(0)))
LPUT(1, CA - CABUF, CABUF, _imp_ADDR(/*?*/ &CODE[0]));
// 348 PPCURR=0; CABUF=CA; %FINISH
PPCURR = 0;
CABUF = CA;
L_0009:;
// 349 ->L7 %IF A(1)=13; ! END OF PROGRAM
if (A[3] != 13) goto L_000A;
goto U_1004;
L_000A:;
// 350 L9: ->L8 %IF Q>=LENGTH ;->L5
U_1005:;
if (Q < LENGTH) goto L_000B;
goto U_1001;
L_000B:;
goto U_1002;
// 351 L6: FAULT(100); ->L9
U_1003:;
FAULT(100);
goto U_1005;
// 352 L7: !DEAL WITH END OF PROGRAM
U_1004:;
// 353 FINALISE
FINALISE();
// 354 SET COM(24,0) %IF COMPILER =0 %AND FAULTY=0
if (COMPILER != 0) goto L_000C;
if (FAULTY != 0) goto L_000C;
SETCOM(24, 0);
L_000C:;
// 355 %STOP
_imp_stop(0);
// 356 INEND: FAULT(108)
U_1000:;
FAULT(108);
// 357 SUBSCHAR:LINE=LINE+1;FAULT(48)
U_1006:;
LINE = LINE + 1;
FAULT(48);
// 358 SPACES(5)
_imp_SPACES(5);
// 359 L15: READSYMBOL(I); ->L8 %IF I=10
U_1007:;
_imp_READSYMBOL(/*?*/ &I);
if (I != 10) goto L_000D;
goto U_1001;
L_000D:;
// 360 PRINTSYMBOL(I); ->L15
_imp_PRINTSYMBOL(I);
goto U_1007;
// 361 %ROUTINE FINALISE
void FINALISE(void) {
// 362 N0=N0+1 %IF N0&1#1
if (N0 & 1 == 1) goto L_000E;
N0 = N0 + 1;
L_000E:;
// 363 CNOP(0,8);ST(0)=X'20000'
CNOP(0, 8);
ST[0] = 131072;
// 364 ST(1)=X'10100000'
ST[1] = 269484032;
// 365 ST(4)=-1; ST(6)=255
ST[4] = -1;
ST[6] = 255;
// 366 ST(8)=OWNLINK
ST[8] = OWNLINK;
// 367 ST(12)=X'41100000'; ! D'1'
ST[12] = 1091567616;
// 368 ST(14)=X'41200000'; ! D'2'
ST[14] = 1092616192;
// 369 ST(18)=X'4E000000'; ! FOR IN LINE FLOATING
ST[18] = 1308622848;
// 370 ST(20)=-4; ST(21)=-8
ST[20] = -4;
ST[21] = -8;
// 371 ST(22)=XREFLINK; XREFLINK=88
ST[22] = XREFLINK;
XREFLINK = 88;
// 372 ST(26)=X'80000000'; ST(27)=X'06492350'; ST(28)=M'ERMA'
ST[26] = -2147483648;
ST[27] = 105456464;
ST[28] = 1163021633;
// 373 !! ^^^^^^^^^ ^^^^^^ WARNING! Big-endian issue?
// 374 ST(29)=X'904EB010'; ! ROUTINE ENTRY SUBROUTINE
ST[29] = -1873891312;
// 375 ST(30)= X'5A10D01C'
ST[30] = 1511051292;
// 376 ST(31)=X'07F10700'
ST[31] = 133236480;
// 377 ST(32)=X'80808080'
ST[32] = -2139062144;
// 378 ST(33)=X'80808080'
ST[33] = -2139062144;
// 379 ST(38)=X'80000000'; ST(39)=X'06532349'; ST(40)=M'OCP '
ST[38] = -2147483648;
ST[39] = 106111817;
ST[40] = 1329811488;
// 380 !! ^^^^^^^^^^^ ^^^^^^^ WARNING! More Big-endianness?
// 381 K=CA
K = CA;
// 382 LPUT(1,CA-CABUF,CABUF,ADDR(CODE(0))) %UNLESS CA=CABUF
if (CA == CABUF) goto L_000F;
LPUT(1, CA - CABUF, CABUF, _imp_ADDR(/*?*/ &CODE[0]));
L_000F:;
// 383 LPUT(2,N0<<2+4,0,ADDR(ST(0)));! GLA
LPUT(2, (N0 << 2) + 4, 0, _imp_ADDR(/*?*/ &ST[0]));
// 384 FAULT(99) %IF N0>1023
if (N0 <= 1023) goto L_0010;
FAULT(99);
L_0010:;
// 385 I=X'E2E2E2E2'
I = -488447262;
// 386 LPUT(4,4,SSTL,ADDR(I))
LPUT(4, 4, SSTL, _imp_ADDR(/*?*/ &I));
// 387 %IF CONSTPTR&1#0 %THEN PSYM(0)
if (CONSTPTR & 1 == 0) goto L_0011;
PSYM(0);
L_0011:;
// 388 ->L129 %IF FAULTY #0
if (FAULTY == 0) goto L_0012;
goto U_1008;
L_0012:;
// 389 NEWLINE; WRITE(STMTS,4)
_imp_NEWLINE();
_imp_WRITE(STMTS, 4);
// 390 print string(" STATEMENTS COMPILED SUCCESSFULLY")
_imp_PRINTSTRING(_imp_str_literal(" STATEMENTS COMPILED SUCCESSFULLY"));
// 391 L120: print string("
U_1009:;
_imp_PRINTSTRING(_imp_str_literal("\nCODE OCCUPIES"));
// 392+ CODE OCCUPIES")
// 393 WRITE(K,3);print string(" BYTES GLAP")
_imp_WRITE(K, 3);
_imp_PRINTSTRING(_imp_str_literal(" BYTES GLAP"));
// 394 WRITE(N0<<2,3); print string(" +")
_imp_WRITE(N0 << 2, 3);
_imp_PRINTSTRING(_imp_str_literal(" +"));
// 395 WRITE(CONSTPTR<<2,1); print string(" BYTES DIAG TABLES")
_imp_WRITE(CONSTPTR << 2, 1);
_imp_PRINTSTRING(_imp_str_literal(" BYTES DIAG TABLES"));
// 396 WRITE(SSTL+4,4); print string(" BYTES TOTAL")
_imp_WRITE(SSTL + 4, 4);
_imp_PRINTSTRING(_imp_str_literal(" BYTES TOTAL"));
// 397 ST(0)=CA; ST(1)=N0<<2+4
ST[0] = CA;
ST[1] = (N0 << 2) + 4;
// 398 ST(2)=(LDPTR<<2+7)&(-8); ST(3)=(SSTL+11)&(-8)
ST[2] = (LDPTR << 2) + 7 & (-8);
ST[3] = SSTL + 11 & (-8);
// 399 ST(4)=CONSTPTR<<2
ST[4] = CONSTPTR << 2;
// 400 ST(5)=CA+ST(1)+ST(2)+ST(3)+ST(4)
ST[5] = CA + ST[1] + ST[2] + ST[3] + ST[4];
// 401 WRITE(ST(5),5); print string(" BYTES")
_imp_WRITE(ST[5], 5);
_imp_PRINTSTRING(_imp_str_literal(" BYTES"));
// 402 NEWLINE
_imp_NEWLINE();
// 403 NEWLINE
_imp_NEWLINE();
// 404 LPUT(7,24,0,ADDR(ST(0)))
LPUT(7, 24, 0, _imp_ADDR(/*?*/ &ST[0]));
// 405 %RETURN
return;
// 406 L129: print string("
U_1008:;
_imp_PRINTSTRING(_imp_str_literal("\nPROGRAM CONTAINS"));
// 407+ PROGRAM CONTAINS"); WRITE(FAULTY,2); print string(" FAULTS"); ->L120
_imp_WRITE(FAULTY, 2);
_imp_PRINTSTRING(_imp_str_literal(" FAULTS"));
goto U_1009;
// 408 %END
} /* end of FINALISE */
// 409 %ROUTINE READ LINE(%BYTEINTEGER N)
void READLINE(unsigned char N) {
// 410 !%SHORTROUTINE
// 411 %INTEGER DEL
int DEL;
// 412 %BYTEINTEGER NP
unsigned char NP;
// 413 %COMMENT ABOUT 30% CPU TIME OF COMPILATION IS SPENT IN THIS
// 414 %COMMENT ROUTINE AS WRITTEN. A HAND CODED VERSION USING I
// 415 %COMMENT ISO CARD NOT READ SYMBOL IS USED IN PRODUCTION VRSN
// 416 Q=1; LINE=LINE+1
Q = 1;
LINE = LINE + 1;
// 417 LENGTH=0; DEL=0
LENGTH = 0;
DEL = 0;
// 418 L1: ->START %UNLESS N=0 %AND NEXT SYMBOL=10;! IGNORE EMPTY LINES
U_100A:;
if (N != 0) goto L_0013;
if (_imp_NEXTSYMBOL() == 10) goto L_0014;
L_0013:;
goto U_100B;
L_0014:;
// 419 SKIP SYMBOL; ->L1; ! IN PROGRAM MODE ONLY
_imp_SKIPSYMBOL();
goto U_100A;
// 420 START: ->L2 %IF LIST=0
U_100B:;
if (LIST != 0) goto L_0015;
goto U_100C;
L_0015:;
// 421 WRITE(LINE,5)
_imp_WRITE(LINE, 5);
// 422 PRINT SYMBOL('''') %IF N#0
if (N == 0) goto L_0016;
_imp_PRINTSYMBOL(39);
L_0016:;
// 423 SPACES(4*LEVEL-N)
_imp_SPACES(4 * LEVEL - N);
// 424 L2: READ SYMBOL(I)
U_100C:;
_imp_READSYMBOL(/*?*/ &I);
// 425 PRINT SYMBOL(I) %UNLESS LIST=0
if (LIST == 0) goto L_0017;
_imp_PRINTSYMBOL(I);
L_0017:;
// 426 ->L4 %UNLESS N=0
if (N == 0) goto L_0018;
goto U_100D;
L_0018:;
// 427 ->L3 %UNLESS I='%'
if (I == 37) goto L_0019;
goto U_100E;
L_0019:;
// 428 DEL=128; ->L2
DEL = 128;
goto U_100C;
// 429 L3: DEL=0 %UNLESS 'A'<=I<='Z'
U_100E:;
{
// Double-sided test on I (Part I)
int tmp;
if (65 > (tmp = I)) goto L_001A;
// Double-sided test on I (Part II)
if (tmp <= 90) goto L_001B;
}
L_001A:;
DEL = 0;
L_001B:;
// 430 ->L2 %IF I=' '
if (I != 32) goto L_001C;
goto U_100C;
L_001C:;
// 431 L4: LENGTH=LENGTH+1
U_100D:;
LENGTH = LENGTH + 1;
// 432 CC(LENGTH)=I!DEL
CC[LENGTH] = I | DEL;
// 433 %IF I='''' %THEN N=1-N
if (I != 39) goto L_001D;
N = 1 - N;
L_001D:;
// 434 ->L2 %UNLESS I=10
if (I == 10) goto L_001E;
goto U_100C;
L_001E:;
// 435 %RETURN %UNLESS CC(LENGTH-1)= 'C'+128
if (CC[LENGTH - 1] == 67 + 128) goto L_001F;
return;
L_001F:;
// 436 LENGTH=LENGTH-1
LENGTH = LENGTH - 1;
// 437 ->L2 %IF LIST=0
if (LIST != 0) goto L_0020;
goto U_100C;
L_0020:;
// 438 SPACES(5); PRINTSYMBOL('C'); SPACES(4*LEVEL); ->L2
_imp_SPACES(5);
_imp_PRINTSYMBOL(67);
_imp_SPACES(4 * LEVEL);
goto U_100C;
// 439 %END
} /* end of READLINE */
// ?NP unused
// 440 %ROUTINE FAULT(%BYTEINTEGER N)
void FAULT(unsigned char N) {
// 441 !%SHORTROUTINE
// 442 %INTEGER I,J,QP
int I;
int J;
int QP;
// 443 print string("
_imp_PRINTSTRING(_imp_str_literal("\n*"));
// 444+ *"); WRITE(LINE,4); I=3; I=3*LEVEL %IF LIST=0 ; SPACES(I)
_imp_WRITE(LINE, 4);
I = 3;
if (LIST != 0) goto L_0021;
I = 3 * LEVEL;
L_0021:;
_imp_SPACES(I);
// 445 FAULTY=FAULTY+1
FAULTY = FAULTY + 1;
// 446 ->L9 %IF N=100; print string("FAULT"); WRITE(N,2)
if (N != 100) goto L_0022;
goto U_100B;
L_0022:;
_imp_PRINTSTRING(_imp_str_literal("FAULT"));
_imp_WRITE(N, 2);
// 447 ->L2 %IF N<100; print string(" DISASTER ")
if (N >= 100) goto L_0023;
goto U_100C;
L_0023:;
_imp_PRINTSTRING(_imp_str_literal(" DISASTER "));
// 448 %MONITOR ; %STOP
/*_imp_monitor(__LINE__, __FILE__, PRETTY_FUNCTION);*/
_imp_stop(0);
// 449 L2: PRINTNAME(FNAME) %UNLESS 7#N#16; ->L99
U_100C:;
{
// Double-sided test on N (Part I)
unsigned char tmp;
if (7 == (tmp = N)) goto L_0024;
// Double-sided test on N (Part II)
if (tmp != 16) goto L_0025;
}
L_0024:;
PRINTNAME(FNAME);
L_0025:;
goto U_100D;
// 450 L9: print string(" SYNTAX ")
U_100B:;
_imp_PRINTSTRING(_imp_str_literal(" SYNTAX "));
// 451 ->L11 %IF LINE#OLDLINE
if (LINE == OLDLINE) goto L_0026;
goto U_100E;
L_0026:;
// 452 QP=Q
QP = Q;
// 453 %CYCLE Q=Q,1,LENGTH-1
// %for Q = Q, 1, LENGTH - 1 %cycle
{
int _initial = Q, _final = LENGTH - 1;
if (invalid_for_loop(_initial, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle Q = Q, 1, LENGTH - 1");
Q = _initial - (1);
L_0027:
if (Q == _final) goto L_0028;
Q += 1;
// ?Non-local
// 454 %IF CC(Q)&128 # 0 %THEN PRINTSYMBOL(CC(Q)&127-'A'+'a') %ELSE PRINTSYMBOL(CC(Q))
if (CC[Q] & 128 == 0) goto L_002A;
_imp_PRINTSYMBOL((CC[Q] & 127) - 65 + 97);
goto L_002B;
L_002A:;
_imp_PRINTSYMBOL(CC[Q]);
L_002B:;
// 455 ->L10 %IF CC(Q)=';'
if (CC[Q] != 59) goto L_002C;
goto U_100F;
L_002C:;
// 456 %REPEAT
goto L_0027;
}
L_0028:;
// 457 L10: Q =Q+1
U_100F:;
Q = Q + 1;
// 458 ->L99 %IF I+20+Q-QP>120
if (I + 20 + Q - QP <= 120) goto L_002D;
goto U_100D;
L_002D:;
// 459 NEWLINE; SPACES(I+QMAX-QP+17)
_imp_NEWLINE();
_imp_SPACES(I + QMAX - QP + 17);
// 460 PRINTSYMBOL('!')
_imp_PRINTSYMBOL(33);
// 461 NEWLINE
_imp_NEWLINE();
// 462 ->L99
goto U_100D;
// 463 L11: print string("
U_100E:;
_imp_PRINTSTRING(_imp_str_literal("\n TEXT MODE FAILURE "));
// 464+ TEXT MODE FAILURE "); WRITE(LINE-OLDLINE,1)
_imp_WRITE(LINE - OLDLINE, 1);
// 465 print string(" LINES LOST ")
_imp_PRINTSTRING(_imp_str_literal(" LINES LOST "));
// 466 NEWLINE; Q=QMAX
_imp_NEWLINE();
Q = QMAX;
// 467 L99: NEWLINE; %END
U_100D:;
_imp_NEWLINE();
return;
} /* end of FAULT */
// ?J unused
// 468 %ROUTINE COMPARE
void COMPARE(void) {
// 469 !%SHORTROUTINE
// 470 %INTEGER RA,RP,RQ,RR,RS,MARKER
int RA;
int RP;
int RQ;
int RR;
int RS;
int MARKER;
// 471 %SWITCH BIP(1000:1019)
int BIP_index;
int BIP_line;
char *BIP_file;
static const void *BIP[20] = {&&case_BIP_missing, &&case_BIP_missing, &&case_BIP_missing, &&case_BIP_missing,
&&case_BIP_missing, &&case_BIP_missing, &&case_BIP_missing, &&case_BIP_missing,
&&case_BIP_missing, &&case_BIP_missing, &&case_BIP_missing, &&case_BIP_missing,
&&case_BIP_missing, &&case_BIP_missing, &&case_BIP_missing, &&case_BIP_missing,
&&case_BIP_missing, &&case_BIP_missing, &&case_BIP_missing, &&case_BIP_missing};
// 472 RP=SYMBOL(P)
RP = SYMBOL[P - 1300];
// 473 RQ=Q; RR=R; ! RESET VALUES OF LINE&AR PTRS
RQ = Q;
RR = R;
// 474 A(R)=1; ! FIRST ALTERNATIVE TO BE TRIED
A[R + 2] = 1;
// 475 P=P+1; RA=SYMBOL(P); RS=P; ! RA TO NEXT PHRASE ALTERNATIVE
P = P + 1;
RA = SYMBOL[P - 1300];
RS = P;
// 476 %COMMENT ROUTINE REALLY STARTS HERE
// 477 L1: R=R+1
U_100E:;
R = R + 1;
// 478 BIP(1000):L2: ! SUCCESS ON TO NEXT ITEM
case_BIP_1000:;
U_100F:;
// 479 RS=RS+1; ->L8 %IF RS=RA; ! RS=NEXT ALTERNATIVE MEANS THAT
RS = RS + 1;
if (RS != RA) goto L_002F;
goto U_1010;
L_002F:;
// 480 ! THIS ALT HAS BEEN COMPLETED SO
// 481 ! EXIT WITH HIT=1
// 482 ITEM=SYMBOL(RS); ! NEXT BRICK IN THE CURRENT ALT
ITEM = SYMBOL[RS - 1300];
// 483 ->L4 %IF ITEM>=1300; ! BRICK IS A PHRASE TYPE
if (ITEM < 1300) goto L_0030;
goto U_1011;
L_0030:;
// 484 ->L6 %IF ITEM>=1000; ! BRICK IS BUILT IN PHRASE
if (ITEM < 1000) goto L_0031;
goto U_1012;
L_0031:;
// 485 %CYCLE J=1,1,CLETT(ITEM);
// %for J = 1, 1, CLETT[ITEM - 1] %cycle
{
int _final = CLETT[ITEM - 1];
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle J = 1, 1, CLETT[ITEM - 1]");
J = 0;
L_0032:
if (J == _final) goto L_0033;
J += 1;
// ?Non-local
// 486 ; ! BRICK IS LITERAL
if (CC[Q] == CLETT[J + ITEM - 1]) goto L_0034;
goto U_1013;
L_0034:;
// 486 ->L3 %UNLESS CC(Q)=CLETT(J+ITEM)
// 487 Q=Q+1; %REPEAT; !CHECK IT WITH LITERAL DICT ENTRY
Q = Q + 1;
goto L_0032;
}
L_0033:;
// 488 ->L2; ! MATCHED SUCCESSFULLY
goto U_100F;
// 489 L4: ! PHRASE TYPE ALTERNATE
U_1011:;
// 490 P=ITEM; COMPARE; ! RCALL COMPARE TO RECOGNISE IT
P = ITEM;
COMPARE();
// 491 ->L2 %IF HIT#0; ! FOUND
if (HIT == 0) goto L_0035;
goto U_100F;
L_0035:;
// 492 L3: QMAX=Q %IF Q>QMAX; ! FAILURE - NOTE POSITION REACHD
U_1013:;
if (Q <= QMAX) goto L_0036;
QMAX = Q;
L_0036:;
// 493 Q=RQ; R=RR; ! RESET LINE AND A.R. POINTERS
Q = RQ;
R = RR;
// 494 ->L7 %IF RA=RP; !TOTAL FAILURE NO ALT LEFT TO TRY
if (RA != RP) goto L_0037;
goto U_1014;
L_0037:;
// 495 RS=RA; A(R)=A(R)+1; ! MOVE TO NEXT ALT OF PHRASE
RS = RA;
A[R + 2] = A[R + 2] + 1;
// 496 RA=SYMBOL(RA); ->L1
RA = SYMBOL[RA - 1300];
goto U_100E;
// 497 L8: ! COMPLETE SUCCESS
U_1010:;
// 498 HIT=1; %RETURN
HIT = 1;
return;
// 499 L7: ! UTTER FAILURE
U_1014:;
// 500 HIT=0; %RETURN
HIT = 0;
return;
// 501 L6: ! BUILT IN PHRASE
U_1012:;
// 502 I=CC(Q); ->BIP(ITEM); ! SO SWITCH TO IT
I = CC[Q];
BIP_line = __LINE__;
BIP_file = __FILE__;
BIP_index = ITEM;
goto case_BIP_dispatch;
// 503 BIP(1001): ! PHRASE NAME
case_BIP_1001:;
// 504 PNAME; ->L1 %IF HIT=1; ->L3
PNAME();
if (HIT != 1) goto L_0038;
goto U_100E;
L_0038:;
goto U_1013;
// 505 BIP(1002): ! PHRASE U/CODE INSRN
case_BIP_1002:;
// 506 ->L3 %UNLESS 'A'<=I<='Z'
{
// Double-sided test on I (Part I)
int tmp;
if (65 > (tmp = I)) goto L_0029;
// Double-sided test on I (Part II)
if (tmp <= 90) goto L_0039;
}
L_0029:;
goto U_1013;
L_0039:;
// 507 S=I; J=1
S = I;
J = 1;
// 508 L200: Q=Q+1; I=CC(Q)
U_1015:;
Q = Q + 1;
I = CC[Q];
// 509 ->L201 %UNLESS 'A'<=I<='Z'
{
// Double-sided test on I (Part I)
int tmp;
if (65 > (tmp = I)) goto L_003A;
// Double-sided test on I (Part II)
if (tmp <= 90) goto L_003B;
}
L_003A:;
goto U_1016;
L_003B:;
// 510 S=S<<8!I;J=J+1; ->L200
S = S << 8 | I;
J = J + 1;
goto U_1015;
// 511 L201: ->L3 %UNLESS I='_' %AND J<=4
U_1016:;
if (I != 95) goto L_003C;
if (J <= 4) goto L_003D;
L_003C:;
goto U_1013;
L_003D:;
// 512 Q=Q+1; ->L2
Q = Q + 1;
goto U_100F;
// 513 BIP(1003): ! PHRASE CONST
case_BIP_1003:;
// 514 CONST(0)
CONST(0);
// 515 ->L3 %IF HIT=0
if (HIT != 0) goto L_003E;
goto U_1013;
L_003E:;
// 516 ->L1 %IF CTYPE=5
if (CTYPE != 5) goto L_003F;
goto U_100E;
L_003F:;
// 517 ->L26 %IF CTYPE=2; ! %REAL
if (CTYPE != 2) goto L_0040;
goto U_1017;
L_0040:;
// 518 ->L22 %IF S>>12=0
if ((unsigned int)S >> 12 != 0) goto L_0041;
goto U_1018;
L_0041:;
// 519 A(R)=1
A[R + 2] = 1;
// 520 TOAR4(R+1,S); R=R+3; ->L2
TOAR4(R + 1, S);
R = R + 3;
goto U_100F;
// 521 L22: A(R)=9; R=R+1; A(R)=S; ->L1
U_1018:;
A[R + 2] = 9;
R = R + 1;
A[R + 2] = S;
goto U_100E;
// 522 L26: A(R)=2; TOAR8(R+1,CVALUE); R=R+5; ->L2
U_1017:;
A[R + 2] = 2;
TOAR8(R + 1, CVALUE);
R = R + 5;
goto U_100F;
// 523 BIP(1005): ! PHRASE N
case_BIP_1005:;
// 524 ->L3 %UNLESS '0'<=I<='9'; ! MUST START WITH DIGIT
{
// Double-sided test on I (Part I)
int tmp;
if (48 > (tmp = I)) goto L_0042;
// Double-sided test on I (Part II)
if (tmp <= 57) goto L_0043;
}
L_0042:;
goto U_1013;
L_0043:;
// 525 CONST(2); A(R)=S; ->L1
CONST(2);
A[R + 2] = S;
goto U_100E;
// 526 BIP(1004): ! PHRASE CONSTLIST
case_BIP_1004:;
// 527 CONSTLIST;->L1
CONSTLIST();
goto U_100E;
// 528 BIP(1006): ! PHRASE S=SEPARATOR
case_BIP_1006:;
// 529 ->L2 %IF I=10
if (I != 10) goto L_0044;
goto U_100F;
L_0044:;
// 530 ->L3 %UNLESS I=';'
if (I == 59) goto L_0045;
goto U_1013;
L_0045:;
// 531 Q=Q+1; ->L2
Q = Q + 1;
goto U_100F;
// 532 BIP(1007):L30: ! PHRASE TEXT=COMMENT TEXT
case_BIP_1007:;
U_1019:;
// 533 ->L1 %UNLESS 10#I#';'
{
// Double-sided test on I (Part I)
int tmp;
if (10 == (tmp = I)) goto L_0046;
// Double-sided test on I (Part II)
if (tmp != 59) goto L_0047;
}
L_0046:;
goto U_100E;
L_0047:;
// 534 Q=Q+1; I=CC(Q); ->L30
Q = Q + 1;
I = CC[Q];
goto U_1019;
// 535 BIP(1008): ! PHRASE TEXTTEXT=BETWEEN QUOTES
case_BIP_1008:;
// 536 TEXTTEXT
TEXTTEXT();
// 537 ->L3 %IF HIT=0;->L1
if (HIT != 0) goto L_0048;
goto U_1013;
L_0048:;
goto U_100E;
// 538 BIP(1009): ! PHRASE NAMELIST
case_BIP_1009:;
// 539 ! GIVES AR IN FORM NNAMES,NAME1,....NAMEN
// 540 U=R; V=1; R=R+1
U = R;
V = 1;
R = R + 1;
// 541 PNAME; ->L3 %IF HIT=0
PNAME();
if (HIT != 0) goto L_0049;
goto U_1013;
L_0049:;
// 542 L90: ->L91 %UNLESS CC(Q)=','
U_101A:;
if (CC[Q] == 44) goto L_004A;
goto U_101B;
L_004A:;
// 543 Q=Q+1; R=R+1
Q = Q + 1;
R = R + 1;
// 544 I=CC(Q)
I = CC[Q];
// 545 PNAME
PNAME();
// 546 ->L92 %IF HIT=0; V=V+1; ->L90
if (HIT != 0) goto L_004B;
goto U_101C;
L_004B:;
V = V + 1;
goto U_101A;
// 547 L92: R=R-1; Q=Q-1
U_101C:;
R = R - 1;
Q = Q - 1;
// 548 L91: A(U)=V; ->L1
U_101B:;
A[U + 2] = V;
goto U_100E;
// 549 BIP(1010): ! PHRASE HOLE
case_BIP_1010:;
// 550 MARKER=R; ->L1
MARKER = R;
goto U_100E;
// 551 BIP(1011): ! PHRASE MARK
case_BIP_1011:;
// 552 A(MARKER)=R-MARKER; ->L2
A[MARKER + 2] = R - MARKER;
goto U_100F;
// 553 BIP(1012): ! PHRASE UCRR=RR FORMAT
case_BIP_1012:;
// 554 ->L124 %IF S&255='R'; ! LAST LETTER=R
if (S & 255 != 82) goto L_004C;
goto U_101D;
L_004C:;
// 555 %CYCLE I=0,1,2
// %for I = 0, 1, 2 %cycle
{
I = -1;
L_004D:
if (I == 2) goto L_004E;
I += 1;
// ?Non-local
// 556 ->L120 %IF S=NEM(I)
if (S != NEM[I]) goto L_0050;
goto U_101E;
L_0050:;
// 557 %REPEAT; ->L3
goto L_004D;
}
L_004E:;
goto U_1013;
// 558 L120: A(R)=OPC(I)&63; ->L1
U_101E:;
A[R + 2] = OPC[I] & 63;
goto U_100E;
// 559 L124: J=S>>8; %CYCLE I=2,1,48
U_101D:;
J = (unsigned int)S >> 8;
// %for I = 2, 1, 48 %cycle
{
I = 1;
L_0051:
if (I == 48) goto L_0052;
I += 1;
// ?Non-local
// 560 ->L120 %IF J=NEM(I)
if (J != NEM[I]) goto L_0053;
goto U_101E;
L_0053:;
// 561 %REPEAT; ->L3
goto L_0051;
}
L_0052:;
goto U_1013;
// 562 BIP(1013): ! PHRASE UCRX=RX FORMAT
case_BIP_1013:;
// 563 %CYCLE I=18,1,64
// %for I = 18, 1, 64 %cycle
{
I = 17;
L_0054:
if (I == 64) goto L_0055;
I += 1;
// ?Non-local
// 564 ->L130 %IF S=NEM(I)
if (S != NEM[I]) goto L_0056;
goto U_101F;
L_0056:;
// 565 %REPEAT; ->L3
goto L_0054;
}
L_0055:;
goto U_1013;
// 566 L130: A(R)=OPC(I); ->L1
U_101F:;
A[R + 2] = OPC[I];
goto U_100E;
// 567 BIP(1014): ! PHRASE UCRS=R,R,DB FORMAT
case_BIP_1014:;
// 568 %CYCLE I=66,1,69
// %for I = 66, 1, 69 %cycle
{
I = 65;
L_0057:
if (I == 69) goto L_0058;
I += 1;
// ?Non-local
// 569 ->L130 %IF S=NEM(I)
if (S != NEM[I]) goto L_0059;
goto U_101F;
L_0059:;
// 570 %REPEAT; ->L3
goto L_0057;
}
L_0058:;
goto U_1013;
// 571 BIP(1015): ! PHRASE UCSI=STORE IMDTE
case_BIP_1015:;
// 572 %CYCLE I=71,1,83
// %for I = 71, 1, 83 %cycle
{
I = 70;
L_005A:
if (I == 83) goto L_005B;
I += 1;
// ?Non-local
// 573 ->L130 %IF S=NEM(I)
if (S != NEM[I]) goto L_005C;
goto U_101F;
L_005C:;
// 574 %REPEAT; ->L3
goto L_005A;
}
L_005B:;
goto U_1013;
// 575 BIP(1016): ! PHRASE UCSHIFT=SHIFT INSTRNS
case_BIP_1016:;
// 576 %CYCLE I=85,1,92
// %for I = 85, 1, 92 %cycle
{
I = 84;
L_005D:
if (I == 92) goto L_005E;
I += 1;
// ?Non-local
// 577 ->L130 %IF S=NEM(I)
if (S != NEM[I]) goto L_005F;
goto U_101F;
L_005F:;
// 578 %REPEAT; ->L3
goto L_005D;
}
L_005E:;
goto U_1013;
// 579 BIP(1017): ! PHRASE UCSS=STORE TO STORE
case_BIP_1017:;
// 580 %CYCLE I=94,1,106
// %for I = 94, 1, 106 %cycle
{
I = 93;
L_0060:
if (I == 106) goto L_0061;
I += 1;
// ?Non-local
// 581 ->L130 %IF S=NEM(I)
if (S != NEM[I]) goto L_0062;
goto U_101F;
L_0062:;
// 582 %REPEAT; ->L3
goto L_0060;
}
L_0061:;
goto U_1013;
// 583 BIP(1018): ! PHRASE UCPD=PACKED DECIMAL
case_BIP_1018:;
// 584 %CYCLE I=108,1,116
// %for I = 108, 1, 116 %cycle
{
I = 107;
L_0063:
if (I == 116) goto L_0064;
I += 1;
// ?Non-local
// 585 ->L130 %IF S=NEM(I)
if (S != NEM[I]) goto L_0065;
goto U_101F;
L_0065:;
// 586 %REPEAT; ->L3
goto L_0063;
}
L_0064:;
goto U_1013;
// 587 BIP(1019): ! PHRASE UCSPEC=THE FUNNIES
case_BIP_1019:;
// 588 %CYCLE I=118,1,120
// %for I = 118, 1, 120 %cycle
{
I = 117;
L_0066:
if (I == 120) goto L_0067;
I += 1;
// ?Non-local
// 589 ->L130 %IF S=NEM(I)
if (S != NEM[I]) goto L_0068;
goto U_101F;
L_0068:;
// 590 %REPEAT; ->L3
goto L_0066;
}
L_0067:;
goto U_1013;
// 591 %END ;!OF ROUTINE 'COMPARE'
case_BIP_dispatch:
if (BIP_index < 1000 || BIP_index > 1019)
_imp_signalf(6, 3, BIP_index, "->BIP(%d) out of bounds at %s line %d", BIP_index, BIP_file, BIP_line);
goto *BIP[BIP_index - 1000];
case_BIP_missing:
_imp_signalf(8, 2, BIP_index, "switch jump to undefined label BIP(%d): at %s line %d", BIP_index, BIP_file,
BIP_line);
} /* end of COMPARE */
// 592 %INTEGERFN HASH(%INTEGER ADDR)
int HASH(int ADDR) {
// 593 %RESULT=NNAMES &(19*BYTE INTEGER(ADDR)+31*BYTE INTEGER(ADDR+1))
return NNAMES & 19 * *_imp_BYTEINTEGER(ADDR) + 31 * *_imp_BYTEINTEGER(ADDR + 1);
// 594 %END
} /* end of HASH */
// 595 %ROUTINE PNAME
void PNAME(void) {
// 596 %INTEGER JJ,KK,LL
int JJ;
int KK;
int LL;
// 597 !%SHORTROUTINE
// 598 HIT=0; I=CC(Q)
HIT = 0;
I = CC[Q];
// 599 ->L3 %UNLESS 'A'<=I<='Z'; ! 1ST CHAR MUST BE LETTER
{
// Double-sided test on I (Part I)
int tmp;
if (65 > (tmp = I)) goto L_004F;
// Double-sided test on I (Part II)
if (tmp <= 90) goto L_0069;
}
L_004F:;
goto U_100B;
L_0069:;
// 600 ->L3 %IF CC(Q+1)='''' %AND(I='B' %OR I='X' %OR I='M')
if (CC[Q + 1] != 39) goto L_006A;
if (I == 66) goto L_006B;
if (I == 88) goto L_006B;
if (I != 77) goto L_006A;
L_006B:;
goto U_100B;
L_006A:;
// 601 S=2; T=1; ->L10
S = 2;
T = 1;
goto U_100C;
// 602 L12: Q=Q+1; I=CC(Q)
U_100D:;
Q = Q + 1;
I = CC[Q];
// 603 ->L101 %UNLESS 'A'<=I<='Z' %OR '0'<=I<='9'
{
// Double-sided test on I (Part I)
int tmp;
if (65 > (tmp = I)) goto L_006C;
// Double-sided test on I (Part II)
if (tmp <= 90) goto L_006D;
}
L_006C:;
{
// Double-sided test on I (Part I)
int tmp;
if (48 > (tmp = I)) goto L_006E;
// Double-sided test on I (Part II)
if (tmp <= 57) goto L_006D;
}
L_006E:;
goto U_100E;
L_006D:;
// 604 T=T+1; S=S+1
T = T + 1;
S = S + 1;
// 605 L10: LETT(NEXT+T)=I; ->L12
U_100C:;
LETT[NEXT + T] = I;
goto U_100D;
// 606 L101: LETT(NEXT)=T; ! INSERT LENGTH
U_100E:;
LETT[NEXT] = T;
// 607 FAULT(108) %IF NEXT+S>DSIZE; !DICTIONARY OVERFLOW
if (NEXT + S <= DSIZE) goto L_006F;
FAULT(108);
L_006F:;
// 608 JJ=HASH(ADDR(LETT(NEXT))); !PREPARE TO LOOK UP
JJ = HASH(_imp_ADDR(/*?*/ &LETT[NEXT]));
// 609 %CYCLE NUM=JJ,1,JJ+NNAMES
// %for NUM = JJ, 1, JJ + NNAMES %cycle
{
int _initial = JJ, _final = JJ + NNAMES;
if (invalid_for_loop(_initial, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle NUM = JJ, 1, JJ + NNAMES");
NUM = _initial - (1);
L_0070:
if (NUM == _final) goto L_0071;
NUM += 1;
// ?Non-local
// 610 KK=NUM&NNAMES; ! TREAT DICTIONARY AS CYCLIC
KK = NUM & NNAMES;
// 611 LL=WORD(KK)
LL = WORD[KK];
// 612 ->L2 %IF LL=0; ! NAME NOT KNOWN
if (LL != 0) goto L_0073;
goto U_100F;
L_0073:;
// 613 %CYCLE JJ=1,1,LETT(LL)
// %for JJ = 1, 1, LETT[LL] %cycle
{
int _final = LETT[LL];
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle JJ = 1, 1, LETT[LL]");
JJ = 0;
L_0074:
if (JJ == _final) goto L_0075;
JJ += 1;
// 614 ->FAIL %UNLESS LETT(NEXT+JJ)=LETT(LL+JJ)
if (LETT[NEXT + JJ] == LETT[LL + JJ]) goto L_0077;
goto U_1010;
L_0077:;
// 615 %REPEAT; ->L41; ! NAME FOUND
goto L_0074;
}
L_0075:;
goto U_1011;
// 616 FAIL: %REPEAT
U_1010:;
goto L_0070;
}
L_0071:;
// 617 FAULT(104); ! TOO MANY NAMES
FAULT(104);
// 618 L2: WORD(KK)=NEXT; NEXT=NEXT+S
U_100F:;
WORD[KK] = NEXT;
NEXT = NEXT + S;
// 619 L41: A(R)=KK; HIT=1
U_1011:;
A[R + 2] = KK;
HIT = 1;
// 620 L3: %END
U_100B:;
return;
} /* end of PNAME */
// 621 %ROUTINE CONST(%BYTEINTEGER MODE)
void CONST(unsigned char MODE) {
// 622 %COMMENT MODE=0 FOR NORMAL MODE=2 FOR EXPONENT ETC
// 623 %INTEGER Z
int Z;
// 624 %LONGREAL X
double X;
// 625 CVALUE=0; I=CC(Q)
CVALUE = 0;
I = CC[Q];
// 626 !%SHORTROUTINE
// 627 S=0; ->N %IF '0'<=I<='9'
S = 0;
{
// Double-sided test on I (Part I)
int tmp;
if (48 > (tmp = I)) goto L_0078;
// Double-sided test on I (Part II)
if (tmp > 57) goto L_0078;
}
goto U_100B;
L_0078:;
// 628 ->DOT %IF I='.' %AND MODE=0 %AND '0'<=CC(Q+1)<='9';! 1 DIDT MIN
if (I != 46) goto L_0079;
if (MODE != 0) goto L_0079;
{
// Double-sided test on CC[Q + 1] (Part I)
unsigned char tmp;
if (48 > (tmp = CC[Q + 1])) goto L_0079;
// Double-sided test on CC[Q + 1] (Part II)
if (tmp > 57) goto L_0079;
}
goto U_100C;
L_0079:;
// 629 ->PI %IF I='$' %AND MODE=0;! PI was represented back then by the character which now prints as '$'!
if (I != 36) goto L_007A;
if (MODE != 0) goto L_007A;
goto U_100D;
L_007A:;
// 630 ->L101 %IF I=''''
if (I != 39) goto L_007B;
goto U_100E;
L_007B:;
// 631 ->L150 %UNLESS CC(Q+1)=''''; Q=Q+2
if (CC[Q + 1] == 39) goto L_007C;
goto U_100F;
L_007C:;
Q = Q + 2;
// 632 ->L102 %IF I='X'; ->MULT %IF I='M'
if (I != 88) goto L_007D;
goto U_1010;
L_007D:;
if (I != 77) goto L_007E;
goto U_1011;
L_007E:;
// 633 ->L104 %IF I='B'
if (I != 66) goto L_007F;
goto U_1012;
L_007F:;
// 634 Q=Q-2; ->L150
Q = Q - 2;
goto U_100F;
// 635 PI:
U_100D:;
// 636 CVALUE=3.14159 26535 89793 23846; Q=Q+1; ->L40
CVALUE = 3.14159265358979323846;
Q = Q + 1;
goto U_1013;
// 637 L101: S=R; A(R)=5; R=R+1
U_100E:;
S = R;
A[R + 2] = 5;
R = R + 1;
// 638 TEXTTEXT
TEXTTEXT();
// 639 ->L24 %IF A(S+1)=0; ! NULL STRING
if (A[S + 1 + 2] != 0) goto L_0080;
goto U_1014;
L_0080:;
// 640 ->L27 %IF A(S+1)=1; ! SINGLE CHAR CONSTANT
if (A[S + 1 + 2] != 1) goto L_0081;
goto U_1015;
L_0081:;
// 641 CTYPE=5; %RETURN
CTYPE = 5;
return;
// 642 L24: R=S; S=0; ->L99
U_1014:;
R = S;
S = 0;
goto U_1016;
// 643 L27: R=S; S=A(S+2); ->L99
U_1015:;
R = S;
S = A[S + 2 + 2];
goto U_1016;
// 644 L102: I=CC(Q); Q=Q+1; ! HEX CONSTANTS
U_1010:;
I = CC[Q];
Q = Q + 1;
// 645 ->L99 %IF I=''''
if (I != 39) goto L_0082;
goto U_1016;
L_0082:;
// 646 ->L5 %IF '0'<=I<='9'
{
// Double-sided test on I (Part I)
int tmp;
if (48 > (tmp = I)) goto L_0083;
// Double-sided test on I (Part II)
if (tmp > 57) goto L_0083;
}
goto U_1017;
L_0083:;
// 647 ->L150 %UNLESS 'A'<=I<='F'
{
// Double-sided test on I (Part I)
int tmp;
if (65 > (tmp = I)) goto L_0072;
// Double-sided test on I (Part II)
if (tmp <= 70) goto L_0084;
}
L_0072:;
goto U_100F;
L_0084:;
// 648 S=S<<4!(I-'A'+10); ->L102
S = S << 4 | I - 65 + 10;
goto U_1010;
// 649 L5: S=S<<4!(I-'0'); ->L102
U_1017:;
S = S << 4 | I - 48;
goto U_1010;
// 650 MULT: T=0; ! MULTIPLE CONSTANTS
U_1011:;
T = 0;
// 651 L28: I=CC(Q); Q=Q+1; ->L22 %IF I=''''
U_1018:;
I = CC[Q];
Q = Q + 1;
if (I != 39) goto L_0085;
goto U_1019;
L_0085:;
// 652 L29: S=S<<8!I; T=T+1; ->L150 %IF T>=5; ->L28
U_101A:;
S = S << 8 | I;
T = T + 1;
if (T < 5) goto L_0086;
goto U_100F;
L_0086:;
goto U_1018;
// 653 L22: ->L99 %UNLESS CC(Q)=''''; Q=Q+1; ->L29
U_1019:;
if (CC[Q] == 39) goto L_0087;
goto U_1016;
L_0087:;
Q = Q + 1;
goto U_101A;
// 654 L104: T=Q; ! BINARY CONST
U_1012:;
T = Q;
// 655 L32: I=CC(Q); Q=Q+1
U_101B:;
I = CC[Q];
Q = Q + 1;
// 656 ->L31 %IF '1'#I#'0'
{
// Double-sided test on I (Part I)
int tmp;
if (49 == (tmp = I)) goto L_0088;
// Double-sided test on I (Part II)
if (tmp == 48) goto L_0088;
}
goto U_101C;
L_0088:;
// 657 S=S<<1!(I-'0')
S = S << 1 | I - 48;
// 658 ->L150 %IF Q-T>=33; ->L32
if (Q - T < 33) goto L_0089;
goto U_100F;
L_0089:;
goto U_101B;
// 659 L31: ->L99 %IF I=''''; ->L150
U_101C:;
if (I != 39) goto L_008A;
goto U_1016;
L_008A:;
goto U_100F;
// 660 N: I=I&15; CVALUE=10*CVALUE+I
U_100B:;
I = I & 15;
CVALUE = 10 * CVALUE + I;
// 661 Q=Q+1; I=CC(Q)
Q = Q + 1;
I = CC[Q];
// 662 ->N %IF '0'<=I<='9'
{
// Double-sided test on I (Part I)
int tmp;
if (48 > (tmp = I)) goto L_008B;
// Double-sided test on I (Part II)
if (tmp > 57) goto L_008B;
}
goto U_100B;
L_008B:;
// 663 ->ALPHA %UNLESS MODE=0 %AND I='.'
if (MODE != 0) goto L_008C;
if (I == 46) goto L_008D;
L_008C:;
goto U_101D;
L_008D:;
// 664 DOT: Q=Q+1; X=10
U_100C:;
Q = Q + 1;
X = 10;
// 665 L45: I=CC(Q); ->ALPHA %UNLESS '0'<=I<='9'
U_101E:;
I = CC[Q];
{
// Double-sided test on I (Part I)
int tmp;
if (48 > (tmp = I)) goto L_008E;
// Double-sided test on I (Part II)
if (tmp <= 57) goto L_008F;
}
L_008E:;
goto U_101D;
L_008F:;
// 666 I=I&15; CVALUE=CVALUE+I/X
I = I & 15;
CVALUE = CVALUE + (double)(I / X);
// 667 X=10*X
X = 10 * X;
// 668 Q=Q+1; ->L45
Q = Q + 1;
goto U_101E;
// 669 ALPHA: %COMMENT TEST FOR EXPONENT
U_101D:;
// 670 ->FIX %UNLESS MODE=0 %AND CC(Q)='@'
if (MODE != 0) goto L_0090;
if (CC[Q] == 64) goto L_0091;
L_0090:;
goto U_101F;
L_0091:;
// 671 Q=Q+1; X=CVALUE
Q = Q + 1;
X = CVALUE;
// 672 Z=1; ->L39 %IF '+'#CC(Q)#'-'
Z = 1;
{
// Double-sided test on CC[Q] (Part I)
unsigned char tmp;
if (43 == (tmp = CC[Q])) goto L_0092;
// Double-sided test on CC[Q] (Part II)
if (tmp == 45) goto L_0092;
}
goto U_1020;
L_0092:;
// 673 Z=-1 %IF CC(Q)='-'; Q=Q+1
if (CC[Q] != 45) goto L_0093;
Z = -1;
L_0093:;
Q = Q + 1;
// 674 L39: CONST(2); ->L150 %IF HIT=0; S=S*Z
U_1020:;
CONST(2);
if (HIT != 0) goto L_0094;
goto U_100F;
L_0094:;
S = S * Z;
// 675 %IF S=-99 %THEN CVALUE=0 %ELSE CVALUE=X*10^^S
if (S != -99) goto L_0095;
CVALUE = 0;
goto L_0096;
L_0095:;
CVALUE = X * (_imp_IEXP(10, S));
L_0096:;
// 676 FIX: %COMMENT SEE IF IT IS INTEGER
U_101F:;
// 677 ->L40 %IF CVALUE>IMAX; ! TOO BIG
if (CVALUE <= IMAX) goto L_0097;
goto U_1013;
L_0097:;
// 678 ->L41 %IF {FRACPT(CVALUE)=0}INTPT(CVALUE)=CVALUE
if (_imp_INTPT(CVALUE) != CVALUE) goto L_0098;
goto U_1021;
L_0098:;
// 679 L40: CTYPE=2; HIT=1; %RETURN
U_1013:;
CTYPE = 2;
HIT = 1;
return;
// 680 L41: S=INT(CVALUE)
U_1021:;
S = _imp_INT(CVALUE);
// 681 L99: CTYPE=1; HIT=1; %RETURN
U_1016:;
CTYPE = 1;
HIT = 1;
return;
// 682 L150: HIT=0; ! FAILURE
U_100F:;
HIT = 0;
// 683 %END
return;
} /* end of CONST */
// 684 %ROUTINE CONSTLIST
void CONSTLIST(void) {
// 685 !%SHORTROUTINE
// 686 %INTEGER PRECP,NCONST,RF,J,K,CPW
int PRECP;
int NCONST;
int RF;
int J;
int K;
int CPW;
// 687 %INTEGER KK,SIGN,SP,RQ,VALUE
int KK;
int SIGN;
int SP;
int RQ;
int VALUE;
// 688 %INTEGER TYPEP,ACC,RP,N,JJ
int TYPEP;
int ACC;
int RP;
int N;
int JJ;
// 689 %LONGREAL C
double C;
// 690 VALUE=0; NCONST=0
VALUE = 0;
NCONST = 0;
// 691 %IF CONSTPTR&1#0 %THEN PSYM(0)
if (CONSTPTR & 1 == 0) goto L_0099;
PSYM(0);
L_0099:;
// 692 A(R+1)=CONSTPTR
A[R + 1 + 2] = CONSTPTR;
// 693 RP=R; R=R+2; ACC=0; N=24
RP = R;
R = R + 2;
ACC = 0;
N = 24;
// 694 TYPEP=TYPEFLAG(A(2)); PRECP=TYPEP>>3
TYPEP = TYPEFLAG[A[4] - 1];
PRECP = (unsigned int)TYPEP >> 3;
// 695 TYPEP=TYPEP&7
TYPEP = TYPEP & 7;
// 696 %IF TYPEP=5 %THEN ACC=A(4)
if (TYPEP != 5) goto L_009A;
ACC = A[6];
L_009A:;
// 697 PRECP=3 %IF TYPEP=2 %AND ALL LONG=1
if (TYPEP != 2) goto L_009B;
if (ALLLONG != 1) goto L_009B;
PRECP = 3;
L_009B:;
// 698 CPW=4//BYTES(PRECP)
CPW = ((long)4 / (long)BYTES[PRECP]);
// 699 CPW=4 %IF TYPEP=5
if (TYPEP != 5) goto L_009C;
CPW = 4;
L_009C:;
// 700 L6: RQ=Q; I=CC(Q); SIGN=1; ->L7 %IF I='-'
U_1019:;
RQ = Q;
I = CC[Q];
SIGN = 1;
if (I != 45) goto L_009D;
goto U_101A;
L_009D:;
// 701 ->L8 %IF I='+'; ->L9
if (I != 43) goto L_009E;
goto U_101B;
L_009E:;
goto U_101C;
// 702 L7: SIGN=-1; ->L99 %IF CPW=4
U_101A:;
SIGN = -1;
if (CPW != 4) goto L_009F;
goto U_101D;
L_009F:;
// 703 L8: Q=Q+1; I=CC(Q)
U_101B:;
Q = Q + 1;
I = CC[Q];
// 704 L9: CONST(0); RF=1
U_101C:;
CONST(0);
RF = 1;
// 705 ->L98 %IF HIT=0
if (HIT != 0) goto L_00A0;
goto U_101E;
L_00A0:;
// 706 ->L1 %UNLESS CC(Q)='('
if (CC[Q] == 40) goto L_00A1;
goto U_101F;
L_00A1:;
// 707 J=S; Q=Q+1; C=CVALUE
J = S;
Q = Q + 1;
C = CVALUE;
// 708 CONST(2); ->L98 %UNLESS HIT=1 %AND S>0 %AND CC(Q)=')'
CONST(2);
if (HIT != 1) goto L_00A2;
if (S <= 0) goto L_00A2;
if (CC[Q] == 41) goto L_00A3;
L_00A2:;
goto U_101E;
L_00A3:;
// 709 Q=Q+1
Q = Q + 1;
// 710 CVALUE=C; RF=S; S=J
CVALUE = C;
RF = S;
S = J;
// 711 L1: ->L21 %IF TYPEP=2
U_101F:;
if (TYPEP != 2) goto L_00A4;
goto U_1020;
L_00A4:;
// 712 ->L51 %IF TYPEP=5
if (TYPEP != 5) goto L_00A5;
goto U_1021;
L_00A5:;
// 713 ->L99 %IF CPW=4 %AND S>255
if (CPW != 4) goto L_00A6;
if (S <= 255) goto L_00A6;
goto U_101D;
L_00A6:;
// 714 ->L99 %IF CPW=2 %AND |S|>>16#0;! SHORT TOO LARGE
if (CPW != 2) goto L_00A7;
if ((unsigned int)_imp_IMOD(S) >> 16 == 0) goto L_00A7;
goto U_101D;
L_00A7:;
// 715 S=S*SIGN
S = S * SIGN;
// 716 S=S&X'FFFF' %IF CPW=2
if (CPW != 2) goto L_00A8;
S = S & 65535;
L_00A8:;
// 717 %CYCLE KK=1,1,RF
// %for KK = 1, 1, RF %cycle
{
int _final = RF;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle KK = 1, 1, RF");
KK = 0;
L_00A9:
if (KK == _final) goto L_00AA;
KK += 1;
// 718 J=NCONST//CPW
J = ((long)NCONST / (long)CPW);
// 719 K=NCONST-CPW*J
K = NCONST - CPW * J;
// 720 SP=S<<(32*(CPW-K-1)//CPW)
SP = S << ((long)(32 * (CPW - K - 1)) / (long)CPW);
// 721 VALUE=SP!VALUE
VALUE = SP | VALUE;
// 722 NCONST=NCONST+1
NCONST = NCONST + 1;
// 723 ->L5 %UNLESS (CPW-1)&NCONST=0
if (CPW - 1 & NCONST == 0) goto L_00AC;
goto U_1022;
L_00AC:;
// 724 PSYM(VALUE); VALUE=0
PSYM(VALUE);
VALUE = 0;
// 725 L5: %REPEAT
U_1022:;
goto L_00A9;
}
L_00AA:;
// 726 L11: ->L99 %UNLESS CC(Q)=','; Q=Q+1
U_1023:;
if (CC[Q] == 44) goto L_00AD;
goto U_101D;
L_00AD:;
Q = Q + 1;
// 727 ->L6 %UNLESS CC(Q)=10
if (CC[Q] == 10) goto L_00AE;
goto U_1019;
L_00AE:;
// 728 READLINE(0); Q=1; ->L6
READLINE(0);
Q = 1;
goto U_1019;
// 729 L21: %IF CTYPE=1 %THEN CVALUE=S
U_1020:;
if (CTYPE != 1) goto L_00AF;
CVALUE = S;
L_00AF:;
// 730 CVALUE=SIGN*CVALUE
CVALUE = SIGN * CVALUE;
// 731 J=INTEGER(ADDR(CVALUE))
J = *_imp_INTEGER(_imp_ADDR(/*?*/ &CVALUE));
// 732 K=INTEGER(ADDR(CVALUE)+4)
K = *_imp_INTEGER(_imp_ADDR(/*?*/ &CVALUE) + 4);
// 733 %CYCLE KK=1,1,RF; NCONST=NCONST+1
// %for KK = 1, 1, RF %cycle
{
int _final = RF;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle KK = 1, 1, RF");
KK = 0;
L_00B0:
if (KK == _final) goto L_00B1;
KK += 1;
NCONST = NCONST + 1;
// 734 PSYM(J); PSYM(K) %IF PRECP=3
PSYM(J);
if (PRECP != 3) goto L_00B2;
PSYM(K);
L_00B2:;
// 735 %REPEAT; ->L11
goto L_00B0;
}
L_00B1:;
goto U_1023;
// 736 L51: ->L52 %IF CTYPE=5
U_1021:;
if (CTYPE != 5) goto L_00B3;
goto U_1024;
L_00B3:;
// 737 ->L98 %UNLESS CTYPE=1 %AND S<=127
if (CTYPE != 1) goto L_00AB;
if (S <= 127) goto L_00B4;
L_00AB:;
goto U_101E;
L_00B4:;
// 738 A(RP+3)=1; A(RP+4)=S
A[RP + 3 + 2] = 1;
A[RP + 4 + 2] = S;
// 739 L52: ->L98 %UNLESS SIGN=1 %AND ACC>=A(RP+3)
U_1024:;
if (SIGN != 1) goto L_00B5;
if (ACC >= A[RP + 3 + 2]) goto L_00B6;
L_00B5:;
goto U_101E;
L_00B6:;
// 740 %CYCLE KK=1,1,RF
// %for KK = 1, 1, RF %cycle
{
int _final = RF;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle KK = 1, 1, RF");
KK = 0;
L_00B7:
if (KK == _final) goto L_00B8;
KK += 1;
// 741 %CYCLE JJ=0,1,ACC
// %for JJ = 0, 1, ACC %cycle
{
int _final = ACC;
if (invalid_for_loop(0, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle JJ = 0, 1, ACC");
JJ = -1;
L_00BA:
if (JJ == _final) goto L_00BB;
JJ += 1;
// 742 S=A(RP+JJ+3)&127
S = A[RP + JJ + 3 + 2] & 127;
// 743 SP=S<<N
SP = S << N;
// 744 VALUE=SP!VALUE; N=N-8
VALUE = SP | VALUE;
N = N - 8;
// 745 ->L55 %UNLESS N<0
if (N < 0) goto L_00BC;
goto U_1025;
L_00BC:;
// 746 PSYM(VALUE); N=24; VALUE=0
PSYM(VALUE);
N = 24;
VALUE = 0;
// 747 L55: %REPEAT
U_1025:;
goto L_00BA;
}
L_00BB:;
// 748 NCONST=NCONST+1
NCONST = NCONST + 1;
// 749 %REPEAT; R=RP+2; ->L11
goto L_00B7;
}
L_00B8:;
R = RP + 2;
goto U_1023;
// 750 L98: Q=RQ
U_101E:;
Q = RQ;
// 751 L99: R=RP; A(R)=NCONST
U_101D:;
R = RP;
A[R + 2] = NCONST;
// 752 PSYM(VALUE) %IF(TYPEP=5%AND N#24)%OR(TYPEP#5 %AND(CPW-1)&NCONST#0)
if (TYPEP != 5) goto L_00BD;
if (N != 24) goto L_00B9;
L_00BD:;
if (TYPEP == 5) goto L_00BE;
if (CPW - 1 & NCONST == 0) goto L_00BE;
L_00B9:;
PSYM(VALUE);
L_00BE:;
// 753 %END
return;
} /* end of CONSTLIST */
// 754 %ROUTINE TEXTTEXT
void TEXTTEXT(void) {
// 755 !%SHORTROUTINE
// 756 %INTEGER S,J
int S;
int J;
// 757 S=R; R=R+1
S = R;
R = R + 1;
// 758 ->L98 %UNLESS I='''' ;!FAIL UNLESS INITIAL QUOTE
if (I == 39) goto L_00BF;
goto U_100A;
L_00BF:;
// 759 Q=Q+1
Q = Q + 1;
// 760 L1: I=CC(Q);A(R)=I;R=R+1
U_100B:;
I = CC[Q];
A[R + 2] = I;
R = R + 1;
// 761 ->L31 %IF I=''''
if (I != 39) goto L_00C0;
goto U_100C;
L_00C0:;
// 762 ->L32 %IF I=10
if (I != 10) goto L_00C1;
goto U_100D;
L_00C1:;
// 763 Q=Q+1;FAULT(106) %IF R-S>256
Q = Q + 1;
if (R - S <= 256) goto L_00C2;
FAULT(106);
L_00C2:;
// 764 ->L1
goto U_100B;
// 765 L32: READ LINE(1);Q=1;->L1
U_100D:;
READLINE(1);
Q = 1;
goto U_100B;
// 766 L31: ->L35 %UNLESS CC(Q+1)=''''
U_100C:;
if (CC[Q + 1] == 39) goto L_00C3;
goto U_100E;
L_00C3:;
// 767 Q=Q+2;->L1
Q = Q + 2;
goto U_100B;
// 768 L35: R=R-2;J=R-S;->L36 %UNLESS J&1=0
U_100E:;
R = R - 2;
J = R - S;
if (J & 1 == 0) goto L_00C4;
goto U_100F;
L_00C4:;
// 769 R=R+1;A(R)=0
R = R + 1;
A[R + 2] = 0;
// 770 L36: A(S)=J;Q=Q+1;HIT=1;->L99
U_100F:;
A[S + 2] = J;
Q = Q + 1;
HIT = 1;
goto U_1010;
// 771 L98: HIT=0
U_100A:;
HIT = 0;
// 772 L99: %END
U_1010:;
return;
} /* end of TEXTTEXT */
// 773 %ROUTINE SET UP LIST
void SETUPLIST(void) {
// 774 !%SHORTROUTINE
// 775 %INTEGER J,K
int J;
int K;
// 776 %CYCLE J=0,8,ASL-16
// %for J = 0, 8, ASL - 16 %cycle
{
int _final = ASL - 16;
if (invalid_for_loop(0, 8, _final)) _imp_signal(5, 1, 0, "Illegal cycle J = 0, 8, ASL - 16");
J = -8;
L_00C5:
if (J == _final) goto L_00C6;
J += 8;
// 777 SET SHORT INTEGER(ADDR(ASLIST(J))+14, J)
SETSHORTINTEGER(_imp_ADDR(/*?*/ &ASLIST[J]) + 14, J);
// 778 %REPEAT
goto L_00C5;
}
L_00C6:;
// 779 INTEGER(ADDR(ASLIST(0)))=-1; ! INITIALISE BOTTOM CELL
*_imp_INTEGER(_imp_ADDR(/*?*/ &ASLIST[0])) = -1;
// 780 INTEGER(ADDR(ASLIST(4)))=X'FFFF0000'
*_imp_INTEGER(_imp_ADDR(/*?*/ &ASLIST[4])) = -65536;
// 781 ASL=ASL-8
ASL = ASL - 8;
// 782 %END
return;
} /* end of SETUPLIST */
// ?K unused
// 783 %ROUTINE INITIALISE
void INITIALISE(void) {
// 784 !%SHORTROUTINE
// 785 %OWNBYTEINTEGERARRAY ILETT(1:320)=11,
static unsigned char ILETT[320] = {
11, 83, 69, 76, 69, 67, 84, 73, 78, 80, 85, 84, 12, 83, 69, 76, 69, 67, 84, 79, 85, 84, 80, 85, 84, 7, 78,
69, 87, 76, 73, 78, 69, 5, 83, 80, 65, 67, 69, 10, 83, 75, 73, 80, 83, 89, 77, 66, 79, 76, 6, 82, 85, 78,
79, 85, 84, 8, 78, 69, 87, 76, 73, 78, 69, 83, 6, 83, 80, 65, 67, 69, 83, 10, 78, 69, 88, 84, 83, 89, 77,
66, 79, 76, 11, 80, 82, 73, 78, 84, 83, 89, 77, 66, 79, 76, 10, 82, 69, 65, 68, 83, 89, 77, 66, 79, 76, 4,
82, 69, 65, 68, 5, 87, 82, 73, 84, 69, 7, 78, 69, 87, 80, 65, 71, 69, 4, 65, 68, 68, 82, 6, 65, 82, 67,
83, 73, 78, 3, 73, 78, 84, 5, 73, 78, 84, 80, 84, 6, 70, 82, 65, 67, 80, 84, 5, 80, 82, 73, 78, 84, 7,
80, 82, 73, 78, 84, 70, 76, 4, 82, 69, 65, 76, 7, 73, 78, 84, 69, 71, 69, 82, 3, 77, 79, 68, 6, 65, 82,
67, 67, 79, 83, 4, 83, 81, 82, 84, 3, 76, 79, 71, 3, 83, 73, 78, 3, 67, 79, 83, 3, 84, 65, 78, 3, 69,
88, 80, 9, 77, 65, 80, 82, 69, 67, 79, 82, 68, 11, 66, 89, 84, 69, 73, 78, 84, 69, 71, 69, 82, 12, 83, 72,
79, 82, 84, 73, 78, 84, 69, 71, 69, 82, 6, 82, 65, 68, 73, 85, 83, 6, 65, 82, 67, 84, 65, 78, 6, 80, 65,
82, 73, 84, 89, 11, 80, 82, 73, 78, 84, 83, 84, 82, 73, 78, 71, 2, 78, 76, 8, 76, 79, 78, 71, 82, 69, 65,
76, 7, 80, 82, 73, 78, 84, 67, 72, 6, 82, 69, 65, 68, 67, 72, 6, 83, 84, 82, 73, 78, 71};
// 786+ 'S','E','L','E','C','T','I','N','P','U','T',
// 787+ 12,'S','E','L','E','C','T','O','U','T','P','U','T',
// 788+ 7,'N','E','W','L','I','N','E',
// 789+ 5,'S','P','A','C','E',
// 790+ 10,'S','K','I','P','S','Y','M','B','O','L',
// 791+ 6,'R','U','N','O','U','T',
// 792+ 8,'N','E','W','L','I','N','E','S',
// 793+ 6,'S','P','A','C','E','S',
// 794+ 10,'N','E','X','T','S','Y','M','B','O','L',
// 795+ 11,'P','R','I','N','T','S','Y','M','B','O','L',
// 796+ 10,'R','E','A','D','S','Y','M','B','O','L',
// 797+ 4,'R','E','A','D',
// 798+ 5,'W','R','I','T','E',
// 799+ 7,'N','E','W','P','A','G','E',
// 800+ 4,'A','D','D','R',
// 801+ 6,'A','R','C','S','I','N',
// 802+ 3,'I','N','T',
// 803+ 5,'I','N','T','P','T',
// 804+ 6,'F','R','A','C','P','T',
// 805+ 5,'P','R','I','N','T',
// 806+ 7,'P','R','I','N','T','F','L',
// 807+ 4,'R','E','A','L',
// 808+ 7,'I','N','T','E','G','E','R',
// 809+ 3,'M','O','D',
// 810+ 6,'A','R','C','C','O','S',
// 811+ 4,'S','Q','R','T',
// 812+ 3,'L','O','G',
// 813+ 3,'S','I','N',
// 814+ 3,'C','O','S',
// 815+ 3,'T','A','N',
// 816+ 3,'E','X','P',
// 817+ 9,'M','A','P','R','E','C','O','R','D' ,
// 818+ 11,'B','Y','T','E','I','N','T','E','G','E','R',
// 819+ 12,'S','H','O','R','T','I','N','T','E','G','E','R',
// 820+ 6,'R','A','D','I','U','S',
// 821+ 6,'A','R','C','T','A','N',
// 822+ 6,'P','A','R','I','T','Y',
// 823+ 11,'P','R','I','N','T','S','T','R','I','N','G',
// 824+ 2,'N','L',
// 825+ 8,'L','O','N','G','R','E','A','L',
// 826+ 7,'P','R','I','N','T','C','H',
// 827+ 6,'R','E','A','D','C','H',
// 828+ 6,'S','T','R','I','N','G'
// 829 %OWNSHORTINTEGERARRAY IWORD(0:42)=1,
static short int IWORD[43] = {1, 13, 26, 34, 40, 51, 58, 67, 74, 85, 97, 108, 113, 119, 127,
132, 139, 143, 149, 156, 162, 170, 175, 183, 187, 194, 199, 203, 207, 211,
215, 219, 229, 241, 254, 261, 268, 275, 287, 290, 299, 307, 314};
// 830+ 13,26,34,40,51,58,67,74,85,97,
// 831+ 108,113,119,127,132,139,143,149,156,162,
// 832+ 170,175,183,187,194,199,203,207,211,215,
// 833+ 219,229,241,254,261,268,275,287,290,299,307,
// 834+ 314
// 835 %INTEGER I
int I;
// 836
// 837 open input(1, "TEST.imp")
_imp_OPENINPUT(1, _imp_str_literal("TEST.imp"));
// 838 select input(1)
_imp_SELECTINPUT(1);
// 839
// 840 CABUF=0; PPCURR=0; QPREAL=0; OLDLINE=0
CABUF = 0;
PPCURR = 0;
QPREAL = 0;
OLDLINE = 0;
// 841 LINE=0; RLEVEL=0; NMAX=0; CONSTPTR=0
LINE = 0;
RLEVEL = 0;
NMAX = 0;
CONSTPTR = 0;
// 842 LEVEL=0; CA=0; AFLAG=0; FFLAG=0; SBFLAG=0
LEVEL = 0;
CA = 0;
AFLAG = 0;
FFLAG = 0;
SBFLAG = 0;
// 843 FAULTY=0; PERM=0; MCSWITCH=0; ALL LONG=0
FAULTY = 0;
PERM = 0;
MCSWITCH = 0;
ALLLONG = 0;
// 844 DCOMP=0; COMPILER=0; CPRMODE=0; PRINT MAP=0
DCOMP = 0;
COMPILER = 0;
CPRMODE = 0;
PRINTMAP = 0;
// 845 NEXT=1; NR=0; LDPTR=0; NEPS=0; EPLINK=0
NEXT = 1;
NR = 0;
LDPTR = 0;
NEPS = 0;
EPLINK = 0;
// 846 RBASE=0; STRINST=0
RBASE = 0;
STRINST = 0;
// 847 IMAX=(-1)>>1;PLABEL=24999
IMAX = (unsigned int)(-1) >> 1;
PLABEL = 24999;
// 848 SSTL=0; STMTS=0; SNUM=0
SSTL = 0;
STMTS = 0;
SNUM = 0;
// 849 LABSET=3<<30;LETT(0)=0
LABSET = 3 << 30;
LETT[0] = 0;
// 850 N0=41; N=12
N0 = 41;
N = 12;
// 851 CHECKSP=1 ; CHECKS=1
CHECKSP = 1;
CHECKS = 1;
// 852 LINENOS=1; DIAGS1=1; QU=1; MONE=1
LINENOS = 1;
DIAGS1 = 1;
QU = 1;
MONE = 1;
// 853 LIST=1; SFLABEL=20999; UNASS=1
LIST = 1;
SFLABEL = 20999;
UNASS = 1;
// 854 OWNLINK=0; XREFLINK=136
OWNLINK = 0;
XREFLINK = 136;
// 855 I=COM(24)
I = COM(24);
// 856 LIST=0 %IF I&2#0
if (I & 2 == 0) goto L_00C8;
LIST = 0;
L_00C8:;
// 857 LINENOS=0 %IF I&4#0
if (I & 4 == 0) goto L_00C9;
LINENOS = 0;
L_00C9:;
// 858 UNASS=0 %IF I&16#0
if (I & 16 == 0) goto L_00CA;
UNASS = 0;
L_00CA:;
// 859 CHECKS=0 %IF I&32#0
if (I & 32 == 0) goto L_00CB;
CHECKS = 0;
L_00CB:;
// 860 PRINTMAP=1 %IF I&X'8000'#0
if (I & 32768 == 0) goto L_00CC;
PRINTMAP = 1;
L_00CC:;
// 861 DIAGS1=0 %IF I&64#0
if (I & 64 == 0) goto L_00CD;
DIAGS1 = 0;
L_00CD:;
// 862 %CYCLE I=0,1,MAXLEVELS
// %for I = 0, 1, MAXLEVELS %cycle
{
int _final = MAXLEVELS;
if (invalid_for_loop(0, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle I = 0, 1, MAXLEVELS");
I = -1;
L_00CE:
if (I == _final) goto L_00CF;
I += 1;
// 863 SET(I)=0; CODEBASE(I)=0; FREG(I)=0; RAL(I)=0
SET[I] = 0;
CODEBASE[I] = 0;
FREG[I] = 0;
RAL[I] = 0;
// 864 LWSP(I)=0; MDARR(I)=0; RNEXT(I)=0; STRWSP(I)=0
LWSP[I] = 0;
MDARR[I] = 0;
RNEXT[I] = 0;
STRWSP[I] = 0;
// 865 CYCLE(I)=0; JUMP(I)=0; NAME(I)=0
CYCLE[I] = 0;
JUMP[I] = 0;
NAME[I] = 0;
// 866 LABEL(I)=0; FLAG(I)=0; SBR(I)=0; WSP(I)=0
LABEL[I] = 0;
FLAG[I] = 0;
SBR[I] = 0;
WSP[I] = 0;
// 867 %REPEAT
goto L_00CE;
}
L_00CF:;
// 868 %CYCLE I=0,1,50
// %for I = 0, 1, 50 %cycle
{
I = -1;
L_00D0:
if (I == 50) goto L_00D1;
I += 1;
// 869 ST(I)=0; PAGENOS(I)=0
ST[I] = 0;
PAGENOS[I] = 0;
// 870 REGISTER(I)=0 %IF I<16
if (I >= 16) goto L_00D2;
REGISTER[I] = 0;
L_00D2:;
// 871 UVARREG(I)=0 %IF 5<=I<=8
{
// Double-sided test on I (Part I)
int tmp;
if (5 > (tmp = I)) goto L_00D3;
// Double-sided test on I (Part II)
if (tmp > 8) goto L_00D3;
}
UVARREG[I - 5] = 0;
L_00D3:;
// 872 %REPEAT; PAGENOS(1)=10
goto L_00D0;
}
L_00D1:;
PAGENOS[1] = 10;
// 873 %CYCLE I=0,1,NNAMES
// %for I = 0, 1, NNAMES %cycle
{
int _final = NNAMES;
if (invalid_for_loop(0, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle I = 0, 1, NNAMES");
I = -1;
L_00D4:
if (I == _final) goto L_00D5;
I += 1;
// 874 WORD(I)=0; TAGS(I)=0
WORD[I] = 0;
TAGS[I] = 0;
// 875 %REPEAT
goto L_00D4;
}
L_00D5:;
// 876 SET UP LIST
SETUPLIST();
// 877 PCLOD(0); ! ST 12,28(GLA)--L 12,92(GLA)
PCLOD(0);
// 878 PCLOD(5); ! ST 15,60(11)--BAL 15,RTI
PCLOD(5);
// 879 A(1)=28
A[3] = 28;
// 880 %CYCLE I=0,1,42
// %for I = 0, 1, 42 %cycle
{
I = -1;
L_00D6:
if (I == 42) goto L_00D7;
I += 1;
// 881 J=IWORD(I)
J = IWORD[I];
// 882 %CYCLE K=1,1,ILETT(J)
// %for K = 1, 1, ILETT[J - 1] %cycle
{
int _final = ILETT[J - 1];
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle K = 1, 1, ILETT[J - 1]");
K = 0;
L_00D8:
if (K == _final) goto L_00D9;
K += 1;
// ?Non-local
// 883 CC(K)=ILETT(J+K); ! COPY SPECIAL NAMES TO SOURCE
CC[K] = ILETT[J + K - 1];
// 884 %REPEAT; CC(K+1)=';'
goto L_00D8;
}
L_00D9:;
CC[K + 1] = 59;
// 885 R=2;Q=1; PNAME; ! SPECIAL NAME TO DICTIONARY
R = 2;
Q = 1;
PNAME();
// 886 CSS(1); %REPEAT; ! AND COMPILED
CSS(1);
goto L_00D6;
}
L_00D7:;
// 887 A(1)=12; CSS(1); ! COMPILE A BEGIN
A[3] = 12;
CSS(1);
// 888 %END
return;
} /* end of INITIALISE */
// 889 !
// 890 %COMMENT THE NEXT 4 ROUTINES CAN BE MACROISED USING MVC
// 891 !
// 892 %ROUTINE TOAR4(%INTEGER PTR,VALUE)
void TOAR4(int PTR, int VALUE) {
// 893 %INTEGER AD; AD=ADDR(VALUE)
int AD;
AD = _imp_ADDR(/*?*/ &VALUE);
// 894 A(PTR)<-SHORT INTEGER(AD)
A[PTR + 2] = (short int)(*_imp_SHORTINTEGER(AD));
// 895 A(PTR+1)<-SHORT INTEGER (AD+2)
A[PTR + 1 + 2] = (short int)(*_imp_SHORTINTEGER(AD + 2));
// 896 %END
return;
} /* end of TOAR4 */
// 897 %ROUTINE TOAR8(%INTEGER PTR,%LONGREAL VALUE)
void TOAR8(int PTR, double VALUE) {
// 898 %INTEGER AD; AD=ADDR(VALUE)
int AD;
AD = _imp_ADDR(/*?*/ &VALUE);
// 899 A(PTR)<-SHORT INTEGER(AD)
A[PTR + 2] = (short int)(*_imp_SHORTINTEGER(AD));
// 900 A(PTR+1)<-SHORT INTEGER(AD+2)
A[PTR + 1 + 2] = (short int)(*_imp_SHORTINTEGER(AD + 2));
// 901 A(PTR+2)<-SHORT INTEGER(AD+4)
A[PTR + 2 + 2] = (short int)(*_imp_SHORTINTEGER(AD + 4));
// 902 A(PTR+3)<-SHORT INTEGER(AD+6)
A[PTR + 3 + 2] = (short int)(*_imp_SHORTINTEGER(AD + 6));
// 903 %END
return;
} /* end of TOAR8 */
// 904 %ROUTINE FROMAR4(%INTEGER PTR,%INTEGERNAME VALUE)
void FROMAR4(int PTR, int *VALUE) {
// 905 %INTEGER AD; AD=ADDR(VALUE)
int AD;
AD = _imp_ADDR(VALUE);
// 906 SET SHORT INTEGER(AD, A(PTR))
SETSHORTINTEGER(AD, A[PTR + 2]);
// 907 SET SHORT INTEGER(AD+2, A(PTR+1))
SETSHORTINTEGER(AD + 2, A[PTR + 1 + 2]);
// 908 %END
return;
} /* end of FROMAR4 */
// 909 %ROUTINE FROMAR8(%INTEGER PTR,%LONGREALNAME VALUE)
void FROMAR8(int PTR, double *VALUE) {
// 910 %INTEGER AD; AD=ADDR(VALUE)
int AD;
AD = _imp_ADDR(VALUE);
// 911 SET SHORT INTEGER(AD, A(PTR))
SETSHORTINTEGER(AD, A[PTR + 2]);
// 912 SET SHORT INTEGER(AD+2, A(PTR+1))
SETSHORTINTEGER(AD + 2, A[PTR + 1 + 2]);
// 913 SET SHORT INTEGER(AD+4, A(PTR+2))
SETSHORTINTEGER(AD + 4, A[PTR + 2 + 2]);
// 914 SET SHORT INTEGER(AD+6, A(PTR+3))
SETSHORTINTEGER(AD + 6, A[PTR + 3 + 2]);
// 915 %END
return;
} /* end of FROMAR8 */
// 916 %ROUTINE PRINTNAME (%INTEGER N)
void PRINTNAME(int N) {
// 917 !%SHORTROUTINE
// 918 %INTEGER J,V
int J;
int V;
// 919 ->L4 %IF N>=0; N=-N
if (N < 0) goto L_00DA;
goto U_100C;
L_00DA:;
N = -N;
// 920 ->L5 %UNLESS 16384<=N<=16384+NNAMES
{
// Double-sided test on N (Part I)
int tmp;
if (16384 > (tmp = N)) goto L_00C7;
// Double-sided test on N (Part II)
if (tmp <= 16384 + NNAMES) goto L_00DB;
}
L_00C7:;
goto U_100D;
L_00DB:;
// 921 N=N-16384; ->L4
N = N - 16384;
goto U_100C;
// 922 L5: WRITE(N,1); ->L3
U_100D:;
_imp_WRITE(N, 1);
goto U_100E;
// 923 L4: SPACE; V=WORD(N)
U_100C:;
_imp_SPACE();
V = WORD[N];
// 924 %CYCLE J=1,1,LETT(V)
// %for J = 1, 1, LETT[V] %cycle
{
int _final = LETT[V];
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle J = 1, 1, LETT[V]");
J = 0;
L_00DC:
if (J == _final) goto L_00DD;
J += 1;
// 925 PRINT SYMBOL(LETT(V+J))
_imp_PRINTSYMBOL(LETT[V + J]);
// 926 %REPEAT
goto L_00DC;
}
L_00DD:;
// 927 L3: %END
U_100E:;
return;
} /* end of PRINTNAME */
// 928 %ROUTINE PCLOD(%INTEGER PTR)
void PCLOD(int PTR) {
// 929 %INTEGER I
int I;
// 930 %CYCLE I=PTR+1,1,PTR+CLODS(PTR)
// %for I = PTR + 1, 1, PTR + CLODS[PTR] %cycle
{
int _initial = PTR + 1, _final = PTR + CLODS[PTR];
if (invalid_for_loop(_initial, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle I = PTR + 1, 1, PTR + CLODS[PTR]");
I = _initial - (1);
L_00DF:
if (I == _final) goto L_00E0;
I += 1;
// 931 PLANT(CLODS(I))
PLANT(CLODS[I]);
// 932 %REPEAT
goto L_00DF;
}
L_00E0:;
// 933 %END
return;
} /* end of PCLOD */
// 934 %ROUTINE PACLOD(%INTEGER PTR,AT,VALUE)
void PACLOD(int PTR, int AT, int VALUE) {
// 935 %INTEGER I,J,K
int I;
int J;
int K;
// 936 J=CLODS(PTR); AT=AT+PTR
J = CLODS[PTR];
AT = AT + PTR;
// 937 %CYCLE I=PTR+1,1,PTR+J
// %for I = PTR + 1, 1, PTR + J %cycle
{
int _initial = PTR + 1, _final = PTR + J;
if (invalid_for_loop(_initial, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle I = PTR + 1, 1, PTR + J");
I = _initial - (1);
L_00E1:
if (I == _final) goto L_00E2;
I += 1;
// 938 K=CLODS(I)
K = CLODS[I];
// 939 K=K!VALUE %IF I=AT
if (I != AT) goto L_00E3;
K = K | VALUE;
L_00E3:;
// 940 PLANT(K);%REPEAT
PLANT(K);
goto L_00E1;
}
L_00E2:;
// 941 %END
return;
} /* end of PACLOD */
// 942 %ROUTINE PLANT(%INTEGER VALUE)
void PLANT(int VALUE) {
// 943 !%SHORTROUTINE
// 944 CODE(PPCURR)<-VALUE
CODE[PPCURR] = (short int)(VALUE);
// 945 PPCURR=PPCURR+1; CA=CA+2
PPCURR = PPCURR + 1;
CA = CA + 2;
// 946 %RETURN %UNLESS PPCURR=192
if (PPCURR == 192) goto L_00E4;
return;
L_00E4:;
// 947 LPUT(1,384,CABUF,ADDR(CODE(0)))
LPUT(1, 384, CABUF, _imp_ADDR(/*?*/ &CODE[0]));
// 948 PPCURR=0; CABUF=CA
PPCURR = 0;
CABUF = CA;
// 949 %END
return;
} /* end of PLANT */
// 950 %ROUTINE PRR (%INTEGER OPCODE,R1,R2)
void PRR(int OPCODE, int R1, int R2) {
// 951 PLANT(OPCODE<<8!R1<<4!R2)
PLANT(OPCODE << 8 | R1 << 4 | R2);
// 952 %END
return;
} /* end of PRR */
// 953 %ROUTINE PRX(%INTEGER OPCODE,R1,R2,BASE,DISP)
void PRX(int OPCODE, int R1, int R2, int BASE, int DISP) {
// 954 PLANT(OPCODE<<8!R1<<4!R2)
PLANT(OPCODE << 8 | R1 << 4 | R2);
// 955 PLANT(BASE<<12!DISP)
PLANT(BASE << 12 | DISP);
// 956 %END
return;
} /* end of PRX */
// 957 %ROUTINE PSI(%INTEGER OPCODE,J,BASE,DISP)
void PSI(int OPCODE, int J, int BASE, int DISP) {
// 958 PLANT(OPCODE<<8!J)
PLANT(OPCODE << 8 | J);
// 959 PLANT(BASE<<12!DISP)
PLANT(BASE << 12 | DISP);
// 960 %END
return;
} /* end of PSI */
// 961 %ROUTINE PSS(%INTEGER OPCODE,N,BASE,DISP,P,Q)
void PSS(int OPCODE, int N, int BASE, int DISP, int P, int Q) {
// 962 PLANT(OPCODE<<8!(N-1))
PLANT(OPCODE << 8 | N - 1);
// 963 PLANT(BASE<<12!DISP)
PLANT(BASE << 12 | DISP);
// 964 PLANT(P<<12!Q)
PLANT(P << 12 | Q);
// 965 %END
return;
} /* end of PSS */
// 966 %ROUTINE PCONST(%INTEGER X)
void PCONST(int X) {
// 967 PLANT(X>>16); PLANT(X&X'FFFF')
PLANT((unsigned int)X >> 16);
PLANT(X & 65535);
// 968 %END
return;
} /* end of PCONST */
// 969 %ROUTINE CNOP(%INTEGER I,J)
void CNOP(int I, int J) {
// 970 J=J-1
J = J - 1;
// 971 L1: ->L9 %IF CA&J=I; PLANT(X'0700'); ->L1
U_100B:;
if (CA & J != I) goto L_00E5;
goto U_100C;
L_00E5:;
PLANT(1792);
goto U_100B;
// 972 L9: %END
U_100C:;
return;
} /* end of CNOP */
// 973 %ROUTINE PSYM(%INTEGER X)
void PSYM(int X) {
// 974 LPUT(5,4,CONSTPTR<<2,ADDR(X))
LPUT(5, 4, CONSTPTR << 2, _imp_ADDR(/*?*/ &X));
// 975 CONSTPTR=CONSTPTR+1
CONSTPTR = CONSTPTR + 1;
// 976 %END
return;
} /* end of PSYM */
// 977 %ROUTINE PLUG(%INTEGER J,K)
void PLUG(int J, int K) {
// 978 !%SHORTROUTINE
// 979 ->INBUF %IF J>=CABUF
if (J < CABUF) goto L_00E6;
goto U_100B;
L_00E6:;
// 980 LPUT(1,2,J,ADDR(K)+2) ; ->L99
LPUT(1, 2, J, _imp_ADDR(/*?*/ &K) + 2);
goto U_100C;
// 981 INBUF: CODE((J-CABUF)>>1)<-K
U_100B:;
CODE[(unsigned int)J - CABUF >> 1] = (short int)(K);
// 982 L99: %END
U_100C:;
return;
} /* end of PLUG */
// 983 %ROUTINE PRHEX(%INTEGER VALUE,PLACES)
void PRHEX(int VALUE, int PLACES) {
// 984 %OWNBYTEINTEGERARRAY HEX(0:15)='0','1','2','3','4',
static unsigned char HEX[16] = {48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 65, 66, 67, 68, 69, 70};
// 985+ '5','6','7','8','9','A','B','C','D','E','F';
// 986 %INTEGER I
int I;
// 987 %CYCLE I=PLACES<<2-4,-4,0
// %for I = (PLACES << 2) - 4, -4, 0 %cycle
{
int _initial = (PLACES << 2) - 4;
if (invalid_for_loop(_initial, -4, 0)) _imp_signal(5, 1, 0, "Illegal cycle I = (PLACES << 2) - 4, -4, 0");
I = _initial - (-4);
L_00E7:
if (I == 0) goto L_00E8;
I -= 4;
// 988 PRINT SYMBOL(HEX(VALUE>>I&15))
_imp_PRINTSYMBOL(HEX[(unsigned int)VALUE >> I & 15]);
// 989 %REPEAT
goto L_00E7;
}
L_00E8:;
// 990 %END
return;
} /* end of PRHEX */
// 991 %ROUTINE SIZES
void SIZES(void) {
auto void SUM(int I);
// 992 !%SHORTROUTINE
// 993 %ROUTINESPEC SUM(%INTEGER I)
// 994 %INTEGER I,J,FREE,TOTAL
int I;
int J;
int FREE;
int TOTAL;
// 995
// 996 free=20000
FREE = 20000;
// 997 sum(5)
SUM(5);
// 998 %if debug=1 %start
if (0 != 1) goto L_00E9;
// 999 print string("NNAMES="); write(NNAMES,0);
_imp_PRINTSTRING(_imp_str_literal("NNAMES="));
_imp_WRITE(NNAMES, 0);
// 1000 print string(" CCSIZE="); write(CCSIZE,0);
_imp_PRINTSTRING(_imp_str_literal(" CCSIZE="));
_imp_WRITE(CCSIZE, 0);
// 1001 print string(" NROUTS="); write(NROUTS,0);
_imp_PRINTSTRING(_imp_str_literal(" NROUTS="));
_imp_WRITE(NROUTS, 0);
// 1002 print string(" ASL="); write(ASL,0);
_imp_PRINTSTRING(_imp_str_literal(" ASL="));
_imp_WRITE(ASL, 0);
// 1003 print string(" ARSIZE="); write(ARSIZE,0);
_imp_PRINTSTRING(_imp_str_literal(" ARSIZE="));
_imp_WRITE(ARSIZE, 0);
// 1004 print string(" DSIZE="); write(DSIZE,0);
_imp_PRINTSTRING(_imp_str_literal(" DSIZE="));
_imp_WRITE(DSIZE, 0);
// 1005 print string(" TOTAL="); write(TOTAL,0);
_imp_PRINTSTRING(_imp_str_literal(" TOTAL="));
_imp_WRITE(TOTAL, 0);
// 1006 newlines(2)
_imp_NEWLINES(2);
// 1007 %finish
L_00E9:;
// 1008
// 1009 !!I=COM(2)
// 1010 !!FREE=INTEGER(I+4); !TOP OF STORE
// 1011 !!FREE=FREE-ADDR(TOTAL)-10000
// 1012 ! TOTAL IS CURRENT TOP OF STACK - 10K FOR COMPARE
// 1013 !!%CYCLE J=0,1,5; SUM(J)
// 1014 !!->L1 %IF TOTAL>FREE
// 1015 !!%REPEAT
// 1016 %RETURN
return;
// 1017 L1: ->L2 %UNLESS J=0
U_100E:;
if (J == 0) goto L_00EA;
goto U_100F;
L_00EA:;
// 1018 print string("NOT ENOUGH CORE ALLOCATED FOR IMP")
_imp_PRINTSTRING(_imp_str_literal("NOT ENOUGH CORE ALLOCATED FOR IMP"));
// 1019 %MONITOR ; %STOP
/*_imp_monitor(__LINE__, __FILE__, PRETTY_FUNCTION);*/
_imp_stop(0);
// 1020 L2: SUM(J-1)
U_100F:;
SUM(J - 1);
// 1021 %RETURN
return;
// 1022 %ROUTINE SUM(%INTEGER I)
void SUM(int I) {
// 1023 NNAMES=128*2^^I-1
NNAMES = 128 * (_imp_IEXP(2, I)) - 1;
// 1024 CCSIZE=200+40*I
CCSIZE = 200 + 40 * I;
// 1025 NROUTS=NNAMES//2
NROUTS = ((long)NNAMES / (long)2);
// 1026 ASL =24*NNAMES
ASL = 24 * NNAMES;
// 1027 ASL=32760 %IF ASL>32760; ! MAX FOR 16BIT LINKS
if (ASL <= 32760) goto L_00EB;
ASL = 32760;
L_00EB:;
// 1028 ARSIZE=300+50*I
ARSIZE = 300 + 50 * I;
// 1029 DSIZE= 6*NNAMES
DSIZE = 6 * NNAMES;
// 1030 TOTAL=CCSIZE+ASL+2*(NROUTS+ARSIZE+DSIZE)
TOTAL = CCSIZE + ASL + 2 * (NROUTS + ARSIZE + DSIZE);
// 1031 %END
return;
} /* end of SUM */
// 1032 %END
return;
} /* end of SIZES */
// ?L1 unused
// ?I unused
// 1033 !
// 1034 %ROUTINE CSS (%INTEGER P)
void CSS(int P) {
auto void REDEFINEEP(int TYPEP, int *PARAMS);
auto void CIOCP(int N);
auto void DEFINEEP(int MODE, int NAME, int ADR);
auto void LOADDATA(void);
auto void PLOCALJUMP(int MASK, int LABEL);
auto void FILLLOCALJUMPS(void);
auto void CLEARLIST(short int *OPHEAD);
auto void STORESTRING(int Z, int FROM, int TO, int BML, int DML);
auto void CEND(int KKK);
auto void CBPAIR(int *LB, int *UB);
auto void UNDCRF(short int *OPHEAD);
auto void CCOND(int IU, int NEARLAB, int FARLAB);
auto void FILLJUMPS(int LEVEL);
auto void SETLINE(void);
auto void CUI(unsigned char CODE);
auto void SET80(int WHERE, int N);
auto void CVDECLN(void);
auto void CSEXP(int REG, unsigned char MODE);
auto void CSTREXP(int REG);
auto void CHECKRF(void);
auto void ASSIGN(int P1, int P2);
auto int COPYRECORDTAG(void);
auto int COUNTAPS(void);
auto int DISPLACEMENT(int LINK);
auto void LOADAD(int REG, int BASE, int X, int DISP);
auto void SKIPAPP(void);
auto void CQUERY(int REG);
auto void CRFORMAT(void);
auto void CADCLN(unsigned char MODE);
auto void CQN(int P);
auto void CLT(void);
auto void MOVER(int R, int N);
auto int GETARRWSP(void);
auto int GETDBLEWRD(void);
auto void CRCALL(int CLINK);
auto void CNAME(int Z, int REG);
auto void CRNAME(int Z, int MODE, int CLINK, int BS, int DP);
auto void CANAME(int Z, int BS, int DP, int CLINK, int BSRF, int DPRF);
auto void CENAME(int Z, int MODE, int BS, int DP);
auto void INSERTAFTER(short int *CELL, int S1, int S2);
auto void FROMLIST(int CELL, int *S1, int *S2);
auto void POP(short int *CELL, int *S1, int *S2);
auto void PUSH(short int *CELL, int S1, int S2);
auto int FIND(int LAB, int LIST);
auto void MLINK(int *CELL);
auto void REPLACE2(int CELL, int S2);
auto void REPLACE1(int CELL, int S1);
auto void REPLACEBOTH(int CELL, int S1, int S2);
auto void FROM2(int CELL, int *S2);
auto void FROM1(int CELL, int *S1);
auto void CRES(int MODE, int LAB);
auto int NEWCELL(void);
auto void COPYTAG(int KK);
auto void CSNAME(int Z, int REG);
auto void REPLACETAG(int KK);
auto int PARK(int REG);
auto int PARKF(int REG, int PREC);
auto int CLAIMABLEREG(void);
auto int FINDPP(void);
auto int GETSTRWSP(void);
auto void SETEX(void);
auto void GXREF(int NAME, int HASH);
auto void UNPARK(int OPCODE, int REG, int Q);
auto void STORETAG(int KK, int SLINK);
auto int PAGENO(int N);
auto void TESTNST(void);
auto void CUCI(void);
auto void SKIPEXP(void);
auto void UNPACK(void);
auto int SORTCONST(int P, int LONG, int TYPE);
auto void PACK(int *PTYPE);
auto void CRSPEC(unsigned char M);
auto void DUMP(int CODE, int REG, int DIS, int X, int LEVEL);
auto void RHEAD(int KK);
auto void TESTASS(int REG);
auto void PJ(int MASK, int LAB);
auto void COMPILEFORMALPARAMETER(void);
auto void PPJ(unsigned char N);
auto void PLAB(int M);
auto void CHECKCAPACITY(int REG, int DIS, int X, int LEVEL);
auto int TSEXP(int *CODE);
// 1035 %ROUTINESPEC REDEFINE EP(%INTEGER TYPEP,%INTEGERARRAYNAME PARAMS)
// 1036 %ROUTINESPEC CIOCP(%INTEGER N)
// 1037 %ROUTINESPEC DEFINE EP(%INTEGER MODE, NAME, ADDR)
// 1038 %ROUTINESPEC LOAD DATA
// 1039 %ROUTINESPEC P LOCAL JUMP(%INTEGER MASK,LAB)
// 1040 %ROUTINESPEC FILL LOCAL JUMPS
// 1041 %ROUTINESPEC CLEAR LIST (%SHORTINTEGERNAME OPHEAD) ; ! Care needed with short conversion!
// 1042 %ROUTINESPEC STORE STRING(%INTEGER Z,FROM,TO,BML,DML)
// 1043 %ROUTINESPEC CEND(%INTEGER KKK)
// 1044 %ROUTINESPEC CBPAIR(%INTEGERNAME LB,UB)
// 1045 %ROUTINESPEC UNDCRF (%SHORTINTEGERNAME OPHEAD) ; ! Care needed with short conversion!
// 1046 %ROUTINESPEC CCOND(%INTEGER IU,REG,ADDR)
// 1047 %ROUTINESPEC FILL JUMPS(%INTEGER LEVEL)
// 1048 %ROUTINESPEC SET LINE
// 1049 %ROUTINESPEC CUI(%BYTEINTEGER CODE)
// 1050 %ROUTINESPEC SET80(%INTEGER WHERE,N)
// 1051 %ROUTINESPEC CVDECLN
// 1052 %ROUTINESPEC CSEXP(%INTEGER REG,%BYTEINTEGER MODE)
// 1053 %ROUTINESPEC CSTREXP(%INTEGER REG)
// 1054 %ROUTINESPEC CHECK RF
// 1055 %ROUTINESPEC ASSIGN (%INTEGER P1,P2)
// 1056 %INTEGERFNSPEC COPY RECORD TAG
// 1057 %INTEGERFNSPEC COUNT APS
// 1058 %INTEGERFNSPEC DISPLACEMENT(%INTEGER LINK)
// 1059 %ROUTINESPEC LOADAD(%INTEGER REG,BASE,X,DISP)
// 1060 %ROUTINESPEC SKIP APP
// 1061 %ROUTINESPEC CQUERY(%INTEGER REG)
// 1062 %ROUTINESPEC CRFORMAT
// 1063 %ROUTINESPEC CADCLN(%BYTEINTEGER MODE)
// 1064 %ROUTINESPEC CQN(%INTEGER P)
// 1065 %ROUTINESPEC CLT
// 1066 %ROUTINESPEC MOVE R(%INTEGER R,N)
// 1067 %INTEGERFNSPEC GET ARR WSP
// 1068 %INTEGERFNSPEC GET DBLE WRD
// 1069 %ROUTINESPEC CRCALL (%INTEGER CLINK)
// 1070 %ROUTINESPEC CNAME(%INTEGER Z,REG)
// 1071 %ROUTINESPEC CRNAME(%INTEGER Z,MODE,CLINK,BS,DP)
// 1072 %ROUTINESPEC CANAME(%INTEGER Z,BS,DP,LINK,BSRF,DPRF)
// 1073 %ROUTINESPEC CENAME(%INTEGER Z,MODE,BS,DP)
// 1074 %ROUTINESPEC INSERTAFTER(%SHORTINTEGERNAME STAD,%INTEGER S1,S2) ; ! Care needed with short conversion!
// 1075 %ROUTINESPEC FROM LIST(%INTEGER CELL,%INTEGERNAME S1,S2)
// 1076 %ROUTINESPEC POP(%SHORTINTEGERNAME CELL,%INTEGERNAME S1,S2) ; ! Care needed with short conversion!
// 1077 %ROUTINESPEC PUSH(%SHORTINTEGERNAME CELL,%INTEGER S1,S2) ; ! Care needed with short conversion!
// 1078 %INTEGERFNSPEC FIND(%INTEGER LAB,LIST)
// 1079 %ROUTINESPEC MLINK(%INTEGERNAME CELL)
// 1080 %ROUTINESPEC REPLACE2(%INTEGER CELL,S2)
// 1081 %ROUTINESPEC REPLACE1(%INTEGER CELL,S1)
// 1082 %ROUTINESPEC REPLACE BOTH(%INTEGER CELL,S1,S2)
// 1083 %ROUTINESPEC FROM2(%INTEGER CELL,%INTEGERNAME S2)
// 1084 %ROUTINESPEC FROM1(%INTEGER CELL,%INTEGERNAME S1)
// 1085 %ROUTINESPEC CRES(%INTEGER MODE,LAB)
// 1086 %INTEGERFNSPEC NEWCELL
// 1087 %ROUTINESPEC COPY TAG (%INTEGER KK)
// 1088 %ROUTINESPEC CSNAME(%INTEGER Z,REG)
// 1089 %ROUTINESPEC REPLACE TAG (%INTEGER KK)
// 1090 %INTEGERFNSPEC PARK(%INTEGER REG)
// 1091 %INTEGERFN %SPEC PARKF (%INTEGER REG,PREC)
// 1092 %INTEGERFNSPEC CLAIMABLE REG
// 1093 %INTEGERFNSPEC FIND PP
// 1094 %INTEGERFNSPEC GET STR WSP
// 1095 %ROUTINESPEC SETEX
// 1096 %ROUTINESPEC GXREF(%INTEGER NAME,HASH)
// 1097 %ROUTINESPEC UNPARK(%INTEGER OPCODE,REG,Q)
// 1098 %ROUTINESPEC STORE TAG(%INTEGER KK,SLINK)
// 1099 %INTEGERFNSPEC PAGENO(%INTEGER N)
// 1100 %ROUTINESPEC TESTNST
// 1101 %ROUTINESPEC CUCI
// 1102 %ROUTINESPEC SKIP EXP
// 1103 %ROUTINESPEC UNPACK
// 1104 %INTEGERFNSPEC SORT CONST(%INTEGER P,LONG,TYPE)
// 1105 %ROUTINESPEC PACK(%INTEGERNAME PTYPE)
// 1106 %ROUTINESPEC CRSPEC (%BYTEINTEGER M)
// 1107 %ROUTINESPEC DUMP(%INTEGER CODE,REG,DIS,X,LEVEL)
// 1108 %ROUTINESPEC RHEAD(%INTEGER KK)
// 1109 %ROUTINESPEC TEST ASS(%INTEGER REG)
// 1110 %ROUTINESPEC PJ(%INTEGER MASK,STAD)
// 1111 %ROUTINESPEC COMPILE FORMAL PARAMETER
// 1112 %ROUTINESPEC PPJ(%BYTEINTEGER N)
// 1113 %ROUTINESPEC PLAB(%INTEGER M)
// 1114 %ROUTINESPEC CHECK CAPACITY(%INTEGER REG,DIS,X,LEVEL)
// 1115 %INTEGERFNSPEC TSEXP(%INTEGERNAME CODE)
// 1116 %SWITCH SW(1:45)
int SW_index;
int SW_line;
char *SW_file;
static const void *SW[45] = {
&&case_SW_1, &&case_SW_2, &&case_SW_3, &&case_SW_4, &&case_SW_5,
&&case_SW_6, &&case_SW_7, &&case_SW_8, &&case_SW_9, &&case_SW_10,
&&case_SW_11, &&case_SW_12, &&case_SW_13, &&case_SW_14, &&case_SW_15,
&&case_SW_16, &&case_SW_17, &&case_SW_18, &&case_SW_19, &&case_SW_20,
&&case_SW_21, &&case_SW_22, &&case_SW_23, &&case_SW_24, &&case_SW_25,
&&case_SW_26, &&case_SW_27, &&case_SW_28, &&case_SW_29, &&case_SW_30,
&&case_SW_31, &&case_SW_32, &&case_SW_33, &&case_SW_34, &&case_SW_35,
&&case_SW_36, &&case_SW_37, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing};
// 1117 %INTEGER INC,INCP,BXLE,ACC
int INC;
int INCP;
int BXLE;
int ACC;
// 1118 %SHORTINTEGER OPHEAD
short int OPHEAD;
// 1119 %INTEGER JJ,JJJ,KK,KKK,Q,QQ,EXTRN
int JJ;
int JJJ;
int KK;
int KKK;
int Q;
int QQ;
int EXTRN;
// 1120 %INTEGER BASE,DISP,VALUE,INDEX
int BASE;
int DISP;
int VALUE;
int INDEX;
// 1121 %INTEGER LOCAL BASE, LOCAL ADDR
int LOCALBASE;
int LOCALADDR;
// 1122 %SHORTINTEGER LOCAL JUMP,LOCAL LABEL
short int LOCALJUMP;
short int LOCALLABEL;
// 1123 %BYTEINTEGER ROUT,NAM,ARR,PREC,TYPE,PRECP
unsigned char ROUT;
unsigned char NAM;
unsigned char ARR;
unsigned char PREC;
unsigned char TYPE;
unsigned char PRECP;
// 1124 %INTEGER PTYPE,I,J,K,OLDI,INREG
int PTYPE;
int I;
int J;
int K;
int OLDI;
int INREG;
// 1125 %INTEGER PTYPEP,SAVE13,CHNGE13
int PTYPEP;
int SAVE13;
int CHNGE13;
// 1126 LOCAL JUMP=0;LOCAL LABEL=0
LOCALJUMP = 0;
LOCALLABEL = 0;
// 1127 LOCAL BASE=0
LOCALBASE = 0;
// 1128 OLDI=0; ->SW(A(P))
OLDI = 0;
SW_line = __LINE__;
SW_file = __FILE__;
SW_index = A[P + 2];
goto case_SW_dispatch;
// 1129 SW(1): MARKER2=P+1+A(P+1); SET LINE
case_SW_1:;
MARKER2 = P + 1 + A[P + 1 + 2];
SETLINE();
// 1130 P=P+2; ->L101 %IF A(MARKER2)=2
P = P + 2;
if (A[MARKER2 + 2] != 2) goto L_00ED;
goto U_1026;
L_00ED:;
// 1131 MASK=15; CUI(0); ->L1
MASK = 15;
CUI(0);
goto U_1027;
// 1132 L101: Q=P
U_1026:;
Q = P;
// 1133 FAULT(54) %IF A(P)=9; ! START
if (A[P + 2] != 9) goto L_00EE;
FAULT(54);
L_00EE:;
// 1134 SAVE13=R13; CHNGE13=0
SAVE13 = R13;
CHNGE13 = 0;
// 1135 ->L103 %IF A(P)=3; ! UI =JUMP
if (A[P + 2] != 3) goto L_00EF;
goto U_1028;
L_00EF:;
// 1136 PLABEL=PLABEL-2; JJJ=PLABEL+1
PLABEL = PLABEL - 2;
JJJ = PLABEL + 1;
// 1137 KKK=PLABEL; P=MARKER2+2
KKK = PLABEL;
P = MARKER2 + 2;
// 1138 CCOND(A(P-1)-1,JJJ,KKK)
CCOND(A[P - 1 + 2] - 1, JJJ, KKK);
// 1139 PLOCAL JUMP(MASK,KKK)
PLOCALJUMP(MASK, KKK);
// 1140 R13=0 %UNLESS R13=SAVE13 %AND CHNGE13=0
if (R13 != SAVE13) goto L_00DE;
if (CHNGE13 == 0) goto L_00F0;
L_00DE:;
R13 = 0;
L_00F0:;
// 1141 PUSH(LOCAL LABEL,CA,JJJ)
PUSH(/*?*/ &LOCALLABEL, CA, JJJ);
// 1142 P=Q; CUI(1)
P = Q;
CUI(1);
// 1143 L104: PUSH(LOCAL LABEL,CA,KKK)
U_1029:;
PUSH(/*?*/ &LOCALLABEL, CA, KKK);
// 1144 R13=0 %UNLESS R13=SAVE13 %AND CHNGE13=0
if (R13 != SAVE13) goto L_00F1;
if (CHNGE13 == 0) goto L_00F2;
L_00F1:;
R13 = 0;
L_00F2:;
// 1145 L102: REGISTER(LOCAL BASE)=0 %UNLESS LOCAL BASE=10 %OR LOCALBASE=0
U_102A:;
if (LOCALBASE == 10) goto L_00F3;
if (LOCALBASE == 0) goto L_00F3;
REGISTER[LOCALBASE] = 0;
L_00F3:;
// 1146 FILL LOCAL JUMPS; ->L1
FILLLOCALJUMPS();
goto U_1027;
// 1147 L103: PLABEL=PLABEL-1; JJJ=PLABEL
U_1028:;
PLABEL = PLABEL - 1;
JJJ = PLABEL;
// 1148 NMDECS(LEVEL)=1
NMDECS[LEVEL] = 1;
// 1149 KKK=A(P+2)+(A(P+1)-1)<<14
KKK = A[P + 2 + 2] + (A[P + 1 + 2] - 1 << 14);
// 1150 P=MARKER2+2; CCOND(2-A(P-1),JJJ,KKK)
P = MARKER2 + 2;
CCOND(2 - A[P - 1 + 2], JJJ, KKK);
// 1151 PLOCAL JUMP(MASK,KKK)
PLOCALJUMP(MASK, KKK);
// 1152 R13=0 %UNLESS R13=SAVE13 %AND CHNGE13=0
if (R13 != SAVE13) goto L_00F4;
if (CHNGE13 == 0) goto L_00F5;
L_00F4:;
R13 = 0;
L_00F5:;
// 1153 PUSH(LOCAL LABEL,CA,JJJ); ->L102
PUSH(/*?*/ &LOCALLABEL, CA, JJJ);
goto U_102A;
// 1154 !
// 1155 SW(2): SET LINE;P=P+1; BXLE=0; CNAME(3,4)
case_SW_2:;
SETLINE();
P = P + 1;
BXLE = 0;
CNAME(3, 4);
// 1156 INC=N; N=N+12
INC = N;
N = N + 12;
// 1157 FAULT(25) %UNLESS TYPE=1 %AND PREC=0
if (TYPE != 1) goto L_00F6;
if (PREC == 0) goto L_00F7;
L_00F6:;
FAULT(25);
L_00F7:;
// 1158 Q=P; SKIP EXP; REGISTER(4)=1
Q = P;
SKIPEXP();
REGISTER[4] = 1;
// 1159 JJ=P; BXLE=1 %IF 3900>CA-CODEBASE(LEVEL)%AND 1<=TSEXP(JJJ)<=2
JJ = P;
if (3900 <= CA - CODEBASE[LEVEL]) goto L_00F8;
{
// Double-sided test on TSEXP(/*?*/&JJJ) (Part I)
int tmp;
if (1 > (tmp = TSEXP(/*?*/ &JJJ))) goto L_00F8;
// Double-sided test on TSEXP(/*?*/&JJJ) (Part II)
if (tmp > 2) goto L_00F8;
}
BXLE = 1;
L_00F8:;
// 1160 P=JJ; CSEXP(2,1); ! INTEGER TO REG2
P = JJ;
CSEXP(2, 1);
// 1161 JJJ=P; KKK=TSEXP(QQ); P=JJJ
JJJ = P;
KKK = TSEXP(/*?*/ &QQ);
P = JJJ;
// 1162 DUMP(1,2,INC,0,RBASE) %IF KKK=0
if (KKK != 0) goto L_00F9;
DUMP(1, 2, INC, 0, RBASE);
L_00F9:;
// 1163 CSEXP(3,1)
CSEXP(3, 1);
// 1164 %IF KKK=0 %THEN PRX(X'90',3,4,RBASE,INC+4) %ELSE %C
if (KKK != 0) goto L_00FA;
PRX(144, 3, 4, RBASE, INC + 4);
goto L_00FB;
L_00FA:;
PRX(144, 2, 4, RBASE, INC);
L_00FB:;
// 1165+ PRX(X'90',2,4,RBASE,INC)
// 1166 P=Q; CSEXP(1,1)
P = Q;
CSEXP(1, 1);
// 1167 ->L202 %IF CHECKSP=0
if (CHECKSP != 0) goto L_00FC;
goto U_102B;
L_00FC:;
// 1168 DUMP(0,2,INC,0,RBASE); PPJ(17)
DUMP(0, 2, INC, 0, RBASE);
PPJ(17);
// 1169 L202: PLAB(-1); REGISTER(4)=0
U_102B:;
PLAB(-1);
REGISTER[4] = 0;
// 1170 DUMP(1,1,0,0,4)
DUMP(1, 1, 0, 0, 4);
// 1171 PUSH(CYCLE(LEVEL),K,INC+4096*BXLE)
PUSH(/*?*/ &CYCLE[LEVEL], K, INC + 4096 * BXLE);
// 1172 ->L1
goto U_1027;
// 1173 !
// 1174 SW(3): !REPEAT
case_SW_3:;
// 1175 SET LINE
SETLINE();
// 1176 POP(CYCLE(LEVEL),J,K)
POP(/*?*/ &CYCLE[LEVEL], /*?*/ &J, /*?*/ &K);
// 1177 ->L302 %UNLESS J=-1
if (J == -1) goto L_00FD;
goto U_102C;
L_00FD:;
// 1178 FAULT(1); ->L1
FAULT(1);
goto U_1027;
// 1179 L302: BXLE=K>>12; K=K&4095
U_102C:;
BXLE = (unsigned int)K >> 12;
K = K & 4095;
// 1180 PRX(X'98',2,4,RBASE,K); ! LM 2,4,?
PRX(152, 2, 4, RBASE, K);
// 1181 DUMP(2,1,0,0,4); ->L301 %IF BXLE=1
DUMP(2, 1, 0, 0, 4);
if (BXLE != 1) goto L_00FE;
goto U_102D;
L_00FE:;
// 1182 PLANT(X'1A12'); ! AR 1,2
PLANT(6674);
// 1183 PCONST(X'59304000'); ! C 3,0(4)
PCONST(1496334336);
// 1184 K=J; PJ(7,K); ->L1
K = J;
PJ(7, K);
goto U_1027;
// 1185 L301: I=FIND(J,LABEL(LEVEL))
U_102D:;
I = FIND(J, LABEL[LEVEL]);
// 1186 PRX(X'87',1,2,10,I-CODEBASE(LEVEL)); ->L1;! BXLE 1,2,ADDR
PRX(135, 1, 2, 10, I - CODEBASE[LEVEL]);
goto U_1027;
// 1187 SW(4): ! (LABEL)':'
case_SW_4:;
// 1188 K=A(P+2)+(A(P+1)-1)<<14
K = A[P + 2 + 2] + (A[P + 1 + 2] - 1 << 14);
// 1189 ->L402 %IF FIND(K,LABEL(LEVEL))=-1
if (FIND(K, LABEL[LEVEL]) != -1) goto L_00FF;
goto U_102E;
L_00FF:;
// 1190 FAULT(2); ->L1
FAULT(2);
goto U_1027;
// 1191 L402: PLAB(K); ->L1
U_102E:;
PLAB(K);
goto U_1027;
// 1192 SW(5): Q=P+1; MARKER2=P+3+A (P+2);
case_SW_5:;
Q = P + 1;
MARKER2 = P + 3 + A[P + 2 + 2];
// 1193 SET LINE; P=MARKER2
SETLINE();
P = MARKER2;
// 1194 SAVE13=R13; CHNGE13=0
SAVE13 = R13;
CHNGE13 = 0;
// 1195 ->L510 %IF A(P)=3; ! UI=JUMP
if (A[P + 2] != 3) goto L_0100;
goto U_102F;
L_0100:;
// 1196 ->L520 %IF A(P)=9; ! UI =START
if (A[P + 2] != 9) goto L_0101;
goto U_1030;
L_0101:;
// 1197 PLABEL=PLABEL-2; JJJ=PLABEL+1; KKK=PLABEL
PLABEL = PLABEL - 2;
JJJ = PLABEL + 1;
KKK = PLABEL;
// 1198 P=Q+2; CCOND(A(Q)-1,JJJ,KKK)
P = Q + 2;
CCOND(A[Q + 2] - 1, JJJ, KKK);
// 1199 P LOCAL JUMP(MASK,KKK)
PLOCALJUMP(MASK, KKK);
// 1200 R13=0 %UNLESS R13=SAVE13 %AND CHNGE13=0
if (R13 != SAVE13) goto L_0102;
if (CHNGE13 == 0) goto L_0103;
L_0102:;
R13 = 0;
L_0103:;
// 1201 PUSH(LOCAL LABEL,CA,JJJ)
PUSH(/*?*/ &LOCALLABEL, CA, JJJ);
// 1202 P=MARKER2; CUI(1)
P = MARKER2;
CUI(1);
// 1203 ->L104 %UNLESS A(P)=1; ! %ELSE FOLLOWS
if (A[P + 2] == 1) goto L_0104;
goto U_1029;
L_0104:;
// 1204 P=P+1; ->L107 %IF A(P)=9; ! UI=START
P = P + 1;
if (A[P + 2] != 9) goto L_0105;
goto U_1031;
L_0105:;
// 1205 PLABEL=PLABEL-1; JJJ=PLABEL
PLABEL = PLABEL - 1;
JJJ = PLABEL;
// 1206 P LOCAL JUMP(15,JJJ)
PLOCALJUMP(15, JJJ);
// 1207 PUSH(LOCAL LABEL,CA,KKK)
PUSH(/*?*/ &LOCALLABEL, CA, KKK);
// 1208 R13=0 %UNLESS R13=SAVE13 %AND CHNGE13=0
if (R13 != SAVE13) goto L_0106;
if (CHNGE13 == 0) goto L_0107;
L_0106:;
R13 = 0;
L_0107:;
// 1209 MASK=15; CUI(2); KKK=JJJ; ->L104
MASK = 15;
CUI(2);
KKK = JJJ;
goto U_1029;
// 1210 L107: PJ(15,SFLABEL-1)
U_1031:;
PJ(15, SFLABEL - 1);
// 1211 CUI(2); ->L104
CUI(2);
goto U_1029;
// 1212 L510: PLABEL=PLABEL-1; JJJ=PLABEL
U_102F:;
PLABEL = PLABEL - 1;
JJJ = PLABEL;
// 1213 NMDECS(LEVEL)=1
NMDECS[LEVEL] = 1;
// 1214 KKK=A(P+2)+(A(P+1)-1)<<14
KKK = A[P + 2 + 2] + (A[P + 1 + 2] - 1 << 14);
// 1215 P=Q+2; CCOND(2-A(Q),JJJ,KKK)
P = Q + 2;
CCOND(2 - A[Q + 2], JJJ, KKK);
// 1216 PLOCAL JUMP(MASK,KKK)
PLOCALJUMP(MASK, KKK);
// 1217 R13=0 %UNLESS R13=SAVE13 %AND CHNGE13=0
if (R13 != SAVE13) goto L_0108;
if (CHNGE13 == 0) goto L_0109;
L_0108:;
R13 = 0;
L_0109:;
// 1218 PUSH(LOCAL LABEL,CA,JJJ)
PUSH(/*?*/ &LOCALLABEL, CA, JJJ);
// 1219 P=MARKER2+3; ->L102 %UNLESS A(P)=1
P = MARKER2 + 3;
if (A[P + 2] == 1) goto L_010A;
goto U_102A;
L_010A:;
// 1220 P=P+1; MASK=15; CUI(0); ->L102
P = P + 1;
MASK = 15;
CUI(0);
goto U_102A;
// 1221 L520: PLABEL=PLABEL-1; JJJ=PLABEL
U_1030:;
PLABEL = PLABEL - 1;
JJJ = PLABEL;
// 1222 KKK=SFLABEL-1
KKK = SFLABEL - 1;
// 1223 P=Q+2; CCOND(A(Q)-1,JJJ,KKK)
P = Q + 2;
CCOND(A[Q + 2] - 1, JJJ, KKK);
// 1224 P LOCAL JUMP(MASK,KKK)
PLOCALJUMP(MASK, KKK);
// 1225 R13=0 %UNLESS R13=SAVE13 %AND CHNGE13=0
if (R13 != SAVE13) goto L_010B;
if (CHNGE13 == 0) goto L_010C;
L_010B:;
R13 = 0;
L_010C:;
// 1226 PUSH(LOCAL LABEL,CA,JJJ)
PUSH(/*?*/ &LOCALLABEL, CA, JJJ);
// 1227 P=MARKER2; CUI(1); P=P+1
P = MARKER2;
CUI(1);
P = P + 1;
// 1228 FAULT(53) %IF A(P)=1; ->L102
if (A[P + 2] != 1) goto L_010D;
FAULT(53);
L_010D:;
goto U_102A;
// 1229 SW(6):L1: ! %COMMENT
case_SW_6:;
U_1027:;
// 1230 %RETURN
return;
// 1231 SW(7): ! SIMPLE DECLN
case_SW_7:;
// 1232 FAULT(57) %UNLESS LEVEL>=2
if (LEVEL >= 2) goto L_010E;
FAULT(57);
L_010E:;
// 1233 FAULT(40) %IF NMDECS(LEVEL)#0
if (NMDECS[LEVEL] == 0) goto L_010F;
FAULT(40);
L_010F:;
// 1234 P=P+1;CLT;ROUT=0
P = P + 1;
CLT();
ROUT = 0;
// 1235 FAULT(70) %IF TYPE=5 %AND ACC=0
if (TYPE != 5) goto L_0110;
if (ACC != 0) goto L_0110;
FAULT(70);
L_0110:;
// 1236 ->SCALAR %IF A(P)=1
if (A[P + 2] != 1) goto L_0111;
goto U_1032;
L_0111:;
// 1237 ->VECTOR %IF A(P)=3
if (A[P + 2] != 3) goto L_0112;
goto U_1033;
L_0112:;
// 1238 ARR=1; NAM=(2-A(P+1))<<1; ! NAME ARRAY BIT
ARR = 1;
NAM = 2 - A[P + 1 + 2] << 1;
// 1239 PACK(PTYPE); P=P+2; SET LINE
PACK(/*?*/ &PTYPE);
P = P + 2;
SETLINE();
// 1240 ACC=4 %IF NAM#0;CADCLN(0);->L1
if (NAM == 0) goto L_0113;
ACC = 4;
L_0113:;
CADCLN(0);
goto U_1027;
// 1241 VECTOR: ARR=2; NAM=0; PACK(PTYPE)
U_1033:;
ARR = 2;
NAM = 0;
PACK(/*?*/ &PTYPE);
// 1242 P=P+1; SET LINE; CVDECLN; ->L1
P = P + 1;
SETLINE();
CVDECLN();
goto U_1027;
// 1243 SCALAR: J=0;ROUT=0;CQN(P+1);P=P+2
U_1032:;
J = 0;
ROUT = 0;
CQN(P + 1);
P = P + 2;
// 1244 INC=N
INC = N;
// 1245 QQ=ACC;ACC=4 %IF TYPE=5;JJ=0
QQ = ACC;
if (TYPE != 5) goto L_0114;
ACC = 4;
L_0114:;
JJ = 0;
// 1246 ->L701 %UNLESS ACC=8 %AND N&7#0
if (ACC != 8) goto L_0115;
if (N & 7 != 0) goto L_0116;
L_0115:;
goto U_1034;
L_0116:;
// 1247 PUSH(WSP(LEVEL),0,N);N=N+4 ;!DOUBLE WORD BOUNDARY
PUSH(/*?*/ &WSP[LEVEL], 0, N);
N = N + 4;
// 1248 L701: SET LINE %IF TYPE=5
U_1034:;
if (TYPE != 5) goto L_0117;
SETLINE();
L_0117:;
// 1249 PACK(PTYPE)
PACK(/*?*/ &PTYPE);
// 1250 %CYCLE KK=1,1,A(P)
// %for KK = 1, 1, A[P + 2] %cycle
{
int _final = A[P + 2];
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle KK = 1, 1, A[P + 2]");
KK = 0;
L_0118:
if (KK == _final) goto L_0119;
KK += 1;
// 1251 K=A(P+KK);TESTNST
K = A[P + KK + 2];
TESTNST();
// 1252 STORE TAG(K,N)
STORETAG(K, N);
// 1253 ->L705 %UNLESS TYPE=5
if (TYPE == 5) goto L_011B;
goto U_1035;
L_011B:;
// 1254 JJ=JJ+QQ
JJ = JJ + QQ;
// 1255 PSS(X'D2',2,WSPR,0,GLA,128) %IF UNASS=1
if (UNASS != 1) goto L_011C;
PSS(210, 2, WSPR, 0, GLA, 128);
L_011C:;
// 1256 PRX(X'50',WSPR,RBASE,0,N) ;!STORE POINTER
PRX(80, WSPR, RBASE, 0, N);
// 1257 PSI(X'92',QQ-1,RBASE,N) ;!STORE MAX LENGTH
PSI(146, QQ - 1, RBASE, N);
// 1258 %IF KK=A(P) %THEN QQ=QQ+(JJ+7)&(-8)-JJ
if (KK != A[P + 2]) goto L_011D;
QQ = QQ + (JJ + 7 & (-8)) - JJ;
L_011D:;
// 1259 PRX(X'41',WSPR,WSPR,0,QQ) ;!ADVANCE WORK SPACE
PRX(65, WSPR, WSPR, 0, QQ);
// 1260 L705: N=N+ACC;%REPEAT
U_1035:;
N = N + ACC;
goto L_0118;
}
L_0119:;
// 1261 N=N+3; N=N&(-4)
N = N + 3;
N = N & (-4);
// 1262 SET80(INC,N-INC) %IF UNASS=1 %AND TYPE#5
if (UNASS != 1) goto L_011E;
if (TYPE == 5) goto L_011E;
SET80(INC, N - INC);
L_011E:;
// 1263 ->L1
goto U_1027;
// 1264 SW(8): ! %END
case_SW_8:;
// 1265 CEND(FLAG(LEVEL))
CEND(FLAG[LEVEL]);
// 1266 ->L1
goto U_1027;
// 1267 SW(9): P=P+1; MARKER1=A(P)+P; !(SEX)(RT)(SPEC')(NAME)(FPP)
case_SW_9:;
P = P + 1;
MARKER1 = A[P + 2] + P;
// 1268 L900: Q=P; KKK=A(MARKER1+1); !KKK ON NAME
U_1036:;
Q = P;
KKK = A[MARKER1 + 1 + 2];
// 1269 EXTRN=A(P+1)
EXTRN = A[P + 1 + 2];
// 1270 ->L902 %IF A(MARKER1)=2
if (A[MARKER1 + 2] != 2) goto L_011F;
goto U_1037;
L_011F:;
// 1271 P=P+1; CRSPEC(0); ->L1 %IF EXTRN=3
P = P + 1;
CRSPEC(0);
if (EXTRN != 3) goto L_0120;
goto U_1027;
L_0120:;
// 1272 N0=N0-1; KK='S'*(2-EXTRN)
N0 = N0 - 1;
KK = 83 * (2 - EXTRN);
// 1273 GXREF(KKK,KK); JJ=TAGS(KKK)
GXREF(KKK, KK);
JJ = TAGS[KKK];
// 1274 FROM1(JJ,Q)
FROM1(JJ, /*?*/ &Q);
// 1275 REPLACE1(JJ,Q&(-2)); ->L1
REPLACE1(JJ, Q & (-2));
goto U_1027;
// 1276 L902: FILL JUMPS(LEVEL)
U_1037:;
FILLJUMPS(LEVEL);
// 1277 KK=KKK
KK = KKK;
// 1278 COPY TAG(KKK); ->L939 %IF OLDI#LEVEL
COPYTAG(KKK);
if (OLDI == LEVEL) goto L_0121;
goto U_1038;
L_0121:;
// 1279 %UNLESS EXTRN=3 %THEN %START
if (EXTRN == 3) goto L_0122;
// 1280 CPRMODE=2 %IF CPRMODE=0
if (CPRMODE != 0) goto L_0123;
CPRMODE = 2;
L_0123:;
// 1281 FAULT(55) %UNLESS CPRMODE=2 %AND LEVEL=1
if (CPRMODE != 2) goto L_0076;
if (LEVEL == 1) goto L_0124;
L_0076:;
FAULT(55);
L_0124:;
// 1282 DEFINE EP(EXTRN,KKK,CA)
DEFINEEP(EXTRN, KKK, CA);
// 1283 PCLOD(0); ! ST 12,28(GLA)--L 12,=A(PERM)
PCLOD(0);
// 1284 %FINISH
L_0122:;
// 1285 ->L908 %IF A(P+2)=1; ROUT=1
if (A[P + 2 + 2] != 1) goto L_0125;
goto U_1039;
L_0125:;
ROUT = 1;
// 1286 P=P+3
P = P + 3;
// 1287 CLT;ARR=0;NAM=(A(P)-1)<<1; ! SET NAME ARRAY BIT FOR MAPS
CLT();
ARR = 0;
NAM = A[P + 2] - 1 << 1;
// 1288 PACK(KKK); ->L909
PACK(/*?*/ &KKK);
goto U_103A;
// 1289 L908: KKK=10000
U_1039:;
KKK = 10000;
// 1290 L909: ->L940 %IF J=15 %AND PTYPE=KKK
U_103A:;
if (J != 15) goto L_0126;
if (PTYPE != KKK) goto L_0126;
goto U_103B;
L_0126:;
// 1291 FNAME=KK; FAULT(7) %UNLESS PTYPE&7=7
FNAME = KK;
if (PTYPE & 7 == 7) goto L_0127;
FAULT(7);
L_0127:;
// 1292 L939: P=Q+1; CRSPEC(0); P=Q; ->L900
U_1038:;
P = Q + 1;
CRSPEC(0);
P = Q;
goto U_1036;
// 1293 L940: J=0; REPLACETAG(KK); JJ=K; ! CHANGE TAG TO ROUT SPECIFIED AND DESCRIBED
U_103B:;
J = 0;
REPLACETAG(KK);
JJ = K;
// 1294 PLABEL=PLABEL-1
PLABEL = PLABEL - 1;
// 1295 PJ(15,PLABEL) %UNLESS COMPILER=1 %OR(CPRMODE=2 %AND LEVEL=1)
if (COMPILER == 1) goto L_0128;
if (CPRMODE != 2) goto L_011A;
if (LEVEL == 1) goto L_0128;
L_011A:;
PJ(15, PLABEL);
L_0128:;
// 1296 RAL(LEVEL)=NMAX<<16!SBFLAG<<15!N
RAL[LEVEL] = NMAX << 16 | SBFLAG << 15 | N;
// 1297 RHEAD(KK)
RHEAD(KK);
// 1298 PPJ(40) %UNLESS EXTRN=3; ! TO RELOCATE OWNS
if (EXTRN == 3) goto L_0129;
PPJ(40);
L_0129:;
// 1299 FLAG(LEVEL)=PTYPE
FLAG[LEVEL] = PTYPE;
// 1300 P=MARKER1+1
P = MARKER1 + 1;
// 1301 ->L942 %IF A(P+1)=2
if (A[P + 1 + 2] != 2) goto L_012A;
goto U_103C;
L_012A:;
// 1302 L943: P=P+2; COMPILE FORMAL PARAMETER
U_103D:;
P = P + 2;
COMPILEFORMALPARAMETER();
// 1303 %CYCLE BXLE=1,1,A(P)
// %for BXLE = 1, 1, A[P + 2] %cycle
{
int _final = A[P + 2];
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle BXLE = 1, 1, A[P + 2]");
BXLE = 0;
L_012B:
if (BXLE == _final) goto L_012C;
BXLE += 1;
// 1304 MLINK(JJ); ->L945 %UNLESS JJ=0
MLINK(/*?*/ &JJ);
if (JJ == 0) goto L_012E;
goto U_103E;
L_012E:;
// 1305 FAULT(8); ->L946
FAULT(8);
goto U_103F;
// 1306 L945: FROM LIST(JJ,J,JJJ)
U_103E:;
FROMLIST(JJ, /*?*/ &J, /*?*/ &JJJ);
// 1307 ->L946 %IF J=PTYPE %AND(PTYPE#5 %OR JJJ=ACC)
if (J != PTYPE) goto L_012F;
if (PTYPE != 5) goto L_0130;
if (JJJ != ACC) goto L_012F;
L_0130:;
goto U_103F;
L_012F:;
// 1308 FAULT(9); PRINT NAME(A(P+BXLE))
FAULT(9);
PRINTNAME(A[P + BXLE + 2]);
// 1309 L946: K=A(P+BXLE); TESTNST
U_103F:;
K = A[P + BXLE + 2];
TESTNST();
// 1310 OPHEAD=0; UNPACK
OPHEAD = 0;
UNPACK();
// 1311 ->L947 %IF ROUT=1; ! RT TYPES
if (ROUT != 1) goto L_0131;
goto U_1040;
L_0131:;
// 1312 ->L9040 %IF PTYPE=5; J=JJJ
if (PTYPE != 5) goto L_0132;
goto U_1041;
L_0132:;
J = JJJ;
// 1313 ->L948 %IF TYPE=3; !RECORDS
if (TYPE != 3) goto L_0133;
goto U_1042;
L_0133:;
// 1314 R=N; ->L950 %IF ARR=1
R = N;
if (ARR != 1) goto L_0134;
goto U_1043;
L_0134:;
// 1315 ->L949 %IF PREC=3 %AND NAM=0; ! LONG
if (PREC != 3) goto L_0135;
if (NAM != 0) goto L_0135;
goto U_1044;
L_0135:;
// 1316 N=N+4-ACC; R=N
N = N + 4 - ACC;
R = N;
// 1317 L950: STORE TAG(K,N)
U_1043:;
STORETAG(K, N);
// 1318 N=R+ACC; ->L999
N = R + ACC;
goto U_1045;
// 1319 L947: PUSH(OPHEAD,N,1000); !SET DUMMY SIDECHAIN FOR RT TYPES
U_1040:;
PUSH(/*?*/ &OPHEAD, N, 1000);
// 1320 J=13
J = 13;
// 1321 L951: KK=OPHEAD
U_1046:;
KK = OPHEAD;
// 1322 R=N; N=KK; ->L950
R = N;
N = KK;
goto U_1043;
// 1323 L9040: PRX(X'41',1,0,RBASE,N+4); ! STRING VALUE SET PTR
U_1041:;
PRX(65, 1, 0, RBASE, N + 4);
// 1324 PRX(X'50',1,0,RBASE,N)
PRX(80, 1, 0, RBASE, N);
// 1325 PSI(X'92',JJJ-1,RBASE,N)
PSI(146, JJJ - 1, RBASE, N);
// 1326 STORE TAG(K,N)
STORETAG(K, N);
// 1327 N=N+(ACC+7)&(-4); ->L999
N = N + (ACC + 7 & (-4));
goto U_1045;
// 1328 L948: PUSH(OPHEAD,0,N); J=0; ->L951; ! DUMMY SIDECHAIN FOR RECORD
U_1042:;
PUSH(/*?*/ &OPHEAD, 0, N);
J = 0;
goto U_1046;
// 1329 L949: R=N; ->L950 %IF N&7=0
U_1044:;
R = N;
if (N & 7 != 0) goto L_0136;
goto U_1043;
L_0136:;
// 1330 PUSH(WSP(LEVEL),0,N)
PUSH(/*?*/ &WSP[LEVEL], 0, N);
// 1331 N=N+4; R=N; ->L950; !ALLIGN ON D W BOUNDARY
N = N + 4;
R = N;
goto U_1043;
// 1332 L999: %REPEAT
U_1045:;
goto L_012B;
}
L_012C:;
// 1333 P=P+1+BXLE; ->L943 %IF A(P)=1
P = P + 1 + BXLE;
if (A[P + 2] != 1) goto L_0137;
goto U_103D;
L_0137:;
// 1334 L942: MLINK(JJ); FAULT(10) %UNLESS JJ=0; ->L1202
U_103C:;
MLINK(/*?*/ &JJ);
if (JJ == 0) goto L_0138;
FAULT(10);
L_0138:;
goto U_1047;
// 1335 !
// 1336 SW(10): ! COMMENT
case_SW_10:;
// 1337 ->L1
goto U_1027;
// 1338 !
// 1339 SW(11): !REALS(LN)
case_SW_11:;
// 1340 ALL LONG=A(P+1)&1;->L1
ALLLONG = A[P + 1 + 2] & 1;
goto U_1027;
// 1341 SW(12): !%BEGIN
case_SW_12:;
// 1342 FILL JUMPS(LEVEL)
FILLJUMPS(LEVEL);
// 1343 RAL(LEVEL)=SBFLAG<<15!N
RAL[LEVEL] = SBFLAG << 15 | N;
// 1344 PTYPE=0; RHEAD(-1)
PTYPE = 0;
RHEAD(-1);
// 1345 FLAG(LEVEL)=0
FLAG[LEVEL] = 0;
// 1346 ->L1 %IF LEVEL=1=RLEVEL
{
// Double-sided test on 1 (Part I)
int tmp;
if (LEVEL != (tmp = 1)) goto L_0139;
// Double-sided test on 1 (Part II)
if (tmp != RLEVEL) goto L_0139;
}
goto U_1027;
L_0139:;
// 1347 ->L1202 %UNLESS LEVEL=2
if (LEVEL == 2) goto L_013A;
goto U_1047;
L_013A:;
// 1348 CPRMODE=1 %IF CPRMODE=0
if (CPRMODE != 0) goto L_013B;
CPRMODE = 1;
L_013B:;
// 1349 DEFINE EP(0,0,0)
DEFINEEP(0, 0, 0);
// 1350 FAULT(55) %UNLESS CPRMODE=1
if (CPRMODE == 1) goto L_013C;
FAULT(55);
L_013C:;
// 1351 L1202: PLANT(X'05A0'); CODEBASE(LEVEL)=CA; ->L1
U_1047:;
PLANT(1440);
CODEBASE[LEVEL] = CA;
goto U_1027;
// 1352 SW(13): ! %ENDOFPROGRAM
case_SW_13:;
// 1353 FAULT(15) %UNLESS LEVEL=2
if (LEVEL == 2) goto L_013D;
FAULT(15);
L_013D:;
// 1354 FAULT(56) %UNLESS CPRMODE=1
if (CPRMODE == 1) goto L_013E;
FAULT(56);
L_013E:;
// 1355 PERM=0; CEND(1)
PERM = 0;
CEND(1);
// 1356 LOAD DATA; ->L1
LOADDATA();
goto U_1027;
// 1357 SW(14): %BEGIN; !SWITCH LABEL
case_SW_14:;
{ /*%begin*/
// 1358 !%SHORTROUTINE
// 1359 R13=0;MONE=1
R13 = 0;
MONE = 1;
// 1360 COPYTAG(A(P+1))
COPYTAG(A[P + 1 + 2]);
// 1361 ->L1401 %IF OLDI=LEVEL %AND TYPE=6
if (OLDI != LEVEL) goto L_013F;
if (TYPE != 6) goto L_013F;
goto U_1048;
L_013F:;
// 1362 FAULT(4); ->L1
FAULT(4);
goto U_1049;
// 1363 L1401: FROM LIST(K,ACC,KKK)
U_1048:;
FROMLIST(K, /*?*/ &ACC, /*?*/ &KKK);
// 1364 MLINK(K); FROM LIST(K,QQ,KK); ! UB & BIT LIST PART 1
MLINK(/*?*/ &K);
FROMLIST(K, /*?*/ &QQ, /*?*/ &KK);
// 1365 ->L1411 %UNLESS A(P+3)&7=1
if (A[P + 3 + 2] & 7 == 1) goto L_0140;
goto U_104A;
L_0140:;
// 1366 %IF A(P+3)=9 %THEN JJ=A(P+4) %ELSE %START
if (A[P + 3 + 2] != 9) goto L_0141;
JJ = A[P + 4 + 2];
goto L_0142;
L_0141:;
// 1367 FROMAR4(P+4,JJ); P=P+1; %FINISH
FROMAR4(P + 4, /*?*/ &JJ);
P = P + 1;
L_0142:;
// 1368 JJ=-JJ %IF A(P+2)=2
if (A[P + 2 + 2] != 2) goto L_0143;
JJ = -JJ;
L_0143:;
// 1369 ->L1402 %IF KKK<=JJ<=KK
{
// Double-sided test on JJ (Part I)
int tmp;
if (KKK > (tmp = JJ)) goto L_0144;
// Double-sided test on JJ (Part II)
if (tmp > KK) goto L_0144;
}
goto U_104B;
L_0144:;
// 1370 L1411: FAULT(5); ->L1
U_104A:;
FAULT(5);
goto U_1049;
// 1371 L1402: Q=JJ-KKK
U_104B:;
Q = JJ - KKK;
// 1372 L1404: ->L1403 %IF 31>=Q
U_104C:;
if (31 < Q) goto L_0145;
goto U_104D;
L_0145:;
// 1373 MLINK(K); Q=Q-32
MLINK(/*?*/ &K);
Q = Q - 32;
// 1374 FROM LIST(K,QQ,JJJ); ->L1404
FROMLIST(K, /*?*/ &QQ, /*?*/ &JJJ);
goto U_104C;
// 1375 L1403: JJJ=1<<Q; FAULT(6) %UNLESS JJJ&QQ=0
U_104D:;
JJJ = 1 << Q;
if (JJJ & QQ == 0) goto L_0146;
FAULT(6);
L_0146:;
// 1376 REPLACE1(K,QQ!JJJ); ! UPDATE BIT LIST
REPLACE1(K, QQ | JJJ);
// 1377 Q=CA-CODEBASE(LEVEL)
Q = CA - CODEBASE[LEVEL];
// 1378 ->L1407 %IF PREC#0
if (PREC == 0) goto L_0147;
goto U_104E;
L_0147:;
// 1379 QQ=ACC+8+(JJ-KKK)<<2; ! WHERE TO PLUG
QQ = ACC + 8 + (JJ - KKK << 2);
// 1380 PLUG(QQ,Q>>16) %UNLESS Q>>16=0
if ((unsigned int)Q >> 16 == 0) goto L_0148;
PLUG(QQ, (unsigned int)Q >> 16);
L_0148:;
// 1381 L1406: PLUG(QQ+2,Q&X'FFFF'); ->L1
U_104F:;
PLUG(QQ + 2, Q & 65535);
goto U_1049;
// 1382 L1407: QQ=ACC+6+(JJ-KKK)<<1
U_104E:;
QQ = ACC + 6 + (JJ - KKK << 1);
// 1383 FAULT(99) %IF Q>X'7FFF';->L1406
if (Q <= 32767) goto L_0149;
FAULT(99);
L_0149:;
goto U_104F;
// 1384 !
// 1385 L1: %END;->L1
U_1049:;
goto end_1000;
end_1000:;
}
goto U_1027;
// 1386 SW(15): %BEGIN; !SWITCH (SWITCH LIST)
case_SW_15:;
{ /*%begin*/
// 1387 !%SHORTROUTINE
// 1388 %INTEGER BP,QQQ
int BP;
int QQQ;
// 1389 Q=P;CNOP(0,4);PJ(15,PLABEL-1)
Q = P;
CNOP(0, 4);
PJ(15, PLABEL - 1);
// 1390 FAULT(56) %UNLESS LEVEL>=2
if (LEVEL >= 2) goto L_014A;
FAULT(56);
L_014A:;
// 1391 L1528: P=Q+A(Q+1)+2
U_104A:;
P = Q + A[Q + 1 + 2] + 2;
// 1392 CBPAIR(KKK,KK); ! LB TO KKK, UB TO KK
CBPAIR(/*?*/ &KKK, /*?*/ &KK);
// 1393 ->L1501 %UNLESS |KKK|<X'7FFF'>|KK|
{
// Double-sided test on 32767 (Part I)
int tmp;
if (_imp_IMOD(KKK) >= (tmp = 32767)) goto L_012D;
// Double-sided test on 32767 (Part II)
if (tmp > _imp_IMOD(KK)) goto L_014B;
}
L_012D:;
goto U_104B;
L_014B:;
// 1394 ->L1535 %IF KKK<=KK; FAULT(27); KK=KKK
if (KKK > KK) goto L_014C;
goto U_104C;
L_014C:;
FAULT(27);
KK = KKK;
// 1395 L1535: %CYCLE QQ=1,1,A(Q+1)
U_104C:;
// %for QQ = 1, 1, A[Q + 1 + 2] %cycle
{
int _final = A[Q + 1 + 2];
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle QQ = 1, 1, A[Q + 1 + 2]");
QQ = 0;
L_014D:
if (QQ == _final) goto L_014E;
QQ += 1;
// ?Non-local
// 1396 K=A(Q+QQ+1);TEST NST
K = A[Q + QQ + 1 + 2];
TESTNST();
// 1397 PREC=0
PREC = 0;
// 1398 PREC=2 %IF SBFLAG=1 %OR COMPILER=1
if (SBFLAG == 1) goto L_0150;
if (COMPILER != 1) goto L_0151;
L_0150:;
PREC = 2;
L_0151:;
// 1399 TYPE=6; ROUT=0; NAM=0; ARR=1; PACK(PTYPE)
TYPE = 6;
ROUT = 0;
NAM = 0;
ARR = 1;
PACK(/*?*/ &PTYPE);
// 1400 OPHEAD=NEWCELL; JJ=OPHEAD
OPHEAD = NEWCELL();
JJ = OPHEAD;
// 1401 J=0;STORE TAG(K,OPHEAD);R=KKK
J = 0;
STORETAG(K, OPHEAD);
R = KKK;
// 1402 INSERT AFTER (OPHEAD,0,KK)
INSERTAFTER(/*?*/ &OPHEAD, 0, KK);
// 1403 L1503: ->L1504 %IF KK-R<32
U_104D:;
if (KK - R >= 32) goto L_0152;
goto U_104E;
L_0152:;
// 1404 INSERT AFTER(OPHEAD,0,0)
INSERTAFTER(/*?*/ &OPHEAD, 0, 0);
// 1405 R=R+32; ->L1503; ! SET UP BIT LIST
R = R + 32;
goto U_104D;
// 1406 L1504: REPLACE BOTH(JJ,CA,KKK)
U_104E:;
REPLACEBOTH(JJ, CA, KKK);
// 1407 PCONST(KKK&X'FFFFFF'!PREC<<24)
PCONST(KKK & 16777215 | PREC << 24);
// 1408 PCONST(KK)
PCONST(KK);
// 1409 JJJ=KK-KKK
JJJ = KK - KKK;
// 1410 JJJ=(JJJ+1)//2 %IF PREC=2
if (PREC != 2) goto L_0153;
JJJ = ((long)(JJJ + 1) / (long)2);
L_0153:;
// 1411 %CYCLE I=0,1,JJJ
// %for I = 0, 1, JJJ %cycle
{
int _final = JJJ;
if (invalid_for_loop(0, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle I = 0, 1, JJJ");
I = -1;
L_0154:
if (I == _final) goto L_0155;
I += 1;
// ?Non-local
// 1412 PCONST(0);%REPEAT
PCONST(0);
goto L_0154;
}
L_0155:;
// 1413 %REPEAT
goto L_014D;
}
L_014E:;
// 1414 Q=P; ->L1528 %UNLESS A(Q)=2
Q = P;
if (A[Q + 2] == 2) goto L_0157;
goto U_104A;
L_0157:;
// 1415 PLAB(-1); ->L1
PLAB(-1);
goto U_104F;
// 1416 L1501: FAULT(18); KK=0; KKK=0; ->L1535
U_104B:;
FAULT(18);
KK = 0;
KKK = 0;
goto U_104C;
// 1417 L1: %END;
U_104F:;
goto end_1001;
end_1001:;
}
goto U_1027;
// ?QQQ unused
// ?BP unused
// 1418 ;->L1
case_SW_16:;
QU = (~A[P + 1 + 2]) & 1;
P = P + 2;
goto U_1027;
// 1418 SW(16): QU=\A(P+1)&1; P=P+2; ->L1
// 1419 !
// 1420 SW(17): ! '%REGISTER' (NAME)
case_SW_17:;
// 1421 KK=CLAIMABLE REG
KK = CLAIMABLEREG();
// 1422 ->L1999 %IF KK=0
if (KK != 0) goto L_0158;
goto U_1048;
L_0158:;
// 1423 REGISTER(KK)=-LEVEL
REGISTER[KK] = -LEVEL;
// 1424 UVARREG(KK)=LEVEL
UVARREG[KK - 5] = LEVEL;
// 1425 PTYPE=8; J=0
PTYPE = 8;
J = 0;
// 1426 K=A(P+1); TESTNST
K = A[P + 1 + 2];
TESTNST();
// 1427 STORE TAG(K,KK); ->L1
STORETAG(K, KK);
goto U_1027;
// 1428 SW(18): ! '%OWN' (TYPE)(OWNDEC)
case_SW_18:;
// 1429 %BEGIN
{ /*%begin*/
// 1430 !%SHORTROUTINE
// 1431 %INTEGER WSP1,LENGTH,BP,PP,SIGN
int WSP1;
int LENGTH;
int BP;
int PP;
int SIGN;
// 1432 %INTEGERNAME VAR
int *VAR;
// 1433 FAULT(40) %UNLESS NMDECS(LEVEL)=0
if (NMDECS[LEVEL] == 0) goto L_0159;
FAULT(40);
L_0159:;
// 1434 P=P+1; CLT
P = P + 1;
CLT();
// 1435 FAULT(70) %IF TYPE=5 %AND ACC=0
if (TYPE != 5) goto L_015A;
if (ACC != 0) goto L_015A;
FAULT(70);
L_015A:;
// 1436 NAM=0; ROUT=0; ARR=A(P)-1; PACK(PTYPE)
NAM = 0;
ROUT = 0;
ARR = A[P + 2] - 1;
PACK(/*?*/ &PTYPE);
// 1437 PP=P+1; P=P+2; ->NONSCALAR %UNLESS ARR=0
PP = P + 1;
P = P + 2;
if (ARR == 0) goto L_015B;
goto U_104F;
L_015B:;
// 1438 ->L1801 %UNLESS A(P)=2; ! NO CONST
if (A[P + 2] == 2) goto L_015C;
goto U_1050;
L_015C:;
// 1439 A(P+1)=4; A(P+2)=9; A(P+3)=0; ! 0== NULL STRING ALSO
A[P + 1 + 2] = 4;
A[P + 2 + 2] = 9;
A[P + 3 + 2] = 0;
// 1440 L1801: SIGN=A(P+1); ->L1820 %IF TYPE=5;! STRING
U_1050:;
SIGN = A[P + 1 + 2];
if (TYPE != 5) goto L_015D;
goto U_1051;
L_015D:;
// 1441 JJ= SORT CONST(P+2,PREC&1,TYPE)
JJ = SORTCONST(P + 2, PREC & 1, TYPE);
// 1442 ->L1810 %IF TYPE=2
if (TYPE != 2) goto L_015E;
goto U_1052;
L_015E:;
// 1443 VAR==ST(N0-1)
VAR = (int *)/*?*/ &ST[N0 - 1];
// 1444 FAULT(44)%IF(PREC=1 %AND VAR>255)%OR(PREC=2 %AND |VAR|>>16#0)
if (PREC != 1) goto L_015F;
if (*VAR > 255) goto L_014F;
L_015F:;
if (PREC != 2) goto L_0160;
if ((unsigned int)_imp_IMOD(*VAR) >> 16 == 0) goto L_0160;
L_014F:;
FAULT(44);
L_0160:;
// 1445 FAULT(44) %IF A(P+2)&7=2; ! REAL CONST FOR INTEGER VARIABLE
if (A[P + 2 + 2] & 7 != 2) goto L_0161;
FAULT(44);
L_0161:;
// 1446 %IF SIGN=2 %THEN VAR=-VAR
if (SIGN != 2) goto L_0162;
*VAR = -*VAR;
L_0162:;
// 1447 %IF SIGN=3 %THEN VAR=\VAR
if (SIGN != 3) goto L_0163;
*VAR = (~*VAR);
L_0163:;
// 1448 L1803: K=A(PP); TESTNST
U_1053:;
K = A[PP + 2];
TESTNST();
// 1449 JJ=JJ+4-BYTES(PREC) %UNLESS PREC=3
if (PREC == 3) goto L_0164;
JJ = JJ + 4 - BYTES[PREC];
L_0164:;
// 1450 PUSH(TAGS(K),PTYPE<<16!LEVEL<<8!GLA<<4,JJ)
PUSH(/*?*/ &TAGS[K], PTYPE << 16 | LEVEL << 8 | GLA << 4, JJ);
// 1451 PUSH(NAME(LEVEL),0,K); ->L99
PUSH(/*?*/ &NAME[LEVEL], 0, K);
goto U_1054;
// 1452 L1810: FAULT(44) %IF SIGN=3; ! \ WITH REAL
U_1052:;
if (SIGN != 3) goto L_0165;
FAULT(44);
L_0165:;
// 1453 ->L1803 %UNLESS SIGN=2
if (SIGN == 2) goto L_0166;
goto U_1053;
L_0166:;
// 1454 ST(JJ>>2)=ST(JJ>>2)!X'80000000';! OR IN SIGN BIT
ST[(unsigned int)JJ >> 2] = ST[(unsigned int)JJ >> 2] | (-2147483648);
// 1455 ->L1803
goto U_1053;
// 1456 L1820: ! STRINGS
U_1051:;
// 1457 ->L1822 %UNLESS A(P+2)=9 %AND A(P+3)<127
if (A[P + 2 + 2] != 9) goto L_0167;
if (A[P + 3 + 2] < 127) goto L_0168;
L_0167:;
goto U_1055;
L_0168:;
// 1458 A(P+2)=5; A(P+4)=A(P+3); A(P+3)=1
A[P + 2 + 2] = 5;
A[P + 4 + 2] = A[P + 3 + 2];
A[P + 3 + 2] = 1;
// 1459 L1822: FAULT(44) %UNLESS SIGN=4 %AND A(P+2)=5 %AND A(P+3)<ACC
U_1055:;
if (SIGN != 4) goto L_0169;
if (A[P + 2 + 2] != 5) goto L_0169;
if (A[P + 3 + 2] < ACC) goto L_016A;
L_0169:;
FAULT(44);
L_016A:;
// 1460 QQ=CONSTPTR<<2
QQ = CONSTPTR << 2;
// 1461 %CYCLE JJ=0,4,(ACC-1)&(-4)
// %for JJ = 0, 4, ACC - 1 & ( -4) %cycle
{
int _final = ACC - 1 & (-4);
if (invalid_for_loop(0, 4, _final)) _imp_signal(5, 1, 0, "Illegal cycle JJ = 0, 4, ACC - 1 & ( -4)");
JJ = -4;
L_016B:
if (JJ == _final) goto L_016C;
JJ += 4;
// ?Non-local
// 1462 WSP1=A(P+JJ+3)<<8!A(P+JJ+4)&255;! COLLECT THE SYMBOLS FROM
WSP1 = A[P + JJ + 3 + 2] << 8 | A[P + JJ + 4 + 2] & 255;
// 1463 WSP1=WSP1<<8!A(P+JJ+5)&255; ! A.R AND ASSEMBLE INTO FOURS
WSP1 = WSP1 << 8 | A[P + JJ + 5 + 2] & 255;
// 1464 WSP1=WSP1<<8!A(P+JJ+6)&255
WSP1 = WSP1 << 8 | A[P + JJ + 6 + 2] & 255;
// 1465 PSYM(WSP1); ! THEN ADD TO SYMBOL TABLES
PSYM(WSP1);
// 1466 %REPEAT
goto L_016B;
}
L_016C:;
// 1467 PRX(X'58',2,0,GLA,8); ! BASE OF ST TO REG2
PRX(88, 2, 0, GLA, 8);
// 1468 LOADAD(1,2,GLA,QQ); ! ABSOLUTE ADDR OF STING
LOADAD(1, 2, GLA, QQ);
// 1469 PRX(X'50',1,0,RBASE,N); ! STUFF IT OFF
PRX(80, 1, 0, RBASE, N);
// 1470 PSI(X'92',ACC-1,RBASE,N); !
PSI(146, ACC - 1, RBASE, N);
// 1471 K=A(PP); TESTNST
K = A[PP + 2];
TESTNST();
// 1472 J=0;STORE TAG(K,N)
J = 0;
STORETAG(K, N);
// 1473 N=N+4; ->L99
N = N + 4;
goto U_1054;
// 1474 NONSCALAR:CBPAIR(KK,KKK)
U_104F:;
CBPAIR(/*?*/ &KK, /*?*/ &KKK);
// 1475 %IF TYPE=5 %THEN BP=ACC %ELSE BP=BYTES(PREC)
if (TYPE != 5) goto L_016E;
BP = ACC;
goto L_016F;
L_016E:;
BP = BYTES[PREC];
L_016F:;
// 1476 LENGTH=KKK-KK+1
LENGTH = KKK - KK + 1;
// 1477 %IF A(P+1)=0 %THEN ->L3; ! NO CONSTLIST
if (A[P + 1 + 2] != 0) goto L_0170;
goto U_1056;
L_0170:;
// 1478 L1: FAULT(45) %UNLESS KKK>=KK %AND LENGTH=A(P+1)
U_1057:;
if (KKK < KK) goto L_016D;
if (LENGTH == A[P + 1 + 2]) goto L_0171;
L_016D:;
FAULT(45);
L_0171:;
// 1479 QQ=CONSTPTR<<2
QQ = CONSTPTR << 2;
// 1480 JJ=A(P+2)<<2
JJ = A[P + 2 + 2] << 2;
// 1481 %COMMENT OUTPUT AN ARRAYHEAD RELATIVE TO QQ
// 1482 ST(N0)=JJ-KK*BP
ST[N0] = JJ - KK * BP;
// 1483 ST(N0+1)=JJ
ST[N0 + 1] = JJ;
// 1484 ST(N0+2)=QQ
ST[N0 + 2] = QQ;
// 1485 ST(N0+3)=OWNLINK
ST[N0 + 3] = OWNLINK;
// 1486 %COMMENT NOW OUTPUT DOPE VECTOR
// 1487 PSYM(1<<16!BP)
PSYM(1 << 16 | BP);
// 1488 PSYM(KK)
PSYM(KK);
// 1489 PSYM(KKK)
PSYM(KKK);
// 1490 %COMMENT NOW PLANT CODE
// 1491 K=A(PP); J=1; TEST NST
K = A[PP + 2];
J = 1;
TESTNST();
// 1492 OWNLINK=N0<<2
OWNLINK = N0 << 2;
// 1493 RBASE=GLA; STORETAG(K,OWNLINK)
RBASE = GLA;
STORETAG(K, OWNLINK);
// 1494 RBASE=10-RLEVEL; N0=N0+4; ->L99
RBASE = 10 - RLEVEL;
N0 = N0 + 4;
goto U_1054;
// 1495 L3: A(P+2)=CONSTPTR
U_1056:;
A[P + 2 + 2] = CONSTPTR;
// 1496 A(P+1)=LENGTH; ->L1 %IF LENGTH<1
A[P + 1 + 2] = LENGTH;
if (LENGTH >= 1) goto L_0172;
goto U_1057;
L_0172:;
// 1497 %CYCLE JJ=1,1,(LENGTH*BP+3)//4
// %for JJ = 1, 1, ( (long)(LENGTH * BP + 3) / (long)4 ) %cycle
{
int _final = ((long)(LENGTH * BP + 3) / (long)4);
if (invalid_for_loop(1, 1, _final))
_imp_signal(5, 1, 0, "Illegal cycle JJ = 1, 1, ( (long)(LENGTH * BP + 3) / (long)4 )");
JJ = 0;
L_0173:
if (JJ == _final) goto L_0174;
JJ += 1;
// ?Non-local
// 1498 PSYM(0); %REPEAT; ->L1
PSYM(0);
goto L_0173;
}
L_0174:;
goto U_1057;
// 1499 L99: %END; ->L1
U_1054:;
goto end_1002;
end_1002:;
}
goto U_1027;
// 1500 SW(19): ! %CLAIM/RELEASE ETC
case_SW_19:;
// 1501 COPY TAG(A(P+3))
COPYTAG(A[P + 3 + 2]);
// 1502 ->L1910 %IF A(P+2)=1; ! '%ARRAY'
if (A[P + 2 + 2] != 1) goto L_0176;
goto U_1049;
L_0176:;
// 1503 ->L1999 %UNLESS ARR=0 %AND TYPE=3
if (ARR != 0) goto L_0175;
if (TYPE == 3) goto L_0177;
L_0175:;
goto U_1048;
L_0177:;
// 1504 FROM2(K,K); ->L1920
FROM2(K, /*?*/ &K);
goto U_104A;
// 1505 L1910: ->L1999 %UNLESS ARR=1 %AND TYPE<=3 %AND J<=2
U_1049:;
if (ARR != 1) goto L_0178;
if (TYPE > 3) goto L_0178;
if (J <= 2) goto L_0179;
L_0178:;
goto U_1048;
L_0179:;
// 1506 L1920: ->L1930 %IF A(P+1)=2; ! %RELEASE
U_104A:;
if (A[P + 1 + 2] != 2) goto L_017A;
goto U_104B;
L_017A:;
// 1507 KK=CLAIMABLE REG; ->L1999 %IF KK=0
KK = CLAIMABLEREG();
if (KK != 0) goto L_017B;
goto U_1048;
L_017B:;
// 1508 REGISTER(KK)=A(P+3)+1
REGISTER[KK] = A[P + 3 + 2] + 1;
// 1509 PRX(X'58',KK,0,I,K); ! LOAD THE REGISTER
PRX(88, KK, 0, I, K);
// 1510 JJ=TAGS(A(P+3))
JJ = TAGS[A[P + 3 + 2]];
// 1511 FROM1(JJ,JJJ)
FROM1(JJ, /*?*/ &JJJ);
// 1512 JJJ=JJJ!KK<<12
JJJ = JJJ | KK << 12;
// 1513 L1925: REPLACE1(JJ,JJJ); ->L1
U_104C:;
REPLACE1(JJ, JJJ);
goto U_1027;
// 1514 L1930: ->L1999 %UNLESS INREG#0 %AND REGISTER(INREG)=A(P+3)+1
U_104B:;
if (INREG == 0) goto L_017C;
if (REGISTER[INREG] == A[P + 3 + 2] + 1) goto L_017D;
L_017C:;
goto U_1048;
L_017D:;
// 1515 REGISTER(INREG)=0; JJ=TAGS(A(P+3))
REGISTER[INREG] = 0;
JJ = TAGS[A[P + 3 + 2]];
// 1516 FROM1(JJ,JJJ)
FROM1(JJ, /*?*/ &JJJ);
// 1517 JJJ=JJJ&X'FFFF0FFF'; ->L1925
JJJ = JJJ & (-61441);
goto U_104C;
// 1518 L1999: FAULT(58); ->L1
U_1048:;
FAULT(58);
goto U_1027;
// 1519 SW(26): COMPILER=1; UNASS=0; ->L1
case_SW_26:;
COMPILER = 1;
UNASS = 0;
goto U_1027;
// 1520 SW(27): ! '%SPEC' FPP
case_SW_27:;
// 1521 P=P+1; ->L2701 %IF A(P+1)=1
P = P + 1;
if (A[P + 1 + 2] != 1) goto L_017E;
goto U_104D;
L_017E:;
// 1522 CRSPEC(2); ->L1
CRSPEC(2);
goto U_1027;
// 1523 L2701: COPY TAG(A(P))
U_104D:;
COPYTAG(A[P + 2]);
// 1524 ->L3901 %UNLESS PTYPE=4 %AND A(P+4)=2=A(P+3)
if (PTYPE != 4) goto L_017F;
{
// Double-sided test on 2 (Part I)
int tmp;
if (A[P + 4 + 2] != (tmp = 2)) goto L_017F;
// Double-sided test on 2 (Part II)
if (tmp == A[P + 3 + 2]) goto L_0180;
}
L_017F:;
goto U_104E;
L_0180:;
// 1525 P=P+2; K=DISPLACEMENT(TAGS(A(P-2)))
P = P + 2;
K = DISPLACEMENT(TAGS[A[P - 2 + 2]]);
// 1526 ->L1 %IF K=-1; OPHEAD=K;
if (K != -1) goto L_0181;
goto U_1027;
L_0181:;
OPHEAD = K;
// 1527 P=P+2; CRSPEC(3); ->L1
P = P + 2;
CRSPEC(3);
goto U_1027;
// 1528 SW(20): MCSWITCH=1; PERM=1; ->L1; ! %MCODE
case_SW_20:;
MCSWITCH = 1;
PERM = 1;
goto U_1027;
// 1529 SW(21): SBFLAG=1; ->L1
case_SW_21:;
SBFLAG = 1;
goto U_1027;
// 1530 SW(22): P=2; CUCI; ->L1; ! *UCI(S)
case_SW_22:;
P = 2;
CUCI();
goto U_1027;
// 1531 SW(23): ! %FAULT FAULTLIST
case_SW_23:;
// 1532 FAULT(26) %UNLESS LEVEL=2 %AND CPRMODE#2
if (LEVEL != 2) goto L_0182;
if (CPRMODE != 2) goto L_0183;
L_0182:;
FAULT(26);
L_0183:;
// 1533 P=P+1; Q=P+1
P = P + 1;
Q = P + 1;
// 1534 L2302: %IF A(Q)=2 %THEN ->L2303
U_104F:;
if (A[Q + 2] != 2) goto L_0184;
goto U_1050;
L_0184:;
// 1535 Q=Q+2; ->L2302
Q = Q + 2;
goto U_104F;
// 1536 L2303: K=A(Q+2)+(A(Q+1)-1)<<14
U_1050:;
K = A[Q + 2 + 2] + (A[Q + 1 + 2] - 1 << 14);
// 1537 KKK=A(P);PCONST(X'41100000'!KKK)
KKK = A[P + 2];
PCONST(1091567616 | KKK);
// 1538 FAULT(36) %IF KKK>32 %OR KKK=0 %OR KKK=29 %OR 12<=KKK<=13
if (KKK > 32) goto L_0185;
if (KKK == 0) goto L_0185;
if (KKK == 29) goto L_0185;
{
// Double-sided test on KKK (Part I)
int tmp;
if (12 > (tmp = KKK)) goto L_0186;
// Double-sided test on KKK (Part II)
if (tmp > 13) goto L_0186;
}
L_0185:;
FAULT(36);
L_0186:;
// 1539 PPJ(20); QQ=CA
PPJ(20);
QQ = CA;
// 1540 PJ(15,K); ! JUMP TO LABEL
PJ(15, K);
// 1541 PCONST(X'07000700') %UNLESS CA=QQ+8;! JUMP MUST BE 8 BYTES
if (CA == QQ + 8) goto L_0187;
PCONST(117442304);
L_0187:;
// 1542 P=P+2; ->L2303 %IF A(P-1)=1
P = P + 2;
if (A[P - 1 + 2] != 1) goto L_0188;
goto U_1050;
L_0188:;
// 1543 ->L1 %IF A(P+2)=2
if (A[P + 2 + 2] != 2) goto L_0189;
goto U_1027;
L_0189:;
// 1544 P=P+3; Q=P+1; ->L2302
P = P + 3;
Q = P + 1;
goto U_104F;
// 1545 SW(24): FAULT(56) %UNLESS CPRMODE=2 %AND RLEVEL=1
case_SW_24:;
if (CPRMODE != 2) goto L_018A;
if (RLEVEL == 1) goto L_018B;
L_018A:;
FAULT(56);
L_018B:;
// 1546 LOAD DATA;FINALISE
LOADDATA();
FINALISE();
// 1547 %STOP
_imp_stop(0);
// 1548 SW(25): MCSWITCH=0; PERM=0; ->L1; ! %ENDOFMCODE
case_SW_25:;
MCSWITCH = 0;
PERM = 0;
goto U_1027;
// 1549 SW(28): !%NAME - SPECIAL NAME
case_SW_28:;
// 1550 J=0; PTYPE=10006
J = 0;
PTYPE = 10006;
// 1551 STORE TAG(A(P+1),SNUM)
STORETAG(A[P + 1 + 2], SNUM);
// 1552 SNUM=SNUM+1;->L1
SNUM = SNUM + 1;
goto U_1027;
// 1553 SW(29): LIST=1; ->L1; ! %LIST
case_SW_29:;
LIST = 1;
goto U_1027;
// 1554 SW(30): LIST=0; ->L1
case_SW_30:;
LIST = 0;
goto U_1027;
// 1555 SW(31): ! %CONTROL CONST
case_SW_31:;
// 1556 %IF A(P+1)=9 %THEN J=A(P+2) %ELSE FROMAR4(P+2,J)
if (A[P + 1 + 2] != 9) goto L_018C;
J = A[P + 2 + 2];
goto L_018D;
L_018C:;
FROMAR4(P + 2, /*?*/ &J);
L_018D:;
// 1557 K=J&15; LINENOS=K %UNLESS K=15
K = J & 15;
if (K == 15) goto L_018E;
LINENOS = K;
L_018E:;
// 1558 K=J>>4&15; DIAGS1=K %UNLESS K=15
K = (unsigned int)J >> 4 & 15;
if (K == 15) goto L_018F;
DIAGS1 = K;
L_018F:;
// 1559 K=J>>8&15
K = (unsigned int)J >> 8 & 15;
// 1560 CHECKS=K %UNLESS K=15
if (K == 15) goto L_0190;
CHECKS = K;
L_0190:;
// 1561 CHECKSP=K&14 %UNLESS K=15
if (K == 15) goto L_0191;
CHECKSP = K & 14;
L_0191:;
// 1562 K=J>>12&15
K = (unsigned int)J >> 12 & 15;
// 1563 UNASS=K %UNLESS K=15
if (K == 15) goto L_0192;
UNASS = K;
L_0192:;
// 1564 K=J>>28
K = (unsigned int)J >> 28;
// 1565 DCOMP=K %UNLESS K=15
if (K == 15) goto L_0193;
DCOMP = K;
L_0193:;
// 1566 ->L1
goto U_1027;
// 1567 SW(32): POP(SBR(LEVEL),J,K); ! FINISH (ELSE')
case_SW_32:;
POP(/*?*/ &SBR[LEVEL], /*?*/ &J, /*?*/ &K);
// 1568 ->L321 %UNLESS J=-1; FAULT(51); ->L1
if (J == -1) goto L_0194;
goto U_1051;
L_0194:;
FAULT(51);
goto U_1027;
// 1569 L321: POP(CYCLE(LEVEL),JJ,KK)
U_1051:;
POP(/*?*/ &CYCLE[LEVEL], /*?*/ &JJ, /*?*/ &KK);
// 1570 ->L322 %IF 0>=JJ
if (0 < JJ) goto L_0195;
goto U_1052;
L_0195:;
// 1571 FAULT(52); ->L321
FAULT(52);
goto U_1051;
// 1572 L322: ->L402 %UNLESS A(2)=1; ! ELSE FOLLOWS
U_1052:;
if (A[4] == 1) goto L_0196;
goto U_102E;
L_0196:;
// 1573 FAULT(47) %UNLESS J=1
if (J == 1) goto L_0197;
FAULT(47);
L_0197:;
// 1574 P=P+2; KK=K
P = P + 2;
KK = K;
// 1575 MONE=0;R13=0;SET LINE ;!CLEAR AFTER FINISH
MONE = 0;
R13 = 0;
SETLINE();
// 1576 %IF A(P)=9 %THEN JJ=SFLABEL-1 %ELSE JJ=PLABEL-1
if (A[P + 2] != 9) goto L_0198;
JJ = SFLABEL - 1;
goto L_0199;
L_0198:;
JJ = PLABEL - 1;
L_0199:;
// 1577 PJ(15,JJ); PLAB(KK); CUI(2); PLAB(-1); ->L1
PJ(15, JJ);
PLAB(KK);
CUI(2);
PLAB(-1);
goto U_1027;
// 1578 SW(33): !RECORD FORMAT
case_SW_33:;
// 1579 FAULT(56) %UNLESS LEVEL>=2
if (LEVEL >= 2) goto L_019A;
FAULT(56);
L_019A:;
// 1580 SET LINE; CRFORMAT; ->L1
SETLINE();
CRFORMAT();
goto U_1027;
// 1581 SW(34): !RECORDS
case_SW_34:;
// 1582 %BEGIN
{ /*%begin*/
auto void TESTANDSET(void);
// 1583 !%SHORTROUTINE
// 1584 %ROUTINESPEC TEST AND SET
// 1585 SET LINE; P=P+1; MARKER1=P+A(P)
SETLINE();
P = P + 1;
MARKER1 = P + A[P + 2];
// 1586 FAULT(57) %UNLESS LEVEL>=2
if (LEVEL >= 2) goto L_019B;
FAULT(57);
L_019B:;
// 1587 FAULT(40) %IF NMDECS(LEVEL)#0
if (NMDECS[LEVEL] == 0) goto L_019C;
FAULT(40);
L_019C:;
// 1588 CHECK RF;->L1 %IF K=-1
CHECKRF();
if (K != -1) goto L_019D;
goto U_1054;
L_019D:;
// 1589 TYPE=3;PREC=0;ROUT=0
TYPE = 3;
PREC = 0;
ROUT = 0;
// 1590 ->SCALAR %IF A(P+1)=1
if (A[P + 1 + 2] != 1) goto L_019E;
goto U_1055;
L_019E:;
// 1591 FAULT(41) %UNLESS A(P+2)=2; ! RECORD NAME ARRAYS FAULTED
if (A[P + 2 + 2] == 2) goto L_019F;
FAULT(41);
L_019F:;
// 1592 NAM=0; ARR=1; PACK(PTYPE)
NAM = 0;
ARR = 1;
PACK(/*?*/ &PTYPE);
// 1593 P=P+3
P = P + 3;
// 1594 L3401: QQ=P+1
U_1056:;
QQ = P + 1;
// 1595 PSS(X'D2',4,WSPR,0,4,0); ! MVC FOR LENGTH
PSS(210, 4, WSPR, 0, 4, 0);
// 1596 CADCLN(2)
CADCLN(2);
// 1597 %CYCLE Q=1,1,A(QQ)
// %for Q = 1, 1, A[QQ + 2] %cycle
{
int _final = A[QQ + 2];
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle Q = 1, 1, A[QQ + 2]");
Q = 0;
L_01A0:
if (Q == _final) goto L_01A1;
Q += 1;
// ?Non-local
// 1598 K=A(Q+QQ)
K = A[Q + QQ + 2];
// 1599 TEST AND SET
TESTANDSET();
// 1600 PPJ(13)
PPJ(13);
// 1601 PRX(X'90',0,3,RBASE,N)
PRX(144, 0, 3, RBASE, N);
// 1602 N=N+16
N = N + 16;
// 1603 %REPEAT
goto L_01A0;
}
L_01A1:;
// 1604 ->L1 %IF A(P)=2
if (A[P + 2] != 2) goto L_01A3;
goto U_1054;
L_01A3:;
// 1605 P=P+1;CHECK RF;->L3401
P = P + 1;
CHECKRF();
goto U_1056;
// 1606 SCALAR: CQN(P+2);P=P+3;J=0
U_1055:;
CQN(P + 2);
P = P + 3;
J = 0;
// 1607 PACK(PTYPE)
PACK(/*?*/ &PTYPE);
// 1608 %CYCLE Q=1,1,A(P)
// %for Q = 1, 1, A[P + 2] %cycle
{
int _final = A[P + 2];
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle Q = 1, 1, A[P + 2]");
Q = 0;
L_01A4:
if (Q == _final) goto L_01A5;
Q += 1;
// ?Non-local
// 1609 K=A(P+Q)
K = A[P + Q + 2];
// 1610 TEST AND SET
TESTANDSET();
// 1611 %IF NAM=1 %THEN PSS(X'D2',4,RBASE,N,GLA,128) %ELSE %C
if (NAM != 1) goto L_01A6;
PSS(210, 4, RBASE, N, GLA, 128);
goto L_01A7;
L_01A6:;
PACLOD(18, 2, RBASE << 12 | N);
L_01A7:;
// 1612+ PACLOD(18,2,RBASE<<12!N)
// 1613 %COMMENT = ST WSP,? - AH WSP,LENGTH - LA WSP,7(WSP) - N WSP,=F'-8'
// 1614 N=N+4; %REPEAT; ->L1
N = N + 4;
goto L_01A4;
}
L_01A5:;
goto U_1054;
// 1615 %ROUTINE TEST AND SET
void TESTANDSET(void) {
// 1616 TEST NST
TESTNST();
// 1617 JJJ=NEWCELL
JJJ = NEWCELL();
// 1618 STORE TAG(K,JJJ)
STORETAG(K, JJJ);
// 1619 REPLACE BOTH(JJJ,TAGS(A(MARKER1)),N)
REPLACEBOTH(JJJ, TAGS[A[MARKER1 + 2]], N);
// 1620 %END
return;
} /* end of TESTANDSET */
// 1621 L1: %END;->L1
U_1054:;
goto end_1003;
end_1003:;
}
goto U_1027;
// 1622 SW(35): ! (RT)'%NAME'(NAMELIST)
case_SW_35:;
// 1623 P=P+1; MARKER1=P+A(P)
P = P + 1;
MARKER1 = P + A[P + 2];
// 1624 ->L3801 %IF A(P+1)=1
if (A[P + 1 + 2] != 1) goto L_01A8;
goto U_1053;
L_01A8:;
// 1625 ROUT=1; P=P+2;CLT
ROUT = 1;
P = P + 2;
CLT();
// 1626 ARR=2-A(P+1);NAM=(A(P+2)-1)<<1
ARR = 2 - A[P + 1 + 2];
NAM = A[P + 2 + 2] - 1 << 1;
// 1627 PACK(PTYPE); ->L3802
PACK(/*?*/ &PTYPE);
goto U_1054;
// 1628 L3801: PTYPE=11000
U_1053:;
PTYPE = 11000;
// 1629 L3802: J=0;%CYCLE KK=1,1,A(MARKER1)
U_1054:;
J = 0;
// %for KK = 1, 1, A[MARKER1 + 2] %cycle
{
int _final = A[MARKER1 + 2];
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle KK = 1, 1, A[MARKER1 + 2]");
KK = 0;
L_01A9:
if (KK == _final) goto L_01AA;
KK += 1;
// 1630 K=A(MARKER1+KK)
K = A[MARKER1 + KK + 2];
// 1631 TESTNST; OPHEAD=0
TESTNST();
OPHEAD = 0;
// 1632 PUSH(OPHEAD,N,1000); ! SIDE CHAIN AS RT PARAM
PUSH(/*?*/ &OPHEAD, N, 1000);
// 1633 STORE TAG(K,OPHEAD); !LINK IN SIDE CHAIN
STORETAG(K, OPHEAD);
// 1634 N=N+40; %REPEAT; ->L1
N = N + 40;
goto L_01A9;
}
L_01AA:;
goto U_1027;
// 1635 SW(36): ! RECORD SPEC
case_SW_36:;
// 1636 P=P+1; MARKER1=P+A(P)
P = P + 1;
MARKER1 = P + A[P + 2];
// 1637 CHECK RF; ->L1 %IF K=-1
CHECKRF();
if (K != -1) goto L_01AB;
goto U_1027;
L_01AB:;
// 1638 P=P+1; COPYTAG(A(P))
P = P + 1;
COPYTAG(A[P + 2]);
// 1639 ->L3910 %IF A(P+1)=1
if (A[P + 1 + 2] != 1) goto L_01AC;
goto U_1055;
L_01AC:;
// 1640 ->L3902 %IF TYPE=3 %AND NAM=1
if (TYPE != 3) goto L_01AD;
if (NAM != 1) goto L_01AD;
goto U_1056;
L_01AD:;
// 1641 L3901: FAULT(63); ->L1
U_104E:;
FAULT(63);
goto U_1027;
// 1642 L3902: FROM1(K,Q)
U_1056:;
FROM1(K, /*?*/ &Q);
// 1643 FAULT(63) %UNLESS Q=0
if (Q == 0) goto L_01AE;
FAULT(63);
L_01AE:;
// 1644 REPLACE1(K,TAGS(A(MARKER1))); ->L1
REPLACE1(K, TAGS[A[MARKER1 + 2]]);
goto U_1027;
// 1645 L3910:
U_1055:;
// 1646 P=P+2; K=DISPLACEMENT(TAGS(A(P-2)))
P = P + 2;
K = DISPLACEMENT(TAGS[A[P - 2 + 2]]);
// 1647 ->L3901 %IF K=-1; ->L3902
if (K != -1) goto L_01AF;
goto U_104E;
L_01AF:;
goto U_1056;
// 1648 SW(37): ->L1; ! (S)
case_SW_37:;
goto U_1027;
// 1649 !
// 1650 %ROUTINE CEND (%INTEGER KKK)
void CEND(int KKK) {
// 1651 !%SHORT %ROUTINE
// 1652 %INTEGER DPTR,LNUM,W1,W2
int DPTR;
int LNUM;
int W1;
int W2;
// 1653 %INTEGERARRAY DD(0:300)
int DD[301];
// 1654 SET LINE; R13=0; MONE=1
SETLINE();
R13 = 0;
MONE = 1;
// 1655 L1: FROM LIST (SBR(LEVEL),J,K)
U_1058:;
FROMLIST(SBR[LEVEL], /*?*/ &J, /*?*/ &K);
// 1656 ->L2 %IF J=-1; FAULT(53); ! FINISH MISSING
if (J != -1) goto L_01B0;
goto U_1059;
L_01B0:;
FAULT(53);
// 1657 A(2)=32; A(3)=2; CSS(2); ! SO COMPILE IT IN
A[4] = 32;
A[5] = 2;
CSS(2);
// 1658 ->L1
goto U_1058;
// 1659 L2: FILL JUMPS(LEVEL)
U_1059:;
FILLJUMPS(LEVEL);
// 1660 NMAX=N %IF N>NMAX; ! WORK SPACE POINTER
if (N <= NMAX) goto L_01B1;
NMAX = N;
L_01B1:;
// 1661 POP (JUMP(LEVEL),J,K)
POP(/*?*/ &JUMP[LEVEL], /*?*/ &J, /*?*/ &K);
// 1662 ->L3 %IF J=-1
if (J != -1) goto L_01B2;
goto U_105A;
L_01B2:;
// 1663 ->L2 %IF K>=SFLABEL; FAULT(11)
if (K < SFLABEL) goto L_01B3;
goto U_1059;
L_01B3:;
FAULT(11);
// 1664 %IF K<16384 %THEN WRITE(K,4) %ELSE PRINTNAME(K-16384); ->L2;
if (K >= 16384) goto L_01B4;
_imp_WRITE(K, 4);
goto L_01B5;
L_01B4:;
PRINTNAME(K - 16384);
L_01B5:;
goto U_1059;
// 1665 L3: CLEAR LIST(LABEL(LEVEL))
U_105A:;
CLEARLIST(/*?*/ &LABEL[LEVEL]);
// 1666 CLEAR LIST (WSP (LEVEL))
CLEARLIST(/*?*/ &WSP[LEVEL]);
// 1667 CLEAR LIST(LWSP(LEVEL))
CLEARLIST(/*?*/ &LWSP[LEVEL]);
// 1668 CLEAR LIST(MDARR(LEVEL))
CLEARLIST(/*?*/ &MDARR[LEVEL]);
// 1669 CLEAR LIST(STR WSP(LEVEL))
CLEARLIST(/*?*/ &STRWSP[LEVEL]);
// 1670 %COMMENT CLEAR DECLARATIONS -PLANT DIAGNOSTICS IF REQUIRED
// 1671 ->L10 %IF DIAGS1=0
if (DIAGS1 != 0) goto L_01B6;
goto U_105B;
L_01B6:;
// 1672 LNUM=LETT(M(LEVEL))
LNUM = LETT[M[LEVEL]];
// 1673 DD(0)=X'C2C2C2C2'
DD[0] = -1027423550;
// 1674 DD(1)=L(LEVEL)<<16!RBASE<<8!LNUM
DD[1] = L[LEVEL] << 16 | RBASE << 8 | LNUM;
// 1675 DPTR=3; ->L9 %UNLESS LNUM=0
DPTR = 3;
if (LNUM == 0) goto L_01B7;
goto U_105C;
L_01B7:;
// 1676 DD(2)=L(LEVEL-1); ->L10
DD[2] = L[LEVEL - 1];
goto U_105B;
// 1677 L9: W1=M(LEVEL)
U_105C:;
W1 = M[LEVEL];
// 1678 %CYCLE W2=1,1,LNUM
// %for W2 = 1, 1, LNUM %cycle
{
int _final = LNUM;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle W2 = 1, 1, LNUM");
W2 = 0;
L_01B8:
if (W2 == _final) goto L_01B9;
W2 += 1;
// 1679 BYTE INTEGER(ADDR(DD(0))+7+W2)=LETT(W1+W2);! MOVE IN RT NAME
*_imp_BYTEINTEGER(_imp_ADDR(/*?*/ &DD[0]) + 7 + W2) = LETT[W1 + W2];
// 1680 %REPEAT
goto L_01B8;
}
L_01B9:;
// 1681 DPTR=DPTR+(LNUM-1)>>2
DPTR = DPTR + ((unsigned int)LNUM - 1 >> 2);
// 1682 L10: POP(NAME(LEVEL),J,JJ)
U_105B:;
POP(/*?*/ &NAME[LEVEL], /*?*/ &J, /*?*/ &JJ);
// 1683 ->L20 %IF J=-1
if (J != -1) goto L_01BA;
goto U_105D;
L_01BA:;
// 1684 COPY TAG(JJ);POP(TAGS(JJ),KK,KK)
COPYTAG(JJ);
POP(/*?*/ &TAGS[JJ], /*?*/ &KK, /*?*/ &KK);
// 1685 %IF PTYPE=8 %THEN %START
if (PTYPE != 8) goto L_01BB;
// 1686 REGISTER(K)=0; UVARREG(K)=0; %FINISH;!RELEASE REGISTERS
REGISTER[K] = 0;
UVARREG[K - 5] = 0;
L_01BB:;
// 1687 %IF INREG#0 %THEN REGISTER(INREG) =0
if (INREG == 0) goto L_01BC;
REGISTER[INREG] = 0;
L_01BC:;
// 1688 ->L12 %UNLESS J=15
if (J == 15) goto L_01BD;
goto U_105E;
L_01BD:;
// 1689 FAULT(28); PRINT NAME (JJ)
FAULT(28);
PRINTNAME(JJ);
// 1690 L12: OPHEAD=K; ->L13 %IF TYPE=4
U_105E:;
OPHEAD = K;
if (TYPE != 4) goto L_01BE;
goto U_105F;
L_01BE:;
// 1691 ->L14 %UNLESS ROUT=1 %OR TYPE=3 %OR TYPE=6 %OR ARR=2
if (ROUT == 1) goto L_01BF;
if (TYPE == 3) goto L_01BF;
if (TYPE == 6) goto L_01BF;
if (ARR == 2) goto L_01BF;
goto U_1060;
L_01BF:;
// 1692 CLEAR LIST(OPHEAD); ->L10
CLEARLIST(/*?*/ &OPHEAD);
goto U_105B;
// 1693 L13: UNDCRF (OPHEAD)
U_105F:;
UNDCRF(/*?*/ &OPHEAD);
// 1694 ->L10
goto U_105B;
// 1695 L14: ->L10 %UNLESS TYPE=1 %OR TYPE=2 %OR TYPE=5
U_1060:;
if (TYPE == 1) goto L_01C0;
if (TYPE == 2) goto L_01C0;
if (TYPE == 5) goto L_01C0;
goto U_105B;
L_01C0:;
// 1696 ->L10 %UNLESS ARR=0 %AND DIAGS1=1 %AND ROUT=0
if (ARR != 0) goto L_01A2;
if (DIAGS1 != 1) goto L_01A2;
if (ROUT == 0) goto L_01C1;
L_01A2:;
goto U_105B;
L_01C1:;
// 1697 ->L10 %IF DPTR>297
if (DPTR <= 297) goto L_01C2;
goto U_105B;
L_01C2:;
// 1698 Q=WORD(JJ);LNUM=LETT(Q)
Q = WORD[JJ];
LNUM = LETT[Q];
// 1699 LNUM=8 %IF LNUM>8; ! TRUNCATE NAMES TO 8 CHARS
if (LNUM <= 8) goto L_01C3;
LNUM = 8;
L_01C3:;
// 1700 PTYPE= NAM<<6!PREC<<3!TYPE
PTYPE = NAM << 6 | PREC << 3 | TYPE;
// 1701 DD(DPTR)=PTYPE<<24!I<<20!K<<8!LNUM
DD[DPTR] = PTYPE << 24 | I << 20 | K << 8 | LNUM;
// 1702 %CYCLE W1=1,1,LNUM
// %for W1 = 1, 1, LNUM %cycle
{
int _final = LNUM;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle W1 = 1, 1, LNUM");
W1 = 0;
L_01C4:
if (W1 == _final) goto L_01C5;
W1 += 1;
// 1703 BYTE INTEGER(ADDR(DD(DPTR))+W1+3)=LETT(W1+Q)
*_imp_BYTEINTEGER(_imp_ADDR(/*?*/ &DD[DPTR]) + W1 + 3) = LETT[W1 + Q];
// 1704 %REPEAT
goto L_01C4;
}
L_01C5:;
// 1705 DPTR=DPTR+1+(LNUM+3)>>2;->L10
DPTR = DPTR + 1 + ((unsigned int)LNUM + 3 >> 2);
goto U_105B;
// 1706 L20: ->L21 %IF DIAGS 1=0
U_105D:;
if (DIAGS1 != 0) goto L_01C7;
goto U_1061;
L_01C7:;
// 1707 DD(DPTR)=-1
DD[DPTR] = -1;
// 1708 LPUT(4,DPTR<<2+4,SSTL,ADDR(DD(0)))
LPUT(4, (DPTR << 2) + 4, SSTL, _imp_ADDR(/*?*/ &DD[0]));
// 1709 SSTL=SSTL+DPTR<<2+4
SSTL = SSTL + (DPTR << 2) + 4;
// 1710 %COMMENT CHECK CYCLE-REPEATS
// 1711 L21: ->L22 %IF CYCLE(LEVEL)=0
U_1061:;
if (CYCLE[LEVEL] != 0) goto L_01C8;
goto U_1062;
L_01C8:;
// 1712 FROM2(CYCLE(LEVEL),J)
FROM2(CYCLE[LEVEL], /*?*/ &J);
// 1713 ->L22 %IF J=0
if (J != 0) goto L_01C9;
goto U_1062;
L_01C9:;
// 1714 POP(CYCLE(LEVEL),I,I)
POP(/*?*/ &CYCLE[LEVEL], /*?*/ &I, /*?*/ &I);
// 1715 FAULT(13); ->L21
FAULT(13);
goto U_1061;
// 1716 L22: %COMMENT GARBAGE COLECT DICTIONARY
U_1062:;
// 1717 NEXT=RNEXT(LEVEL)
NEXT = RNEXT[LEVEL];
// 1718 %CYCLE W1=0,1,NNAMES
// %for W1 = 0, 1, NNAMES %cycle
{
int _final = NNAMES;
if (invalid_for_loop(0, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle W1 = 0, 1, NNAMES");
W1 = -1;
L_01CA:
if (W1 == _final) goto L_01CB;
W1 += 1;
// 1719 WORD(W1)=0 %IF WORD(W1)>NEXT
if (WORD[W1] <= NEXT) goto L_01CC;
WORD[W1] = 0;
L_01CC:;
// 1720 %REPEAT
goto L_01CA;
}
L_01CB:;
// 1721 %COMMENT PLANT ANY NECESSARY CODE
// 1722 NMAX=(NMAX+7)&(-8)
NMAX = NMAX + 7 & (-8);
// 1723 FAULT(99) %IF NMAX>4092
if (NMAX <= 4092) goto L_01CD;
FAULT(99);
L_01CD:;
// 1724 PLUG(SET(RLEVEL),NMAX) %IF KKK>=10000 %OR KKK=1
if (KKK >= 10000) goto L_01C6;
if (KKK != 1) goto L_01CE;
L_01C6:;
PLUG(SET[RLEVEL], NMAX);
L_01CE:;
// 1725 ->L23 %IF KKK=10000
if (KKK != 10000) goto L_01CF;
goto U_1063;
L_01CF:;
// 1726 ->L24 %IF KKK=0
if (KKK != 0) goto L_01D0;
goto U_1064;
L_01D0:;
// 1727 %IF KKK>10000 %AND COMPILER =0 %THEN %START
if (KKK <= 10000) goto L_01D1;
if (COMPILER != 0) goto L_01D1;
// 1728 PCONST(X'4100000B') ;!LA 0,11 --- FAULT 11
PCONST(1090519051);
// 1729 PPJ(21);%FINISH ;! *->RTF1
PPJ(21);
L_01D1:;
// 1730 PPJ(6) %IF KKK=1; ->L30; ! 'STOP' AT END OF PROGRAM
if (KKK != 1) goto L_01D2;
PPJ(6);
L_01D2:;
goto U_1065;
// 1731 L23: P=P+1; A(P)=5; CUI(0); ->L30; ! COMPILE '%RTURN' FOR ROUTINES
U_1063:;
P = P + 1;
A[P + 2] = 5;
CUI(0);
goto U_1065;
// 1732 L24: JJ=X'FFF'&RAL(LEVEL-1)
U_1064:;
JJ = 4095 & RAL[LEVEL - 1];
// 1733 PRX(X'98',10,11,RBASE,JJ); ! RESTORE R11&12
PRX(152, 10, 11, RBASE, JJ);
// 1734 PSS(X'D2',4,GLA,20,RBASE,JJ+8) %IF DIAGS1=1
if (DIAGS1 != 1) goto L_01D3;
PSS(210, 4, GLA, 20, RBASE, JJ + 8);
L_01D3:;
// 1735 L30: ->L99 %IF KKK=2; NEWLINE
U_1065:;
if (KKK != 2) goto L_01D4;
goto U_1066;
L_01D4:;
_imp_NEWLINE();
// 1736 %IF PRINTMAP=1 %AND LIST=1 %AND KKK#0 %THEN %START
if (PRINTMAP != 1) goto L_01D5;
if (LIST != 1) goto L_01D5;
if (KKK == 0) goto L_01D5;
// 1737 print string(" LOCALS EXTEND TO ")
_imp_PRINTSTRING(_imp_str_literal(" LOCALS EXTEND TO "));
// 1738 WRITE(NMAX,2); NEWLINE; %FINISH
_imp_WRITE(NMAX, 2);
_imp_NEWLINE();
L_01D5:;
// 1739 ->L31 %IF LIST#0; WRITE(LINE,5)
if (LIST == 0) goto L_01D6;
goto U_1067;
L_01D6:;
_imp_WRITE(LINE, 5);
// 1740 SPACES(3*LEVEL-3); print string("END")
_imp_SPACES(3 * LEVEL - 3);
_imp_PRINTSTRING(_imp_str_literal("END"));
// 1741 L31: ->L33 %IF LEVEL>2 %OR PERM=1 %OR CPRMODE=2
U_1067:;
if (LEVEL > 2) goto L_01D7;
if (PERM == 1) goto L_01D7;
if (CPRMODE != 2) goto L_01D8;
L_01D7:;
goto U_1068;
L_01D8:;
// 1742 ->L32 %IF KKK=1
if (KKK != 1) goto L_01D9;
goto U_1069;
L_01D9:;
// 1743 FAULT(14); A(1)=13; ->L99; ! TOO MANY ENDS
FAULT(14);
A[3] = 13;
goto U_1066;
// 1744 L32: KKK=2
U_1069:;
KKK = 2;
// 1745 L33: LEVEL=LEVEL-1
U_1068:;
LEVEL = LEVEL - 1;
// 1746 RLEVEL=RLEVEL-1 %IF KKK>=10000
if (KKK < 10000) goto L_01DA;
RLEVEL = RLEVEL - 1;
L_01DA:;
// 1747 RBASE=10-RLEVEL; REGISTER (9-RLEVEL)=0
RBASE = 10 - RLEVEL;
REGISTER[9 - RLEVEL] = 0;
// 1748 N=RAL(LEVEL); SBFLAG=N>>15&1
N = RAL[LEVEL];
SBFLAG = (unsigned int)N >> 15 & 1;
// 1749 NMAX=N>>16 %IF KKK>=10000; N=N&4095
if (KKK < 10000) goto L_01DB;
NMAX = (unsigned int)N >> 16;
L_01DB:;
N = N & 4095;
// 1750 ->L2 %IF KKK=2; ! ROUND AGAIN FOR 'ENDOFPROGRAM'
if (KKK != 2) goto L_01DC;
goto U_1059;
L_01DC:;
// 1751 ->L99 %IF RLEVEL=1 %AND CPRMODE=2
if (RLEVEL != 1) goto L_01DD;
if (CPRMODE != 2) goto L_01DD;
goto U_1066;
L_01DD:;
// 1752 ->L99 %IF KKK=0 %OR COMPILER=1
if (KKK == 0) goto L_01DE;
if (COMPILER != 1) goto L_01DF;
L_01DE:;
goto U_1066;
L_01DF:;
// 1753 FROM2(JUMP(LEVEL),J) ; PLAB(J)
FROM2(JUMP[LEVEL], /*?*/ &J);
PLAB(J);
// 1754 L99: %END
U_1066:;
return;
} /* end of CEND */
// 1755 %ROUTINE CRSPEC (%BYTEINTEGER M)
void CRSPEC(unsigned char M) {
// 1756 !%SHORTROUTINE
// 1757 %INTEGER PP,KK,JJ,JJJ,Q,TYPEP
int PP;
int KK;
int JJ;
int JJJ;
int Q;
int TYPEP;
// 1758 ->L12 %IF M=3
if (M != 3) goto L_01E0;
goto U_1059;
L_01E0:;
// 1759 PP=P; ->L2 %UNLESS M=2
PP = P;
if (M == 2) goto L_01E1;
goto U_105A;
L_01E1:;
// 1760 KK=A(P); P=P+1; COPYTAG(KK)
KK = A[P + 2];
P = P + 1;
COPYTAG(KK);
// 1761 ->L1 %IF OLDI=LEVEL %AND 10006#PTYPE>=10000
if (OLDI != LEVEL) goto L_01E2;
{
// Double-sided test on PTYPE (Part I)
int tmp;
if (10006 == (tmp = PTYPE)) goto L_01E2;
// Double-sided test on PTYPE (Part II)
if (tmp < 10000) goto L_01E2;
}
goto U_105B;
L_01E2:;
// 1762 FAULT(3); ->L99
FAULT(3);
goto U_105C;
// 1763 L1: FROM LIST(K,JJ,Q); OPHEAD=K
U_105B:;
FROMLIST(K, /*?*/ &JJ, /*?*/ &Q);
OPHEAD = K;
// 1764 ->L12 %IF Q=1000; ->L10
if (Q != 1000) goto L_01E3;
goto U_1059;
L_01E3:;
goto U_105D;
// 1765 L2: ->L3 %IF A(PP+1)=2
U_105A:;
if (A[PP + 1 + 2] != 2) goto L_01E4;
goto U_105E;
L_01E4:;
// 1766 TYPEP=10000; P=PP+3; ->L4
TYPEP = 10000;
P = PP + 3;
goto U_105F;
// 1767 L3: ROUT=1;ARR=0;P=PP+2;CLT
U_105E:;
ROUT = 1;
ARR = 0;
P = PP + 2;
CLT();
// 1768 NAM=(A(P)-1)*2; PACK(TYPEP); P=P+2
NAM = (A[P + 2] - 1) * 2;
PACK(/*?*/ &TYPEP);
P = P + 2;
// 1769 L4: KK=A(P); COPYTAG(KK)
U_105F:;
KK = A[P + 2];
COPYTAG(KK);
// 1770 ->L11 %IF OLDI#LEVEL
if (OLDI == LEVEL) goto L_01E5;
goto U_1060;
L_01E5:;
// 1771 ->L1 %IF PTYPE=TYPEP %OR |PTYPE-TYPEP|=1000
if (PTYPE == TYPEP) goto L_01E6;
if (_imp_IMOD(PTYPE - TYPEP) != 1000) goto L_01E7;
L_01E6:;
goto U_105B;
L_01E7:;
// 1772 L10: FNAME=KK;FAULT(7) %UNLESS PTYPE=7
U_105D:;
FNAME = KK;
if (PTYPE == 7) goto L_01E8;
FAULT(7);
L_01E8:;
// 1773 ->L99 %IF M=2
if (M != 2) goto L_01E9;
goto U_105C;
L_01E9:;
// 1774 L11: JJ=NR; NR=NR+1; RA(JJ)=4*N0; N0=N0+1
U_1060:;
JJ = NR;
NR = NR + 1;
RA[JJ] = 4 * N0;
N0 = N0 + 1;
// 1775 FAULT(109) %IF NR>NROUTS
if (NR <= NROUTS) goto L_01EA;
FAULT(109);
L_01EA:;
// 1776 OPHEAD=NEWCELL;J=15;PTYPE=TYPEP
OPHEAD = NEWCELL();
J = 15;
PTYPE = TYPEP;
// 1777 STORE TAG(KK,OPHEAD)
STORETAG(KK, OPHEAD);
// 1778 L12: JJJ=OPHEAD; Q=0; ->L24 %IF A(P+1)=2; ! NO FORMAL PARAMS
U_1059:;
JJJ = OPHEAD;
Q = 0;
if (A[P + 1 + 2] != 2) goto L_01EB;
goto U_1061;
L_01EB:;
// 1779 L13: P=P+2; COMPILE FORMAL PARAMETER
U_1062:;
P = P + 2;
COMPILEFORMALPARAMETER();
// 1780 %CYCLE PP=1,1,A(P)
// %for PP = 1, 1, A[P + 2] %cycle
{
int _final = A[P + 2];
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle PP = 1, 1, A[P + 2]");
PP = 0;
L_01EC:
if (PP == _final) goto L_01ED;
PP += 1;
// 1781 KK=0; KK=ACC %IF PTYPE=5
KK = 0;
if (PTYPE != 5) goto L_01EF;
KK = ACC;
L_01EF:;
// 1782 INSERT AFTER(OPHEAD,PTYPE,KK);! FOR STRINGS PUSH IN LMAX
INSERTAFTER(/*?*/ &OPHEAD, PTYPE, KK);
// 1783 Q=Q+1; %REPEAT
Q = Q + 1;
goto L_01EC;
}
L_01ED:;
// 1784 P=P+PP+1; ->L13 %IF A(P)=1
P = P + PP + 1;
if (A[P + 2] != 1) goto L_01F0;
goto U_1062;
L_01F0:;
// 1785 L24: REPLACE2(JJJ,Q)
U_1061:;
REPLACE2(JJJ, Q);
// 1786 ->L99 %IF M=3
if (M != 3) goto L_01F1;
goto U_105C;
L_01F1:;
// 1787 REPLACE1(JJJ,JJ)
REPLACE1(JJJ, JJ);
// 1788 L99: %END
U_105C:;
return;
} /* end of CRSPEC */
// 1789 %ROUTINE COMPILE FORMAL PARAMETER
void COMPILEFORMALPARAMETER(void) {
// 1790 !%SHORT %ROUTINE
// 1791 %SWITCH FPD(1:5)
int FPD_index;
int FPD_line;
char *FPD_file;
static const void *FPD[5] = {&&case_FPD_missing, &&case_FPD_missing, &&case_FPD_missing, &&case_FPD_missing,
&&case_FPD_missing};
// 1792 ->FPD(A(P))
FPD_line = __LINE__;
FPD_file = __FILE__;
FPD_index = A[P + 2];
goto case_FPD_dispatch;
// 1793 FPD(1): !(RT)
case_FPD_1:;
// 1794 ACC=16;ROUT=1;NAM=1
ACC = 16;
ROUT = 1;
NAM = 1;
// 1795 ARR=0
ARR = 0;
// 1796 ->L1 %UNLESS A(P+1)=1
if (A[P + 1 + 2] == 1) goto L_01F3;
goto U_106A;
L_01F3:;
// 1797 PREC=0;TYPE=0;P=P+3; ->L98
PREC = 0;
TYPE = 0;
P = P + 3;
goto U_106B;
// 1798 L1: P=P+2; CLT;NAM =2*(A(P)-1)+1
U_106A:;
P = P + 2;
CLT();
NAM = 2 * (A[P + 2] - 1) + 1;
// 1799 P=P+2; ACC=16; ->L98
P = P + 2;
ACC = 16;
goto U_106B;
// 1800 FPD(2): !(LENGTH')(TYPE)(ARRAY')(NAME)
case_FPD_2:;
// 1801 P=P+1; CLT
P = P + 1;
CLT();
// 1802 CQN(P); ROUT=0
CQN(P);
ROUT = 0;
// 1803 FAULT(70) %IF TYPE=5 %AND ACC=0
if (TYPE != 5) goto L_01F4;
if (ACC != 0) goto L_01F4;
FAULT(70);
L_01F4:;
// 1804 P=P+1; ->L98
P = P + 1;
goto U_106B;
// 1805 FPD(3): !%NAME
case_FPD_3:;
// 1806 TYPE=0
TYPE = 0;
// 1807 L31: NAM=1; ARR=2-A(P+1); ROUT=0
U_106C:;
NAM = 1;
ARR = 2 - A[P + 1 + 2];
ROUT = 0;
// 1808 ACC=4+12*ARR
ACC = 4 + 12 * ARR;
// 1809 PREC=0; P=P+2; ->L98
PREC = 0;
P = P + 2;
goto U_106B;
// 1810 FPD(4): TYPE=3; ->L31
case_FPD_4:;
TYPE = 3;
goto U_106C;
// 1811 L98: PACK(PTYPE)
U_106B:;
PACK(/*?*/ &PTYPE);
// 1812 %END
return;
case_FPD_dispatch:
if (FPD_index < 1 || FPD_index > 5)
_imp_signalf(6, 3, FPD_index, "->FPD(%d) out of bounds at %s line %d", FPD_index, FPD_file, FPD_line);
goto *FPD[FPD_index - 1];
case_FPD_missing:
_imp_signalf(8, 2, FPD_index, "switch jump to undefined label FPD(%d): at %s line %d", FPD_index, FPD_file,
FPD_line);
} /* end of COMPILEFORMALPARAMETER */
// 1813 %ROUTINE ASSIGN (%INTEGER P1,P2)
void ASSIGN(int P1, int P2) {
// 1814 !%SHORTROUTINE
// 1815 %INTEGER Q,ASSOP,KK,REG,PRECP,Z,ZP,TYPEP
int Q;
int ASSOP;
int KK;
int REG;
int PRECP;
int Z;
int ZP;
int TYPEP;
// 1816 %INTEGER JJJ
int JJJ;
// 1817 %SWITCH SW(1:4), S(0:15)
int SW_index;
int SW_line;
char *SW_file;
static const void *SW[4] = {&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing};
int S_index;
int S_line;
char *S_file;
static const void *S[16] = {&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing};
// 1818 ASSOP=A(P2); ->SW(ASSOP); !P2 ON ASSOP
ASSOP = A[P2 + 2];
SW_line = __LINE__;
SW_file = __FILE__;
SW_index = ASSOP;
goto case_SW_dispatch;
// 1819 SW(2):SW(3): COPYTAG(A(P1+1)); P=P2+1
case_SW_2:;
case_SW_3:;
COPYTAG(A[P1 + 1 + 2]);
P = P2 + 1;
// 1820 ->REGVAR %IF TYPE=8
if (TYPE != 8) goto L_01F6;
goto U_105F;
L_01F6:;
// 1821 ->MAPS %IF ROUT=1
if (ROUT != 1) goto L_01F7;
goto U_1060;
L_01F7:;
// 1822 ->L34 %IF TYPE=2
if (TYPE != 2) goto L_01F8;
goto U_1061;
L_01F8:;
// 1823 ->L50 %IF TYPE=5
if (TYPE != 5) goto L_01F9;
goto U_1062;
L_01F9:;
// 1824 ->L35 %IF TYPE=3
if (TYPE != 3) goto L_01FA;
goto U_1063;
L_01FA:;
// 1825 ->L32 %IF NAM=0 %AND TYPE=1 %AND ARR=0
if (NAM != 0) goto L_01FB;
if (TYPE != 1) goto L_01FB;
if (ARR != 0) goto L_01FB;
goto U_1064;
L_01FB:;
// 1826 L33: P=P2+1
U_1065:;
P = P2 + 1;
// 1827 KK=0; KK=4 %UNLESS ARR=0 %AND ROUT=0 %AND 1>=TYPE
KK = 0;
if (ARR != 0) goto L_01EE;
if (ROUT != 0) goto L_01EE;
if (1 >= TYPE) goto L_01FC;
L_01EE:;
KK = 4;
L_01FC:;
// 1828 L36: %IF KK=4 %AND REGISTER(4)#0 %THEN KK=14
U_1066:;
if (KK != 4) goto L_01FD;
if (REGISTER[4] == 0) goto L_01FD;
KK = 14;
L_01FD:;
// 1829 CSEXP(KK,1); REG=NEST;KK=P
CSEXP(KK, 1);
REG = NEST;
KK = P;
// 1830 REGISTER(REG)=1 %IF REGISTER(REG)=0
if (REGISTER[REG] != 0) goto L_01FE;
REGISTER[REG] = 1;
L_01FE:;
// 1831 P=P1+1; CNAME((ASSOP-1)*(ASSOP-1),REG)
P = P1 + 1;
CNAME((ASSOP - 1) * (ASSOP - 1), REG);
// 1832 REGISTER(REG)=0 %IF REGISTER(REG)>0
if (REGISTER[REG] <= 0) goto L_01FF;
REGISTER[REG] = 0;
L_01FF:;
// 1833 L30:
U_1067:;
// 1834 P=KK; %IF A(P)=1=QU %THEN CQUERY (REG)
P = KK;
{
// Double-sided test on 1 (Part I)
int tmp;
if (A[P + 2] != (tmp = 1)) goto L_0200;
// Double-sided test on 1 (Part II)
if (tmp != QU) goto L_0200;
}
CQUERY(REG);
L_0200:;
// 1835 P=P+1; ->L1
P = P + 1;
goto U_1068;
// 1836 L31: print string(" CRUNCH "); %MONITOR ; %STOP
U_1069:;
_imp_PRINTSTRING(_imp_str_literal(" CRUNCH "));
/*_imp_monitor(__LINE__, __FILE__, PRETTY_FUNCTION);*/
_imp_stop(0);
// 1837 L32: ->L33 %IF ROUT=1 %OR A(P1+2)=1 %OR A(P1+3)=1;! ACTUAL PARAMS
U_1064:;
if (ROUT == 1) goto L_0201;
if (A[P1 + 2 + 2] == 1) goto L_0201;
if (A[P1 + 3 + 2] != 1) goto L_0202;
L_0201:;
goto U_1065;
L_0202:;
// 1838 ->L33 %IF UNASS =1
if (UNASS != 1) goto L_0203;
goto U_1065;
L_0203:;
// 1839 PRECP=PREC; TYPEP=PTYPE
PRECP = PREC;
TYPEP = PTYPE;
// 1840 KK=K; REG=I; Q=TSEXP(JJJ)
KK = K;
REG = I;
Q = TSEXP(/*?*/ &JJJ);
// 1841 PTYPE=TYPEP; UNPACK
PTYPE = TYPEP;
UNPACK();
// 1842 ->L33 %IF Q=0 %OR A(P)=1=QU
if (Q == 0) goto L_0204;
{
// Double-sided test on 1 (Part I)
int tmp;
if (A[P + 2] != (tmp = 1)) goto L_0205;
// Double-sided test on 1 (Part II)
if (tmp != QU) goto L_0205;
}
L_0204:;
goto U_1065;
L_0205:;
// 1843 ->L37 %IF 10<=Q<=12 %AND Q-10=PRECP
{
// Double-sided test on Q (Part I)
int tmp;
if (10 > (tmp = Q)) goto L_0206;
// Double-sided test on Q (Part II)
if (tmp > 12) goto L_0206;
}
if (Q - 10 != PRECP) goto L_0206;
goto U_106D;
L_0206:;
// 1844 ->L33 %UNLESS Q=1 %AND PRECP=1
if (Q != 1) goto L_0207;
if (PRECP == 1) goto L_0208;
L_0207:;
goto U_1065;
L_0208:;
// 1845 PSI(X'92',JJJ,REG,KK); ! MVI TO SET BYTE
PSI(146, JJJ, REG, KK);
// 1846 P=P+1;->L1; ! SKIP QUERY IF ANY
P = P + 1;
goto U_1068;
// 1847 L37: PSS(X'D2',BYTES(PRECP),REG,KK,I,K); ! MVC IF POSSIBL
U_106D:;
PSS(210, BYTES[PRECP], REG, KK, I, K);
// 1848 P=P+1; ->L1
P = P + 1;
goto U_1068;
// 1849 L34: Q=2; Q=3 %IF PREC=3
U_1061:;
Q = 2;
if (PREC != 3) goto L_0209;
Q = 3;
L_0209:;
// 1850 %IF A(P1+2)=1 %THEN %START
if (A[P1 + 2 + 2] != 1) goto L_020A;
// 1851 P=P1+2; FFLAG=0; SKIP APP; ->L55 %IF FFLAG#0
P = P1 + 2;
FFLAG = 0;
SKIPAPP();
if (FFLAG == 0) goto L_020B;
goto U_106E;
L_020B:;
// 1852 P=P2+1; %FINISH
P = P2 + 1;
L_020A:;
// 1853 CSEXP(0,Q); KK=P
CSEXP(0, Q);
KK = P;
// 1854 FREG(NEST)=1; REG=NEST
FREG[NEST] = 1;
REG = NEST;
// 1855 P=P1+1; CNAME(1,NEST)
P = P1 + 1;
CNAME(1, NEST);
// 1856 FREG(REG)=0
FREG[REG] = 0;
// 1857 ->L30
goto U_1067;
// 1858 L35: P=P1+1; Q=COPY RECORD TAG
U_1063:;
P = P1 + 1;
Q = COPYRECORDTAG();
// 1859 P=P2+1
P = P2 + 1;
// 1860 TYPE=1 %UNLESS TYPE=2 %OR TYPE=5
if (TYPE == 2) goto L_020C;
if (TYPE == 5) goto L_020C;
TYPE = 1;
L_020C:;
// 1861 ->L50 %IF TYPE=5
if (TYPE != 5) goto L_020D;
goto U_1062;
L_020D:;
// 1862 KK=4; ->L36 %IF TYPE=1; ->L34
KK = 4;
if (TYPE != 1) goto L_020E;
goto U_1066;
L_020E:;
goto U_1061;
// 1863 L50: CSTREXP(4);KK=P
U_1062:;
CSTREXP(4);
KK = P;
// 1864 REGISTER(4)=1
REGISTER[4] = 1;
// 1865 P=P1+1;
P = P1 + 1;
// 1866 CNAME((ASSOP-1)^^2,4)
CNAME(_imp_IEXP(ASSOP - 1, 2), 4);
// 1867 REGISTER(4)=0
REGISTER[4] = 0;
// 1868 REG=4; ->L30
REG = 4;
goto U_1067;
// 1869 MAPS: %IF PTYPE=10006 %THEN %START
U_1060:;
if (PTYPE != 10006) goto L_020F;
// 1870 TYPE=TSNAME(K);PREC=TYPE>>3
TYPE = TSNAME[K];
PREC = (unsigned int)TYPE >> 3;
// 1871 TYPE=TYPE&7; %FINISH
TYPE = TYPE & 7;
L_020F:;
// 1872 ->L33 %IF TYPE=1; ! NORMAL CHANNELS FOR INT MAPS
if (TYPE != 1) goto L_0210;
goto U_1065;
L_0210:;
// 1873 ->L50 %IF TYPE=5; ! STRING MAPS
if (TYPE != 5) goto L_0211;
goto U_1062;
L_0211:;
// 1874 L55: P=P2+1; PRECP=PREC
U_106E:;
P = P2 + 1;
PRECP = PREC;
// 1875 CSEXP(0,2+PREC&1)
CSEXP(0, 2 + (PREC & 1));
// 1876 Q=PARKF(NEST,3)
Q = PARKF(NEST, 3);
// 1877 KK=P; P=P1+1; CNAME(3,1); ! ADDR TO GR1
KK = P;
P = P1 + 1;
CNAME(3, 1);
// 1878 DUMP(16,0,Q,0,RBASE); ! PICK UP TO FR0
DUMP(16, 0, Q, 0, RBASE);
// 1879 DUMP(9+2*PREC,0,0,0,1); ! STUFF IT OFF
DUMP(9 + 2 * PREC, 0, 0, 0, 1);
// 1880 PUSH(LWSP(LEVEL),0,Q); ->L30; ! TO QUERY PRINT
PUSH(/*?*/ &LWSP[LEVEL], 0, Q);
goto U_1067;
// 1881 REGVAR: FAULT(59) %UNLESS A(P1+2)=2=A(P1+3)
U_105F:;
{
// Double-sided test on 2 (Part I)
int tmp;
if (A[P1 + 2 + 2] != (tmp = 2)) goto L_0212;
// Double-sided test on 2 (Part II)
if (tmp == A[P1 + 3 + 2]) goto L_0213;
}
L_0212:;
FAULT(59);
L_0213:;
// 1882 KK=K; CSEXP(KK,1)
KK = K;
CSEXP(KK, 1);
// 1883 REGISTER(KK)=-1
REGISTER[KK] = -1;
// 1884 %IF A(P)=1=QU %THEN CQUERY(REG)
{
// Double-sided test on 1 (Part I)
int tmp;
if (A[P + 2] != (tmp = 1)) goto L_0214;
// Double-sided test on 1 (Part II)
if (tmp != QU) goto L_0214;
}
CQUERY(REG);
L_0214:;
// 1885 P=P+1; ->L1
P = P + 1;
goto U_1068;
// 1886 SW(4): !ASSOP=->L
case_SW_4:;
// 1887 P=P1+1; CNAME(2,1)
P = P1 + 1;
CNAME(2, 1);
// 1888 P=P2+1
P = P2 + 1;
// 1889 CRES(0,0)
CRES(0, 0);
// 1890 P=P+1;->L1
P = P + 1;
goto U_1068;
// 1891 SW(1): !ASSOP='=='
case_SW_1:;
// 1892 P=P1+1; COPYTAG(A(P))
P = P1 + 1;
COPYTAG(A[P + 2]);
// 1893 ->L9 %IF I=-1;Q=1
if (I != -1) goto L_0215;
goto U_106F;
L_0215:;
Q = 1;
// 1894 %IF TYPE=3 %THEN Q=COPY RECORD TAG
if (TYPE != 3) goto L_0216;
Q = COPYRECORDTAG();
L_0216:;
// 1895 ->L201 %IF Q=0
if (Q != 0) goto L_0217;
goto U_1070;
L_0217:;
// 1896 FAULT(81) %UNLESS A(P2+1)=4 %AND A(P2+2)=1
if (A[P2 + 1 + 2] != 4) goto L_0218;
if (A[P2 + 2 + 2] == 1) goto L_0219;
L_0218:;
FAULT(81);
L_0219:;
// 1897 ->L101 %IF ROUT=1; NEST=4
if (ROUT != 1) goto L_021A;
goto U_1071;
L_021A:;
NEST = 4;
// 1898 ->S((NAM&2+ARR)<<2!(NAM&1)*2!(2-A(P+1)))
S_line = __LINE__;
S_file = __FILE__;
S_index = (NAM & 2) + ARR << 2 | (NAM & 1) * 2 | 2 - A[P + 1 + 2];
goto case_S_dispatch;
// 1899 L9: FNAME=A(P); FAULT(16)
U_106F:;
FNAME = A[P + 2];
FAULT(16);
// 1900 S(0):S(1):S(3):S(4):S(5):
case_S_0:;
case_S_1:;
case_S_3:;
case_S_4:;
case_S_5:;
// 1901 S(7):S(8):S(10):S(11):S(12):
case_S_7:;
case_S_8:;
case_S_10:;
case_S_11:;
case_S_12:;
// 1902 L10: FAULT(82)
U_1072:;
FAULT(82);
// 1903 P=P2+1; SKIPEXP; P=P+1; ->L1
P = P2 + 1;
SKIPEXP();
P = P + 1;
goto U_1068;
// 1904 S(2): ! NAM=1; S(9):!NAMARR + APP; S(15):! NAMARR +NAM+APP; S(13):
case_S_2:;
// 1905 Z=3; ZP=6
Z = 3;
ZP = 6;
// 1906 L12: P=P2+3; CNAME(Z,4)
U_1073:;
P = P2 + 3;
CNAME(Z, 4);
// 1907 ->L10 %UNLESS A(P)=2; PRECP=PREC
if (A[P + 2] == 2) goto L_021C;
goto U_1072;
L_021C:;
PRECP = PREC;
// 1908 TYPEP=TYPE
TYPEP = TYPE;
// 1909 KK=P+2; P=P1+1; CNAME(ZP,4)
KK = P + 2;
P = P1 + 1;
CNAME(ZP, 4);
// 1910 L14:
U_1074:;
// 1911 P=KK; ->L1 %IF PREC=PRECP %AND TYPE=TYPEP
P = KK;
if (PREC != PRECP) goto L_021D;
if (TYPE != TYPEP) goto L_021D;
goto U_1068;
L_021D:;
// 1912 FAULT(83); ->L1
FAULT(83);
goto U_1068;
// 1913 S(6): ! ARRAYNAME-NO APP
case_S_6:;
// 1914 S(14): !NAMARRAYNAME-NO APP
case_S_14:;
// 1915 Z=12; ZP=11; ->L12
Z = 12;
ZP = 11;
goto U_1073;
// 1916 L201:
U_1070:;
// 1917 ->S(6) %IF ARR=1 %AND NAM=1 %AND A(P+1)=2
if (ARR != 1) goto L_021E;
if (NAM != 1) goto L_021E;
if (A[P + 1 + 2] != 2) goto L_021E;
S_line = __LINE__;
S_file = __FILE__;
S_index = 6;
goto case_S_dispatch;
L_021E:;
// 1918 Z=15; ZP=14; ->L12
Z = 15;
ZP = 14;
goto U_1073;
// 1919 L101: P=P1+1; CNAME(13,1); ! ASSIGNMENTS TO RECORDNAMES
U_1071:;
P = P1 + 1;
CNAME(13, 1);
// 1920 PRECP=PREC; TYPEP=TYPE; JJJ=K;
PRECP = PREC;
TYPEP = TYPE;
JJJ = K;
// 1921 ->L10 %UNLESS J=0 %AND NAM=1
if (J != 0) goto L_021F;
if (NAM == 1) goto L_0220;
L_021F:;
goto U_1072;
L_0220:;
// 1922 REG=FINDPP; ->L31 %IF REG=0
REG = FINDPP();
if (REG != 0) goto L_0221;
goto U_1069;
L_0221:;
// 1923 DUMP(0,REG,DISP,INDEX,BASE); ! ADDRESS OF LHS TO SAFE PLACE
DUMP(0, REG, DISP, INDEX, BASE);
// 1924 P=P2+3; CNAME(13,1); ! RHSIDE
P = P2 + 3;
CNAME(13, 1);
// 1925 ->L102 %IF BASE=GLA %AND J=0; ! COMMON OR GARDEN ROUTINE
if (BASE != GLA) goto L_0222;
if (J != 0) goto L_0222;
goto U_1075;
L_0222:;
// 1926 PSS(X'D2',16,REG,0,BASE,DISP)
PSS(210, 16, REG, 0, BASE, DISP);
// 1927 ->L103 %IF J=14; ! EXTERNAL ROUTINE
if (J != 14) goto L_0223;
goto U_1076;
L_0223:;
// 1928 L110: REGISTER(REG)=0; KK=P+2
U_1077:;
REGISTER[REG] = 0;
KK = P + 2;
// 1929 FROM2(JJJ,Z); FROM2(K,ZP)
FROM2(JJJ, /*?*/ &Z);
FROM2(K, /*?*/ &ZP);
// 1930 FAULT(83) %UNLESS Z=ZP
if (Z == ZP) goto L_0224;
FAULT(83);
L_0224:;
// 1931 ->L14
goto U_1074;
// 1932 L102: DUMP(2,2,DISP,INDEX,BASE); ! PICK UP RT ADDR
U_1075:;
DUMP(2, 2, DISP, INDEX, BASE);
// 1933 PRX(X'5A',2,0,GLA,28); ! RELOCATE
PRX(90, 2, 0, GLA, 28);
// 1934 PCONST(X'180C181D'); ! LR 0,12 LR1,13 PERM AND GLA
PCONST(403445789);
// 1935 PRR(X'18',3,REG); ! CUNNING PTR TO ENVRMNT
PRR(24, 3, REG);
// 1936 PRX(X'90',0,9,REG,0); ->L110; ! STUFF OFF + ENVRMNT
PRX(144, 0, 9, REG, 0);
goto U_1077;
// 1937 L103: PRX(X'50',9,0,REG,12); ->L110; ! EXTRNS DUMMY ENVRMNT
U_1076:;
PRX(80, 9, 0, REG, 12);
goto U_1077;
// 1938 L1: %END
U_1068:;
return;
case_SW_dispatch:
if (SW_index < 1 || SW_index > 4)
_imp_signalf(6, 3, SW_index, "->SW(%d) out of bounds at %s line %d", SW_index, SW_file, SW_line);
goto *SW[SW_index - 1];
case_SW_missing:
_imp_signalf(8, 2, SW_index, "switch jump to undefined label SW(%d): at %s line %d", SW_index, SW_file, SW_line);
case_S_dispatch:
if (S_index < 0 || S_index > 15)
_imp_signalf(6, 3, S_index, "->S(%d) out of bounds at %s line %d", S_index, S_file, S_line);
goto *S[S_index - 0];
case_S_missing:
_imp_signalf(8, 2, S_index, "switch jump to undefined label S(%d): at %s line %d", S_index, S_file, S_line);
} /* end of ASSIGN */
// 1939 %ROUTINE CUI(%BYTEINTEGER CODE)
void CUI(unsigned char CODE) {
// 1940 !%SHORTROUTINE
// 1941 %INTEGER KK,JJ,QQ
int KK;
int JJ;
int QQ;
// 1942 %SWITCH SW(1:11)
int SW_index;
int SW_line;
char *SW_file;
static const void *SW[11] = {&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_missing, &&case_SW_missing};
// 1943 ->SW(A(P))
SW_line = __LINE__;
SW_file = __FILE__;
SW_index = A[P + 2];
goto case_SW_dispatch;
// 1944 SW(1): P=P+1; MARKER1=P+A(P); !(NAME)(APP)(RESTOFUI)
case_SW_1:;
P = P + 1;
MARKER1 = P + A[P + 2];
// 1945 ->L3 %IF A(MARKER 1)=1
if (A[MARKER1 + 2] != 1) goto L_0226;
goto U_1078;
L_0226:;
// 1946 P=P+1; CNAME(0,0); P=P+1; ->L1
P = P + 1;
CNAME(0, 0);
P = P + 1;
goto U_1058;
// 1947 L3: ASSIGN(P,MARKER1+1); ->L1
U_1078:;
ASSIGN(P, MARKER1 + 1);
goto U_1058;
// 1948 SW(2): !->L<NAME><EXRN>
case_SW_2:;
// 1949 NMDECS(LEVEL)=1
NMDECS[LEVEL] = 1;
// 1950 COPY TAG(A(P+1))
COPYTAG(A[P + 1 + 2]);
// 1951 PTYPEP=PTYPE
PTYPEP = PTYPE;
// 1952 KK=K; P=P+2
KK = K;
P = P + 2;
// 1953 ->L200 %IF OLDI=LEVEL %AND TYPE=6
if (OLDI != LEVEL) goto L_0227;
if (TYPE != 6) goto L_0227;
goto U_1059;
L_0227:;
// 1954 FAULT(4);SKIP EXP; ->L1
FAULT(4);
SKIPEXP();
goto U_1058;
// 1955 L200: CSEXP(1,1);PTYPE=PTYPEP; UNPACK
U_1059:;
CSEXP(1, 1);
PTYPE = PTYPEP;
UNPACK();
// 1956 FROM LIST(KK,QQ,JJ)
FROMLIST(KK, /*?*/ &QQ, /*?*/ &JJ);
// 1957 QQ=QQ-CODEBASE(LEVEL)
QQ = QQ - CODEBASE[LEVEL];
// 1958 ->L205 %IF CHECKSP=0
if (CHECKSP != 0) goto L_0228;
goto U_105A;
L_0228:;
// 1959 L201: LOADAD( 2,10,0,QQ);PPJ(7); ->L1
U_105B:;
LOADAD(2, 10, 0, QQ);
PPJ(7);
goto U_1058;
// 1960 L205: JJ=8+QQ-JJ*BYTES(PREC); !@ SW(0)
U_105A:;
JJ = 8 + QQ - JJ * BYTES[PREC];
// 1961 ->L201 %UNLESS 0<=JJ<=4095
{
// Double-sided test on JJ (Part I)
int tmp;
if (0 > (tmp = JJ)) goto L_0229;
// Double-sided test on JJ (Part II)
if (tmp <= 4095) goto L_022A;
}
L_0229:;
goto U_105B;
L_022A:;
// 1962 ->L210 %IF PREC=0
if (PREC != 0) goto L_022B;
goto U_105C;
L_022B:;
// 1963 PLANT(X'1A11');KK= X'48'; !AR_1,1
PLANT(6673);
KK = 72;
// 1964 L207: PRX(KK,1,1,10,JJ); !L(H)_1,JJ(1,10)
U_105D:;
PRX(KK, 1, 1, 10, JJ);
// 1965 PCONST(X'47F1A000');->L1; !BC_15,0(1,10)
PCONST(1207017472);
goto U_1058;
// 1966 L210: PCONST(X'89100002');KK= X'58';->L207;! SLL_1,2
U_105C:;
PCONST(-1995440126);
KK = 88;
goto U_105D;
// 1967 SW(3): ! '->L'(LABEL)
case_SW_3:;
// 1968 NMDECS(LEVEL)=1
NMDECS[LEVEL] = 1;
// 1969 K=A(P+2)+(A(P+1)-1)<<14
K = A[P + 2 + 2] + (A[P + 1 + 2] - 1 << 14);
// 1970 PJ(MASK,K); P=P+3; ->L1
PJ(MASK, K);
P = P + 3;
goto U_1058;
// 1971 SW(4): !PRINT TEXT
case_SW_4:;
// 1972 K=(A(P+1)+2)//2; P=P+1; PPJ(30)
K = ((long)(A[P + 1 + 2] + 2) / (long)2);
P = P + 1;
PPJ(30);
// 1973 %CYCLE KK=1,1,K; PLANT(A(P)<<8!A(P+1))
// %for KK = 1, 1, K %cycle
{
int _final = K;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle KK = 1, 1, K");
KK = 0;
L_022C:
if (KK == _final) goto L_022D;
KK += 1;
PLANT(A[P + 2] << 8 | A[P + 1 + 2]);
// 1974 P=P+2; %REPEAT; ->L1
P = P + 2;
goto L_022C;
}
L_022D:;
goto U_1058;
// 1975 SW(5): !RETURN
case_SW_5:;
// 1976 FAULT(30) %UNLESS FLAG(LEVEL)=10000 %OR PERM=1
if (FLAG[LEVEL] == 10000) goto L_022F;
if (PERM == 1) goto L_022F;
FAULT(30);
L_022F:;
// 1977 P=P+1
P = P + 1;
// 1978 L6: PSS(X'D2',4,GLA,20,RBASE,0) %IF DIAGS1=1
U_105E:;
if (DIAGS1 != 1) goto L_0230;
PSS(210, 4, GLA, 20, RBASE, 0);
L_0230:;
// 1979 %COMMENT CHECK FOR REGISTER VARS & UPDATE CORE COPY
// 1980 %CYCLE KK=5,1,8
// %for KK = 5, 1, 8 %cycle
{
KK = 4;
L_0231:
if (KK == 8) goto L_0232;
KK += 1;
// 1981 %IF 0#UVARREG(KK)<LEVEL %THEN PRX(X'50',KK,0,RBASE,KK<<2)
{
// Double-sided test on UVARREG[KK - 5] (Part I)
int tmp;
if (0 == (tmp = UVARREG[KK - 5])) goto L_0233;
// Double-sided test on UVARREG[KK - 5] (Part II)
if (tmp >= LEVEL) goto L_0233;
}
PRX(80, KK, 0, RBASE, KK << 2);
L_0233:;
// 1982 %REPEAT
goto L_0231;
}
L_0232:;
// 1983 PRX(X'98',4,15,RBASE,16); ! LM OLD REGISTERS
PRX(152, 4, 15, RBASE, 16);
// 1984 R13=0; PRR(7,15,LINK); ->L1; ! BR LINK
R13 = 0;
PRR(7, 15, LINK);
goto U_1058;
// 1985 SW(6): ! %RESULT =EXPR
case_SW_6:;
// 1986 P=P+1; KK=FLAG(LEVEL)
P = P + 1;
KK = FLAG[LEVEL];
// 1987 FAULT(31) %UNLESS KK>10000
if (KK > 10000) goto L_0234;
FAULT(31);
L_0234:;
// 1988 ->L61 %IF KK=10002
if (KK != 10002) goto L_0235;
goto U_105F;
L_0235:;
// 1989 ->L62 %IF KK=10032
if (KK != 10032) goto L_0236;
goto U_1060;
L_0236:;
// 1990 ->L63 %IF KK=10005
if (KK != 10005) goto L_0237;
goto U_1061;
L_0237:;
// 1991 CSEXP(1,1); ->L6
CSEXP(1, 1);
goto U_105E;
// 1992 L61: CSEXP(2,2); ->L6
U_105F:;
CSEXP(2, 2);
goto U_105E;
// 1993 L62: CSEXP(2,3); ->L6
U_1060:;
CSEXP(2, 3);
goto U_105E;
// 1994 L63: CSTREXP(1); ->L6
U_1061:;
CSTREXP(1);
goto U_105E;
// 1995 SW(7):SW(8): ! STOP & MONITORSTOP
case_SW_7:;
case_SW_8:;
// 1996 PPJ(6*(A(P)-6)); P=P+1; ->L1
PPJ(6 * (A[P + 2] - 6));
P = P + 1;
goto U_1058;
// 1997 SW(9): SFLABEL=SFLABEL-1
case_SW_9:;
SFLABEL = SFLABEL - 1;
// 1998 PUSH(SBR(LEVEL),CODE,SFLABEL)
PUSH(/*?*/ &SBR[LEVEL], CODE, SFLABEL);
// 1999 PUSH(CYCLE(LEVEL),0,0)
PUSH(/*?*/ &CYCLE[LEVEL], 0, 0);
// 2000 ->L1
goto U_1058;
// 2001 SW(11): ! %QUERIES (ONOFF)
case_SW_11:;
// 2002 KK=2-A(P+1); P=P+2
KK = 2 - A[P + 1 + 2];
P = P + 2;
// 2003 PSI(X'92',KK,GLA,1); ->L1
PSI(146, KK, GLA, 1);
goto U_1058;
// 2004 SW(10): PPJ(31); P=P+1; ; ! %MONITOR
case_SW_10:;
PPJ(31);
P = P + 1;
// 2005 L1: %END
U_1058:;
return;
case_SW_dispatch:
if (SW_index < 1 || SW_index > 11)
_imp_signalf(6, 3, SW_index, "->SW(%d) out of bounds at %s line %d", SW_index, SW_file, SW_line);
goto *SW[SW_index - 1];
case_SW_missing:
_imp_signalf(8, 2, SW_index, "switch jump to undefined label SW(%d): at %s line %d", SW_index, SW_file, SW_line);
} /* end of CUI */
// 2006 %ROUTINE CRFORMAT
void CRFORMAT(void) {
// 2007 !%SHORTROUTINE
// 2008 %INTEGER LENGTHP,QQQ,REP,CODE
int LENGTHP;
int QQQ;
int REP;
int CODE;
// 2009 K=A(P+1);TEST NST
K = A[P + 1 + 2];
TESTNST();
// 2010 J=0;PTYPE=4;OPHEAD=NEWCELL
J = 0;
PTYPE = 4;
OPHEAD = NEWCELL();
// 2011 JJJ=OPHEAD;STORE TAG(K,JJJ)
JJJ = OPHEAD;
STORETAG(K, JJJ);
// 2012 P=3;Q=0;INC=4;INCP=0
P = 3;
Q = 0;
INC = 4;
INCP = 0;
// 2013 ! INC COUNTS ALONG RECORD FORMAT DOPEVECTOR..INCP BYTES FROM RECORDHD
// 2014 ->L101 %IF A(P)=2; ! NO FPP
if (A[P + 2] != 2) goto L_0238;
goto U_1079;
L_0238:;
// 2015 L1: P=P+1; COMPILE FORMAL PARAMETER
U_1078:;
P = P + 1;
COMPILEFORMALPARAMETER();
// 2016 LENGTHP=ACC-1; LENGTHP=3 %IF ACC>8
LENGTHP = ACC - 1;
if (ACC <= 8) goto L_0239;
LENGTHP = 3;
L_0239:;
// 2017 L2: ->L3 %IF INCP&LENGTHP=0; INCP=INCP+1; ->L2
U_1058:;
if (INCP & LENGTHP != 0) goto L_023A;
goto U_1059;
L_023A:;
INCP = INCP + 1;
goto U_1058;
// 2018 L3: %CYCLE REP=1,1,A(P); P=P+1
U_1059:;
// %for REP = 1, 1, A[P + 2] %cycle
{
int _final = A[P + 2];
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle REP = 1, 1, A[P + 2]");
REP = 0;
L_023B:
if (REP == _final) goto L_023C;
REP += 1;
P = P + 1;
// 2019 CODE=255; LENGTHP=ACC
CODE = 255;
LENGTHP = ACC;
// 2020 ->L11 %IF ROUT=1
if (ROUT != 1) goto L_023D;
goto U_105A;
L_023D:;
// 2021 ->L12 %IF TYPE=3;QQQ=INCP
if (TYPE != 3) goto L_023E;
goto U_105B;
L_023E:;
QQQ = INCP;
// 2022 ->L4 %UNLESS TYPE=5
if (TYPE == 5) goto L_023F;
goto U_105C;
L_023F:;
// 2023 CODE=250; LENGTHP=ACC-1; QQQ=INC
CODE = 250;
LENGTHP = ACC - 1;
QQQ = INC;
// 2024 L4: INSERT AFTER(OPHEAD,PTYPE<<4!A(P)<<20,QQQ)
U_105C:;
INSERTAFTER(/*?*/ &OPHEAD, PTYPE << 4 | A[P + 2] << 20, QQQ);
// 2025 PSI(X'92',CODE,RBASE,N+INC)
PSI(146, CODE, RBASE, N + INC);
// 2026 PSI(X'92',LENGTHP,RBASE,N+INC+1)
PSI(146, LENGTHP, RBASE, N + INC + 1);
// 2027 Q=Q+1
Q = Q + 1;
// 2028 INC=INC+4; INCP=INCP+ACC
INC = INC + 4;
INCP = INCP + ACC;
// 2029 ->L15
goto U_105D;
// 2030 L11: QQQ=NEWCELL; REPLACE BOTH(QQQ,INCP,100)
U_105A:;
QQQ = NEWCELL();
REPLACEBOTH(QQQ, INCP, 100);
// 2031 FAULT(41) %UNLESS PTYPE=11000;! FUNCTIONS TOO DICEY AT PRESENT
if (PTYPE == 11000) goto L_0240;
FAULT(41);
L_0240:;
// 2032 ACC=40; LENGTHP=ACC; ->L4; ! RT NAME MUST CARRY ENVRMNT
ACC = 40;
LENGTHP = ACC;
goto U_105C;
// 2033 L12: QQQ=NEWCELL; REPLACE BOTH(QQQ,0,INCP); ->L4
U_105B:;
QQQ = NEWCELL();
REPLACEBOTH(QQQ, 0, INCP);
goto U_105C;
// 2034 L15: %REPEAT
U_105D:;
goto L_023B;
}
L_023C:;
// 2035 P=P+1; ! P ON REST OF FP LIST
P = P + 1;
// 2036 ->L101 %IF A(P)=2; P=P+1; ->L1
if (A[P + 2] != 2) goto L_0241;
goto U_1079;
L_0241:;
P = P + 1;
goto U_1078;
// 2037 L101: P=P+1
U_1079:;
P = P + 1;
// 2038 L102: ->L201 %IF A(P)=2; ! NO ARRAYS
U_105E:;
if (A[P + 2] != 2) goto L_0242;
goto U_105F;
L_0242:;
// 2039 P=P+2; CLT
P = P + 2;
CLT();
// 2040 NAM= 2*(2-A(P))
NAM = 2 * (2 - A[P + 2]);
// 2041 ACC=4 %IF NAM#0;P=P+1
if (NAM == 0) goto L_0243;
ACC = 4;
L_0243:;
P = P + 1;
// 2042 ROUT=0; ARR=1; PACK(PTYPE)
ROUT = 0;
ARR = 1;
PACK(/*?*/ &PTYPE);
// 2043 L103:
U_1060:;
// 2044 PSI(X'92',0,RBASE,N+INC); ! FLAG FOR ARRAYS
PSI(146, 0, RBASE, N + INC);
// 2045 DUMP(1,WSPR,N+INC+8,0,RBASE); ! PTR TO DOPE VECTOR
DUMP(1, WSPR, N + INC + 8, 0, RBASE);
// 2046 QQ=P; CADCLN(1)
QQ = P;
CADCLN(1);
// 2047 JJ=P; P=QQ+2
JJ = P;
P = QQ + 2;
// 2048 REP=P+A(P-1); ! AFTER LAST NAME
REP = P + A[P - 1 + 2];
// 2049 L105: INSERT AFTER(OPHEAD,J!PTYPE<<4!A(P)<<20,INC)
U_1061:;
INSERTAFTER(/*?*/ &OPHEAD, J | PTYPE << 4 | A[P + 2] << 20, INC);
// 2050 INC=INC+16; Q=Q+1
INC = INC + 16;
Q = Q + 1;
// 2051 P=P+1; ->L106 %IF P=REP
P = P + 1;
if (P != REP) goto L_0244;
goto U_1062;
L_0244:;
// 2052 PSS(X'D2',16,RBASE,N+INC,RBASE,N+INC-16); ->L105
PSS(210, 16, RBASE, N + INC, RBASE, N + INC - 16);
goto U_1061;
// 2053 L106: P=JJ+2
U_1062:;
P = JJ + 2;
// 2054 ->L103 %IF A(P-1)=1; ->L102; ! P ON RESTOFARRAYLIST
if (A[P - 1 + 2] != 1) goto L_0245;
goto U_1060;
L_0245:;
goto U_105E;
// 2055 L201: REPLACE BOTH(JJJ,N,Q)
U_105F:;
REPLACEBOTH(JJJ, N, Q);
// 2056 PRX(X'41',1,0,0,Q); ! LA 1,ITEMS
PRX(65, 1, 0, 0, Q);
// 2057 DUMP(5,1,N,0,RBASE); !STH
DUMP(5, 1, N, 0, RBASE);
// 2058 DUMP(0,1,N,0,RBASE)
DUMP(0, 1, N, 0, RBASE);
// 2059 PPJ(25); N=N+INC
PPJ(25);
N = N + INC;
// 2060 %END
return;
} /* end of CRFORMAT */
// 2061 %ROUTINE CADCLN(%BYTEINTEGER MODE)
void CADCLN(unsigned char MODE) {
// 2062 !%SHORTROUTINE
// 2063 ! MODE=0 NORMAL DECN, =1 IN RECORD FORMAY, =2 RECORD ARRAY
// 2064 ! P POINTS TO NAMELIST -1
// 2065 %INTEGER Q,QQ,KK,S,JJ,JJJ
int Q;
int QQ;
int KK;
int S;
int JJ;
int JJJ;
// 2066 Q=P; PTYPEP=PTYPE
Q = P;
PTYPEP = PTYPE;
// 2067 L1: P=A(Q+1)+Q+1
U_1059:;
P = A[Q + 1 + 2] + Q + 1;
// 2068 KK=0; %IF MODE=1 %THEN ->L4
KK = 0;
if (MODE != 1) goto L_0246;
goto U_105A;
L_0246:;
// 2069 PRX(X'50',WSPR,0,GLA,36); ! PTR TO DOPE VECTOR INTO GLA
PRX(80, WSPR, 0, GLA, 36);
// 2070 PSI(X'92',1,GLA,36) %IF UNASS=1;! FLAG TO FILL WITH X'000'
if (UNASS != 1) goto L_0247;
PSI(146, 1, GLA, 36);
L_0247:;
// 2071 L4: P=P+2; JJ=P; KK=KK+1
U_105A:;
P = P + 2;
JJ = P;
KK = KK + 1;
// 2072 SKIP EXP; QQ=TSEXP(JJJ); P=JJ
SKIPEXP();
QQ = TSEXP(/*?*/ &JJJ);
P = JJ;
// 2073 %IF QQ=0 %THEN CSEXP(4,1) %ELSE CSEXP(1,1)
if (QQ != 0) goto L_0248;
CSEXP(4, 1);
goto L_0249;
L_0248:;
CSEXP(1, 1);
L_0249:;
// 2074 REGISTER(4)=1; CSEXP(2,1); REGISTER(4)=0
REGISTER[4] = 1;
CSEXP(2, 1);
REGISTER[4] = 0;
// 2075 PRR(X'18',1,4) %IF QQ=0; ! BOUND PAIR NOW IN R1 & R2
if (QQ != 0) goto L_024A;
PRR(24, 1, 4);
L_024A:;
// 2076 ->L41 %UNLESS KK=1; S=1
if (KK == 1) goto L_024B;
goto U_105B;
L_024B:;
S = 1;
// 2077 %UNLESS MODE=2 %THEN %START
if (MODE == 2) goto L_024C;
// 2078 S=0; PRX(X'41',0,0,0,ACC); %FINISH;
S = 0;
PRX(65, 0, 0, 0, ACC);
L_024C:;
// 2079 PRX(X'90',S,2,WSPR,4*S); ! STM TO DUMP BOUND PAIR & R0
PRX(144, S, 2, WSPR, 4 * S);
// 2080 PSI(X'92',3-A(P),WSPR,1); ! MVI TO SET DIMENSION
PSI(146, 3 - A[P + 2], WSPR, 1);
// 2081 MOVER(WSPR,16); ->L42
MOVER(WSPR, 16);
goto U_105C;
// 2082 L41: S=(KK&1)<<2
U_105B:;
S = (KK & 1) << 2;
// 2083 %IF S=0 %THEN JJJ=8*A(P) %ELSE JJJ=16
if (S != 0) goto L_024D;
JJJ = 8 * A[P + 2];
goto L_024E;
L_024D:;
JJJ = 16;
L_024E:;
// 2084 PRX(X'90',1,2,WSPR,S)
PRX(144, 1, 2, WSPR, S);
// 2085 MOVER(WSPR,JJJ)
MOVER(WSPR, JJJ);
// 2086 L42: ->L4 %IF A(P)=1; ! FOR NEXT BOUND PAIR
U_105C:;
if (A[P + 2] != 1) goto L_024F;
goto U_105A;
L_024F:;
// 2087 ->L5 %IF KK<=2
if (KK > 2) goto L_0250;
goto U_105D;
L_0250:;
// 2088 FAULT(37) %IF KK>6
if (KK <= 6) goto L_0251;
FAULT(37);
L_0251:;
// 2089 PACLOD(27,3,KK); ! L 1,=A(DV)--MVI 1(1),KK
PACLOD(27, 3, KK);
// 2090 L5: QQ=Q+1; J=KK; PTYPE=PTYPEP; ->L9 %IF MODE >=1
U_105D:;
QQ = Q + 1;
J = KK;
PTYPE = PTYPEP;
if (MODE < 1) goto L_0252;
goto U_105E;
L_0252:;
// 2091 %CYCLE JJJ=1,1,A(QQ)
// %for JJJ = 1, 1, A[QQ + 2] %cycle
{
int _final = A[QQ + 2];
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle JJJ = 1, 1, A[QQ + 2]");
JJJ = 0;
L_0253:
if (JJJ == _final) goto L_0254;
JJJ += 1;
// 2092 K=A(QQ+JJJ); TESTNST; J=KK
K = A[QQ + JJJ + 2];
TESTNST();
J = KK;
// 2093 STORE TAG(K,N);PPJ(13)
STORETAG(K, N);
PPJ(13);
// 2094 PRX(X'90',0,3,RBASE,N); ! STM 0,3--SAVE ARRAYHEAD
PRX(144, 0, 3, RBASE, N);
// 2095 N=N+16; %REPEAT
N = N + 16;
goto L_0253;
}
L_0254:;
// 2096 Q=P+2; ->L1 %IF A(Q-1)=1
Q = P + 2;
if (A[Q - 1 + 2] != 1) goto L_0255;
goto U_1059;
L_0255:;
// 2097 L9: %END
U_105E:;
return;
} /* end of CADCLN */
// 2098 %ROUTINE CVDECLN
void CVDECLN(void) {
// 2099 !%SHORTROUTINE
// 2100 %INTEGER LB,UB,ADV,Q,QQ,RANGE,JJJ,KK,DISP0,DISP1
int LB;
int UB;
int ADV;
int Q;
int QQ;
int RANGE;
int JJJ;
int KK;
int DISP0;
int DISP1;
// 2101 Q=P
Q = P;
// 2102 P=A(Q+1)+Q+2
P = A[Q + 1 + 2] + Q + 2;
// 2103 CBPAIR(LB,UB)
CBPAIR(/*?*/ &LB, /*?*/ &UB);
// 2104 ADV=N0
ADV = N0;
// 2105 ST(N0)=1<<16!ACC
ST[N0] = 1 << 16 | ACC;
// 2106 ST(N0+1)=LB
ST[N0 + 1] = LB;
// 2107 ST(N0+2)=UB
ST[N0 + 2] = UB;
// 2108 RANGE=UB-LB+1
RANGE = UB - LB + 1;
// 2109 ST(N0+3)=RANGE; N0=N0+4
ST[N0 + 3] = RANGE;
N0 = N0 + 4;
// 2110 FAULT(44) %IF LB>UB
if (LB <= UB) goto L_0256;
FAULT(44);
L_0256:;
// 2111 PRX(X'41',2,0,GLA,ADV<<2)
PRX(65, 2, 0, GLA, ADV << 2);
// 2112 PRX(X'41',3,0,0,RANGE)
PRX(65, 3, 0, 0, RANGE);
// 2113 QQ=Q+1; J=1
QQ = Q + 1;
J = 1;
// 2114 %CYCLE JJJ=1,1,A(QQ)
// %for JJJ = 1, 1, A[QQ + 2] %cycle
{
int _final = A[QQ + 2];
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle JJJ = 1, 1, A[QQ + 2]");
JJJ = 0;
L_0257:
if (JJJ == _final) goto L_0258;
JJJ += 1;
// 2115 N=(N+7)&(-8)
N = N + 7 & (-8);
// 2116 DISP1=N+16
DISP1 = N + 16;
// 2117 DISP0=DISP1-LB*ACC; FAULT(44) %UNLESS 0<DISP0<4095
DISP0 = DISP1 - LB * ACC;
{
// Double-sided test on DISP0 (Part I)
int tmp;
if (0 >= (tmp = DISP0)) goto L_0156;
// Double-sided test on DISP0 (Part II)
if (tmp < 4095) goto L_0259;
}
L_0156:;
FAULT(44);
L_0259:;
// 2118 KK=NEWCELL; REPLACE BOTH(KK,DISP0,N)
KK = NEWCELL();
REPLACEBOTH(KK, DISP0, N);
// 2119 PRX(X'41',0,0,RBASE,DISP0)
PRX(65, 0, 0, RBASE, DISP0);
// 2120 PRX(X'41',1,0,RBASE,DISP1)
PRX(65, 1, 0, RBASE, DISP1);
// 2121 K=A(QQ+JJJ); TESTNST
K = A[QQ + JJJ + 2];
TESTNST();
// 2122 STORE TAG(K,KK)
STORETAG(K, KK);
// 2123 PRX(X'90',0,3,RBASE,N)
PRX(144, 0, 3, RBASE, N);
// 2124 SET80(DISP1,ACC*RANGE) %IF UNASS=1
if (UNASS != 1) goto L_025A;
SET80(DISP1, ACC * RANGE);
L_025A:;
// 2125 N=DISP1+ACC*RANGE
N = DISP1 + ACC * RANGE;
// 2126 %REPEAT
goto L_0257;
}
L_0258:;
// 2127 P=P+1; %IF A(P-1)=1 %THEN CVDECLN
P = P + 1;
if (A[P - 1 + 2] != 1) goto L_025B;
CVDECLN();
L_025B:;
// 2128 N=(N+3)&(-4)
N = N + 3 & (-4);
// 2129 %END
return;
} /* end of CVDECLN */
// 2130 %ROUTINE CSEXP(%INTEGER REG,%BYTEINTEGER MODE)
void CSEXP(int REG, unsigned char MODE) {
// 2131 %COMMENT MODE=1 FOR %INTEGER, =2REAL, =3LONG,=0INTEGER %IF PNS
// 2132 %INTEGER C,D,QP,NOP,X,JJ,OPCODE
int C;
int D;
int QP;
int NOP;
int X;
int JJ;
int OPCODE;
// 2133 %INTEGER EVALUATE,OPND
int EVALUATE;
int OPND;
// 2134 %SHORTINTEGER OPHEAD
short int OPHEAD;
// 2135 %BYTEINTEGER REAL,LONGREAL,REALOP
unsigned char REAL;
unsigned char LONGREAL;
unsigned char REALOP;
// 2136 %INTEGER OPERATOR,NOPS,LASTOP
int OPERATOR;
int NOPS;
int LASTOP;
// 2137 %INTEGERARRAY BS,PT,DP(1:2)
int BS[2];
int PT[2];
int DP[2];
// 2138 %INTEGERARRAY OP,OPPREC(0:5)
int OP[6];
int OPPREC[6];
auto void TEST(int N);
auto void PLANT(int OPCODE, int R1, int R2);
auto int FINDR(void);
auto void LOAD(int *N, int REG, int MODE);
auto void PRINTORDERS(void);
// 2139 %ROUTINESPEC TEST(%INTEGER N)
// 2140 %ROUTINESPEC PLANT(%INTEGER A,B,C)
// 2141 %INTEGERFNSPEC FINDR
// 2142 %ROUTINESPEC LOAD(%INTEGERNAME N,%INTEGER REG,MODE)
// 2143 %ROUTINESPEC PRINT ORDERS
// 2144 %OWNINTEGER N0=1024
static int N0 = 1024;
// 2145 QP=0; OPHEAD=0; OPCODE=0
QP = 0;
OPHEAD = 0;
OPCODE = 0;
// 2146 REAL=0; LONGREAL=0; REALOP=0
REAL = 0;
LONGREAL = 0;
REALOP = 0;
// 2147 NOPS=0; LASTOP=0
NOPS = 0;
LASTOP = 0;
// 2148 %BEGIN
{ /*%begin*/
// 2149 !%SHORTROUTINE
// 2150 %SWITCH S,SW(1:4)
int S_index;
int S_line;
char *S_file;
static const void *S[4] = {&&case_S_1, &&case_S_2, &&case_S_3, &&case_S_4};
int SW_index;
int SW_line;
char *SW_file;
static const void *SW[4] = {&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing};
// 2151 AFLAG=0; NOP=N0
AFLAG = 0;
NOP = N0;
// 2152 OP(0)=0; OPPREC(0)=0
OP[0] = 0;
OPPREC[0] = 0;
// 2153 ->S(A(P)); !SWITCH ON PHRASE (+1)
S_line = __LINE__;
S_file = __FILE__;
S_index = A[P + 2];
goto case_S_dispatch;
// 2154 S(2): !NEGATE
case_S_2:;
// 2155 OP(1)=11;
OP[1] = 11;
// 2156 L101: OPPREC(1)=2+OP(1)//6; QP=1; ->L1
U_1074:;
OPPREC[1] = 2 + ((long)OP[1] / (long)6);
QP = 1;
goto U_1075;
// 2157 S(3): OP(1)=23; ->L101; !INITIAL NOT
case_S_3:;
OP[1] = 23;
goto U_1074;
// 2158 S(1):S(4):L1: ! PLUS OR NULL ALTERNATIVE
case_S_1:;
case_S_4:;
U_1075:;
// 2159 OPND=A(P+1); P=P+2; QP=QP+1
OPND = A[P + 1 + 2];
P = P + 2;
QP = QP + 1;
// 2160 ->SW(OPND); ! SWITCH ON OPERAND
SW_line = __LINE__;
SW_file = __FILE__;
SW_index = OPND;
goto case_SW_dispatch;
// 2161 SW(1): !NAME
case_SW_1:;
// 2162 COPYTAG(A(P))
COPYTAG(A[P + 2]);
// 2163 ->REGVAR %IF TYPE=8
if (TYPE != 8) goto L_025E;
goto U_1076;
L_025E:;
// 2164 ->L19 %IF TYPE=3 %AND ARR=0 %AND INREG#0
if (TYPE != 3) goto L_025F;
if (ARR != 0) goto L_025F;
if (INREG == 0) goto L_025F;
goto U_1077;
L_025F:;
// 2165 ->L171 %IF ARR=2 %AND A(P+1)=1
if (ARR != 2) goto L_0260;
if (A[P + 1 + 2] != 1) goto L_0260;
goto U_107A;
L_0260:;
// 2166 ->L17 %IF 1<=TYPE<=2 %AND ARR=0 %AND ROUT=0 %AND A(P+1)=2=A(P+2)
{
// Double-sided test on TYPE (Part I)
unsigned char tmp;
if (1 > (tmp = TYPE)) goto L_0261;
// Double-sided test on TYPE (Part II)
if (tmp > 2) goto L_0261;
}
if (ARR != 0) goto L_0261;
if (ROUT != 0) goto L_0261;
{
// Double-sided test on 2 (Part I)
int tmp;
if (A[P + 1 + 2] != (tmp = 2)) goto L_0261;
// Double-sided test on 2 (Part II)
if (tmp != A[P + 2 + 2]) goto L_0261;
}
goto U_107B;
L_0261:;
// 2167 L10:
U_107C:;
// 2168 ->L14 %UNLESS TYPE=1 %OR(ROUT=1%AND TYPE=6%AND TSNAME(K)&7=1)
if (TYPE == 1) goto L_0262;
if (ROUT != 1) goto L_022E;
if (TYPE != 6) goto L_022E;
if (TSNAME[K] & 7 == 1) goto L_0262;
L_022E:;
goto U_107D;
L_0262:;
// 2169 C=P; ->L11 %IF QP>1
C = P;
if (QP <= 1) goto L_0263;
goto U_107E;
L_0263:;
// 2170 P=P+1; SKIPAPP; ->L11 %UNLESS A(P)=A(P+1)=2
P = P + 1;
SKIPAPP();
{
// Double-sided test on A[P + 1 + 2] (Part I)
short int tmp;
if (A[P + 2] != (tmp = A[P + 1 + 2])) goto L_0264;
// Double-sided test on A[P + 1 + 2] (Part II)
if (tmp == 2) goto L_0265;
}
L_0264:;
goto U_107E;
L_0265:;
// 2171 P=C; C=REG
P = C;
C = REG;
// 2172 %IF REG<=0 %THEN %START
if (REG > 0) goto L_0266;
// 2173 C=FINDR; REGISTER(C)=0
C = FINDR();
REGISTER[C] = 0;
// 2174 %FINISH
L_0266:;
// 2175 CNAME(2,C); NEST=C; ->L80; ! ONE OPND EXPR
CNAME(2, C);
NEST = C;
goto U_107F;
// 2176 L11: P=C
U_107E:;
P = C;
// 2177 C=FINDPP; ->L14 %IF C=0
C = FINDPP();
if (C != 0) goto L_0267;
goto U_107D;
L_0267:;
// 2178 CNAME(2,C); NEST=C
CNAME(2, C);
NEST = C;
// 2179 ->L80 %IF QP=1 %AND A(P)=2;P=P+1; ! ONE OPND EXPR
if (QP != 1) goto L_0268;
if (A[P + 2] != 2) goto L_0268;
goto U_107F;
L_0268:;
P = P + 1;
// 2180 L12: ST(N0)=9; ST(N0+1)=C; N0=N0+3
U_1080:;
ST[N0] = 9;
ST[N0 + 1] = C;
N0 = N0 + 3;
// 2181 REGISTER(C)=1
REGISTER[C] = 1;
// 2182 ->L50
goto U_1081;
// 2183 L14: %COMMENT OPERAND MUST BE FETCHED AND STORED
U_107D:;
// 2184 CNAME (2,2);NEST =2
CNAME(2, 2);
NEST = 2;
// 2185 %IF TYPE=5 %THEN %START; FAULT(42); TYPE=1; %FINISH;
if (TYPE != 5) goto L_0269;
FAULT(42);
TYPE = 1;
L_0269:;
// 2186 %IF TYPE=2 %THEN FREG(2)=1 %ELSE REGISTER(2)=1
if (TYPE != 2) goto L_026A;
FREG[2] = 1;
goto L_026B;
L_026A:;
REGISTER[2] = 1;
L_026B:;
// 2187 NAM=0;ARR=0;ROUT=0
NAM = 0;
ARR = 0;
ROUT = 0;
// 2188 LONGREAL=1 %IF PREC=3
if (PREC != 3) goto L_026C;
LONGREAL = 1;
L_026C:;
// 2189 ->L80 %IF QP=1 %AND A(P)=2
if (QP != 1) goto L_026D;
if (A[P + 2] != 2) goto L_026D;
goto U_107F;
L_026D:;
// 2190 L16: ->L15 %IF TYPE=1
U_1082:;
if (TYPE != 1) goto L_026E;
goto U_1083;
L_026E:;
// 2191 REAL=1; LONGREAL=1 %IF PREC=3
REAL = 1;
if (PREC != 3) goto L_026F;
LONGREAL = 1;
L_026F:;
// 2192 ->L161 %IF A(P)=2; ! EXPRESSION ENDED
if (A[P + 2] != 2) goto L_0270;
goto U_1084;
L_0270:;
// 2193 C=PARKF(NEST,PREC)
C = PARKF(NEST, PREC);
// 2194 FREG(NEST)=0
FREG[NEST] = 0;
// 2195 L13: ST(N0)=10; P=P+1
U_1085:;
ST[N0] = 10;
P = P + 1;
// 2196 ST(N0+1)=RBASE!(TYPE!PREC<<3!NAM<<6)<<8
ST[N0 + 1] = RBASE | (TYPE | PREC << 3 | NAM << 6) << 8;
// 2197 ST(N0+2)=C; N0=N0+3; ->L50
ST[N0 + 2] = C;
N0 = N0 + 3;
goto U_1081;
// 2198 L161: ST(N0)=8; ST(N0+1)=NEST+512+PREC<<11
U_1084:;
ST[N0] = 8;
ST[N0 + 1] = NEST + 512 + (PREC << 11);
// 2199 FREG(NEST)=1
FREG[NEST] = 1;
// 2200 N0=N0+3; P=P+1; ->L50
N0 = N0 + 3;
P = P + 1;
goto U_1081;
// 2201 L15: C=NEST
U_1083:;
C = NEST;
// 2202 C=PARK(NEST)
C = PARK(NEST);
// 2203 REGISTER(NEST)=0 %UNLESS NEST=C
if (NEST == C) goto L_0271;
REGISTER[NEST] = 0;
L_0271:;
// 2204 ->L18 %IF C>0; ! IN GENERAL REGISTER
if (C <= 0) goto L_0272;
goto U_1086;
L_0272:;
// 2205 C=|C|; PREC=0; ->L13; ! IN CORE EQUIVALENT TO INTEGER
C = _imp_IMOD(C);
PREC = 0;
goto U_1085;
// 2206 L18: P=P+1; ->L12
U_1086:;
P = P + 1;
goto U_1080;
// 2207 L17: %COMMENT OPND HAS BASE REGISTER COVER
U_107B:;
// 2208 ST(N0)=2; ST(N0+1)=I!(TYPE!PREC<<3!NAM<<6)<<8
ST[N0] = 2;
ST[N0 + 1] = I | (TYPE | PREC << 3 | NAM << 6) << 8;
// 2209 ST(N0+2)=K; P=P+4; N0=N0+3
ST[N0 + 2] = K;
P = P + 4;
N0 = N0 + 3;
// 2210 REAL=1 %IF TYPE=2
if (TYPE != 2) goto L_0273;
REAL = 1;
L_0273:;
// 2211 LONGREAL=1 %IF PREC=3
if (PREC != 3) goto L_0274;
LONGREAL = 1;
L_0274:;
// 2212 ->L50 %UNLESS UNASS=1 %AND(PREC=0 %OR PREC=3)
if (UNASS != 1) goto L_0275;
if (PREC == 0) goto L_0276;
if (PREC == 3) goto L_0276;
L_0275:;
goto U_1081;
L_0276:;
// 2213 ->L50 %IF NAM=1
if (NAM != 1) goto L_0277;
goto U_1081;
L_0277:;
// 2214 PSS(X'D5',BYTES(PREC),I,K,GLA,128); ! CLC V,=X'80808080'
PSS(213, BYTES[PREC], I, K, GLA, 128);
// 2215 PRX(X'47',8,0,CODER,40); ->L50;;! CHECK ASSIGNED
PRX(71, 8, 0, CODER, 40);
goto U_1081;
// 2216 L171: ->L10 %UNLESS A(P+2)=4 %AND A(P+3)=2 %AND A(P+4)=9
U_107A:;
if (A[P + 2 + 2] != 4) goto L_0278;
if (A[P + 3 + 2] != 2) goto L_0278;
if (A[P + 4 + 2] == 9) goto L_0279;
L_0278:;
goto U_107C;
L_0279:;
// 2217 ->L10 %UNLESS A(P+5)<256 %AND A(P+6)=2 %AND A(P+7)=2=A(P+8)
if (A[P + 5 + 2] >= 256) goto L_027A;
if (A[P + 6 + 2] != 2) goto L_027A;
{
// Double-sided test on 2 (Part I)
int tmp;
if (A[P + 7 + 2] != (tmp = 2)) goto L_027A;
// Double-sided test on 2 (Part II)
if (tmp == A[P + 8 + 2]) goto L_027B;
}
L_027A:;
goto U_107C;
L_027B:;
// 2218 FROM1(K,C); C=C+BYTES(PREC)*A(P+5)
FROM1(K, /*?*/ &C);
C = C + BYTES[PREC] * A[P + 5 + 2];
// 2219 ->L10 %UNLESS 0<C<4096; K=C; P=P+6; ->L17
{
// Double-sided test on C (Part I)
int tmp;
if (0 >= (tmp = C)) goto L_027C;
// Double-sided test on C (Part II)
if (tmp < 4096) goto L_027D;
}
L_027C:;
goto U_107C;
L_027D:;
K = C;
P = P + 6;
goto U_107B;
// 2220 L19: ->L14 %UNLESS A(P+1)=2 %AND A(P+2)=1; ! NO APP BIUT ENAME
U_1077:;
if (A[P + 1 + 2] != 2) goto L_027E;
if (A[P + 2 + 2] == 1) goto L_027F;
L_027E:;
goto U_107D;
L_027F:;
// 2221 P=P+3; FROM1(K,FNAME); I=INREG
P = P + 3;
FROM1(K, /*?*/ &FNAME);
I = INREG;
// 2222 K=DISPLACEMENT(FNAME)
K = DISPLACEMENT(FNAME);
// 2223 ->L191 %IF I=-1; UNPACK
if (I != -1) goto L_0280;
goto U_1087;
L_0280:;
UNPACK();
// 2224 ->L17 %IF ARR=0 %AND ROUT=0 %AND 1<=TYPE<=2 %AND A(P+1)=2%C
if (ARR != 0) goto L_0281;
if (ROUT != 0) goto L_0281;
{
// Double-sided test on TYPE (Part I)
unsigned char tmp;
if (1 > (tmp = TYPE)) goto L_0281;
// Double-sided test on TYPE (Part II)
if (tmp > 2) goto L_0281;
}
{
// Double-sided test on 2 (Part I)
int tmp;
if (A[P + 1 + 2] != (tmp = 2)) goto L_0281;
// Double-sided test on 2 (Part II)
if (tmp != A[P + 2 + 2]) goto L_0281;
}
goto U_107B;
L_0281:;
// 2225+ =A(P+2); ! NO APP OR SECOND ENAME
// 2226 L191: P=P-3; ->L14
U_1087:;
P = P - 3;
goto U_107D;
// 2227 REGVAR: ->L14 %UNLESS A(P+1)=2=A(P+2);! NO APP OR ENAME
U_1076:;
{
// Double-sided test on 2 (Part I)
int tmp;
if (A[P + 1 + 2] != (tmp = 2)) goto L_0282;
// Double-sided test on 2 (Part II)
if (tmp == A[P + 2 + 2]) goto L_0283;
}
L_0282:;
goto U_107D;
L_0283:;
// 2228 P=P+4; ST(N0)=9; ST(N0+1)=K
P = P + 4;
ST[N0] = 9;
ST[N0 + 1] = K;
// 2229 N0=N0+3; ->L50
N0 = N0 + 3;
goto U_1081;
// 2230 SW(2): !CONSTANT
case_SW_2:;
// 2231 C=A(P); ST(N0+1)=P; ST(N0+2)=A(P+1)
C = A[P + 2];
ST[N0 + 1] = P;
ST[N0 + 2] = A[P + 1 + 2];
// 2232 ->L24 %IF C&7=2
if (C & 7 != 2) goto L_0284;
goto U_1088;
L_0284:;
// 2233 %IF C=5 %THEN %START
if (C != 5) goto L_0285;
// 2234 FAULT(42); P=P+A(P+1)&X'FE'+1
FAULT(42);
P = P + (A[P + 1 + 2] & 254) + 1;
// 2235 C=9; %FINISH
C = 9;
L_0285:;
// 2236 ->L22 %UNLESS C>8; !GO UNLESS IMMEDIATE
if (C > 8) goto L_0286;
goto U_1089;
L_0286:;
// 2237 ST(N0)=0
ST[N0] = 0;
// 2238 L21: N0=N0+3; P=P+3;
U_108A:;
N0 = N0 + 3;
P = P + 3;
// 2239 ->L50
goto U_1081;
// 2240 L22: ST(N0)=1; P=P+1; ->L21
U_1089:;
ST[N0] = 1;
P = P + 1;
goto U_108A;
// 2241 L24: REAL=1; P=P+2; ->L22
U_1088:;
REAL = 1;
P = P + 2;
goto U_1089;
// 2242 SW(3):SW(4): ! SUB EXPRESSION
case_SW_3:;
case_SW_4:;
// 2243 D=0; D=1 %IF MODE=1 %OR LASTOP=12;! INTEGER EXPONENTS
D = 0;
if (MODE == 1) goto L_0287;
if (LASTOP != 12) goto L_0288;
L_0287:;
D = 1;
L_0288:;
// 2244 CSEXP(0,D)
CSEXP(0, D);
// 2245 ->L32 %UNLESS OPND=4
if (OPND == 4) goto L_0289;
goto U_108B;
L_0289:;
// 2246 D=16*TYPE
D = 16 * TYPE;
// 2247 D=48 %IF TYPE=2 %AND PREC=0
if (TYPE != 2) goto L_028A;
if (PREC != 0) goto L_028A;
D = 48;
L_028A:;
// 2248 PRR(D,NEST,NEST); !DEAL WITH MOD SIGNS
PRR(D, NEST, NEST);
// 2249 L32: LONGREAL=1 %IF PREC=3
U_108B:;
if (PREC != 3) goto L_028B;
LONGREAL = 1;
L_028B:;
// 2250 ->L80 %IF QP=1 %AND A(P)=2; !ONE OPD EXPRESSION
if (QP != 1) goto L_028C;
if (A[P + 2] != 2) goto L_028C;
goto U_107F;
L_028C:;
// 2251 ->L16 ; !TO STORE RESULT
goto U_1082;
// 2252 L50: %COMMENT DEAL WITH OPERATOR
U_1081:;
// 2253 ->L60 %IF A(P-1)=2; !EXPRESSION FINISHED
if (A[P - 1 + 2] != 2) goto L_028D;
goto U_108C;
L_028D:;
// 2254 OPERATOR=A(P)
OPERATOR = A[P + 2];
// 2255 %IF OPERATOR=12 %THEN %START; ! '.'
if (OPERATOR != 12) goto L_028E;
// 2256 FAULT(42); OPERATOR=2; %FINISH;! CHANGE TO +
FAULT(42);
OPERATOR = 2;
L_028E:;
// 2257 OPERATOR = 6 %IF OPERATOR=13; !%NULL == *
if (OPERATOR != 13) goto L_028F;
OPERATOR = 6;
L_028F:;
// 2258 REALOP=1 %IF OPERATOR=1 %OR OPERATOR=8
if (OPERATOR == 1) goto L_0290;
if (OPERATOR != 8) goto L_0291;
L_0290:;
REALOP = 1;
L_0291:;
// 2259 OPERATOR=12 %IF OPERATOR=1
if (OPERATOR != 1) goto L_0292;
OPERATOR = 12;
L_0292:;
// 2260 NOPS=NOPS+1; LASTOP=OPERATOR
NOPS = NOPS + 1;
LASTOP = OPERATOR;
// 2261 C=PRECEDENCE(OPERATOR)
C = PRECEDENCE[OPERATOR - 1];
// 2262 L51: ->L52 %IF C>OPPREC(QP-1); !OPERATOR MAY BE STORED
U_108D:;
if (C <= OPPREC[QP - 1]) goto L_0293;
goto U_108E;
L_0293:;
// 2263 QP=QP-1
QP = QP - 1;
// 2264 ST(N0)=OP(QP)
ST[N0] = OP[QP];
// 2265 N0=N0+3; ->L51; !UNLOAD STACK
N0 = N0 + 3;
goto U_108D;
// 2266 L52: OP(QP)=10+OPERATOR
U_108E:;
OP[QP] = 10 + OPERATOR;
// 2267 OPPREC(QP)=C; ->L1; !FOR NEXT OPERAND
OPPREC[QP] = C;
goto U_1075;
// 2268 L60: %COMMENT - END OF EXPRESSION
U_108C:;
// 2269 %CYCLE JJ=QP-1,-1,0
// %for JJ = QP - 1, -1, 0 %cycle
{
int _initial = QP - 1;
if (invalid_for_loop(_initial, -1, 0)) _imp_signal(5, 1, 0, "Illegal cycle JJ = QP - 1, -1, 0");
JJ = _initial - (-1);
L_0294:
if (JJ == 0) goto L_0295;
JJ -= 1;
// ?Non-local
// 2270 ST(N0)=OP(JJ)
ST[N0] = OP[JJ];
// 2271 N0=N0+3; %REPEAT; !EMPTY OPERATOR STACK
N0 = N0 + 3;
goto L_0294;
}
L_0295:;
// 2272 REAL=1 %IF MODE#1 %AND REALOP=1
if (MODE == 1) goto L_0297;
if (REALOP != 1) goto L_0297;
REAL = 1;
L_0297:;
// 2273 ->L70 %IF REAL=1
if (REAL != 1) goto L_0298;
goto U_108F;
L_0298:;
// 2274 %COMMENT - CAN EVALUATE AS INTEGER
// 2275 PRINT ORDERS
PRINTORDERS();
// 2276 L61: ->L71 %IF MODE>=2
U_1090:;
if (MODE < 2) goto L_0299;
goto U_1091;
L_0299:;
// 2277 L72: D=1; REG=REG-1 %IF 0>=REG
U_1092:;
D = 1;
if (0 < REG) goto L_029A;
REG = REG - 1;
L_029A:;
// 2278 LOAD(D,REG,REAL) %UNLESS REAL=0 %AND 0>REG %AND DP(1)<0 %C
if (REAL != 0) goto L_0296;
if (0 <= REG) goto L_0296;
if (DP[0] >= 0) goto L_0296;
if (REGISTER[BS[0]] < 0) goto L_029B;
L_0296:;
LOAD(/*?*/ &D, REG, REAL);
L_029B:;
// 2279+ %AND REGISTER(BS(1))<0; ! RESULT IN LOCKED REG
// 2280 NEST=BS(1)
NEST = BS[0];
// 2281 %IF REAL=1 %THEN FREG(NEST)=0 %ELSE %START
if (REAL != 1) goto L_029C;
FREG[NEST] = 0;
goto L_029D;
L_029C:;
// 2282 REGISTER(NEST)=0 %IF REGISTER(NEST)>0; %FINISH
if (REGISTER[NEST] <= 0) goto L_029E;
REGISTER[NEST] = 0;
L_029E:;
L_029D:;
// 2283 PTYPE=1+30*LONGREAL+REAL
PTYPE = 1 + 30 * LONGREAL + REAL;
// 2284 N0=NOP; UNPACK; ->L99
N0 = NOP;
UNPACK();
goto U_1093;
// 2285 L70: %COMMENT EVALUATE AS REAL
U_108F:;
// 2286 FAULT(24) %IF MODE=1; ! REAL IN INTEGER EXPRN
if (MODE != 1) goto L_029F;
FAULT(24);
L_029F:;
// 2287 LONGREAL=1 %IF MODE=3
if (MODE != 3) goto L_02A0;
LONGREAL = 1;
L_02A0:;
// 2288 EVALUATE=16*LONGREAL
EVALUATE = 16 * LONGREAL;
// 2289 PRINT ORDERS
PRINTORDERS();
// 2290 ->L72
goto U_1092;
// 2291 L71: LONGREAL=1 %IF MODE=3
U_1091:;
if (MODE != 3) goto L_02A1;
LONGREAL = 1;
L_02A1:;
// 2292 REAL=1
REAL = 1;
// 2293 EVALUATE=16*LONGREAL
EVALUATE = 16 * LONGREAL;
// 2294 ->L72
goto U_1092;
// 2295 L80: %COMMENT SINGLE OPERAND EXPRESSION
U_107F:;
// 2296 BS(1)=NEST; DP(1)=-1
BS[0] = NEST;
DP[0] = -1;
// 2297 PT(1)=PREC<<3!TYPE
PT[0] = PREC << 3 | TYPE;
// 2298 AFLAG=0; P=P+1
AFLAG = 0;
P = P + 1;
// 2299 FAULT(24) %IF TYPE=2 %AND MODE=1
if (TYPE != 2) goto L_02A2;
if (MODE != 1) goto L_02A2;
FAULT(24);
L_02A2:;
// 2300 ->L61 %IF TYPE=1; ->L71
if (TYPE != 1) goto L_02A3;
goto U_1090;
L_02A3:;
goto U_1091;
// 2301 L99: %END;->L99
U_1093:;
goto end_1004;
case_S_dispatch:
if (S_index < 1 || S_index > 4)
_imp_signalf(6, 3, S_index, "->S(%d) out of bounds at %s line %d", S_index, S_file, S_line);
goto *S[S_index - 1];
case_SW_dispatch:
if (SW_index < 1 || SW_index > 4)
_imp_signalf(6, 3, SW_index, "->SW(%d) out of bounds at %s line %d", SW_index, SW_file, SW_line);
goto *SW[SW_index - 1];
case_SW_missing:
_imp_signalf(8, 2, SW_index, "switch jump to undefined label SW(%d): at %s line %d", SW_index, SW_file,
SW_line);
end_1004:;
}
goto U_1072;
// 2302 %INTEGERFN FINDR
int FINDR(void) {
// 2303 !%SHORTROUTINE
// 2304 %INTEGER I
int I;
// 2305 ->L2 %IF 0>=REG
if (0 < REG) goto L_02A4;
goto U_1074;
L_02A4:;
// 2306 I=REG; ->L1 %IF REGISTER(I)=0
I = REG;
if (REGISTER[I] != 0) goto L_02A5;
goto U_1075;
L_02A5:;
// 2307 L2: %CYCLE I=1,1,RBASE-1
U_1074:;
// %for I = 1, 1, RBASE - 1 %cycle
{
int _final = RBASE - 1;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle I = 1, 1, RBASE - 1");
I = 0;
L_02A6:
if (I == _final) goto L_02A7;
I += 1;
// 2308 ->L1 %IF REGISTER(I)=0
if (REGISTER[I] != 0) goto L_02A9;
goto U_1075;
L_02A9:;
// 2309 %REPEAT; FAULT(241)
goto L_02A6;
}
L_02A7:;
FAULT(241);
// 2310 L1: REGISTER(I)=1; %RESULT=I; %END
U_1075:;
REGISTER[I] = 1;
return I;
} /* end of FINDR */
// 2311 %INTEGERFN FINDPR
int FINDPR(void) {
// 2312 %INTEGER I
int I;
// 2313 %CYCLE I=0,2,6
// %for I = 0, 2, 6 %cycle
{
I = -2;
L_02AA:
if (I == 6) goto L_02AB;
I += 2;
// 2314 ->FOUND %IF REGISTER(I)=0 %AND REGISTER(I+1)=0
if (REGISTER[I] != 0) goto L_02AC;
if (REGISTER[I + 1] != 0) goto L_02AC;
goto U_1075;
L_02AC:;
// 2315 %REPEAT
goto L_02AA;
}
L_02AB:;
// 2316 FAULT(242)
FAULT(242);
// 2317 FOUND: REGISTER(I)=1
U_1075:;
REGISTER[I] = 1;
// 2318 REGISTER(I+1)=1
REGISTER[I + 1] = 1;
// 2319 %RESULT=I
return I;
// 2320 %END
} /* end of FINDPR */
// 2321 %INTEGERFN FIND FR
int FINDFR(void) {
// 2322 !%SHORTROUTINE
// 2323 %INTEGER I
int I;
// 2324 %CYCLE I=6,-2,0
// %for I = 6, -2, 0 %cycle
{
I = 8;
L_02AD:
if (I == 0) goto L_02AE;
I -= 2;
// 2325 ->L1 %IF FREG (I)=0
if (FREG[I] != 0) goto L_02AF;
goto U_1076;
L_02AF:;
// 2326 %REPEAT; FAULT(242)
goto L_02AD;
}
L_02AE:;
FAULT(242);
// 2327 L1: FREG(I)=1; %RESULT=I
U_1076:;
FREG[I] = 1;
return I;
// 2328 %END
} /* end of FINDFR */
// 2329 %ROUTINE LOAD(%INTEGERNAME N,%INTEGER REG,MODE)
void LOAD(int *N, int REG, int MODE) {
// 2330 !%SHORTROUTINE
// 2331 %INTEGER I,X
int I;
int X;
// 2332 %INTEGERNAME BSI,DPI,PTI
int *BSI;
int *DPI;
int *PTI;
// 2333 I=N; ->NOCHOICE %UNLESS I=0
I = *N;
if (I == 0) goto L_02B0;
goto U_107F;
L_02B0:;
// 2334 I=1; ->CHOSEN %IF DP(1)<0 %AND REGISTER(BS(1))>=0
I = 1;
if (DP[0] >= 0) goto L_02B1;
if (REGISTER[BS[0]] < 0) goto L_02B1;
goto U_1080;
L_02B1:;
// 2335 I=2; ->CHOSEN %IF DP(2)<0 %AND REGISTER(BS(2))>=0
I = 2;
if (DP[1] >= 0) goto L_02B2;
if (REGISTER[BS[1]] < 0) goto L_02B2;
goto U_1080;
L_02B2:;
// 2336 ->CHOSEN %IF MODE=0 %AND (PT(2)=255 %OR PT(2)&24=8)
if (MODE != 0) goto L_02B3;
if (PT[1] == 255) goto L_02A8;
if (PT[1] & 24 != 8) goto L_02B3;
L_02A8:;
goto U_1080;
L_02B3:;
// 2337 ->CHOSEN %IF MODE=1 %AND (PT(2)&7=1 %OR (EVALUATE>0 %AND %C
if (MODE != 1) goto L_02B4;
if (PT[1] & 7 == 1) goto L_02B5;
if (EVALUATE <= 0) goto L_02B4;
if (PT[1] & 24 != 0) goto L_02B4;
L_02B5:;
goto U_1080;
L_02B4:;
// 2338+ PT(2)&24=0)); I=1
I = 1;
// 2339 CHOSEN: N=I
U_1080:;
*N = I;
// 2340 NOCHOICE:BSI==BS(I);DPI==DP(I);PTI==PT(I)
U_107F:;
BSI = (int *)/*?*/ &BS[I - 1];
DPI = (int *)/*?*/ &DP[I - 1];
PTI = (int *)/*?*/ &PT[I - 1];
// 2341 ->SHORT CONST %IF MODE=0 %AND PTI=255
if (MODE != 0) goto L_02B6;
if (*PTI != 255) goto L_02B6;
goto U_1081;
L_02B6:;
// 2342 TEST(I) %IF MODE=1 %OR PTI&64#0
if (MODE == 1) goto L_02B7;
if (*PTI & 64 == 0) goto L_02B8;
L_02B7:;
TEST(I);
L_02B8:;
// 2343 ->INREG %IF DPI<0
if (*DPI >= 0) goto L_02B9;
goto U_1082;
L_02B9:;
// 2344 ->NOFIND %IF REG>=0
if (REG < 0) goto L_02BA;
goto U_1083;
L_02BA:;
// 2345 %IF MODE=0 %THEN REG=FINDR %ELSE REG=FINDFR
if (MODE != 0) goto L_02BB;
REG = FINDR();
goto L_02BC;
L_02BB:;
REG = FINDFR();
L_02BC:;
// 2346 NOFIND: X=MODE<<3! (PTI>>2&6)+2
U_1083:;
X = (MODE << 3 | (unsigned int)*PTI >> 2 & 6) + 2;
// 2347 DUMP(X,REG,DPI,0,BSI) ; ->L98 ;! PICK UP VARIABLE
DUMP(X, REG, *DPI, 0, *BSI);
goto U_1084;
// 2348 INREG: ->L90 %IF MODE=1
U_1082:;
if (MODE != 1) goto L_02BD;
goto U_1085;
L_02BD:;
// 2349 ->L99 %IF BSI=REG
if (*BSI != REG) goto L_02BE;
goto U_1086;
L_02BE:;
// 2350 ->LOCKED %IF REGISTER(BSI)<0
if (REGISTER[*BSI] >= 0) goto L_02BF;
goto U_1087;
L_02BF:;
// 2351 ->L99 %IF 0>REG
if (0 <= REG) goto L_02C0;
goto U_1086;
L_02C0:;
// 2352 REGISTER(BSI)=0
REGISTER[*BSI] = 0;
// 2353 SWOP: PRR(X'18',REG,BSI); ->L98
U_1088:;
PRR(24, REG, *BSI);
goto U_1084;
// 2354 LOCKED: REG=FINDR %IF 0>REG; ->SWOP
U_1087:;
if (0 <= REG) goto L_02C1;
REG = FINDR();
L_02C1:;
goto U_1088;
// 2355 L90: ->L91 %IF BSI=0; !CURRENTLY CAN LEAVE NOTHING INFR0
U_1085:;
if (*BSI != 0) goto L_02C2;
goto U_1089;
L_02C2:;
// 2356 ->L99 %IF BSI=REG %OR 0>REG
if (*BSI == REG) goto L_02C3;
if (0 <= REG) goto L_02C4;
L_02C3:;
goto U_1086;
L_02C4:;
// 2357 L91:
U_1089:;
// 2358 REG=FINDFR %IF 0>REG
if (0 <= REG) goto L_02C5;
REG = FINDFR();
L_02C5:;
// 2359 PRR(X'38'-EVALUATE,REG,BSI)
PRR(56 - EVALUATE, REG, *BSI);
// 2360 FREG(BSI)=0; ->L98
FREG[*BSI] = 0;
goto U_1084;
// 2361 SHORT CONST: REG=FINDR %IF 0>REG
U_1081:;
if (0 <= REG) goto L_02C6;
REG = FINDR();
L_02C6:;
// 2362 DUMP(0,REG,DPI,0,0); !LOAD ADDRESS
DUMP(0, REG, *DPI, 0, 0);
// 2363 L98: BSI=REG; DPI=-2
U_1084:;
*BSI = REG;
*DPI = -2;
// 2364 L99: %END
U_1086:;
return;
} /* end of LOAD */
// 2365 %ROUTINE PLANT(%INTEGER OPCODE,R1,R2)
void PLANT(int OPCODE, int R1, int R2) {
// 2366 !%SHORTROUTINE
// 2367 %INTEGER BSR2
int BSR2;
// 2368 BSR2=BS(R2);R1=BS(R1)
BSR2 = BS[R2 - 1];
R1 = BS[R1 - 1];
// 2369 ->RROP %IF DP(R2)<0
if (DP[R2 - 1] >= 0) goto L_02C7;
goto U_107B;
L_02C7:;
// 2370 %IF PT(R2)&24=16 %AND X'5A'<=OPCODE<=X'5B' %THEN %C
if (PT[R2 - 1] & 24 != 16) goto L_02C8;
{
// Double-sided test on OPCODE (Part I)
int tmp;
if (90 > (tmp = OPCODE)) goto L_02C8;
// Double-sided test on OPCODE (Part II)
if (tmp > 91) goto L_02C8;
}
OPCODE = OPCODE - 16;
L_02C8:;
// 2371+ OPCODE=OPCODE-16; ! CAN PLANT HALF LENGTH OP
// 2372 PRX(OPCODE,R1,0,BSR2,DP(R2));->L99
PRX(OPCODE, R1, 0, BSR2, DP[R2 - 1]);
goto U_107C;
// 2373 RROP: PRR(OPCODE-64,R1,BSR2)
U_107B:;
PRR(OPCODE - 64, R1, BSR2);
// 2374 %IF REAL=1 %THEN FREG(BSR2)=0
if (REAL != 1) goto L_02C9;
FREG[BSR2] = 0;
L_02C9:;
// 2375 %IF REAL=0 %AND REGISTER(BSR2)>0 %THEN REGISTER(BSR2)=0
if (REAL != 0) goto L_02CA;
if (REGISTER[BSR2] <= 0) goto L_02CA;
REGISTER[BSR2] = 0;
L_02CA:;
// 2376 L99: %END
U_107C:;
return;
} /* end of PLANT */
// 2377 %ROUTINE TEST(%INTEGER N)
void TEST(int N) {
// 2378 !%SHORTROUTINE
// 2379 %COMMENT INSPECTS OPERAND - MAKES TYPE CONVERSIONS ETC.
// 2380 %INTEGER X
int X;
// 2381 %INTEGERNAME LBASE,LDISP,LPTYPE
int *LBASE;
int *LDISP;
int *LPTYPE;
// 2382 %BYTEINTEGER LPREC
unsigned char LPREC;
// 2383 LPTYPE==PT(N); LDISP==DP(N)
LPTYPE = (int *)/*?*/ &PT[N - 1];
LDISP = (int *)/*?*/ &DP[N - 1];
// 2384 LBASE==BS(N); LPREC=LPTYPE>>3&3
LBASE = (int *)/*?*/ &BS[N - 1];
LPREC = (unsigned int)*LPTYPE >> 3 & 3;
// 2385 ->SHORTCONST %IF LPTYPE=255
if (*LPTYPE != 255) goto L_02CB;
goto U_107D;
L_02CB:;
// 2386 ->START %UNLESS LPTYPE&64 #0 ;! GO UNLESS NAME TYPE
if (*LPTYPE & 64 != 0) goto L_02CC;
goto U_107E;
L_02CC:;
// 2387 RP13=R13;R13=LBASE<<12!LDISP
RP13 = R13;
R13 = *LBASE << 12 | *LDISP;
// 2388 PRX(X'58',LINK,0,LBASE,LDISP) %UNLESS R13=RP13
if (R13 == RP13) goto L_02CD;
PRX(88, LINK, 0, *LBASE, *LDISP);
L_02CD:;
// 2389 LPTYPE=LPTYPE&31; LBASE=LINK;LDISP=0
*LPTYPE = *LPTYPE & 31;
*LBASE = LINK;
*LDISP = 0;
// 2390 START: ->FLOATING %IF REAL#0
U_107E:;
if (REAL == 0) goto L_02CE;
goto U_107F;
L_02CE:;
// 2391 ->FINISH %IF LPREC=0 %OR (LPREC=2 %AND 12<=OPCODE<=13)
if (LPREC == 0) goto L_02CF;
if (LPREC != 2) goto L_02D0;
{
// Double-sided test on OPCODE (Part I)
int tmp;
if (12 > (tmp = OPCODE)) goto L_02D0;
// Double-sided test on OPCODE (Part II)
if (tmp > 13) goto L_02D0;
}
L_02CF:;
goto U_1080;
L_02D0:;
// 2392 PICKUP: LOAD(N,-1,0)
U_1081:;
LOAD(/*?*/ &N, -1, 0);
// 2393 LPREC=0; ->FINISH
LPREC = 0;
goto U_1080;
// 2394 SHORTCONST: LPREC=0; ->PICK UP %IF REAL=0
U_107D:;
LPREC = 0;
if (REAL != 0) goto L_02D1;
goto U_1081;
L_02D1:;
// 2395 ->INGLA %IF 0<=LDISP<=2;! THESE 3 ALWAYS IN THE GLA
{
// Double-sided test on LDISP (Part I)
int tmp;
if (0 > (tmp = *LDISP)) goto L_02D2;
// Double-sided test on LDISP (Part II)
if (tmp > 2) goto L_02D2;
}
goto U_1082;
L_02D2:;
// 2396 A(-2)=9; A(-1)=LDISP
A[0] = 9;
A[1] = *LDISP;
// 2397 LDISP= SORT CONST(-2,LONGREAL,2);! COMPILE TIME FLOAT
*LDISP = SORTCONST(-2, LONGREAL, 2);
// 2398 L1: LBASE=GLA; ->FINISH
U_1083:;
*LBASE = GLA;
goto U_1080;
// 2399 INGLA: LDISP= 8*LDISP+40; ->L1
U_1082:;
*LDISP = 8 * *LDISP + 40;
goto U_1083;
// 2400 FLOATING:->FLOAT IT %IF LPTYPE&7=1 ;! INTEGER - RUN TIME FLOAT
U_107F:;
if (*LPTYPE & 7 != 1) goto L_02D3;
goto U_1084;
L_02D3:;
// 2401 ->FINISH %IF LPREC=3 %OR EVALUATE=0
if (LPREC == 3) goto L_02D4;
if (EVALUATE != 0) goto L_02D5;
L_02D4:;
goto U_1080;
L_02D5:;
// 2402 %COMMENT MUST STRETCH A 32 BIT REAL
// 2403 FREG(LBASE)=1 %IF LDISP<0
if (*LDISP >= 0) goto L_02D6;
FREG[*LBASE] = 1;
L_02D6:;
// 2404 X=FINDFR;PRR(X'2B',X,X); !FIND AND CLEAR REGISTER
X = FINDFR();
PRR(43, X, X);
// 2405 %IF LDISP<0 %THEN %START
if (*LDISP >= 0) goto L_02D7;
// 2406 PRR(X'38',X,LBASE); ! LER_X,LBASE
PRR(56, X, *LBASE);
// 2407 FREG(LBASE)=0;
FREG[*LBASE] = 0;
// 2408 %FINISH %ELSE PRX(X'78',X,0,LBASE,LDISP)
goto L_02D8;
L_02D7:;
PRX(120, X, 0, *LBASE, *LDISP);
L_02D8:;
// 2409 LBASE=X;LDISP=-2; ->FINISH
*LBASE = X;
*LDISP = -2;
goto U_1080;
// 2410 FLOATIT: LOAD(N,1,0);PPJ(43); REGISTER(1)=0
U_1084:;
LOAD(/*?*/ &N, 1, 0);
PPJ(43);
REGISTER[1] = 0;
// 2411 LBASE=0; LDISP=-2
*LBASE = 0;
*LDISP = -2;
// 2412 FINISH: LPTYPE=(1+REAL)!LPREC<<3
U_1080:;
*LPTYPE = 1 + REAL | LPREC << 3;
// 2413 %IF LONGREAL=1 %AND REAL=1 %THEN LPTYPE=LPTYPE!24
if (LONGREAL != 1) goto L_02D9;
if (REAL != 1) goto L_02D9;
*LPTYPE = *LPTYPE | 24;
L_02D9:;
// 2414 %END
return;
} /* end of TEST */
// 2415 %ROUTINE MULT(%INTEGERNAME RESULT)
void MULT(int *RESULT) {
// 2416 !%SHORTROUTINE
// 2417 %INTEGER I,K
int I;
int K;
// 2418 %CYCLE I=1,1,2
// %for I = 1, 1, 2 %cycle
{
I = 0;
L_02DA:
if (I == 2) goto L_02DB;
I += 1;
// 2419 ->L30 %IF PT(I)=255 %AND DP(I)=2
if (PT[I - 1] != 255) goto L_02DD;
if (DP[I - 1] != 2) goto L_02DD;
goto U_107B;
L_02DD:;
// 2420 ->L1 %IF DP(I)<0 %AND REGISTER(BS(I))>=0
if (DP[I - 1] >= 0) goto L_02DE;
if (REGISTER[BS[I - 1]] < 0) goto L_02DE;
goto U_107C;
L_02DE:;
// 2421 L5: %REPEAT
U_107D:;
goto L_02DA;
}
L_02DB:;
// 2422 I=1; K=FINDPR
I = 1;
K = FINDPR();
// 2423 LOAD(I,K+1,0); ->L11
LOAD(/*?*/ &I, K + 1, 0);
goto U_107E;
// 2424 L1: ->L14 %IF BS(I)&1=1 %AND I>0 %AND REGISTER(BS(I)-1)=0
U_107C:;
if (BS[I - 1] & 1 != 1) goto L_02DF;
if (I <= 0) goto L_02DF;
if (REGISTER[BS[I - 1] - 1] != 0) goto L_02DF;
goto U_107F;
L_02DF:;
// 2425 ->L12 %IF BS(I)&1=0 %AND REGISTER(BS(I)+1)=0
if (BS[I - 1] & 1 != 0) goto L_02E0;
if (REGISTER[BS[I - 1] + 1] != 0) goto L_02E0;
goto U_1080;
L_02E0:;
// 2426 ->L5
goto U_107D;
// 2427 L12: K=BS(I); REGISTER(K+1)=1
U_1080:;
K = BS[I - 1];
REGISTER[K + 1] = 1;
// 2428 PRR(X'18',K+1,K); ->L13
PRR(24, K + 1, K);
goto U_1081;
// 2429 L14: REGISTER(BS(I)-1)=1
U_107F:;
REGISTER[BS[I - 1] - 1] = 1;
// 2430 L11: BS(I)=BS(I)-1
U_107E:;
BS[I - 1] = BS[I - 1] - 1;
// 2431 L13: TEST(3-I); PLANT(X'5C',I,3-I);! MULTIPLY
U_1081:;
TEST(3 - I);
PLANT(92, I, 3 - I);
// 2432 ->L15 %IF CHECKSP=0
if (CHECKSP != 0) goto L_02E1;
goto U_1082;
L_02E1:;
// 2433 PRX(X'8F',BS(I),0,0,32); ! SLDA ?,32
PRX(143, BS[I - 1], 0, 0, 32);
// 2434 L15: RESULT=257+BS(I)-CHECKSP
U_1082:;
*RESULT = 257 + BS[I - 1] - CHECKSP;
// 2435 REGISTER(BS(I)+CHECKSP)=0
REGISTER[BS[I - 1] + CHECKSP] = 0;
// 2436 AFLAG=CHECKS
AFLAG = CHECKS;
// 2437 ->L99
goto U_1083;
// 2438 L30: K= 3-I; LOAD(K,-1,0)
U_107B:;
K = 3 - I;
LOAD(/*?*/ &K, -1, 0);
// 2439 PRR(X'1A',BS(K),BS(K))
PRR(26, BS[K - 1], BS[K - 1]);
// 2440 AFLAG=1; RESULT=256+BS(K)
AFLAG = 1;
*RESULT = 256 + BS[K - 1];
// 2441 L99: %END
U_1083:;
return;
} /* end of MULT */
// 2442 %ROUTINE DIV(%INTEGERNAME RESULT)
void DIV(int *RESULT) {
// 2443 !%SHORTROUTINE
// 2444 %INTEGER I,K
int I;
int K;
// 2445 ->L3 %IF DP(1)<0
if (DP[0] >= 0) goto L_02E2;
goto U_107C;
L_02E2:;
// 2446 L1: K=FIND PR
U_107D:;
K = FINDPR();
// 2447 L2: I=1; LOAD(I,K,0); ->L10
U_107E:;
I = 1;
LOAD(/*?*/ &I, K, 0);
goto U_107F;
// 2448 L3: ->L4 %IF BS(1)&1=0 %AND REGISTER(BS(1)+1)=0
U_107C:;
if (BS[0] & 1 != 0) goto L_02E3;
if (REGISTER[BS[0] + 1] != 0) goto L_02E3;
goto U_1080;
L_02E3:;
// 2449 K=FINDPR; ->L2
K = FINDPR();
goto U_107E;
// 2450 L4: ->L1 %IF REGISTER(BS(1))<0; !A CLAIMED REGISTER
U_1080:;
if (REGISTER[BS[0]] >= 0) goto L_02E4;
goto U_107D;
L_02E4:;
// 2451 REGISTER(BS(1)+1)=1; K=BS(1)
REGISTER[BS[0] + 1] = 1;
K = BS[0];
// 2452 L10: PRX(X'8E',K,0,0,32); ! SRDA K,32
U_107F:;
PRX(142, K, 0, 0, 32);
// 2453 TEST(2); PLANT(X'5D',1,2); ! DIVIDE
TEST(2);
PLANT(93, 1, 2);
// 2454 ->L20 %IF CHECKSP=0
if (CHECKSP != 0) goto L_02E5;
goto U_1081;
L_02E5:;
// 2455 ->L20 %IF OPCODE=17; PRR(X'12',K,K); ! LTR
if (OPCODE != 17) goto L_02E6;
goto U_1081;
L_02E6:;
PRR(18, K, K);
// 2456 PRX(X'47',7,0,CODER,64); ! BC 7,64(CODE)
PRX(71, 7, 0, CODER, 64);
// 2457 L20: REGISTER(K)=0
U_1081:;
REGISTER[K] = 0;
// 2458 AFLAG=0;RESULT=K+257
AFLAG = 0;
*RESULT = K + 257;
// 2459 %END
return;
} /* end of DIV */
// 2460 %ROUTINE PRINT ORDERS
void PRINTORDERS(void) {
// 2461 !%SHORTROUTINE
// 2462 %SWITCH S(0:49)
int S_index;
int S_line;
char *S_file;
static const void *S[50] = {
&&case_S_0, &&case_S_1, &&case_S_2, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_9, &&case_S_10, &&case_S_11,
&&case_S_12, &&case_S_13, &&case_S_14, &&case_S_15, &&case_S_16, &&case_S_17,
&&case_S_18, &&case_S_19, &&case_S_20, &&case_S_21, &&case_S_22, &&case_S_23,
&&case_S_24, &&case_S_25, &&case_S_26, &&case_S_27, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_33, &&case_S_34, &&case_S_35,
&&case_S_36, &&case_S_37, &&case_S_38, &&case_S_39, &&case_S_40, &&case_S_41,
&&case_S_42, &&case_S_43, &&case_S_44, &&case_S_45, &&case_S_46, &&case_S_47,
&&case_S_48, &&case_S_49};
// 2463 %INTEGER C,D,LAST,KK
int C;
int D;
int LAST;
int KK;
// 2464 LAST=N0-6
LAST = N0 - 6;
// 2465 %CYCLE JJ=NOP,3,LAST
// %for JJ = NOP, 3, LAST %cycle
{
int _initial = NOP, _final = LAST;
if (invalid_for_loop(_initial, 3, _final)) _imp_signal(5, 1, 0, "Illegal cycle JJ = NOP, 3, LAST");
JJ = _initial - (3);
L_02E7:
if (JJ == _final) goto L_02E8;
JJ += 3;
// ?Non-local
// 2466 OPCODE=ST(JJ)
OPCODE = ST[JJ];
// 2467 ->SKIP %IF 10>=OPCODE %OR OPCODE=24
if (10 >= OPCODE) goto L_02E9;
if (OPCODE != 24) goto L_02EA;
L_02E9:;
goto U_107E;
L_02EA:;
// 2468 %IF OPCODE=11 %OR OPCODE=23 %THEN KK=1 %ELSE KK=2
if (OPCODE == 11) goto L_02EB;
if (OPCODE != 23) goto L_02EC;
L_02EB:;
KK = 1;
goto L_02ED;
L_02EC:;
KK = 2;
L_02ED:;
// 2469 %CYCLE KK=KK,-1,1
// %for KK = KK, -1, 1 %cycle
{
int _initial = KK;
if (invalid_for_loop(_initial, -1, 1)) _imp_signal(5, 1, 0, "Illegal cycle KK = KK, -1, 1");
KK = _initial - (-1);
L_02EE:
if (KK == 1) goto L_02EF;
KK -= 1;
// 2470 POP(OPHEAD,C,DP(KK))
POP(/*?*/ &OPHEAD, /*?*/ &C, /*?*/ &DP[KK - 1]);
// 2471 PT(KK)=C>>8; BS(KK)=C&15
PT[KK - 1] = (unsigned int)C >> 8;
BS[KK - 1] = C & 15;
// 2472 %REPEAT
goto L_02EE;
}
L_02EF:;
// 2473 SKIP: ->S(OPCODE+25*REAL)
U_107E:;
S_line = __LINE__;
S_file = __FILE__;
S_index = OPCODE + 25 * REAL;
goto case_S_dispatch;
// 2474 S(0): ! INTEGER CONST<4096 IN INT EXP
case_S_0:;
// 2475 S(25): ! INT CONST<4096 IN REAL EXRRN
case_S_25:;
// 2476 D=X'FF00'; C=ST(JJ+2);->L99
D = 65280;
C = ST[JJ + 2];
goto U_107F;
// 2477 S(1): ! LONG INT CONST IN INT EXPRN
case_S_1:;
// 2478 C=SORT CONST(ST(JJ+1),0,1)
C = SORTCONST(ST[JJ + 1], 0, 1);
// 2479 D=256+GLA;->L99
D = 256 + GLA;
goto U_107F;
// 2480 S(26): ! LONG ICONST IN EXPRN
case_S_26:;
// 2481 D=512+GLA; D=D+3<<11 %IF LONGREAL=1
D = 512 + GLA;
if (LONGREAL != 1) goto L_02F2;
D = D + (3 << 11);
L_02F2:;
// 2482 C=SORT CONST(ST(JJ+1),LONGREAL,2);->L99
C = SORTCONST(ST[JJ + 1], LONGREAL, 2);
goto U_107F;
// 2483 S(2): S(27): !LOCAL VARIABLE
case_S_2:;
case_S_27:;
// 2484 D=ST(JJ+1); C=ST(JJ+2); ->L99
D = ST[JJ + 1];
C = ST[JJ + 2];
goto U_107F;
// 2485 S(33): ! REAL IN FR
case_S_33:;
// 2486 D=ST(JJ+1); C=-2; ->L99
D = ST[JJ + 1];
C = -2;
goto U_107F;
// 2487 S(9): S(34): !(INTEGER) IN G.R.
case_S_9:;
case_S_34:;
// 2488 D=256+ST(JJ+1); C=-2; ->L99
D = 256 + ST[JJ + 1];
C = -2;
goto U_107F;
// 2489 S(10): S(35): !PARKED IN CORE
case_S_10:;
case_S_35:;
// 2490 C=ST(JJ+2);D=ST(JJ+1)
C = ST[JJ + 2];
D = ST[JJ + 1];
// 2491 %IF REAL=1 %AND D>>8&24=24 %THEN PUSH(LWSP(LEVEL),0,C) %ELSE %C
if (REAL != 1) goto L_02F3;
if ((unsigned int)D >> 8 & 24 != 24) goto L_02F3;
PUSH(/*?*/ &LWSP[LEVEL], 0, C);
goto L_02F4;
L_02F3:;
PUSH(/*?*/ &WSP[LEVEL], 0, C);
L_02F4:;
// 2492+ PUSH(WSP(LEVEL),0,C); ->L99
goto U_107F;
// 2493 S(11): ! NEGATE IN INTEGER EXPRN
case_S_11:;
// 2494 ->L109 %UNLESS PT(1)=255 %AND DP(1)=1
if (PT[0] != 255) goto L_02F0;
if (DP[0] == 1) goto L_02F5;
L_02F0:;
goto U_1080;
L_02F5:;
// 2495 AFLAG=0; D=256+GLA; C=16; ->L99 ;! OPTIMISE (-1)
AFLAG = 0;
D = 256 + GLA;
C = 16;
goto U_107F;
// 2496 S(36): ! NEGATE IN REAL EXPRN
case_S_36:;
// 2497 L109: C=1; D=X'13'+REAL*(32-EVALUATE)
U_1080:;
C = 1;
D = 19 + REAL * (32 - EVALUATE);
// 2498 LOAD(C,-1,REAL)
LOAD(/*?*/ &C, -1, REAL);
// 2499 AFLAG=1
AFLAG = 1;
// 2500 PRR(D,BS(1),BS(1)); ! LCR,LCER,LCDR
PRR(D, BS[0], BS[0]);
// 2501 L111: D=(REAL+1+24*LONGREAL)<<8!BS(C)
U_1081:;
D = REAL + 1 + 24 * LONGREAL << 8 | BS[C - 1];
// 2502 C=-2; ->L99
C = -2;
goto U_107F;
// 2503 S(23): !INITIAL NOT
case_S_23:;
// 2504 C=1; AFLAG=2; LOAD(C,-1,0)
C = 1;
AFLAG = 2;
LOAD(/*?*/ &C, -1, 0);
// 2505 PRX(X'57',BS(1),0,GLA,16); ->L111
PRX(87, BS[0], 0, GLA, 16);
goto U_1081;
// 2506 S(12): S(37): !ADDITION
case_S_12:;
case_S_37:;
// 2507 AFLAG=1;D=X'5A'
AFLAG = 1;
D = 90;
// 2508 L125: C=0
U_1082:;
C = 0;
// 2509 L126: LOAD(C,-1,REAL); TEST(3-C)
U_1083:;
LOAD(/*?*/ &C, -1, REAL);
TEST(3 - C);
// 2510 D=D+REAL*(X'20'-EVALUATE)
D = D + REAL * (32 - EVALUATE);
// 2511 PLANT(D,C,3-C);->L111
PLANT(D, C, 3 - C);
goto U_1081;
// 2512 S(13): S(38): !SUBTRACTION
case_S_13:;
case_S_38:;
// 2513 AFLAG=1; D=X'5B';C=1
AFLAG = 1;
D = 91;
C = 1;
// 2514 ->L126 %UNLESS REAL=0 %AND PT(2)=255 %AND 1<=DP(2)<=2
if (REAL != 0) goto L_02F6;
if (PT[1] != 255) goto L_02F6;
{
// Double-sided test on DP[1] (Part I)
int tmp;
if (1 > (tmp = DP[1])) goto L_02F6;
// Double-sided test on DP[1] (Part II)
if (tmp <= 2) goto L_02F7;
}
L_02F6:;
goto U_1083;
L_02F7:;
// 2515 AFLAG=0; LOAD(C,-1,0)
AFLAG = 0;
LOAD(/*?*/ &C, -1, 0);
// 2516 PRR(6,BS(1),0) %IF DP(2)=2
if (DP[1] != 2) goto L_02F8;
PRR(6, BS[0], 0);
L_02F8:;
// 2517 PRR(6,BS(1),0);->L111 ;!BCTR TO SUBTRACT 1 OR 2
PRR(6, BS[0], 0);
goto U_1081;
// 2518 S(14): D=X'57'; !EXCLUSIVE OR
case_S_14:;
D = 87;
// 2519 L141: AFLAG=2; ->L125
U_1084:;
AFLAG = 2;
goto U_1082;
// 2520 S(15): D=X'56';->L141; !OR
case_S_15:;
D = 86;
goto U_1084;
// 2521 S(16): MULT(D); C=-2; ->L99
case_S_16:;
MULT(/*?*/ &D);
C = -2;
goto U_107F;
// 2522 S(17):S(18): DIV(D); C=-2; ->L99
case_S_17:;
case_S_18:;
DIV(/*?*/ &D);
C = -2;
goto U_107F;
// 2523 S(19): D=X'54';->L141; !AND
case_S_19:;
D = 84;
goto U_1084;
// 2524 S(20):S(21): !SLL(21) AND SLR
case_S_20:;
case_S_21:;
// 2525 D=0
D = 0;
// 2526 C=1; LOAD(C,-1,0)
C = 1;
LOAD(/*?*/ &C, -1, 0);
// 2527 D=1 %IF PT(2)=255
if (PT[1] != 255) goto L_02F9;
D = 1;
L_02F9:;
// 2528 C=2; LOAD(C,-1,0) %IF D=0
C = 2;
if (D != 0) goto L_02FA;
LOAD(/*?*/ &C, -1, 0);
L_02FA:;
// 2529 PRX(X'89'+OPCODE-21,BS(1),0,BS(2),D*DP(2))
PRX(137 + OPCODE - 21, BS[0], 0, BS[1], D * DP[1]);
// 2530 REGISTER(BS(2))=0 %IF D=0
if (D != 0) goto L_02FB;
REGISTER[BS[1]] = 0;
L_02FB:;
// 2531 C=1; AFLAG=0; ->L111
C = 1;
AFLAG = 0;
goto U_1081;
// 2532 S(22): %CYCLE C=1,1,2
case_S_22:;
// %for C = 1, 1, 2 %cycle
{
C = 0;
L_02FC:
if (C == 2) goto L_02FD;
C += 1;
// 2533 LOAD(C,-1,0)
LOAD(/*?*/ &C, -1, 0);
// 2534 DUMP(1,BS(C),28+4*C,0,GLA)
DUMP(1, BS[C - 1], 28 + 4 * C, 0, GLA);
// 2535 REGISTER(BS(C))=0; %REPEAT
REGISTER[BS[C - 1]] = 0;
goto L_02FC;
}
L_02FD:;
// 2536 ->L221 %IF REGISTER(0)#0
if (REGISTER[0] == 0) goto L_02FF;
goto U_1085;
L_02FF:;
// 2537 C=2; AFLAG=0
C = 2;
AFLAG = 0;
// 2538 REGISTER(0)=1
REGISTER[0] = 1;
// 2539 PPJ(15); BS(2)=0; ->L111; ! RESULT IN R0
PPJ(15);
BS[1] = 0;
goto U_1081;
// 2540 L221: C=FINDR; D=FINDR; PRR(X'18',C,0)
U_1085:;
C = FINDR();
D = FINDR();
PRR(24, C, 0);
// 2541 PPJ(15); PRR(X'18',D,0); PRR(X'18',0,C)
PPJ(15);
PRR(24, D, 0);
PRR(24, 0, C);
// 2542 REGISTER(C)=0; C=2; AFLAG=0; BS(2)=D; ->L111
REGISTER[C] = 0;
C = 2;
AFLAG = 0;
BS[1] = D;
goto U_1081;
// 2543 S(39):S(40):S(42):S(44):S(45):S(46):S(48): !INTEGER OP IN REAL
case_S_39:;
case_S_40:;
case_S_42:;
case_S_44:;
case_S_45:;
case_S_46:;
case_S_48:;
// 2544 FAULT(24); ! INTEGER OP IN REAL
FAULT(24);
// 2545 %IF OPCODE=23 %THEN OPCODE=36 %ELSE OPCODE=37;! \ ->L - ...
if (OPCODE != 23) goto L_0300;
OPCODE = 36;
goto L_0301;
L_0300:;
OPCODE = 37;
L_0301:;
// 2546 ->S(OPCODE); ! ! TREAT OTHERS AS +
S_line = __LINE__;
S_file = __FILE__;
S_index = OPCODE;
goto case_S_dispatch;
// 2547 S(41): !REAL MULT
case_S_41:;
// 2548 D=X'5C';C=0
D = 92;
C = 0;
// 2549 L410: AFLAG=0; ->L126
U_1086:;
AFLAG = 0;
goto U_1083;
// 2550 S(43): ! REAL DIVISION
case_S_43:;
// 2551 D=X'5D';C=1;->L410
D = 93;
C = 1;
goto U_1086;
// 2552 S(47): !REAL EXPONENTIATION
case_S_47:;
// 2553 C=1; LOAD(C,-1,1)
C = 1;
LOAD(/*?*/ &C, -1, 1);
// 2554 ->L222 %IF PT(2)=255 %AND DP(2)=2; ! OPTIMISE **2
if (PT[1] != 255) goto L_0302;
if (DP[1] != 2) goto L_0302;
goto U_1087;
L_0302:;
// 2555 PRR(X'38'-EVALUATE,0,BS(1))
PRR(56 - EVALUATE, 0, BS[0]);
// 2556 C=2; FAULT(39) %UNLESS PT(2)=255 %OR PT(2)&7<=1
C = 2;
if (PT[1] == 255) goto L_0303;
if (PT[1] & 7 <= 1) goto L_0303;
FAULT(39);
L_0303:;
// 2557 LOAD(C,1,0); PPJ(36)
LOAD(/*?*/ &C, 1, 0);
PPJ(36);
// 2558 REGISTER(1)=0
REGISTER[1] = 0;
// 2559 PRR(X'38'-EVALUATE,BS(1),0)
PRR(56 - EVALUATE, BS[0], 0);
// 2560 C=1;->L111
C = 1;
goto U_1081;
// 2561 L222: PRR(X'3C'-EVALUATE,BS(1),BS(1))
U_1087:;
PRR(60 - EVALUATE, BS[0], BS[0]);
// 2562 C=1; ->L111
C = 1;
goto U_1081;
// 2563 L99: PUSH(OPHEAD,D,C) %UNLESS JJ=LAST
U_107F:;
if (JJ == LAST) goto L_0304;
PUSH(/*?*/ &OPHEAD, D, C);
L_0304:;
// 2564 S(24):S(49): %REPEAT
case_S_24:;
case_S_49:;
goto L_02E7;
}
L_02E8:;
// 2565 DP(1)=C;PT(1)=D>>8;BS(1)=D&15 ;! FINAL RESULT
DP[0] = C;
PT[0] = (unsigned int)D >> 8;
BS[0] = D & 15;
// 2566 %END
return;
case_S_dispatch:
if (S_index < 0 || S_index > 49)
_imp_signalf(6, 3, S_index, "->S(%d) out of bounds at %s line %d", S_index, S_file, S_line);
goto *S[S_index - 0];
case_S_missing:
_imp_signalf(8, 2, S_index, "switch jump to undefined label S(%d): at %s line %d", S_index, S_file, S_line);
} /* end of PRINTORDERS */
// 2567 L99: %END;
U_1072:;
return;
} /* end of CSEXP */
// ?X unused
// 2568 ; ! OF ROUTINE CSEXP
int SORTCONST(int P, int LONG, int TYPE) {
// 2568 %INTEGERFN SORT CONST(%INTEGER P,LONG,TYPE)
// 2569 !%SHORTROUTINE
// 2570 %LONGREAL CVALUE
double CVALUE;
// 2571 %INTEGER I,K
int I;
int K;
// 2572 ->L50 %IF TYPE=2
if (TYPE != 2) goto L_0305;
goto U_1058;
L_0305:;
// 2573 { FAULT(24) %IF A(P)&7#1 ; ! This is faulting erroneously on the sparc
// 2574 %IF A(P)=9 %THEN I=A(P+1) %ELSE FROMAR4(P+1,I)
if (A[P + 2] != 9) goto L_0306;
I = A[P + 1 + 2];
goto L_0307;
L_0306:;
FROMAR4(P + 1, /*?*/ &I);
L_0307:;
// 2575 L40: K=N0
U_1059:;
K = N0;
// 2576 ST(K)=I; N0=N0+1
ST[K] = I;
N0 = N0 + 1;
// 2577 %RESULT =K<<2
return K << 2;
// 2578 L50: CVALUE=0
U_1058:;
CVALUE = 0;
// 2579 ->L60 %UNLESS A(P)&7=1
if (A[P + 2] & 7 == 1) goto L_0308;
goto U_105A;
L_0308:;
// 2580 %IF A(P)=9 %THEN I=A(P+1) %ELSE FROMAR4(P+1,I)
if (A[P + 2] != 9) goto L_0309;
I = A[P + 1 + 2];
goto L_030A;
L_0309:;
FROMAR4(P + 1, /*?*/ &I);
L_030A:;
// 2581 CVALUE=I;->L70
CVALUE = I;
goto U_105B;
// 2582 L60: FROMAR8(P+1,CVALUE)
U_105A:;
FROMAR8(P + 1, /*?*/ &CVALUE);
// 2583 L70: ->L75 %IF LONG#0
U_105B:;
if (LONG == 0) goto L_030B;
goto U_105C;
L_030B:;
// 2584 I=INTEGER(ADDR(CVALUE)); ->L40
I = *_imp_INTEGER(_imp_ADDR(/*?*/ &CVALUE));
goto U_1059;
// 2585 L75: K=(N0+1)&(-2)
U_105C:;
K = N0 + 1 & (-2);
// 2586 ST(K)=INTEGER(ADDR(CVALUE))
ST[K] = *_imp_INTEGER(_imp_ADDR(/*?*/ &CVALUE));
// 2587 ST(K+1)=INTEGER(ADDR(CVALUE)+4)
ST[K + 1] = *_imp_INTEGER(_imp_ADDR(/*?*/ &CVALUE) + 4);
// 2588 N0=K+2
N0 = K + 2;
// 2589 %RESULT=K<<2
return K << 2;
// 2590 %END
} /* end of SORTCONST */
// 2591 %ROUTINE CSTREXP(%INTEGER REG)
void CSTREXP(int REG) {
// 2592 !%SHORTROUTINE
// 2593 %COMMENT EVALUATES STRING EXPR USING CURRENT
// 2594 %COMMENT WORKAREA AND 1 SUBROUTINES LEAVES ADDR IN
// 2595 %COMMENT REG -VE IF STRING MUST BE MOVED TO WK.ARREA
// 2596 %INTEGER JJ,QQ,KK,WKAREA,PP
int JJ;
int QQ;
int KK;
int WKAREA;
int PP;
// 2597 SETEX %UNLESS STRINST#0
if (STRINST != 0) goto L_030C;
SETEX();
L_030C:;
// 2598 PP=P
PP = P;
// 2599 JJ=TSEXP(QQ); ->L71 %IF JJ=20 %AND REG>=0
JJ = TSEXP(/*?*/ &QQ);
if (JJ != 20) goto L_030D;
if (REG < 0) goto L_030D;
goto U_1058;
L_030D:;
// 2600 P=PP; REG=|REG|
P = PP;
REG = _imp_IMOD(REG);
// 2601 WKAREA=GET STR WSP
WKAREA = GETSTRWSP();
// 2602 PSI(X'92',0,RBASE,WKAREA); ! CLEAR WORK AREA
PSI(146, 0, RBASE, WKAREA);
// 2603 ->L2 %IF A(P)=4
if (A[P + 2] != 4) goto L_030E;
goto U_1059;
L_030E:;
// 2604 L1: FAULT(71)
U_105A:;
FAULT(71);
// 2605 L4: P=PP; SKIP EXP; ->L99
U_105B:;
P = PP;
SKIPEXP();
goto U_105C;
// 2606 L5: FAULT(72); ->L4
U_105D:;
FAULT(72);
goto U_105B;
// 2607 L2: ->L10 %IF A(P+1)=2
U_1059:;
if (A[P + 1 + 2] != 2) goto L_030F;
goto U_105E;
L_030F:;
// 2608 ->L1 %UNLESS A(P+1)=1 ;!NAME
if (A[P + 1 + 2] == 1) goto L_0310;
goto U_105A;
L_0310:;
// 2609 P=P+2; CNAME(2,1)
P = P + 2;
CNAME(2, 1);
// 2610 ->L1 %UNLESS TYPE=5;->L20
if (TYPE == 5) goto L_0311;
goto U_105A;
L_0311:;
goto U_105F;
// 2611 L10: P=P+2;->L14 %IF A(P)=5
U_105E:;
P = P + 2;
if (A[P + 2] != 5) goto L_0312;
goto U_1060;
L_0312:;
// 2612 ->L1 %UNLESS A(P)=9 %AND A(P+1)<127
if (A[P + 2] != 9) goto L_02DC;
if (A[P + 1 + 2] < 127) goto L_0313;
L_02DC:;
goto U_105A;
L_0313:;
// 2613 ->L11 %IF A(P+1)=0
if (A[P + 1 + 2] != 0) goto L_0314;
goto U_1061;
L_0314:;
// 2614 PRX(X'41',1,0,0,A(P+1))
PRX(65, 1, 0, 0, A[P + 1 + 2]);
// 2615 P=P+2;->L20
P = P + 2;
goto U_105F;
// 2616 L11: P=P+2; ->L21; ! NULL STRING
U_1061:;
P = P + 2;
goto U_1062;
// 2617 L14: %COMMENT STRING CONSTANT PUT IN CODE CF (TEXTTEXT)
U_1060:;
// 2618 KK=(CA+6+A(P+1)-CODEBASE(LEVEL))&(-2)
KK = CA + 6 + A[P + 1 + 2] - CODEBASE[LEVEL] & (-2);
// 2619 QQ=0;->L15 %IF KK<4095
QQ = 0;
if (KK >= 4095) goto L_0315;
goto U_1063;
L_0315:;
// 2620 KK=KK+4;QQ=1
KK = KK + 4;
QQ = 1;
// 2621 PRX(X'58',1,GLA,0,PAGENO(KK)<<2)
PRX(88, 1, GLA, 0, PAGENO(KK) << 2);
// 2622 L15: PRX(X'45',1,10,QQ,KK&4095)
U_1063:;
PRX(69, 1, 10, QQ, KK & 4095);
// 2623 P=P+1; %CYCLE KK=1,1,(A(P)+2)//2
P = P + 1;
// %for KK = 1, 1, ( (long)(A[P + 2] + 2) / (long)2 ) %cycle
{
int _final = ((long)(A[P + 2] + 2) / (long)2);
if (invalid_for_loop(1, 1, _final))
_imp_signal(5, 1, 0, "Illegal cycle KK = 1, 1, ( (long)(A[P + 2] + 2) / (long)2 )");
KK = 0;
L_0316:
if (KK == _final) goto L_0317;
KK += 1;
// 2624 PLANT(A(P)<<8!A(P+1))
PLANT(A[P + 2] << 8 | A[P + 1 + 2]);
// 2625 P=P+2;%REPEAT
P = P + 2;
goto L_0316;
}
L_0317:;
// 2626 L20: PRX(X'41',2,RBASE,0,WKAREA)
U_105F:;
PRX(65, 2, RBASE, 0, WKAREA);
// 2627 PPJ(26)
PPJ(26);
// 2628 L21: ->L90 %IF A(P)=2; ! END OF EXPRN
U_1062:;
if (A[P + 2] != 2) goto L_0319;
goto U_1064;
L_0319:;
// 2629 ->L5 %UNLESS A(P+1)=12
if (A[P + 1 + 2] == 12) goto L_031A;
goto U_105D;
L_031A:;
// 2630 P=P+1;->L2
P = P + 1;
goto U_1059;
// 2631 L71: DUMP(2,REG,K,I,0); ->L99
U_1058:;
DUMP(2, REG, K, I, 0);
goto U_105C;
// 2632 L90: P=P+1
U_1064:;
P = P + 1;
// 2633 PUSH(STR WSP(LEVEL),0,WKAREA)
PUSH(/*?*/ &STRWSP[LEVEL], 0, WKAREA);
// 2634 PRX(X'41',REG,0,RBASE,WKAREA)
PRX(65, REG, 0, RBASE, WKAREA);
// 2635 L99: PTYPE=5; UNPACK; %END
U_105C:;
PTYPE = 5;
UNPACK();
return;
} /* end of CSTREXP */
// 2636 %ROUTINE CRES(%INTEGER MODE,LAB)
void CRES(int MODE, int LAB) {
auto void SKIPNAME(void);
auto void FAIL(int MASK);
// 2637 %ROUTINESPEC SKIP NAME
// 2638 %ROUTINESPEC FAIL(%INTEGER MASK)
// 2639 !%SHORTROUTINE
// 2640 %INTEGER P1,P2,P3,W,SEXPRN
int P1;
int P2;
int P3;
int W;
int SEXPRN;
// 2641 %COMMENT MODE=0 UNCONDITIONAL # 0 CONDITIONAL
// 2642 %COMMENT ENTER WITH ADDR OF LHS IN R1 AND P ON PLUS''
// 2643 SEXPRN=0;W=GET DBLE WRD
SEXPRN = 0;
W = GETDBLEWRD();
// 2644 P1=P;->L1 %IF A(P)=4
P1 = P;
if (A[P + 2] != 4) goto L_031B;
goto U_105B;
L_031B:;
// 2645 L1000: P=P1;SKIP EXP
U_105C:;
P = P1;
SKIPEXP();
// 2646 FAULT(74);->L99
FAULT(74);
goto U_105D;
// 2647 L1: ->L1000 %UNLESS TYPE=5
U_105B:;
if (TYPE == 5) goto L_031C;
goto U_105C;
L_031C:;
// 2648 PRR(X'1B',2,2) ;!SR_2,2
PRR(27, 2, 2);
// 2649 PRX(X'90',1,2,RBASE,W) ;!STM_1,2,W(RBASE)
PRX(144, 1, 2, RBASE, W);
// 2650 P2=-1;P=P+2
P2 = -1;
P = P + 2;
// 2651 ->L10 %IF A(P-1)=3 ;!SUB EXPRESSION
if (A[P - 1 + 2] != 3) goto L_031D;
goto U_105E;
L_031D:;
// 2652 ->L1000 %UNLESS A(P-1)=1
if (A[P - 1 + 2] == 1) goto L_031E;
goto U_105C;
L_031E:;
// 2653 L3: P2=P;SKIP NAME
U_105F:;
P2 = P;
SKIPNAME();
// 2654 ->L50 %IF A(P)=2 ;!END
if (A[P + 2] != 2) goto L_031F;
goto U_1060;
L_031F:;
// 2655 ->L1000 %UNLESS A(P+1)=12 ;!ONLY - PERMITTED
if (A[P + 1 + 2] == 12) goto L_0320;
goto U_105C;
L_0320:;
// 2656 ->L1000 %UNLESS A(P+2)=3; P=P+3
if (A[P + 2 + 2] == 3) goto L_0321;
goto U_105C;
L_0321:;
P = P + 3;
// 2657 L10: CSTREXP(-4); ! STRING MUST GO TO WK.AREA
U_105E:;
CSTREXP(-4);
// 2658 ! IN CASE OF SIDE EFFECTS
// 2659 SEXPRN=SEXPRN+1
SEXPRN = SEXPRN + 1;
// 2660 PRX(X'98',1,2,RBASE,W)
PRX(152, 1, 2, RBASE, W);
// 2661 PPJ(27)
PPJ(27);
// 2662 FAIL(7)
FAIL(7);
// 2663 PRX(X'90',1,2,RBASE,W); ! SAVE R1 AND R2 FOR LATER
PRX(144, 1, 2, RBASE, W);
// 2664 ->L15 %IF P2<0
if (P2 >= 0) goto L_0322;
goto U_1061;
L_0322:;
// 2665 P3=P;P=P2
P3 = P;
P = P2;
// 2666 CNAME(1,4)
CNAME(1, 4);
// 2667 FAULT(71) %UNLESS TYPE=5
if (TYPE == 5) goto L_0323;
FAULT(71);
L_0323:;
// 2668 P=P3
P = P3;
// 2669 L12: ->L1000 %UNLESS A(P)=1 %AND A(P+1)=12 %AND A(P+2)=1
U_1062:;
if (A[P + 2] != 1) goto L_0318;
if (A[P + 1 + 2] != 12) goto L_0318;
if (A[P + 2 + 2] == 1) goto L_0324;
L_0318:;
goto U_105C;
L_0324:;
// 2670 P=P+3;->L3
P = P + 3;
goto U_105F;
// 2671 L15: PSI(X'95',0,4,0)
U_1061:;
PSI(149, 0, 4, 0);
// 2672 FAIL(7);->L12
FAIL(7);
goto U_1062;
// 2673 L50: ->L1000 %IF SEXPRN=0
U_1060:;
if (SEXPRN != 0) goto L_0325;
goto U_105C;
L_0325:;
// 2674 PRX(X'98',1,2,RBASE,W); ! SAVE R1 AND R2 FOR LATER
PRX(152, 1, 2, RBASE, W);
// 2675 PPJ(37)
PPJ(37);
// 2676 P3=P;P=P2
P3 = P;
P = P2;
// 2677 CNAME(1,4)
CNAME(1, 4);
// 2678 FAULT(71) %UNLESS TYPE=5
if (TYPE == 5) goto L_0326;
FAULT(71);
L_0326:;
// 2679 P=P3+1
P = P3 + 1;
// 2680 L99: PUSH(LWSP(LEVEL),0,W)
U_105D:;
PUSH(/*?*/ &LWSP[LEVEL], 0, W);
// 2681 %RETURN
return;
// 2682 %ROUTINE SKIP NAME
void SKIPNAME(void) {
// 2683 L1: P=P+1;SKIP APP
U_1063:;
P = P + 1;
SKIPAPP();
// 2684 P=P+1;%RETURN %IF A(P-1)=2
P = P + 1;
if (A[P - 1 + 2] != 2) goto L_0327;
return;
L_0327:;
// 2685 P=P+1;->L1
P = P + 1;
goto U_1063;
// 2686 %END
} /* end of SKIPNAME */
// 2687 %ROUTINE FAIL(%INTEGER MASK)
void FAIL(int MASK) {
// 2688 %IF MODE=0 %THEN PRX(X'47',MASK,0,CODER,152) %ELSE %C
if (MODE != 0) goto L_0328;
PRX(71, MASK, 0, CODER, 152);
goto L_0329;
L_0328:;
PLOCALJUMP(MASK, LAB);
L_0329:;
// 2689+ P LOCAL JUMP(MASK,LAB)
// 2690 %END
return;
} /* end of FAIL */
// 2691 %END
return;
} /* end of CRES */
// 2692 %ROUTINE CCOND(%INTEGER IU,NEARLAB,FARLAB)
void CCOND(int IU, int NEARLAB, int FARLAB) {
auto void CCC(void);
auto void CSC(int *FLAB);
// 2693 %COMMENT IU=0 FOR IF =1 FOR UNLESS
// 2694 %ROUTINESPEC CCC
// 2695 %ROUTINESPEC CSC(%INTEGERNAME FLAB)
// 2696 %COMMENT P ON ALT OF (SC)
// 2697 %INTEGER T,C,FAILPT,BASE,DISP
int T;
int C;
int FAILPT;
int BASE;
int DISP;
// 2698 %INTEGER JNPORFP,TP,CLAUSES
int JNPORFP;
int TP;
int CLAUSES;
// 2699 CLAUSES=0
CLAUSES = 0;
// 2700 T=A(P+1+A(P+1))
T = A[P + 1 + A[P + 1 + 2] + 2];
// 2701 T=0 %IF T=3; !0=SC 1=%AND 2=%OR
if (T != 3) goto L_032A;
T = 0;
L_032A:;
// 2702 TP=T ; TP=TP+1 %IF T=0
TP = T;
if (T != 0) goto L_032B;
TP = TP + 1;
L_032B:;
// 2703 %IF IU!!(TP-1)=0 %THEN JNPORFP=FARLAB %ELSE JNPORFP=NEARLAB
if (IU ^ TP - 1 != 0) goto L_032C;
JNPORFP = FARLAB;
goto L_032D;
L_032C:;
JNPORFP = NEARLAB;
L_032D:;
// 2704 FAILPT = 0; CCC ; ->L99
FAILPT = 0;
CCC();
goto U_105F;
// 2705 %ROUTINE CCOMP(%INTEGER C)
void CCOMP(int C) {
// 2706 !%SHORTROUTINE
// 2707 ! C=1 FIRST TIME, 2 SECOND
// 2708 %INTEGER M,L,Q,R,T
int M;
int L;
int Q;
int R;
int T;
// 2709 %OWNBYTEINTEGERARRAY FCOMP(1:7)=8,10,2,7,12,4,7;
static unsigned char FCOMP[7] = {8, 10, 2, 7, 12, 4, 7};
// 2710 %OWNBYTEINTEGERARRAY BCOMP(1:7)=8,12,4,7,10,2,7;
static unsigned char BCOMP[7] = {8, 12, 4, 7, 10, 2, 7};
// 2711 %SWITCH SW(-10:2)
int SW_index;
int SW_line;
char *SW_file;
static const void *SW[13] = {&&case_SW_M10, &&case_SW_M9, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_M5, &&case_SW_M4, &&case_SW_M3,
&&case_SW_M2, &&case_SW_M1, &&case_SW_0, &&case_SW_1,
&&case_SW_2};
// 2712 M=A(P)
M = A[P + 2];
// 2713 P=P+1; ->SW(C) %UNLESS M=8
P = P + 1;
if (M == 8) goto L_032E;
SW_line = __LINE__;
SW_file = __FILE__;
SW_index = C;
goto case_SW_dispatch;
L_032E:;
// 2714 FAULT(73); SKIP EXP; ->L1
FAULT(73);
SKIPEXP();
goto U_106D;
// 2715 SW(-10): ! FIRST OPERAND SIMPLE STRING
case_SW_M10:;
// 2716 CSTREXP(1); NEST=1; DUMP(2,2,DISP,0,BASE); ->L161
CSTREXP(1);
NEST = 1;
DUMP(2, 2, DISP, 0, BASE);
goto U_106E;
// 2717 SW(-9): T=P; R=TSEXP(Q)
case_SW_M9:;
T = P;
R = TSEXP(/*?*/ &Q);
// 2718 ->REG1 %IF R=10 %AND A(P)=2
if (R != 10) goto L_0330;
if (A[P + 2] != 2) goto L_0330;
goto U_106F;
L_0330:;
// 2719 ->REG2 %IF R=11 %AND A(P)=2
if (R != 11) goto L_0331;
if (A[P + 2] != 2) goto L_0331;
goto U_1070;
L_0331:;
// 2720 P=T; CSEXP(0,0)
P = T;
CSEXP(0, 0);
// 2721 ->REG3 %IF TYPE=2
if (TYPE != 2) goto L_0332;
goto U_1071;
L_0332:;
// 2722 PRR(X'19',DISP,NEST); ->L20; !CR
PRR(25, DISP, NEST);
goto U_1072;
// 2723 REG1: Q=X'59'; ->RCOM
U_106F:;
Q = 89;
goto U_1073;
// 2724 REG2: Q=X'49'
U_1070:;
Q = 73;
// 2725 RCOM: PRX(Q,DISP,0,I,K); ->L20; !C OR CH
U_1073:;
PRX(Q, DISP, 0, I, K);
goto U_1072;
// 2726 REG3: PRR(X'18',1,DISP); ->L37 ; !TO FLOAT ETC
U_1071:;
PRR(24, 1, DISP);
goto U_1074;
// 2727 SW(-5): !FIRST OPERAND LONG REAL
case_SW_M5:;
// 2728 CSEXP(0,3); Q=X'69'; ! COMPILE LONG
CSEXP(0, 3);
Q = 105;
// 2729 L51: PRX(Q,NEST,0,BASE,DISP); ->L21
U_1075:;
PRX(Q, NEST, 0, BASE, DISP);
goto U_1076;
// 2730 SW(-4): !FIRST OPERAND SHORT REAL
case_SW_M4:;
// 2731 Q=X'79'; CSEXP(0,2)
Q = 121;
CSEXP(0, 2);
// 2732 L40: ->L51 %IF PREC=0; !SHORT EXPRESSION
U_1077:;
if (PREC != 0) goto L_0333;
goto U_1075;
L_0333:;
// 2733 PRR(X'2B',0,0)
PRR(43, 0, 0);
// 2734 PRX(X'78',0,0,BASE,DISP); !STETCH IST OPN
PRX(120, 0, 0, BASE, DISP);
// 2735 PRR(X'29',0,NEST); ->L20
PRR(41, 0, NEST);
goto U_1072;
// 2736 SW(-3): !FIRST OPERAND ASHORT CONSTANY
case_SW_M3:;
// 2737 CSEXP(0,0)
CSEXP(0, 0);
// 2738 ->L30 %IF VALUE=0
if (VALUE != 0) goto L_0334;
goto U_107A;
L_0334:;
// 2739 ->L36 %IF TYPE=2
if (TYPE != 2) goto L_0335;
goto U_107B;
L_0335:;
// 2740 R=2
R = 2;
// 2741 R=1 %IF NEST=2
if (NEST != 2) goto L_0336;
R = 1;
L_0336:;
// 2742 DUMP(0,R,VALUE,0,0); !LOAD ADDR FOR CONSTANT
DUMP(0, R, VALUE, 0, 0);
// 2743 L29: PRR(X'19',R,NEST); ->L20; !CR2,1
U_107C:;
PRR(25, R, NEST);
goto U_1072;
// 2744 L30: !COMPARISONS WITH ZERO
U_107A:;
// 2745 ->L35 %IF TYPE=5
if (TYPE != 5) goto L_0337;
goto U_107D;
L_0337:;
// 2746 ->L32 %IF AFLAG=1
if (AFLAG != 1) goto L_0338;
goto U_107E;
L_0338:;
// 2747 ->L31 %IF TYPE=2
if (TYPE != 2) goto L_0339;
goto U_107F;
L_0339:;
// 2748 ->L32 %IF AFLAG=2 %AND 7<=FCOMP(M)<=8
if (AFLAG != 2) goto L_033A;
{
// Double-sided test on FCOMP[M - 1] (Part I)
unsigned char tmp;
if (7 > (tmp = FCOMP[M - 1])) goto L_033A;
// Double-sided test on FCOMP[M - 1] (Part II)
if (tmp > 8) goto L_033A;
}
goto U_107E;
L_033A:;
// 2749 L31: PRR((TYPE-1)*(2-PREC&1)*16+X'12',NEST,NEST); !LTR,LTER,LTDR
U_107F:;
PRR((TYPE - 1) * (2 - (PREC & 1)) * 16 + 18, NEST, NEST);
// 2750 L32: ->L21 %IF C=-3; ->L20
U_107E:;
if (C != -3) goto L_033B;
goto U_1076;
L_033B:;
goto U_1072;
// 2751 L35: PSI(X'95',0,NEST,0); ->L20; ! NULL STRING LENGTH=0
U_107D:;
PSI(149, 0, NEST, 0);
goto U_1072;
// 2752 L36: DUMP(0,1,VALUE,0,0);
U_107B:;
DUMP(0, 1, VALUE, 0, 0);
// 2753 L37: PPJ(43);
U_1074:;
PPJ(43);
// 2754 PRR((1-PREC&1)*16+X'29',0,NEST); ! CDR OR CER
PRR((1 - (PREC & 1)) * 16 + 41, 0, NEST);
// 2755 ->L20
goto U_1072;
// 2756 SW(-2): Q=X'49'; !OPERAND SHORT
case_SW_M2:;
Q = 73;
// 2757 L24: CSEXP(0,0); ->L25 %IF TYPE=2
U_1080:;
CSEXP(0, 0);
if (TYPE != 2) goto L_033C;
goto U_1081;
L_033C:;
// 2758 PRX(Q,NEST,0,BASE,DISP); ->L21; ! C OR CH
PRX(Q, NEST, 0, BASE, DISP);
goto U_1076;
// 2759 L25: R=2; R=6 %IF Q=X'49'; ! HERE FOR REALS
U_1081:;
R = 2;
if (Q != 73) goto L_033D;
R = 6;
L_033D:;
// 2760 L26: DUMP(R,1,DISP,0,BASE); ->L37
U_1082:;
DUMP(R, 1, DISP, 0, BASE);
goto U_1074;
// 2761 SW(-1): ! FIRST OPERAND A BYTE
case_SW_M1:;
// 2762 T=P; R=TSEXP(Q); L=1
T = P;
R = TSEXP(/*?*/ &Q);
L = 1;
// 2763 ->L18 %IF R=11 %AND A(P)=2
if (R != 11) goto L_033E;
if (A[P + 2] != 2) goto L_033E;
goto U_1083;
L_033E:;
// 2764 ->L19 %IF R=1 %AND A(P)=2
if (R != 1) goto L_033F;
if (A[P + 2] != 2) goto L_033F;
goto U_1084;
L_033F:;
// 2765 P=T;CSEXP(0,0); ->L14 %IF TYPE=2
P = T;
CSEXP(0, 0);
if (TYPE != 2) goto L_0340;
goto U_1085;
L_0340:;
// 2766 R=2; R=1 %IF NEST=2
R = 2;
if (NEST != 2) goto L_0341;
R = 1;
L_0341:;
// 2767 DUMP(4,R,DISP,0,BASE); ->L29
DUMP(4, R, DISP, 0, BASE);
goto U_107C;
// 2768 L14: R=4; ->L26
U_1085:;
R = 4;
goto U_1082;
// 2769 L18: PSS(X'D5',L,BASE,DISP,I,K); ->L20; ! CLC COMPARISONS
U_1083:;
PSS(213, L, BASE, DISP, I, K);
goto U_1072;
// 2770 L19: PSI(X'95',Q,BASE,DISP);->L20; !CLI FOR BYTE/INTEGER
U_1084:;
PSI(149, Q, BASE, DISP);
goto U_1072;
// 2771 SW(0): !FIRST OPERAND INTEGER
case_SW_0:;
// 2772 T=P; R=TSEXP(Q); L=4
T = P;
R = TSEXP(/*?*/ &Q);
L = 4;
// 2773 ->RSTORE %UNLESS R=10 %AND A(P)=2
if (R != 10) goto L_0342;
if (A[P + 2] == 2) goto L_0343;
L_0342:;
goto U_1086;
L_0343:;
// 2774 ->L18 %IF 7<=FCOMP(M)<=8
{
// Double-sided test on FCOMP[M - 1] (Part I)
unsigned char tmp;
if (7 > (tmp = FCOMP[M - 1])) goto L_0344;
// Double-sided test on FCOMP[M - 1] (Part II)
if (tmp > 8) goto L_0344;
}
goto U_1083;
L_0344:;
// 2775 RSTORE: P=T; Q=X'59'; ->L24
U_1086:;
P = T;
Q = 89;
goto U_1080;
// 2776 SW(1): !FIRST OPERAND EXPRESSION
case_SW_1:;
// 2777 SW(2): !2ND HALT OF DOUBLE SEDED
case_SW_2:;
// 2778 T=P; PTYPEP=PTYPE; R=TSEXP(VALUE)
T = P;
PTYPEP = PTYPE;
R = TSEXP(/*?*/ &VALUE);
// 2779 PTYPE=PTYPEP;UNPACK
PTYPE = PTYPEP;
UNPACK();
// 2780 ->L30 %IF R=1 %AND VALUE=0 %AND(A(P)=2 %OR C=2)
if (R != 1) goto L_0345;
if (VALUE != 0) goto L_0345;
if (A[P + 2] == 2) goto L_0346;
if (C != 2) goto L_0345;
L_0346:;
goto U_107A;
L_0345:;
// 2781 ->L160 %IF TYPE=5
if (TYPE != 5) goto L_0347;
goto U_1087;
L_0347:;
// 2782 ->L150 %IF TYPE=2
if (TYPE != 2) goto L_0348;
goto U_1088;
L_0348:;
// 2783 ->L120 %IF R=0 %OR 14<=R<=15 %OR(A(P)=1 %AND C=1)
if (R == 0) goto L_0349;
{
// Double-sided test on R (Part I)
int tmp;
if (14 > (tmp = R)) goto L_034A;
// Double-sided test on R (Part II)
if (tmp <= 15) goto L_0349;
}
L_034A:;
if (A[P + 2] != 1) goto L_034B;
if (C != 1) goto L_034B;
L_0349:;
goto U_1089;
L_034B:;
// 2784 ->L130 %IF UNASS=1 %OR R=100 %OR R=11 %OR R<=2
if (UNASS == 1) goto L_034C;
if (R == 100) goto L_034C;
if (R == 11) goto L_034C;
if (R > 2) goto L_034D;
L_034C:;
goto U_108A;
L_034D:;
// 2785 ->L131 %IF R=50; ! REGISTER VARIABLE
if (R != 50) goto L_034E;
goto U_108B;
L_034E:;
// 2786 Q=X'59'; Q=X'49' %IF R=12
Q = 89;
if (R != 12) goto L_034F;
Q = 73;
L_034F:;
// 2787 PRX(Q,NEST,0,I,K); ->L20
PRX(Q, NEST, 0, I, K);
goto U_1072;
// 2788 L130: !1ST OPND INTEGER IN NEST-2ND OPN SIMPLE INTEGER EXPRN
U_108A:;
// 2789 R=NEST; REGISTER(R)=1 %IF REGISTER(R)=0
R = NEST;
if (REGISTER[R] != 0) goto L_0350;
REGISTER[R] = 1;
L_0350:;
// 2790 P=T; CSEXP(0,1)
P = T;
CSEXP(0, 1);
// 2791 REGISTER(R)=0 %IF REGISTER(R)>0; ->L29
if (REGISTER[R] <= 0) goto L_0351;
REGISTER[R] = 0;
L_0351:;
goto U_107C;
// 2792 L131: PRR(X'19',NEST,K); ->L20
U_108B:;
PRR(25, NEST, K);
goto U_1072;
// 2793 L120: !1ST OPND INTEGER EXPRN IN NEST-SECOND OPND UNKNOWN
U_1089:;
// 2794 Q=PARK(NEST); P=T
Q = PARK(NEST);
P = T;
// 2795 CSEXP(0,0); ->L122 %IF TYPE=2
CSEXP(0, 0);
if (TYPE != 2) goto L_0352;
goto U_108C;
L_0352:;
// 2796 UNPARK(X'59',NEST,Q); ->L21
UNPARK(89, NEST, Q);
goto U_1076;
// 2797 L122: UNPARK(X'58',1,Q); ->L37; ! TO FLOAT FIRST OPERAND
U_108C:;
UNPARK(88, 1, Q);
goto U_1074;
// 2798 L150: P=T; Q=PARKF(NEST,PREC); !
U_1088:;
P = T;
Q = PARKF(NEST, PREC);
// 2799 ->L155 %IF PREC=0
if (PREC != 0) goto L_0353;
goto U_108D;
L_0353:;
// 2800 CSEXP(0,3); !1ST OPND LONG REAL EXPR
CSEXP(0, 3);
// 2801 PUSH(LWSP(LEVEL),0,Q)
PUSH(/*?*/ &LWSP[LEVEL], 0, Q);
// 2802 BASE=RBASE
BASE = RBASE;
// 2803 DISP=Q; Q=X'69'; ->L51
DISP = Q;
Q = 105;
goto U_1075;
// 2804 L155: CSEXP(0,2); !1ST OPND SHORT REAL EXPRN
U_108D:;
CSEXP(0, 2);
// 2805 PUSH(WSP(LEVEL),0,Q)
PUSH(/*?*/ &WSP[LEVEL], 0, Q);
// 2806 BASE=RBASE;DISP=Q
BASE = RBASE;
DISP = Q;
// 2807 Q=X'79'; ->L40
Q = 121;
goto U_1077;
// 2808 L160: %COMMENT 1ST OPERAND A STRING EXPRESSION PTR IN NEST
U_1087:;
// 2809 P=T; POP(STR WSP(LEVEL),R,T);! RMEOVE WKAREA WITH STRING%C
P = T;
POP(/*?*/ &STRWSP[LEVEL], /*?*/ &R, /*?*/ &T);
// 2810 !FROM FREE LIST TO PREVENT CORRUPTION
// 2811 R=PARK(NEST)
R = PARK(NEST);
// 2812 CSTREXP(1); NEST=1
CSTREXP(1);
NEST = 1;
// 2813 UNPARK(X'58',2,R)
UNPARK(88, 2, R);
// 2814 PUSH(STR WSP(LEVEL),0,T)
PUSH(/*?*/ &STRWSP[LEVEL], 0, T);
// 2815 L161: ->L162 %UNLESS 7<=FCOMP(M)<=8; ! OPTIMISE = & \=
U_106E:;
{
// Double-sided test on FCOMP[M - 1] (Part I)
unsigned char tmp;
if (7 > (tmp = FCOMP[M - 1])) goto L_0354;
// Double-sided test on FCOMP[M - 1] (Part II)
if (tmp <= 8) goto L_0355;
}
L_0354:;
goto U_108E;
L_0355:;
// 2816 PRX(X'43',3,0,1,0); ! IC TO SET UP FOR EX
PRX(67, 3, 0, 1, 0);
// 2817 PRX(X'44',3,0,GLA,STRINST+6); ->L20; ! EX_3,COMPARISON
PRX(68, 3, 0, GLA, STRINST + 6);
goto U_1072;
// 2818 L162: PPJ(35); ! GO TO SUBROUTINE FOR COMPARISON
U_108E:;
PPJ(35);
// 2819 L20: MASK=FCOMP(M); ->L1; ! MASK FOR NORMAL COMPARISON
U_1072:;
MASK = FCOMP[M - 1];
goto U_106D;
// 2820 L21: MASK=BCOMP(M); ! BACKWARDS COMPARISON
U_1076:;
MASK = BCOMP[M - 1];
// 2821 L1: %END
U_106D:;
return;
case_SW_dispatch:
if (SW_index < -10 || SW_index > 2)
_imp_signalf(6, 3, SW_index, "->SW(%d) out of bounds at %s line %d", SW_index, SW_file, SW_line);
goto *SW[SW_index - -10];
case_SW_missing:
_imp_signalf(8, 2, SW_index, "switch jump to undefined label SW(%d): at %s line %d", SW_index, SW_file,
SW_line);
} /* end of CCOMP */
// 2822 %ROUTINE CCC
void CCC(void) {
// 2823 !%SHORTROUTINE
// 2824 %INTEGER LINE,FLAB
int LINE;
int FLAB;
// 2825 CSC(FLAB)
CSC(/*?*/ &FLAB);
// 2826 C=A(P) ; P=P+1
C = A[P + 2];
P = P + 1;
// 2827 CLAUSES=CLAUSES+1
CLAUSES = CLAUSES + 1;
// 2828 ->L10 %IF T=0 %OR(CLAUSES>1 %AND C=2)
if (T == 0) goto L_0356;
if (CLAUSES <= 1) goto L_0357;
if (C != 2) goto L_0357;
L_0356:;
goto U_1063;
L_0357:;
// 2829 ->L2 %IF FAILPT#0
if (FAILPT == 0) goto L_0358;
goto U_1064;
L_0358:;
// 2830 FAILPT=1 ; LINE=1 ; ->L3
FAILPT = 1;
LINE = 1;
goto U_1065;
// 2831 L2: LINE=0
U_1064:;
LINE = 0;
// 2832 L3:
U_1065:;
// 2833 PLOCAL JUMP(MASK,JNPORFP)
PLOCALJUMP(MASK, JNPORFP);
// 2834 %UNLESS FLAB=0 %THEN %START
if (FLAB == 0) goto L_0359;
// 2835 PUSH(LOCAL LABEL,CA,FLAB)
PUSH(/*?*/ &LOCALLABEL, CA, FLAB);
// 2836 R13=0 %UNLESS R13=SAVE13 %AND CHNGE13=0
if (R13 != SAVE13) goto L_02FE;
if (CHNGE13 == 0) goto L_035A;
L_02FE:;
R13 = 0;
L_035A:;
// 2837 %FINISH
L_0359:;
// 2838 CCC; !FIX NEXT CLAUSE
CCC();
// 2839 ->L10 %IF LINE=0
if (LINE != 0) goto L_035B;
goto U_1063;
L_035B:;
// 2840 MASK=MASK!!15 %IF JNPORFP=NEARLAB
if (JNPORFP != NEARLAB) goto L_035C;
MASK = MASK ^ 15;
L_035C:;
// 2841 L10: %END
U_1063:;
return;
} /* end of CCC */
// 2842 %ROUTINE CSC(%INTEGERNAME FLAB)
void CSC(int *FLAB) {
// 2843 !%SHORTROUTINE
// 2844 %INTEGER LINE,Q,R,S,TP,NEAR
int LINE;
int Q;
int R;
int S;
int TP;
int NEAR;
// 2845 FLAB=0
*FLAB = 0;
// 2846 S=A(P+1+A(P+1))
S = A[P + 1 + A[P + 1 + 2] + 2];
// 2847 LINE=S
LINE = S;
// 2848 NEAR=NEARLAB
NEAR = NEARLAB;
// 2849 ->START %IF T=0 %OR(S=2 %AND CLAUSES>0)
if (T == 0) goto L_035D;
if (S != 2) goto L_035E;
if (CLAUSES <= 0) goto L_035E;
L_035D:;
goto U_1068;
L_035E:;
// 2850 PLABEL=PLABEL-1; NEAR=PLABEL
PLABEL = PLABEL - 1;
NEAR = PLABEL;
// 2851 START: ->L1 %IF A(P)=1
U_1068:;
if (A[P + 2] != 1) goto L_035F;
goto U_1069;
L_035F:;
// 2852 P=P+2
P = P + 2;
// 2853 ->REDUND %IF T=0
if (T != 0) goto L_0360;
goto U_106D;
L_0360:;
// 2854 ->REDUND2 %IF T=A(P+1+A(P+1))
if (T != A[P + 1 + A[P + 1 + 2] + 2]) goto L_0361;
goto U_106E;
L_0361:;
// 2855 FLAB=NEAR %UNLESS NEAR=NEARLAB
if (NEAR == NEARLAB) goto L_0362;
*FLAB = NEAR;
L_0362:;
// 2856 TP=T-1; ->LAST %IF NEAR=NEARLAB
TP = T - 1;
if (NEAR != NEARLAB) goto L_0363;
goto U_106F;
L_0363:;
// 2857 CCOND(TP,NEAR,FARLAB); ->L9
CCOND(TP, NEAR, FARLAB);
goto U_1070;
// 2858 REDUND:CCOND(IU,NEARLAB,FARLAB); ->L9
U_106D:;
CCOND(IU, NEARLAB, FARLAB);
goto U_1070;
// 2859 REDUND2: CCOND(IU,NEARLAB,FARLAB)
U_106E:;
CCOND(IU, NEARLAB, FARLAB);
// 2860 MASK=MASK!!15 %IF JNPORFP=NEARLAB ;->L9
if (JNPORFP != NEARLAB) goto L_0364;
MASK = MASK ^ 15;
L_0364:;
goto U_1070;
// 2861 LAST: CCOND(IU,NEAR,FARLAB)
U_106F:;
CCOND(IU, NEAR, FARLAB);
// 2862 NEARLAB=0; ->L9
NEARLAB = 0;
goto U_1070;
// 2863 L1: %COMMENT CLASSIFY SIMPLE CONDITION AND ACT ACCORDINGLY
U_1069:;
// 2864 P=P+2; S=P; SKIP EXP
P = P + 2;
S = P;
SKIPEXP();
// 2865 ->L21 %IF A(P)=8; ! RESOLUTION (ALL OCCURRENCES)
if (A[P + 2] != 8) goto L_0365;
goto U_1071;
L_0365:;
// 2866 P=P+1; Q=TSEXP(R); ! TEST MIDDLE OPERAND FIRST
P = P + 1;
Q = TSEXP(/*?*/ &R);
// 2867 %IF TYPE=3 %THEN %START
if (TYPE != 3) goto L_0366;
// 2868 P=P+2; R=COPY RECORD TAG; %FINISH
P = P + 2;
R = COPYRECORDTAG();
L_0366:;
// 2869 ->STR %IF TYPE=5
if (TYPE != 5) goto L_0367;
goto U_1072;
L_0367:;
// 2870 ->ZERO %IF Q=1 %AND R=0 %AND A(P)=2;! ! NOT DOUBLE SIDED
if (Q != 1) goto L_0368;
if (R != 0) goto L_0368;
if (A[P + 2] != 2) goto L_0368;
goto U_1073;
L_0368:;
// 2871 P=S; Q=TSEXP(R); ! TEST LHS
P = S;
Q = TSEXP(/*?*/ &R);
// 2872 ->CONST %IF 1<=Q<=2
{
// Double-sided test on Q (Part I)
int tmp;
if (1 > (tmp = Q)) goto L_0369;
// Double-sided test on Q (Part II)
if (tmp > 2) goto L_0369;
}
goto U_1074;
L_0369:;
// 2873 ->SIMPLE %IF Q=20
if (Q != 20) goto L_036A;
goto U_1075;
L_036A:;
// 2874 ->REGVAR %IF Q=50
if (Q != 50) goto L_036B;
goto U_1076;
L_036B:;
// 2875 ->STR %IF TYPE=5
if (TYPE != 5) goto L_036C;
goto U_1072;
L_036C:;
// 2876 ->NORMAL %UNLESS UNASS=0 %AND 10<=Q<=15
if (UNASS != 0) goto L_036D;
{
// Double-sided test on Q (Part I)
int tmp;
if (10 > (tmp = Q)) goto L_036D;
// Double-sided test on Q (Part II)
if (tmp <= 15) goto L_036E;
}
L_036D:;
goto U_1077;
L_036E:;
// 2877 SIMPLE: BASE=I; DISP=K; CCOMP(10-Q); ->L8
U_1075:;
BASE = I;
DISP = K;
CCOMP(10 - Q);
goto U_107A;
// 2878 REGVAR: DISP=K; CCOMP(-9); ->L8
U_1076:;
DISP = K;
CCOMP(-9);
goto U_107A;
// 2879 STR: P=S; CSTREXP(1); NEST=1; CCOMP(1); ->L8
U_1072:;
P = S;
CSTREXP(1);
NEST = 1;
CCOMP(1);
goto U_107A;
// 2880 CONST: VALUE=R; CCOMP(-3); ->L8
U_1074:;
VALUE = R;
CCOMP(-3);
goto U_107A;
// 2881 L21: P=S+2; ->L22 %UNLESS A(S)=4 %AND A(S+1)=1
U_1071:;
P = S + 2;
if (A[S + 2] != 4) goto L_036F;
if (A[S + 1 + 2] == 1) goto L_0370;
L_036F:;
goto U_107B;
L_0370:;
// 2882 CNAME(2,1)
CNAME(2, 1);
// 2883 ->L23 %IF A(P)=2 %AND TYPE=5
if (A[P + 2] != 2) goto L_0371;
if (TYPE != 5) goto L_0371;
goto U_107C;
L_0371:;
// 2884 L22: P=S; SKIP EXP
U_107B:;
P = S;
SKIPEXP();
// 2885 L28: P=P+1; SKIP EXP
U_107D:;
P = P + 1;
SKIPEXP();
// 2886 FAULT(73); ->L8
FAULT(73);
goto U_107A;
// 2887 L23: P=P+2
U_107C:;
P = P + 2;
// 2888 FLAB=NEAR %UNLESS NEAR=NEARLAB
if (NEAR == NEARLAB) goto L_0372;
*FLAB = NEAR;
L_0372:;
// 2889 %IF T#2 %THEN R=JNPORFP %ELSE %START
if (T == 2) goto L_0373;
R = JNPORFP;
goto L_0374;
L_0373:;
// 2890 %IF JNPORFP#FARLAB %AND LINE=2 %AND CLAUSES>0 %C
if (JNPORFP == FARLAB) goto L_0375;
if (LINE != 2) goto L_0375;
if (CLAUSES <= 0) goto L_0375;
R = FARLAB;
goto L_0376;
L_0375:;
R = NEAR;
L_0376:;
// 2891+ %THEN R=FARLAB %ELSE R=NEAR
// 2892 %FINISH
L_0374:;
// 2893 CRES(1,R)
CRES(1, R);
// 2894 ->L28 %UNLESS A(P)=2 ;! NO DOUBLE SIDED RESOLUTION
if (A[P + 2] == 2) goto L_0377;
goto U_107D;
L_0377:;
// 2895 P=P+1;
P = P + 1;
// 2896 MASK=15; ->L10
MASK = 15;
goto U_107E;
// 2897 ZERO: P=S; Q=TSEXP(R); ->SIMPLE %IF Q=11; ! CLI FOR BYTE/ZERO
U_1073:;
P = S;
Q = TSEXP(/*?*/ &R);
if (Q != 11) goto L_0378;
goto U_1075;
L_0378:;
// 2898 ->STR %IF TYPE=5
if (TYPE != 5) goto L_0379;
goto U_1072;
L_0379:;
// 2899 NORMAL: P=S; CSEXP(0,0); CCOMP(1)
U_1077:;
P = S;
CSEXP(0, 0);
CCOMP(1);
// 2900 L8: P=P+1
U_107A:;
P = P + 1;
// 2901 ->L10 %IF A(P-1)=2; ! GO UNLESS DOUBLESIDED
if (A[P - 1 + 2] != 2) goto L_037A;
goto U_107E;
L_037A:;
// 2902 FLAB=NEAR %UNLESS NEAR=NEARLAB
if (NEAR == NEARLAB) goto L_037B;
*FLAB = NEAR;
L_037B:;
// 2903 ->ORCOND %IF T=2
if (T != 2) goto L_037C;
goto U_107F;
L_037C:;
// 2904 R=JNPORFP; ->L7
R = JNPORFP;
goto U_1080;
// 2905 ORCOND: %IF JNPORFP#FARLAB %AND LINE=2 %AND CLAUSES>0 %THEN %C
U_107F:;
if (JNPORFP == FARLAB) goto L_037D;
if (LINE != 2) goto L_037D;
if (CLAUSES <= 0) goto L_037D;
R = FARLAB;
goto L_037E;
L_037D:;
R = NEAR;
L_037E:;
// 2906+ R=FARLAB %ELSE R=NEAR
// 2907 %COMMENT LAST DOUBLESIDED IN OR CONDITION IS SPECIAL
// 2908 L7:
U_1080:;
// 2909 PLOCAL JUMP(MASK!!15,R)
PLOCALJUMP(MASK ^ 15, R);
// 2910 CCOMP(2)
CCOMP(2);
// 2911 L10: MASK=MASK!!15 %IF T=1 %OR(T=0 %AND IU=0)
U_107E:;
if (T == 1) goto L_037F;
if (T != 0) goto L_0380;
if (IU != 0) goto L_0380;
L_037F:;
MASK = MASK ^ 15;
L_0380:;
// 2912 L9: %END
U_1070:;
return;
} /* end of CSC */
// 2913 L99: %END ;!OF CCOND
U_105F:;
return;
} /* end of CCOND */
// 2914 %ROUTINE FILL LOCAL JUMPS
void FILLLOCALJUMPS(void) {
// 2915 !%SHORTROUTINE
// 2916 %INTEGER T,C,J
int T;
int C;
int J;
// 2917 L1: POP(LOCAL JUMP,T,C)
U_106C:;
POP(/*?*/ &LOCALJUMP, /*?*/ &T, /*?*/ &C);
// 2918 ->L98 %IF T=-1
if (T != -1) goto L_0381;
goto U_1079;
L_0381:;
// 2919 J=FIND(C,LOCAL LABEL)
J = FIND(C, LOCALLABEL);
// 2920 FAULT(233) %IF J=-1
if (J != -1) goto L_0382;
FAULT(233);
L_0382:;
// 2921 J=J-LOCAL ADDR
J = J - LOCALADDR;
// 2922 PLUG(T+2,J); ->L1
PLUG(T + 2, J);
goto U_106C;
// 2923 L98: CLEAR LIST(LOCAL LABEL)
U_1079:;
CLEARLIST(/*?*/ &LOCALLABEL);
// 2924 %END
return;
} /* end of FILLLOCALJUMPS */
// 2925 %ROUTINE P LOCAL JUMP(%INTEGER MASK,LABEL)
void PLOCALJUMP(int MASK, int LABEL) {
// 2926 !%SHORTROUTINE
// 2927 %RETURN %IF MASK=0
if (MASK != 0) goto L_0383;
return;
L_0383:;
// 2928 CHNGE13=1 %UNLESS SAVE13=R13
if (SAVE13 == R13) goto L_0384;
CHNGE13 = 1;
L_0384:;
// 2929 ->L1 %IF LABEL>21000
if (LABEL <= 21000) goto L_0385;
goto U_106B;
L_0385:;
// 2930 PJ(MASK,LABEL); ->L99
PJ(MASK, LABEL);
goto U_106C;
// 2931 L1: ->L2 %UNLESS LOCAL BASE=0
U_106B:;
if (LOCALBASE == 0) goto L_0386;
goto U_1079;
L_0386:;
// 2932 LOCAL BASE=10; LOCAL ADDR=CODEBASE(LEVEL)
LOCALBASE = 10;
LOCALADDR = CODEBASE[LEVEL];
// 2933 ->L2 %IF SBFLAG=1 %OR 3000+800*COMPILER>CA-CODEBASE(LEVEL)
if (SBFLAG == 1) goto L_0387;
if (3000 + 800 * COMPILER <= CA - CODEBASE[LEVEL]) goto L_0388;
L_0387:;
goto U_1079;
L_0388:;
// 2934 LOCAL BASE=FIND PP
LOCALBASE = FINDPP();
// 2935 FAULT(231) %IF LOCAL BASE<=0
if (LOCALBASE > 0) goto L_0389;
FAULT(231);
L_0389:;
// 2936 PRR(5,LOCAL BASE,0); LOCAL ADDR=CA
PRR(5, LOCALBASE, 0);
LOCALADDR = CA;
// 2937 L2: PUSH(LOCAL JUMP,CA,LABEL)
U_1079:;
PUSH(/*?*/ &LOCALJUMP, CA, LABEL);
// 2938 PRX(X'47',MASK,LOCAL BASE,0,0)
PRX(71, MASK, LOCALBASE, 0, 0);
// 2939 L99: %END
U_106C:;
return;
} /* end of PLOCALJUMP */
// 2940 %ROUTINE CSNAME(%INTEGER Z,REG)
void CSNAME(int Z, int REG) {
// 2941 %INTEGERARRAY B(0:5)
int B[6];
// 2942 %OWNBYTEINTEGERARRAY PLABEL(0:45)=9,9,3,3,
static unsigned char PLABEL[46] = {9,
9,
3,
3,
1,
[5 ... 7] = 14,
2,
3,
1,
18,
4,
3,
[14 ... 15] = 12,
33,
42,
34,
35,
32,
[21 ... 36] = 12,
5,
[38 ... 45] = 12};
// 2943+ 1,14(3),2,3,1,18,4,3,12(2),
// 2944+ 33,42,34,35,32,12(16),5,12(8);
// 2945 %OWNBYTEINTEGERARRAY MODE(0:45)=16(2),
static unsigned char MODE[46] = {[0 ... 1] = 16,
[2 ... 4] = 0,
[5 ... 7] = 16,
2,
[9 ... 10] = 16,
31,
32,
0,
18,
31,
[16 ... 18] = 18,
63,
47,
[21 ... 22] = 23,
18,
[24 ... 30] = 31,
31,
[32 ... 33] = 23,
[34 ... 35] = 47,
18,
16,
2,
23,
[40 ... 41] = 16,
23,
[43 ... 45] = 0};
// 2946+ 0(3),16(3),2,16(2),31,32,0,
// 2947+ 18,31,18(3),63,47,23(2),18,31(7),
// 2948+ 31,23(2),47(2),18,16,2,23,16(2),
// 2949+ 23,0(3);
// 2950 ! TOP 4 BITS OF MODE = NO OF PARAMS BOTTOM 4 ALLOWED Z VALUE
// 2951 %SWITCH SW(0:45)
int SW_index;
int SW_line;
char *SW_file;
static const void *SW[46] = {
&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing};
// 2952 %INTEGER PL,KK,PP,V,JJ
int PL;
int KK;
int PP;
int V;
int JJ;
// 2953 KK=K; JJ=COUNTAPS
KK = K;
JJ = COUNTAPS();
// 2954 PL=PLABEL(KK); PP=P+1; V=MODE(K)
PL = PLABEL[KK];
PP = P + 1;
V = MODE[K];
// 2955 P=P+1; P=P+1 %IF V>>4#0
P = P + 1;
if ((unsigned int)V >> 4 == 0) goto L_038A;
P = P + 1;
L_038A:;
// 2956 ->L1010 %IF V&15=15
if (V & 15 != 15) goto L_038B;
goto U_105D;
L_038B:;
// 2957 ->L1001 %IF V>>4#JJ; V=V&15
if ((unsigned int)V >> 4 == JJ) goto L_038C;
goto U_105E;
L_038C:;
V = V & 15;
// 2958 ->L1002 %IF V=0 %AND Z#0; ! ROUTINE CALL IN EXPRESSION
if (V != 0) goto L_038D;
if (Z == 0) goto L_038D;
goto U_105F;
L_038D:;
// 2959 ->L1003 %IF V=2 %AND Z#2; ! FN CALLED INCORRECTLY
if (V != 2) goto L_038E;
if (Z == 2) goto L_038E;
goto U_1060;
L_038E:;
// 2960 ->L1005 %IF Z=0 %AND V#0
if (Z != 0) goto L_038F;
if (V == 0) goto L_038F;
goto U_1061;
L_038F:;
// 2961 L1010: ->SW(KK)
U_105D:;
SW_line = __LINE__;
SW_file = __FILE__;
SW_index = KK;
goto case_SW_dispatch;
// 2962 L1001: FAULT(19); PRINTNAME(FNAME)
U_105E:;
FAULT(19);
PRINTNAME(FNAME);
// 2963 L1000: P=PP; SKIP APP; P=P-1; ->L99
U_1062:;
P = PP;
SKIPAPP();
P = P - 1;
goto U_1063;
// 2964 L1002: FAULT(23); ->L1000
U_105F:;
FAULT(23);
goto U_1062;
// 2965 L1003: FAULT(29); ->L1000
U_1060:;
FAULT(29);
goto U_1062;
// 2966 L1004: FAULT(22); ->L1000
U_1064:;
FAULT(22);
goto U_1062;
// 2967 L1005: FAULT(17); ->L1000
U_1061:;
FAULT(17);
goto U_1062;
// 2968 L1: PPJ(PL); ->L99
U_1065:;
PPJ(PL);
goto U_1063;
// 2969 SW(4): CIOCP(1); ->L99; ! SKIP SYMBOL
case_SW_4:;
CIOCP(1);
goto U_1063;
// 2970 SW(2): V=10; ! NEWLINE
case_SW_2:;
V = 10;
// 2971 PRX(X'41',1,0,0,V)
PRX(65, 1, 0, 0, V);
// 2972 L23: CIOCP(3); ->L99
U_1066:;
CIOCP(3);
goto U_1063;
// 2973 L21: PRX(X'41',1,0,0,V); ->L1
U_1067:;
PRX(65, 1, 0, 0, V);
goto U_1065;
// 2974 SW(3): V=32; ->L21; ! SPACE
case_SW_3:;
V = 32;
goto U_1067;
// 2975 SW(5): V=0; ! RUNOUT
case_SW_5:;
V = 0;
// 2976 L51: CSEXP(2,1); ->L21
U_1068:;
CSEXP(2, 1);
goto U_1067;
// 2977 SW(6): V=10; ->L51; ! NEWLINES(N)
case_SW_6:;
V = 10;
goto U_1068;
// 2978 SW(7): V=32; ->L51; ! SPACES(N)
case_SW_7:;
V = 32;
goto U_1068;
// 2979 SW(0):SW(1): ! SELECT INPUT AND OUTPUT
case_SW_0:;
case_SW_1:;
// 2980 CSEXP(1,1); CIOCP(KK+8)
CSEXP(1, 1);
CIOCP(KK + 8);
// 2981 ->L99
goto U_1063;
// 2982 SW(9): ! PRINTSYMBOL
case_SW_9:;
// 2983 CSEXP(1,1); ->L23
CSEXP(1, 1);
goto U_1066;
// 2984 SW(8): CIOCP(2); ! NEXT SYMBOL
case_SW_8:;
CIOCP(2);
// 2985 L81: %UNLESS REG=1 %THEN PRR(X'18',REG,1)
U_1069:;
if (REG == 1) goto L_0391;
PRR(24, REG, 1);
L_0391:;
// 2986 L82: PTYPE=10001;UNPACK; ->L99
U_106D:;
PTYPE = 10001;
UNPACK();
goto U_1063;
// 2987 SW(10): CIOCP(1); ! READ SYMBOL
case_SW_10:;
CIOCP(1);
// 2988 L106: ->L1004 %UNLESS A(P)=4 %AND A(P+1)=1
U_106E:;
if (A[P + 2] != 4) goto L_0392;
if (A[P + 1 + 2] == 1) goto L_0393;
L_0392:;
goto U_1064;
L_0393:;
// 2989 P=P+2; COPYTAG(A(P)); UNPACK
P = P + 2;
COPYTAG(A[P + 2]);
UNPACK();
// 2990 ->L104 %UNLESS TYPE=1 %AND ARR=0 %AND ROUT=0
if (TYPE != 1) goto L_0394;
if (ARR != 0) goto L_0394;
if (ROUT == 0) goto L_0395;
L_0394:;
goto U_106F;
L_0395:;
// 2991 CNAME(1,1)
CNAME(1, 1);
// 2992 L102: ->L1004 %UNLESS A(P)=2; P=P+1; ->L99
U_1070:;
if (A[P + 2] == 2) goto L_0396;
goto U_1064;
L_0396:;
P = P + 1;
goto U_1063;
// 2993 L104: PLANT(X'1841'); REGISTER(4)=1
U_106F:;
PLANT(6209);
REGISTER[4] = 1;
// 2994 CNAME(1,4); REGISTER(4)=0
CNAME(1, 4);
REGISTER[4] = 0;
// 2995 ->L1004 %UNLESS TYPE=1; ->L102
if (TYPE == 1) goto L_0397;
goto U_1064;
L_0397:;
goto U_1070;
// 2996 SW(11): ! READ
case_SW_11:;
// 2997 B(0)=1; B(1)=1000
B[0] = 1;
B[1] = 1000;
// 2998 L110: JJ=10000; ->L1004 %IF 0#Z#13; ->L302
U_1071:;
JJ = 10000;
{
// Double-sided test on Z (Part I)
int tmp;
if (0 == (tmp = Z)) goto L_0398;
// Double-sided test on Z (Part II)
if (tmp == 13) goto L_0398;
}
goto U_1064;
L_0398:;
goto U_1072;
// 2999 SW(12): ! WRITE
case_SW_12:;
// 3000 CSEXP(1,1); P=P+1
CSEXP(1, 1);
P = P + 1;
// 3001 JJ=P; V=TSEXP(KK)
JJ = P;
V = TSEXP(/*?*/ &KK);
// 3002 ->L121 %UNLESS V=0
if (V == 0) goto L_0399;
goto U_1073;
L_0399:;
// 3003 V=PARK(1); CSEXP(2,1)
V = PARK(1);
CSEXP(2, 1);
// 3004 UNPARK(X'58',1,V)
UNPARK(88, 1, V);
// 3005 L120: PPJ(PL); ->L99
U_1074:;
PPJ(PL);
goto U_1063;
// 3006 L121: P=JJ; REGISTER(1)=1
U_1073:;
P = JJ;
REGISTER[1] = 1;
// 3007 CSEXP(2,1); REGISTER(1)=0; ->L120
CSEXP(2, 1);
REGISTER[1] = 0;
goto U_1074;
// 3008 SW(13): ! NEWPAGE
case_SW_13:;
// 3009 PRX(X'41',1,0,0,12); ! LA 0,12
PRX(65, 1, 0, 0, 12);
// 3010 CIOCP(5); ->L99
CIOCP(5);
goto U_1063;
// 3011 SW(14): ->L1004 %UNLESS A(P)=4 %AND A(P+1)=1;! ADDR
case_SW_14:;
if (A[P + 2] != 4) goto L_039A;
if (A[P + 1 + 2] == 1) goto L_039B;
L_039A:;
goto U_1064;
L_039B:;
// 3012 P=P+2
P = P + 2;
// 3013 CNAME(3,REG); ->L1004 %UNLESS A(P)=2
CNAME(3, REG);
if (A[P + 2] == 2) goto L_039C;
goto U_1064;
L_039C:;
// 3014 P=P+1; ->L82
P = P + 1;
goto U_106D;
// 3015 SW(16): ! INT
case_SW_16:;
// 3016 SW(17): ! INTPT
case_SW_17:;
// 3017 CSEXP(0,3)
CSEXP(0, 3);
// 3018 PRR(X'28',0,NEST)%UNLESS NEST=0
if (NEST == 0) goto L_039D;
PRR(40, 0, NEST);
L_039D:;
// 3019 PPJ(PL); ->L81
PPJ(PL);
goto U_1069;
// 3020 SW(18): CSEXP(6,3) ; ! FRACPT
case_SW_18:;
CSEXP(6, 3);
// 3021 PCLOD(32); !INSERT FRACPT SR IN LINE
PCLOD(32);
// 3022 PRR(X'28',REG,2) %UNLESS REG=2
if (REG == 2) goto L_039E;
PRR(40, REG, 2);
L_039E:;
// 3023 PTYPE=10032; UNPACK; ->L99
PTYPE = 10032;
UNPACK();
goto U_1063;
// 3024 SW(19): ! PRINT
case_SW_19:;
// 3025 B(0)=3;B(3)=1
B[0] = 3;
B[3] = 1;
// 3026 L191: B(1)=32;B(2)=1;->L110
U_1075:;
B[1] = 32;
B[2] = 1;
goto U_1071;
// 3027 SW(20): ! PRINTFL
case_SW_20:;
// 3028 QPREAL=N0<<2+4
QPREAL = (N0 << 2) + 4;
// 3029 B(0)=2;->L191
B[0] = 2;
goto U_1075;
// 3030 SW(39): JJ=11032; ->L210; ! LONGREAL
case_SW_39:;
JJ = 11032;
goto U_1076;
// 3031 SW(21): JJ=11002; ! REAL
case_SW_21:;
JJ = 11002;
// 3032 L210: CSEXP(0,1); P=P+1
U_1076:;
CSEXP(0, 1);
P = P + 1;
// 3033 ->L212 %UNLESS NEST=0
if (NEST == 0) goto L_039F;
goto U_1077;
L_039F:;
// 3034 PLANT(X'1810'); NEST=1
PLANT(6160);
NEST = 1;
// 3035 L212: PTYPE=JJ; UNPACK; ->L99
U_1077:;
PTYPE = JJ;
UNPACK();
goto U_1063;
// 3036 SW(22): JJ=11001; ->L210; ! INTEGER
case_SW_22:;
JJ = 11001;
goto U_1076;
// 3037 SW(23): CSEXP(REG,3); ! MOD
case_SW_23:;
CSEXP(REG, 3);
// 3038 PRR(X'20',REG,REG); ->L99; ! LPDR
PRR(32, REG, REG);
goto U_1063;
// 3039 SW(25):SW(26):SW(27): ! SQRT,LOG,SIN
case_SW_25:;
case_SW_26:;
case_SW_27:;
// 3040 SW(28):SW(29):SW (30): ! COS,TAN,EXP
case_SW_28:;
case_SW_29:;
case_SW_30:;
// 3041 B(0)=1
B[0] = 1;
// 3042 L301: B(1)=32;JJ=10032;
U_107A:;
B[1] = 32;
JJ = 10032;
// 3043 ->L1004 %IF 2#Z#13
{
// Double-sided test on Z (Part I)
int tmp;
if (2 == (tmp = Z)) goto L_03A0;
// Double-sided test on Z (Part II)
if (tmp == 13) goto L_03A0;
}
goto U_1064;
L_03A0:;
// 3044 L302: REDEFINE EP(JJ,B)
U_1072:;
REDEFINEEP(JJ, B);
// 3045 CNAME(Z,REG);P=P-2;->L99
CNAME(Z, REG);
P = P - 2;
goto U_1063;
// 3046 SW(31): ! MAP RECORD
case_SW_31:;
// 3047 CSEXP(REG,1); FAULT(84) %UNLESS Z=15
CSEXP(REG, 1);
if (Z == 15) goto L_03A1;
FAULT(84);
L_03A1:;
// 3048 PTYPE=3; UNPACK
PTYPE = 3;
UNPACK();
// 3049 ->L99
goto U_1063;
// 3050 SW(32): JJ=11011; ->L210; ! BYTEINTEGER
case_SW_32:;
JJ = 11011;
goto U_1076;
// 3051 SW(33): JJ=11021; ->L210; ! SHORT INTEGER
case_SW_33:;
JJ = 11021;
goto U_1076;
// 3052 SW(34):SW(35): !RADIUS & ARCTAN
case_SW_34:;
case_SW_35:;
// 3053 B(0)=2; B(2)=32; ->L301
B[0] = 2;
B[2] = 32;
goto U_107A;
// 3054 SW(36): ! %INTEGERFN PARITY
case_SW_36:;
// 3055 CSEXP(REG,1)
CSEXP(REG, 1);
// 3056 PRX(X'89',REG,0,0,31); ! SLL REL,31
PRX(137, REG, 0, 0, 31);
// 3057 PRX(X'8A',REG,0,0,30); ! SRA REG,30
PRX(138, REG, 0, 0, 30);
// 3058 PRX(X'5B',REG,0,GLA,16);! S_REG,,=F'-1'
PRX(91, REG, 0, GLA, 16);
// 3059 ->L99
goto U_1063;
// 3060 SW(37): CSTREXP(1); CIOCP(7); ->L99; ! PRINT STRING
case_SW_37:;
CSTREXP(1);
CIOCP(7);
goto U_1063;
// 3061 SW(38): PRX(X'41',REG,0,0,10); ->L82
case_SW_38:;
PRX(65, REG, 0, 0, 10);
goto U_106D;
// 3062 SW(40): ! PRINTCH
case_SW_40:;
// 3063 CSEXP(1,1); CIOCP(5); ->L99
CSEXP(1, 1);
CIOCP(5);
goto U_1063;
// 3064 SW(41): ! READ CH
case_SW_41:;
// 3065 CIOCP(4); ->L106
CIOCP(4);
goto U_106E;
// 3066 SW(42): JJ=11005; ->L210; ! STRING
case_SW_42:;
JJ = 11005;
goto U_1076;
// 3067 L99: %END
U_1063:;
return;
case_SW_dispatch:
if (SW_index < 0 || SW_index > 45)
_imp_signalf(6, 3, SW_index, "->SW(%d) out of bounds at %s line %d", SW_index, SW_file, SW_line);
goto *SW[SW_index - 0];
case_SW_missing:
_imp_signalf(8, 2, SW_index, "switch jump to undefined label SW(%d): at %s line %d", SW_index, SW_file, SW_line);
} /* end of CSNAME */
// 3068 %ROUTINE CIOCP(%INTEGER N)
void CIOCP(int N) {
// 3069 PRX(X'41',0,0,0,N); ! LA 0,N
PRX(65, 0, 0, 0, N);
// 3070 PRX(X'90',4,1,11,16); ! STM 4,1,16(11)
PRX(144, 4, 1, 11, 16);
// 3071 PRX(X'98',12,14,GLA,140); ! LM 12,14,=V(IOCP)
PRX(152, 12, 14, GLA, 140);
// 3072 PRR(X'05',15,14); ! BALR 15,14
PRR(5, 15, 14);
// 3073 R13=0
R13 = 0;
// 3074 %END
return;
} /* end of CIOCP */
// 3075 %ROUTINE CANAME(%INTEGER Z,BS,DP,CLINK,BSRF,DPRF)
void CANAME(int Z, int BS, int DP, int CLINK, int BSRF, int DPRF) {
// 3076 ! BS& DP FOR ARRAY HEAD BSRF & DPRF POINT TO MULTIPLIER
// 3077 ! IN RECORD FORMAT FOR RECORD ARRAYS LINK POINTS TO LP CELL HOLDING
// 3078 ! DIMENSION OF ARRAY IN CASE THIS HAS TO BE DEDUCED & INSERTED
// 3079 !%SHORTROUTINE
// 3080 %SWITCH S(0:3)
int S_index;
int S_line;
char *S_file;
static const void *S[4] = {&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing};
// 3081 %INTEGER PTYPEP,KK,RR,PP,JJ,JJJ
int PTYPEP;
int KK;
int RR;
int PP;
int JJ;
int JJJ;
// 3082 %INTEGER KKK,DIS,Q,PRECP,CHECKSP
int KKK;
int DIS;
int Q;
int PRECP;
int CHECKSP;
// 3083 %INTEGER BASEREG,ARRP,BASIC DISP
int BASEREG;
int ARRP;
int BASICDISP;
// 3084 CHECKSP=CHECKS; CHECKSP=1 %IF TYPE=0; ! NO TYPE MUST GO TO PERM
CHECKSP = CHECKS;
if (TYPE != 0) goto L_03A2;
CHECKSP = 1;
L_03A2:;
// 3085 PP=P; BASEREG=LINK
PP = P;
BASEREG = LINK;
// 3086 %IF INREG#0 %THEN %START
if (INREG == 0) goto L_03A3;
// 3087 CHECKSP=0 %IF TYPE#0; BASEREG=INREG
if (TYPE == 0) goto L_03A4;
CHECKSP = 0;
L_03A4:;
BASEREG = INREG;
// 3088 %FINISH
L_03A3:;
// 3089 JJ=J; PTYPEP=PTYPE
JJ = J;
PTYPEP = PTYPE;
// 3090 ARRP=ARR
ARRP = ARR;
// 3091 Q=COUNT APS; ->L1 %UNLESS JJ=0
Q = COUNTAPS();
if (JJ == 0) goto L_03A5;
goto U_1067;
L_03A5:;
// 3092 FROM1(CLINK,JJ)
FROM1(CLINK, /*?*/ &JJ);
// 3093 REPLACE1(CLINK,JJ!Q); JJ=Q
REPLACE1(CLINK, JJ | Q);
JJ = Q;
// 3094 L1: ->L4 %IF JJ=Q#0
U_1067:;
{
// Double-sided test on Q (Part I)
int tmp;
if (JJ != (tmp = Q)) goto L_03A6;
// Double-sided test on Q (Part II)
if (tmp == 0) goto L_03A6;
}
goto U_1068;
L_03A6:;
// 3095 FAULT(19); PRINTNAME(FNAME)
FAULT(19);
PRINTNAME(FNAME);
// 3096 P=P+1; SKIP APP; ->L99
P = P + 1;
SKIPAPP();
goto U_1069;
// 3097 L4:
U_1068:;
// 3098 %IF ARRP=2 %THEN FROM LIST(K,BASIC DISP,DP)
if (ARRP != 2) goto L_03A7;
FROMLIST(K, /*?*/ &BASICDISP, /*?*/ &DP);
L_03A7:;
// 3099 ->L12 %UNLESS CHECKSP=0 %AND JJ=1 %AND Z#3
if (CHECKSP != 0) goto L_03A8;
if (JJ != 1) goto L_03A8;
if (Z != 3) goto L_03A9;
L_03A8:;
goto U_106D;
L_03A9:;
// 3100 ->L12 %UNLESS 2>=TYPE
if (2 >= TYPE) goto L_03AA;
goto U_106D;
L_03AA:;
// 3101 PRECP=PREC; KKK=0; P=PP+2; JJJ=TSEXP(KKK)
PRECP = PREC;
KKK = 0;
P = PP + 2;
JJJ = TSEXP(/*?*/ &KKK);
// 3102 %IF 3<=JJJ<=99 %THEN DIS=0 %ELSE DIS=KKK*BYTES(PRECP)
{
// Double-sided test on JJJ (Part I)
int tmp;
if (3 > (tmp = JJJ)) goto L_03AB;
// Double-sided test on JJJ (Part II)
if (tmp > 99) goto L_03AB;
}
DIS = 0;
goto L_03AC;
L_03AB:;
DIS = KKK * BYTES[PRECP];
L_03AC:;
// 3103 ->L12 %IF DIS>4095 %OR (ARRP=2 %AND DIS+BASIC DISP>4095)
if (DIS > 4095) goto L_03AD;
if (ARRP != 2) goto L_03AE;
if (DIS + BASICDISP <= 4095) goto L_03AE;
L_03AD:;
goto U_106D;
L_03AE:;
// 3104 ->REGVAR %IF JJJ=50 %AND PRECP=1
if (JJJ != 50) goto L_03AF;
if (PRECP != 1) goto L_03AF;
goto U_106E;
L_03AF:;
// 3105 ->RDISP %IF JJJ=101
if (JJJ != 101) goto L_03B0;
goto U_106F;
L_03B0:;
// 3106 ->CONST %IF 1<=JJJ<=2
{
// Double-sided test on JJJ (Part I)
int tmp;
if (1 > (tmp = JJJ)) goto L_03B1;
// Double-sided test on JJJ (Part II)
if (tmp > 2) goto L_03B1;
}
goto U_1070;
L_03B1:;
// 3107 ->L12 %UNLESS JJJ=100
if (JJJ == 100) goto L_03B2;
goto U_106D;
L_03B2:;
// 3108 DUMP(2+2*PREC,1,K,0,I); P=P+1; ->L9
DUMP(2 + 2 * PREC, 1, K, 0, I);
P = P + 1;
goto U_1071;
// 3109 REGVAR: JJJ=K; P=P+1; ->L8; !CAN ONLY OPTIMISE BYTES
U_106E:;
JJJ = K;
P = P + 1;
goto U_1072;
// 3110 RDISP: ->REGVAR %IF PRECP=1
U_106F:;
if (PRECP != 1) goto L_03B3;
goto U_106E;
L_03B3:;
// 3111 PRR(X'18',1,K); P=P+1; ->L9
PRR(24, 1, K);
P = P + 1;
goto U_1071;
// 3112 L12: P=PP+2; DIS=0
U_106D:;
P = PP + 2;
DIS = 0;
// 3113 ->L21 %UNLESS JJ=1
if (JJ == 1) goto L_03B4;
goto U_1073;
L_03B4:;
// 3114 CSEXP(1,1);P=P+1
CSEXP(1, 1);
P = P + 1;
// 3115 ->L10 %IF CHECKSP=1
if (CHECKSP != 1) goto L_03B5;
goto U_1074;
L_03B5:;
// 3116 L9: JJJ=1
U_1071:;
JJJ = 1;
// 3117 L8: %IF BASEREG#LINK %THEN ->L5
U_1072:;
if (BASEREG == LINK) goto L_03B6;
goto U_1075;
L_03B6:;
// 3118 ->VECTOR %IF ARRP=2
if (ARRP != 2) goto L_03B7;
goto U_1076;
L_03B7:;
// 3119 RP13=R13; R13=BS<<12!DP
RP13 = R13;
R13 = BS << 12 | DP;
// 3120 PRX(X'58',LINK,0,BS,DP) %UNLESS R13=RP13; ! ADDR A0
if (R13 == RP13) goto L_03B8;
PRX(88, LINK, 0, BS, DP);
L_03B8:;
// 3121 ->L5
goto U_1075;
// 3122 VECTOR: DIS=DIS+BASIC DISP; BASEREG=BS
U_1076:;
DIS = DIS + BASICDISP;
BASEREG = BS;
// 3123 L5: PTYPE=PTYPEP; UNPACK
U_1075:;
PTYPE = PTYPEP;
UNPACK();
// 3124 ->L6 %IF JJJ=0
if (JJJ != 0) goto L_03B9;
goto U_1077;
L_03B9:;
// 3125 ->STR %IF TYPE=5
if (TYPE != 5) goto L_03BA;
goto U_107A;
L_03BA:;
// 3126 ->S(PREC) %UNLESS TYPE=3; ! RECORDS
if (TYPE == 3) goto L_03BB;
S_line = __LINE__;
S_file = __FILE__;
S_index = PREC;
goto case_S_dispatch;
L_03BB:;
// 3127 L3: PRX(X'4C',1,0,BSRF,DPRF); ->L6
U_107B:;
PRX(76, 1, 0, BSRF, DPRF);
goto U_1077;
// 3128 STR: PRX(X'58',2,0,BS,DP+8); ! ADDR OF DV
U_107A:;
PRX(88, 2, 0, BS, DP + 8);
// 3129 BSRF=2; DPRF=2; ->L3
BSRF = 2;
DPRF = 2;
goto U_107B;
// 3130 S(3): !LONG REAL
case_S_3:;
// 3131 S(0): ! %INTEGER
case_S_0:;
// 3132 PCONST(X'89100002'! PREC); ->L6; ! SLL 1,2 OR 3
PCONST((-1995440126) | PREC);
goto U_1077;
// 3133 S(2): ! %SHORT
case_S_2:;
// 3134 PLANT(X'1A11'); ! AR 1,1
PLANT(6673);
// 3135 S(1):L6: DISP=DIS; INDEX=JJJ; BASE=BASEREG; ->L99
case_S_1:;
U_1077:;
DISP = DIS;
INDEX = JJJ;
BASE = BASEREG;
goto U_1069;
// 3136 CONST: JJJ=0; P=P+1; ! 1 D WITH A CONSTANT SUFFIX
U_1070:;
JJJ = 0;
P = P + 1;
// 3137 ->L8
goto U_1072;
// 3138 L10: ! 1 DIMENSION PLUS CHECKS
U_1074:;
// 3139 DUMP(0,3,DP,0,BS); ! ADDR ARRAYHEAD
DUMP(0, 3, DP, 0, BS);
// 3140 PPJ(22+JJ); JJJ=1; ! PERM CHECKS BOUNDS AND SHIFTS
PPJ(22 + JJ);
JJJ = 1;
// 3141 L11: PTYPE=PTYPEP; UNPACK
U_107C:;
PTYPE = PTYPEP;
UNPACK();
// 3142 ->L6
goto U_1077;
// 3143 L21: ! TWO DIMENSIONS
U_1073:;
// 3144 ->L31 %UNLESS JJ=2 %AND CHECKSP=0
if (JJ != 2) goto L_03BD;
if (CHECKSP == 0) goto L_03BE;
L_03BD:;
goto U_107D;
L_03BE:;
// 3145 CSEXP(2,1);JJJ=2;P=P+1
CSEXP(2, 1);
JJJ = 2;
P = P + 1;
// 3146 KK=P;Q=TSEXP(PP);P=KK
KK = P;
Q = TSEXP(/*?*/ &PP);
P = KK;
// 3147 ->L22 %UNLESS Q=0
if (Q == 0) goto L_03BF;
goto U_107E;
L_03BF:;
// 3148 JJJ=PARK(2)
JJJ = PARK(2);
// 3149 L22: CSEXP(1,1);P=P+1
U_107E:;
CSEXP(1, 1);
P = P + 1;
// 3150 PRX(X'4C',1,0,BS,DP+14); ! MH 1,MULTIPLIER
PRX(76, 1, 0, BS, DP + 14);
// 3151 UNPARK(X'5A',1,JJJ); !ADD 1ST SUFFIX
UNPARK(90, 1, JJJ);
// 3152 ->L9
goto U_1071;
// 3153 L31: !MULTIDIMENSION - ALWAYS VIA PERM
U_107D:;
// 3154 RR=GET ARR WSP
RR = GETARRWSP();
// 3155 %CYCLE PP=0,1,JJ-1
// %for PP = 0, 1, JJ - 1 %cycle
{
int _final = JJ - 1;
if (invalid_for_loop(0, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle PP = 0, 1, JJ - 1");
PP = -1;
L_03C0:
if (PP == _final) goto L_03C1;
PP += 1;
// 3156 CSEXP(0,1);P=P+1
CSEXP(0, 1);
P = P + 1;
// 3157 DUMP(1,NEST,RR+PP<<2,0,RBASE)
DUMP(1, NEST, RR + (PP << 2), 0, RBASE);
// 3158 %REPEAT
goto L_03C0;
}
L_03C1:;
// 3159 DUMP(0,1,RR+PP<<2,0,RBASE); !LA 1,2
DUMP(0, 1, RR + (PP << 2), 0, RBASE);
// 3160 DUMP(0,2,DP,0,BS) ;!LA 2,ARRAY HEAD
DUMP(0, 2, DP, 0, BS);
// 3161 PPJ(24);JJJ=1;
PPJ(24);
JJJ = 1;
// 3162 PUSH(MDARR(LEVEL),0,RR) ;!FREE WORK SPACE
PUSH(/*?*/ &MDARR[LEVEL], 0, RR);
// 3163 ->L11
goto U_107C;
// 3164 L99: J=JJ; %END
U_1069:;
J = JJ;
return;
case_S_dispatch:
if (S_index < 0 || S_index > 3)
_imp_signalf(6, 3, S_index, "->S(%d) out of bounds at %s line %d", S_index, S_file, S_line);
goto *S[S_index - 0];
case_S_missing:
_imp_signalf(8, 2, S_index, "switch jump to undefined label S(%d): at %s line %d", S_index, S_file, S_line);
} /* end of CANAME */
// 3165 %ROUTINE CENAME(%INTEGER Z,MODE,BS,DP)
void CENAME(int Z, int MODE, int BS, int DP) {
// 3166 !%SHORTROUTINE
// 3167 %COMMENT MODE=0 POINTER TO RECORD IN CORE AT BS & DP
// 3168 %COMMENT MODE=1 POINTER TO RECORD IN REGISTER BS DP RUBBISH
// 3169 %COMMENT MODE=2 RECORD REG CLAIMED
// 3170 ! P POINTS TO (ENAME)***** FNAME HOLD FORMAT NAME
// 3171 %INTEGER Q,QQQ,BSRF,DPRF
int Q;
int QQQ;
int BSRF;
int DPRF;
// 3172 ->L2 %IF A(P)=1
if (A[P + 2] != 1) goto L_03C3;
goto U_105A;
L_03C3:;
// 3173 ->L1 %IF Z>=14; FAULT(64)
if (Z < 14) goto L_03C4;
goto U_105B;
L_03C4:;
FAULT(64);
// 3174 P=P-2
P = P - 2;
// 3175 PTYPE=1; UNPACK; ->L99
PTYPE = 1;
UNPACK();
goto U_105C;
// 3176 L1: BASE=BS; DISP=DP
U_105B:;
BASE = BS;
DISP = DP;
// 3177 DISP=-1 %IF MODE#0
if (MODE == 0) goto L_03C5;
DISP = -1;
L_03C5:;
// 3178 INDEX=0; ->L99
INDEX = 0;
goto U_105C;
// 3179 L2: P=P+1; Q=DISPLACEMENT(FNAME); UNPACK
U_105A:;
P = P + 1;
Q = DISPLACEMENT(FNAME);
UNPACK();
// 3180 ! K POINTS TO CELL HOLD ING DETAILS FOR THOS CELL
// 3181 ->L98 %IF Q=-1; ->L50 %IF TYPE =3
if (Q != -1) goto L_03C6;
goto U_105D;
L_03C6:;
if (TYPE != 3) goto L_03C7;
goto U_105E;
L_03C7:;
// 3182 ->L20 %IF ARR=1
if (ARR != 1) goto L_03C8;
goto U_105F;
L_03C8:;
// 3183 ->L30 %IF TYPE=5
if (TYPE != 5) goto L_03C9;
goto U_1060;
L_03C9:;
// 3184 ->L11 %IF MODE#0
if (MODE == 0) goto L_03CA;
goto U_1061;
L_03CA:;
// 3185 RP13=R13; R13=BS<<12!DP
RP13 = R13;
R13 = BS << 12 | DP;
// 3186 PRX(X'58',LINK,0,BS,DP) %UNLESS R13=RP13
if (R13 == RP13) goto L_03CB;
PRX(88, LINK, 0, BS, DP);
L_03CB:;
// 3187 BASE=LINK
BASE = LINK;
// 3188 L7: INDEX=0; DISP=Q
U_1062:;
INDEX = 0;
DISP = Q;
// 3189 %IF ROUT=1 %THEN FROM1(Q,DISP); ->L99
if (ROUT != 1) goto L_03CC;
FROM1(Q, /*?*/ &DISP);
L_03CC:;
goto U_105C;
// 3190 L11: BASE=BS; ->L7
U_1061:;
BASE = BS;
goto U_1062;
// 3191 L20: ! DEAL WITH ARRAY IN RECORD
U_105F:;
// 3192 FROM LIST(FNAME,BSRF,QQQ)
FROMLIST(FNAME, /*?*/ &BSRF, /*?*/ &QQQ);
// 3193 BSRF=BSRF>>4&15
BSRF = (unsigned int)BSRF >> 4 & 15;
// 3194 FROM1(QQQ,DPRF)
FROM1(QQQ, /*?*/ &DPRF);
// 3195 ->L21 %IF Z<10 %OR A(P+1)=1; K=DPRF+Q
if (Z < 10) goto L_03C2;
if (A[P + 1 + 2] != 1) goto L_03CD;
L_03C2:;
goto U_1063;
L_03CD:;
K = DPRF + Q;
// 3196 I=BSRF; ! SS5V1
I = BSRF;
// 3197 DUMP(2,1,DP,0,BS) %IF MODE=0; ->L99; ! R1 NOW POINTS TO REORD
if (MODE != 0) goto L_03CE;
DUMP(2, 1, DP, 0, BS);
L_03CE:;
goto U_105C;
// 3198 L21: ->L22 %UNLESS MODE=0 %AND BS<4;! WILL POINTER BE DESTROTED?
U_1063:;
if (MODE != 0) goto L_03CF;
if (BS < 4) goto L_03D0;
L_03CF:;
goto U_1064;
L_03D0:;
// 3199 DUMP(2,1,DP,0,BS); MODE=1; BS=1; ! YES-- SO SAVE IT
DUMP(2, 1, DP, 0, BS);
MODE = 1;
BS = 1;
// 3200 L22: QQQ=PARK(1) %IF MODE=1
U_1064:;
if (MODE != 1) goto L_03D1;
QQQ = PARK(1);
L_03D1:;
// 3201 CANAME(3,BSRF,DPRF+Q,K,0,0)
CANAME(3, BSRF, DPRF + Q, K, 0, 0);
// 3202 R13=0
R13 = 0;
// 3203 %IF MODE=0 %THEN PRX(X'5A',INDEX,BS,0,DP)
if (MODE != 0) goto L_03D2;
PRX(90, INDEX, BS, 0, DP);
L_03D2:;
// 3204 %IF MODE=1 %THEN UNPARK(X'5A',INDEX,QQQ)
if (MODE != 1) goto L_03D3;
UNPARK(90, INDEX, QQQ);
L_03D3:;
// 3205 %IF MODE=2 %THEN PRR(X'1A',INDEX,BS)
if (MODE != 2) goto L_03D4;
PRR(26, INDEX, BS);
L_03D4:;
// 3206 I=BSRF; K=DPRF+Q
I = BSRF;
K = DPRF + Q;
// 3207 ->L99
goto U_105C;
// 3208 L30: FROMLIST(FNAME,BSRF,QQQ)
U_1060:;
FROMLIST(FNAME, /*?*/ &BSRF, /*?*/ &QQQ);
// 3209 FROM1(QQQ,DPRF); BSRF=BSRF>>4&15
FROM1(QQQ, /*?*/ &DPRF);
BSRF = (unsigned int)BSRF >> 4 & 15;
// 3210 PRR(X'18',1,BS) %IF MODE#0 %AND BS#1
if (MODE == 0) goto L_03D5;
if (BS == 1) goto L_03D5;
PRR(24, 1, BS);
L_03D5:;
// 3211 PRX(X'58',1,BS,0,DP) %IF MODE=0
if (MODE != 0) goto L_03D6;
PRX(88, 1, BS, 0, DP);
L_03D6:;
// 3212 PRX(X'5A',1,BSRF,0,DPRF+Q)
PRX(90, 1, BSRF, 0, DPRF + Q);
// 3213 BASE=1; INDEX=0; DISP=0
BASE = 1;
INDEX = 0;
DISP = 0;
// 3214 I=BSRF; K=DPRF+Q; ->L99
I = BSRF;
K = DPRF + Q;
goto U_105C;
// 3215 L50: ! RECORDNAME IN RECORD--Q POINTS TO SIDECHAIN
U_105E:;
// 3216 DUMP(2,1,DP,0,BS) %IF MODE=0;! LOAD PTR TO FIRST RECORD
if (MODE != 0) goto L_03D7;
DUMP(2, 1, DP, 0, BS);
L_03D7:;
// 3217 PRR(X'18',1,BS) %IF MODE#0
if (MODE == 0) goto L_03D8;
PRR(24, 1, BS);
L_03D8:;
// 3218 FROM2(Q,QQQ)
FROM2(Q, /*?*/ &QQQ);
// 3219 CRNAME(Z,1,K,1,QQQ); ->L99
CRNAME(Z, 1, K, 1, QQQ);
goto U_105C;
// 3220 L98: P=P+1; SKIP APP; P=P-2
U_105D:;
P = P + 1;
SKIPAPP();
P = P - 2;
// 3221 L99: %END
U_105C:;
return;
} /* end of CENAME */
// 3222 %ROUTINE CRNAME(%INTEGER Z,MODE,CLINK,BS,DP)
void CRNAME(int Z, int MODE, int CLINK, int BS, int DP) {
// 3223 !%SHORTROUTINE
// 3224 %COMMENT DEALS WITH RECORD NAME CALLING CENAME TO COMPILE SUBFIELDS
// 3225 %COMMENT MODE=0 POINTER TO RECORD IN CORE AT BS & DP
// 3226 %COMMENT MODE=1 POINTER TO RECORD IN REGISTER BS DP RUBBISH
// 3227 %COMMENT CLINK POINTS TO CELL CONTAING NAME DETAILS
// 3228 %INTEGER KK,JJ,Q,QQ
int KK;
int JJ;
int Q;
int QQ;
// 3229 FROM2(CLINK,Q)
FROM2(CLINK, /*?*/ &Q);
// 3230 FROM1(Q,FNAME)
FROM1(Q, /*?*/ &FNAME);
// 3231 ->L50 %IF ARR=0
if (ARR != 0) goto L_03D9;
goto U_105B;
L_03D9:;
// 3232 I=BS; K=DP;
I = BS;
K = DP;
// 3233 ->L99 %IF 11<=Z<=12 %AND A(P+1)=2 ;! FETCH ARRAYHEAD
{
// Double-sided test on Z (Part I)
int tmp;
if (11 > (tmp = Z)) goto L_03DA;
// Double-sided test on Z (Part II)
if (tmp > 12) goto L_03DA;
}
if (A[P + 1 + 2] != 2) goto L_03DA;
goto U_105C;
L_03DA:;
// 3234 FROM LIST(FNAME,KK,JJ)
FROMLIST(FNAME, /*?*/ &KK, /*?*/ &JJ);
// 3235 KK=KK>>4&15; ! BASE REG OF FORMAT
KK = (unsigned int)KK >> 4 & 15;
// 3236 FROM1(JJ,JJ)
FROM1(JJ, /*?*/ &JJ);
// 3237 %IF MODE=2 %THEN PRR(X'1A',INDEX,BS)
if (MODE != 2) goto L_03DB;
PRR(26, INDEX, BS);
L_03DB:;
// 3238 ->L3 %UNLESS MODE=0 %AND BS<4;! WILL POINTER BE DESTROTED?
if (MODE != 0) goto L_03DC;
if (BS < 4) goto L_03DD;
L_03DC:;
goto U_105D;
L_03DD:;
// 3239 DUMP(2,1,DP,0,BS); MODE=1; BS=1; ! YES-- SO SAVE IT
DUMP(2, 1, DP, 0, BS);
MODE = 1;
BS = 1;
// 3240 L3:
U_105D:;
// 3241 QQ=BS; QQ=PARK(BS) %IF MODE=1
QQ = BS;
if (MODE != 1) goto L_03DE;
QQ = PARK(BS);
L_03DE:;
// 3242 CANAME(Z,QQ,DP,CLINK,KK,JJ+2)
CANAME(Z, QQ, DP, CLINK, KK, JJ + 2);
// 3243 FROM1(Q,FNAME)
FROM1(Q, /*?*/ &FNAME);
// 3244 REGISTER(QQ)=0 %IF MODE=1
if (MODE != 1) goto L_03DF;
REGISTER[QQ] = 0;
L_03DF:;
// 3245 PRR(X'1A',1,LINK)
PRR(26, 1, LINK);
// 3246 CENAME(Z,1,1,0); ->L99
CENAME(Z, 1, 1, 0);
goto U_105C;
// 3247 L50: P=P+1; ->L51 %IF A(P)=2
U_105B:;
P = P + 1;
if (A[P + 2] != 2) goto L_03E0;
goto U_105E;
L_03E0:;
// 3248 FAULT(19); SKIP APP
FAULT(19);
SKIPAPP();
// 3249 L51: P=P+1
U_105E:;
P = P + 1;
// 3250 %IF INREG=0 %OR Z=14 %THEN CENAME(Z,0,BS,DP) %ELSE %C
if (INREG == 0) goto L_03E1;
if (Z != 14) goto L_03E2;
L_03E1:;
CENAME(Z, 0, BS, DP);
goto L_03E3;
L_03E2:;
CENAME(Z, 2, INREG, 0);
L_03E3:;
// 3251+ CENAME(Z,2,INREG,0)
// 3252 L99: %END
U_105C:;
return;
} /* end of CRNAME */
// 3253 %ROUTINE CNAME(%INTEGER Z,REG)
void CNAME(int Z, int REG) {
// 3254 %INTEGER JJ,JJJ,KK,RR,PTYPEP,LEVELP
int JJ;
int JJJ;
int KK;
int RR;
int PTYPEP;
int LEVELP;
// 3255 %INTEGER DISPP
int DISPP;
// 3256 %COMMENT Z=0-RTCALL, Z=1 STORE(=), Z=2 FETCH, Z=3 FETCH ADDR, Z=4 STORE(<-), Z=6 STORE PTR, Z=12 FETCH ARRAYHEAD, Z=11 STORE ARRAY HEAD
// 3257 %SWITCH S,FUNNY(10:15)
int S_index;
int S_line;
char *S_file;
static const void *S[6] = {&&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing};
int FUNNY_index;
int FUNNY_line;
char *FUNNY_file;
static const void *FUNNY[6] = {&&case_FUNNY_missing, &&case_FUNNY_missing, &&case_FUNNY_missing,
&&case_FUNNY_missing, &&case_FUNNY_missing, &&case_FUNNY_missing};
// 3258 %SWITCH SW(0:8),MOD(0:31)
int SW_index;
int SW_line;
char *SW_file;
static const void *SW[9] = {&&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_missing, &&case_SW_missing,
&&case_SW_missing, &&case_SW_missing, &&case_SW_missing};
int MOD_index;
int MOD_line;
char *MOD_file;
static const void *MOD[32] = {&&case_MOD_missing, &&case_MOD_missing, &&case_MOD_missing, &&case_MOD_missing,
&&case_MOD_missing, &&case_MOD_missing, &&case_MOD_missing, &&case_MOD_missing,
&&case_MOD_missing, &&case_MOD_missing, &&case_MOD_missing, &&case_MOD_missing,
&&case_MOD_missing, &&case_MOD_missing, &&case_MOD_missing, &&case_MOD_missing,
&&case_MOD_missing, &&case_MOD_missing, &&case_MOD_missing, &&case_MOD_missing,
&&case_MOD_missing, &&case_MOD_missing, &&case_MOD_missing, &&case_MOD_missing,
&&case_MOD_missing, &&case_MOD_missing, &&case_MOD_missing, &&case_MOD_missing,
&&case_MOD_missing, &&case_MOD_missing, &&case_MOD_missing, &&case_MOD_missing};
// 3259 FNAME=A(P); COPYTAG(FNAME)
FNAME = A[P + 2];
COPYTAG(FNAME);
// 3260 ->L3 %UNLESS I=-1;
if (I == -1) goto L_03E4;
goto U_105F;
L_03E4:;
// 3261 { FAULT(16) ;! Generating erroneous fault
// 3262 I=LEVEL; J=0; K=FNAME
I = LEVEL;
J = 0;
K = FNAME;
// 3263 PTYPE=7;STORE TAG(K,N)
PTYPE = 7;
STORETAG(K, N);
// 3264 K=N; N=N+4; UNPACK
K = N;
N = N + 4;
UNPACK();
// 3265 L3: JJ=J; JJ=0 %IF JJ=15
U_105F:;
JJ = J;
if (JJ != 15) goto L_03E5;
JJ = 0;
L_03E5:;
// 3266 LEVELP=I; DISPP=K
LEVELP = I;
DISPP = K;
// 3267 ->L502 %IF TYPE=7
if (TYPE != 7) goto L_03E6;
goto U_1060;
L_03E6:;
// 3268 ->L500 %IF Z=0 %AND (ROUT#1 %OR 0#TYPE#6)
if (Z != 0) goto L_03E7;
if (ROUT != 1) goto L_03E8;
{
// Double-sided test on TYPE (Part I)
unsigned char tmp;
if (0 == (tmp = TYPE)) goto L_03E7;
// Double-sided test on TYPE (Part II)
if (tmp == 6) goto L_03E7;
}
L_03E8:;
goto U_1061;
L_03E7:;
// 3269 ->FUNNY(Z) %IF Z>=10
if (Z < 10) goto L_03E9;
FUNNY_line = __LINE__;
FUNNY_file = __FILE__;
FUNNY_index = Z;
goto case_FUNNY_dispatch;
L_03E9:;
// 3270 ->L501 %IF ROUT=1
if (ROUT != 1) goto L_03EB;
goto U_1062;
L_03EB:;
// 3271 ->SW(TYPE)
SW_line = __LINE__;
SW_file = __FILE__;
SW_index = TYPE;
goto case_SW_dispatch;
// 3272 L500: ->SW(3) %IF TYPE=3
U_1061:;
if (TYPE != 3) goto L_03EC;
SW_line = __LINE__;
SW_file = __FILE__;
SW_index = 3;
goto case_SW_dispatch;
L_03EC:;
// 3273 FAULT(17) %UNLESS TYPE=7; ->L502
if (TYPE == 7) goto L_03ED;
FAULT(17);
L_03ED:;
goto U_1060;
// 3274 SW(6): ->L661 %UNLESS Z=3 %AND ARR=1
case_SW_6:;
if (Z != 3) goto L_03EE;
if (ARR == 1) goto L_03EF;
L_03EE:;
goto U_1063;
L_03EF:;
// 3275 K=K<<2; ARR=0; I=10; ->L600
K = K << 2;
ARR = 0;
I = 10;
goto U_1064;
// 3276 SW(4): !RECORD FORMAT NAME
case_SW_4:;
// 3277 L661: FAULT(20)
U_1063:;
FAULT(20);
// 3278 SW(7):L502: P=P+1; ! NAME NOT SET
case_SW_7:;
U_1060:;
P = P + 1;
// 3279 PTYPE=1; UNPACK; ->L6 %IF A(P)=2; ->L102
PTYPE = 1;
UNPACK();
if (A[P + 2] != 2) goto L_03F0;
goto U_1065;
L_03F0:;
goto U_1066;
// 3280 FUNNY(11): ->L1011 %IF TYPE=3
case_FUNNY_11:;
if (TYPE != 3) goto L_03F1;
goto U_1067;
L_03F1:;
// 3281 FAULT(17) %UNLESS ARR=1 %AND NAM=1 %AND K>>12=0
if (ARR != 1) goto L_03F2;
if (NAM != 1) goto L_03F2;
if ((unsigned int)K >> 12 == 0) goto L_03F3;
L_03F2:;
FAULT(17);
L_03F3:;
// 3282 PRX(X'90',0,3,I,K); ->L91
PRX(144, 0, 3, I, K);
goto U_1068;
// 3283 L1011: PCLOD(44);->SW(3); !STM 0,3,0(11) - LA 11,16(11)
U_1067:;
PCLOD(44);
SW_line = __LINE__;
SW_file = __FILE__;
SW_index = 3;
goto case_SW_dispatch;
// 3284 S(11): MOVER(WSPR,-16)
case_S_11:;
MOVER(WSPR, -16);
// 3285 PSS(X'D2',16,1,0,WSPR,0); ->L91
PSS(210, 16, 1, 0, WSPR, 0);
goto U_1068;
// 3286 FUNNY(12): ->SW(3) %IF TYPE=3
case_FUNNY_12:;
if (TYPE != 3) goto L_03F5;
SW_line = __LINE__;
SW_file = __FILE__;
SW_index = 3;
goto case_SW_dispatch;
L_03F5:;
// 3287 ->L1202 %IF ARR=2; ! VECTORS
if (ARR != 2) goto L_03F6;
goto U_1069;
L_03F6:;
// 3288 FAULT(17) %UNLESS ARR=1
if (ARR == 1) goto L_03F7;
FAULT(17);
L_03F7:;
// 3289 L1201: PRX(X'98',0,3,I,K&4095); ->L91
U_106D:;
PRX(152, 0, 3, I, K & 4095);
goto U_1068;
// 3290 L1202: FROM2(K,K); ->L1201
U_1069:;
FROM2(K, /*?*/ &K);
goto U_106D;
// 3291 S(12): ->L1201 %IF TYPE=3 %AND ARR=1
case_S_12:;
if (TYPE != 3) goto L_03F8;
if (ARR != 1) goto L_03F8;
goto U_106D;
L_03F8:;
// 3292 PRR(X'18',0,1)
PRR(24, 0, 1);
// 3293 PRX(X'5A',0,0,I,K)
PRX(90, 0, 0, I, K);
// 3294 PRX(X'5A',1,0,I,K+4)
PRX(90, 1, 0, I, K + 4);
// 3295 PRX(X'98',2,3,I,K+8); ->L91
PRX(152, 2, 3, I, K + 8);
goto U_1068;
// 3296 FUNNY(13): ! SET BASE & DISP FOR ROUTINE ADDR
case_FUNNY_13:;
// 3297 ->SW(3) %IF TYPE=3
if (TYPE != 3) goto L_03F9;
SW_line = __LINE__;
SW_file = __FILE__;
SW_index = 3;
goto case_SW_dispatch;
L_03F9:;
// 3298 ->L1302 %IF PTYPE=10006
if (PTYPE != 10006) goto L_03FA;
goto U_106E;
L_03FA:;
// 3299 ->L1301 %IF ROUT=1 %AND NAM&1=1
if (ROUT != 1) goto L_03FB;
if (NAM & 1 != 1) goto L_03FB;
goto U_106F;
L_03FB:;
// 3300 BASE=GLA; FROM1(K,DISP)
BASE = GLA;
FROM1(K, /*?*/ &DISP);
// 3301 INDEX=0; DISP=RA(DISP)
INDEX = 0;
DISP = RA[DISP];
// 3302 DISP=DISP+4 %IF J=14; ! EXTERNAL ROUTINES SKIP LINK
if (J != 14) goto L_03FC;
DISP = DISP + 4;
L_03FC:;
// 3303 L1300: ->L500 %UNLESS ROUT=1
U_1070:;
if (ROUT == 1) goto L_03FD;
goto U_1061;
L_03FD:;
// 3304 ->L91
goto U_1068;
// 3305 L1301: BASE=I; FROM1(K,DISP)
U_106F:;
BASE = I;
FROM1(K, /*?*/ &DISP);
// 3306 INDEX=0; ->L91
INDEX = 0;
goto U_1068;
// 3307 L1302: CSNAME(Z,REG); ->L6
U_106E:;
CSNAME(Z, REG);
goto U_1065;
// 3308 S(13): FROM2(K,K); ->L1300
case_S_13:;
FROM2(K, /*?*/ &K);
goto U_1070;
// 3309 FUNNY(15): ! FETCH RECORD NAME
case_FUNNY_15:;
// 3310 ->L1501 %IF PTYPE=10006
if (PTYPE != 10006) goto L_03FE;
goto U_1071;
L_03FE:;
// 3311 FUNNY(14): ! STORE INTO RECORD NAME
case_FUNNY_14:;
// 3312 RR=0; %IF ARR=0 %AND INREG#0 %AND A(P+1)=2=A(P+2)%THEN RR=INREG
RR = 0;
if (ARR != 0) goto L_03FF;
if (INREG == 0) goto L_03FF;
{
// Double-sided test on 2 (Part I)
int tmp;
if (A[P + 1 + 2] != (tmp = 2)) goto L_03FF;
// Double-sided test on 2 (Part II)
if (tmp != A[P + 2 + 2]) goto L_03FF;
}
RR = INREG;
L_03FF:;
// 3313 ->SW(3) %IF TYPE=3; ->L661
if (TYPE != 3) goto L_0400;
SW_line = __LINE__;
SW_file = __FILE__;
SW_index = 3;
goto case_SW_dispatch;
L_0400:;
goto U_1063;
// 3314 S(14): FAULT(20) %UNLESS TYPE=3 %AND NAM=1
case_S_14:;
if (TYPE != 3) goto L_0401;
if (NAM == 1) goto L_0402;
L_0401:;
FAULT(20);
L_0402:;
// 3315 PRR(X'18',RR,REG) %IF REG#RR#0
{
// Double-sided test on RR (Part I)
int tmp;
if (REG == (tmp = RR)) goto L_0403;
// Double-sided test on RR (Part II)
if (tmp == 0) goto L_0403;
}
PRR(24, RR, REG);
L_0403:;
// 3316 DISP=0 %IF DISP<0
if (DISP >= 0) goto L_0404;
DISP = 0;
L_0404:;
// 3317 R13=0 %IF R13=BASE<<12!DISP
if (R13 != BASE << 12 | DISP) goto L_0405;
R13 = 0;
L_0405:;
// 3318 L1401: DUMP(Z-13,REG,DISP,INDEX,BASE)
U_1072:;
DUMP(Z - 13, REG, DISP, INDEX, BASE);
// 3319 P=P+1; ->L9005
P = P + 1;
goto U_1073;
// 3320 S(15): ->L661 %UNLESS TYPE=3
case_S_15:;
if (TYPE == 3) goto L_0406;
goto U_1063;
L_0406:;
// 3321 ->L1401 %IF DISP>=0
if (DISP < 0) goto L_0407;
goto U_1072;
L_0407:;
// 3322 DUMP(0,REG,0,INDEX,BASE); P=P+1; ->L9005
DUMP(0, REG, 0, INDEX, BASE);
P = P + 1;
goto U_1073;
// 3323 L1501: CSNAME(Z,REG)
U_1071:;
CSNAME(Z, REG);
// 3324 FAULT(22) %UNLESS A(P)=2 %AND A(P+1)=2; P=P+2; ->L9005
if (A[P + 2] != 2) goto L_0408;
if (A[P + 1 + 2] == 2) goto L_0409;
L_0408:;
FAULT(22);
L_0409:;
P = P + 2;
goto U_1073;
// 3325 SW(3): ! RECORD
case_SW_3:;
// 3326 FROM2(K,JJJ)
FROM2(K, /*?*/ &JJJ);
// 3327 CRNAME(Z,0,TAGS(A(P)),I,JJJ)
CRNAME(Z, 0, TAGS[A[P + 2]], I, JJJ);
// 3328 ->S(Z) %IF Z>=10
if (Z < 10) goto L_040A;
S_line = __LINE__;
S_file = __FILE__;
S_index = Z;
goto case_S_dispatch;
L_040A:;
// 3329 ->L5020 %IF TYPE=5
if (TYPE != 5) goto L_040B;
goto U_1074;
L_040B:;
// 3330 ->L601 %UNLESS Z=0
if (Z == 0) goto L_040C;
goto U_1075;
L_040C:;
// 3331 ->L500 %UNLESS ROUT=1 %AND NAM=1
if (ROUT != 1) goto L_040D;
if (NAM == 1) goto L_040E;
L_040D:;
goto U_1061;
L_040E:;
// 3332 LEVELP=PARK(BASE); RR=DISP
LEVELP = PARK(BASE);
RR = DISP;
// 3333 PTYPEP=PTYPE; FROM2(K,JJ)
PTYPEP = PTYPE;
FROM2(K, /*?*/ &JJ);
// 3334 FROM2(JJ,K); ->L22
FROM2(JJ, /*?*/ &K);
goto U_1076;
// 3335 SW(5): !STRINGS
case_SW_5:;
// 3336 BASE=I; INDEX=0; DISP=K
BASE = I;
INDEX = 0;
DISP = K;
// 3337 JJJ=2; ->L5000 %UNLESS ARR=1
JJJ = 2;
if (ARR == 1) goto L_040F;
goto U_1077;
L_040F:;
// 3338 CANAME(Z,I,K,TAGS(FNAME),0,0)
CANAME(Z, I, K, TAGS[FNAME], 0, 0);
// 3339 L4998: NAM=NAM>>1;JJJ=0
U_107A:;
NAM = (unsigned int)NAM >> 1;
JJJ = 0;
// 3340 ->L5000 %UNLESS Z=3
if (Z == 3) goto L_0410;
goto U_1077;
L_0410:;
// 3341 DUMP(0,REG,DISP,INDEX,BASE)
DUMP(0, REG, DISP, INDEX, BASE);
// 3342 PRX (X'58',2,0,LEVELP,DISPP+8) %IF CHECKS#0
if (CHECKS == 0) goto L_0411;
PRX(88, 2, 0, LEVELP, DISPP + 8);
L_0411:;
// 3343 PACLOD(10,6,REG<<4); ->L9
PACLOD(10, 6, REG << 4);
goto U_107B;
// 3344 %COMMENT L 2,LMAX. BCTR 2,0. SLL 2,24. OR REG,2
// 3345 L5000: ->L605 %IF 2<=Z<=3
U_1077:;
{
// Double-sided test on Z (Part I)
int tmp;
if (2 > (tmp = Z)) goto L_0412;
// Double-sided test on Z (Part II)
if (tmp > 3) goto L_0412;
}
goto U_107C;
L_0412:;
// 3346 PRR(X'18',4,REG) %UNLESS REG=4
if (REG == 4) goto L_0413;
PRR(24, 4, REG);
L_0413:;
// 3347 DUMP(JJJ,1,DISP,INDEX,BASE)
DUMP(JJJ, 1, DISP, INDEX, BASE);
// 3348 ->L5001 %IF ARR=0
if (ARR != 0) goto L_0414;
goto U_107D;
L_0414:;
// 3349 PRX(X'58',2,0,LEVELP,DISPP+8) %IF Z=4 %OR CHECKS#0
if (Z == 4) goto L_0415;
if (CHECKS == 0) goto L_0416;
L_0415:;
PRX(88, 2, 0, LEVELP, DISPP + 8);
L_0416:;
// 3350 I=2; K=3
I = 2;
K = 3;
// 3351 L5001: STORE STRING(Z,4,1,I,K);->L9
U_107D:;
STORESTRING(Z, 4, 1, I, K);
goto U_107B;
// 3352 L5020: ! STRINGS IN RE CORDS
U_1074:;
// 3353 ->L5025 %IF ARR=1
if (ARR != 1) goto L_0417;
goto U_107E;
L_0417:;
// 3354 ->L9 %IF 2<=Z<=3
{
// Double-sided test on Z (Part I)
int tmp;
if (2 > (tmp = Z)) goto L_0418;
// Double-sided test on Z (Part II)
if (tmp > 3) goto L_0418;
}
goto U_107B;
L_0418:;
// 3355 PRR(X'18',4,REG) %UNLESS REG=4; ->L5001
if (REG == 4) goto L_0419;
PRR(24, 4, REG);
L_0419:;
goto U_107D;
// 3356 L5025: ! STRING ARRAYS IN RECORDS
U_107E:;
// 3357 LEVELP=I; DISPP=K; ->L4998
LEVELP = I;
DISPP = K;
goto U_107A;
// 3358 SW(8): !REGISTER VARIABLE
case_SW_8:;
// 3359 FAULT(29) %UNLESS 1<=Z<=2 %OR Z=4
{
// Double-sided test on Z (Part I)
int tmp;
if (1 > (tmp = Z)) goto L_041A;
// Double-sided test on Z (Part II)
if (tmp <= 2) goto L_041B;
}
L_041A:;
if (Z == 4) goto L_041B;
FAULT(29);
L_041B:;
// 3360 ->L9 %IF K=REG
if (K != REG) goto L_041C;
goto U_107B;
L_041C:;
// 3361 %IF Z=2 %THEN PRR(X'18',REG,K) %ELSE PRR(X'18',K,REG)
if (Z != 2) goto L_041D;
PRR(24, REG, K);
goto L_041E;
L_041D:;
PRR(24, K, REG);
L_041E:;
// 3362 ->L9
goto U_107B;
// 3363 SW(0): %UNLESS Z=3 %OR Z>10 %THEN %START
case_SW_0:;
if (Z == 3) goto L_041F;
if (Z > 10) goto L_041F;
// 3364 FAULT(12); TYPE=1; PTYPE=PTYPE+1; %FINISH
FAULT(12);
TYPE = 1;
PTYPE = PTYPE + 1;
L_041F:;
// 3365 SW(2): !REAL
case_SW_2:;
// 3366 SW(1): ->L600 %IF ARR=0; ! TYPE 1 = %INTEGER
case_SW_1:;
if (ARR != 0) goto L_0420;
goto U_1064;
L_0420:;
// 3367 CANAME(Z,I,K,TAGS(FNAME),0,0)
CANAME(Z, I, K, TAGS[FNAME], 0, 0);
// 3368 TYPE=1 %IF TYPE=0; ! IN CASE OF ABUSE OF ARRAYNAME
if (TYPE != 0) goto L_0421;
TYPE = 1;
L_0421:;
// 3369 NAM=NAM>>1; ->L601
NAM = (unsigned int)NAM >> 1;
goto U_1075;
// 3370 L501: ->L503 %UNLESS Z#0 %AND PTYPE=10000;! ROUTINES
U_1062:;
if (Z == 0) goto L_0422;
if (PTYPE == 10000) goto L_0423;
L_0422:;
goto U_107F;
L_0423:;
// 3371 FAULT(23); PRINTNAME(A(P)); ->L503
FAULT(23);
PRINTNAME(A[P + 2]);
goto U_107F;
// 3372 L503: PTYPEP=PTYPE
U_107F:;
PTYPEP = PTYPE;
// 3373 ->L20 %UNLESS PTYPE=10006
if (PTYPE == 10006) goto L_0424;
goto U_1080;
L_0424:;
// 3374 CSNAME(Z,REG)
CSNAME(Z, REG);
// 3375 ->L202 %IF ROUT=1 %AND NAM>=1 %AND Z#0; ->L6; ! MAPS
if (ROUT != 1) goto L_0425;
if (NAM < 1) goto L_0425;
if (Z == 0) goto L_0425;
goto U_1081;
L_0425:;
goto U_1065;
// 3376 L20: KK=K; FROM LIST(KK,RR,K)
U_1080:;
KK = K;
FROMLIST(KK, /*?*/ &RR, /*?*/ &K);
// 3377 L22: ->L21 %UNLESS K=1000; FAULT(21); ->L502
U_1076:;
if (K == 1000) goto L_0426;
goto U_1082;
L_0426:;
FAULT(21);
goto U_1060;
// 3378 L21: CRCALL(KK)
U_1082:;
CRCALL(KK);
// 3379 PTYPE=PTYPEP; UNPACK
PTYPE = PTYPEP;
UNPACK();
// 3380 ->L37 %IF NAM&1=1
if (NAM & 1 != 1) goto L_0427;
goto U_1083;
L_0427:;
// 3381 ->L36 %IF JJ=14
if (JJ != 14) goto L_0428;
goto U_1084;
L_0428:;
// 3382 DUMP(2,1,RA(RR),0,GLA) ;! RT ADDR TO REG1
DUMP(2, 1, RA[RR], 0, GLA);
// 3383 PRX(X'45',LINK,0,GLA,116); ! BAL 15,SR IN PERM
PRX(69, LINK, 0, GLA, 116);
// 3384 L371: MONE=1; R13=0
U_1085:;
MONE = 1;
R13 = 0;
// 3385 P=P+1
P = P + 1;
// 3386 ->L1 %IF PTYPE=10000 %OR PTYPE=11000; ! ROUTINE OR RTNAME
if (PTYPE == 10000) goto L_0429;
if (PTYPE != 11000) goto L_042A;
L_0429:;
goto U_1086;
L_042A:;
// 3387 ->L201 %IF NAM>1; !MAPS
if (NAM <= 1) goto L_042B;
goto U_1087;
L_042B:;
// 3388 FAULT(29) %UNLESS Z=2; !FN OUT OF CONTEXT
if (Z == 2) goto L_042C;
FAULT(29);
L_042C:;
// 3389 ->L43 %IF TYPE=2
if (TYPE != 2) goto L_042D;
goto U_1088;
L_042D:;
// 3390 L44: PRR(X'18',REG,1) %UNLESS REG=1; ->L1
U_1089:;
if (REG == 1) goto L_042E;
PRR(24, REG, 1);
L_042E:;
goto U_1086;
// 3391 L43: PRR(X'28',REG,2) %UNLESS REG=2; ->L1
U_1088:;
if (REG == 2) goto L_042F;
PRR(40, REG, 2);
L_042F:;
goto U_1086;
// 3392 L36: ! CALL OF EXTERNAL ROUTINE
U_1084:;
// 3393 PACLOD(55,4,RA(RR)+4); !STM 4,14 - LM 12,14-BALR 13,14
PACLOD(55, 4, RA[RR] + 4);
// 3394 ->L371
goto U_1085;
// 3395 L37: ! CALL OF RT PARAM******** REGISTERS MUST BE RESET
U_1083:;
// 3396 REGISTER(LEVELP)=0 %IF LEVELP<RBASE
if (LEVELP >= RBASE) goto L_0430;
REGISTER[LEVELP] = 0;
L_0430:;
// 3397 PACLOD(61,4,LEVELP<<12!RR)
PACLOD(61, 4, LEVELP << 12 | RR);
// 3398 %COMMENT STM 4,14,?--LM 12,15 ? -- LM 5,9,20(15) -- BALR 15,14
// 3399 ->L371
goto U_1085;
// 3400 L201: %COMMENT - REAL MAPS AND INTEGER MAPS
U_1087:;
// 3401 NEST=1
NEST = 1;
// 3402 L202:
U_1081:;
// 3403 ->L205 %IF TYPE=5; ! STRING MAPS
if (TYPE != 5) goto L_0431;
goto U_108A;
L_0431:;
// 3404 ->L203 %IF Z=3
if (Z != 3) goto L_0432;
goto U_108B;
L_0432:;
// 3405 JJJ=Z; JJJ=1 %IF Z=4
JJJ = Z;
if (Z != 4) goto L_0433;
JJJ = 1;
L_0433:;
// 3406 JJJ=TYPE<<3+PREC<<1-8+JJJ
JJJ = (TYPE << 3) + (PREC << 1) - 8 + JJJ;
// 3407 DUMP(JJJ,REG,0,0,NEST)
DUMP(JJJ, REG, 0, 0, NEST);
// 3408 CHECK CAPACITY(REG,0,0,NEST) %IF Z=1 %AND CHECKS=1
if (Z != 1) goto L_0434;
if (CHECKS != 1) goto L_0434;
CHECKCAPACITY(REG, 0, 0, NEST);
L_0434:;
// 3409 TEST ASS(REG) %IF Z=2 %AND UNASS=1
if (Z != 2) goto L_0435;
if (UNASS != 1) goto L_0435;
TESTASS(REG);
L_0435:;
// 3410 ->L1
goto U_1086;
// 3411 L203: PRR(X'18',REG,NEST) %UNLESS REG=NEST; ->L1
U_108B:;
if (REG == NEST) goto L_0436;
PRR(24, REG, NEST);
L_0436:;
goto U_1086;
// 3412 L205: %COMMENT STRING MAPS
U_108A:;
// 3413 %IF NEST#1 %THEN PRR(X'18',1,NEST)
if (NEST == 1) goto L_0437;
PRR(24, 1, NEST);
L_0437:;
// 3414 ->L206 %IF 2<=Z<=3
{
// Double-sided test on Z (Part I)
int tmp;
if (2 > (tmp = Z)) goto L_0438;
// Double-sided test on Z (Part II)
if (tmp > 3) goto L_0438;
}
goto U_108C;
L_0438:;
// 3415 STORE STRING(Z,REG,1,0,255); ->L1
STORESTRING(Z, REG, 1, 0, 255);
goto U_1086;
// 3416 L206: PCLOD(69);->L44; ! LA 0,255--SLL 0,24 OR 1,0
U_108C:;
PCLOD(69);
goto U_1089;
// 3417 !ARR=0
// 3418 L600: BASE=I; INDEX=0; DISP=K
U_1064:;
BASE = I;
INDEX = 0;
DISP = K;
// 3419 L601: ->L602 %IF Z=6
U_1075:;
if (Z != 6) goto L_0439;
goto U_108D;
L_0439:;
// 3420 ->MOD(NAM<<4!PREC<<2!Z&3)
MOD_line = __LINE__;
MOD_file = __FILE__;
MOD_index = NAM << 4 | PREC << 2 | Z & 3;
goto case_MOD_dispatch;
// 3421 L602: FAULT(17) %IF NAM=0
U_108D:;
if (NAM != 0) goto L_043A;
FAULT(17);
L_043A:;
// 3422 R13=0 %IF R13=BASE<<12!DISP
if (R13 != BASE << 12 | DISP) goto L_043B;
R13 = 0;
L_043B:;
// 3423 JJJ=1; ->L605
JJJ = 1;
goto U_107C;
// 3424 MOD(1): ! INTEGER STORE (=)
case_MOD_1:;
// 3425 MOD(0): ! INTEGER STORE(<-)
case_MOD_0:;
// 3426 MOD(5): ! BYTE STORE(=)
case_MOD_5:;
// 3427 MOD(4): ! BYTE STORE(<-)
case_MOD_4:;
// 3428 MOD(9): ! SHORT STORE(=)
case_MOD_9:;
// 3429 MOD(8): ! SHORT STORE(<-)
case_MOD_8:;
// 3430 MOD(12): !LONG REAL STORE (<-)
case_MOD_12:;
// 3431 MOD(13): !LONG REAL STORE (=)
case_MOD_13:;
// 3432 MOD(2): !INTEGER OR REAL FETCH
case_MOD_2:;
// 3433 MOD(14): !LONGREAL FETCH
case_MOD_14:;
// 3434 JJJ=Z; JJJ=1 %IF Z=4
JJJ = Z;
if (Z != 4) goto L_043C;
JJJ = 1;
L_043C:;
// 3435 JJJ=TYPE<<3+PREC<<1-8+JJJ
JJJ = (TYPE << 3) + (PREC << 1) - 8 + JJJ;
// 3436 L605: DUMP(JJJ,REG,DISP,INDEX,BASE)
U_107C:;
DUMP(JJJ, REG, DISP, INDEX, BASE);
// 3437 CHECK CAPACITY(REG,DISP,INDEX,BASE) %IF Z=1 %AND CHECKS=1
if (Z != 1) goto L_043D;
if (CHECKS != 1) goto L_043D;
CHECKCAPACITY(REG, DISP, INDEX, BASE);
L_043D:;
// 3438 TEST ASS(REG) %IF Z=2 %AND UNASS=1
if (Z != 2) goto L_043E;
if (UNASS != 1) goto L_043E;
TESTASS(REG);
L_043E:;
// 3439 ->L9
goto U_107B;
// 3440 MOD(31): !LONG REAL NAME FETCH ADDR
case_MOD_31:;
// 3441 MOD(19): ! INTEGER NAME FETCH ADDR
case_MOD_19:;
// 3442 MOD(23): ! BYTE NAME FETCH ADDR
case_MOD_23:;
// 3443 MOD(27): ! SHORT NAME FETCH ADDR
case_MOD_27:;
// 3444 JJJ=2;->L605
JJJ = 2;
goto U_107C;
// 3445 MOD(15): !LONG REAL FETCH ADDR
case_MOD_15:;
// 3446 MOD(3): ! INTEGER FETCH ADDR
case_MOD_3:;
// 3447 MOD(7): ! BYTE FETCH ADDR
case_MOD_7:;
// 3448 MOD(11): ! SHORT FETCH ADDR
case_MOD_11:;
// 3449 JJJ=0;->L605
JJJ = 0;
goto U_107C;
// 3450 MOD(6): ! BYTE FETCH
case_MOD_6:;
// 3451 MOD(10): ! SHORT FETCH
case_MOD_10:;
// 3452 JJJ=PREC<<1+2;->L605
JJJ = (PREC << 1) + 2;
goto U_107C;
// 3453 MOD(16): ! INTEGER NAME STORE (<-)
case_MOD_16:;
// 3454 MOD(20): ! BYTE NAME STORE (<-)
case_MOD_20:;
// 3455 MOD(24): ! SHORT NAME STORE (<-)
case_MOD_24:;
// 3456 MOD(17): ! INTEGER NAME STORE (=)
case_MOD_17:;
// 3457 MOD(21): ! BYTE NAME STORE (=)
case_MOD_21:;
// 3458 MOD(25): ! SHORT NAME STORE (=)
case_MOD_25:;
// 3459 MOD(28): !LONG REAL NAME STORE (<-)
case_MOD_28:;
// 3460 MOD(29): !LONG REAL NAME STORE (=)
case_MOD_29:;
// 3461 MOD(18): ! INTEGER NAME FETCH
case_MOD_18:;
// 3462 MOD(22): ! BYTE NAME FETCH
case_MOD_22:;
// 3463 MOD(26): ! SHORT NAME FETCH
case_MOD_26:;
// 3464 MOD(30): !LONG REAL NAME FETCH
case_MOD_30:;
// 3465 RP13=R13; R13=BASE<<12!DISP
RP13 = R13;
R13 = BASE << 12 | DISP;
// 3466 PRX(X'58',LINK,INDEX,BASE,DISP) %UNLESS R13=RP13 %AND INDEX=0
if (R13 != RP13) goto L_043F;
if (INDEX == 0) goto L_0440;
L_043F:;
PRX(88, LINK, INDEX, BASE, DISP);
L_0440:;
// 3467 JJJ=Z; JJJ=1 %IF Z=4
JJJ = Z;
if (Z != 4) goto L_0441;
JJJ = 1;
L_0441:;
// 3468 JJJ=TYPE<<3+PREC<<1-8+JJJ
JJJ = (TYPE << 3) + (PREC << 1) - 8 + JJJ;
// 3469 DUMP(JJJ,REG,0,0,LINK)
DUMP(JJJ, REG, 0, 0, LINK);
// 3470 CHECK CAPACITY(REG,0,0,LINK) %IF Z=1 %AND CHECKS=1
if (Z != 1) goto L_0442;
if (CHECKS != 1) goto L_0442;
CHECKCAPACITY(REG, 0, 0, LINK);
L_0442:;
// 3471 TEST ASS (REG) %IF Z=2 %AND UNASS=1
if (Z != 2) goto L_0443;
if (UNASS != 1) goto L_0443;
TESTASS(REG);
L_0443:;
// 3472 L9: ->L1 %UNLESS ARR=0
U_107B:;
if (ARR == 0) goto L_0444;
goto U_1086;
L_0444:;
// 3473 L91: P=P+1
U_1068:;
P = P + 1;
// 3474 ->L6 %IF A(P)=2
if (A[P + 2] != 2) goto L_0445;
goto U_1065;
L_0445:;
// 3475 FAULT(19)
FAULT(19);
// 3476 L102: SKIP APP; ->L1
U_1066:;
SKIPAPP();
goto U_1086;
// 3477 L6: P=P+1
U_1065:;
P = P + 1;
// 3478 L1: P=P+1; ->L9005 %IF A(P-1)=2
U_1086:;
P = P + 1;
if (A[P - 1 + 2] != 2) goto L_0446;
goto U_1073;
L_0446:;
// 3479 FAULT(69); ->L91
FAULT(69);
goto U_1068;
// 3480 L9005: %END
U_1073:;
return;
case_S_dispatch:
if (S_index < 10 || S_index > 15)
_imp_signalf(6, 3, S_index, "->S(%d) out of bounds at %s line %d", S_index, S_file, S_line);
goto *S[S_index - 10];
case_S_missing:
_imp_signalf(8, 2, S_index, "switch jump to undefined label S(%d): at %s line %d", S_index, S_file, S_line);
case_FUNNY_dispatch:
if (FUNNY_index < 10 || FUNNY_index > 15)
_imp_signalf(6, 3, FUNNY_index, "->FUNNY(%d) out of bounds at %s line %d", FUNNY_index, FUNNY_file, FUNNY_line);
goto *FUNNY[FUNNY_index - 10];
case_FUNNY_missing:
_imp_signalf(8, 2, FUNNY_index, "switch jump to undefined label FUNNY(%d): at %s line %d", FUNNY_index,
FUNNY_file, FUNNY_line);
case_SW_dispatch:
if (SW_index < 0 || SW_index > 8)
_imp_signalf(6, 3, SW_index, "->SW(%d) out of bounds at %s line %d", SW_index, SW_file, SW_line);
goto *SW[SW_index - 0];
case_SW_missing:
_imp_signalf(8, 2, SW_index, "switch jump to undefined label SW(%d): at %s line %d", SW_index, SW_file, SW_line);
case_MOD_dispatch:
if (MOD_index < 0 || MOD_index > 31)
_imp_signalf(6, 3, MOD_index, "->MOD(%d) out of bounds at %s line %d", MOD_index, MOD_file, MOD_line);
goto *MOD[MOD_index - 0];
case_MOD_missing:
_imp_signalf(8, 2, MOD_index, "switch jump to undefined label MOD(%d): at %s line %d", MOD_index, MOD_file,
MOD_line);
} /* end of CNAME */
// 3481 %ROUTINE CRCALL (%INTEGER CLINK)
void CRCALL(int CLINK) {
// 3482 !%SHORTROUTINE
// 3483 %SWITCH FPD(0:3)
int FPD_index;
int FPD_line;
char *FPD_file;
static const void *FPD[4] = {&&case_FPD_missing, &&case_FPD_missing, &&case_FPD_missing, &&case_FPD_missing};
// 3484 %INTEGER KK,II,III,Q,QQ,QQQ,PP,RF
int KK;
int II;
int III;
int Q;
int QQ;
int QQQ;
int PP;
int RF;
auto void MOVEBACK(void);
// 3485 %ROUTINESPEC MOVEBACK
// 3486 %INTEGER MOVED,TOMOVE,TYPEP
int MOVED;
int TOMOVE;
int TYPEP;
// 3487 %SHORTINTEGER LIST; LIST=0
short int LIST;
LIST = 0;
// 3488 FFLAG=0; KK=COUNT APS
FFLAG = 0;
KK = COUNTAPS();
// 3489 P=P+1; ->L2 %IF K=KK
P = P + 1;
if (K != KK) goto L_0447;
goto U_1061;
L_0447:;
// 3490 FAULT(19); PRINTNAME(FNAME)
FAULT(19);
PRINTNAME(FNAME);
// 3491 SKIP APP; P=P-1; ->L99
SKIPAPP();
P = P - 1;
goto U_1062;
// 3492 L2: ->L99 %IF K=0; ! NO PARAMETERS
U_1061:;
if (K != 0) goto L_0448;
goto U_1062;
L_0448:;
// 3493 Q=0; QQ=64; RF=1-FFLAG; ! RF=1 NO NEED TO MOVE WSPR
Q = 0;
QQ = 64;
RF = 1 - FFLAG;
// 3494 MOVED=0; RF=1 %IF KK=1
MOVED = 0;
if (KK != 1) goto L_0449;
RF = 1;
L_0449:;
// 3495 L7: MLINK(CLINK)
U_1063:;
MLINK(/*?*/ &CLINK);
// 3496 FROM1(CLINK,PTYPE)
FROM1(CLINK, /*?*/ &PTYPE);
// 3497 P=P+1; UNPACK
P = P + 1;
UNPACK();
// 3498 II=TYPE; III=PREC; QQQ=P
II = TYPE;
III = PREC;
QQQ = P;
// 3499 PP=(NAM<<1!ARR)&3
PP = (NAM << 1 | ARR) & 3;
// 3500 ->L10 %UNLESS(PP=0 %AND ROUT=0) %OR(A(P)=4 %AND A(P+1)=1)
if (PP != 0) goto L_044A;
if (ROUT == 0) goto L_044B;
L_044A:;
if (A[P + 2] != 4) goto L_044C;
if (A[P + 1 + 2] == 1) goto L_044B;
L_044C:;
goto U_1064;
L_044B:;
// 3501 ->L12 %IF ROUT=1; ->FPD(PP)
if (ROUT != 1) goto L_044D;
goto U_1065;
L_044D:;
FPD_line = __LINE__;
FPD_file = __FILE__;
FPD_index = PP;
goto case_FPD_dispatch;
// 3502 L10: P=QQQ; SKIP EXP;
U_1064:;
P = QQQ;
SKIPEXP();
// 3503 L11: FAULT(22); ->L53
U_1066:;
FAULT(22);
goto U_1067;
// 3504 %COMMENT ROUTINE TYPE PARAMETERS
// 3505 L12: II=PTYPE; P=P+2; CNAME(13,0)
U_1065:;
II = PTYPE;
P = P + 2;
CNAME(13, 0);
// 3506 ->L10 %IF 1000#|PTYPE-II|#0
{
// Double-sided test on _imp_IMOD(PTYPE - II) (Part I)
int tmp;
if (1000 == (tmp = _imp_IMOD(PTYPE - II))) goto L_044F;
// Double-sided test on _imp_IMOD(PTYPE - II) (Part II)
if (tmp == 0) goto L_044F;
}
goto U_1064;
L_044F:;
// 3507 ->L10 %IF A(P)=1; P=P+1
if (A[P + 2] != 1) goto L_0450;
goto U_1064;
L_0450:;
P = P + 1;
// 3508 ->L13 %IF J=14; ! EXTERNAL
if (J != 14) goto L_0451;
goto U_1068;
L_0451:;
// 3509 ->L15 %IF NAM&1#0; ! RT NAME OR RTTYPE
if (NAM & 1 == 0) goto L_0452;
goto U_1069;
L_0452:;
// 3510 DUMP(2,2,DISP,INDEX,BASE); ! PICK UP RT ADDR
DUMP(2, 2, DISP, INDEX, BASE);
// 3511 PRX(X'5A',2,0,GLA,28); ! RELOCATE
PRX(90, 2, 0, GLA, 28);
// 3512 PCONST(X'180C181D'); ! LR 0,12 LR1,13 PERM AND GLA
PCONST(403445789);
// 3513 PUSH(LIST,QQ+12,0); ->L69
PUSH(/*?*/ &LIST, QQ + 12, 0);
goto U_106D;
// 3514 L13: PRX(X'98',0,2,BASE,DISP); ! CODE,GLA,EP
U_1068:;
PRX(152, 0, 2, BASE, DISP);
// 3515 PRR(X'18',3,9); ->L69; ! ANYTHING D W ALIGNED AS ENVRMNT
PRR(24, 3, 9);
goto U_106D;
// 3516 L15: PRX(X'98',0,3,BASE,DISP); ->L69
U_1069:;
PRX(152, 0, 3, BASE, DISP);
goto U_106D;
// 3517 FPD(0): ->L41 %IF PREC=3
case_FPD_0:;
if (PREC != 3) goto L_0453;
goto U_106E;
L_0453:;
// 3518 ->L45 %IF TYPE=5
if (TYPE != 5) goto L_0454;
goto U_106F;
L_0454:;
// 3519 ->L39 %UNLESS UNASS=0 %AND TYPE=1
if (UNASS != 0) goto L_0455;
if (TYPE == 1) goto L_0456;
L_0455:;
goto U_1070;
L_0456:;
// 3520 PP=P; TYPEP=PREC
PP = P;
TYPEP = PREC;
// 3521 II=TSEXP(III)
II = TSEXP(/*?*/ &III);
// 3522 ->L42 %IF II=10 %AND TYPEP=0
if (II != 10) goto L_0457;
if (TYPEP != 0) goto L_0457;
goto U_1071;
L_0457:;
// 3523 ->L43 %IF II=1 %AND TYPEP=1
if (II != 1) goto L_0458;
if (TYPEP != 1) goto L_0458;
goto U_1072;
L_0458:;
// 3524 P=PP; TYPE=1
P = PP;
TYPE = 1;
// 3525 L39: CSEXP(0,TYPE)
U_1070:;
CSEXP(0, TYPE);
// 3526 MOVE BACK
MOVEBACK();
// 3527 DUMP(8*TYPE-7,NEST,QQ-MOVED,0,WSPR)
DUMP(8 * TYPE - 7, NEST, QQ - MOVED, 0, WSPR);
// 3528 CHECK CAPACITY(NEST,QQ-MOVED,0,WSPR) %IF CHECKS=1
if (CHECKS != 1) goto L_0459;
CHECKCAPACITY(NEST, QQ - MOVED, 0, WSPR);
L_0459:;
// 3529 TOMOVE=4;->L50
TOMOVE = 4;
goto U_1073;
// 3530 L42: MOVEBACK
U_1071:;
MOVEBACK();
// 3531 PSS(X'D2',4,WSPR,QQ-MOVED,I,K)
PSS(210, 4, WSPR, QQ - MOVED, I, K);
// 3532 TOMOVE=4; ->L50
TOMOVE = 4;
goto U_1073;
// 3533 L43: MOVEBACK
U_1072:;
MOVEBACK();
// 3534 PSI(X'92',III,WSPR,QQ-MOVED+3)
PSI(146, III, WSPR, QQ - MOVED + 3);
// 3535 TOMOVE=4; ->L50
TOMOVE = 4;
goto U_1073;
// 3536 L41: II=0; II=4 %UNLESS QQ&7=0; !LONG REAL
U_106E:;
II = 0;
if (QQ & 7 == 0) goto L_045A;
II = 4;
L_045A:;
// 3537 CSEXP(0,3)
CSEXP(0, 3);
// 3538 DUMP(15,NEST,QQ-MOVED+II,0,WSPR)
DUMP(15, NEST, QQ - MOVED + II, 0, WSPR);
// 3539 TOMOVE=8+II;->L50
TOMOVE = 8 + II;
goto U_1073;
// 3540 L45: CSTREXP(4); FROM2(CLINK,III)
U_106F:;
CSTREXP(4);
FROM2(CLINK, /*?*/ &III);
// 3541 PRX(X'41',1,0,WSPR,QQ-MOVED+4)
PRX(65, 1, 0, WSPR, QQ - MOVED + 4);
// 3542 STORE STRING(1,4,1,0,III-1)
STORESTRING(1, 4, 1, 0, III - 1);
// 3543 TOMOVE =(III+7)&(-4); ->L50
TOMOVE = III + 7 & (-4);
goto U_1073;
// 3544 FPD(2): ! NAME TYPES INCLUDES RECORDNAME
case_FPD_2:;
// 3545 P=P+2
P = P + 2;
// 3546 %IF TYPE=3 %THEN CNAME(15,1) %ELSE CNAME(3,1)
if (TYPE != 3) goto L_045B;
CNAME(15, 1);
goto L_045C;
L_045B:;
CNAME(3, 1);
L_045C:;
// 3547 ->L10 %IF A(P)=1; P=P+1; ! CHECK NO RESTOF EXPRN
if (A[P + 2] != 1) goto L_045D;
goto U_1064;
L_045D:;
P = P + 1;
// 3548 ->L11 %UNLESS (II=TYPE %AND III=PREC) %OR II=0
if (II != TYPE) goto L_045E;
if (III == PREC) goto L_045F;
L_045E:;
if (II == 0) goto L_045F;
goto U_1066;
L_045F:;
// 3549 MOVE BACK
MOVEBACK();
// 3550 DUMP(1,1,QQ-MOVED,0,WSPR)
DUMP(1, 1, QQ - MOVED, 0, WSPR);
// 3551 TOMOVE=4;->L50 %UNLESS II=0
TOMOVE = 4;
if (II == 0) goto L_0460;
goto U_1073;
L_0460:;
// 3552 FAULT(12) %UNLESS 2>=TYPE
if (2 >= TYPE) goto L_0461;
FAULT(12);
L_0461:;
// 3553 PSI(X'92',PREC<<3!TYPE,WSPR,QQ-MOVED); ->L50;!FLAG FOR %NAME
PSI(146, PREC << 3 | TYPE, WSPR, QQ - MOVED);
goto U_1073;
// 3554 FPD(1):FPD(3): ! ARRAYNAME (+ARRAY VALUE)
case_FPD_1:;
case_FPD_3:;
// 3555 P=P+2; CNAME(12,0); ->L10 %IF A(P)=1; ! REST OF EXPRN
P = P + 2;
CNAME(12, 0);
if (A[P + 2] != 1) goto L_0462;
goto U_1064;
L_0462:;
// 3556 P=P+1
P = P + 1;
// 3557 FROM2(CLINK,PP)
FROM2(CLINK, /*?*/ &PP);
// 3558 %IF PP=0 %THEN %START; REPLACE2(CLINK,J); %FINISH
if (PP != 0) goto L_0463;
REPLACE2(CLINK, J);
L_0463:;
// 3559 FAULT(22) %UNLESS ARR>0 %AND(J=0 %OR PP=0 %OR J=PP)
if (ARR <= 0) goto L_0464;
if (J == 0) goto L_0465;
if (PP == 0) goto L_0465;
if (J == PP) goto L_0465;
L_0464:;
FAULT(22);
L_0465:;
// 3560 FAULT(22) %UNLESS II=0 %OR(TYPE=II %AND III=PREC)
if (II == 0) goto L_0466;
if (TYPE != II) goto L_0467;
if (III == PREC) goto L_0466;
L_0467:;
FAULT(22);
L_0466:;
// 3561 L69: MOVE BACK
U_106D:;
MOVEBACK();
// 3562 PRX(X'90',0,3,WSPR,QQ-MOVED); ! STM
PRX(144, 0, 3, WSPR, QQ - MOVED);
// 3563 TOMOVE=16
TOMOVE = 16;
// 3564 L50: QQ=QQ+TOMOVE
U_1073:;
QQ = QQ + TOMOVE;
// 3565 ->L53 %IF RF=1 %OR Q=KK-1
if (RF == 1) goto L_0468;
if (Q != KK - 1) goto L_0469;
L_0468:;
goto U_1067;
L_0469:;
// 3566 II=(QQ+7)&(-8)-MOVED
II = (QQ + 7 & (-8)) - MOVED;
// 3567 MOVER(WSPR,II); MOVED=MOVED+II
MOVER(WSPR, II);
MOVED = MOVED + II;
// 3568 L53: Q=Q+1; ->L7 %UNLESS Q=KK
U_1067:;
Q = Q + 1;
if (Q == KK) goto L_046A;
goto U_1063;
L_046A:;
// 3569 MOVER(WSPR,-MOVED) %UNLESS RF=1
if (RF == 1) goto L_046B;
MOVER(WSPR, -MOVED);
L_046B:;
// 3570 L55: POP(LIST,Q,QQ); ->L99 %IF Q=-1
U_1074:;
POP(/*?*/ &LIST, /*?*/ &Q, /*?*/ &QQ);
if (Q != -1) goto L_046C;
goto U_1062;
L_046C:;
// 3571 PRX(X'50',WSPR,0,WSPR,Q); ->L55;! POINTER TO SAVE AREA RTTYPES
PRX(80, WSPR, 0, WSPR, Q);
goto U_1074;
// 3572 %ROUTINE MOVEBACK
void MOVEBACK(void) {
// 3573 ->L1 %IF QQ>=MOVED
if (QQ < MOVED) goto L_046D;
goto U_1075;
L_046D:;
// 3574 MOVER(WSPR,QQ-MOVED); MOVED=QQ
MOVER(WSPR, QQ - MOVED);
MOVED = QQ;
// 3575 L1: %END
U_1075:;
return;
} /* end of MOVEBACK */
// 3576 L99: %END
U_1062:;
return;
case_FPD_dispatch:
if (FPD_index < 0 || FPD_index > 3)
_imp_signalf(6, 3, FPD_index, "->FPD(%d) out of bounds at %s line %d", FPD_index, FPD_file, FPD_line);
goto *FPD[FPD_index - 0];
case_FPD_missing:
_imp_signalf(8, 2, FPD_index, "switch jump to undefined label FPD(%d): at %s line %d", FPD_index, FPD_file,
FPD_line);
} /* end of CRCALL */
// 3577 %COMMENT Z=1 FOR= ,4 FOR <- AND MAX LENGTH IN BYTE DEFINED BY BML&DML
// 3578 %ROUTINE STORE STRING(%INTEGER Z,FROM,TO,BML,DML)
void STORESTRING(int Z, int FROM, int TO, int BML, int DML) {
// 3579 !%SHORTROUTINE
// 3580 %COMMENT REGISTER 2 IS ASSUMED TO BE USABLE.
// 3581 FAULT(239) %UNLESS TO=1 %AND FROM=4
if (TO != 1) goto L_046E;
if (FROM == 4) goto L_046F;
L_046E:;
FAULT(239);
L_046F:;
// 3582 ->L10 %IF Z=4
if (Z != 4) goto L_0470;
goto U_1078;
L_0470:;
// 3583 ->L2 %IF CHECKS=0
if (CHECKS != 0) goto L_0471;
goto U_1058;
L_0471:;
// 3584 ->L1 %IF BML>0
if (BML <= 0) goto L_0472;
goto U_1059;
L_0472:;
// 3585 PSI(X'95',DML,FROM,0); ->L3; ! CLI FOR FIXED LENGTH
PSI(149, DML, FROM, 0);
goto U_105A;
// 3586 L1:
U_1059:;
// 3587 PSS(X'D5',1,FROM,0,BML,DML) ;!CLC_ACTUALL(1),MAX
PSS(213, 1, FROM, 0, BML, DML);
// 3588 L3:
U_105A:;
// 3589 PRX(X'47',2,0,CODER,88) ;!BH_FAIL
PRX(71, 2, 0, CODER, 88);
// 3590 L2: PRX(X'43',2,0,FROM,0) ;!IC_2,ACTUALL
U_1058:;
PRX(67, 2, 0, FROM, 0);
// 3591 PRX(X'44',2,0,GLA,STRINST) ;!EX_2,MOVE
PRX(68, 2, 0, GLA, STRINST);
// 3592 ->L99
goto U_105B;
// 3593 L10: PRX(X'43',2,0,BML,DML) ;!IC_2,MAXL
U_1078:;
PRX(67, 2, 0, BML, DML);
// 3594 PPJ(39)
PPJ(39);
// 3595 L99: %END
U_105B:;
return;
} /* end of STORESTRING */
// 3596 %ROUTINE TEST NST
void TESTNST(void) {
// 3597 FNAME=K
FNAME = K;
// 3598 FAULT(7) %UNLESS FIND(FNAME,NAME(LEVEL))=-1
if (FIND(FNAME, NAME[LEVEL]) == -1) goto L_0473;
FAULT(7);
L_0473:;
// 3599 %END
return;
} /* end of TESTNST */
// 3600 %ROUTINE CUCI
void CUCI(void) {
auto void DXB(void);
auto void DLB(void);
auto void DB(void);
auto void CUCS(void);
// 3601 !%SHORTROUTINE
// 3602 %ROUTINESPEC DXB
// 3603 %ROUTINESPEC DLB
// 3604 %ROUTINESPEC DB
// 3605 %ROUTINESPEC CUCS
// 3606 %INTEGER Z,KK,X,OPCODE,REG
int Z;
int KK;
int X;
int OPCODE;
int REG;
// 3607 %SWITCH SW(1:4),S(1:8)
int SW_index;
int SW_line;
char *SW_file;
static const void *SW[4] = {&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing};
int S_index;
int S_line;
char *S_file;
static const void *S[8] = {&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing};
// 3608 P=2; ->SW(A(P))
P = 2;
SW_line = __LINE__;
SW_file = __FILE__;
SW_index = A[P + 2];
goto case_SW_dispatch;
// 3609 SW(1): ! **(N),(@')(NAME)(APP)
case_SW_1:;
// 3610 NEST=A(3); P=5; Z=A(4)-1
NEST = A[5];
P = 5;
Z = A[6] - 1;
// 3611 Z=3 %IF Z=0; CNAME(Z,NEST)
if (Z != 0) goto L_0474;
Z = 3;
L_0474:;
CNAME(Z, NEST);
// 3612 ->L99
goto U_105D;
// 3613 SW(2): PPJ(A(P+1)); ->L99
case_SW_2:;
PPJ(A[P + 1 + 2]);
goto U_105D;
// 3614 SW(4): ! *PUT_CONST
case_SW_4:;
// 3615 ->L401 %IF A(P+1)#9
if (A[P + 1 + 2] == 9) goto L_0475;
goto U_105E;
L_0475:;
// 3616 PLANT(A(P+2)); P=P+3; ->L99
PLANT(A[P + 2 + 2]);
P = P + 3;
goto U_105D;
// 3617 L401: FAULT(32) %UNLESS A(P+1)=1
U_105E:;
if (A[P + 1 + 2] == 1) goto L_0476;
FAULT(32);
L_0476:;
// 3618 PLANT(A(P+3)); ! LEAST SIGNIFICANT 16 BITS ONLY
PLANT(A[P + 3 + 2]);
// 3619 P=P+4; ->L99
P = P + 4;
goto U_105D;
// 3620 SW(3): OPCODE=A(P+2);P=P+3; ->S(A(P-2))
case_SW_3:;
OPCODE = A[P + 2 + 2];
P = P + 3;
S_line = __LINE__;
S_file = __FILE__;
S_index = A[P - 2 + 2];
goto case_S_dispatch;
// 3621 S(1): ->L87 %IF OPCODE=0;
case_S_1:;
if (OPCODE != 0) goto L_0477;
goto U_105F;
L_0477:;
// 3622 PRR(OPCODE,A(P),A(P+1)); P=P+2; ->L99; ! RR
PRR(OPCODE, A[P + 2], A[P + 1 + 2]);
P = P + 2;
goto U_105D;
// 3623 S(2): REG=A(P); P=P+1;DXB; !RX
case_S_2:;
REG = A[P + 2];
P = P + 1;
DXB();
// 3624 L11: PRX(OPCODE,REG,X,I,K);->L99
U_1060:;
PRX(OPCODE, REG, X, I, K);
goto U_105D;
// 3625 S(3): REG=A(P); X=A(P+1);P=P+2; !RS
case_S_3:;
REG = A[P + 2];
X = A[P + 1 + 2];
P = P + 2;
// 3626 DB; ->L11
DB();
goto U_1060;
// 3627 S(4): DB;Z=0;->L41 %IF A(P)=2;Z=A(P+2); !SI
case_S_4:;
DB();
Z = 0;
if (A[P + 2] != 2) goto L_0478;
goto U_1061;
L_0478:;
Z = A[P + 2 + 2];
// 3628 FAULT(32) %UNLESS A(P+1)=9 %AND Z<256
if (A[P + 1 + 2] != 9) goto L_0479;
if (Z < 256) goto L_047A;
L_0479:;
FAULT(32);
L_047A:;
// 3629 P=P+2
P = P + 2;
// 3630 L41: PSI(OPCODE,Z,I,K);P=P+1; ->L99
U_1061:;
PSI(OPCODE, Z, I, K);
P = P + 1;
goto U_105D;
// 3631 S(5): REG=A(P);P=P+1; DB; !SHIFT INSTR.
case_S_5:;
REG = A[P + 2];
P = P + 1;
DB();
// 3632 X=0; ->L11
X = 0;
goto U_1060;
// 3633 S(6): DLB;KK=K;Z=X;REG=I;DB; !SS FORMAT
case_S_6:;
DLB();
KK = K;
Z = X;
REG = I;
DB();
// 3634 Z=1 %IF Z=0
if (Z != 0) goto L_047B;
Z = 1;
L_047B:;
// 3635 L61: PSS(OPCODE,Z,REG,KK,I,K); ->L99
U_1062:;
PSS(OPCODE, Z, REG, KK, I, K);
goto U_105D;
// 3636 S(7): DLB; KK=K; Z=X; REG=I; !PACKED DECIMAL
case_S_7:;
DLB();
KK = K;
Z = X;
REG = I;
// 3637 DLB; Z=1 %IF Z=0
DLB();
if (Z != 0) goto L_047C;
Z = 1;
L_047C:;
// 3638 X=1 %IF X=0
if (X != 0) goto L_047D;
X = 1;
L_047D:;
// 3639 Z=(Z-1)<<4!X; ->L61
Z = Z - 1 << 4 | X;
goto U_1062;
// 3640 S(8): REG=A(P); P=P+1; !FUNNIES
case_S_8:;
REG = A[P + 2];
P = P + 1;
// 3641 ->L85 %IF OPCODE=X'80' ;! IDL
if (OPCODE != 128) goto L_047E;
goto U_1063;
L_047E:;
// 3642 ->L83 %IF OPCODE=10; ! SVC
if (OPCODE != 10) goto L_047F;
goto U_1064;
L_047F:;
// 3643 PRR(OPCODE,REG,0);->L99
PRR(OPCODE, REG, 0);
goto U_105D;
// 3644 L83: PLANT(X'A00'!REG); ->L99
U_1064:;
PLANT(2560 | REG);
goto U_105D;
// 3645 L85: PSI(OPCODE,REG,0,0); ->L99
U_1063:;
PSI(OPCODE, REG, 0, 0);
goto U_105D;
// 3646 L87: CNOP(A(P),A(P+1)); ->L99
U_105F:;
CNOP(A[P + 2], A[P + 1 + 2]);
goto U_105D;
// 3647 %ROUTINE DB
void DB(void) {
// 3648 ->L2 %IF A(P)=1
if (A[P + 2] != 1) goto L_0480;
goto U_1065;
L_0480:;
// 3649 K=A(P+1); I=0; P=P+3
K = A[P + 1 + 2];
I = 0;
P = P + 3;
// 3650 ->L99 %IF A(P-1)=2
if (A[P - 1 + 2] != 2) goto L_0481;
goto U_1066;
L_0481:;
// 3651 I=A(P);P=P+1;->L99
I = A[P + 2];
P = P + 1;
goto U_1066;
// 3652 L2: CUCS
U_1065:;
CUCS();
// 3653 L99: %END
U_1066:;
return;
} /* end of DB */
// 3654 %ROUTINE DXB
void DXB(void) {
// 3655 %SWITCH SW(1:3)
int SW_index;
int SW_line;
char *SW_file;
static const void *SW[3] = {&&case_SW_missing, &&case_SW_missing, &&case_SW_missing};
// 3656 ->L2 %IF A(P)=2
if (A[P + 2] != 2) goto L_0482;
goto U_1066;
L_0482:;
// 3657 CUCS;X=0;P=P+1
CUCS();
X = 0;
P = P + 1;
// 3658 ->L99 %IF A(P-1)=2
if (A[P - 1 + 2] != 2) goto L_0483;
goto U_1067;
L_0483:;
// 3659 X=A(P);P=P+1; ->L99
X = A[P + 2];
P = P + 1;
goto U_1067;
// 3660 L2: K=A(P+1);P=P+2;I=0;X=0
U_1066:;
K = A[P + 1 + 2];
P = P + 2;
I = 0;
X = 0;
// 3661 ->SW(A(P))
SW_line = __LINE__;
SW_file = __FILE__;
SW_index = A[P + 2];
goto case_SW_dispatch;
// 3662 SW(1): X=A(P+1);P=P+1
case_SW_1:;
X = A[P + 1 + 2];
P = P + 1;
// 3663 SW(2): I=A(P+1);P=P+1
case_SW_2:;
I = A[P + 1 + 2];
P = P + 1;
// 3664 SW(3): P=P+1
case_SW_3:;
P = P + 1;
// 3665 L99: %END
U_1067:;
return;
case_SW_dispatch:
if (SW_index < 1 || SW_index > 3)
_imp_signalf(6, 3, SW_index, "->SW(%d) out of bounds at %s line %d", SW_index, SW_file, SW_line);
goto *SW[SW_index - 1];
case_SW_missing:
_imp_signalf(8, 2, SW_index, "switch jump to undefined label SW(%d): at %s line %d", SW_index, SW_file,
SW_line);
} /* end of DXB */
// 3666 %ROUTINE DLB
void DLB(void) {
// 3667 ->L2 %IF A(P)=2
if (A[P + 2] != 2) goto L_0485;
goto U_1065;
L_0485:;
// 3668 K=A(P+1); X=A(P+2); I=A(P+3); P=P+4; ->L99
K = A[P + 1 + 2];
X = A[P + 2 + 2];
I = A[P + 3 + 2];
P = P + 4;
goto U_1066;
// 3669 L2: CUCS; X=A(P); P=P+1
U_1065:;
CUCS();
X = A[P + 2];
P = P + 1;
// 3670 L99: %END
U_1066:;
return;
} /* end of DLB */
// 3671 %ROUTINE CUCS
void CUCS(void) {
// 3672 %SWITCH UTYPE(0:8)
int UTYPE_index;
int UTYPE_line;
char *UTYPE_file;
static const void *UTYPE[9] = {&&case_UTYPE_0, &&case_UTYPE_1, &&case_UTYPE_2, &&case_UTYPE_3, &&case_UTYPE_4,
&&case_UTYPE_5, &&case_UTYPE_6, &&case_UTYPE_7, &&case_UTYPE_8};
// 3673 P=P+1
P = P + 1;
// 3674 ->L10 %IF A(P)=2
if (A[P + 2] != 2) goto L_0486;
goto U_1066;
L_0486:;
// 3675 FNAME=A(P+1); COPYTAG(FNAME)
FNAME = A[P + 1 + 2];
COPYTAG(FNAME);
// 3676 P=P+3; ->L1 %UNLESS I=-1
P = P + 3;
if (I == -1) goto L_0487;
goto U_1067;
L_0487:;
// 3677 FAULT(16); J=0; I=LEVEL; PTYPE=7; UNPACK
FAULT(16);
J = 0;
I = LEVEL;
PTYPE = 7;
UNPACK();
// 3678 STORE TAG(FNAME,N);K=N;N=N+4
STORETAG(FNAME, N);
K = N;
N = N + 4;
// 3679 L1: FAULT(33) %IF ROUT=1; ->UTYPE(TYPE)
U_1067:;
if (ROUT != 1) goto L_0488;
FAULT(33);
L_0488:;
UTYPE_line = __LINE__;
UTYPE_file = __FILE__;
UTYPE_index = TYPE;
goto case_UTYPE_dispatch;
// 3680 UTYPE(3): FROM2(K,K); ->L9; ! RECORDS
case_UTYPE_3:;
FROM2(K, /*?*/ &K);
goto U_1068;
// 3681 UTYPE(4): FROM1(K,K); ->L9; ! FORMATS
case_UTYPE_4:;
FROM1(K, /*?*/ &K);
goto U_1068;
// 3682 UTYPE(8):FAULT(33); ->L9
case_UTYPE_8:;
FAULT(33);
goto U_1068;
// 3683 UTYPE(6): FROM1(K,K); ! SWITCHES
case_UTYPE_6:;
FROM1(K, /*?*/ &K);
// 3684 K=K-CODEBASE(OLDI); FAULT(99) %IF K>4095
K = K - CODEBASE[OLDI];
if (K <= 4095) goto L_0489;
FAULT(99);
L_0489:;
// 3685 I=10
I = 10;
// 3686 UTYPE(0):UTYPE(1):UTYPE(2):UTYPE(5):UTYPE(7):
case_UTYPE_0:;
case_UTYPE_1:;
case_UTYPE_2:;
case_UTYPE_5:;
case_UTYPE_7:;
// 3687 ->L9 %UNLESS ARR=2; ! VECTOR
if (ARR == 2) goto L_048A;
goto U_1068;
L_048A:;
// 3688 FROM2(K,K); ! EXTRACT DISPLACEMENT
FROM2(K, /*?*/ &K);
// 3689 L9: ->L99 %IF A(P-1)=2
U_1068:;
if (A[P - 1 + 2] != 2) goto L_048B;
goto U_1069;
L_048B:;
// 3690 K=K+A(P); P=P+1; ->L99
K = K + A[P + 2];
P = P + 1;
goto U_1069;
// 3691 L10: K=A(P+2)+(A(P+1)-1)<<14
U_1066:;
K = A[P + 2 + 2] + (A[P + 1 + 2] - 1 << 14);
// 3692 J=FIND(K,LABEL(LEVEL))
J = FIND(K, LABEL[LEVEL]);
// 3693 ->L25 %IF J=-1
if (J != -1) goto L_048C;
goto U_106D;
L_048C:;
// 3694 K=J-CODEBASE(LEVEL); I=10
K = J - CODEBASE[LEVEL];
I = 10;
// 3695 FAULT(99) %IF K>4095; P=P+3; ->L99
if (K <= 4095) goto L_048D;
FAULT(99);
L_048D:;
P = P + 3;
goto U_1069;
// 3696 L25: PUSH(JUMP(LEVEL),CA!LABSET,K)
U_106D:;
PUSH(/*?*/ &JUMP[LEVEL], CA | LABSET, K);
// 3697 K=0; I=0; P=P+3
K = 0;
I = 0;
P = P + 3;
// 3698 L99: %END
U_1069:;
return;
case_UTYPE_dispatch:
if (UTYPE_index < 0 || UTYPE_index > 8)
_imp_signalf(6, 3, UTYPE_index, "->UTYPE(%d) out of bounds at %s line %d", UTYPE_index, UTYPE_file,
UTYPE_line);
goto *UTYPE[UTYPE_index - 0];
} /* end of CUCS */
// 3699 L99: %END
U_105D:;
return;
case_SW_dispatch:
if (SW_index < 1 || SW_index > 4)
_imp_signalf(6, 3, SW_index, "->SW(%d) out of bounds at %s line %d", SW_index, SW_file, SW_line);
goto *SW[SW_index - 1];
case_SW_missing:
_imp_signalf(8, 2, SW_index, "switch jump to undefined label SW(%d): at %s line %d", SW_index, SW_file, SW_line);
case_S_dispatch:
if (S_index < 1 || S_index > 8)
_imp_signalf(6, 3, S_index, "->S(%d) out of bounds at %s line %d", S_index, S_file, S_line);
goto *S[S_index - 1];
case_S_missing:
_imp_signalf(8, 2, S_index, "switch jump to undefined label S(%d): at %s line %d", S_index, S_file, S_line);
} /* end of CUCI */
// 3700 %ROUTINE TEST ASS(%INTEGER REG)
void TESTASS(int REG) {
// 3701 !%SHORTROUTINE
// 3702 %INTEGER J
int J;
// 3703 %RETURN %UNLESS 1<=TYPE<=2
{
// Double-sided test on TYPE (Part I)
unsigned char tmp;
if (1 > (tmp = TYPE)) goto L_048E;
// Double-sided test on TYPE (Part II)
if (tmp <= 2) goto L_048F;
}
L_048E:;
return;
L_048F:;
// 3704 ->L5 %IF TYPE=1
if (TYPE != 1) goto L_0490;
goto U_106B;
L_0490:;
// 3705 J=X'79'; J=X'69' %IF PREC=3
J = 121;
if (PREC != 3) goto L_0491;
J = 105;
L_0491:;
// 3706 L3: PRX(J,REG,0,GLA,128)
U_106C:;
PRX(J, REG, 0, GLA, 128);
// 3707 PRX(X'47',8,0,CODER,40); ->L99
PRX(71, 8, 0, CODER, 40);
goto U_1079;
// 3708 L5: ->L99 %UNLESS PREC=0
U_106B:;
if (PREC == 0) goto L_0492;
goto U_1079;
L_0492:;
// 3709 J=X'59'; ->L3
J = 89;
goto U_106C;
// 3710 L99: %END
U_1079:;
return;
} /* end of TESTASS */
// 3711 %ROUTINE GXREF(%INTEGER NAME,HASH)
void GXREF(int NAME, int HASH) {
// 3712 !%SHORTROUTINE
// 3713 %INTEGER I,J,K,N,NP
int I;
int J;
int K;
int N;
int NP;
// 3714 I=N0; N0=N0+7; J=WORD(NAME)
I = N0;
N0 = N0 + 7;
J = WORD[NAME];
// 3715 ST(I+1)=0; ST(I+2)=0; ST(I+3)=0
ST[I + 1] = 0;
ST[I + 2] = 0;
ST[I + 3] = 0;
// 3716 N=LETT(J); NP=N; NP=8 %IF NP>8
N = LETT[J];
NP = N;
if (NP <= 8) goto L_0493;
NP = 8;
L_0493:;
// 3717 K=ADDR(ST(I+5)); ->L1 %IF HASH=0
K = _imp_ADDR(/*?*/ &ST[I + 5]);
if (HASH != 0) goto L_0494;
goto U_1059;
L_0494:;
// 3718 ST(I+5)=HASH<<16!'#'<<8
ST[I + 5] = HASH << 16 | 35 << 8;
// 3719 K=K+2; N=N+2
K = K + 2;
N = N + 2;
// 3720 NP=6 %IF NP>6
if (NP <= 6) goto L_0495;
NP = 6;
L_0495:;
// 3721 L1: %CYCLE NP=1,1,NP
U_1059:;
// %for NP = 1, 1, NP %cycle
{
int _final = NP;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle NP = 1, 1, NP");
NP = 0;
L_0496:
if (NP == _final) goto L_0497;
NP += 1;
// 3722 BYTEINTEGER(K+NP)=LETT(J+NP); %REPEAT
*_imp_BYTEINTEGER(K + NP) = LETT[J + NP];
goto L_0496;
}
L_0497:;
// 3723 N=8 %IF N>8; ST(I+4)=X'80000000'; ! MARK NEW FORMAT
if (N <= 8) goto L_0499;
N = 8;
L_0499:;
ST[I + 4] = -2147483648;
// 3724 ST(I)=XREFLINK; XREFLINK=I<<2; ! LINK IN REFERENCE
ST[I] = XREFLINK;
XREFLINK = I << 2;
// 3725 BYTE INTEGER(ADDR(ST(I+5)))=N
*_imp_BYTEINTEGER(_imp_ADDR(/*?*/ &ST[I + 5])) = N;
// 3726 N0=N0+1 %IF N=8
if (N != 8) goto L_049A;
N0 = N0 + 1;
L_049A:;
// 3727 %END
return;
} /* end of GXREF */
// 3728 %ROUTINE UNDCRF (%SHORTINTEGERNAME OPHEAD) ; ! Care needed with short conversion!
void UNDCRF(short int *OPHEAD) {
// 3729 %INTEGER I,J
int I;
int J;
// 3730 %SHORTINTEGER OP
short int OP;
// 3731 %COMMENT UNSCRAMBLES RECORD FORMAT TAGS LIST & SIDECHAIN
// 3732 POP (OPHEAD,I,J); ! LST ITEM IS DESPMENT
POP(OPHEAD, /*?*/ &I, /*?*/ &J);
// 3733 L1: POP (OPHEAD,I,J)
U_1079:;
POP(OPHEAD, /*?*/ &I, /*?*/ &J);
// 3734 ->L9 %IF I=-1
if (I != -1) goto L_049B;
goto U_1078;
L_049B:;
// 3735 OP=J;PTYPE=I>>4&X'FFFF';UNPACK
OP = J;
PTYPE = (unsigned int)I >> 4 & 65535;
UNPACK();
// 3736 %IF ROUT=1 %OR TYPE=3 %THEN CLEAR LIST(OP)
if (ROUT == 1) goto L_0498;
if (TYPE != 3) goto L_049C;
L_0498:;
CLEARLIST(/*?*/ &OP);
L_049C:;
// 3737 ->L1
goto U_1079;
// 3738 L9: %END
U_1078:;
return;
} /* end of UNDCRF */
// 3739 %ROUTINE CLT
void CLT(void) {
// 3740 !%SHORTROUTINE
// 3741 %COMMENT P ON PHRASE TYPE AT ENTRY - TO NEXT PHRASE AT EXIT
// 3742 TYPE=TYPEFLAG(A(P))
TYPE = TYPEFLAG[A[P + 2] - 1];
// 3743 PREC=TYPE>>3; TYPE=TYPE&7
PREC = (unsigned int)TYPE >> 3;
TYPE = TYPE & 7;
// 3744 PREC=3 %IF TYPE=2 %AND ALL LONG#0
if (TYPE != 2) goto L_049D;
if (ALLLONG == 0) goto L_049D;
PREC = 3;
L_049D:;
// 3745 ACC=BYTES(PREC);P=P+1
ACC = BYTES[PREC];
P = P + 1;
// 3746 ->L99 %UNLESS TYPE=5
if (TYPE == 5) goto L_049E;
goto U_1057;
L_049E:;
// 3747 ->L2 %UNLESS A(P)=2
if (A[P + 2] == 2) goto L_049F;
goto U_106A;
L_049F:;
// 3748 ACC=0; P=P+1; ->L99
ACC = 0;
P = P + 1;
goto U_1057;
// 3749 L1: P=P+1;FAULT(70);->L99
U_106B:;
P = P + 1;
FAULT(70);
goto U_1057;
// 3750 L2: P=P+1;ACC=A(P)+1
U_106A:;
P = P + 1;
ACC = A[P + 2] + 1;
// 3751 ->L1 %UNLESS 2<=ACC<=256
{
// Double-sided test on ACC (Part I)
int tmp;
if (2 > (tmp = ACC)) goto L_04A0;
// Double-sided test on ACC (Part II)
if (tmp <= 256) goto L_04A1;
}
L_04A0:;
goto U_106B;
L_04A1:;
// 3752 P=P+1
P = P + 1;
// 3753 L99: %END
U_1057:;
return;
} /* end of CLT */
// 3754 %ROUTINE CQN(%INTEGER P)
void CQN(int P) {
// 3755 !%SHORTROUTINE
// 3756 %BYTEINTEGER I
unsigned char I;
// 3757 I=A(P);NAM=0;ARR=0
I = A[P + 2];
NAM = 0;
ARR = 0;
// 3758 NAM=2 %IF I=1 ;ARR=1 %IF I<=2
if (I != 1) goto L_04A2;
NAM = 2;
L_04A2:;
if (I > 2) goto L_04A3;
ARR = 1;
L_04A3:;
// 3759 NAM=NAM!1 %IF I<=3;ACC=16 %IF ARR=1
if (I > 3) goto L_04A4;
NAM = NAM | 1;
L_04A4:;
if (ARR != 1) goto L_04A5;
ACC = 16;
L_04A5:;
// 3760 ACC=4 %IF I=3
if (I != 3) goto L_04A6;
ACC = 4;
L_04A6:;
// 3761 %END
return;
} /* end of CQN */
// 3762 %ROUTINE SKIP EXP
void SKIPEXP(void) {
// 3763 !%SHORTROUTINE
// 3764 %SWITCH SW(1:4);%INTEGER J
int SW_index;
int SW_line;
char *SW_file;
static const void *SW[4] = {&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing};
int J;
// 3765 %OWNINTEGER RT=10000
static int RT = 10000;
// 3766 L3: P=P+1; ->SW(A(P)); ! SWITCH ON OPERAND
U_106C:;
P = P + 1;
SW_line = __LINE__;
SW_file = __FILE__;
SW_index = A[P + 2];
goto case_SW_dispatch;
// 3767 SW(1): P=P+2; ! OPERAND = NAME
case_SW_1:;
P = P + 2;
// 3768 J=ADDR(ASLIST(TAGS(A(P-1))))
J = _imp_ADDR(/*?*/ &ASLIST[TAGS[A[P - 1 + 2]]]);
// 3769 ->L5 %IF SHORT INTEGER(J)<RT; FFLAG=1
if (*_imp_SHORTINTEGER(J) >= RT) goto L_04A7;
goto U_1079;
L_04A7:;
FFLAG = 1;
// 3770 L5: SKIP APP; P=P+1
U_1079:;
SKIPAPP();
P = P + 1;
// 3771 ->L1 %IF A(P-1)=2; P=P+1; ->L5
if (A[P - 1 + 2] != 2) goto L_04A8;
goto U_1078;
L_04A8:;
P = P + 1;
goto U_1079;
// 3772 SW(2): ! CONST
case_SW_2:;
// 3773 P=P+1; J=A(P)
P = P + 1;
J = A[P + 2];
// 3774 %IF J=9 %THEN %START; P=P+2; ->L1; %FINISH
if (J != 9) goto L_04A9;
P = P + 2;
goto U_1078;
L_04A9:;
// 3775 %IF J=1 %THEN %START; P=P+3; ->L1; %FINISH
if (J != 1) goto L_04AA;
P = P + 3;
goto U_1078;
L_04AA:;
// 3776 %IF J=2 %THEN %START; P=P+5; ->L1; %FINISH
if (J != 2) goto L_04AB;
P = P + 5;
goto U_1078;
L_04AB:;
// 3777 P=P+A(P+1)&X'FE'+3; ->L1
P = P + (A[P + 1 + 2] & 254) + 3;
goto U_1078;
// 3778 SW(3):SW(4): P=P+1; SKIP EXP
case_SW_3:;
case_SW_4:;
P = P + 1;
SKIPEXP();
// 3779 L1: P=P+1; ->L3 %IF A(P-1)=1
U_1078:;
P = P + 1;
if (A[P - 1 + 2] != 1) goto L_04AC;
goto U_106C;
L_04AC:;
// 3780 %END
return;
case_SW_dispatch:
if (SW_index < 1 || SW_index > 4)
_imp_signalf(6, 3, SW_index, "->SW(%d) out of bounds at %s line %d", SW_index, SW_file, SW_line);
goto *SW[SW_index - 1];
case_SW_missing:
_imp_signalf(8, 2, SW_index, "switch jump to undefined label SW(%d): at %s line %d", SW_index, SW_file, SW_line);
} /* end of SKIPEXP */
// 3781 %ROUTINE SKIP APP; ! SKIPS ACTUAL PARAMETER PART
void SKIPAPP(void) {
// 3782 L5: P=P+1; ->L1 %IF A(P-1)=2; SKIP EXP; ->L5
U_1057:;
P = P + 1;
if (A[P - 1 + 2] != 2) goto L_04AD;
goto U_106A;
L_04AD:;
SKIPEXP();
goto U_1057;
// 3783 L1: %END
U_106A:;
return;
} /* end of SKIPAPP */
// 3784 %ROUTINE CQUERY(%INTEGER REG)
void CQUERY(int REG) {
// 3785 !%SHORTROUTINE
// 3786 PSI(X'95',0,GLA,1); ! CLI 1(GLA),0
PSI(149, 0, GLA, 1);
// 3787 PJ(8,PLABEL-1); ! JUMP ROUND IF QUERIES OFF
PJ(8, PLABEL - 1);
// 3788 ->L1 %IF TYPE=2
if (TYPE != 2) goto L_04AE;
goto U_106A;
L_04AE:;
// 3789 ->L5 %IF TYPE=5
if (TYPE != 5) goto L_04AF;
goto U_106B;
L_04AF:;
// 3790 PRR(X'18',1,REG) %UNLESS REG=1; ! LR 1,REG
if (REG == 1) goto L_04B0;
PRR(24, 1, REG);
L_04B0:;
// 3791 PCONST(X'4120000B'); ! LA 2,11
PCONST(1092616203);
// 3792 PPJ(4); ->L9; ! TO WRITE
PPJ(4);
goto U_106C;
// 3793 L1: PCONST(X'41100020'); PPJ(3); ! OUTPUT SPACE
U_106A:;
PCONST(1091567648);
PPJ(3);
// 3794 %IF QPREAL=0 %THEN %START
if (QPREAL != 0) goto L_04B1;
// 3795 QPREAL=N0<<2+4
QPREAL = (N0 << 2) + 4;
// 3796 ST(N0)=XREFLINK; XREFLINK=QPREAL-4
ST[N0] = XREFLINK;
XREFLINK = QPREAL - 4;
// 3797 ST(N0+4)=8; ST(N0+5)=M'I#PR'; ST(N0+6)=M'INTF'
ST[N0 + 4] = 8;
ST[N0 + 5] = 1227051090;
ST[N0 + 6] = 1229870150;
// 3798 !! ^^^^^^ ^^^^^^^ WARNING! Endianness
// 3799 N0=N0+7; %FINISH
N0 = N0 + 7;
L_04B1:;
// 3800 PACLOD(82,1,REG<<4)
PACLOD(82, 1, REG << 4);
// 3801 %COMMENT STD REG,64(11).LA 0,12.ST 0,68(11) %ABD SS ENTRYPRINTF
// 3802 PACLOD(55,4,QPREAL); ->L9
PACLOD(55, 4, QPREAL);
goto U_106C;
// 3803 L5: PCONST(X'4110000A'); PPJ(3); ! NEWLINE
U_106B:;
PCONST(1091567626);
PPJ(3);
// 3804 PRR(X'18',1,REG); PPJ(5)
PRR(24, 1, REG);
PPJ(5);
// 3805 L9: PLAB(-1)
U_106C:;
PLAB(-1);
// 3806 %END
return;
} /* end of CQUERY */
// 3807 %ROUTINE LOADAD(%INTEGER REG,BASE,X,DISP)
void LOADAD(int REG, int BASE, int X, int DISP) {
// 3808 !%SHORTROUTINE
// 3809 ! LOADS ADDRESS & DEALS CORRECTLY WITH DISP>4095
// 3810 %INTEGER I
int I;
// 3811 PRX(X'41',REG,X,BASE,DISP&4095)
PRX(65, REG, X, BASE, DISP & 4095);
// 3812 I=PAGENO(DISP)
I = PAGENO(DISP);
// 3813 PRX(X'5A',REG,0,GLA,4*I)%UNLESS 4095>=DISP
if (4095 >= DISP) goto L_04B2;
PRX(90, REG, 0, GLA, 4 * I);
L_04B2:;
// 3814 %END
return;
} /* end of LOADAD */
// 3815 %INTEGERFN TSEXP(%INTEGERNAME CODE)
int TSEXP(int *CODE) {
// 3816 !%SHORTROUTINE
// 3817 %SWITCH SW(1:4)
int SW_index;
int SW_line;
char *SW_file;
static const void *SW[4] = {&&case_SW_missing, &&case_SW_missing, &&case_SW_missing, &&case_SW_missing};
// 3818 TYPE=1
TYPE = 1;
// 3819 ->L9 %IF 1#A(P)#4; ->SW(A(P+1))
{
// Double-sided test on A[P + 2] (Part I)
short int tmp;
if (1 == (tmp = A[P + 2])) goto L_04B3;
// Double-sided test on A[P + 2] (Part II)
if (tmp == 4) goto L_04B3;
}
goto U_106B;
L_04B3:;
SW_line = __LINE__;
SW_file = __FILE__;
SW_index = A[P + 1 + 2];
goto case_SW_dispatch;
// 3820 SW(1): CODE=A(P+2); COPYTAG(CODE)
case_SW_1:;
*CODE = A[P + 2 + 2];
COPYTAG(*CODE);
// 3821 %IF PTYPE=10006 %THEN %START
if (PTYPE != 10006) goto L_04B4;
// 3822 TYPE=TSNAME(K);PREC=TYPE>>3
TYPE = TSNAME[K];
PREC = (unsigned int)TYPE >> 3;
// 3823 TYPE=TYPE&7; %FINISH
TYPE = TYPE & 7;
L_04B4:;
// 3824 ->L40 %IF TYPE=8; !REGISTER VARIABLE
if (TYPE != 8) goto L_04B5;
goto U_106C;
L_04B5:;
// 3825 ->L30 %IF TYPE=3 %AND ARR=0 %AND INREG#0
if (TYPE != 3) goto L_04B6;
if (ARR != 0) goto L_04B6;
if (INREG == 0) goto L_04B6;
goto U_1079;
L_04B6:;
// 3826 ->L50 %IF ARR=2 %AND TYPE=1
if (ARR != 2) goto L_04B7;
if (TYPE != 1) goto L_04B7;
goto U_1078;
L_04B7:;
// 3827 ->L9 %UNLESS A(P+3)=2 =A(P+4); ! NO APP OR ENAME
{
// Double-sided test on 2 (Part I)
int tmp;
if (A[P + 3 + 2] != (tmp = 2)) goto L_04B8;
// Double-sided test on 2 (Part II)
if (tmp == A[P + 4 + 2]) goto L_04B9;
}
L_04B8:;
goto U_106B;
L_04B9:;
// 3828 ->L9 %UNLESS ROUT=0 %AND ARR=0
if (ROUT != 0) goto L_04BA;
if (ARR == 0) goto L_04BB;
L_04BA:;
goto U_106B;
L_04BB:;
// 3829 ->L20 %IF TYPE=5
if (TYPE != 5) goto L_04BC;
goto U_1058;
L_04BC:;
// 3830 ->L9 %UNLESS NAM=0
if (NAM == 0) goto L_04BD;
goto U_106B;
L_04BD:;
// 3831 ->L14 %IF TYPE=2
if (TYPE != 2) goto L_04BE;
goto U_1059;
L_04BE:;
// 3832 ->L9 %UNLESS TYPE=1
if (TYPE == 1) goto L_04BF;
goto U_106B;
L_04BF:;
// 3833 ->L11 %IF A(P+5)=2; ! NO RST OF EXPS
if (A[P + 5 + 2] != 2) goto L_04C0;
goto U_105A;
L_04C0:;
// 3834 ->L9 %UNLESS A(P+6)=2=A(P+7)
{
// Double-sided test on 2 (Part I)
int tmp;
if (A[P + 6 + 2] != (tmp = 2)) goto L_04C1;
// Double-sided test on 2 (Part II)
if (tmp == A[P + 7 + 2]) goto L_04C2;
}
L_04C1:;
goto U_106B;
L_04C2:;
// 3835 ->L9 %UNLESS A(P+8)=9 %AND A(P+10)=2
if (A[P + 8 + 2] != 9) goto L_04C3;
if (A[P + 10 + 2] == 2) goto L_04C4;
L_04C3:;
goto U_106B;
L_04C4:;
// 3836 CODE=A(P+9); P=P+11; %RESULT=100
*CODE = A[P + 9 + 2];
P = P + 11;
return 100;
// 3837 L11: P=P+6; %RESULT=10+PREC
U_105A:;
P = P + 6;
return 10 + PREC;
// 3838 L14: ->L9 %UNLESS A(P+5)=2; !NO NOT OF EXPRN
U_1059:;
if (A[P + 5 + 2] == 2) goto L_04C5;
goto U_106B;
L_04C5:;
// 3839 P=P+6; %RESULT=14+PREC&1
P = P + 6;
return 14 + (PREC & 1);
// 3840 L20: ->L9 %UNLESS A(P+5)=2
U_1058:;
if (A[P + 5 + 2] == 2) goto L_04C6;
goto U_106B;
L_04C6:;
// 3841 P=P+6; %RESULT=20
P = P + 6;
return 20;
// 3842 L30: ->L9 %UNLESS A(P+3)=2 %AND A(P+4)=1; ! NO APP BUT ENAME
U_1079:;
if (A[P + 3 + 2] != 2) goto L_04C7;
if (A[P + 4 + 2] == 1) goto L_04C8;
L_04C7:;
goto U_106B;
L_04C8:;
// 3843 P=P+5; FROM1(K,FNAME); I=INREG
P = P + 5;
FROM1(K, /*?*/ &FNAME);
I = INREG;
// 3844 K=DISPLACEMENT(FNAME); UNPACK
K = DISPLACEMENT(FNAME);
UNPACK();
// 3845 ->L9 %IF I=-1 %OR ARR#0 %OR ROUT#0
if (I == -1) goto L_04C9;
if (ARR != 0) goto L_04C9;
if (ROUT == 0) goto L_04CA;
L_04C9:;
goto U_106B;
L_04CA:;
// 3846 ->L9 %UNLESS 1<=TYPE<=2 %AND A(P+1)=2=A(P+2)
{
// Double-sided test on TYPE (Part I)
unsigned char tmp;
if (1 > (tmp = TYPE)) goto L_04CB;
// Double-sided test on TYPE (Part II)
if (tmp > 2) goto L_04CB;
}
{
// Double-sided test on 2 (Part I)
int tmp;
if (A[P + 1 + 2] != (tmp = 2)) goto L_04CB;
// Double-sided test on 2 (Part II)
if (tmp == A[P + 2 + 2]) goto L_04CC;
}
L_04CB:;
goto U_106B;
L_04CC:;
// 3847 ->L9 %UNLESS A(P+3)=2; ! NO REST OF EXPRN
if (A[P + 3 + 2] == 2) goto L_04CD;
goto U_106B;
L_04CD:;
// 3848 P=P-2; ->L11 %IF TYPE=1; ->L14
P = P - 2;
if (TYPE != 1) goto L_04CE;
goto U_105A;
L_04CE:;
goto U_1059;
// 3849 L40: ->L41 %IF A(P+5)=2; !NO REST OF EXP
U_106C:;
if (A[P + 5 + 2] != 2) goto L_04CF;
goto U_105B;
L_04CF:;
// 3850 ->L9 %UNLESS A(P+6)=2=A(P+7)
{
// Double-sided test on 2 (Part I)
int tmp;
if (A[P + 6 + 2] != (tmp = 2)) goto L_04D0;
// Double-sided test on 2 (Part II)
if (tmp == A[P + 7 + 2]) goto L_04D1;
}
L_04D0:;
goto U_106B;
L_04D1:;
// 3851 ->L9 %UNLESS A(P+8)=9 %AND A(P+10)=2
if (A[P + 8 + 2] != 9) goto L_04D2;
if (A[P + 10 + 2] == 2) goto L_04D3;
L_04D2:;
goto U_106B;
L_04D3:;
// 3852 CODE=A(P+9);P=P+11; %RESULT=101
*CODE = A[P + 9 + 2];
P = P + 11;
return 101;
// 3853 L41: P=P+6; %RESULT=50
U_105B:;
P = P + 6;
return 50;
// 3854 L50: ->L9 %UNLESS A(P+3)=1 %AND A(P+4)=4 %AND A(P+5)=2
U_1078:;
if (A[P + 3 + 2] != 1) goto L_04D4;
if (A[P + 4 + 2] != 4) goto L_04D4;
if (A[P + 5 + 2] == 2) goto L_04D5;
L_04D4:;
goto U_106B;
L_04D5:;
// 3855 ->L9 %UNLESS A(P+6)=9 %AND A(P+7)<256 %AND A(P+8)=2
if (A[P + 6 + 2] != 9) goto L_04D6;
if (A[P + 7 + 2] >= 256) goto L_04D6;
if (A[P + 8 + 2] == 2) goto L_04D7;
L_04D6:;
goto U_106B;
L_04D7:;
// 3856 ->L9 %UNLESS A(P+9)=2 %AND A(P+10)=2 %AND A(P+11)=2
if (A[P + 9 + 2] != 2) goto L_04D8;
if (A[P + 10 + 2] != 2) goto L_04D8;
if (A[P + 11 + 2] == 2) goto L_04D9;
L_04D8:;
goto U_106B;
L_04D9:;
// 3857 FROM1(K,K); K=K+A(P+7)*BYTES(PREC)
FROM1(K, /*?*/ &K);
K = K + A[P + 7 + 2] * BYTES[PREC];
// 3858 ->L9 %UNLESS 0<=K<4096
{
// Double-sided test on K (Part I)
int tmp;
if (0 > (tmp = K)) goto L_04DA;
// Double-sided test on K (Part II)
if (tmp < 4096) goto L_04DB;
}
L_04DA:;
goto U_106B;
L_04DB:;
// 3859 P=P+12; %RESULT=10+PREC
P = P + 12;
return 10 + PREC;
// 3860 SW(2): TYPE=A(P+2)&7
case_SW_2:;
TYPE = A[P + 2 + 2] & 7;
// 3861 ->L9 %UNLESS A(P+2)=9
if (A[P + 2 + 2] == 9) goto L_04DC;
goto U_106B;
L_04DC:;
// 3862 ->L21 %IF A(P+4)=1; ! REST OF EXPR
if (A[P + 4 + 2] != 1) goto L_04DD;
goto U_105C;
L_04DD:;
// 3863 CODE=A(P+3); P=P+5
*CODE = A[P + 3 + 2];
P = P + 5;
// 3864 %RESULT=1 %IF 256>CODE
if (256 <= *CODE) goto L_04DE;
return 1;
L_04DE:;
// 3865 %RESULT=2
return 2;
// 3866 L21: %IF A(P+5)=12 %THEN TYPE=5;! STRING EXPRESSION
U_105C:;
if (A[P + 5 + 2] != 12) goto L_04DF;
TYPE = 5;
L_04DF:;
// 3867 SW(3):SW(4):L9:%RESULT=0
case_SW_3:;
case_SW_4:;
U_106B:;
return 0;
// 3868 %END
case_SW_dispatch:
if (SW_index < 1 || SW_index > 4)
_imp_signalf(6, 3, SW_index, "->SW(%d) out of bounds at %s line %d", SW_index, SW_file, SW_line);
goto *SW[SW_index - 1];
case_SW_missing:
_imp_signalf(8, 2, SW_index, "switch jump to undefined label SW(%d): at %s line %d", SW_index, SW_file, SW_line);
} /* end of TSEXP */
// 3869 %ROUTINE MOVE R(%INTEGER R,N)
void MOVER(int R, int N) {
// 3870 !%SHORTROUTINE
// 3871 ->L99 %IF N=0; ->L2 %IF 0>N
if (N != 0) goto L_04E0;
goto U_106B;
L_04E0:;
if (0 <= N) goto L_04E1;
goto U_106C;
L_04E1:;
// 3872 DUMP(0,R,N,0,R); ->L99
DUMP(0, R, N, 0, R);
goto U_106B;
// 3873 L2: N=-N; ->L3 %UNLESS N=4 %OR N=8
U_106C:;
N = -N;
if (N == 4) goto L_04E2;
if (N == 8) goto L_04E2;
goto U_1079;
L_04E2:;
// 3874 PRX(X'5A',R,0,GLA,76+N); ->L99
PRX(90, R, 0, GLA, 76 + N);
goto U_106B;
// 3875 L3: PCONST(X'41000000'!N); ! LA 0,N
U_1079:;
PCONST(1090519040 | N);
// 3876 PRR(X'1B',R,0); ! SR R,0
PRR(27, R, 0);
// 3877 L99: %END
U_106B:;
return;
} /* end of MOVER */
// 3878 %INTEGERFN FIND PP
int FINDPP(void) {
// 3879 !%SHORTROUTINE
// 3880 %INTEGER I
int I;
// 3881 %CYCLE I=9-RLEVEL,-1,4
// %for I = 9 - RLEVEL, -1, 4 %cycle
{
int _initial = 9 - RLEVEL;
if (invalid_for_loop(_initial, -1, 4)) _imp_signal(5, 1, 0, "Illegal cycle I = 9 - RLEVEL, -1, 4");
I = _initial - (-1);
L_04E3:
if (I == 4) goto L_04E4;
I -= 1;
// 3882 ->L1 %IF REGISTER(I)=0
if (REGISTER[I] != 0) goto L_04E6;
goto U_106A;
L_04E6:;
// 3883 %REPEAT
goto L_04E3;
}
L_04E4:;
// 3884 %RESULT=0
return 0;
// 3885 L1: REGISTER(I)=1
U_106A:;
REGISTER[I] = 1;
// 3886 %RESULT=I
return I;
// 3887 %END
} /* end of FINDPP */
// 3888 %ROUTINE UNPARK(%INTEGER OPCODE,REG,Q)
void UNPARK(int OPCODE, int REG, int Q) {
// 3889 !%SHORTROUTINE
// 3890 ->L1 %IF 0>Q
if (0 <= Q) goto L_04E7;
goto U_106C;
L_04E7:;
// 3891 PRR(OPCODE-X'40',REG,Q); REGISTER(Q)=0; ->L9
PRR(OPCODE - 64, REG, Q);
REGISTER[Q] = 0;
goto U_1079;
// 3892 L1: Q=|Q|; PRX(OPCODE,REG,0,RBASE,Q)
U_106C:;
Q = _imp_IMOD(Q);
PRX(OPCODE, REG, 0, RBASE, Q);
// 3893 PUSH(WSP(LEVEL),0,Q);
PUSH(/*?*/ &WSP[LEVEL], 0, Q);
// 3894 L9: %END
U_1079:;
return;
} /* end of UNPARK */
// 3895 %INTEGERFN PARK(%INTEGER REG)
int PARK(int REG) {
// 3896 !%SHORTROUTINE
// 3897 %INTEGER I,J,P
int I;
int J;
int P;
// 3898 P=CLAIMABLE REG
P = CLAIMABLEREG();
// 3899 ->L1 %IF P=0
if (P != 0) goto L_04E8;
goto U_1079;
L_04E8:;
// 3900 REGISTER(P)=1
REGISTER[P] = 1;
// 3901 ->L2 %IF P=REG
if (P != REG) goto L_04E9;
goto U_1078;
L_04E9:;
// 3902 PRR(X'18',P,REG); ! LR P,REG
PRR(24, P, REG);
// 3903 L2: %RESULT=P
U_1078:;
return P;
// 3904 L1: POP(WSP(LEVEL),I,J); ->L3 %UNLESS J=-1
U_1079:;
POP(/*?*/ &WSP[LEVEL], /*?*/ &I, /*?*/ &J);
if (J == -1) goto L_04EA;
goto U_1058;
L_04EA:;
// 3905 J=N; N=N+4
J = N;
N = N + 4;
// 3906 L3: DUMP(1,REG,J,0,RBASE); %RESULT=-J
U_1058:;
DUMP(1, REG, J, 0, RBASE);
return -J;
// 3907 %END
} /* end of PARK */
// 3908 %INTEGERFN CLAIMABLE REG
int CLAIMABLEREG(void) {
// 3909 !%SHORTROUTINE
// 3910 %INTEGER I
int I;
// 3911 ->L1 %IF RBASE<= 4
if (RBASE > 4) goto L_04EB;
goto U_106A;
L_04EB:;
// 3912 %CYCLE I=5,1,RBASE
// %for I = 5, 1, RBASE %cycle
{
int _final = RBASE;
if (invalid_for_loop(5, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle I = 5, 1, RBASE");
I = 4;
L_04EC:
if (I == _final) goto L_04ED;
I += 1;
// 3913 %RESULT=I %IF REGISTER(I)=0
if (REGISTER[I] != 0) goto L_04EE;
return I;
L_04EE:;
// 3914 %REPEAT
goto L_04EC;
}
L_04ED:;
// 3915 L1: %RESULT=0
U_106A:;
return 0;
// 3916 %END
} /* end of CLAIMABLEREG */
// 3917 %INTEGERFN PARKF (%INTEGER REG,PREC)
int PARKF(int REG, int PREC) {
// 3918 !%SHORTROUTINE
// 3919 %INTEGER I,J
int I;
int J;
// 3920 ->L10 %UNLESS PREC=0
if (PREC == 0) goto L_04EF;
goto U_1079;
L_04EF:;
// 3921 POP(WSP(LEVEL),I,J)
POP(/*?*/ &WSP[LEVEL], /*?*/ &I, /*?*/ &J);
// 3922 ->L3 %UNLESS J=-1
if (J == -1) goto L_04F0;
goto U_1078;
L_04F0:;
// 3923 J=N; N=N+4
J = N;
N = N + 4;
// 3924 L3: DUMP(9+2*PREC,REG,J,0,RBASE)
U_1078:;
DUMP(9 + 2 * PREC, REG, J, 0, RBASE);
// 3925 %RESULT=J
return J;
// 3926 L10: J=GET DBLE WRD;->L3 ;!PARKING SPACE
U_1079:;
J = GETDBLEWRD();
goto U_1078;
// 3927 %END
} /* end of PARKF */
// 3928 %INTEGERFN GET ARR WSP
int GETARRWSP(void) {
// 3929 %COMMENT PRODUCES 6 CONTIGUOUS WORDS UNDER BASE
// 3930 %COMMENT REGISTER COVER FOR ARRAY ACCESS
// 3931 %INTEGER I,J
int I;
int J;
// 3932 POP(MDARR(LEVEL),I,J)
POP(/*?*/ &MDARR[LEVEL], /*?*/ &I, /*?*/ &J);
// 3933 ->L1 %IF J>0
if (J <= 0) goto L_04F1;
goto U_106B;
L_04F1:;
// 3934 J=N; N=N+24
J = N;
N = N + 24;
// 3935 L1: %RESULT =J
U_106B:;
return J;
// 3936 %END
} /* end of GETARRWSP */
// 3937 %ROUTINE RHEAD(%INTEGER KK)
void RHEAD(int KK) {
// 3938 !%SHORTROUTINE
// 3939 %INTEGER FLAG,W1,W2
int FLAG;
int W1;
int W2;
// 3940 FLAG=KK;FLAG=10000 %IF RLEVEL=0
FLAG = KK;
if (RLEVEL != 0) goto L_04F2;
FLAG = 10000;
L_04F2:;
// 3941 ->L5 %IF RLEVEL=0
if (RLEVEL != 0) goto L_04F3;
goto U_1079;
L_04F3:;
// 3942 ->L5 %UNLESS LIST=0
if (LIST == 0) goto L_04F4;
goto U_1079;
L_04F4:;
// 3943 NEWLINE;WRITE(LINE,5);SPACES(3*LEVEL)
_imp_NEWLINE();
_imp_WRITE(LINE, 5);
_imp_SPACES(3 * LEVEL);
// 3944 %IF KK<0 %THEN print string("BEGIN") %ELSE %START
if (KK >= 0) goto L_04F5;
_imp_PRINTSTRING(_imp_str_literal("BEGIN"));
goto L_04F6;
L_04F5:;
// 3945 print string("RT/FN/MAP "); PRINTNAME(KK); %FINISH
_imp_PRINTSTRING(_imp_str_literal("RT/FN/MAP "));
PRINTNAME(KK);
L_04F6:;
// 3946 WRITE(CA,6)
_imp_WRITE(CA, 6);
// 3947 L5: LEVEL=LEVEL+1
U_1079:;
LEVEL = LEVEL + 1;
// 3948 ->L6 %IF FLAG<0
if (FLAG >= 0) goto L_04F7;
goto U_1078;
L_04F7:;
// 3949 RLEVEL=RLEVEL+1;RBASE=10-RLEVEL;R13=0
RLEVEL = RLEVEL + 1;
RBASE = 10 - RLEVEL;
R13 = 0;
// 3950 FAULT(35) %IF RBASE=4 %OR REGISTER(RBASE)#0
if (RBASE == 4) goto L_04E5;
if (REGISTER[RBASE] == 0) goto L_04F8;
L_04E5:;
FAULT(35);
L_04F8:;
// 3951 REGISTER(RBASE)=1
REGISTER[RBASE] = 1;
// 3952 L6: FAULT(34) %IF LEVEL=10
U_1078:;
if (LEVEL != 10) goto L_04F9;
FAULT(34);
L_04F9:;
// 3953 FAULT(105) %IF LEVEL>MAX LEVELS
if (LEVEL <= MAXLEVELS) goto L_04FA;
FAULT(105);
L_04FA:;
// 3954 NMDECS(LEVEL)=0
NMDECS[LEVEL] = 0;
// 3955 ->L10 %IF FLAG>=0
if (FLAG < 0) goto L_04FB;
goto U_1058;
L_04FB:;
// 3956 PRX(X'90',10,11,RBASE,N); ! STM 10,11,?
PRX(144, 10, 11, RBASE, N);
// 3957 N=N+12;W1=RBASE;W2=N-4
N = N + 12;
W1 = RBASE;
W2 = N - 4;
// 3958 ->L20
goto U_1059;
// 3959 L10: ->L25 %IF KK<0
U_1058:;
if (KK >= 0) goto L_04FC;
goto U_105A;
L_04FC:;
// 3960 FROM LIST(JJ,J,K);ST(RA(J)>>2)=CA
FROMLIST(JJ, /*?*/ &J, /*?*/ &K);
ST[(unsigned int)RA[J] >> 2] = CA;
// 3961 PRX(X'50',LINK,0,WSPR,60); !SAVE LINK
PRX(80, LINK, 0, WSPR, 60);
// 3962 W1=WSPR; W2=0
W1 = WSPR;
W2 = 0;
// 3963 L20: ->L21 %IF DIAGS1=0
U_1059:;
if (DIAGS1 != 0) goto L_04FD;
goto U_105B;
L_04FD:;
// 3964 PSS(X'D2',4,W1,W2,GLA,20)
PSS(210, 4, W1, W2, GLA, 20);
// 3965 LOADAD(0,0,0,LINE)
LOADAD(0, 0, 0, LINE);
// 3966 PCONST(X'4000D014') ; !STH 0,20(GLA)
PCONST(1073795092);
// 3967 L21: MONE=1;SET LINE
U_105B:;
MONE = 1;
SETLINE();
// 3968 L25: PRR(X'18',RBASE,WSPR) %UNLESS FLAG<0
U_105A:;
if (FLAG < 0) goto L_04FE;
PRR(24, RBASE, WSPR);
L_04FE:;
// 3969 %IF KK<0 %THEN W1=0 %ELSE W1=WORD(KK)
if (KK >= 0) goto L_04FF;
W1 = 0;
goto L_0500;
L_04FF:;
W1 = WORD[KK];
L_0500:;
// 3970 L(LEVEL)=LINE;M(LEVEL)=W1
L[LEVEL] = LINE;
M[LEVEL] = W1;
// 3971 RNEXT(LEVEL)=NEXT
RNEXT[LEVEL] = NEXT;
// 3972 %RETURN %IF FLAG<0
if (FLAG >= 0) goto L_0501;
return;
L_0501:;
// 3973 SET(RLEVEL)=CA+2
SET[RLEVEL] = CA + 2;
// 3974 PRX(X'41',WSPR,WSPR,0,0); ! LA WSP,?(WSP)
PRX(65, WSPR, WSPR, 0, 0);
// 3975 %IF CHECKS#0 %THEN PCLOD(75); ! CHECK VFOR EXCESS BLOCKS
if (CHECKS == 0) goto L_0502;
PCLOD(75);
L_0502:;
// 3976 N=64; NMAX=N;
N = 64;
NMAX = N;
// 3977 %END
return;
} /* end of RHEAD */
// 3978 %ROUTINE SET80(%INTEGER WHERE,N)
void SET80(int WHERE, int N) {
// 3979 %RETURN %IF N<=2
if (N > 2) goto L_0503;
return;
L_0503:;
// 3980 %INTEGER K
int K;
// 3981 !%SHORTROUTINE
// 3982 PSI(X'92',X'80',RBASE,WHERE)
PSI(146, 128, RBASE, WHERE);
// 3983 N=N-1; K=WHERE
N = N - 1;
K = WHERE;
// 3984 L1: ->L2 %IF N<=256
U_106C:;
if (N > 256) goto L_0504;
goto U_1079;
L_0504:;
// 3985 PSS(X'D2',256,RBASE,K+1,RBASE,K)
PSS(210, 256, RBASE, K + 1, RBASE, K);
// 3986 K=K+256; N=N-256; ->L1
K = K + 256;
N = N - 256;
goto U_106C;
// 3987 L2: PSS(X'D2',N,RBASE,K+1,RBASE,K)
U_1079:;
PSS(210, N, RBASE, K + 1, RBASE, K);
// 3988 %END
return;
} /* end of SET80 */
// 3989 %ROUTINE CBPAIR(%INTEGERNAME LB,UB)
void CBPAIR(int *LB, int *UB) {
// 3990 !%SHORTROUTINE
// 3991 %INTEGER KK,KKK,JJ,BP
int KK;
int KKK;
int JJ;
int BP;
// 3992 P=P+1; KK=0
P = P + 1;
KK = 0;
// 3993 %CYCLE JJ=1,1,2; KKK=KK
// %for JJ = 1, 1, 2 %cycle
{
JJ = 0;
L_0505:
if (JJ == 2) goto L_0506;
JJ += 1;
KKK = KK;
// 3994 %IF A(P)=2 %THEN KK=-1 %ELSE KK=1
if (A[P + 2] != 2) goto L_0508;
KK = -1;
goto L_0509;
L_0508:;
KK = 1;
L_0509:;
// 3995 ->REAL %IF A(P+1)&7=2
if (A[P + 1 + 2] & 7 != 2) goto L_050A;
goto U_1058;
L_050A:;
// 3996 ->STRING %IF A(P+1)&7=5
if (A[P + 1 + 2] & 7 != 5) goto L_050B;
goto U_1059;
L_050B:;
// 3997 %IF A(P+1)=9 %THEN BP=A(P+2) %ELSE %START
if (A[P + 1 + 2] != 9) goto L_050C;
BP = A[P + 2 + 2];
goto L_050D;
L_050C:;
// 3998 FROMAR4(P+2,BP); P=P+1; %FINISH
FROMAR4(P + 2, /*?*/ &BP);
P = P + 1;
L_050D:;
// 3999 KK=KK*BP; P=P+3; ->AGAIN
KK = KK * BP;
P = P + 3;
goto U_105A;
// 4000 REAL: FAULT(24); P=P+6; KK=0; ->AGAIN
U_1058:;
FAULT(24);
P = P + 6;
KK = 0;
goto U_105A;
// 4001 STRING: FAULT(42); P=P*A(P+2)&X'FE'+2; KK=0
U_1059:;
FAULT(42);
P = (P * A[P + 2 + 2] & 254) + 2;
KK = 0;
// 4002 AGAIN: %REPEAT
U_105A:;
goto L_0505;
}
L_0506:;
// 4003 LB=KKK; UB=KK
*LB = KKK;
*UB = KK;
// 4004 %END
return;
} /* end of CBPAIR */
// 4005 %ROUTINE LOAD DATA
void LOADDATA(void) {
// 4006 !%SHORTROUTINE
// 4007 %INTEGER LDLINK,JJ,KK,PTR,JJJ
int LDLINK;
int JJ;
int KK;
int PTR;
int JJJ;
// 4008 %SHORTINTEGER HEAD
short int HEAD;
// 4009 LDPTR=8+8*NEPS
LDPTR = 8 + 8 * NEPS;
// 4010 %INTEGERARRAY BUFFER(0:LDPTR)
int BUFFER[LDPTR + 1];
// 4011 BUFFER(0)=7; BUFFER(2)=88
BUFFER[0] = 7;
BUFFER[2] = 88;
// 4012 BUFFER(3)=0; BUFFER(4)=0
BUFFER[3] = 0;
BUFFER[4] = 0;
// 4013 BUFFER(5)=0; BUFFER(6)=64
BUFFER[5] = 0;
BUFFER[6] = 64;
// 4014 PTR=8; LDLINK=0
PTR = 8;
LDLINK = 0;
// 4015 L1: POP(EPLINK,JJ,KK)
U_1059:;
POP(/*?*/ &EPLINK, /*?*/ &JJ, /*?*/ &KK);
// 4016 ->L10 %IF JJ<0
if (JJ >= 0) goto L_050E;
goto U_105A;
L_050E:;
// 4017 HEAD=KK
HEAD = KK;
// 4018 BUFFER(PTR)=LDLINK
BUFFER[PTR] = LDLINK;
// 4019 LDLINK=PTR<<2
LDLINK = PTR << 2;
// 4020 BUFFER(PTR+1)=0
BUFFER[PTR + 1] = 0;
// 4021 BUFFER(PTR+2)=0
BUFFER[PTR + 2] = 0;
// 4022 BUFFER(PTR+3)=JJ
BUFFER[PTR + 3] = JJ;
// 4023 BUFFER(PTR+4)=X'80000000'
BUFFER[PTR + 4] = -2147483648;
// 4024 POP(HEAD,BUFFER(PTR+5),KK); ! FIRST BIT OF ID.
POP(/*?*/ &HEAD, /*?*/ &BUFFER[PTR + 5], /*?*/ &KK);
// 4025 %IF KK>3 %THEN POP(HEAD,BUFFER(PTR+6),JJJ)
if (KK <= 3) goto L_050F;
POP(/*?*/ &HEAD, /*?*/ &BUFFER[PTR + 6], /*?*/ &JJJ);
L_050F:;
// 4026 PTR=PTR+7; %IF KK>7 %THEN %START
PTR = PTR + 7;
if (KK <= 7) goto L_0510;
// 4027 POP(HEAD,BUFFER(PTR),JJJ); PTR=PTR+1; %FINISH; ->L1
POP(/*?*/ &HEAD, /*?*/ &BUFFER[PTR], /*?*/ &JJJ);
PTR = PTR + 1;
L_0510:;
goto U_1059;
// 4028 L10: BUFFER(1)=LDLINK
U_105A:;
BUFFER[1] = LDLINK;
// 4029 LPUT(3,PTR<<2,0,ADDR(BUFFER(0)))
LPUT(3, PTR << 2, 0, _imp_ADDR(/*?*/ &BUFFER[0]));
// 4030 LDPTR=PTR
LDPTR = PTR;
// 4031 %END
return;
} /* end of LOADDATA */
// 4032 %ROUTINE DEFINE EP(%INTEGER MODE,NAME,ADR)
void DEFINEEP(int MODE, int NAME, int ADR) {
// 4033 !%SHORTROUTINE
// 4034 %SHORTINTEGER HEAD
short int HEAD;
// 4035 %INTEGER JJ,KK,LENGTH,ID1,ID2,ID3
int JJ;
int KK;
int LENGTH;
int ID1;
int ID2;
int ID3;
// 4036 %SWITCH SW(0:2)
int SW_index;
int SW_line;
char *SW_file;
static const void *SW[3] = {&&case_SW_0, &&case_SW_1, &&case_SW_2};
// 4037 KK=WORD(NAME)
KK = WORD[NAME];
// 4038 HEAD=0; ->SW(MODE)
HEAD = 0;
SW_line = __LINE__;
SW_file = __FILE__;
SW_index = MODE;
goto case_SW_dispatch;
// 4039 SW(0): %COMMENT DEFINE S#GO
case_SW_0:;
// 4040 !! WARNING!!! The fact that these M'xxx' constants are 3 bytes, and
// 4041 !! the length byte is plugged in below suggests that we are looking
// 4042 !! at some big-endian-dependent code here! Which might explain why
// 4043 !! there are problems with the PRIMs.
// 4044 LENGTH=4; ID1=M'S#G'; ID2=M'O '; ->L10
LENGTH = 4;
ID1 = 5448519;
ID2 = 1327505440;
goto U_105D;
// 4045 !! ^^^^^^
// 4046 SW(1): %COMMENT SYSTEM EP
case_SW_1:;
// 4047 LENGTH=LETT(KK)+2
LENGTH = LETT[KK] + 2;
// 4048 ID1=M'S#A'; %CYCLE JJ=1,1,6
ID1 = 5448513;
// %for JJ = 1, 1, 6 %cycle
{
JJ = 0;
L_0511:
if (JJ == 6) goto L_0512;
JJ += 1;
// 4049 !! ^^^^^^
// 4050 BYTEINTEGER(ADDR(ID1)+JJ+2)=LETT(KK+JJ)
*_imp_BYTEINTEGER(_imp_ADDR(/*?*/ &ID1) + JJ + 2) = LETT[KK + JJ];
// 4051 %REPEAT; ->L10
goto L_0511;
}
L_0512:;
goto U_105D;
// 4052 SW(2): %COMMENT ENTRY TO EXTERNAL ROUTINE
case_SW_2:;
// 4053 LENGTH=LETT(KK)
LENGTH = LETT[KK];
// 4054 %CYCLE JJ=1,1,8
// %for JJ = 1, 1, 8 %cycle
{
JJ = 0;
L_0513:
if (JJ == 8) goto L_0514;
JJ += 1;
// 4055 BYTE INTEGER(ADDR(ID1)+JJ)=LETT(KK+JJ)
*_imp_BYTEINTEGER(_imp_ADDR(/*?*/ &ID1) + JJ) = LETT[KK + JJ];
// 4056 %REPEAT
goto L_0513;
}
L_0514:;
// 4057 L10: LENGTH=8 %IF LENGTH>8
U_105D:;
if (LENGTH <= 8) goto L_0515;
LENGTH = 8;
L_0515:;
// 4058 BYTE INTEGER(ADDR(ID1))=LENGTH
*_imp_BYTEINTEGER(_imp_ADDR(/*?*/ &ID1)) = LENGTH;
// 4059 %IF LENGTH>7 %THEN PUSH(HEAD,ID3,0)
if (LENGTH <= 7) goto L_0516;
PUSH(/*?*/ &HEAD, ID3, 0);
L_0516:;
// 4060 %IF LENGTH>3 %THEN PUSH(HEAD,ID2,0)
if (LENGTH <= 3) goto L_0517;
PUSH(/*?*/ &HEAD, ID2, 0);
L_0517:;
// 4061 PUSH(HEAD,ID1,LENGTH) ; ! COMPLETE SIDE CHAIN
PUSH(/*?*/ &HEAD, ID1, LENGTH);
// 4062 PUSH(EPLINK,ADR,HEAD); ! LINK TO MAIN LIST
PUSH(/*?*/ &EPLINK, ADR, HEAD);
// 4063 NEPS=NEPS+1
NEPS = NEPS + 1;
// 4064 %END
return;
case_SW_dispatch:
if (SW_index < 0 || SW_index > 2)
_imp_signalf(6, 3, SW_index, "->SW(%d) out of bounds at %s line %d", SW_index, SW_file, SW_line);
goto *SW[SW_index - 0];
} /* end of DEFINEEP */
// 4065 %ROUTINE REDEFINE EP(%INTEGER TYPEP,%INTEGERARRAYNAME PARAMS)
void REDEFINEEP(int TYPEP, int *PARAMS) {
// 4066 !%SHORTROUTINE
// 4067 %INTEGER JJ,KK;%SHORTINTEGER OPHEAD
int JJ;
int KK;
short int OPHEAD;
// 4068 JJ=N0;P=P-2;GXREF(A(P),'I')
JJ = N0;
P = P - 2;
GXREF(A[P + 2], 73);
// 4069 K=NEWCELL;OPHEAD=K
K = NEWCELL();
OPHEAD = K;
// 4070 ->L1 %IF PARAMS(0)=0 ; %CYCLE KK=1,1,PARAMS(0)
if ([/*BUG*/ 0] != 0) goto L_0518;
goto U_1078;
L_0518:;
// %for KK = 1, 1, [/*BUG*/0] %cycle
{
int _final = [/*BUG*/ 0];
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle KK = 1, 1, [/*BUG*/0]");
KK = 0;
L_0519:
if (KK == _final) goto L_051A;
KK += 1;
// 4071 INSERT AFTER(OPHEAD,PARAMS(KK),0)
INSERTAFTER(/*?*/ &OPHEAD, [/*BUG*/ 0], 0);
// 4072 %REPEAT
goto L_0519;
}
L_051A:;
// 4073 L1: I=9;J=14;OLDI=0;PTYPE=TYPEP
U_1078:;
I = 9;
J = 14;
OLDI = 0;
PTYPE = TYPEP;
// 4074 REPLACE TAG(A(P));REPLACE BOTH(K,NR,PARAMS(0))
REPLACETAG(A[P + 2]);
REPLACEBOTH(K, NR, [/*BUG*/ 0]);
// 4075 RA(NR)=JJ<<2;NR=NR+1
RA[NR] = JJ << 2;
NR = NR + 1;
// 4076 %END
return;
} /* end of REDEFINEEP */
// 4077 %INTEGERFN GET DBLE WRD
int GETDBLEWRD(void) {
// 4078 !%SHORT %ROUTINE
// 4079 %COMMENT PRODUCES A DOUBLE WORD OF TEMPORARY SPACE
// 4080 %COMMENT COVERED BY CURRENT BASE REGISTER (RBASE)
// 4081 %INTEGER I,J
int I;
int J;
// 4082 POP(LWSP(LEVEL),I,J)
POP(/*?*/ &LWSP[LEVEL], /*?*/ &I, /*?*/ &J);
// 4083 ->L3 %UNLESS I=-1
if (I == -1) goto L_051B;
goto U_106B;
L_051B:;
// 4084 ->L2 %IF N&7=0
if (N & 7 != 0) goto L_051C;
goto U_106C;
L_051C:;
// 4085 PUSH(WSP(LEVEL),0,N);N=N+4
PUSH(/*?*/ &WSP[LEVEL], 0, N);
N = N + 4;
// 4086 L2: J=N;N=N+8
U_106C:;
J = N;
N = N + 8;
// 4087 L3: %RESULT =J
U_106B:;
return J;
// 4088 %END
} /* end of GETDBLEWRD */
// 4089 %INTEGERFN GET STR WSP
int GETSTRWSP(void) {
// 4090 !%SHORTROUTINE
// 4091 %INTEGER I,J
int I;
int J;
// 4092 POP(STR WSP(LEVEL),I,J)
POP(/*?*/ &STRWSP[LEVEL], /*?*/ &I, /*?*/ &J);
// 4093 ->L2 %UNLESS J=-1
if (J == -1) goto L_051D;
goto U_106B;
L_051D:;
// 4094 J=N; N=N+256
J = N;
N = N + 256;
// 4095 L2: %RESULT=J
U_106B:;
return J;
// 4096 %END
} /* end of GETSTRWSP */
// 4097 %ROUTINE SETEX
void SETEX(void) {
// 4098 %RETURN %UNLESS STRINST=0
if (STRINST == 0) goto L_051E;
return;
L_051E:;
// 4099 ST(N0)=X'D2001000'
ST[N0] = -771747840;
// 4100 ST(N0+1)=X'4000D500'
ST[N0 + 1] = 1073796352;
// 4101 ST(N0+2)=X'20001000'
ST[N0 + 2] = 536875008;
// 4102 STRINST=N0<<2; N0=N0+3
STRINST = N0 << 2;
N0 = N0 + 3;
// 4103 %END
return;
} /* end of SETEX */
// 4104 %ROUTINE SETLINE
void SETLINE(void) {
// 4105 !%SHORTROUTINE
// 4106 %INTEGER K
int K;
// 4107 %OWNINTEGER VALUE
static int VALUE;
// 4108 %RETURN %UNLESS LINENOS=1
if (LINENOS == 1) goto L_051F;
return;
L_051F:;
// 4109 K=LINE&255
K = LINE & 255;
// 4110 MONE=1 %IF K=0
if (K != 0) goto L_0520;
MONE = 1;
L_0520:;
// 4111 PSI(X'92',K,GLA,23) %UNLESS K=VALUE %AND MONE=0
if (K != VALUE) goto L_0507;
if (MONE == 0) goto L_0521;
L_0507:;
PSI(146, K, GLA, 23);
L_0521:;
// 4112 VALUE=K
VALUE = K;
// 4113 ->L9 %IF MONE=0
if (MONE != 0) goto L_0522;
goto U_106B;
L_0522:;
// 4114 PSI(X'92',LINE>>8,GLA,22); ! MVI
PSI(146, (unsigned int)LINE >> 8, GLA, 22);
// 4115 L9: MONE=0; %END
U_106B:;
MONE = 0;
return;
} /* end of SETLINE */
// 4116 %ROUTINE CHECK CAPACITY(%INTEGER REG,DIS,X,LEVEL)
void CHECKCAPACITY(int REG, int DIS, int X, int LEVEL) {
// 4117 !%SHORTROUTINE
// 4118 %INTEGER MASK
int MASK;
// 4119 %RETURN %UNLESS TYPE=1 %AND 1<=PREC<=2
if (TYPE != 1) goto L_0523;
{
// Double-sided test on PREC (Part I)
unsigned char tmp;
if (1 > (tmp = PREC)) goto L_0523;
// Double-sided test on PREC (Part II)
if (tmp <= 2) goto L_0524;
}
L_0523:;
return;
L_0524:;
// 4120 ->L3 %IF PREC=1; ! %YTE
if (PREC != 1) goto L_0525;
goto U_1078;
L_0525:;
// 4121 MASK=7
MASK = 7;
// 4122 PRX(X'49',REG,LEVEL,X,DIS); ! CH REG,STORED VALUE
PRX(73, REG, LEVEL, X, DIS);
// 4123 L1: PRX(X'47',MASK,12,0,88); ->L99; ! BC MASK,CAPACITY EXCE
U_1058:;
PRX(71, MASK, 12, 0, 88);
goto U_1059;
// 4124 L3: PRX(X'55',REG,0,GLA,24); ! CL_1,=F'255'
U_1078:;
PRX(85, REG, 0, GLA, 24);
// 4125 MASK=2; ->L1
MASK = 2;
goto U_1058;
// 4126 L99: %END
U_1059:;
return;
} /* end of CHECKCAPACITY */
// 4127 ! ******* LIST***PROCESSING***ROUTINES
// 4128 %COMMENT MACROISING THE FROMS,REPLACES & MLINK SAVES TIME & SPACE;
// 4129 %COMMENT MACROISING THE OTHERS SAVES TIME BUT INCREASES SIZE
// 4130 %ROUTINE FROM LIST(%INTEGER CELL,%INTEGERNAME S1,S2)
void FROMLIST(int CELL, int *S1, int *S2) {
// 4131 %INTEGER J
int J;
// 4132 J=ADDR(ASLIST(CELL))
J = _imp_ADDR(/*?*/ &ASLIST[CELL]);
// 4133 S1=INTEGER(J)
*S1 = *_imp_INTEGER(J);
// 4134 S2= SHORT INTEGER(J+4)
*S2 = *_imp_SHORTINTEGER(J + 4);
// 4135 %END
return;
} /* end of FROMLIST */
// 4136 %INTEGERFN NEW CELL
int NEWCELL(void) {
// 4137 %INTEGER P
int P;
// 4138 P=ASL; FAULT(107) %IF P=0
P = ASL;
if (P != 0) goto L_0526;
FAULT(107);
L_0526:;
// 4139 ASL= SHORT INTEGER(ADDR(ASLIST(P+6)));! NEXT FREE CELL
ASL = *_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &ASLIST[P + 6]));
// 4140 SET SHORT INTEGER(ADDR(ASLIST(P+6)), 0); ! LINK OF NEWCELL TO 0
SETSHORTINTEGER(_imp_ADDR(/*?*/ &ASLIST[P + 6]), 0);
// 4141 %RESULT=P
return P;
// 4142 %END
} /* end of NEWCELL */
// 4143 %ROUTINE PUSH(%SHORTINTEGERNAME CELL,%INTEGER S1,S2) ; ! Care needed with short conversion!
void PUSH(short int *CELL, int S1, int S2) {
// 4144 %INTEGER P,Q
int P;
int Q;
// 4145 P=NEWCELL
P = NEWCELL();
// 4146 Q=ADDR(ASLIST(P))
Q = _imp_ADDR(/*?*/ &ASLIST[P]);
// 4147 INTEGER(Q)=S1
*_imp_INTEGER(Q) = S1;
// 4148 SET SHORT INTEGER(Q+4, S2)
SETSHORTINTEGER(Q + 4, S2);
// 4149 SET SHORT INTEGER(Q+6, CELL)
SETSHORTINTEGER(Q + 6, *CELL);
// 4150 CELL=P
*CELL = P;
// 4151 %END
return;
} /* end of PUSH */
// 4152 %ROUTINE POP(%SHORTINTEGERNAME CELL,%INTEGERNAME S1,S2)
void POP(short int *CELL, int *S1, int *S2) {
// 4153 %INTEGER P,Q
int P;
int Q;
// 4154 Q=ADDR(ASLIST(CELL))
Q = _imp_ADDR(/*?*/ &ASLIST[*CELL]);
// 4155 S1=INTEGER(Q)
*S1 = *_imp_INTEGER(Q);
// 4156 S2=SHORT INTEGER(Q+4)
*S2 = *_imp_SHORTINTEGER(Q + 4);
// 4157 ->L1 %IF CELL=0; ! LIST ALREADY EMPTY
if (*CELL != 0) goto L_0527;
goto U_1078;
L_0527:;
// 4158 P=CELL; CELL=SHORT INTEGER(Q+6);! CELL ONTO NEXT CELL
P = *CELL;
*CELL = *_imp_SHORTINTEGER(Q + 6);
// 4159 SHORT INTEGER(Q+6)=ASL; ASL=P;! OLD CELL ONTO FREE LIST
*_imp_SHORTINTEGER(Q + 6) = ASL;
ASL = P;
// 4160 L1: %END
U_1078:;
return;
} /* end of POP */
// 4161 %ROUTINE REPLACE1(%INTEGER CELL,S1)
void REPLACE1(int CELL, int S1) {
// 4162 INTEGER(ADDR(ASLIST(CELL)))=S1
*_imp_INTEGER(_imp_ADDR(/*?*/ &ASLIST[CELL])) = S1;
// 4163 %END
return;
} /* end of REPLACE1 */
// 4164 %ROUTINE REPLACE2(%INTEGER CELL,S2)
void REPLACE2(int CELL, int S2) {
// 4165 SHORT INTEGER(ADDR(ASLIST(CELL+4)))=S2
*_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &ASLIST[CELL + 4])) = S2;
// 4166 %END
return;
} /* end of REPLACE2 */
// 4167 %ROUTINE MLINK(%INTEGERNAME CELL)
void MLINK(int *CELL) {
// 4168 CELL=SHORT INTEGER(ADDR(ASLIST(CELL+6)))
*CELL = *_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &ASLIST[*CELL + 6]));
// 4169 %END
return;
} /* end of MLINK */
// 4170 %ROUTINE INSERT AFTER(%SHORTINTEGERNAME CELL,%INTEGER S1,S2)
void INSERTAFTER(short int *CELL, int S1, int S2) {
// 4171 ->L1 %IF CELL=0
if (*CELL != 0) goto L_0528;
goto U_106C;
L_0528:;
// 4172 PUSH(SHORT INTEGER(ADDR(ASLIST(CELL+6))),S1,S2)
PUSH(_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &ASLIST[*CELL + 6])), S1, S2);
// 4173 CELL=SHORT INTEGER(ADDR(ASLIST(CELL+6)))
*CELL = *_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &ASLIST[*CELL + 6]));
// 4174 %RETURN
return;
// 4175 L1: PUSH(CELL,S1,S2)
U_106C:;
PUSH(CELL, S1, S2);
// 4176 %END
return;
} /* end of INSERTAFTER */
// 4177 %INTEGERFN FIND(%INTEGER LAB,LIST)
int FIND(int LAB, int LIST) {
// 4178 L3: ->L1 %IF LIST=0
U_106B:;
if (LIST != 0) goto L_0529;
goto U_106C;
L_0529:;
// 4179 ->L4 %IF SHORT INTEGER(ADDR(ASLIST(LIST+4)))=LAB
if (*_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &ASLIST[LIST + 4])) != LAB) goto L_052A;
goto U_1079;
L_052A:;
// 4180 MLINK(LIST); ->L3
MLINK(/*?*/ &LIST);
goto U_106B;
// 4181 L4: %RESULT=INTEGER(ADDR(ASLIST(LIST)))
U_1079:;
return *_imp_INTEGER(_imp_ADDR(/*?*/ &ASLIST[LIST]));
// 4182 L1: %RESULT =-1
U_106C:;
return -1;
// 4183 %END
} /* end of FIND */
// 4184 %ROUTINE FROM1(%INTEGER CELL,%INTEGERNAME S1)
void FROM1(int CELL, int *S1) {
// 4185 S1=INTEGER(ADDR(ASLIST(CELL)))
*S1 = *_imp_INTEGER(_imp_ADDR(/*?*/ &ASLIST[CELL]));
// 4186 %END
return;
} /* end of FROM1 */
// 4187 %ROUTINE FROM2(%INTEGER CELL,%INTEGERNAME S2)
void FROM2(int CELL, int *S2) {
// 4188 S2=SHORT INTEGER(ADDR(ASLIST(CELL+4)))
*S2 = *_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &ASLIST[CELL + 4]));
// 4189 %END
return;
} /* end of FROM2 */
// 4190 %ROUTINE REPLACE BOTH(%INTEGER CELL,S1,S2)
void REPLACEBOTH(int CELL, int S1, int S2) {
// 4191 %INTEGER I
int I;
// 4192 I=ADDR(ASLIST(CELL))
I = _imp_ADDR(/*?*/ &ASLIST[CELL]);
// 4193 INTEGER(I)=S1
*_imp_INTEGER(I) = S1;
// 4194 SHORT INTEGER(I+4)=S2
*_imp_SHORTINTEGER(I + 4) = S2;
// 4195 %END
return;
} /* end of REPLACEBOTH */
// 4196 %ROUTINE CLEAR LIST (%SHORTINTEGERNAME OPHEAD)
void CLEARLIST(short int *OPHEAD) {
// 4197 %INTEGER I,J
int I;
int J;
// 4198 L1: POP(OPHEAD,I,J)
U_106C:;
POP(OPHEAD, /*?*/ &I, /*?*/ &J);
// 4199 ->L1 %UNLESS I=-1
if (I == -1) goto L_052B;
goto U_106C;
L_052B:;
// 4200 %END
return;
} /* end of CLEARLIST */
// 4201 ! ************END****OF****LIST****PROCESSING ROUTINES
// 4202 %ROUTINE STORE TAG(%INTEGER KK,SLINK)
void STORETAG(int KK, int SLINK) {
// 4203 PUSH(TAGS(KK),PTYPE<<16!LEVEL<<8!RBASE<<4!J,SLINK)
PUSH(/*?*/ &TAGS[KK], PTYPE << 16 | LEVEL << 8 | RBASE << 4 | J, SLINK);
// 4204 PUSH(NAME(LEVEL),0,KK) %UNLESS LEVEL<=1
if (LEVEL <= 1) goto L_052C;
PUSH(/*?*/ &NAME[LEVEL], 0, KK);
L_052C:;
// 4205 %END
return;
} /* end of STORETAG */
// 4206 %INTEGERFN COUNT APS
int COUNTAPS(void) {
// 4207 %INTEGER PP,Q
int PP;
int Q;
// 4208 Q=0; PP=P; P=P+1; ! P ON NAME AT ENTRY
Q = 0;
PP = P;
P = P + 1;
// 4209 L1: ->L2 %IF A(P)=2
U_106B:;
if (A[P + 2] != 2) goto L_052D;
goto U_106C;
L_052D:;
// 4210 P=P+1; Q=Q+1; SKIP EXP; ->L1
P = P + 1;
Q = Q + 1;
SKIPEXP();
goto U_106B;
// 4211 L2: P=PP; %RESULT=Q
U_106C:;
P = PP;
return Q;
// 4212 %END
} /* end of COUNTAPS */
// 4213 %INTEGERFN DISPLACEMENT(%INTEGER LINK)
int DISPLACEMENT(int LINK) {
// 4214 !%SHORTROUTINE
// 4215 ! A(P) HAS ENAME--LINK IS HEAD OF RFORMAT LIST. RESULT IS DISP FROM
// 4216 ! START OF RECORD FOR SCALAR DISP OF DV FROM RECORD FORMAT FOR ARRAY
// 4217 %INTEGER RR,II
int RR;
int II;
// 4218 ->L2 %IF LINK=0
if (LINK != 0) goto L_052E;
goto U_106C;
L_052E:;
// 4219 FROM2(LINK,LINK)
FROM2(LINK, /*?*/ &LINK);
// 4220 L1: MLINK(LINK); FROM LIST(LINK,RR,II)
U_1079:;
MLINK(/*?*/ &LINK);
FROMLIST(LINK, /*?*/ &RR, /*?*/ &II);
// 4221 ->L2 %IF II=-1
if (II != -1) goto L_052F;
goto U_106C;
L_052F:;
// 4222 J=RR&15;PTYPE=RR>>4&X'FFFF'
J = RR & 15;
PTYPE = (unsigned int)RR >> 4 & 65535;
// 4223 RR=RR>>20;K=LINK
RR = (unsigned int)RR >> 20;
K = LINK;
// 4224 INREG=0
INREG = 0;
// 4225 ->L99 %IF RR=A(P); ->L1
if (RR != A[P + 2]) goto L_0530;
goto U_1078;
L_0530:;
goto U_1079;
// 4226 L2: FAULT(65); PRINT NAME(A(P))
U_106C:;
FAULT(65);
PRINTNAME(A[P + 2]);
// 4227 PTYPE=1
PTYPE = 1;
// 4228 L99: %RESULT=II
U_1078:;
return II;
// 4229 %END
} /* end of DISPLACEMENT */
// 4230 %INTEGERFN COPY RECORD TAG
int COPYRECORDTAG(void) {
// 4231 !%SHORTROUTINE
// 4232 ! AS COPY TAG-GIVES TYNE ETC OF THE ENAME
// 4233 !P POINTS TO RECORD NAME
// 4234 %INTEGER Q,FNAME
int Q;
int FNAME;
// 4235 ! K POINT TO SIDE CHAIN
// 4236 L1: FROM1(K,FNAME)
U_106B:;
FROM1(K, /*?*/ &FNAME);
// 4237 P=P+1; SKIP APP
P = P + 1;
SKIPAPP();
// 4238 %RESULT=0 %IF A(P)=2
if (A[P + 2] != 2) goto L_0531;
return 0;
L_0531:;
// 4239 P=P+1; Q=DISPLACEMENT (FNAME)
P = P + 1;
Q = DISPLACEMENT(FNAME);
// 4240 PTYPE=7 %IF Q=-1
if (Q != -1) goto L_0532;
PTYPE = 7;
L_0532:;
// 4241 UNPACK
UNPACK();
// 4242 %IF TYPE=3 %THEN %START
if (TYPE != 3) goto L_0533;
// 4243 K=Q; ->L1; %FINISH
K = Q;
goto U_106B;
L_0533:;
// 4244 %RESULT=-1 %IF Q=-1
if (Q != -1) goto L_0534;
return -1;
L_0534:;
// 4245 %RESULT=1
return 1;
// 4246 %END
} /* end of COPYRECORDTAG */
// 4247 %ROUTINE COPY TAG(%INTEGER KK)
void COPYTAG(int KK) {
// 4248 %INTEGER Q
int Q;
// 4249 FROM LIST(TAGS(KK),Q,K)
FROMLIST(TAGS[KK], /*?*/ &Q, /*?*/ &K);
// 4250 ->NOTSET %IF Q=-1
if (Q != -1) goto L_0535;
goto U_106B;
L_0535:;
// 4251 PTYPE=Q>>16
PTYPE = (unsigned int)Q >> 16;
// 4252 INREG=Q>>12&15
INREG = (unsigned int)Q >> 12 & 15;
// 4253 OLDI=Q>>8&15
OLDI = (unsigned int)Q >> 8 & 15;
// 4254 I=Q>>4&15
I = (unsigned int)Q >> 4 & 15;
// 4255 J=Q&15
J = Q & 15;
// 4256 L1: UNPACK
U_106C:;
UNPACK();
// 4257 %RETURN
return;
// 4258 NOTSET: PTYPE=7
U_106B:;
PTYPE = 7;
// 4259 I=-1; J=I; OLDI=J; ->L1
I = -1;
J = I;
OLDI = J;
goto U_106C;
// 4260 %END
} /* end of COPYTAG */
// 4261 %ROUTINE REPLACE TAG (%INTEGER KK)
void REPLACETAG(int KK) {
// 4262 !%SHORTROUTINE
// 4263 %INTEGER P,Q
int P;
int Q;
// 4264 P=TAGS(KK)
P = TAGS[KK];
// 4265 Q=PTYPE<<16!INREG<<12!OLDI<<8!I<<4!J
Q = PTYPE << 16 | INREG << 12 | OLDI << 8 | I << 4 | J;
// 4266 REPLACE BOTH(P,Q,K)
REPLACEBOTH(P, Q, K);
// 4267 %END
return;
} /* end of REPLACETAG */
// 4268 %ROUTINE UNPACK
void UNPACK(void) {
// 4269 %INTEGER Q
int Q;
// 4270 ROUT=PTYPE//10000
ROUT = ((long)PTYPE / (long)10000);
// 4271 Q=PTYPE-10000*ROUT
Q = PTYPE - 10000 * ROUT;
// 4272 NAM=Q//1000
NAM = ((long)Q / (long)1000);
// 4273 Q=Q-1000*NAM
Q = Q - 1000 * NAM;
// 4274 ARR=Q//100
ARR = ((long)Q / (long)100);
// 4275 Q=Q-100*ARR
Q = Q - 100 * ARR;
// 4276 PREC=Q//10
PREC = ((long)Q / (long)10);
// 4277 TYPE=Q-10*PREC
TYPE = Q - 10 * PREC;
// 4278 %END
return;
} /* end of UNPACK */
// 4279 %ROUTINE PACK(%INTEGERNAME PTYPE)
void PACK(int *PTYPE) {
// 4280 %INTEGER Q
int Q;
// 4281 Q=10000*ROUT+1000*NAM+100*ARR
Q = 10000 * ROUT + 1000 * NAM + 100 * ARR;
// 4282 PTYPE=Q+10*PREC+TYPE
*PTYPE = Q + 10 * PREC + TYPE;
// 4283 %END
return;
} /* end of PACK */
// 4284 !************* LABEL ***** AND**** JUMP **** ROUTINES*************
// 4285 %ROUTINE PPJ(%BYTEINTEGER N)
void PPJ(unsigned char N) {
// 4286 R13=0; PCONST(X'45F0C000'!N<<2); ! BAL LINP,PLAB N
R13 = 0;
PCONST(1173405696 | N << 2);
// 4287 %END
return;
} /* end of PPJ */
// 4288 %INTEGERFN PAGENO(%INTEGER N)
int PAGENO(int N) {
// 4289 %INTEGER I,J
int I;
int J;
// 4290 J=N>>12; I=PAGENOS(J)
J = (unsigned int)N >> 12;
I = PAGENOS[J];
// 4291 %RESULT=I %UNLESS I=0
if (I == 0) goto L_0536;
return I;
L_0536:;
// 4292 ST(N0)=J<<12
ST[N0] = J << 12;
// 4293 PAGENOS(J)=N0
PAGENOS[J] = N0;
// 4294 N0=N0+1
N0 = N0 + 1;
// 4295 %RESULT=N0-1
return N0 - 1;
// 4296 %END
} /* end of PAGENO */
// 4297 %ROUTINE FILL JUMPS(%INTEGER LEVEL)
void FILLJUMPS(int LEVEL) {
// 4298 !%SHORTROUTINE
// 4299 %INTEGER J,K,Q,KK
int J;
int K;
int Q;
int KK;
// 4300 OPHEAD=0
OPHEAD = 0;
// 4301 L1: POP(JUMP(LEVEL),J,K); ->L3 %IF J=-1
U_1078:;
POP(/*?*/ &JUMP[LEVEL], /*?*/ &J, /*?*/ &K);
if (J != -1) goto L_0537;
goto U_1058;
L_0537:;
// 4302 Q=FIND(K,LABEL(LEVEL))
Q = FIND(K, LABEL[LEVEL]);
// 4303 ->L2 %UNLESS Q=-1;
if (Q == -1) goto L_0538;
goto U_1059;
L_0538:;
// 4304 PUSH(OPHEAD,J,K); ->L1
PUSH(/*?*/ &OPHEAD, J, K);
goto U_1078;
// 4305 L2: KK=0
U_1059:;
KK = 0;
// 4306 Q=Q-CODEBASE(LEVEL); K=Q>>12
Q = Q - CODEBASE[LEVEL];
K = (unsigned int)Q >> 12;
// 4307 ->L22 %IF J&LABSET#0
if (J & LABSET == 0) goto L_0539;
goto U_105A;
L_0539:;
// 4308 ->L23 %IF SBFLAG=1
if (SBFLAG != 1) goto L_053A;
goto U_105B;
L_053A:;
// 4309 PLUG(J,X'58E0')
PLUG(J, 22752);
// 4310 PLUG(J+2,GLA<<12!4*PAGENO(Q)); J=J+4
PLUG(J + 2, GLA << 12 | 4 * PAGENO(Q));
J = J + 4;
// 4311 KK=14 %UNLESS K=0
if (K == 0) goto L_053B;
KK = 14;
L_053B:;
// 4312 L21: PLUG(J+2,KK<<12!Q&X'FFF'); ->L1
U_105C:;
PLUG(J + 2, KK << 12 | Q & 4095);
goto U_1078;
// 4313 L22: J=J&X'FFFFFF'; KK=10
U_105A:;
J = J & 16777215;
KK = 10;
// 4314 L23: FAULT(99) %IF Q>4095; ->L21
U_105B:;
if (Q <= 4095) goto L_053C;
FAULT(99);
L_053C:;
goto U_105C;
// 4315 L3: JUMP(LEVEL)=OPHEAD
U_1058:;
JUMP[LEVEL] = OPHEAD;
// 4316 %END
return;
} /* end of FILLJUMPS */
// 4317 %ROUTINE PJ(%INTEGER MASK,LAB)
void PJ(int MASK, int LAB) {
// 4318 !%SHORTROUTINE
// 4319 %INTEGER I,J,Q
int I;
int J;
int Q;
// 4320 J=FIND(LAB,LABEL(LEVEL)); ->L200 %IF J=-1
J = FIND(LAB, LABEL[LEVEL]);
if (J != -1) goto L_053D;
goto U_1078;
L_053D:;
// 4321 I=J-CODEBASE(LEVEL); ->L50 %IF I>=4096
I = J - CODEBASE[LEVEL];
if (I < 4096) goto L_053E;
goto U_1058;
L_053E:;
// 4322 PRX(X'47',MASK,0,10,I); ->L999;! BC MASK,I(10,0)
PRX(71, MASK, 0, 10, I);
goto U_1059;
// 4323 L50: Q=4*PAGENO(I); ! DISPLACEMENT OF MULTIPLE OF 4K
U_1058:;
Q = 4 * PAGENO(I);
// 4324 PCONST(X'58E0D000'!Q); ! L 14,Q(GLA)
PCONST(1491128320 | Q);
// 4325 PRX(X'47',MASK,14,10,I&4095); ->L999;! BC MASK,?(10,14)
PRX(71, MASK, 14, 10, I & 4095);
goto U_1059;
// 4326 L200: PUSH(JUMP(LEVEL),CA,LAB); PCONST(0) %UNLESS SBFLAG=1
U_1078:;
PUSH(/*?*/ &JUMP[LEVEL], CA, LAB);
if (SBFLAG == 1) goto L_053F;
PCONST(0);
L_053F:;
// 4327 PRX(X'47',MASK,10,0,0); ! BC MASK,?(10,?)
PRX(71, MASK, 10, 0, 0);
// 4328 L999: %END
U_1059:;
return;
} /* end of PJ */
// 4329 %ROUTINE PLAB(%INTEGER M)
void PLAB(int M) {
// 4330 !%SHORTROUTINE
// 4331 MONE=1
MONE = 1;
// 4332 %IF M>=0 %THEN ->L1
if (M < 0) goto L_0540;
goto U_106A;
L_0540:;
// 4333 PLABEL=PLABEL-1; K=PLABEL
PLABEL = PLABEL - 1;
K = PLABEL;
// 4334 M=K
M = K;
// 4335 L1: PUSH(LABEL(LEVEL),CA,M)
U_106A:;
PUSH(/*?*/ &LABEL[LEVEL], CA, M);
// 4336 R13=0
R13 = 0;
// 4337 %END
return;
} /* end of PLAB */
// 4338 !********** END **** OF **** LABEL ****** ROUTINES **************
// 4339 %ROUTINE CHECK RF
void CHECKRF(void) {
// 4340 !%SHORTROUTINE
// 4341 COPYTAG(A(MARKER1))
COPYTAG(A[MARKER1 + 2]);
// 4342 ->L1 %UNLESS TYPE=4
if (TYPE == 4) goto L_0541;
goto U_1057;
L_0541:;
// 4343 JJ=K; FROM LIST(JJ,Q,FNAME)
JJ = K;
FROMLIST(JJ, /*?*/ &Q, /*?*/ &FNAME);
// 4344 DUMP(0,4,Q,0,I); ! ADDR OF FORMAT TO R4
DUMP(0, 4, Q, 0, I);
// 4345 ->L9
goto U_106A;
// 4346 L1: K=-1; FAULT(62)
U_1057:;
K = -1;
FAULT(62);
// 4347 L9: %END
U_106A:;
return;
} /* end of CHECKRF */
// 4348 %ROUTINE DUMP(%INTEGER CODE,REG,DIS,X,LEVEL)
void DUMP(int CODE, int REG, int DIS, int X, int LEVEL) {
// 4349 !%SHORTROUTINE
// 4350 %COMMENT CODE=8*(TYPE-1)+2*PREC+Z
// 4351 %INTEGER J
int J;
// 4352 %OWNBYTEINTEGERARRAY OPCODE(0:16)=X'41',
static unsigned char OPCODE[17] = {65, 80, 88, 66, 67, 64, 72, 89, 73, 112, 120, [11 ... 14] = 0, 96, 104};
// 4353+ X'50',X'58',X'42',X'43',X'40',X'48',X'59',X'49',
// 4354+ X'70',X'78',0(4),X'60',X'68'
// 4355 J=OPCODE(CODE);FAULT(248) %IF J=0
J = OPCODE[CODE];
if (J != 0) goto L_0542;
FAULT(248);
L_0542:;
// 4356 ->L4 %IF CODE=4; ! IC NEEDED
if (CODE != 4) goto L_0543;
goto U_1059;
L_0543:;
// 4357 ->L1 %UNLESS CODE=0=DIS; ! OPTIMISE LOAD ADDR
{
// Double-sided test on 0 (Part I)
int tmp;
if (CODE != (tmp = 0)) goto L_0544;
// Double-sided test on 0 (Part II)
if (tmp == DIS) goto L_0545;
}
L_0544:;
goto U_105A;
L_0545:;
// 4358 ->L3 %UNLESS LEVEL=0=X
{
// Double-sided test on 0 (Part I)
int tmp;
if (LEVEL != (tmp = 0)) goto L_0546;
// Double-sided test on 0 (Part II)
if (tmp == X) goto L_0547;
}
L_0546:;
goto U_105B;
L_0547:;
// 4359 PRR(X'1F',REG,REG); ->L99; ! SLR INSTEAD LO LA REG,0
PRR(31, REG, REG);
goto U_105C;
// 4360 L3: ->L1 %UNLESS LEVEL=0 %OR X=0
U_105B:;
if (LEVEL == 0) goto L_0548;
if (X == 0) goto L_0548;
goto U_105A;
L_0548:;
// 4361 PRR(X'18',REG,X+LEVEL) %UNLESS REG=X+LEVEL;->L99
if (REG == X + LEVEL) goto L_0549;
PRR(24, REG, X + LEVEL);
L_0549:;
goto U_105C;
// 4362 L4: PRR(X'1F',REG,REG) %IF X#REG#LEVEL; ! SLR FOR BYTE
U_1059:;
{
// Double-sided test on REG (Part I)
int tmp;
if (X == (tmp = REG)) goto L_054A;
// Double-sided test on REG (Part II)
if (tmp == LEVEL) goto L_054A;
}
PRR(31, REG, REG);
L_054A:;
// 4363 L1: PRX(J,REG,X,LEVEL,DIS)
U_105A:;
PRX(J, REG, X, LEVEL, DIS);
// 4364 %COMMENT AND WITH 255 FOR BYTE IF SLR NOT POSSIBLE AS ADDR IN R
// 4365 PRX(X'54',REG,0,GLA,24) %UNLESS CODE#4 %OR X#REG#LEVEL
if (CODE != 4) goto L_054B;
{
// Double-sided test on REG (Part I)
int tmp;
if (X == (tmp = REG)) goto L_054C;
// Double-sided test on REG (Part II)
if (tmp != LEVEL) goto L_054B;
}
L_054C:;
PRX(84, REG, 0, GLA, 24);
L_054B:;
// 4366 L99: %END
U_105C:;
return;
} /* end of DUMP */
// 4367 %END
return;
case_SW_dispatch:
if (SW_index < 1 || SW_index > 45)
_imp_signalf(6, 3, SW_index, "->SW(%d) out of bounds at %s line %d", SW_index, SW_file, SW_line);
goto *SW[SW_index - 1];
case_SW_missing:
_imp_signalf(8, 2, SW_index, "switch jump to undefined label SW(%d): at %s line %d", SW_index, SW_file, SW_line);
} /* end of CSS */
// ?PRECP unused
// 4368 %ENDOFPROGRAM
_imp_stop(0);
return 0;
end_0:;
}