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