BEGIN;  !IMP15 COMPILER  30/10/78 resurrected Sept 2002
!OUTPUT STREAMS
CONSTINTEGER ERR=0, OBJ=1, MAP=2
!input streams
!constinteger prim=2, prog=1;               !(tag limit reached)
!PRIMITIVE ROUTINE TAGS
CONSTINTEGER MONI=4;                        !MONITOR
CONSTINTEGER NST=5;                         !NEST
CONSTINTEGER LE=6;                          !TEST LESS-THAN OR EQUAL
CONSTINTEGER GE=7;                          !TEST GREATER-THAN OR EQUAL
CONSTINTEGER AR=8;                          !ARRAY REFERENCE
CONSTINTEGER ADEC=9;                        !ARRAY DECLARATION
CONSTINTEGER SH=10;                         !SHIFT
CONSTINTEGER ENT=16;                        !PROCEDURE ENTRY/EXIT
CONSTINTEGER FLT=17;                        !FAULT TRAP
CONSTINTEGER BAR=20;                        !BYTE ARRAY-REF
CONSTINTEGER BGET=21;                       !BYTE FETCH
CONSTINTEGER BPUT=22;                       !BYTE STORE
CONSTINTEGER ADR=28;                        !ADDR
CONSTINTEGER INT=29;                        !INTEGER
CONSTINTEGER PTXT=38;                       !PRINT TEXT
!DECLARATION CODES
CONSTINTEGER BEG=108;                       !BEGIN
CONSTINTEGER EXT=128, OWN=64, BODY=64
CONSTINTEGER REF=32, ARRAY=8, PROC=4

OWNINTEGER LINE=1;                          !LINE NUMBER
OWNINTEGER LINES=0;                         !LINE COUNT
OWNINTEGER ICOUNT=0;                        !INSTRUCTION COUNT
OWNINTEGER SYM=0;                           !CURRENT INPUT SYMBOL
OWNINTEGER SYMTYPE=0;                       !-2:LET, -1:DIG, 0:TERM
                                            ! 1:OTHER, 2:KEYLET
OWNINTEGER DECL=0;                          !DECLARATOR TYPE
OWNINTEGER SSTYPE=1;                        !STATEMENT TYPE
OWNINTEGER SECTION=0;                       !0:INSTR, 1:DATA
OWNINTEGER OWNC=0;                          !OWN COUNT
OWNINTEGER FAULTY=0;                        !FAULT INDICATOR
!CURRENT INPUT LINE
OWNINTEGER POS1=0;                          !START-OF-ATOM POSITION
OWNINTEGER POS=0;                           !CURRENT CHAR POSITION
INTEGERARRAY CHAR(1:73)
!NAME DICTIONARY
OWNINTEGER DMAX=0;                          !NAME DICT MAX
CONSTINTEGER DBOUND=500;                    !UPPER BOUND (CHANGED FROM 350)
INTEGERARRAY DICT(1:DBOUND)
!TAG INFO
OWNINTEGER GLOBAL=0;                        !ZERO OR ENDOFPRIM TAG
OWNINTEGER TMAX=0;                          !TAG MAX
INTEGER X;                                  !CURRENT TAG (WHEN RELEVANT)
OWNINTEGER LMIN=253;                        !COMP LAB MIN
INTEGERNAME TT0,TTX;                        !==TAGTYPE(0),TAGTYPE(X)
INTEGERARRAY TAGTYPE,INDEX(0:223)
! SIGNIFICANCE OF TAGTYPE VALUES:
!  VAL256+   VAL128  VAL64  VAL32  VAL0:15
!     0         0     SET     0    0 0 0 0   LABEL
!     0        EXT    OWN    REF   0 0 0 1   INTEGER  (EXT+OWN=CONST)
!     0         0     OWN    REF   0 0 1 0   BYTE
!  GRAM AD  SAFE/EXT  BODY   REF   0 1 0 0   PRED
!  GRAM AD  SAFE/EXT  BODY   REF   0 1  T    T FN
!     0         0      0      0    0 1 1 1   STRING
! BOUNDS AD     0      1      0    1 0 0 0   SWITCH
!     0         0     OWN    REF   1 0  T    T ARRAY
!  GRAM AD  SAFE/EXT  BODY   REF   1 1 0 0   ROUTINE
!  GRAM AD  SAFE/EXT  BODY   REF   1 1  T    T MAP
!     0         0      1      1    1 1 0 0   BEGIN
! NEVER STORED IN TAGTYPE
!     0         0      0      1    0 1 0 0   SPEC
!ANALYSIS RECORD
INTEGER SS;                                 !START OF SS
CONSTINTEGER NODEBOUND=70
INTEGERARRAY REFCO,SUB(1:NODEBOUND)

!* GRAMMAR AND KEYDICT GENERATED BY TAKEON PROGRAM
OWNINTEGER GMAX1= 196
OWNINTEGER GMAX= 196

OWNINTEGERARRAY PHRASE(112:127) = C
 194,  69,  72,  77,  81, 115, 125, 147,
 153, 156, 159, 168, 173, 176, 188,   0

OWNINTEGERARRAY ATOMIC(80:111) = C
  64,  70,  72,  77,  68,  69,  73,  67,
  73,  73,  74,  77,  76,  77,  78,  78,
  65,  65,  66,  66,  74,  78,  74,  12,
  18,  15,  15,  65,  10,  15,   9,  42

OWNINTEGERARRAY INITIAL(1:79) = C
            36225,   35842,   33923,    3332,   68741,       0,       0,
       0,       0,       0,       0,       0,       0,       0,       0,
       0, -118767,       0,       0,    3604,       0,       0,       0,
       0,       0,       0,       0,       0,       0,       0, -131041,
       0,       0, -117854, -117981,    3876, -117595, -117722,       0,
    2088,    4009,       0,       0,       0,       0,   33838,   33071,
       0,       0,    1842,    1075,    1460,    3765,       0,   66615,
   99384,   33849,   33850,   98363,       0,       0,       0,       0,
   35664, -118944, -118429,       0,       0,       0,       0,       0,
   35794, -118058, -118044,       0, -118196, -118061, -118043,       0

OWNINTEGERARRAY GRAM(0:255) = C
       0,     756, -129612, -129999,    1140,  -94156,  -94155, -129132,
       9, -126846,    4996,    1653, -128746,    1073, -131063,   33918,
 -129978,    1095, -129999,    2676, -130640,       9,      10,    5134,
    1137,    5329,    5745,    6129,    6526,    6517,   39367,   33913,
   33909,    4465, -126452,     110,   37625, -126739,     110,    6726,
   40441,    5376, -123378,       9,   38642, -127729,       9,   39027,
 -127601,       9,    1074,    7825,   39667, -124020,     110, -123127,
    7417, -123923,     110,    2832,    8070,    1088,    7040,    8262,
 -122481, -123002,    1040, -122810,    8070,    9030, -122225,       0,
    9358,    9594,    9610,    9850,      16,    9998,   10233,   10348,
    9849, -118944, -118767, -118196, -118058, -118061, -131041, -117981,
 -117854, -118429, -118044, -118043, -117722,   13477, -117492,   46494,
 -131008,   46664, -117492,   46750,   46960,   47216,   32890,   32887,
   46915,   32839,   46970,   79735,   65648,   79736, -116497,       0,
   80231,     116,  112506, -115978,   15482,  -82774,  -82645,       0,
   32768,   15862,   15222,  -82774,       0, -114546, -114004, -113852,
   16890, -121227,   17402, -112979,   32768,     118,   32880,   17424,
 -112870, -112741, -112612, -112979,   32768,   51450,   50301,   50428,
   50555, -117971,       0, -111775, -113832,   17243,  -78819,       0,
   65658, -111774, -113818,   17247, -117608, -117607,   32839, -110439,
 -109800,   53629, -110438, -109669, -109796,       0,   53883,   53756,
   54525, -109542, -109029,       0,   54652,   55165, -108902,       0,
 -131007, -131001, -131006, -113847, -113851, -113843, -113846, -113842,
 -121458,   23826,   24061,     104,   24299,   24332,   57338,   24681,
   57594,   13162,   24974,   25210,      16,       0,       0,       0,
       0,       0,       0,       0,       0,       0,       0,       0,
       0,       0,       0,       0,       0,       0,       0,       0,
       0,       0,       0,       0,       0,       0,       0,       0,
       0,       0,       0,       0,       0,       0,       0,       0,
       0,       0,       0,       0,       0,       0,       0,       0,
       0,       0,       0,       0,       0,       0,       0,       0,
       0,       0,       0,       0,       0,       0,       0,       0

