home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / pascal2c / cref.p < prev    next >
Text File  |  1992-08-03  |  12KB  |  360 lines
  1.  
  2. $debug$
  3. $ sysprog, partial_eval $
  4.  
  5. program crefprog(input, output);
  6.  
  7.  
  8. const
  9.  {  linesperpage = 139;  }
  10.    maxnamelen = 30;
  11.  
  12.  
  13. type
  14.    str255 = string[255];
  15.  
  16.    occurptr = ^occur;
  17.    occur =
  18.       record
  19.          next : occurptr;
  20.          lnum : integer;
  21.          fnum : integer;
  22.          defn : boolean;
  23.       end;
  24.  
  25.    kinds = (k_normal, k_proc, k_var, k_const, k_type, k_strlit, k_extproc,
  26.             k_kw, k_prockw, k_varkw, k_constkw, k_typekw, k_beginkw);
  27.  
  28.    nodeptr = ^node;
  29.    node =
  30.       record
  31.          left, right : nodeptr;
  32.          name : string[maxnamelen];
  33.          first : occurptr;
  34.          kind : kinds;
  35.       end;
  36.  
  37.  
  38. var
  39.    f : text;
  40.    fn : string[120];
  41.    fnum : integer;
  42.    buf, name : str255;
  43.    good : boolean;
  44.    i, j : integer;
  45.    lnum : integer;
  46.    np, base : nodeptr;
  47.    op : occurptr;
  48.    curkind, section : kinds;
  49.    paren : integer;
  50.    brace : integer;
  51.  
  52.  
  53.  
  54. procedure lookup(var name : str255; var np : nodeptr);
  55.    var
  56.       npp : ^nodeptr;
  57.    begin
  58.       if strlen(name) > maxnamelen then
  59.          setstrlen(name, maxnamelen);
  60.       npp := addr(base);
  61.       while (npp^ <> nil) and (npp^^.name <> name) do
  62.          begin
  63.             if name < npp^^.name then
  64.                npp := addr(npp^^.left)
  65.             else
  66.                npp := addr(npp^^.right);
  67.          end;
  68.       if (npp^ = nil) then
  69.          begin
  70.             new(np);
  71.             npp^ := np;
  72.             np^.name := name;
  73.             np^.first := nil;
  74.             np^.left := nil;
  75.             np^.right := nil;
  76.             np^.kind := k_normal;
  77.          end
  78.       else
  79.          np := npp^;
  80.    end;
  81.  
  82.  
  83. procedure kw(name : str255; kind : kinds);
  84.    var
  85.       np : nodeptr;
  86.    begin
  87.       lookup(name, np);
  88.       np^.kind := kind;
  89.    end;
  90.  
  91.  
  92. procedure cref(np : nodeptr; kind : kinds);
  93.    var
  94.       op : occurptr;
  95.    begin
  96.       new(op);
  97.       op^.next := np^.first;
  98.       np^.first := op;
  99.       op^.lnum := lnum;
  100.       op^.fnum := fnum;
  101.       op^.defn := (kind in [k_var, k_type, k_const, k_proc]);
  102.       if op^.defn or (kind = k_strlit) or
  103.          ((kind = k_extproc) and (np^.kind = k_normal)) then
  104.          np^.kind := kind;
  105.    end;
  106.  
  107.  
  108.  
  109. procedure traverse(np : nodeptr);
  110.    var
  111.       op : occurptr;
  112.       i : integer;
  113.    begin
  114.       if (np <> nil) then
  115.          begin
  116.             traverse(np^.left);
  117.             if np^.kind < k_kw then
  118.                begin
  119.                   case np^.kind of
  120.                      k_var:
  121.                         write(f, 'V:');
  122.                      k_type:
  123.                         write(f, 'T:');
  124.                      k_const:
  125.                         write(f, 'C:');
  126.                      k_proc:
  127.                         write(f, 'P:');
  128.                      k_strlit:
  129.                         write(f, 'S:');
  130.                      k_extproc:
  131.                         write(f, 'E:');
  132.                      k_normal:
  133.                         write(f, 'X:');
  134.                   end;
  135.                   write(f, np^.name);
  136.                   i := 0;
  137.                   op := np^.first;
  138.                   while op <> nil do
  139.                      begin
  140.                         if i = 0 then
  141.                            begin
  142.                               writeln(f);
  143.                               write(f, '   ');
  144.                               i := 5;
  145.                            end;
  146.                         write(f, ' ', op^.lnum:1, '/', op^.fnum:1);
  147.                         if op^.defn then
  148.                            write(f, '*');
  149.                         i := i - 1;
  150.                         op := op^.next;
  151.                      end;
  152.                   writeln(f);
  153.                end;
  154.             traverse(np^.right);
  155.          end;
  156.    end;
  157.  
  158.  
  159.  
  160. begin
  161.    base := nil;
  162.    fnum := 0;
  163.    kw('procedure', k_prockw);
  164.    kw('function', k_prockw);
  165.    kw('var', k_varkw);
  166.    kw('record', k_varkw);
  167.    kw('type', k_typekw);
  168.    kw('const', k_constkw);
  169.    kw('begin', k_beginkw);
  170.    kw('end', k_kw);
  171.    kw('do', k_kw);
  172.    kw('for', k_kw);
  173.    kw('to', k_kw);
  174.    kw('while', k_kw);
  175.    kw('repeat', k_kw);
  176.    kw('until', k_kw);
  177.    kw('if', k_kw);
  178.    kw('then', k_kw);
  179.    kw('else', k_kw);
  180.    kw('case', k_kw);
  181.    kw('of', k_kw);
  182.    kw('div', k_kw);
  183.    kw('mod', k_kw);
  184.    kw('nil', k_kw);
  185.    kw('not', k_kw);
  186.    kw('and', k_kw);
  187.    kw('or', k_kw);
  188.    kw('with', k_kw);
  189.    kw('array', k_kw);
  190.    kw('integer', k_kw);
  191.    kw('char', k_kw);
  192.    kw('boolean', k_kw);
  193.    kw('true', k_kw);
  194.    kw('false', k_kw);
  195.    writeln;
  196.    writeln('Pascal Cross Reference Utility');
  197.    writeln;
  198.    repeat
  199.       fnum := fnum + 1;
  200.       write('Name of cross-reference file #', fnum:1, '? ');
  201.       readln(fn);
  202.       good := true;
  203.       if (fn <> '') then
  204.          begin
  205.             try
  206.                reset(f, fn);
  207.             recover
  208.                if escapecode <> -10 then
  209.                   escape(escapecode)
  210.                else
  211.                   begin
  212.                      good := false;
  213.                      writeln('Can''t read file!');
  214.                   end;
  215.          end
  216.       else
  217.          good := false;
  218.       if good then
  219.          begin
  220.             lnum := 0;
  221.             section := k_normal;
  222.             curkind := k_normal;
  223.             paren := 0;
  224.             while not eof(f) do
  225.                begin
  226.                   lnum := lnum + 1;
  227.                   readln(f, buf);
  228.                   strappend(buf, #0);
  229.                   i := 1;
  230.                   while (buf[i] = ' ') do
  231.                      i := i + 1;
  232.                   repeat
  233.                      while not (buf[i] in ['a'..'z', 'A'..'Z', '0'..'9', '_', #0]) do
  234.                         begin
  235.                            case buf[i] of
  236.                               ':', '=':
  237.                                  if brace = 0 then
  238.                                     curkind := k_normal;
  239.                               ';':
  240.                                  if brace = 0 then
  241.                                     curkind := section;
  242.                               '''':
  243.                                  if brace = 0 then
  244.                                     begin
  245.                                        i := i + 1;
  246.                                        j := i;
  247.                                        while ((buf[i] <> '''') or (buf[i+1] = '''')) and
  248.                                              (buf[i] <> #0) do
  249.                                           begin
  250.                                              if (buf[i] = '''') then
  251.                                                 i := i + 2
  252.                                              else
  253.                                                 i := i + 1;
  254.                                           end;
  255.                                        if (buf[i] = #0) then
  256.                                           i := i - 1;
  257.                                        name := '''' + str(buf, j, i-j) + '''';
  258.                                        lookup(name, np);
  259.                                        cref(np, k_strlit);
  260.                                     end;
  261.                               '(':
  262.                                  if brace = 0 then
  263.                                     if (buf[i+1] = '*') then
  264.                                        begin
  265.                                           brace := 1;
  266.                                           i := i + 1;
  267.                                        end
  268.                                     else
  269.                                        begin
  270.                                           paren := paren + 1;
  271.                                           curkind := k_normal;
  272.                                        end;
  273.                               ')':
  274.                                  if brace = 0 then
  275.                                     paren := paren - 1;
  276.                               '*':
  277.                                  if (buf[i+1] = ')') then
  278.                                     begin
  279.                                        brace := 0;
  280.                                        i := i + 1;
  281.                                     end;
  282.                               '{': brace := 1;
  283.                               '}': brace := 0;
  284.                               otherwise ;
  285.                            end;
  286.                            i := i + 1;
  287.                         end;
  288.                      if (buf[i] <> #0) then
  289.                         begin
  290.                            j := i;
  291.                            if (buf[i] in ['0'..'9']) and (i > 1) and (buf[i-1] = '-') then
  292.                               j := j - 1;
  293.                            while (buf[i] in ['a'..'z', 'A'..'Z', '0'..'9', '_']) do
  294.                               i := i + 1;
  295.                            if brace = 0 then
  296.                               begin
  297.                                  name := str(buf, j, i-j);
  298.                                  for j := 1 to strlen(name) do
  299.                                     if (buf[j] in ['A'..'Z']) then
  300.                                        buf[j] := chr(ord(buf[j]) + 32);
  301.                                  while (buf[i] = ' ') do
  302.                                     i := i + 1;
  303.                                  lookup(name, np);
  304.                                  case np^.kind of
  305.                                     k_varkw:
  306.                                        if paren = 0 then
  307.                                           begin
  308.                                              section := k_var;
  309.                                              curkind := section;
  310.                                           end;
  311.                                     k_typekw:
  312.                                        begin
  313.                                           section := k_type;
  314.                                           curkind := section;
  315.                                        end;
  316.                                     k_constkw:
  317.                                        begin
  318.                                           section := k_const;
  319.                                           curkind := section;
  320.                                        end;
  321.                                     k_prockw:
  322.                                        begin
  323.                                           section := k_normal;
  324.                                           curkind := k_proc;
  325.                                        end;
  326.                                     k_beginkw:
  327.                                        begin
  328.                                           section := k_normal;
  329.                                           curkind := k_normal;
  330.                                        end;
  331.                                     k_kw: ;
  332.                                     otherwise
  333.                                        if (curkind = k_normal) and (buf[i] = '(') then
  334.                                           cref(np, k_extproc)
  335.                                        else
  336.                                           cref(np, curkind);
  337.                                  end;
  338.                               end;
  339.                         end;
  340.                   until buf[i] = #0;
  341.                end;
  342.             if paren <> 0 then
  343.                writeln('Warning: ending paren count = ', paren:1);
  344.             close(f);
  345.          end;
  346.    until fn = '';
  347.    writeln;
  348.    repeat
  349.       write('Output file name: ');
  350.       readln(fn);
  351.    until fn <> '';
  352.    rewrite(f, fn);
  353.    traverse(base);
  354.    close(f, 'save');
  355. end.
  356.  
  357.  
  358.  
  359.  
  360.