EXTERNALROUTINESPEC  DEFINE(STRING (63)S)
EXTERNALROUTINE  COMPRESSEM(STRING (63)S)
!***********************************************************************
!*    COMPRESSES A FILE OF ERROR MESSAGE INTO TWO CONSTARRAYS AND      *
!*    GENERATES A ROUTINE TO REGURGITATE THEM IN ENGLISH               *
!***********************************************************************
INTEGER  CPSTRM,INSTRM,LPSTRM
BYTEINTEGERARRAY  WORD(0:1000)
INTEGERARRAY  LETT(0:256)
INTEGER  I, J, K, N, NUM, NEXT, NMAX
STRING (31) FILE1, FILE2, FILE3
STRING (71)TEMP
 STRING (71)FNSPEC  MESS(INTEGER  N)
ROUTINESPEC  LIT(INTEGERNAME  P)
ROUTINESPEC  CARDS OUT
      UNLESS  S->FILE1.(",").FILE2.(",").FILE3 THEN  C 
         PRINTSTRING("PARAMS??") AND  RETURN 
      DEFINE("ST49,".FILE1)
      INSTRM=49
      SELECT INPUT(INSTRM)
      DEFINE("ST50,".FILE2)
      CPSTRM=50
      DEFINE("ST51,".FILE3)
      LPSTRM=51
      SELECT OUTPUT(LPSTRM)
      CYCLE  I=0,1,1000;  WORD(I)=0
      REPEAT 
      LETT(0)=0
      NEXT=1;  NUM=1;  NMAX=0
RMESS:READ(N);  NMAX=N IF  N>NMAX
      NEWLINE;  WRITE(N,5)
      IF  N=0 THEN  ->OUTPUT
      J=1;  WORD(NUM)=N
