⟦ac5e62c0a⟧

TextFile

PROGRAM crossref; æ$R-,K-å

æ This program will generate a cross reference map of any Poly- å
æ 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 PolyPascal. 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 that 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 å
  nofrwords = 44;	æ Number of reserved words å
  formfeed = ^L;	æ Form-feed character å

æ Table of reserved words å

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

TYPE

æ Identifier types å

  identptr = ^ident;
  ident = STRINGÆ32Å;

æ 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;
	       reserved: boolean;
	       firstline,lastline: linerecptr;
	       left,right: identrecptr;
	     END;

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

  sourceline = STRINGÆ127Å;

VAR

æ Global variables.						å

  linenumber,           æ Current line number å
  nofidents,            æ Number of identifiers processed å
  linepos,              æ Position within current line å
  linelen: integer;     æ Length of current line å
  ch: char;             æ Current character å
  inopen,               æ True if input file open å
  outopen,              æ True if output file open å
  listing,              æ True if source listing requested å
  error: boolean;       æ Error flag å
  line: sourceline;     æ Current source line å
  idtree: identrecptr;  æ Root of cross reference tree å
  infile: textÆ4096Å;   æ Input file å
  outfile: text;        æ Output file å

æ FREEMEM returns the number of bytes available on the heap.    å
æ The result type is real to allow for values outside the inte- å
æ ger range.                                                    å

FUNCTION freemem: real;
BEGIN
  IF memavail>0 THEN
  freemem:=memavail*16.0 ELSE
  freemem:=65536.0-memavail*16.0;
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 (linepos<=linelen) THEN
  BEGIN
    ch:=lineÆlineposÅ; linepos:=linepos+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);
    END ELSE
    BEGIN
      write('.');
      IF linenumber MOD maxdots=0 THEN writeln;
    END;
    linelen:=len(line); linepos:=1; ch:=' ';
  END ELSE
  ch:=^Z;
END;

æ 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 ALLOCATE procedure to allocate only the required number   å
æ of bytes for the identifier instead of the maximum length.    å

PROCEDURE enterid(newid: ident; rword: boolean);
VAR
  x: linerecptr;

PROCEDURE enter(VAR root: identrecptr);
BEGIN
  IF root=NIL THEN
  BEGIN
    new(root);
    WITH root^ DO
    BEGIN
      allocate(id,len(newid)+1); id^:=newid;
      reserved:=rword;
      IF NOT reserved THEN
      BEGIN
        new(firstline);
        firstline^.number:=linenumber; firstline^.next:=NIL;
        lastline:=firstline;
        nofidents:=nofidents+1;
      END;
      left:=NIL; right:=NIL;
    END;
  END ELSE
  IF newid<root^.id^ THEN enter(root^.left) ELSE
  IF newid>root^.id^ THEN enter(root^.right) ELSE
  WITH root^ DO
  IF NOT reserved THEN
  IF linenumber<>lastline^.number THEN
  BEGIN
    new(x); x^.number:=linenumber; x^.next:=NIL;
    lastline^.next:=x;
    lastline:=x;
  END;
END;

BEGIN æenteridå
  enter(idtree);
END;

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

PROCEDURE initialize;
VAR
  i: integer;
  inname,outname: STRINGÆ64Å;
  listyn: STRINGÆ1Å;
BEGIN
  error:=false;
  writeln;
  writeln('      PolyPascal Cross Reference Generator');
  writeln;
  writeln('                  Version 1.1');
  writeln;
  writeln('               Copyright (C) 1985');
  writeln('            PolyData MicroCenter A/S');
  writeln;
  writeln;
  write('Input file name (default .PAS)? '); readln(inname);
  write('Output file name (default printer)? '); readln(outname);
  write('Print source listing (Y/N)? '); readln(listyn);
  writeln;
  inopen:=false; outopen:=false;
  IF pos('.',inname)=0 THEN inname:=inname+'.PAS';
  assign(infile,inname); æ$I-å reset(infile) æ$I+å;
  IF iores>0 THEN
  BEGIN
    writeln('Input File Error');
    error:=true; exit;
  END;
  inopen:=true;
  IF outname='' THEN outname:='LST:';
  assign(outfile,outname); æ$I-å rewrite(outfile) æ$I+å;
  IF iores>0 THEN
  BEGIN
    writeln('Output File Error');
    error:=true; exit;
  END;
  outopen:=true;
  listing:=(listyn='Y') OR (listyn='y');
  idtree:=NIL;
  FOR i:=1 TO nofrwords DO enterid(rwordsÆiÅ,true);
  linenumber:=0; nofidents:=0;
  linepos:=1; linelen:=0; nextch;
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'..'_' = Æ'0'..'9','A'..'Z','_'Å;
  hexdigits: SET OF '0'..'F' = Æ'0'..'9','A'..'F'Å;

æ PROCESSIDENT reads an identifier and enters it into the cross å
æ reference tree.                                               å

PROCEDURE processident;
VAR
  newid: ident;
BEGIN
  newid:='';
  REPEAT
    newid:=newid+ch; nextch;
  UNTIL NOT(ch IN alphanums);
  enterid(newid,false);
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
        nextch;
        REPEAT
          WHILE (ch<>'*') AND (ch<>^Z) DO nextch;
          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 write(outfile,formfeed);
  END;
END;

æ PRINTXREF outputs the cross reference map å

PROCEDURE printxref;
VAR
  n: integer;
  x: linerecptr;

æ 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
    IF NOT reserved THEN
    BEGIN
      write(outfile,id^);
      x:=firstline; n:=1;
      REPEAT
	IF n MOD 8=1 THEN writeln(outfile);
	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); write(outfile,formfeed);
END;

æ Main program å

BEGIN
  initialize;
  IF NOT error THEN processfile;
  IF NOT error THEN printxref;
  IF inopen THEN close(infile);
  IF outopen THEN close(outfile);
END.
«eof»
DataMuseum.dk

CP/M

⟦ac5e62c0a⟧ TextFile

Derivation

TextFile
