program hash_demo (input, infile1, output);

{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      STORAGE STRUCTURE  -  DECLARATIONS}

type
  infotype = integer;
  list = ^listype;
  position = list;
  listype = record
              info: infotype;
              next: list
            end;
  bucket = ^bucketype;
  bposition = bucket;
  bucketype = record
                info: infotype;
                contents: list;
                next: bucket
              end;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}

var
  infile1: text;
  S: bucket;
  tsize: integer; {maximum number of buckets}

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

       LIST ADT (WITHOUT HEADER)  -  CODE}

function FIRST (var L: list): position;
  begin
    FIRST:=L
  end;
function ENDLIS (L: list): position;
  begin
    ENDLIS:= nil
  end;
function NEXT (p: position; L:list): position;
  begin
    NEXT:= p^.next
  end;
function LOCATE (x: infotype; L: list): position;
  var
    p: position;
    found: boolean;
  begin
    p:= L;
    found:= false;
    while ((p<>nil) and (not found)) do
      if p^.info = x
        then
          found:= true
        else
          p:= p^.next;
    LOCATE:= p
  end;
function RETRIEVE (p: position; L: list): infotype;
  begin
    RETRIEVE:= p^.info
  end;
procedure DELETE (var p: position; var L: list);
  var
    s,t: position;
  begin
    if p=L
      then
        begin
          L:= L^.next;
          p:= L
        end
      else
        begin
          s:= L;
          t:= L^.next;
          while t<>p do
            begin
              s:= s^.next;
              t:= t^.next
            end;
          s^.next:= p^.next;
          s:= p;
          p:= p^.next;
          dispose (s)
        end
  end;
procedure MAKENULLIS (var L: list);
  begin
    L:=nil
  end;
procedure INSERT (x: infotype; p: position; var L: list);
  var
    q, s, t: position;
  begin
    new(q);
    q^.info:=x;
    if p=L
      then
        begin
          q^.next:= L;
          L:=q
        end
      else
        begin
          s:= L;
          t:= L^.next;
          while t<>p do
            begin
              s:= s^.next;
              t:= t^.next
            end;
          s^.next:= q;
          q^.next:= p
        end
  end;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

        STORAGE  -  CODE}

function HASH (i: infotype; tsize: integer): integer;
  begin
    HASH:= i mod tsize
  end;
function LOCATEB (x: infotype; S: bucket; tsize: integer): bposition;
  var
    p: bposition;
    found: boolean;
  begin
    p:= S;
    found:= false;
    while ((p<>nil) and (not found)) do
      if HASH (p^.info, tsize) = HASH (x, tsize)
        then
          found:= true
        else
          p:= p^.next;
    LOCATEB:= p
  end;
procedure MAKENULLS (var S: bucket);
  begin
    S:= nil
  end;
procedure INSERTB (x: infotype; var S: bucket);
  var
    p,q: bposition;
  begin
    new(q);
    q^.info:= x;
    q^.next:= nil;
    MAKENULLIS(q^.contents);
    if S=nil
      then         {THIS BUCKET IS THE FIRST AND ONLY ELEMENT}
        S:= q
      else         {ADD BUCKET TO THE END OF THE LIST}
        begin
          p:= S;
          while p^.next<>nil do
            p:= p^.next;
          p^.next:= q
        end
  end;
procedure INSERT_CONTENTS (x: infotype; vp: bposition);
  begin
    INSERT (x, ENDLIS(vp^.contents), vp^.contents)
  end;
procedure STAT_PRINT (S: bucket; tsize: integer);
  var
    A: integer; {TO HOLD NUMBER OF ENTRIES FOR EACH BUCKET}
    p: bposition;
    q: position;
    n: integer;
  procedure b_table (n: integer);
    begin
      write ('|');
      while n<>0 do
        begin
          write('*');
          n:= n-1
        end;
      writeln
    end;
  begin
    for n:=0 to tsize-1 do
      begin
        p:= LOCATEB (n, S, tsize);
        if p=nil
          then
            A:= 0   {NOTHING HASHED TO THIS BUCKET, SO IT IS NOT ON THE LIST}
          else
            begin
              A:= 1;
              q:= FIRST(p^.contents);
              while q<>ENDLIS(p^.contents) do
                begin
                  A:= A + 1;       {COUNT UP THE LIST}
                  q:= NEXT (q, p^.contents)
                end;
            end;
        write (n+1:4,'  ',A:6,'     ');       {WRITE ENTRY COUNTS}
        b_table (A)
      end
  end;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}

procedure store_info (i: infotype; var S: bucket; tsize: integer);
  var
    p: bposition;
  begin
    p:= LOCATEB (i, S, tsize);
    if p=nil
      then
        INSERTB (i, S)
      else
        INSERT_CONTENTS (i, p)
  end;
procedure read_in (var f: text; var S: bucket; tsize: integer);
  var
    i: infotype;
    c: integer;
  begin
    c:= 0;    {c is just used to give us 8 numbers per line}
    while not eof(f) do
      begin
        readln (f, i);
        if ((c mod 8 = 0) and (c<>0)) then writeln;
        write (i:10);
        c:=c+1;
        store_info (i, S, tsize)
      end
  end;

    {     *  *  *     MAIN PROGRAM CODE STARTS HERE    *  *  *}

  begin
    reset (infile1);
    MAKENULLS (S);
    readln (tsize);
    writeln;
    read_in (infile1, S, tsize);
    writeln;
    writeln;
    writeln ('MAXIMUM NUMBER OF BUCKETS:-   ',tsize:2);
    writeln;
    writeln ('STORAGE MAP: -');
    writeln;
    writeln ('BUCKET  RECORD');
    writeln ('NUMBER   COUNT');
    STAT_PRINT (S, tsize);
    writeln
  end.