home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-385-Vol-1of3.iso / m / miscpas.zip / CROSSREF.PAS < prev    next >
Pascal/Delphi Source File  |  1987-10-04  |  11KB  |  388 lines
  1. PROGRAM CROSSREF; (*$R-,K-*)
  2.  
  3. (* This program will generate a cross reference map of any    *)
  4. (* SURPAS Pascal program, i.e. a map that lists all identifiers    *)
  5. (* used within the program as well as the line numbers of all    *)
  6. (* lines that contain references to the identifiers. Optional-    *)
  7. (* ly, a source listing with line numbers may be output.    *)
  8.  
  9. (* On processing the input file, all identifiers are extracted    *)
  10. (* and compared with the reserved words of SURPAS Pascal. If an    *)
  11. (* identifier is not a reserved word, it is entered into a    *)
  12. (* binary tree. Each entry in the binary tree contains a poin-    *)
  13. (* ter to the identifier, and a left node and a right node    *)
  14. (* pointer to subsequent entries (or NIL if no entries follow).    *)
  15. (* Furthermore, an entry contains a pointer to the first re-    *)
  16. (* cord in a line number reference chain, and a pointer to the    *)
  17. (* last record in that chain. When an identifier is entered    *)
  18. (* into the tree for the first time, the program allocates both    *)
  19. (* a new identifier record and a line number reference record.    *)
  20. (* Subsequent references to that identifier will then expand    *)
  21. (* the line number reference chain, provided that the line num-    *)
  22. (* ber is not the same as that of the last reference.        *)
  23.  
  24. (* When all lines have been processed, the program traverses    *)
  25. (* the binary tree, printing all identifiers along with the    *)
  26. (* numbers of the lines within which they are referenced.    *)
  27.  
  28. CONST
  29.  
  30. (* Various constants.                        *)
  31.  
  32.   MAXDOTS = 50;        (* Max number of dots per line on CRT *)
  33.   NOFRWORDS = 44;    (* Number of reserved words *)
  34.   FORMFEED = ^L;    (* Form-feed character *)
  35.  
  36. (* Table of reserved words.                    *)
  37.  
  38.   RWORDS: ARRAY[1..NOFRWORDS] OF STRING[9] = (
  39.     'AND','ARRAY','AT','BEGIN','CASE','CODE','CONST','DIV','DO',
  40.     'DOWNTO','ELSE','END','EXOR','EXTERNAL','FILE','FOR','FORWARD',
  41.     'FUNCTION','GOTO','IF','IN','LABEL','MOD','NIL','NOT','OF',
  42.     'OR','OTHERWISE','PACKED','PROCEDURE','PROGRAM','RECORD',
  43.     'REPEAT','SET','SHL','SHR','STRING','THEN','TO','TYPE','UNTIL',
  44.     'VAR','WHILE','WITH');
  45.  
  46. TYPE
  47.  
  48. (* Identifier types. The maximum length is 64 characters.    *)
  49.  
  50.   IDENTPTR = ^IDENT;
  51.   IDENT = STRING[64];
  52.  
  53. (* Line record types. Each line record contains the number of a    *)
  54. (* line, within which a given identifier is referenced, and a    *)
  55. (* pointer to the next line record.                *)
  56.  
  57.   LINERECPTR = ^LINEREC;
  58.   LINEREC = RECORD
  59.           NUMBER: INTEGER;
  60.           NEXT: LINERECPTR;
  61.         END;
  62.  
  63. (* Identifier record types. Each identifier record contains a    *)
  64. (* pointer to the identifier string, a pointer to the first and    *)
  65. (* the last line record in the reference chain, and a left node    *)
  66. (* and a right node pointer to subsequent entries in the binary    *)
  67. (* tree.                            *)
  68.  
  69.   IDENTRECPTR = ^IDENTREC;
  70.   IDENTREC = RECORD
  71.            ID: IDENTPTR;
  72.            FIRSTLINE,LASTLINE: LINERECPTR;
  73.            LEFT,RIGHT: IDENTRECPTR;
  74.          END;
  75.  
  76. (* Source line type. The maximum length of a source line is 127    *)
  77. (* characters.                            *)
  78.  
  79.   SOURCELINE = STRING[127];
  80.  
  81. (* Reserved word table pointers type. Each element points to    *)
  82. (* the first reserved word, that starts with the character gi-    *)
  83. (* ven by the index.                        *)
  84.  
  85.   RWORDTP = ARRAY['A'..'Z'] OF INTEGER;
  86.  
  87. VAR
  88.  
  89. (* Global variables.                        *)
  90.  
  91.   LINENUMBER,        (* Current line number *)
  92.   NOFIDENTS,        (* Number of identifiers processed *)
  93.   POS,            (* Position within current line *)
  94.   LINELEN: INTEGER;    (* Length of current line *)
  95.   CH: CHAR;        (* Current character *)
  96.   LISTING,        (* True if source listing requested *)
  97.   ERROR: BOOLEAN;    (* Error flag *)
  98.   LINE: SOURCELINE;    (* Current source line *)
  99.   IDTREE: IDENTRECPTR;    (* Root of cross reference tree *)
  100.   FIRSTRWORD: RWORDTP;    (* Pointers to reserved word table *)
  101.   INFILE,        (* Input file *)
  102.   OUTFILE: TEXT;    (* Output file *)
  103.  
  104. (* FREEMEM returns the number of bytes available on the heap.    *)
  105. (* The result type is real to allow for values outside the in-    *)
  106. (* teger range.                            *)
  107.  
  108. FUNCTION FREEMEM: REAL;
  109. BEGIN
  110.   IF MEMAVAIL>0 THEN
  111.   FREEMEM:=MEMAVAIL*16.0 ELSE
  112.   FREEMEM:=65536.0-MEMAVAIL*16.0;
  113. END;
  114.  
  115. (* NEXTCH reads the next character from the input file into CH.    *)
  116. (* If a source listing was requested, NEXTCH lists input lines    *)
  117. (* to the output file as they are read. Otherwise, a dot is    *)
  118. (* printed on the console for each line read. A ^Z character is    *)
  119. (* returned on reaching the end of the input file.        *)
  120.  
  121. PROCEDURE NEXTCH;
  122. VAR
  123.   P,T: INTEGER;
  124. BEGIN
  125.   IF (POS<=LINELEN) THEN
  126.   BEGIN
  127.     CH:=LINE[POS]; POS:=POS+1;
  128.     IF (CH>='a') AND (CH<='z') THEN CH:=CHR(ORD(CH)-32);
  129.   END ELSE
  130.   IF NOT EOF(INFILE) THEN
  131.   BEGIN
  132.     READLN(INFILE,LINE); LINENUMBER:=LINENUMBER+1;
  133.     IF LISTING THEN
  134.     BEGIN
  135.       WRITE(OUTFILE,'<',LINENUMBER:5,'> ');
  136.       T:=8;
  137.       FOR P:=1 TO LEN(LINE) DO
  138.       IF LINE[P]<>^I THEN
  139.       BEGIN
  140.     WRITE(OUTFILE,LINE[P]); T:=T-1; IF T=0 THEN T:=8;
  141.       END ELSE
  142.       BEGIN
  143.     WRITE(OUTFILE,'':T); T:=8;
  144.       END;
  145.       WRITELN(OUTFILE);
  146.     END ELSE
  147.     BEGIN
  148.       WRITE('.');
  149.       IF LINENUMBER MOD MAXDOTS=0 THEN WRITELN;
  150.     END;
  151.     LINELEN:=LEN(LINE); POS:=1; CH:=' ';
  152.   END ELSE
  153.   CH:=^Z;
  154. END;
  155.  
  156. (* INITIALIZE is used to initialize input and output files and    *)
  157. (* all global variables.                    *)
  158.  
  159. PROCEDURE INITIALIZE;
  160. LABEL EXIT;
  161. VAR
  162.   I: INTEGER;
  163.   MATCH: BOOLEAN;
  164.   INNAME,OUTNAME: STRING[14];
  165.   LISTYN: STRING[1];
  166. BEGIN
  167.   ERROR:=FALSE;
  168.   WRITELN;
  169.   WRITELN('    SURPAS PASCAL CROSS REFERENCE GENERATOR');
  170.   WRITELN;
  171.   WRITELN('                  Version 1.1');
  172.   WRITELN;
  173.   WRITELN('             Copyright (C) 1983 by');
  174.   WRITELN('           Poly-Data microcenter ApS');
  175.   WRITELN;
  176.   WRITELN;
  177.   WRITE('Input file name? '); READLN(INNAME);
  178.   WRITE('Output file name (default printer)? '); READLN(OUTNAME);
  179.   WRITE('Print source listing (Y/N)? '); READLN(LISTYN);
  180.   WRITELN;
  181.   ASSIGN(INFILE,INNAME); (*$I-*) RESET(INFILE) (*$I+*);
  182.   IF IORES>0 THEN
  183.   BEGIN
  184.     WRITELN('INPUT FILE ERROR');
  185.     ERROR:=TRUE; GOTO EXIT;
  186.   END;
  187.   IF OUTNAME='' THEN OUTNAME:='LST:';
  188.   ASSIGN(OUTFILE,OUTNAME); (*$I-*) REWRITE(OUTFILE) (*$I+*);
  189.   IF IORES>0 THEN
  190.   BEGIN
  191.     WRITELN('OUTPUT FILE ERROR');
  192.     ERROR:=TRUE; GOTO EXIT;
  193.   END;
  194.   LISTING:=(LISTYN='Y') OR (LISTYN='y');
  195.   IDTREE:=NIL;
  196.   I:=1;
  197.   FOR CH:='A' TO 'Z' DO
  198.   BEGIN
  199.     FIRSTRWORD[CH]:=I; MATCH:=TRUE;
  200.     WHILE (I<=NOFRWORDS) AND MATCH DO
  201.     BEGIN
  202.       MATCH:=RWORDS[I][1]=CH; IF MATCH THEN I:=I+1;
  203.     END;
  204.   END;
  205.   LINENUMBER:=0; NOFIDENTS:=0;
  206.   POS:=1; LINELEN:=0; NEXTCH;
  207.   EXIT:
  208. END;
  209.  
  210. (* PROCESSFILE processes the input file, creating a cross refe-    *)
  211. (* rence binary tree.                        *)
  212.  
  213. PROCEDURE PROCESSFILE;
  214. VAR
  215.   IFREE: REAL;
  216.  
  217. (* GETSYMBOL reads the next symbol from the input file. If the    *)
  218. (* symbol is an identifier, it is processed using PROCESSIDENT    *)
  219. (* below.                            *)
  220.  
  221. PROCEDURE GETSYMBOL;
  222. CONST
  223.   ALPHANUMS: SET OF '0'..'Z' = ['0'..'9','A'..'Z'];
  224.   HEXDIGITS: SET OF '0'..'F' = ['0'..'9','A'..'F'];
  225.  
  226. (* PROCESSIDENT reads an identifier and enters it into the    *)
  227. (* cross reference binary tree, provided that it is not a re-    *)
  228. (* served word.                            *)
  229.  
  230. PROCEDURE PROCESSIDENT;
  231. VAR
  232.   I,MAX: INTEGER;
  233.   NOTFOUND: BOOLEAN;
  234.   NEWID: IDENT;
  235.   X: LINERECPTR;
  236.  
  237. (* ENTERID enters NEWID into the cross reference binary tree.    *)
  238. (* Note that an identifier record is allocated only if the    *)
  239. (* identifier is not already within the tree. Also note the use    *)
  240. (* of the ALLOCATE procedure to allocate only the required num-    *)
  241. (* ber of bytes for the identifier instead of the full maximum    *)
  242. (* length.                            *)
  243.  
  244. PROCEDURE ENTERID(VAR ROOT: IDENTRECPTR);
  245. BEGIN
  246.   IF ROOT=NIL THEN
  247.   BEGIN
  248.     NOFIDENTS:=NOFIDENTS+1;
  249.     NEW(ROOT);
  250.     WITH ROOT^ DO
  251.     BEGIN
  252.       ALLOCATE(ID,LEN(NEWID)+1); ID^:=NEWID;
  253.       NEW(FIRSTLINE);
  254.       FIRSTLINE^.NUMBER:=LINENUMBER; FIRSTLINE^.NEXT:=NIL;
  255.       LASTLINE:=FIRSTLINE;
  256.       LEFT:=NIL; RIGHT:=NIL;
  257.     END;
  258.   END ELSE
  259.   IF NEWID<ROOT^.ID^ THEN ENTERID(ROOT^.LEFT) ELSE
  260.   IF NEWID>ROOT^.ID^ THEN ENTERID(ROOT^.RIGHT) ELSE
  261.   WITH ROOT^ DO
  262.   BEGIN
  263.     IF LINENUMBER<>LASTLINE^.NUMBER THEN
  264.     BEGIN
  265.       NEW(X); X^.NUMBER:=LINENUMBER; X^.NEXT:=NIL;
  266.       LASTLINE^.NEXT:=X;
  267.       LASTLINE:=X;
  268.     END;
  269.   END;
  270. END;
  271.  
  272. BEGIN (*PROCESSIDENT*)
  273.   IF CH='_' THEN
  274.   BEGIN
  275.     I:=NOFRWORDS; MAX:=NOFRWORDS;
  276.   END ELSE
  277.   BEGIN
  278.     I:=FIRSTRWORD[CH];
  279.     IF CH<'Z' THEN MAX:=FIRSTRWORD[SUCC(CH)] ELSE MAX:=NOFRWORDS;
  280.   END;
  281.   NEWID:='';
  282.   REPEAT
  283.     NEWID:=NEWID+CH; NEXTCH;
  284.   UNTIL NOT(CH IN ALPHANUMS);
  285.   NOTFOUND:=TRUE;
  286.   WHILE (I<MAX) AND NOTFOUND DO
  287.   BEGIN
  288.     NOTFOUND:=NEWID<>RWORDS[I]; I:=I+1;
  289.   END;
  290.   IF NOTFOUND THEN ENTERID(IDTREE);
  291. END;
  292.  
  293. BEGIN (*GETSYMBOL*)
  294.   CASE CH OF
  295.     'A'..'Z','_':
  296.       PROCESSIDENT;
  297.     '''':
  298.       REPEAT
  299.     REPEAT NEXTCH UNTIL (CH='''') OR (CH=^Z);
  300.     NEXTCH;
  301.       UNTIL CH<>'''';
  302.     '$':
  303.       REPEAT NEXTCH UNTIL NOT(CH IN HEXDIGITS);
  304.     '{':
  305.       BEGIN
  306.     REPEAT NEXTCH UNTIL (CH='}') OR (CH=^Z);
  307.     NEXTCH;
  308.       END;
  309.     '(':
  310.       BEGIN
  311.     NEXTCH;
  312.     IF CH='*' THEN
  313.     BEGIN
  314.       REPEAT
  315.         REPEAT NEXTCH UNTIL (CH='*') OR (CH=^Z);
  316.         NEXTCH;
  317.       UNTIL (CH=')') OR (CH=^Z);
  318.       NEXTCH;
  319.     END;
  320.       END;
  321.   OTHERWISE
  322.     NEXTCH;
  323.   END;
  324. END;
  325.  
  326. BEGIN (*PROCESSFILE*)
  327.   IFREE:=FREEMEM;
  328.   WHILE (CH<>^Z) AND (FREEMEM>100.0) DO GETSYMBOL;
  329.   IF NOT LISTING THEN
  330.   BEGIN
  331.     IF (LINENUMBER MOD MAXDOTS<>0) THEN WRITELN;
  332.     WRITELN;
  333.   END;
  334.   IF (FREEMEM<=100.0) THEN
  335.   BEGIN
  336.     WRITELN('SYMBOL TABLE OVERFLOW');
  337.     ERROR:=TRUE;
  338.   END ELSE
  339.   BEGIN
  340.     WRITELN(LINENUMBER,' lines read from input file.');
  341.     WRITELN(NOFIDENTS,' identifiers processed.');
  342.     WRITELN(IFREE-FREEMEM:0:0,' bytes used, ',FREEMEM:0:0,' free.');
  343.     IF LISTING THEN WRITE(OUTFILE,FORMFEED);
  344.   END;
  345. END;
  346.  
  347. (* PRINTXREF outputs the cross reference map.            *)
  348.  
  349. PROCEDURE PRINTXREF;
  350. VAR
  351.   N: INTEGER;
  352.   X: LINERECPTR;
  353.  
  354. (* TRAVERSE traverses the binary tree from "left" to "right",    *)
  355. (* printing all identifiers and the numbers of the lines within    *)
  356. (* which they are referenced.                    *)
  357.  
  358. PROCEDURE TRAVERSE(ROOT: IDENTRECPTR);
  359. BEGIN
  360.   IF ROOT<>NIL THEN
  361.   BEGIN
  362.     TRAVERSE(ROOT^.LEFT);
  363.     WITH ROOT^ DO
  364.     BEGIN
  365.       WRITE(OUTFILE,ID^);
  366.       X:=FIRSTLINE; N:=1;
  367.       REPEAT
  368.     IF N MOD 8=1 THEN WRITELN(OUTFILE);
  369.     WRITE(OUTFILE,X^.NUMBER:8); X:=X^.NEXT; N:=N+1;
  370.       UNTIL X=NIL;
  371.       WRITELN(OUTFILE);
  372.     END;
  373.     TRAVERSE(ROOT^.RIGHT);
  374.   END;
  375. END;
  376.  
  377. BEGIN (*PRINTXREF*)
  378.   TRAVERSE(IDTREE); WRITE(OUTFILE,FORMFEED);
  379. END;
  380.  
  381. (* Main program.                        *)
  382.  
  383. BEGIN
  384.   INITIALIZE;
  385.   IF NOT ERROR THEN PROCESSFILE;
  386.   IF NOT ERROR THEN PRINTXREF;
  387. END.
  388.