<> <> <> <> <> <> <> <> DIRECTORY Ascii: TYPE USING [Lower], BasicTime: TYPE USING [GMT, Now, Period, ToNSTime], Commander: TYPE USING [CommandObject, Handle, Register], CommandUtil: TYPE USING [PairList, Echo, Failed, GetNth, GetRootName, ListLength, Parse, SetExtension], CompilerOps: TYPE USING [AppendHerald, DefaultSwitches, DoTransaction, LetterSwitches, Punt, Start, Stop, StreamId, Transaction], FileNames: TYPE USING [CurrentWorkingDirectory, GetShortName], FileParms: TYPE USING [BindingProc, nullActual], FileParmOps: TYPE USING [ClearAList, Finalize, Initialize, SetAList], FS: TYPE USING [Delete, Error, FileInfo, GetName, nullOpenFile, OpenFile, OpenFileFromStream, StreamOpen], IO: TYPE USING [Close, EndOfStream, Error, GetTokenRope, IDProc, int, Put, PutChar, PutRope, RIS, rope, STREAM, time], Process: TYPE USING [CheckForAbort, GetPriority, MsecToTicks, Priority, priorityBackground, SetPriority, SetTimeout], Rope: TYPE USING [Fetch, Length, ROPE, Substr], TimeStamp: TYPE USING [Null]; TestInterface: MONITOR IMPORTS Ascii, BasicTime, Commander, CommandUtil, CompilerOps, FileNames, FileParmOps, FS, IO, Process, Rope = { Outcome: TYPE = {ok, warnings, errors, aborted}; parms: REF CompilerOps.Transaction = NEW[CompilerOps.Transaction]; standardDefaults: CompilerOps.LetterSwitches = CompilerOps.DefaultSwitches[]; sourceName, objectName, errorName, rootName, wDir: Rope.ROPE _ NIL; sourceStream, objectStream, errorStream: IO.STREAM _ NIL; <<>> useLog: BOOL; -- use compiler.log for error reporting log: IO.STREAM _ NIL; compilerInUse: BOOL _ FALSE; inUseChanged: CONDITION; inUseTimeoutMillis: NAT _ 1000; WaitForCompilerFree: ENTRY PROC RETURNS[BOOL] = { ENABLE UNWIND => NULL; IF compilerInUse THEN { Process.CheckForAbort[]; Process.SetTimeout[@inUseChanged, Process.MsecToTicks[inUseTimeoutMillis]]; WAIT inUseChanged; RETURN[FALSE]}; RETURN[compilerInUse _ TRUE]}; SetCompilerFree: ENTRY PROC = { compilerInUse _ FALSE; BROADCAST inUseChanged}; Compile: SAFE PROC[cmd: Commander.Handle] RETURNS[result: REF _ NIL, msg: Rope.ROPE _ NIL] ~ TRUSTED { userAbort: BOOL _ FALSE; -- set by ^DEL, STOP errors, warnings: BOOL _ FALSE; priority: Process.Priority = Process.GetPriority[]; compilerStartTime, moduleStartTime: BasicTime.GMT; switchDefaults: CompilerOps.LetterSwitches; moduleCount: CARDINAL _ 0; complex: BOOL = (SELECT cmd.procData.clientData FROM $Vanilla => FALSE, $Complex => TRUE, $RemoteVanilla => FALSE, ENDCASE => ERROR); cmdStream: IO.STREAM; filesInit: BOOL _ FALSE; started: BOOL _ FALSE; Cleanup: PROC = { Process.SetPriority[priority]; IF log # NIL THEN {IO.Close[log ! IO.Error => CONTINUE;]; log _ NIL}; IF started THEN {started _ FALSE; CompilerOps.Stop[]}; IF filesInit THEN {filesInit _ FALSE; FileParmOps.Finalize[]}; SetCompilerFree[]}; Initialize: PROC = { sourceStream _ FS.StreamOpen[sourceName]; parms.sourceStream _ sourceStream; parms.source.version _ TimeStamp.Null; parms.source.version.time _ BasicTime.ToNSTime[FS.FileInfo[name: sourceName, wDir: wDir].created]; }; Finalize: PROC[userAbort: BOOL] = { sourceFileName: Rope.ROPE; IF objectStream # NIL THEN IO.Close[objectStream ! IO.Error => CONTINUE]; IF sourceStream # NIL THEN { sourceFile: FS.OpenFile _ FS.OpenFileFromStream[sourceStream]; sourceFileName _ FS.GetName[sourceFile ! FS.Error => CONTINUE].fullFName; IO.Close[sourceStream ! IO.Error => CONTINUE]}; IF errorStream # NIL AND errorStream # log THEN IO.Close[errorStream ! IO.Error => CONTINUE]; objectStream _ sourceStream _ errorStream _ NIL; IF userAbort OR parms.nErrors # 0 THEN { IF objectName # NIL THEN DO FS.Delete[name: objectName, wDir: wDir ! FS.Error => IF error.group = lock OR error.code = $unknownFile THEN EXIT]; ENDLOOP; }; IF errorName = NIL THEN { errlogFileName: Rope.ROPE _ CommandUtil.SetExtension[rootName, "errlog"]; DO FS.Delete[name: errlogFileName, wDir: wDir ! FS.Error => IF error.group = lock OR error.code = $unknownFile THEN EXIT]; ENDLOOP; }; }; <> IF NOT WaitForCompilerFree[] THEN {RETURN[$Failure, "B"]}; -- Blocked <> cmdStream _ IO.RIS[cmd.commandLine]; sourceName _ NIL; <> Process.SetPriority[Process.priorityBackground]; BEGIN ENABLE UNWIND => Cleanup[]; StartPass: PROC[pass: CARDINAL] RETURNS[goOn: BOOL] = { userAbort _ FALSE; Process.CheckForAbort[ ! ABORTED => {userAbort _ TRUE; CONTINUE}]; cmd.out.PutRope["." ! ABORTED => {userAbort _ TRUE; CONTINUE}]; IF userAbort THEN cmd.out.PutRope[" aborted."]; RETURN[~userAbort]}; compilerStartTime _ BasicTime.Now[]; switchDefaults _ CompilerOps.DefaultSwitches[]; parms.fileParms _ FileParmOps.Initialize[]; filesInit _ TRUE; CompilerOps.Start[]; started _ TRUE; wDir _ FileNames.CurrentWorkingDirectory[]; IF log = NIL THEN log _ FS.StreamOpen[fileName: "Compiler.log", accessOptions: $create]; WriteHerald[log, NIL]; DO first: BOOL; args, results: CommandUtil.PairList; switches: Rope.ROPE _ NIL; localPause: BOOL; sense: BOOL; { -- start scope for EXITS parms.switches _ switchDefaults; parms.switches['p] _ FALSE; parms.debugPass _ CARDINAL.LAST; parms.getStream _ GetStream; parms.startPass _ StartPass; parms.objectBytes _ parms.objectFrameSize _ parms.linkCount _ 0; parms.nErrors _ parms.nWarnings _ 0; parms.sourceTokens _ 0; IF complex THEN [sourceName, args, results, switches] _ CommandUtil.Parse[cmdStream ! CommandUtil.Failed => GOTO badSyntax] ELSE { <> token: Rope.ROPE; token _ cmdStream.GetTokenRope[IO.IDProc ! IO.EndOfStream => EXIT].token; IF token.Length[] > 0 THEN SELECT token.Fetch[0] FROM '- => switches _ token.Substr[1, token.Length[]-1]; ENDCASE => sourceName _ token }; IF sourceName = NIL AND switches = NIL THEN EXIT; IO.PutRope[log, "\nCommand: "]; CommandUtil.Echo[log, sourceName, args, results, switches]; IF CommandUtil.ListLength[results] > 1 THEN GOTO badSemantics; IF sourceName = NIL THEN GOTO globalSwitches; rootName _ CommandUtil.GetRootName[IF CommandUtil.ListLength[results] = 1 THEN CommandUtil.GetNth[results, 0] ELSE FileNames.GetShortName[sourceName]]; IF switches # NIL THEN { sense _ TRUE; FOR i: INT IN [0..switches.Length[]) DO c: CHAR = switches.Fetch[i]; SELECT c FROM '-, '~ => sense _ ~sense; IN ['a..'z], IN ['A..'Z] => { parms.switches[Ascii.Lower[c]] _ sense; sense _ TRUE}; IN ['1..'5] => { parms.debugPass _ c-'0; sense _ TRUE}; ENDCASE => sense _ TRUE; ENDLOOP; switches _ NIL; }; sourceName _ CommandUtil.SetExtension[sourceName, "mesa"]; parms.source.locator _ FileNames.GetShortName[sourceName]; IF CommandUtil.ListLength[results] # 0 THEN { objectName _ CommandUtil.GetNth[list: results, n: 0, delete: TRUE]; results _ NIL} ELSE objectName _ rootName; objectName _ CommandUtil.SetExtension[objectName, "bcd"]; parms.objectName _ objectName; parms.objectFile _ FS.nullOpenFile; moduleCount _ moduleCount + 1; <> cmd.out.Put[IO.rope["Compiling: "], IO.rope[rootName]]; first _ TRUE; FOR c: CHAR IN ['a..'z] DO sd: BOOL = (IF c = 'p THEN FALSE ELSE standardDefaults[c]); IF parms.switches[c] # sd THEN { IF first THEN {first _ FALSE; cmd.out.PutChar['/]}; IF sd THEN cmd.out.PutChar['-]; cmd.out.PutChar[c]}; ENDLOOP; useLog _ parms.switches['g]; parms.switches['g] _ FALSE; localPause _ parms.switches['p]; parms.switches['p] _ FALSE; <
> Initialize[ ! FS.Error => GOTO noSource]; sourceName _ FileNames.GetShortName[sourceName]; { ENABLE UNWIND => Finalize[userAbort]; FileParmOps.SetAList[args]; { ENABLE UNWIND => FileParmOps.ClearAList[]; BindPattern: FileParms.BindingProc = { parms.pattern _ actual; parms.op _ IF actual = FileParms.nullActual THEN $compile ELSE $replace}; parms.fileParms.Binding[formalId: "$", formalType: NIL, binder: BindPattern]; log.PutChar['\n]; moduleStartTime _ BasicTime.Now[]; CompilerOps.DoTransaction[parms ! CompilerOps.Punt => { FileParmOps.ClearAList[]; Finalize[userAbort]; GOTO punt}; ABORTED => { userAbort _ TRUE; FileParmOps.ClearAList[]; Finalize[userAbort]; GOTO truncateList} ]; }; -- end ENABLE UNWIND => FileParmOps.ClearAList[]; FileParmOps.ClearAList[]; }; -- end ENABLE UNWIND => Finalize[]; Finalize[userAbort]; SELECT WriteResults[cmd.out, moduleStartTime ! IO.Error => CONTINUE] FROM errors => errors _ TRUE; warnings => warnings _ TRUE; ENDCASE; EXITS globalSwitches => { objectName _ NIL; sense _ TRUE; FOR i: INT IN [0..switches.Length[]) DO c: CHAR = switches.Fetch[i]; SELECT c FROM '-, '~ => sense _ ~sense; IN ['a..'z] => {switchDefaults[c] _ sense; sense _ TRUE}; IN ['A..'Z] => { switchDefaults[VAL['a.ORD+(c.ORD-'A.ORD)]] _ sense; sense _ TRUE}; ENDCASE => EXIT; ENDLOOP; switches _ NIL; args _ NIL}; noSource => { log.Put[IO.rope[" -- source not found\n"], IO.time[]]; IO.PutRope[cmd.out, " -- source not found\n"]; errors _ TRUE; parms.nErrors _ 1; args _ NIL}; badSemantics => { objectName _ NIL; errors _ TRUE; log.PutRope[" -- Illegal command"]; args _ NIL}; }; <> sourceName _ rootName _ objectName _ errorName _ NIL; parms.objectName _ NIL; results _ NIL; log.PutChar['\n]; IF userAbort THEN {log.PutRope["\n... command aborted\n"]; GOTO truncateList}; IF (errors OR warnings) AND localPause THEN GOTO truncateList; REPEAT badSyntax => {IO.PutRope[log, "\n-- Illegal syntax"]; errors _ TRUE}; truncateList => switchDefaults['p] _ TRUE; punt => {-- was Finalize[]; , but this is done by new UNWIND catch phrase errors _ TRUE; [] _ WriteResults[cmd.out, moduleStartTime ! IO.Error => CONTINUE]; log.PutChar['\n]}; ENDLOOP; <> WriteClosing[cmd.out, compilerStartTime, moduleCount]; SELECT TRUE FROM userAbort => {result _ $Failure; msg _ "A"}; errors => {result _ $Failure; msg _ "F"}; warnings => {result _ $Failure; msg _ "W"}; ENDCASE => {result _ $Success; msg _ "S"}; END; -- end catch phrase to release the resource and reset the process priority Cleanup[]; }; <<>> <> WriteResults: PROC[out: IO.STREAM, startTime: BasicTime.GMT] RETURNS[outcome: Outcome] = { OPEN IO; elapsed: INT; log.Put[rope[sourceName], rope[" -- "]]; elapsed _ BasicTime.Period[from: startTime, to: BasicTime.Now[]]; IF parms.nErrors # 0 THEN { log.Put[rope["aborted, "], int[parms.nErrors], rope[" errors"]]; IF parms.nWarnings # 0 THEN { log.Put[rope[" and "], int[parms.nWarnings], rope[" warnings"]]}; IF ~useLog THEN log.Put[IO.rope[" on "], IO.rope[wDir], IO.rope[errorName]]; log.Put[rope[", seconds: "], int[elapsed]]} ELSE { log.Put[rope["source tokens: "], int[parms.sourceTokens]]; log.Put[rope[", seconds: "], int[elapsed]]; IF parms.objectBytes # 0 THEN { log.Put[rope["\n code bytes: "], int[parms.objectBytes]]; log.Put[rope[", links: "], int[parms.linkCount]]; log.Put[rope[", frame size: "], int[parms.objectFrameSize]]; IF parms.matched THEN PutChar[log, '.]}; IF parms.nWarnings # 0 THEN { log.PutChar['\n]; log.Put[int[parms.nWarnings], rope[" warnings"]]; IF log # NIL AND ~useLog THEN log.Put[IO.rope[" on "], IO.rope[errorName]]}}; <> out.PutRope[" "]; IF parms.nErrors = 0 THEN out.PutRope["no errors"] ELSE out.Put[IO.int[parms.nErrors], IO.rope[" errors"]]; IF parms.nWarnings # 0 THEN out.Put[IO.rope[", "], IO.int[parms.nWarnings], IO.rope[" warnings"]]; out.PutRope[".\n"]; RETURN[SELECT TRUE FROM parms.nErrors # 0 => $errors, parms.nWarnings # 0 => $warnings, ENDCASE => $ok] }; WriteHerald: PROC[s: IO.STREAM, id: Rope.ROPE] = { CompilerOps.AppendHerald[s]; IO.PutRope[s, " (Cedar 6 Version)\n"]; IF id # NIL THEN {IO.Put[s, IO.rope[id], IO.rope[" -- "]]}; IO.Put[s, IO.time[], IO.rope["\n"]]}; WriteClosing: PROC[out: IO.STREAM, startTime: BasicTime.GMT, moduleCount: CARDINAL] = { elapsed: INT; out.PutRope["End of compilation\n"]; elapsed _ BasicTime.Period[from: startTime, to: BasicTime.Now[]]; IF moduleCount > 1 THEN IO.Put[log, IO.rope["\nTotal elapsed seconds: "], IO.int[elapsed]]; log.PutChar['\n]}; <> GetStream: PROC[id: CompilerOps.StreamId] RETURNS[s: IO.STREAM] = { SELECT id FROM source => RETURN[sourceStream]; object => { IF objectStream = NIL THEN objectStream _ NewOutputStream[objectName]; RETURN[objectStream]}; log => {IF errorStream = NIL THEN ErrorInit[]; RETURN[errorStream]}; ENDCASE => ERROR; }; NewOutputStream: PROC[fileName: Rope.ROPE] RETURNS[stream: IO.STREAM] = { stream _ FS.StreamOpen[fileName: fileName, accessOptions: $create]}; ErrorInit: PROC = { IF errorStream = NIL THEN IF useLog THEN errorStream _ log ELSE { errorName _ CommandUtil.SetExtension[rootName, "errlog"]; errorStream _ FS.StreamOpen[fileName: errorName, accessOptions: $create]; WriteHerald[errorStream, errorName]; errorStream.PutChar['\n]} }; <> Commander.Register["TestCompile", Compile, "", $Complex]; --Commander.Register["MyCompile", NIL, Compile, "", $Complex]; }.