! PRODUCED BY OLDPS FROM PERQ_PS01 ON 22/02/82 %CONSTBYTEINTEGERARRAY CLETT(0: 444)= 1, 40, 1, 41, 1, 42, 1, 44, 2, 201, 198, 6, 213, 206, 204, 197, 211, 211, 5, 215, 200, 201, 204, 197, 5, 213, 206, 212, 201, 204, 3, 198, 207, 210, 1, 61, 5, 193, 204, 201, 193, 211, 7, 201, 206, 212, 197, 199, 197, 210, 4, 210, 197, 193, 204, 4, 204, 207, 206, 199, 4, 194, 217, 212, 197, 6, 211, 212, 210, 201, 206, 199, 4, 200, 193, 204, 198, 5, 211, 200, 207, 210, 212, 6, 210, 197, 195, 207, 210, 196, 7, 210, 207, 213, 212, 201, 206, 197, 2, 198, 206, 3, 205, 193, 208, 8, 198, 213, 206, 195, 212, 201, 207, 206, 4, 206, 193, 205, 197, 9, 193, 210, 210, 193, 217, 206, 193, 205, 197, 9, 207, 198, 208, 210, 207, 199, 210, 193, 205, 6, 207, 198, 198, 201, 204, 197, 6, 207, 198, 204, 201, 211, 212, 6, 198, 207, 210, 205, 193, 212, 3, 206, 207, 212, 3, 193, 206, 196, 2, 207, 210, 1, 58, 4, 211, 208, 197, 195, 5, 193, 210, 210, 193, 217, 3, 207, 215, 206, 8, 197, 216, 212, 197, 210, 206, 193, 204, 9, 197, 216, 212, 210, 201, 206, 211, 201, 195, 8, 195, 207, 206, 211, 212, 193, 206, 212, 5, 195, 207, 206, 211, 212, 5, 197, 214, 197, 206, 212, 5, 211, 212, 193, 210, 212, 9, 212, 200, 197, 206, 211, 212, 193, 210, 212, 4, 212, 200, 197, 206, 9, 197, 204, 211, 197, 211, 212, 193, 210, 212, 4, 197, 204, 211, 197, 1, 95, 6, 211, 217, 211, 212, 197, 205, 7, 196, 217, 206, 193, 205, 201, 195, 4, 80, 85, 84, 95, 5, 67, 78, 79, 80, 95, 1, 43, 1, 45, 1, 64, 2, 45, 62, 6, 210, 197, 212, 213, 210, 206, 6, 210, 197, 211, 213, 204, 212, 7, 205, 207, 206, 201, 212, 207, 210, 4, 211, 212, 207, 208, 6, 211, 201, 199, 206, 193, 204, 4, 197, 216, 201, 212, 8, 195, 207, 206, 212, 201, 206, 213, 197, 6, 198, 201, 206, 201, 211, 200, 5, 195, 217, 195, 204, 197, 6, 210, 197, 208, 197, 193, 212, 3, 197, 206, 196, 7, 201, 206, 195, 204, 213, 196, 197, 5, 194, 197, 199, 201, 206, 2, 207, 206, 6, 211, 215, 201, 212, 195, 200, 4, 204, 201, 211, 212, 7, 211, 208, 197, 195, 201, 193, 204, 14, 212, 210, 213, 211, 212, 197, 196, 208, 210, 207, 199, 210, 193, 205, 6, 205, 193, 201, 206, 197, 208, 7, 195, 207, 206, 212, 210, 207, 204, 4, 40, 42, 41, 58; %CONSTINTEGERARRAY SYMBOL(1300: 2090)= 1311, 1305, 1001, 1358, 1790, 1307, 1003, 1311, 0, 1337, 2, 1321, 1315, 1001, 1014, 1317, 1003, 1321, 0, 1321, 2, 1328, 1328, 1010, 1028, 1311, 1011, 1351, 1337, 1335, 1010, 1028, 1311, 1011, 1351, 1337, 4, 1344, 1344, 1010, 1028, 1300, 1011, 1344, 1351, 1349, 1026, 1300, 999, 1351, 1000, 1358, 1356, 1026, 1311, 999, 1358, 1000, 1366, 1364, 0, 1337, 1366, 2, 1366, 1000, 1373, 1371, 6, 1337, 999, 1373, 1000, 1378, 1376, 8, 1378, 11, 1402, 1385, 18, 1010, 1542, 1562, 1011, 1391, 24, 1010, 1542, 1562, 1011, 1402, 30, 1010, 1001, 34, 1337, 6, 1337, 6, 1337, 1011, 1408, 1406, 36, 1013, 1408, 1000, 1415, 1413, 6, 1001, 999, 1415, 1000, 1420, 1418, 42, 1420, 1000, 1440, 1423, 42, 1425, 50, 1428, 55, 50, 1431, 60, 1415, 1434, 65, 1696, 1437, 72, 1415, 1440, 77, 1415, 1465, 1443, 42, 1445, 50, 1448, 55, 50, 1451, 60, 1415, 1454, 65, 1696, 1457, 72, 1415, 1460, 77, 1415, 1465, 83, 0, 1841, 2, 1472, 1468, 90, 1472, 1031, 1420, 1472, 1479, 1475, 98, 1477, 101, 1479, 105, 1495, 1485, 1440, 1500, 1001, 1408, 1491, 1465, 1495, 1001, 1408, 1507, 1495, 114, 1001, 1408, 1500, 1498, 114, 1500, 1000, 1507, 1503, 119, 1505, 114, 1507, 1000, 1517, 1515, 0, 1010, 1479, 1011, 1517, 2, 1517, 1000, 1526, 1524, 1030, 1010, 1479, 1011, 999, 1526, 1000, 1537, 1530, 129, 1016, 1532, 139, 1535, 146, 1018, 1537, 1016, 1542, 1540, 153, 1542, 1000, 1556, 1548, 1337, 1032, 1337, 1556, 1553, 0, 1542, 1562, 2, 1556, 160, 1542, 1562, 1560, 1037, 1337, 1562, 1000, 1573, 1567, 164, 1542, 1573, 1571, 168, 1542, 1580, 1573, 1000, 1580, 1578, 164, 1542, 999, 1580, 1000, 1587, 1585, 168, 1542, 999, 1587, 1000, 1595, 1591, 1033, 1337, 1593, 171, 1595, 1000, 1600, 1598, 173, 1600, 1015, 1604, 1603, 173, 1604, 1613, 1611, 6, 1337, 171, 1337, 1604, 1613, 1000, 1622, 1618, 1500, 1001, 1408, 1622, 178, 1537, 1622, 1628, 1628, 1001, 1408, 1798, 1628, 1634, 1632, 6, 1622, 1634, 1000, 1652, 1645, 1500, 1600, 1010, 1001, 1402, 1806, 1011, 1652, 1006, 1652, 178, 1537, 1600, 1001, 1798, 1674, 1663, 1661, 6, 1010, 1001, 1402, 1806, 1011, 1652, 1663, 1000, 1674, 1666, 184, 1668, 188, 1670, 197, 1672, 207, 1674, 216, 1685, 1683, 34, 1012, 1028, 1311, 1351, 1696, 1685, 1685, 1000, 1696, 1694, 6, 1012, 1028, 1311, 1351, 1696, 999, 1696, 1000, 1703, 1701, 0, 1328, 2, 1703, 1000, 1710, 1708, 6, 1321, 999, 1710, 1000, 1715, 1713, 222, 1715, 1000, 1721, 1719, 6, 1337, 1721, 1000, 1734, 1732, 6, 1001, 1408, 0, 1337, 171, 1337, 2, 999, 1734, 1000, 1741, 1739, 24, 1542, 1562, 1741, 1000, 1754, 1744, 1019, 1746, 1006, 1751, 1373, 1542, 1562, 1006, 1754, 1378, 1006, 1767, 1758, 228, 1034, 1761, 234, 1034, 1767, 244, 1010, 1929, 1011, 1773, 1773, 1771, 164, 1929, 1773, 1000, 1790, 1777, 249, 1034, 1785, 259, 1373, 1010, 1542, 1562, 1011, 1754, 1788, 259, 1929, 1790, 1000, 1798, 1796, 264, 1001, 1358, 1790, 1798, 1000, 1806, 1806, 0, 1337, 171, 1337, 1604, 2, 1814, 1812, 34, 1028, 1311, 1351, 1814, 1000, 1823, 1817, 266, 1819, 188, 1821, 273, 1823, 1000, 1834, 1832, 1001, 34, 1337, 6, 1337, 6, 1337, 1834, 1000, 1841, 1839, 6, 1848, 999, 1841, 1000, 1848, 1844, 1001, 1848, 1848, 1834, 1866, 1858, 1852, 1440, 1858, 1858, 0, 1848, 1834, 1866, 2, 1866, 1863, 1500, 1001, 1408, 1866, 178, 1622, 1874, 1872, 168, 1848, 1834, 999, 1874, 1000, 1891, 1880, 4, 1900, 1001, 1891, 1883, 281, 1002, 1886, 1022, 1907, 1891, 286, 1009, 6, 1009, 1900, 1895, 292, 1005, 1898, 294, 1005, 1900, 1000, 1907, 1903, 296, 1905, 34, 1907, 1000, 1929, 1910, 1023, 1913, 1024, 1321, 1916, 1025, 1321, 1919, 1039, 1321, 1924, 1040, 1321, 6, 1321, 1929, 1041, 1321, 6, 1321, 1962, 1938, 1010, 1001, 1358, 1790, 1011, 1587, 1767, 1942, 298, 1001, 1358, 1944, 301, 1948, 308, 1033, 1337, 1951, 315, 1767, 1953, 323, 1958, 328, 1710, 1321, 1715, 1960, 335, 1962, 340, 2091, 1969, 1027, 1010, 1929, 1011, 1741, 1971, 1007, 1979, 1373, 1010, 1542, 1562, 1011, 1754, 1006, 1984, 349, 1035, 1773, 1006, 1989, 356, 1029, 1823, 1006, 1994, 362, 1036, 1734, 1006, 1999, 1378, 356, 1029, 1006, 2006, 1004, 1010, 1440, 1011, 1613, 1006, 2010, 369, 1526, 1006, 2020, 83, 153, 1001, 0, 1848, 1834, 1866, 2, 1006, 2030, 1010, 1814, 1465, 1011, 1595, 1001, 1402, 1507, 1006, 2034, 1663, 1440, 1634, 2038, 373, 1003, 1038, 2042, 381, 1015, 1006, 2051, 387, 1021, 1710, 1321, 1703, 228, 1034, 1006, 2062, 390, 1001, 1408, 0, 1337, 171, 1337, 2, 1721, 1006, 2066, 397, 1006, 1017, 2071, 402, 114, 1001, 1006, 2075, 4, 1874, 1006, 2078, 410, 1006, 2082, 425, 1001, 1006, 2086, 432, 1003, 1006, 2089, 1001, 440, 2091, 1006; %CONSTINTEGER SS= 1962 ! %CONST %BYTE %INTEGER %ARRAY I TO E TAB(0 : 127) = %C X'40',X'40',X'40',X'40',X'40',X'40',X'40',X'40', X'40',X'40',X'15',X'40',X'0C',X'40',X'40',X'40', X'40',X'40',X'40',X'40',X'40',X'40',X'40',X'40', X'40',X'40',X'40',X'40',X'40',X'40',X'40',X'40', X'40',X'4F',X'7F',X'7B',X'5B',X'6C',X'50',X'7D', X'4D',X'5D',X'5C',X'4E',X'6B',X'60',X'4B',X'61', X'F0',X'F1',X'F2',X'F3',X'F4',X'F5',X'F6',X'F7', X'F8',X'F9',X'7A',X'5E',X'4C',X'7E',X'6E',X'6F', X'7C',X'C1',X'C2',X'C3',X'C4',X'C5',X'C6',X'C7', X'C8',X'C9',X'D1',X'D2',X'D3',X'D4',X'D5',X'D6', X'D7',X'D8',X'D9',X'E2',X'E3',X'E4',X'E5',X'E6', X'E7',X'E8',X'E9',X'4A',X'5F',X'5A',X'6A',X'6D', X'7C',X'81',X'82',X'83',X'84',X'85',X'86',X'87', X'88',X'89',X'91',X'92',X'93',X'94',X'95',X'96', X'97',X'98',X'99',X'A2',X'A3',X'A4',X'A5',X'A6', X'A7',X'A8',X'A9',X'C0',X'40',X'D0',X'40',X'40' %INCLUDE "PERQ_OPCODES" %CONSTINTEGER FIRST UCUB=150 %CONSTINTEGER FIRST UCSB=177 %CONSTINTEGER FIRST UCW=179 %CONSTINTEGER FIRST UCUBUB=189 %CONSTINTEGER FIRST UCUBW=195 %CONSTSTRING(7)%ARRAY QCODES(0:199) =%C "LDC0","LDC1","LDC2","LDC3","LDC4","LDC5","LDC6","LDC7", "LDC8","LDC9","LDC10","LDC11","LDC12","LDC13","LDC14","LDC15", "LDCN","LDCMO","LDL0","LDL1","LDL2","LDL3","LDL4","LDL5","LDL6", "LDL7","LDL8","LDL9","LDL10","LDL11","LDL12","LDL13","LDL14", "LDL15","STL0","STL1","STL2","STL3","STL4","STL5","STL6","STL7", "LDO0","LDO1","LDO2","LD03","LDO4","LDO5","LDO6","LDO7","LDO8", "LDO9","LDO10","LDO11","LDO12","LDO13","LDO14","LDO15","STO0", "STO1","STO2","STO3","STO4","STO5","STO6","STO7","STIND","LDIND", "LDDW","STDW","LDMW","STMW","LDB","STB","MVBW","SAS","LDCH","LDP", "STP","STCH","MOVW","SIND0","SIND1","SIND2","SIND3","SIND4", "SIND5","SIND6","SIND7","IXAW","IXA1","IXA2","IXA3","IXA4", "LAND","LOR","LNOT","ABI","ADI","NGI","SBI","MPI","DVI","MODI", "CHK","EQUI","NEQI","LEQI","LESI","GEQI","GTRI", "SGS","SRS","INN","UNI","INT","DIF", "EQUPOWR","NEQPOWR","LEQPOWR","GEQPOWR","EQUSTR","NEQSTR", "LEQSTR","LESSTR","GEQSTR","GTRSTR","CALLV","RETURN","NOOP", "REPL","REPL2","MMS","MES","MMS2","MES2","RASTER","EXCH","EXCH2", "TLATE1","TLATE2","TLATE3","LSSN","LDTP","LDAP","ATP","WCS", "JCS","REFILL","INCDDS", "LDLB","LLAB","STLB","LDOB","LOAB","STOB","LDMC", "MVBB","LSA","MOVB","INDB","INCB","IXAB","IXP","ROTSHI","ADJ", "EQUBYT","NEQBYT","LEQBYT","LESBYT","GEQBYT","GTRBYT", "EQUWORD","NEQWORD","LOPS","CALL","STLATE","LDCB","ATPB", "LDCW","LDLW","LLAW","STLW","LDOW","LOAW","STOW", "INDW","INCW","XJP","LDGB","LGAB","STGB","LDIB", "LIAB","STIB","CALLXB",""(*); %CONSTBYTEINTEGERARRAY OPC(0:199)=%C LDC0+0,LDC0+1,LDC0+2,LDC0+3,LDC0+4,LDC0+5,LDC0+6,LDC0+7, LDC0+8,LDC0+9,LDC0+10,LDC0+11,LDC0+12,LDC0+13,LDC0+14,LDC0+15, LDCN,LDCMO,LDL0+0,LDL0+1,LDL0+2,LDL0+3,LDL0+4,LDL0+5,LDL0+6, LDL0+7,LDL0+8,LDL0+9,LDL0+10,LDL0+11,LDL0+12,LDL0+13,LDL0+14, LDL0+15,STL0+0,STL0+1,STL0+2,STL0+3,STL0+4,STL0+5,STL0+6,STL0+7, LDO0+0,LDO0+1,LDO0+2,LDO0+3,LDO0+4,LDO0+5,LDO0+6,LDO0+7,LDO0+8, LDO0+9,LDO0+10,LDO0+11,LDO0+12,LDO0+13,LDO0+14,LDO0+15, STO0+0,STO0+1,STO0+2,STO0+3,STO0+4,STO0+5,STO0+6,STO0+7, STIND,LDIND,LDDW,STDW,LDMW,STMW,LDB,STB,MVBW,SAS, LDCH,STCH,MOVW,SIND0+0,SIND0+1,SIND0+2,SIND0+3,SIND0+4,SIND0+5, SIND0+6,SIND0+7,IXAW,IXA1,IXA1+1,IXA1+2,IXA1+3, LDP,STP,LAND,LOR,LNOT,ABI,ADI,NGI, SBI,MPI,DVI,MODI,CHK,EQUI,NEQI,LEQI,LESI, GEQI,GTRI,SGS,SRS,INN,UNI,SETINT,DIF, EQUPOWR,NEQPOWR,LEQPOWR,GEQPOWR,EQUSTR,NEQSTR, LEQSTR,LESSTR,GEQSTR,GTRSTR,CALLV,RETURN,NOOP, REPL,REPL2,MMS,MES,MMS2,MES2,RASTER,EXCH,EXCH2, TLATE1,TLATE2,TLATE3,LSSN,LDTP,LDAP,ATPW,WCS, JCS,REFILL,INCDDS, LDLB,LLAB,STLB,LDOB,LOAB,STOB,LDMC, MVBB,LSA,MOVB,INDB,INCB,IXAB,IXP,ROTSHI,ADJ, EQUBYT,NEQBYT,LEQBYT,LESBYT,GEQBYT,GTRBYT, EQUWORD,NEQWORD,LOPS,CALL,STLATE,LDCB,ATPB, LDCW,LDLW,LLAW,STLW,LDOW,LOAW,STOW, INDW,INCW,XJP,LDGB,LGAB,STGB,LDIB, LIAB,STIB,CALLXB,0(*); %CONSTBYTEINTEGERARRAY ONE CASE(0 : 127) = %C 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15, 16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31, 32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47, 48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63, 64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79, 80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95, 96,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79, 80,81,82,83,84,85,86,87,88,89,90,123,124,125,126,127; %CONSTINTEGER MAXLEVELS=31,COMMALT=2,DECALT=8,ENDALT=9,SNPT=X'1006' %SYSTEMINTEGERMAPSPEC COMREG(%INTEGER I) %CONSTBYTEINTEGERARRAY TRTAB(0:255)=0(48),1(10), 0(7),2(26),0(6),2(26),0(*); %INCLUDE "ERCC07.PERQ_FORMATS" %EXTRINSICRECORD(PARMF)PARM %EXTRINSICRECORD(WORKAF)WORKA %EXTERNALINTEGERFN PASSONE(%ROUTINE POP(%INTEGERNAME A,B,C,D), %ROUTINE PUSH(%INTEGERNAME A,%INTEGER B,C,D)) %EXTERNALROUTINESPEC FAULT(%INTEGER A,B,C) %ROUTINESPEC READ LINE(%INTEGER MODE,CHAR) %INTEGERFNSPEC COMPARE(%INTEGER P) %ROUTINESPEC PNAME(%INTEGER MODE) %ROUTINESPEC CONST(%INTEGER MODE) %ROUTINESPEC TEXTTEXT(%INTEGER EBCDIC) %ROUTINESPEC TOAR2(%INTEGER PTR,VALUE) %ROUTINESPEC TOAR4(%INTEGER PTR,VALUE) %ROUTINESPEC TOAR8(%INTEGER PTR,%LONGREAL VALUE) %CONSTINTEGER NO OF SNS=63 %CONSTINTEGER LRLPT=X'52' %CONSTHALFINTEGERARRAY TSNAME (0:NO OF SNS)=X'1000'(8), X'1041',X'1000'(5),X'1051',X'1000'+LRLPT, X'1041'(2),X'1000'+LRLPT, X'1000'(2),X'52',X'51',LRLPT,X'1000'+LRLPT(7), X'1000',X'31',X'51',X'1000'+LRLPT(2),X'31',X'1000', X'4051',LRLPT,X'1000'(2),X'35',X'1000',X'1035', X'31',X'35',X'1035',X'33',0,X'1001',X'51',X'4052',X'51', X'61',X'72',X'61',X'72',X'51',LRLPT,X'1051',X'41', X'1000',LRLPT; %CONSTINTEGERARRAY PRECONSTS(0:3)=10,0,{NL}X'413243F6',X'A8885A31'{PI}; %INTEGER I,J,K,LENGTH,LEVEL,QMAX,Q,R,S,SNUM,NNAMES,DSIZE,NEXT,JJ,CPTR, ATLINE1,STARSTART,ARSIZE,HIT,CTYPE,LASTAT,LASTNAME,LASTEND,STRLINK %LONGREAL IMAX %STRING(7)NEM %INTEGERNAME LINE %BYTEINTEGERARRAYNAME CC,A %INTEGERARRAYNAME WORD,TAGS LINE==WORKA_LINE CC==WORKA_CC A==WORKA_A TAGS==WORKA_TAGS WORD==WORKA_WORD NNAMES=WORKA_NNAMES DSIZE=7*NNAMES ARSIZE=768*WORKA_WKFILEK-300 IMAX=(-1)>>1 %INTEGERARRAY SFS(0:MAXLEVELS) %BYTEINTEGERARRAY TLINE(-60:161),LETT(0:DSIZE+20) %CONSTBYTEINTEGERARRAY ILETT(0: 501)= 11, 'S','E','L','E','C','T','I','N','P','U','T', 12,'S','E','L','E', 'C','T','O','U','T','P','U','T', 7,'N','E','W','L','I','N','E', 5,'S','P','A','C','E', 10,'S','K','I','P','S','Y','M','B','O', 'L', 10,'R','E','A','D','S','T','R','I','N','G', 8,'N','E','W', 'L','I','N','E','S', 6,'S','P','A','C','E','S', 10,'N','E','X', 'T','S','Y','M','B','O','L', 11,'P','R','I','N','T','S','Y','M', 'B','O','L', 10,'R','E','A','D','S','Y','M','B','O','L', 4,'R', 'E','A','D', 5,'W','R','I','T','E', 7,'N','E','W','P','A','G', 'E', 4,'A','D','D','R', 6,'A','R','C','S','I','N', 3,'I','N', 'T', 5,'I','N','T','P','T', 6,'F','R','A','C','P','T', 5,'P', 'R','I','N','T', 7,'P','R','I','N','T','F','L', 4,'R','E','A', 'L', 7,'I','N','T','E','G','E','R', 3,'M','O','D', 6,'A','R', 'C','C','O','S', 4,'S','Q','R','T', 3,'L','O','G', 3,'S','I', 'N', 3,'C','O','S', 3,'T','A','N', 3,'E','X','P', 11,'C','L', 'O','S','E','S','T','R','E','A','M', 11,'B','Y','T','E','I','N', 'T','E','G','E','R', 8,'E','V','E','N','T','I','N','F', 6,'R','A','D','I','U','S', 6,'A','R','C','T','A','N', 6,'L','E','N','G','T','H', 11,'P','R','I','N','T','S','T','R', 'I','N','G', 2,'N','L', 8,'L','O','N','G','R','E','A','L', 7, 'P','R','I','N','T','C','H', 6,'R','E','A','D','C','H', 6,'S', 'T','R','I','N','G', 8,'R','E','A','D','I','T','E','M', 8,'N', 'E','X','T','I','T','E','M', 6,'C','H','A','R','N','O', 8,'T', 'O','S','T','R','I','N','G', 9,'S','U','B','S','T','R','I', 'N','G', 6,'R','E','C','O','R','D', 5,'A','R','R','A','Y', 6, 'S','I','Z','E','O','F',4,'I','M','O','D',2,'P', 'I',9,'E','V','E','N','T','L','I','N','E',11,'L','O','N','G', 'I','N','T','E','G','E','R',12,'L','O','N','G','L','O','N','G', 'R','E','A','L',9,'L','E','N','G','T','H','E','N','I', 9,'L','E','N','G','T','H','E','N','R', 8,'S','H','O','R','T','E','N','I', 8,'S','H','O','R','T','E','N','R', 6,'N','E','X','T','C','H', 11,'H','A','L','F','I','N','T','E','G','E','R', 8,'P','P','R','O','F','I','L','E', 5,'F','L','O','A','T',255; LETT(0)=0 ATLINE1=ADDR(TLINE(1)) LEVEL=0 WORKA_DICTBASE=ADDR(LETT(0)) %CYCLE I=0,1,MAXLEVELS SFS(I)=0 %REPEAT %CYCLE I=0,1,NNAMES WORD(I)=0; TAGS(I)=0; %REPEAT PARM_OPT=1; PARM_ARR=1 PARM_LINE=1; PARM_TRACE=1; PARM_DIAG=1 PARM_CHK=1 I=PARM_BITS1 %IF I&4=4 %THEN PARM_DIAG=0 %IF I&X'800000'#0 %THEN PARM_LINE=0 %IF I&16=16 %THEN PARM_CHK=0 PARM_LIST=(I>>1&1)!!1 PARM_FREE=I>>19&1 %IF I&32=32 %THEN PARM_ARR=0 PARM_PROF=(I>>15&1)!(I>>7&1); ! USE MAP OR PROFILE BIT PRO TEM PARM_DYNAMIC=I>>20&1 PARM_LET=I>>13&1 PARM_DCOMP=I>>14&1; ! PARM CODE OR D PARM_DBUG=I>>18&1 %IF I&64=64 %THEN PARM_TRACE=0 %AND PARM_DIAG=0 PARM_SMAP=I>>26&1; ! USE PARMZ BIT FOR DUMPING WKFILE PARM_X=I>>28&1; ! DONT REFORMAT REALS FOR SIMULATOR PARM_TTOPUT=COMREG(40) %IF I&(1<<16)#0 %THEN %START PARM_ARR=0; PARM_OPT=0 PARM_LINE=0; PARM_CHK=0; PARM_DIAG=0 %FINISH PARM_TRACE=PARM_TRACE!PARM_OPT; ! ALLOW NOTRACE ONLY WITH OPT NEWLINES(3); SPACES(14) PRINTSTRING("ERCC. PERQ Imp80") PRINTSTRING(" Compiler Release") WRITE(WORKA_RELEASE,1) PRINTSTRING(" Version ".WORKA_LADATE) NEWLINES(3) WRITE(NNAMES,5); WRITE(WORKA_ASL MAX,5) NEWLINE ! ! NOW DECLARE THE SPECIAL NAMES WHICH ARE IN ARRAY ILETT. ! CPTR=0; SNUM=0; STRLINK=0 K=0; NEXT=1 I=ILETT(0) %WHILE I<255 %CYCLE %CYCLE J=I,-1,1 CC(J)=ILETT(K+J) %REPEAT CC(I+1)=';' R=2; Q=1; PNAME(1) JJ=TSNAME(SNUM) %IF JJ&X'C000'#X'4000' %START; ! NOT A CONST VARAIBLE PUSH(TAGS(LASTNAME),SNPT<<16!X'8000',JJ,SNUM<<16) %FINISH %ELSE %START PUSH(TAGS(LASTNAME),JJ<<16!X'8000', PRECONSTS(CPTR),PRECONSTS(CPTR+1)) CPTR=CPTR+2 %FINISH SNUM=SNUM+1 K=K+I+1; I=ILETT(K) %REPEAT ! COMREG(24)=16; ! RETURN CODE LINE=0; LENGTH=0; Q=1 R=1; LEVEL=1 %CYCLE %IF Q>=LENGTH %THEN QMAX=1 %AND READ LINE(0,0) STARSTART=R R=R+3 A(R)=LINE>>8 A(R+1)=LINE&255 R=R+2 %IF COMPARE(SS)=0 %THEN %START FAULT(100,ADDR(CC(Q)),(QMAX-Q)<<16!LENGTH) R=STARSTART Q=Q+1 %WHILE CC(Q)#';' %AND QARSIZE %IF A(STARSTART+5)=COMMALT %THEN R=STARSTART %ELSE %START I=R-STARSTART A(STARSTART)=I>>16 A(STARSTART+1)=I>>8&255 A(STARSTART+2)=I&255 !*DELSTART %IF PARM_SMAP#0 %THEN %START NEWLINE; WRITE(LINE, 5) WRITE(STARSTART,5); NEWLINE; J=0 %CYCLE I=STARSTART, 1, R-1 WRITE(A(I), 5) J=J+1 %IF J>=20 %THEN NEWLINE %AND J=0 %REPEAT NEWLINE %FINISH !*DELEND %IF A(STARSTART+5)=ENDALT %AND %C 1<=A(STARSTART+6)<=2 %START;! ENDOF PROG OR FILE %EXIT %FINISH %IF LEVEL=0 %THEN %START FAULT(14, 0, 0) R=STARSTART; ! IGNORE IT LEVEL=1 %FINISH %FINISH %FINISH %REPEAT TO AR8(R,0); R=R+8 %IF R+NEXT>ARSIZE %THEN FAULT(102, WORKA_WKFILEK,0) %CYCLE I=0,1,NEXT A(R+I)=LETT(I) %REPEAT WORKA_DICTBASE=ADDR(A(R)) R=R+NEXT+1 %IF LEVEL>1 %THEN FAULT(15,LEVEL-1,0) R=(R+7)&(-8) NEWLINE %IF PARM_FAULTY=0 %THEN %START WRITE(LINE, 5) PRINT STRING(" LINES ANALYSED SIZE=") WRITE(R, 5) %IF LINE>90 %AND PARM_LIST#0 %THEN NEWPAGE %ELSE NEWLINE %FINISH %ELSE %START PRINTSTRING("CODE GENERATION NOT ATTEMPTED ") COMREG(24)=8 COMREG(47)=PARM_FAULTY %STOP %FINISH %RESULT=R %ROUTINE READ LINE(%INTEGER MODE,CHAR) %ROUTINESPEC GET LINE %INTEGER DEL, LL, LP, PREV LL=0; LP=0; Q=1 LENGTH=0; DEL=0 NEXT: LP=LP+1 %IF LP>LL %THEN GET LINE %AND LP=1 I=TLINE(LP) %IF MODE=0 %THEN %START %IF I='{' %THEN %START %CYCLE PREV=I LP=LP+1 I=TLINE(LP) %REPEAT %UNTIL PREV='}' %OR I=NL %FINISH %IF I='%' %THEN DEL=128 %AND ->NEXT I=ONE CASE(I) %IF 'A'<=I<='Z' %THEN I=I!DEL %ELSE %START DEL=0 ->NEXT %IF I=' ' %FINISH LENGTH=LENGTH+1 CC(LENGTH)=I %IF I='''' %OR I=34 %THEN MODE=1 %AND CHAR=I %FINISH %ELSE %START LENGTH=LENGTH+1 CC(LENGTH)=I %IF I=CHAR %THEN MODE=0 %FINISH ->NEXT %UNLESS I=NL I=CC(LENGTH-1) %IF I='C'+128 %THEN LENGTH=LENGTH-2 %AND ->NEXT %IF MODE=0 %AND I=',' %THEN LENGTH=LENGTH-1 %AND ->NEXT FAULT(101,0,0) %IF LENGTH>WORKA_CCSIZE %RETURN %ROUTINE GET LINE %SYSTEMROUTINESPEC IOCP(%INTEGER A,B) %CONSTBYTEINTEGERARRAY ITOI(0:255)=%C 32(10),10,32(14),25,26,32(5), 32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47, 48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63, 64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79, 80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95, 96,97,98,99,100,101,102,103,104,105,106,107,108,109, 110,111,112,113,114,115,116,117,118,119, 120,121,122,123,124,125,126,32, 26(5),10,26(10), 26(16), 26(14),92,38, 26(11),35,26(4), 26(16), 26(9),35,26(5),94, 26(32); %INTEGER K LL=0 %UNTIL K=NL %CYCLE READ SYMBOL(K) TLINE(LL+1)=ITOI(K) LL=LL+1 %REPEAT LINE=LINE+1; ! COUNT ALL LINES %IF PARM_LIST#0 %THEN %START %IF MODE=0 %AND LENGTH>0 %THEN %C PRINTSTRING(" C") %ELSE WRITE(LINE, 5) ! SPACES(8) %CYCLE K=-7,1,0 TLINE(K)=' ' %REPEAT %IF MODE#0 %THEN TLINE(-7)=M'"' TLINE(-8)=LL+8 IOCP(15,ADDR(TLINE(-8))) %FINISH %IF PARM_FREE=0 %AND LL>73 %THEN TLINE(73)=10 %AND LL=73 %END %END %INTEGERFN COMPARE(%INTEGER P) %INTEGER I, J, ITEM, RA, RL, RP, RQ, RR, RS, MARKER, SSL, ALT, PP %OWNINTEGER SAVECOMP; ! FOR CHECKING DSIDED CONDS %SWITCH BIP(999:1043) RP=SYMBOL(P) RL=LEVEL P=P+1 PP=P; ! ROUTINE REALLY STARTS HERE COMM: RQ=Q; ! RESET VALUES OF LINE&AR PTRS RR=R SSL=STRLINK; ! SAVE STRING LINK ALT=1; ! FIRST ALTERNATIVE TO BE TRIED RA=SYMBOL(P); ! RA TO NEXT PHRASE ALTERNATIVE RS=P UPR: R=R+1 SUCC: ! SUCCESS ON TO NEXT ITEM RS=RS+1; ! RS=NEXT ALTERNATIVE MEANS THAT ! THIS ALT HAS BEEN COMPLETED SO ! EXIT WITH HIT=1 %IF RS=RA %THEN ->FINI ITEM=SYMBOL(RS); ! NEXT BRICK IN THE CURRENT ALT %IF ITEM<999 %THEN ->LIT %IF ITEM<1300 %THEN ->BIP(ITEM) ! BRICK IS A PHRASE TYPE %IF COMPARE(ITEM)=0 %THEN ->FAIL ->SUCC LIT: ! BRICK IS LITERAL I=CC(Q); ! OBTAIN CURRENT CHARACTER ->FAIL %UNLESS I=CLETT(ITEM+1) Q=Q+1 K=CLETT(ITEM)+ITEM ITEM=ITEM+2 %WHILE ITEM<=K %CYCLE ->FAIL %UNLESS CC(Q)=CLETT(ITEM) Q=Q+1 ITEM=ITEM+1 %REPEAT; ! CHECK IT WITH LITERAL DICT ENTRY ->SUCC; ! MATCHED SUCCESSFULLY FAIL: ! FAILURE - NOTE POSITION REACHD %IF RA=RP %THEN ->TFAIL; ! TOTAL FAILURE NO ALT TO TRY QMAX=Q %IF Q>QMAX Q=RQ; ! RESET LINE AND A.R. POINTERS R=RR+1; ! AVOID GOING VIA UPR: STRLINK=SSL ALT=ALT+1; ! MOVE TO NEXT ALT OF PHRASE RS=RA RA=SYMBOL(RA) ->SUCC TFAIL: LEVEL=RL %RESULT=0 BIP(999): ! REPEATED PHRASE A(RR)=ALT; P=PP ->COMM BIP(1000):FINI: ! NULL ALWAYS LAST & OK A(RR)=ALT %RESULT=1 BIP(1001): ! PHRASE NAME I=CC(Q); ! OBTAIN CURRENT CHARACTER ->FAIL %UNLESS TRTAB(I)=2 PNAME(ITEM-1004) ->SUCC %IF HIT=1; ->FAIL BIP(1002): ! PHRASE INTEGER CONSTANT BIP(1003): ! PHRASE CONST CONST(ITEM-1003) ->FAIL %IF HIT=0 ->SUCC BIP(1004): ! PHRASE CHECK EXTENDEDTYPE ! FIRST LETTER IS (B,H,I,L,R,S) ! 3RD LETTER (A,C,L,N,O,R,T) I=CC(Q) ->FAIL %UNLESS I>128 %AND X'80000000'>>(I&31)&X'20C83000'#0%C %AND X'80000000'>>(CC(Q+2)&31)&X'500B2800'#0 ->SUCC BIP(1005): ! PHRASE N I=CC(Q); ! OBTAIN CURRENT CHARACTER ->FAIL %UNLESS '0'<=I<='9' S=0 %WHILE '0'<=I<='9' %CYCLE S=10*S+I&15 Q=Q+1; I=CC(Q) %REPEAT TOAR2(R,S) R=R+2; ->SUCC BIP(1006): ! PHRASE S=SEPARATOR I=CC(Q); ! OBTAIN CURRENT CHARACTER ->SUCC %IF I=NL ->FAIL %UNLESS I=';' Q=Q+1; ->SUCC BIP(1007): ! PHRASE COMMENT TEXT I=CC(Q); ! OBTAIN CURRENT CHARACTER ->FAIL %UNLESS I='!' %OR I='|' %OR (I='C'+128 %AND CC(Q+1)=%C 'O'+128 %AND CC(Q+2)=CC(Q+3)='M'+128 %AND CC(Q+4)='E'+128 %C %AND CC(Q+5)='N'+128 %AND CC(Q+6)='T'+128) Q=Q+1+6*(I>>7); J=CC(Q) %CYCLE %EXIT %IF J=NL Q=Q+1; J=CC(Q) %REPEAT ->SUCC BIP(1008): ! PHRASE BIGHOLE TO AR4(R,0) R=R+4; ->SUCC BIP(1009): ! PHRASE N255 I=CC(Q); ! OBTAIN CURRENT CHARACTER ->FAIL %UNLESS '0'<=I<='9' S=0 %WHILE '0'<=I<='9' %CYCLE S=10*S+I&15 Q=Q+1; I=CC(Q) %REPEAT ->FAIL %UNLESS 0<=S<=255 A(R)=S; ->UPR BIP(1010): ! PHRASE HOLE MARKER=R; R=R+2; ->SUCC BIP(1011): ! PHRASE MARK I=R-MARKER A(MARKER+1)<-I A(MARKER)<-I>>8 ->SUCC BIP(1012): ! PHRASE READLINE? I=CC(Q); ! OBTAIN CURRENT CHARACTER %WHILE I=NL %%CYCLE READLINE(0,0) RQ=1 I=CC(Q) %REPEAT FAULT(102, WORKA_WKFILEK,0) %IF R>ARSIZE ->SUCC BIP(1013): ! PHRASE CHECKIMPS R=R-4; ! AVOID HOLE LEFT BY TEXTTEXT TEXTTEXT(0) ->FAIL %IF HIT=0 ->SUCC BIP(1014): ! PHRASE DUMMY APP A(R)=2; A(R+1)=2 R=R+2; ->SUCC BIP(1015): ! PHRASE DOWN=NEW TEXT LEVEL LEVEL=LEVEL+1 SFS(LEVEL)=0 ->SUCC BIP(1016): ! PHRASE UP 1 TEXTUAL LEVEL %WHILE SFS(LEVEL)#0 %CYCLE POP(SFS(LEVEL),I,J,K) %IF I=1 %THEN FAULT(53,K,0); ! FINISH MISSING %IF I=2 %THEN FAULT(13,K,0); ! %REPEAT MISSING %REPEAT LEVEL=LEVEL-1 ->SUCC BIP(1017): ! PHRASE LISTON PARM_LIST=1; ->SUCC BIP(1018): ! PHRASE LISTOFF PARM_LIST=0; ->SUCC BIP(1019): ! PHRASE COLON FOR LABEL ->FAIL %UNLESS CC(Q-1)=':' ->SUCC BIP(1020): ! PHRASE NOTE CONST ->SUCC BIP(1021): ! TRACE FOR ON CONDITIONS PARM_TRACE=1; ->SUCC BIP(1022): ! SET MNEMONIC I=CC(Q); ! OBTAIN CURRENT CHARACTER J=0 NEM="1234567" %WHILE 'A'<=I<='Z' %OR '0'<=I<='9' %CYCLE J=J+1 CHARNO(NEM,J)=I Q=Q+1; I=CC(Q) %REPEAT ->FAIL %UNLESS J>0 BYTEINTEGER(ADDR(NEM))=J %IF I='_' %THEN Q=Q+1 ->SUCC BIP(1023): ! UCNOP MNEMONIC SANS OPERANDS ->FAIL %IF CC(Q-1)='_' %CYCLE I=0,1,FIRSTUCUB-1 ->PFND %IF NEM=QCODES(I) %REPEAT ->FAIL PFND: A(R)=OPC(I); ->UPR BIP(1024): ! UCUB MNEMONIC WITH UNSIGNED BYTE OPERAND %CYCLE I=FIRST UCUB,1,FIRST UCSB-1 ->PFND %IF NEM=QCODES(I) %REPEAT ->FAIL BIP(1025): ! UCUB SIGNED BYTE OPERANDS %CYCLE I=FIRST UCSB,1,FIRST UCW-1 ->PFND %IF NEM=QCODES(I) %REPEAT; ->FAIL BIP(1026): ! P(OP)=+,-,&,****,**,*,!!,!, ! //,/,>>,<<,.,\\,\ I=CC(Q); ! OBTAIN CURRENT CHARACTER ->FAIL %UNLESS 32>((I-32)&31)&X'4237000A'#0 Q=Q+1 %IF I='+' %THEN A(R)=1 %AND ->UPR %IF I='-' %THEN A(R)=2 %AND ->UPR %IF I='&' %THEN A(R)=3 %AND ->UPR J=CC(Q) %IF I='*' %THEN %START %IF J#I %THEN A(R)=6 %AND ->UPR %IF CC(Q+1)=I=CC(Q+2) %THEN A(R)=4 %AND Q=Q+3 %AND ->UPR A(R)=5; Q=Q+1; ->UPR %FINISH %IF I='/' %THEN %START %IF J#I %THEN A(R)=10 %AND ->UPR A(R)=9; Q=Q+1; ->UPR %FINISH %IF I='!' %THEN %START %IF J#I %THEN A(R)=8 %AND ->UPR A(R)=7; Q=Q+1; ->UPR %FINISH %IF I='.' %THEN A(R)=13 %AND ->UPR %IF I=J='<' %THEN A(R)=12 %AND Q=Q+1 %AND ->UPR %IF I=J='>' %THEN A(R)=11 %AND Q=Q+1 %AND ->UPR %IF I='\' %THEN %START %IF J#I %THEN A(R)=15 %AND ->UPR Q=Q+1; A(R)=14; ->UPR %FINISH ->FAIL BIP(1027): ! PHRASE CHECK UI I=CC(Q); ! OBTAIN CURRENT CHARACTER ->SUCC %IF TRTAB(I)=2 %OR I='-' ->SUCC %IF X'80000000'>>(I&31)&X'14043000'#0 ->FAIL BIP(1028): ! P(+')=+,-,\,0 I=CC(Q); ! OBTAIN CURRENT CHARACTER %IF I='\' %OR I=X'7E' %THEN A(R)=3 %AND Q=Q+1 %AND ->UPR %IF I='-' %THEN A(R)=2 %AND Q=Q+1 %AND ->UPR %IF I='+' %THEN A(R)=1 %AND Q=Q+1 %AND ->UPR A(R)=4; ->UPR BIP(1029): ! PHRASE NOTE CYCLE TOAR4(R,0) PUSH(SFS(LEVEL),2,R,LINE) R=R+4 ->SUCC BIP(1030): ! P(,')=',',0 ! ! THIS IS VERY AWKWARD AS IT MEANS IT IS VERY TO HARD TO FIND ! THE END OF A PARAMETER LIST WITHOUT CHURNING. BY MAKING THIS A BIP ! WE CAN PEEP AHEAD FOR ')' AND FAIL HERE. ! I=CC(Q); ! OBTAIN CURRENT CHARACTER %IF I=')' %THEN ->FAIL %IF I=',' %THEN Q=Q+1 ->SUCC BIP(1031): ! PHRASE CHECKTYPE IE ENSURE ! FIRST LETTER IS(B,H,I,L,R,S) & ! 3RD LETTER IS (A,L,N,O,R,T) I=CC(Q); ! OBTAIN CURRENT CHARACTER ->FAIL %UNLESS I>128 %AND X'80000000'>>(I&31)&X'20C83000'#0%C %AND X'80000000'>>(CC(Q+2)&31)&X'400B2800'#0 ->SUCC BIP(1032): ! PHRASE COMP1 BIP(1037): ! PHRASE COMP2(IS 2ND HALF OF DSIDED) I=CC(Q); ! OBTAIN CURRENT CHARACTER ->FAIL %UNLESS 32>(I&31)&X'1004000E'#0 ! '='=1,'>='=2,'>'=3 ! '#' OR '\=' OR '<>'=4 ! '<='=5,'<'=6 ! 7UNUSED,'->'=8,'=='=9 ! '##' OR '\==' =10 %IF I='=' %THEN %START %IF CC(Q+1)=I %THEN J=9 %AND ->JOIN1 J=1; ->JOIN %FINISH %IF I='#' %THEN %START %IF CC(Q+1)=I %THEN J=10 %AND ->JOIN1 J=4; ->JOIN %FINISH %IF I='\' %AND CC(Q+1)='=' %THEN %START Q=Q+1 %IF CC(Q+1)='=' %THEN J=10 %AND ->JOIN1 J=4; ->JOIN %FINISH %IF I='>' %THEN %START %IF CC(Q+1)='=' %THEN J=2 %AND ->JOIN1 J=3; ->JOIN %FINISH %IF I='<' %THEN %START %IF CC(Q+1)='>' %THEN J=4 %AND ->JOIN1 %IF CC(Q+1)='=' %THEN J=5 %AND ->JOIN1 J=6; ->JOIN %FINISH %IF I='-' %AND CC(Q+1)='>' %THEN J=8 %AND ->JOIN1 ->FAIL JOIN1:Q=Q+1 JOIN: Q=Q+1 A(R)=J %IF ITEM=1032 %THEN SAVECOMP=J %AND ->UPR ! SAVE J TO CHECK DSIDED %IF SAVECOMP>6 %OR J>6 %THEN Q=Q-1 %AND ->FAIL;! ILLEGAL DSIDED ->UPR; ! NB OWNS WONT WORK IF ! COND EXPRS ALLOWED AS THE ! CAN BE NESTED! BIP(1033): ! P(ASSOP)- ==,=,<-,-> I=CC(Q); ! OBTAIN CURRENT CHARACTER %IF I='=' %THEN %START %IF CC(Q+1)='=' %THEN A(R)=1 %AND Q=Q+2 %AND ->UPR A(R)=2; Q=Q+1; ->UPR %FINISH %IF I='<' %AND CC(Q+1)='-' %THEN A(R)=3 %AND Q=Q+2 %AND ->UPR %IF I='-' %AND CC(Q+1)='>' %THEN A(R)=4 %AND Q=Q+2 %AND ->UPR ->FAIL BIP(1034): ! NOTE START TOAR4(R,0); ! HOLE FOR FORWARD PTR PUSH(SFS(LEVEL),1,R,LINE) R=R+4 ->SUCC BIP(1035): ! NOTE FINISH %IF SFS(LEVEL)=0 %THEN FAULT(51,0,0) %AND ->SUCC POP(SFS(LEVEL),I,J,K) %IF I=2 %THEN FAULT(59,K,0) TOAR4(J,STARSTART) ->SUCC BIP(1036): ! NOTE REPEAT %IF SFS(LEVEL)=0 %THEN FAULT(1,0,0) %AND ->SUCC POP(SFS(LEVEL),I,J,K) %IF I=1 %THEN FAULT(52,K,0); ! START INSTEAD OF CYCLE TOAR4(J,STARSTART) ->SUCC BIP(1038): ! INCLUDE "FILE" ->FAIL BIP(1039): ! UCW = USERCODE WORD OFFSET INSTRS %CYCLE I=FIRST UCW,1,FIRST UCUBUB-1 ->PFND %IF NEM=QCODES(I) %REPEAT ->FAIL BIP(1040): ! UCUBUB TWO UNSIGNED BYTE OPERANDS %CYCLE I=FIRST UCUBUB,1,FIRST UCUBW-1 ->PFND %IF NEM=QCODES(I) %REPEAT; ->FAIL BIP(1041): ! UCUCUBW - BYTE&WORD OPERANDS %CYCLE I=94,1,106 %REPEAT; ->FAIL BIP(1042): ! UCPD = DECIMAL MNEMONICS %CYCLE I=108,1,116 %REPEAT; ->FAIL BIP(1043): ! UCSPEC THE FUNNIES %CYCLE I=11,1,120 %REPEAT; ->FAIL %END; !OF ROUTINE 'COMPARE' %ROUTINE PNAME(%INTEGER MODE) !*********************************************************************** !* MODE=0 FOR OLD NAME(ALREADY IN DICT), MODE=1 FOR NEW NAME * !*********************************************************************** %CONSTINTEGERARRAY HASH(0:7)=71,47,97,79,29,37,53,59; %INTEGER JJ, KK, LL, FQ, FS, T, S, I HIT=0; FQ=Q; FS=CC(Q) %RETURN %UNLESS TRTAB(FS)=2 %AND M'"'#CC(Q+1)#M'''' ! 1ST CHAR MUST BE LETTER T=1 LETT(NEXT+1)=FS; JJ=71*FS %CYCLE Q=Q+1 I=CC(Q) %EXIT %IF TRTAB(I)=0 JJ=JJ+HASH(T) %IF T<=7 T=T+1 LETT(NEXT+T)=I %REPEAT LETT(NEXT)=T; ! INSERT LENGTH S=T+1 FAULT(103,0,0) %IF NEXT+S>DSIZE; !DICTIONARY OVERFLOW JJ=(JJ+113*T)&NNAMES %CYCLE KK=JJ, 1, NNAMES LL=WORD(KK) ->HOLE %IF LL=0; ! NAME NOT KNOWN ->FND %IF STRING(ADDR(LETT(NEXT)))=STRING(ADDR(LETT(LL))) %REPEAT %CYCLE KK=0,1,JJ LL=WORD(KK) ->HOLE %IF LL=0; ! NAME NOT KNOWN ->FND %IF STRING(ADDR(LETT(NEXT)))=STRING(ADDR(LETT(LL))) %REPEAT FAULT(104, 0, 0); ! TOO MANY NAMES HOLE: %IF MODE=0 %THEN Q=FQ %AND %RETURN WORD(KK)=NEXT; NEXT=NEXT+S FND: LASTAT=FQ; HIT=1; LASTNAME=KK A(R+1)<-LASTNAME A(R)=LASTNAME>>8; R=R+2 LASTEND=Q %END %ROUTINE CONST(%INTEGER MODE) !*********************************************************************** !* SYNTAX CHECK AND EVALUATE ALL THE FORMS OF IMP CONSTANT * !* MODE=0 FOR INTEGER CONSTANTS #0 FOR ANY SORT OF CONSTANT * !*********************************************************************** %INTEGER Z, DOTSEEN, EBCDIC, FS, CPREC, RR, S, T %LONGREAL X,CVALUE,DUMMY %INTEGER RADIXV %CONSTLONGREAL TEN=R'41A0000000000000' %ON %EVENT 1,2 %START HIT=0; %RETURN %FINISH CPREC=5; RR=R; R=R+1 DOTSEEN=0; HIT=0 CVALUE=0; DUMMY=0; X=0; FS=CC(Q) S=0; ->N %IF M'0'<=FS<=M'9' ->DOT %IF FS='.' %AND MODE=0 %AND '0'<=CC(Q+1)<='9' ! 1 DIDT MIN CTYPE=1; EBCDIC=0 ->QUOTE %IF FS=M'''' ->STR2 %IF FS=34 ->NOTQUOTE %UNLESS CC(Q+1)=M''''; Q=Q+2 ->HEX %IF FS='X' ->MULT %IF FS='M' ->BIN %IF FS=M'B' ->RHEX %IF FS='R' %AND MODE=0 ->OCT %IF FS='K' %IF FS='C' %THEN EBCDIC=1 %AND ->MULT ! %IF FS='D' %AND MODE=0 %THEN %START ! CPREC=7 ! %IF M'0'<=CC(Q)<=M'9' %THEN ->N ! %IF CC(Q)='.' %THEN ->DOT ! %FINISH Q=Q-2; %RETURN QUOTE: ! SINGLE CH BETWEEN QUOTES S=CC(Q+1); Q=Q+2 %IF S=NL %THEN READLINE(1,'''') %AND Q=1 %IF CC(Q)=M'''' %THEN %START Q=Q+1 %IF S#M'''' %THEN ->IEND %IF CC(Q)=M'''' %THEN Q=Q+1 %AND ->IEND %FINISH %RETURN; ! NOT VALID NOTQUOTE: ! CHECK FOR E"...." %RETURN %UNLESS FS='E' %AND CC(Q+1)=M'"' EBCDIC=1; Q=Q+1 STR2: ! DOUBLE QUOTED STRING A(RR)=X'35'; TEXTTEXT(EBCDIC) CTYPE=5; %RETURN HEX: T=0; ! HEX CONSTANTS %CYCLE I=CC(Q); Q=Q+1 %EXIT %IF I=M'''' T=T+1 %RETURN %UNLESS %C ('0'<=I<='9' %OR 'A'<=I<='F' %OR 'a'<=I<='f') %AND T<9 ! %IF T=9 %THEN SS=S %AND S=0 S=S<<4+I&15+9*I>>6 %REPEAT ! %IF T>8 %START ! Z=4*(T-8) ! S=S!(SS<>(32-Z) ! CPREC=6 ! %FINISH IEND: ! %IF CPREC=6 %THEN TOAR4(R,SS) %AND R=R+4 %IF CPREC=5 %AND 0<=S<=X'7FFF' %START CPREC=4; TOAR2(R,S); R=R+2 %FINISH %ELSE TOAR4(R,S) %AND R=R+4 HIT=1 %UNLESS MODE#0 %AND CPREC=6 A(RR)=CPREC<<4!CTYPE %RETURN RHEX: ! REAL HEX CONSTANTS T=0 %CYCLE I=CC(Q); Q=Q+1 %IF T&7=0 %AND T#0 %START TOAR4(R,S); R=R+4; S=0 %FINISH %EXIT %IF I=M''''; T=T+1 %RETURN %UNLESS '0'<=I<='9' %OR 'A'<=I<='F' %OR 'a'<=I<='f' S=S<<4+I&15+9*I>>6 %REPEAT ! %RETURN %UNLESS T=8 %OR T=16 %OR T=32 ! %IF T=32 %THEN CPREC=7 %ELSE CPREC=4+T//8 %RETURN %UNLESS T=8 %OR T=16 CPREC=4+T//8 A(RR)=CPREC<<4!2 HIT=1; %RETURN OCT: ! OCTAL CONSTANTS T=0 %CYCLE I=CC(Q); Q=Q+1; T=T+1 %EXIT %IF I=M'''' %RETURN %UNLESS '0'<=I<='7' %AND T<12 S=S<<3!(I&7) %REPEAT ->IEND MULT: T=0; ! MULTIPLE CONSTANTS %CYCLE I=CC(Q); Q=Q+1; T=T+1 %IF I=M'''' %THEN %START %IF CC(Q)#M'''' %THEN %EXIT %ELSE Q=Q+1 %FINISH %RETURN %IF T>=5 %IF EBCDIC#0 %THEN I=ITOETAB(I) S=S<<8!I %REPEAT ->IEND BIN: T=0; ! BINARY CONST %CYCLE I=CC(Q); Q=Q+1; T=T+1 %EXIT %IF I=M'''' %RETURN %UNLESS '0'<=I<='1' %AND T<33 S=S<<1!I&1 %REPEAT ->IEND RADIX: ! BASE_VALUE CONSTANTS T=0; RADIXV=0 Q=Q+1 %CYCLE I=CC(Q) %EXIT %UNLESS '0'<=I<='9' %OR 'A'<=I<='Z' %IF I<='9' %THEN I=I-'0' %ELSE I=I-('A'-10) %EXIT %IF I>=S; ! MUST BE LESS THAN BASE T=T+1; Q=Q+1 RADIXV=RADIXV*S+I %REPEAT %RETURN %IF T=0; ! NO VALID DIGIGITS ! SS<-RADIXV>>32 S<-RADIXV CTYPE=1 ! %IF SS#0 %THEN CPREC=6 ->IEND N: ! CONSTANT STARTS WITH DIGIT I=CC(Q) %UNTIL IM'9' %CYCLE CVALUE=TEN*CVALUE+(I&15) Q=Q+1; I=CC(Q); ! ONTO NEXT CHAR %REPEAT %IF I='_' %AND CVALUE<33 %THEN S=INT(CVALUE) %AND ->RADIX ->ALPHA %UNLESS MODE=0 %AND I='.' DOT: Q=Q+1; X=TEN; I=CC(Q) DOTSEEN=1; ! CONSTANT HAS DECIMAL POINT %WHILE M'0'<=I<=M'9' %CYCLE CVALUE=CVALUE+(I&15)/X X=TEN*X; Q=Q+1; I=CC(Q) %REPEAT ALPHA: ! TEST FOR EXPONENT %IF MODE=0 %AND CC(Q)='@' %THEN %START Q=Q+1; X=CVALUE Z=1; I=CC(Q) %IF I='-' %THEN Z=-1 %IF I='+' %OR I='-' %THEN Q=Q+1 CONST(2) %IF HIT=0 %THEN %RETURN HIT=0 R=RR+1 %IF A(R)>>4#4 %THEN %RETURN; ! EXPONENT MUST BE HALFINTEGER S=(A(R+1)<<8!A(R+2))*Z %IF S=-99 %THEN CVALUE=0 %ELSE %START %WHILE S>0 %CYCLE S=S-1 CVALUE=CVALUE*TEN %REPEAT %WHILE S<0 %AND CVALUE#0 %CYCLE S=S+1 CVALUE=CVALUE/TEN %REPEAT %FINISH %FINISH ! SEE IF IT IS INTEGER %IF FS='D' %THEN %START I=CC(Q) %IF I='''' %THEN Q=Q+1 %ELSE %RETURN DOTSEEN=1; ! ENSURE NOT TAKEN AS INTEGER %FINISH %IF DOTSEEN=1 %OR CVALUE>IMAX %OR FRACPT(CVALUE)#0 %C %THEN CTYPE=2 %ELSE CTYPE=1 %AND S=INT(CVALUE) %IF CTYPE=1 %THEN ->IEND %IF CPREC=6 %THEN CPREC=5; ! ONLY 32 BIT REAL CONSTS %IF CPREC=6 %THEN %START TOAR8(R,CVALUE); R=R+8 %FINISH %ELSE %START TOAR4(R,INTEGER(ADDR(CVALUE))); R=R+4 %FINISH A(RR)=CPREC<<4+CTYPE HIT=1 %END %ROUTINE TEXTTEXT(%INTEGER EBCDIC) !*********************************************************************** !* PROCESSES TEXT BETWEEN DOUBLE QUOTES AND STORES IN ISO OR EBCDIC * !*********************************************************************** %INTEGER J, II %CONSTINTEGER QU='"' I=CC(Q) S=R; R=R+1; HIT=0 %RETURN %UNLESS I=QU; ! FAIL UNLESS INITIAL QUOTE Q=Q+1 %CYCLE I=CC(Q) %IF EBCDIC#0 %THEN II=ITOETAB(I) %ELSE II=I A(R)=II; R=R+1 %IF I=QU %THEN %START Q=Q+1 %IF CC(Q)#QU %THEN %EXIT %FINISH %IF I=10 %THEN READLINE(1,QU) %ELSE Q=Q+1 FAULT(106,0,0) %IF R-S>256 %REPEAT R=R-1; J=R-S-1 A(S)=J; HIT=1 %END %ROUTINE TOAR2(%INTEGER PTR,VALUE) A(PTR+1)<-VALUE A(PTR)<-VALUE>>8 %END %ROUTINE TOAR4(%INTEGER PTR, VALUE) %INTEGER I %CYCLE I=0,1,3 A(PTR+I)=BYTE INTEGER(ADDR(VALUE)+I) %REPEAT %END %ROUTINE TOAR8(%INTEGER PTR, %LONGREAL VALUE) %INTEGER I %CYCLE I=0,1,7 A(PTR+I)=BYTE INTEGER(ADDR(VALUE)+I) %REPEAT %END %END; ! OF BLOCK CONTAINING PASS 1 %ENDOFFILE