%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< 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 %ELSE %START I = 1<= 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 -- commenting out this line allows the program to compile %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<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<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; %ELSE %START %UNLESS K&6=4 %AND -256GET ASS(-12): !TEST CC COND = VAL!!1 ->GET ASS(-13): !AND %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®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 %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<= 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; !W 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®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 %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(-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) %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®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 %ELSE %START VAL = VAL+J; MODE = -2 PLANT VAL %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<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