|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 11008 (0x2b00)
Types: TextFile
Names: »CROSSREF.PAS«
└─⟦74e5ee6fb⟧ Bits:30002683 PolyPascal-86 v. 3.11 - Piccoline
└─⟦74e5ee6fb⟧ Bits:30003934 SW1402 PolyPascal v3.11 (dk) til Piccoline
└─ ⟦this⟧ »CROSSREF.PAS«
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.
«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»«nul»