# 2.11BSD#431 - /usr/src/ucb/PORT/pascal/utilities/pxref.p

       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: 588 |