!!!!!!  Spelling Dictionary Takeon program  !!!!!!!!!!!!!!!!!!
!Input: EMAS lexicon (expanded or compressed)
!      -- also has provision for suffix groups
!  CONVERTED TO RUN ON EMAS KR 3/8/87
!Always creates new TEMP.MAP
!$IF AMDAHL
{%external %routine DGEN %alias "C#DGEN"
{%external %routine %spec emas3integer(%stringname vec,%integername val)
{%external %routine %spec emas3string (%stringname vec, val)
{%external %routine %spec setline %alias "S#SETLINE"(%string(255) param)
!$IF VAX
begin 
externalstring (255)fnspec  cliparam alias  "IMP_CLI_PARAM"
!$FINISH
constinteger  sourcebound=128000
constinteger  dictlength=65536+65536
constinteger  dictbound = dictlength>>2-1
integer  start
string (255) infile, outfile
integer  instr,outstr
byteintegerarray  char(1:sourcebound)
integerarray  alt(0:sourcebound)
integer  sp,i,j,dictstart
constinteger  null='a'-1
owninteger  clusters=0, dmax=0, max=0, words=0, dups=0
constinteger  termbit=1<<16, lastbit=1<<15

integer  map  dict(integer  i)
  signal  event  6 unless  0 <= i <= dictbound
  result  == integer(dictstart+i<<2)
end 

routine  read source dictionary
integer  sym,actsym,slashmap,pre,upper
routine  read sym
integer  k
  k = sym;  read symbol(sym)
  actsym = sym
  if  actsym = '/' start 
    actsym = slashmap;  slashmap = ','
  finish 
 !READ SYM not used for initial symbol
  sym = sym+('a'-'A') and  upper = 1 if  'A' <= sym <= 'Z'
  sym = null if  sym < null
end 

ownintegerarray  pp(0:63) = 0(*)
routine  insert(integer  p)
!Insert (remainder of) word into DICT continuing from PP(P)
integer  p1,i,q
  p1 = p;  q = pp(p)
  cycle ;  !for each character
    read sym and  insert(p) and  return  if  actsym = '('
    q = q+1
    if  q <= dmax start 
      cycle ;  !for each alternative
        if  char(q) = sym start 
          if  sym = null start 
            if  dups = 0 then  print string("* Duplicate:") c 
            else  start 
              print symbol(',')
              newline and  spaces(12) if  dups&7 = 0
            finish 
            for  i = 1,1,p cycle 
              print symbol(char(pp(i)))
            repeat 
            dups = dups+1
          finish 
          exit 
        finish 
        if  alt(q) = 0 start 
          dmax = dmax+1
          alt(q) = dmax;  q = dmax
          char(q) = sym;  alt(q) = 0
          exit 
        finish 
        q = alt(q)
      repeat 
    finish  else  start 
      dmax = q
      char(q) = sym;  alt(q) = 0
    finish 
    p = p+1;  pp(p) = q
    if  sym = null start 
      read sym and  insert(p-1) and  return  if  actsym = '['
      return  if  actsym # ','
    finish 
    read sym
  repeat 
end 

  on  event  9 start 
    words = words-dups;  newline if  dups # 0
    return 
  finish 
  cycle 
    read symbol(sym) until  sym > ' '
    signal  9 if  sym = '$'
    pre = 0;  upper = 0
    if  '0' <= sym <= '9' start 
      pre = sym-'0'
      read symbol(sym)
      if  '0' <= sym <= '9' start 
        pre = pre*10+sym-'0'
        read symbol(sym)
      finish 
      sym = sym+('a'-'A') and  upper = 1 if  'A' <= sym <= 'Z'
    finish 
    if  dmax >= sourcebound-200 start 
      newline
      print string(" **Too many words (source)");  newline
      exit 
    finish 
    words = words+1
    slashmap = '(';  actsym = sym
    insert(pre)
  repeat 
end 

!$IF AMDAHL
{%routine open mapped dictionary
{%external %routine %spec CREATE %alias "s#outfile"(%string (255) FILE,
{   %integer SIZE, HOLE, PROT, %integer %name CONAD, FLAG)
{%conststring(22) dictfile="T#DICT"
{%integer f,length
{  length = dictlength + 32
{  create(dictfile,length,0,0,dictstart,f)
{  %monitor %and %stop %if f # 0
{  integer(dictstart+12) = 4;    ! set filetype
{  integer(dictstart) = length;   !Set size
{  dictstart = dictstart + 32;    !Return data start
{%end
!$IF VAX
routine  open mapped dictionary
!VM mapping routine (Gordon Brebner).  Source is MAP.MAR
externalintegerfnspec  create(string (127) file,
                              integername  start, integer  length)
conststring (22) dictfile="TEMP.MAP"
integer  f,length
  length = dictlength
  f = create(dictfile,dictstart,length)
  monitor  and  stop  if  f&1 = 0
end 
!$FINISH

routine  convert
integer  i,j,k,m,n
integerarray  index(0:255)
integerarray  link(0:dictbound)

integerfn  stored(integer  list)
owninteger  i,j,k,hash
integer  sp1,term,val
  term = 0;  sp1 = sp
  while  list # 0 cycle 
    val = char(list)-null
    if  val # 0 start 
      sp = sp-1;  j = list+1
      if  alt(j) = 0 and  char(j) # null start 
        val = (char(j)-null)<<5+val;  j = j+1
        if  alt(j) = 0 and  char(j) # null start 
          val = (char(j)-null)<<10+val;  j = j+1
        finish 
      finish 
      val = stored(j)+val
      dict(sp) = val
    finish  else  term = termbit
    list = alt(list)
  repeat 
  result  = termbit if  sp = sp1
  val = val+lastbit
  hash = val&255;  j = index(hash)
  while  j # 0 cycle 
    if  dict(j) = val start 
      i = sp;  k = j
      cycle 
        i = i+1;  k = k-1
        sp = sp1 and  result  = (k+1)<<17+term if  i = sp1
      repeat  until  dict(i) # dict(k)
    finish 
    j = link(j)
  repeat 
  i = sp1;  j = max
  cycle 
    max = max+1;  i = i-1
    exit  if  i = sp
    dict(max) = dict(i)
  repeat 
  dict(max) = val
  link(max) = index(hash);  index(hash) = max
  sp = sp1
  clusters = clusters+1
  result  = (j+1)<<17+term
end 

  sp = dictbound+1
  dict(i) = 0 for  i = 0,1,dictbound
  index(i) = 0 for  i = 0,1,255
  max = 127;  i = 1
  cycle 
    dict(char(i)) = stored(i+1)>>17<<2
    i = alt(i)
  repeat  until  i = 0
end ;  !convert

routine  output
integer  i,pos
routine  show(integer  i)
integer  k,kk
  newline and  return  if  i = 0
  cycle 
    k = dict(i)
    space;  print symbol(k&31+null)
    k = k>>5
    if  k&31 # 0 then  print symbol(k&31+null) else  space
    k = k>>5
    if  k&31 # 0 then  print symbol(k&31+null) else  space
    k = k>>5
    if  k&termbit>>15 # 0 then  print symbol('|') else  space
    pos = pos+5;  show(k>>2);  pos = pos-5
    exit  if  k&lastbit>>15 # 0
    i = i+1
    spaces(pos)
  repeat 
end 
  if  outfile # "" start 
    select output(outstr)
    for  i = 'a',1,'z' cycle 
      print symbol(i);  print symbol(':')
      pos = 2;  show(dict(i)>>2)
      newline
    repeat 
    for  i = 'A',1,'Z' cycle 
      if  dict(i) # 0 start 
        print symbol(i);  print symbol(':')
        pos = 2;  show(dict(i)>>2)
        newline
      finish 
    repeat 
    select output(0)
  finish 
end 


!$IF VAX
infile = cliparam
  outfile = "" unless  infile -> infile.("/").outfile
  outstr = 2
  instr = 1
  open input(instr,infile)
  open output(outstr,outfile) if  outfile # ""
!$IF AMDAHL
{  emas3integer("Dictionary;route,in,char;KNTLIB:LEXICON;" %c
{              ."The name of the EMAS LEXICON",instr)
{  emas3string("Output;file,write,notexist,ornull;;Listing of dictionary",outfile)
{  %if outfile # "" %start
{     setline(outfile)
{     emas3integer("Output;route,out,notexist;;",outstr)
{  %finish
!$FINISH
  select input(instr)
  select output(0)
  read source dictionary
  write(words,1);  print string(" words")
  write(dmax,1);  print string(" cells")
  newline
  open mapped dictionary
  convert
  print string(" reduced to");  write(max,1);  print string(" cells")
  write(clusters,5);  print string(" clusters")
  newline
  output
  print string("New VECCE dictionary T#DICT created")
  new line
!$IF AMDAHL
{%end
{%endoffile
!IF VAX
endofprogram 
!$FINISH