-- SMFakeBcdImpl.mesa
-- last edit by Schmidt, May 24, 1983 3:13 pm
-- last edit by Satterthwaite, August 12, 1983 1:09 pm
-- procedures to build the fake config in the compile tool
	
DIRECTORY
  BcdDefs: TYPE USING [
    Base, BCD, CTIndex, CTNull, CTRecord, EXPIndex, FTIndex, FTNull, FTRecord, FTSelf,
    GFTIndex, Link, MTIndex, MTRecord, NameRecord, NullVersion, SGIndex, SGRecord,
    VersionID],
  BcdOps: TYPE USING [BcdBase, MTHandle, NameString, ProcessModules],
  Directory: TYPE USING [ignore, Lookup, Error],
  Environment: TYPE USING [wordsPerPage],
  File: TYPE USING [Capability],
  IO: TYPE USING [card, PutF, PutFR, rope, STREAM],
  CS: TYPE USING [NewFile, readWrite],
  PilotLoadStateFormat: TYPE USING [ConfigIndex],
  PilotLoadStateOps: TYPE USING [
    ConfigIndex, EnterModule, GetMap, Map, ReleaseLoadState, ReleaseMap, UpdateLoadState],
  PrincOps: TYPE USING [GFTIndex],
  Rope: TYPE USING [Text],
  RopeInline: TYPE USING [InlineFlatten],
  SMFakeBcd: TYPE USING [],
  SMLoad: TYPE USING [Zero],
  SMTree: TYPE Tree USING [ApplOp, Handle, Link],
  SMTreeOps: TYPE USING [OpName, Scan, ScanSons],
  SMVal: TYPE USING [LoadMod, GetExtFromParse],
  Space: TYPE USING [
    Create, Delete, Handle, LongPointer, Map, nullHandle, virtualMemory];
				
