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) 06/21/85 7 *) 8 9{$t-,p-,b2,w+} 10program xref(input, output); 11label 12 99, 100; 13const 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 = ' '; 23type 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; 45var 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 305begin { 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); 38299: 383 if list then begin 384 page(output); 385 writeln; 386 end; 387 printtable; 388 writeln; 389 writeln(c1, ' identifiers', c2, ' occurrences'); 390100: 391 {nil} 392end { xref }. 393