Annotation of 41BSD/cmd/pascal/pxref.p, revision 1.1.1.1

1.1       root        1: {$t-,p-,b2,w+}
                      2: program xref(input, output);
                      3: label
                      4:     99, 100;
                      5: const
                      6:     alfasize = 18;
                      7:     linesize = 10;
                      8:     namesize = 64;
                      9:     linelength = 133;
                     10:     maxlineno = 30000;
                     11:     charclassize = 127;
                     12:     p = 1000;
                     13:     nk = 36;
                     14:     blanks = '  ';
                     15: type
                     16:     alfa = 
                     17:       array[1..alfasize] of 
                     18:        char;
                     19:     index = 0..p;
                     20:     linptr = 0..linelength;
                     21:     linebuf = array[1..linelength] of char;
                     22:     ref = ^item;
                     23:     filename = array [1..namesize] of char;
                     24:     charclasses = (digit, letter, separator, illegal);
                     25:     charclasstype = array[0..charclassize] of charclasses;
                     26:     word = 
                     27:       record
                     28:        key: alfa;
                     29:        first, last: ref;
                     30:        fol: index
                     31:       end;
                     32:     item =   packed
                     33:       record
                     34:        lno: 0..maxlineno;
                     35:        next: ref
                     36:       end;
                     37: var
                     38:     i, top: index;
                     39:     formfeed :char;
                     40:     scr: alfa;
                     41:     list: boolean;
                     42:     k, k1: integer;
                     43:     n: integer;
                     44:     c1, c2: integer;
                     45:     inputfile : filename;
                     46:     lineptr :linptr;
                     47:     line :linebuf;
                     48:     charclass :charclasstype;
                     49:     id: 
                     50:       record
                     51:        case boolean of
                     52:          false:(
                     53:            a: alfa
                     54:          );
                     55:          true:(
                     56:            ord: integer
                     57:          )
                     58:       end;
                     59:     a: array [1..alfasize] of char;
                     60:     t: array [index] of word;
                     61:     key: array [1..nk] of alfa;
                     62:     empty: alfa;
                     63: 
                     64:     function nokey(x: alfa): Boolean;
                     65:     var
                     66:        i, j, k: integer;
                     67:     begin
                     68:        i := 1;
                     69:        j := nk;
                     70:        repeat
                     71:            k := (i + j) div 2;
                     72:            if key[k] <= x then 
                     73:                i := k + 1;
                     74:            if key[k] >= x then 
                     75:                j := k - 1
                     76:        until i > j;
                     77:        nokey := key[k] <> x
                     78:     end { nokey };
                     79: 
                     80:     procedure search;
                     81:     var
                     82:        h, d: index;
                     83:        x: ref;
                     84:        f: Boolean;
                     85:     begin
                     86:        h := id.ord div 4096 mod p;
                     87:        f := false;
                     88:        d := 1;
                     89:        c2 := c2 + 1;
                     90:        new(x);
                     91:        x^.lno := n;
                     92:        x^.next := nil;
                     93:        repeat
                     94:            if t[h].key = id.a then begin
                     95:                f := true;
                     96:                t[h].last^.next := x;
                     97:                t[h].last := x
                     98:            end else if t[h].key = empty then begin
                     99:                f := true;
                    100:                c1 := c1 + 1;
                    101:                t[h].key := id.a;
                    102:                t[h].first := x;
                    103:                t[h].last := x;
                    104:                t[h].fol := top;
                    105:                top := h
                    106:            end else begin
                    107:                h := (h + d) mod p;
                    108:                d := d + 2;
                    109:                if d = p then begin
                    110:                    writeln;
                    111:                    writeln(' **** table full');
                    112:                    goto 99
                    113:                end
                    114:            end
                    115:        until f
                    116:     end { search };
                    117: 
                    118:     procedure printword(w: word);
                    119:     var
                    120:        l: integer;
                    121:        x: ref;
                    122:     begin
                    123:        write(' ', w.key);
                    124:        x := w.first;
                    125:        l := 0;
                    126:        repeat
                    127:            if l = linesize then begin
                    128:                l := 0;
                    129:                writeln;
                    130:                write(' ', empty)
                    131:            end;
                    132:            l := l + 1;
                    133:            write(x^.lno: 6);
                    134:            x := x^.next
                    135:        until x = nil;
                    136:        writeln
                    137:     end { printword };
                    138: 
                    139:     procedure printtable;
                    140:     var
                    141:        i, j, m: index;
                    142:     begin
                    143:        i := top;
                    144:        while i <> p do begin
                    145:            m := i;
                    146:            j := t[i].fol;
                    147:            while j <> p do begin
                    148:                if t[j].key < t[m].key then 
                    149:                    m := j;
                    150:                j := t[j].fol
                    151:            end;
                    152:            printword(t[m]);
                    153:            if m <> i then begin
                    154:                t[m].key := t[i].key;
                    155:                t[m].first := t[i].first;
                    156:                t[m].last := t[i].last
                    157:            end;
                    158:            i := t[i].fol
                    159:        end
                    160:     end { printtable };
                    161: 
                    162:     procedure readinput(var inpfile :filename);
                    163:     var
                    164:     inp :file of char;
                    165:     
                    166:     procedure lwriteln;
                    167:     var
                    168:        i :linptr;
                    169:     begin
                    170:        if list then begin
                    171:            { actually should use ...
                    172:            for i:=1 to lineptr do
                    173:                write(line[i]);
                    174:            }
                    175:            line[lineptr+1]:=chr(0);
                    176:            writeln(line);
                    177:        end;
                    178:        get(inp);
                    179:        line:=blanks;
                    180:        lineptr:=0
                    181:     end { lwriteln };
                    182: 
                    183:     procedure newline;
                    184:     begin
                    185:        n:=n+1;
                    186:        if n = maxlineno then begin
                    187:            writeln(' text too long');
                    188:            goto 99
                    189:        end;
                    190:        if inp^ = formfeed then begin
                    191:            if list then
                    192:                page(output);
                    193:            get(inp)
                    194:        end;
                    195:        if list then
                    196:            if not eoln(inp) then
                    197:                write(n:6,'  ')
                    198:     end { newline };
                    199: 
                    200:     begin
                    201:        reset(inp,inpfile);
                    202:        while not eof(inp) do begin
                    203:            newline;
                    204:            if inp^ = '#' then begin
                    205:                while inp^ <> '"' do begin
                    206:                    lineptr:=lineptr+1;
                    207:                    read(inp,line[lineptr])
                    208:                end;
                    209:                lineptr:=lineptr+1;
                    210:                read(inp,line[lineptr]);
                    211:                k:=0;
                    212:                inputfile:=blanks;
                    213:                repeat
                    214:                    k:=k+1;
                    215:                    if k <= namesize then
                    216:                        inputfile[k]:=inp^;
                    217:                    lineptr:=lineptr+1;
                    218:                    read(inp,line[lineptr])
                    219:                until inp^ = '"';
                    220:                while not eoln(inp) do begin
                    221:                    lineptr:=lineptr+1;
                    222:                    read(inp,line[lineptr])
                    223:                end;
                    224:                id.a := '#include';
                    225:                search;
                    226:                lwriteln;
                    227:                readinput(inputfile);
                    228:            end else begin
                    229:                while not eoln(inp) do begin
                    230:                    if (inp^ = ' ') or (inp^ = tab) then begin
                    231:                        lineptr:=lineptr+1;
                    232:                        read(inp,line[lineptr])
                    233:                    end else if charclass[ord(inp^)] = letter then begin
                    234:                        k := 0;
                    235:                        a:=blanks;
                    236:                        repeat
                    237:                            k := k + 1;
                    238:                            if k <= alfasize then
                    239:                                a[k] := inp^;
                    240:                            lineptr:=lineptr+1;
                    241:                            read(inp,line[lineptr])
                    242:                        until (charclass[ord(inp^)] <> letter) and
                    243:                              (charclass[ord(inp^)] <> digit);
                    244:                        pack(a, 1, id.a);
                    245:                        if nokey(id.a) then 
                    246:                            search
                    247:                    end else if charclass[ord(inp^)] = digit then 
                    248:                        repeat
                    249:                            lineptr:=lineptr+1;
                    250:                            read(inp,line[lineptr])
                    251:                        until charclass[ord(inp^)] <> digit
                    252:                    else if inp^='''' then begin
                    253:                        repeat
                    254:                            lineptr:=lineptr+1;
                    255:                            read(inp,line[lineptr])
                    256:                        until inp^ = '''';
                    257:                        lineptr:=lineptr+1;
                    258:                        read(inp,line[lineptr])
                    259:                    end else if inp^ = '{' then begin
                    260:                        repeat
                    261:                            lineptr:=lineptr+1;
                    262:                            read(inp,line[lineptr]);
                    263:                            while eoln(inp) do begin
                    264:                                lwriteln;
                    265:                                newline
                    266:                            end
                    267:                        until inp^ = '}';
                    268:                        lineptr:=lineptr+1;
                    269:                        read(inp,line[lineptr])
                    270:                    end else if inp^ = '(' then begin
                    271:                        lineptr:=lineptr+1;
                    272:                        read(inp,line[lineptr]);
                    273:                        if inp^ = '*' then begin
                    274:                            lineptr:=lineptr+1;
                    275:                            read(inp,line[lineptr]);
                    276:                            repeat
                    277:                                while inp^ <> '*' do
                    278:                                    if eoln(inp) then begin
                    279:                                        lwriteln;
                    280:                                        newline
                    281:                                    end else begin
                    282:                                        lineptr:=lineptr+1;
                    283:                                        read(inp,line[lineptr])
                    284:                                    end;
                    285:                                lineptr:=lineptr+1;
                    286:                                read(inp,line[lineptr])
                    287:                            until inp^ = ')';
                    288:                            lineptr:=lineptr+1;
                    289:                            read(inp,line[lineptr])
                    290:                        end
                    291:                    end else begin
                    292:                        lineptr:=lineptr+1;
                    293:                        read(inp,line[lineptr]);
                    294:                    end
                    295:                end; { scan of token }
                    296:                lwriteln;
                    297:            end; { scan of line }
                    298:        end; { while not eof }
                    299:     end; {readinput }
                    300: 
                    301: begin { xref }
                    302:     empty := blanks;
                    303:     list := true;
                    304:     if argc = 3 then begin
                    305:        argv(1, scr);
                    306:        if (scr[1] <> '-') or (scr[2] <> ' ') then begin
                    307:            writeln('usage: pxref [ - ] file');
                    308:            goto 100
                    309:        end;
                    310:        list := false
                    311:     end;
                    312:     if (argc < 2) or (argc > 3) then begin
                    313:        writeln('usage: pxref [ - ] file');
                    314:        goto 100
                    315:     end;
                    316:     for i := 0 to p - 1 do 
                    317:        t[i].key := empty;
                    318:     c1 := 0;
                    319:     c2 := 0;
                    320:     key[1] := 'and';
                    321:     key[2] := 'array';
                    322:     key[3] := 'assert';
                    323:     key[4] := 'begin';
                    324:     key[5] := 'case';
                    325:     key[6] := 'const';
                    326:     key[7] := 'div';
                    327:     key[8] := 'do';
                    328:     key[9] := 'downto';
                    329:     key[10] := 'else';
                    330:     key[11] := 'end';
                    331:     key[12] := 'file';
                    332:     key[13] := 'for';
                    333:     key[14] := 'function';
                    334:     key[15] := 'hex';
                    335:     key[16] := 'if';
                    336:     key[17] := 'in';
                    337:     key[18] := 'mod';
                    338:     key[19] := 'nil';
                    339:     key[20] := 'not';
                    340:     key[21] := 'oct';
                    341:     key[22] := 'of';
                    342:     key[23] := 'or';
                    343:     key[24] := 'packed';
                    344:     key[25] := 'procedure';
                    345:     key[26] := 'program';
                    346:     key[27] := 'record';
                    347:     key[28] := 'repeat';
                    348:     key[29] := 'set';
                    349:     key[30] := 'then';
                    350:     key[31] := 'to';
                    351:     key[32] := 'type';
                    352:     key[33] := 'until';
                    353:     key[34] := 'var';
                    354:     key[35] := 'while';
                    355:     key[36] := 'with';
                    356:     for k:= 0 to charclassize do
                    357:        charclass[k]:=illegal;
                    358:     for k:=ord('a') to ord('z') do
                    359:        charclass[k]:=letter;
                    360:     for k:=ord('A') to ord('Z') do
                    361:        charclass[k]:=letter;
                    362:     for k:=ord('0') to ord('9') do
                    363:        charclass[k]:=digit;
                    364:     charclass[ord('_')]:=letter;
                    365:     charclass[ord(' ')]:=separator;
                    366:     charclass[ord(tab)]:=separator;
                    367:     n := 0;
                    368:     lineptr:=0;
                    369:     line:=blanks;
                    370:     top := p;
                    371:     k1 := alfasize;
                    372:     formfeed:=chr(12);
                    373:     if list then
                    374:         argv(1,inputfile)
                    375:     else
                    376:         argv(2,inputfile);
                    377:     readinput(inputfile);
                    378: 99:
                    379:     if list then begin
                    380:        page(output);
                    381:         writeln;
                    382:         end;
                    383:     printtable;
                    384:     writeln;
                    385:     writeln(c1, ' identifiers', c2, ' occurrences');
                    386: 100:
                    387:     {nil}
                    388: end { xref }.

unix.superglobalmegacorp.com

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