begin ; !KEYGEN: generate Keyword dict
include "I:UTIL.INC"
!Input streams:-
constinteger old=1
!Output streams:-
constinteger report=0, new=1, list=2
!
constinteger atommax=99
constinteger itembound=500
shortintegerarray item,next(0:itembound)
constinteger dictbound=500
ownshortintegerarray dicthead('a':'z') = 0 (26)
shortintegerarray symbol,cont,alt(0:dictbound)
string (15)array classname(0:atommax)
owninteger dictmax=0
owninteger sym=nl,last=0
on event 9 start
stop
finish
routine croak(string (63) s)
select output(report)
printstring("**".s." Run abandoned ")
cycle
print symbol(sym)
exit if sym = nl
read symbol(sym)
repeat
stop
end
routine read sym
read symbol(sym)
print symbol(sym)
end
routine read(integername v)
!Read numeric item, including terminating symbol
read sym until sym # ' '
croak("Not digit: ".tostring(sym)) unless '0' <= sym <= '9'
v = 0
cycle
v = v*10+sym-'0'
read sym
repeat until not '0' <= sym <= '9'
end
routine read keyword definitions
integer l,class
string (255) s
on event 9 start
croak("Premature end-of-file")
finish
routine read atoms(integer class)
shortintegername p
integer sub
cycle
read sym until sym > ' '
croak("*Not lower-case letter: ".tostring(sym)) unless 'a' <= sym <= 'z'
p == dicthead(sym)
cycle
read sym
exit unless 'a' <= sym <= 'z'
p == alt(p) while 128 > symbol(p) # sym
if symbol(p) >= 128 start
dictmax = dictmax+1
symbol(dictmax) = sym
cont(dictmax) = 0; alt(dictmax) = p
p = dictmax
finish
p == cont(p)
repeat
sub = 0
read(sub) if sym = '_'
p == alt(p) while symbol(p) < 128
if symbol(p) = 128 start
dictmax = dictmax+1
symbol(dictmax) = class+128
cont(dictmax) = 0; alt(dictmax) = sub
p = dictmax
finish else start
select output(report)
print string("Dict clash: ")
print string(classname(class))
newline
select output(new)
finish
repeat until sym # ','
read sym if sym = '}'
read sym while sym = ' '
end
classname(l) = "" for l = 0,1,atommax
cycle
read sym until sym > ' '
l = 0
cycle
l = l+1; length(s) = l
charno(s,l) = sym
read sym
repeat until sym < 'A'
read sym while sym # '='
read(class)
croak("Class out of range") if class > atommax
croak("Duplicate: ".s) if classname(class) # ""
classname(class) = s
read sym while sym = ' '
read atoms(class) if sym = '{'
repeat until sym # ','
end ; !read keyword defs
integerfn dicth(integer i)
integer j
! i = i!32 %if 'A' <= i <= 'Z'
! %if 'a' <= i <= 'z' %start
j = dicthead(i)
j = 1 if j = 0
result = j
! %result = -j
! %finish
! %result = -999 %if '0' <= i <= '9'
! %result = 0 %if i <= ' ' %or i = '{' %or i = '%'
! %result = '%' %if i = '|'
! %result = '¬' %if i = '^'
! %result = '?' %if i > atommax
! %result = i
end
integerfn symb(integer i)
result = item(i)
end
integerfn dnext(integer i)
result = next(i)
end
routine put(integer case,from,to,places,perline)
integer n
print symbol('('); write(from,-1)
print symbol(':'); write(to,-1)
printstring(") = %C")
n = perline
cycle
n = n+1; newline and n = 1 if n > perline
if case = 1 then write(dicth(from),places) c
else if case = 2 then write(symb(from),places) c
else write(dnext(from),places)
from = from+1
exit if from > to
print symbol(',')
repeat
newlines(2)
end
routine put tables
integer i,j,k,dlim
routine linearise(shortintegername qq)
integer p,q
q = qq
return if q = 0
qq = dlim
cycle
item(dlim) = symbol(q); next(dlim) = alt(q)
dlim = dlim+1; q = cont(q)
repeat until q = 0
p = qq; q = dlim-1; !last cell is class_subclass
while p < q cycle
if next(p) # 0 start
linearise(next(p))
next(p) = next(p)-p
finish
p = p+1
repeat
end
routine show(integer i,pos)
integer j
newline and return if i = 0
cycle
j = item(i)
exit if j >= 128
space; print symbol(j)
show(i+1,pos+2)
j = next(i)
return if j = 0
i = i+j
spaces(pos)
repeat
print symbol('.') and pos = pos+1 until pos >= 20
write(j-128,1)
j = next(i)
if j # 0 start
print symbol('[')
write(j,-1)
print symbol(']')
finish
newline
end
item(1) = 128; next(1) = 0
dlim = 2
linearise(dicthead(i)) for i = 'a',1,'z'
select output(list)
newlines(2)
for i = 'a',1,'z' cycle
space; print symbol(i)
show(dicthead(i),2)
repeat
newlines(2)
select output(new)
! printstring("%CONSTSTRING(9)%ARRAY CLASSNAME(")
! write(0,-1); print symbol(':'); write(atommax,-1)
! printstring(") = %C")
! j = 0
! %for i = 0,1,atommax %cycle
! print symbol(',') %unless i = 0
! newline %and j = 5 %if j = 0
! space; print symbol('"')
! %if i <= ' ' %or (i <= atommax %and classname(i) # "") %start
! print string(classname(i))
! %finish %else %start
! k = dicth(i)
! %if k > ' ' %then print symbol(k) %else write(k,-1)
! print symbol(k) %if k = '"'
! %finish
! print symbol('"')
! j = j-1
! %repeat
! newlines(2)
print string("%CONSTSHORTINTEGERARRAY SYMINIT")
put(1,'a','z',-3,16)
print string("%CONSTBYTEINTEGERARRAY SYMBOL")
put(2,1,dlim-1,-3,16)
print string("%CONSTBYTEINTEGERARRAY ALTDISP")
put(3,1,dlim-1,-3,16)
newline
end ; !put tables
ownstring (127) oldfile="",newfile="",listfile=""
define param("Old compiler",oldfile,pamnodefault+paminfile)
define param("New compiler",newfile,pamnewgroup)
define param("Listing",listfile,0)
process parameters(cliparam)
newfile = oldfile if newfile = ""
open output(new,newfile)
open output(list,listfile) if listfile # ""
symbol(0) = 128; cont(0) = 0; alt(0) = 0
select input(old); select output(new)
!Find keyword declarations
last = sym and read sym until last=nl and sym='!' and nextsymbol='~'
read sym until sym = nl
read sym until sym = '%'; read sym until sym = ' '
read keyword definitions
!Find tables
last = sym and read sym until last=nl and sym='!' and nextsymbol='~'
read sym until sym = nl
!Skip existing tables
read symbol(sym) until sym = nl and next symbol = '!'
put tables
cycle
read symbol(sym)
print symbol(sym)
repeat
endofprogram