# hasher --- create hash table for shared libraries

   define (MAXSIZE, 1001)

   integer i, looks, entries, hash_mod, probe, hash_width
   integer min_hash, fd
   integer getarg, ctoi, getlin, mktemp
   character names (9, MAXSIZE)
   character arg1 (MAXLINE), arg2 (MAXLINE), buf (MAXLINE)
   real hash_depth, min_depth

   integer hash_calc (2)
   longint long_hash_calc
   equivalence (hash_calc (1), long_hash_calc)

   procedure hash_names (hmod) forward

   if (getarg (1, arg1, MAXLINE) == EOF || getarg (2, arg2, MAXLINE) == EOF)
      call error ("Usage:  hasher <table size> <search width>"p)

   i = 1
   hash_mod = ctoi (arg1, i)
   if (hash_mod < 1 | hash_mod > MAXSIZE)
      call error ("Hash table size < 1 or too large"p)
   i = 1
   hash_width = ctoi (arg2, i)
   if (hash_mod - hash_width < 1 || hash_mod + hash_width > MAXSIZE
         || hash_width < 0)
      call error ("Hash size search width too big"p)

   fd = mktemp (READWRITE)
   if (fd == ERR)
      call error ("Can't create temporary file"p)
   call fcopy (STDIN, fd)

   hash_names (hash_mod - hash_width)
   min_depth = hash_depth
   min_hash = hash_mod - hash_width

   for (i = hash_mod - hash_width + 1; i <= hash_mod + hash_width; i += 1) {
      hash_names (i)
      if (hash_depth < min_depth) {
         min_depth = hash_depth
         min_hash = i
         }
      }

   hash_names (min_hash)

   call print (STDOUT, "** Hash table generated by hasher*n"p)
   call print (STDOUT, "HMOD   DATA  *iL*nHTAB   EQU    ***n"p, min_hash)

   for (i = 1; i <= min_hash | names (1, i) ~= 0; i = i + 1) {
      if (names (1, i) == 0)
         call print (STDOUT, "***n       BSZ     6*n"p)
      else {
         call print (STDOUT, "***n       EXT     *s*n"p, names (1, i))
         call print (STDOUT, "       DATA    C'*s'*n"p, names (1, i))
         call print (STDOUT, "       IP      *s*n"p, names (1, i))
         }
      }

   call print (STDOUT, "***n       OCT     0*n"p)

   call print (ERROUT, "entries: *i, table size: *i, search depth: *r*n"p,
      entries, i - 1, min_depth)

   stop

   # hash_names --- hash the names into the table and count probes

      procedure hash_names (hmod) {

      integer hmod
      local i; integer i

      call rewind (fd)

      do i = 1, MAXSIZE
         names (1, i) = 0

      entries = 0
      looks = 0

      while (getlin (buf, fd) ~= EOF) {

         if (buf (1) == '*'c)
            next

         entries = entries + 1

         for (i = length (buf); i <= 8; i = i + 1)
            buf (i) = ' 'c
         buf (9) = EOS

         if (buf (3) == ' 'c && buf (4) == ' 'c) {
            hash_calc (1) = 0
            hash_calc (2) = xor (ls (buf (1), 8), buf (2))
            }
         else if (buf (5) == ' 'c && buf (6) == ' 'c) {
            hash_calc (1) = xor (ls (buf (3), 8), buf (4))
            hash_calc (2) = xor (ls (buf (1), 8), buf (2))
            }
         else if (buf (7) == ' 'c && buf (8) == ' 'c) {
            hash_calc (1) = xor (ls (buf (3), 8), buf (4))
            hash_calc (2) = xor (xor (ls (buf (1), 8), buf (2)),
               xor (ls (buf (5), 8), buf (6)))
            }
         else {
            hash_calc (1) = xor (xor (ls (buf (3), 8), buf (4)),
               xor (ls (buf (7), 8), buf (8)))
            hash_calc (2) = xor (xor (ls (buf (1), 8), buf (2)),
               xor (ls (buf (5), 8), buf (6)))
            }
         hash_calc (1) = and (hash_calc (1), :77777)

         probe = mod (long_hash_calc, intl (hmod)) + 1

         while (names (1, probe) ~= 0) {
            looks = looks + 1
            probe = probe + 1
            if (probe > MAXSIZE)
               call error ("Hash table overflow -- make mod + width bigger"p)
            }

         call scopy (buf, 1, names (1, probe), 1)
         }

      hash_depth = float (looks) / float (entries) + 1.0
      }

   end
