-- SMP4Impl.mesa
-- last edit by Schmidt, May 18, 1983 4:12 pm
-- last edit by Satterthwaite, May 26, 1983 5:40 pm
-- code to run the compiler for the Cedar Modeller

DIRECTORY
  Atom: TYPE USING [GetPName, MakeAtom],
  BcdStamps: TYPE USING [Compute],
  CompilerOps: TYPE USING [
    AppendHerald, CompilerVersion, DefaultSwitches, DoTransaction,
    LetterSwitches, Start, Stop, StreamId, Transaction],
  CS: TYPE USING [
    Confirm, EndsIn, EqualRope, EquivalentRope, MakeTS, NewFile, NewStream,
    SetPFCodes, Write],
  Directory: TYPE USING [DeleteFile, Error, Handle, ignore, Lookup, Rename, UpdateDates],
  File: TYPE USING [Capability, nullCapability, read],
  FileParms: TYPE USING [
    ActualId, BindingProc, Name, nullActual, nullSymbolSpace, SymbolSpace],
  FileStream: TYPE USING [Create],
  Heap: TYPE USING [systemZone],
  IO: TYPE USING [
    card, CreateProcsStream, CreateRefStreamProcs, Handle, PutChar, PutF, PutFR,
    rope, STREAM, string, UserAbort, UserAborted],
  List: TYPE USING [Reverse],
  Loader: TYPE USING [Instantiate, Start],
  LongString: TYPE USING [SubString, SubStringDescriptor],
  PrincOps: TYPE USING [ControlModule],
  Rope: TYPE USING [Cat, Fetch, Flatten, FromChar, IsEmpty, Length, Lower, ROPE, Text],
  RopeInline: TYPE USING [InlineFlatten],
  RTOS: TYPE USING [CheckForModuleReplacement],
  Runtime: TYPE USING [IsBound],
  SMEval: TYPE USING [CompMod, CompModRecord, LoadMod],
  SMFI: TYPE USING [BcdFileInfo, BcdModuleRecord, SrcFileInfo],
  SMFIOps: TYPE USING [
    AllocateBcdFileInfo, ConstructFIBcd, EraseCacheEntryForBcd, GetExtFromParse,
    LookupBcdFileInfo, NewVersionOfBcd, PutExtInParse],
  SMLoad: TYPE USING [ReplaceResult],
  SMOps: TYPE USING [MS, PL],
  SMP4: TYPE USING [],
  SMSrcBcd: TYPE USING [AddBcdInfo],
  SMTree: TYPE Tree USING [Handle, Link],
  SMTreeOps: TYPE USING [OpName, NthSon, NSons, Scan, ScanSons],
  Stream: TYPE USING [Delete, Handle, PutChar],
  Time: TYPE USING [Current],
  TimeStamp: TYPE USING [Null, Stamp],
  ViewerClasses: TYPE USING [Viewer],
  ViewerOps: TYPE USING [CreateViewer, FindViewer, OpenIcon, RestoreViewer],
  WindowManager: TYPE USING [UnWaitCursor, WaitCursor];
	
-- this monitor locks the compiler

