!*                                                                  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)
!*
!!{GT:}%include "hostcodes.inc"

%CONSTINTEGER YES=1,NO=0
            
!
! THESE CODE ARE ARBITARY BUT THE TOP DECIMAL DIGIT GIVES THE NO OF BYTES
! IN THE UNIT OF ADDRESSABILITY. BYTE ADDRESSED HOSTS BEING 1N ( also 0N) AND
! 16 BIT WORD ADDRESSED HOSTS BEING 2N ETC
%CONSTINTEGER PENTIUM=4;                ! PENTIUM chip Unix stack and completely swopped
%constinteger MIPS=05;                  ! Imp on MIPS (all variants)
%CONSTINTEGER RS6=06;                   ! imp on IBM rs6000
%CONSTINTEGER M88K=07;                  ! Imp on all forms of 88k
                                        ! also serves for Sparc sinc there is a common b-e
%CONSTINTEGER VAX=08;                   ! Imp on Vax using F & G formats
%CONSTINTEGER UNISYS=09;                ! Imp on UnisSys. Unix stack unswopped Vax reals
%CONSTINTEGER EMAS=10;                  ! emas on 2900 (unsigned shorts)
%CONSTINTEGER IBM=11;                   ! emas on 24 bit ibm hardware
%CONSTINTEGER IBMXA=12;                 ! emas of XA 31 bit hardware
%CONSTINTEGER WWC=13;                   ! WWc (Natsemi chip) completely swopped
%CONSTINTEGER AMDAHL=14;                ! Emas on Amdahls guess at Xa Minor differences fron IBM)
%CONSTINTEGER PERQ3=15;                 ! ICL packaged 68k chip Unix stack but not swopped
%CONSTINTEGER GOULD=16;                 ! Gould unswopped forward stack. Needs 4&8 byte alined
%CONSTINTEGER VNS=17;                   ! Unix on 2900 unsigned shorts params as
                                        ! 2900. Long int available but not in Ecode
%CONSTINTEGER EAMD=18;                  ! Amdahl via the Emachine
%CONSTINTEGER DRS=19;                   ! Intel chip Unix stack and mostly swopped
%CONSTINTEGER PERQ=20;                  ! Pos perq now obselete. Fully swopped forward stack
%CONSTINTEGER PNX=21;                   ! ICL's perq2 Unix stack byte swopped (unsigned shorts)
%CONSTINTEGER ACCENT=22;                ! Perq 1 under accent. obsolete now
                                        ! ACCENT DIFFERS FROM PERQ ONLY IN
                                        ! ASSEMBLES SEQUENCES&SYNTAX
                                        ! AND GENERATOR
%constinteger ORN=23
%CONSTINTEGER UNSIGNEDSHORTS=1<<emas!1<<pnx!1<<vns
%CONSTINTEGER LINTAVAIL=1<<IBM!1<<IBMXA!1<<amdahl!1<<EMAS!1<<GOULD!1<<MIPS
%CONSTINTEGER LLREALAVAIL=1<<IBM!1<<IBMXA!1<<amdahl!1<<EMAS!1<<MIPS
%CONSTINTEGER EMACHINE=1<<DRS!1<<PENTIUM!1<<WWC!1<<Vax!1<<GOULD!1<<PERQ3!1<<VNS!1<<EAMD!1<<ORN!1<<UniSys!1<<m88k!1<<rs6!1<<MIPS
%CONSTINTEGER IBMFPFORMAT=1<<ibm!1<<ibmxa!1<<amdahl!1<<emas!1<<gould!1<<vns!1<<EAMD
%constinteger VAXFPFORMAT=1<<Vax!1<<UniSys
%constinteger IEEEFPFORMAT=1<<WWC!1<<PERQ3!1<<DRS!1<<PENTIUM!1<<PERQ!1<<accent!1<<m88k!1<<rs6!1<<MIPS
%CONSTINTEGER BYTESWOPPED=1<<PERQ!1<<ACCENT!1<<WWC!1<<Vax!1<<PNX!1<<ORN
%CONSTINTEGER HALFSWOPPED=1<<PERQ!1<<ACCENT!1<<WWC!1<<Vax!1<<DRS!1<<PENTIUM!1<<ORN
%CONSTINTEGER WORDSWOPPED=1<<PERQ!1<<ACCENT!1<<WWC!1<<Vax!1<<DRS!1<<PENTIUM!1<<ORN
%CONSTINTEGER RISKMC=1<<M88K!1<<rs6!1<<MIPS
!
! end of file hostcodes
!

