EXTERNALROUTINE  PSPROG2(STRING (63) S)
EXTERNALSTRINGFNSPEC  DATE
INTEGER  I, J, K, SS, NBIP
STRING (15) ST49,ST50,ST51
EXTERNALROUTINESPEC  DEFINE(STRING (63)S)
INTEGERARRAY  SYMBOL(1300:3000), CC(0:300)
INTEGER  CNEXT, DNEXT, CNUM, DNUM, ALT, DEF, ASL, NIDFLAG
INTEGERARRAY  KK, DWORD(1001:1200), DLETT(0:1000)
ROUTINESPEC  READ STRING(INTEGER  TERMINATOR)
ROUTINESPEC  RECORD(INTEGERARRAYNAME  WORD, LETT,  C 
            INTEGERNAME  NUM, NEXT)
ROUTINESPEC  LOOK UP(INTEGERARRAYNAME  WORD, LETT,  C 
            INTEGER  FIRST, LAST, INSERT)
ROUTINESPEC  PDDICT
ROUTINESPEC  PRINT STR(INTEGERARRAYNAME  CC, INTEGER  PTR)
         UNLESS  S->ST49.(",").ST50.(",").ST51 THEN  C 
            PRINTSTRING("PARAMS?????") AND  NEWLINE AND  RETURN 
         DEFINE('ST49,'.ST49)
         DEFINE('ST50,'.ST50)
         DEFINE('ST51,'.ST51)
         SELECT INPUT(49)
         SELECT OUTPUT(51)
         ASL=1300
         CNEXT=0
         DNEXT=0
         CNUM=0
         NIDFLAG=0
         DNUM=1000
         READ(NBIP)
L1:       READ SYMBOL(I)
         IF  I=68 THEN  ->L3;            !'D'
         IF  I=80 THEN  ->L4;            !'P'
         IF  I=69 THEN  ->L5;            !'E'
         ->L1
L3:       READ SYMBOL(I)
         READSTRING(')')
         RECORD(DWORD, DLETT, DNUM, DNEXT)
         ->L1
L4:       NEWLINES(2)
         PRINTSYMBOL(I)
         READSYMBOL(I)
         PRINTSYMBOL(I)
         READ STRING(')')
         PRINT STR(CC, 0)
         PRINTSYMBOL(')')
         LOOK UP(DWORD, DLETT, 1001+NBIP, DNUM, 0)
         KK(I)=ASL
         DEF=ASL
         ALT=ASL+1
         ASL=ASL+2
L6:       READ SYMBOL(I)
         PRINTSYMBOL(I)
         IF  I='(' THEN  ->L7;           !
         IF  I=M'''' THEN  ->LLIT;       !'''OR EQUIVALENT                
                                        !       
         IF  I=44 THEN  ->L9;            !','                             
                                        !         
         IF  I=59 THEN  ->L10;           !
         IF  I=48 THEN  ->L11;           !'0'                             
                                        !         
         IF  I='*' THEN  I=999 AND  ->L12
         ->L6
L7:       READ STRING(')')
         PRINT STR(CC, 0)
         PRINTSYMBOL(')')
         LOOK UP(DWORD, DLETT, 1001, DNUM, 0)
L12:      SYMBOL(ASL)=I
         ASL=ASL+1
         ->L6
