
<<Interface.mesa>>
<<last modified by Satterthwaite, May 12, 1983 5:16 pm>>
<<Last Edited by: Maxwell, September 14, 1983 3:15 pm>>
<<Last Edited by: Paul Rovner, December 4, 1983 11:57 am>>

DIRECTORY
Ascii: TYPE USING [Lower],
BasicTime: TYPE USING [GMT, Now, Period, ToNSTime],
Commander: TYPE USING [Handle, Register],
CommandUtil: TYPE USING [
PairList, Echo, Failed, GetNth, GetRootName, ListLength, Parse, SetExtension],
CompilerOps: TYPE USING [
LetterSwitches, StreamId, Transaction,
AppendHerald, DefaultSwitches, DoTransaction, Punt, Start, Stop],
FileParms: TYPE USING [BindingProc, nullActual],
FileParmOps: TYPE USING [ClearAList, Finalize, Initialize, SetAList],
FileViewerOps: TYPE USING [ShowLog, WaitUntilSaved],
FS: TYPE USING [nullOpenFile, OpenFile, StreamOpen, FileInfo, Error, Delete],
IO: TYPE USING [Close, Error, int, Put, PutChar, PutRope, rope, STREAM, time, RIS],
Process: TYPE USING [GetPriority, Priority, priorityBackground, SetPriority],
ProcessExtras: TYPE USING [CheckForAbort],
Resource: TYPE USING [AbortProc, Acquire, Release],
Rope: TYPE USING [Cat, Fetch, Length, ROPE],
TimeStamp: TYPE USING [Null],
UserProfile: TYPE USING [Boolean, Token];

Interface: PROGRAM
IMPORTS
Ascii, BasicTime, Commander, CommandUtil, CompilerOps, FileParmOps, FileViewerOps, FS, 
IO, Process, ProcessExtras, Resource, Rope, UserProfile
= { 

Outcome: TYPE = {ok, warnings, errors, aborted};

parms: REF CompilerOps.Transaction = NEW[CompilerOps.Transaction];
standardDefaults: CompilerOps.LetterSwitches = CompilerOps.DefaultSwitches[];
switchDefaults: CompilerOps.LetterSwitches;
sourceName, objectName, errorName, rootName: Rope.ROPE _ NIL;
sourceStream, objectStream, errorStream: IO.STREAM _ NIL;
<<>>
useLog: BOOL;        -- use compiler.log for error reporting
log: IO.STREAM _ NIL;

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;
moduleCount: CARDINAL _ 0;

compilerSwitches: Rope.ROPE _ UserProfile.Token["Compiler.Switches"];
cmdStream: IO.STREAM;
IF UserProfile.Boolean["Compiler.SeparateLogs", FALSE] 
THEN compilerSwitches _ Rope.Cat[compilerSwitches, "-g"];
IF compilerSwitches.Length[] # 0
THEN {
cmd.commandLine _ Rope.Cat["/", compilerSwitches, " ", cmd.commandLine];
};
cmdStream _ IO.RIS[cmd.commandLine];

<<acquire the compiler's resource lock; await success>>
{
otherOwner: Rope.ROPE;
success: BOOL _ FALSE;
abortProc: Resource.AbortProc = TRUSTED{
<<-- PROC [data: REF ANY] RETURNS[abort: BOOL];>>
abort _ FALSE;
ProcessExtras.CheckForAbort[! ABORTED => {abort _ TRUE; CONTINUE}];
};
[success, otherOwner] _ Resource.Acquire[
resource: $Compiler, owner: "Compiler", waitForIt: FALSE];
IF NOT success THEN {
cmd.out.PutRope[Rope.Cat["Waiting for ", otherOwner, " to finish..."]];
[success, ] _ Resource.Acquire
[resource: $Compiler, owner: "Compiler", waitForIt: TRUE, abortProc: abortProc];
IF NOT success 
THEN RETURN[$Failure, "ABORTED"]
ELSE cmd.out.PutRope["proceeding\n"];
};
};

<<do the compilation>>
Process.SetPriority[Process.priorityBackground];
BEGIN ENABLE UNWIND => {Process.SetPriority[priority]; [] _ Resource.Release[$Compiler]};

StartPass: PROC [pass: CARDINAL] RETURNS [goOn: BOOL] = {
userAbort _ FALSE;
ProcessExtras.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[];
{ ENABLE UNWIND => FileParmOps.Finalize[];
CompilerOps.Start[];
{ ENABLE UNWIND => CompilerOps.Stop[];

IF log = NIL THEN log _ FS.StreamOpen[fileName: "Compiler.log", accessOptions: $create];
{ ENABLE UNWIND => {log.Close[]; log _ NIL};

WriteHerald[log, NIL];  

DO
first: BOOL;
args, results: CommandUtil.PairList;
switches: Rope.ROPE _ NIL;
localPause: BOOL;
sense: BOOL;

BEGIN   -- for EXITS clause
parms.switches _ switchDefaults;  parms.switches['p] _ FALSE;
parms.debugPass _ CARDINAL.LAST;
parms.getStream _ GetStream;  parms.startPass _ StartPass;
parms.objectBytes _ 0;  parms.objectFrameSize _ 0;  parms.linkCount _ 0;
parms.nErrors _ 0;  parms.nWarnings _ 0;
parms.sourceTokens _ 0;

[sourceName, args, results, switches] _
CommandUtil.Parse[cmdStream ! CommandUtil.Failed => GOTO badSyntax];
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 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;
ENDLOOP;
};
sourceName _ CommandUtil.SetExtension[sourceName, "mesa"];
FileViewerOps.WaitUntilSaved[sourceName, cmd.out
! ABORTED => {userAbort _ TRUE; GOTO truncateList}];
parms.source.locator _ sourceName;

IF CommandUtil.ListLength[results] # 0
THEN {
objectName _ CommandUtil.GetNth[list: results, n: 0, delete: TRUE];
results _ NIL;
}
ELSE objectName _ rootName;
parms.objectName _ CommandUtil.SetExtension[objectName, "bcd"];
parms.objectFile _ FS.nullOpenFile;

moduleCount _ moduleCount + 1;

<<feedback to user>>
<<IF beginItem # NIL THEN IF beginItem[sourceName, out] THEN LOOP;>>
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];
{ 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];

NewLogLine[];  
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;
<<IF endItem # NIL THEN endItem[sourceName, out, outcome];>>

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;
};
noSource => {
log.Put[IO.rope[" -- source not found\n"], IO.time[]];
errors _ TRUE;  parms.nErrors _ 1;
args _ NIL;
};
badSemantics => {
objectName _ NIL; errors _ TRUE;
log.PutRope[" -- Illegal command"];
};
END;

<<Here after completion of subcommand>>
NewLogLine[];
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];
NewLogLine[];
};
ENDLOOP;
<<Here after completion of all subcommands>>
}; -- end ENABLE UNWIND => log.Close[]
}; -- end ENABLE UNWIND => CompilerOps.Stop[]
CompilerOps.Stop[];
}; -- end ENABLE UNWIND => FileParmOps.Finalize[]
FileParmOps.Finalize[];
WriteClosing[cmd.out, compilerStartTime, moduleCount];
log.Close[]; log _ NIL;

