⟦8f8169cff⟧

TextFile

PROGRAM CROSSREF; æ$R-,S+å

æ This program will generate a cross reference map of any	å
æ COMPAS Pascal program, i.e. a map that lists all identifiers	å
æ used within the program as well as the line numbers of all	å
æ lines that contain references to the identifiers. Optionally,	å
æ a source listing with line numbers may be output.		å

æ On processing the input file, all identifiers are extracted	å
æ and compared with the reserved words of COMPAS Pascal. If an	å
æ identifier is not a reserved word, it is entered into a	å
æ binary tree. Each entry in the binary tree contains a pointer	å
æ to the identifier, and a left node and a right node pointer	å
æ to subsequent entries (or NIL if no entries follow). Further-	å
æ more, an entry contains a pointer to the first record in a	å
æ line number reference chain, and a pointer to the last record	å
æ in that chain. When an identifier is entered into the tree	å
æ for the first time, the program allocates both a new identi-	å
æ fier record and a line number reference record. Subsequent	å
æ references to that identifier will then expand the line num-	å
æ ber reference chain, provided that the line number is not the	å
æ same as the line number of the last reference.		å

æ When all lines have been processed, the program traverses the	å
æ binary tree, printing all identifiers along with the numbers	å
æ of the lines within which they are referenced.		å

CONST

æ Various constants.						å

  MAXDOTS = 50;		æ Max number of dots per line on CRT å
  DEFPLEN = 72;		æ Default page length å
  BOTTOMMARGIN = 6;	æ Number of lines for bottom margin å
  NOFRWORDS = 44;	æ Number of reserved words å

æ Table of reserved words.					å

  RWORDS: ARRAYÆ1..NOFRWORDSÅ OF STRINGÆ9Å = (
    'AND','ARRAY','AT','BEGIN','CASE','CODE','CONST','DIV','DO',
    'DOWNTO','ELSE','END','EXOR','EXTERNAL','FILE','FOR','FORWARD',
    'FUNCTION','GOTO','IF','IN','LABEL','MOD','NIL','NOT','OF',
    'OR','OTHERWISE','PACKED','PROCEDURE','PROGRAM','RECORD',
    'REPEAT','SET','SHL','SHR','STRING','THEN','TO','TYPE','UNTIL',
    'VAR','WHILE','WITH');

TYPE

æ Identifier types. The maximum length is 64 characters.	å

  IDENTPTR = ^IDENT;
  IDENT = STRINGÆ64Å;

æ Line record types. Each line record contains the number of a	å
æ line, within which a given identifier is referenced, and a	å
æ pointer to the next line record.				å

  LINERECPTR = ^LINEREC;
  LINEREC = RECORD
	      NUMBER: INTEGER;
	      NEXT: LINERECPTR;
	    END;

æ Identifier record types. Each identifier record contains a	å
æ pointer to the identifier string, a pointer to the first and	å
æ the last line record in the reference chain, and a left node	å
æ and a right node pointer to subsequent entries in the binary	å
æ tree.								å

  IDENTRECPTR = ^IDENTREC;
  IDENTREC = RECORD
	       ID: IDENTPTR;
	       FIRSTLINE,LASTLINE: LINERECPTR;
	       LEFT,RIGHT: IDENTRECPTR;
	     END;

æ Source line type. The maximum length of a source line is 127	å
æ characters.							å

  SOURCELINE = STRINGÆ127Å;

æ Reserved word table pointers type. Each element points to the	å
æ first reserved word, that starts with the character given by	å
æ the index.							å

  RWORDTP = ARRAYÆ'A'..'Z'Å OF INTEGER;

VAR

æ Global variables.						å

  LINENUMBER,		æ Current line number å
  PAGELEN,		æ Printed lines per page å
  LINECOUNT,		æ Output line counter å
  NOFIDENTS,		æ Number of identifiers processed å
  POS,			æ Position within current line å
  LINELEN: INTEGER;	æ Length of current line å
  CH: CHAR;		æ Current character å
  LISTING,		æ True if source listing requested å
  ERROR: BOOLEAN;	æ Error flag å
  LINE: SOURCELINE;	æ Current source line å
  IDTREE: IDENTRECPTR;	æ Root of cross reference tree å
  FIRSTRWORD: RWORDTP;	æ Pointers to reserved word table å
  INFILE,		æ Input file å
  OUTFILE: TEXT;	æ Output file å

