head 1.2; access; symbols; locks gtoal:1.2; strict; comment @# @; 1.2 date 2021.10.03.18.58.12; author gtoal; state Exp; branches; next 1.1; 1.1 date 2021.10.03.18.55.55; author gtoal; state Exp; branches; next ; desc @KDF9 Imp(AA) compiler after line reconstruction @ 1.2 log @with updated comment @ text @mcode begin integerI,J,K,NLIB,LFLAG,DEVNO,LISTFLAG,M10,M13 integerLINE,LENGTH,Q,N0,NUM,NEXT,V,FAULTY,N,NR integerR,QU,PLABEL,LEVEL,MCSWITCH,PERM,AFLAG,DFLAG,OVERFLAG integerV0,PPSTART,PPCURR,ABC,FFLAG integerPTBLOCK,PCHSUM,PTDEV,PLSTART,PLCURR,PSSTART integerPSCURR,COMPILER,DIAGS integerTIMELIMIT,MARKER1,MARKER2,Q5,Q6,Q7 integerarrayST(-3:2300),A(1:400),WORD,TAGS(-1:340),SL(1:120),LETT(1:620) integerarrayCC(0:300) integerarrayCYCLE,NAME,LABEL,JUMP,FLAG,RAL,SET,L,M,ARRDIM(0:10) integerarrayRA(-3:200),PPBUF,PLBUF,PSBUF(-3:99),T(1:7) realA',A'' routinespecCOMPARE routinespecCSS routinespecSPLASH(integerWARNING,integernameFROM) routinespecINITIALISE routinespecDPCA integerfnspecCA T(1)=5 T(2)=6 T(3)=15 T(4)=8 T(5)=9 T(6)=15 T(7)=8 TIMELIMIT=120 *ZERO *NOT *SHL-9 *SET47 *FLOAT **=A'' ABC=0 *JS98P cycleJ=1,1,5 SKIPSYMBOL repeat READ(K) integerarrayCLETT(1:K) cycleJ=1,1,K READ(CLETT(J)) repeat READ(K) integerarraySYMBOL(1300:K) cycleJ=1300,1,K READ(SYMBOL(J)) repeat READ(K) LFLAG=0 LISTFLAG=0 NLIB=90 *SET58P: *=E160 DIAGS=0 OVERFLAG=1 DFLAG=0 FAULTY=0 N0=4 N=2 NR=0 MCSWITCH=0 PERM=1 COMPILER=1 QU=1 PLABEL=50000 LEVEL=0 cycleJ=2300,-1,801 ST(J)=J-1 repeat ST(800)=0 J=-1 cycleI=0,1,10 ARRDIM(I)=0 CYCLE(I)=J NAME(I)=J LABEL(I)=J JUMP(I)=J repeat cycleI=0,1,330 TAGS(I)=J repeat cycleI=1,1,120 SL(I)=0 RA(I)=0 repeat comment INITIALISATION 320:*SET2300 *DUP *=I9 *=C9 **@@ST(0) *=M9 PPCURR=300*32768 comment 0/150/0 INITIALISE ->342 routineINITIALISE *C0TOQ1 *C0TOQ3 *C0TOQ4 *SET419 *=M13 *M0M13 *DUP **=PTDEV *=C15 **COMPILER *J1=Z *SET5 *=M15 *PMDQ15 comment REWIND *PMAQ15 comment SKIP LABEL, CALL, AND POSSIBLY COMPILER 1:V0=65535 PTBLOCK=0 PCHSUM=0 PLCURR=0 PSCURR=65536 **@@PPBUF(0) **=PPSTART **@@PLBUF(0) **=PLSTART **@@PSBUF(0) **=PSSTART cycleI=-3,1,99 PPBUF(I)=0 PLBUF(I)=0 PSBUF(I)=0 repeat end 50P:**PPSTART *=M14 **PPCURR *=Q15 304:*C15 *NOT *NEG *DUP *SET-8 *XD *CONT *=C15 *REV *SET255 *AND *SHCC15 *M14M15 *OR *=M14M15 *SET6 *J301# *ERASE *C0TOQ15 54P:*SET1 *=+M15 *SET100 *M15 *J302# *M0TOQ15 *=+I15 *Q14 *Q15 SPLASH(0,PPBUF(0)) *=Q15 *=Q14 ->303 301:*=C15 ->303 302:*ERASE 303:*DC14 *J304C14NZ *Q15 **=PPCURR *EXIT1 52P:**PSSTART **PSCURR ->316 51P:**PLSTART **PLCURR 316:*=Q15 *=M14 *SET2 *=C14 314:*C15 *SET1 *DUP *=+C15 *- *DUP *J310=Z *J311>Z *SHL32 *=M14M15 ->312 310:*ERASE **V0 *AND *SHL16 *M14M15 *OR *=M14M15 ->312 311:**V0 *AND *M14M15 *OR *=M14M15 *C0TOQ15 *SET1 *=+M15 *SET100 *M15 *- *J312#Z *M0TOQ15 *Q14 *Q15 *I15 *J313#Z SPLASH(1,PLBUF(0)) ->317 313:SPLASH(2,PSBUF(0)) 317:*=Q15 *=Q14 312:*DC14 *J314C14NZ *Q15 *I15 *J315#Z **=PLCURR *EXIT1 315:**=PSCURR *EXIT1 routineSPLASH(integerWARNING,integernameFROM) returnifFAULTY#0 **@@FROM *DUP *=RM14 *SET3 *- *DUP *=I15 *SET100 *=C14 *ZERO *VR 2:*M0M14Q *+ *J1NV *NOT *NEG 1:*J2C14NZ *M-I14 *M14TOQ15 *REV *=M14 **PTBLOCK *DUP *=M0M14Q *NOT *NEG **=PTBLOCK **WARNING *=M0M14Q *DUP *=M0M14Q **PCHSUM *+ *J3NV *NOT *NEG 3:**=PCHSUM **PTDEV *=C15 *POAQ15 comment MWQ 15 *SET100 *=C14 5:*ZERO *=M0M14Q *J5C14NZ end routineDPCA integerP ->1ifLFLAG=1 **PPCURR *=Q14 *M+I14 *M14 *C14 *SET7 *AND **=P WRITE(P,3) PRINTSYMBOL('/') **=P WRITE(P,3) 1:end integerfnCA **PPCURR *DUP *=Q14 *M+I14 *SHL-19 *SETB160000 *AND *M14 *+ return end routineDUMP integerI caption\\PROGRAM_(+PERM)_OCCUPIES **CA *SETB17777 *AND **=I WRITE(I+N0+NR,1) PRINTSYMBOL('(') WRITE(I,5) caption)_WORDS ->8ifFAULTY=0 caption\PROGRAM_FAULTY stop 10:caption\PROGRAM_TOO_BIG\ stop 8:ST(0)=N0 ST(1)=NR **PPCURR *=Q15 *M15 *I15 *+ *SET8191 *- *J10>Z *J1C15NZ *M15 *J2=Z 1:SPLASH(0,PPBUF(0)) 2:**PLCURR *J3=Z SPLASH(1,PLBUF(0)) 3:**PSCURR *=Q15 *J4C15NZ *M15 *J5=Z 4:SPLASH(2,PSBUF(0)) 5:I=0 6:SPLASH(3,ST(I)) I=I+100 ->6ifI7ifI8 2:*C0TOQ4 *ERASE 1:*Q14 *JS49P ! READ CHAR *DUP *=M0M6QN *REV *C6 *SET399 *+ *J39=Z *=Q14 *SET32 ! '_' *J2= *SET37 ! ' ' *J20# *=C4 *J1 20:*J3C4Z *DUP *SET65 ! 'A' *- *J21Z *SET128 *OR *J3 21:*C0TOQ4 3:*M+I14 *DUP *=M7M14 *SET10 ! '\' *- *J1#Z *M14 *C14 *- *M-I14 *J8=Z *M7M14 *SET195 ! '%C ' *- *J4#Z *M14 *=C14 *M-I14 *Q14 1011:*JS49P *SET10 *- *J1011=Z *E227 *=Q14 *M-I14 *Q14 *=E227 *=Q14 ! IGNORE NLS *M-I6 *M-I6 *M0M6 *SET37 *- *J1#Z *M-I6 ->1 4:*M+I14 *M14 *DUP *SET300 *- *J39>Z **=LENGTH **LINE *NOT *NEG **=LINE *I12 *=RM8 5:**LISTFLAG *J5555=Z WRITE(LINE,5) SPACES(3*LEVEL) **Q5 *=RM6 *SET36P: *=M14 *M0M14 *=Q15 5543:*M0M6QN *DUP *JS13P *SET10 *- *J5543#Z *Q15 *=M0M14 5555:**Q5 *=Q5 **Q6 *=Q6 **Q7 *=Q7 **K COMPARE 4565:*J6C8Z *M6 *SET380 *- *J11>Z CSS 4566:**A(1) *SET15 *- *J7=Z *M8 **LENGTH *- *J8=Z ->5555 11:PRINTSYMBOL(42) WRITE(LINE,4) caption:_LONG_ANALYSIS_RECORD\ stop 39:PRINTSYMBOL(42) WRITE(LINE,4) caption:_>_300_CHARS\ stop 6:PRINTSYMBOL(42) WRITE(LINE,4) caption:_INSTRUCTION_NOT_RECOGNISED\ *I12 ifFAULTY=1then->5556 *E418 *=RC15 *E444 *=M15 *PMEQ15 *ZERO *=E444 *E435 *SET1 *=C15 *JS25P stopunlessLFLAG=0 5556:**=FAULTY **LENGTH *=M14 *Q8TOQ15 **Q7 *=Q7 13:*M7M15 *SET59 ! ':,' *- *J12#Z *M7M15N *SET10 ! '\' *- *J9#Z 12:*M+I15 *M15 *M14 *- *J13#Z 9:begin integerPC PC=0 *M8 **=Q *M15 **=I cycleJ=Q,1,I ifPC=0then->1 ifCC(J)<128then->2 CC(J)=CC(J)-128 ->3 2:PC=0 ->3 1:->3ifCC(J)<128 PRINTSYMBOL(37) PC=1 CC(J)=CC(J)-128 3:PRINTSYMBOL(CC(J)) repeat NEWLINE end **I **LENGTH *- *J8=Z **I *NOT *NEG *=M8 ->5555 7:DUMP routineCOMPARE integerRA,RP,RQ,RR,RS,SAVE switchBIP(1000:1009) ! Q5 = @@SYMBOL(0) / 48 / @@A(0) '0' = 48 ! Q6 = @@CWORD(0) / 1 / R ! Q7 = @@CLETT(0) / 57 / @@CC(0) '9' = 57 ! Q8 = HIT / 1 / Q ! ENTER WITH P IN NS *DUP *NOT *NEG **=RS ! RS=P+1 *C5 *+ *=M13 *M0M13 **=RP ! RP=SYMBOL(P) *M0M13N **=RA ! RA =SYMBOL(P+1) *M8 **=RQ ! RQ=Q *M6 **=RR ! RR=R *I6 *=M5M6 1:*M+I6 ! R=R+1 BIP(1000):2:**RS *NOT *NEG *DUP **=RS ! RS=RS+1 **RA *J8= ! %IF RS=RA %THEN ->8 *C5 *+ *=M13 *M0M13 *DUP *SET1300 *- *J4>=Z ! %IF ITEM>=300 %THEN ->4 *DUP *SET1000 *- *J6>=Z ! %IF ITEM>=200 %THEN ->6 *DUP *=RM14 *C7 *=M13 *M13M14 *+ ! CLETT(I)+I *DUP *=M15 *M14 *- *=C14 * 5:*M13M14QN *M7M8Q *- *J3#Z ! %IF CLETT(I)# CC(Q) %THEN ->3 *J5C14NZS ! %IF I5 ->2 4:COMPARE *J2C8NZ ! %IF HIT#0 %THEN ->2 !! There was some paper tape corruption here which may or may not have !! been manually repaired correctly. !! The area with the error was: ! *=M6 ;! R=RR ! **RA ! `j~vp ! `````~Nw} ;! %IF RA=RP %THEN ->7 ! *DUP ! **=RS ;! RS=RA ! *M5M6 !! which we 'corrected' to: ! **RA ! **RP ! *J7= ;! %IF RA=RP %THEN ->7 ! *DUP ! **=RS ;! RS=RA !! I'm not 100% sure that the DUP is duplicating RA on the stack - we need !! to check that with a KDF9 programmer... I'm worndering if the correct !! restoration should have been... ! **RA { RA - } ! *DUP { RA RA - } ! **RP { RA RA RP - } ! *J7= ;! %IF RA=RP %THEN ->7 { RA = removes RA and RP, leaving an RA on the stack } ! *DUP { RA RA - } ! **=RS ;! RS=RA { RA - removes RA, leaving an RA on the stack to be used later in fetching SYMBOL(RA) } !! Anyway... we later noticed that the first version of ICL4/75 Imp, which !! was fully bootstrapped in Imp rather than Imp plus assembler, contained !! identical code at this point. So here is the Imp version of what should !! be below: ! 4: ! PHRASE TYPE ALTERNATE ! P=ITEM; COMPARE; ! RCALL COMPARE TO RECOGNISE IT ! ->2 %IF HIT#0; ! FOUND ! 3: QMAX=Q %IF Q>QMAX; ! FAILURE - NOTE POSITION REACHD ! Q=RQ; R=RR; ! RESET LINE AND A.R. POINTERS ! ->7 %IF RA=RP; !TOTAL FAILURE NO ALT LEFT TO TRY ! RS=RA; A(R)=A(R)+1; ! MOVE TO NEXT ALT OF PHRASE ! RA=SYMBOL(RA); ->1 ! 8: ! COMPLETE SUCCESS ! HIT=1; %RETURN ! 7: ! UTTER FAILURE ! HIT=0; %RETURN ! 6: ! BUILT IN PHRASE !! Original KDF9 code resumes here: 3:**RQ *=M8 ! Q=RQ **RR *=M6 ! R=RR **RA **RP *J7= ! %IF RA=RP %THEN ->7 *DUP **=RS ! RS=RA *M5M6 *NOT *NEG *=M5M6 ! A(R)=A(R)+1 *C5 *+ *=M13 *M0M13 **=RA ! RA=SYMBOL(RA) ->1 8:*ERASE *DC8 return 7:*ERASE *C0TOQ8 return 6:**=J ->BIP(J) ! PHRASE NAME 9:*ERASE *J3 BIP(1001):*C0TOQ8 *M7M8 *DUP *SET65 ! 'A' *- *J99 *DUP *SET90 ! 'Z' *- *J1021<=Z *DUP *SETB141 *- *J9Z 1021:**V *=Q14 ! Q14 = 6/6/@@LETT(0) **NEXT *DUP *=RM15 ! Q15 = 0/1/NEXT+S *REV *DC14 *DC14 *ZERO *NOT **=J ! J=1 *M7M8QN 1101:*DUP ! SEQUENCE FOR LETTERS *SET65 ! 'A' *- *J1010 *DUP *SET90 ! 'Z' *- *J11<=Z ! %IF I<= 90 %THEN -> 11 *DUP *SETB141 *- *J10Z 11:*DC14 *REV *SHL+8 *OR ! V=256*V+I *J12C14NZ *=M14M15Q ! LETT(NEXT+S)=V *I14 *=C14 *ZERO 12:*M7M8QN **J *DUP *J1103>Z *J110113 *DUP *I7 *- *J11<=Z ! %IF I<='9' %THEN ->11 13:*SET1 **=J ! J=3 *ZERO 1103:*ERASE *SET39 ! SEQUENCE FOR PRIMES 39 = ''' *J11= *ERASE *DUP *J15=Z ! %IF V=0 %THEN ->15 *=M14M15Q ! LETT(NEXT+S)=V *ZERO 15:*ERASE *=M13 *C8 *NEG *SHL40 *M14M13 *OR *=M14M13 ! LETT(NEXT)=256*(NO. OF CHARS. IN WORD) !+(FIRST LETTER) *M15 *SET620 *- *J14<=Z NEWLINES(2) PRINTSYMBOL(42) WRITE(LINE,4) caption:_NAMES_TOO_LONG\ stop 14:*M13 ! DICTIONARY LOOK UP SEQUENCE *=I15 **@@WORD(0) *Q9 **=SAVE *=M15 **NUM *DUP *=C13 *NEG *NOT *NC15 ! Q15 = S+1/NEXT/@@WORD(0) *=RM9 *C13TOQ9 *I9=-1 ! U=-1 17:*I15 *=RM13 *J18C9Z *M14M13Q * ! 1ST WORD OF NEW NAME *M15M9Q *=RM10 *M14M10Q *J16= *J17C9NZS *ERASE ->18 16:*ERASE *C15TOQ10 *DC10 *J133C10Z * *M14M13Q *M14M10Q *- *J17#Z *J16C10NZS 133:*M9 *NOT *NEG *=M5M6 ! A(R)=U **SAVE *=Q9 ->1 18:**NUM *DUP *=M13 *I15 *DUP *=M15M13 ! WORD(NUM)=NEXT *C15 *+ **=NEXT ! NEXT=NEXT+S+1 *DUP *=M5M6 ! A(R)=NUM *NOT *NEG **=NUM ! NUM=NUM+1 **SAVE *=Q9 ifNUM<330then->1 NEWLINES(2) PRINTSYMBOL(42) WRITE(LINE,4) caption:_>_256_NAMES\ stop ! PHRASE CONST BIP(1002):*M7M8Q *SET36 ! '$' *J60# ! %IF I#36 %THEN ->60 *ERASE ! $ SEQUENCE *SET2 *=M5M6 ! A(R)=2 *M+I6 ! R=R+1 *SET3 *=M5M6 ! A(R)=3 ->1 60:*SET39 ! ''' *J20# *J62C3NZ *M7M8N *REV *J101# ! %IF I#39 %THEN ->101 *ERASE *M7M8Q *M+I8 *SET95 ! _ *J71= *SET92 ! \ *J72= ->76 101:*SET76 ! 'L' *J102= *SET80 ! 'P' *J103= ->9 102:*ERASE *M7M8Q *SET78 ! 'N' *J9# *M7M8N *SET39 *J9# *ERASE *M+I8 *M+I8 ->72 103:*ERASE *M7M8Q *SET83 *J9# *M7M8N *SET39 *J9# *ERASE *M+I8 *M+I8 ->71 71:*ERASE *SET32 ! '_' ->76 72:*ERASE *SET10 ! '\' ->76 62:*ERASE *C0TOQ13 *ZERO 66:*M7M8Q *SET39 *J63= *SET34 !" *J67= *SET95 ! _ *J64# *ERASE *J65 64:*SETB177 *AND 68:*SHLC13 *OR 65:*SET8 *=+C13 ->66 63:*ERASE ->61 67:*ERASE *SET39 ->68 20:*M-I8 *SET41P: *=M14 *SET1000 *=C14 *ZERO *REV *DUP *I5 *- *J19Z *ZERO *NOT *=C14 *J23 22:*M7M8QN *DUP *I5 *- *J26Z *REV *M0M14 *XF *REV *DC14 23:*I5 *- *I1 *FLOAT *+F *J22 26:*SET46 ! '.' *J27= *SET96 !'@@' *J28= 42:*ERASE *C14 *DUP *J44Z 44:*NEG *JS14P *J34 29:*JS15P *J34 21:*ERASE *ERASE 25:*ERASE *ERASE *J3 27:*ERASE *C14 *DUP *J33<=Z *ERASE *C0TOQ14 *J22 28:*ERASE *ZERO *ZERO *M7M8QN *DUP *I5 *- *J31Z 32:*REV *SET10 *XD *CONT *+ *I5 *- 35:*M7M8QN *DUP *I5 *- *J24Z *C14 *+ *J33 31:*SET43 !'+' *J37= *SET45 !'-' *J21# *CAB *ERASE *I12 *PERM 37:*ERASE *J35 30:*ERASE 34:*DUP **=A' ->431ifA'>=A'' **FRACPT(A') *J43=Z 431:*SET2 *=M5M6 ! A(R)=2 *M+I6 ! R=R+1 **N0 *DUP *=M5M6 ! A(R)=N0 *=RM13 *=M9M13Q ! ST(N0)=A *M13 **=N0 ! N0=N0+1 ->1 43:*ERASE **INT(A') 61:*DUP *SET32767 *- *J45>Z ! %IF U>32767 %THEN ->45 76:*I12 *=M5M6 ! A(R)=1 *M+I6 ! R=R+1 *=M5M6 ! A(R)=U ->1 45:*SET3 *=M5M6 ! A(R)=3 *M+I6 ! R=R+1 **N0 *DUP *=M5M6 ! A(R)=N0 *DUP *NOT *NEG **=N0 ! N0=N0+1 *=M13 *=M9M13 ! ST(N0)=U ->1 ! PHRASE N BIP(1003):*M7M8 *DUP *I5 *- *J99 *DUP *I7 *- *J9>Z ! %IF I>'9' %THEN ->9 *ZERO *REV 38:*REV *SET10 *XD *CONT *+ *I5 *- ! U=10*U+I-'0' *M7M8QN *DUP *I5 *- *J8181 *DUP *I7 *- *J38<=Z ! %IF I<='9' %THEN ->38 81:*ERASE *=M5M6 ->1 ! PHRASE S BIP(1004):*M7M8 *SET10 ! '\' *J82= ! %IF I=10 %THEN ->82 *SET59 ! '' *- *J3#Z ! %IF I#59 %THEN ->3 83:*M+I8 ->2 82:*ERASE ->2 ! PHRASE TEXT BIP(1005):*M7M8 39:*SET10 ! '\' *J82= ! %IF I=10 %THEN ->82 *SET59 ! '' *- *J83=Z ! %IF I=59 %THEN ->1 *M7M8QN ->39 ! PHRASE CAPTION TEXT BIP(1006):**N0 *DUP *=M5M6 *DUP *=M15 *=RM14 *SET32 *=C14 *ZERO *M-I8 93:*M7M8QN *SET10 ! '\' *J47= *SET59 ! '' *J47= *SET95 ! _ *J91= *SET92 !\ *J92= 49:*SHLC14 *OR *C14 *SET8 *- *DUP *J5093 91:*ERASE *SET32 ! '_' ->49 92:*ERASE *SET10 ! '\' ->49 50:*ERASE *=M9M14Q *SET40 *=C14 *ZERO ->93 47:*ERASE *DUP *J51=Z *=M9M14 *J98 51:*ERASE *M-I14 98:*M14 *M15 *- *NOT *NEG *SHL40 *M9M15 *OR *=M9M15 *M+I14 *M14 **=N0 ->1 ! PHRASE OCTAL BIP(1007):*M7M8 *DUP *I5 *- *J9Z *ZERO *REV 41:*REV *SHL+3 *+ *I5 *- *M7M8QN *DUP *I5 *- *J991 ! PHRASE SET MARKER 1 BIP(1008):*M6 **=MARKER1 ->2 ! PHRASE SET MARKER 2 BIP(1009):*M6 **=MARKER2 ->2 end ***A SWOP routineCSS routinespecCCOND routinespecCUI routinespecCSEXP(integerZ) routinespecMOVEM(integerQ,N) routinespecCNAME(integerZ) routinespecFINDLABEL routinespecPUSHDOWN2(integernameCELL,integerS1,S2) routinespecSTORETAG(integerKK) routinespecCOPYTAG(integerKK) routinespecFROMLIST2(integernameCELL,S1,S2) routinespecPOPUP2(integernameCELL,S1,S2) routinespecNEWCELL(integernameSTAD) routinespecINSERTAFTER2(integernameSTAD,integerS1,S2) routinespecREPLACETAG(integerKK) routinespecLINK(integernameSTAD) routinespecRETURNCELL(integernameSTAD) routinespecMORESPACE routinespecSTOREJUMP routinespecSTORENAME routinespecTESTNST routinespecFAULT(integerN) routinespecCMOD(integerN,Z) routinespecCUCI routinespecPPJ(integerI,J,K) routinespecPJ(integerA,S,B) routinespecPSET(integerN) routinespecPQ(integerA,Q,QQ) routinespecPSH(integerA,N) routinespecPN(integerA) routinespecPMS(integerA,M,Q) routinespecFILLLABEL(integerAT,EQUALS) routinespecFILLSET(integerAT,EQUALS) routinespecPRINTNAME(integerI) routinespecSKIPEXP switchSW(1:34),RFPD(1:8),RT(6:10),END(0:10) integerI,J,K,P,TYPE,Q,KK,KKK,QQ,JJ,JJJ,TYPE',FNAME routinespecCRSPEC(integerM) ->SW(A(1)) SW(1):comment [UI] [S] *JS3 ifA(MARKER2)=2then->90 P=2 CUI ->1 3:ifOVERFLAG=0orLFLAG=1then->6 PSET(LINE) PQ(120,2,4) 6:*EXIT1 SW(2):comment [%CYCLE ] *JS3 P=2 CNAME(3) unlessTYPE=2thenFAULT(25) PMS(1,N,LEVEL) CSEXP(2) ->5145unlessMCSWITCH=0 PN(34) 5145:CSEXP(2) PN(34) PMS(1,N+1,LEVEL) ->5146unlessMCSWITCH=0 PN(34) 5146:CSEXP(2) ->5147unlessMCSWITCH=0 PN(34) PN(54) 5147:PN(46) PMS(1,N+2,LEVEL) ->5148unlessMCSWITCH=0 PJ(8,SL(5),13) 5148:PMS(0,N,LEVEL) PQ(120,13,2) PUSHDOWN2(CYCLE(LEVEL),CA,N) PQ(65,13,0) N=N+3 M10=0 M13=0 ->1 SW(3):comment [%REPEAT ] [S] POPUP2(CYCLE(LEVEL),J,K) ifJ=-1thenFAULT(1) PMS(0,K,LEVEL) PQ(120,13,2) PQ(64,13,0) PMS(0,K+1,LEVEL) PN(46) PMS(0,K+2,LEVEL) PJ(8,J,1) PN(42) M13=0 ->1 SW(4):comment [N] [:] K=A(2) M10=0 M13=0 FINDLABEL ifJ=-1then->2 FAULT(2) ->1 2:PUSHDOWN2(LABEL(LEVEL),CA,K) ->1 SW(5):comment [%IU ] [SC][REST OF COND] [%THEN ] [UI] [S] *JS3 Q=2 ->4 SW(6):comment [!][TEXT][S] ->1 90:comment [UI][SET MARKER 2][REST OF SS1][%IU ][SC][REST OF COND] [S] Q=MARKER2+1 4:P=Q+1 CCOND ifA(1)=1thenP=2 ->1234unlessA(P)=2 K=A(P+1) STOREJUMP PJ(10-A(Q),0,6) ->1 1234:PLABEL=PLABEL-1 K=PLABEL STOREJUMP PJ(7+A(Q),0,6) Q=PLABEL CUI M10=0 M13=0 PUSHDOWN2(LABEL(LEVEL),CA,Q) ->1 SW(7):comment [TYPE] [NAME] [REST OF NAME LIST] [S] TYPE=3-A(2) J=0 P=2 PN(33)ifDIAGS=1 5:K=A(P+1) TESTNST STORETAG(K) STORENAME PN(34)ifDIAGS=1 PMS(1,N,LEVEL)ifDIAGS=1 N=N+1 P=P+2 ifA(P)=1then->5 PN(42)ifDIAGS=1 ->1 SW(8):comment [%END ] [S] *JS3 M10=0 M13=0 KKK=FLAG(LEVEL) 8401:POPUP2(ARRDIM(LEVEL),JJ,KK) ->50ifJJ=-1 COPYTAG(KK) FILLSET(JJ,J) ! FILL IN ARRAY DIM ->8401 50:comment COMPLETE LABELS JUMPS *JS2701 *ZERO *NOT **=A(2) **L(LEVEL) **=A(3) A(4)=M(LEVEL) A(5)=LEVEL KK=5 56:comment CLEAR THE DECS POPUP2(NAME(LEVEL),J,K) ifJ=-1then->857 JJ=K FNAME=JJ COPYTAG(K) POPUP2(TAGS(JJ),I,I) ifTYPE=2then->811 ifTYPE=1then->810 ifJ=15andLEVEL#1thenFAULT(28) ->56unless6<=TYPE<=10 JJ=K 58:POPUP2(ST(JJ),J,K) ifJ#-1then->58 RETURNCELL(JJ) ->56 810:*ZERO *NOT *SHL32 ->812 811:*ZERO 812:**JJ *SHL16 **K *OR *OR KK=KK+1 **=A(KK) ->56 820:KK=2 A(2)=-1 857:->838ifDIAGS=0orFAULTY=1 A(KK+1)=-1 *E419 *=C15 **@@A(2) *DUP *=I15 *SET99 *+ *=M15 *POAQ15 838:ifKK=2then->1 comment CHECK %CYCLE - %REPEAT POPUP2(CYCLE(LEVEL),J,K) ifJ=-1then->59 FAULT(13) ->857 59:comment PLANT ALLOCATION NEST UP INSTRUCTIONS ifKKK=1thenPJ(8,SL(6),11) if10>=KKK>=7thenPJ(8,SL(11),11) FILLSET(SET(LEVEL),N) if0#KKK#6then->60 PQ(105,LEVEL,12) PQ(64,12,0) PQ(120,LEVEL,2) PPJ(8,67,13)ifDIAGS=1 ifKKK=6thenPJ(8,SL(4),11) 60:ifKKK=2then->820 ifLFLAG=1then->4011 ifLISTFLAG=1then->401 WRITE(LINE,5) SPACES(3*LEVEL-3) captionEND_OF_ ->END(KKK) END(0):captionBLOCK ->401 END(1):captionPROGRAM ->401 END(6):captionROUTINE ->401 END(7):captionREAL_FN ->401 END(8):captionINTEGER_FN ->401 END(9):captionREAL_MAP ->401 END(10):captionINTEGER_MAP 401:ifMCSWITCH=1thenDPCA NEWLINE 4011:ifLEVEL>2orPERM=1orLFLAG=1then->61 ifKKK=1then->62 FAULT(14) A(1)=15 ->1 61:ifKKK#1then->63 FAULT(15) ->1 62:ifFAULTY#0then->64 begin integerP,Q,R cycleP=2,1,NLIB ->1ifRA(P)=1 repeat **COMPILER *J9#Z *E418 *=RC15 *E444 *=M15 *PMEQ15 *ZERO *=E444 ifLFLAG=0then->9 6:**DEVNO *E440 *=E420 *=E440 LFLAG=0 A(1)=15 *E9 *=E439 *E10 *=E443 *JS11 * 5:*M0M15Q * *=M0M14Q *J5C14NZS !RESTORE BUFFERS caption\ALL_LIBRARY_ITEMS_INSERTED RAL(LEVEL)=N LEVEL=LEVEL+1 ->9 2:*SET35P: *=M14 *M0M14 *=Q15 *=C15 *SETB242 *DUP *JS13 *SETB302 *DUP *=M0M14N *SET44P: *=M14 *M0M14 *=Q15 *PERM *=M0M14N *=C15 13:*=I15 *Q15 *=M0M14 *EXIT1 12:*M+I15 *M15 *SETB37 *AND *J12#Z *EXIT1 11:*SET42P: *=RM14 *SET68 *=C14 *SET11 *=RM15 *EXIT1 1:ifLFLAG=1then->3 LFLAG=1 A(1)=8 LISTFLAG=0 LEVEL=LEVEL-1 N=RAL(LEVEL) *E439 *=E9 *ZERO *=E439 *E443 *=E10 *JS11 * 4:*M0M14Q * *=M0M15Q *J4C14NZS !DUMP BUFFERS IN PTFC *ZERO *NOT *=E443 *E420 *E440 **=DEVNO *=E440 *E418 *DUP *DUP *=E420 *JS2 8:*SET30P: *=Q14 *M0M14 *=Q15 *JS12 *JS7 ->110 7:*M0M15 *=Q13 *ZERO *=TR *PARQ13 *J105TR *PIAQ13 *E444 *NOT *NEG *=E444 *M0M15N *=M15 *EXIT1 110:*JS12 *M-I15 *M-I15 *Q15 *=M0M14 3: 101:*E226 *=Q15 102:*JS12 *JS7 *M0M15 *M+I15 *J102>=Z *Q15 *=E226 ->21 105:*E437 *E436 *SET2 *=C15 *JS25P *ZERO *OUT ! PARITY 21:*JS49P **=Q ->21ifQ=10orQ=32 R=Q-48 23:*JS49P **=Q ->22unless'0'<=Q<='9' R=10R+Q-'0' ->23 22:->101ifP>R ->9ifP=R *E418 *=RC15 *E444 *SET5 *- *DUP *=M15 *J101<=Z *PMEQ15 *SET5 *=E444 ->101 9:ifFAULTY#0andLFLAG=1then->6 end ifLFLAG#0then->1 64:KKK=2 63:LEVEL=LEVEL-1 stopifLEVEL<=0 N=RAL(LEVEL) ifKKK=0then->1 ifKKK=2then->50 FROMLIST2(JUMP(LEVEL),J,K) PUSHDOWN2(LABEL(LEVEL),CA,K) ->1 SW(9):comment [RT] [%SPEC '] [NAME] [FPP] [S] ifA(3)=2then->41 CRSPEC(0) ->1 41:KKK=A(2)+5 KK=A(4) COPYTAG(KK) ->39unlessI=LEVEL ->40ifJ=15andTYPE=KKK FNAME=KK FAULT(7)unlessTYPE=0 39:CRSPEC(0) ->41 40:J=0 M10=0 M13=0 REPLACETAG(KK) JJ=K PLABEL=PLABEL-1 K=PLABEL STOREJUMP PJ(8,0,11) RAL(LEVEL)=N ifLISTFLAG=1then->4001 WRITE(LINE,5) SPACES(3*LEVEL) ->RT(TYPE) RT(6):captionROUTINE_ ->400 RT(7):captionREAL_FN_ ->400 RT(8):captionINTEGER_FN_ ->400 RT(9):captionREAL_MAP_ ->400 RT(10):captionINTEGER_MAP_ 400:SPACE PRINTNAME(KK) 4001:ifMCSWITCH=1thenDPCA NEWLINE ifLEVEL=9thenFAULT(34) ifLEVEL<10then->411 FAULT(35) stop 411:LEVEL=LEVEL+1 R=CA PQ(121,LEVEL,2) PQ(65,12,0) PQ(105,12,LEVEL) L(LEVEL)=LINE M(LEVEL)=KK N=3 ->407ifDIAGS=0 *JS415 407:FLAG(LEVEL)=TYPE SET(LEVEL)=CA PSET(0) PQ(122,12,2) PPJ(8,95,13)unlessMCSWITCH=1 FROMLIST2(ST(JJ),J,K) RA(J)=R ifA(5)=2then->42 P=4 43:P=P+2 ->RFPD(A(P)) RFPD(1):TYPE=A(P+1)+5 P=P+1 ->44 RFPD(2):TYPE=4 ->44 RFPD(3):TYPE=12 ->44 RFPD(4):TYPE=2 ->44 RFPD(5):TYPE=3 P=P+1 ->44 RFPD(6):TYPE=11 ->44 RFPD(7):TYPE=1 ->44 RFPD(8):TYPE=14 44:P=P+1 LINK(JJ) ifJJ#0then->45 FAULT(8) ->46 45:FROMLIST2(ST(JJ),J,JJJ) ifJ#TYPEthenFAULT(9) ->46if3#TYPE#4 PUSHDOWN2(ARRDIM(LEVEL),CA,A(P)) PSET(0) PMS(0,N,LEVEL) PPJ(8,66,13) 46:K=A(P) TESTNST if6<=TYPE<=10then->47 J=0 TYPE'=TYPE ifTYPE=14thenTYPE=2 STORETAG(K) TYPE=TYPE' N=N+1 STORENAME ->99 47:NEWCELL(KK) J=0 R=N N=KK STORETAG(K) STORENAME N=R PUSHDOWN2(ST(KK),JJJ,1000) 99:P=P+1 ifA(P)=1then->44 P=P+1 ifA(P)=1then->43 42:LINK(JJ) ifJJ#0thenFAULT(10) ->1 SW(10):comment [%SPEC ] [NAME] [FPP] [S] CRSPEC(2) ->1 SW(11):comment [%COMMENT ] [TEXT] [S] ->1 SW(12):comment [TYPE'] [%ARRAY ] [ARRAY LIST] [S] *JS3 TYPE'=4 ifA(2)#1thenTYPE'=3 Q=2 15:P=Q+2 10:ifA(P)=2then->9 P=P+2 ->10 9:KK=0 1201:PQ(121,12,2) ! *M12 PQ(96,12,0) ! *M+I12 1202:P=P+1 PQ(96,12,0) ! *M+I12 CSEXP(2) PQ(67,12,0) ! =M0M12Q CSEXP(2) PQ(67,12,0) KK=KK+1 ifA(P)=1then->1202 PSET(1) PQ(67,12,0) PN(34) ! DUP PQ(120,13,2) ! *=M13 PSET(KK) PQ(65,13,0) ! *=M0M13 M13=0 M10=0 QQ=Q+1 1205:K=A(QQ) PPJ(8,61,13) TESTNST TYPE=TYPE' J=KK STORETAG(K) STORENAME PMS(1,N,LEVEL) ! =E(N)M(LEVEL) STORE ARRAYWORD N=N+1 ifA(QQ+1)=2then->1206 QQ=QQ+2 ->1205 1206:PN(42) ! ERASE Q=P+1 ifA(Q)=1then->15 ->1 SW(14):comment [%BEGIN ] [S] ifLISTFLAG=1orLFLAG=1then->4111 WRITE(LINE,5) SPACES(3*LEVEL) captionBEGIN 4111:ifMCSWITCH=1thenDPCA NEWLINE RAL(LEVEL)=N LEVEL=LEVEL+1 ifLEVEL=10thenFAULT(34) ifLEVEL<11then->412 FAULT(35) stop 412:PQ(121,LEVEL,2) PQ(65,12,0) PQ(105,12,LEVEL) L(LEVEL)=LINE M(LEVEL)=0 N=2 ->413ifDIAGS=0 *JS415 413:FLAG(LEVEL)=0 SET(LEVEL)=CA PSET(0) PQ(122,12,2) PPJ(8,95,13)unlessMCSWITCH=1 M10=0 M13=0 ->1 415:PSET(LINE) PSET(LEVEL) PPJ(8,68,13) N=3 *EXIT1 SW(15):*JS3 ! END OF PRGAM PERM=0 KKK=1 ->50 SW(16):*SET38P: !LIST *=Q14 *M0M14 *=Q15 *C15 *E421 *- *J1=Z LISTFLAG=1 ->1 SW(17):COPYTAG(A(2)) ![NAME][+'] [CONST] [)] [:] ifTYPE=5andI=LEVELthen->29 FAULT(4) ->1 29:KK=K M10=0 M13=0 KKK=A(5) ifA(3)=2thenKKK=-KKK ifST(KK)<=KKK<=ST(KK+1)andA(4)=1then->30 FAULT(5) ->1 30:**CA **@@ST(KK+2) **KKK **ST(KK) *- *=M15 *=M14 *SHL24 *M14M15H *J31=Z FAULT(6) *ERASE ->1 31:*=M14M15H ->1 SW(18):Q=1 ![%SWITCH] [SWITCH LIST] [S] 28:P=Q+2 25:ifA(P)=2then->24 P=P+2 ->25 24:P=P+1 ifA(P+1)#1orA(P+4)#1then->1811 KKK=A(P+2) ifA(P)=2thenKKK=-KKK KK=A(P+5) ifA(P+3)=2thenKK=-KK ->1807ifKK35 1807:FAULT(27) KK=KKK JJ=N0+2 35:QQ=Q+1 27:K=A(QQ) TESTNST R=N TYPE=5 J=0 N=N0 STORETAG(K) STORENAME N=R cycleI=N0+2,1,JJ+2 ST(I)=0 repeat ST(N0)=KKK ST(N0+1)=KK R=JJ-N0 N0=JJ+2 JJ=N0+R ifA(QQ+1)=2then->26 QQ=QQ+2 ->27 26:Q=P+6 ifA(Q)=2then->1 ->28 1811:FAULT(18) KK=0 JJ=N0+2 KKK=0 ->35 SW(19):QU=1 ![COMPILE QUERIES] [S] ->1 SW(20):QU=0 ! [IGNORE QUERIES] [S] ->1 SW(21):MCSWITCH=1 ! [%MCODE] OVERFLAG=0 PERM=1 ->1 SW(28):MCSWITCH=0 ! [%END %OF %MCODE] OVERFLAG=1 PERM=0 ->1 SW(22):comment [N][P][:] ifMCSWITCH=0thenFAULT(32) ifSL(A(2))#0thenFAULT(33) SL(A(2))=CA M10=0 M13=0 ifLFLAG=1then->1 WRITE(LINE,5) SPACES(3*LEVEL) WRITE(A(2),2) PRINTSYMBOL('P') PRINTSYMBOL(':') DPCA NEWLINE ->1 SW(23):P=2 ![*] [UCI] [S] ifMCSWITCH=0thenFAULT(32) MCSWITCH=1 CUCI M10=0 M13=0 ->1 SW(24):comment "%FAULT" [FAULT LIST] ifLEVEL=2then->2401 FAULT(26) ->1 2401:P=2 Q=P+1 2402:ifA(Q)=2then->2403 Q=Q+2 ->2402 2403:K=A(Q+1) PSET(A(P)) PPJ(8,84,13) STOREJUMP PJ(8,0,11) M13=0 P=P+2 ->2403ifA(P-1)=1 ->1ifA(P+1)=2 P=P+2 Q=P+1 ->2402 SW(25):LISTFLAG=0 ![%ENDOFLIST] ->1 SW(26):*DC3 ![STRINGS] ->1 SW(27):NEWLINES(2) ![%ENDOFPERM] LINE=-1 *JS2701 ->SW(28) 2701:POPUP2(JUMP(LEVEL),J,K) ifJ=-1then->2702 I=J FINDLABEL ifJ#-1then->2703 FAULT(11) WRITE(K,1) NEWLINE ->2701 2703:FILLLABEL(I,J) ->2701 2702:POPUP2(LABEL(LEVEL),J,K) ifJ#-1then->2702 *EXIT1 SW(29):comment [%DEFINE %COMPILER ][S] LINE=-1 COMPILER=0 *ZERO *=E445 *SET5 *=E444 *JS70 *JS46P INITIALISE *E425 *=M0M0H **PPCURR *=Q13 *M13 *=+I13 *M0TOQ13 *Q13 **=PPCURR *E419 *E441 *- *J1=Z *SET1 *=C15 *E446 *JS25P *ZERO *OUT 70:*SET94P: *=RM13 *E7 *=M0M13 ! DATE *M0TOQ13 *J71EN 72:*=E102M13Q *J72NEN 71:*C13 *NEG *=E101 *ZERO *=RM13 *J73EJ 74:*LINK *=E119M13Q *J74NEJ 73:*C13 *NEG *=E118 *SET15 *=RC14 *Q15 *Q14 *Q13 *Q12 *Q11 *Q10 *Q9 *Q8 *Q7 *Q6 *Q5 *Q4 *Q3 *Q2 *Q1 75:*=E135M14Q *J75C14NZ *ZERO NEWLINE cycleI=1,1,8 *SHL6 79:READSYMBOL(J) ->79ifJ=10orJ=32 PRINTSYMBOL(J) **J *SET32 *- *SET63 *AND *OR repeat ! TAPE IDENTIFIER NOW IN NS 80:*E384 *=Q15 *BUSYQ15 *J80TR NEWLINE *SET101 *DUP *=M13 *DUP *M12 *REV *- *=RC14 *ZERO *ZERO * 76:*M13M14Q * *STR *+D *J76C14NZS *=M13M14Q *=M13M14 *M+I12 *=I12 *SET4 *DUP *=M15 *OUT ! PICK UP TAPE *DUP *=C15 *=C12 *PMDQ15 *PMAQ15 *POAQ12 *I12=+1 ! DUMP 101 TO WS + 1 *PMEQ15 *PARQ15 *J77NTR caption\PARITY_FAILURE ->78 77:*C15 *SET6 *OUT ! DEALLOCATE NEW COMPILER caption\COMPILER_DEFINED\ 78:WRITE(NUM,4) WRITE(NEXT,4) WRITE(N0,4) *I9 **=I WRITE(I,4) *M12 **=I WRITE(I,4) NEWPAGE *SET38P: *=M13 *M0M13 *SHL-32 *SET6 *OUT *ZERO *OUT SW(31):ABC=1 ->1 ! [COMPILE ARRAY BOUND CHECKS] SW(32):ABC=0 ->1 ! IGNORE ARRAY BOUND CHECKS SW(33):->1 ! [S] SW(30):->62 ! END OF PACK SW(13):M10=0 M13=0 ![*][*][*][A][S] 10/12/65 FOR ISO VERSION begin integerI,J,K,N,N0',TAPE,ZEROTAPE,N',FLAG,PFLAG realTL,A' switchS(0:10) routinespecREADKEYWORD routinespecREADSYM routinespecINITIALOUTPUT ->77 * 62P:*165134/127722/16045 !ZEROTAPE *2701/43532/22756 !KEYWORDS IN *10014/101322/150262 !FIVE BIT CODE *1573/60226/13101 !A=1 B=2 ETC *5170/100000/0 *12014/5000/0 *7655/20532/0 *10014/5440/0 ! PAPER *11673/160000/0 *10010/153122/0 *1414/104000/0 ! CARD 77:*SET62P: *=M15 *M0M15 **=ZEROTAPE *E423 **=FLAG PFLAG=0 *SET+1 *SET89P: *=M10 *SET+18 *=RC13 * 4:*NEG *DUP *=M10M13Q * *J4C13NZS *ERASE *ZERO *=M0M10 ->2 1:->2ifLINE<20 INITIALOUTPUT caption\\FAULTY_JOB_HEAD stop 2:READKEYWORD ->S(K) S(9):PFLAG=1 ->3 S(0):comment KEY WORD UNKNOWN 3:->1ifI=10 READSYMBOL(I) ->3 S(1):comment EXECUTION READ(TL) READSYM ->3unlessI=77orI=83 ifI=77thenTL=60*TL TIMELIMIT=INT(TL) ->3 S(2):comment PARAMETER READSYM ->3unlessI=42 N=0 N'=0 cycleJ=1,1,4 ! UNSCRAMBLE PARAMETER READSYM ->3unless48<=I<=55 ->21ifJ=4 N=8N+I-48 N'=N'+I ->22 21:**I **N' *- *SHL+45 *J3#Z 22:**I READSYM **I *NEV **J *- *J3#Z repeat **N *SET89P: *=M13 *=M0M13 ->3 S(7):comment PAPER *E420 *J7001>Z *ZERO *OUT 7001:*E438 *J7002<=Z *E438 *SET6 *OUT *SET-2 *=E438 7002:*ZERO *=E439 7003:*JS46P INITIALISE ->99 S(10):*E438 *J10001>Z *SET4 *SET5 *OUT *=E438 10001:*SET1 *=E439 ->7003 S(8):comment SWOP begin *E420 *SET7 *- *J2>=Z *E420 *SET6 *OUT *SET2 *SET5 *OUT *DUP *=E420 *DUP *SET35P: *JS1 *SET44P: *JS1 ->2 1:*=M14 *M0M14 *=Q15 *=C15 *Q15 *=M0M14 *EXIT1 2:end ->99 S(3):!COMPILERAAORAB READSYM ->3001ifI=66 ->3unlessI=65orI=76 3002:READSYM ->3003unlessI=10 LINE=-1 INITIALOUTPUT ->99 ! TO END OF JOB HEAD BLOCK 3001:READSYM ->3003unlessI=67 ABC=1 DIAGS=1 ->3002 3003:LINE=21 ->3 S(4):comment JOB 43:READSYM ->43unlessI=10andNEXTSYMBOL#10 *SET92P: *DUP *DUP cycleJ=1,1,10 *NOT *NEG *DUP *ZERO cycleK=40,-8,0 READSYMBOL(I) ->41unlessI=10 J=10 ->42 41:**I **K *=C13 *SHLC13 *OR repeat 42:*REV *=M13 *=M0M13 repeat *PERM *=M13 *- *DUP *NOT *NEG *SHL40 *OR *=M0M13 ->3 S(5):comment TAPE TAPE=1 51:READKEYWORD ->S(K)unlessTAPE=1 *ZERO cycleJ=42,-6,0 READSYM I=I-32 !REDUCES TO KDF9 EQUIVALENT ->3unless16<=I<=58 **I **J *=C13 *SHLC13 *OR repeat **ZEROTAPE *J54# *ERASE *ZERO 54:READSYM *SET89P: **N *DUP *+ *+ *=M13 *=M0M13 *SET+1 ->52unlessI=42 !WRITE PERMIT *NEG 52:*=M0M13N 53:->51ifI=10 READSYMBOL(I) ->53 S(6):comment OUTPUT 61:READSYM ->61ifI=10 ->3unless48<=I<=57orI=79 ! ZERO OR LETTER O READSYM ifI='7'orI='E'orI='8'thenI='S' J=I ifFLAG=1thenJ='L' ifFLAG=-1thenJ='S' FLAG=FLAG-1ifI='S' 63:K=NEXTSYMBOL if'0'<=K<='9'then->62 SKIPSYMBOL ifK='\'then->1 ->63 62:READ(A') N=INT(A') READSYM ifI='B'andJ='S'thenN=N*4096 ifI='B'andJ='L'thenN=N*200 ifI='L'andJ='S'thenN=N*60 ifJ='S'andN<4096thenN=4096 ifJ='L'andN<200thenN=200 **N *=E434 ->3 routineREADSYM 1:READSYMBOL(I) ->1ifI=32 end routineREADKEYWORD 1:READSYM ->1ifI=10 LINE=LINE+1 ->8if49<=I<=56 TAPE=0 2:*ZERO cycleJ=40,-5,0 **I *SET64 *- *DUP *SHL-5 *J4#Z **J *=C13 *SHLC13 *OR *SET62P: *=RM15 cycleK=1,1,10 *M0M15QN *J6= repeat READSYM repeat *ZERO 4:*ERASE K=0 6:*ERASE ->10 8:N=I-48 9:K=0 10:end routineINITIALOUTPUT ->1ifFLAG<0 *JS98P ->2 1:*E421 *J3>Z *SET1 *SET5 *OUT *=E421 3:*JS99P 2:*SET92P: *I11 *- *JS3P ->4ifDIAGS=1 caption_____COMPILED_IN_OPTIMISING_MODE ->5 4:caption_____COMPILED_IN_DIAGNOSTIC_MODE 5:NEWLINES(2) end 99:**PFLAG *NEG *=E443 end ! END OF JOB HEAD BLOCK ->1 routineCRSPEC(integerM) integerKK,JJ,Q,JJJ,KKK switchFPD(1:8) P=A(2)+5 KK=A(4-M) COPYTAG(KK) ifM#2then->11 ifI=LEVELand6<=TYPE<=10then->33 FAULT(3) ->1 11:->32ifI#LEVEL ->33ifTYPE=P 34:FNAME=KK FAULT(7)unlessTYPE=0 ->32 33:FROMLIST2(ST(K),JJ,Q) ifQ#1000then->34 POPUP2(ST(K),JJ,Q) ->35 32:JJ=NR NR=NR+1 NEWCELL(K) J=15 TYPE=P R=N N=K STORETAG(KK) N=R R=K K=KK STORENAME K=R 35:JJJ=K Q=0 ifA(5-M)=2then->36 P=4-M 37:P=P+2 ->FPD(A(P)) FPD(1):TYPE=A(P+1)+5 P=P+1 ->38 FPD(2):TYPE=4 ->38 FPD(3):TYPE=12 ->38 FPD(4):TYPE=2 ->38 FPD(5):TYPE=3 P=P+1 ->38 FPD(6):TYPE=11 ->38 FPD(7):TYPE=1 ->38 FPD(8):TYPE=14 38:P=P+2 if6<=TYPE<=10then->101 INSERTAFTER2(K,TYPE,0) 102:Q=Q+1 ifA(P)=1then->38 P=P+1 ifA(P)=1then->37 36:PUSHDOWN2(ST(JJJ),JJ,Q) ->1 101:INSERTAFTER2(K,TYPE,NR) NR=NR+1 ->102 1:end routineCUI integerKK,Q switchSW(1:10) ->SW(A(P)) SW(1):comment [NAME] [APP] [SET MARKER 1] [REST OF UI] ifA(MARKER1)=1then->3 P=P+1 CNAME(0) P=P+1 ->1 3:Q=P+1 COPYTAG(A(Q)) P=MARKER1+1 KK=PARITY(TYPE) ->20unlessTYPE=0orKK=-1 CSEXP(1) ->21 20:CSEXP(2) 21:unlessA(P)=1=QUthen->2 ifKK=1thenPJ(8,SL(20),13) ifKK=-1thenPJ(8,SL(21),13) M13=0 2:KK=P P=Q CNAME(1) P=KK+1 ->1 SW(2):comment [->] [N] K=A(P+1) STOREJUMP PJ(8,0,11) P=P+2 ->1 SW(3):comment [%CAPTION ] [CAPTION TEXT] PSET(A(P+1)) PPJ(8,3,13) M13=0 P=P+2 ->1 SW(4):comment [%RETURN ] unlessFLAG(LEVEL)=6orPERM=1thenFAULT(30) P=P+1 6:PQ(105,LEVEL,12) PQ(64,12,0) PQ(120,LEVEL,2) PPJ(8,67,13)ifDIAGS=1 PJ(8,SL(4),11) ->1 SW(5):comment [%RESULT = ] [+'] [OPERAND] [REST OF EXPR] unless7<=FLAG(LEVEL)<=10thenFAULT(31) P=P+1 ifFLAG(LEVEL)=7then->5 CSEXP(2) ->6 5:CSEXP(1) ->6 SW(6):comment [%STOP ] PJ(8,SL(6),11) P=P+1 ->1 SW(7):comment [->] [NAME] [(] [+'] [OPERAND] [REST OF EXPR] [)] COPYTAG(A(P+1)) KK=K unlessTYPE=5andI=LEVELthenFAULT(4) P=P+2 CSEXP(2) PSET(KK) PPJ(8,7,11) ->1 SW(8):comment "%MONITOR " [N] PSET(A(P+1)) PJ(8,SL(90),13) P=P+2 M10=0 M13=0 ->1 SW(9):->SW(6)ifDIAGS=0 ! MONITORSTOP PPJ(8,24,11) P=P+1 1:end ***A SWOP routineCSEXP(integerZ) comment DATED 5/8/65 - FOR VER 4G WITH NEW PHRASE STUCTURE comment Z=1 FOR REAL, Z=2 FOR INTEGER, Z=3 FOR INTEGER IF POSSIBLE integerC,D,J,M,Q',N0',LC,TSF,Z',USENEST,NESTED integerarrayOP(0:5) switchS1(1:4) routinespecPRINTORDERS USENEST=0 NESTED=0 ->53ifA(P+1)=2andA(P+2)=1andA(P+4)=2 comment SINGLE SHORT CONSTANT comment IF DFLAG = 0 THEN AFLAG = 0, DFLAG + 1 **DFLAG *DUP *J199#Z AFLAG=0 199:*NOT *NEG **=DFLAG ->201ifDFLAG>2 ->201ifA(P+1)=1andA(P+3)=2andA(P+4)=2 FFLAG=0 C=P SKIPEXP P=C USENEST=1ifFFLAG=0 201:10:N0'=N0 TSF=2 comment Q', D, M, LC, OP(0) ALL TO 0 *ZERO *DUP *DUPD **=Q' **=D **=M *DUP **=LC **=OP(0) ->1unlessA(P)=2 OP(1)=13 Q'=1 1:P=P+2 Q'=Q'+1 comment P TO OPERAND + 1 ->S1(A(P-1)) S1(1):comment P TO [NAME] ->2ifA(P+1)=1 COPYTAG(A(P)) ->2unlessTYPE=1orTYPE=2orTYPE=11orTYPE=12 ST(N0)=TYPE ST(N0+1)=I ST(N0+2)=K N0=N0+3 P=P+3 ->20 comment R OF E + 1 2:CNAME(2) ->6 S1(2):comment P TO [CONST] TYPE=A(P)-1 ST(N0)=TYPE ST(N0+2)=A(P+1) ->5ifTYPE=0 ST(N0+1)=13 LC=1 5:N0=N0+3 P=P+3 ->20 comment P = R OF E + 1 S1(4):M=1 comment ! EXPR ! S1(3):Z'=3 Z'=2ifZ=2orOP(Q'-1)=15 CSEXP(Z') ifTYPE=0thenTYPE=2 comment NUT MIGHT WRITE (0) ->6unlessM=1 PN(26-2*TYPE) M=0 6:P=P+1 ->35ifA(P-1)=2andQ'=1and(Z#2orTYPE=2) ST(N0)=TYPE+2 ->301ifUSENEST=0orNESTED>=3 NESTED=NESTED+1 ST(N0+1)=NESTED PN(53)ifNESTED=2 ! REV PN(10)ifNESTED=3 ! PERM N0=N0+3 ->20 301:ST(N0+1)=0 N0=N0+3 PQ(67,12,0) D=D+1 20:->21unlessTYPE=1orTYPE=11 TSF=1 ifZ=2thenFAULT(24) ifOP(Q'-1)=15thenFAULT(39) 21:->30ifA(P-1)=2 OP(Q')=T(A(P)) if(OP(Q')=9orOP(Q')=15)andZ#2thenTSF=1 22:ifOP(Q')>OP(Q'-1)+1then->1 ST(N0)=OP(Q'-1) N0=N0+3 OP(Q'-1)=OP(Q') Q'=Q'-1 ->22 30:MOVEM(12,-D) **LC *J32=Z ->32ifM13=-1 PQ(121,11,4) PQ(120,13,2) M13=-1 32:cycleJ=Q'-1,-1,0 ST(N0)=OP(J) N0=N0+3 repeat PRINTORDERS MOVEM(12,-D) TYPE=TSF 35:->50unlessZ=1andTYPE=2 PQ(121,1,4) PN(20) TYPE=1 50:ifN0>N0'+6thenAFLAG=1 ifAFLAG*DFLAG*OVERFLAG=1thenPJ(9,SL(8),8) DFLAG=DFLAG-1 N0=N0' ->60 comment END 53:comment SHORT CONSTANT **A(P+3) *DUP *J55#Z **=TYPE P=P+5 PN(33) ->60 55:->56unlessA(P)=2 *NEG 56:TYPE=2 *DUP **=C P=P+5 *NEG *NOT *J111=Z PSET(C) 112:->60unlessZ=1 PQ(121,1,4) PN(20) TYPE=1 ->60 comment END 111:PQ(121,12,4) ->112 routinePRINTORDERS switchS(0:15),S'(0:2) integerC,N',N,CELLS,M CELLS=0 cycleJ=N0',3,N0-6 N=ST(J) ->S(N) S(0):C=ST(J+2) N'=ST(J+3) ! SHORT CONSTANT ->S'(C)ifC<3and(N'=5orN'=6)andTSF=2 CELLS=CELLS+1 ->1ifC=2andN'=15 ->2ifN'=13 ->3 S'(2):PN(47-4N') PN(3+4N') S'(1):PN(47-4N') PN(3+4N') S'(0):ST(J+3)=14 ->12 1:ST(J+3)=8 PN(34) ->12 2:ST(J+3)=14 C=-C 3:N=2 PSET(C) ->9 S(1):S(2):CELLS=CELLS+1 PMS(0,ST(J+2),ST(J+1)) ->9 S(11):S(12):CELLS=CELLS+1 N=N-10 M=1000ST(J+1)+ST(J+2) ->1101ifM=M10 ->1102ifM=M13 PMS(0,ST(J+2),ST(J+1)) PQ(120,10,2) 1101:PQ(64,10,0) M10=M ->9 1102:PQ(64,13,0) ->9 S(3):S(4):N=N-2 C=CELLS CELLS=CELLS+1 ->401ifST(J+1)=0 M=ST(J+3) ->9ifC=0 ->402ifC=2 ->403ifC=3 ifC>=4thencaption_CSEXP_CLANG_ 405:->407ifTSF=1andN=2 ->12ifM=5orM=8 407:PN(53) ->9 ! REV 402:PN(54) ->9 ! CAB 403:PN(10) PN(41) ->405 ! PERM REND 401:PQ(66,12,0) ->9 S(5):CELLS=CELLS-1 PN(74-14*TSF) ->12 S(6):CELLS=CELLS-1 PN(92-31*TSF) ->12 S(8):CELLS=CELLS-1 PN(24*TSF-20) ifTSF=2thenPN(40) ->12 S(9):CELLS=CELLS-1 PN(64-14*TSF) ifTSF=2thenPJ(8,SL(9),6) ->12 S(13):PN(27-2*TSF) ->12 S(15):M10=0 M13=0 CELLS=CELLS-1 PJ(8,SL(80+TSF),13) ->12 9:->12unlessTSF=1andN=2andST(J+3)#15 PQ(121,1,4) PN(20) 12:S(14):repeat end 60:end comment END OF CSEXP routineCCOND comment DATED 4/6/65 - FOR VER 4G WITH NEW PHRASE STRUCTURE comment COVERS [SC] [REST OF COND] integerC,T routinespecCCC routinespecCSC routinespecCCOMP(integerC) DFLAG=DFLAG+1 ifDFLAG=1thenAFLAG=0 T=0 CCC ifAFLAG*DFLAG*OVERFLAG=1thenPJ(9,SL(8),8) DFLAG=DFLAG-1 ->99 routineCCC comment T =0 FOR COND, T = 1 FOR AND-C, T=2 FOR OR-C integerLINE CSC C=A(P) P=P+1 ->1unlessT=0 T=C C=C-1 1:->10ifC=2 PN(34) LINE=CA PJ(7+T,0,6) PN(42) CCC FILLLABEL(LINE,CA) M10=0 M13=0 10:end routineCSC integerLINE1,LINE2 ->1ifA(P)=1 P=P+1 CCOND ->9 1:P=P+1 CSEXP(3) CCOMP(1) comment P TO R OF SC P=P+1 ->9ifA(P-1)=2 LINE1=CA PJ(8,0,6) CCOMP(2) LINE2=CA PJ(8,0,11) FILLLABEL(LINE1,CA) PN(42) PQ(121,12,4) FILLLABEL(LINE2,CA) M10=0 M13=0 9:end routineCCOMP(integerC) comment C=1 FIRST TIME, C=2 ON SECOND ENTRY integerT1,COMP,CTYPE switchS(1:7) T1=TYPE COMP=A(P) P=P+1 ifCOMP>4thenCOMP=11-COMP CSEXP(3) ->1unlessC=1=A(P) PN(34) PN(10) 1:CTYPE=31 ifT1=1orTYPE=1thenCTYPE=63 ->3unlessT1*TYPE=2 ->2ifT1=1 PN(53) COMP=8-COMP 2:PQ(121,1,4) PN(20) 3:PN(CTYPE) ->S(COMP) S(4):PN(22) S(3):PN(23) PN(27) ->4 S(6):PN(23) S(2):PSH(116,-1) ->4 S(5):PN(27) PN(23) S(1):S(7):4:end comment P TO 1 AFTER SEXP 99:end comment END OF CCOND routineCNAME(integerZ) integerJJ,KK,TYPE',RR,QQ,JJJ,II,Q,QQQ,PP switchSW(0:12),FPT(1:14) COPYTAG(A(P)) ifI#-1then->3 FNAME=A(P) FAULT(16) I=LEVEL J=0 K=A(P) TYPE=0 STORETAG(K) STORENAME K=N N=N+1 3:JJ=J ifJJ=15thenJJ=0 ifZ#0then->SW(TYPE) ifTYPE=6then->SW(7) FAULT(17)unlessTYPE=0 ->SW(0) SW(5):comment %SWITCH FAULT(20) SW(0):comment NAME NOT SET P=P+1 11:TYPE=2 ifA(P)=2then->6 ->102 SW(3):comment %REAL %ARRAY SW(4):comment %INTEGER %ARRAY TYPE'=TYPE KK=K RR=I PP=P P=P+1 ifA(P)=1then->16 FAULT(19) P=P+1 ->10 16:Q=0 17:P=P+1 Q=Q+1 ifJJ=1andABC=0andA(P+1)=2andA(P)=3andA(P+2)=1andA(P+4)=2andA(P+5)=2then->311 CSEXP(2) ifA(P)=1then->17 ifJJ#0then->2 JJ=Q COPYTAG(A(PP)) J=JJ REPLACETAG(A(PP)) 2:P=P+1 ifQ=JJthen->18 FAULT(19) ->10 311:QQ=1000RR+KK ->313ifQQ=M13 PMS(0,KK,RR) PQ(120,13,2) 313:M13=QQ ->312ifZ=3 PMS(2-Z,A(P+3),13) ! ENM13 P=P+6 ->10 312:PSET(A(P+3)) P=P+6 ->307 18:QQ=1000RR+KK ->321ifQQ=M13 M13=0 PMS(0,KK,RR) ifABC=1then->303 ifQ=1then->301 ifQ=2then->302 303:PPJ(8,69,13) ->10ifZ=3 PQ(120,13,2) ! =M13 304:PQ(66-Z,13,0) ! ='M0M13 10:TYPE=TYPE'-2 ->1 301:PN(46) !*+ PQ(120,13,2) ! =M13 305:->304ifZ#3 PQ(121,13,2) ->10 302:PQ(120,13,14) PQ(122,13,2) PQ(121,13,4) PN(28) PN(40) 307:PQ(122,13,2) !*=+M13 M13=0 ->305 321:M13=0 ->307 SW(6):comment %ROUTINE IN EXPRESSION FAULT(23) ->SW(0) SW(7):comment %REAL %FN AND %ROUTINE SW(8):comment %INTEGER %FN SW(9):comment %REAL %MAP SW(10):comment %INTEGER %MAP TYPE'=TYPE 20:JJ=K FROMLIST2(ST(JJ),RR,K) P=P+1 ifI#1orRR>=2then->400 ifA(P)=2then->402 411:Q=P ifA(P+1)=3andA(P+2)=1then->412 413:FAULT(22) P=Q 415:P=P+1 SKIPEXP ifA(P)=1then->415 ->414 412:P=P+3 CNAME(3) ifA(P)=1then->413 P=P+1 ifRR=1then->401 PSET(TYPE) PJ(8,SL(12),13) M10=0 M13=0 ifA(P)=1then->411 414:P=P+1 ->1 401:TYPE=2 ifA(P)=2then->414 FAULT(19) P=Q ->415 400:if2<=RR<=NLIBandRA(RR)=0thenRA(RR)=1 ifK#1000then->21 FAULT(21) ->11 21:ifA(P)=1then->22 ifK=0then->37 402:FAULT(19) P=P+1 TYPE=2 ->1 22:ifK#0then->24 FAULT(19) ->11 24:Q=0 MOVEM(12,3)unlessK=1 KK=K QQ=0 26:LINK(JJ) FROMLIST2(ST(JJ),TYPE,JJJ) P=P+1 ->FPT(TYPE) FPT(1):comment %REAL CSEXP(1) ->27 FPT(2):comment %INTEGER CSEXP(2) ->27 FPT(6):comment %ROUTINE FPT(7):comment %REAL %FN FPT(8):comment %INTEGER %FN FPT(9):comment %REAL %MAP FPT(10):comment %INTEGER %MAP QQQ=P unlessA(P)#3orA(P+1)#1orA(P+3)#2orA(P+4)#2then->28 33:P=QQQ SKIPEXP 29:FAULT(22) ->32 28:II=TYPE FNAME=A(P+2) COPYTAG(FNAME) ifI=-1thenFAULT(16) P=P+5 ifII=TYPEthen->31 FAULT(22) ->32 31:J=K FROMLIST2(ST(J),I,K) if2<=I<=NLIBandRA(I)=0thenRA(I)=1 PMS(0,I,11) PMS(1,JJJ,11) ->32 FPT(11):comment %REAL %NAME FPT(12):comment %INTEGER %NAME FPT(14):comment %ADDR II=TYPE-10 QQQ=P ifA(P)#3orA(P+1)#1then->33 P=P+2 CNAME(3) ifA(P)=1then->33 P=P+1 ifII=TYPEorII=4then->27 ->29 FPT(3):comment %REAL %ARRAY %NAME FPT(4):comment %INTEGER %ARRAY %NAME II=TYPE QQQ=P ifA(P)#3orA(P+1)#1orA(P+3)#2orA(P+4)#2then->33 FNAME=A(P+2) COPYTAG(FNAME) ifI=-1thenFAULT(16) unlessII=TYPEthenFAULT(22) PMS(0,K,I) P=P+5 27:->2701ifKK=1 PQ(67,12,0) QQ=QQ+1 ->32 2701:PMS(1,3,12) 32:Q=Q+1 ifQ=KKandA(P)=2then->35 ifA(P)=1then->36 FAULT(19) ->41 36:ifQ26 FAULT(19) 40:P=P+1 SKIPEXP ifA(P)=1then->40 ->41 35:MOVEM(12,-QQ-3)unlessKK=1 37:PMS(0,RR,11) PJ(8,SL(1),13) M10=0 M13=0 41:P=P+1 ifTYPE'=6then->1 if7#TYPE'#8then->201 TYPE=TYPE'-6 ifZ#2thenFAULT(29) ->1 201:TYPE=TYPE'-8 ifZ=3then->1 PPJ(8,65,13)ifABC=1=ZandMCSWITCH=0 PQ(120,13,2) PQ(66-Z,13,0) ->1 SW(1):comment %REAL SW(2):comment %INTEGER CMOD(1,Z) ->9 SW(11):comment %REAL %NAME SW(12):comment %INTEGER %NAME TYPE=TYPE-10 CMOD(0,Z) 9:P=P+1 ifA(P)=2then->6 FAULT(19) 102:P=P+1 SKIPEXP ifA(P)=1then->102 6:P=P+1 1:end routineCMOD(integerN,Z) integerQ switchSW(1:6) Q=1000I+K ->SW(3N+Z) SW(1):SW(2):->7ifM13=Q ->8ifM10=Q PMS(0,K,I) PQ(120,13,2) 7:PQ(66-Z,13,0) M13=Q ->1 8:PQ(66-Z,10,0) ->1 SW(3):SW(5):PMS(0,K,I) ->1 SW(4):PMS(1,K,I) ->1 SW(6):PSET(K) PQ(121,I,2) PN(46) 1:end routineFAULT(integerN) PRINTSYMBOL(42) WRITE(LINE,4) SPACES(3*LEVEL) captionFAULT_ WRITE(N,2) ifFAULTY=1then->2 *E418 *=RC15 *E444 *=M15 *PMEQ15 *ZERO *=E444 *E435 *SET1 *=C15 *JS25P stopunlessLFLAG=0 2:FAULTY=1 ->3ifN=28 ->1if7#N#16 3:SPACE PRINTNAME(FNAME) 1:NEWLINEunlessN=11 end routinePRINTNAME(integerI) integerJ,K,N J=WORD(I) **LETT(J) *ZERO *SHLD+8 *SET4 *- *DUP **=N *J4>Z ->2 1:J=J+1 **LETT(J) N=N-6 ifN<=0then->2 4:*ZERO *SHLD+8 *DUP *J3#Z *ERASE *ERASE *J1 3:**=K PRINTSYMBOL(K) ->4 2:*SET+1 **N *- *SHL+3 *=C13 *SHLC13 5:*ZERO *SHLD+8 *DUP *J6#Z *ERASE *ERASE return 6:**=K PRINTSYMBOL(K) ->5 end routineTESTNST **K *DUP **=FNAME **I **J **TYPE COPYTAG(K) ifI=LEVELandTYPE#0thenFAULT(7) 1:**=TYPE **=J **=I **=K end routineCUCI integerQ,I,J,RR,TT,AP switchEE(1:10),E(97:103) AP=A(P) ifAP<=10then->EE(AP) ifAP<=18then->101 ifAP>=97then->E(AP) if90<=AP<=94then->61 if28>=APthen->71 ->51 EE(1):comment [*] [@@] [NAME] [APP] P=P+1 CNAME(3) ->9 EE(2):comment [*] ['] [NAME] [APP] P=P+2 CNAME(A(P-1)) ->9 EE(3):comment [J] [N] [P'] [J-INSTR] ifA(P+2)=1then->10 K=A(P+1) STOREJUMP K=0 11:P=P+3 ->21 10:K=SL(A(P+1)) FAULT(33)ifK=0 ->11 21:ifA(P)>=2then->22 POPUP2(JUMP(LEVEL),J,K) comment JRCQNZS PQ(127,A(P+1),0) ->9 * 53P:*0/5400/144 ! JRCQNZ *0/5000/144 ! JRCQZ *0/4400/6 ! JR=Z *0/4400/1 ! JR= *0/4000/6 ! JR#Z *0/4000/1 ! JR# *0/4400/4 ! JR>Z *0/4000/2 ! JR>=Z *0/4400/2 ! JR9 EE(4):![SETB][OCTAL] PSET(A(P+1)) ->9 EE(5):![SET][N][P][:] PSET(SL(A(P+1))) ->9 EE(6):comment [JS] [N] [P'] ifA(P+2)=1then->12 K=A(P+1) STOREJUMP PJ(8,0,13) ->9 12:PPJ(8,A(P+1),13) ->9 EE(7):**A(P+1) *DUP *NOT *SET1 *AND *SHL14 *REV *SHL-1 *OR **=RR ! [EXIT] [N] PJ(8,RR,15) ->9 EE(8):comment [='] [M] [N] [M] [N] [MS-INSTR] I=0 ifA(P+1)=1thenI=1 Q=A(P+3) K=A(P+2) P=P+4 ->31 * 55P:*0/47000/106 ! MKMQQHN+MKMQQH *0/45000/102 ! MKMQQN+MKMQQ *0/46000/104 ! MKMQHN+MKMQH *0/44000/100 ! MKMQN+MKMQ 31:*SET55P: *=M15 **A(P) *NEG *NOT *=M14 *M15M14H *SHL-24 **I *+ **=I PQ(I,Q,K) ->9 * 56P:*0/70400/162 ! SHA (N OR CQ) + SHAD (N OR CQ) *0/72000/166 ! SHL (N OR CQ) + SHLD (N OR CQ) *0/73400/0 ! SHC (N OR CQ) EE(9):P=P+1 35:*SET56P: *=M15 **A(P) *NEG *NOT *DUP *SET5 *- *DUP *J36>=Z *REV 36:*=M14 *M15M14H *SHL-24 **=I *J1001>=Z 1000:K=A(P+2) ifA(P+1)=2thenK=-K PSH(I,K) ->9 1001:PQ(I,A(P+1),0) ->9 * 57P:*0/74000/16 ! =QQ *0/74000/10 ! =CQ *0/74000/4 ! =IQ *0/74000/2 ! =MQ *0/74000/11 ! =RCQ *0/74000/5 ! =RIQ *0/74000/3 ! =RMQ *0/75000/16 ! =+QQ *0/75000/10 ! =+CQ *0/75000/4 ! =+IQ *0/75000/2 ! =+MQ *0/52000/4 ! TLOQQ *0/56000/2 ! INTQQ *0/50400/0 ! PARQQ *0/50000/2 ! BUSYQQ *0/50000/1 ! MANUALQQ *0/74400/16 ! QQ *0/74400/10 ! CQ *0/74400/4 ! IQ *0/74400/2 ! MQ *0/61000/0 ! NCQ *0/61400/0 ! DCQ *0/71400/0 ! X+CQ EE(10):P=P+1 41:ifA(P)#1then->42 PQ(124,0,0) ->9 !=LINK 42:*SET57P: *=M15 **A(P) *SET2 *- *=M14 43:*M15M14 *ZERO *SHLD+24 **=I *SHL-24 **=J 2:PQ(I,A(P+1),J) ->9 * 63P:*0/67400/154 !QK OR CK TO QQ *0/65000/151 !IK OR MK TO QQ *0/65400/155 !IMK ORCMK TO QQ *0/67000/0 !CIK TO QQ 101:*SET63P: *=M15 **AP *SET11 *- *=M14 *M15M14H *SHL-24 *DUP *J102=Z **=I J=A(P+2) ->2 102:*ERASE comment [I] [N] [=] [+'] [N] K=A(P+3) I=0 ifA(P+2)=2thenK=-K ifK=1thenI=4 ifK=-1thenI=5 ifK=2thenI=6 ifK=-2thenI=7 ifI=0thenFAULT(33) PQ(96+I,A(P+1),0) ->9 * 60P:*0/10400/20 ! ROUNDHF + ROUNDF *0/6000/16 ! ROUNDH + ROUND *0/12400/24 ! FLOATD + FLOAT *0/25000/51 ! ERASE + REVD *0/32400/41 ! REV + ZERO *0/21400/42 ! DUPD + DUP *0/34400/31 ! NEGDF + NEGF *0/4000/27 ! NEGD + NEG *0/14000/26 ! ABSF + ABS *0/35000/32 ! MAXF + MAX *0/37400/37 ! SIGNF + SIGN *0/33000/67 ! CAB + FRB *0/34000/63 ! STAND + /DF *0/30400/62 ! /D + /F *0/32000/44 ! /R + /I *0/30000/23 ! / + +DF *0/27400/74 ! +D + +F *0/27000/22 ! + + -DF *0/25400/75 ! -D + -F *0/17000/5 ! - + XDF *0/16000/4 ! XD + XF *0/3400/0 !X+F +X+ *0/1000/3 !=TR +BITS *0/7400/12 !DUMMY +PERM *0/5400/11 !TOB +OR *0/400/15 ! VR +NEV *0/15400/45 ! NOT + FIX *0/23400/50 ! STR + CONT *0/26000/0 ! AND (EXIT) *0/0/35 ! (OUT) + X *0/0/0 ! (I/0 INSTR) 51:*SET60P: *=M15 **AP *SET29 *- *=M14 *M15M14H *SHL-24 **=TT ifTT=0then->52 PN(TT) ->9 52:ifAP=72then->53 ifAP=86then->54 ifAP=89then->45 PJ(8,0,9) ->9 !(87)OUT 53:PSH(115,0) ->9 ! X+ 54:PJ(8,16384,15) ->9 ! EXIT 61:*SET57P: *=M15 **AP *SET79 *- *=M14 ->43 71:**AP *SET25 *J75= *SET26 *J76= *SET27 *J77= *SET28 *J78= *SET57P: *=M15 *SET3 *- *=M14 ->43 75:*ERASE PQ(123,0,0) ->9 76:*ERASE P=P+1 I=95+A(P) J=0 ->2 77:*ERASE I=115 ->1000 78:*ERASE *SET57P: *=M15 *SET22 *=M14 ->43 * 59P:*0/52000/0 ! PIAQQ *0/52400/0 ! PIBQQ *0/52000/10 ! PICQQ *0/52400/10 ! PIDQQ *0/53000/0 ! PIEQQ *0/53400/0 ! PIFQQ *0/54000/0 ! POAQQ *0/54400/0 ! POBQQ *0/54000/10 ! POCQQ *0/54400/10 ! PODQQ *0/54000/14 ! P0EQQ *0/54000/4 ! POFQQ *0/56000/0 ! PMAQQ *0/50000/10 ! PMBQQ *0/50000/4 ! PMCQQ *0/57000/10 ! PMDQQ *0/57000/0 ! PMEQQ *0/51000/0 ! PMFQQ 45:*SET59P: *=M15 TT=6A(P+1)+A(P+2)-7 **TT *=M14 *M15M14 *ZERO *SHLD+24 **=I *SHL-24 **=J 1:PQ(I,A(P+3),J) ->9 E(97):comment [SET] [+'] [N] K=A(P+2) ifA(P+1)=2thenK=-K PSET(K) ->9 E(98):comment [ADVCA] [N] cycleI=1,1,2A(P+1) PSET(0) repeat ->9 E(99):comment [OCTAL][/][OCTAL][/][OCTAL] cycleI=P+1,1,P+3 J=A(I) **J *SHL-8 **=Q PN(Q) PN(J) repeat ->9 E(100):comment [= '] [E] [N] [E-INSTR] [M] [N] [Q] I=0 J=A(P+3) unlessJ=3thenI=A(P+4) Q=2-A(P+1) ifJ=1thenQ=Q+2 PMS(Q,A(P+2),I) ->9 E(101):comment [JS] [E] [N] PJ(8,A(P+1),13) ->9 E(102):comment [J] [E] [N] PJ(8,A(P+1),11) ->9 E(103):comment 0 8:**PPCURR *=Q13 *J9C13Z PN(15) ->8 9:end routineMOVEM(integerM,N) switchS(-2:2) ->S(N)if2>=!N! PSET(N) PQ(122,M,2) ->1 S(-2):PQ(97,M,0) S(-1):PQ(97,M,0) ->1 S(2):PQ(96,M,0) S(1):PQ(96,M,0) S(0):1:end routineFINDLABEL **K **LABEL(LEVEL) *=Q15 *M15 *J13 2:*C15 **V0 *AND ->4 1:*SET-1 4:**=J *ERASE end routineCOPYTAG(integerKK) **TAGS(KK) *=Q15 *M15 *J12 1:*SET-1 *DUP *DUPD 2:**=TYPE **=I **=J **=K end routineREPLACETAG(integerKK) **TAGS(KK) *=M15 *M15 *J1>=Z *M0TOQ15 1:**K *=I15 **TYPE *SET255 *AND *SHL8 **I *SET15 *AND *SHL4 **J *SET15 *AND *OR *OR *=C15 *Q15 **=TAGS(KK) end routineFROMLIST2(integernameCELL,S1,S2) **CELL *=Q15 *M15 *J12 1:*SET-1 *DUP 2:**=S2 **=S1 end routinePOPUP2(integernameCELL,S1,S2) **CELL *=Q15 *M15 *DUP *J13 2:*SET-1 **=CELL ->3 1:*DUP **=S1 **=S2 3:end routineSTORETAG(integerKK) integerZ **TYPE *SET255 *AND *SHL8 **LEVEL *SET15 *AND *SHL4 **J *SET15 *AND *OR *OR **=Z PUSHDOWN2(TAGS(KK),Z,N) end routinePUSHDOWN2(integernameCELL,integerS1,S2) **CELL *DUP *=C15 *C15 *J1=Z *DUP *=I9 3:*=M15 *M9M15 *=C9 *=M9M15 4:**S1 *=C15 **S2 *=I15 *Q15 **=CELL ->5 1:*M0TOQ15 *ERASE ->4 5:end routineLINK(integernameSTAD) **STAD *DUP *J1<=Z *=M15 *M9M15 *=C15 *C15 1:**=STAD end routineMORESPACE captionASL_EMPTY stop end routineNEWCELL(integernameSTAD) *J1C9NZ MORESPACE 1:*C9 *DUP **=STAD *DUP *I9 *- *J2>=Z *DUP *=I9 2:*=M15 *M9M15 *=C9 *SET-1 *=M9M15 end routineRETURNCELL(integernameSTAD) **STAD *DUP *=M15 *C9 *=M9M15 *=C9 end routineINSERTAFTER2(integernameSTAD,integerS1,S2) integerI I=STAD LINK(STAD) ifSTAD=0then->1 ifSTAD=-1thenSTAD=I ->2 1:NEWCELL(STAD) **I *=M15 *M9M15 **STAD *OR *=M9M15 2:PUSHDOWN2(ST(STAD),S1,S2) end routineSKIPEXP switchSW(1:4) 3:P=P+1 ->SW(A(P)) SW(1):P=P+2 COPYTAG(A(P-1)) FFLAG=1if7<=TYPE<=10 5:P=P+1 ->1ifA(P-1)=2 SKIPEXP ->5 SW(2):P=P+3 ->1 SW(3):SW(4):P=P+1 SKIPEXP 1:P=P+1 ifA(P-1)=1then->3 end routineSTOREJUMP PUSHDOWN2(JUMP(LEVEL),CA,K) end routineSTORENAME PUSHDOWN2(NAME(LEVEL),0,K) end routinePSET(integerN) **N *DUP *ABS *NEG *NOT *J1=Z *DUP *SHL-8 *SET196 *SET3 *=C14 *JS50P ->2 1:PN(33) PN(27) *J2