|
DataMuseum.dkPresents historical artifacts from the history of: DANOSI |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DANOSI Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 30009 (0x7539)
Types: TextFile
Names: »PASCROSS.PAS«
└─⟦e2123b2a1⟧ Bits:30010498 DVBS1.SW2103.src.1.8-1 Pascal TOOLS JTAS 1989-04-26 LEIF NIELSEN E.d.
└─⟦this⟧ »PASCROSS.PAS«
{[A=20,I=2,L=4,E=3,W=1-100] PASCFORM direktiv }\r
{$R-,S+,I+,B+,N- }\r
{$M 16000, 0, 655000 } {Take all of mem. to heap }\r
\r
PROGRAM PasCrossRef;\r
\r
{ This program will generate a program listing and/or cross }\r
{ reference map of any Turbo Pascal program, i.e. a map that }\r
{ lists all identifiers used within the program as well as the }\r
{ line numbers of all lines that contain references to the }\r
{ identifiers. Optionally, include files may be incorporated }\r
{ in the source listing. }\r
\r
{ On processing the input file, all identifiers are extracted }\r
{ and compared with the reserved words of Turbo Pascal. If an }\r
{ identifier is not a reserved word, it is entered into a }\r
{ binary tree. Each entry in the binary tree contains a pointer }\r
{ to the identifier, and a left node and a right node pointer }\r
{ to subsequent entries (or NIL if no entries follow). Further- }\r
{ more, an entry contains a pointer to the first record in a }\r
{ line number reference chain, and a pointer to the last record }\r
{ in that chain. When an identifier is entered into the tree }\r
{ for the first time, the program allocates both a new identi- }\r
{ fier record and a line number reference record. Subsequent }\r
{ references to that identifier will then expand the line num- }\r
{ ber reference chain, provided that the line number is not the }\r
{ same as that of the last reference. }\r
\r
{ When all lines have been processed, the program traverses the }\r
{ binary tree, printing all identifiers along with the numbers }\r
{ of the lines within which they are referenced. }\r
{-----------------------------------------------------------------------------\r
Date. Init. Vers. Explanation.\r
\r
1988-01-01 OKT 1.0 Expanded original and asjusted to Turbo Pascal 3.0\r
1988-03-03 OKT 1.1 Changed to Turbo Pascal 4.0, and improved parameters.\r
-----------------------------------------------------------------------------}\r
\r
USES\r
Crt,\r
Dos,\r
dosutil,\r
param,\r
help;\r
\r
\r
CONST\r
\r
Version = ('1.1');\r
\r
{ Constants controlling default settings }\r
\r
CompressedPageWidth = 128;\r
NormalPageWidth = 80;\r
CompressedSpacing = 12;\r
NormalSpacing = 6;\r
PageWidth = CompressedPageWidth;\r
Spacing = CompressedSpacing;\r
PageLength = 60;\r
\r
{ Various constants }\r
\r
MaxDots = 50; { Max number of dots per line on CRT }\r
MaxReservedWords = 53;\r
ReservedWordLng = 14;\r
NoOfVersions = 4;\r
MaxDevices = 3;\r
FormFeed = ^L; { Form-feed character }\r
VerticalTabLength = 2; { Number of lines to skip at top of page }\r
File_buff_size = 512;\r
\r
TYPE\r
EnterExit = (en, ex);\r
PrinterControl = ARRAY[EnterExit] OF STRING[32];\r
NumberForm = (None, Binary, ASCII);\r
DeviceControlType = ARRAY[1..MaxDevices] OF RECORD\r
Name : STRING[12];\r
Numeric : NumberForm;\r
PrinterControlCode,\r
LeftMarginCode,\r
CompressCode: PrinterControl;\r
END;\r
ResWordType = RECORD\r
NoOfReservedWords : integer;\r
ReservedWords : ARRAY[1..MaxReservedWords] OF\r
STRING[ReservedWordLng];\r
END;\r
\r
CONST\r
\r
{ Escape sequences used to control the printer }\r
DC : DeviceControlType = (\r
(Name : 'EPSON'; Numeric : Binary;\r
PrinterControlCode : (^['@'^['R'#0,^['@');\r
LeftMarginCode : (^['l','');\r
CompressCode : (^O,'')),\r
(Name : 'HPLASER'; Numeric : ASCII;\r
PrinterControlCode : (^['E',^['E');\r
LeftMarginCode : (^['&a','L');\r
CompressCode : (^['&k2S','')),\r
(Name : 'NUL'; Numeric : None;\r
PrinterControlCode : ('','');\r
LeftMarginCode : ('','');\r
CompressCode : ('','')));\r
\r
\r
{ Table of reserved words }\r
\r
\r
ReservedWordTable : array[1..NoOfVersions] of ResWordType =(\r
(NoOfReservedWords: 44; ReservedWords: (\r
{ Poly Pascal values: }\r
'LABEL','ELSE','CASE','AT','AND','ARRAY','BEGIN','DIV','CODE','CONST',\r
'DO','DOWNTO','FOR','EXTERNAL','END','EXOR','FILE','GOTO','FORWARD',\r
'FUNCTION','IF','IN','REPEAT','OTHERWISE','NOT','MOD','NIL','OF','OR',\r
'PROGRAM','PACKED','PROCEDURE','RECORD','TO','SHR','SET','SHL','STRING',\r
'THEN','VAR','TYPE','UNTIL','WHILE','WITH','','','','','','','','','')),\r
(NoOfReservedWords: 53; ReservedWords: (\r
{ Real Time Pascal values: }\r
'LOCK','END','CHANNEL','BEGIN','ARRAY','AND','AS','CASE','BEGINBODY',\r
'DO','CONTINUELOOP','CONST','DIV','ELSE','DOWNTO','FORWARD','EXPORT',\r
'EXIT','ENDLOOP','EXITLOOP','FOR','EXTERNAL','IF','GOTO','FUNCTION',\r
'LABEL','IN','SET','OTHERWISE','NOT','LOOP','LOCKMES','MOD','OR','OF',\r
'PROCEDURE','POOL','PACKED','PREFIX','RECORD','PROCESS','REPEAT',\r
'UNTIL','TO','THEN','SHIFT','TYPESIZE','TYPE','WHILE','VARSIZE',\r
'VAR','XOR','WITH')),\r
(NoOfReservedWords : 44; ReservedWords: (\r
{ Turbo Pascal version 3 values: }\r
'MOD','END','CONST','ARRAY','AND','ABSOLUTE','CASE','BEGIN','DOWNTO','DO',\r
'DIV','ELSE','GOTO','FORWARD','FILE','EXTERNAL','FUNCTION','FOR','IN','IF',\r
'INLINE','LABEL','SHL','PACKED','OVERLAY','NOT','NIL','OR','OF','RECORD',\r
'PROGRAM','PROCEDURE','SET','REPEAT','UNTIL','THEN','STRING','SHR','TO',\r
'TYPE','WITH','WHILE','VAR','XOR','','','','','','','','','')),\r
(NoOfReservedWords: 48; ReservedWords: (\r
{ Turbo Pascal version 4 values: }\r
'LABEL','EXTERNAL','CONST','ARRAY','AND','ABSOLUTE','CASE','BEGIN',\r
'DOWNTO','DO','DIV','END','ELSE','IF','FORWARD','FOR','FILE','GOTO',\r
'FUNCTION','INLINE','IN','IMPLEMENTATION','INTERRUPT','INTERFACE',\r
'SHL','PACKED','NOT','NIL','MOD','OR','OF','RECORD','PROGRAM',\r
'PROCEDURE','SET','REPEAT','UNIT','THEN','STRING','SHR','TYPE',\r
'TO','VAR','USES','UNTIL','WITH','WHILE','XOR','','','','','')));\r
\r
TYPE\r
\r
{ Identifier types }\r
\r
IdentPtr = ^Ident;\r
Ident = STRING[32];\r
\r
{ Line record types. Each line record contains the number of a }\r
{ line, within which a given identifier is referenced, and a }\r
{ pointer to the next line record. }\r
\r
LineRecPtr = ^LineRec;\r
LineRec = RECORD\r
Number: INTEGER;\r
Next: LineRecPtr;\r
END;\r
\r
{ Identifier record types. Each identifier record contains a }\r
{ pointer to the identifier string, a pointer to the first and }\r
{ the last line record in the reference chain, and a left node }\r
{ and a right node pointer to subsequent entries in the binary }\r
{ tree. }\r
\r
IdentRecPtr = ^IdentRec;\r
IdentRec = RECORD\r
Id: IdentPtr;\r
Reserved: BOOLEAN;\r
FirstLine,LastLine: LineRecPtr;\r
Left,Right: IdentRecPtr;\r
END;\r
\r
{ Source line type. The maximum length of a source line is 127 }\r
{ characters. }\r
\r
SourceLine = STRING[127];\r
\r
VAR\r
\r
{ Option varables }\r
PrintCompressed, { True if compressed print }\r
PrintIncludeFile, { True if include files are also printed }\r
PrintListing, { True if source listing requested }\r
PrintLineNumbers, { True if linenumbers is to be printed }\r
PrintCrossRef : BOOLEAN; { True if a cross reference is printed }\r
PrintPageLength, { Number of lines to print on page }\r
PrintPageWidth, { Width of printed page }\r
PrintSpacing : INTEGER; { No of blanks in front of line }\r
\r
{ Global variables. }\r
\r
LineNumber, { Current line number }\r
NoOfIdents, { Number of identifiers processed }\r
LinePos, { Position within current line }\r
CurRow, { Current line on printed page }\r
PageNo, { Current page number }\r
DeviceNo,\r
PascalVersion,\r
LineLength: INTEGER; { Length of current line }\r
Ch: CHAR; { Current character }\r
IncludeActive,\r
InOpen, { True if input file open }\r
OutOpen, { True if output file open }\r
Error: BOOLEAN; { Error flag }\r
Line: SourceLine; { Current source line }\r
IdTree: IdentRecPtr; { Root of cross reference tree }\r
MainFile: TEXT{[4096]}; { Input file }\r
{! 15. Use the n^ew standard procedure SetTextBuf to set Text buffer size.}\r
IncludeFile : TEXT{[4096]};\r
{! 16. Use the new s^tandard procedure SetTextBuf to set Text buffer size.}\r
OutFile: TEXT; { Output file }\r
I_buff, IC_buff, O_buff: ARRAY[1..File_buff_size] OF byte;\r
IncludeFileName,\r
MainFileName: STRING; { Name of main program file }\r
MainHeadLine,\r
HeadLine : SourceLine;\r
SR : SearchRec;\r
Date : DateTime;\r
CurrentDate : STRING;\r
Dummy : word; { to be used as dummy parameter }\r
\r
{ UserFreeMem returns the number of bytes available on the heap. }\r
{ The result type is real to allow for values outside the inte- }\r
{ ger range. }\r
\r
\r
\r
CONST\r
MaxParam = 2;\r
MaxOption = 10;\r
\r
ParamList : ARRAY[1..MaxParam] OF ParamRec =\r
((Kind:KnownFile;Defined:FALSE ;KeyWord:'M';NumVal:0;TextVal:'.PAS'),\r
(Kind:FileType; Defined:FALSE ;KeyWord:'O';NumVal:0;TextVal:'PRN'));\r
\r
OptionList : ARRAY[1..MaxOption] OF ParamRec =\r
((Kind:Numeric; Defined:FALSE ;KeyWord:'PAGE' ;NumVal:PageLength;TextVal:''),\r
(Kind:Numeric; Defined:FALSE ;KeyWord:'SPACING' ;NumVal:Spacing;TextVal:''),\r
(Kind:Numeric; Defined:FALSE ;KeyWord:'WIDTH' ;NumVal:PageWidth;TextVal:''),\r
(Kind:OnOff; Defined:FALSE ;KeyWord:'COMPRESS';NumVal:0;TextVal:'ON'),\r
(Kind:OnOff; Defined:FALSE ;KeyWord:'INCLUDE' ;NumVal:0;TextVal:'OFF'),\r
(Kind:OnOff; Defined:FALSE ;KeyWord:'NUMBERS' ;NumVal:0;TextVal:'ON'),\r
(Kind:OnOff; Defined:FALSE ;KeyWord:'LIST' ;NumVal:0;TextVal:'ON'),\r
(Kind:OnOff; Defined:FALSE ;KeyWord:'XREF' ;NumVal:0;TextVal:'ON'),\r
(Kind:Numeric; Defined:FALSE ;KeyWord:'VERSION' ;NumVal:4;TextVal:''),\r
(Kind:TextType; Defined:false; KeyWord:'DEVICE' ;NumVal:0;TextVal:'EPSON'));\r
\r
Search1 = '{$I'; Search2 = '{$i'; Search3 = '(*$I'; Search4 = '(*$i';\r
\r
PROCEDURE ProgError(Msg : STRING);\r
BEGIN\r
WriteLn(Msg);\r
Halt;\r
END; { ProgError }\r
\r
FUNCTION IncludeIn(VAR CurStr: SourceLine): BOOLEAN;\r
VAR\r
ChkChar : CHAR;\r
Column : INTEGER;\r
BEGIN\r
ChkChar := '-';\r
Column := Pos(Search1,CurStr);\r
IF Column <> 0 THEN\r
ChkChar := CurStr[Column+3]\r
ELSE\r
BEGIN\r
Column := Pos(Search2,CurStr);\r
IF Column <> 0 THEN\r
ChkChar := CurStr[Column+4]\r
ELSE\r
BEGIN\r
Column := Pos(Search3,CurStr);\r
IF Column <> 0 THEN\r
ChkChar := CurStr[Column+3]\r
ELSE\r
BEGIN\r
Column := Pos(Search4,CurStr);\r
IF Column <> 0 THEN\r
ChkChar := CurStr[Column+4];\r
END;\r
END;\r
END;\r
IncludeIn := ChkChar IN [' ','0'..'9','A'..'Z','a'..'z','!','@','#','$',\r
'%','^','&','(',')','_'];\r
END { IncludeIn };\r
\r
\r
FUNCTION Parse(IncStr: SourceLine): STRING;\r
\r
CONST\r
PathLength = 63;\r
VAR\r
NameStart,\r
NameEnd : INTEGER;\r
BEGIN\r
NameStart := Pos('$I',IncStr);\r
IF NameStart = 0 THEN NameStart := Pos('$i',IncStr);\r
NameStart := NameStart + 2;\r
WHILE IncStr[NameStart] = ' ' DO NameStart := Succ(NameStart);\r
NameEnd := NameStart;\r
WHILE (NOT (IncStr[NameEnd] IN [' ','}','*']))\r
AND ((NameEnd - NameStart) <= PathLength)\r
DO NameEnd := Succ(NameEnd);\r
NameEnd := Pred(NameEnd);\r
IF Pos('.',Copy(IncStr,NameStart,(NameEnd-NameStart+1))) = 0 THEN\r
Parse := Copy(IncStr,NameStart,(NameEnd-NameStart+1))+'.PAS'\r
ELSE\r
Parse := Copy(IncStr,NameStart,(NameEnd-NameStart+1));\r
END {Parse};\r
\r
\r
PROCEDURE NewPage(Message : STRING);\r
\r
VAR\r
i: INTEGER;\r
s : STRING;\r
BEGIN\r
IF PageNo > 0 THEN\r
BEGIN\r
FOR i := 1 TO VerticalTabLength DO WriteLn(OutFile);\r
Str(PageNo:0,s);\r
s := 'PAGE '+s;\r
i := PrintPageWidth - Length(s);\r
WriteLn(OutFile,'':i,s);\r
Write(OutFile,FormFeed);\r
END;\r
IF Message <> '' THEN\r
BEGIN\r
s := 'Printed: '+CurrentDate;\r
i := PrintPageWidth - Length(Message) - Length(s);\r
WriteLn(OutFile,Message,'':i,s);\r
FOR i := 1 TO VerticalTabLength DO WriteLn(OutFile);\r
END;\r
PageNo := Succ(PageNo);\r
CurRow := 1;\r
END {vertical tab};\r
\r
\r
PROCEDURE ProcessLine(LineNo: INTEGER; PrintStr: SourceLine);\r
\r
VAR\r
PrintCh : CHAR;\r
TabVal,\r
CurChPos,\r
LinePos : INTEGER;\r
BEGIN\r
CurRow := Succ(CurRow);\r
IF CurRow > PrintPageLength THEN NewPage(HeadLine);\r
LinePos := 1;\r
IF PrintLineNumbers THEN\r
BEGIN\r
IF LineNo = 0 THEN Write(OutFile,'---- ')\r
ELSE Write(OutFile,LineNo:4,' ');\r
LinePos := LinePos + 5;\r
END;\r
TabVal := 8;\r
FOR CurChPos := 1 TO Length(PrintStr) DO\r
BEGIN\r
IF PrintStr[CurChPos] <> ^I THEN\r
BEGIN\r
LinePos := Succ(LinePos);\r
IF LinePos > PrintPageWidth THEN\r
BEGIN\r
WriteLn(OutFile);\r
CurRow := Succ(CurRow);\r
IF CurRow > PrintPageLength THEN NewPage(HeadLine);\r
Write(OutFile,'':PrintSpacing);\r
LinePos := PrintSpacing + 1;\r
IF PrintLineNumbers THEN\r
BEGIN\r
Write(OutFile,'':5);\r
LinePos := LinePos + 5;\r
END;\r
TabVal := 8;\r
END;\r
Write(OutFile,PrintStr[CurChPos]);\r
TabVal := Pred(TabVal);\r
IF TabVal = 0 THEN TabVal := 8;\r
END\r
ELSE\r
BEGIN\r
LinePos := LinePos + TabVal;\r
IF LinePos > PrintPageWidth THEN\r
BEGIN\r
WriteLn(OutFile);\r
CurRow := Succ(CurRow);\r
IF CurRow > PrintPageLength THEN NewPage(HeadLine);\r
LinePos := 1;\r
IF PrintLineNumbers THEN\r
BEGIN\r
Write(OutFile,'':5);\r
LinePos := LinePos + 5;\r
END;\r
TabVal := 8;\r
END\r
ELSE\r
BEGIN\r
Write(OutFile,'':TabVal);\r
TabVal := 8;\r
END;\r
END;\r
END;\r
WriteLn(OutFile);\r
END {Process line};\r
\r
{ NEXTCH reads the next character from the input file into CH. }\r
{ If a source listing was requested, NEXTCH lists input lines }\r
{ to the output file as they are read. Otherwise, a dot is }\r
{ printed on the console for each line read. A ^Z character is }\r
{ returned on reaching the end of the input file. }\r
\r
\r
PROCEDURE NextCh;\r
\r
VAR\r
p,t: INTEGER;\r
TmpStr : STRING;\r
BEGIN\r
IF (LinePos<=LineLength) THEN\r
BEGIN\r
Ch:=Line[LinePos]; LinePos:=LinePos+1;\r
Ch:=UpCase(Ch);\r
END\r
ELSE\r
BEGIN\r
IF IncludeActive THEN\r
BEGIN\r
IF NOT Eof(IncludeFile) THEN\r
BEGIN\r
ReadLn(IncludeFile,Line); LineNumber := LineNumber + 1;\r
IF PrintListing THEN ProcessLine( LineNumber, Line )\r
ELSE\r
BEGIN\r
Write('.');\r
IF LineNumber MOD MaxDots=0 THEN WriteLn;\r
END;\r
LineLength:=Length(Line); LinePos:=1; Ch:=' ';\r
END\r
ELSE\r
BEGIN\r
IF PrintListing THEN\r
BEGIN\r
ProcessLine(0,' ');\r
ProcessLine(0,'End of include file: '+IncludeFileName);\r
ProcessLine(0,' ');\r
END;\r
IncludeActive := FALSE;\r
Close(IncludeFile);\r
Ch := ' ';\r
HeadLine := MainHeadLine;\r
END;\r
END\r
ELSE\r
BEGIN\r
IF PrintIncludeFile THEN\r
BEGIN\r
IF IncludeIn(Line) THEN\r
BEGIN\r
IncludeFileName := UpperStr(Parse(Line));\r
IF NOT FileExist(IncludeFileName) THEN\r
BEGIN\r
Ch := ' '; Line := '';\r
ProcessLine(0,'ERROR -- Include file not found: '\r
+IncludeFileName);\r
END\r
ELSE\r
BEGIN\r
Assign(IncludeFile,IncludeFileName);\r
SetTextBuf(IncludeFile, IC_buff);\r
Reset(IncludeFile);\r
IF PrintListing THEN\r
BEGIN\r
ProcessLine(0,' ');\r
ProcessLine(0,'Start of include file: '+IncludeFileName);\r
ProcessLine(0,' ');\r
END;\r
IncludeActive := TRUE;\r
FindFirst(IncludeFileName,0,SR);\r
UnpackTime(SR.Time,Date);\r
HeadLine := 'Include file: '+IncludeFileName;\r
IF DosError <> 0 THEN\r
HeadLine := HeadLine+' ('+DateTimeText(Date)+')';\r
Ch := ' ';\r
END;\r
END;\r
END;\r
IF (NOT Eof(MainFile)) AND (NOT IncludeActive) THEN\r
BEGIN\r
ReadLn(MainFile,Line); LineNumber:=LineNumber+1;\r
IF PrintListing THEN ProcessLine( LineNumber, Line )\r
ELSE\r
BEGIN\r
Write('.');\r
IF LineNumber MOD MaxDots=0 THEN WriteLn;\r
END;\r
LineLength:=Length(Line); LinePos:=1; Ch:=' ';\r
END\r
ELSE\r
IF Eof(MainFile) THEN Ch:=^Z;\r
END;\r
END;\r
END;\r
\r
{ ENTERID enters NEWID into the cross reference binary tree. }\r
{ Note that an identifier record is allocated only if the iden- }\r
{ tifier is not already within the tree. Also note the use of }\r
{ the getmem procedure to allocate only the required number }\r
{ of bytes for the identifier instead of the maximum Length. }\r
\r
\r
PROCEDURE EnterId(NewId: Ident; ResWord: BOOLEAN);\r
\r
VAR\r
x: LineRecPtr;\r
\r
PROCEDURE Enter(VAR Root: IdentRecPtr);\r
BEGIN\r
IF Root=NIL THEN\r
BEGIN\r
New(Root);\r
WITH Root^ DO\r
BEGIN\r
GetMem(Id,Length(NewId)+1); Id^:=NewId;\r
Reserved:=ResWord;\r
IF NOT Reserved THEN\r
BEGIN\r
New(FirstLine);\r
FirstLine^.Number:=LineNumber; FirstLine^.Next:=NIL;\r
LastLine:=FirstLine;\r
NoOfIdents:=NoOfIdents+1;\r
END;\r
Left:=NIL; Right:=NIL;\r
END;\r
END ELSE\r
IF NewId<Root^.Id^ THEN Enter(Root^.Left) ELSE\r
IF NewId>Root^.Id^ THEN Enter(Root^.Right) ELSE\r
WITH Root^ DO\r
IF NOT Reserved THEN\r
IF LineNumber<>LastLine^.Number THEN\r
BEGIN\r
New(x); x^.Number:=LineNumber; x^.Next:=NIL;\r
LastLine^.Next:=x;\r
LastLine:=x;\r
END;\r
END;\r
\r
BEGIN {EnterId}\r
Enter(IdTree);\r
END;\r
\r
{ INITIALIZE is used to initialize input and output files and }\r
{ all global variables. }\r
\r
\r
PROCEDURE Initialize;\r
\r
VAR\r
i: INTEGER;\r
InName,OutName: STRING[64];\r
ListYN: STRING[1];\r
St : STRING;\r
BEGIN\r
Error:=FALSE;\r
TextColor(LightGray);\r
WriteLn('Turbo Pascal Cross Reference, Version ', version );\r
WriteLn('Copyright (C) Ole Krog Thomsen, 1987, 1988');\r
WriteLn;\r
\r
IF ( ParamCount = 0 ) OR\r
( ParamCount >= 1) AND ( ParamStr(1 ) = '?') THEN\r
BEGIN\r
ShowHelp;\r
Halt;\r
END;\r
St := ProgFileName;\r
Delete(St, Pos('.',St), 255);\r
WHILE pos('\',St) > 0 DO delete(St, 1, Pos('\',St));\r
GetOptions(StripBlanks(EnvStrVal(St)), OptionList, MaxOption);\r
GetParams(ParamList, MaxParam, OptionList, MaxOption);\r
InOpen:=FALSE; OutOpen:=FALSE; IncludeActive := FALSE;\r
DeviceNo := 1;\r
WITH OptionList[10] DO\r
IF Defined THEN\r
BEGIN\r
i := 1;\r
WHILE (i <= MaxDevices) AND\r
(UpperStr(TextVal) <> DC[i].Name) DO i := i + 1;\r
IF UpperStr(TextVal) = DC[i].Name THEN DeviceNo := i\r
ELSE ProgError('Unknown device: '+TextVal);\r
END;\r
PrintLineNumbers := OptionList[6].TextVal = 'ON';\r
PrintCompressed := OptionList[4].TextVal = 'ON';\r
PrintIncludeFile := OptionList[5].TextVal = 'ON';\r
PrintListing := OptionList[7].TextVal = 'ON';\r
PrintCrossRef := OptionList[8].TextVal = 'ON';\r
PrintPageLength := OptionList[1].NumVal;\r
PrintSpacing := OptionList[2].NumVal;\r
PrintPageWidth := OptionList[3].NumVal;\r
PascalVersion := OptionList[9].NumVal;\r
IF (PascalVersion < 1) OR (PascalVersion > NoOfVersions) THEN\r
ProgError('Unknown Pascal version: ');\r
CurRow := PrintPageLength; PageNo := 0;\r
InName := ParamList[1].TextVal;\r
IF (NOT PrintCompressed) AND (NOT OptionList[3].Defined) THEN\r
BEGIN\r
PrintPageWidth := NormalPageWidth;\r
PrintSpacing := NormalSpacing;\r
END;\r
IF PrintSpacing > 0 THEN PrintPageWidth := PrintPageWidth - PrintSpacing;\r
IF FileExist(InName) THEN\r
BEGIN\r
Assign(MainFile, InName);\r
SetTextBuf(MainFile, I_buff);\r
Reset(MainFile);\r
END\r
ELSE\r
BEGIN\r
WriteLn('Input File Error');\r
Error:=true; Halt;\r
END;\r
InOpen:=TRUE;\r
OutName := ParamList[2].TextVal;\r
Assign(OutFile, OutName);\r
SetTextBuf(OutFile, O_buff);\r
{$I-}\r
Rewrite(OutFile);\r
{$I+}\r
IF IOResult <> 0 THEN\r
BEGIN\r
WriteLn('Output File Error');\r
Error:=true; Halt;\r
END;\r
OutOpen:=TRUE;\r
FindFirst(InName,0,SR);\r
MainFileName := SR.Name;\r
UnpackTime(SR.Time, Date);\r
HeadLine := 'Main file: '+MainFileName+' ('+DateTimeText(Date)+')';\r
MainHeadLine := HeadLine;\r
GetSysDate(Date);\r
CurrentDate := DateTimeText(Date);\r
IdTree:=NIL;\r
WITH ReservedWordTable[PascalVersion] DO\r
FOR i:=1 TO NoOfReservedWords DO EnterId(ReservedWords[i],TRUE);\r
WITH DC[DeviceNo] DO\r
IF PrintListing OR PrintCrossRef THEN\r
BEGIN\r
Write(OutFile,PrinterControlCode[en]);\r
IF PrintCompressed THEN Write(OutFile,CompressCode[en],CompressCode[ex]);\r
IF PrintSpacing > 0 THEN\r
CASE Numeric OF\r
None: { do nothing };\r
Binary:\r
Write(OutFile,LeftMarginCode[en],Char(PrintSpacing),LeftMarginCode[ex]);\r
ASCII:\r
Write(OutFile,LeftMarginCode[en],PrintSpacing:0,LeftMarginCode[ex])\r
END;\r
END;\r
LineNumber:=0; NoOfIdents:=0;\r
LinePos:=1; LineLength:=0; NextCh;\r
END;\r
\r
{ PROCESSFILE processes the input file, creating a cross refe- }\r
{ rence binary tree. }\r
\r
\r
PROCEDURE ProcessFile;\r
\r
VAR\r
IFree: REAL;\r
\r
{ GETSYMBOL reads the next symbol from the input file. If the }\r
{ symbol is an identifier, it is processed using PROCESSIDENT }\r
{ below. }\r
\r
PROCEDURE GetSymbol;\r
CONST\r
AlphaNums: SET OF '0'..'_' = ['0'..'9','A'..'Z','_'];\r
HexDigits: SET OF '0'..'F' = ['0'..'9','A'..'F'];\r
\r
{ PROCESSIDENT reads an identifier and enters it into the cross }\r
{ reference tree. }\r
\r
PROCEDURE ProcessIdent;\r
VAR\r
NewId: Ident;\r
BEGIN\r
NewId:='';\r
REPEAT\r
NewId:=NewId+Ch; NextCh;\r
UNTIL NOT(Ch IN AlphaNums);\r
EnterId(NewId,FALSE);\r
END;\r
\r
BEGIN {GetSymbol}\r
CASE Ch OF\r
'A'..'Z','_': ProcessIdent;\r
'''':\r
REPEAT\r
REPEAT NextCh UNTIL (Ch='''') OR (Ch=^Z);\r
NextCh;\r
UNTIL Ch<>'''';\r
'$':\r
REPEAT NextCh UNTIL NOT(Ch IN HexDigits);\r
'{':\r
BEGIN\r
REPEAT NextCh UNTIL (Ch='}') OR (Ch=^Z);\r
NextCh;\r
END;\r
'(':\r
BEGIN\r
NextCh;\r
IF Ch='*' THEN\r
BEGIN\r
NextCh;\r
REPEAT\r
WHILE (Ch<>'*') AND (Ch<>^Z) DO NextCh;\r
NextCh;\r
UNTIL (Ch=')') OR (Ch=^Z);\r
NextCh;\r
END;\r
END;\r
ELSE\r
NextCh;\r
END;\r
END;\r
\r
BEGIN {ProcessFile}\r
IFree:=MaxAvail;\r
WHILE (Ch<>^Z) AND (MaxAvail>100.0) DO GetSymbol;\r
IF NOT PrintListing THEN\r
BEGIN\r
IF (LineNumber MOD MaxDots<>0) THEN WriteLn;\r
WriteLn;\r
END;\r
IF (MaxAvail<=100.0) THEN\r
BEGIN\r
WriteLn('Symbol Table Overflow');\r
Error:=TRUE;\r
END ELSE\r
BEGIN\r
WriteLn(LineNumber,' lines read from input file.');\r
WriteLn(NoOfIdents,' identifiers processed.');\r
WriteLn(IFree-MaxAvail:0:0,' bytes used, ',MaxAvail:0,' free.');\r
IF PrintListing THEN\r
BEGIN\r
WHILE CurRow < PrintPageLength DO\r
BEGIN\r
WriteLn(OutFile);\r
CurRow := Succ(CurRow);\r
END;\r
END;\r
END;\r
END;\r
\r
{ PRINTXREF outputs the cross reference map }\r
\r
\r
PROCEDURE PrintXRef;\r
\r
VAR\r
n, lf: INTEGER;\r
x: LineRecPtr;\r
\r
{ TRAVERSE traverses the binary tree from "left" to "right", }\r
{ printing all identifiers and the numbers of the lines within }\r
{ which they are referenced. }\r
\r
PROCEDURE Traverse(Root: IdentRecPtr);\r
BEGIN\r
IF Root<>NIL THEN\r
BEGIN\r
Traverse(Root^.Left);\r
WITH Root^ DO\r
IF NOT Reserved THEN\r
BEGIN\r
Write(OutFile,Id^);\r
x:=FirstLine; n:=1;\r
REPEAT\r
IF n MOD lf=1 THEN\r
BEGIN\r
WriteLn(OutFile);\r
CurRow := Succ(CurRow);\r
IF CurRow > PrintPageLength THEN NewPage(HeadLine);\r
END;\r
Write(OutFile,x^.Number:8); x:=x^.Next; n:=n+1;\r
UNTIL x=NIL;\r
WriteLn(OutFile);\r
CurRow := Succ(CurRow);\r
IF CurRow > PrintPageLength THEN NewPage(HeadLine);\r
END;\r
Traverse(Root^.Right);\r
END;\r
END;\r
\r
BEGIN {PrintXRef}\r
NewPage(HeadLine);\r
lf := PrintPageWidth DIV 9;\r
Traverse(IdTree);\r
WHILE CurRow < PrintPageLength DO\r
BEGIN\r
WriteLn(OutFile);\r
CurRow := Succ(CurRow);\r
END;\r
WriteLn(OutFile);\r
END;\r
\r
\r
\r
BEGIN\r
Initialize;\r
IF NOT Error THEN ProcessFile;\r
HeadLine := 'Cross reference of main file: '+MainFileName;\r
IF (NOT Error) AND PrintCrossRef THEN PrintXRef;\r
IF PrintListing OR PrintCrossRef THEN\r
BEGIN\r
NewPage('');\r
Write(OutFile,DC[DeviceNo].PrinterControlCode[ex]);\r
END;\r
IF InOpen THEN close(MainFile);\r
IF OutOpen THEN close(OutFile);\r
END.\r
\r
«eof»