

<<MCrossRefMain.mesa>>
<<kap&wsh  March 16, 1980  1:55 PM >>
<<kap 14-Apr-80 16:51  >>
<<pdr October 11, 1983 11:59 pm  >>
DIRECTORY
Ascii USING[SP, CR, LF, FF, TAB, ControlZ],
Atom USING[MakeAtom, GetProp, PutProp, MapAtoms],
Basics USING[LowHalf],
Commander USING[Register, Handle],
FS USING[StreamOpen],
FileUtilDefs USING[GetExtendedFileName, FileExists],
IO USING[STREAM, GetChar, Close, RIS, EndOfStream, PutRope, GetLength],
List USING[Reverse],
MCrossRefDefs,
MCrossSorter USING[Enter, Initialize, Finalize],
MessageWindow USING[Confirm],
Rope USING[Size, ROPE, FromRefText, Fetch],
MCrossUtilityDefs USING[IsTerminator];


MCrossRefMain: PROGRAM 
IMPORTS Atom, Basics, Commander, IO, FS, FileUtilDefs, List, MCrossRefDefs,
MCrossSorter, MessageWindow, Rope, MCrossUtilityDefs          
= BEGIN OPEN MCrossRefDefs;


<<ERRORs>>
EndOfProgram: ERROR = CODE;

<<global variables>>
lineNumber: LineNumberRange;
herald: Rope.ROPE = "-- Cedar Cross Reference Program of May 2, 1983 12:36 pm  --\n";
outputFileName: Rope.ROPE;
inputFileName: Rope.ROPE;
inputSwitches: Rope.ROPE;
inputStream: IO.STREAM _ NIL;
oldch: CHARACTER;
CurrentFileName: ATOM _ NIL;
tabSpaces: CARDINAL;
lineStringLength: CARDINAL;
scannedString: REF TEXT = NEW[TEXT[100]];
reservedXREF: BOOLEAN;
doLineRefs: BOOLEAN;

charWasPutBack: BOOLEAN;
putBackChar: CHARACTER;

execTS: IO.STREAM;

<<internal procedures>>

