-- SMCompImpl.mesa
-- last edit by Schmidt, May 27, 1983 6:44 pm
-- last edit by Satterthwaite, August 15, 1983 11:01 am
-- code to run the compiler for the Cedar Modeller

DIRECTORY
Atom: TYPE USING [MakeAtom],
BcdStamps: TYPE USING [Compute],
CompilerOps: TYPE USING [
AppendHerald, CompilerVersion, DefaultSwitches, DoTransaction,
LetterSwitches, Start, Stop, StreamId, Transaction],
CS: TYPE USING [
Confirm, NewFile, NewStream, readWrite, RopeFromStamp, RootName, SetPFCodes, write],
Directory: TYPE USING [DeleteFile, Error, Handle, ignore, Lookup, UpdateDates],
File: TYPE USING [Capability, read],
FileParms: TYPE USING [
ActualId, BindingProc, Name, nullActual, nullSymbolSpace, SymbolSpace],
FileStream: TYPE USING [Create, GetLeaderPropertiesForCapability],
Heap: TYPE USING [systemZone],
IO: TYPE USING [
atom, card, CreateProcsStream, CreateRefStreamProcs, PutChar, PutF, PutFR, PutRope,
rope, STREAM, string, UserAbort, UserAborted],
Loader: TYPE USING [Instantiate, Start],
LongString: TYPE USING [SubString, SubStringDescriptor],
Rope: TYPE USING [--Cat,-- Equal, Fetch, Flatten, FromProc, Length, Lower, ROPE, Text],
Runtime: TYPE USING [IsBound],
SMComp: TYPE USING [],
SMFI: TYPE USING [BcdFileInfo, SrcFileInfo],
SMOps: TYPE USING [MS],
SMProj: TYPE USING [Proj, Analyzed, Available, Erase, Fill, Find, Rename, Update],
SMTree: TYPE Tree USING [ApplOp, Handle, Link, Name],
SMTreeOps: TYPE USING [
GetExt, GetName, NthSon, NSons, OpName, PutExt, Scan, ScanSons],
SMVal: TYPE USING [
Binding, BtoG, LoadMod, GetExtFromParse, OuterBody, ValOf, ValOfNthSon, VisitNodes],
Stream: TYPE USING [Delete, Handle, PutChar],
Time: TYPE USING [Current],
TimeStamp: TYPE USING [Stamp],
--UnsafeStorage: TYPE USING [GetSystemUZone],
ViewerClasses: TYPE USING [Viewer],
ViewerOps: TYPE USING [CreateViewer, FindViewer, OpenIcon, RestoreViewer],
WindowManager: TYPE USING [UnWaitCursor, WaitCursor];
 
-- this monitor locks the compiler

