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