%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