%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