[unix-history] / usr / src / usr.bin / pascal / pxref / pxref.p

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