Annotation of 43BSDReno/pgrm/pascal/pxref/pxref.p, revision 1.1.1.1

1.1       root        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 }.

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.