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<<SH
SH=SH-6; ->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