SMFakeBcdImpl: PROGRAM 
      IMPORTS
	BcdOps, CS,  Directory, SMLoad, SMTreeOps, SMVal, IO,
	PilotLoadStateOps, RopeInline, Space
      EXPORTS SMFakeBcd  ~ {
    OPEN Tree~~SMTree, TreeOps~~SMTreeOps;
	
-- no MDS usage!
	
  MTPAGE: CARDINAL ~ (BcdDefs.BCD.SIZE/Environment.wordsPerPage) + 1;
  nmtp: CARDINAL ~ 20;
  FTPAGE: CARDINAL ~ MTPAGE + nmtp;
  nftp: CARDINAL ~ 6;
  SGPAGE: CARDINAL ~ FTPAGE + nftp;
  nsgp: CARDINAL ~ 6;
  CTPAGE: CARDINAL ~ SGPAGE + nsgp;
  nctp: CARDINAL ~ 1;
  SSPAGE: CARDINAL ~ CTPAGE + nctp;
  nssp: CARDINAL ~ 16;
  EXPAGE: CARDINAL ~ SSPAGE + nssp;
  nexp: CARDINAL ~ 3;
  BCDPAGES: CARDINAL ~ EXPAGE + nexp;

-- also updates the load state with the modules
  BuildFakeBcd: PUBLIC SAFE PROC[
	configIndex: PilotLoadStateFormat.ConfigIndex, root: Tree.Link,
	oldFakeBcdFileName: Rope.Text, oldFakeBcdSpace: Space.Handle,
	out: IO.STREAM]
      RETURNS [fakeBcdFileName: Rope.Text, fakeBcdSpace: Space.Handle] ~ TRUSTED {
    bcdSpace: Space.Handle _ Space.nullHandle;
      {
      ENABLE
        UNWIND => {
          IF bcdSpace ~= Space.nullHandle AND oldFakeBcdSpace = Space.nullHandle THEN
            Space.Delete[bcdSpace]
          };
      Cbcdbase: BcdOps.BcdBase;
      Cctb, Cmtb, Csgb, Cftb, Cetb: BcdDefs.Base;
      Cmti: BcdDefs.MTIndex _ BcdDefs.MTIndex.FIRST;
      Cfti: BcdDefs.FTIndex _ BcdDefs.FTIndex.FIRST;
      Csgi: BcdDefs.SGIndex _ BcdDefs.SGIndex.FIRST;
      Ceti: BcdDefs.EXPIndex _ BcdDefs.EXPIndex.FIRST;
      Cnamei: CARDINAL;
      Cnamestring: BcdOps.NameString;
      Cngfi: CARDINAL _ 1;
	
      ProcAnalyze: PROC[loadMod: SMVal.LoadMod] ~ {
	sgb, ftb: BcdDefs.Base;
	bcdbase: BcdOps.BcdBase;
	namestring: BcdOps.NameString;
		
	ForEachModule: PROC[mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
	    RETURNS[stop: BOOL_FALSE] ~ {
	  rgfi: PrincOps.GFTIndex;
	  Check[Cmti + MTRecordLength[mth], Cbcdbase.mtLimit];
	  Cmtb[Cmti] _ mth^;
	  Cmtb[Cmti].name _ NewName[namestring, mth.name];
	  Cmtb[Cmti].gfi _ Cngfi;
	  Cmtb[Cmti].extension _ direct[length~0, frag~];
	  IF mth.gfi >= loadMod.loadInfo.gfiMap.size THEN ERROR;
	  -- this has previously been done in 
	  --	CedarLoaderImpl.CreateGlobalFrames
	  -- we do it here to set the map for the fake config
	  rgfi _ loadMod.loadInfo.gfiMap[mth.gfi].index;
	  FOR i: CARDINAL IN [0 .. mth.ngfi) DO
	    PilotLoadStateOps.EnterModule[
	      rgfi+i, [resolved~TRUE, config~configIndex, gfi~Cngfi+i]];
	    ENDLOOP;
	  Cngfi _ Cngfi + mth.ngfi;
	  Check[Cfti + BcdDefs.FTRecord.SIZE, Cbcdbase.ftLimit];
	  IF mth.file = BcdDefs.FTSelf THEN {
	    -- get info from header
	    Cftb[Cfti] _ [NewName[namestring, bcdbase.source], bcdbase.version];
	    Cmtb[Cmti].file _ Cfti;
	    Cfti _ Cfti + BcdDefs.FTRecord.SIZE}
	  ELSE IF mth.file = BcdDefs.FTNull THEN {
	    Cmtb[Cmti].file _ BcdDefs.FTNull}
	  ELSE {
	    Cftb[Cfti] _ ftb[mth.file];
	    Cftb[Cfti].name _ NewName[namestring, ftb[mth.file].name];
	    Cmtb[Cmti].file _ Cfti;
	    Cfti _ Cfti + BcdDefs.FTRecord.SIZE};
	  Check[Csgi + BcdDefs.SGRecord.SIZE, Cbcdbase.sgLimit];
	  Csgb[Csgi] _ sgb[mth.sseg];
	  Cmtb[Cmti].sseg _ Csgi;
	  Check[Cfti + BcdDefs.FTRecord.SIZE, Cbcdbase.ftLimit];
	  IF Csgb[Csgi].file = BcdDefs.FTSelf THEN {
	    -- if self then the symbols are in the config's file
	    Cftb[Cfti] _ [NewString[loadMod.proj.localName], bcdbase.version];
	    Csgb[Csgi].file _ Cfti;
	    Cfti _ Cfti + BcdDefs.FTRecord.SIZE}
	  ELSE IF Csgb[Csgi].file = BcdDefs.FTNull THEN {
	    Csgb[Csgi].file _ BcdDefs.FTNull}
	  ELSE {
	    Cftb[Cfti] _ ftb[Csgb[Csgi].file];
	    Cftb[Cfti].name _ NewName[namestring, ftb[Csgb[Csgi].file].name];
	    Csgb[Csgi].file _ Cfti;
	    Cfti _ Cfti + BcdDefs.FTRecord.SIZE};
	  Csgi _ Csgi + BcdDefs.SGRecord.SIZE;
	  Cmti _ Cmti + BcdDefs.MTRecord.direct.SIZE;
	  Cbcdbase.nModules _ Cbcdbase.nModules + 1};
			
	IF loadMod.loadInfo = NIL THEN RETURN;
	bcdbase _ loadMod.loadInfo.bcdBase;
	sgb _ LOOPHOLE[bcdbase + bcdbase.sgOffset, BcdDefs.Base];
	ftb _ LOOPHOLE[bcdbase + bcdbase.ftOffset, BcdDefs.Base];
	namestring _ LOOPHOLE[bcdbase + bcdbase.ssOffset];
	[] _ BcdOps.ProcessModules[bcdbase, ForEachModule]};
		
      NewName: PROC[namestring: BcdOps.NameString, oldname: BcdDefs.NameRecord]
	  RETURNS[newname: BcdDefs.NameRecord] ~ {
	newname _ LOOPHOLE[Cnamei];
	Check[(Cnamei + namestring.size[oldname] + 1)/2 + 1, Cbcdbase.ssLimit];
	Cnamestring.size[newname] _ namestring.size[oldname];
	FOR i: CARDINAL IN [0 .. Cnamestring.size[newname]) DO
	  Cnamestring.string.text[newname + i] _ namestring.string.text[oldname + i];
	  ENDLOOP;
	Cnamei _ Cnamei + Cnamestring.size[newname] + 1};
		
      NewString: PROC[oldrope: Rope.Text] RETURNS[newname: BcdDefs.NameRecord] ~ {
	oldstring: LONG STRING _ LOOPHOLE[oldrope];
	newname _ LOOPHOLE[Cnamei];
	Check[(Cnamei + oldstring.length + 1)/2, Cbcdbase.ssLimit];
	Cnamestring.size[newname] _ oldstring.length;
	FOR i: CARDINAL IN [0 .. Cnamestring.size[newname]) DO
	  Cnamestring.string.text[newname + i] _ oldstring[i];
	  ENDLOOP;
	Cnamei _ Cnamei + Cnamestring.size[newname] + 1};
		
      -- traverses the value tree
      ForEachApply: TreeOps.Scan ~ TRUSTED {
	WITH t SELECT FROM
	  node: Tree.Handle => {
	    TreeOps.ScanSons[node, ForEachApply];	-- postorder
	    IF TreeOps.OpName[node] IN Tree.ApplOp THEN
	      WITH SMVal.GetExtFromParse[node] SELECT FROM
		loadMod: SMVal.LoadMod => ProcAnalyze[loadMod];
		ENDCASE;
	    };
	  ENDCASE => NULL;
	};

	{
	map: PilotLoadStateOps.Map;
	IF oldFakeBcdSpace ~= Space.nullHandle THEN {
	  bcdSpace _ oldFakeBcdSpace;	-- assumed mapped
	  fakeBcdFileName _ oldFakeBcdFileName}
	ELSE {
	  cap: File.Capability;
	  bcdSpace _ Space.Create[size~BCDPAGES, parent~Space.virtualMemory];
	  fakeBcdFileName _ GenUniqueBcdName["FakeConfig"];
	  cap _ CS.NewFile[fakeBcdFileName, CS.readWrite, BCDPAGES];
	  bcdSpace.Map[window~[cap, 1]]};
	Cbcdbase _ bcdSpace.LongPointer;
	[] _ SMLoad.Zero[Cbcdbase, BCDPAGES * Environment.wordsPerPage];
	Cbcdbase.versionIdent _ BcdDefs.VersionID;
	Cbcdbase.nPages _ BCDPAGES;
	Cbcdbase.version  _ BcdDefs.NullVersion;
	Cbcdbase.nConfigs _ 1;
	Cbcdbase.nModules _ 0;
	Cbcdbase.extended _ TRUE;	-- to keep the RT happy
	Cbcdbase.nImports _ Cbcdbase.nExports _ 0;
	-- all the Limit vars are set to 0
	Cbcdbase.impOffset _ Cbcdbase.evOffset _ 0;
	Cbcdbase.spOffset _ Cbcdbase.ntOffset _ Cbcdbase.typOffset _ 0;
	Cbcdbase.tmOffset _ Cbcdbase.fpOffset _ 0;
	Cbcdbase.ctOffset _ CTPAGE * Environment.wordsPerPage;
	Cbcdbase.mtOffset _ MTPAGE * Environment.wordsPerPage;
	Cbcdbase.sgOffset _ SGPAGE * Environment.wordsPerPage;
	Cbcdbase.ftOffset _ FTPAGE * Environment.wordsPerPage;
	Cbcdbase.expOffset _ EXPAGE * Environment.wordsPerPage;
	Cbcdbase.ssOffset _ SSPAGE * Environment.wordsPerPage;
	Cnamei _ 0;
	Cctb _ LOOPHOLE[Cbcdbase + Cbcdbase.ctOffset, BcdDefs.Base];
	Cmtb _ LOOPHOLE[Cbcdbase + Cbcdbase.mtOffset, BcdDefs.Base];
	Csgb _ LOOPHOLE[Cbcdbase + Cbcdbase.sgOffset, BcdDefs.Base];
	Cftb _ LOOPHOLE[Cbcdbase + Cbcdbase.ftOffset, BcdDefs.Base];
	Cetb _ LOOPHOLE[Cbcdbase + Cbcdbase.expOffset, BcdDefs.Base];
	Cnamestring _ LOOPHOLE[Cbcdbase + Cbcdbase.ssOffset, BcdDefs.Base];
	Cbcdbase.ctLimit _ BcdDefs.CTIndex.FIRST + BcdDefs.CTRecord.SIZE;
	Cbcdbase.mtLimit _ LOOPHOLE[nmtp * Environment.wordsPerPage];
	Cbcdbase.ftLimit _ LOOPHOLE[nftp * Environment.wordsPerPage];
	Cbcdbase.sgLimit _ LOOPHOLE[nsgp * Environment.wordsPerPage];
	Cbcdbase.expLimit _ LOOPHOLE[nexp * Environment.wordsPerPage];
	Cbcdbase.ssLimit _ LOOPHOLE[nssp * Environment.wordsPerPage];
	LOOPHOLE[Cnamestring+1, LONG POINTER TO CARDINAL]^ _ (Cbcdbase.ssLimit-2)*2;	-- the maxlength of namestring
	Cnamestring.string.length _ Cnamestring.string.maxlength;
	 
	Cctb[BcdDefs.CTIndex.FIRST] _ [
		name~NewString[fakeBcdFileName], namedInstance~FALSE,
		file~BcdDefs.FTSelf, config~BcdDefs.CTNull, 
		nControls~0, controls~];
	
	ForEachApply[root];
	
	Cbcdbase.firstdummy _ Cngfi;	-- # gfi's needed for the modules in the config
	Cbcdbase.mtLimit _ Cmti;
	Cbcdbase.ftLimit _ Cfti;
	Cbcdbase.sgLimit _ Csgi;
	Cbcdbase.expLimit _ Ceti;
	Cbcdbase.ssLimit _ (Cnamei/2)+1;
	
	fakeBcdSpace _ bcdSpace;
	-- now insert the new bcdbase
	-- newer version of BcdOps
	PilotLoadStateOps.UpdateLoadState[configIndex, LOOPHOLE[Cbcdbase]];
	map _ PilotLoadStateOps.GetMap[configIndex];
	-- CedarLinkerOps.Export[LOOPHOLE[Cbcdbase], map];
	PilotLoadStateOps.ReleaseMap[map];
	PilotLoadStateOps.ReleaseLoadState[];
	out.PutF["Total # of gfi's needed to load: %s.\n", IO.card[Cngfi-1]];
	-- this ForceOut is expensive, only need it for debugging
	-- bcdSpace.ForceOut;
	-- out.PutF["Fake bcd written out on %s\n", IO.rope[fakeBcdFileName]];
	};
      }
    };
	
  Check: PROC[val, limit: UNSPECIFIED] ~ {
    IF LOOPHOLE[val, CARDINAL] >= LOOPHOLE[limit, CARDINAL] THEN ERROR};
	
  MTRecordLength: PROC[mth: BcdOps.MTHandle] RETURNS[CARDINAL] ~ {
    RETURN[WITH m~~mth SELECT FROM
      direct => BcdDefs.MTRecord.direct.SIZE + m.length*BcdDefs.Link.SIZE,
      indirect => BcdDefs.MTRecord.indirect.SIZE,
      multiple => BcdDefs.MTRecord.multiple.SIZE,
      ENDCASE => ERROR];
    };
	
  GenUniqueBcdName: SAFE 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;
    };

  }.