!!! ****** ******* ****** ** ** ***** ******* ***** !!! ** ** ** ** ** ** ** ** ** ** ** ** !!! ** ** ** ** ** ** ** ** ** ** !!! ****** ***** ** ** ** ** ** ***** ***** !!! ** ** ** ** ** ** ** ** ** ** !!! ** ** ** ** ** ** ** ** ** ** ** ** !!! ** ** ******* ****** ***** ***** ******* ***** ! ! NEW PHRASE STRUCTURE REDUCTION PROGRAM ! %CONTROL 0 %EXTERNALROUTINESPEC SET STREAMS(%STRING (63) S) %CONSTINTEGER DATA IN = 1 %CONSTINTEGER DATA OUT = 2 %CONSTINTEGER ERROR OUT = 3 %EXTERNALROUTINE REDUCE(%STRING (63) FILES) %STRING (63) INPUT, OUTPUT, REPORT %OWNBYTEINTEGERARRAY BIPD(3 : 15) %BYTEINTEGERARRAY PHRASE USE(1 : 1000) %STRING (31) %ARRAY PHRASE(1 : 1000) %SHORTINTEGERARRAY MAIN, SUB, SMOD(1 : 3000) %SHORTINTEGERARRAY PVAL(1 : 1000), LITP(1 : 500) %BYTEINTEGERARRAY LITERAL(0 : 2000), PDEFN(1 : 1000) %OWNINTEGER PHS = 1, BPS = 501 %RECORDFORMAT EXTFM(%STRINGNAME NAME, %INTEGER EP) %RECORDARRAY EXT EP(1 : 100)(EXTFM) %INTEGER J, K, L, S, PN, BN, MP, SP, LP, LITN, N, MOD %INTEGER FAULTY, EXTPT %STRING (63) NAME, NUMBER %INTEGERFN NEXTS %INTEGER S READSYMBOL(S) %UNTIL S # ' ' %AND S # NL %RESULT = S %END %ROUTINE FAULT(%INTEGER N) FAULTY = FAULTY+1 %SWITCH FN(1 : 6) -> FN(N) FN(1): %PRINTTEXT '? ' PRINTSYMBOL(S); S = '^' PRINTSYMBOL(S) %AND READSYMBOL(S) %UNTIL S = NL NEWLINE %RETURN FN(2): PRINTSTRING('DUPLICATE '''.NAME.''' '); %RETURN FN(3): PRINTSTRING('VALUE '''.NAME.'''? '); %RETURN FN(4): PRINTSTRING(''''.NAME.''' UNDEFINED '); %RETURN %END %ROUTINE GET NAME(%INTEGER DELIM) %INTEGER S NAME = '' %CYCLE S = NEXTS; %EXIT %IF S = DELIM NAME = NAME.TOSTRING(S) %REPEAT %END %INTEGERFN STOI(%STRINGNAME S) %INTEGER J, K, N N = 0; %RESULT = 0 %IF LENGTH(S) = 0 %CYCLE J = ADDR(S)+1, 1, ADDR(S)+LENGTH(S) K = BYTEINTEGER(J)-'0' %RESULT = -1 %UNLESS 0 <= K <= 9 N = 10*N+K %REPEAT %RESULT = N %END %INTEGERFN FIND(%INTEGER S, %INTEGERNAME P) %WHILE S <= P %CYCLE %RESULT = S %IF PHRASE(S) = NAME S = S+1 %REPEAT P = P+1; PHRASE(P) = NAME PVAL(P) = 0; PDEFN(P) = 0 %RESULT = P %END PN = 0; BN = 500 PVAL(500) = 2; PHRASE(500) = ''; PDEFN(500) = 2 MP = 0; SP = 1; LP = 1 %CYCLE J = 1, 1, 3000; SMOD(J) = 0 %REPEAT %UNLESS FILES -> INPUT.('/').OUTPUT %START PRINTSTRING(FILES.'? ') %RETURN %FINISH REPORT = '.TT' %UNLESS OUTPUT -> OUTPUT.(',').REPORT SET STREAMS(INPUT.','.OUTPUT.','.REPORT) SELECTINPUT(DATA IN) SELECTOUTPUT(ERROR OUT) %CYCLE J = 1, 1, 1000; PHRASE USE(J) = 0 %REPEAT %CYCLE J = 1, 1, 100 EXTEP(J) = 0 %REPEAT ! FAULTY = 0 LITN = 0 EXTPT = 0 TOP: S = NEXTS TOPM: %IF S = 'B' %START; ! BUILT-IN PHRASE DEFN FAULT(1) %AND -> TOP %IF NEXTS # '[' GET NAME(']'); L = 3 BL: J = FIND(BPS, BN) FAULT(2) %AND -> TOP %IF PDEFN(J) # 0 PDEFN(J) = L FAULT(1) %AND -> TOP %IF NEXTS # '=' READ(N); ! VALUE %IF L = 1 %START FAULT(3) %AND -> TOP %UNLESS 2 < N <= 15 %AND BIPD(N) = 0 BIPD(N) = 1 %FINISH PVAL(J) = N -> TOP %FINISH %IF S = 'L' %START; ! LITERAL DEFN FAULT(1) %AND -> TOP %UNLESS NEXTS = '<' GET NAME('>'); L = 2; -> BL %FINISH %IF S = 'D' %START; ! DEFINE COMPLEX PHRASE FAULT(1) %AND -> TOP %IF NEXTS # '[' GET NAME(']') FAULT(1) %AND -> TOP %IF NEXTS # '=' %OR NEXTS # '[' J = FIND(BPS, BN) FAULT(2) %AND -> TOP %IF PDEFN(J) # 0 GET NAME(']') K = 0; K = STOI(NUMBER) %IF NAME -> NAME.('=').NUMBER NAME = NAME.NUMBER %IF K < 0 L = FIND(BPS, BN) PHRASE USE(L) = 1 FAULT(4) %AND -> TOP %UNLESS PDEFN(L) = 3 PDEFN(J) = 4 PVAL(J) <- PVAL(L)<<12!K -> TOP %FINISH %IF S = 'P' %START; ! PHRASE DEFN FAULT(1) %AND -> TOP %UNLESS NEXTS = '(' GET NAME(')') J = FIND(PHS, PN) FAULT(2) %AND -> TOP %UNLESS PDEFN(J) = 0 PDEFN(J) = 1 MP = MP+1; MAIN(MP) = SP PVAL(J) = MP-1 -> TOP %FINISH %IF S = '<' %START; ! LITERAL VALUE GET NAME('>') K = STOI(NAME) %IF K < 0 %START K = FIND(BPS, BN) FAULT(4) %AND -> TOP %IF PDEFN(K) # 2 PHRASE USE(K) = 1 K = PVAL(K) %FINISH SP = SP+1; SUB(SP) <- 500; SMOD(SP) <- K -> TOP %FINISH %IF S = '(' %START; ! PHRASE REF GET NAME(')') J = FIND(PHS, PN) PHRASE USE(J) = 1 SP = SP+1; SUB(SP) <- J SMOD(SP) = X'1000' -> TOP %FINISH %IF S = '[' %START; ! BIP REF GET NAME(']') K = 0 K = STOI(NUMBER) %IF NAME -> NAME.('=').NUMBER NAME = NAME.NUMBER %IF K < 0 J = FIND(BPS, BN) FAULT(3) %UNLESS PDEFN(J) = 3 %OR (PDEFN(J) = 4 %AND K = 0) PHRASE USE(J) = 1 SP = SP+1; SUB(SP) <- J; SMOD(SP) <- K -> TOP %FINISH %IF S = '''' %START MOD = 0; J = LP PC1: S = NEXTS -> PC2 %IF S = '''' MOD = 32 %AND -> PC1 %IF S = '%' MOD = 0 %UNLESS 'A' <= S <= 'Z' J = J+1; LITERAL(J) = S+MOD -> PC1 PC2: LITERAL(LP) = J-LP K = LITN %WHILE K > 0 %CYCLE -> PC3 %IF STRING(ADDR(LITERAL(LITP(K)))) = STRING( %C ADDR(LITERAL(LP))) K = K-1 %REPEAT K = LITN+1; LITN = K; LITP(K) = LP; LP = J+1 PC3: SP = SP+1; SUB(SP) <- 0; SMOD(SP) <- LITP(K) -> TOP %FINISH %IF S = ':' %START; ! END OF ALTERNATIVE SP = SP+1; SUB(SP) <- 0 S = NEXTS %IF S = ';' %THEN %START MP = MP+1; MAIN(MP) = SP-1 -> TOP %FINISH MP = MP+1; MAIN(MP) = SP; -> TOPM %FINISH %IF S = ';' %START SP = SP+1; SUB(SP) <- 0 MP = MP+1; MAIN(MP) = 0 -> TOP %FINISH %IF S = '*' %START READSYMBOL(S) %UNTIL S = NL -> TOP %FINISH %IF S = 'E' %START; ! EXTERNAL ENTRY POINT FAULT(1) %AND -> TOP %IF NEXTS # '[' GET NAME(']') FAULT(1) %AND -> TOP %IF NEXTS # '=' %OR NEXTS # '(' J = FIND(BPS, BN) FAULT(2) %AND -> TOP %IF PDEFN(J) # 0 EXTPT = EXTPT+1 EXTEP(EXTPT)_NAME == PHRASE(J) GET NAME(')') L = FIND(PHS, PN) PHRASE USE(L) = 1 FAULT(4) %AND -> TOP %IF PDEFN(L) > 1 PDEFN(J) = 5; ! EXTERNAL EXTEP(EXTPT)_EP = L -> TOP %FINISH FAULT(1) %AND -> TOP %IF S # '@' ! ! SECOND PHASE ! LP = LP-1 %CYCLE J = 2, 1, SP K = SUB(J) %IF K # 0 %START %IF PDEFN(K) = 0 %THEN %START NAME = PHRASE(K); FAULT(4) PDEFN(K) = 1 %FINISH %ELSE %START L = PVAL(K) L = L<<12 %IF 1 # PDEFN(K) # 4 SUB(J) <- L+SMOD(J) %FINISH %FINISH %ELSE SUB(J) = SMOD(J) %REPEAT %IF EXTPT # 0 %START %CYCLE J = 1, 1, EXTPT K = EXTEP(J)_EP %IF PDEFN(K) = 0 %START NAME = PHRASE(K); FAULT(4) PDEFN(K) = 1 %FINISH %ELSE EXTEP(J)_EP = PVAL(K) %REPEAT %FINISH ! %IF FAULTY # 0 %START SELECTOUTPUT(0) PRINTSTRING(INPUT.' CONTAINS') WRITE(FAULTY, 1) %PRINTTEXT' FAULT'; %PRINTTEXT'S' %IF FAULTY # 1 NEWLINE %RETURN %FINISH %CYCLE J = BPS, 1, BN PRINTSTRING('? ['.PHRASE(J).'] UNUSED ') %C %IF PHRASE USE(J) = 0 %AND PDEFN(J) # 5 %REPEAT %CYCLE J = PHS, 1, PN PRINTSTRING('? ('.PHRASE(J).') UNUSED ') %C %IF PHRASE USE(J) = 0 %REPEAT SELECTOUTPUT(DATA OUT) %PRINTTEXT '%ENDOFLIST ' %IF EXTPT # 0 %START %CYCLE J = 1, 1, EXTPT PRINTSTRING('%CONSTSHORTINTEGER '.EXTEP(J)_NAME.' =') WRITE(EXTEP(J)_EP, 4); NEWLINE %REPEAT %FINISH %PRINTTEXT ' %CONSTSHORTINTEGERARRAY MAIN(1:' WRITE(MP, 1); %PRINTTEXT ') = %C ' L = 12 %CYCLE J = 1, 1, MP-1 WRITE(MAIN(J), 4); %PRINTTEXT ',' L = L-1; L = 12 %AND NEWLINE %IF L <= 0 %REPEAT WRITE(MAIN(MP), 4) %PRINTTEXT ' %CONSTSHORTINTEGERARRAY SUB(2:' WRITE(SP, 1); %PRINTTEXT ') = %C ' L = 9 %CYCLE J = 2, 1, SP-1 WRITE(SUB(J), 5); %PRINTTEXT ',' L = L-1; L = 9 %AND NEWLINE %IF L <= 0 %REPEAT WRITE(SUB(SP), 4) %PRINTTEXT ' %CONSTBYTEINTEGERARRAY LITERAL(1:' WRITE(LP, 1); %PRINTTEXT ') = %C ' L = 12 %CYCLE J = 1, 1, LP-1 WRITE(LITERAL(J), 4); %PRINTTEXT ',' L = L-1; L = 12 %AND NEWLINE %IF L <= 0 %REPEAT WRITE(LITERAL(LP), 4) %PRINTTEXT ' %LIST ' SELECTOUTPUT(ERROR OUT) %PRINTTEXT 'REDUCTION SUCCESSFUL MAIN' WRITE(MP*2, 1) %PRINTTEXT ' BYTES SUB' WRITE(SP*2-2, 1) %PRINTTEXT ' BYTES LITERAL' WRITE(LP+1, 1) %PRINTTEXT ' BYTES TOTAL' WRITE(MP*2+SP*2+LP-1, 1) %PRINTTEXT ' BYTES ' %END %ENDOFFILE