***A
JOB
MAC022 PS PREPARATION MK3 CC->650, SYMBOL ->2400
OUTPUT 0 LINE PRINTER 5000 LINES
COMPILER IMP

%BEGIN 
%INTEGER  I,J,K,SS,NIDFLAG
%INTEGERARRAY  CLETT(1:650),SYMBOL(1300:3000),CC(0:300)
%SHORTINTEGERARRAY DUMMY(0:64),CL(0:650),SY(1300:2400),DUM(0:64)

 
%INTEGER  CNEXT,DNEXT,CNUM,DNUM,ALT,DEF,ASL,PFLAG
%INTEGERARRAY  KK,DWORD(1001:1100),DLETT(1:750),CWORD(1:200)
%ROUTINESPEC  READ STRING
%ROUTINE %SPEC  RECORD(%INTEGERARRAYNAME  WORD,LETT, %INTEGER %C
%NAME  NUM,NEXT)
%ROUTINESPEC  LOOK UP(%INTEGERARRAYNAME  WORD,LETT, %INTEGER  FI%C
RST,LAST)

ASL=1300
CNEXT=1
DNEXT=1
CNUM=0
DNUM=1000
PFLAG=0
NIDFLAG=0
1:READ SYMBOL(I)
%IF  I=67 %THEN  ->2        ; ! 'C'
%IF  I=68 %THEN  ->3        ; ! 'D'
%IF  I=80 %THEN  ->4        ; ! 'P'
%IF  I=69 %THEN  ->5        ; ! 'D'
->1
2:READ SYMBOL(I)
READ STRING
RECORD(CWORD,CLETT,CNUM,CNEXT)
->1
3:->33 %IF PFLAG=1
PFLAG=1
%CYCLE I=1,1,CNEXT-1
CL(I)=CLETT(I)
%REPEAT
%MCODE
**@CL(0); *SHL-1
**@CL(650); *NOT; *NEG; *SHL-1
*=M15; *=I15; *E338; *=C15
*C15; *J34>Z; *SET1; *SET5; *OUT
*DUP; *=C15; *=E338
34:*POAQ15
%ENDOFMCODE
33:READ SYMBOL(I)
READ STRING

RECORD(DWORD,DLETT,DNUM,DNEXT)
->1
4:READ SYMBOL(I)
READ STRING
LOOK UP(DWORD,DLETT,1012,DNUM)
KK(I)=ASL
DEF=ASL
ALT=ASL+1
ASL=ASL+2
6:READ SYMBOL(I)
%IF  I=91 %THEN  ->7        ; ! '['
%IF  I=34 %THEN  ->8        ; !'"' OR EQUIVALENT
%IF  I=44 %THEN  ->9        ; ! ','
%IF  I=59 %THEN  ->10       ; ! ;
%IF  I=48 %THEN  ->11       ; ! '0'
->6
7:READ STRING
LOOK UP(DWORD,DLETT,1001,DNUM)
12:SYMBOL(ASL)=I
ASL=ASL+1
->6

8:READ STRING
LOOK UP(CWORD,CLETT,1,CNUM)
->12
9:SYMBOL(ALT)=ASL
ALT=ASL
ASL=ASL+1
->6
10:SYMBOL(ALT)=ASL
SYMBOL(DEF)=ASL
->1
11:I=1000
->12
5:%CYCLE  I=1300,1,ASL-1
%IF 1<=SYMBOL(I)<=CNUM %THEN SYMBOL(I) =CWORD(SYMBOL(I))
%IF  1012<=SYMBOL(I)<=DNUM %THEN  SYMBOL(I)=KK(SYMBOL(I))
%REPEAT 
SS=KK(DNUM)
->FLOP %UNLESS NIDFLAG=0
%MCODE
*E338; *=RC15
*SET25; *=M15
*ZERO; *=TR
*BUSYQ15; *J55NTR
%PRINTTEXT' PUNCH BUSY
'
55:*POEQ15
%ENDOFMCODE

%CYCLE I=1300,1,ASL-1
SY(I)=SYMBOL(I)
%REPEAT
SY(2400)=SS
%MCODE
**@SY(1300)
*SHL-1

**@SY(2400)
*NOT
*NEG
*SHL-1
*E338; *=RC15;
*=M15; *=I15
*POAQ15
%ENDOFMCODE

NEWLINES(2)
WRITE(CNEXT-1,1)
NEWLINE
%CYCLE I=1,1,CNEXT-1
WRITE(CLETT(I),5)
%REPEAT

NEWLINES(2)
WRITE(ASL-1,1)
NEWLINE
%CYCLE I=1300,1,ASL-1
WRITE(SYMBOL(I),5)
%REPEAT
NEWLINES(2)
WRITE(SS,1)

SELECT PUNCH;RUNOUT(50);NEWLINE
%PRINTTEXT'***A
MAG
'
RUNOUT(50);NEWLINE; %PRINTTEXT'***A
CARDS
'
RUNOUT(200); SELECTPRINTER

NEWLINES(2)
%STOP

FLOP: NEWLINE
      WRITE (NIDFLAG, 4)
      %PRINTTEXT' WRONG PHRASES'
      %MONITORSTOP

%ROUTINE  READ STRING
%INTEGER  UNDER ; UNDER = 0
J=0
1:READ SYMBOL(I)
-> 12 %UNLESS  I=37       ; !PERCENT
UNDER =128
-> 1
12: -> 13  %UNLESS  65<= I <= 90
I=I+UNDER
-> 14
13: UNDER =0
14:%IF  I=32 %THEN  ->1     ; ! '_'
%IF ( I=34 %OR  I=93) %AND J#0 %THEN  ->2; ! '"' OR EQUIVALENT AND ']'
J=J+1
CC(J)=I
->1
2:CC(0)=J
%END 

%ROUTINE  RECORD(%INTEGER %ARRAY %NAME  WORD,LETT, %INTEGER %NAME  NUM%C
,NEXT)
NUM=NUM+1
WORD(NUM)=NEXT
%MCODE
**@LETT(NEXT)
*=RM9
**@CC(0)
*=RM8
*M0M8;*SHL-16; *NOT;*NEG
*=C9;*
1: *M0M8Q;*=M0M9Q;*;*J1C9NZS

NEXT=NEXT+CC(0)+1
%END 

%ROUTINE  LOOK UP(%INTEGERARRAYNAME  WORD,LETT,%INTEGER  FIRST,LAST)
%MCODE
%INTEGER K
**@ CC(0); *=RM7
**@LETT(1); *=RM9; *M-I9
**@WORD(FIRST);*=RM8
K=LAST-FIRST+1
**K;*SHL-16; *=C8
10:*M0M8Q; *DUP; **=J
*SHL-16; *=RM15
*Q7TOQ14
*M15M9; !**LETT(J)
*SHL-16; *NOT; *NEG; *=C15
*
5: *M9M15Q; *M0M14Q
*-; *J1#Z
*J5C15NZS
*C8; *SHL16; **=K
I=LAST-K
%RETURN
1: *J10C8NZ
%ENDOFMCODE
 
%PRINTTEXT'
PHRASE NOT IN DICTIONARY   '

%CYCLE  K=1,1,CC(0)
PRINT SYMBOL(CC(K))
%REPEAT 
NIDFLAG=NIDFLAG+1
 
%END
%ENDOFPROGRAM