home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / draco / draco-1.ark / XREF.DRC < prev   
Encoding:
Text File  |  1986-11-13  |  5.9 KB  |  277 lines
  1. #util.g
  2.  
  3. /*
  4.  * XREF.DRC - program to produce a procedure cross-reference listing from
  5.  *          a group of .REL files.
  6.  */
  7.  
  8. word
  9.     NAMEMAX = 100,        /* maximum length of procedure name */
  10.     MAXCOL = 80;        /* maximum output columns for listing */
  11.  
  12. type
  13.     ENTRY = struct {
  14.     *ENTRY e_next;
  15.     *char e_name;
  16.     *char e_file;
  17.     *USAGE e_uses;            /* the ones this one uses */
  18.     *USAGE e_references;        /* the ones that use this one */
  19.     },
  20.  
  21.     USAGE = struct {
  22.     *USAGE u_next;
  23.     *ENTRY u_this;
  24.     };
  25.  
  26. *ENTRY Head;
  27.  
  28. file(1024) InputFile, OutputFile;
  29. channel input binary Chin;
  30. channel output text Chout;
  31. bool IgnoreSystem, IgnoreUpper;
  32. [NAMEMAX] char Name;
  33.  
  34. /*
  35.  * getSymbol - read a symbol from the current input file.
  36.  */
  37.  
  38. proc nonrec getSymbol()void:
  39.     *char p;
  40.  
  41.     p := &Name[0];
  42.     while
  43.     read(Chin; p*);
  44.     p* ~= '\e'
  45.     do
  46.     if p ~= &Name[NAMEMAX - 1] then
  47.         p := p + 1;
  48.     fi;
  49.     od;
  50.     p* := '\e';
  51. corp;
  52.  
  53. /*
  54.  * lookup - look up (and possibly enter) a symbol in the symbol chain.
  55.  *        Alphabetical ordering is maintained using insertion.
  56.  */
  57.  
  58. proc nonrec lookUp()*ENTRY:
  59.     **ENTRY e1;
  60.     *ENTRY e;
  61.  
  62.     e1 := &Head;
  63.     while e1* ~= nil and CharsCmp(e1**.e_name, &Name[0]) = LESS do
  64.     e1 := &e1**.e_next;
  65.     od;
  66.     if e1* = nil or CharsCmp(e1**.e_name, &Name[0]) ~= EQUAL then
  67.     e := new(ENTRY);
  68.     e*.e_next := e1*;
  69.     e*.e_name := pretend(Malloc(CharsLen(&Name[0]) + 1), *char);
  70.     CharsCopy(e*.e_name, &Name[0]);
  71.     e*.e_file := nil;
  72.     e*.e_uses := nil;
  73.     e*.e_references := nil;
  74.     e1* := e;
  75.     e
  76.     else
  77.     e1*
  78.     fi
  79. corp;
  80.  
  81. /*
  82.  * insert - insert a useage into a useage chain. Again, alphabetical order
  83.  *        is maintained using list insertion.
  84.  */
  85.  
  86. proc nonrec insert(**USAGE chain; *ENTRY reference)void:
  87.     *USAGE u;
  88.  
  89.     while chain* ~= nil and
  90.         CharsCmp(chain**.u_this*.e_name, reference*.e_name) = LESS do
  91.     chain := &chain**.u_next;
  92.     od;
  93.     u := new(USAGE);
  94.     u*.u_next := chain*;
  95.     u*.u_this := reference;
  96.     chain* := u;
  97. corp;
  98.  
  99. /*
  100.  * processFile - process the currently open .REL file.
  101.  */
  102.  
  103. proc nonrec processFile(*char fileName)void:
  104.     *ENTRY p, q;
  105.     word w, cnt;
  106.     byte b;
  107.  
  108.     read(Chin; w, w, w);    /* magic number, global size, file size */
  109.     while
  110.     getSymbol();
  111.     Name[0] ~= '\e'
  112.     do
  113.     p := lookUp();
  114.     p*.e_file := fileName;
  115.     read(Chin; w, cnt);    /* size of local vars, size of code */
  116.     while cnt ~= 0 do
  117.         cnt := cnt - 1;
  118.         read(Chin; b);
  119.     od;
  120.     /* read 4 sets of relocation information: */
  121.     for b from 1 upto 4 do
  122.         read(Chin; cnt);
  123.         while cnt ~= 0 do
  124.         cnt := cnt - 1;
  125.         read(Chin; w, w);
  126.         od;
  127.     od;
  128.     while
  129.         getSymbol();
  130.         Name[0] ~= '\e'
  131.     do
  132.         if
  133.         if Name[0] = '_' then
  134.             not IgnoreSystem
  135.         elif Name[0] >= 'A' and Name[0] <= 'Z' then
  136.             not IgnoreUpper
  137.         else
  138.             true
  139.         fi
  140.         then
  141.         q := lookUp();
  142.         insert(&p*.e_uses, q);
  143.         insert(&q*.e_references, p);
  144.         fi;
  145.         read(Chin; w);
  146.     od;
  147.     od;
  148. corp;
  149.  
  150. /*
  151.  * printChain - print a chain of procedure names (prettily).
  152.  */
  153.  
  154. proc nonrec printChain(*char message; *USAGE u)void:
  155.     ushort column;
  156.  
  157.     if u ~= nil then
  158.     write(Chout; "    ", message, ':');
  159.     column := MAXCOL;
  160.     while u ~= nil do
  161.         if column + CharsLen(u*.u_this*.e_name) + 2 >= MAXCOL then
  162.         writeln(Chout;);
  163.         write(Chout; "        ");
  164.         column := 8;
  165.         fi;
  166.         column := column + CharsLen(u*.u_this*.e_name);
  167.         write(Chout; u*.u_this*.e_name);
  168.         if u*.u_next ~= nil then
  169.         write(Chout; ", ");
  170.         column := column + 2;
  171.         fi;
  172.         u := u*.u_next;
  173.     od;
  174.     writeln(Chout;);
  175.     fi;
  176. corp;
  177.  
  178. /*
  179.  * printTable - print the accumulated table of interreferences.
  180.  */
  181.  
  182. proc nonrec printTable()void:
  183.  
  184.     while Head ~= nil do
  185.     write(Chout; Head*.e_name);
  186.     if Head*.e_file ~= nil then
  187.         write(Chout; " (", Head*.e_file, ')');
  188.     fi;
  189.     writeln(Chout; ':');
  190.     printChain("uses", Head*.e_uses);
  191.     printChain("is used by", Head*.e_references);
  192.     Head := Head*.e_next;
  193.     od;
  194. corp;
  195.  
  196. /*
  197.  * main - main program.
  198.  */
  199.  
  200. proc nonrec main()void:
  201.     extern
  202.     ListOutput(char ch)void;
  203.     FILENAME fn;
  204.     [15] char nameBuffer;
  205.     *char p;
  206.  
  207.     p := GetPar();
  208.     if p = nil then
  209.     writeln("Use is:  xref [-sup] [-ofile] file1[.rel] ... filen[.rel]");
  210.     exit(1);
  211.     fi;
  212.     open(Chout);
  213.     IgnoreSystem := true;
  214.     IgnoreUpper := true;
  215.     Head := nil;
  216.     while p ~= nil do
  217.     if p* = '-' then
  218.         while
  219.         p := p + 1;
  220.         p* ~= '\e'
  221.         do
  222.         case p*
  223.         incase 'S':
  224.             IgnoreSystem := false;
  225.         incase 'U':
  226.             IgnoreUpper := false;
  227.         incase 'P':
  228.             close(Chout);
  229.             open(Chout, ListOutput);
  230.         incase 'O':
  231.             SetFileName(fn, (p + 1));
  232.             if fn.fn_type[0] = ' ' then
  233.             fn.fn_type[0] := 'X';
  234.             fn.fn_type[1] := 'R';
  235.             fn.fn_type[2] := 'F';
  236.             fi;
  237.             GetFileName(fn, &nameBuffer[0]);
  238.             pretend(FileDestroy(fn), void);
  239.             if not FileCreate(fn) then
  240.             writeln("Can't create file '", &nameBuffer[0],
  241.                 "' - aborting.");
  242.             exit(1);
  243.             fi;
  244.             close(Chout);
  245.             if not open(Chout, OutputFile, &nameBuffer[0]) then
  246.             writeln("Can't open file '", &nameBuffer[0],
  247.                 "' - aborting.");
  248.             exit(1);
  249.             fi;
  250.             p* := '\e';
  251.             p := p - 1;
  252.         default:
  253.             writeln("Invalid flag '", p*, "' - ignored.");
  254.         esac;
  255.         od;
  256.     else
  257.         SetFileName(fn, p);
  258.         if fn.fn_type[0] = ' ' then
  259.         fn.fn_type[0] := 'R';
  260.         fn.fn_type[1] := 'E';
  261.         fn.fn_type[2] := 'L';
  262.         fi;
  263.         GetFileName(fn, &nameBuffer[0]);
  264.         if open(Chin, InputFile, &nameBuffer[0]) then
  265.         p := pretend(Malloc(CharsLen(&nameBuffer[0]) + 1), *char);
  266.         CharsCopy(p, &nameBuffer[0]);
  267.         processFile(p);
  268.         else
  269.         writeln("Can't open file '", &nameBuffer[0], "'.");
  270.         fi;
  271.     fi;
  272.     p := GetPar();
  273.     od;
  274.     printTable();
  275.     close(Chout);
  276. corp;
  277.