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