%BEGIN;                               !HAL-70
!    INPUT/OUTPUT STREAMS
%OWNINTEGER MAIN=1, PRE=2;            !INPUT
%OWNINTEGER BIN=1, LIS=2;             !OUTPUT
!    OPERAND TYPES
%OWNINTEGER OPMASK=16_F000;           !MACHINE INSTRUCTION OR MACRO
%OWNINTEGER MACRO=16_A000
%OWNINTEGER SINGLE=16_5000
%OWNINTEGER FMASK=16_0800;            !FORWARD REF
%OWNINTEGER OPFMASK=16_F800;          !=OPMASK+FMASK
%OWNINTEGER UMASK=16_0200;            !UNDEF (FORWARD REF)
%OWNINTEGER BMASK=16_0100;            !BYTE
%OWNINTEGER REG=16_0080;              !REGISTER
%OWNINTEGER MEMMASK=16_0040;          !MEM REF
%OWNINTEGER RELMASK=16_0020;          !RELOCATABLE
%OWNINTEGER XMASK=16_0010;            !INDEXED
%OWNINTEGER REGXMASK=16_0090;         !=REG+XMASK
%OWNINTEGER RELUXMASK=16_0230;        !=RELMASK+UMASK+XMASK
!    TEXT POINTERS (BYTE ADDRESSES)
%OWNINTEGER CODEPOS;                  !(NOT ACTUALLY BYTE)
%OWNINTEGER STARTPOS;                 !START OF CURRENT LINE
%OWNINTEGER GETPOS;                   !INPUT POINTER (NEXT)
%OWNINTEGER PUTPOS
%OWNINTEGER PSEUDOLIM
%OWNINTEGER PRINTPOS;                 !START OF PRINT LINE
%OWNINTEGER FAULTPOS
%OWNINTEGER MACLIM;                   !MACRO DEF LIMIT
!    OTHER POINTERS (WORD ADDRESSES)
%OWNINTEGER MP;                       !MACRO-CALL PARAMETERS
%OWNINTEGER QBASE,QSTART,QLIM,TRANSF; !OPERAND QUEUE
%OWNINTEGER DEFMIN;                   !TAG MIN (DOWN - RESET)
%OWNINTEGER DEFLIM;                   !TAG LIM (FIXED)
%OWNINTEGER ALMAX;                    !ASSEMBLER LAB MAX (UP - RESET)
%OWNINTEGER LABMIN;                   !USER LAB MIN (DOWN - RESET)
%OWNINTEGER LABLIM;                   !USER LAB LIM (FIXED)
%OWNINTEGER BP;                       !BLOCK POINTER (UP - DOWN)
%OWNINTEGER NP;                       !NEST POINTER (DOWN - UP)
%OWNINTEGER STORELIM;                 !(FIXED)
%INTEGER SYM;                         !CURRENT SYMBOL
%INTEGER TERM;                        !TAG TERMINATOR
%INTEGER FSYM;                        !FAULT FLAG SYMBOL
%OWNINTEGER CHARS=0;                  !PRINT CHAR COUNT
%OWNINTEGER LINES=0;                  !PRINT LINE COUNT
%OWNINTEGER BINCOUNT=0;               !OUTPUT RECORD ITEM COUNT
%OWNINTEGER CHECK=0;                  !OUTPUT RECORD CHECKSUM
%OWNINTEGER PASS=-1;                  !CURRENT PASS (-1,0,1)
%OWNINTEGER LIST=-1;                  !LISTING CONTROL
%INTEGER ASSCOND,SKIP;                !ASSEMBLY CONDITIONS (BIT NEST)
%OWNINTEGER SAVE=1;                   !REG SAVE DISPLACEMENT
%OWNINTEGER TEMPS=12;                 !TEMPORARY REGISTER SET (2,3)
%INTEGER LOCTYPE,LOC;                 !LOCATION COUNTER
%INTEGER ACC,ATYPE,AVAL;              !MAIN TEMP REGISTER
%INTEGER CREG,CTYPE,CVAL;             !CONDITION CODE
%INTEGER COND;                        !CONDITION CODE MASK
%INTEGER DREG,DUSE;                   !DESTINATION REGISTER
%INTEGER TYPE,VAL;                    !CURRENT TYPE,VALUE
%INTEGER TAG1,TAG2;                   !TAG (CHARS 1:3, 4:6)
%INTEGER MODE;                        !ASSEMBLY MODE
%INTEGER PEND;                        !TAG ALREADY RECOGNISED
%INTEGER FLAG;                        !JUMPS / AHM
%OWNINTEGER QQ='?'
%OWNINTEGERARRAY BREC(1:52);          !BINARY OUTPUT RECORD
%INTEGER SBOUND
    SBOUND = 32767;
    SELECT OUTPUT(LIS)
%INTEGERARRAY STORE(1:SBOUND)
%INTEGERFN CHAR(%INTEGER P)
  %result = 0; ! STORE(P)
%END
%ROUTINE PUT CHAR(%INTEGER K)
!AT PUTPOS WITH POST-INCREMENT
  !STORE(PUTPOS) = K
  PUTPOS = PUTPOS + 1
%END
%ROUTINE FAULT(%INTEGER K)
!RECORD (FIRST) FAULT
!NOT NECESSARILY CULPABLE IN PASS 0
    FSYM = K %IF FSYM = ' '
%END
%ROUTINE PRINT(%INTEGER K)
    INTEGER(CODEPOS+CHARS) = K
    CHARS = CHARS+1
%END
%ROUTINE PRINT WORD(%INTEGER V)
    %ROUTINE PRINT HIT(%INTEGER V)
        V = V&15+'0';  V = V+7 %IF V > '9'
        PRINT(V)
    %END
    %ROUTINE PRINT1(%INTEGER V)
        PRINT HIT(V>>4);  PRINT HIT(V)
    %END
    PRINT1(V>>8);  PRINT1(V)
%END
%ROUTINE PRINT LOC
    PRINT WORD(LOC)
    %IF LOCTYPE&RELMASK # 0 %THEN PRINT('''') %ELSE PRINT(' ')
    PRINT(' ')
%END
%ROUTINE DO NEWLINE
    NEWLINE;  LINES = LINES+1
    NEWLINES(2) %AND LINES = 0 %IF LINES = 61
