Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/MADTRB30.ZIP/XREFPAS.PAS

Pascal/Delphi Source File | 1985-04-15 | 6.5 KB | 254 lines

program xrefpas;
(*
 Cross reference generator

 Usage: XREFPAS filename   (subdirectories not supported)

 >>>> This must be compiled by Turbo Pascal(tm) before running <<<<
*)
const
  c1 = 10; { characters per word }
  c2 = 12; { line numbers per printed reference line }
  c3 =  5; { size of displayed line numbers }
type
  wordref = ^word;
  itemref = ^item;
  word = record key: string[c1];
                first, last: itemref;
                left, right: wordref;
         end ;
  item = record lno: integer;
                next: itemref;
         end ;
  state = (none,symbol,quote,com1,pcom2,com2,pcom2x);
var
  param: string[127] absolute cseg:$0080;
  fname: string[14];
  root:  wordref;
  n:     integer;
  id:    string[127];
  fv:    text;
  f:     char;
  scan:  state;
  pageno:integer;
  title: string[4];
procedure newpage;
  begin
    pageno := pageno+1;
    write(lst,#12,title,': ',fname,' ':50,'Page ',pageno:3);
    writeln(lst);
    writeln(lst);
  end {newpage};
procedure writeid;
  function rsvdword: boolean;
    const
      wordlist: array[1..43] of string[9] =
        ('ABSOLUTE','AND','ARRAY','BEGIN','CASE','CONST','DIV',
         'DO','DOWNTO','ELSE','END','EXTERNAL','FILE','FOR',
         'FORWARD','FUNCTION','GOTO','IF','IN','INLINE','LABEL',
         'MOD','NIL','NOT','OF','OR','PACKED','PROCEDURE',
         'PROGRAM','RECORD','REPEAT','SET','SHL','SHR','STRING',
         'THEN','TO','TYPE','UNTIL','VAR','WHILE','WITH','XOR');
    var
      i, j, k: integer;
      upid:    string[127];
    begin
      upid := '';
      for i := 1 to length(id) do
        upid := upid + upcase(copy(id,i,1));
      i := 1;
      j := 43;
      repeat
        k := (i+j) div 2;
        if upid > wordlist[k] then i := k+1
                            else j := k
    until i = j;
    rsvdword := (upid = wordlist[i])
    end {rsvdword};
  procedure search (var w1: wordref);
    var w: wordref;
        x: itemref;
    begin
      w := w1;
      if w = nil then
      begin
        new(w);
        new(x);
        with w^ do
        begin
          key := id;
          left := nil;
          right := nil;
          first := x;
          last := x
        end ;
        x^.lno := n;
        x^.next := nil;
        w1 := w
      end
      else
      if id < w^.key then search(w^.left)
      else
      if id > w^.key then search(w^.right)
      else
      begin
        new(x);
        x^.lno := n;
        x^.next := nil;
        w^.last^.next := x;
        w^.last := x
      end
    end {search} ;
  begin
    if rsvdword then
    begin
      write(lst,#27,#69,id,#27,#70)
    end
    else
    begin
      write(lst,id);
      search(root)
    end
  end {writeid};
procedure printtree (w:wordref);
  procedure printword (w:word);
    var l: integer;
        x: itemref;
    begin
      if (n mod 60) = 0 then newpage;
      write(lst,' ',w.key:c1);
      x := w.first;
      l:= 0;
      repeat
        if l = c2 then
        begin
          writeln(lst);
          n := n+1;
          if (n mod 60) = 0 then newpage;
          write(lst,' ':c1+1);
          l := 0
        end ;
        l := l+1;
        write(lst,x^.lno:c3);
        x := x^.next
      until x = nil;
    writeln(lst);
    n := n+1
    end {printword} ;
  begin if w <> nil then
    begin
      printtree(w^.left);
      printword(w^);
      printtree(w^.right)
    end
  end {printtree} ;
begin
  n := 0;
  repeat
    n := n+1
  until (n > length(param)) or (param[n] <> ' ');
  fname := copy(param,n,length(param)-n+1);
  assign(fv,fname);
  reset(fv);
  root := nil;
  n := 0;
  scan := none;
  pageno := 0;
  title := 'List';
  while not eof(fv) do
  begin
    if (n mod 60) = 0 then newpage;
    n := n+1;
    write(lst,n:c3,' ');
    while not eoln(fv) do
    begin
      read(fv,f);
      case scan of
        none:   begin
                  if f in['a'..'z','A'..'Z','_'] then
                  begin
                    id := f;
                    scan := symbol
                  end
                  else
                  begin
                    write(lst,f);
                    if f = '''' then scan := quote
                    else
                    if f = '{' then scan := com1
                    else
                    if f = '(' then scan := pcom2
                  end
                end;
        symbol: begin
                  if f in['a'..'z','A'..'Z','0'..'9','_'] then
                  begin
                    id := id + f;
                  end
                  else
                  begin
                    writeid;
                    write(lst,f);
                    if f = '''' then scan := quote
                    else
                    if f = '{' then scan := com1
                    else
                    if f = '(' then scan := pcom2
                    else
                    scan := none
                  end
                end;
        quote:  begin
                  write(lst,f);
                  if f = '''' then scan := none
                end;
        com1:   begin
                  write(lst,f);
                  if f = '}' then scan := none
                end;
        pcom2:  begin
                  if f in['a'..'z','A'..'Z','_'] then
                  begin
                    id := f;
                    scan := symbol
                  end
                  else
                  begin
                    write(lst,f);
                    if f = '''' then scan := quote
                    else
                    if f = '{' then scan := com1
                    else
                    if f = '(' then scan := pcom2
                    else
                    if f = '*' then scan := com2
                    else
                    scan := none
                  end
                end;
        com2:   begin
                  write(lst,f);
                  if f = '*' then scan := pcom2x
                end;
        pcom2x: begin
                  write(lst,f);
                  if f = ')' then scan := none
                             else scan := com2
                end;
      end;
    end;
    if scan = symbol then
    begin
      writeid;
      scan := none
    end;
    writeln(lst);
    readln(fv);
  end;
  n := 0;
  pageno := 0;
  title := 'xref';
  printtree(root);
  write(lst,#12)
end.