%BEGIN; !IMP15 COMPILER  30/10/78
!OUTPUT STREAMS
%CONSTINTEGER ERR=0, OBJ=1, MAP=2
!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)

    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);                     !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
%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
    CLOSE OUTPUT
    %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