{GT:}%CONSTINTEGER HOST={mips}PENTIUM
{GT:}%CONSTINTEGER TARGET={mips}PENTIUM
! PRODUCED BY newps FROM imptocps on locust
%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: 2096)=  1311,
  1305,  1001,  1358,  1783,  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,  1552,  1011,  1391,    24,  1010,  1530,  1552,  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,
  1689,  1445,    72,  1415,  1448,    77,  1415,  1453,    83,     0,
  1845,     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,  1546,
  1536,  1337,  1032,  1337,  1546,  1541,     0,  1530,  1552,     2,
  1544,   160,  1530,  1546,  1337,  1552,  1550,  1037,  1337,  1552,
  1000,  1563,  1557,   164,  1530,  1563,  1561,   168,  1530,  1570,
  1563,  1000,  1570,  1568,   164,  1530,   999,  1570,  1000,  1577,
  1575,   168,  1530,   999,  1577,  1000,  1585,  1581,  1033,  1337,
  1583,   171,  1585,  1000,  1592,  1589,   173,  1010,  1592,  1015,
  1010,  1596,  1595,   173,  1596,  1605,  1603,     6,  1337,   171,
  1337,  1596,  1605,  1000,  1614,  1610,  1488,  1001,  1408,  1614,
   178,  1525,  1614,  1620,  1620,  1001,  1408,  1791,  1620,  1626,
  1624,     6,  1614,  1626,  1000,  1645,  1637,  1488,  1592,  1010,
  1001,  1402,  1799,  1011,  1645,  1006,  1645,   178,  1525,  1592,
  1001,  1402,  1791,  1667,  1656,  1654,     6,  1010,  1001,  1402,
  1799,  1011,  1645,  1656,  1000,  1667,  1659,   184,  1661,   188,
  1663,   197,  1665,   207,  1667,   216,  1678,  1676,    34,  1012,
  1028,  1300,  1344,  1689,  1678,  1678,  1000,  1689,  1687,     6,
  1012,  1028,  1300,  1344,  1689,   999,  1689,  1000,  1696,  1694,
     0,  1328,     2,  1696,  1000,  1703,  1701,     6,  1321,   999,
  1703,  1000,  1708,  1706,   222,  1708,  1000,  1714,  1712,     6,
  1337,  1714,  1000,  1727,  1725,     6,  1001,  1408,     0,  1337,
   171,  1337,     2,   999,  1727,  1000,  1734,  1732,    24,  1530,
  1552,  1734,  1000,  1747,  1737,  1019,  1739,  1006,  1744,  1373,
  1530,  1552,  1006,  1747,  1378,  1006,  1760,  1751,   228,  1034,
  1754,   234,  1034,  1760,   244,  1010,  1939,  1011,  1766,  1766,
  1764,   164,  1939,  1766,  1000,  1783,  1770,   249,  1034,  1778,
   259,  1373,  1010,  1530,  1552,  1011,  1747,  1781,   259,  1939,
  1783,  1000,  1791,  1789,   264,  1001,  1358,  1783,  1791,  1000,
  1799,  1799,     0,  1337,   171,  1337,  1596,     2,  1807,  1805,
    34,  1028,  1300,  1344,  1807,  1000,  1816,  1810,   266,  1812,
   188,  1814,   273,  1816,  1000,  1827,  1825,  1001,    34,  1337,
     6,  1337,     6,  1337,  1827,  1000,  1834,  1832,     6,  1852,
   999,  1834,  1000,  1845,  1838,   173,  1001,  1845,  1001,     0,
  1852,  1827,  1870,     2,  1852,  1848,  1001,  1852,  1852,  1827,
  1870,  1862,  1856,  1428,  1862,  1862,     0,  1852,  1827,  1870,
     2,  1870,  1867,  1488,  1001,  1408,  1870,   178,  1614,  1878,
  1876,   168,  1852,  1827,   999,  1878,  1000,  1901,  1885,     4,
  1910,  1001,  1901,  1006,  1889,   281,  1002,  1006,  1893,  1022,
  1917,  1006,  1899,   286,  1009,     6,  1009,  1006,  1901,  1043,
  1910,  1905,   292,  1005,  1908,   294,  1005,  1910,  1000,  1917,
  1913,   296,  1915,    34,  1917,  1000,  1939,  1920,  1023,  1923,
  1024,  1321,  1926,  1025,  1321,  1929,  1039,  1321,  1934,  1040,
  1321,     6,  1321,  1939,  1041,  1321,     6,  1321,  1972,  1948,
  1010,  1001,  1358,  1783,  1011,  1577,  1760,  1952,   298,  1001,
  1358,  1954,   301,  1958,   308,  1033,  1337,  1961,   315,  1760,
  1963,   323,  1968,   328,  1703,  1321,  1708,  1970,   335,  1972,
   340,  2097,  1979,  1027,  1010,  1939,  1011,  1734,  1981,  1007,
  1989,  1373,  1010,  1530,  1552,  1011,  1747,  1006,  1994,   349,
  1035,  1766,  1006,  1999,   356,  1029,  1816,  1006,  2004,   362,
  1036,  1727,  1006,  2009,  1378,   356,  1029,  1006,  2016,  1031,
  1010,  1428,  1011,  1605,  1006,  2020,   369,  1514,  1006,  2025,
    83,   153,  1834,  1006,  2035,  1010,  1807,  1453,  1011,  1585,
  1001,  1402,  1495,  1006,  2039,  1656,  1428,  1626,  2043,   373,
  1003,  1038,  2048,   381,  1015,  1010,  1006,  2057,   387,  1021,
  1703,  1321,  1696,   228,  1034,  1006,  2068,   390,  1001,  1408,
     0,  1337,   171,  1337,     2,  1714,  1006,  2072,   397,  1006,
  1017,  2078,   259,  1035,  1004,  1034,  1006,  2081,     4,  1878,
  2084,   402,  1006,  2088,   417,  1001,  1006,  2092,   424,  1003,
  1006,  2095,  1001,   432,  2097,  1006;
%CONSTINTEGER SS= 1972
%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<<host&unsignedshorts=0 %START
%RECORDFORMAT RD((%INTEGER S1 %OR %SHORT PTYPE,%BYTE XB,FLAG),
      ((%INTEGER D %OR %REAL R),
      %INTEGER XTRA %OR %SHORT H0,H1,H2,H3 %OR %BYTE B0,B1,B2,B3,B4,B5,B6,B7))
%RECORDFORMAT TAGF((%SHORTINTEGER PTYPE,UIOJ,SNDISP,ACC,SLINK,KFORM %OR %C
      %INTEGER S1,S2,S3),%INTEGER LINK)
%RECORDFORMAT TRIPF(%BYTE OPERN,OPTYPE,CNT,DPTH,
      %SHORTINTEGER FLAGS,PUSE,FLINK,BLINK,%INTEGER X1,
      %RECORD(RD) OPND1,OPND2)
%RECORDFORMAT LISTF((%SHORTINTEGER PTYPE,(%SHORT UIOJ %OR %BYTE XB,FLAG),
      %SHORT SNDISP,ACC,SLINK,KFORM %OR  %INTEGER S1,S2,S3),%INTEGER LINK)
%FINISH %ELSE %START
%RECORDFORMAT RD((%INTEGER S1 %OR %HALF PTYPE,%BYTE XB,FLAG),
      ((%INTEGER D %OR %REAL R),
      %INTEGER XTRA %OR %HALF H0,H1,H2,H3 %OR %BYTE B0,B1,B2,B3,B4,B5,B6,B7))
%RECORDFORMAT TAGF((%HALFINTEGER PTYPE,UIOJ,SNDISP,ACC,SLINK,KFORM %OR %C
      %INTEGER S1,S2,S3),%INTEGER LINK)
%RECORDFORMAT TRIPF(%BYTE OPERN,OPTYPE,CNT,DPTH,
      %HALFINTEGER FLAGS,PUSE,FLINK,BLINK,%INTEGER X1,
      %RECORD(RD) OPND1,OPND2)
%RECORDFORMAT LISTF((%HALFINTEGER PTYPE,(%HALF UIOJ %OR %BYTE XB,FLAG),
      %HALF SNDISP,ACC,SLINK,KFORM %OR  %INTEGER S1,S2,S3),%INTEGER LINK)
