-- MDCompImpl.mesa
-- last edit by Schmidt, April 21, 1982 2:55 pm		
-- last edit by Satterthwaite, January 31, 1983 10:52 am		
-- Pilot 6.0/ Mesa 7.0
-- procedures to determine compilation, etc. for the system modeller
					
DIRECTORY
  CompilerOps: TYPE USING [LetterSwitches],
  CWF: TYPE USING [FWF1, FWF2, SWF1, SWF2, SWF3, WF0, WF1, WF2, WF3, WF4, WFCR],
  Dir: TYPE USING [DepSeq, FileInfo, NewVersion],
  Directory: TYPE USING [Error, Handle, ignore, Lookup, Rename],
  ExecOps: TYPE USING [Outcome],
  File: TYPE USING [Capability],
  IO: TYPE USING [Handle],
  LowLoader: TYPE USING [ReplaceResult],
  LongString: TYPE USING [AppendChar, AppendString, EquivalentString],
  MDComp: TYPE USING [],
  MDDB: TYPE USING [GetBcdDepSeq],
  MDMain: TYPE USING [DebugWP],
  MDModel: TYPE USING [
    AddToEndOfList, APPLSymbol, CkType, EraseCacheEntry, 
    FoldInParms, GenerateUniqueName, GetBcdCreate, GetFileInfo, GetSrcCreate, 
    LETSymbol, LISTSymbol, LocForType, LOCSymbol, MODELSymbol, 
    NarrowToLIST, NarrowToPROC, NewSymAPPL, OPENSymbol, PROCSymbol,
    SpliceBefore, STRINGSymbol, Symbol, SymbolSeq, TraverseList, TYPESymbol],
  MDUtil: TYPE USING [MakeConfig, RunBinder, SetModelCreateProperty],
  RComp: TYPE USING [Compile, StopBatchCompile],
  RTOS: TYPE USING [CheckForModuleReplacement],
  Runtime: TYPE USING [IsBound],
  Stream: TYPE USING [Delete, Handle],
  String: TYPE USING [AppendString],
  Subr: TYPE USING [
    AbortMyself, CheckForModify, CopyString, debugflg, EndsIn, 
    NewStream, strcpy, TTYProcs, Write],
  TimeStamp: TYPE USING [Null],
  TypeScript: TYPE USING[TS, UserAbort];

