!!!! 18/4/79 ! GPM -- DIRTY VERSION FOR INTERDATA IMP ! CONSTSTRING (8) VERSION = "GPM 1.09" !-------------------------------------------------! ! I/O STREAMS: ! ! ----------- ! ! INPUT 2: MACRO DEFN. FILE ! ! INPUT 1: SOURCE TEXT TO BE EXPANDED ! ! ! ! OUTPUT 0: REPORT STREAM FOR ERROR MESSAGES ! ! OUTPUT 1: EXPANDED VERSION OF SOURCE TEXT. ! ! OUTPUT 2: DUMP FILE FOR MACRO DEFINITIONS. ! !-------------------------------------------------! ! ****THE DUMP FACILITY FOR UNLOADING ALL CURRENT MACRO DEFINITIONS ! IS NOT SUPPORTED MEANTIME**** ! CONSTINTEGER CUT OFF = 50; ! ... STOP AFTER THIS MANY ERRORS CONSTINTEGER DUPLICATE = 1; ! DUPLICATE ERROR MESSAGES IN OUTPUT 1 ! ! ! ! PRIMARY INPUT: SOURCE TEXT TO BE EXPANDED ! PRIMARY OUTPUT: RESULTING OUTPUT TEXT ! MACRO DEFNS: MACRO DEFN. FILE READ BEFORE PRIMARY INPUT. ! DUMP FILE: DUMP OF MACRO ENVIRONMENT DEFINED. ! THE LAST TWO ARE OPTIONAL: IF NO DEFN. FILE IS DEFINED THAT ! STAGE WILL BE SKIPPED: IF A DUMP FILE IS DEFINED, MACROS ! DEFINED AT '$*END*' OF THE PRIMARY INPUT WILL BE DUMPED ONTO ! IT IN A FORM IN WHICH THEY CAN BE RE-READ AS A 'MACRO FILE' ! NOTE THAT BOTH THE MACRO FILE AND THE PRIMARY INPUT MUST ! END WITH '$*END*' - ALSO THAT DEFNS AND/OR CALLS CAN BE ! PUT IN EITHER INPUT FILE, THE SEPARATION BEING MERELY A MATTER ! OF CONVENIENCE. ! ! A COMMAND('DELIMS') HAS BEEN ADDED TO PERMIT THE VARIOUS ! SPECIAL CHARACTERS TO BE CHANGED. NOTE THAT USED IN CONJUNCTION ! WITH THE 'DUMP' FACILITY, THIS CAN PRODUCE ABSOLUTE RUBBISH. ! BEGIN ; ! ...MAIN PROGRAM LEVEL INTEGER STKLIMIT; CONSTINTEGER STKMAX = 32767; ! ...16 BITS! BEGIN STKLIMIT = (FREE SPACE - 1000)>>1 STKLIMIT = STKMAX IF STKLIMIT > STKMAX END SHORTINTEGERARRAY ST(0:STKLIMIT) ! DEFINE I/O STREAMS -- NOTE THAT THE DUMP FACILITY CAN BE ! DISABLED BY SETTING 'DUMP' TO A NEGATIVE VALUE. CONSTINTEGER DEFN FILE=2, SOURCE=1, REPORT=0, OUT=1, DUMP=-1 CONSTINTEGER FF=12; ! FORM-FEED CHARACTER OWNINTEGER ERROR = 0 OWNSHORTINTEGER INSTRM SHORTINTEGER LBR, RBR; ! ... LEFT/RIGHT BRACKET OWNINTEGER A,R,W,X,K OWNINTEGER D1,D2,D3,W1 OWNINTEGER Q = 1; CONSTINTEGER MARKER = -1 SWITCH MACHINE MACRO(1:8); ! DEF,VAL,UPDATE,BIN,DEC,BAR,*END*,DELIMS OWNSHORTINTEGER LAST OUT=NL; ! LAST OUTPUT CHARACTER OWNSHORTINTEGER SP=0; ! NO. OF SPACES PENDING OWNINTEGER S = 56,E = 50; CONSTBYTEINTEGER MSTHEAD = 50 CONSTSHORTINTEGERARRAY MST(0:55) = -1,6,'*','E','N','D','*',-8, 0,7,'D','E','L','I','M','S',-7, 8,4,'D','E','F',-1, 17,4,'V','A','L',-2, 23,7,'U','P','D','A','T','E',-3, 29,4,'B','I','N',-4, 38,4,'D','E','C',-5, 44,4,'B','A','R',-6 OWNINTEGER H=0, P=0, F=0, C=0 OWNBYTEINTEGERARRAY SYMTYPE(-1:127) SWITCH SW(1:7) ! ! BEGIN ; ! SET DEFAULT WARNING CHARACTERS INTO 'SYMTYPE' SYMTYPE(K) = 0 FOR K = -1,1,127 SYMTYPE('$') = 1; ! ...FN SYMTYPE(',') = 2; ! ...NEXT ITEM SYMTYPE(';') = 3; ! ...APPLY SYMTYPE('¬') = 4; ! ...LOAD ARG SYMTYPE(MARKER) = 5; ! ...END FN SYMTYPE('[') = 6; ! ...PROTECT SYMTYPE(']') = 7; ! ...EXIT LBR = '['; ! ...DEFAULT LEFT BRACKET RBR = ']'; ! ...DEFAULT RIGHT BRACKET END ! ! ! !============= MOUSES SPECIFIC===================== PREDICATE NULL INPUT(INTEGER N) INTEGER K; STRING (255)NAME S K = 3+(N-1)*2 S == STRING(COMREG(K)) TRUE IF S = ".N" OR S = "" FALSE END !================================================ ! SELECT OUTPUT(REPORT); PRINT SYMBOL(FF); NEWLINE PRINT STRING(VERSION." Stack size =") WRITE(STKLIMIT+1,1); PRINT STRING(" cells") NEWLINES(2) IF STKLIMIT < S+100 START ; ! ... AD HOCKERY PRINT STRING("***** MORE STORE REQ'D *****"); NEWLINE SIGNAL 0,2 FINISH ! INITIALISE STACK WITH NAMES OF 'MACHINE MACROS' ST(K) = MST(K) FOR K = 0,1,S-1 INSTRM = DEFN FILE; INSTRM = SOURCE IF NULL INPUT(INSTRM) SELECT INPUT(INSTRM); SELECT OUTPUT(OUT) -> START ! ! ROUTINESPEC LOAD ROUTINE MONITOR(INTEGER N) SWITCH M(0 : 15); INTEGER W1,R ERROR = ERROR+1 IF DUPLICATE # 0 THEN START NEWLINE IF LAST OUT # NL PRINT STRING(" ** ERROR"); WRITE(ERROR,1); PRINT STRING(" **") NEWLINE; LAST OUT = NL; SP = 0 SELECT OUTPUT(REPORT) FINISH PRINT STRING(" *ERROR"); WRITE(ERROR,1); PRINT SYMBOL(':') -> M(N) ! ROUTINE ITEM(INTEGER X) INTEGER APR,HPR,K,J APR = A; HPR = H H = 0 J = ST(X)-1; J = S-X-1 IF ST(X) = 0 IF J > 0 THEN START CYCLE K = 1,1,J A = ST(X+K); LOAD REPEAT FINISH PRINT STRING("... (INCOMPLETE)") IF ST(X) = 0 A = APR; H = HPR END ! M(0): PRINT STRING(" *** STACK OVERFLOW - GPM CANNOT PROCEED *** ") STOP ! M(1): PRINT STRING("UNMATCHED SEMI-COLON IN DEFINITION OF ") ITEM(P+2) PRINT STRING(" IF THIS HAD BEEN QUOTED THE RESULT WOULD BE ") -> RETURN ! M(2): PRINT STRING("UNQUOTED TILDE IN ARGUMENT LIST OF "); ITEM(F+2) PRINT STRING(" IF THIS HAD BEEN QUOTED THE RESULT WOULD BE") -> RETURN ! M(3): PRINT STRING("IMPOSSIBLE ARGUMENT NUMBER IN DEFINITION OF ") ITEM(P+2) -> M11 ! M(4): PRINT STRING("NO ARGUMENT ") D1 = H; H = 0 LOAD PRINT STRING(" IN CALL FOR "); ITEM(P+2) H = D1 -> RETURN ! M(5): PRINT STRING("TERMINATOR IN ") IF C = 0 THEN START PRINT STRING("INPUT STREAM. PROBABLY MACHINE ERROR. ") -> M11 FINISH PRINT STRING("ARGUMENT LIST FOR "); ITEM(F+2) PRINT STRING(" PROBABLY DUE TO A SEMI-COLON MISSING FROM THE DEFINITION OF ") ITEM(P+2) PRINT STRING(" IF A FINAL SEMI-COLON IS ADDED THE RESULT IS ") -> RETURN ! M(7): PRINT STRING("UNDEFINED NAME "); ITEM(W) -> M11 ! M(8): PRINT STRING("UNMATCHED ']'. PROBABLY YOUR ERROR.") -> M11 ! M(9): PRINT STRING("UPDATE ARGUMENT TOO LONG FOR "); ITEM(P+9) -> M11 ! M(10): PRINT STRING("NON-DIGIT IN NUMBER ") -> M11 ! M(12): PRINT STRING("BAR - FAULTY OPERATOR SPECIFICATION") -> M11 ! M(13): PRINT STRING("BAR - ZERO DIVISOR SET TO ONE") NEWLINE -> RETURN ! M(14): PRINT STRING("UNMATCHED ']' -- GPM TERMINATES") NEWLINE -> RETURN M(15): PRINT STRING("'DELIMS' ARGUMENT FAULTY "); ITEM(P+9) NEWLINE -> RETURN M(11): M11: W = 36 PRINT STRING(" CURRENT MACROS ARE:") WHILE P # 0 OR F # 0 CYCLE IF P > F THEN START W1 = P+2 P = ST(P) PRINT STRING(" ALREADY ENTERED ") FINISH ELSE START W1 = F+2 F = ST(F) PRINT STRING(" NOT YET ENTERED ") FINISH CYCLE R = 1,1,W ITEM(W1); EXIT IF ST(W1) = 0 W1 = W1+ST(W1); EXIT IF ST(W1) = MARKER IF W # 1 THEN START PRINT STRING(" ARG"); WRITE(R,0); PRINT STRING(" ") FINISH REPEAT W = 1 REPEAT PRINT STRING(" END OF MONITOR PRINTING ") A = '?'; H = 0; LOAD RETURN: SIGNAL 0,2 IF ERROR = CUT OFF OR N = 15 SELECT OUTPUT(OUT) IF DUPLICATE # 0 END ; ! ... OF MONITOR ROUTINE !-------------------------------------------------! ! THIS ROUTINE EDITS OUTPUT TO: ! ! (1) REMOVE MULTIPLE NEWLINES. ! ! (2) REMOVE TRAILING SPACES. ! ! (3) INSERT ONE SPACE AT THE END OF EACH LINE ! ! TO KEEP CAL R04 ET AL HAPPY. ! !-------------------------------------------------! ROUTINE LOAD IF H # 0 THEN ST(S) = A AND S = S+1 ELSE START IF A # NL START IF A = ' ' THEN SP = SP+1 ELSE START SPACES(SP) AND SP=0 UNLESS SP=0 PRINT SYMBOL(A); LAST OUT = A FINISH ELSE SP = 0 SPACE AND NEWLINE AND LAST OUT = NL UNLESS LAST OUT = NL FINISH FINISH END ROUTINE NEXT CH IF C = 0 THEN READ SYMBOL(A) ELSE A = ST(C) AND C = C+1 END ROUTINE FIND(INTEGER X) INTEGER R A = E; W = X; K = 0 WHILE A >= 0 CYCLE CYCLE R = 0,1,ST(W)-1 -> L1 IF ST(W+R) # ST(A+R+1) REPEAT W = A+1+ST(W) RETURN L1: A = ST(A) REPEAT MONITOR(7); K = 1 END ! ! !*** MAIN LOOP *** ! 'STRIP' IS FOR ERROR RECOVERY ! STRIP: -> END FN IF P > F START: MONITOR(0) IF S > STKLIMIT; ! STACK OVERFLOW? NEXT CH K = SYMTYPE(A); -> SW(K) IF K # 0 ! THE ABOVE LINE REPLACES THE TEST-AND-BRANCH SEQUENCE BELOW ! PURELY FOR EFFICIENCY REASONS -- LOGICALLY THERE IS NO CHANGE. ! Q = Q+1 %AND -> Q2 %IF A = '[' ! -> FN %IF A = '$' ! -> NEXT ITEM %IF A = ',' ! -> APPLY %IF A = SEMI-COLON ! -> LOAD ARG %IF A = '¬' ! -> END FN %IF A = MARKER ! -> EXIT %IF A = ']' COPY: LOAD ! SCAN: -> START IF Q = 1 Q2:NEXT CH Q = Q+1 AND -> COPY IF A = LBR; ! ...LEFT BRACKET -> COPY IF A # RBR; ! ...RIGHT BRACKET Q = Q-1; -> START IF Q = 1 -> COPY ! ! [ ... PROTECT FROM EVALUATION SW(6): Q = Q+1 -> Q2 ! SW(1): ! FN: ST(S) = H; ST(S+1) = F; F = S+1 ST(S+2) = 0; ST(S+3) = 0; H = S+3 S = S+4 -> START ! SW(2): ! NEXT ITEM: -> COPY IF H = 0 ST(H) = S-H-ST(H); ST(S) = 0 H = S; S = S+1 -> START ! SW(3): APPLY: MONITOR(1) AND -> COPY IF P > F -> COPY IF H = 0 D1 = ST(F); D2 = ST(F-1) ST(H) = S-H; ST(S) = MARKER ST(F-1) = S-F+2 ST(F) = P ST(F+1) = C P = F; F = D1; H = D2; S = S+1 ST(H) = ST(H)+ST(P-1) IF H # 0 FIND(P+2); -> STRIP IF K # 0 -> MACHINE MACRO(-ST(W)) IF ST(W) < 0 C = W+1 -> START ! SW(4): ! LOAD ARG: IF P = 0 THEN START -> COPY IF H = 0 MONITOR(2); -> COPY FINISH NEXT CH W = P+2 IF '0' <= A <= '9' THEN W1 = A-'0' ELSE START IF 'A' <= A <= 'Z' THEN W1 = A-'A'+10 ELSE START W1 = -1; MONITOR(3); -> STRIP FINISH FINISH WHILE W1 # 0 CYCLE W = W+ST(W) MONITOR(4) AND -> STRIP IF ST(W) = MARKER W1 = W1-1 REPEAT A = ST(W+R) AND LOAD FOR R = 1,1,ST(W)-1 -> START ! SW(5): END FN: IF F > P THEN START MONITOR(5); -> STRIP IF C = 0 C = C-1; -> APPLY FINISH ST(S) = E; A = S WHILE ST(A) >= P-1+ST(P-1) CYCLE D1 = ST(A) ST(A) = D1-ST(P-1) A = D1 REPEAT W = ST(A) W = ST(W) WHILE W > P-1 ST(A) = W; E = ST(S) IF H # 0 THEN START IF H > P THEN H = H-ST(P-1) ELSE ST(H) = ST(H)-ST(P-1) FINISH A = P-1; W = P-1+ST(P-1) S = S-ST(P-1); C = ST(P+1); P = ST(P) WHILE A # S CYCLE ST(A) = ST(W); A = A+1; W = W+1 REPEAT -> START ! SW(7): EXIT: MONITOR(14) AND -> STOP IF C = 0 = H; ! ...TOO MANY ']' MONITOR(8); -> STRIP ! !*** BUILT-IN MACRO'S FOLLOW *** !DEF MACHINE MACRO(1): ST(H) = ST(H)-ST(P-1) IF H # 0 ST(P-1) = E; E = P-1 W = P; P = ST(P) ST(W) = ST(W+6) AND W = W+1 WHILE W+6 # S S = W -> START ! ! VAL MACHINE MACRO(2): FIND(P+6); -> STRIP IF K # 0 WHILE ST(W+1) # MARKER CYCLE A = ST(W+1); W = W+1; LOAD REPEAT -> END FN ! ! UPDATE MACHINE MACRO(3): FIND(P+9); -> STRIP IF K # 0 A = P+9+ST(P+9) MONITOR(9) AND -> STRIP IF ST(A) > ST(W) ST(W+R) = ST(A+R) FOR R = 1,1,ST(A) -> END FN ! ! BIN MACHINE MACRO(4): W = 0; A = P+7 MONITOR(4) AND -> STRIP IF ST(P+6) = MARKER A = P+8 UNLESS '+' # ST(P+7) # '-' WHILE ST(A) # MARKER CYCLE X = ST(A)-'0' MONITOR(10) AND -> STRIP˙ UNLESS 0 <= X <= 9 W = 10*W+X; A = A+1 REPEAT W = -W IF ST(P+7) = '-' MONITOR(4) AND -> STRIP IF A = P+7;! MISSING PARAMETER ST(S) = W; S = S+1 -> END FN ! ! DEC MACHINE MACRO(5): W = ST(P+7) MONITOR(4) AND -> STRIP IF ST(P+6) = MARKER IF W < 0 THEN START W = -W; A = '-'; LOAD FINISH W1 = 1; W1 = 10*W1 WHILE 10*W1 <= W CYCLE D1 = W//W1; D2 = W-D1*W1 D1 = D1+'0'; D3 = W1//10 A = D1; W = D2; W1 = D3 LOAD exit if w1 < 1 REPEAT -> END FN ! ! BAR MACHINE MACRO(6): IF ST(P+6) = MARKER OR ST(P+8) = MARKER C OR ST(P+10) = MARKER THEN MONITOR(4) AND -> STRIP R = ST(P+7); W = ST(P+9); A = ST(P+11) IF R = '+' OR R = '-' THEN START IF R = '+' THEN A = W+A ELSE A = W-A ELSE IF R # '*' AND R # '/' AND R # 'R' C THEN MONITOR(12) AND -> STRIP IF R = '*' THEN A = W*A ELSE START MONITOR(13) AND A = 1 IF A = 0 A = W//A IF R = '/' A = W-A*(W//A) IF R = 'R' FINISH FINISH LOAD -> END FN ! ! DELIMS MACHINE MACRO(7): MONITOR(15) IF ST(P+9) # 7 OR ST(P+16) # MARKER FOR W = P+9+1,1,P+16-1 CYCLE FOR K = W+1,1,P+16 CYCLE ; ! ...CHECKS AGAINST 'MARKER' MONITOR(15) IF ST(W) = ST(K) OR ST(W)<0 OR ST(W)>127 REPEAT REPEAT BEGIN CONSTBYTEINTEGERARRAY M(1:6) = 1,2,3,4,6,7 SYMTYPE(K) = 0 FOR K = 0,1,127 SYMTYPE(ST(P+9+K)) = M(K) FOR K = 1,1,6 LBR = ST(P+9+5); ! ...LEFT BRACKET RBR = ST(P+9+6); ! ...RIGHT BRACKET END -> END FN ! ! STOP: ! FORCE TERMINATION INSTRM = SOURCE ! !*END* MACHINE MACRO(8): ! '*END*' IF INSTRM = DEFN FILE THEN START ; ! READING MACRO DEFN FILE? CLOSE INPUT INSTRM = SOURCE; SELECT INPUT(INSTRM) -> END FN FINISH ! !-------------------------------------------------! ! N.B. ! ! THIS FEATURE USED IN CONJUNCTION WITH ! ! 'DELIMS' AS CURRENTLY IMPLEMENTED CAN ! ! CAUSE ABSOLUTE CHAOS. ! !-------------------------------------------------! ROUTINE DUMP TEXT ! ASSUMES 'W' POINTS TO LENGTH CELL INTEGER END R = 0; END = ST(W)-1 R = R+1 AND PRINT SYMBOL(ST(W+R)) WHILE R # END END IF DUMP >= 0 THEN START SELECT OUTPUT(DUMP) W = E; K = STK LIMIT+1 WHILE W # MSTHEAD CYCLE K = K-1; ST(K) = W; W = ST(W) REPEAT WHILE K <= STK LIMIT CYCLE W = ST(K)+1 PRINT STRING(" $DEF,"); DUMP TEXT; PRINT STRING(",[") W = W+ST(W); ! START OF DEFN BODY DUMP TEXT; PRINT STRING("];"); NEWLINE K = K+1 REPEAT PRINT STRING(" $*END*; ") FINISH ! ! SELECT OUTPUT(REPORT) IF ERROR = 0 C THEN PRINT STRING(" No monitor entries - output O.K. ") C ELSE START PRINT STRING(" ****"); WRITE(ERROR,1) PRINT STRING(" MONITOR ENTRIES - OUTPUT FAULTY ") FINISH WRITE(S,7); PRINT STRING(" out of"); WRITE(STKLIMIT+1,1) PRINT STRING(" cells are occupied.") NEWLINES(2) SIGNAL 0,1 UNLESS ERROR = 0; ! ...TELL NEXT OUTERMOST LEVEL ENDOFPROGRAM