BEGIN INTEGER E0,F0,H0,R OWNINTEGER A,W,W1,H,P,F,C=0,S=39,E=33,Q=1,MARKER=X'FFFFC000' SWITCH MCM(1:6) OWNSHORTINTEGERARRAY ST(0:1000)=C -1,4,'D','E','F',-1, 0,4,'V','A','L',-2, 6,7,'U','P','D','A','T','E',-3, 12,4,'B','I','N',-4, 21,4,'D','E','C',-5, 27,4,'B','A','R',-6, 0(962) ROUTINESPEC MONITOR(INTEGER N) ROUTINE LOAD IF H=0 THEN PRINT SYMBOL(A) ELSE ST(S)=A AND S=S+1 END ROUTINE NEXTCH IF C=0 THEN READ SYMBOL(A) ELSE A=ST(C) AND C=C+1 END ROUTINE FIND(INTEGER X) A=E W=X 1: CYCLE R=0,1,ST(W)-1 IF ST(W+R)#ST(A+R+1) THEN ->NEXT REPEAT W=A+1+ST(W) RETURN NEXT:A=ST(A) ->1 UNLESS A<0 MONITOR(7) END EXTERNALROUTINESPEC DEFINE(STRING(63) S) STRING(63) FILENAME START:NEXTCH IF A='[' THEN START READ STRING(FILENAME) DEFINE('STREAM01,'.FILENAME) SELECT INPUT(1) ->START ; FINISH IF A=']' THEN SELECT INPUT(0) AND ->START IF A='<' THEN Q=Q+1 AND ->Q2 IF A='$' THEN ->FN IF A=',' THEN ->NEXT ITEM IF A=';' THEN ->APPLY IF A='#' THEN ->LOAD ARG IF A=MARKER THEN ->ENDFN IF A='>' THEN ->EXIT COPY:LOAD IF Q=1 THEN ->START Q2:NEXTCH IF A='<' THEN Q=Q+1 AND ->COPY IF A#'>' THEN ->COPY Q=Q-1 IF Q=1 THEN ->START ELSE ->COPY FN:ST(S)=H ST(S+1)=F ST(S+2)=0 ST(S+3)=0 H=S+3 F=S+1 S=S+4 ->START NEXT ITEM:IF H=0 THEN ->COPY ST(H)=S-H-ST(H) ST(S)=0 H=S S=S+1 ->START APPLY:IF P>F THEN MONITOR(1) IF H=0 THEN ->COPY ST(H)=S-H ST(S)=MARKER H0=ST(F-1) F0=ST(F) ST(F-1)=S-F+2 ST(F)=P ST(F+1)=C P=F F=F0 H=H0 S=S+1 UNLESS H=0 THEN ST(H)=ST(H)+ST(P-1) FIND(P+2) IF ST(W)<0 THEN ->MCM(-ST(W)) C=W+1 ->START LOADARG:IF P=0 THEN START IF H=0 THEN ->COPY ELSE MONITOR(2) FINISH NEXTCH W=P+2 IF A<'0' THEN MONITOR(3) IF A>'0' THEN START CYCLE R=0,1,A-'0'-1 W=W+ST(W) IF ST(W)=MARKER THEN MONITOR(4) REPEAT FINISH CYCLE R=1,1,ST(W)-1 A=ST(W+R) LOAD REPEAT ->START ENDFN:IF F>P THEN MONITOR(5) ST(S)=E A=S WHILE ST(A)>=P-1+ST(P-1) THEN E0=ST(A) AND C ST(A)=E0-ST(P-1) AND A=E0 W=ST(A) WHILE W>P-1 THEN W=ST(W) ST(A)=W E=ST(S) UNLESS 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=A+ST(P-1) C=ST(P+1) S=S-ST(P-1) P=ST(P) WHILE A#S THEN ST(A)=ST(W) AND A=A+1 AND W=W+1 ->START EXIT:UNLESS C=H=0 THEN MONITOR(8) STOP MCM(1):! DEF UNLESS H=0 THEN ST(H)=ST(H)-ST(P-1)+6 ST(P-1)=6 ST(P+5)=E E=P+5 ->ENDFN MCM(2):! VAL FIND(P+6) WHILE ST(W+1)#MARKER THEN A=ST(W+1) AND W=W+1 AND LOAD ->ENDFN MCM(3):! UPDATE FIND(P+9) A=P+9+ST(P+9) IF ST(A)>ST(W) THEN MONITOR(9) CYCLE R=1,1,ST(A) ST(W+R)=ST(A+R) REPEAT ->ENDFN MCM(4):! BIN W=0 IF ST(P+7)='+' OR ST(P+7)='-' THEN A=P+8 ELSE A=P+7 WHILE ST(A)#MARKER CYCLE UNLESS '0'<=ST(A)<='9' THEN MONITOR(10) W=10*W+ST(A)-'0' A=A+1 REPEAT IF ST(P+7)='-' THEN ST(S)=-W ELSE ST(S)=W S=S+1 ->ENDFN MCM(5):! DEC W=ST(P+7) IF W<0 THEN W=-W AND A='-' AND LOAD R=1 WHILE 10*R<=W THEN R=10*R WHILE R>=1 THEN A=W//R+'0' AND LOAD AND W=W-R*(A-'0')AND R=R//10 ->ENDFN MCM(6):! BAR W=ST(P+9) A=ST(P+11) IF ST(P+7)='+' THEN A=W+A IF ST(P+7)='-' THEN A=W-A IF ST(P+7)='*' THEN A=W*A IF ST(P+7)='/' THEN A=W//A IF ST(P+7)='R' THEN A=W-W//A*A LOAD ->ENDFN ROUTINE MONITOR(INTEGER N) ROUTINESPEC ITEM(INTEGER X) SWITCH FAULT(1:10) PRINT STRING(' MONITOR : ') ->FAULT(N) FAULT(1):PRINT STRING('UNMATCHED SEMICOLON IN DEFINITION OF ') ITEM(P+2) ->11 FAULT(2):PRINT STRING('UNQUOTED # IN ARGUMENT LIST OF ') ITEM(F+2) ->11 FAULT(3):PRINT STRING('IMPOSSIBLE ARGUMENT NUMBER IN DEFINITION OF ') ITEM(P+2) ->11 FAULT(4):PRINT STRING('NO ARGUMENT ') PRINT SYMBOL(A) PRINT STRING(' IN CALL FOR ') ITEM(P+2) ->11 FAULT(5):PRINT STRING('TERMINATOR IN ') IF C=0 THEN PRINT STRING('INPUT STREAM. GPM ERROR ?') AND ->11 PRINT STRING('ARGUMENT LIST FOR ') ITEM(F+2) PRINT STRING(' PROBABLY DUE TO SEMICOLON MISSING FROM DEFINITION OF ') ITEM(P+2) ->11 FAULT(7):PRINT STRING('UNDEFINED NAME ') ITEM(W) ->11 FAULT(8):PRINT STRING('UNMATCHED >. GPM ERROR ?') ->11 FAULT(9):PRINT STRING('UPDATE ARGUMENT TOO LONG FOR ') ITEM(P+9) ->11 FAULT(10):PRINT STRING('NON-DIGIT IN NUMBER ') 11:! GENERAL MONITOR W=20 PRINT STRING(' CURRENT MACROS ARE :') WHILE P#0 OR F#0 CYCLE IF P>F THEN W1=P+2 AND P=ST(P) AND PRINT STRING(' ALREADY ENTERED : ') ELSE W1=F+2 AND F=ST(F) AND PRINT STRING(' NOT YET ENTERED : ') CYCLE R=1,1,W ITEM(W1) IF ST(W1)=0 THEN EXIT W1=W1+ST(W1) IF ST(W1)=MARKER THEN EXIT UNLESS W=1 THEN PRINT STRING(' ARG') AND WRITE(R,1) AND PRINT STRING(' : ') REPEAT W=1 REPEAT PRINT STRING(' END OF MONITOR PRINTING ') STOP ROUTINE ITEM(INTEGER X) INTEGER K,L IF ST(X)=0 THEN L=S-X-1 ELSE L=ST(X)-1 IF L>0 THEN START CYCLE K=1,1,L PRINT SYMBOL(ST(X+K)) REPEAT FINISH IF ST(X)=0 THEN PRINT STRING('... (INCOMPLETE)') END END ENDOFPROGRAM