æ$A+å

æ FREEMEM returns the number of bytes available on the heap.	å
æ The result type is real to allow for values greater than 32K.	å

FUNCTION FREEMEM: REAL;
BEGIN
  IF MEMAVAIL>0 THEN
  FREEMEM:=MEMAVAIL ELSE
  FREEMEM:=65536.0-MEMAVAIL;
END;

æ ALLOC allocates NBYTES bytes on the heap, and sets POINTER to	å
æ point at that area. POINTER may be any pointer variable.	å

PROCEDURE ALLOC(VAR POINTER; NBYTES: INTEGER);
VAR
  P: INTEGER AT POINTER;
BEGIN
  P:=HPTR; HPTR:=HPTR+NBYTES;
END;

æ NEWPAGE skips to the top of a form on the output file	if the	å
æ print head is not already there.				å

PROCEDURE NEWPAGE;
VAR
  I: INTEGER;
BEGIN
  IF LINECOUNT<>0 THEN
  BEGIN
    FOR I:=LINECOUNT TO PAGELEN-1 DO WRITELN(OUTFILE);
    LINECOUNT:=0;
  END;
END;

æ NEWLINE increments the output line counter and skips to the	å
æ top of a new form if necessary.				å

PROCEDURE NEWLINE;
BEGIN
  LINECOUNT:=LINECOUNT+1;
  IF LINECOUNT=PAGELEN-BOTTOMMARGIN THEN NEWPAGE;
END;

æ NEXTCH reads the next character from the input file into CH.	å
æ If a source listing was requested, NEXTCH lists input lines	å
æ to the output file as they are read. Otherwise, a dot is	å
æ printed on the console for each line read. A ^Z character is	å
æ returned on reaching the end of the input file.		å

PROCEDURE NEXTCH;
VAR
  P,T: INTEGER;
BEGIN
  IF (POS<=LINELEN) THEN
  BEGIN
    CH:=LINEÆPOSÅ; POS:=POS+1;
    IF (CH>='a') AND (CH<='z') THEN CH:=CHR(ORD(CH)-32);
  END ELSE
  IF NOT EOF(INFILE) THEN
  BEGIN
    READLN(INFILE,LINE); LINENUMBER:=LINENUMBER+1;
    IF LISTING THEN
    BEGIN
      WRITE(OUTFILE,'<',LINENUMBER:5,'> ');
      T:=8;
      FOR P:=1 TO LEN(LINE) DO
      IF LINEÆPÅ<>^I THEN
      BEGIN
	WRITE(OUTFILE,LINEÆPÅ); T:=T-1; IF T=0 THEN T:=8;
      END ELSE
      BEGIN
	WRITE(OUTFILE,'':T); T:=8;
      END;
      WRITELN(OUTFILE); NEWLINE;
    END ELSE
    BEGIN
      WRITE('.');
      IF LINENUMBER MOD MAXDOTS=0 THEN WRITELN;
    END;
    LINELEN:=LEN(LINE); POS:=1; CH:=' ';
  END ELSE
  CH:=^Z;
END;

æ INITIALIZE is used to initialize input and output files and	å
æ all global variables.						å

PROCEDURE INITIALIZE;
LABEL EXIT;
VAR
  I: INTEGER;
  MATCH: BOOLEAN;
  INNAME,OUTNAME: STRINGÆ14Å;
  LISTYN: STRINGÆ1Å;