RSYM: READ SYMBOL(I)
      ->SC IF  I=';' OR  I=NL
      ->RSYM UNLESS  I=''''
      LIT(I)
      IF  J=5 THEN  START 
         PRINTSTRING(" MESSAGE TOO LONG")
         MONITOR 
         STOP 
      FINISH 
      WORD(NUM+J)=I;  J=J+1;  ->RSYM
SC:   NUM=NUM+5;  ->RMESS
OUTPUT:
      NEWLINES(2)
      CYCLE  I=1,1,NMAX
         TEMP=MESS(I)
         IF  TEMP#"" THEN  START 
            NEWLINE; WRITE(I,5)
            PRINTSTRING(TEMP)
         FINISH 
      REPEAT 
      CARDS OUT
      SELECT OUTPUT(0)
      PRINTSTRING("ROUTINE MESSAGE GENERATED
");  STOP 
 STRING (71)FN  MESS(INTEGER  N)
STRING (70)OMESS
INTEGER  I, J, K, M, Q, S
      OMESS="  ("
      CYCLE  I=1,5,NUM-5
         ->FOUND IF  N=WORD(I)
      REPEAT 
      RESULT =""
FOUND: CYCLE  J=1,1,4
         K=WORD(I+J)
         IF  K=0 THEN  EXIT 
         OMESS=OMESS." " UNLESS  J=1
         UNTIL  M&1=0 CYCLE 
            M=LETT(K);  S=26
            UNTIL  S<0 CYCLE 
               Q=M>>S&31
               IF  Q=31 THEN  Q=-32
               IF  Q¬=0 THEN  OMESS=OMESS.TOSTRING(Q+64)
               S=S-5
            REPEAT 
            K=K+1
         REPEAT 
      REPEAT 
      OMESS=OMESS.")"
      RESULT =OMESS
END 
ROUTINE  LIT(INTEGERNAME  P)
INTEGER  I, J, K, L, N, SH
      N=0;  J=0
      SH=26;  L=0
AGN:  READ SYMBOL(I)
      ->Q IF  I=''''
      IF  'A'<=I<='Z' THEN  I=I-64
      IF  I=32 THEN  I=31
      N=N+1;  J=J!I<<SH
      SH=SH-5;  ->AGN UNLESS  SH<0
      J=J!1 UNLESS  NEXT SYMBOL=''''
      LETT(NEXT+L)=J
      J=0;  SH=26;  L=L+1;  ->AGN
Q:    IF  SH#26 THEN  LETT(NEXT+L)=J AND  L=L+1
      I=0
      WHILE  I<=NEXT-1 CYCLE 
         CYCLE  J=0,1,L-1
            ->FAIL UNLESS  LETT(I+J)=LETT(NEXT+J)
         REPEAT 
         ->FOUND
FAIL:    I=I+1
      REPEAT 
      P=NEXT;  NEXT=NEXT+L
      PRINTSTRING(" WORD ENTERED");  RETURN 
FOUND:P=I;  PRINTSTRING(" WORD FOUND  ")
END 
ROUTINE  PHEX(INTEGER  N)
INTEGER  I, J
      PRINTSTRING("X'")
      CYCLE  J=28,-4,0
         I=N>>J&15
         IF  I>=10 THEN  I=I+7
         PRINT SYMBOL(I+'0')
      REPEAT ;  PRINTSTRING("'")
END 
ROUTINE  CARDS OUT
STRING (73)M
INTEGER  I, J
      SELECT OUTPUT(CPSTRM)
      PRINTSTRING("
         %ROUTINE MESSAGE(%INTEGER N)
!")
      CYCLE  I=1,1,71
         PRINTSYMBOL('*')
      REPEAT 
      PRINTSTRING("
!*       OUTPUTS AN ERROR MESSAGE STORED IN A COMPRESSED FORMAT        *
")
      CYCLE  I=1,1,NMAX
         M=MESS(I)
         IF  M#"" THEN  START 
            PRINTSTRING("!*    ")
            WRITE(I,3)
            PRINTSTRING(M)
            SPACES(61-LENGTH(M))
            PRINTSTRING("*
")
         FINISH 
      REPEAT 
      PRINTSTRING("!")
      CYCLE  I=1,1,71
         PRINT SYMBOL('*')
      REPEAT 
      NEXT=NEXT-1;  NUM=NUM-1
      PRINTSTRING("
         %CONST")
      IF  NEXT<=255 THEN  PRINTSTRING("BYTE")
      PRINTSTRING("INTEGERARRAY WORD(0:")
      WRITE(NUM,2);  PRINTSTRING(")=0,%C")
      NEWLINE;  SPACES(9)
      CYCLE  I=1,1,NUM
         WRITE(WORD(I),3);  PRINTSTRING(",") UNLESS  I=NUM
         IF  I&7=0 THEN  START 
            NEWLINE;  SPACES(9)
         FINISH 
      REPEAT 
      PRINTSTRING("
          %CONSTINTEGERARRAY LETT(0:")
      WRITE(NEXT,2)
      PRINTSTRING(")=0,%C")
      NEWLINE;  SPACES(8)
      CYCLE  I=1,1,NEXT
         PHEX(LETT(I));  PRINTSTRING(",") UNLESS  I=NEXT
         IF  I&3=0 THEN  NEWLINE AND  SPACES(8)
      REPEAT 
      PRINTSTRING("
         %INTEGER I,J,K,M,Q,S
         PRINTSTRING("" ("")
         I=-4
         %UNTIL N=WORD(I) %OR I=" C 
         )
      WRITE(NUM-4,1)
      PRINTSTRING(" %THEN I=I+5")
      PRINTSTRING("
         %CYCLE J=1,1,4
            K=WORD(I+J)")
      PRINTSTRING("
            %IF K=0 %THEN %EXIT
            SPACE %UNLESS J=1
            %UNTIL M&1=0 %CYCLE
               M=LETT(K); S=26
               %UNTIL S<0 %CYCLE
                  Q=M>>S&31; " C 
         )
      PRINTSTRING("
                  %IF Q=31 %THEN Q=-32
                  %IF Q¬=0 %THEN PRINT SYMBOL(Q+64)
                  S=S-5
               %REPEAT
               K=K+1
            %REPEAT
         %REPEAT
         PRINTSTRING("") "")
         %END" C 
         )
      SELECT OUTPUT(LPSTRM)
END 
END 
ENDOFFILE