BSD 1 development

[unix-history] / pxref / pxref.p

program xref(input, output);
label
   99, 100;
const
   p = 797;
   nk = 36;
   empty = '          ';
type
   index = 0..p;
   ref = ^item;
   word = 
     record
       key: alfa;
       first, last: ref;
       fol: index
     end;
   item = packed 
     record
       lno: 0..9999;
       next: ref
     end;
var
   i, top: index;
   scr: alfa;
   list: boolean;
   k, k1: integer;
   n: integer;
   c1, c2: integer;
   id: 
     record
       case boolean of
         false:(
           a: alfa
         );
         true:(
           ord: integer
         )
     end;
   a: array [1..10] of char;
   t: array [index] of word;
   key: array [1..nk] of alfa;

   function letter(ch: char): Boolean;
   begin
       letter := (ch >= 'a') and (ch <= 'z') or (ch >= 'A') and (ch <= 'Z')
   end { letter };

   function digit(ch: char): Boolean;
   begin
       digit := (ch >= '0') and (ch <= '9')
   end { digit };

   function nokey(x: alfa): Boolean;
   var
       i, j, k: integer;
   begin
       i := 1;
       j := nk;
       repeat
           k := (i + j) div 2;
           if key[k] <= x then 
               i := k + 1;
           if key[k] >= x then 
               j := k - 1
       until i > j;
       nokey := key[k] <> x
   end { nokey };

   procedure newline;
   begin
       if n < 9999 then begin
           n := n + 1;
           if list then 
               write(n: 6, '  ')
       end else begin
           writeln(' text too long');
           goto 99
       end
   end { newline };

   procedure search;
   var
       h, d: index;
       x: ref;
       f: Boolean;
   begin
       h := id.ord div 4096 mod p;
       f := false;
       d := 1;
       c2 := c2 + 1;
       new(x);
       x^.lno := n;
       x^.next := nil;
       repeat
           if t[h].key = id.a then begin
               f := true;
               t[h].last^.next := x;
               t[h].last := x
           end else if t[h].key = empty then begin
               f := true;
               c1 := c1 + 1;
               t[h].key := id.a;
               t[h].first := x;
               t[h].last := x;
               t[h].fol := top;
               top := h
           end else begin
               h := h + d;
               d := d + 2;
               if h >= p then 
                   h := h - p;
               if d = p then begin
                   writeln;
                   writeln(' **** table full');
                   goto 99
               end
           end
       until f
   end { search };

   procedure printword(w: word);
   var
       l: integer;
       x: ref;
   begin
       write(' ', w.key);
       x := w.first;
       l := 0;
       repeat
           if l = 20 then begin
               l := 0;
               writeln;
               write(' ', empty)
           end;
           l := l + 1;
           write(x^.lno: 6);
           x := x^.next
       until x = nil;
       writeln
   end { printword };

   procedure printtable;
   var
       i, j, m: index;
   begin
       i := top;
       while i <> p do begin
           m := i;
           j := t[i].fol;
           while j <> p do begin
               if t[j].key < t[m].key then 
                   m := j;
               j := t[j].fol
           end;
           printword(t[m]);
           if m <> i then begin
               t[m].key := t[i].key;
               t[m].first := t[i].first;
               t[m].last := t[i].last
           end;
           i := t[i].fol
       end
   end { printtable };

   procedure openinput(i: integer);
   var
       filename: array [1..64] of char;
   begin
       argv(i, filename);
       reset(input, filename)
   end { openinput };

   procedure lwriteln;
   begin
       if list then 
           writeln
   end { lwriteln };

   procedure lwrite(c: char);
   begin
       if list then 
           write(c)
   end { lwrite };

begin { xref }
   list := true;
   if argc = 3 then begin
       argv(1, scr);
       if (scr[1] <> '-') or (scr[2] <> ' ') then begin
           writeln('usage: pxref [ - ] file');
           goto 100
       end;
       list := false
   end;
   if (argc < 2) or (argc > 3) then begin
       writeln('usage: pxref [ - ] file');
       goto 100
   end;
   if list then 
       openinput(1)
   else 
       openinput(2);
   for i := 0 to p - 1 do 
       t[i].key := empty;
   c1 := 0;
   c2 := 0;
   key[1] := 'and';
   key[2] := 'array';
   key[3] := 'assert';
   key[4] := 'begin';
   key[5] := 'case';
   key[6] := 'const';
   key[7] := 'div';
   key[8] := 'do';
   key[9] := 'downto';
   key[10] := 'else';
   key[11] := 'end';
   key[12] := 'file';
   key[13] := 'for';
   key[14] := 'function';
   key[15] := 'hex';
   key[16] := 'if';
   key[17] := 'in';
   key[18] := 'mod';
   key[19] := 'nil';
   key[20] := 'not';
   key[21] := 'oct';
   key[22] := 'of';
   key[23] := 'or';
   key[24] := 'packed';
   key[25] := 'procedure';
   key[26] := 'program';
   key[27] := 'record';
   key[28] := 'repeat';
   key[29] := 'set';
   key[30] := 'then';
   key[31] := 'to';
   key[32] := 'type';
   key[33] := 'until';
   key[34] := 'var';
   key[35] := 'while';
   key[36] := 'with';
   n := 0;
   top := p;
   k1 := 10;
   while not eof(input) do begin
       if not eoln(input) then 
           newline
       else 
           n := n + 1;
       if input^ = '#' then begin
           while not eoln(input) do begin
               lwrite(input^);
               get(input)
           end;
           id.a := '#include';
           search
       end else 
           while not eoln(input) do begin
               if (input^ = ' ') or (input^ = tab) then begin
                   lwrite(input^);
                   get(input)
               end else if letter(input^) then begin
                   k := 0;
                   repeat
                       lwrite(input^);
                       if k < 10 then begin
                           k := k + 1;
                           a[k] := input^
                       end;
                       get(input)
                   until not (letter(input^) or digit(input^));
                   if k >= k1 then 
                       k1 := k
                   else 
                       repeat
                           a[k1] := ' ';
                           k1 := k1 - 1
                       until k1 = k;
                   pack(a, 1, id.a);
                   if nokey(id.a) then 
                       search
               end else if digit(input^) then 
                   repeat
                       lwrite(input^);
                       get(input)
                   until not digit(input^)
               else if input^ = '''' then begin
                   repeat
                       lwrite(input^);
                       get(input)
                   until input^ = '''';
                   lwrite('''');
                   get(input)
               end else if input^ = '{' then begin
                   repeat
                       lwrite(input^);
                       get(input);
                       while eoln(input) do begin
                           lwriteln;
                           get(input);
                           newline
                       end
                   until input^ = '}';
                   lwrite('}');
                   get(input)
               end else if input^ = '(' then begin
                   lwrite('(');
                   get(input);
                   if input^ = '*' then begin
                       lwrite('*');
                       get(input);
                       repeat
                           while input^ <> '*' do begin
                               if eoln(input) then begin
                                   lwriteln;
                                   newline
                               end else 
                                   lwrite(input^);
                               get(input)
                           end;
                           lwrite('*');
                           get(input)
                       until input^ = ')';
                       lwrite(')');
                       get(input)
                   end
               end else begin
                   lwrite(input^);
                   get(input)
               end
           end;
       lwriteln;
       get(input)
   end;
99:
   if list then 
       page(output);
   printtable;
   lwriteln;
   writeln(c1, ' identifiers', c2, ' occurrences');
100:
   {nil}
end { xref }.