1{$t-,p-,b2,w+} 2program xref(input, output); 3label 4 99, 100; 5const 6 { sccsid = '@(#)pxref.p 1.2 (Berkeley) 03/05/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 = ' '; 16type 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; 38var 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 302begin { 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); 37999: 380 if list then begin 381 page(output); 382 writeln; 383 end; 384 printtable; 385 writeln; 386 writeln(c1, ' identifiers', c2, ' occurrences'); 387100: 388 {nil} 389end { xref }. 390