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}; }; args: IO.STREAM _ IO.RIS[cmd.commandLine]; firstArg, options, fileName: Rope.ROPE; root: AT.ModulePNode; env: BD.EnvironmentNode; cs: BD.CompilerStateNode; messageCount: INT _ 0; warningCount: INT _ 0; errorCount: INT _ 0; BEGIN 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; }; END; 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}; 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."] }; cs _ BD.MakeCompilerState[SaffronDefaultArchitecture.DefaultArchitecture[], options]; 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]; }. 6SaffronDriver.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 Declarations if: BD.InterfaceValNode _ NIL; pg: BD.CompilerStateNode _ NIL; Handle any messges, warnings, or errors that might be raised. Don't catch EH.InternalError; we want a notifier to pop up when an internal error occurs. Parse the command line. 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. Create a CompilerState Apply the tree-recursive procedure MakeEnvironment to the abstract parse tree root. ÊÃ– "cedar" style˜codešœ™K™