MDCompImpl: PROGRAM
  IMPORTS
    CWF, Dir, Directory, LongString, MDDB, MDMain, MDModel, MDUtil, 
    RComp, RTOS, Runtime, Stream, String, Subr, TypeScript
  EXPORTS MDComp = {

  RTCallable: BOOL = TRUE;

-- no MDS Usage!!!

  OutCome: TYPE = {
    compNotNecc, compDeclined, compFailed,
    compSuccNotRepl, compSuccRepl, compSucc};

 -- this may call a procedure to look at bcd header
  DetermineRecomp: PUBLIC PROC[
	sproot: MDModel.Symbol, symbolseq: MDModel.SymbolSeq,
	officialwindow: Subr.TTYProcs, uniquename, tryreplacement: BOOL, 
	confirm: REF BOOL, typeScript: TypeScript.TS, ttyin, ttyout, msgout: IO.Handle] 
      RETURNS[wascompiled, didfail: BOOL] = {
    m, dontProceed: BOOL _ FALSE;
    numberOfErrors, numberOfWarnings, numberSuccessful: CARDINAL;

    RecompRecur: PROC[
    	  sp: MDModel.Symbol, mustcomp, failed: BOOL,
	  spparent: MDModel.Symbol, spmodel: MDModel.MODELSymbol]
	RETURNS[BOOL, BOOL] = {
      mustcomp1, mustcomp2, mustcomp3, f1, f2, f3: BOOL;
	
      IF sp = NIL THEN RETURN[mustcomp, failed];
      IF sp.visited THEN RETURN[sp.changed OR mustcomp, sp.failed OR failed];
      sp.visited _ TRUE;
      WITH sp SELECT FROM
	spt: MDModel.TYPESymbol => {
	  [mustcomp1, f1] _ RecompRecur[spt.typeval, FALSE, FALSE, sp, spmodel];
	  [mustcomp2, f2] _ RecompRecur[spt.letparent, FALSE, FALSE, sp, spmodel];
	  failed _ f1 OR f2;
	  mustcomp _ mustcomp1 OR mustcomp2};
	spt: MDModel.PROCSymbol => {
	  [mustcomp1, f1] _ RecompRecur[spt.procparm, FALSE, FALSE, sp, spmodel];
	  [mustcomp2, f2] _ RecompRecur[spt.procret, FALSE, FALSE, sp, spmodel];
	  [mustcomp3, f3] _ RecompRecur[spt.procval, FALSE, FALSE, sp, spmodel];
	  mustcomp _ mustcomp1 OR mustcomp2 OR mustcomp3;
	  failed _ f1 OR f2 OR f3};
	spt: MDModel.APPLSymbol => {
	  [mustcomp1, f1] _ RecompRecur[spt.appltype, FALSE, FALSE, sp, spmodel];
	  [mustcomp, f2] _ RecompRecur[spt.applval, mustcomp1, FALSE, sp, spmodel];
	  failed _ f1 OR f2};
	spt: MDModel.LISTSymbol => {
	  ignoreappls: BOOL = (spparent.stype = typeLOC);
	  flist, mlist: BOOL _ FALSE;
	
	  RunDownList: PROC[spinner: MDModel.Symbol] = {
	    m1, f1: BOOL;
	    -- special case for parameter that is an instance;
	    -- an instance may change but the Importer need not change
	    -- this is only set to true if the parent is a LOC
	    -- forthermore, we want to avoid analyzing the value of an APPL
	    -- but since the LOC is parameterized by TYPES, it is ok to skip them now
	    -- (problem arose with FRAMEPTRTYPEs)
	    IF ignoreappls AND ISTYPE[spinner, MDModel.APPLSymbol] THEN m1 _ f1 _ FALSE
	    ELSE [m1, f1] _ RecompRecur[spinner, FALSE, FALSE, sp, spmodel];
	    mlist _ mlist OR m1;
	    flist _ flist OR f1};

	  MDModel.TraverseList[spt, RunDownList];
	  mustcomp _ mlist;
	  failed _ flist};
	spt: MDModel.LETSymbol => {
	  [mustcomp1, f1] _ RecompRecur[spt.letgrp, FALSE, FALSE, sp, spmodel];
	  [mustcomp, f2] _ RecompRecur[spt.letval, mustcomp1, FALSE, sp, spmodel];
	  failed _ f1 OR f2};
	spt: MDModel.LOCSymbol => {
	  o: OutCome;
	  [mustcomp1, f1] _ RecompRecur[spt.parmlist, FALSE, FALSE, sp, spmodel];
	  [mustcomp2, f2] _ RecompRecur[spt.nestedmodel, FALSE, FALSE, sp, spmodel];
	  failed _ failed OR f1 OR f2;
	  mustcomp _ mustcomp OR mustcomp1 OR mustcomp2;
	  IF TypeScript.UserAbort[typeScript] THEN SIGNAL Subr.AbortMyself;
	  o _ GenerateBcd[spt, 
			mustcomp, uniquename, tryreplacement, failed, confirm, 
			symbolseq, officialwindow, spmodel, typeScript, ttyin, ttyout, msgout];
	  SELECT o FROM
	    $compNotNecc => {mustcomp _ FALSE; failed _ FALSE};
	    $compDeclined => {failed _ FALSE; dontProceed _ TRUE};
	    $compFailed => {mustcomp _ TRUE; failed _ TRUE; dontProceed _ TRUE};
	    $compSuccNotRepl => {mustcomp _ TRUE; failed _ FALSE; dontProceed _ TRUE};
	    $compSuccRepl => {mustcomp _ TRUE; failed _ FALSE};
	    $compSucc => {mustcomp _ TRUE; failed _ FALSE};
	    ENDCASE => ERROR;
	  -- dontProceed means do not do anything after trying to compile --};
	spt: MDModel.MODELSymbol => {
	  IF Subr.debugflg THEN CWF.WF1["About to analyze %s.\n"L, spt.modelfilename];
	  [mustcomp, failed] _ RecompRecur[spt.model, mustcomp, FALSE, sp, spt]};
	spt: MDModel.OPENSymbol => NULL;
	spt: MDModel.STRINGSymbol => NULL;
	ENDCASE => ERROR;	-- Unknown stype
      sp.changed _ mustcomp;
      sp.failed _ failed;
      RETURN[mustcomp, failed]};

    -- print is used temporarily here to mean compilation failed ,???
    IF symbolseq.traversalInProgress THEN ERROR;
    symbolseq.traversalInProgress _ TRUE;
    FOR i: CARDINAL IN [0.. symbolseq.size) DO
      symbolseq[i].failed _ symbolseq[i].visited _ symbolseq[i].changed _ FALSE;
      ENDLOOP;
    [m, didfail] _ RecompRecur[sproot, FALSE, FALSE, NIL, NIL
	! UNWIND => {
	    symbolseq.traversalInProgress _ FALSE; [] _ RComp.StopBatchCompile[]}
	];
    sproot.changed _ m;
    [numberSuccessful, numberOfWarnings, numberOfErrors] _ RComp.StopBatchCompile[];
    IF numberSuccessful = 0 AND numberOfErrors = 0 AND numberOfWarnings = 0 THEN
      CWF.WF0["Nothing was compiled.\n"L]
    ELSE {
      CWF.WF1["%u successful; "L, @numberSuccessful];
      IF numberOfErrors > 0 THEN CWF.WF1["%u w/errors; "L, @numberOfErrors];
      IF numberOfWarnings > 0 THEN CWF.WF1["%u w/warnings; "L, @numberOfWarnings];
      CWF.WFCR[]};
    CWF.WFCR[];
    symbolseq.traversalInProgress _ FALSE;
    RETURN[m, (numberOfErrors > 0) OR dontProceed]};

  oType: TYPE = {mesa, config, model};

  -- sploc will be of type typeLOC
  -- this procedure may look at the bcd header
  GenerateBcd: PROC[
  	sploc: MDModel.LOCSymbol,
  	mustcomp, uniquename, tryreplacement, failed: BOOL, confirm: REF BOOL, 
	symbolseq: MDModel.SymbolSeq, officialwindow: Subr.TTYProcs,
	spmodel: MDModel.MODELSymbol,
	typeScript: TypeScript.TS, ttyin, ttyout, msgout: IO.Handle] 
      RETURNS [outc: OutCome] = {
    need: BOOL;
    ot: oType;
    fi: Dir.FileInfo;

    MDModel.CkType[sploc, typeLOC];
    fi _ MDModel.GetFileInfo[sploc];
    IF fi.isBcd THEN {
      IF fi.bcdPresent THEN SetVersAndModulename[sploc];
      RETURN[$compNotNecc]};
    IF Subr.debugflg AND ~fi.srcPresent THEN 
      CWF.WF1["Check - Cannot find %s.\n"L, fi.srcFileName];
    IF sploc.sext = NIL OR LongString.EquivalentString[sploc.sext, "mesa"L] THEN
      ot _ $mesa
    ELSE IF LongString.EquivalentString[sploc.sext, "config"L] THEN ot _ $config
    ELSE IF LongString.EquivalentString[sploc.sext, "model"L] THEN ot _ $model
    ELSE ERROR;
    IF ot=$model THEN RETURN[$compNotNecc];
    -- 
    IF failed THEN {
      -- the bcdVers has not been set!
      CWF.WF1["Don't bother with %s since something failed before it.\n"L, fi.srcFileName];
      RETURN[$compFailed]};
    SetVersAndModulename[sploc];	-- this analyzes the bcd to get the bcd version stamp
    IF fi.srcPresent
     AND sploc.createtime > 0 AND MDModel.GetSrcCreate[fi] ~= sploc.createtime THEN {
      CWF.WF3["You want %s of %lt but the disk has %lt.\n"L,
			fi.srcFileName, @sploc.createtime, @fi.srcCreate];
      RETURN[$compNotNecc]};
    -- we used to skip checking the bcd to see if it needs to be compiled
    -- if a paramter had changed, but recompiling a defs file may not changed the
    -- functional time stamp so we always check now
    need _ BcdNoGood[sploc];
    IF need THEN {
      errors, warnings, replaceable: BOOL _ FALSE;
      declined: BOOL _ FALSE;
      -- oldBcdCap: File.Capability _ fi.bcdCap;
      IF ~fi.srcPresent THEN {
	CWF.WF1["Error - Cannot compile/bind %s.\n"L, fi.srcFileName];
	RETURN[$compFailed]};
      SELECT ot FROM
	$mesa => {
	  IF CheckParametersOnDisk[sploc] THEN RETURN[$compFailed];
	  -- always tries for replacement
	  IF -- tryreplacement AND -- fi.loadInfoSeq ~= NIL 
	   AND fi.loadInfoSeq.size = 1 THEN {
	    -- should do something about checking
	    -- both for local frames and copied and shared
	    replaceResult: LowLoader.ReplaceResult;
	    oldname: STRING _ [100];
	    GenUniqueBcdName[oldname, sploc];
	    replaceResult _ SELECT TRUE FROM
	      LongString.EquivalentString[oldname, fi.bcdFileName] => $cantCopyOldBcd,
	      RTCallable AND Runtime.IsBound[RTOS.CheckForModuleReplacement]
	       AND ~RTOS.CheckForModuleReplacement[fi.loadInfoSeq[0].frame] =>
	       	$checkForMRFailed,
	      ENDCASE => $ok;
	    IF replaceResult ~= $ok THEN {
	      CWF.WF2["%s cannot be replaced because %s.\n"L, fi.bcdFileName,
			    SELECT replaceResult FROM
				$cantCopyOldBcd => "can't copy old bcd"L,
				$checkForMRFailed => "RT check for module replacement failed"L,
				ENDCASE => ERROR];
	      declined _ TRUE;
	      GOTO skip};
	    -- make sure depseq is ready for old bcd
	    [] _ MDDB.GetBcdDepSeq[fi, 0];
	    Directory.Rename[newName: oldname, oldName: fi.bcdFileName];
	    CWF.WF2["Old version of %s renamed to %s.*N"L, fi.bcdFileName, oldname];
	    [errors, warnings, replaceable, declined] _ RComp.Compile[
	    				symbolseq, sploc, TRUE, oldname,
					spmodel, confirm, typeScript, ttyin, ttyout, msgout];
	    IF ~replaceable THEN replaceResult _ $compilerSaysNo;
	    IF replaceable AND ~errors AND ~declined THEN {
	      CWF.WF1["%s passes compiler's test for replaceability.\n"L, fi.bcdFileName];
	      fi.loadInfoSeq.mustreplace _ TRUE}
	    ELSE {
	      fi.loadInfoSeq.mustreplace _ FALSE;
	      IF declined OR errors THEN {
		-- new version has to be deleted
		Directory.Rename[newName: fi.bcdFileName, oldName: oldname];
		CWF.WF1["Old, loaded version of %s has been left on disk.\n"L, fi.bcdFileName]}
	      ELSE CWF.WF3[
	        "%s is not replaceable%s, new version has been left on disk, \n\told loaded version is called %s.\n"L, 
	        fi.bcdFileName,
	        IF replaceResult = $compilerSaysNo
	          THEN " (Compiler refuses)"L ELSE ""L, oldname]};
	    EXITS
	      skip => NULL;
	    }
	  ELSE -- not currently called -- {
	    [errors, warnings, , declined] _ RComp.Compile[
	    				symbolseq, sploc, FALSE, NIL,
					spmodel, confirm, typeScript, ttyin, ttyout, msgout]}};
	$config => {
	  outcome: ExecOps.Outcome;
	  cmd: STRING _ [1500];
	  objectfile: STRING _ [100];
	  FormatBinderCmd[cmd, objectfile, fi.srcFileName, uniquename, NIL];
	  outcome _ MDUtil.RunBinder[cmd, typeScript, ttyin, ttyout, msgout, confirm];
	  SELECT outcome FROM
	    $ok, $aborted => NULL;
	    $warnings => warnings _ TRUE;
	    $errors => errors _ TRUE;
	    $errorsAndWarnings => warnings _ errors _ TRUE;
	    ENDCASE => ERROR}
	ENDCASE => ERROR;
      -- leave undisturbed if declined
      IF ~declined THEN {
	IF errors THEN {
	  -- there were errors, remove any capabilities for it
	  MDModel.EraseCacheEntry[fi: fi, src: FALSE];
	  CWF.FWF1[MDMain.DebugWP, "Erasing fi entry for %s.\n"L, fi.bcdFileName]}
	ELSE {
	  -- record new version and update cache
	  fdepseq: Dir.DepSeq;
	  [] _ Dir.NewVersion[fi: fi, src: FALSE];
	  fdepseq _ MDDB.GetBcdDepSeq[fi, 0];	-- this will use the DB cache
	  IF fdepseq = NIL THEN ERROR;
	  fi.bcdVers _ fdepseq.bcdVers;
	  CWF.FWF1[MDMain.DebugWP, "Resetting fi entry for %s.\n"L, fi.bcdFileName]}};
      RETURN[SELECT TRUE FROM
	declined => $compDeclined,
	errors => $compFailed,
	replaceable AND fi.loadInfoSeq ~= NIL => $compSuccRepl,
	~replaceable AND fi.loadInfoSeq ~= NIL => $compSuccNotRepl,
	ENDCASE => $compSucc]};
    RETURN[$compNotNecc]};

  SetVersAndModulename: PUBLIC PROC[sploc: MDModel.LOCSymbol] = {
    fi: Dir.FileInfo = MDModel.GetFileInfo[sploc];
    IF fi.bcdPresent THEN {
      fdepseq: Dir.DepSeq = MDDB.GetBcdDepSeq[fi, 0];
      IF fdepseq ~= NIL THEN {
	IF fdepseq.moduleName ~= NIL AND fi.moduleName = NIL THEN
	  fi.moduleName _ Subr.CopyString[fdepseq.moduleName];
	IF fi.bcdVers = TimeStamp.Null 
	 OR fi.bcdVers.time ~= sploc.createtime 
	 OR sploc.createtime = MDModel.GetBcdCreate[fi] THEN {
	  IF Subr.debugflg AND fi.bcdVers ~= fdepseq.bcdVers THEN
	    CWF.WF2["%s bcdVers set to %v.\n"L, fi.bcdFileName, @fdepseq.bcdVers];
	  fi.bcdVers _ fdepseq.bcdVers}}};
    };

  CheckParametersOnDisk: PROC[sploctop: MDModel.LOCSymbol]
      RETURNS [willfail: BOOL _ FALSE] = {
    FOR splist: MDModel.LISTSymbol _ sploctop.parmlist, splist.rest WHILE splist ~= NIL DO
      WITH splist.first SELECT FROM
        sptype: MDModel.TYPESymbol => {
	  sploc: MDModel.LOCSymbol = MDModel.LocForType[sptype];
	  fi: Dir.FileInfo;
	  IF sploc = NIL THEN RETURN;
	  fi _ MDModel.GetFileInfo[sploc];
	  IF fi.bcdVers = TimeStamp.Null THEN {
	    IF Subr.debugflg THEN 
	      CWF.WF1["Warning- no version stamp for %s.\n"L, fi.bcdFileName]}
	  ELSE IF ~fi.bcdPresent THEN {
	    CWF.WF2["Error - to compile %s.Mesa you need %s on the local disk.\n"L,
				sploctop.tail, fi.bcdFileName];
	    RETURN[TRUE]}};
        ENDCASE => NULL;
      ENDLOOP};
		
  GenUniqueBcdName: PROC[newname: LONG STRING, sploc: MDModel.LOCSymbol] = {
    inx: CARDINAL _ 1;
    fi: Dir.FileInfo = MDModel.GetFileInfo[sploc];
    Subr.strcpy[newname, fi.bcdFileName];
    IF ~fi.bcdPresent THEN RETURN;
    DO
      CWF.SWF2[newname, "%s.%u.Bcd$"L, sploc.tail, @inx];
      [] _ Directory.Lookup[fileName: newname, permissions: Directory.ignore
		! Directory.Error => {GOTO out}];
      inx _ inx + 1;
      ENDLOOP;
    EXITS
	out => NULL;
    };


-- verify the Bcd is ok
  BcdNoGood: PROC[splocsrc: MDModel.LOCSymbol] RETURNS[terrible: BOOL] = {
    bcddepseq: Dir.DepSeq;
    fi: Dir.FileInfo;
    wantsw: CompilerOps.LetterSwitches;
    explicitSortSwitch: BOOL _ FALSE;

    -- this only checks the time part of the version stamp
    -- in case the sploc.bcdVers came from the model and
    -- the bcd is not on the local disk
    -- you only need to check the number and types of TYPES (defs files)
    -- to verify the parameters (also, should check parms)

    ProcParm: PROC[sp: MDModel.Symbol] = {
      WITH sp SELECT FROM
        spt: MDModel.STRINGSymbol =>
	  [wantsw, explicitSortSwitch] _ MDModel.FoldInParms[spt.strval];
        sptype: MDModel.TYPESymbol => {
	  sploc: MDModel.LOCSymbol;
	  fiInner: Dir.FileInfo;
          IF terrible THEN RETURN;
          sploc _ MDModel.LocForType[sptype];
          IF sploc = NIL THEN RETURN;
          fiInner _ MDModel.GetFileInfo[sploc];
          IF fiInner.bcdVers = TimeStamp.Null THEN {
	    CWF.FWF1[MDMain.DebugWP, "Bcdvers for %s is 0.\n"L, fiInner.bcdFileName];
	    RETURN};
          IF ~fiInner.bcdPresent AND ~fiInner.srcPresent THEN {
	    CWF.FWF2[MDMain.DebugWP,
			"Neither src nor bcd present for %s, needed by %s.\n"L,
			fiInner.bcdFileName, fi.bcdFileName];
	    RETURN};
          IF fiInner.moduleName = NIL THEN ERROR;
          -- since the bcddepseq[i].modulename may be NIL, we must match
          -- on bcdfilename and bcdvers rather than sptype.typeName
          FOR i: CARDINAL IN [0.. bcddepseq.size) DO
	    IF bcddepseq[i].relation ~= directory THEN LOOP;
	    IF LongString.EquivalentString[fiInner.bcdFileName, bcddepseq[i].bcdFileName] THEN {
	      IF bcddepseq[i].bcdVers.time ~= fiInner.bcdVers.time THEN {
		CWF.WF2["\nMust recompile %s since it depends on %s.\n"L,
					fi.bcdFileName, fiInner.bcdFileName];
		CWF.WF4["  %s is now dated %v\n\tbut %s was compiled with %v.\n"L, 
					fiInner.bcdFileName, @fiInner.bcdVers, 
					fi.bcdFileName, @bcddepseq[i].bcdVers];
		terrible _ TRUE};
	      RETURN};
	    ENDLOOP;
          terrible _ TRUE;
          CWF.WF4[
		" \nMust recompile %s since it was compiled with type %s, which is %s of %v in the model\n"L,
		fi.bcdFileName, sptype.typeName, fiInner.bcdFileName, @fiInner.bcdVers];
          CWF.WF1["  but %s does not use it.\n"L, fi.bcdFileName]};
        ENDCASE => NULL};

    [wantsw] _ MDModel.FoldInParms[NIL];	-- get default switches
    wantsw['s] _ FALSE;	-- default for modeller is /-s
    MDModel.CkType[splocsrc, typeLOC];
    fi _ MDModel.GetFileInfo[splocsrc];
    IF ~fi.bcdPresent THEN {
      CWF.WF2[
        "Must compile %s since there is no %s on the disk.\n"L, fi.srcFileName, fi.bcdFileName];
      RETURN[TRUE]};
    IF ~fi.srcPresent THEN RETURN[FALSE]; 	-- can't recompile anyway
    -- don't ever free this depseq
    bcddepseq _ MDDB.GetBcdDepSeq[fi, 0];
    IF bcddepseq = NIL THEN RETURN[TRUE];	-- not in Bcd format, must recompile
    terrible _ FALSE;
    -- do the file names agree?
    IF ~LongString.EquivalentString[fi.srcFileName, bcddepseq.srcFileName] THEN {
      CWF.WF3["Must recompile %s since the source for %s on the disk is %s,\n"L,
		fi.bcdFileName,  fi.bcdFileName, bcddepseq.srcFileName];
      CWF.WF1["  so it cannot be used as a .Bcd for %s.\n"L,
		fi.srcFileName];
      terrible _ TRUE}
    -- do the create dates agree?
    ELSE IF MDModel.GetSrcCreate[fi] ~= bcddepseq.srcCreate THEN {
      CWF.WF3["Must recompile %s since it was compiled with %s of %lt,\n"L,
		fi.bcdFileName, fi.srcFileName, @bcddepseq.srcCreate];
      CWF.WF2["  but %s is now dated %lt.\n"L, fi.srcFileName, @fi.srcCreate];
      terrible _ TRUE}
    -- do the parameters agree in type?
    ELSE MDModel.TraverseList[splocsrc.parmlist, ProcParm];

    -- check parameter switches, these must agree (only for implementors)
    -- /b (bounds checks)
    -- /c (cedar fork)
    -- /j (cross jump)
    -- /l (links in code, new interpretation)
    -- /n (nil check)
    -- /s (sort by usage), only check if the user explicitly specified switches
    IF ~terrible AND ~bcddepseq.isdefns AND
     (wantsw['b] ~= bcddepseq.switches['b]
      OR wantsw['c] ~= bcddepseq.switches['c]
      OR wantsw['j] ~= bcddepseq.switches['j]
      OR wantsw['l] ~= bcddepseq.switches['l]
      OR wantsw['n] ~= bcddepseq.switches['n]
      OR (wantsw['s] ~= bcddepseq.switches['s] AND explicitSortSwitch))
     THEN {
     	s1: STRING _ [20];
	s2: STRING _ [20];
	AppendBcdSwitches[s1, wantsw];
	AppendBcdSwitches[s2, bcddepseq.switches];
	CWF.WF2[
	  "Must compile %s since the model specifies compiler options %s,\n"L, fi.srcFileName, s1];
	CWF.WF2["but %s was compiled with %s.\n"L, fi.bcdFileName, s2];
        terrible _ TRUE};
	
    -- if the file is ok, then make sure the loc has recorded in it
    -- the bcd time stamp; if the file is not ok, then give a bogus date
    -- can't do this because this module may be replaced, and we need the bcdVers
    -- fi.bcdVers _ IF terrible THEN [net: 0, host: 0, time: 1] ELSE depseq.bcdVers;
    fi.bcdVers _ bcddepseq.bcdVers;
    IF Subr.debugflg AND ~terrible THEN CWF.WF1["%s is ok.\n"L, fi.bcdFileName];
    RETURN[terrible]};

-- only does this for
-- /b (bounds checks)
-- /c (cedar fork)
-- /j (cross jump)
-- /l (links in code, new interpretation)
-- /n (nil check)
  AppendBcdSwitches: PROC[to: LONG STRING, switches: CompilerOps.LetterSwitches] = {
    arr: ARRAY [0..5] OF CHAR = ['b, 'c, 'j, 'l, 'n, 's];
    to.length _ 0;
    LongString.AppendChar[to, '/];
    FOR i: CARDINAL IN [0..arr.LENGTH) DO
      c: CHAR = arr[i];
      IF ~switches[c] THEN LongString.AppendChar[to, '-];
      LongString.AppendChar[to, c];
      ENDLOOP};

-- stores the binder command in "cmd"
-- the objectfile name in "objectfile"
  FormatBinderCmd: PROC[
      cmd, objectfile, sourcefile: LONG STRING, uniquename: BOOL,
      fileparameters: LONG STRING] = {
    try: STRING _ [100];
    Subr.strcpy[objectfile, sourcefile];
    IF Subr.EndsIn[objectfile, ".config"L] THEN objectfile.length _ objectfile.length - 7;
    CWF.SWF1[try, "%s.bcd"L, objectfile];
    IF uniquename THEN {
      num: CARDINAL _ 1;
      [] _ Directory.Lookup[fileName: try, permissions: Directory.ignore
		! Directory.Error => {GOTO ok}];
      DO
	CWF.SWF2[try, "%s%u.bcd"L, objectfile, @num];
	[] _ Directory.Lookup[fileName: try, permissions: Directory.ignore
		! Directory.Error => {EXIT}];
	num _ num + 1;
	ENDLOOP;
      -- try is the name we will give it
      EXITS
	ok => NULL;
      };
    Subr.strcpy[objectfile, try];
    CWF.SWF3[cmd, "[bcd: %s] _ %s[%s]/e"L, objectfile, sourcefile, 
	IF fileparameters = NIL THEN ""L ELSE fileparameters]};

-- take PLUS nodes and convert them to format acceptible to the modeller loader
  HandlePlus: PUBLIC PROC[symbolseq: MDModel.SymbolSeq] = {
    start: MDModel.PROCSymbol;
    splist : MDModel.LISTSymbol _ symbolseq.toploc.nestedmodel.model;
    WHILE splist ~= NIL AND ~ISTYPE[splist.first, MDModel.PROCSymbol] DO
      splist _ splist.rest;
      IF splist = NIL THEN RETURN;
      MDModel.CkType[splist, typeLIST];
      ENDLOOP;
    start _ MDModel.NarrowToPROC[splist.first];
    splist _ MDModel.NarrowToLIST[start.procval];
    WHILE splist ~= NIL DO
      MDModel.CkType[splist, typeLIST];
      WITH splist.first SELECT FROM
        spa: MDModel.APPLSymbol =>
          WITH spa.applval SELECT FROM
            spp: MDModel.LISTSymbol =>
	      IF spp.listtype = $plus AND ISTYPE[spp.first, MDModel.LOCSymbol] THEN {
		spnewlist: MDModel.LISTSymbol _ NIL;
		WHILE spp ~= NIL DO
		  spnew: MDModel.APPLSymbol = MDModel.NewSymAPPL[symbolseq];
		  MDModel.CkType[spp, typeLIST];
		  spnew.applsym _ MDModel.GenerateUniqueName[spa];
		  spnew.applval _ spp.first;
		  spnew.appltype _ spa.appltype;
		  spnew.recursive _ spa.recursive;
		  start.procval _ MDModel.SpliceBefore[symbolseq, 
				spnew, splist, MDModel.NarrowToLIST[start.procval]];
		  spnewlist _ MDModel.AddToEndOfList[spnewlist, spnew, $plus, symbolseq];
		  spp _ spp.rest;
		  ENDLOOP;
		-- now replace list val by new one
		-- this discards the old list
		-- FreeListHeaders[spa.applval];
		spa.applval _ spnewlist};
            ENDCASE => NULL;
        ENDCASE => NULL;
      splist _ splist.rest;
      ENDLOOP};

-- add the UID (create date) for the model to the config
  NewBind: PUBLIC PROC[
	sproot: MDModel.MODELSymbol, symbolseq: MDModel.SymbolSeq,
	needsconfig, uniquename: BOOL, confirm: REF BOOL, modelfile: LONG STRING,
	modelcreate: LONG CARDINAL, officialwindow: Subr.TTYProcs,
	typeScript: TypeScript.TS, ttyin, ttyout, msgout: IO.Handle]
      RETURNS[successful: BOOL _ FALSE] = {
    fileparameters: STRING _ [2000];
    cmd: STRING _ [2000];
    sourcefile: STRING _ [100];
    objectfile: STRING _ [100];
    outcome: ExecOps.Outcome;
    IF ~Subr.EndsIn[modelfile, ".model"L] THEN ERROR;
    Subr.strcpy[sourcefile, "MODEL"L];
    LongString.AppendString[sourcefile, modelfile];
    sourcefile.length _ sourcefile.length - 5;
    String.AppendString[sourcefile, "config"L];
    IF needsconfig THEN {
      sh: Stream.Handle;
      CWF.WF1["\nThe New Config File Is %s.\n"L, sourcefile];
      -- this changes the model to allow for 
      -- Binder limitations; don't save this version
      HandlePlus[symbolseq];
      IF Subr.debugflg THEN MDUtil.MakeConfig[sproot, symbolseq, NIL, 0, ttyout, NIL];
      IF Subr.CheckForModify[sourcefile, officialwindow] THEN {
	cap: File.Capability;
	sh _ Subr.NewStream[sourcefile, Subr.Write];
	MDUtil.MakeConfig[sproot, symbolseq, sh, modelcreate, ttyout, fileparameters];
	Stream.Delete[sh];
	cap _ Directory.Lookup[fileName: sourcefile, permissions: Directory.ignore];
	MDUtil.SetModelCreateProperty[cap, modelcreate]}};
    FormatBinderCmd[cmd, objectfile, sourcefile, uniquename, 
	IF fileparameters.length = 0 THEN NIL ELSE fileparameters];
    outcome _ MDUtil.RunBinder[cmd, typeScript, ttyin, ttyout, msgout, confirm];
    IF outcome = $ok OR outcome = $warnings THEN {
      cap: File.Capability;
      successful _ TRUE;
      cap _ Directory.Lookup[fileName: sourcefile, permissions: Directory.ignore];
      MDUtil.SetModelCreateProperty[cap, modelcreate];
      -- call with the top-level bcd name
      -- strip off ".Bcd", it's not needed
      objectfile.length _ objectfile.length - 4};
    CWF.WFCR[];
    RETURN};

  }.



 TimeToStamp: PROC [time: TimeStamp.Stamp] RETURNS [Stamp] = INLINE {
    RETURN [LOOPHOLE[time]]};

 -- new version stamp operations
 
  StampSize: NAT = 3;
  Stamp: TYPE = RECORD [word: ARRAY [0..StampSize) OF CARDINAL];
  
  AddStamps: PROC [s1, s2: Stamp] RETURNS [sum: Stamp] = {
    carry: [0..1] _ 0;
    i: NAT;
    FOR i DECREASING IN [0..StampSize) DO
      t: Inline.LongNumber _ [lc[LONG[s1.word[i]] + LONG[s2.word[i]] + LONG[carry]]];
      sum.word[i] _ t.lowbits;  carry _ t.highbits;
      ENDLOOP;
    FOR i DECREASING IN [0..StampSize) WHILE carry # 0 DO
      t: Inline.LongNumber _ [lc[LONG[sum.word[i]] + LONG[carry]]];
      sum.word[i] _ t.lowbits;  carry _ t.highbits;
      ENDLOOP};
    
  RotateStamp: PROC [s: Stamp] RETURNS [Stamp] = INLINE {RETURN [AddStamps[s, s]]};
  
  MergeStamps: PUBLIC PROC [sum, item: Stamp] RETURNS [Stamp] = {
    RETURN [AddStamps[RotateStamp[sum], item]]};
    
QuickCheck: PROC[diskbcd, disksrc: Dir.Disk, sploctop: MDModel.LOCSymbol] 
	RETURNS[bcdisok: BOOL] = {
switches: PACKED ARRAY CHAR ['a..'z] OF BOOL;
compilerVersion: TimeStamp.Stamp = CompilerOps.CompilerVersion[]; -- current Cedar release
trystamp: Stamp;
actualstamp: TimeStamp.Stamp;
depseq: Dir.DepSeq;
willfail: BOOL _ FALSE;
t: TimeStamp.Stamp;
		
	GetSwitches: PROC[sp: MDModel.Symbol] = {
	spstr: MDModel.STRINGSymbol;
	IF sp.stype ~= typeSTRING THEN RETURN;
	spstr _ MDModel.NarrowToSTRING[sp];
	switches _ MDModel.FoldInParms[spstr.strval];
	};

	GetTYPES: PROC[sp: MDModel.Symbol] = {
	sptype: MDModel.TYPESymbol;
	sploc: MDModel.LOCSymbol;
	IF sp.stype ~= typeTYPE THEN RETURN;
	sptype _ MDModel.NarrowToTYPE[sp];
	sploc _ MDModel.LocForType[sptype];
	IF sploc = NIL THEN RETURN;
	IF sploc.bcdVers = TimeStamp.Null AND Subr.debugflg THEN 
		CWF.WF1["Warning- no version stamp for %s.Bcd.\n"L, sploc.tail];
	IF sploc.bcdVers.net = 0 AND sploc.bcdVers.host = 0 THEN {
		willfail _ TRUE;	-- this means a bcdVers is from a bcd not on the disk
		IF Subr.debugflg THEN
			CWF.WF3["QuickCheck will fail for %s because of %s (time = %lt).\n"L, 
				sploctop.tail, sploc.tail, @sploc.bcdVers.time];
		RETURN;
		};
	trystamp _ MergeStamps[trystamp, TimeToStamp[sploc.bcdVers -- mdb[c.module].stamp -- ]];
	};
	
-- figure out what stamp should be if the model were correct
trystamp _ TimeToStamp[[net: 0, host: 0, time: disksrc.create]];
-- encode switches, compiler version
-- set defaults
switches _ MDModel.FoldInParms[NIL];
MDModel.TraverseList[sploctop.parmlist, GetSwitches];
switches['g] _ FALSE;
switches['p] _ FALSE;
trystamp _ MergeStamps[trystamp, TimeToStamp[[0, 0, LOOPHOLE[switches]]]];
trystamp _ MergeStamps[trystamp, TimeToStamp[compilerVersion]];
MDModel.TraverseList[sploctop.parmlist, GetTYPES];
IF willfail THEN RETURN[FALSE];
-- now look in the bcd to get the actual stamp
IF sploctop.bcdVers ~= TimeStamp.Null AND sploctop.bcdVers.net ~= 0 THEN
	actualstamp _ sploctop.bcdVers	-- use this if bonafide
ELSE IF (depseq _ diskbcd.depseq) ~= NIL 
     OR (depseq _ DBStash.Lookup[diskbcd.create]) ~= NIL THEN 
	actualstamp _ depseq.bcdtime
ELSE {
	bcd: BcdOps.BcdBase;
	space: Space.Handle _ Space.Create[size: 1, parent: Space.virtualMemory];
	Space.Map[space, [diskbcd.cap, 1]];
	MDModel.numberofbcdsmapped _ MDModel.numberofbcdsmapped + 1;
	bcd _ Space.LongPointer[space];
	actualstamp _ bcd.version;	-- this is the bcd version stamp
	IF sploctop.bcdVers = TimeStamp.Null 
	OR sploctop.bcdVers.time ~= sploctop.createtime 
	OR sploctop.createtime = diskbcd.create THEN
		sploctop.bcdVers _ actualstamp;
	Space.Delete[space];
	};
IF trystamp = TimeToStamp[actualstamp] THEN {
	IF Subr.debugflg THEN 
		CWF.WF1["Quick check succeeded for %s.Bcd.\n"L, sploctop.tail];
	RETURN[TRUE];
	}
ELSE IF actualstamp.time ~= diskbcd.create THEN	{ -- only give msg for Cedar 
	t _ LOOPHOLE[trystamp];
	IF Subr.debugflg THEN 
		CWF.WF3["Quick check failed for %s.Bcd: %lu ~= %lu.\n"L, sploctop.tail, 
			@t.time, @actualstamp.time];
	};
RETURN[FALSE];
};