4.4BSD/usr/src/usr.bin/pascal/pxref/pxref.p
(*
* Copyright (c) 1980, 1993
* The Regents of the University of California. All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* 3. All advertising materials mentioning features or use of this software
* must display the following acknowledgement:
* This product includes software developed by the University of
* California, Berkeley and its contributors.
* 4. Neither the name of the University nor the names of its contributors
* may be used to endorse or promote products derived from this software
* without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
* ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
* SUCH DAMAGE.
*
* @(#)pxref.p 8.1 (Berkeley) 6/6/93
*)
{$t-,p-,b2,w+}
program xref(input, output);
label
99, 100;
const
alfasize = 18;
linesize = 10;
namesize = 64;
linelength = 133;
maxlineno = 30000;
charclassize = 127;
p = 1000;
nk = 36;
blanks = ' ';
type
alfa =
array[1..alfasize] of
char;
index = 0..p;
linptr = 0..linelength;
linebuf = array[1..linelength] of char;
ref = ^item;
filename = array [1..namesize] of char;
charclasses = (digit, letter, separator, illegal);
charclasstype = array[0..charclassize] of charclasses;
word =
record
key: alfa;
first, last: ref;
fol: index
end;
item = packed
record
lno: 0..maxlineno;
next: ref
end;
var
i, top: index;
formfeed :char;
scr: alfa;
list: boolean;
k, k1: integer;
n: integer;
c1, c2: integer;
inputfile : filename;
lineptr :linptr;
line :linebuf;
charclass :charclasstype;
id:
record
case boolean of
false:(
a: alfa
);
true:(
ord: integer
)
end;
a: array [1..alfasize] of char;
t: array [index] of word;
key: array [1..nk] of alfa;
empty: alfa;
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 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) mod p;
d := d + 2;
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 = linesize 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 readinput(var inpfile :filename);
var
inp :file of char;
procedure lwriteln;
begin
if list then begin
{ write sans trailing blanks }
if lineptr > 0 then
writeln(line: lineptr)
else
writeln;
end;
get(inp);
lineptr:=0
end { lwriteln };
procedure newline;
begin
n:=n+1;
if n = maxlineno then begin
writeln(' text too long');
goto 99
end;
if inp^ = formfeed then begin
if list then
page(output);
get(inp)
end;
if list then
if not eoln(inp) then
write(n:6,' ')
end { newline };
begin
reset(inp,inpfile);
while not eof(inp) do begin
newline;
if inp^ = '#' then begin
while inp^ <> '"' do begin
lineptr:=lineptr+1;
read(inp,line[lineptr])
end;
lineptr:=lineptr+1;
read(inp,line[lineptr]);
k:=0;
inputfile:=blanks;
repeat
k:=k+1;
if k <= namesize then
inputfile[k]:=inp^;
lineptr:=lineptr+1;
read(inp,line[lineptr])
until inp^ = '"';
while not eoln(inp) do begin
lineptr:=lineptr+1;
read(inp,line[lineptr])
end;
id.a := '#include';
search;
lwriteln;
readinput(inputfile);
end else begin
while not eoln(inp) do begin
if (inp^ = ' ') or (inp^ = tab) then begin
lineptr:=lineptr+1;
read(inp,line[lineptr])
end else if charclass[ord(inp^)] = letter then begin
k := 0;
a:=blanks;
repeat
k := k + 1;
if k <= alfasize then
a[k] := inp^;
lineptr:=lineptr+1;
read(inp,line[lineptr])
until (charclass[ord(inp^)] <> letter) and
(charclass[ord(inp^)] <> digit);
pack(a, 1, id.a);
if nokey(id.a) then
search
end else if charclass[ord(inp^)] = digit then
repeat
lineptr:=lineptr+1;
read(inp,line[lineptr])
until charclass[ord(inp^)] <> digit
else if inp^='''' then begin
repeat
lineptr:=lineptr+1;
read(inp,line[lineptr])
until inp^ = '''';
lineptr:=lineptr+1;
read(inp,line[lineptr])
end else if inp^ = '{' then begin
repeat
lineptr:=lineptr+1;
read(inp,line[lineptr]);
while eoln(inp) do begin
lwriteln;
newline
end
until inp^ = '}';
lineptr:=lineptr+1;
read(inp,line[lineptr])
end else if inp^ = '(' then begin
lineptr:=lineptr+1;
read(inp,line[lineptr]);
if inp^ = '*' then begin
lineptr:=lineptr+1;
read(inp,line[lineptr]);
repeat
while inp^ <> '*' do
if eoln(inp) then begin
lwriteln;
newline
end else begin
lineptr:=lineptr+1;
read(inp,line[lineptr])
end;
lineptr:=lineptr+1;
read(inp,line[lineptr])
until inp^ = ')';
lineptr:=lineptr+1;
read(inp,line[lineptr])
end
end else begin
lineptr:=lineptr+1;
read(inp,line[lineptr]);
end
end; { scan of token }
lwriteln;
end; { scan of line }
end; { while not eof }
end; {readinput }
begin { xref }
empty := blanks;
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;
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';
for k:= 0 to charclassize do
charclass[k]:=illegal;
for k:=ord('a') to ord('z') do
charclass[k]:=letter;
for k:=ord('A') to ord('Z') do
charclass[k]:=letter;
for k:=ord('0') to ord('9') do
charclass[k]:=digit;
charclass[ord('_')]:=letter;
charclass[ord(' ')]:=separator;
charclass[ord(tab)]:=separator;
n := 0;
lineptr:=0;
line:=blanks;
top := p;
k1 := alfasize;
formfeed:=chr(12);
if list then
argv(1,inputfile)
else
argv(2,inputfile);
readinput(inputfile);
99:
if list then begin
page(output);
writeln;
end;
printtable;
writeln;
writeln(c1, ' identifiers', c2, ' occurrences');
100:
{nil}
end { xref }.