OWNINTEGERARRAY KDICT(32: 425) = C
       0,     387,     131,     403,     131,     131,     407,     131,
     411,     415,     419,     431,     447,     451,     131,     475,
     129,     129,     129,     129,     129,     129,     129,     129,
     129,     129,     487,     490,     495,     523,     539,     131,
     131,     556,     628,     656,     708,     752,     904,     128,
     128,     972,    1152,     128,    1188,    1232,    1248,    1256,
    1284,     128,    1348,    1440,    1552,    1604,     128,    1636,
    1648,     128,     128,     131,    1695,     131,     131,     131,
 -118367,  -64814,   66268,   66204,  106541,   65947,   65550,   65552,
 -117462,   66331,   66522, -116949,  -65448,   65628,   66013,   65551,
 -116051, -116162,  -65384,   65692,   65553,   66077, -115665,   66459,
   66395,   65546,   65545, -114500, -114627, -114754,   69677,   65818,
   77869,   65818, -113987,  -57332,   73773,   66142, -113347, -113474,
  110637,   65882,  102445, -112188,    8782, -112349, -112470,  -60760,
   65578,   71336,   68265, -111039, -111676,      82,   70696, -111197,
 -111318,   70056,   71080,   68009,   71592, -110395,   10841,      69,
   65728,    9415,      78,   65591, -108534, -109361,    8665,    8908,
   65586, -108851,   10702,      84,   77827,    8909,   10830,   65547,
   65536, -107711,    9946, -107862,   69864,   70888, -107325,      68,
   71528, -107094,   69736,   70760, -102452, -105010,      88, -105271,
      84, -105659,    9426,   10702,    8649,   73731,   10066,    9793,
   73728,      84,   66847,      68, -104625,   65592,      70, -102842,
      80, -103099,      82, -103351,    9167,    8402,      77,   65595,
      77,   65593,    9938,   65594,    9801,      69,   65595,    8915,
  -65489,   65584, -100671, -101559,   10575,   65556,    9422,    9299,
 -101051,   65582,   10700,      69,   65583, -100148,    9813,      84,
   65572,    8915,   66719,  -94266,  -98738,  -98993,   11603,  -99158,
   70248,   71272,      84,   70568,    8916,    8903,      82,  -95295,
  -96186,  -97075,  -97586,  -65470,   65606,    9921,      69,  -63422,
   67654,   10305,  -96557,  -60603,   70470,    8912,      67,   66373,
      78,  -95661,  -61115,   69958,    8912,      67,   65861,   10578,
   11457,  -94770,   66116,    9921,      69,  -62910,   68166,   66356,
      77,  -93360,      83,  -93526,   69800,   70824,  -93142,   70440,
   71464,  -92607,   10825,   67817,  -92221,      68,   71656,  -91741,
  -91862,   69928,   70952,   67881,   10063,   10825,   10575,   65573,
   10831,   65580,  -90160,  -90286,   10071,   69635,   65579,      82,
   70632,      82,  -89019,   10057,   10836,   11333,      84,   65574,
    9412,    8387,    8916,  -88237,  -61179,   69894,    8912,      67,
   65797,  -86587,   10959,    9428,    8910,  -86957,  -60667,   70406,
    8912,      67,   66309,  -85296,  -85933,   10964,   10066,   66591,
    9813,    7892,  -85443,   65571,   65570,    8389,      84,   65587,
  -82111,  -82488,  -82736,  -83884,    9431,    8660,      72,   70145,
  -83007,  -83249,    9426,    9166,   65990,      80,   66783,   10834,
   65585,    8645,   67845,   10575,      84,   65536,      68,  -81501,
  -81622,   70376,   71400,   68329,  -80447,  -80696,   10962,      69,
   66655,   10053,   65558,      68,  -79837,  -79958,   70120,   71144,
   68073,      78,  -79028,    9428,      76,   67061,   10693,      83,
   66484,    9416,    8908,   66869,  -77373,   10575,  -77533,  -77654,
   69992,   71016,   67945,      84,  -77014,   70184,   71208,  -76611,
   65753,  106541

!!END OF GENERATED SECTION

INTEGERNAME APP;                            !== PHRASE(112)
INTEGER BAPP;                               !BASIC APP IE LB EXP RB
INTEGERNAME MREF;                           !== MAP RESULT REF

ROUTINESPEC COMPILE BLOCK(INTEGER LEVEL, BTAG INTEGERNAME BTYPE,GD)

    selectinput(2);                         !prim/perm specs
    APP == PHRASE(112);  BAPP = APP
    TT0 == TAGTYPE(0);  TT0 = BEG
    MREF == GRAM(INITIAL(34)>>7&255)
    COMPILE BLOCK(-3,0,TT0,TT0)
    NEWLINE
    MONITOR 192 IF FAULTY # 0
ROUTINE COMPILE BLOCK(INTEGER LEVEL,BTAG INTEGERNAME BTYPE,GD)
ROUTINESPEC PRINT SS(INTEGER S)
INTEGERFNSPEC GAPP
ROUTINESPEC FAULT(INTEGER N)
ROUTINESPEC ANALYSE
ROUTINESPEC COMPILE
OWNINTEGER AC=¬255, ACLIT=0
INTEGER TBASE,DBASE,LSTACK,ESTACK,PMAX,ATAG,DANGER,ACCESS,EXTIND,IBASE
    TBASE = TMAX;  DBASE = DMAX
    LSTACK = 3;  ESTACK = 0
    IF BTYPE # BEG START;                   !PROCEDURE (NOT BEGIN)
       ANALYSE;                             !FORMAL PARAMETERS
       X = GAPP<<8
       IF BTYPE&(¬255) # 0 START
          FAULT(18) IF BTYPE&(¬255) # X AND GLOBAL # 0
       FINISH ELSE START
          BTYPE = BTYPE+X
       FINISH
       ->FIN IF BTYPE&BODY = 0;             !SPEC ->
    FINISH
    PRINT SS(MAP+8) IF BTAG # 0
    ACCESS = BTAG;                          !NON-ZERO EXCEPT AT OUTSET
    EXTIND = BTYPE&EXT;  BTYPE = BTYPE!!EXTIND
    ATAG = 0;  IBASE = ICOUNT
    DANGER = 0;  PMAX = TMAX
    AC=¬PMAX AND ACLIT=0 IF PMAX-1=TBASE AND TAGTYPE(PMAX)&62=0
    CYCLE
       LINE = LINE+LINES
       NEWLINES(LINES) unless global=0;     !LINE-END CODE
       LINES = 0
       ANALYSE; COMPILE IF SS # 0
       IF SSTYPE < 0 START;                 !START OR END OF BLOCK
          AC = ¬255
          EXIT IF SSTYPE<<1 # 0;            !END
          COMPILE BLOCK(LEVEL+3,X,TAGTYPE(X),DANGER)
       FINISH
    REPEAT
    PRINT SS(MAP)
FIN:TMAX = TBASE;  DMAX = DBASE
    RETURN

ROUTINE PRINT SS(INTEGER S)
INTEGER K,P
    SELECT OUTPUT(S&7)
    WRITE(LINE,3);  SPACE;  SPACE
    SPACES(LEVEL) AND POS1=0 IF S # ERR
    P = 1
    CYCLE
       PRINT SYMBOL('^') IF P = POS1
       EXIT IF P = POS
       K = CHAR(P);  P = P+1
       EXIT IF K = NL OR (K = '%' AND P = POS)
       PRINT SYMBOL(K)
    REPEAT
    WRITE(ICOUNT-IBASE,5) IF S = MAP
    NEWLINE
    SELECT OUTPUT(OBJ)
END

ROUTINE PRINT IDENT
INTEGER I,J,K,L
    I = INDEX(X);  J = I>>9
    PRINT SYMBOL(J>>3+32)
    I = I&511;  J = J&7
    WHILE J # 0 CYCLE
       J = J-1
       CYCLE L = 12,-6,0
          K = DICT(I-J)>>L&63
          PRINT SYMBOL(K+32) IF K # 0
       REPEAT
    REPEAT