SMP4Impl: CEDAR MONITOR 
    IMPORTS
      Atom, BcdStamps, CompilerOps, CS, Directory, FileStream, Heap, IO, List, Loader,
      Rope, RopeInline, RTOS, Runtime, SMFIOps, SMOps, SMSrcBcd, SMTreeOps,
      Stream, Time, ViewerOps, WindowManager
    EXPORTS SMP4 ~ {
  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;
  sourcesh: Stream.Handle;		-- in stream to source file
  msgsw: IO.STREAM;		-- out stream to print status messages
  inputsh: IO.STREAM _ NIL;		-- in stream from typescript
  good, warn, err: CARDINAL _ 0;
  compilerStarted: BOOL _ FALSE;
  timeCompilerStarted: LONG CARDINAL _ 0;
 -- endof MDS

  OuterCompEval: PUBLIC PROC[
	ms: SMOps.MS, t: Tree.Link, confirm: REF BOOL, replacement: BOOL] 
      RETURNS[errors: BOOL] ~ {
    ENABLE UNWIND => ReleaseCompilerLock[];
    time: LONG CARDINAL;
    numberSuccessful, numberOfWarnings, numberOfErrors: CARDINAL;
    errors _ FALSE;
    AcquireCompilerLock[];
    inputsh _ ms.in;
    msgsw _ ms.msgOut;
    TRUSTED {time _ Time.Current[]};
    TraverseTreeForCompile[ms, NARROW[t], confirm, replacement
	! UNWIND => {[] _ StopBatchCompile[]}];
    [numberSuccessful, numberOfWarnings, numberOfErrors] _ StopBatchCompile[];
    TRUSTED {time _ Time.Current[] - time};
    IF numberSuccessful = 0 AND numberOfErrors = 0 AND numberOfWarnings = 0 THEN
      ms.PL["Nothing was compiled.\n"L]
    ELSE {
      ms.out.PutF["%d successful; ", IO.card[numberSuccessful]];
      IF numberOfErrors > 0 THEN ms.out.PutF["%d w/errors; ", IO.card[numberOfErrors]];
      IF numberOfWarnings > 0 THEN
        ms.out.PutF["%d w/warnings; ", IO.card[numberOfWarnings]];
      ms.PL["\n"L]};
    ms.PL["\n"L];
    ms.out.PutF["Elapsed time for compile: %r\n", IO.card[time]];
    ms.out.PutF["--------------------------------\n"];
    ReleaseCompilerLock[];
    errors _ numberOfErrors > 0};

  AcquireCompilerLock: ENTRY PROC ~ {
    ENABLE UNWIND => {NULL};
    WHILE compilerIsLocked DO WAIT compilerWait ENDLOOP;
    compilerIsLocked _ TRUE};
	
  ReleaseCompilerLock: ENTRY PROC ~ {
    ENABLE UNWIND => {NULL};
    compilerIsLocked _ FALSE;
    NOTIFY compilerWait};
	
  TraverseTreeForCompile: PROC[
      ms: SMOps.MS, top: Tree.Handle, confirm: REF BOOL, replacement: BOOL] ~ {

      Consider: PROC[anode: Tree.Handle, oldLoadMod: SMEval.LoadMod] ~ {
	groupOrBind: Tree.Handle;
	firstSon: Tree.Link;
	TreeOps.ScanSons[anode, AnalSons];
	groupOrBind _ NARROW[TreeOps.NthSon[anode, 2]];
	IF TreeOps.OpName[groupOrBind] ~= $bind 
	 AND TreeOps.OpName[groupOrBind] ~= $group THEN
	  RETURN;
	firstSon _ TreeOps.NthSon[anode, 1];
	WITH firstSon SELECT FROM
	  fiSrc: SMFI.SrcFileInfo => {
	    compMod: SMEval.CompMod ~ PossibleRecomp[
	      ms, fiSrc, groupOrBind, confirm, replacement, oldLoadMod];
	    SMFIOps.PutExtInParse[anode, compMod]};
	  ENDCASE => NULL;	-- do nothing
	};
		
      -- ms is passed in
      AnalSons: TreeOps.Scan ~ {
	WITH t SELECT FROM
	  applyNode: Tree.Handle => {
	    SELECT applyNode.name FROM
	      $apply => {
		ext: Tree.Link _ SMFIOps.GetExtFromParse[applyNode];
		IF ext ~= NIL AND ISTYPE[ext, SMEval.LoadMod] THEN {
		  -- manages to skip outer loading apply node
		  AnalSons[TreeOps.NthSon[applyNode, 2]];
		  Consider[NARROW[TreeOps.NthSon[applyNode, 1]], NARROW[ext]]}
		ELSE {
		  IF ext ~= NIL THEN RETURN;	-- already analyzed
		  Consider[applyNode, NIL]};
		};
	      ENDCASE => TreeOps.ScanSons[applyNode, AnalSons]};
	  ENDCASE => NULL;
	};

      TreeOps.ScanSons[top, AnalSons]};
	
  PossibleRecomp: PROC[
  	ms: SMOps.MS, fiSrc: SMFI.SrcFileInfo, 
	groupOrBind: Tree.Handle, confirm: REF BOOL, replacement: BOOL,
	oldLoadMod: SMEval.LoadMod] 
      RETURNS[compMod: SMEval.CompMod] ~ TRUSTED {
    fiBcd: SMFI.BcdFileInfo;
    errors, declined: BOOL;
    directoryList: LIST OF REF FormalActual;
    bcdVers: TimeStamp.Stamp;
    switches: CompilerOps.LetterSwitches;
    expSortSwitch: BOOL;
    compMod _ NEW[SMEval.CompModRecord _ [fiSrc: fiSrc]];
    [bcdVers, directoryList, switches, expSortSwitch] _
      ConstructBcdStampFromBinding[ms, fiSrc, groupOrBind];
    compMod.fiBcd _ SMFIOps.LookupBcdFileInfo[fiSrc.srcFileName, bcdVers];
    -- first scan existing projection database
    ms.out.PutF["Considering compilation of %s ..\n", IO.rope[compMod.fiSrc.srcFileName]];
    IF compMod.fiBcd ~= NIL THEN RETURN;	-- already exists
    -- see if on disk
    fiBcd _ SMFIOps.ConstructFIBcd[compMod.fiSrc.shortname, bcdVers];
    IF fiBcd.bcdPresent AND bcdVers = fiBcd.bcdVers THEN {
      compMod.fiBcd _ fiBcd; RETURN};
    IF ~fiBcd.bcdPresent THEN
      ms.out.PutF["Must compile %g since there is no .Bcd on the disk.\n",
	IO.rope[compMod.fiSrc.srcFileName]]
    ELSE 
      ms.out.PutF["Must compile because bcd on disk is stamped %a, and the newer version will be stamped %a.\n",
	CS.MakeTS[fiBcd.bcdVers], CS.MakeTS[bcdVers]];
    -- bcd is not ok or doesn't exist, must recompile
    [errors, declined] _ ArrangeForCompile[
      ms, compMod.fiSrc, groupOrBind, replacement,
      fiBcd, switches, directoryList, confirm, expSortSwitch, oldLoadMod];
    IF ~declined THEN {
      IF errors THEN {
	-- there were errors, remove any capabilities for it
	SMFIOps.EraseCacheEntryForBcd[fi: fiBcd];
	compMod _ NIL}
      ELSE {
	-- record new version and update cache
	[] _ SMFIOps.NewVersionOfBcd[fi: fiBcd];
	compMod.fiBcd _ fiBcd};
      }
    ELSE compMod _ NIL};

  ArrangeForCompile: PROC[
	ms: SMOps.MS, fiOuter: SMFI.SrcFileInfo, groupOrBind: Tree.Handle,
	tryreplacement: BOOL, fiBcd: SMFI.BcdFileInfo, switches: CompilerOps.LetterSwitches, 
	directoryList: LIST OF REF FormalActual, confirm: REF BOOL, expSortSwitch: BOOL,
	oldLoadMod: SMEval.LoadMod] 
      RETURNS[errors, declined: BOOL] ~ TRUSTED {
    warnings, replaceable: BOOL;
    errors _ declined _ warnings _ replaceable _ FALSE;
    IF oldLoadMod ~= NIL 
     AND oldLoadMod.loadInfoSeq ~= NIL
     AND oldLoadMod.loadInfoSeq.size = 1 THEN {
      -- try for replacement
      oldBcdFileName: Rope.Text ~ GenUniqueBcdName[fiBcd.bcdFileName];
      replaceResult: SMLoad.ReplaceResult _ (SELECT TRUE FROM
	CS.EquivalentRope[oldBcdFileName, fiBcd.bcdFileName] => $cantCopyOldBcd,
	~RTOS.CheckForModuleReplacement[oldLoadMod.loadInfoSeq[0].frame] =>
	  $checkForMRFailed,
	ENDCASE => $ok);
      IF replaceResult ~= $ok THEN {
	ms.out.PutF["%s cannot be replaced because %s.\n", 
	    IO.rope[fiBcd.bcdFileName],
	    IO.rope[SELECT replaceResult FROM
		$cantCopyOldBcd => "can't copy old bcd",
		$checkForMRFailed => "RT check for module replacement failed",
		ENDCASE => ERROR]];
	declined _ TRUE;
	GOTO skip};
      Directory.Rename[
        newName~LOOPHOLE[oldBcdFileName], oldName~LOOPHOLE[fiBcd.bcdFileName]];
      fiBcd.bcdCap _ File.nullCapability;
      ms.out.PutF["Old version of %s renamed to %s.\n",
        IO.rope[fiBcd.bcdFileName], IO.rope[oldBcdFileName]];
      [errors, warnings, replaceable, declined] _ CompileIt[
        ms, fiOuter, groupOrBind, oldBcdFileName, TRUE,
        fiBcd, switches, directoryList, confirm, expSortSwitch];
      IF ~replaceable THEN replaceResult _ $compilerSaysNo;
      IF replaceable AND ~errors AND ~declined THEN {
	ms.out.PutF["%s passes compiler's test for replaceability.\n", IO.rope[fiBcd.bcdFileName]];
	oldLoadMod.loadInfoSeq.mustreplace _ TRUE}
      ELSE {
	oldLoadMod.loadInfoSeq.mustreplace _ FALSE;
	IF declined OR errors THEN {
	  -- new version has to be deleted
	  Directory.Rename[
	    newName: LOOPHOLE[fiBcd.bcdFileName], oldName: LOOPHOLE[oldBcdFileName]];
	  ms.out.PutF["Old, loaded version of %s has been left on disk.\n", 
	    IO.rope[fiBcd.bcdFileName]]}
	ELSE ms.out.PutF[
	  "%s is not replaceable%s, new version has been left on disk, \n\told loaded version is called %s.\n", 
	  IO.rope[fiBcd.bcdFileName], 
	  IO.rope[IF replaceResult = $compilerSaysNo THEN " (Compiler refuses)" ELSE ""],
	  IO.rope[oldBcdFileName]]};
      EXITS
	skip => NULL;
      }
    ELSE {
      [errors, warnings, , declined] _ CompileIt[
        ms, fiOuter, groupOrBind, NIL, FALSE,
        fiBcd, switches, directoryList, confirm, expSortSwitch]};
    };
	
  FormalActual: TYPE ~ RECORD[
    id: ATOM,
    actual: FileParms.ActualId,
    compMod: SMEval.CompMod];
	
  ConstructBcdStampFromBinding: PROC[
	ms: SMOps.MS, fiSrc: SMFI.SrcFileInfo, groupOrBind: Tree.Handle] 
      RETURNS[
	bcdVers: TimeStamp.Stamp, directoryList: LIST OF REF FormalActual,
	switches: CompilerOps.LetterSwitches, expSortSwitch: BOOL] ~ {
    inx: CARDINAL _ 1;
	
    ForEachFormal: TreeOps.Scan ~ {
      WITH t SELECT FROM
	declElem: Tree.Handle => {
	  SELECT declElem.name FROM
	    $declElem => {	-- id, compMod are passed in

	      ForEachActual: TreeOps.Scan ~ {
		WITH t SELECT FROM
		    bindElem: Tree.Handle => {
		      SELECT bindElem.name FROM
			$bindElem =>
			  IF TreeOps.NthSon[bindElem, 1] = id THEN {
			    innerApply: Tree.Link _ TreeOps.NthSon[bindElem, 2];
			    IF ISTYPE[innerApply, Rope.Text] THEN {
			      [switches, expSortSwitch] _ InterpolateSwitches[NARROW[innerApply]];
			      RETURN};
			    compMod _ NARROW[SMFIOps.GetExtFromParse[innerApply]];
			    IF compMod = NIL THEN {
			      -- consider this is the loading apply, try the compiling apply
			      first: Tree.Link _ TreeOps.NthSon[innerApply, 1];
			      IF ISTYPE[first, Tree.Handle]
			       AND TreeOps.OpName[first] = $apply THEN
				compMod _ NARROW[SMFIOps.GetExtFromParse[first]]; -- innerApply
			      };
			    };
			ENDCASE => NULL};
		    ENDCASE => NULL;
		};
		
	      id: ATOM;
	      compMod: SMEval.CompMod;
	      IF TreeOps.OpName[TreeOps.NthSon[declElem, 2]] ~= $type THEN RETURN;
	      id _ NARROW[TreeOps.NthSon[declElem, 1]];
	      compMod _ NIL;
	      IF TreeOps.OpName[groupOrBind] = $group THEN {
		innerApply: Tree.Link;
		DO
		  IF inx > TreeOps.NSons[groupOrBind] THEN EXIT;
		  innerApply _ TreeOps.NthSon[groupOrBind, inx];
		  WITH innerApply SELECT FROM
		    innerApplyNode: Tree.Handle => {
		      IF TreeOps.OpName[innerApplyNode] = $apply THEN {
			compMod _ NARROW[SMFIOps.GetExtFromParse[innerApply]];
			IF compMod = NIL THEN {
			  -- consider this is the loading apply, try the compiling apply
			  first: Tree.Link _ TreeOps.NthSon[innerApply, 1];
			  IF TreeOps.OpName[first] = $apply THEN
			    compMod _ NARROW[SMFIOps.GetExtFromParse[first]];
			  };
			EXIT};
		      -- else goes to next item
		      };
		    str: Rope.Text => [switches, expSortSwitch] _ InterpolateSwitches[str];
		    ENDCASE => NULL;
		  inx _ inx + 1;
		  ENDLOOP;
		inx _ inx + 1;	-- bump for next iteration
		IF compMod = NIL THEN { 
		  ms.out.PutF["No compMod for formal '%s'.\n", IO.rope[Atom.GetPName[id]]];
		  RETURN}
		}
	      ELSE TreeOps.ScanSons[groupOrBind, ForEachActual];
	      IF compMod = NIL THEN 
		ms.out.PutF["can't find %s in actual tree.\n", IO.rope[Atom.GetPName[id]]]
	      ELSE {
		actual: FileParms.ActualId;
		fiInner: SMFI.BcdFileInfo ~ compMod.fiBcd;
		actual _ [
		  version~fiInner.bcdVers, 
		  locator~[
		    base~LOOPHOLE[fiInner.bcdFileName],
		    offset~0, length~fiInner.bcdFileName.Length]];
		directoryList _ CONS[NEW[FormalActual _ [id, actual, compMod]], directoryList]};
	      };
	    ENDCASE => NULL};
	ENDCASE => NULL;
      };
		
    domain: Tree.Handle ~ NARROW[TreeOps.NthSon[fiSrc.type, 1]];
    stampList: LIST OF REF TimeStamp.Stamp;
    TRUSTED {switches _ CompilerOps.DefaultSwitches[]};
    expSortSwitch _ FALSE;
    TreeOps.ScanSons[domain, ForEachFormal];
    FOR l: LIST OF REF FormalActual _ directoryList, l.rest UNTIL l = NIL DO
      stampList _ CONS[NEW[TimeStamp.Stamp _ l.first.actual.version], stampList];
      ENDLOOP;
    -- stampList is now reversed in the correct order!!!
    TRUSTED {directoryList _ LOOPHOLE[List.Reverse[LOOPHOLE[directoryList]]]};
    switches['s] _ expSortSwitch;	-- prefer not sorted
    TRUSTED {bcdVers _ BcdStamps.Compute[
      fiSrc.srcCreate, switches, CompilerOps.CompilerVersion[], stampList]};
    ms.out.PutF[
      "For %s, the version stamp is %a\n", IO.rope[fiSrc.shortname], CS.MakeTS[bcdVers]];
    };

	
  CompileIt: UNSAFE PROC[
	ms: SMOps.MS, fiOuter: SMFI.SrcFileInfo, groupOrBind: Tree.Handle,
	oldBcdFileName: Rope.Text, tryreplacement: BOOL, fiBcd: SMFI.BcdFileInfo,
	switches: CompilerOps.LetterSwitches, 
	directoryList: LIST OF REF FormalActual, confirm: REF BOOL, expSortSwitch: BOOL] 
      RETURNS[errors, warnings, replaceable, declined: BOOL] ~ UNCHECKED {
    t: CompilerOps.Transaction;
    cap: File.Capability;
    onestarttime: LONG CARDINAL;
    loadedOk: BOOL;
	
    DirectoryBinding: PROC[
    	formalId, formalType: FileParms.Name, defaultLocator: LONG STRING,
	binder: FileParms.BindingProc] ~ TRUSTED {
      desiredName: Rope.Text ~ SubStringToRope[@formalId];
      desiredId: ATOM ~ Atom.MakeAtom[desiredName];
      FOR l: LIST OF REF FormalActual _ directoryList, l.rest UNTIL l = NIL DO
	IF l.first.id = desiredId THEN {
	  fiInner: SMFI.BcdFileInfo ~ l.first.compMod.fiBcd;
	  binder[l.first.actual];
	  ms.out.PutF["match %g with %g of %a\n", IO.rope[desiredName],
		IO.rope[fiInner.bcdFileName], CS.MakeTS[fiInner.bcdVers]];
	  RETURN};
	ENDLOOP;
      ms.out.PutF["\nError - '%s' not found on any parameter list.\n", IO.rope[desiredName]]};

   -- called after DirectoryBinding, except for hidden directory entries
    DirectoryAcquire: PROC[
	  type: LongString.SubStringDescriptor, actual: FileParms.ActualId]
	RETURNS[ss: FileParms.SymbolSpace] ~ TRUSTED {
      bcdFileName: Rope.Text;
      fiInner: SMFI.BcdFileInfo;
      FOR l: LIST OF REF FormalActual _ directoryList, l.rest UNTIL l = NIL DO
	IF l.first.actual.version = actual.version THEN
	  RETURN[FindSymbolSpace[ms, l.first.compMod.fiBcd, type]];
	ENDLOOP;
      -- not found
      bcdFileName _ SubStringToRope[@actual.locator];
      IF CS.EndsIn[bcdFileName, "."L] THEN
	bcdFileName _ bcdFileName.Flatten[len~bcdFileName.Length-1];
      fiInner _ SMFIOps.LookupBcdFileInfo[bcdFileName, actual.version];
      IF fiInner ~= NIL THEN {
	ss _ FindSymbolSpace[ms, fiInner, type];
	IF ss = FileParms.nullSymbolSpace THEN
	  ms.out.PutF["Can't get symbol space for type %s, file %s\n",
		IO.rope[SubStringToRope[@type]], IO.rope[bcdFileName]];
	RETURN[FindSymbolSpace[ms, fiInner, type]]};
      ms.out.PutF["%s of %v not found on parameter list.\n", 
		IO.rope[bcdFileName], CS.MakeTS[actual.version]];
      RETURN[FileParms.nullSymbolSpace]};
	
    DeleteBadBcd: UNSAFE PROC ~ {
      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; sourcesh _ NIL};
	
    {
    ENABLE UNWIND => {DeleteBadBcd[]; Cleanup[]};

    errors _ warnings _ declined _ TRUE;  replaceable _ FALSE;
    t.sourceStream _ NIL;  t.objectName _ NIL;
    t.switches _ switches;
    IF AskTheUser[ms, fiOuter.srcFileName, ~confirm^, t.switches] THEN RETURN;
    declined _ FALSE;
    -- make sure the compiler is loaded, etc.
    IF ~compilerStarted THEN {
      loadedOk _ StartBatchCompile[ms];
      IF ~loadedOk THEN RETURN};
    -- set up Transaction record contents
    t.op _ IF tryreplacement THEN $replace ELSE $compile;
    t.source _ [
        version~[net~0, host~0, time~fiOuter.srcCreate],
	locator~[
	    base~LOOPHOLE[fiOuter.srcFileName],
	    offset~0, length~fiOuter.srcFileName.Length]];
    cap _ Directory.UpdateDates[fiOuter.srcCap, File.read];
    sourcesh _ t.sourceStream _ FileStream.Create[cap];
    t.fileParms _ [DirectoryBinding, DirectoryAcquire, DirectoryRelease, DirectoryForget];
    IF tryreplacement THEN {
      fiBcdForOld: SMFI.BcdFileInfo;
      IF fiBcd.bcdVers = TimeStamp.Null THEN ERROR;
      t.pattern _ [
          version~fiBcd.bcdVers, 
          locator~[base: LOOPHOLE[oldBcdFileName], offset~0, length~oldBcdFileName.Length]];
      fiBcdForOld _ SMFIOps.AllocateBcdFileInfo[];
      fiBcdForOld.bcdFileName _ oldBcdFileName;
      SMFIOps.NewVersionOfBcd[fiBcdForOld]}
    ELSE t.pattern _ FileParms.nullActual;
    t.objectName _ LOOPHOLE[fiBcd.bcdFileName];
    t.objectFile _ CS.NewFile[fiBcd.bcdFileName, CS.Write, 10];
    t.debugPass _ CARDINAL.LAST;
    t.getStream _ LogGetStream;
    t.startPass _ CompilerPass;
    PrintStartOne[@t];
    onestarttime _ Time.Current[];
   -- these are here to hide them from the user
    t.switches['d] _ TRUE;	-- debugging
    t.switches['g] _ FALSE;	-- log is always Compiler.Log
    t.switches['s] _ expSortSwitch;
   -- actually call the Compiler!
    CompilerOps.DoTransaction[@t];
    PrintStopOne[ms, @t, onestarttime];
    replaceable _ tryreplacement AND t.matched;
    errors _ (t.nErrors # 0);  warnings _ (t.nWarnings # 0);
    IF errors THEN err _ err + 1;
    IF warnings THEN warn _ warn + 1;
    IF ~errors AND NOT warnings THEN good _ good + 1;
    IF ~errors THEN fiBcd.bcdVers _ t.objectVersion ELSE DeleteBadBcd[];
    Cleanup[]}};

  FindSymbolSpace: PROC[
	ms: SMOps.MS, fiBcd: SMFI.BcdFileInfo, type: LongString.SubStringDescriptor]
      RETURNS[ss: FileParms.SymbolSpace] ~ TRUSTED {
    name: Rope.Text ~ SubStringToRope[@type];
    -- warning: this is a workaround, SHOULD NOT be calling SMSrcBcd.AddBcdInfo
    -- as it is only supposed to be called from SMFIImpl
    IF fiBcd.bcdInfo = NIL THEN SMSrcBcd.AddBcdInfo[ms, fiBcd];
    -- for replacement when old Bcd is needed
    IF name.IsEmpty THEN RETURN[fiBcd.bcdInfo.modules.first.symbolSpace];
    FOR mod: LIST OF SMFI.BcdModuleRecord _ fiBcd.bcdInfo.modules, mod.rest UNTIL mod = NIL DO
      IF CS.EqualRope[name, mod.first.moduleName] THEN
	RETURN[mod.first.symbolSpace];
      ENDLOOP;
    RETURN[FileParms.nullSymbolSpace]};
	

 -- local procedures

  StartBatchCompile: PROC[ms: SMOps.MS] RETURNS[loadedOk: BOOL] ~ TRUSTED {
    herald: STRING _ [100];
    good _ warn _ err _ 0;
    logsh _ NIL;
    loadedOk _ LoadCompiler[ms];
    timeCompilerStarted _ Time.Current[];
    IF ~loadedOk THEN RETURN;
    Directory.DeleteFile["Compiler.Log"L ! Directory.Error => {CONTINUE}];
    [] _ LogGetStream[log];	-- creates new log
    CompilerOps.AppendHerald[herald];
    ms.out.PutF["%s\n%t\n", IO.string[herald], IO.card[timeCompilerStarted]];
    logsh.PutF["%s\n%t\n", IO.string[herald], IO.card[timeCompilerStarted]];
    CompilerOps.Start[Heap.systemZone];
    compilerStarted _ TRUE};

  StopBatchCompile: PROC RETURNS[nOk, nWarn, nErr: CARDINAL] ~ {
    log: ViewerClasses.Viewer;
    IF ~compilerStarted THEN RETURN[0, 0, 0];	-- noop call; compiler not running
    IF good # 0 THEN logsh.PutF[" %d successful; ", IO.card[good]];
    IF warn # 0 THEN logsh.PutF[" %d w/warnings; ", IO.card[warn]];
    IF err # 0 THEN logsh.PutF[" %d w/errors; ", IO.card[err]];
    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 warn > 0 OR err > 0 THEN {
      IF log ~= NIL THEN ViewerOps.OpenIcon[log]
      ELSE {msgsw.PutChar['\n]; CreateANewViewer["Compiler.log", msgsw]}};
    msgsw.PutF["End of compilation\n"];
    msgsw _ NIL;
    RETURN[good, warn, err]};

  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,
	dontconfirm: BOOL, wantsw: CompilerOps.LetterSwitches]
      RETURNS[declined: BOOL] ~ {
    ch: CHAR;
    dif: Rope.ROPE;
    declined _ TRUE;
    -- ask the user if he really wants it compiled
    ms.out.PutF["Compile %s", IO.rope[filename]];
    dif _ ProduceDifferentialSwitches[wantsw];
    IF ~dif.IsEmpty THEN ms.out.PutF["/%s", IO.rope[dif]];
    ms.out.PutF[" ... "];
    ch _ IF dontconfirm THEN 'y ELSE 'n;
    IF ch = 'n THEN ch _ CS.Confirm['y, ms.in, ms.out] ;
    IF ch = 'q THEN {ms.PL["Quit.\n"L]; ERROR IO.UserAborted[]};
    IF ch = 'y THEN {declined _ FALSE; ms.PL["Yes.\n"L]}
    ELSE ms.PL["No.\n"L]};

  ProduceDifferentialSwitches: PROC[sw: CompilerOps.LetterSwitches]
      RETURNS[dif: Rope.ROPE] ~ TRUSTED {
    standardSwitches: CompilerOps.LetterSwitches ~ CompilerOps.DefaultSwitches[];
    FOR c: CHAR IN ['a .. 'z] DO
      sd: BOOL ~ (IF c = 'p THEN FALSE ELSE standardSwitches[c]);
      IF sw[c] ~= sd THEN {
	IF sd THEN dif _ dif.Cat[Rope.FromChar['-]];
	dif _ dif.Cat[Rope.FromChar[c]]};
      ENDLOOP;
    };

  DirectoryRelease: UNSAFE PROC[ss: FileParms.SymbolSpace] ~ {};

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

  PrintStartOne: UNSAFE PROC[t: POINTER TO CompilerOps.Transaction] ~ UNCHECKED {
    first: BOOL _ TRUE;
    standardSwitches: CompilerOps.LetterSwitches ~ CompilerOps.DefaultSwitches[];
    msgsw.PutF["Compiling: %s", IO.string[t.source.locator.base]];
    logsh.PutF["\nCommand: %s", IO.string[t.source.locator.base]];
    FOR c: CHAR IN ['a .. 'z] DO
      sd: BOOL ~ (IF c = 'p THEN FALSE ELSE standardSwitches[c]);
      IF t.switches[c] ~= sd THEN {
	IF first THEN {first _ FALSE; msgsw.PutChar['/]; logsh.PutChar['/]};
	IF sd THEN {msgsw.PutChar['-]; logsh.PutChar['-]};
	msgsw.PutChar[c];
	logsh.PutChar[c]};
	ENDLOOP;
    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 msgsw.PutF["%d errors", IO.card[t.nErrors]]
    ELSE msgsw.PutF["no errors"];
    IF t.nWarnings > 0 THEN msgsw.PutF[", %d warnings", IO.card[t.nWarnings]];
    msgsw.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]];
      ms.PL["\n\n"L]};
    };

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

  LogGetStream: PROC[sid: CompilerOps.StreamId] RETURNS[sh: Stream.Handle] ~ {
    IF sid = source THEN RETURN[sourcesh];	-- temporary
    IF sid ~= log THEN ERROR;
    IF logsh = NIL THEN {
      TRUSTED {logpilotsh _ CS.NewStream["Compiler.Log", CS.Write]};
      logsh _ IO.CreateProcsStream[IO.CreateRefStreamProcs[putChar~LogStreamPutChar], NIL];
      CS.SetPFCodes[logsh]};
    sh _ logpilotsh;
    IF sh = NIL THEN ERROR};

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

  CompilerPass: PROC[p: CARDINAL] RETURNS[goOn: BOOL] ~ {
    goOn _ ~inputsh.UserAbort;
    msgsw.PutChar['.]};

  SubStringToRope: PROC[lp: LongString.SubString] RETURNS[rope: Rope.Text] ~ TRUSTED {
    r: Rope.ROPE _ NIL;
    FOR i: CARDINAL IN [0 .. lp.length) DO
      r _ r.Cat[Rope.FromChar[lp.base[lp.offset+i]]];
      ENDLOOP;
    rope _ r.Flatten[]};

  FoldInParms: PROC[parms: Rope.Text]
      RETURNS[switches: CompilerOps.LetterSwitches, explicitSortSwitch: BOOL] ~ {
    i: CARDINAL _ 0;
    on: BOOL;
    ch: CHAR;
     -- set defaults
    TRUSTED {switches _ CompilerOps.DefaultSwitches[]};
    -- switches['s] _ FALSE;	the modeller defaults to /-s
    explicitSortSwitch _ FALSE;
    IF parms # NIL THEN
      WHILE i < parms.Length DO
	on _ TRUE;
	IF parms.Fetch[i] = '- THEN {i _ i + 1; on _ FALSE;};
	ch _ Rope.Lower[parms.Fetch[i]];
	IF ch IN ['a .. 'z] THEN {
	  switches[ch] _ on;
	  IF ch = 's THEN explicitSortSwitch _ TRUE};
	i _ i + 1;
	ENDLOOP;
    };

  InterpolateSwitches: PROC[parms: Rope.Text]
      RETURNS[switches: CompilerOps.LetterSwitches, explicitSortSwitch: BOOL] ~ {
    i: CARDINAL _ 0;
    on: BOOL;
    ch: CHAR;
     -- set defaults
    TRUSTED {switches _ CompilerOps.DefaultSwitches[]};
    -- switches['s] _ FALSE;	the modeller defaults to /-s
    explicitSortSwitch _ FALSE;
    IF parms = NIL THEN RETURN;
    WHILE i < parms.Length DO
      on _ TRUE;
      IF parms.Fetch[i] = '- THEN {i _ i + 1; on _ FALSE};
      ch _ Rope.Lower[parms.Fetch[i]];
      IF ch IN ['a .. 'z] THEN {
	switches[ch] _ on;
	IF ch = 's THEN explicitSortSwitch _ TRUE};
      i _ i + 1;
      ENDLOOP;
    };

  GenUniqueBcdName: PROC[bcdFileName: Rope.Text]
      RETURNS[newName: Rope.Text] ~ TRUSTED {
    inx: CARDINAL _ 1;
    newName _ bcdFileName;
    DO
      newName _ RopeInline.InlineFlatten[
			IO.PutFR["%s.%d.Bcd$", IO.rope[bcdFileName], IO.card[inx]]];
      [] _ Directory.Lookup[fileName: LOOPHOLE[newName], permissions: Directory.ignore
			! Directory.Error => {GOTO out}];
      inx _ inx + 1;
      ENDLOOP;
    EXITS
      out => NULL;
    };

  }.