pass1.i

    !*                                                                  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};
    constshortintegerarray 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'#0C
             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