END

INTEGERFN GAPP;                             !GRAMMAR FOR APP
CONSTINTEGER COMMA=15, LB=14
INTEGER I,L

INTEGERFN CLASS(INTEGER K)
    RESULT = K&15+80 IF K&(ARRAY+PROC) # 0;   !PROC AND ARRAY PARAMS
    RESULT = 122 IF K&REF = 0;              !INTEGER->EXP(122)
    RESULT = 119 IF K&2 = 0;                !INTEGERNAME->REF(119)
    RESULT = 120;                           !BYTEINTEGERNAME->BREF(120)
END

ROUTINE SET GCELL(INTEGER C)
    C = L<<7+C;                             !LINK + CLASS
    WHILE L # GMAX CYCLE
       L = L+1;  RETURN IF GRAM(L) = C
    REPEAT
    GMAX = GMAX+1;  L = GMAX;  GRAM(L) = C
END

    I = TMAX
    RESULT = 255 IF I = TBASE;              !NULL APP (FOR NOW)
    L = GMAX1;                              !')' CELL
    CYCLE
       SET GCELL(CLASS(TAGTYPE(I)))
       I = I-1
       EXIT IF I = TBASE
       SET GCELL(COMMA);                    !',' CELL
    REPEAT
    SET GCELL(LB);                          !'(' CELL
    RESULT = L
END

ROUTINE FAULT(INTEGER N)
SWITCH S(0:18)
       POS1 = 0 IF N > 2
       PRINT SS(ERR) IF POS # 0
       SELECT OUTPUT(ERR)
       PRINT SYMBOL('*')
       ->S(N)
