!* rs6p104 !* 21/12/92 - Changes to correctly number include file lines(pds) !* rs6p102.i !* 30/08/89 - changes incorporated (ex Sun3 version) to get source !* directly from buffer using Consource since read symbol !* is not supported (gm) !* m88p102 !* 29/08/89 - original from pds (m88p102s on emas) !* %include "hostcodes.inc" %CONSTINTEGER HOST=DRS %CONSTINTEGER TARGET=PENTIUM ! PRODUCED BY OLDPS FROM ITRIMP_VAXPS01 ON 30/05/89 %CONSTBYTEINTEGERARRAY CLETT(0: 436)= 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, 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: 2094)= 1311, 1305, 1001, 1358, 1781, 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, 1530, 1550, 1011, 1391, 24, 1010, 1530, 1550, 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, 1428, 1423, 42, 1425, 50, 1428, 55, 50, 1453, 1431, 42, 1433, 50, 1436, 55, 1420, 1439, 60, 1415, 1442, 65, 1687, 1445, 72, 1415, 1448, 77, 1415, 1453, 83, 0, 1843, 2, 1460, 1456, 90, 1460, 1031, 1428, 1460, 1467, 1463, 98, 1465, 101, 1467, 105, 1483, 1473, 1428, 1488, 1001, 1408, 1479, 1453, 1483, 1001, 1408, 1495, 1483, 114, 1001, 1408, 1488, 1486, 114, 1488, 1000, 1495, 1491, 119, 1493, 114, 1495, 1000, 1505, 1503, 0, 1010, 1467, 1011, 1505, 2, 1505, 1000, 1514, 1512, 1030, 1010, 1467, 1011, 999, 1514, 1000, 1525, 1518, 129, 1016, 1520, 139, 1523, 146, 1018, 1525, 1016, 1530, 1528, 153, 1530, 1000, 1544, 1536, 1337, 1032, 1337, 1544, 1541, 0, 1530, 1550, 2, 1544, 160, 1530, 1550, 1548, 1037, 1337, 1550, 1000, 1561, 1555, 164, 1530, 1561, 1559, 168, 1530, 1568, 1561, 1000, 1568, 1566, 164, 1530, 999, 1568, 1000, 1575, 1573, 168, 1530, 999, 1575, 1000, 1583, 1579, 1033, 1337, 1581, 171, 1583, 1000, 1590, 1587, 173, 1010, 1590, 1015, 1010, 1594, 1593, 173, 1594, 1603, 1601, 6, 1337, 171, 1337, 1594, 1603, 1000, 1612, 1608, 1488, 1001, 1408, 1612, 178, 1525, 1612, 1618, 1618, 1001, 1408, 1789, 1618, 1624, 1622, 6, 1612, 1624, 1000, 1643, 1635, 1488, 1590, 1010, 1001, 1402, 1797, 1011, 1643, 1006, 1643, 178, 1525, 1590, 1001, 1402, 1789, 1665, 1654, 1652, 6, 1010, 1001, 1402, 1797, 1011, 1643, 1654, 1000, 1665, 1657, 184, 1659, 188, 1661, 197, 1663, 207, 1665, 216, 1676, 1674, 34, 1012, 1028, 1311, 1351, 1687, 1676, 1676, 1000, 1687, 1685, 6, 1012, 1028, 1311, 1351, 1687, 999, 1687, 1000, 1694, 1692, 0, 1328, 2, 1694, 1000, 1701, 1699, 6, 1321, 999, 1701, 1000, 1706, 1704, 222, 1706, 1000, 1712, 1710, 6, 1337, 1712, 1000, 1725, 1723, 6, 1001, 1408, 0, 1337, 171, 1337, 2, 999, 1725, 1000, 1732, 1730, 24, 1530, 1550, 1732, 1000, 1745, 1735, 1019, 1737, 1006, 1742, 1373, 1530, 1550, 1006, 1745, 1378, 1006, 1758, 1749, 228, 1034, 1752, 234, 1034, 1758, 244, 1010, 1937, 1011, 1764, 1764, 1762, 164, 1937, 1764, 1000, 1781, 1768, 249, 1034, 1776, 259, 1373, 1010, 1530, 1550, 1011, 1745, 1779, 259, 1937, 1781, 1000, 1789, 1787, 264, 1001, 1358, 1781, 1789, 1000, 1797, 1797, 0, 1337, 171, 1337, 1594, 2, 1805, 1803, 34, 1028, 1300, 1351, 1805, 1000, 1814, 1808, 266, 1810, 188, 1812, 273, 1814, 1000, 1825, 1823, 1001, 34, 1337, 6, 1337, 6, 1337, 1825, 1000, 1832, 1830, 6, 1850, 999, 1832, 1000, 1843, 1836, 173, 1001, 1843, 1001, 0, 1850, 1825, 1868, 2, 1850, 1846, 1001, 1850, 1850, 1825, 1868, 1860, 1854, 1428, 1860, 1860, 0, 1850, 1825, 1868, 2, 1868, 1865, 1488, 1001, 1408, 1868, 178, 1612, 1876, 1874, 168, 1850, 1825, 999, 1876, 1000, 1899, 1883, 4, 1908, 1001, 1899, 1006, 1887, 281, 1002, 1006, 1891, 1022, 1915, 1006, 1897, 286, 1009, 6, 1009, 1006, 1899, 1043, 1908, 1903, 292, 1005, 1906, 294, 1005, 1908, 1000, 1915, 1911, 296, 1913, 34, 1915, 1000, 1937, 1918, 1023, 1921, 1024, 1321, 1924, 1025, 1321, 1927, 1039, 1321, 1932, 1040, 1321, 6, 1321, 1937, 1041, 1321, 6, 1321, 1970, 1946, 1010, 1001, 1358, 1781, 1011, 1575, 1758, 1950, 298, 1001, 1358, 1952, 301, 1956, 308, 1033, 1337, 1959, 315, 1758, 1961, 323, 1966, 328, 1701, 1321, 1706, 1968, 335, 1970, 340, 2095, 1977, 1027, 1010, 1937, 1011, 1732, 1979, 1007, 1987, 1373, 1010, 1530, 1550, 1011, 1745, 1006, 1992, 349, 1035, 1764, 1006, 1997, 356, 1029, 1814, 1006, 2002, 362, 1036, 1725, 1006, 2007, 1378, 356, 1029, 1006, 2014, 1031, 1010, 1428, 1011, 1603, 1006, 2018, 369, 1514, 1006, 2023, 83, 153, 1832, 1006, 2033, 1010, 1805, 1453, 1011, 1583, 1001, 1402, 1495, 1006, 2037, 1654, 1428, 1624, 2041, 373, 1003, 1038, 2046, 381, 1015, 1010, 1006, 2055, 387, 1021, 1701, 1321, 1694, 228, 1034, 1006, 2066, 390, 1001, 1408, 0, 1337, 171, 1337, 2, 1712, 1006, 2070, 397, 1006, 1017, 2076, 259, 1035, 1004, 1034, 1006, 2079, 4, 1876, 2082, 402, 1006, 2086, 417, 1001, 1006, 2090, 424, 1003, 1006, 2093, 1001, 432, 2095, 1006; %CONSTINTEGER SS= 1970 %conststring(11)%array qcodes(0:233)="HALT"{=0}, "IADD"{=1},"ISUB"{=2},"IMULT"{=3},"IDIV"{=4}, "INEG"{=5},"IABS"{=6},"IREM"{=7},"IAND"{=8}, "IOR"{=9},"INOT"{=10},"IXOR"{=11},"ISHLL"{=12}, "ISHRL"{=13},"ISHLA"{=14},"ISHRA"{=15},"IGT"{=16}, "ILT"{=17},"IEQ"{=18},"INE"{=19},"IGE"{=20}, "ILE"{=21},"BNOT"{=22},"ITWB"{=36},"SFA"{=41}, "RETURN"{=42},"ASF"{=43},"IPUSH"{=44},"IPOP"{=45}, "EXCH"{=46},"DUPL"{=47},"DISCARD"{=48},"INDEX1"{=51}, "INDEX2"{=52},"INDEX4"{=53},"INDEX8"{=54},"INDEX"{=55}, "MVB"{=56},"CHK"{=57},"TMASK"{=58},"MVW"{=59}, "EZERO"{=60},"CPBGT"{=62},"CPBLT"{=63},"CPBEQ"{=64}, "CPBNE"{=65},"CPBGE"{=66},"CPBLE"{=67},"EMAKED"{68}, "ESPLITD"{69},"UMULT"{77},"UREM"{78},"UDIV"{79}, "UADD"{=80},"USUB"{=81},"UGT"{=82},"ULT"{=83}, "UEQ"{=84},"UNE"{=85},"UGE"{=86},"ULE"{=87}, "UCVTII"{=100},"IADDST"{=101},"ISUBST"{=102},"IMULTST"{=103}, "IDIVST"{=104},"INEGST"{=105},"UREMST"{106},"UDIVST"{107}, "IANDST"{=108},"IORST"{=109},"INOTST"{=110},"IXORST"{=111}, "IREMST"{=112},"RADD"{=113},"RSUB"{=114},"RMULT"{=115}, "RDIV"{=116},"RNEG"{=117},"RABS"{=118},"TNCRU"{130}, "CVTSBI"{=131},"CVTUI"{=132},"CVTUR"{=133},"CVTIU"{=134}, "CVTRU"{=135},"CVTII"{=136},"CVTIR"{=137},"CVTRR"{=138}, "TNCRI"{=139},"RNDRI"{=140},"EFLOOR"{=141},"TNCRR"{=142}, "RNDRR"{=143},"RGT"{=144},"RLT"{=145},"REQ"{=146}, "RNE"{=147},"RGE"{=148},"RLE"{=149},"RTWB"{=162}, "UCHECK"{=177},"ESTORE"{=184},"EDUPSTORE"{=185},"PUSHVAL"{=186}, "PUSHADDR"{=187},"EVAL"{=188},"EVALADDR"{=189},"EADDRESS"{=190}, "EINTRES"{=191},"EREALRES"{=192},"ESIZE"{=193},"EPOWER"{=194}, "EPOWERI"{=195},"ARGPROC"{=196},"PUSHBYTES"{=197},"EAUXST"{=198}, "EAUXADD"{=199},"EAUXRES"{=200},"EOLDLNB"{=201},"EFILL"{=202}, "ECDUP"{=203},"EMCHIP"{=205},"CXADD"{=257},"CXSUB"{=258}, "CXMULT"{=259},"CXDIV"{=260},"CXNEG"{=261},"CXASGN"{=262}, "CXEQ"{=263},"CXNE"{=264},"ECMPLX1"{=286},"ECMPLX2"{=287}, "ECONJG"{=279},"EANINT"{=266},"EM1EXP"{=267},"EISIGN"{=268}, "ESIGN"{=269},"EIMOD"{=270},"ERMOD"{=271},"EIDIM"{=272}, "ERDIM"{=273},"EIMIN"{=274},"ERMIN"{=275},"EIMAX"{=276}, "ERMAX"{=277},"EDMULT"{=278},"ECHAR"{=280},"EICHAR"{=281}, "EINDEXCHAR"{=282},"ECONCAT"{=283},"EASGNCHAR"{=284},"ECOMPCHAR"{=285}, "EISHFT"{=288},"EIBITS"{=289},"EIBSET"{=290},"EIBTEST"{=291}, "EIBCLR"{=292},"EISHFTC"{=293},"PROCARG"{=294},"IPROCARG"{=295}, "CHARARG"{=296},"IPROCCALL"{=297},"ARGPROCCALL"{=298},"CALLTPLATE"{=299}, "NOTEIORES"{=300},"STKIORES"{=301},"EFCVT"{=302},"EFCVTASGN"{=303}, "EARGLEN"{=304},"EFDVACC"{=305},"EFNOTEVR"{=306},"EFSETVR"{=307}, "EINCR"{=308},"EDECR"{=309},"ELOADB"{=310},"ESTOREB"{=311}, "EINCRB"{=312},"EDECRB"{=313},"EDINIT"{=314},"ELSHIFT"{=315}, "ERSHIFT"{=316},"EADJL"{=317},"EADJR"{=318},"EVERIFY"{=319}, "STRGT"{=511},"STRLT"{=512},"STREQ"{=513},"STRNE"{=514}, "STRGE"{=515},"STRLE"{=516},"PTREQ"{=520},"PTRNE"{=521}, "SETI"{=530},"SETU"{=531},"SETD"{=532},"SETLE"{=533}, "SETEQ"{=534},"SETNE"{=535},"SETIN"{=536},"SETSING"{=537}, "SETRANGE"{=538},"SETEMPTY"{=539},"CAPMOVE"{=547},"INDEXP"{=548}, "EOFOP"{=559},"EOLOP"{=560},"LAZYOP"{=574},"ISQR"{=601}, "IODD"{=602},"ISUCC"{=603},"IPRED"{=604},"UODD"{=605}, "USUCC"{=606},"UPRED"{=607},"RSQR"{=611},"CHKLT"{=620}, "CHKGT"{=621},"CHKNE"{=629},"CHKRNG"{=622},"CHKSETGT"{=623}, "CHKSETRNG"{=624},"UCHKLT"{=625},"UCHKGT"{=626},"UCHKNE"{=627}, "UCHKRNG"{=628},"CHKNEW2"{=630},"CHKUNDEF"{=631},"SETUNDEF"{=632}, "TRAP"{=633},"ICLPSH"{=642},"ICLPROT"{=643},""{=0}, "ESTKLIT"{=255}; %constshortinteger%array opc(0:233)=0, 1,2,3,4, 5,6,7,8, 9,10,11,12, 13,14,15,16, 17,18,19,20, 21,22,36,41, 42,43,44,45, 46,47,48,51, 52,53,54,55, 56,57,58,59, 60,62,63,64, 65,66,67,68, 69,77,78,79, 80,81,82,83, 84,85,86,87, 100,101,102,103, 104,105,106,107, 108,109,110,111, 112,113,114,115, 116,117,118,130, 131,132,133,134, 135,136,137,138, 139,140,141,142, 143,144,145,146, 147,148,149,162, 177,184,185,186, 187,188,189,190, 191,192,193,194, 195,196,197,198, 199,200,201,202, 203,205,257,258, 259,260,261,262, 263,264,286,287, 279,266,267,268, 269,270,271,272, 273,274,275,276, 277,278,280,281, 282,283,284,285, 288,289,290,291, 292,293,294,295, 296,297,298,299, 300,301,302,303, 304,305,306,307, 308,309,310,311, 312,313,314,315, 316,317,318,319, 511,512,513,514, 515,516,520,521, 530,531,532,533, 534,535,536,537, 538,539,547,548, 559,560,574,601, 602,603,604,605, 606,607,611,620, 621,629,622,623, 624,625,626,627, 628,630,631,632, 633,642,643,0, 255; ! %CONSTINTEGER FIRST UCUB=224 %CONSTINTEGER FIRST UCSB=first ucub+0 %CONSTINTEGER FIRST UCW=first ucsb+1 %CONSTINTEGER FIRST UCUBUB=first ucw+1 %CONSTINTEGER FIRST UCUBW=0 %CONSTINTEGER FIRST UCJUMP=0 %CONSTINTEGER LASTUC=0 %CONSTINTEGER LRLPT=X'62' %CONSTINTEGER NO OF SNS=67 ! THE SPECIAL NAMES ARE HERE TO ALLOW ! DIFFERENCES OF PRECISION BETWEEN COMPILERS ! ESPECIAL THE MAPS HALF&SHORT %CONSTINTEGERARRAY TSNAME (0:NO OF SNS)=X'1000'(8), X'1041',X'1000'(5),X'1051',X'1000'+LRLPT, X'1051'(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'1051',X'51',X'4062',X'51', X'61',X'72',X'61',X'72',X'51',LRLPT,X'1051',X'51', X'1000',LRLPT,X'1061'(2),X'41',X'1051'; ! %END OF FILE M88Kponeas ie M88K TARGET DEPENDENT TABLES ! ! Changes for poneb02s ! 1) Improvements to UP and DOWN to flag internal blks or procs ! ! %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' %CONSTBYTEINTEGERARRAY ONE CASE(0 : 255) = %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, 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+128,66+128,67+128,68+128,69+128,70+128,71+128,72+128,73+128,74+128,75+128,76+128,77+128,78+128,79+128, 80+128,81+128,82+128,83+128,84+128,85+128,86+128,87+128,88+128,89+128,90+128,123,124,125,126,127; %CONSTINTEGER MAXLEVELS=31,COMMALT=2,DECALT=8,ENDALT=9,SNPT=X'1006' %CONSTINTEGER MAXIBITS=32; ! BITS IN LARGEST INTEGER %CONSTBYTEINTEGERARRAY TRTAB(0:255)=0(48),1(10), 0(7),2(26),0(6),2(26),0(*); ! ! RECORDFORMAT FOR ALL THE OPTION AND FLAG VARAIBLES ! ! amended to remove non-alined longreal prior to bootstrapping to gould ! %RECORDFORMAT PARMF(%INTEGER BITS1,BITS2,TTOPUT, %BYTEINTEGER LET,DYNAMIC,LINE,TRACE,ARR,DBUG,CHK,DIAG,OPT,FREE, LIST,CPRMODE,COMPILER,Z,Y,PROF,INHCODE,DCOMP,FAULTY,X,STACK,MAP,QUOTES,S2, %INTEGER LPOPUT,SP0) %RECORDFORMAT LEVELF(%INTEGER RBASE, DIAGINF, RAL, FLAG, L, M, NMDECS, ONWORD, ONINF, LABEL, JROUND, UNATT FORMATS, PSIZE, ENTRYAD, DISPLAY, AUXSBASE, NAMES, SNMAX,SN,RESSIZE,CLEVEL,SET, MAXPP, EXITLAB, CONTLAB, S3, %INTEGERARRAY AVL WSP(0:4)) %IF 1<>1 %INTEGERARRAY Downptr,SFS(0:MAXLEVELS) %BYTEINTEGERARRAYFORMAT LETTF(0:DSIZE+20) %BYTEINTEGERARRAYNAME LETT %BYTEINTEGERARRAY TLINE(0:2047) %CONSTBYTEINTEGERARRAY ILETT(0: 532)= 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', 4,'L','I','N','T', 6,'L','I','N','T','P','T', 12,'S','H','O','R','T','I','N','T','E','G','E','R', 5,'T','R','U','N','C',255; !* %byteintegerarrayformat inbuffm(0:4095) %ownbyteintegerarrayname inbuf %owninteger inptr=4095 %owninteger dataad !* LETT==ARRAY(ADDR(A(ARSIZE-DSIZE-20)),LETTF) ARSIZE=ARSIZE-DSIZE-300 !* dataad = malloc(4096) inbuf == array(dataad, inbuffm) !* LETT(0)=0 LEVEL=0 WORKA_LETT==LETT %CYCLE I=0,1,MAXLEVELS SFS(I)=0 %REPEAT %CYCLE I=0,1,NNAMES WORD(I)=0; TAGS(I)=0; %REPEAT FILEADDR=WORKA_FILEADDR IDEPTH=0; IHEAD=0 %IF FILEADDR#0 %THEN %START HDR==RECORD(FILEADDR) SOURCE==ARRAY(FILEADDR,SRCEF) FILEPTR=HDR_STARTRA FILEEND=HDR_ENDRA %FINISH 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_MAP=I>>17&1; ! MAP CONTROLS FUNNY LISTING OF INCLUDES PARM_LIST=(I>>1&1)!!1 ! PARM_FREE=I>>19&1 %IF I&32=32 %THEN PARM_ARR=0 PARM_PROF=I>>7&1; ! PROFILE BIT parm_prof=0 %if parm_map#0; ! Cant profile funny listint PARM_DYNAMIC=I>>20&1 PARM_LET=I>>13&1 PARM_DCOMP=I>>14&1; ! PARM CODE OR D PARM_DBUG=I>>18&1 PARM_QUOTES=I&1 %IF I&64=64 %THEN PARM_TRACE=0 %AND PARM_DIAG=0 PARM_X=I>>28&1; ! DONT REFORMAT REALS FOR SIMULATOR PARM_Y=I>>27&1 PARM_Z=I>>26&1; ! USE PARMZ BIT FOR DUMPING WKFILE PARM_STACK=I>>3&1 %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) %if target=MIPS %or Target=M88K %then printstring(assprefix) SPACES(14) PRINTSTRING("ERCC. Portable Imp80") PRINTSTRING(" Compiler Release") WRITE(WORKA_RELEASE,1) PRINTSTRING(" Version ".WORKA_LADATE) NEWLINES(3) %if target=MIPS %or Target=M88k %then printstring(assprefix) WRITE(NNAMES,5); WRITE(WORKA_ASL MAX,5) NEWLINE ! ! NOW DECLARE THE SPECIAL NAMES WHICH ARE IN ARRAY ILETT. ! %BEGIN %RECORD(TAGF) SNTAG CPTR=0; SNUM=0; STRLINK=0 K=0 %IF HOST//10<=1 %THEN NEXT=1 %ELSE NEXT=2; !START AT 2 FOR WORD ADDRESSES HOSTS I=ILETT(0) %WHILE I<255 %CYCLE %CYCLE J=I,-1,1 CC(J)=ILETT(K+J) %if PARM_QUOTES#0 %then CC(J)=CC(J)!32 %REPEAT CC(I+1)=';' R=2; Q=1; PNAME(1) SNTAG=0; SNTAG_UIOJ<-X'8000'; ! SET USED BIT JJ=TSNAME(SNUM) %IF JJ&X'C000'#X'4000' %START; ! NOT A CONST VARAIBLE SNTAG_PTYPE=SNPT SNTAG_ACC=JJ; ! TRUE PTYPE HERE SNTAG_SLINK=SNUM %FINISHELSESTART SNTAG_PTYPE=JJ SNTAG_S2=PRECONSTS(CPTR) SNTAG_S3=PRECONSTS(CPTR+1) CPTR=CPTR+2 %FINISH PUSH(TAGS(LASTNAME),SNTAG_S1,SNTAG_S2,SNTAG_S3) SNUM=SNUM+1 K=K+I+1; I=ILETT(K) %exit %if snum>no of sns %REPEAT ! ! The idea of the above exit is to allow further special names to be added ! without preventing the rebuilds of compilers that do not support the extra facilities ! Until no of sns is increased in the steering consts the new names are ignored ! %END ! LINE=0; LLENGTH=0; Q=1 R=1; LEVEL=1 %CYCLE %IF Q>=LLENGTH %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,Q,QMAX<<16!LLENGTH) 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_Z#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 %IF IHEAD=0 %THEN %EXIT OLD SOURCE R=STARSTART; ! IGNORE ENDOFFILE LIKE IMP77 LLENGTH=1 %CONTINUE %FINISH %IF LEVEL=0 %THEN %START FAULT(14, 0, 0) R=STARSTART; ! IGNORE IT LEVEL=1 %FINISH %FINISH %FINISH %REPEAT %WHILE SFS(1)#0 %CYCLE POP(SFS(1),I,J,K) %IF I=1 %THEN FAULT(53,K,0); ! FINISH MISSING %IF I=2 %THEN FAULT(13,K,0); ! %REPEAT MISSING %REPEAT A(I)=0 %FOR I=R,1,R+7; R=R+8 R=(R+7)&(-8) WORKA_DICTBASE=R ! %CYCLE I=0,1,NEXT ! A(R+I)=LETT(I) ! %REPEAT move bytes(next+1,addr(lett(0)),0,addr(a(0)),r) WORKA_LETT==ARRAY(ADDR(A(R)),SRCEF) R=R+NEXT+1 %IF LEVEL>1 %THEN FAULT(15,LEVEL-1,0) R=(R+7)&(-8) NEWLINE %IF PARM_FAULTY=0 %THEN %START %if Target=Mips %or Target=M88k %then printstring(assprefix) WRITE(LINE, 5) PRINT STRING(" LINES ANALYSED SIZE=") WRITE(R, 5) %IF (HOST=EMAS %OR HOST=IBM %OR HOST=IBMXA) %AND %C LINE>90 %AND PARM_LIST#0 %THEN NEWPAGE %ELSE NEWLINE free(dataad) %FINISH %ELSE %START PRINTSTRING("CODE GENERATION NOT ATTEMPTED ") %FINISH %RESULT=R %ROUTINE NEWSOURCE(%INTEGER NEWFILEADDR) !*********************************************************************** !* SETS UP COMPILER TO USE AN INCLUDED SOURCE FILES * !*********************************************************************** %owninteger filesseen=0 PUSH(IHEAD,FILEADDR,FILEPTR,LINE) FILEADDR=NEWFILEADDR HDR==RECORD(FILEADDR) SOURCE==ARRAY(FILEADDR,SRCEF) FILEPTR=HDR_STARTRA FILEEND=HDR_ENDRA IDEPTH=IDEPTH+1 filesseen=filesseen+1 %IF PARM_MAP#0 %THEN LINE=10000+2000*filesseen %END %ROUTINE OLDSOURCE !*********************************************************************** !* UNDOES THE ABOVE !*********************************************************************** %INTEGER ALT LINE %IF IHEAD#0 %THEN %START POP(IHEAD,FILEADDR,FILEPTR,ALTLINE) %if Fileaddr#0 %start; ! if it was mapped remap HDR==RECORD(FILEADDR) FILEEND=HDR_ENDRA SOURCE==ARRAY(FILEADDR,SRCEF) %finish %IF PARM_MAP#0 %THEN LINE=ALT LINE IDEPTH=IDEPTH-1 %FINISH %ELSE FAULT(110,0,0) %END %ROUTINE READ LINE(%INTEGER MODE,CHAR) %ROUTINESPEC GET LINE %INTEGER DEL, LL, LP, PREV, LASTC, PPREV LL=0; LP=0; PREV=0; Q=1 LLENGTH=0; DEL=0; LASTC=-1; ! NO CONTINUATIONS AS YET NEXT: LP=LP+1 %IF LP>LL %THEN GET LINE %AND LP=1 I=TLINE(LP) %IF MODE=0 %THEN %START %WHILE I='{' %CYCLE %CYCLE PREV=I LP=LP+1 I=TLINE(LP) %REPEAT %UNTIL PREV='}' %OR I=NL %REPEAT %while I='/' %and tline(lp+1)='*' %cycle %cycle pprev=prev; prev=i; lp=lp+1 i=tline(lp); %repeat %until i=nl %or (prev='/' %and pprev='*') %repeat %IF I='%' %THEN DEL=128 %AND ->NEXT %if parm_quotes=0 %then {i=onecase(i+128) %else} I=ONE CASE(I) %IF 'A'<=I<='Z' %THEN %start I=I!DEL %finish %else %if 'a'<=i<='z' %start %if del#0 %then i=(i-32)!DEL %else DEL=0 ->NEXT %IF I=' ' %FINISH LLENGTH=LLENGTH+1 CC(LLENGTH)=I %IF I='''' %OR I=34 %THEN MODE=1 %AND CHAR=I %FINISH %ELSE %START LLENGTH=LLENGTH+1 CC(LLENGTH)=I %IF I=CHAR %THEN MODE=0 %FINISH ->NEXT %UNLESS I=NL %IF LLENGTH-1=LASTC %THEN LLENGTH=LASTC %AND ->NEXT I=CC(LLENGTH-1) %IF I='C'+128 %THEN LLENGTH=LLENGTH-2 %AND LASTC=LLENGTH %AND ->NEXT %IF MODE=0 %AND I=',' %THEN LLENGTH=LLENGTH-1 %AND LASTC=LLENGTH %AND ->NEXT FAULT(101,0,0) %IF LLENGTH>WORKA_CCSIZE %RETURN %ROUTINE GET LINE %externalintegerspec SrcId %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 %IF FILE ADDR=0 %THEN %START; ! SOURCE NOT A 'CLEAN' FILE %UNTIL K=NL %CYCLE { Since there is no support for read symbol, use } { Unix block read which is faster anyway. } { READ SYMBOL(K) } inptr = inptr + 1 %if inptr = 4096 %thenstart k = fileread(SrcId, addr(inbuf(0)), 4096) inptr = 0 %finish k = inbuf(inptr) TLINE(LL+1)=ITOI(K) LL=LL+1 %REPEAT %FINISH %ELSE %START %IF FILEPTR>=FILE END %START OLD SOURCE; ! RESET SOURCE FILES GETLINE %RETURN %FINISH %UNTIL K=NL %OR K=0 %CYCLE K=SOURCE(FILEPTR); ! NEXT CHAR FROM SORCE FILE FILE PTR=FILE PTR+1 TLINE(LL+1)=ITOI(K) LL=LL+1 %REPEAT %FINISH LINE=LINE+1; ! COUNT ALL LINES %IF PARM_LIST#0 %THEN %START %IF MODE=0 %AND LLENGTH>0 %THEN %C PRINTSTRING(" C") %ELSE WRITE(LINE, 5) %IF MODE#0 %THEN PRINTSTRING(""" ") %ELSE SPACES(8) %IF HOST=ACCENT %or ll>255 %THEN %START PRINT SYMBOL(TLINE(K)) %FOR K=1,1,LL %ELSE tline(0)=ll printstring(string(ADDR(TLINE(0)))) %finish %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 EVALCONST(ITEM-1003) ->FAIL %IF HIT=0 ->SUCC BIP(1004): ! PHRASE DUMMYSTART A(R)=1; ! THERE IS AN '%ELSESTART' R=R+1 ->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 A(R)<-S>>8; A(R+1)=S&255 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 %IF I='!' %THEN Q=Q+1 %AND ->COMFOUND ->FAIL %UNLESS 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 ->FAIL %UNLESS CC(Q+5)='N'+128 %AND CC(Q+6)='T'+128 Q=Q+7 COMFOUND: J=CC(Q) %CYCLE %EXIT %IF J=NL Q=Q+1; J=CC(Q) %REPEAT ->SUCC BIP(1008): ! PHRASE BIGHOLE ! NOT CURRENTLY USED IN TRIMP ! A(I)=0 %FOR I=R,1,R+3 ! 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 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 %if level>1 %then a(downptr(level))=1; ! flag down in enclosing blk LEVEL=LEVEL+1 SFS(LEVEL)=0 Downptr(level)=r ->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="123456789abcdef" %WHILE 'A'<=I<='Z' %OR '0'<=I<='9' %CYCLE J=J+1 %if j>=15 %then ->fail CHARNO(NEM,J)=I Q=Q+1; I=CC(Q) %REPEAT ->FAIL %UNLESS J>0 LENGTH(NEM)=J %IF I='_' %THEN Q=Q+1 ->SUCC BIP(1023): ! UCNOP MNEMONIC SANS OPERANDS ->FAIL %IF (TARGET=PNX %OR TARGET=ACCENT %or %c target=drs %or target=PENTIUM %or target=wwc %or target=perq3) %AND CC(Q-1)='_' ! EFFICIENCY FROG FOR ASSBLERS ! WITH NO PARAMETER OPCODES %CYCLE I=0,1,FIRSTUCUB-1 ->PFND %IF NEM=QCODES(I) %REPEAT ->FAIL PFND: J=OPC(I) A(R)<-J>>8; A(R+1)<-J R=R+2; ->SUCC; ! ALLOW MORE THAN 255 OPCODES 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 A(R)=0; A(R+1)=0 A(R+2)=0; A(R+3)=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'500B2800'#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 A(R)=0; A(R+1)=0 A(R+2)=0; A(R+3)=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) MOVEBYTES(4,ADDR(STARSTART),0,ADDR(A(0)),J) ->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 MOVEBYTES(4,ADDR(STARSTART),0,ADDR(A(0)),J) ->SUCC BIP(1038): ! INCLUDE "FILE" ->FAIL %IF IDEPTH>10 I=CC(Q) ->FAIL %UNLESS I=NL %OR I=';' Q=Q+1 %IF I=';' ->FAIL %UNLESS CTYPE=5 %AND (Host#emas %or A(S)<=31) %IF HOST=PNX %or 1<(".") %then fname=fname.".INC" %finish CONSOURCE(FNAME,J) NEWSOURCE(J) %END ->SUCC %FINISH ->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=FIRST UCUBW,1,FIRST UCJUMP-1 ->PFND %IF NEM=QCODES(I) %REPEAT; ->FAIL BIP(1042): ! UCJUMP = JUMP MNEMONICS %CYCLE I=FIRST UCJUMP,1,LASTUC ->PFND %IF NEM=QCODES(I) %REPEAT; ->FAIL BIP(1043): ! UCWRONG ERRORS AND OTHER M-CS I=CC(Q) %CYCLE Q=Q+1 %EXIT %IF I=NL %OR I=';' I=CC(Q) %REPEAT ->SUCC %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 %if PARM_QUOTES=0 %then LETT(NEXT+1)=FS!32 %else LETT(NEXT+1)=FS JJ=71*FS %CYCLE Q=Q+1 I=CC(Q) %EXIT %IF TRTAB(I)=0 JJ=JJ+HASH(T)*I %IF T<=7 T=T+1 %if PARM_QUOTES=0 %then LETT(NEXT+T)=I!32 %else 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 %IF HOST//10<=1 %THEN NEXT=NEXT+S %ELSE NEXT=(NEXT+S+1)&(-2) FND: LASTAT=FQ; HIT=1; LASTNAME=KK A(R+1)<-LASTNAME A(R)=LASTNAME>>8; R=R+2 LASTEND=Q %END %ROUTINE EVALCONST(%INTEGER MODE) !*********************************************************************** !* SYNTAX CHECK AND EVALUATE ALL THE FORMS OF IMP CONSTANT * !* MODE=0 FOR INTEGER CONSTANTS #0 FOR ANY SORT OF CONSTANT * !*********************************************************************** %CONSTBYTEINTEGERARRAY RSHIFT(0:32)=0,0,1,0,2,0(3),3,0(7),4,0(15),5; %INTEGER Z, DOTSEEN, EBCDIC, FS, CPREC, RR, S, SS, T, RS, J %integerarray rhexpat(0:3) %constinteger powerl=75 %IF 1<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 %if 'a'<=fs<='z' %then fs=fs-32 ->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' %or FS='H') %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<17 %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) %unless Z=32 %then S=S!(SS<>(32-Z);! shifts modulo 31 on gould! CPREC=6 %FINISH IEND: %IF CPREC=6 %THEN %Start %if 1<>8; A(R+1)=S&255; R=R+2 %FINISH %ELSE %START MOVEBYTES(4,ADDR(S),0,ADDR(A(0)),R) R=R+4 %FINISH 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 rhexpat(t//8-1)=s; 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 A(RR)=CPREC<<4!2 %if host#target %and ibmfpformat>>host&1#ibmfpformat>>target&1 %c %and FS='R'%then A(RR)=A(RR)!8; ! Flag const not to converted t=t//8-1 %for i=0,1,t %cycle %if 1<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 RS=RSHIFT(S) 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 Q=Q+1 %IF RS#0 %THEN RADIXV=RADIXV<0 %AND T>MAXIBITS);! NO VALID DIGITS %IF 1<>32 %ELSE SS=0 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 2<=CVALUE<33 %THEN S=INT(CVALUE) %AND ->RADIX ->ALPHA %UNLESS MODE=0 %AND I='.' DOT: Q=Q+1; I=CC(Q) DOTSEEN=1; ! CONSTANT HAS DECIMAL POINT dvalue=0; s=0 %WHILE M'0'<=I<=M'9' %CYCLE dvalue=ten*dvalue+(i&15) s=s+1 Q=Q+1; I=CC(Q) %REPEAT cvalue=cvalue+(dvalue/powers(s)) 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 EVALCONST(2) %IF HIT=0 %THEN %RETURN HIT=0 DOTSEEN=1; ! @ IMPLIES REAL IN IMP80 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 %if powerll<=s<=powerl %then cvalue=cvalue*powers(s) %else %c %if imod(s)<=powerl %then cvalue=cvalue/powers(-s) %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 %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 %THEN CTYPE=2 %C %ELSE CTYPE=1 %AND S=INT(CVALUE) %IF CTYPE=1 %THEN ->IEND %IF CPREC=5 %THEN CPREC=6; ! ONLY 64 BIT REAL CONSTS %IF CPREC=6 %THEN %START cvaluep=cvalue; ! may perform a round MOVEBYTES(8,ADDR(CVALUEp),0,ADDR(A(0)),R); R=R+8 %FINISH %ELSE %START; ! PREC = 7 CONTSTANTS MOVEBYTES(16,ADDR(CVALUE),0,ADDR(A(0)),R) R=R+16 %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 %END; ! OF ROUTINE PASS ONE %ENDOFFILE