%FINISH
%RECORDFORMAT WORKAF(%INTEGER NNAMES,CCSIZE,DSIZE,ASL MAX,ASL CUR BTM,CONST PTR,
      CONST BTM,LASTTRIP,WKFILEAD,WKFILEK,FILE ADDR,RELEASE,AASL0,CONST LIMIT,
      RTCOUNT,ARTOP,AMAINEP,DICTBASE,OPTCNT,INCLHEAD,S2,S3,S4,
      %INTEGERNAME LINE,N,S5,%STRING(9)LADATE,
      %BYTEINTEGERARRAYNAME CC,A,LETT,
      %INTEGERARRAYNAME WORD,TAGS,CTABLE,
      %RECORD(LEVELF)%ARRAYNAME LEVELINF,
      %INTEGERARRAY PLABS,PLINK(0:31),
      %RECORD(LISTF)%ARRAYNAME ASLIST)
!
! TRIPF_FLAGS SIGNIFY AS FOLLOWS
%CONSTINTEGER LEAVE STACKED=2****0;     ! SET LEAVE RESULT IN ESTACK
%CONSTINTEGER LOADOP1=2****1;           ! OPERAND 1 NEEDS LOADING
%CONSTINTEGER LOADOP2=2****2;           ! OPERAND 2 NEEDS LOADING
%CONSTINTEGER NOTINREG=2****3;          ! PREVENT REG OPTIMISNG
                                        ! OF TEMPS OVER LOOPS&JUMPS
%CONSTINTEGER USE ESTACK=2****4;        ! KEEP DUPLICATE IN ESTACK
%CONSTINTEGER USE MSTACK=2****5;        ! PUT DUPLICAT ON MSTACK
%CONSTINTEGER CONSTANTOP=2****6;        ! ONE OPERAND IS CONSTANT(FOR FOLDING)
%CONSTINTEGER COMMUTABLE=2****7;        ! OPERATION IS COMMUTABLE
%CONSTINTEGER BSTRUCT=2****12;          ! Proc contains inner blks or RTs
%CONSTINTEGER USED LATE=2****13;        ! I-RESULT USED AFTER LAB OR A LONG WAY AHEAD
%CONSTINTEGER ASS LEVEL=2****14;        ! ASSEMBLER LEVEL OPERATION
%CONSTINTEGER DONT OPT=2****15;         ! DONT DUPLICATE THIS RESULT
                                        ! USED FOR BYTE PTR & OTHER SODS!
!
%RECORDFORMAT EMASFHDRF(%INTEGER ENDRA,STARTRA,FBYTESIZE,W3,W4,W5,W6,W7)
                                        ! FORMAT FOR ARRAY HEADS
! %END %OF  %FILE "ERCC07.TRIMP_TFORM1S"
%EXTRINSICRECORD(PARMF)PARM
%EXTRINSICRECORD(WORKAF)WORKA
%EXTERNALROUTINESPEC POP(%INTEGERNAME A,B,C,D)
%EXTERNALROUTINESPEC PUSH(%INTEGERNAME A,%INTEGER B,C,D)
%externalroutinespec insert at end(%integername a,%integer b,c,d)
%EXTERNALROUTINESPEC FAULT(%INTEGER A,B,C)
!*
%externalintegerfnspec malloc(%integer bytes)
%externalintegerfnspec fileread %alias "read" (%integer fid, bad, blen)
%externalroutinespec free(%integer bytes)
!*
%if Target=MIPS %start
   %conststring(3) assprefix=" #"
%finish %else %if Target=M88k %start
   %conststring(3) assprefix=" ;"
%finish %else %start
   %conststring(3) assprefix=""
%finish
%EXTERNALINTEGERFN PASSONE
%ROUTINESPEC NEW SOURCE(%INTEGER NEW FIL AD)
%integerfnspec OLD SOURCE
%ROUTINESPEC READ LINE(%INTEGER MODE,CHAR)
%INTEGERFNSPEC COMPARE(%INTEGER P)
%ROUTINESPEC PNAME(%INTEGER MODE)
%ROUTINESPEC EVALCONST(%INTEGER MODE)
%ROUTINESPEC TEXTTEXT(%INTEGER EBCDIC)
%EXTERNALROUTINESPEC MOVE BYTES(%INTEGER LENGTH,FBASE,FOFF,TOBASE,TOOFF)
%if 1<<host&IBMFPFORMAT#0 %start
      %CONSTINTEGERARRAY PRECONSTS(0:3)=10,0,{NL}X'413243F6',X'A8885A31'{PI};
%finish %else %if host=Vax %Start
      %constintegerarray preconsts(0:3)=10,0,X'21fb4029',x'2d185444'
%finish %else %if 1<<host&wordswopped#0 %start
      %constintegerarray preconsts(0:3)=10,0,x'54442d18',x'400921fb';
%finish %else %start;          ! IEEE unswopped
       %constintegerarray preconsts(0:3)=10,0,x'400921fb',x'54442d18'
%finish
%INTEGER I,J,K,LLENGTH,LEVEL,QMAX,Q,R,S,SNUM,NNAMES,DSIZE,NEXT,JJ,CPTR,
      STARSTART,ARSIZE,HIT,CTYPE,LASTAT,LASTNAME,LASTEND,STRLINK,IHEAD,
      IDEPTH,FILEADDR,FILEPTR,FILEEND
%OWNBYTEINTEGERARRAYFORMAT SRCEF(0:1024*1024)

