home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / XREFPAS.ZIP / XREFPAS.PAS
Encoding:
Pascal/Delphi Source File  |  1986-11-07  |  4.0 KB  |  181 lines
  1. program xrefpas;
  2. {
  3.  Cross reference generator --- based on program 4.8 in
  4.  Wirth's "Algorithms + Data Structures = Programs"
  5.  
  6.  Usage: XREFPAS filename   (subdirectories not supported)
  7.  
  8.  >>>> This must be compiled by Turbo Pascal(tm) before running <<<<
  9. }
  10. const
  11.   c1 = 10;
  12.   c2 =  8;
  13.   c3 =  6;
  14. type
  15.   alfa = array [1..c1] of char;
  16.   wordref = ^word;
  17.   itemref = ^item;
  18.   word = record key: alfa;
  19.                 first, last: itemref;
  20.                 left, right: wordref;
  21.          end ;
  22.   item = record lno: integer;
  23.                 next: itemref;
  24.          end ;
  25.   state = (none,symbol,quote,comment);
  26. var
  27.   param: string[127] absolute cseg:$0080;
  28.   fname: string[14];
  29.   root:  wordref;
  30.   k:     integer;
  31.   n:     integer;
  32.   id:    alfa;
  33.   fv:    text;
  34.   f:     char;
  35.   scan:  state;
  36.   pageno:integer;
  37.   title: string[4];
  38. procedure newpage;
  39.   begin
  40.     pageno := pageno+1;
  41.     write(lst,#12,title,': ',fname,' ':50,'Page ',pageno:3);
  42.     writeln(lst);
  43.     writeln(lst);
  44.   end {newpage};
  45. procedure search (var w1: wordref);
  46.   var w: wordref;
  47.       x: itemref;
  48.   begin
  49.     w := w1;
  50.     if w = nil then
  51.     begin
  52.       new(w);
  53.       new(x);
  54.       with w^ do
  55.       begin
  56.         key := id;
  57.         left := nil;
  58.         right := nil;
  59.         first := x;
  60.         last := x
  61.       end ;
  62.       x^.lno := n;
  63.       x^.next := nil;
  64.       w1 := w
  65.     end
  66.     else
  67.     if id < w^.key then search(w^.left)
  68.     else
  69.     if id > w^.key then search(w^.right)
  70.     else
  71.     begin
  72.       new(x);
  73.       x^.lno := n;
  74.       x^.next := nil;
  75.       w^.last^.next := x;
  76.       w^.last := x
  77.     end
  78.   end {search} ;
  79. procedure printtree (w:wordref);
  80.   procedure printword (w:word);
  81.     var l: integer;
  82.         x: itemref;
  83.     begin
  84.       if (n mod 60) = 0 then newpage;
  85.       write(lst,' ',w.key);
  86.       x := w.first;
  87.       l:= 0;
  88.       repeat
  89.         if l = c2 then
  90.         begin
  91.           writeln(lst);
  92.           n := n+1;
  93.           if (n mod 60) = 0 then newpage;
  94.           write(lst,' ':c1+1);
  95.           l := 0
  96.         end ;
  97.         l := l+1;
  98.         write(lst,x^.lno:c3);
  99.         x := x^.next
  100.       until x = nil;
  101.     writeln(lst);
  102.     n := n+1
  103.     end {printword} ;
  104.   begin if w <> nil then
  105.     begin
  106.       printtree(w^.left);
  107.       printword(w^);
  108.       printtree(w^.right)
  109.     end
  110.   end {printtree} ;
  111. begin
  112.   n := 0;
  113.   repeat
  114.     n := n+1
  115.   until (n > length(param)) or (param[n] <> ' ');
  116.   fname := copy(param,n,length(param)-n+1);
  117.   assign(fv,fname);
  118.   reset(fv);
  119.   root := nil;
  120.   n := 0;
  121.   scan := none;
  122.   pageno := 0;
  123.   title := 'List';
  124.   while not eof(fv) do
  125.   begin
  126.     if (n mod 60) = 0 then newpage;
  127.     n := n+1;
  128.     write(lst,n:c3);
  129.     write(lst,' ');
  130.     while not eoln(fv) do
  131.     begin
  132.       read(fv,f);
  133.       write(lst,f);
  134.       case scan of
  135.         none:   begin
  136.                 if f in['a'..'z','A'..'Z'] then
  137.                 begin
  138.                   k := 1;
  139.                   id[k] := f;
  140.                   scan := symbol
  141.                 end
  142.                 else
  143.                 if f = '''' then scan := quote
  144.                 else
  145.                 if f = '{' then scan := comment
  146.                 end;
  147.         symbol: begin
  148.                 if f in['a'..'z','A'..'Z','0'..'9'] then
  149.                   begin
  150.                     k := k+1;
  151.                     if k <= c1 then id[k] := f
  152.                   end
  153.                 else
  154.                   begin
  155.                     if k < c1 then
  156.                     repeat
  157.                       k := k+1;
  158.                       id[k] := ' ';
  159.                     until k = c1;
  160.                     search(root);
  161.                     scan := none
  162.                   end;
  163.                 end;
  164.         quote:  begin
  165.                 if f = '''' then scan := none
  166.                 end;
  167.         comment:begin
  168.                 if f = '}' then scan := none
  169.                 end;
  170.       end;
  171.     end ;
  172.     writeln(lst);
  173.     readln(fv);
  174.   end ;
  175.   n := 0;
  176.   pageno := 0;
  177.   title := 'xref';
  178.   printtree(root);
  179.   write(lst,#12)
  180. end .
  181.