%BEGIN;                               !HAL-7502
!    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 FMASK=16_0800;            !FORWARD REF
%OWNINTEGER UMASK=16_0200;            !UNDEF (FORWARD REF)
%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 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
%OWNINTEGER CONTROL=16_40;            !OBJECT CODE CONTROL FIELD
%OWNINTEGER CHECK=0;  !BINARY CHECKSUM
%INTEGER LOCTYPE,LOC;                 !LOCATION COUNTER
%INTEGER ACC,ATYPE,AVAL;              !MAIN TEMP REGISTER
%INTEGER CREG;                        !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


%INTEGER SBOUND
    SBOUND = FREESTORE-260;           !ALLOW FOR INPUT BUFFER
    SBOUND = SBOUND-256 %IF OUTDEV = 2
    SELECT OUTPUT(LIS)
    SBOUND = SBOUND-256 %IF OUTDEV = 2
%INTEGERARRAY STORE(1:SBOUND)

%INTEGERFN CHAR(%INTEGER P)
!BYTE FETCH
    %OPR 2064;!RCR;  %DAC P
    %LAC* P;  %OPR 768;!SZL;  %JMP L1
    %OPR 1040;!RTR;  %OPR 1040
    %OPR 1040;  %OPR 1040
L1: %AND #255;  %JMP* CHAR
    %STOP
%END

%ROUTINE PUT CHAR(%INTEGER K)
!AT PUTPOS WITH POST-INCREMENT
%INTEGER P
    %MONITOR 21 %IF PUTPOS>>1-DEFMIN >= 0
    %LAC PUTPOS;  %OPR 2064;!RCR;  %DAC P
    %OPR 768;!SZL;  %JMP L1
    %LAC K;  %OPR 1032;!RTL;  %OPR 1032
    %OPR 1032;  %OPR 1032;  %DAC K
    %LAC #-256;  %OPR 513;!SKP!CMA
L1: %LAC #-256;  %AND* P;  %TAD K;  %DAC* P
    %ISZ PUTPOS
%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 WORD(%INTEGER V)
    CHECK = CHECK!!V
    SELECT OUTPUT(BIN)
    PRINT CH(V>>12&15+CONTROL)
    PRINT CH(V>>8&15+16_40)
    PRINT CH(V>>4&15+16_40)
    PRINT CH(V&15+16_40)
    CONTROL = 16_50
    SELECT OUTPUT(LIS)
%END