SMCompImpl: CEDAR MONITOR
IMPORTS
Atom, BcdStamps, CompilerOps, CS, Directory, FileStream, Heap, IO, Loader,
Rope, Runtime, SMProj, SMTreeOps, SMVal, Stream, Time, --UnsafeStorage,--
ViewerOps, WindowManager
EXPORTS SMComp ~ {
OPEN Tree~~SMTree, TreeOps~~SMTreeOps;

-- MDS usage
-- all these variables are protected by the monitor
compilerIsLocked: BOOL ← FALSE;
compilerWait: CONDITION;
logSH: IO.STREAM ← NIL;  -- out stream to Compiler.Log
logPilotSH: Stream.Handle ← NIL;
nSuccessful, nWarnings, nErrors: CARDINAL;
nUnmatched: CARDINAL;  -- compiled but not replaceable
compilerStarted: BOOL ← FALSE;
timeCompilerStarted: LONG CARDINAL;
-- endof MDS

CompileAll: PUBLIC PROC[ms: SMOps.MS, t: Tree.Link, confirm: REF BOOL, replace: BOOL]
RETURNS[complete: BOOL] ~ {
AcquireCompiler[];
{
ENABLE UNWIND => {ReleaseCompiler[]};
time: LONG CARDINAL;
formals, body: Tree.Link;
[formals, body] ← SMVal.OuterBody[t];
TRUSTED {time ← Time.Current[]};
nSuccessful ← nWarnings ← nErrors ← nUnmatched ← 0;
complete ← TraverseTreeForCompile[ms, body, confirm, replace
 ! UNWIND => {[] ← StopBatchCompile[ms]}];
StopBatchCompile[ms];
TRUSTED {time ← Time.Current[] - time};
IF nSuccessful = 0 AND nErrors = 0 AND nWarnings = 0 THEN
ms.out.PutRope["Nothing was compiled.\n\n"]
ELSE {
ms.out.PutF["%d successful", IO.card[nSuccessful]];
IF nErrors > 0 THEN ms.out.PutF["; %d w/errors", IO.card[nErrors]];
IF nWarnings > 0 THEN
ms.out.PutF["; %d w/warnings", IO.card[nWarnings]];
ms.out.PutF["\nTotal time to compile: %r\n\n", IO.card[time]]};
complete ← complete AND (nErrors = 0) AND (nUnmatched = 0);
};
ReleaseCompiler[];
RETURN};

AcquireCompiler: ENTRY PROC ~ {
ENABLE UNWIND => {NULL};
WHILE compilerIsLocked DO WAIT compilerWait ENDLOOP;
compilerIsLocked ← TRUE};
 
ReleaseCompiler: ENTRY PROC ~ {
ENABLE UNWIND => {NULL};
compilerIsLocked ← FALSE;
NOTIFY compilerWait};
 
TraverseTreeForCompile: PROC[
 ms: SMOps.MS, root: Tree.Link, confirm: REF BOOL, replace: BOOL]
RETURNS[complete: BOOL ← TRUE] ~ {

ForEachApply: PROC[node, parent: Tree.Link] ~ {
SELECT TreeOps.OpName[node] FROM
IN Tree.ApplOp =>
  WITH SMVal.ValOfNthSon[node, 1] SELECT FROM
  source: SMFI.SrcFileInfo =>
  WITH TreeOps.GetExt[node] SELECT FROM
  proj: SMProj.Proj => -- already processed
   IF ~proj.Available THEN complete ← FALSE;
  ENDCASE => {
   oldLoadMod: SMVal.LoadMod ~ NARROW[SMVal.GetExtFromParse[parent]];
   args: Tree.Link ~ SMVal.ValOfNthSon[node, 2];
   proj: SMProj.Proj ~
   PossibleCompile[ms, source, args, confirm, replace, oldLoadMod];
   TreeOps.PutExt[node, proj];
   IF ~proj.Available THEN complete ← FALSE}; -- errors or declined
  ENDCASE; -- ignore this appl on this pass
ENDCASE;
};

SMVal.VisitNodes[ms.tm, root, ForEachApply]};
 

FormalActual: TYPE ~ RECORD[
SEQUENCE length: NAT OF RECORD[
name: Tree.Name,
object: SMProj.Proj]
];
 
PossibleCompile: PROC[
 ms: SMOps.MS,
 source: SMFI.SrcFileInfo, args: Tree.Link,
 confirm: REF BOOL, replace: BOOL, oldLoadMod: SMVal.LoadMod]
RETURNS[proj: SMProj.Proj] ~ TRUSTED {
directoryMap: REF FormalActual;
bcdStamp: TimeStamp.Stamp;
switches: CompilerOps.LetterSwitches;
argsAvailable: BOOL ← TRUE;
tryToReplace: BOOL;
[bcdStamp, directoryMap, switches] ← BcdStampFromAppl[ms, source, args];
-- first scan existing projection database
proj ← SMProj.Find[bcdStamp];
IF proj.Available THEN RETURN; -- already found and analyzed
-- see if on disk
proj.Fill[source.localName, source.new];
-- proj.Fill[
-- CS.RootName[source.localName].Cat["$"].Cat[CS.RopeFromStamp[bcdStamp]].Flatten[],
-- source.new];
IF proj.Available THEN RETURN; -- correct version on local file system
FOR i: NAT IN [0..directoryMap.length) WHILE argsAvailable DO
IF ~(directoryMap[i].object).Available THEN argsAvailable ← FALSE;
ENDLOOP;
tryToReplace ← replace AND argsAvailable AND Replaceable[oldLoadMod];
IF ~argsAvailable THEN
ms.out.PutF[
"Cannot compile %s because compilation of an argument failed\n",
IO.rope[source.localName]]
ELSE IF AskTheUser[ms, source.localName, switches, confirm^] THEN {
oldProj: SMProj.Proj ~ (IF tryToReplace THEN oldLoadMod.proj ELSE NIL);
errors, replaceable: BOOL;
[errors, replaceable] ← AttemptCompile[ms, source, directoryMap, switches, proj, oldProj];
IF oldLoadMod # NIL THEN oldLoadMod.mustReplace ← replaceable}
ELSE NULL;
};


Replaceable: PROC[loadMod: SMVal.LoadMod] RETURNS[BOOL] ~ INLINE {
RETURN[loadMod # NIL AND loadMod.loadInfo # NIL AND loadMod.loadInfo.size = 1]};


BcdStampFromAppl: PROC[ms: SMOps.MS, source: SMFI.SrcFileInfo, args: Tree.Link]
RETURNS[
 bcdVersion: TimeStamp.Stamp, directoryMap: REF FormalActual,
 switches: CompilerOps.LetterSwitches] ~ {
inx: NAT ← 0;
 
DeclName: PROC[t: Tree.Link] RETURNS[Tree.Name] ~ INLINE {
RETURN [TreeOps.GetName[TreeOps.NthSon[t, 1]]]};

SetFormalName: TreeOps.Scan ~ {
SELECT TreeOps.OpName[t] FROM
 $declElem =>
  IF inx < directoryMap.length THEN {
  directoryMap[inx].name ← DeclName[t]; inx ← inx + 1};
 ENDCASE;
};

d: Tree.Link ~ TreeOps.NthSon[source.type, 1];
g: Tree.Link ~ (IF SMVal.Binding[args] THEN SMVal.BtoG[args] ELSE args);
TRUSTED {switches ← CompilerOps.DefaultSwitches[]; switches['s] ← FALSE};
directoryMap ← (ms.z).NEW[FormalActual[TreeOps.NSons[d]-1]]; -- exclude &options
TreeOps.ScanSons[d, SetFormalName];
IF TreeOps.OpName[g] = $group THEN {
i: NAT ← 0;

ActualByPosition: TreeOps.Scan ~ {
WITH SMVal.ValOf[t] SELECT FROM
  node: Tree.Handle => {
  directoryMap[i].object ← ExtractProjection[node];
  i ← i + 1};
  text: Rope.Text => switches ← InterpolateSwitches[text];
  ENDCASE => NULL;
 };

TreeOps.ScanSons[g, ActualByPosition]}
ELSE ERROR; -- TYPE CHECK
TRUSTED {

DirectoryEnumerator: PROC[forEach: PROC[TimeStamp.Stamp]] ~ CHECKED {
FOR i: NAT IN [0..directoryMap.length) DO
forEach[directoryMap[i].object.stamp]
ENDLOOP;
};

bcdVersion ← BcdStamps.Compute[
source.create, switches, CompilerOps.CompilerVersion[], DirectoryEnumerator]};
};

ExtractProjection: PROC[t: Tree.Link] RETURNS[proj: SMProj.Proj ← NIL] ~ {
SELECT TreeOps.OpName[t] FROM
IN Tree.ApplOp =>
 WITH SMVal.ValOfNthSon[t, 1] SELECT FROM
node: Tree.Handle =>
  IF TreeOps.OpName[node] IN Tree.ApplOp AND
  ISTYPE[SMVal.ValOfNthSon[node, 1], SMFI.SrcFileInfo] THEN
  proj ← NARROW[TreeOps.GetExt[node]];
fiBcd: SMFI.BcdFileInfo => { -- temporary (inefficient)
proj ← SMProj.Find[fiBcd.stamp];
IF ~proj.Analyzed THEN proj.Fill[fiBcd.localName, FALSE]};
ENDCASE;
$subscript => proj ← ExtractProjection[SMVal.ValOfNthSon[t, 1]];
ENDCASE;
RETURN};


AttemptCompile: PROC[
 ms: SMOps.MS,
 source: SMFI.SrcFileInfo, args: REF FormalActual,
 switches: CompilerOps.LetterSwitches,
 proj, oldProj: SMProj.Proj]
RETURNS[errors, replaceable: BOOL] ~ TRUSTED {
warnings: BOOL;
IF oldProj ~= NIL THEN { -- try for replacement
oldBcdFileName: Rope.Text ~ GenUniqueBcdName[oldProj.localName];
IF oldBcdFileName.Equal[proj.localName, FALSE] THEN {
 ms.out.PutF[
  "%s cannot be recompiled because old bcd can't be renamed.\n",
  IO.rope[source.localName]];
 errors ← TRUE; replaceable ← FALSE;
 GOTO skip};
oldProj.Rename[oldBcdFileName];
[errors, warnings, replaceable] ← CompileIt[ms, source, args, switches, proj, oldProj];
IF replaceable AND ~errors THEN {
 ms.out.PutF[" %s passes compiler's test for replaceability.\n", IO.rope[proj.localName]];
 ms.out.PutF["\told version renamed to %s.\n", IO.rope[oldBcdFileName]]}
ELSE {
 replaceable ← FALSE;
 IF errors THEN oldProj.Rename[proj.localName] -- new version was deleted
 ELSE {
  ms.out.PutF[
  " %s is not replaceable (compiler refuses), new version has been left on disk.\n",
  IO.rope[proj.localName]];
  ms.out.PutF["\told loaded version renamed to %s.\n", IO.rope[oldBcdFileName]]};
 };
EXITS
 skip => NULL;
}
ELSE [errors, warnings, ] ← CompileIt[ms, source, args, switches, proj, NIL];
};
 

CompileIt: UNSAFE PROC[
 ms: SMOps.MS,
 source: SMFI.SrcFileInfo, args: REF FormalActual,
 switches: CompilerOps.LetterSwitches,
 proj, oldProj: SMProj.Proj]
RETURNS[errors, warnings, replaceable: BOOL] ~ UNCHECKED {
t: CompilerOps.Transaction;
cap: File.Capability;
oneStartTime: LONG CARDINAL;
 
DirectoryBinding: PROC[
 formalId, formalType: FileParms.Name, defaultLocator: LONG STRING,
 binder: FileParms.BindingProc] ~ TRUSTED {
desiredName: Tree.Name ~ Atom.MakeAtom[SubStringToText[@formalId]];
FOR i: NAT IN [0 .. args.length) DO
 IF args[i].name = desiredName THEN {
  bcd: SMProj.Proj ~ args[i].object;
  binder[
  FileParms.ActualId[
   version~bcd.stamp,
   locator~[
   base~LOOPHOLE[bcd.localName],
   offset~0, length~bcd.localName.Length]
   ]];
  IF ms.debugFlag THEN
  ms.out.PutF["match %g with %g of %s\n", IO.atom[desiredName],
  IO.rope[bcd.localName], IO.rope[CS.RopeFromStamp[bcd.stamp]]];
  RETURN};
 ENDLOOP;
ms.out.PutF["\nError - '%s' not found in argument list.\n", IO.atom[desiredName]];
binder[FileParms.nullActual]};

-- called after DirectoryBinding, except for hidden directory entries
DirectoryAcquire: PROC[type: LongString.SubStringDescriptor, actual: FileParms.ActualId]
 RETURNS[ss: FileParms.SymbolSpace] ~ TRUSTED {
bcdFileName: Rope.Text;
bcd: SMProj.Proj;
FOR i: NAT IN [0 .. args.length) DO
 IF args[i].object.stamp = actual.version THEN
  RETURN[[file~args[i].object.capability, span~ args[i].object.symbolPages]];
 ENDLOOP;
-- not found
bcdFileName ← SubStringToText[@actual.locator];
bcd ← SMProj.Find[actual.version];
IF ~bcd.Available THEN bcd.Fill[bcdFileName, FALSE];
IF bcd.Available THEN {
 IF bcd.symbolPages = FileParms.nullSymbolSpace.span THEN
  ms.out.PutF["Can't get symbol space for type %s, file %s\n",
  IO.rope[SubStringToText[@type]], IO.rope[bcdFileName]];
 RETURN[[file~bcd.capability, span~bcd.symbolPages]]};
ms.out.PutF["%s of %s not found on parameter list.\n",
  IO.rope[bcdFileName], IO.rope[CS.RopeFromStamp[actual.version]]];
RETURN[FileParms.nullSymbolSpace]};
 
DirectoryRelease: PROC[ss: FileParms.SymbolSpace] ~ CHECKED {};

DirectoryForget: PROC[actual: FileParms.ActualId] ~ CHECKED {};

GetStream: PROC[id: CompilerOps.StreamId] RETURNS[sh: Stream.Handle] ~ TRUSTED {
SELECT id FROM
 $source => sh ← t.sourceStream; -- temporary
 $log => {CreateLogStream[]; sh ← logPilotSH};
 ENDCASE => ERROR;
RETURN};

CompilerPass: PROC[p: CARDINAL] RETURNS[goOn: BOOL] ~ CHECKED {
goOn ← ~(ms.in).UserAbort;
ms.msgOut.PutChar['.]};

DeleteBadBcd: UNSAFE PROC ~ {
proj.Erase[];
IF t.objectName ~= NIL THEN Directory.DeleteFile[t.objectName];
t.objectName ← NIL};
 
Cleanup: UNSAFE PROC ~ {
IF t.sourceStream ~= NIL THEN Stream.Delete[t.sourceStream];
t.sourceStream ← NIL};
 
{
ENABLE UNWIND => {DeleteBadBcd[]; Cleanup[]};

errors ← warnings ← TRUE; replaceable ← FALSE;
t.sourceStream ← NIL; t.objectName ← NIL;
-- make sure the compiler is loaded, etc.
IF ~(compilerStarted OR StartBatchCompile[ms]) THEN RETURN;
source.new ← FALSE;
-- set up Transaction record contents
cap ← Directory.UpdateDates[source.capability, File.read];
IF FileStream.GetLeaderPropertiesForCapability[cap].create # source.create THEN {
ms.out.PutF["Incorrect version of %g found on local disk\n", IO.rope[source.localName]];
errors ← TRUE;
RETURN};
t.op ← IF oldProj # NIL THEN $replace ELSE $compile;
t.source ← [
version~[net~0, host~0, time~source.create],
 locator~[
  base~LOOPHOLE[source.localName],
  offset~0, length~source.localName.Length]];
t.sourceStream ← FileStream.Create[cap];
t.fileParms ← [DirectoryBinding, DirectoryAcquire, DirectoryRelease, DirectoryForget];
t.switches ← switches;
IF t.op = $replace THEN
t.pattern ← [
version~oldProj.stamp,
locator~[base: LOOPHOLE[oldProj.localName], offset~0, length~oldProj.localName.Length]]
ELSE t.pattern ← FileParms.nullActual;
t.objectName ← LOOPHOLE[proj.localName];
t.objectFile ← CS.NewFile[proj.localName, CS.readWrite, 10];
t.debugPass ← CARDINAL.LAST;
t.getStream ← GetStream;
t.startPass ← CompilerPass;
PrintStartOne[ms, @t];
oneStartTime ← Time.Current[];
-- these are here to hide them from the user
t.switches['d] ← TRUE --ms.debugFlag--; -- debugging
t.switches['g] ← FALSE; -- log is always Compiler.Log
-- actually call the compiler
CompilerOps.DoTransaction[@t];
PrintStopOne[ms, @t, oneStartTime];
replaceable ← (t.op = $replace AND t.matched);
errors ← (t.nErrors # 0); IF errors THEN nErrors ← nErrors + 1;
warnings ← (t.nWarnings # 0); IF warnings THEN nWarnings ← nWarnings + 1;
IF ~errors AND ~warnings THEN nSuccessful ← nSuccessful + 1;
IF ~errors THEN {
IF proj.stamp # t.objectVersion THEN ERROR;
proj.Update[@t];
IF t.op = $replace AND ~t.matched THEN nUnmatched ← nUnmatched + 1}
ELSE DeleteBadBcd[];
Cleanup[]}};


-- local procedures

StartBatchCompile: PROC[ms: SMOps.MS] RETURNS[loadedOk: BOOL] ~ TRUSTED {
herald: STRING ← [100];
logSH ← NIL;
IF ~(loadedOk ← LoadCompiler[ms.msgOut]) THEN RETURN;
timeCompilerStarted ← Time.Current[];
Directory.DeleteFile["Compiler.Log"L ! Directory.Error => {CONTINUE}];
CreateLogStream[]; -- creates new log, sets logSH
CompilerOps.AppendHerald[herald];
logSH.PutF["%s\n%t\n", IO.string[herald], IO.card[timeCompilerStarted]];
CompilerOps.Start[Heap.systemZone--UnsafeStorage.GetSystemUZone[]--];
compilerStarted ← TRUE};

StopBatchCompile: PROC[ms: SMOps.MS]~ {
log: ViewerClasses.Viewer;
IF ~compilerStarted THEN RETURN; -- noop call; compiler not running
IF nSuccessful # 0 THEN logSH.PutF[" %d successful; ", IO.card[nSuccessful]];
IF nWarnings # 0 THEN logSH.PutF[" %d w/warnings; ", IO.card[nWarnings]];
IF nErrors # 0 THEN logSH.PutF[" %d w/errors; ", IO.card[nErrors]];
TRUSTED {timeCompilerStarted ← Time.Current[] - timeCompilerStarted};
logSH.PutF["\nTotal elapsed time %y.\n", IO.card[timeCompilerStarted]];
TRUSTED {Stream.Delete[logPilotSH]};
logSH ← NIL;
TRUSTED {CompilerOps.Stop[]};
compilerStarted ← FALSE;
log ← ViewerOps.FindViewer["Compiler.Log"];
IF log ~= NIL THEN ViewerOps.RestoreViewer[log];
IF nWarnings # 0 OR nErrors # 0 THEN {
IF log ~= NIL THEN ViewerOps.OpenIcon[log]
ELSE {ms.msgOut.PutChar['\n]; CreateANewViewer["Compiler.log", ms.msgOut]}};
ms.msgOut.PutRope["End of compilation\n"]};

CreateANewViewer: PROC[name: Rope.Text, out: IO.STREAM] ~ {
viewer: ViewerClasses.Viewer;
WindowManager.WaitCursor[];
viewer ← ViewerOps.CreateViewer[
   flavor~$Text,
   info~[name~name, file~name, iconic~FALSE, column~left]];
out.PutF["Created Viewer: %s\n", IO.rope[name]];
WindowManager.UnWaitCursor[]};

AskTheUser: PROC[
 ms: SMOps.MS, filename: Rope.Text, switches: CompilerOps.LetterSwitches, confirm: BOOL]
RETURNS[accepted: BOOL ← TRUE] ~ {

PutChar: PROC[c: CHAR] ~ {ms.out.PutChar[c]};

ms.out.PutF["Compile %s", IO.rope[filename]];
GenerateDifferentialSwitches[switches, PutChar];
IF confirm THEN -- ask the user if he really wants it compiled
SELECT CS.Confirm['y, ms.in, ms.out] FROM
 'q => {ms.out.PutRope["Quit.\n"]; ERROR IO.UserAborted[]};
 'y => ms.out.PutRope["Yes."]
 ENDCASE => {accepted ← FALSE; ms.out.PutRope["No."]};
IF accepted THEN ms.out.PutRope[" ... "];
ms.out.PutChar['\n]};

GenerateDifferentialSwitches: PROC[
sw: CompilerOps.LetterSwitches, proc: PROC[CHAR]] ~ TRUSTED {
standardSwitches: CompilerOps.LetterSwitches ~ CompilerOps.DefaultSwitches[];
first: BOOL ← TRUE;
FOR c: CHAR IN ['a .. 'z] DO
sd: BOOL ~ (c # 'p AND standardSwitches[c]);
IF sw[c] ~= sd THEN {
 IF first THEN {first ← FALSE; proc['/]};
 IF sd THEN proc['-];
 proc[c]};
ENDLOOP;
};

PrintStartOne: UNSAFE PROC[
ms: SMOps.MS, t: POINTER TO CompilerOps.Transaction] ~ UNCHECKED {

PutChar: SAFE PROC[c: CHAR] ~ TRUSTED {
ms.msgOut.PutChar[c]; logSH.PutChar[c]};

ms.msgOut.PutF["Compiling: %s", IO.string[t.source.locator.base]];
logSH.PutF["\nCommand: %s", IO.string[t.source.locator.base]];
GenerateDifferentialSwitches[t.switches, PutChar];
logSH.PutChar['\n]};

PrintStopOne: UNSAFE PROC[
ms: SMOps.MS,
t: POINTER TO CompilerOps.Transaction, oneStartTime: LONG CARDINAL] ~ UNCHECKED {
-- first MsgSW
IF t.nErrors > 0 THEN ms.msgOut.PutF["%d errors", IO.card[t.nErrors]]
ELSE ms.msgOut.PutRope["no errors"];
IF t.nWarnings > 0 THEN ms.msgOut.PutF[", %d warnings", IO.card[t.nWarnings]];
ms.msgOut.PutChar['\n];
-- now log
logSH.PutF["%s -- ", IO.string[t.source.locator.base]];
IF t.nErrors > 0 THEN {
logSH.PutF[" aborted, %d errors", IO.card[t.nErrors]];
IF t.nWarnings > 0 THEN logSH.PutF[" and %d warnings", IO.card[t.nWarnings]];
oneStartTime ← Time.Current[] - oneStartTime;
logSH.PutF[", time: %y.\n\n", IO.card[oneStartTime]]}
ELSE {
oneStartTime ← Time.Current[] - oneStartTime;
logSH.PutF["source tokens: %d, time: %y", IO.card[t.sourceTokens], IO.card[oneStartTime]];
IF t.objectBytes > 0 THEN
 logSH.PutF["\n code bytes: %d, links: %d, global frame words: %d",
  IO.card[t.objectBytes], IO.card[t.linkCount], IO.card[t.objectFrameSize]];
IF t.nWarnings > 0 THEN
 logSH.PutF["\n%d warnings", IO.card[t.nWarnings]];
logSH.PutChar['\n]};
};


CreateLogStream: PROC ~ {
IF logSH = NIL THEN {
TRUSTED {logPilotSH ← CS.NewStream["Compiler.Log", CS.write]};
logSH ← IO.CreateProcsStream[IO.CreateRefStreamProcs[putChar~LogStreamPutChar], NIL];
CS.SetPFCodes[logSH]};
};

LogStreamPutChar: PROC[self: IO.STREAM, char: CHAR] ~ TRUSTED {
logPilotSH.PutChar[char]};

SubStringToText: PROC[lp: LongString.SubString] RETURNS[Rope.Text] ~ TRUSTED {
i: CARDINAL ← 0;

EachChar: PROC RETURNS[c: CHAR] ~ TRUSTED {
c ← lp.base[lp.offset+i]; i ← i+1; RETURN};

RETURN [Rope.FromProc[lp.length, EachChar].Flatten[]]};

InterpolateSwitches: PROC[parms: Rope.Text] RETURNS[switches: CompilerOps.LetterSwitches] ~ {
on: BOOL ← TRUE;
-- set defaults
TRUSTED {switches ← CompilerOps.DefaultSwitches[]};
switches['s] ← FALSE;  -- the modeller defaults to /-s
IF parms # NIL THEN
FOR i: INT IN [0 .. parms.Length) DO
 c: CHAR ~ Rope.Lower[parms.Fetch[i]];
 SELECT c FROM
  '-, '~ => on ← ~on;
  IN ['a .. 'z] => {switches[c] ← on; on ← TRUE};
  ENDCASE;
 ENDLOOP;
};

GenUniqueBcdName: PROC[bcdFileName: Rope.Text]
RETURNS[newName: Rope.Text] ~ TRUSTED {
rootName: Rope.ROPE ~ CS.RootName[bcdFileName];
newName ← bcdFileName;
FOR inx: CARDINAL ← 1, inx+1 DO
newName ← IO.PutFR["%s.%d.bcd$", IO.rope[rootName], IO.card[inx]].Flatten[];
[] ← Directory.Lookup[fileName~LOOPHOLE[newName], permissions~Directory.ignore
   ! Directory.Error => {EXIT}];
ENDLOOP;
RETURN};


-- not monitored properly
LoadCompiler: PUBLIC PROC[out: IO.STREAM] RETURNS[success: BOOL←TRUE] ~ TRUSTED {
IF ~Runtime.IsBound[CompilerOps.Start] THEN { -- not already loaded
ENABLE ANY => {GOTO failed};
cap: File.Capability;
out.PutRope["Loading Compiler ... "];
cap ← Directory.Lookup["compiler.bcd"L];
Loader.Start[Loader.Instantiate[file~cap, offset~1, codeLinks~TRUE].cm];
out.PutRope["done.\n"];
EXITS
 failed => {out.PutRope["failed.\n"]; success ← FALSE};
};
RETURN};

}.