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) 6/21/85
   7:  *)
   8: 
   9: {$t-,p-,b2,w+}
  10: program xref(input, output);
  11: label
  12:     99, 100;
  13: const
  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 = '  ';
  23: type
  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;
  45: var
  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: 
 305: begin { 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);
 382: 99:
 383:     if list then begin
 384:     page(output);
 385:         writeln;
 386:         end;
 387:     printtable;
 388:     writeln;
 389:     writeln(c1, ' identifiers', c2, ' occurrences');
 390: 100:
 391:     {nil}
 392: end { xref }.
Last modified: 1985-06-22
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 378
Valid CSS Valid XHTML 1.0 Strict