%EXTERNALROUTINESPEC DEFINE(%STRING(63)S) %EXTERNALROUTINE COMPRESS(%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 %INTEGERARRAY WORD(0:2000) %INTEGERARRAY LETT(0:1000) %INTEGER I, J, K, N, NUM, NEXT, NMAX, NUMMAX %STRING(31) FILE1, FILE2, FILE3 %STRING(71)TEMP,INPUT,WK1,WK2 %%STRING(71)%FNSPEC MESS(%INTEGER N) %ROUTINESPEC LIT(%INTEGERNAME P,%STRINGNAME TXT1) %ROUTINESPEC CARDS OUT %CONSTBYTEINTEGERARRAY INTT(0:127)= 63(32),63(3),61,63,60, %C 27,30,31,32,63(3), 28,59,29,63(17), 1,2,3,4,5,6,7,8,9,10,11,12, 13,14,15,16,17,18,19,20, 21,22,23,24,25,26, 63(6), 33,34,35,36,37,38,39,40,41,42, 43,44,45,46,47,48,49,50,51,52, 53,54,55,56,57,58,63(5); %CONSTBYTEINTEGERARRAY OUTTT(0:63)='?','A','B','C','D','E','F','G', 'H','I','J','K','L','M','N', 'O','P','Q','R','S','T','U', 'V','W','X','Y','Z','&','-', '/','''','(',')', 'a','b','c','d','e','f','g', 'h','i','j','k','l','m','n', 'o','p','q','r','s','t','u', 'v','w','x','y','z','.','%', '#','?'(2); %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 %IF N=0 %THEN ->OUTPUT J=1; WORD(NUM)=N; NUMMAX=NUM RSYM: I=NEXT SYMBOL %IF I=';' %OR I=NL %THEN SKIP SYMBOL %AND ->RSYM %UNLESS I='"' %THEN SKIP SYMBOL %AND ->RSYM READSTRING(INPUT) INPUT=WK1." ".WK2 %WHILE INPUT->WK1.(" ").WK2 %IF INPUT="" %OR INPUT=" " %THEN ->RMESS;! MISSING ERROR MESSAGE NUM=NUM+1 NEWLINE; WRITE(N,5) %WHILE INPUT->WK1.(" ").INPUT %CYCLE %IF WK1#"" %THEN %START LIT(I,WK1) WORD(NUM)=I!X'8000' NUM=NUM+1 %FINISH %REPEAT ->RMESS %IF INPUT="" LIT(I,INPUT) WORD(NUM)=I!X'8000' NUM=NUM+1 ->RMESS OUTPUT: WORD(NUM)=0 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,1,NUM-1 ->FOUND %IF N=WORD(I) %REPEAT %RESULT="" FOUND: J=1 %CYCLE K=WORD(I+J) %IF K&X'8000'=0 %THEN %EXIT K=K!!X'8000' OMESS=OMESS." " %UNLESS J=1 %UNTIL M&1=0 %CYCLE M=LETT(K); S=25 %UNTIL S<0 %CYCLE Q=M>>S&63 %IF Q\=0 %THEN OMESS=OMESS.TOSTRING(OUTTT(Q)) S=S-6 %REPEAT K=K+1 %REPEAT J=J+1 %REPEAT %RESULT=OMESS %END %ROUTINE LIT(%INTEGERNAME P,%STRINGNAME TXT) %INTEGER I, J, K, L, N, SH, CH N=0; J=0 SH=25; L=0; CH=1 AGN: ->Q %IF CH>LENGTH(TXT) I=CHARNO(TXT,CH) I=INTT(I) CH=CH+1 N=N+1; J=J!I<AGN %UNLESS SH<0 J=J!1 %UNLESS CH>LENGTH(TXT) LETT(NEXT+L)=J J=0; SH=25; L=L+1; ->AGN Q: %IF SH#25 %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(" %STRINGFN 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(59-LENGTH(M)) PRINTSTRING("* ") %FINISH %REPEAT PRINTSTRING("!") %CYCLE I=1,1,71 PRINT SYMBOL('*') %REPEAT NEXT=NEXT-1 PRINTSTRING(" %CONSTBYTEINTEGERARRAY OUTTT(0:63)='?','A','B','C','D','E','F','G', 'H','I','J','K','L','M','N', 'O','P','Q','R','S','T','U',") PRINTSTRING(" 'V','W','X','Y','Z','&','-', '/','''','(',')', 'a','b','c','d','e','f','g',") PRINTSTRING(" 'h','i','j','k','l','m','n', 'o','p','q','r','s','t','u', 'v','w','x','y','z','.','%',") PRINTSTRING(" '#','?'(2)") PRINTSTRING(" %CONSTINTEGER WORDMAX=") WRITE(NUM,2) PRINTSTRING(",DEFAULT="); WRITE(NUMMAX,2) PRINTSTRING(" %CONSTHALFINTEGERARRAY WORD(0:WORDMAX)=0,%C") NEWLINE; SPACES(9) %CYCLE I=1,1,NUM WRITE(WORD(I),5); 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 %STRING(70)OMESS OMESS="" "" %CYCLE I=1,1,WORDMAX-1 ->FOUND %IF N=WORD(I) %REPEAT I=DEFAULT") PRINTSTRING(" FOUND: J=1 %CYCLE K=WORD(I+J)") PRINTSTRING(" %IF K&X'8000'=0 %THEN %EXIT K=K!!X'8000' OMESS=OMESS."" "" %UNLESS J=1 %UNTIL M&1=0 %CYCLE M=LETT(K); S=25 %UNTIL S<0 %CYCLE Q=M>>S&63; ") PRINTSTRING(" %IF Q\=0 %THEN OMESS=OMESS.TOSTRING(OUTTT(Q)) S=S-6 %REPEAT K=K+1 %REPEAT J=J+1 %REPEAT %RESULT=OMESS %END ") SELECT OUTPUT(LPSTRM) %END %END %ENDOFFILE