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