S(0):  PRINTTEXT 'FORM';  ->F
S(1):  PRINTTEXT 'ATOM';  ->F
S(2):  PRINTTEXT 'NAME';  ->F
S(3):  PRINTTEXT 'SIZE'; ->F
S(4):  PRINTTEXT 'DUPLICATE';  ->F
S(5):  PRINTTEXT '%BEGIN';  ->M
S(6):  PRINTTEXT '%CYCLE';  ->M
S(7):  PRINTTEXT '%START'; ->M
S(8):  PRINTTEXT '%END';  ->M
S(9):  PRINTTEXT '%REPEAT';  ->M
S(10): PRINTTEXT '%FINISH';  ->M
S(11): PRINTTEXT '%RESULT';  ->M
S(12): PRINT SYMBOL('''')
       PRINT IDENT
       PRINT SYMBOL('''')
M:     PRINTTEXT ' MISSING';  ->F
S(13): PRINTTEXT 'BOUNDS';  ->F
S(14): PRINTTEXT 'INDEX';  ->F
S(15): PRINTTEXT 'CONTEXT';  ->E
S(16): PRINTTEXT 'ACCESS';  ->A
S(17): PRINTTEXT 'ORDER';  ->F
S(18): PRINTTEXT 'MATCH'
F:     FAULTY = 1
A:     ACCESS = -1
E:     NEWLINE;  SELECT OUTPUT(OBJ)
       POS = 0 IF SYMTYPE = 0
END

ROUTINE ANALYSE
CONSTINTEGER COMMA=15
INTEGER ATOM1,ATOM2,SUBATOM,LAST,HEAD,MAX,DUP,TEXT,LIM,INDEX0
INTEGER K,N,S,G,CLASS,NMIN,NMAX
INTEGERNAME Z
OWNINTEGER QUOTE=0, KEY=0, GG=0

ROUTINE READ SYM
    ->2 UNLESS SYM = NL
    POS = 0;  POS1 = 0
1:  SYMTYPE = 1
2:  READ SYMBOL(SYM)
    POS = POS+1 UNLESS POS = 73
    CHAR(POS) = SYM
    IF SYM # NL START
       RETURN IF QUOTE # 0
       ->1 IF SYM = ' '
       SYMTYPE=2 AND ->2 IF SYM = '%'
      !KDICT(33:95) := LINK<9>:CODE<2>
       SYM = SYM-32 IF SYM >= 96
       KEY = KDICT(SYM)
       SYMTYPE = KEY&3-2 UNLESS KEY&3=0 AND SYMTYPE=2
    FINISH ELSE START
       LINES = LINES+1;  SYMTYPE = QUOTE;   !0,>0
    FINISH
END;  !READ SYM

ROUTINE CODE ATOM(INTEGER TARGET)
!TARGET (IF SPECIFIED) IS FIRST ATOM CLASS FROM GRAMMAR
INTEGER I,J,K
1:  POS1 = POS
    ATOM1 = 9;  ATOM2 = 0;  SUBATOM = 0
    RETURN IF SYMTYPE = 0;                  !NL OR SEMI-COLON
    ->NAME IF SYMTYPE = -2;                 !LETTER ->
    ->NUMBER IF SYMTYPE < 0;                !DIGIT ->
    ->QUOTED IF QUOTE # 0;                  !QUOTED SYMBOL ->
    ->QUOTEMARK IF SYM = ''''
    ->STRING IF SYM = '"'

!LOCATE ATOM IN FIXED DICT
!KDICT(96:KMAX) := MORE<1>:0<1>:LINK<9>:SYM<7>
!               OR MORE<1>:1<1>:SUBCLASS<10>:CLASS<6>
    I = KEY>>2;  READ SYM
    CYCLE
       J = KDICT(I)
       EXIT IF J&65536 # 0
       IF J&127 # SYM OR SYMTYPE < 0 START
          ->ERR UNLESS J < 0
          I = I+1
       FINISH ELSE START
          K = J>>7&511;  READ SYM
          IF J > 0 START
             IF K # 0 START
                ->ERR IF K # SYM OR SYMTYPE < 0
                READ SYM
             FINISH
             K = I+1
          FINISH
          I = K
       FINISH
    REPEAT
    ATOM1 = J&63;                           !ATOM CLASS
    SUBATOM = J>>6&1023
    ->1 IF ATOM1 = 0 AND SUBATOM = 0;       !% C NL, (SHORT)
    ATOM2 = KDICT(I+1)&63 IF J < 0;         !VARIANT ATOM CLASS
    RETURN UNLESS ATOM1 < 8;                !DECLARATOR
    DECL = 0 UNLESS LAST < 8
    !CUMULATE SUBATOM INFO IN DECL (FOR MULTI-WORD KEYWORDS)
    DECL = DECL!!SUBATOM
    !ADJUST PROCEDURE-TYPE PARAMETERS
    DECL = DECL-BODY+REF IF LAST # 0 AND DECL&PROC # 0;    !PROC PAR
    RETURN UNLESS ATOM1 = 0
   !EXTERNAL, BYTE
    ->1 IF SYMTYPE > 0
ERR:ATOM1 = -1
    RETURN

QUOTED:
    ATOM1 = COMMA AND RETURN IF LAST # COMMA;     !INFILTRATE COMMA
QUOTEMARK:
    ->STRING IF LAST = 38;                  !PRINTTEXT
    QUOTE = SYM;  READ SYM
    ATOM1 = 71;  SUBATOM = SYM;             !SCONST
    READ SYM IF SYM = QUOTE AND NEXT SYMBOL = QUOTE
    RETURN IF NEXT SYMBOL # QUOTE
    READ SYM
    ->ENDQUOTE
STRING:
    QUOTE = SYM;  READ SYM
    ATOM1 = 67; SUBATOM = TEXT;             !STRING
    J = 0
    WHILE SYM # QUOTE OR NEXTSYMBOL = QUOTE CYCLE
       READ SYM IF SYM = QUOTE
       IF J&(¬127) # 0 START
          DICT(TEXT) = J;  TEXT = TEXT-1
          IF TEXT = DMAX START;             !TOO LONG
             ATOM1 = -3;  TEXT = TEXT+1
          FINISH
          J = 0
       FINISH
       J = J<<7+SYM
       READ SYM
    REPEAT
    DICT(TEXT) = J-131072;  TEXT = TEXT-1
ENDQUOTE:
    QUOTE = 0;  READ SYM
    RETURN

NUMBER:
    ->NAME IF LAST=17 OR (LAST=0 AND SECTION=0);    !JUMP OR LAB
    ATOM1 = 71;                             !SCONST
    I = 10;                                 !DECIMAL
    CYCLE
       SUBATOM = 0
       CYCLE
          IF SYMTYPE=-1 THEN K=SYM-'0' ELSE K=SYM-'A'+10
          ->ERR IF K >= I
          SUBATOM = SUBATOM+K
          READ SYM
          EXIT IF SYMTYPE >= 0
          J = I;  K = SUBATOM;  SUBATOM = 0; !MULTIPLY BY RADIX
          WHILE J # 0 CYCLE
             SUBATOM = SUBATOM+K IF J&1 # 0
             K = K<<1;  J = J>>1
          REPEAT
       REPEAT
       RETURN IF SYM # '_'
       I = SUBATOM
       READ SYM;  ->ERR IF SYMTYPE >= 0
    REPEAT

ROUTINE LOOKUP(INTEGER D)
OWNINTEGER I;                               !OWN FOR OPTIMISATION
INTEGER J,K,L,M
    I = INDEX0+TMAX+1;  L = INDEX0+LIM
REP:I = I-1
    ->NEW IF I = L
    ->REP UNLESS INTEGER(I)&(¬511) = HEAD
    J = INTEGER(I)&511;  K = MAX
    WHILE K # DMAX CYCLE
       M = DICT(K)
       ->REP IF DICT(J) # M
       J = J-1; K = K-1
    REPEAT
    SUBATOM = I-INDEX0
    TTX == TAGTYPE(SUBATOM);  ATOM1 = TTX&15+64
    !SET UP GRAM FOR PARAMETERS
    IF TTX&PROC # 0 THEN APP=TTX>>8 ELSE APP=BAPP
    !NON-DECLARATIVE CONTEXT
    RETURN IF D&255 = 0
    !SPEC FOR PROC PARAMETER
    RETURN IF D = 36 AND APP = 0
    !LABEL AFTER JUMP, PROC AFTER SPEC
    TTX=TTX+BODY AND RETURN IF TTX&255+BODY = D
    DUP = 1
NEW:RETURN IF D = 0
    TMAX = TMAX+1;  SUBATOM = TMAX
    TTX == TAGTYPE(SUBATOM);  TTX = D;  ATOM1 = TTX&15+64
    INDEX(TMAX) = HEAD+MAX;  DMAX = MAX
END;   !LOOKUP

NAME:
    HEAD = (SYM-32)<<12;  MAX = DMAX
    CYCLE
       READ SYM;  ->25 IF SYMTYPE >= 0
       HEAD = HEAD+512;  MAX = MAX+1
       J = SYM-32
       READ SYM;  EXIT IF SYMTYPE >= 0
       J = J<<6+SYM-32
       READ SYM;  EXIT IF SYMTYPE >= 0
       J = J<<6+SYM-32;  DICT(MAX) = J
    REPEAT
    DICT(MAX) = J
25: ATOM1 = -2;  ATOM2 = 70;                !IDENT
    LIM = TBASE;                            !LOCAL
    LOOKUP(64) AND RETURN IF LAST = 0 AND SYM = ':';     !LABEL
    LOOKUP(256) AND RETURN IF LAST = 17;    !JUMP
    LOOKUP(DECL) AND RETURN IF TARGET = 70 AND DECL # 0;     !IDENT
    LIM = GLOBAL
    IF LAST = 40 THEN LOOKUP(256) ELSE LOOKUP(0);    !MCODE,NORMAL
    RETURN UNLESS ATOM1 = 65 AND TTX&(¬255) # 0
    ATOM1 = 71;  SUBATOM = DICT(TTX>>8);    !CONSTINTEGER
END;  !CODE ATOM

! GRAM LAYOUT: MORE<1> ORDER<2> LINK<8> CLASS<7>
    SS = 0;  SSTYPE = 1;  DECL = 0
    ATOM1 = 0;  LAST = 0;  DUP = 0
    TEXT = DBOUND;  INDEX0 = ADDR(INDEX(0))
    MREF = MREF&(¬127)+119;  MREF = MREF+1 IF BTYPE&2 # 0
    NMAX = 0;  NMIN = NODEBOUND+1;  N = 0
    IF GG = 0 OR SECTION # 0 START
       READ SYM IF SYMTYPE = 0
       ->SKP IF SYMTYPE = 0 OR SYM = '!'
       CODE ATOM(0);  ->SKP IF ATOM1 = 11;  !COMMENT
    FINISH
    ->L4 IF GG # 0
    ->91 IF ATOM1 <= 0
    GG = INITIAL(ATOM1)
    ->91 IF GG = 0
    SSTYPE = GG<<1&8_600000
    IF GG < 0 START;                        !INIT ATOM FOR IMP
       NMAX = 1;  REFCO(NMAX) = 0;  SUB(NMAX) = 1
    FINISH
L1: LAST = ATOM1;  ATOM1 = 0
    S = SUBATOM
L2: CLASS = GG&127
    IF CLASS >= 24 START;                   !NOT TRANSPARENT
       NMIN = NMIN-1;  ->90 IF NMIN = NMAX
       SUB(NMIN) = S
L3:    Z == N
       CYCLE;                               !INSERT CELL IN ORDER
          K = Z&127
          EXIT IF K = 0 OR GG&98304 = 0
          GG = GG-32768;  Z == REFCO(K)
       REPEAT
       REFCO(NMIN) = CLASS<<7+K;  Z = Z!!K+NMIN
    FINISH
L4: G = GG>>7&255
    CYCLE
       GG = GRAM(G);  CLASS = GG&127
       EXIT IF CLASS = 0
       IF CLASS < 112 START
          CLASS = ATOMIC(CLASS) IF CLASS >= 80
          CODE ATOM(CLASS) IF ATOM1 = 0
          ->L1 IF CLASS = ATOM1 OR CLASS = ATOM2
          ->91 IF GG >= 0
          G = G+1
       FINISH ELSE START
          NMAX = NMAX+1;  ->90 IF NMAX = NMIN
          REFCO(NMAX) = N; SUB(NMAX) = G
          N = 0
          G = PHRASE(CLASS)
       FINISH
    REPEAT
    S = 0
    WHILE N # 0 CYCLE;                      !REVERSE LINKS
       Z == REFCO(N)
       K = Z&127;  Z = Z!!K+S
       S = N; N = K
    REPEAT
    ->L5 IF NMAX = 0
    N = REFCO(NMAX);  G = SUB(NMAX)
    NMAX = NMAX-1
    K = GG;                                 !EXIT-POINT CODE
    CYCLE
       GG = GRAM(G)
       EXIT IF K = 0
       ->91 IF GG >= 0
       K = K-32768;  G = G+1
    REPEAT
    ->L2 UNLESS S # 0 AND Z&127 = 0;    !SINGLETON
    CLASS = Z>>7;  !DON'T BOTHER WITH NEW NODE
    ->L3
L5: SS = S
    FAULT(4) IF DUP # 0
    RETURN

!ERROR
90: ATOM1 = -3
91: READ SYM WHILE SYM # NL
    IF ATOM1 < 0 THEN FAULT(-ATOM1) ELSE FAULT(0)
    QUOTE = 0;  SYMTYPE = 0;  DECL = 0;  SECTION = 0
    GG = 0
    RETURN
SKP:READ SYM WHILE SYMTYPE # 0
END;  !ANALYSE


ROUTINE COMPILE
CONSTINTEGER LAC=68,LAD=95,TAD=71,ADA=64,DAC=65,DAD=93; !ada was 94
INTEGER I,J,K,NEXT,LINK,CLASS,REFDEST,BOWN
INTEGER PEND,PEND1,PENDOPR,LABCODE,ELSE,MAIN,LTAG,LNEST,FINAL
INTEGER CONTROL,INC,END,ILIT,ELIT
OWNINTEGER LIT=0,LIT1=0
SWITCH C(1:112)

ROUTINE PR(INTEGER X)
INTEGER I
    I = !X!
    WHILE I # 0 CYCLE
       PRINT SYMBOL(I&15+'0');              !'HEX' DIGIT
       I = I>>4
    REPEAT
    PRINT SYMBOL('-') IF X < 0
END

ROUTINE PLANT NAME(INTEGER X);              !PROCEDURES, EXT SPECS
INTEGER I,J
ROUTINE NEXT
    SPACE
    J = J-1 AND PR(DICT(I-J)) IF J # 0
END
    I = INDEX(X);  J = I>>9&7
    PR(I&(¬511)+TAGTYPE(X)&15);             !SYM1+LENGTH+TYPE
    I = I&511
    NEXT;  NEXT
    SPACE
END

ROUTINE SWOP;                               !SWITCH SECTIONS
OWNINTEGER T
    IF LEVEL < 0 START
       IF SECTION = 0 START
          PRINT SYMBOL('(');  T = X
       FINISH ELSE START
          PR(T);  PRINT SYMBOL(')')
          IF GLOBAL # 0 START;    !EXTERNAL NOT PERM
             PLANT NAME(T);  PR(T);  PRINT SYMBOL('!')
          FINISH
       FINISH
    FINISH ELSE PRINT SYMBOL('/')
    SECTION = SECTION!!1
END

ROUTINE DEF(INTEGER T);                     !DEFINE TAG
    PR(T);  PRINT SYMBOL('.')
    RETURN IF SECTION # 0
    ACCESS = 1;  AC = ¬255
END

ROUTINE OP(INTEGER OP);                     !OUTPUT OP-CODE
    PRINT SYMBOL(OP);  ICOUNT = ICOUNT+1
END

ROUTINE PLANT(INTEGER V);                   !PLANT VALUE
    PR(V);  OP('#')
END

ROUTINE PRINT(INTEGER X)
    IF PENDOPR >= 0 START
       FINAL = 0 UNLESS NEXT = LINK
       PENDOPR = PENDOPR!!FINAL;            !INVERT SKIP IF FINAL
       IF PENDOPR # 0 START
          PR(PENDOPR);  OP(79);             !OPR
       FINISH
       IF FINAL = 0 START
          LABCODE = MAIN;  PR(LMIN);  OP(76); !JMP
       FINISH
       DEF(LTAG-1) IF LNEST&1 # 0
       PENDOPR = -1;  ACCESS = 1
    FINISH
    PR(X)
END

ROUTINE NEST
    PRINT(NST);  OP(66);  AC = ¬AC;         !JMS NST (PRESERVES AC)
END

ROUTINE POP
    OP(84);  AC = 255;                      !LAC* T0
END

ROUTINE EXPEND;                             !DISCHARGE PENDING LAC
INTEGER C
    RETURN IF PEND < 0
    NEST IF AC >= 0
    UNLESS ¬AC = PEND START
       IF PEND = 0 START;                   !CONSTANT
          PRINT(LIT);  OP(36);              !LAC #LIT (PSEUDO-OP)
       FINISH ELSE START
          C = LAC; C = LAD IF PEND&256 # 0
          IF LIT # 0 START
             PRINT(LIT);  OP(36)
             C = TAD;  C = ADA IF PEND&256 # 0
          FINISH
          PRINT(PEND&255);  OP(C)
       FINISH
    FINISH ELSE START
       IF ACLIT # LIT START
          IF PEND = 0 START
             PRINT(LIT);  OP(36)
          FINISH ELSE START
             PRINT(LIT-ACLIT);  OP(39);     !TAD #
          FINISH
       FINISH
    FINISH
    AC = PEND;  ACLIT = LIT;  PEND = -1
END

ROUTINE LOAD(INTEGER T);                    !LOAD AC
    EXPEND;  PEND = T;  LIT = 0
END

ROUTINE DO(INTEGER C);                      !(ADD),TAD,AND,XOR,SAD
    IF PEND >= 0 START
       IF PEND = 0 START;                   !CONSTANT
          PRINT(LIT);  OP(C-32);            !PSEUDO-OP
       FINISH ELSE START
          IF LIT # 0 START
             IF C = TAD START
                PRINT(LIT);  OP(39);        !TAD #LIT (PSEUDO-OP)
             FINISH ELSE START
                EXPEND;  ->1
             FINISH
          FINISH
          PRINT(PEND);  OP(C)
       FINISH
    FINISH ELSE START
1:     OP(C+16);                            !<OP>* T0
    FINISH
    PEND = -1;  AC = 255 UNLESS C = 75;     !SAD
END

ROUTINE STORE(INTEGER T);                   !DEPOSIT AC
CONSTINTEGER DZM=67, ISZ=73
    IF PEND = 0 AND LIT = 0 START
       PEND = -1;  AC = ¬255 IF ¬AC = T
       FINAL = 512; PRINT(T);  OP(DZM)
    FINISH ELSE START
       IF PEND = T AND LIT = 1 AND ¬AC # T START
          PEND = -1
          FINAL = 512;  PRINT(T);  OP(ISZ)
          OP(79);                           !NOP
       FINISH ELSE START
          EXPEND
          AC=T AND ACLIT=0 IF PENDOPR < 0;  AC = ¬AC;   !??
          FINAL = 512;  PRINT(T);  OP(DAC)
       FINISH
    FINISH
END

ROUTINE OPR(INTEGER X);                     !OPERATE-GROUP
    EXPEND;  PRINT(X);  OP(79)
    AC = 255 IF X&4125 # 0
END

ROUTINE NOT;                                !COMPLEMENT AC
    IF PEND # 0 THEN OPR(1) ELSE LIT=¬LIT
END

ROUTINE NEG;                                !NEGATE
    IF PEND < 0 START
       PRINT(-1);  OP(39);
    FINISH ELSE LIT = LIT-1
    NOT
END

ROUTINE CALL(INTEGER T);                    !SUBROUTINE JUMP
    EXPEND;  PRINT(T);  OP(66);  AC = 255;  !JMS T
END

ROUTINE JMSX(INTEGER T);                    !SPECIAL JMS
    IF PEND >= 0 START;                     !SECOND PARAM SIMPLE
       PRINT(2);  OP(DAC);  AC = ¬AC
    FINISH ELSE START
       STORE(1);  POP;  STORE(2);  LOAD(1)
    FINISH
    CALL(T)
END

ROUTINE JUMP(INTEGER T);                    !JUMP
    PRINT(T);  OP(76)
END

ROUTINE MON(INTEGER N);                     !MONITOR
    PRINT(MONI);  OP(82);  PLANT(N&255+256);!JMS* MONI: FLTNUM
    AC = ¬255;  ACCESS = 0
END

ROUTINE AREF;                               !ARRAY REF
    CALL(AR);  PRINT(X);  OP(LAD)
END

ROUTINE BAREF
    CALL(BAR);  PRINT(X);  OP(LAD)
END

ROUTINE PLANT OWN
    OWNC = OWNC-1
    IF OWNC&BOWN = 0 START
       LIT = LIT<<9+LIT1 IF BOWN # 0
       PLANT(LIT)
    FINISH ELSE LIT1 = LIT
END

ROUTINE COMPILE END
INTEGER I,J,K
    WHILE LSTACK # 3 CYCLE
       FAULT(LSTACK&1+9)
       LMIN = LMIN+2;  LSTACK = LSTACK>>2
    REPEAT
    X = TMAX
    SWOP;                                   !SELECT DATA SECTION
    PLANT(0) IF DANGER # 0
    I = -1
    WHILE X # TBASE CYCLE
       TTX == TT0++X;  K = TTX&255
       IF K = OWN+ARRAY START;              !SWITCH
          J = TTX>>8
          IF J # 0 START
             SWOP;  DEF(X);  PLANT(DICT(J-1))
             J = DICT(J);  PLANT(J)
             OP(79) AND J=J-1 WHILE J > 0;   !NOP (JMP SET BY LOAD)
             SWOP
          FINISH
       FINISH
       IF K&(EXT+OWN) = 0 START
          IF K = 0 OR K&(PROC+REF) = PROC THEN FAULT(12) ELSE START
          IF K&(REF+ARRAY+PROC) = 0 AND DANGER = 0 START
             DEF(X);                        !DEFINE TAG DIRECT
          FINISH ELSE START
             DEF(-X);                       !DEFINE TAG INDIRECT
          FINISH
          IF K&(REF+ARRAY+PROC) = 0 AND DANGER # 0 START
             PLANT(-1);                     !POINTER SLOT
          FINISH ELSE START
             PLANT(0)
          FINISH
          I = I-1
       FINISH
       FINISH
       X = X-1
    REPEAT
    IF BTAG # 0 START
       DEF(BTAG);  PLANT(0);                !ENTRY POINT
       IF DANGER = 0 START
          IF PMAX # TBASE START
             CYCLE
                PRINT(PMAX);  OP(DAD)
                PMAX = PMAX-1
                EXIT IF PMAX = TBASE
                POP
             REPEAT
          FINISH
       FINISH ELSE START
          J = PMAX-TBASE;  J = J-1 IF J # 0
          CALL(ENT);                        !JMS ENTRY/EXIT
          PLANT(I);  PLANT(I+J-1);          !-SLOTS:-NEST
       FINISH
       IF BTAG#DANGER>0 THEN GD=BTAG ELSE BTYPE=BTYPE+EXT
    FINISH
    SWOP;                                   !REVERT TO INSTR SECTION
END

!PROCESS ANALYSIS RECORD

ROUTINE GET NEXT
INTEGER I
    IF NEXT = 0 START
       NEXT = REFCO(LINK)&127;  LINK = SUB(LINK)
    FINISH
    CYCLE
       X = SUB(NEXT);  TTX == TT0++X
       I = REFCO(NEXT);  CLASS = I>>7
       EXIT IF CLASS < 112 OR X = 0;        !ATOM OR NULL PHRASE
       IF I&127 # 0 START
          SUB(NEXT) = LINK;  LINK = NEXT
       FINISH
       NEXT = X
    REPEAT
    NEXT = I&127
END

    PEND = -1;  LIT = 0
    LABCODE = 0;  ELSE = 0;  PENDOPR = -1
    STOP IF AC >= 0
    NEXT = SS;  LINK = 0
    FAULT(16) IF SSTYPE = 0 AND ACCESS = 0
1:  GET NEXT
2:  ->C(X) IF CLASS <= 31;                  !OPERATORS,SIMP
    ->C(CLASS)
9:  ->1 IF NEXT # LINK
10: RETURN IF LABCODE = 0
11: JUMP(-(LMIN+1)) AND ACCESS=0 IF LABCODE&1=0;   !JUMP BACK FOR LOOPS
    RETURN IF LABCODE = 0
    DEF(LMIN) UNLESS LABCODE = 3
    DEF(LMIN+1) IF ELSE # 0;                !PICKUP POINT FOR ELSE
    RETURN


!COMPILE DECLARATIONS
INTEGERFN SIZE
INTEGER I
    I = LIT-LIT1+1
    IF I <= 0 OR I > 4095 START
       FAULT(13);  I = 200
    FINISH
    RESULT = I
END

ROUTINE SAVE(INTEGER V)
    DMAX = DMAX+1;  DICT(DMAX) = V
END

C(70):                                      !IDENT
    IF TTX&OWN = 0 START
       ->811 IF TTX&EXT # 0
       ->9 IF TTX&(REF+ARRAY) # ARRAY;      !SCALAR
       IF TTX&2 # 0 START;                  !BYTE
          PRINT(3);  OP(67);                !DZM T3 (AS INDIC)
       FINISH
       IF AC >= 0 START;                    !FIRST IN GROUP
          FAULT(17) IF LSTACK # 3
          JMSX(ADEC);                       !JMS ADEC
       FINISH ELSE START;                   !BOUNDS ALREADY SET
          LOAD(1);  CALL(ADEC);             !LAC T1:JMS ADEC
       FINISH
       ATAG = X;  PRINT(ATAG);  OP(DAD)
       AC = ¬255
       ->9
    FINISH
    OWNC = 0;  PEND = -1
    IF TTX&3 = 0 START;                     !SWITCH
       SAVE(-LIT)
       SAVE(SIZE)
701:   TTX = DMAX<<8+TTX
       ->9
    FINISH
    IF TTX&EXT # 0 START;                   !CONST
       SAVE(LIT)
       ->701
    FINISH
    SWOP IF SECTION = 0
    X = -X IF TTX&REF # 0
    DEF(X)
    IF TTX&(REF+ARRAY) # ARRAY START
       PLANT(LIT)
       SWOP IF LEVEL < 0
       ->9
    FINISH
    PLANT(-LIT)
    OWNC = SIZE;  PLANT(OWNC)
    LIT = 0;  BOWN = 0
    ->9 IF TTX&2 = 0
    BOWN = 1;  OWNC = OWNC&1+OWNC
    ->9
C(108):                                     !CONST BOUND SEP (COLON)
    LIT1 = LIT;  PEND = -1
    ->9
C(109):                                     !OWNSEP (COMMA)
    PLANT OWN IF OWNC > 0
    LIT = 0;  PEND = -1
    ->9
C(110):                                     !OWNT (T)
    PLANT OWN AND LIT = 0 WHILE OWNC > 0
    SWOP IF SECTION # 0;                    !REVERT TO INSTR SECTION
    RETURN
C(81):                                      !PROCEDURE IDENT
    IF TTX&(EXT+BODY) = 0 START;           !INTERNAL SPEC
       TTX = TTX+EXT IF GLOBAL = 0;   !PERM
       RETURN
    FINISH
811:PRINT SYMBOL('(');                      !BODY OR EXT SPEC
    ->9 IF TTX&BODY # 0;                !BODY
    PLANT NAME(X)
    PRINT(X);  PRINT SYMBOL(',')
    PRINT SYMBOL(')')
    ->9

!COMPILE BEGIN,END
C(57):                                      !ENDOFPRIM
    TBASE = TMAX
    RETURN
C(58):                                      !ENDOFPERM
    GLOBAL = TBASE;  TBASE = TMAX
    LINE = 1;  LINES = 0;  ICOUNT = 0
    selectinput(1);                         !switch to prog file
    RETURN
C(55):                                      !BEGIN
    IF LEVEL < 0 START;                     !MAIN BEGIN
       SSTYPE = 0;  ACCESS = 1;  LEVEL = 0
       PRINT SYMBOL('!');                   !ENTRY-POINT
    FINISH ELSE START
       TMAX = TMAX+1;  X = TMAX;            !TREAT AS ROUTINE
       TAGTYPE(X) = BEG;  INDEX(X) = 0
       CALL(X);  AC = ¬255
       PRINT SYMBOL('(')
    FINISH
    RETURN
C(56):                                      !END
    IF BTAG = 0 START;                      !MAIN PROGRAM
       FAULT(5);  SSTYPE = 0
       RETURN
    FINISH
    IF ACCESS # 0 START
       FAULT(11) IF ACCESS > 0 AND BTYPE&15 # 12 AND GLOBAL # 0
       PRINT(BTAG);  OP(92);                !JMP* BTAG
    FINISH
    DANGER = -ATAG IF DANGER = 0
    COMPILE END
    PLANT NAME(TBASE) IF GLOBAL # 0;        !NAME UNLESS PERM
    PRINT(TBASE);  PRINT SYMBOL(')')
    RETURN IF EXTIND = 0
    FAULT(15) UNLESS LEVEL = 0
    PLANT NAME(TBASE);  PR(TBASE);  PRINT SYMBOL('!')
    RETURN
C(59):                                      !ENDOFPROGRAM, ENDOFFILE
    MON(0) IF ACCESS # 0
    DANGER = 0
    COMPILE END UNLESS LEVEL < 0
    PRINT SYMBOL(')');                      !END OF BLOCK
    RETURN IF BTAG = 0
    FAULT(8);                               !MISSING END
    MONITOR 192

!COMPILE LOOPS AND CONDITIONS
!LSTACK, ESTACK AND LNEST ARE SINGLE-WORD NESTS
!LSTACK (2 BITS) KEEPS TRACK OF STATEMENT BRACKETS
!ESTACK (1 BIT) KEEPS TRACK OF ELSE JUMPS
!LNEST (3 BITS) DEALS WITH INTERNAL STRUCTURE OF COND STATEMENTS
!SIGNIFICANCE OF LSTACK VALUES:
!    00   CYCLE
!    01   IF,UNLESS
!    10   FOR,WHILE,UNTIL
!    11   ELSE
!SIGNIFICANCE OF LNEST VALUES:
!    000  AND AFTER AND,IF
!    001  AS ABOVE + DISCONTINUITY
!    010  OR AFTER OR,UNLESS
!    011  AS ABOVE + DISCONTINUITY
!    100  IF / WHILE / AND AFTER OR,UNLESS
!    101  AS ABOVE + DISCONTINUITY
!    110  UNLESS / OR AFTER AND,IF
!    111  UNTIL / AS ABOVE + DISCONTINUITY

ROUTINE POP LABEL(INTEGER IND)
    FAULT(IND+6) AND RETURN IF LSTACK=3 OR LSTACK&1 # IND
    LABCODE = LSTACK&3;  ELSE = ESTACK&1
    LSTACK = LSTACK>>2;  ESTACK = ESTACK>>1
    LMIN = LMIN+2
END

!COMPILE FOR LOOP
! ORDER =  (START) CONTROL (INC) CSEP1 (END) CSEP2 (CYCLE,IMP)
C(107):                                     !CONTROL VARIABLE
    CONTROL = X
    PEND1 = PEND;  LIT1 = LIT;              !START VALUE
    PEND = -1
    ->9

ROUTINE SET(INTEGERNAME W)
    IF PEND # 0 START
       TMAX = TMAX+1;  W = TMAX
       TAGTYPE(W) = 1;  INDEX(W) = 0;       !DECLARE WL (INTEGER=1)
       STORE(W);  LIT = 0
    FINISH ELSE START
       W = 0;  PEND = -1
    FINISH
END
C(105):                                     !CSEP1
    SET(INC);  ILIT = LIT
    ->9
C(106):                                     !CSEP2
    SET(END);  ELIT = LIT;                  !END VALUE
    LOAD(INC);  LIT = ILIT;                 !LAC INC
    NEG
    IF PEND1 < 0 START
       POP IF AC < 0;  DO(TAD)
    FINISH ELSE START
       IF PEND # 0 START
          LOAD(PEND1);  LIT = LIT1;  DO(TAD)
       FINISH ELSE START
          PEND = PEND1;  LIT = LIT+LIT1
       FINISH
    FINISH
    STORE(CONTROL);                         != START-INC
    DEF(LMIN+1);                            !LAB FOR JUMP BACK
    LOAD(CONTROL);                          !LAC CONTROL
    LOAD(END);  LIT = ELIT;  DO(75);        !SAD END
    JUMP(LMIN);                             !JMP (NEXT INSTR)
    LOAD(INC);  LIT = ILIT;  DO(TAD);       !TAD INC
    STORE(CONTROL);                         !DAC CONTROL
    LABCODE = 2
    ->9
C(51):                                      !REPEAT
    POP LABEL(0)
    ->11

!COMPILE CONDITIONS
!STAT ORDER  = CWORD COND IMP, CWORD COND START'
!            CWORD COND IMP ELSE IMP, CWORD COND IMP ELSE START
!COND ORDER  = AND C1 C2, OR C1 C2, NOT C1
!SCOND ORDER = EXP1 EXP2 COP, EXP1 EXP2 COP EXP3 COP
C(53):!LWORD: WHILE(20), UNTIL(23)
    JUMP(LMIN-1) IF X&1 # 0;                !UNTIL - JUMP OVER TEST
    DEF(LMIN+1);                            !LABEL FOR LOOPING
C(52):                                      !CWORD: IF(12), UNLESS(14)
    LABCODE = 0;  MAIN = X>>3; LNEST = X&7
    LTAG = LMIN
    ->9

ROUTINE PUSH(INTEGER ANDOR)
    IF LNEST&2 # ANDOR START
       ANDOR = ANDOR+4;  LNEST = LNEST!1
    FINISH
    LTAG = LTAG-1 IF LNEST&1 # 0
    LNEST = LNEST<<3+ANDOR
END

C(42):                                      !AND
    PUSH(0)
    ->9
C(43):                                      !OR
    PUSH(2)
    ->9
C(44):                                      !NOT
    LNEST = LNEST!!2
    ->9

C(45): !COP: <(64), =(128), <=(192), >=(576), #(640), >(704)
    PUSH(0) IF NEXT # 0;                    !DOUBLE-SIDED
    IF PEND = 0 AND LIT = 0 START;          !COMPARISON WITH ZERO
       PEND = -1
       X = X+4096 IF NEXT # 0;              !+CLA IF DOUBLE
    FINISH ELSE START
       K = PEND
       IF X&64 # 0 START;                   !<,<=,>=,>
          IF PEND=0 AND LIT>0 AND NEXT=0 START
             PRINT(64);  OP(79);            !SMA
             NEG;  DO(TAD)
          FINISH ELSE START
             IF X&128 # 0 START;            !<=,>
                JMSX(LE);  X = X!!448;      !SZL,SNL
             FINISH ELSE START
                JMSX(GE);  X = X!!832;      !SZL,SNL
             FINISH
             AC = K IF K >= 0;              !ACLIT STILL SET
          FINISH
       FINISH ELSE START;                   !=,#
          DO(75);                           !SAD
          IF X = 640 START;                 !#
             IF K >= 0 AND NEXT # 0 START
                PEND = K;  AC = ¬255
             FINISH
             X = 0
          FINISH ELSE X = 512;              !SKP
       FINISH
    FINISH
CONDSKIP:
    X = X!!512 IF LNEST&2 # 0;              !INVERT
    IF LNEST&(¬7) # 0 OR MAIN = 2 START
       OPR(X) UNLESS X = 0
       AC = ¬AC UNLESS NEXT # 0
       I = LTAG;  J = LNEST
       WHILE J&4 = 0 CYCLE
          J = J>>3;  I = J&1+I
       REPEAT
       JUMP(I);  LABCODE = MAIN IF I = LMIN
       DEF(LTAG-1) IF LNEST&1 # 0
       LNEST = LNEST>>3
       LTAG = LNEST&1+LTAG
    FINISH ELSE START
       PENDOPR = X;  FINAL = 0
       AC = ¬AC;  AC = ¬255 IF LNEST&1 # 0
    FINISH
    ->9

!COMPILE START, FINISH, ELSE, EXIT
C(49):C(50):                                !START, CYCLE
    PRINT(0) IF PENDOPR >= 0;               !DISCHARGE PENDING SKIP
    DEF(LMIN+1) IF LABCODE = 0;             !INDEFINITE CYCLE
    MONITOR 21 IF LSTACK < 0
    LSTACK = LSTACK<<2+LABCODE
    ESTACK = ESTACK<<1+ELSE
    LMIN = LMIN-2
    RETURN
C(46):                                      !FINISH
    POP LABEL(1)
    ->9
C(47):                                      !FINISH ELSE
    POP LABEL(1)
    FAULT(15) IF LABCODE = 3
C(48):                                      !ELSE
    IF ACCESS # 0 START
       JUMP(LMIN+1); ELSE = 1
    FINISH
    LABCODE = 3;  DEF(LMIN)
    ->9
C(20):                                      !EXIT
    J = LMIN+2;  K = 1
    J = J+2 AND K = K<<2 WHILE K&LSTACK # 0
    FAULT(15) AND K=0  IF (-K)&LSTACK = 0
    ACCESS = 0;  FINAL = 512
    JUMP(J);  LSTACK = K<<1!LSTACK
    ->9

!COMPILE LABELS AND JUMPS
C(80):                                      !LAB
    FAULT(17) IF X < ATAG
    DEF(X)
    RETURN
C(64):                                      !L
    ACCESS = 0;  FINAL = 512;  JUMP(X)
    ->9
C(82):                                      !SLAB
    I = TTX>>8;  RETURN IF I = 0;           !POINTER TO BOUNDS
    LIT = DICT(I-1)+LIT;                    !INDEX - UPPER
    IF LIT <= 0 START
       LIT = DICT(I)+LIT;                   !+ NUMBER
       IF LIT > 0 START
          PRINT(LIT+1);  SPACE;  DEF(X)
          RETURN
       FINISH
    FINISH
    FAULT(14)
    RETURN
C(72):                                      !SNAME
    AREF
    PRINT(3);  OP(88);  MON(135);           !XCT* T3:MON 7+128
    ->10

!COMPILE PROCEDURE EXITS
C(16):                                      !RETURN
    I = 12;                                 !SHOULD BE ROUTINE
PEX:FAULT(15) IF BTYPE&15 # I
    ACCESS = 0;  FINAL = 512
    PRINT(BTAG);  OP(92);                   !JMP* BTAG
    ->9
C(17):                                      !TRUE
    OPR(2050);                              !STL
171:I = 4;                                  !SHOULD BE PRED
    ->PEX
C(18):                                      !FALSE
    OPR(2048);                              !CLL
    ->171
C(35):                                      !FRESULT

    I = BTYPE&3+4;                          !SHOULD BE FN
    J = AC;  K = ACLIT;  EXPEND
    AC = J;  AC = ¬255 IF AC >= 0;  ACLIT = K
    ->PEX
C(34):                                      !MRESULT
    I = BTYPE&3+12;                         !SHOULD BE MAP
    STORE(3)
    ->PEX

!COMPILE STOP, FAULT, MONITOR, ETC
C(19):                                      !STOP
    MON(64)
    ->9
C(36):                                      !FAULT
    FAULT(15) IF BTAG # 0;                  !SHOULD BE MAIN PROG
    CALL(FLT);  PLANT(1);                   !JMS FLT: SLOT FOR NP
    AC = ¬255
    GET NEXT
    JUMP(X)
    ->9
C(37):                                      !MONITOR
    PEND = -1;  MON(LIT)
    ->9
C(40):                                      !MCODE (OPERAND AFTER)
    LIT = SUB(NEXT)
C(41):                                      !LMCODE (CONST BEFORE)
    PRINT(LIT);  OP(X)
    AC = ¬255
    RETURN
C(67): C(87):                               !STRING (PRINTTEXT)
    CALL(PTXT);                             !PTEXT SR (TEXT FOLLOWS)
    UNTIL I < 0 CYCLE
       I = DICT(X);  PLANT(I);  X = X-1
    REPEAT
    AC = ¬255
    GET NEXT;                               !IGNORE CALL
    ->9

!COMPILE OPERANDS
ROUTINE PCALL
!PROCEDURE CALL
    CALL(X)
    RETURN IF DANGER # 0 AND DANGER # BTAG
    DANGER = X IF TTX&EXT=0 AND X<=PMAX;    !NOT SAFE
END

ROUTINE MCALL
!MAP CALL
    IF X=INT AND PEND>0 AND LIT=0 AND TAGTYPE(PEND)&(OWN+REF)=OWN START
       I = PEND;  PEND = -1
    FINISH ELSE START
       PCALL;  I = 3
    FINISH
END

ROUTINE RESTORE
    IF PEND1 >= 0 START
       PEND = PEND1;  LIT = LIT1
       AC = ¬255;  EXPEND
    FINISH ELSE START
       POP
    FINISH
END

 C(71):                                     !SCONST
    I = X
    GET NEXT
    IF PEND >= 0 AND CLASS = 28 AND X <= 2 START
       !EXP +- LIST
       I = -I IF X # 1;  LIT = LIT+I
       ->9
    FINISH
    LOAD(0);  LIT = I
    ->2
C(103):                                     !ASSA: = (EXP = APP (A,M))
    PEND1 = PEND;  LIT1 = LIT;  PEND = -1
    ->9
C(65):                                      !V
    LOAD(X)
    ->9
C(73):                                      !ARRAY ELEMENT (VAL)
    AREF;  I = 3
VG: PRINT(I);  OP(84);                      !LAC*
    ->9
C(77):                                      !MAP ELEMENT (VAL)
    MCALL
    ->VG IF I = 3
    NEST IF AC >= 0;  AC = 255
    ->VG
C(66):                                      !BV
    LOAD(256+X)
BG: CALL(BGET)
    ->9
C(74):                                      !BYTE ARRAY ELEMENT (VAL)
    BAREF
    ->BG
C(78):                                      !BYTE MAP ELEMENT (VAL)
    PCALL
    ->BG
C(96):                                      !VDEST: V
    STORE(X)
    ->9
C(86):                                      !ARRAY ELEMENT (DEST)
    AREF;  I = 3
VP: RESTORE
VP1:PRINT(I);  OP(81);                      !DAC*
    AC = ¬AC
    ->9
C(83):                                      !MAP ELEMENT (DEST)
    MCALL
    ->VP IF I = 3 OR AC < 0
    ->VP1
C(99):                                      !BVDEST: BV
    CALL(BPUT);  PRINT(X);  OP(LAD)
    AC = ¬255
    ->9
C(100):                                     !BADEST: BA
    BAREF
BP: RESTORE
    CALL(BPUT);  PRINT(3);  OP(LAC)
    AC = ¬255
    ->9
C(101):                                     !BMDEST: BM
    PCALL
    ->BP
C(112):                                     !APP (NULL)
    EXPEND;  NEST IF AC >= 0
    ->9
C(84):C(85):C(89):C(90):C(92):              !PPAR,FPAR,APAR,BAPAR,RPAR
C(93):C(94):C(97):C(98):                    !MPAR,BMPAR,VREF,BVREF
    LOAD(256+X);                            !LAD X
    ->9
C(88):                                      !ARRAY ELEMENT (REF)
    AREF
    ->9
C(102):                                     !BYTE AREF
    BAREF
    ->9
C(91):C(95):                                !MAP ELEMENT (REF,BREF)
    PCALL UNLESS X = INT
    ->9
C(69):                                      !F (CALL)
    PCALL UNLESS X = ADR
    ->9
C(68):                                      !P (CALL)
    PCALL
    X = 256;                                !FOR SNL
    ->CONDSKIP
C(76):                                      !R (CALL)
    EXPEND;  FINAL = 512;  PCALL
    AC = ¬255
    ->9

C(111): ->9;                                !SEP

!COMPILE OPERATORS
C(104):                                     !MOD
    OPR(65);  OPR(513);                     !SMA!CMA:SKP!CMA
    PRINT(1);  OP(39);                      !TAD #1
    ->9
C(1):                                       !PLUS-SIGN
    DO(TAD) IF CLASS # 24;                  !TAD (UNLESS UNARY)
    ->9
C(2):                                       !MINUS-SIGN
    IF CLASS # 24 START
       IF PEND > 0 START
          PRINT(1);  OP(79);                !INFILTRATE CMA
          DO(TAD);  NOT;                    !TAD: CMA
       FINISH ELSE START
          NEG; DO(TAD)
       FINISH
    FINISH ELSE START
       NEG
    FINISH
    ->9
C(3):                                       !UOP: ¬
    NOT
    ->9
C(4): C(5):                                 !LEFT-SHIFT, RIGHT-SHIFT
    IF PEND = 0 AND LIT&(¬7) = 0 START
       PEND = -1
       WHILE LIT # 0 CYCLE
          IF X # 5 THEN OPR(2056) ELSE OPR(2064);    !RCL,RCR
          LIT = LIT-1
       REPEAT
    FINISH ELSE START
       NEG IF X = 5
       JMSX(SH)
    FINISH
    ->9
C(6):                                       !AND
    DO(74)
    ->9
C(10):                                      !XOR
    DO(69)
    ->9
C(11):C(12):C(13):C(14):C(15):              !OR,MULT,IDIV,DIV,EXP
    JMSX(X)
   ->9
C(8):                                       !REFOP -- (DISP -- REF)
    NEG
C(7):                                       !REFOP ++ (DISP ++ REF)
    GET NEXT
    IF PEND = 0 START
       PEND = 256+X;                        !AD OF X PLUS LIT
    FINISH ELSE START
       EXPEND
       PRINT(X);  OP(ADA)
       AC = 255
    FINISH
    ->9
C(9):                                       !REFASS: ==
    GET NEXT;  FAULT(15) IF TTX&REF = 0
    IF PEND-256 = X AND LIT = 1 START
       PRINT(X);  OP(89);                   !ISZ* (FOR ISZ)
       AC = ¬255 IF ¬AC&255 = X
    FINISH ELSE START
       IF PEND > 0 START
          TTX == TT0++(PEND&255)
          EXPEND
          IF TTX&(OWN+REF) = 0 START
             PRINT(-65537);  OP(42);        !AND #-65537
          FINISH
       FINISH
       PRINT(X);  OP(DAD)
       AC = ¬(X+256);  ACLIT = 0
    FINISH
    ->9
END;   !COMPILE SS
END;   !COMPILE BLOCK
ENDOFPROGRAM