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