LLIT:     READ STRING(M'''')
         PRINT STR(CC, 0)
         PRINTSYMBOL(M'''')
         CYCLE  I=1,1,CC(0)
            SYMBOL(ASL)=CC(I)
            ASL=ASL+1
         REPEAT 
         ->L6
L9:       SYMBOL(ALT)=ASL
         ALT=ASL
         ASL=ASL+1
         ->L6
L10:      SYMBOL(ALT)=ASL
         SYMBOL(DEF)=ASL
         ->L1
L11:      I=1000
         ->L12
L5:
       PDDICT
         CYCLE  I=1300, 1, ASL-1
            IF  1001+NBIP<=SYMBOL(I)<=DNUM C 
               THEN  SYMBOL(I)=KK(SYMBOL(I))
         REPEAT 
         SS=KK(DNUM)
         NEWLINE
         CYCLE  K=1, 1, 2
            SELECT OUTPUT(50) IF  K=2
            PRINTSTRING('! PRODUCED FROM '.ST49.' BY PSPROG2S ON '.DATE)
            PRINTSTRING("
%CONSTINTEGERARRAY SYMBOL(1300:")
            WRITE(ASL-1, 1);  PRINTSTRING(")=")
            CYCLE  I=1300, 1, ASL-1
               WRITE(SYMBOL(I), 5)
               J=','
               J=';' IF  I=ASL-1
               PRINTSYMBOL(J)
               NEWLINE IF  (I-1299)-((I-1299)//10)*10=1
            REPEAT 
            NEWLINE
            PRINTSTRING("%CONSTINTEGER SS=")
            WRITE(SS, 1)
            NEWLINE
            RETURN  UNLESS  NIDFLAG=0
         REPEAT 
         SELECT OUTPUT(99)
         PRINTSTRING("NO ERRORS
")
         RETURN 
ROUTINE  READ STRING(INTEGER  TERMINATOR)
INTEGER  UNDER;  UNDER=0
         J=0
L1:       READ SYMBOL(I)
         IF  I='%' THEN  UNDER=128 AND  ->L1
         IF  'A'<=I<='Z' THEN  I=I+UNDER ELSE  UNDER=0
         IF  I=32 THEN  ->L1;            !'_'                             
                                        !         
         IF  I=TERMINATOR THEN  CC(0)=J AND  RETURN 
         J=J+1
         CC(J)=I
         ->L1
END 
ROUTINE  RECORD(INTEGER  ARRAY  NAME  WORD,LETT,           C            
INTEGER  NAME  NUM,NEXT)                                                
         NUM=NUM+1
         WORD(NUM)=NEXT
         CYCLE  I=0, 1, CC(0)
            LETT(NEXT+I)=CC(I)
         REPEAT 
         NEXT=NEXT+CC(0)+1
END 
ROUTINE  LOOK UP(INTEGERARRAYNAME  WORD, LETT,  C 
            INTEGER  FIRST, LAST, INSERT)
         I=FIRST
         WHILE  I<=LAST CYCLE 
            J=WORD(I)
            CYCLE  K=0, 1, LETT(J)
               IF  LETT(J+K)#CC(K) THEN  ->LNXT
            REPEAT 
            RETURN 
LNXT:        I=I+1
         REPEAT 
         IF  INSERT=0 THEN  START 
            PRINTSTRING("
****************PHRASE NOT IN DICTIONARY***********   ")
            PRINT STR(CC, 0)
            NIDFLAG=NIDFLAG+1
            RETURN 
         FINISH 
         RECORD(WORD, LETT, CNUM, CNEXT)
                                        ! INSERT INTO C DICTIONARY       
         I=CNUM
END 
ROUTINE  PRINT STR(INTEGERARRAYNAME  CC, INTEGER  PTR)
INTEGER  I, J, K
         SS=CC(PTR);  K=SS
         IF  CC(PTR+1)>128 THEN  SS=SS+1 AND  PRINT SYMBOL('%')
         CYCLE  I=1, 1, K
            PRINT SYMBOL(CC(PTR+I))
         REPEAT 
END 
ROUTINE  PDDICT
INTEGER  J
         NEWLINES(4)
         PRINTSTRING(" KEY TO MAIN TABLE (SYMBOL)
")
         CYCLE  J=1001, 1, DNUM
            IF  J<=1000+NBIP THEN  WRITE(J, 4) ELSE  WRITE(KK(J), 4)
            SPACES(2)
            PRINT STR(DLETT, DWORD(J))
            SPACES(17-SS)
            NEWLINE IF  (J-1000)&3=0
         REPEAT 
END 
END 
ENDOFFILE