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
END
ROUTINE PUT CHAR(INTEGER K)
!AT PUTPOS WITH POST-INCREMENT
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
finish 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
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
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®XMASK = 0
I = TYPE&15; I = VAL IF TYPE = REG
IF I = DREG START
DUSE = DUSE-1
finish 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)
finish ELSE IF ¬VAL&(¬255) = 0 AND TYPE&UMASK = 0 START
PLANT INST(I+(¬VAL))
PLANT INST(COMP+R<<4+R)
CREG = R
finish 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
finish ELSE IF TYPE&XMASK = 0 START
LOAD CONST(R)
PLANT INST(LOAD+R<<8+R<<4) IF TYPE&MEMMASK # 0
finish 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
finish ELSE START
LOAD CONST(R)
PLANT INST(ADD+R<<4+TYPE&15)
FINISH
CREG = R
finish ELSE START
IF |VAL| <= 127 START
IF VAL # 0 START
PLANT INST(ADDI+R<<8+VAL&255)
CREG = R
FINISH
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 -- commenting out this line allows the program to compile
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
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
IF OP = AND AND TYPE = 0 AND VAL&(¬255) = 0 START
PLANT INST(ANDI+VAL1<<8+VAL)
finish 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 = -3
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;
finish 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
finish 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
IF MODE > 0 START
SET JUMP(16_1000)
finish 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)
finish 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®XMASK # 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
finish 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
finish 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 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
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 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; !W
TYPE = 0; VAL = 0
finish 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®XMASK # 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
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
finish ELSE IF S('#') START
K = 4
finish ELSE IF S('<') START
K = 3; K = 7 IF S('=')
finish ELSE IF S('>') START
K = 6; K = 2 IF S('=')
finish ELSE START
QUEUE(-12)
RETURN
FINISH
GET EXP
QUEUE(-2); !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)
finish 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
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
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®XMASK # 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
FINISH
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)
finish 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
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
TYPE = UMASK; LOOKUP(0)
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_FF9F = 0 START
LOCTYPE = TYPE&RELMASK+MEMMASK; LOC = VAL
PUT WORD(VAL-1) AND CONTROL=16_30 IF PASS > 0
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; !!%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