%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<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