%begin
   %constinteger magic = 6700421
   %constinteger name bits = 11
   %constinteger max names = b'11111111111';  !!!1<<name bits-1
   %constinteger max d = 40000
   %byteintegerarray d(1:max d)
   %integerarray p,n(0:max names)
   %integer key,k1,k2,dp,sym,j,total,add, num, dflag
   %ownstring(63) word, dword = ""
   %routine read sym
      readsymbol(sym)
      sym = sym-32 %if 'a' <= sym <= 'z'
   %end
   %routine read word(%string(*)%Name word)
      %on %event 9 %start
         word = ""
         %return
      %finish
      word = ""
      key = 0;  dflag = 0
      read sym %until 'A' <= sym <= 'Z' %or sym < 0
      %return %if sym < 0
      %cycle
         key = key<<3!!sym
         word = word.tostring(sym)
         read sym
         word = "" %and %return %if sym < 0
         %exit %unless 'A' <= sym <= 'Z' %or sym = '-'
      %repeat
      dflag = 1 %if sym = '*'
   %end
   %routine include(%integer new, %string(63)%name s)
      printstring(s)
      printsymbol('*') %if new # 0
      newline
   %end
   %routine next word
      include(dflag, dword) %if add # 0
      read word(dword)
   %end
   %predicate correct(%string(*)%name s)
      %cycle
         %false %if dword = ""
         %true %if s = dword
         %if s < dword %start
            include(1, s) %if add # 0 %and length(s) > 2
            %false
         %finish
         next word
      %repeat
   %end
   %routine set(%integer x)
      %string(63)%name sn
      %return %if x > total
      sn == string(addr(d(p(x))))
      x = n(x)
      write(x, -5)
      %if x = 1 %then printstring("<- ") %else printstring("   ")
      printstring(sn)
      spaces(21-length(sn))
   %end
   %routine qsort(%integer a, b)
      %string(63)%name s
      %integer hold, l, u, dump, dumpn
again:%return %if a >= b
      l = a;  u = b
      dump = p(u)
      dumpn = n(u)
      s == string(addr(d(dump)))
      ->find
up:   l = l+1
      ->found %if l = u
find: ->up %unless string(addr(d(p(l)))) > s
      p(u) = p(l)
      n(u) = n(l)
down: u = u-1
      -> found %if l = u
      -> down %unless string(addr(d(p(u)))) < s
      p(l) = p(u)
      n(l) = n(u)
      ->up
found:p(u) = dump
      n(u) = dumpn
      l = l-1;  u = u+1
      %if l-a > b-l %start
         qsort(u, b)
         b = l
      %else
         qsort(a, l)
         a = u
      %finish
      ->again
   %end
   %routine count and sort words
      %integer j, flag, t, limit
      num = -1
      %for j = 0, 1, max names %cycle
         %if p(j) # 0 %start
            num = num+1;  p(num) = p(j);  n(num) = n(j)
         %finish
      %repeat
      qsort(0, num)
   %end
   %routine analyse
      %integer j,k,l,t
      %string(63)%name sn
      count and sort words
      open input(2, "THESIS:GLOSSARY")
      select input(2)
      select output(2)
      add = 0
      next word
      add = 1 %if string(comreg(1)) = "+"
      k = -1
      %for j = 0, 1, num %cycle
         sn == string(addr(d(p(j))))
         %unless correct(sn) %start
            k = k+1
            p(k) = p(j)
            n(k) = n(j)
         %finish
      %repeat
      num = k
      %if add # 0 %start;      !copy dict
         next word %while dword # ""
      %finish
      select output(1)
      total = num
      l = (num+3)>>2
      %for j = 0, 1, l-1 %cycle
         set(j);  set(j+l);  set(j+l+l);  set(j+l+l+l)
         printsymbol(11)
         newline
      %repeat
   %end
   %routine insert
      %integer k1, k2, x
      k1 = key*magic
      k2 = k1>>(32-2*name bits)!1;                     !giving 2*name bits
      k1 = k2>>name bits;                       !giving name bits
      %cycle
         x = p(k1)
         %exit %if x = 0;                !not in
         %if string(addr(d(x))) = word %start
            n(k1) = n(k1)+1
            %return
         %finish
         k1 = (k1+k2)&max names
      %repeat
      p(k1) = dp
      n(k1) = 1
      string(addr(d(dp))) = word
      dp = dp+length(word)+1
   %end
   dp = 1
   %for j = 0, 1, max names %cycle
      p(j) = 0
      n(j) = 0
   %repeat
   printstring("Analysis of file ")
   printstring(string(comreg(3)))
   newlines(2)
   %cycle
      read word(word)
      %exit %if word = ""
      insert
   %repeat
   analyse
%endofprogram