GetQuotedConstant: PROC =
{ch: CHARACTER;
DO
UNTIL GetChar[] = '" DO NULL; ENDLOOP;
IF (ch _ GetChar[]) # '"
THEN {IF ch # 'L THEN PutCharBack[ch]; EXIT};
ENDLOOP};

PutCharBack: PROC [ch: CHARACTER] =
{IF IsSpacingChar[ch] THEN RETURN;
IF charWasPutBack THEN ERROR;
charWasPutBack _ TRUE;
putBackChar _ ch;

IF lineStringLength>0 THEN lineStringLength _ lineStringLength - 1};

<<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>>
GetChar: PROC RETURNS[ch: CHARACTER] =
{charSpaces: CARDINAL;

SELECT oldch FROM
Ascii.CR, Ascii.LF => { lineNumber _ lineNumber + 1;
lineStringLength _ 0};
Ascii.FF => { lineNumber _ lineNumber+(Gacha8linesPerPage -
(lineNumber MOD Gacha8linesPerPage));
lineStringLength _ 0};
ENDCASE;


IF charWasPutBack
THEN {charWasPutBack _ FALSE; ch _ putBackChar}
ELSE ch _ IO.GetChar[inputStream];

charSpaces _ (IF ch = Ascii.TAB THEN tabSpaces ELSE 1);

<<NOTE is this right?>>
IF ch = Ascii.ControlZ
THEN UNTIL ch = Ascii.CR DO ch _ IO.GetChar[inputStream] ENDLOOP;

IF (lineStringLength _ lineStringLength + charSpaces) > Gacha8charsPerLine THEN
{  -- line overflow
lineNumber _ lineNumber + 1;
lineStringLength _ 0};

oldch _ ch;
RETURN[ch]};


<<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>>
IsSpacingChar: PROC[ch: CHARACTER] RETURNS[BOOLEAN] =
{ OPEN Ascii;
RETURN[ch = SP OR ch = TAB OR ch = CR OR ch = LF OR ch = FF]};

<<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>>
Scan: PROC RETURNS[token: TokenHandle, ch: CHARACTER] =
{atom: ATOM;

DO        --Big Loop, till the next token is scanned

<<initialize>>
scannedString.length _ 0;
ch _ GetChar[];
token _ NIL;

WHILE IsSpacingChar[ch] DO ch _ GetChar[] ENDLOOP; --skip initial spaces, tabs, crs  

UNTIL MCrossUtilityDefs.IsTerminator[ch]
DO
scannedString[scannedString.length] _ ch;
scannedString.length _ scannedString.length + 1;
ch _ GetChar[];
ENDLOOP;

<<here with scannedString and terminator(in ch)>>

IF (scannedString.length # 0) AND scannedString[0] IN ['0..'9] THEN
{PutCharBack[ch]; LOOP}; -- all the way back to retry big loop

IF ch = '- THEN        -- look for comments 
{ ch _ GetChar[];
IF ch = '- THEN
{ch _ GetChar[];
DO
UNTIL ch = '- OR ch = Ascii.CR DO ch _ GetChar[] ENDLOOP;
IF ch = Ascii.CR THEN EXIT;        --comment is snarfed
ch _ GetChar[];
IF ch = '- THEN EXIT;        --comment is snarfed
ENDLOOP}
ELSE {PutCharBack[ch]; ch _ '-};
IF scannedString.length = 0 THEN LOOP}; -- all the way back to retry big loop

IF ch = '" THEN         --look for quoted constants
{GetQuotedConstant[];
IF scannedString.length = 0
THEN LOOP -- all the way back to retry big loop
ELSE ch _ GetChar[]};

IF ch = '' THEN         --look for character constants
{ [] _ GetChar[];
IF scannedString.length = 0
THEN LOOP -- all the way back to retry big loop
ELSE ch _ GetChar[]};

IF scannedString.length = 0 THEN LOOP; -- all the way back to retry big loop

atom _ Atom.MakeAtom[Rope.FromRefText[scannedString]];
IF atom = $END AND ch = '. THEN ERROR EndOfProgram;

token _ NARROW[Atom.GetProp[atom, $MCROSSToken], TokenHandle];
IF token = NIL AND NOT reservedXREF THEN
token _ MakeNewToken[scannedString, identifier, atom];

IF token = NIL OR token.type # (IF reservedXREF THEN reserved ELSE identifier)
THEN LOOP;

RETURN[token, ch];
ENDLOOP};         -- The Big Loop, Scan

<<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>>
MakeNewToken: PROC[tokenString: REF TEXT, type: TokenType, atom: ATOM _ NIL] 
RETURNS[TokenHandle] =
{ token : TokenHandle;
IF atom = NIL THEN atom _ Atom.MakeAtom[Rope.FromRefText[tokenString]];

IF Atom.GetProp[atom, $MCROSSToken] # NIL
THEN ERROR;        --a supposedly new token ain't new;

token _ NEW[Token _ []];
Atom.PutProp[atom, $MCROSSToken, token];

token.type _ type;
token.name _ atom;
IF type = (IF reservedXREF THEN reserved ELSE identifier)
THEN MCrossSorter.Enter[token]; 
RETURN[token]};

<<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>>
SetRef: PROC [fileN: fileNHandle, ln: LineNumberRange, def: BOOLEAN] =
{ p: XRefHandle _ fileN.xrefTail;
np: XRefHandle _ NIL;
IF (fileN.xrefHead = NIL) THEN        -- no XRef list yet
{p _ NEW[XRef _ []];
fileN.xrefHead _ fileN.xrefTail _ p};

IF (p.nRefs = maxNRefs) THEN
{p.next _ np _ NEW[XRef _ []];
fileN.xrefTail _ np;
p _ np};
p.coords[(p.nRefs _ p.nRefs + 1)] _ [def, ln]};

<<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>>
MakeNewFileN: PROC[token: TokenHandle] =
{fN: fileNHandle _ NEW[fileN _ []];
IF token.fileNHead = NIL 
THEN token.fileNHead _ fN
ELSE token.fileNTail.next _ fN;
token.fileNTail _ fN;
fN.name _ CurrentFileName};


<<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>>
Slurp: PROC =
{token: TokenHandle;
ch: CHARACTER;

lineNumber _ 1;
oldch _ Ascii.SP; --vanilla-flavored initial value, or undo last CR from former file
charWasPutBack _ FALSE;

{ DO
ENABLE EndOfProgram, IO.EndOfStream => GOTO eof;
[token, ch] _ Scan[];
IF token = NIL THEN ERROR;
IF token.type # (IF reservedXREF THEN reserved ELSE identifier) THEN ERROR;
<<see if token is in a new file>>
IF (token.fileNTail = NIL) OR (token.fileNTail.name # CurrentFileName)
THEN MakeNewFileN[token];
IF doLineRefs THEN SetRef[token.fileNTail, lineNumber, ch = ':];
ENDLOOP;
EXITS
eof => NULL}};

<<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>>


NoteReservedWords: PROC[wordList: LIST OF REF ANY] =
BEGIN
IF wordList # NIL
THEN FOR l: LIST OF REF ANY _ wordList, l.rest UNTIL l = NIL
DO [] _ MakeNewToken[NIL, reserved, Atom.MakeAtom[NARROW[l.first]]]
ENDLOOP
ELSE
{[] _ MakeNewToken[NIL, reserved, $ABS];
[] _ MakeNewToken[NIL, reserved, $ALL];
[] _ MakeNewToken[NIL, reserved, $AND];
[] _ MakeNewToken[NIL, reserved, $ANY];
[] _ MakeNewToken[NIL, reserved, $ARRAY];
[] _ MakeNewToken[NIL, reserved, $ATOM];
[] _ MakeNewToken[NIL, reserved, $BASE];
[] _ MakeNewToken[NIL, reserved, $BEGIN];
[] _ MakeNewToken[NIL, reserved, $BOOLEAN];
[] _ MakeNewToken[NIL, reserved, $BROADCAST];
[] _ MakeNewToken[NIL, reserved, $CARDINAL];
[] _ MakeNewToken[NIL, reserved, $CHARACTER];
[] _ MakeNewToken[NIL, reserved, $CODE];
[] _ MakeNewToken[NIL, reserved, $COMPUTED];
[] _ MakeNewToken[NIL, reserved, $CONDITION];
[] _ MakeNewToken[NIL, reserved, $CONFIGURATION];
[] _ MakeNewToken[NIL, reserved, $CONTINUE];
[] _ MakeNewToken[NIL, reserved, $CONTROL];
[] _ MakeNewToken[NIL, reserved, $DECREASING];
[] _ MakeNewToken[NIL, reserved, $DEFINITIONS];
[] _ MakeNewToken[NIL, reserved, $DEPENDENT];
[] _ MakeNewToken[NIL, reserved, $DESCRIPTOR];
[] _ MakeNewToken[NIL, reserved, $DIRECTORY];
[] _ MakeNewToken[NIL, reserved, $DO];
[] _ MakeNewToken[NIL, reserved, $ELSE];
[] _ MakeNewToken[NIL, reserved, $ENABLE];
[] _ MakeNewToken[NIL, reserved, $END];
[] _ MakeNewToken[NIL, reserved, $ENDCASE];
[] _ MakeNewToken[NIL, reserved, $ENDLOOP];
[] _ MakeNewToken[NIL, reserved, $ENTRY];
[] _ MakeNewToken[NIL, reserved, $ERROR];
[] _ MakeNewToken[NIL, reserved, $EXIT];
[] _ MakeNewToken[NIL, reserved, $EXITS];
[] _ MakeNewToken[NIL, reserved, $EXPORTS];
[] _ MakeNewToken[NIL, reserved, $FALSE];
[] _ MakeNewToken[NIL, reserved, $FINISHED];
[] _ MakeNewToken[NIL, reserved, $FIRST];
[] _ MakeNewToken[NIL, reserved, $FOR];
[] _ MakeNewToken[NIL, reserved, $FORK];
[] _ MakeNewToken[NIL, reserved, $FRAME];
[] _ MakeNewToken[NIL, reserved, $FROM];
[] _ MakeNewToken[NIL, reserved, $GO];
[] _ MakeNewToken[NIL, reserved, $GOTO];
[] _ MakeNewToken[NIL, reserved, $IF];
[] _ MakeNewToken[NIL, reserved, $IMPORTS];
[] _ MakeNewToken[NIL, reserved, $IN];
[] _ MakeNewToken[NIL, reserved, $INLINE];
[] _ MakeNewToken[NIL, reserved, $INTEGER];
[] _ MakeNewToken[NIL, reserved, $INTERNAL];
[] _ MakeNewToken[NIL, reserved, $JOIN];
[] _ MakeNewToken[NIL, reserved, $LAST];
[] _ MakeNewToken[NIL, reserved, $LENGTH];
[] _ MakeNewToken[NIL, reserved, $LOCKS];
[] _ MakeNewToken[NIL, reserved, $LONG];
[] _ MakeNewToken[NIL, reserved, $LOOP];
[] _ MakeNewToken[NIL, reserved, $MACHINE];
[] _ MakeNewToken[NIL, reserved, $MAX];
[] _ MakeNewToken[NIL, reserved, $MIN];
[] _ MakeNewToken[NIL, reserved, $MOD];
[] _ MakeNewToken[NIL, reserved, $MONITOR];
[] _ MakeNewToken[NIL, reserved, $MONITORED];
[] _ MakeNewToken[NIL, reserved, $MONITORLOCK];
[] _ MakeNewToken[NIL, reserved, $NEW];
[] _ MakeNewToken[NIL, reserved, $NIL];
[] _ MakeNewToken[NIL, reserved, $NOT];
[] _ MakeNewToken[NIL, reserved, $NOTIFY];
[] _ MakeNewToken[NIL, reserved, $NULL];
[] _ MakeNewToken[NIL, reserved, $OF];
[] _ MakeNewToken[NIL, reserved, $OPEN];
[] _ MakeNewToken[NIL, reserved, $OR];
[] _ MakeNewToken[NIL, reserved, $ORDERED];
[] _ MakeNewToken[NIL, reserved, $OVERLAID];
[] _ MakeNewToken[NIL, reserved, $PACKED];
[] _ MakeNewToken[NIL, reserved, $POINTER];
[] _ MakeNewToken[NIL, reserved, $PORT];
[] _ MakeNewToken[NIL, reserved, $PRIVATE];
[] _ MakeNewToken[NIL, reserved, $PROC];
[] _ MakeNewToken[NIL, reserved, $PROCESS];
[] _ MakeNewToken[NIL, reserved, $PROGRAM];
[] _ MakeNewToken[NIL, reserved, $PUBLIC];
[] _ MakeNewToken[NIL, reserved, $READONLY];
[] _ MakeNewToken[NIL, reserved, $REAL];
[] _ MakeNewToken[NIL, reserved, $RECORD];
[] _ MakeNewToken[NIL, reserved, $REF];
[] _ MakeNewToken[NIL, reserved, $RELATIVE];
[] _ MakeNewToken[NIL, reserved, $REPEAT];
[] _ MakeNewToken[NIL, reserved, $RESTART];
[] _ MakeNewToken[NIL, reserved, $RESUME];
[] _ MakeNewToken[NIL, reserved, $RETRY];
[] _ MakeNewToken[NIL, reserved, $RETURN];
[] _ MakeNewToken[NIL, reserved, $RETURNS];
[] _ MakeNewToken[NIL, reserved, $SELECT];
[] _ MakeNewToken[NIL, reserved, $SHARES];
[] _ MakeNewToken[NIL, reserved, $SIGNAL];
[] _ MakeNewToken[NIL, reserved, $SIZE];
[] _ MakeNewToken[NIL, reserved, $START];
[] _ MakeNewToken[NIL, reserved, $STATE];
[] _ MakeNewToken[NIL, reserved, $STOP];
[] _ MakeNewToken[NIL, reserved, $STRING];
[] _ MakeNewToken[NIL, reserved, $THEN];
[] _ MakeNewToken[NIL, reserved, $THROUGH];
[] _ MakeNewToken[NIL, reserved, $TO];
[] _ MakeNewToken[NIL, reserved, $TRANSFER];
[] _ MakeNewToken[NIL, reserved, $TRUE];
[] _ MakeNewToken[NIL, reserved, $TYPE];
[] _ MakeNewToken[NIL, reserved, $UNSPECIFIED];
[] _ MakeNewToken[NIL, reserved, $UNTIL];
[] _ MakeNewToken[NIL, reserved, $UNWIND];
[] _ MakeNewToken[NIL, reserved, $USING];
[] _ MakeNewToken[NIL, reserved, $WAIT];
[] _ MakeNewToken[NIL, reserved, $WHILE];
[] _ MakeNewToken[NIL, reserved, $WITH];
[] _ MakeNewToken[NIL, reserved, $WORD]
};
END;

Finalize: PROC =
{ inputStream _ NIL;
CurrentFileName _ NIL;
MCrossSorter.Finalize[];

{p: SAFE PROC[atom: ATOM] = TRUSTED {Atom.PutProp[atom, $MCROSSToken, NIL]};
Atom.MapAtoms[p]}};

MCross: SAFE PROC [cmd: Commander.Handle]
RETURNS [result: REF _ NIL, msg: Rope.ROPE _ NIL] = TRUSTED {
ENABLE UNWIND => GOTO unwind;
comCMStream: IO.STREAM = IO.RIS[cmd.commandLine];
inputFileNames: LIST OF REF ANY _ NIL;
specifiedWords: LIST OF REF ANY _ NIL;
snarfingSpecifiedWords: BOOLEAN _ FALSE;

Finalize[];
execTS _ cmd.out;
lineStringLength _ 0;
tabPosition _ 0;
tabSpaces _ 8;
reservedXREF _ FALSE;
doLineRefs _ TRUE;

IO.PutRope[execTS, "\n"];
IO.PutRope[execTS, herald];

<<try to get an output "mcross" file name from the command line>>
outputFileName _ NIL;
IF IO.GetLength[comCMStream] # 0
THEN [outputFileName, ] _ FileUtilDefs.GetExtendedFileName[comCMStream, "mcross"];
IF outputFileName = NIL THEN {
IO.PutRope[execTS, "MCross <outFile.mcross> <inFile1.mesa> <inFile2.mesa> ...\n"];
IO.PutRope[execTS,
"   File name extensions may be defaulted; outFile extension must be 'mcross'\n"];
Finalize[];
RETURN};

IF FileUtilDefs.FileExists[outputFileName] THEN {
IO.PutRope[execTS, "\n"];
IO.PutRope[execTS, outputFileName];
IO.PutRope[execTS, " exists. Do you want to replace its contents? "];
IF NOT MessageWindow.Confirm["[Confirm]"] THEN {Finalize[];RETURN}};

SetMCrossOutputStream[outputFileName];

IO.PutRope[execTS, "        Output to "];
IO.PutRope[execTS, outputFileName];
IO.PutRope[execTS, "\n"];
OutputLine[" ***** Cross Reference for files:"];
OutputChar[Ascii.CR];

MCrossSorter.Initialize[15];  -- only the first 15 chars alphabetized

DO        -- read parameters
[inputFileName, inputSwitches]
_ FileUtilDefs.GetExtendedFileName[comCMStream,
(IF snarfingSpecifiedWords
THEN NIL
ELSE "mesa"),
FALSE];
FOR i: INT IN [0..Rope.Size[inputSwitches])
DO SELECT Rope.Fetch[inputSwitches, i] FROM
'b, 'B => {IO.PutRope[execTS,
"***Listing references to specified words only.\n"];
reservedXREF _ TRUE;
snarfingSpecifiedWords _ TRUE};
'e, 'E => snarfingSpecifiedWords _ FALSE;
'f, 'F => {IO.PutRope[execTS,
"***Not listing individual line references.\n"];
doLineRefs _ FALSE};
ENDCASE;
ENDLOOP;
IF inputSwitches = NIL AND inputFileName = NIL THEN EXIT;        -- no more input files
IF inputFileName = NIL THEN LOOP;
IF snarfingSpecifiedWords
THEN {specifiedWords _ CONS[inputFileName, specifiedWords];
LOOP};
inputFileNames _ CONS[inputFileName, inputFileNames];
IF NOT FileUtilDefs.FileExists[inputFileName] THEN
{IO.PutRope[execTS, inputFileName];
IO.PutRope[execTS, " does not exist. Should I continue? "];
IF MessageWindow.Confirm["[Confirm]"]
THEN LOOP ELSE {Finalize[];RETURN}};


tabPosition _ MAX[tabPosition, Basics.LowHalf[Rope.Size[inputFileName]]+5];
ENDLOOP;        -- read parameters

NoteReservedWords[specifiedWords];

inputFileNames _ List.Reverse[inputFileNames];

FOR l: LIST OF REF ANY _ inputFileNames, l.rest UNTIL l = NIL
DO        -- process all input files
inputFileName _ NARROW[l.first];
inputStream _ FS.StreamOpen[fileName: inputFileName];
IO.PutRope[execTS, inputFileName];
IO.PutRope[execTS, "..."];
OutputLine[inputFileName];

CurrentFileName _ Atom.MakeAtom[inputFileName];

Slurp[];
IO.Close[inputStream];
ENDLOOP;        -- process all input files

IO.PutRope[execTS, "\n"];
IO.PutRope[execTS, "Dumping the Cross Reference..."];
PrintXREF[execTS];
DestroyMCrossOutputStream[];
IO.PutRope[execTS, "done.\n"];
Finalize[];
EXITS unwind => Finalize[];
};  -- END of MCross procedure


<<MODULE INITIALIZATION>>

Commander.Register["MCross", MCross, "cross reference maker"];

END.