-- 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};

  }.