%END
%ROUTINE PRINT LINE
   %ROUTINE PRINTIT(%INTEGER SUB)
   %OWNINTEGER MARKER=124;            !VERTICAL BAR
   %INTEGER P,Q,K
       %RETURN %IF CHARS = 0 %AND CHAR(PRINTPOS) = NL
       PRINT SYMBOL(FSYM);  SPACE
       P = CODEPOS;  Q = P+CHARS
       PRINT SYMBOL(INTEGER(P)) %AND P=P+1 %WHILE P # Q
       %RETURN %IF PRINTPOS = 0
       SPACES(17-CHARS)
       P = PRINTPOS;  Q = 0
       %CYCLE
          PRINT SYMBOL(MARKER) %IF P = FAULTPOS
          K = CHAR(P);  K = SUB %IF P = PSEUDOLIM
          PRINT SYMBOL('''') %IF (K!!Q)&128 # 0
          %RETURN %IF K = NL
          PRINT SYMBOL(K&127)
          P = P+1;  Q = K
       %REPEAT
   %END
    %RETURN %IF PASS = 0
    %UNLESS LIST < 0 %OR (PRINTPOS=0 %AND FSYM=' ' %AND LIST&1=0) %START
       NEWLINES(3) %IF LINES = 0
       PRINTIT(' ')
       DO NEWLINE
    %FINISH
    %IF FSYM # ' ' { %AND OUTDEV # 1 } %START
       SELECT OUTPUT(0)
       PRINTPOS = STARTPOS %IF PRINTPOS = 0
       PRINT LOC %IF CHARS = 0
       PRINTIT(NL)
       NEWLINE
       SELECT OUTPUT(LIS)
    %FINISH
    FSYM = ' ';  PRINTPOS = 0;  CHARS = 0
%END
%ROUTINE PUT(%INTEGER V)
!STORE 4-BIT ITEM IN BINARY RECORD
%OWNINTEGER HOLD=0
    V = V&15
    HOLD = HOLD<<4+V
    BINCOUNT = BINCOUNT+1
    %IF BINCOUNT&3 = 0 %START
       BREC(BINCOUNT>>2) = HOLD
       CHECK = CHECK!!HOLD
       HOLD = 0
    %FINISH
%END
%ROUTINE PUT WORD(%INTEGER V)
    %ROUTINE PUT1(%INTEGER V)
        PUT(V>>4);  PUT(V)
    %END
    PUT1(V>>8);  PUT1(V)
%END
%ROUTINE OUTPUT RECORD
%OWNINTEGER SEQ=0
%INTEGER I
    %ROUTINE OUTPUT WORD(%INTEGER W)
        PRINT SYMBOL(W>>8&255);  PRINT SYMBOL(W&255)
    %END
    PUT(0) %WHILE BINCOUNT # 208
    SELECT OUTPUT(BIN)
    %CYCLE I = 1,1,10
       PRINT SYMBOL(0);                   !RUNOUT
    %REPEAT
    PRINT SYMBOL(16_F0);                  !HEADER CODE
    SEQ = SEQ-1
    OUTPUT WORD(SEQ);                 !SEQUENCE NUMBER
    OUTPUT WORD(\(CHECK!!SEQ));       !CHECKSUM
    %CYCLE I = 1,1,52
       OUTPUT WORD(BREC(I))
    %REPEAT
    BINCOUNT = 0;  CHECK = 0
    SELECT OUTPUT(LIS)
%END
%ROUTINE PLANT VAL
%INTEGER I,J
    TYPE = 0 %IF TYPE = SINGLE
    I = 2;  I = 4 %IF TYPE&OPMASK # 0
    %IF PASS > 0 %START
       OUTPUT RECORD %IF BINCOUNT+I+I >= 208
       %IF I = 4 %START
          %IF TYPE&16_4000 = 0 %START
             PUT(11);  J = TYPE!!OPMASK
             TYPE = RELMASK
          %FINISH %ELSE %START
             PUT(10);  J = TYPE;  TYPE = 0
          %FINISH
          PUT WORD(J)
          PRINT LINE %IF CHARS # 0
          PRINT LOC
          PRINT WORD(J);  PRINT(' ')
       %FINISH %ELSE %START
          %IF TYPE&RELMASK # 0 %THEN PUT(9) %ELSE PUT(8)
          %IF CHARS # 0 %THEN PRINT(' ') %ELSE PRINT LOC
       %FINISH
       PUT WORD(VAL);  PRINT WORD(VAL)
       PRINT('''') %IF TYPE&RELMASK # 0
       PRINT LINE %IF TYPE&RELMASK#0 %OR CHARS=15
    %FINISH
    LOC = LOC+I
%END
%ROUTINE NEST(%INTEGER K)
    NP = NP-1;  %SIGNAL %EVENT 23 %IF NP = BP
    INTEGER(NP) = K
%END
%ROUTINE SET LAB(%INTEGER DEST)
%INTEGER D
    D = DEST
    %CYCLE
       TYPE = INTEGER(NP)&16_FFF+DEFLIM; !DEST SLOT
       NP = NP+1
       VAL = INTEGER(NP);             !LOC OF JUMP
       NP = NP+1
       ATYPE = -1;  CREG = -1
       FLAG = 0;  FLAG = 2 %IF (D-VAL)>>1+PASS <= 16
       VAL = VAL-FLAG
       %IF PASS = 0 %START
          D = D-FLAG;  INTEGER(TYPE) = D
          %IF FLAG # 0 %START
             LOC = LOC-2;  DEST = DEST-2
             %WHILE TYPE # ALMAX %CYCLE
                TYPE = TYPE+1;  INTEGER(TYPE) = INTEGER(TYPE)-2
             %REPEAT
          %FINISH
       %FINISH %ELSE %START
          FAULT('P') %IF INTEGER(TYPE) # D
       %FINISH
       %RETURN %UNLESS INTEGER(NP)&16_1000 # 0
       %IF INTEGER(NP)&16_2000 # 0 %START; !OR
          D = VAL+4 %IF D = DEST
       %FINISH %ELSE %START
          D = DEST
       %FINISH
    %REPEAT
%END
%ROUTINE ASSEMBLE
!   INTERDATA OP-CODES (+FORMATS)
%OWNINTEGER LOAD=16_080F, LB=16_9303
%OWNINTEGER ADD=16_0A0F, SUB=16_0B0F, AND=16_0407
%OWNINTEGER OR=16_0607, XOR=16_0707
%OWNINTEGER SLLS=16_7508, SRLS=16_7408, SLHL=16_0D04, SRHL=16_0C04
%OWNINTEGER COMP=16_0907, CLB=16_9402
%OWNINTEGER STORE=16_0002, STB=16_9202, AHM=16_2102
%OWNINTEGER BT=16_0203, BF=16_0303
!    FORMAT CODES
%OWNINTEGER REGISTER=1, MEM=2, LIT=4, SHORT=8
%OWNINTEGER ZQUERY=0
%INTEGER OP,K,Q,LITVAL,NQ,TYPE1,VAL1,FREE
%SWITCH ASS(-30:-1)
%ROUTINE FORM INST(%INTEGER CODE)
!    LS 4 BITS OF CODE DEFINE VALID FORMATS
!    INTERDATA OP-CODES FOR DIFFERENT FORMATS
!    ARE SYSTEMATICALLY RELATED
!    SHORT=REGISTER+SINC, LIT=REGISTER+LINC, MEM=REGISTER+MINC
%OWNINTEGER SINC=16_1C00, LINC=16_C000, MINC=16_4000
%INTEGER OP
    OP = CODE&16_FFF0
    %IF TYPE = REG %START
       %IF CODE&REGISTER # 0 %START
          TYPE = SINGLE;  VAL = OP+VAL
          %RETURN
       %FINISH
       TYPE = XMASK+VAL;  VAL = 0;    !COERCE TO INDEXED IMMEDIATE
    %FINISH
    %IF TYPE=0 %AND |VAL|<=15 %AND CODE&SHORT#0 %START; !SHORT
       VAL = -VAL %AND OP = OP!!16_100 %IF VAL < 0
       TYPE = SINGLE;  VAL = OP+SINC+VAL
    %FINISH %ELSE %START
       FAULT('R') %IF TYPE&31 = XMASK; !R0 AS INDEX
       %IF TYPE&MEMMASK = 0 %START;   !IMMEDIATE
          FAULT('I') %IF CODE&LIT = 0
          OP = OP+LINC
       %FINISH %ELSE %START;                  !MEMORY
          FAULT('I') %IF CODE&MEM = 0
          OP = OP+MINC
       %FINISH
       OP = OP!!OPMASK %IF TYPE&RELMASK # 0
       TYPE = TYPE&15+OP
    %FINISH
%END
%ROUTINE PLANT JUMP
%INTEGER I,OP
    OP = BF;  COND=\COND %AND OP=BT %IF COND < 0
    %IF TYPE&(\UMASK) = LOCTYPE %START
       I = LOC>>1-VAL>>1
       FAULT('J') %AND I=0 %IF FLAG # 0 %AND |I| > 15
       %IF |I| <= 15 %START
          %IF TYPE&UMASK = 0 %OR FLAG # 0 %START
             OP = OP<<1+2;            !0408, 0608
             TYPE = 0;  VAL = I
          %FINISH %ELSE %START
             FAULT('S') %IF LIST >= 0 %AND LIST&8 # 0
          %FINISH
       %FINISH
    %FINISH
    FORM INST(COND<<4+OP)
    PLANT VAL
    COND = 0
%END
%ROUTINE SET JUMP(%INTEGER CASE)
%INTEGER THOLD,VHOLD,FHOLD
    ALMAX = ALMAX+1;  %SIGNAL %EVENT 22 %IF ALMAX = LABMIN
    NEST(LOC);  NEST(ALMAX-DEFLIM+CASE)
    THOLD = TYPE;  VHOLD = VAL;  FHOLD = FLAG
    TYPE = LOCTYPE;  VAL = INTEGER(ALMAX);  FLAG = 0
    TYPE = TYPE+UMASK %IF PASS = 0
    COND = \COND
    PLANT JUMP
    TYPE = THOLD;  VAL = VHOLD;  FLAG = FHOLD
%END
%ROUTINE PLANT INST(%INTEGER CODE)
    FORM INST(CODE)
    SET JUMP(16_1000) %IF COND # 0
    PLANT VAL
%END
%ROUTINE LOAD REG(%INTEGER R)
%INTEGER OP
    %IF ATYPE = TYPE %AND AVAL = VAL %START
       TYPE = REG;  VAL = ACC
       %RETURN %IF R = ACC
    %FINISH
    ATYPE = TYPE %AND AVAL = VAL %IF R = ACC
    ATYPE = -1 %IF (ATYPE=REG %AND AVAL=R) %OR ATYPE&15=R#0
    %IF TYPE&BMASK = 0 %START
       OP = LOAD
       OP = ADD %AND TYPE = 0 %IF TYPE!!XMASK = R # 0
       CREG = R;  CTYPE = 0;  CVAL = 0
    %FINISH %ELSE %START
       OP = LB
       CREG = -1 %IF CREG = R
    %FINISH
    PLANT INST(R<<4+OP)
    TYPE = REG;  VAL = R
%END
%ROUTINE RELEASE
%INTEGER I
    %RETURN %IF TYPE&REGXMASK = 0
    I = TYPE&15;  I = VAL %IF I = 0
    %IF I = DREG %START
       DUSE = DUSE-1
    %FINISH %ELSE %START
       I = 1<<I
       FREE = FREE!I %IF TEMPS&I # 0
    %FINISH
%END
%ROUTINE LOAD TEMP
%INTEGER I,J
    RELEASE
    %IF DREG >= ZQUERY %AND DUSE = 0 %START
       I = DREG;  DUSE = 1
    %FINISH %ELSE %START
       J = 1+ZQUERY
       %CYCLE I = ZQUERY,1,15
          ->OK %IF FREE&J # 0 %AND I # DREG
          J = J<<1
       %REPEAT
       FAULT('R')
OK:    FREE = FREE-J
    %FINISH
    LOAD REG(I)
%END
%ROUTINE SWOP
%INTEGER K
    K = TYPE1;  TYPE1 = TYPE;  TYPE = K
    K = VAL1;  VAL1 = VAL;  VAL = K
%END
%ROUTINE PROGREF
    %IF TYPE&RELUXMASK = XMASK %AND VAL = 0 %START
       VAL = TYPE&15;  TYPE = REG
    %FINISH
    TYPE = TYPE!MEMMASK %IF TYPE # REG
%END
    Q = QSTART
NEW:NQ = QSTART;  FREE = TEMPS
    TYPE = INTEGER(Q);  Q = Q+1
    VAL = INTEGER(Q);  Q = Q+1
GET:%CYCLE
      %RETURN %IF Q = QLIM
       K = INTEGER(Q);  Q = Q+1
       ->ASS(K) %IF K < 0
       INTEGER(NQ) = TYPE1;  INTEGER(NQ+1) = VAL1
       NQ = NQ+2
       TYPE1 = TYPE;  VAL1 = VAL
       TYPE = K;  VAL = INTEGER(Q);  Q = Q+1
    %REPEAT
%PREDICATE TEMP
    %FALSE %IF TYPE1 # REG
    %IF VAL1 = DREG %START
       %FALSE %IF DUSE # 1
    %FINISH %ELSE %START
       %FALSE %IF 1<<VAL1&TEMPS = 0
    %FINISH
    %TRUE
%END
NOP: K = 0;                           !NOT SYMMETRIC
BOP:%IF MODE <= 0 %OR (TYPE = 0 %AND TYPE1 = 0) %START
       FAULT('A') %IF TYPE # 0
       TYPE = TYPE1;  VAL = LITVAL
    %FINISH %ELSE %START
       %IF %NOT TEMP %OR (TYPE=REG %AND VAL=DREG %AND DUSE=1 %AND K#0) %START
          SWOP
          %IF K = 0 %OR %NOT TEMP %START
             LOAD TEMP;  SWOP
          %FINISH
       %FINISH
       LOAD TEMP %IF TYPE&BMASK # 0 %OR (OP&MEM=0 %AND TYPE&MEMMASK#0)
       RELEASE
       PLANT INST(VAL1<<4+OP)
       TYPE = REG;  VAL = VAL1
       CREG = VAL;  CTYPE = 0;  CVAL = 0
       ATYPE = -1 %IF ACC = VAL %OR ATYPE&15 = VAL # 0
       ATYPE = -1 %IF ATYPE = REG %AND AVAL = VAL
    %FINISH
POP:NQ = NQ-2
    TYPE1 = INTEGER(NQ);  VAL1 = INTEGER(NQ+1)
    ->GET
ASS(-2):
    OP = SUB
    ->NOP %IF MODE > 0 %AND TYPE # 0
    TYPE1 = 0 %AND TYPE = 0 %IF MODE <= 0 %AND TYPE1 = TYPE
    VAL = -VAL
ASS(-1):
    OP = ADD;  LITVAL = VAL1+VAL
    ->BOP %UNLESS TYPE = 0
    %IF TYPE1&MEMMASK # 0 %AND MODE > 0 %START
       SWOP;  LOAD TEMP;  SWOP
    %FINISH
    %IF TYPE1 = REG %START
       ->BOP %IF VAL1 = 0
       TYPE1 = XMASK+VAL1;  LITVAL = VAL
    %FINISH
    TYPE = TYPE1;  VAL = LITVAL
    ->POP
ASS(-3):
    OP = AND;  LITVAL = VAL1&VAL
    ->BOP
ASS(-4):
    OP = OR;  LITVAL = VAL1!VAL
    ->BOP
ASS(-5):
    OP = XOR;  LITVAL = VAL1!!VAL
    ->BOP
ASS(-6):
    OP = SLLS;  LITVAL = VAL1<<VAL
    OP = SLHL %IF TYPE # 0
    ->NOP
ASS(-7):
    OP = SRLS;  LITVAL = VAL1>>VAL
    OP = SRHL %IF TYPE # 0
    ->NOP
ASS(-8):                              !TYPE_VAL
    TYPE = VAL1
    TYPE = 0 %IF TYPE&OPMASK = MACRO; !SAFETY
    TYPE = 0 %IF TYPE&(OPMASK+FMASK) = FMASK
    ->POP
ASS(-11):                             !COMPARE
    K = INTEGER(Q);  Q = Q+1
    %IF MODE <= 0 %START
       VAL1 = TYPE1 %AND VAL = TYPE %IF TYPE1 # TYPE
       LITVAL = \3
       LITVAL = 1 %IF VAL1 < VAL
       LITVAL = 2 %IF VAL1 > VAL
       K = K&LITVAL;  K = \0 %IF K # 0
    %FINISH %ELSE %UNLESS CREG=16 %AND TYPE1=CTYPE %AND VAL1=CVAL %AND TYPE=VAL=0 %START
       %IF TYPE1 # REG %START
          SWOP
          %IF TYPE1 # REG %START
             LOAD TEMP;  SWOP
          %FINISH %ELSE %START
             K = K!!3 %UNLESS K = 3 %OR K = \3
          %FINISH
       %FINISH
       %UNLESS CREG = VAL1 %AND CTYPE = TYPE %AND CVAL = VAL %START
          CREG = VAL1;  CTYPE = TYPE;  CVAL = VAL
          %UNLESS TYPE = VAL = 0 %START
             OP = COMP
             %IF TYPE = ATYPE %AND VAL = AVAL %START
                TYPE = REG;  VAL = ACC
             %FINISH
             %IF TYPE&BMASK # 0 %START
                OP = CLB
                FAULT('I') %UNLESS K = 3 %OR K = \3
             %FINISH
          %FINISH %ELSE %START
             OP = LOAD
             TYPE = REG;  VAL = VAL1
          %FINISH
          PLANT INST(VAL1<<4+OP)
       %FINISH
    %FINISH
    COND = K
    ->GET
ASS(-12):                             !TEST CC
    COND = \VAL
    ->GET
ASS(-13):                             !AND,WHILE
    %IF MODE > 0 %START
       SET JUMP(16_1000)
    %FINISH %ELSE %START
       %RETURN %IF COND # 0;          !CONDITION FALSE
    %FINISH
    %RETURN %IF Q = QLIM
    ->NEW
ASS(-14):                             !OR
    %IF MODE > 0 %START
       COND = \COND
       SET JUMP(16_3000)
    %FINISH %ELSE %START
       %RETURN %IF COND = 0;          !CONDITION TRUE
    %FINISH
    ->NEW
ASS(-15):                             !IF
    SET JUMP(16_2000)
    %RETURN
ASS(-16):                             !ELSE
    COND = \0
    SET JUMP(16_4000)
    %RETURN
ASS(-17):                             !IF AFTER ELSE
    SET JUMP(16_6000)
    %RETURN
ASS(-18):                             !MACCALL IF
    SET JUMP(16_8000)
    %RETURN
ASS(-20):                             !HASH
    TYPE = TYPE&(UMASK+63)
    ->GET
ASS(-21):                             !INDEX
    FAULT('I') %IF TYPE1&REGXMASK # 0
    %IF TYPE&MEMMASK # 0 %START
       %IF MODE > 0 %START
          ZQUERY = 1
          LOAD TEMP
          ZQUERY = 0
       %FINISH %ELSE FAULT('A')
    %FINISH
    %IF TYPE = REG %START
       TYPE = XMASK+VAL;  VAL = 0
    %FINISH
    ZQUERY = 0
    FAULT('I') %IF TYPE1&TYPE&RELMASK # 0
    TYPE = TYPE1!TYPE!MEMMASK;  VAL = VAL1+VAL
    ->POP
ASS(-22):                             !MINST SEPARATOR
    %IF TYPE1&OPMASK = 16_7000 %START
       %IF TYPE1&16_10 = 0 %START;    !REG-TYPE INST
          FAULT('I') %IF TYPE # REG
       %FINISH %ELSE %START
          VAL = \VAL %AND VAL1 = VAL1!!16_0100 %IF VAL < 0
          FAULT('I') %IF TYPE # 0 %OR VAL > 15
       %FINISH
       TYPE = TYPE1+16_8000;  VAL = VAL1&16_FF0F+VAL<<4
    %FINISH %ELSE %IF TYPE1&OPMASK = 16_F000 %START
       PROGREF %IF VAL1&16_FC0F = 16_0003; !BAL,BTC,BFC
       FORM INST(VAL1)
    %FINISH %ELSE FAULT('I')
    ->POP
ASS(-23):                             !MACHINE INST
    SET JUMP(16_1000) %IF COND # 0
    PLANT VAL
    CREG = -1;  ATYPE = -1
    %RETURN
ASS(-24):                             !LOAD
    LOAD TEMP %IF TYPE # REG
    Q = QBASE
    ->GET
ASS(-25):                             !STORE (TYPE1,VAL1 -> TYPE,VAL)
    %IF TYPE = REG %START
       SWOP %AND LOAD REG(VAL1) %IF VAL1 # VAL
    %FINISH %ELSE %START
       ATYPE = -1 %IF ATYPE&MEMMASK # 0
       %IF FLAG = 0 %START
          %IF VAL1 = ACC %AND ATYPE < 0 %START
             K = TYPE&15
             ATYPE = TYPE %AND AVAL = VAL %IF K = 0 %OR 1<<K&TEMPS = 0
          %FINISH
          OP = STORE;  OP = STB %IF TYPE&BMASK # 0
       %FINISH %ELSE %START
          CREG = 16;  CTYPE = TYPE;  CVAL = VAL
          OP = AHM
       %FINISH
       PLANT INST(VAL1<<4+OP)
    %FINISH
    %RETURN
ASS(-26):                             !JUMP
    SET JUMP(16_1000) %IF INTEGER(NP)&16_F000 = 16_3000; !OR
    %IF FLAG < 0 %START;              !REPEAT
       FLAG = 0
       %IF PASS = 0 %START
          K = NP;  LITVAL = LOC
          %WHILE INTEGER(K)&16_1000 # 0 %CYCLE
             K = K+2;  LITVAL = LITVAL-2
          %REPEAT
          FLAG = 1 %IF LITVAL-VAL < 32
       %FINISH
    %FINISH
    PROGREF
    PLANT JUMP
    %RETURN
%END;  !ASSEMBLE
%ROUTINE LOOKUP(%INTEGER CONTROL)
!ALL DICT OPERATIONS LOCALISED HERE
!CONTROL = 0 (LOOKUP ONLY), 1 (FORWARD OK),
!          2 (REDEF), 3 (DEF),
!          4 (MACPARM), 7 (LABEL)
%INTEGER DP
    DP = DEFMIN;  DP = MP+5 %IF CONTROL = 4
    %WHILE INTEGER(DP) # 0 %CYCLE
       ->YES %IF INTEGER(DP) = TAG1 %AND INTEGER(DP+1) = TAG2
       DP = DP+4
    %REPEAT
!%OWNINTEGER P
NO:
    %RETURN %IF CONTROL&1 = 0;        !NO CREATION
NEW:DEFMIN = DEFMIN-4;  DP = DEFMIN
    %SIGNAL %EVENT 21 %IF DP-QLIM <= 0
    INTEGER(DP) = TAG1;  INTEGER(DP+1) = TAG2
SET:INTEGER(DP+2) = TYPE;  INTEGER(DP+3) = VAL
    %RETURN
YES:%IF CONTROL&2 = 0 %START;         !NOT DEF CLASS
       TYPE = INTEGER(DP+2);  VAL = INTEGER(DP+3)
       %RETURN
    %FINISH
    %IF CONTROL = 3 %START
       ->NEW %IF DP-INTEGER(BP) >= 0; !GLOBAL
       FAULT('D')
    %FINISH
    ->SET %IF CONTROL # 7
    %IF INTEGER(DP+2)&OPFMASK = FMASK %START
       VAL = INTEGER(DP+3)
       %IF PASS = 0 %START
          INTEGER(VAL) = LOC
       %FINISH %ELSE %START
          FAULT('P') %AND LOC=INTEGER(VAL) %IF INTEGER(VAL) # LOC
       %FINISH
       VAL = LOC
    %FINISH %ELSE %START
       ->NEW %IF DP-INTEGER(BP) >= 0
       FAULT('D')
    %FINISH
    ->SET
%END
%ROUTINE TAGREF
%OWNINTEGER B=2184, W=24717
    %IF TERM = '(' %START
       TYPE = 0;  VAL = 0
       %RETURN %IF TAG1 = W
       TYPE = BMASK
       %RETURN %IF TAG1 = B
    %FINISH
    TYPE = LOCTYPE+FMASK+UMASK;  VAL = LABMIN-1
    LOOKUP(1)
    %IF TYPE&OPFMASK = FMASK %START
       %IF VAL = LABMIN-1 %START
          LABMIN = VAL;  %SIGNAL %EVENT 22 %IF LABMIN = ALMAX
       %FINISH
       %IF PASS > 0 %START
          VAL = INTEGER(VAL)
          FAULT('U') %IF VAL = 0
       %FINISH
       TYPE = TYPE-FMASK
    %FINISH
%END
%ROUTINE GET SYM
    %CYCLE
       SYM = CHAR(GETPOS);  GETPOS = GETPOS+1
       %RETURN %IF SYM # ' '
    %REPEAT
%END
%PREDICATE S(%INTEGER K)
    %FALSE %UNLESS K = SYM
    GET SYM
    %TRUE
%END
%PREDICATE SS(%INTEGER K)
    %FALSE %UNLESS K = SYM = CHAR(GETPOS)
    GETPOS = GETPOS+1
    GET SYM
    %TRUE
%END
%PREDICATE TAG
%INTEGER J,K
    %ROUTINE CODE SYM
       SYM = CHAR(GETPOS);  GETPOS = GETPOS+1
       K = SYM-'0'
       %IF K >= 0 %START
          TERM = -1 %AND %RETURN %IF K < 10
          K = SYM-'A'
          %RETURN %IF K >= 0 %AND K < 26 %AND TERM = 0
       %FINISH
       TERM = SYM
    %END
    %ROUTINE PACK TRIPLE
       ->T1 %IF TERM < 0
       J = ((K<<5+K)<<1+K)<<4+K+1111; !K*1073+1111
       CODE SYM
       ->T2 %IF TERM # 0
       J = (K<<3+K)<<2+K+111+J;       !J+K*37+111
       CODE SYM
       ->T3 %IF TERM # 0
       J = J+K+11
       CODE SYM
       %RETURN
T1:    J = ((K<<1+K)<<1+K)<<4-K+1;    !K*111+1
       CODE SYM
T2:    %RETURN %IF TERM > 0
       J = (K<<2+K)<<1+K+1+J;         !J+K*11+1
       CODE SYM
T3:    %RETURN %IF TERM > 0
       J = J+K+1
       CODE SYM
    %END
    K = SYM-'A'
    %FALSE %UNLESS K >= 0 %AND K < 26
    %FALSE %IF SYM = 'X' %AND CHAR(GETPOS)&128 # 0
    TERM = 0
    PACK TRIPLE
    TAG1 = J
    %CYCLE
       J = 0
       PACK TRIPLE %IF TERM <= 0
       TAG2 = J
       CODE SYM %WHILE TERM <= 0
       %EXIT %UNLESS TERM = QQ
       TYPE = 1;  LOOKUP(0)
       FAULT('U') %IF TYPE # 0
       TAG1 = VAL
       TERM = 0;  CODE SYM
    %REPEAT
    GET SYM %IF TERM = ' '
    %TRUE
%END
%PREDICATE TAGIF
    %FALSE %UNLESS SYM='I' %AND CHAR(GETPOS)='F' %AND CHAR(GETPOS+1)=' '
    GETPOS = GETPOS+2
    GET SYM
    %TRUE
%END
%ROUTINE QUEUE(%INTEGER K)
    INTEGER(QLIM) = K
    QLIM = QLIM+1;  %SIGNAL %EVENT 21 %IF QLIM = DEFMIN
%END
%ROUTINE GET EXP
%INTEGER I,NBASE
    NBASE = NP
    ->E3 %IF PEND # 0
E1: NEST(0) %WHILE S('(')
    NEST(-20) %IF S('#')
    %IF TAG %START
E3:    TAGREF %IF PEND >= 0
       PEND = 0
       %IF TYPE = REG %AND TERM = '(' %START
          TYPE = 0 %IF SAVE&1 = 0;  VAL = VAL+VAL+SAVE
       %FINISH
       FAULT('I') %AND TYPE=0 %IF TYPE&OPMASK # 0
       %IF MODE # 0 %START
          %IF TYPE&REGXMASK # 0 %START
             I = TYPE&15;  I = VAL %IF I = 0
             DUSE = DUSE+1 %IF I = DREG
          %FINISH
       %FINISH
       %IF TERM = '(' %START
          GET SYM
          I = TYPE&31
          QUEUE(TYPE-I);  QUEUE(VAL)
          NEST(-21);  NEST(0)
          %IF I # 0 %START
             QUEUE(REG);  QUEUE(I&15)
             NEST(-1)
          %FINISH
          ->E1
       %FINISH
    %FINISH %ELSE %IF '0' <= SYM <= '9' %START
       TYPE = 0;  VAL = SYM-'0'
       %CYCLE
          SYM = CHAR(GETPOS)-'0'
          %EXIT %UNLESS 0 <= SYM <= 9
          VAL = (VAL<<2+VAL)<<1+SYM
          GETPOS = GETPOS+1
       %REPEAT
       GET SYM
    %FINISH %ELSE %IF SYM = 'X' %START
       TYPE = 0;  VAL = 0
       %CYCLE
          SYM = CHAR(GETPOS)-128
          %EXIT %IF SYM < 0
          SYM = SYM-32 %IF SYM >= 96; !ENSURE UPPER-CASE
          %IF '0' <= SYM <= '9' %OR 'A' <= SYM <= 'F' %START
             VAL = VAL<<4+SYM-'0'
             VAL = VAL-7 %IF SYM >= 'A'
          %FINISH %ELSE FAULT('H')
          GETPOS = GETPOS+1
       %REPEAT
       GET SYM
    %FINISH %ELSE %IF SYM&128 # 0 %START
       TYPE = 0;  VAL = SYM-128
       GET SYM
       %IF MODE >= 0 %AND SYM&128 # 0 %START
          VAL = VAL<<8+SYM-128;  GET SYM
       %FINISH
    %FINISH %ELSE %IF S('.') %START
       ->ERR %IF %NOT TAG
       TYPE = 0;  VAL = TAG1
    %FINISH %ELSE %IF S('*') %START
       TYPE = LOCTYPE&63;  VAL = LOC
       %IF SYM = 'L' %START;          !FOR NOW
          TYPE = 0;  VAL = LIST %IF TAG
       %FINISH
    %FINISH %ELSE %IF SYM = '-' %START
       TYPE = 0;  VAL = 0
    %FINISH %ELSE %IF SYM = '\' %START
       TYPE = 0;  VAL = \0
    %FINISH %ELSE ->ERR
    QUEUE(TYPE);  QUEUE(VAL)
    %WHILE NP # NBASE %CYCLE
       %IF INTEGER(NP) < 0 %START
          QUEUE(INTEGER(NP))
       %FINISH %ELSE %START
          %EXIT %IF %NOT S(')')
       %FINISH
       NP = NP+1
    %REPEAT
    I = 1
    NEST(-1) %AND ->E8 %IF S('+')
    NEST(-2) %AND ->E8 %IF S('-')
    NEST(-3) %AND ->E9 %IF S('&')
    NEST(-4) %AND ->E9 %IF S('!')
    NEST(-5) %AND ->E9 %IF S('\')
    NEST(-6) %AND ->E9 %IF SS('<')
    NEST(-7) %AND ->E9 %IF SS('>')
    NEST(-8) %AND ->E9 %IF S('_')
    %RETURN %IF NP = NBASE
ERR:NP = NBASE
    %SIGNAL %EVENT 1{9}
E8: I = 0
E9: ->E1 %UNLESS MODE = 2 %AND NP+1 = NBASE
    %IF FLAG = I %THEN FLAG = QLIM %ELSE FLAG = -1
    ->E1
%END
%ROUTINE CONDIT(%INTEGER QVAL)
%OWNINTEGER AND=1717, OR=16873
%INTEGER J,K
    TRANSF = QSTART;  QSTART = QLIM
    J = 0
    %CYCLE
       GET EXP
       %IF S('=') %START
          K = 3
       %FINISH %ELSE %IF S('#') %START
          K = \3
       %FINISH %ELSE %IF S('<') %START
          K = \1;  K = 2 %IF S('=')
       %FINISH %ELSE %IF S('>') %START
          K = \2;  K = 1 %IF S('=')
       %FINISH %ELSE %START
          QUEUE(-12)
          ->ANDOR
       %FINISH
       GET EXP
       QUEUE(-11);  QUEUE(K)
ANDOR:
       %EXIT %IF %NOT TAG
       %IF TAG1 = AND %AND TAG2 = 0 %START
          %SIGNAL %EVENT 1{9} %IF J < 0
          J = 1;  QUEUE(-13)
       %FINISH %ELSE %START
          %SIGNAL %EVENT 1{9} %IF TAG1 # OR %OR J > 0
          J = -1;  QUEUE(-14)
       %FINISH
    %REPEAT
    QUEUE(QVAL) %IF QVAL # 0
    ASSEMBLE
    ATYPE=-1 %AND CREG=-1 %IF J < 0
%END
%ROUTINE GET INST
%INTEGER I
!OPMASK VALUES
!    0100,0110,1100,1101,1110: DOUBLE WORD INSTRUCTIONS
!    1011,1001,0011,0010,0001: AS ABOVE BUT RELOCATABLE
!    0101: SINGLE WORD INSTRUCTION
!    0111: 2 OPERANDS TO COME
!    1111: 1 OPERAND TO COME
!    1010: MACRO
    QUEUE(TYPE);  QUEUE(VAL)
    %RETURN %IF TYPE&16_7000 # 16_7000
    %RETURN %IF TERM # ' ';           !NO OPERAND FOLLOWING =>
    %CYCLE
       GET EXP
       QUEUE(-22)
       %RETURN %IF %NOT S(',')
    %REPEAT
%END
%ROUTINE READ LINE
%INTEGER Q
    PUTPOS = STARTPOS
    %IF MP = 0 %START
       Q = 0;  PSEUDOLIM = 0
       %CYCLE
          READ SYMBOL(SYM)
          READ SYMBOL(SYM) %AND Q=Q!!128 %IF SYM = ''''
          %EXIT %IF SYM = NL
          SYM = SYM-32 %IF SYM-Q >= 96; !LOWER-CASE -> UPPER-CASE
          SYM = SYM+Q
          %EXIT %IF SYM = '/' %AND PSEUDOLIM # 0
          %IF SYM = ' ' %START
             PSEUDOLIM = PUTPOS %IF PSEUDOLIM = 0
          %FINISH %ELSE PSEUDOLIM = 0
          PUT CHAR(SYM)
       %REPEAT
       %IF PSEUDOLIM # 0 %START
          Q = PUTPOS;  PUTPOS = PSEUDOLIM
          PUT CHAR(NL)
          PUTPOS = Q
       %FINISH
       %CYCLE
          PUT CHAR(SYM)
          %EXIT %IF SYM = NL
          READ SYMBOL(SYM)
       %REPEAT
       PRINTPOS = STARTPOS
    %FINISH %ELSE %START
       GETPOS = INTEGER(MP)
       %IF CHAR(GETPOS) = 0 %START
          QBASE = MP
          GETPOS = INTEGER(MP+2)
          STARTPOS = INTEGER(MP+3)
          MP = INTEGER(MP+4)
          %IF MP < 0 %START
             MP = MP-8_700000
             %WHILE INTEGER(NP)&16_8000 = 0 %CYCLE
                FAULT('C');  NP = NP+2
             %REPEAT
             SET LAB(LOC)
          %FINISH
          PRINTPOS = 0 %IF LIST&2 # 0
          GET SYM;                    !TERMINATOR
          GET SYM %IF SYM = ';'
          %RETURN
       %FINISH
       PRINTPOS = STARTPOS %IF LIST&2 # 0
       QQ = 0
       %CYCLE
          SYM = CHAR(GETPOS);  GETPOS = GETPOS+1
          %IF TAG %START
             SYM=TERM %AND GETPOS=GETPOS-1 %IF TERM = ' '
             TYPE = INTEGER(MP);  VAL = GETPOS-1
             LOOKUP(4)
             %WHILE TYPE # VAL %CYCLE
                PUT CHAR(CHAR(TYPE))
                TYPE = TYPE+1
             %REPEAT
          %FINISH
          PUT CHAR(SYM)
          INTEGER(MP) = GETPOS
          %EXIT %IF SYM = NL
       %REPEAT
       QQ = '?'
    %FINISH
    QBASE = (PUTPOS+1)>>1
    GETPOS = STARTPOS;  GET SYM
%END
%ROUTINE SCAN ARG
!    SET TYPE,VAL TO START,LIM OF ARG IF NOT NULL
%INTEGER I,J
    %RETURN %IF SYM='I' %AND CHAR(GETPOS)='F' %AND CHAR(GETPOS+1)=' '
    I = GETPOS-1;  I = GETPOS %IF SYM = '['
    J = 0
    %CYCLE
       %EXIT %IF SYM = NL
       %EXIT %IF (SYM=' ' %OR SYM=',' %OR SYM=';') %AND J<=0
       J = J+1 %IF SYM = '['
       %IF SYM = ']' %START
          J = J-1;  %EXIT %IF J = 0
       %FINISH
       SYM = CHAR(GETPOS);  GETPOS = GETPOS+1
    %REPEAT
    %IF GETPOS-1 # I %START
       TYPE = I;  VAL = GETPOS-1
    %FINISH
    GET SYM %IF SYM = ']'
%END
%ROUTINE SET ACC
%INTEGER I
    ACC = -1;  ATYPE = -1;  CREG = -1
    I = TEMPS
    %RETURN %IF I = 0
    %CYCLE
       ACC = ACC+1
       %RETURN %IF I&1 # 0
       I = I>>1
    %REPEAT
%END
!MAIN PROGRAM
!RADIX 36 CONSTANTS
%OWNINTEGER B=2184, IF=9991, ELS=5950, E=5403, FIN=6907, ISH=10490
%OWNINTEGER JUM=11642, P=17206, PS=17983, DEF=4605, END=6009
%INTEGER I,J,K
    %ON %EVENT 9, 1{9} %START
      %IF EVENT=19 %THEN ->ERR;                      !RECOGNITION ERROR
      %IF EVENT=9 %THEN ->BEND;                      !INPUT ENDED
    %FINISH
    %CYCLE I = 1,1,SBOUND
       STORE(I) = 0
    %REPEAT
    CODEPOS = ADDR(STORE(1))
    MACLIM = (CODEPOS+20)<<1
    STORELIM = ADDR(STORE(SBOUND))
    NP = STORELIM
    LABLIM = NP-60
    BP = LABLIM
    DEFLIM = BP-(SBOUND>>2)
    DEFMIN = DEFLIM
    INTEGER(BP) = DEFLIM
    open input(PRE, "hal70.def")
    SELECT INPUT(PRE)
DO PASS:
    STARTPOS = MACLIM
    MP = 0
    ALMAX = DEFLIM
    LABMIN = LABLIM
    ASSCOND = 1;  SKIP = 0
    LOCTYPE = MEMMASK+RELMASK;  LOC = 0
    SET ACC
READ: FSYM = ' ';  FAULTPOS = 0
    READ LINE
NEXT:
    DREG = -1
    MODE = 0
    PEND = 0;  COND = 0
    QSTART = QBASE;  QLIM = QSTART
    FLAG = 0
    %IF S('$') %START
       ->NEWPAGE %IF SYM = '/'
       ->ERR %IF %NOT TAG
       ->ASSIF %IF TAG1 = IF
       ->ASSELSE %IF TAG1 = ELS
       ->ASSFIN %IF TAG1 = FIN
       ->LEND %IF SKIP # 0
       ->DEFINE %IF TAG1 = DEF
       ->DEFINE %IF TAG1 = 19625;     !RED
       ->LISTC %IF TAG1 = 13350;      !LIS
       ->TEMP %IF TAG1 = 21780;       !TEM
       ->LOCC %IF TAG1 = 13556;       !LOC
       ->LOCC %IF TAG1 = 1917;        !ASS
       ->SAVC %IF TAG1 = 20568;       !SAV
       ->MACDEF %IF TAG1 = 14111;     !MAC
       ->BEGIN %IF TAG1 = 2460;       !BEG
       ->BEND %IF TAG1 = END
       FAULT('U')
       ->LEND
    %FINISH
    ->LEND %IF SKIP # 0 %OR SYM = '/'
    ->LEND %IF SYM = NL
    %IF TAG %START
       ->LABDEF %IF TERM = ':'
       MODE = 1
       ->ASSIGN %IF TERM = '(' %OR SYM = '='
       ->JUMP %IF TAG1 = JUM %AND (TAG2=P %OR TAG2=PS)
       ->IFC %IF TAG1 = IF
       ->ELSE %IF TAG1 = ELS %AND TAG2 = E
       ->FINISH %IF TAG1 = FIN %AND TAG2 = ISH
       ->WHILE %IF TAG1 = 25106 %AND TAG2 = 13173
       ->CYCLE %IF TAG1 = 4269 %AND TAG2 = 13173
       ->REPEAT %IF TAG1 = 19637 %AND TAG2 = 5544
       MODE=-2 %AND ->DATA %IF TAG1 = B
       TYPE = UMASK;  LOOKUP(0)
       ->MACCALL %IF TYPE&OPMASK = MACRO
       ->MINST %IF TYPE&OPMASK # 0
       FAULT('U') %AND ->LEND %IF TYPE&UMASK # 0
       PEND = -1
    %FINISH
    MODE = -1
DATA:
    %CYCLE
       GET EXP;  ASSEMBLE
       FAULT('I') %IF TYPE&REGXMASK # 0
       I = 1
       %IF S('$') %START
          I = VAL %IF VAL < 1000
          QLIM = QSTART
          GET EXP;  ASSEMBLE
       %FINISH
       %WHILE I > 0 %CYCLE
          %IF MODE # -1 %START
             FAULT('T') %IF VAL&16_FF00 # 0
             %IF MODE = -2 %START
                J = VAL<<8;  MODE = -3
             %FINISH %ELSE %START
                VAL = VAL+J;  MODE = -2
                PLANT VAL;  VAL = VAL&255
             %FINISH
          %FINISH %ELSE %START
             PLANT VAL
          %FINISH
          I = I-1
       %REPEAT
       %EXIT %UNLESS S(',') %OR SYM&128 # 0
       %IF SYM = NL %START
          PRINT LINE %IF PRINTPOS # 0;  READ LINE
          QSTART = QBASE
       %FINISH
       QLIM = QSTART
    %REPEAT
    VAL=J %AND PLANT VAL %IF MODE = -3
    ->SEND
LABDEF:
    CREG = -1;  ATYPE = -1
    GET SYM
    FAULT('C') %AND NP=STORELIM %IF NP # STORELIM
    TYPE = LOCTYPE;  VAL = LOC
    LOOKUP(7)
    ->NEXT
ASSIGN:
    PEND = 1
    GET EXP
    ->ERR %IF %NOT S('=')
    QUEUE(-25);                       !'STORE'
    %IF INTEGER(QBASE) = REG %START
       DREG = INTEGER(QBASE+1)
       DUSE = 0
    %FINISH
    QSTART = QLIM;  MODE = 2
    GET EXP
    %IF FLAG # 0 %START
       %IF DREG<0 %AND FLAG-QSTART=QSTART-QBASE-1 %C
          %AND INTEGER(QBASE)&BMASK=0 %START
       I = QBASE;  J = QSTART
       I = I+1 %AND J=J+1 %WHILE INTEGER(I) = INTEGER(J)
       %IF J = FLAG %START
          %IF INTEGER(QLIM-1) = -2 %START; !MINUS
             QSTART = J-2
             INTEGER(QSTART) = 0;  INTEGER(QSTART+1) = 0
          %FINISH %ELSE %START
             QSTART = J;  QLIM = QLIM-1
          %FINISH
       %FINISH %ELSE FLAG = 0
       %FINISH %ELSE FLAG = 0
    %FINISH
    QUEUE(-24);                       !'LOAD'
CONDQ:
    %IF TAGIF %START
       MODE = MODE+4;  DREG = DREG-16; !SCARIFY
       CONDIT(0)
       MODE = MODE-4;  DREG = DREG+16; !RESTORE
       QLIM = QSTART;  QSTART = TRANSF
    %FINISH
    ASSEMBLE
    ->SEND
JUMP:
    FLAG = TAG2-P;                    !POSITIVE IF SHORT
    GET EXP
    QUEUE(-26);                       !'JUMP'
    ->CONDQ
MINST:
    MODE = -1
    GET INST
    QUEUE(-23);                       !'PLANT'
    ->CONDQ
MACCALL:
    QUEUE(0);                         !(DEFPOS)
    QUEUE(0);                         !SPARE
    QUEUE(0);                         !(CALLPOS)
    QUEUE(STARTPOS)
    QUEUE(MP)
    J = VAL;  QQ = 0
    %CYCLE
       %EXIT %IF CHAR(J) = NL;        !END OF MAC DEF
       I = GETPOS-1;                  !SAVE CALLPOS
       GETPOS = J;  GET SYM
       %SIGNAL %EVENT 24 %IF %NOT TAG
       TYPE = 0;  VAL = 0
       SCAN ARG
       GET SYM %IF SYM = ','
       J = GETPOS-1;                  !SAVE DEFPOS
       GETPOS = I;  GET SYM;          !RESTORE CALLPOS
       SCAN ARG
       GET SYM %IF SYM = ','
       QUEUE(TAG1);  QUEUE(TAG2)
       QUEUE(TYPE);  QUEUE(VAL)
    %REPEAT
    QQ = '?'
    GET SYM %IF SYM = ' '
    %IF TAGIF %START
       CONDIT(-18)
       QLIM = QSTART
       INTEGER(QBASE+4) = MP+8_700000
    %FINISH
    QUEUE(0)
    STARTPOS = QLIM<<1
    MP = QBASE
    INTEGER(MP) = J+1;                !START OF BODY
    INTEGER(MP+2) = GETPOS-1
    ->LEND
!CODING OF JUMPS: 1000 (SINGLE INST), 2000 (MAIN IF)
!                 4000 (ELSE), 6000 (IF AFTER ELSE)
IFC:
    CONDIT(-15)
    ->SEND
ELSE:
    ->CERR %IF INTEGER(NP)&16_2000 = 0
    QUEUE(0);  QUEUE(0)
    QUEUE(-16);  ASSEMBLE
    ATYPE = -1; CREG = -1
    %IF TAGIF %START
       CONDIT(-17)
    %FINISH
    ->SEND
FINISH:
    ->CERR %IF INTEGER(NP)&16_6000 = 0
    I = LOC
    %WHILE INTEGER(NP)&16_4000 # 0 %CYCLE
       %IF INTEGER(NP)&16_2000 # 0 %START; !IF AFTER ELSE
          SET LAB(I)
       %FINISH %ELSE %START
          SET LAB(LOC)
          I = VAL+4
       %FINISH
    %REPEAT
    SET LAB(I)
    ->SEND
WHILE:
    I = LOC;  ATYPE = -1;  CREG = -1
    CONDIT(-13)
    NEST(I);  NEST(1)
    ->SEND
CYCLE:
    NEST(LOC);  NEST(1)
    ATYPE = -1;  CREG = -1
    ->SEND
REPEAT:
    ->CERR %IF INTEGER(NP) # 1
    QUEUE(LOCTYPE);  QUEUE(INTEGER(NP+1))
    NP = NP+2
    QUEUE(-26);                       !'JUMP'
    FLAG = -1
    ->CONDQ
CERR:
    FAULT('C')
    ->LEND
SEND:
    SET LAB(LOC) %IF INTEGER(NP)&16_1000 # 0
    ->LEND %IF SYM = NL
    ->NEXT %IF S(';')
ERR:FSYM = 'F';  FAULTPOS = GETPOS-1
    PRINTPOS = STARTPOS
LEND:
    ->READ %IF SKIP # 0 %AND LIST&4 = 0
    ->READ %IF FSYM = ' ' %AND CHARS = 0 %AND %C
     (PRINTPOS = 0 %OR (MP#0 %AND LIST&2=0))
    PRINT LINE
    ->READ
ASSIF:
    ASSCOND = ASSCOND<<1
    ->LEND %IF SKIP # 0
A1: CONDIT(0)
    SKIP = ASSCOND %IF COND # 0
    PRINT LINE %IF PRINTPOS # 0
    ->LEND
ASSELSE:
    %IF SKIP = 0 %START
       ->CERR %IF ASSCOND&1 # 0
       SKIP = ASSCOND
    %FINISH %ELSE %START
       ->LEND %IF SKIP # ASSCOND
       SKIP = 0
       ->A1 %IF TAGIF
    %FINISH
    ASSCOND = ASSCOND+1
    ->LEND
ASSFIN:
    ->CERR %IF ASSCOND = 1
    ASSCOND = ASSCOND>>1
    SKIP = 0 %IF SKIP>>1 = ASSCOND
    ->LEND
DEFINE:
    FAULT('C') %IF NP # STORELIM
    I = TAG1
    %CYCLE
       ->ERR %IF %NOT (TAG %AND S('='))
       J = TAG1;  K = TAG2
       %IF TAG %START
          TAGREF
          %IF TYPE&OPMASK # 0 %START
             GET INST
          %FINISH %ELSE %START
             PEND = -1;  GET EXP
          %FINISH
       %FINISH %ELSE GET EXP
       ASSEMBLE
       TAG1 = J;  TAG2 = K
       %IF I=DEF %THEN LOOKUP(3) %ELSE LOOKUP(2)
       %EXIT %UNLESS S(',')
       QLIM = QSTART
    %REPEAT
    ->SEND
NEWPAGE:
    DO NEWLINE %WHILE LINES # 0
    ->LEND
LISTC:
    GET EXP;  ASSEMBLE
    LIST = VAL
    ->SEND
TEMP:
    I = 0
    %IF SYM # NL %START
       %CYCLE
          GET EXP
          FAULT('I') %IF TYPE # REG
          I = I!1<<VAL
          %EXIT %UNLESS S(',')
       %REPEAT
    %FINISH
    TEMPS = I
    SET ACC
    ->SEND
LOCC:
    I = TAG1
    GET EXP;  ASSEMBLE
    %IF TYPE&16_FF80 = 0 %START
       %IF I = 13556 %START;          !LOC
          OUTPUT RECORD %IF BINCOUNT >= 203
          PUT(3) %IF (LOCTYPE!!TYPE)&RELMASK # 0
          PUT(5);  PUT WORD(VAL)
       %FINISH
       LOCTYPE = TYPE&63+MEMMASK;  LOC = VAL
    %FINISH %ELSE FAULT('I')
    ->SEND
SAVC:
    GET EXP;  ASSEMBLE
    SAVE = VAL
    ->SEND
MACDEF:
    ->CERR %IF MP # 0
    ->ERR %IF %NOT TAG
    J = TAG1;  K = TAG2
    I = GETPOS-1
    %IF SYM # NL %START
       %CYCLE
          ->ERR %IF %NOT TAG
          SCAN ARG
          %EXIT %IF %NOT S(',')
       %REPEAT
    %FINISH
    ->ERR %IF SYM # NL
    TAG1 = J;  TAG2 = K
    TYPE = MACRO;  VAL = I
    LOOKUP(3)
    %CYCLE
       PRINT LINE
       %EXIT %IF S('$') %AND TAG %AND TAG1 = END
       STARTPOS = PUTPOS
       STARTPOS = PSEUDOLIM+1 %IF PSEUDOLIM # 0
       READ LINE
    %REPEAT
    PUTPOS = STARTPOS;  PUT CHAR(0)
    STARTPOS = PUTPOS
    MACLIM = STARTPOS
    ->LEND
%ROUTINE BNEST
    BP = BP+4;  %SIGNAL %EVENT 23 %IF BP-NP >= 0
    INTEGER(BP-3) = SAVE;  INTEGER(BP-2) = TEMPS
    INTEGER(BP-1) = MACLIM;  INTEGER(BP) = DEFMIN
%END
BEGIN:
    BNEST
    ->NEWPAGE %IF SYM # NL
    ->LEND
BEND:
    FAULT('C') %IF NP # STORELIM %OR MP # 0
    MP = 0;  NP = STORELIM
    %IF BP # LABLIM %START
       SAVE = INTEGER(BP-3);  TEMPS = INTEGER(BP-2)
       MACLIM = INTEGER(BP-1);  STARTPOS = MACLIM
       DEFMIN = INTEGER(BP)
       SET ACC
       BP = BP-4
       ->LEND %IF BP # LABLIM
    %FINISH
    CLOSE INPUT;  SELECT INPUT(MAIN)
    BNEST
    LIST = 5
    PASS = PASS+1
    ->DO PASS %IF PASS # 2
    OUTPUT RECORD %IF BINCOUNT = 208
    PUT(1)
    OUTPUT RECORD
    FAULT('$')
    PRINT LOC;  PRINT LINE
%ENDOFPROGRAM