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