home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Distributions / ucb / spencer_2bsd.tar.gz / 2bsd.tar / src / pxref / pxref.p < prev   
Text File  |  1980-02-17  |  6KB  |  346 lines
  1. {$p-,t-,b2}
  2. program xref(input, output);
  3. label
  4.     99, 100;
  5. const
  6.     p = 797;
  7.     nk = 36;
  8.     empty = '          ';
  9. type
  10.     index = 0..p;
  11.     ref = ^item;
  12.     word = 
  13.       record
  14.     key: alfa;
  15.     first, last: ref;
  16.     fol: index
  17.       end;
  18.     item =   packed
  19.       record
  20.     lno: 0..9999;
  21.     next: ref
  22.       end;
  23. var
  24.     i, top: index;
  25.     scr: alfa;
  26.     list: boolean;
  27.     k, k1: integer;
  28.     n: integer;
  29.     c1, c2: integer;
  30.     id: 
  31.       record
  32.     case boolean of
  33.       false:(
  34.         a: alfa
  35.       );
  36.       true:(
  37.         ord: integer
  38.       )
  39.       end;
  40.     a: array [1..10] of char;
  41.     t: array [index] of word;
  42.     key: array [1..nk] of alfa;
  43.  
  44.     function letter(ch: char): Boolean;
  45.     begin
  46.     letter := (ch >= 'a') and (ch <= 'z') or (ch >= 'A') and (ch <= 'Z')
  47.     end { letter };
  48.  
  49.     function digit(ch: char): Boolean;
  50.     begin
  51.     digit := (ch >= '0') and (ch <= '9')
  52.     end { digit };
  53.  
  54.     function nokey(x: alfa): Boolean;
  55.     var
  56.     i, j, k: integer;
  57.     begin
  58.     i := 1;
  59.     j := nk;
  60.     repeat
  61.         k := (i + j) div 2;
  62.         if key[k] <= x then 
  63.         i := k + 1;
  64.         if key[k] >= x then 
  65.         j := k - 1
  66.     until i > j;
  67.     nokey := key[k] <> x
  68.     end { nokey };
  69.  
  70.     procedure newline;
  71.     begin
  72.     if n < 9999 then begin
  73.         n := n + 1;
  74.         if list then 
  75.         write(n: 6, '  ')
  76.     end else begin
  77.         writeln(' text too long');
  78.         goto 99
  79.     end
  80.     end { newline };
  81.  
  82.     procedure search;
  83.     var
  84.     h, d: index;
  85.     x: ref;
  86.     f: Boolean;
  87.     begin
  88.     h := id.ord div 4096 mod p;
  89.     f := false;
  90.     d := 1;
  91.     c2 := c2 + 1;
  92.     new(x);
  93.     x^.lno := n;
  94.     x^.next := nil;
  95.     repeat
  96.         if t[h].key = id.a then begin
  97.         f := true;
  98.         t[h].last^.next := x;
  99.         t[h].last := x
  100.         end else if t[h].key = empty then begin
  101.         f := true;
  102.         c1 := c1 + 1;
  103.         t[h].key := id.a;
  104.         t[h].first := x;
  105.         t[h].last := x;
  106.         t[h].fol := top;
  107.         top := h
  108.         end else begin
  109.         h := h + d;
  110.         d := d + 2;
  111.         if h >= p then 
  112.             h := h - p;
  113.         if d = p then begin
  114.             writeln;
  115.             writeln(' **** table full');
  116.             goto 99
  117.         end
  118.         end
  119.     until f
  120.     end { search };
  121.  
  122.     procedure printword(w: word);
  123.     var
  124.     l: integer;
  125.     x: ref;
  126.     begin
  127.     write(' ', w.key);
  128.     x := w.first;
  129.     l := 0;
  130.     repeat
  131.         if l = 20 then begin
  132.         l := 0;
  133.         writeln;
  134.         write(' ', empty)
  135.         end;
  136.         l := l + 1;
  137.         write(x^.lno: 6);
  138.         x := x^.next
  139.     until x = nil;
  140.     writeln
  141.     end { printword };
  142.  
  143.     procedure printtable;
  144.     var
  145.     i, j, m: index;
  146.     begin
  147.     i := top;
  148.     while i <> p do begin
  149.         m := i;
  150.         j := t[i].fol;
  151.         while j <> p do begin
  152.         if t[j].key < t[m].key then 
  153.             m := j;
  154.         j := t[j].fol
  155.         end;
  156.         printword(t[m]);
  157.         if m <> i then begin
  158.         t[m].key := t[i].key;
  159.         t[m].first := t[i].first;
  160.         t[m].last := t[i].last
  161.         end;
  162.         i := t[i].fol
  163.     end
  164.     end { printtable };
  165.  
  166.     procedure openinput(i: integer);
  167.     var
  168.     filename: array [1..64] of char;
  169.     begin
  170.     argv(i, filename);
  171.     reset(input, filename)
  172.     end { openinput };
  173.  
  174.     procedure lwriteln;
  175.     begin
  176.     if list then 
  177.         writeln
  178.     end { lwriteln };
  179.  
  180.     procedure lwrite(c: char);
  181.     begin
  182.     if list then 
  183.         write(c)
  184.     end { lwrite };
  185.  
  186. begin { xref }
  187.     list := true;
  188.     if argc = 3 then begin
  189.     argv(1, scr);
  190.     if (scr[1] <> '-') or (scr[2] <> ' ') then begin
  191.         writeln('usage: pxref [ - ] file');
  192.         goto 100
  193.     end;
  194.     list := false
  195.     end;
  196.     if (argc < 2) or (argc > 3) then begin
  197.     writeln('usage: pxref [ - ] file');
  198.     goto 100
  199.     end;
  200.     if list then 
  201.     openinput(1)
  202.     else 
  203.     openinput(2);
  204.     for i := 0 to p - 1 do 
  205.     t[i].key := empty;
  206.     c1 := 0;
  207.     c2 := 0;
  208.     key[1] := 'and';
  209.     key[2] := 'array';
  210.     key[3] := 'assert';
  211.     key[4] := 'begin';
  212.     key[5] := 'case';
  213.     key[6] := 'const';
  214.     key[7] := 'div';
  215.     key[8] := 'do';
  216.     key[9] := 'downto';
  217.     key[10] := 'else';
  218.     key[11] := 'end';
  219.     key[12] := 'file';
  220.     key[13] := 'for';
  221.     key[14] := 'function';
  222.     key[15] := 'hex';
  223.     key[16] := 'if';
  224.     key[17] := 'in';
  225.     key[18] := 'mod';
  226.     key[19] := 'nil';
  227.     key[20] := 'not';
  228.     key[21] := 'oct';
  229.     key[22] := 'of';
  230.     key[23] := 'or';
  231.     key[24] := 'packed';
  232.     key[25] := 'procedure';
  233.     key[26] := 'program';
  234.     key[27] := 'record';
  235.     key[28] := 'repeat';
  236.     key[29] := 'set';
  237.     key[30] := 'then';
  238.     key[31] := 'to';
  239.     key[32] := 'type';
  240.     key[33] := 'until';
  241.     key[34] := 'var';
  242.     key[35] := 'while';
  243.     key[36] := 'with';
  244.     n := 0;
  245.     top := p;
  246.     k1 := 10;
  247.     while not eof(input) do begin
  248.     if not eoln(input) then 
  249.         newline
  250.     else 
  251.         n := n + 1;
  252.     if input^ = '#' then begin
  253.         while not eoln(input) do begin
  254.         lwrite(input^);
  255.         get(input)
  256.         end;
  257.         id.a := '#include';
  258.         search
  259.     end else 
  260.         while not eoln(input) do begin
  261.         if (input^ = ' ') or (input^ = tab) then begin
  262.             lwrite(input^);
  263.             get(input)
  264.         end else if letter(input^) then begin
  265.             k := 0;
  266.             repeat
  267.             lwrite(input^);
  268.             if k < 10 then begin
  269.                 k := k + 1;
  270.                 a[k] := input^
  271.             end;
  272.             get(input)
  273.             until not (letter(input^) or digit(input^));
  274.             if k >= k1 then 
  275.             k1 := k
  276.             else 
  277.             repeat
  278.                 a[k1] := ' ';
  279.                 k1 := k1 - 1
  280.             until k1 = k;
  281.             pack(a, 1, id.a);
  282.             if nokey(id.a) then 
  283.             search
  284.         end else if digit(input^) then 
  285.             repeat
  286.             lwrite(input^);
  287.             get(input)
  288.             until not digit(input^)
  289.         else if input^ = '''' then begin
  290.             repeat
  291.             lwrite(input^);
  292.             get(input)
  293.             until input^ = '''';
  294.             lwrite('''');
  295.             get(input)
  296.         end else if input^ = '{' then begin
  297.             repeat
  298.             lwrite(input^);
  299.             get(input);
  300.             while eoln(input) do begin
  301.                 lwriteln;
  302.                 get(input);
  303.                 newline
  304.             end
  305.             until input^ = '}';
  306.             lwrite('}');
  307.             get(input)
  308.         end else if input^ = '(' then begin
  309.             lwrite('(');
  310.             get(input);
  311.             if input^ = '*' then begin
  312.             lwrite('*');
  313.             get(input);
  314.             repeat
  315.                 while input^ <> '*' do begin
  316.                 if eoln(input) then begin
  317.                     lwriteln;
  318.                     newline
  319.                 end else 
  320.                     lwrite(input^);
  321.                 get(input)
  322.                 end;
  323.                 lwrite('*');
  324.                 get(input)
  325.             until input^ = ')';
  326.             lwrite(')');
  327.             get(input)
  328.             end
  329.         end else begin
  330.             lwrite(input^);
  331.             get(input)
  332.         end
  333.         end;
  334.     lwriteln;
  335.     get(input)
  336.     end;
  337. 99:
  338.     if list then 
  339.     page(output);
  340.     printtable;
  341.     lwriteln;
  342.     writeln(c1, ' identifiers', c2, ' occurrences');
  343. 100:
  344.     {nil}
  345. end { xref }.
  346.