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
->6ifI<N0
I=0
7:
SPLASH(4,RA(I))
I=I+100
->7ifI<NR
ST(0)=PCHSUM
SPLASH(7,ST(0))
*E419
*=RC15
*ZERO
*NOT
**=WORD(-1)
**@WORD(-1)
*DUP
*=I15
*SET341
*+
*=M15
*POAQ15
**@LETT(1)
*DUP
*=I15
*SET619
*+
*=M15
*POAQ15
*PMDQ15
caption\PROGRAM_DUMPED\COMPILING_TIME___
*SET9
*OUT
*SHL-24
*SET91P:
*=M13
*M0M13
*-
*JS2P
caption_/__
*SET3
*OUT
*SHL-24
*SET91P:
*=M13
*M0M13N
*-
*JS2P
15:
*E384
*=Q15
*BUSYQ15
*J15TR
NEWLINE
**TIMELIMIT
**PTDEV
*SET4
*=M1
*Q0TOQ11
*=C1
comment  DEVICE
*PMDQ1
comment  REWIND
*PMAQ1
! SKIP LABEL + 3 DUMMIES
**COMPILER
*J14=Z
*MANUALQ1
*ZERO
*OUT
14:
*SET8
*=I15
*SET120
*=M15
*C1TOQ15
*PIAQ15
*ZERO
*=LINK
*EXIT31
!TO LOADER
end
342:
comment  SET UP $ AND ^2
*SET+2
*=M13
*SETB401
*SHL+38
*=M13M9
*SET+3
*=M13
*SETB40544
*=C14
*SETB103755
*=I14
*SETB50421
*=M14
*Q14
*=M13M9
*ZERO
**=NUM
! NUM = 0
*ZERO
*NOT
*DUP
**=LINE
! LINE = -1
*NEG
**=NEXT
! NEXT = 1
**`A(0)
*=M15
*SET48
! '0'
*=I15
**`SYMBOL(0)
*=C15
*Q15
**=Q5
! STORE   `SYMBOL(0)/'0'/`A(0)
*I12
! * SET 1
*=RM15
*Q15
**=Q6
! STORE   `CWORD(0)/1/1
**`CC(0)
*=M15
*SET57
! '9'
*=I15
**`CLETT(0)
*=C15
*Q15
**=Q7
! STORE   `CLETT(0)/'9'/`CC(0)
**`LETT(0)
*=M15
*SET6
*DUP
*=I15
*=C15
*Q15
**=V
! STORE   6/6/`LETT(0)
8:
*I12
*=RC14
! M14 = LENGTH, C14 = LENGTH'
**Q7
! SET  M7 = `CC(0)
*=Q7
**Q5
*=RM6
*ZERO
*J2NV
PRINTSYMBOL(42)
WRITE(LINE,4)
caption__OVERFLOW_SET_DURING_COMPILATION\
FAULTY=1
->8
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'
*-
*J21<Z
*DUP
*SET90
! 'Z'
*-
*J21>Z
*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  I<J %THEN  ->5
->2
4:
COMPARE
*J2C8NZ
! %IF  HIT#0 %THEN  ->2
3:
**RQ
*=M8
! Q=RQ
**RR
*=M6
! R=RR
**RA
`J~VP`````~NW}
! %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'
*-
*J9<Z
! %IF  CC(Q)<65 %THEN  ->9
*DUP
*SET90
! 'Z'
*-
*J1021<=Z
*DUP
*SETB141
*-
*J9<Z
*DUP
*SETB172
*-
*J9>Z
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'
*-
*J10<Z
! %IF  I<65 %THEN  ->10
*DUP
*SET90
! 'Z'
*-
*J11<=Z
! %IF  I<= 90 %THEN  -> 11
*DUP
*SETB141
*-
*J10<Z
*DUP
*SETB172
*-
*J10>Z
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
*J1101<Z
10:
*ZERO
**=J
! J=2
1102:
*DUP
! SEQUENCE FOR DIGITS
*I5
*-
*J13<Z
! %IF  I<'0' %THEN  ->13
*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
*-
*J19<Z
*DUP
*I7
*-
*J23<=Z
19:
*SET46
! '.'
*J25#
*ERASE
*M7M8QN
*DUP
*I5
*-
*J25<Z
*DUP
*I7
*-
*J25>Z
*ZERO
*NOT
*=C14
*J23
22:
*M7M8QN
*DUP
*I5
*-
*J26<Z
*DUP
*I7
*-
*J26>Z
*REV
*M0M14
*XF

