SaffronDriver.Mesa
Copyright Ó 1987 by Xerox Corporation. All rights reserved.
Sturgis, July 23, 1987 6:13:00 pm PDT
Bill Jackson (bj) August 11, 1987 1:25:18 pm PDT
Lucy Hederman July 30, 1987 2:12:24 pm PDT
Last edited by: James Rauen July 11, 1988 12:54:53 pm PDT
DIRECTORY
Commander USING [ CommandProc, Register ],
FS USING [StreamOpen],
IO USING [ Close, EndOfStream, GetTokenRope, IDProc, PutF, PutFR, RIS, rope, STREAM ],
OneCasabaParser USING [ GetReportStream ],
Rope USING [ Concat, Find, IsPrefix, ROPE ],
SaffronATDef USING [ ModulePNode, ModulePVal ],
SaffronBaseDef USING [CompilerStateNode, CreateEmptyEnvironment, EnvironmentNode, MakeCompilerState, ReadDefFile ],
SaffronContext USING [ ErrorSignal, ShowEnvironment ],
SaffronDefaultArchitecture USING [DefaultArchitecture],
SaffronErrorHandling,
ThreeC4Support USING [ GetReportStream ];
SaffronDriver:
CEDAR
MONITOR
IMPORTS Commander, FS, IO, OneCasabaParser, Rope, SaffronATDef, SaffronBaseDef, SaffronContext, SaffronDefaultArchitecture, SaffronErrorHandling, ThreeC4Support
~ {
OPEN AT: SaffronATDef, BD: SaffronBaseDef, EH: SaffronErrorHandling;
debugFlags: CARDINAL ← 0;
PrintHelp:
PROC[s:
IO.
STREAM] ~
BEGIN
IO.PutF[s, "Usage: Saffron [-options] filename\n"];
IO.PutF[s, " The filename should not have an extension.\n"];
IO.PutF[s, " Options are:\n"];
IO.PutF[s, " t = Print type graph.\n"];
IO.PutF[s, " p = Generate a program graph.\n"];
END;
SaffronCompiler: Commander.CommandProc ~
BEGIN
ENABLE {
ThreeC4Support.GetReportStream => RESUME[cmd.out];
OneCasabaParser.GetReportStream => { result ← $Failure; RESUME[cmd.out] };
IO.EndOfStream => { PrintHelp[cmd.out]; GOTO puntQuietly};
Declarations
args: IO.STREAM ← IO.RIS[cmd.commandLine];
firstArg, options, fileName: Rope.ROPE;
root: AT.ModulePNode;
env: BD.EnvironmentNode;
cs: BD.CompilerStateNode;
if: BD.InterfaceValNode ← NIL;
pg: BD.CompilerStateNode ← NIL;
messageCount: INT ← 0;
warningCount: INT ← 0;
errorCount: INT ← 0;
BEGIN
Handle any messges, warnings, or errors that might be raised.
ENABLE
BEGIN
SaffronContext.ErrorSignal => {
EH.ReportInternalError[cmd.out, "SaffronContext.ErrorSignal used"];
GOTO punt;
};
EH.Message => {
messageCount ← messageCount + 1;
EH.ReportMessage[cmd.out, messageCount, message];
RESUME;
};
EH.Warning => {
warningCount ← warningCount + 1;
EH.ReportWarning[cmd.out, warningCount, position, reason];
RESUME;
};
EH.Error => {
errorCount ← errorCount + 1;
EH.ReportError[cmd.out, errorCount, position, reason];
RESUME;
};
EH.FatalError => {
errorCount ← errorCount + 1;
EH.ReportFatalError[cmd.out, errorCount, position, reason];
GOTO punt;
};
Don't catch EH.InternalError; we want a notifier to pop up when an internal error occurs.
END;
Parse the command line.
firstArg ← IO.GetTokenRope[args, IO.IDProc].token;
IF Rope.IsPrefix["-", firstArg]
THEN { options ← firstArg; fileName ← IO.GetTokenRope[args, IO.IDProc].token;}
ELSE { options ← ""; fileName ← firstArg};
Parse the source file. If the parser encounters any syntax errors, it will signal OneCasabaParser.GetReportStream; the ENABLE clause (above) will notice this and set result to $Failure.
result ← $Success;
root ← AT.ModulePVal[BD.ReadDefFile[fileName]];
IF ( result = $Failure )
THEN { SIGNAL EH.Message["Syntax errors detected."]; GOTO punt }
ELSE { SIGNAL EH.Message["No syntax errors detected."] };
Create a CompilerState
cs ← BD.MakeCompilerState[SaffronDefaultArchitecture.DefaultArchitecture[], options];
Apply the tree-recursive procedure MakeEnvironment to the abstract parse tree root.
env ← root.procs.MakeEnvironment[root, fileName,
BD.CreateEmptyEnvironment[], cs];
IF errorCount > 0
THEN
GOTO punt;
IF Rope.Find[options, "t"] ~= -1
THEN
BEGIN
logFileName: Rope.ROPE ← Rope.Concat[fileName, ".log"];
logStream: IO.STREAM ← FS.StreamOpen[logFileName, $create];
SaffronContext.ShowEnvironment[logStream, 0, env, cs];
IO.PutF[logStream, "\n"];
IO.Close[logStream];
SIGNAL EH.Message[IO.PutFR["Log written to %g", IO.rope[logFileName]]];
END;
END;
IO.PutF[cmd.out, "No errors.\n"];
EXITS
punt => IO.PutF[cmd.out, "Compilation aborted.\n"];
puntQuietly => NULL;
END;
Commander.Register["Saffron", SaffronCompiler];
}.