BEGIN
  ERROR:=FALSE;
  WRITELN;
  WRITELN('    COMPAS PASCAL CROSS REFERENCE GENERATOR');
  WRITELN;
  WRITELN('                  Version 1.0');
  WRITELN;
  WRITELN('             Copyright (C) 1983 by');
  WRITELN('           Poly-Data microcenter ApS');
  WRITELN;
  WRITELN;
  WRITE('Input file name? '); READLN(INNAME);
  WRITE('Output file name (default printer)? '); READLN(OUTNAME);
  WRITE('Print source listing (Y/N)? '); READLN(LISTYN);
  WRITE('Page length (default ',DEFPLEN,')? ');
  PAGELEN:=DEFPLEN; READLN(PAGELEN);
  WRITELN;
  ASSIGN(INFILE,INNAME); æ$I-å RESET(INFILE) æ$I+å;
  IF IORES>0 THEN
  BEGIN
    WRITELN('INPUT FILE ERROR');
    ERROR:=TRUE; GOTO EXIT;
  END;
  IF OUTNAME='' THEN OUTNAME:='LST:';
  ASSIGN(OUTFILE,OUTNAME); æ$I-å REWRITE(OUTFILE) æ$I+å;
  IF IORES>0 THEN
  BEGIN
    WRITELN('OUTPUT FILE ERROR');
    ERROR:=TRUE; GOTO EXIT;
  END;
  LISTING:=(LISTYN='Y') OR (LISTYN='y');
  IDTREE:=NIL;
  I:=1;
  FOR CH:='A' TO 'Z' DO
  BEGIN
    FIRSTRWORDÆCHÅ:=I; MATCH:=TRUE;
    WHILE (I<=NOFRWORDS) AND MATCH DO
    BEGIN
      MATCH:=RWORDSÆIÅÆ1Å=CH; IF MATCH THEN I:=I+1;
    END;
  END;
  LINENUMBER:=0; LINECOUNT:=0; NOFIDENTS:=0;
  POS:=1; LINELEN:=0; NEXTCH;
  EXIT:
END;

æ PROCESSFILE processes the input file, creating a cross refe-	å
æ rence binary tree.						å

PROCEDURE PROCESSFILE;
VAR
  IFREE: REAL;

æ GETSYMBOL reads the next symbol from the input file. If the	å
æ symbol is an identifier, it is processed using PROCESSIDENT	å
æ below.							å

PROCEDURE GETSYMBOL;
CONST
  ALPHANUMS: SET OF '0'..'Z' = Æ'0'..'9','A'..'Z'Å;
  HEXDIGITS: SET OF '0'..'F' = Æ'0'..'9','A'..'F'Å;

æ PROCESSIDENT reads an identifier and enters it into the cross	å
æ reference binary tree, provided that it is not a reserved	å
æ word.								å

PROCEDURE PROCESSIDENT;
VAR
  I,MAX: INTEGER;
  NOTFOUND: BOOLEAN;
  NEWID: IDENT;
  X: LINERECPTR;

æ$A-å

æ ENTERID enters NEWID into the cross reference binary tree.	å
æ Note that an identifier record is allocated only if the iden-	å
æ tifier is not already within the tree. Also note the use of	å
æ the ALLOC procedure to allocate only the required number of	å
æ bytes for the identifier instead of the full maximum length.	å

PROCEDURE ENTERID(VAR ROOT: IDENTRECPTR);
BEGIN
  IF ROOT=NIL THEN
  BEGIN
    NOFIDENTS:=NOFIDENTS+1;
    NEW(ROOT);
    WITH ROOT^ DO
    BEGIN
      ALLOC(ID,LEN(NEWID)+1); ID^:=NEWID;
      NEW(FIRSTLINE);
      FIRSTLINE^.NUMBER:=LINENUMBER; FIRSTLINE^.NEXT:=NIL;
      LASTLINE:=FIRSTLINE;
      LEFT:=NIL; RIGHT:=NIL;
    END;
  END ELSE
  IF NEWID<ROOT^.ID^ THEN ENTERID(ROOT^.LEFT) ELSE
  IF NEWID>ROOT^.ID^ THEN ENTERID(ROOT^.RIGHT) ELSE
  WITH ROOT^ DO
  BEGIN
    IF LINENUMBER<>LASTLINE^.NUMBER THEN
    BEGIN
      NEW(X); X^.NUMBER:=LINENUMBER; X^.NEXT:=NIL;
      LASTLINE^.NEXT:=X;
      LASTLINE:=X;
    END;
  END;
END;

