TestInterface.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Satterthwaite, April 21, 1986 5:20:59 pm PST
Maxwell, January 26, 1984 9:05:33 am PST
Paul Rovner, December 4, 1983 11:57 am
Spreitzer, May 16, 1984 7:45:09 pm PDT
Russ Atkinson (RRA) April 3, 1985 4:02:43 pm PST
Bob Hagmann May 24, 1985 11:48:36 am PDT
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;
};
};
acquire the compiler's resource lock; await success
IF NOT WaitForCompilerFree[] THEN {RETURN[$Failure, "B"]}; -- Blocked
init cmdStream and sourceName
cmdStream ← IO.RIS[cmd.commandLine];
sourceName ← NIL;
do the compilation
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 {
use a simple syntax for the command line
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;
feedback to user
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;
main line code
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};
};
Here after completion of subcommand
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;
Here after completion of all subcommands
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[];
};
compiler sequencing
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]]}};
write to the Commander output file
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]};
special output stream control
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]}
};
START HERE
Commander.Register["TestCompile", Compile, "", $Complex];
--Commander.Register["MyCompile", NIL, Compile, "", $Complex];
}.