%ROUTINE PLANT VAL
    %IF PASS > 0 %START
    %IF CHARS = 0 %START
    %IF PRINTPOS#0 %THEN PRINT LOC %ELSE %START
    PRINT(' '); PRINT(' '); PRINT(' ')
    PRINT(' '); PRINT(' '); PRINT(' ')
    %FINISH
    %FINISH
    PRINT(' ') %IF CHARS = 10
    PRINT WORD(VAL); PUT WORD(VAL)
    PRINT('''') %IF TYPE&RELMASK # 0
    PRINT LINE %IF CHARS >= 15
    %FINISH
    LOC = LOC+1
%END

%ROUTINE PLANT(%INTEGER V)
%INTEGER THOLD,VHOLD
    THOLD = TYPE;  VHOLD = VAL
    TYPE = 0;  VAL = V
    PLANT VAL
    TYPE = THOLD;  VAL = THOLD
%END

%ROUTINE NEST(%INTEGER K)
    NP = NP-1;  %MONITOR 23 %IF NP = BP
    INTEGER(NP) = K
%END

%ROUTINE SET LAB(%INTEGER DEST)
%INTEGER P,Q
    Q = 0
    %CYCLE
    TYPE = INTEGER(NP);  P = TYPE&16_3FF+DEFLIM; !DEST SLOT
    NP = NP+1
    VAL = INTEGER(NP);             !LOC OF JUMP
    NP = NP+1
    ATYPE = -1;  CREG = -1
    FLAG = 0;
    %IF TYPE&16_800 = 0 %START
    FLAG = 1 %IF DEST-VAL+PASS <= 128
    %ELSE %IF TYPE&16_400 # 0 %START
    FLAG = 2 %IF DEST-VAL+PASS+PASS = 1
    %FINISH
    %IF PASS = 0 %START
    DEST = DEST-FLAG;  INTEGER(P) = DEST
    %IF FLAG # 0 %START
    LOC = LOC-FLAG
    %WHILE P # ALMAX %CYCLE
    P = P+1;  INTEGER(P) = INTEGER(P)-FLAG
    %REPEAT
    %FINISH
    %ELSE %START
    FAULT('P') %IF INTEGER(P) # DEST
    %FINISH
    %RETURN %IF INTEGER(NP)&16_1000 = 0
    %IF INTEGER(NP)&16_2000 # 0 %AND Q = 0 %START; !OR
    DEST = VAL+1
    DEST = VAL+2-FLAG %UNLESS TYPE&16_C00 = 16_C00
    Q = 1
    %FINISH
    %REPEAT
%END

%ROUTINE ASSEMBLE
!   7502 OP-CODES
%OWNINTEGER ADD=16_F400, SUB=16_F500, AND=16_F100
%OWNINTEGER OR=16_F000, XOR=16_F700, COMP=16_F200
%OWNINTEGER COPY=16_F300
%OWNINTEGER LOADI=16_6000, SKIDI=16_7000, ADDI=16_8000
%OWNINTEGER ANDI=16_9000
%OWNINTEGER BOC=16_5800, BOCR=16_5000, JUM=16_4000
%OWNINTEGER SKIP=16_4002, LOADC=16_20F2, ROT=16_3000
%OWNINTEGER LOAD=16_2000, STORE=16_2008

%INTEGER Q,NQ,OP,K,LITVAL,TYPE1,VAL1,FREE
%SWITCH ASS(-30:-1)

%ROUTINE COMBINE
%INTEGER I,J,K
    I = 11; K = 2048
    I=I-1 %AND K=K>>1 %WHILE K&TYPE1 = 0 %AND I # 0
    J = K
    I =I-1 %AND J=J>>1 %WHILE J&VAL1 = 0 %AND I # 0
    VAL = VAL<<I & (K<<1-1)
    TYPE = TYPE1-K
    VAL = VAL1-J+VAL
%END

%ROUTINE PLANT JUMP
%INTEGER I,V
    I = VAL-LOC
    %IF COND&6 = 0 %START
    %IF COND = 8 %START
    %RETURN %IF I=1
    PLANT(SKIP)
    %FINISH
    %ELSE %START
    FAULT('J') %AND I=0 %IF FLAG # 0 %AND !I! > 127
    %IF !I! <= 127 %START
    %IF TYPE&UMASK = 0 %OR FLAG # 0 %START
    PLANT(BOC+(COND!!1)<<8+I&255)
    %RETURN
    %FINISH
    FAULT('S') %IF LIST >= 0 %AND LIST&8 # 0
    %FINISH
    PLANT(BOC+COND<<8+2)
    %FINISH
    PLANT(JUM+(VAL-LOC)&4095)
%END

%ROUTINE SET JUMP(%INTEGER CASE)
%INTEGER THOLD,VHOLD,FHOLD
    CASE = CASE+16_0800 %IF COND&6 = 0
    CASE = CASE+16_0400 %IF COND&1 # 0
    ALMAX = ALMAX+1;  %MONITOR 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!!1
    PLANT JUMP;  COND = 0
    TYPE = THOLD;  VAL = VHOLD;  FLAG = FHOLD
%END

%ROUTINE PLANT INST(%INTEGER CODE)
    SET JUMP(16_1000) %IF COND # 0
    PLANT(CODE)
%END

%ROUTINE RELEASE
%INTEGER I
    %RETURN %IF TYPE&REGXMASK = 0
    I = TYPE&15;  I = VAL %IF TYPE = REG
    %IF I = DREG %START
    DUSE = DUSE-1
    %ELSE %START
    I = 1<<I
    FREE = FREE!I %IF TEMPS&I # 0
    %FINISH
%END

%INTEGERFN TREG
%INTEGER I,J
    %IF DREG >= 0 %AND DUSE = 0 %START
    DUSE = 1
    %RESULT = DREG
    %FINISH
    J = 1
    %CYCLE I = 0,1,15
    ->OK %IF FREE&J # 0 %AND I # DREG
    J = J<<1
    %REPEAT
    FAULT('R')
OK: FREE = FREE-J
    %RESULT = I
%END

%ROUTINE LOAD CONST(%INTEGER R)
%INTEGER I,J
    I = LOADI+R<<8
    %IF VAL&(\255) = 0 %AND TYPE&UMASK = 0 %START
    PLANT INST(I+(\VAL))
    %ELSE %IF \VAL&(\255) = 0 %AND TYPE&UMASK = 0 %START
    PLANT INST(I+(\VAL))
    PLANT INST(COMP+R<<4+R)
    CREG = R
    %ELSE %START
!       PLANT INST(LOADC+R<<8)
!       PLANT INST(SKIP)
!       PLANT VAL
    J = VAL>>8&255
    J = J+1 %IF VAL&128 # 0
    PLANT INST(I+J)
    PLANT INST(ROT+R<<8+7<<4+r)
    PLANT INST(ADDI+R<<8+VAL&255) %IF VAL&255 # 0
    %FINISH
%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)
    ATYPE = -1 %IF ATYPE&XMASK # 0 %AND ATYPE&15 = R
    %IF TYPE = REG %START
    PLANT INST(COPY+R<<4+VAL)
    CREG = R
    %ELSE %IF TYPE&XMASK = 0 %START
    LOAD CONST(R)
       PLANT INST(LOAD+R<<8+R<<4) %IF TYPE&MEMMASK # 0
    %ELSE %START
       %IF VAL&(\3) # 0 %OR TYPE&MEMMASK = 0 %START
          %IF TYPE&15 # R %START
             %IF !VAL! <= 127 %START
                PLANT INST(COPY+R<<4+TYPE&15)
                PLANT INST(ADDI+R<<8+VAL&255) %IF VAL # 0
             %ELSE %START
                LOAD CONST(R)
                PLANT INST(ADD+R<<4+TYPE&15)
             %FINISH
             CREG = R
          %ELSE %START
             %IF !VAL! <= 127 %START
                %IF VAL # 0 %START
                   PLANT INST(ADDI+R<<8+VAL&255)
                   CREG = R
                %FINISH
                %ELSE %START
                OP = TREG
                LOAD CONST(OP)
                TYPE = REG;  VAL = OP
                RELEASE
                PLANT INST(ADD+R<<4+OP)
                CREG = R
                %FINISH
                %FINISH
                TYPE = TYPE&MEMMASK+XMASK+R;  VAL = 0
                %FINISH
    %IF TYPE&MEMMASK # 0 %START
    PLANT INST(LOAD+R<<8+(TYPE&15)<<4+VAL)
    CREG = -1
    %FINISH
    %ELSE %START
    LOAD CONST(R)
    PLANT INST(LOAD+R<<8+R<<4)
    %FINISH
    %FINISH
    TYPE = REG;  VAL = R
%END

%ROUTINE LOAD TEMP
    RELEASE
    LOAD REG(TREG)
%END

%ROUTINE SWOP
%INTEGER K
    K = TYPE1;  TYPE1 = TYPE;  TYPE = K
    K = VAL1;  VAL1 = VAL;  VAL = K
%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
    %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
    %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
    %IF OP = AND %AND TYPE = 0 %AND VAL&(\255) = 0 %START
    PLANT INST(ANDI+VAL1<<8+VAL)
    %ELSE %START
    LOAD TEMP %IF TYPE # REG
    RELEASE
    PLANT INST(OP+VAL1<<4+VAL)
    %FINISH
    TYPE = REG;  VAL = VAL1
    CREG = VAL
    ATYPE = -1 %IF ACC = VAL
    ATYPE = -1 %IF ATYPE&XMASK # 0 %AND ATYPE&15 = VAL
    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 %AND %NOT TYPE=VAL=0 %START
    TYPE1 = XMASK+VAL1;  LITVAL = VAL
    %FINISH
    TYPE = TYPE1;  VAL = LITVAL
    ->POP
ASS(-6):
    LITVAL = VAL1<<VAL;  K = (-1)<<VAL
    VAL = 16-VAL
    ->AS7
ASS(-7):
    LITVAL = VAL1>>VAL;  K = (16_FFFF)>>VAL
AS7:K=0 %AND ->BOP %IF MODE <= 0
    FAULT('I') %IF TYPE # 0 %OR VAL&(\15) # 0
    %IF %NOT TEMP %START
    SWOP;  LOAD TEMP;  SWOP
    %FINISH
    OP = ROT+VAL1<<8+VAL1
    PLANT INST(OP+16_0070) %IF VAL > 8
    PLANT INST(OP+(VAL-1)<<4) %IF VAL # 0
    TYPE = 0;  VAL = K;  K = -1
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(-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
    LITVAL = 2_01011000
    LITVAL = 2_01100100 %IF VAL < 0
    LITVAL = 2_10101000 %IF VAL1 > VAL
    K = LITVAL>>K&1;
    %ELSE %START
    %UNLESS K&6=4 %AND -256<VAL<0 %AND TYPE&XMASK#0 %START
    LOAD TEMP %IF TYPE # REG
    PLANT INST(COPY+VAL<<4+VAL) %IF CREG # VAL
    CREG = VAL
    %ELSE %START
    PLANT INST(SKIDI+(TYPE&15)<<8-VAL)
    K = K+4;                    !8,9
    %FINISH
    %FINISH
    COND = K
    ->GET

ASS(-12):                             !TEST CC
    COND = VAL!!1
    ->GET

ASS(-13):                             !AND,WHILE
    %IF MODE > 0 %START
    SET JUMP(16_1000)
    %ELSE %START
    %RETURN %IF COND = 0
    %FINISH
    %RETURN %IF Q = QLIM
    ->NEW

ASS(-14):                             !OR
    %IF MODE > 0 %START
    COND = COND!!1
    SET JUMP(16_3000)
    %ELSE %START
    %RETURN %IF COND # 0
    %FINISH
    ->NEW

ASS(-15):                             !IF
    SET JUMP(16_2000)
    %RETURN

ASS(-16):                             !ELSE
    COND = 1
    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 %THEN LOAD TEMP %ELSE FAULT('A')
    %FINISH
    %IF TYPE = REG %START
    TYPE = XMASK+VAL;  VAL = 0
    %FINISH
    FAULT('I') %IF TYPE1&TYPE&RELMASK # 0
    TYPE = TYPE1!TYPE!MEMMASK;  VAL = VAL1+VAL
    ->POP

ASS(-22):                             !MINST SEPARATOR
    COMBINE
    ->POP

ASS(-23):                             !PLANT INST
    MODE = 1
    PLANT INST(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
    %ELSE %START
    ATYPE = -1 %IF ATYPE&MEMMASK # 0
    %IF VAL1 = ACC %AND ATYPE < 0 %START
    K = TYPE&15
    ATYPE = TYPE %AND AVAL = VAL %IF TYPE&XMASK = 0 %OR 1<<K&TEMPS = 0
    %FINISH
    %IF TYPE&XMASK = 0 %OR VAL&(\3) # 0 %START
    TYPE = TYPE&(\MEMMASK)
    LOAD TEMP
    TYPE = MEMMASK+XMASK+VAL;  VAL = 0
    %FINISH
    PLANT INST(STORE+VAL1<<8+(TYPE&15)<<4+VAL)
    %FINISH
    %RETURN

ASS(-26):                             !JUMP
    SET JUMP(16_1000) %IF INTEGER(NP)&16_F000 = 16_3000; !OR
    TYPE = TYPE!MEMMASK %IF TYPE # REG
    %IF TYPE&(\UMASK) = LOCTYPE %START
       PLANT JUMP
    %ELSE %START
    TYPE = XMASK+VAL %AND VAL=0 %IF TYPE = REG
    FAULT('I') %IF TYPE&XMASK = 0 %OR VAL&(\15) # 0
    %IF COND&8 # 0 %START
    PLANT(SKIP) %IF COND = 8
    COND = 1
    %FINISH
    PLANT(BOCR+COND<<8+(TYPE&15)<<4+VAL)
    %FINISH
    COND = 0
    %RETURN
%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;  J = 0
    PACK TRIPLE %IF TERM <= 0
    TAG2 = J
    CODE SYM %WHILE TERM <= 0
    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 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
    DP = DP-4
REP:DP = DP+4
    %LAC* DP; %OPR 640;!SNA; %JMP NO
    %SAD TAG1; %OPR 512; %JMP REP
    %LAC DP; %TAD #1; %DAC P
    %LAC* P; %SAD TAG2; %JMP YES
    ->REP
NO:
    %RETURN %IF CONTROL&1 = 0;        !NO CREATION
NEW:DEFMIN = DEFMIN-4;  DP = DEFMIN
    %MONITOR 21 %IF DP-QLIM <= 0
    INTEGER(DP) = TAG1;  INTEGER(DP+1) = TAG2
SET:INTEGER(DP+2) = TYPE;  INTEGER(DP+3) = VAL
    %RETURN
YES:->NEW %IF CONTROL = 3 %AND DP-INTEGER(BP) >= 0
    %IF CONTROL&2 = 0 %START;         !NOT DEF CLASS
    TYPE = INTEGER(DP+2);  VAL = INTEGER(DP+3)
    %RETURN %UNLESS TYPE&OPMASK = MACRO %AND CONTROL = 0
    %IF TYPE&31#25 %THEN INTEGER(DP+2)=TYPE+1 %C
    %ELSE INTEGER(DP+2) = TYPE+7
    %RETURN
    %FINISH
    FAULT('D') %IF CONTROL = 3
    ->SET %IF CONTROL # 7
    %IF INTEGER(DP+2)&(OPMASK+FMASK) = FMASK %START
    VAL = INTEGER(DP+3)
    %IF PASS = 0 %START
    INTEGER(VAL) = LOC
    %ELSE %START
    FAULT('P') %AND LOC=INTEGER(VAL) %IF INTEGER(VAL) # LOC
    %FINISH
    VAL = LOC
    %ELSE %START
    ->NEW %IF DP-INTEGER(BP) >= 0
    FAULT('D')
    %FINISH
    ->SET
%END

%ROUTINE QUEUE(%INTEGER K)
    INTEGER(QLIM) = K
    QLIM = QLIM+1;  %MONITOR 21 %IF QLIM = DEFMIN
%END

%ROUTINE GET EXP
%OWNINTEGER W=24717
%INTEGER I,NBASE

    NBASE = NP
    ->E3 %IF PEND # 0
E1: NEST(0) %WHILE S('(')
    NEST(-20) %IF S('#')
    %IF TAG %START
E3: %IF TAG1 = W %START
    TYPE = 0;  VAL = 0
    %ELSE %START
    %IF PEND >= 0 %START
    TYPE = LOCTYPE+FMASK+UMASK;  VAL = LABMIN-1
    LOOKUP(1)
    %IF TYPE&(OPMASK+FMASK) = FMASK %START
    %IF VAL = LABMIN-1 %START
    LABMIN = VAL;  %MONITOR 22 %IF LABMIN = ALMAX
    %FINISH
    VAL = INTEGER(VAL)
    FAULT('U') %IF VAL = 0
    TYPE = TYPE-FMASK
    %FINISH
    %FINISH
    %FINISH
    PEND = 0
    %IF TYPE = REG %AND TERM = '(' %START
    TYPE = 0 %IF SAVE&1 = 0;  VAL = VAL+SAVE;   !?
    %FINISH
    %IF MODE # 0 %START
    FAULT('I') %AND TYPE=0 %IF TYPE&OPMASK # 0
    %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
    %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
    %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'
    %ELSE FAULT('H')
    GETPOS = GETPOS+1
    %REPEAT
    GET SYM
    %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
    %ELSE %IF S('.') %START
    ->ERR %IF %NOT TAG
    TYPE = 0;  VAL = TAG1
    %ELSE %IF S('*') %START
    TYPE = LOCTYPE&63;  VAL = LOC
    %IF SYM = 'L' %START;          !FOR NOW
    TYPE = 0;  VAL = LIST %IF TAG
    %FINISH
    %ELSE %IF SYM = '-' %START
    TYPE = 0;  VAL = 0
    %ELSE %IF SYM = '\' %START
    TYPE = 0;  VAL = \0
    %ELSE ->ERR
    QUEUE(TYPE);  QUEUE(VAL)

    %WHILE NP # NBASE %CYCLE
    %IF INTEGER(NP) < 0 %START
    QUEUE(INTEGER(NP))
    %ELSE %START
    %EXIT %IF %NOT S(')')
    %FINISH
    NP = NP+1
    %REPEAT

    NEST(-1) %AND ->E1 %IF S('+')
    NEST(-2) %AND ->E1 %IF S('-')
    NEST(-3) %AND ->E1 %IF S('&')
    NEST(-4) %AND ->E1 %IF S('!')
    NEST(-5) %AND ->E1 %IF S('\')
    NEST(-6) %AND ->E1 %IF SS('<')
    NEST(-7) %AND ->E1 %IF SS('>')
    NEST(-8) %AND ->E1 %IF S('_')
    %RETURN %IF NP = NBASE
ERR:NP = NBASE
    %MONITOR 19
%END

%ROUTINE GET COND
%OWNINTEGER AND=1717, OR=16873
%INTEGER J,K
    TRANSF = QSTART;  QSTART = QLIM
    J = 0
    %CYCLE
    GET EXP
    %IF S('=') %START
    K = 5
    %ELSE %IF S('#') %START
    K = 4
    %ELSE %IF S('<') %START
    K = 3;  K = 7 %IF S('=')
    %ELSE %IF S('>') %START
    K = 6;  K = 2 %IF S('=')
    %ELSE %START
    QUEUE(-12)
    %RETURN
    %FINISH
    GET EXP
    QUEUE(-1);  !SUBTRACT
    QUEUE(-11);  QUEUE(K)
    %RETURN %IF %NOT TAG
    %IF TAG1 = AND %AND TAG2 = 0 %START
    %MONITOR 19 %IF J < 0
    J = 1;  QUEUE(-13)
    %ELSE %START
    %MONITOR 19 %IF TAG1 # OR %OR J > 0
    J = -1;  QUEUE(-14)
    %FINISH
    %REPEAT
%END

%ROUTINE GET INST
%INTEGER I
    QUEUE(TYPE);  QUEUE(VAL)
    %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
    %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
    %ELSE %START
    GETPOS = INTEGER(MP)
    %IF CHAR(GETPOS) = 0 %START
    QBASE = MP
    %IF INTEGER(MP+1)&16_8000 # 0 %START
    %WHILE INTEGER(NP)&16_8000 = 0 %CYCLE
    FAULT('C');  NP = NP+2
    %REPEAT
    SET LAB(LOC)
    %FINISH
    GETPOS = INTEGER(MP+2)
    STARTPOS = INTEGER(MP+3)
    MP = INTEGER(MP+4)
    PRINTPOS = 0 %IF LIST&2 # 0
    GET SYM;                    !TERMINATOR
    GET SYM %IF SYM = ';'
    %RETURN
    %FINISH
    PRINTPOS = STARTPOS %IF LIST&2 # 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
    %IF SYM = '?' %START
    PUT CHAR(INTEGER(MP+1)>>5&31+'A')
    SYM = INTEGER(MP+1)&31+'A'
    %FINISH
    PUT CHAR(SYM)
    INTEGER(MP) = GETPOS
    %EXIT %IF SYM = NL
    %REPEAT
    %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
%FAULT 19 ->ERR;                      !RECOGNITION ERROR
%FAULT 9 ->BEND;                      !INPUT ENDED

    %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 = STORELIM-(SBOUND>>2)
    DEFMIN = DEFLIM
    INTEGER(BP) = DEFLIM
    SELECT INPUT(PRE)
DO PASS:
    PUT WORD(0) %AND CONTROL=16_20 %IF PASS > 0
    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 = '/'
    %IF SYM = NL %START
    ->LEND %IF LINES < 54
    DO NEWLINE %WHILE LINES # 0
    ->READ
    %FINISH
    %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
    %ELSE %START
    VAL = VAL+J;  MODE = -2
    PLANT VAL;  VAL = VAL&255
    %FINISH
    %ELSE %START
    PLANT VAL;  VAL = VAL&255
    %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
    QUEUE(-24);                       !'LOAD'

CONDQ:
    %IF TAGIF %START
    MODE = MODE+4;  DREG = DREG-16; !SCARIFY
    GET COND;  ASSEMBLE
    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(VAL);                       !(DEFPOS)
    QUEUE(TYPE&1023);                 !JOKER
    QUEUE(0);                         !(CALLPOS)
    QUEUE(STARTPOS)
    QUEUE(MP)
    %CYCLE
    %EXIT %IF CHAR(INTEGER(QBASE)) = NL; !END OF MAC DEF
    I = GETPOS-1;                  !SAVE CALLPOS
    GETPOS = INTEGER(QBASE);  GET SYM
    %MONITOR 24 %IF %NOT TAG
    TYPE = 0;  VAL = 0
    SCAN ARG
    GET SYM %IF SYM = ','
    INTEGER(QBASE) = GETPOS-1;        !UPDATE DEFPOS
    GETPOS = I;  GET SYM;             !RESTORE CALLPOS
    SCAN ARG
    GET SYM %IF SYM = ','
    QUEUE(TAG1);  QUEUE(TAG2)
    QUEUE(TYPE);  QUEUE(VAL)
    %REPEAT
    GET SYM %IF SYM = ' '
    %IF TAGIF %START
    GET COND; QUEUE(-18); ASSEMBLE
    QLIM = QSTART
    INTEGER(QBASE+1) = INTEGER(QBASE+1)+16_8000
    %FINISH
    QUEUE(0)
    MP = QBASE; STARTPOS = QLIM<<1
    INTEGER(MP) = INTEGER(MP)+1
    INTEGER(MP+2) = GETPOS-1
    PRINT LINE %IF PRINTPOS # 0 %AND LIST&2 # 0
    ->READ

!CODING OF JUMPS: 1000 (SINGLE INST), 2000 (MAIN IF)
!                 4000 (ELSE), 6000 (IF AFTER ELSE)

IFC:
    GET COND;  QUEUE(-15);  ASSEMBLE
    ->SEND

ELSE:
    ->CERR %IF INTEGER(NP)&16_2000 = 0
    QUEUE(0);  QUEUE(0)
    QUEUE(-16);  ASSEMBLE
    ATYPE = -1; CREG = -1
    %IF TAGIF %START
    GET COND;  QUEUE(-17);  ASSEMBLE
    %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)
    %ELSE %START
    SET LAB(LOC)
    I = VAL+1
    %FINISH
    %REPEAT
    SET LAB(I)
    ->SEND

WHILE:
    I = LOC;  ATYPE = -1;  CREG = -1
    GET COND;  QUEUE(-13); ASSEMBLE
    NEST(I);  NEST(1)
    ->SEND

CYCLE:
    NEST(LOC);  NEST(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: GET COND; ASSEMBLE
    SKIP = ASSCOND %IF COND # 0
    PRINT LINE %IF PRINTPOS # 0
    ->LEND

ASSELSE:
    %IF SKIP = 0 %START
    ->CERR %IF ASSCOND&1 # 0
    SKIP = ASSCOND
    %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
    TYPE = UMASK;  LOOKUP(0)
    %IF TYPE&OPMASK # 0 %START
    GET INST
    %ELSE %START
    PEND = -1;  GET EXP
    %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_FF9F = 0 %START
    LOCTYPE = TYPE&RELMASK+MEMMASK;  LOC = VAL
    PUT WORD(VAL-1) %AND CONTROL=16_30 %IF PASS > 0
    %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;  %MONITOR 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

    PUT WORD(CHECK!!16_0100);  CONTROL = 16_30
    PUT WORD(16_0100)
    SELECT OUTPUT(BIN);  PRINT CH(16_60);  SELECT OUTPUT(LIS)
    FAULT('$')
    PRINT LOC;  PRINT LINE
    LINES = 60 %IF OUTDEV = 1
    DO NEWLINE %WHILE LINES # 0

%ENDOFPROGRAM