BEGIN æPROCESSIDENTå
  IF CH='_' THEN
  BEGIN
    I:=NOFRWORDS; MAX:=NOFRWORDS;
  END ELSE
  BEGIN
    I:=FIRSTRWORDÆCHÅ;
    IF CH<'Z' THEN MAX:=FIRSTRWORDÆSUCC(CH)Å ELSE MAX:=NOFRWORDS;
  END;
  NEWID:='';
  REPEAT
    NEWID:=NEWID+CH; NEXTCH;
  UNTIL NOT(CH IN ALPHANUMS);
  NOTFOUND:=TRUE;
  WHILE (I<MAX) AND NOTFOUND DO
  BEGIN
    NOTFOUND:=NEWID<>RWORDSÆIÅ; I:=I+1;
  END;
  IF NOTFOUND THEN ENTERID(IDTREE);
END;

BEGIN æGETSYMBOLå
  CASE CH OF
    'A'..'Z','_':
      PROCESSIDENT;
    '''':
      REPEAT
	REPEAT NEXTCH UNTIL (CH='''') OR (CH=^Z);
	NEXTCH;
      UNTIL CH<>'''';
    '$':
      REPEAT NEXTCH UNTIL NOT(CH IN HEXDIGITS);
    'æ':
      BEGIN
	REPEAT NEXTCH UNTIL (CH='å') OR (CH=^Z);
	NEXTCH;
      END;
    '(':
      BEGIN
	NEXTCH;
	IF CH='*' THEN
	BEGIN
	  REPEAT
	    REPEAT NEXTCH UNTIL (CH='*') OR (CH=^Z);
	    NEXTCH;
	  UNTIL (CH=')') OR (CH=^Z);
	  NEXTCH;
	END;
      END;
  OTHERWISE
    NEXTCH;
  END;
END;

BEGIN æPROCESSFILEå
  IFREE:=FREEMEM;
  WHILE (CH<>^Z) AND (FREEMEM>100.0) DO GETSYMBOL;
  IF NOT LISTING THEN
  BEGIN
    IF (LINENUMBER MOD MAXDOTS<>0) THEN WRITELN;
    WRITELN;
  END;
  IF (FREEMEM<=100.0) THEN
  BEGIN
    WRITELN('SYMBOL TABLE OVERFLOW');
    ERROR:=TRUE;
  END ELSE
  BEGIN
    WRITELN(LINENUMBER,' lines read from input file.');
    WRITELN(NOFIDENTS,' identifiers processed.');
    WRITELN(IFREE-FREEMEM:0:0,' bytes used, ',FREEMEM:0:0,' free.');
    IF LISTING THEN NEWPAGE;
  END;
END;

æ$A+å

æ PRINTXREF outputs the cross reference map to the output file.	å

PROCEDURE PRINTXREF;
VAR
  N: INTEGER;
  X: LINERECPTR;

æ$A-å

æ TRAVERSE traverses the binary tree from "left" to "right",	å
æ printing all identifiers and the numbers of the lines within	å
æ which they are referenced.					å

PROCEDURE TRAVERSE(ROOT: IDENTRECPTR);
BEGIN
  IF ROOT<>NIL THEN
  BEGIN
    TRAVERSE(ROOT^.LEFT);
    WITH ROOT^ DO
    BEGIN
      WRITE(OUTFILE,ID^);
      X:=FIRSTLINE; N:=1;
      REPEAT
	IF N MOD 8=1 THEN
	BEGIN
	  WRITELN(OUTFILE); NEWLINE;
	END;
	WRITE(OUTFILE,X^.NUMBER:8); X:=X^.NEXT; N:=N+1;
      UNTIL X=NIL;
      WRITELN(OUTFILE);
    END;
    TRAVERSE(ROOT^.RIGHT);
  END;
END;

BEGIN æPRINTXREFå
  TRAVERSE(IDTREE); NEWPAGE;
END;

æ Main program.							å

BEGIN
  INITIALIZE;
  IF NOT ERROR THEN PROCESSFILE;
  IF NOT ERROR THEN PRINTXREF;
END.
«eof»
DataMuseum.dk

CP/M

⟦8f8169cff⟧ TextFile

Derivation

TextFile