IF userAbort OR errors OR warnings THEN result _ $Failure ELSE result _ $Success;
FileViewerOps.ShowLog[
fileName: "Compiler.log",
destroyIt: result # $Failure,
createIconic: UserProfile.Boolean["Compiler.IconicLogs", FALSE],
blinkIfIconic: UserProfile.Boolean["Compiler.BlinkLogs", TRUE]
];
END;  -- end catch phrase to release the resource and reset the process priority
Process.SetPriority[priority];
[] _ Resource.Release[$Compiler];
};  -- end Compile
<<>>
<<compiler sequencing>>

Initialize: PROC  = {
sourceStream _ FS.StreamOpen[sourceName];
parms.sourceStream _ sourceStream;
parms.source.version _ TimeStamp.Null;
parms.source.version.time _ BasicTime.ToNSTime[FS.FileInfo[sourceName].created]};

Finalize: PROC [userAbort: BOOL] = {
IF objectStream # NIL THEN IO.Close[objectStream ! IO.Error => CONTINUE];
IF sourceStream # NIL THEN 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[objectName ! FS.Error => IF error.code = $unknownFile THEN EXIT];
ENDLOOP;
};
};
IF errorName = NIL THEN {
errorName _ CommandUtil.SetExtension[rootName, "errlog"]; 
DO
FS.Delete[errorName ! FS.Error => IF error.code = $unknownFile THEN EXIT];
ENDLOOP;
};
};

WriteHerald: PROC [s: IO.STREAM, id: Rope.ROPE] = {
CompilerOps.AppendHerald[s];
IO.PutRope[s, " (Cedar 5 Version)\n"];
IF id # NIL THEN {IO.Put[s, IO.rope[id], IO.rope[" -- "]]};
IO.Put[s, IO.time[], IO.rope["\n"]]};

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[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 {
NewLogLine[];
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]};

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]];
NewLogLine[]};

NewLogLine: PROC = {log.PutRope["\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["Compiler", Compile, "Compile a list of cedar modules."];

}.