%RECORD(EMASFHDRF)%NAME HDR
%LONGREAL IMAX
%integer curlinead
%STRING(15)NEM
%INTEGERNAME LINE
%BYTEINTEGERARRAYNAME CC,SOURCE,A
%INTEGERARRAYNAME WORD,TAGS
      LINE==WORKA_LINE
      CC==WORKA_CC
      A==WORKA_A
      TAGS==WORKA_TAGS
      WORD==WORKA_WORD
      NNAMES=WORKA_NNAMES
      DSIZE=8*NNAMES
      ARSIZE=1024*WORKA_WKFILEK-(WORKA_CCSIZE+256);!256 BYTE MARGIN LEFT AT MAP TIME
      IMAX=(-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(4)
         PRINTSTRING("/* EPC Imp to C Translation ")
         PRINTSTRING("Release")
         WRITE(WORKA_RELEASE,1)
         PRINTSTRING(" Version ".WORKA_LADATE." */")
         NEWLINES(3)
         printstring("#include ""imptoc.h""
")
!        %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)!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
         curlinead=file addr+fileptr
            %IF Q>=LLENGTH %THEN QMAX=1 %AND READ LINE(0,0)
            %if llength=-1 %then %exit        { no more input}
            STARSTART=R
            R=R+3
            A(R)=LINE>>8
            A(R+1)=LINE&255
            R=R+2
            movebytes(4,addr(curlinead),0,addr(a(0)),r)
            r=r+4
            %IF COMPARE(SS)=0 %THEN %START
               FAULT(100,Q,QMAX<<16!LLENGTH)
               R=STARSTART
               Q=Q+1 %WHILE CC(Q)#';' %AND Q<LLENGTH
               Q=Q+1
            %FINISH %ELSE %START
               FAULT(102, WORKA_WKFILEK, 0) %IF R>ARSIZE
!               %IF A(STARSTART+9)=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+9)=ENDALT %AND %C
                     1<=A(STARSTART+10)<=2 %START;! ENDOF PROG OR FILE
                     %IF IHEAD=0 %THEN %EXIT
                     llength=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
            free(dataad)
         %FINISH %ELSE %START
            PRINTSTRING("C GENERATION NOT ATTEMPTED
")
         %FINISH
         %RESULT=R
%ROUTINE NEWSOURCE(%INTEGER NEWFILEADDR)
!***********************************************************************
!*    SETS UP COMPILER TO USE AN INCLUDED SOURCE FILES                 *
!***********************************************************************
%externalinteger 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=18000+2000*filesseen
%END
%integerfn 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
         %result=1
      %FINISH %ELSE %result=0
%END
%ROUTINE READ LINE(%INTEGER MODE,CHAR)
%integerfnSPEC GET LINE
%INTEGER DEL, LL, LP, PREV, LASTC, PPREV, LASTNS, i,j
      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 lp=GET LINE
     %if lp=0 %then llength=-1 %and %return
      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' %then %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
      j=LLENGTH
      LASTNS=CC(LLENGTH-1)
      %while  LASTNS=' ' %cycle             { Dont allow trailing spaces to trip us up}
         j=j-1
         LASTNS=CC(j-1)
      %repeat
      %IF LLENGTH-1=LASTC %THEN LLENGTH=LASTC %AND ->NEXT
      %IF LASTNS='C'+128 %THEN %start
         CC(j-1)=' '                 { obnliterate %c with space }
         LLENGTH=LLENGTH-1
         LASTC=LLENGTH
         ->NEXT
      %finish
      %IF MODE=0 %AND LASTNS='\' %THEN cc(LLENGTH)=13 %and LASTC=LLENGTH %AND ->NEXT
      %IF MODE=0 %AND LASTNS=',' %THEN LLENGTH=LLENGTH-1 %AND LASTC=LLENGTH %AND ->NEXT
      FAULT(101,0,0) %IF LLENGTH>WORKA_CCSIZE
      %RETURN
%%integerfn 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
         curlinead=0
      %FINISH %ELSE %START
        %IF FILEPTR>=FILE END %START
            %if OLD SOURCE=0 %then %result=0;                 ! RESET SOURCE FILES
            %result=GETLINE
         %FINISH
!         curlinead=file addr+fileptr
         %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
      %while ll>1 %and TLINE(ll-1)=' ' %cycle     { deal with trailing spaces }
         TLINE(LL-1)=TLINE(LL)
         LL=LL-1
      %repeat
      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
      %result=1             { line got OK}
%END
%END
%integerfn next nonspace
%integer i
      i=cc(q)
      q=q+1 %and i=cc(q) %while i=' '
      %result=i
%end
%INTEGERFN COMPARE(%INTEGER P)
%INTEGER I, J, ITEM, RA, RL, RP, RQ, RR, RS, MARKER, SSL, ALT, PP, nbochar
%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
!printstring("testing item&sym"); write(item,4); space; printsymbol(nextnonspace&127); 
!      write(q,5);
!      write(nextnonspace,4); newline
      %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=next nonspace;                  ! 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 next nonspace=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=next nonspace;                  ! 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=next nonspace;                  ! OBTAIN CURRENT CHARACTER
      ->FAIL %UNLESS '0'<=I<='9'
      S=0
      %WHILE '0'<=I<='9' %CYCLE
         S=10*S+I&15
         Q=Q+1; I=next nonspace
      %REPEAT
      A(R)<-S>>8; A(R+1)=S&255
      R=R+2; ->SUCC
BIP(1006):                              ! PHRASE S=SEPARATOR
      I=next nonspace;                  ! OBTAIN CURRENT CHARACTER
      a(r)=I; r=r+1
      ->SUCC %IF I=NL
      ->FAIL %UNLESS I=';'
      Q=Q+1; ->SUCC
BIP(1007):
                                        ! PHRASE COMMENT TEXT
      I=next nonspace;                  ! OBTAIN CURRENT CHARACTER
      %IF I='#' %THEN %start
         a(r)=1; r=r+1
         Q=Q+1; ->COMFOUND
      %finish
      %IF I='!' %THEN %start
         a(r)=2; r=r+1
         Q=Q+1; ->COMFOUND
      %finish
      ->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
      a(r)=3; r=r+1
COMFOUND:
      J=CC(Q)
      %CYCLE
         a(r)=j; r=r+1
         %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=next nonspace;                  ! OBTAIN CURRENT CHARACTER
      ->FAIL %UNLESS '0'<=I<='9'
      S=0
      %WHILE '0'<=I<='9' %CYCLE
         S=10*S+I&15
         Q=Q+1; I=next nonspace
      %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 read line?
      I=next nonspace;                  ! OBTAIN CURRENT CHARACTER
      %WHILE I=NL %%CYCLE
         %if llength=-1 %then fault(110,0,0)
         read line(0,0)
         RQ=1
         I=next nonspace
      %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=next nonspace;                  ! 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=next nonspace
      %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=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=next nonspace;                  ! OBTAIN CURRENT CHARACTER
      ->FAIL %UNLESS 32<I<127 %AND %C
         X'80000000'>>((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=next nonspace
      %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=next nonspace;                  ! 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=next nonspace;                  ! 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=next nonspace;                  ! 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=next nonspace;                  ! 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=next nonspace;                  ! OBTAIN CURRENT CHARACTER
      ->FAIL %UNLESS 32<I<=92 %AND %C
         X'80000000'>>(I&31)&X'1004000E'#0
                                        ! '='=1,'>='=2,'>'=3
                                        ! '#' OR '\=' OR '<>'=4
                                        ! '<='=5,'<'=6
                                        ! 7UNUSED,'->'=8,'=='=9
                                        ! '##' OR '\==' =10
      q=q+1; nbochar=next nonspace
      %IF I='=' %THEN %START
         %IF nbochar=I %THEN J=9 %AND ->JOIN1
         J=1; ->JOIN
      %FINISH
      %IF I='#' %THEN %START
         %IF nbochar=I %THEN J=10 %AND ->JOIN1
         J=4; ->JOIN
      %FINISH
      %IF I='\' %AND nbochar='=' %THEN %START
         Q=Q+1
         %IF next nonspace='=' %THEN J=10 %AND ->JOIN1
         J=4; ->JOIN
      %FINISH
      %IF I='>' %THEN %START
         %IF nbochar='=' %THEN J=2 %AND ->JOIN1
         J=3; ->JOIN
      %FINISH
      %IF I='<' %THEN %START
         %IF nbochar='>' %THEN J=4 %AND ->JOIN1
         %IF nbochar='=' %THEN J=5 %AND ->JOIN1
         J=6; ->JOIN
      %FINISH
      %IF I='-' %AND nbochar='>' %THEN J=8 %AND ->JOIN1
      ->FAIL
JOIN1:Q=Q+1
JOIN:
      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=next nonspace
      q=q+1; nbochar=next nonspace
      %if i='=' %then %start
         %if nbochar='=' %then A(R)=1 %AND Q=Q+1 %AND ->UPR
         A(R)=2; ->UPR
      %FINISH
      %IF I='<' %AND nbochar='-' %THEN A(R)=3 %AND Q=Q+1 %AND ->UPR
      %IF I='-' %AND nbochar='>' %THEN A(R)=4 %AND Q=Q+1 %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=next nonspace
      ->FAIL %UNLESS I=NL %OR I=';'
      Q=Q+1 %IF I=';'
      ->FAIL %UNLESS CTYPE=5 %AND (Host#emas %or A(S)<=31)
%BEGIN
%STRING(255) FNAME
%SYSTEMROUTINESPEC CONSOURCE(%STRING(255)FILENAME,%INTEGERNAME FILEADDR)
      LENGTH(FNAME)=A(S)
      CHARNO(FNAME,I)=A(S+I) %FOR I=1,1,A(S)
      %if host=Vax %Start
         %unless fname->(".") %then fname=fname.".INC"
      %finish
      CONSOURCE(FNAME,J)
      NEWSOURCE(J)
%END
      ->succ
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=next nonspace
      %CYCLE
         Q=Q+1
         %EXIT %IF I=NL %OR I=';'
         I=next nonspace
      %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=next nonspace
      q=q+1
      %RETURN %UNLESS TRTAB(FS)=2 %AND M'"'#next nonspace#M''''
                                        ! 1ST CHAR MUST BE LETTER
      %if PARM_QUOTES=0 %then FS=FS!32
      T=1
      LETT(NEXT+1)=FS; JJ=71*FS
      q=q-1
      %CYCLE
         Q=Q+1
         I=next nonspace
         %EXIT %IF TRTAB(I)=0
         %if PARM_QUOTES=0 %then I=I!32
         JJ=JJ+HASH(T)*I %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
      %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, nbochar, QQ
%integer hexformat
%integerarray rhexpat(0:3)
%constinteger powerl=75
%IF 1<<HOST&LLREALAVAIL#0 %START
   %if 1<<host&ibmfpformat#0 %Start
%constinteger powerll=-78
! from ibm assembler which claims to evaluate exactly and round to 128 bits
%CONSTLONGLONGREALARRAY    POWERS (-78:75)=                  %C
       {Ten to the -78}           R'001DA48CE468E7C772026520247D3556' ,
       {Ten to the -77}           R'011286D80EC190DC73617F3416CE4156' ,
       {Ten to the -76}           R'01B94470938FA89B73CEF808E40E8D5B' ,
       {Ten to the -75}           R'0273CAC65C39C96174615B058E891859' ,
       {Ten to the -74}           R'03485EBBF9A41DDC75DCD8E37915AF38' ,
       {Ten to the -73}           R'042D3B357C0692AA760A078E2BAD8D83' ,
       {Ten to the -72}           R'051C45016D841BAA774644B8DB4C7872' ,
       {Ten to the -71}           R'0611AB20E472914A786BEAF3890FCB47' ,
       {Ten to the -70}           R'06B0AF48EC79ACE878372D835A9DF0C7' ,
       {Ten to the -69}           R'076E6D8D93CC0C1179227C7218A2B67C' ,
       {Ten to the -68}           R'084504787C5F878A7AB58DC74F65B20E' ,
       {Ten to the -67}           R'092B22CB4DBBB4B67BB1789C919F8F49' ,
       {Ten to the -66}           R'0A1AF5BF109550F27C2EEB61DB03B98D' ,
       {Ten to the -65}           R'0B10D9976A5D52977D5D531D28E253F8' ,
       {Ten to the -64}           R'0BA87FEA27A539E97DA53F2398D747B3' ,
       {Ten to the -63}           R'0C694FF258C744327E0747763F868CD0' ,
       {Ten to the -62}           R'0D41D1F7777C8A9F7F448CA9E7B41802' ,
       {Ten to the -61}           R'0E29233AAAADD6A3008AD7EA30D08F01' ,
       {Ten to the -60}           R'0F19B604AAACA6260136C6F25E825961' ,
       {Ten to the -59}           R'101011C2EAABE7D702E23C577B1177DD' ,
       {Ten to the -58}           R'10A0B19D2AB70E6E02D65B6ACEAEAE9D' ,
       {Ten to the -57}           R'11646F023AB269050345F922C12D2D22' ,
       {Ten to the -56}           R'123EC56164AF81A3044BBBB5B8BC3C35' ,
       {Ten to the -55}           R'13273B5CDEEDB106050F55519375A5A1' ,
       {Ten to the -54}           R'1418851A0B548EA306C99552FC298785' ,
       {Ten to the -53}           R'14F53304714D926506DFD53DD99F4B30' ,
       {Ten to the -52}           R'15993FE2C6D07B7F07ABE546A8038EFE' ,
       {Ten to the -51}           R'165FC7EDBC424D2F08CB6F4C2902395F' ,
       {Ten to the -50}           R'173BDCF495A9703D09DF258F99A163DB' ,
       {Ten to the -49}           R'18256A18DD89E6260AAB7779C004DE69' ,
       {Ten to the -48}           R'1917624F8A762FD80B2B2AAC18030B02' ,
       {Ten to the -47}           R'19E9D71B689DDE710BAFAAB8F01E6E11' ,
       {Ten to the -46}           R'1A9226712162AB070C0DCAB3961304CA' ,
       {Ten to the -45}           R'1B5B5806B4DDAAE40D689EB03DCBE2FF' ,
       {Ten to the -44}           R'1C391704310A8ACE0EC1632E269F6DDF' ,
       {Ten to the -43}           R'1D23AE629EA696C10F38DDFCD823A4AB' ,
       {Ten to the -42}           R'1E164CFDA3281E3810C38ABE071646EB' ,
       {Ten to the -41}           R'1EDF01E85F912E3710A36B6C46DEC52F' ,
       {Ten to the -40}           R'1F8B61313BBABCE211C62323AC4B3B3E' ,
       {Ten to the -39}           R'20571CBEC554B60D12BBD5F64BAF0507' ,
       {Ten to the -38}           R'213671F73B54F1C8139565B9EF4D6324' ,
       {Ten to the -37}           R'2222073A8515171D145D5F9435905DF7' ,
       {Ten to the -36}           R'23154484932D2E72155A5BBCA17A3ABA' ,
       {Ten to the -35}           R'23D4AD2DBFC3D0771587955E4EC64B45' ,
       {Ten to the -34}           R'2484EC3C97DA624A16B4BD5AF13BEF0B' ,
       {Ten to the -33}           R'255313A5DEE87D6E17B0F658D6C57567' ,
       {Ten to the -32}           R'2633EC47AB514E65182E99F7863B6960' ,
       {Ten to the -31}           R'272073ACCB12D0FF193D203AB3E521DC' ,
       {Ten to the -30}           R'2814484BFEEBC29F1A863424B06F352A' ,
       {Ten to the -29}           R'28CAD2F7F5359A3B1A3E096EE45813A0' ,
       {Ten to the -28}           R'297EC3DAF94180651B06C5E54EB70C44' ,
       {Ten to the -27}           R'2A4F3A68DBC8F03F1C243BAF513267AB' ,
       {Ten to the -26}           R'2B318481895D96271D76A54D92BF80CB' ,
       {Ten to the -25}           R'2C1EF2D0F5DA7DD81EAA27507BB7B07F' ,
       {Ten to the -24}           R'2D1357C299A88EA71F6A58924D52CE4F' ,
       {Ten to the -23}           R'2DC16D9A0095928A1F2775B7053C0F18' ,
       {Ten to the -22}           R'2E78E480405D7B962058A9926345896F' ,
       {Ten to the -21}           R'2F4B8ED0283A6D3D21F769FB7E0B75E5' ,
       {Ten to the -20}           R'302F39421924844622BAA23D2EC729AF' ,
       {Ten to the -19}           R'311D83C94FB6D2AC2334A5663D3C7A0E' ,
       {Ten to the -18}           R'3212725DD1D243AB24A0E75FE645CC48' ,
       {Ten to the -17}           R'32B877AA3236A4B4244909BEFEB9FAD5' ,
       {Ten to the -16}           R'33734ACA5F6226F025ADA6175F343CC5' ,
       {Ten to the -15}           R'34480EBE7B9D5856266C87CE9B80A5FB' ,
       {Ten to the -14}           R'352D09370D4257362703D4E1213067BD' ,
       {Ten to the -13}           R'361C25C26849768128C2650CB4BE40D6' ,
       {Ten to the -12}           R'37119799812DEA1129197F27F0F6E886' ,
       {Ten to the -11}           R'37AFEBFF0BCB24AA29FEF78F69A5153A' ,
       {Ten to the -10}           R'386DF37F675EF6EA2ADF5AB9A2072D44' ,
       {Ten to the  -9}           R'3944B82FA09B5A522BCB98B405447C4B' ,
       {Ten to the  -8}           R'3A2AF31DC46118732CBF3F70834ACDAF' ,
       {Ten to the  -7}           R'3B1AD7F29ABCAF482D5787A6520EC08D' ,
       {Ten to the  -6}           R'3C10C6F7A0B5ED8D2E36B4C7F3493858' ,
       {Ten to the  -5}           R'3CA7C5AC471B47842E230FCF80DC3372' ,
       {Ten to the  -4}           R'3D68DB8BAC710CB22F95E9E1B089A027' ,
       {Ten to the  -3}           R'3E4189374BC6A7EF309DB22D0E560419' ,
       {Ten to the  -2}           R'3F28F5C28F5C28F531C28F5C28F5C28F' ,
       {Ten to the  -1}           R'4019999999999999329999999999999A' ,
       {Ten to the   0}           R'41100000000000003300000000000000' ,
       {Ten to the   1}           R'41A00000000000003300000000000000' ,
       {Ten to the   2}           R'42640000000000003400000000000000' ,
       {Ten to the   3}           R'433E8000000000003500000000000000' ,
       {Ten to the   4}           R'44271000000000003600000000000000' ,
       {Ten to the   5}           R'45186A00000000003700000000000000' ,
       {Ten to the   6}           R'45F42400000000003700000000000000' ,
       {Ten to the   7}           R'46989680000000003800000000000000' ,
       {Ten to the   8}           R'475F5E10000000003900000000000000' ,
       {Ten to the   9}           R'483B9ACA000000003A00000000000000' ,
       {Ten to the  10}           R'492540BE400000003B00000000000000' ,
       {Ten to the  11}           R'4A174876E80000003C00000000000000' ,
       {Ten to the  12}           R'4AE8D4A5100000003C00000000000000' ,
       {Ten to the  13}           R'4B9184E72A0000003D00000000000000' ,
       {Ten to the  14}           R'4C5AF3107A4000003E00000000000000' ,
       {Ten to the  15}           R'4D38D7EA4C6800003F00000000000000' ,
       {Ten to the  16}           R'4E2386F26FC100004000000000000000' ,
       {Ten to the  17}           R'4F16345785D8A0004100000000000000' ,
       {Ten to the  18}           R'4FDE0B6B3A7640004100000000000000' ,
       {Ten to the  19}           R'508AC7230489E8004200000000000000' ,
       {Ten to the  20}           R'5156BC75E2D631004300000000000000' ,
       {Ten to the  21}           R'523635C9ADC5DEA04400000000000000' ,
       {Ten to the  22}           R'5321E19E0C9BAB244500000000000000' ,
       {Ten to the  23}           R'54152D02C7E14AF64680000000000000' ,
       {Ten to the  24}           R'54D3C21BCECCEDA14600000000000000' ,
       {Ten to the  25}           R'558459516140148447A0000000000000' ,
       {Ten to the  26}           R'5652B7D2DCC80CD248E4000000000000' ,
       {Ten to the  27}           R'5733B2E3C9FD080349CE800000000000' ,
       {Ten to the  28}           R'58204FCE5E3E25024A61100000000000' ,
       {Ten to the  29}           R'591431E0FAE6D7214B7CAA0000000000' ,
       {Ten to the  30}           R'59C9F2C9CD04674E4BDEA40000000000' ,
       {Ten to the  31}           R'5A7E37BE2022C0914C4B268000000000' ,
       {Ten to the  32}           R'5B4EE2D6D415B85A4DCEF81000000000' ,
       {Ten to the  33}           R'5C314DC6448D93384EC15B0A00000000' ,
       {Ten to the  34}           R'5D1ED09BEAD87C034F78D8E640000000' ,
       {Ten to the  35}           R'5E13426172C74D82502B878FE8000000' ,
       {Ten to the  36}           R'5EC097CE7BC9071550B34B9F10000000' ,
       {Ten to the  37}           R'5F785EE10D5DA46D51900F436A000000' ,
       {Ten to the  38}           R'604B3B4CA85A86C4527A098A22400000' ,
       {Ten to the  39}           R'612F050FE938943A53CC45F655680000' ,
       {Ten to the  40}           R'621D6329F1C35CA454BFABB9F5610000' ,
       {Ten to the  41}           R'63125DFA371A19E655F7CB54395CA000' ,
       {Ten to the  42}           R'63B7ABC62705030555ADF14A3D9E4000' ,
       {Ten to the  43}           R'6472CB5BD86321E3568CB6CE6682E800' ,
       {Ten to the  44}           R'6547BF19673DF52E5737F2410011D100' ,
       {Ten to the  45}           R'662CD76FE086B93C58E2F768A00B22A0' ,
       {Ten to the  46}           R'671C06A5EC5433C6590DDAA16406F5A4' ,
       {Ten to the  47}           R'68118427B3B4A05B5AC8A8A4DE845987' ,
       {Ten to the  48}           R'68AF298D050E43955AD69670B12B7F41' ,
       {Ten to the  49}           R'696D79F82328EA3D5BA61E066EBB2F89' ,
       {Ten to the  50}           R'6A446C3B15F992665C87D2C40534FDB5' ,
       {Ten to the  51}           R'6B2AC3A4EDBBFB805D14E3BA83411E91' ,
       {Ten to the  52}           R'6C1ABA4714957D305E0D0E549208B31B' ,
       {Ten to the  53}           R'6D10B46C6CDD6E3E5F0828F4DB456FF1' ,
       {Ten to the  54}           R'6DA70C3C40A64E6C5F51999090B65F68' ,
       {Ten to the  55}           R'6E6867A5A867F10360B2FFFA5A71FBA1' ,
       {Ten to the  56}           R'6F4140C78940F6A2614FDFFC78873D45' ,
       {Ten to the  57}           R'7028C87CB5C89A256271EBFDCB54864B' ,
       {Ten to the  58}           R'71197D4DF19D60576367337E9F14D3EF' ,
       {Ten to the  59}           R'71FEE50B7025C36A630802F236D04754' ,
       {Ten to the  60}           R'729F4F2726179A22644501D762422C94' ,
       {Ten to the  61}           R'7363917877CEC055656B21269D695BDD' ,
       {Ten to the  62}           R'743E3AEB4AE138356662F4B82261D96A' ,
       {Ten to the  63}           R'7526E4D30ECCC321675DD8F3157D27E2' ,
       {Ten to the  64}           R'76184F03E93FF9F468DAA797ED6E38ED' ,
       {Ten to the  65}           R'76F316271C7FC390688A8BEF464E3946' ,
       {Ten to the  66}           R'7797EDD871CFDA3A695697758BF0E3CC' ,
       {Ten to the  67}           R'785EF4A74721E8646A761EA977768E5F' ,
       {Ten to the  68}           R'793B58E88C75313E6BC9D329EAAA18FC' ,
       {Ten to the  69}           R'7A25179157C93EC76C3E23FA32AA4F9D' ,
       {Ten to the  70}           R'7B172EBAD6DDC73C6D86D67C5FAA71C2' ,
       {Ten to the  71}           R'7BE7D34C64A9C85D6D4460DBBCA87197' ,
       {Ten to the  72}           R'7C90E40FBEEA1D3A6E4ABC8955E946FE' ,
       {Ten to the  73}           R'7D5A8E89D75252446F6EB5D5D5B1CC5F' ,
       {Ten to the  74}           R'7E3899162693736A70C531A5A58F1FBB' ,
       {Ten to the  75}           R'7F235FADD81C282271BB3F07877973D5';
   %else
%constinteger powerll=0
%constlonglongrealarray powers(0:75)=1, 10, 1@2, 1@3, 1@4, 1@5, 1@6, 1@7,
                               1@8, 1@9, 1@10, 1@11, 1@12, 1@13, 1@14, 1@15,
                               1@16, 1@17, 1@18, 1@19, 1@20, 1@21, 1@22, 1@23,
                               1@24, 1@25, 1@26, 1@27, 1@28, 1@29, 1@30, 1@31,
                               1@32, 1@33, 1@34, 1@35, 1@36, 1@37, 1@38, 1@39,
                               1@40, 1@41, 1@42, 1@43, 1@44, 1@45, 1@46, 1@47,
                               1@48, 1@49, 1@50, 1@51, 1@52, 1@53, 1@54, 1@55,
                               1@56, 1@57, 1@58, 1@59, 1@60, 1@61, 1@62, 1@63,
                               1@64, 1@65, 1@66, 1@67, 1@68, 1@69, 1@70, 1@71,
                               1@72, 1@73, 1@74, 1@75;
      %finish
      %LONGLONGREAL X,dvalue,CVALUE,DUMMY
      %CONSTLONGLONGREAL TEN=10
%FINISH %ELSE %START
      %LONGREAL X,dvalue,CVALUE,DUMMY
%constinteger powerll=0
%constlongrealarray powers(0:75)=1, 10, 1@2, 1@3, 1@4, 1@5, 1@6, 1@7,
                               1@8, 1@9, 1@10, 1@11, 1@12, 1@13, 1@14, 1@15,
                               1@16, 1@17, 1@18, 1@19, 1@20, 1@21, 1@22, 1@23,
                               1@24, 1@25, 1@26, 1@27, 1@28, 1@29, 1@30, 1@31,
                               1@32, 1@33, 1@34, 1@35, 1@36, 1@37, 1@38, 1@39,
                               1@40, 1@41, 1@42, 1@43, 1@44, 1@45, 1@46, 1@47,
                               1@48, 1@49, 1@50, 1@51, 1@52, 1@53, 1@54, 1@55,
                               1@56, 1@57, 1@58, 1@59, 1@60, 1@61, 1@62, 1@63,
                               1@64, 1@65, 1@66, 1@67, 1@68, 1@69, 1@70, 1@71,
                               1@72, 1@73, 1@74, 1@75;
      %CONSTLONGREAL TEN=10
%FINISH
%longreal cvaluep
%IF 1<<HOST&LINTAVAIL#0 %START
      %LONGINTEGER RADIXV
%FINISH %ELSE %START
      %INTEGER RADIXV
%FINISH
      %ON %EVENT 1,2 %START
         HIT=0; hexformat=0
         %RETURN
      %FINISH
      CPREC=5;  RR=R;  R=R+1
      DOTSEEN=0;  HIT=0; hexformat=0
      CVALUE=0;  DUMMY=0; X=0;  FS=next nonspace
      qq=q; q=q+1; nbochar=next nonspace; q=qq
      S=0;  ->N %IF M'0'<=FS<=M'9'
      ->DOT %IF FS='.' %AND MODE=0 %AND '0'<=nbo char<='9'
                                        ! 1 DIDT MIN
      CTYPE=1;  EBCDIC=0
      ->QUOTE %IF FS=M''''
      ->STR2 %IF FS=34
      ->NOTQUOTE %UNLESS nbo char=M'''';  Q=Q+2
      ->HEX %IF FS='X' %or FS='x'
      ->MULT %IF FS='M' %or FS='m'
      ->BIN %IF FS=M'B' %or FS='b'
      ->RHEX %IF (FS='R' %or FS='H' %or FS='r' %or FS='h') %AND MODE=0
      ->OCT %IF FS='K' %or FS='k'
      %IF FS='C' %or FS='c' %THEN EBCDIC=1 %AND ->MULT
      %IF (FS='D' %or FS='d') %AND MODE=0 %THEN %START
         CPREC=7
         %IF M'0'<=next nonspace<=M'9' %THEN ->N
         %IF next nonspace='.' %THEN ->DOT
      %FINISH
      Q=Q-2;  %RETURN
QUOTE:                                  ! SINGLE CH BETWEEN QUOTES
      hexformat=8; cprec=3
      q=q+1; s=cc(q); q=q+1
      %if s=nl %start
         READ LINE(1,'''')
         fault(110,0,0) %if llength=-1
        Q=1
      %finish
      %IF next nonspace=M'''' %THEN %START
         Q=Q+1
         %IF S#M'''' %THEN ->IEND
         %IF next nonspace=M'''' %THEN Q=Q+1 %AND ->IEND
      %FINISH
      %RETURN;                          ! NOT VALID
NOTQUOTE:                               ! CHECK FOR E"...."
      %RETURN %UNLESS FS='E' %AND nbochar=M'"'
      EBCDIC=1; Q=Q+1
STR2:                                   ! DOUBLE QUOTED STRING
      A(RR)=X'35';  TEXTTEXT(EBCDIC)
      CTYPE=5;  %RETURN
HEX:  T=0;                              ! HEX CONSTANTS
      hexformat=8
      %CYCLE
         I=next nonspace;  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<<Z) %and SS=SS>>(32-Z);! shifts modulo 31 on gould!
         CPREC=6
      %FINISH
IEND:
      %IF CPREC=6 %THEN %Start
         %if 1<<host&wordswopped#0 %Start
            move bytes(4,addr(ss),0,addr(a(0)),R+4)
            move bytes(4,addr(s),0,addr(a(0)),R)
         %else
            MOVEBYTES(4,ADDR(SS),0,ADDR(A(0)),R)
            move bytes(4,addr(s),0,addr(a(0)),r+4)
         %finish
         r=r+8
      %finish %else %IF cprec=3 %or cprec=4 %or (CPREC=5 %AND 0<=S<=X'7FFF') %START
         %if cprec=5 %then CPREC=4;
         A(R)<-S>>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! hexformat
      %RETURN
RHEX:                                   ! REAL HEX CONSTANTS
      T=0
      %CYCLE
         I=next nonspace;  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<<host&wordswopped#0 %Then j=4*(t-i) %else j=4*i
         move bytes(4,addr(rhexpat(0)),j,addr(a(0)),r)
         r=r+4
      %repeat
      HIT=1;  %RETURN
OCT:                                    ! OCTAL CONSTANTS
      hexformat=8
      T=0
      %CYCLE
         I=next nonspace;  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 next nonspace#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
      hexformat=8
      %CYCLE
         I=next nonspace;  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
      hexformat=8
      T=0; RADIXV=0
      RS=RSHIFT(S)
      Q=Q+1
      %CYCLE
         I=next nonspace
         %EXIT %UNLESS '0'<=I<='9' %OR 'A'<=I<='Z' %OR 'a'<=I<='z'
         %IF I<='9' %THEN I=I-'0' %ELSE I=I&15+9
         %EXIT %IF I>=S;                ! MUST BE LESS THAN BASE
         Q=Q+1
         %IF RS#0 %THEN RADIXV=RADIXV<<RS+I %AND T=T+RS %C
            %ELSE RADIXV=RADIXV*S+I %AND T=T+1
      %REPEAT
      %RETURN %IF T=0 %OR (1<<TARGET&LINTAVAIL=0 %AND RS>0 %AND T>MAXIBITS);! NO VALID DIGITS
      %IF 1<<HOST&LINTAVAIL#0 %THEN SS<-RADIXV>>32 %ELSE SS=0
      S<-RADIXV
      CTYPE=1
      %IF SS#0 %THEN CPREC=6
      ->IEND
N:                                      ! CONSTANT STARTS WITH DIGIT
      I=next nonspace
      %UNTIL I<M'0' %OR I>M'9' %CYCLE
         CVALUE=TEN*CVALUE+(I&15)
         Q=Q+1;  I=next nonspace;               ! 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=next nonspace
      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=next nonspace
      %REPEAT
      cvalue=cvalue+(dvalue/powers(s))
ALPHA:                                  ! TEST FOR EXPONENT
      %IF MODE=0 %AND next nonspace='@' %THEN %START
         Q=Q+1;  X=CVALUE
         Z=1;  I=next nonspace
         %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
               %if 1<<Target&LLREALAVAIL#0 %then cprec=7
               %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=next nonspace
         %IF I='''' %THEN Q=Q+1 %ELSE %RETURN
         DOTSEEN=1;                     ! ENSURE NOT TAKEN AS INTEGER
      %FINISH
      %if 1<<Host&LINTAVAIL#0 %and 1<<Target&LINTAVAIL#0 %andc
         dotseen=0 %and cvalue>imax %start
         radixv=lint(cvalue)
         ss<-radixv>>32; s<-radixv
         cprec=6; ->iend
      %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=next nonspace
         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 next nonspace#QU %THEN %EXIT
            %FINISH
            %IF I=10 %THEN %start
               READ LINE(1,QU)
              fault(110,0,0) %if llength=-1
            %finish %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
