|
|
1.1 root 1: {$t-,p-,b2,w+}
2: program xref(input, output);
3: label
4: 99, 100;
5: const
6: { sccsid = '@(#)pxref.p 1.2 (Berkeley) 3/5/82'; }
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 }.
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.