externalstring (255)fnspec itos(integer i,n) begin routinespec load routinespec nextch routinespec find(integer x) routinespec monitor(integer n) constinteger marker=16_ffffc000 conststring (1) snl = " " ownshortintegerarray st(0:10000)=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(9962) owninteger e=33, s=39 integer a, w, w1, h, p, f, c, q, e0, f0, h0, r string (63) filename switch mcm(1:6) on event 0, 9 start if event_event = 9 then start select input(0) ->start finish else print string(snl."GPM terminated".snl) stop finish a=0 w=0 w1=0 h=0 p=0 f=0 c=0 q=1 start:nextch if a='@' then start read(filename) openinput(1,filename) select input(1) ->start ; finish if a='/' then start read(filename) openoutput(1,filename) select output(1) ->start ; finish 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 for r=0,1,a-'0'-1 cycle w=w+st(w) if st(w)=marker then monitor(4) repeat finish for r=1,1,st(w)-1 cycle 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) cycle e0=st(a) st(a)=e0-st(p-1) a=e0 repeat w=st(a) w=st(w) while w>p-1 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) st(a)=st(w) and a=a+1 and w=w+1 while a#s ->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) a=st(w+1) and w=w+1 and load while st(w+1)#marker ->endfn mcm(3):! update find(p+9) a=p+9+st(p+9) if st(a)>st(w) then monitor(9) for r=1,1,st(a) cycle 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 r=10*r while 10*r<=w a=w//r+'0' and load and w=w-r*(a-'0')and r=r//10 while r>=1 ->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 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 again: for r=0,1,st(w)-1 cycle if st(w+r)#st(a+r+1) then ->next repeat w=a+1+st(w) return next:a=st(a) ->again unless a<0 monitor(7) end {------------------------------------------------------------------------------} routine monitor(integer n) routinespec item(integer x) switch fault(1:10) print string(snl."Monitor : ") ->fault(n) fault(1):print string("Unmatched semicolon in definition of ") item(p+2) ->end fault(2):print string("Unquoted # in argument list of ") item(f+2) ->end fault(3):print string("Impossible argument number in definition of ") item(p+2) ->end fault(4):print string("No argument ") print symbol(a) print string(" in call for ") item(p+2) ->end fault(5):print string("Terminator in ") if c=0 then print string("input stream; GPM error ?") and ->end print string("argument list for ") item(f+2) print string(snl."probably due to semicolon missing from definition of ") item(p+2) ->end fault(6):print string("GPM error?") ->end fault(7):print string("Undefined name ") item(w) ->end fault(8):print string("Unmatched >; GPM error ?") ->end fault(9):print string("Update argument too long for ") item(p+9) ->end fault(10):print string("Non-digit in number ") end: ! general monitor w=20 print string(snl."Current macros are :") while p#0 or f#0 cycle if p>f then start w1=p+2 p=st(p) print string(snl."already entered : ") finish else start w1=f+2 f=st(f) print string(snl."not yet entered : ") finish for r=1,1,w cycle item(w1) if st(w1)=0 then exit w1=w1+st(w1) if st(w1)=marker then exit unless w=1 then start print string(snl."arg".itos(r,1)." : ") finish repeat w=1 repeat print string(snl."End of monitor printing".snl) 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 print symbol(st(x+k)) for k=1, 1, l finish if st(x)=0 then print string("... (incomplete)") end end endofprogram