*REV
*DC14
23:
*I5
*-
*I1
*FLOAT
*+F
*J22
26:
*SET46
! '.'
*J27=
*SET96
!'`'
*J28=
42:
*ERASE
*C14
*DUP
*J44<Z
*ERASE
*J34
33:
*DUP
*J30=Z
*DUP
*J29>Z
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
*-
*J31<Z
*DUP
*I7
*-
*J31>Z
32:
*REV
*SET10
*XD
*CONT
*+
*I5
*-
35:
*M7M8QN
*DUP
*I5
*-
*J24<Z
*DUP
*I7
*-
*J32<=Z
24:
*ERASE
*REV
*J36=Z
*NEG
36:
*C14
*J33>Z
*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
*-
*J9<Z
! %IF  I<'0' %THEN  ->9
*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
*-
*J81<Z
! %IF  I<'0' %THEN  ->81
*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
*J50<Z
*=C14
->93
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
*99:
*ERASE
*=M5M6
->1
! PHRASE SET MARKER 1
BIP(1008):
*M6
**=MARKER1
->2
! PHRASE SET MARKER 2
BIP(1009):
*M6
**=MARKER2
->2
end
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
->1807ifKK<KKK
**N0
**KK
**KKK
*-
*SHL-1
*NOT
*NEG
*+
**=JJ
*I9
**JJ
*-
*J1807<Z
->35
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):
! COMPILER AA OR AB
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
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:
ifQ<KKthen->26
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
! JR<Z
*0/4000/4
! JR<=Z
*0/4400/10
! JRV
*0/4000/10
! JRNV
*0/4400/12
! JREN
*0/4000/12
! JRNEN
*0/4400/14
! JREJ
*0/4000/14
! JRNEJ
*0/4400/16
! JRTR
*0/4000/16
! JRNTR
*0/4000/13
! JR
22:
*SET53P:
*=M15
**A(P)
*SET2
*-
*=M14
*M14M15
*ZERO
*SHLD+24
**=TT
*SHL-24
**=RR
ifRR=100thenRR=A(P+1)
PJ(TT,K,RR)
->9
EE(4):
! [SET B] [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
*J1<Z
3:
*I15
**V0
*AND
*J2=
*M15
*J1<=Z
*M9M15
*=Q15
->3
2:
*C15
**V0
*AND
->4
1:
*SET-1
4:
**=J
*ERASE
end
routineCOPYTAG(integerKK)
**TAGS(KK)
*=Q15
*M15
*J1<Z
**V0
*I15
*AND
*C15
*DUP
*SET15
*AND
*REV
*SHL-4
*DUP
*SET15
*AND
*REV
*SHL-4
*SET255
*AND
->2
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
*J1<Z
**V0
*DUP
*C15
*AND
*REV
*I15
*AND
->2
1:
*SET-1
*DUP
2:
**=S2
**=S1
end
routinePOPUP2(integernameCELL,S1,S2)
**CELL
*=Q15
*M15
*DUP
*J1<Z
**V0
*DUP
*C15
*AND
**=S1
*I15
*AND
**=S2
*J2=Z
*M9M15
**=CELL
*C9
*=M9M15
*M15
*=C9
->3
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
*J2C9NZ
MORESPACE
2:
*C9
*DUP
*I9
*-
*J3>=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<Z
PN(23)
2:
end
routinePSH(integerA,N)
**N
*NOT
*SHL1
*NOT
**A
*SET2
*=C14
*JS50P
end
routinePN(integerA)
**A
*SET1
*=C14
*JS50P
end
routinePQ(integerA,Q,QQ)
**Q
*SHL4
**QQ
*SET15
*AND
*OR
**A
*SET2
*=C14
*JS50P
end
routineFILLLABEL(integerAT,EQUALS)
**EQUALS
**AT
*JS51P
end
routineFILLSET(integerAT,EQUALS)
**EQUALS
**AT
*JS52P
end
routinePPJ(integerI,J,K)
J=SL(J)
FAULT(33)ifJ=0
PJ(I,J,K)
end
routinePJ(integerA,S,B)
**S
*DUP
*SHL-8
*DUP
*SET15
*AND
**B
*SHL4
*OR
*REV
*DUP
*SET16
*AND
*SHL-1
*REV
*SHL-5
*SET7
*AND
**A
*SHL4
*OR
*OR
*SET3
*=C14
*JS50P
end
routinePMS(integerA,M,Q)
**M
*DUP
*DUP
*SHL-8
*SET15
*AND
**Q
*SHL4
*OR
**A
*SET7
*AND
*SET192
*OR
*CAB
*SHL-9
*SET56
*AND
*OR
*SET3
*=C14
*JS50P
end
1:
end
! OF CSSS
endofprogram

