-- AMModelSectionImpl.mesa
-- Last Modified On December 20, 1982 4:24 pm By Paul Rovner
-- moduleName, configName should not be source name

DIRECTORY
AMBridge USING [TVForGFHReferent, TVForRemoteGFHReferent, GFHFromTV,
RemoteGFHFromTV, GetWorld],
AMModel USING [Class, Source, SourceObj, CharIndex],
AMModelPrivate USING [FGIndex, FGNull, EPI, EPIToFirstFGI, GetModuleSTB,
EPIToLastFGI, FGIToFirstChar, FGIToLastChar, FGIToEPI,
NextFGI, SectionRec, RefTVRec, z, GetLocalBCD, GetRemoteBCD],
AMTypes USING [TVType, Error, TVToName, TV],
BcdDefs USING [MTIndex, NameRecord],
BcdOps USING [BcdBase, MTHandle, ProcessModules, NameString],
Convert USING [ValueToRope],
ConvertUnsafe USING [ToRope],
Environment USING [wordsPerPage],
PilotLoadStateFormat USING [LoadState, LoadStateObject, ConfigIndex],
PilotLoadStateOps USING [ReleaseBcd, InputLoadState, ReleaseLoadState, AcquireBcd,
MapConfigToReal, MapRealToConfig],
PilotLoadStatePrivate USING [InstallLoadState],
PrincOps USING [GFTIndex, GFTNull],
Rope USING [ROPE, Concat],
RTBasic USING [Type],
RTSymbols USING [SymbolTableBase, SymbolTableHandle, AcquireSTB,
ReleaseSTB, AcquireRope, AcquireType, BodyIndex, nullBodyIndex,
rootBodyIndex, FineGrainTableHeader],
RTSymbolsPrivate USING [AcquireBCDFromVersion, ReleaseBCD, GetSTHForModule],
RTTypesPrivate USING [GFT],
RTTypesRemotePrivate USING [AcquireRemoteBCD, GetRemoteGFHandle, GetRemoteGFHeader,
ReleaseRemoteBCD],
Strings USING [SubStringDescriptor, AppendSubString],
Table USING [Base],
TimeStamp USING [Stamp],
WorldVM USING [World, Lock, Unlock, LocalWorld, Loadstate];

AMModelSectionImpl: PROGRAM
IMPORTS AMBridge, AMModelPrivate, AMTypes, BcdOps, Convert, ConvertUnsafe,
PilotLoadStateOps, PilotLoadStatePrivate, Rope, RTSymbols, RTSymbolsPrivate,
RTTypesPrivate, RTTypesRemotePrivate, Strings, WorldVM
EXPORTS AMModel

= { OPEN AMBridge, AMTypes, Environment, Rope, RTBasic, AMModel, AMModelPrivate,
RTSymbols, RTTypesRemotePrivate, WorldVM;


-- TYPEs

-- either binder output bundle for a config, or compiler output bundle
-- for a prog module, DEFs module, proc, or statement
Section: TYPE = REF SectionObj;
SectionObj: PUBLIC TYPE = SectionRec;

-- PROCs dealing with Sections

SectionClass: PUBLIC PROC[section: Section] RETURNS[Class] =
{RETURN[section.class]};

SectionName: PUBLIC PROC[section: Section] RETURNS[ans: ROPE ← NIL] =
{WITH s: section SELECT FROM
model => RETURN[s.configName];
prog => RETURN[s.moduleName];
interface => RETURN[s.moduleName];
proc => IF s.procTV # NIL
THEN RETURN[TVToName[s.procTV]]
ELSE {sth: SymbolTableHandle
= RTSymbolsPrivate.GetSTHForModule
[stamp: s.prog.versionStamp,
fileName: Rope.Concat[s.prog.moduleName, ".bcd"],
moduleName: s.prog.moduleName];
stb: SymbolTableBase ← AcquireSTB[sth];
FindProc: PROC[bti: BodyIndex] RETURNS[stop: BOOLEAN ← FALSE] =
{WITH b: stb.bb[bti] SELECT FROM
Callable => IF ~b.inline AND b.entryIndex = s.entryPointIndex
THEN {ans ← AcquireRope[stb, stb.seb[b.id].hash];
RETURN[TRUE]};
ENDCASE};

IF stb.EnumerateBodies[rootBodyIndex, FindProc
! UNWIND => ReleaseSTB[stb]] = nullBodyIndex
THEN {ReleaseSTB[stb]; ERROR};
ReleaseSTB[stb];
RETURN[ans]}; -- figure it out from the ep# and the prog section
statement => RETURN[Rope.Concat[Rope.Concat[s.prog.moduleName, "."],
Convert.ValueToRope[[unsigned[s.fgtIndex.fgCard]]]]]
ENDCASE => ERROR
};

-- param to creator of section.
SectionSource: PUBLIC PROC[section: Section] RETURNS[ans: Source] =
--param to creator of section
{WITH s: section SELECT FROM
model => { IF s.configContext # NIL
THEN -- loaded model section
{IF s.configContext.world = LocalWorld[]
THEN
{bcd: BcdOps.BcdBase;
[] ← PilotLoadStateOps.InputLoadState[];
bcd ← PilotLoadStateOps.AcquireBcd[s.configContext.configIndex];
ans ← z.NEW[SourceObj ← [fileName: BcdNameToRope
[bcd, bcd.source],
class: model,
versionStamp: bcd.sourceVersion,
sourceRange: entire[]]];
PilotLoadStateOps.ReleaseBcd[bcd];
PilotLoadStateOps.ReleaseLoadState[];
RETURN}
ELSE
{bcd: BcdOps.BcdBase;
world: World = s.configContext.world;

Lock[world];
{ ENABLE UNWIND => Unlock[world];
oldState: PilotLoadStateFormat.LoadState;
newState: REF PilotLoadStateFormat.LoadStateObject;
loadStateHeld: BOOL ← FALSE;

newState ← Loadstate[world];
[] ← PilotLoadStateOps.InputLoadState[];
loadStateHeld ← TRUE;
oldState ← PilotLoadStatePrivate.InstallLoadState[LOOPHOLE[newState]];
-- no error raised

bcd ← AcquireRemoteBCD[world: world,
bcd: PilotLoadStateOps.AcquireBcd
[s.configContext.configIndex]
! ANY => {[] ← PilotLoadStatePrivate.InstallLoadState
[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadStateHeld ← FALSE;
}];
IF loadStateHeld
THEN {[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[]};
IF bcd = NIL
THEN ERROR AMTypes.Error[reason: noSymbols];
ans ← z.NEW[SourceObj ← [fileName: BcdNameToRope
[bcd, bcd.source],
class: model,
versionStamp: bcd.sourceVersion,
sourceRange: entire[]]];
ReleaseRemoteBCD[bcd];
}; -- end ENABLE UNWIND => Unlock[world];
Unlock[world];
RETURN;
}
}
ELSE { -- model section, not loaded. Get the binder output bcd, given the
-- config name and its version stamp
bcd: BcdOps.BcdBase
= RTSymbolsPrivate.AcquireBCDFromVersion
[versionStamp: s.versionStamp,
shortFileNameHint: Rope.Concat[s.configName,
".bcd"]];
IF bcd = NIL THEN ERROR AMTypes.Error[reason: noSymbols];
ans ← z.NEW[SourceObj ← [fileName: BcdNameToRope[bcd, bcd.source],
class: model,
versionStamp: bcd.sourceVersion,
sourceRange: entire[]]];
RTSymbolsPrivate.ReleaseBCD[bcd];
}};
prog =>
{ -- get the compiler output bcd, given the module name and
-- its version stamp. Could poke around in the loadstate, but painful.
IF s.someGFHTV = NIL
THEN -- unloaded prog section
{bcd: BcdOps.BcdBase = RTSymbolsPrivate.AcquireBCDFromVersion
[versionStamp: s.versionStamp,
shortFileNameHint: Rope.Concat[s.moduleName,
".bcd"]];
IF bcd = NIL THEN ERROR AMTypes.Error[reason: noSymbols];
ans ← z.NEW[SourceObj ← [fileName: BcdNameToRope[bcd, bcd.source],
class: prog,
versionStamp: bcd.sourceVersion,
sourceRange: entire[]]];
RTSymbolsPrivate.ReleaseBCD[bcd]}
ELSE -- loaded prog section; get the bcd from the loadstate
{ptv: TV = s.someGFHTV;
world: World ← GetWorld[ptv];
IF world = LocalWorld[]
THEN
{bcd: BcdOps.BcdBase = GetLocalBCD[rgfi: GFHFromTV[ptv].gfi];
stb: SymbolTableBase ← GetModuleSTB[bcd, s.versionStamp];
{ ENABLE UNWIND => ReleaseSTB[stb];
ns: LONG STRING
= @LOOPHOLE
[stb.stHandle
+ stb.stHandle.fgRelPgBase*wordsPerPage,
LONG POINTER TO FineGrainTableHeader].sourceFile;
ans ← z.NEW[SourceObj ← [fileName: ConvertUnsafe.ToRope[ns],
class: prog,
versionStamp: stb.stHandle.sourceVersion,
sourceRange: entire[]]];
}; -- end ENABLE UNWIND => ReleaseSTB[stb]
ReleaseSTB[stb];
}
ELSE -- remote world
{bcd: BcdOps.BcdBase
← GetRemoteBCD[world: world,
rgfi: GetRemoteGFHeader
[RemoteGFHFromTV[ptv]].gfi];
{ ENABLE UNWIND => ReleaseRemoteBCD[bcd];
stb: SymbolTableBase ← GetModuleSTB[bcd, s.versionStamp];
{ ENABLE UNWIND => ReleaseSTB[stb];
ns: LONG STRING
= @LOOPHOLE
[stb.stHandle
+ stb.stHandle.fgRelPgBase*wordsPerPage,
LONG POINTER TO FineGrainTableHeader].sourceFile;
ans ← z.NEW[SourceObj ← [fileName: ConvertUnsafe.ToRope[ns],
class: prog,
versionStamp: stb.stHandle.sourceVersion,
sourceRange: entire[]]];
}; -- end ENABLE UNWIND => ReleaseSTB[stb]
ReleaseSTB[stb];
}; -- end ENABLE UNWIND => ... FREE[@bcd];
ReleaseRemoteBCD[bcd];
}
};
};
interface =>
{ -- get the compiler output bcd, given the module name and its version stamp.
bcd: BcdOps.BcdBase = RTSymbolsPrivate.AcquireBCDFromVersion
[versionStamp: s.versionStamp,
shortFileNameHint: Rope.Concat[s.moduleName,
".bcd"]];
IF bcd = NIL THEN ERROR AMTypes.Error[reason: noSymbols];
ans ← z.NEW[SourceObj ← [fileName: BcdNameToRope[bcd, bcd.source],
class: prog,
versionStamp: bcd.sourceVersion,
sourceRange: entire[]]];
RTSymbolsPrivate.ReleaseBCD[bcd];
};
proc =>
{ IF s.prog.someGFHTV = NIL
THEN -- unloaded proc section
{bcd: BcdOps.BcdBase = RTSymbolsPrivate.AcquireBCDFromVersion
[versionStamp: s.prog.versionStamp,
shortFileNameHint: Rope.Concat[s.prog.moduleName,
".bcd"]];
IF bcd = NIL THEN ERROR AMTypes.Error[reason: noSymbols];
ans ← z.NEW[SourceObj
← [fileName: BcdNameToRope[bcd, bcd.source],
class: proc,
versionStamp: bcd.sourceVersion,
sourceRange:
field[firstCharIndex: ProcToFirstCI[NARROW[section]],
lastCharIndex:
ProcToLastCI[NARROW[section]]]]];
RTSymbolsPrivate.ReleaseBCD[bcd]}
ELSE -- loaded proc section; get the bcd from the loadstate
{ptv: TV = s.prog.someGFHTV;
world: World ← GetWorld[ptv];
IF world = LocalWorld[]
THEN
{bcd: BcdOps.BcdBase = GetLocalBCD[rgfi: GFHFromTV[ptv].gfi];
stb: SymbolTableBase ← GetModuleSTB[bcd, s.prog.versionStamp];
{ ENABLE UNWIND => ReleaseSTB[stb];
ns: LONG STRING
= @LOOPHOLE
[stb.stHandle
+ stb.stHandle.fgRelPgBase*wordsPerPage,
LONG POINTER TO FineGrainTableHeader].sourceFile;
ans ← z.NEW[SourceObj
← [fileName: ConvertUnsafe.ToRope[ns],
class: proc,
versionStamp: stb.stHandle.sourceVersion,
sourceRange:
field[firstCharIndex: ProcToFirstCI[NARROW[section]],
lastCharIndex:
ProcToLastCI[NARROW[section]]]]];
}; -- end ENABLE UNWIND => ReleaseSTB[stb]
ReleaseSTB[stb];
}
ELSE -- remote world
{bcd: BcdOps.BcdBase
← GetRemoteBCD[world: world,
rgfi: GetRemoteGFHeader
[RemoteGFHFromTV[ptv]].gfi];
{ ENABLE UNWIND => ReleaseRemoteBCD[bcd];
stb: SymbolTableBase ← GetModuleSTB[bcd, s.prog.versionStamp];
{ ENABLE UNWIND => ReleaseSTB[stb];
ns: LONG STRING
= @LOOPHOLE
[stb.stHandle
+ stb.stHandle.fgRelPgBase*wordsPerPage,
LONG POINTER TO FineGrainTableHeader].sourceFile;
ans ← z.NEW[SourceObj
← [fileName: ConvertUnsafe.ToRope[ns],
class: proc,
versionStamp: stb.stHandle.sourceVersion,
sourceRange:
field[firstCharIndex: ProcToFirstCI[NARROW[section]],
lastCharIndex:
ProcToLastCI[NARROW[section]]]]];
}; -- end ENABLE UNWIND => ReleaseSTB[stb]
ReleaseSTB[stb];
}; -- end ENABLE UNWIND => ... FREE[@bcd];
ReleaseRemoteBCD[bcd];
}
};
};

statement =>
{ IF s.prog.someGFHTV = NIL
THEN -- unloaded proc section
{bcd: BcdOps.BcdBase = RTSymbolsPrivate.AcquireBCDFromVersion
[versionStamp: s.prog.versionStamp,
shortFileNameHint: Rope.Concat[s.prog.moduleName,
".bcd"]];
fci, lci: INT;
IF bcd = NIL THEN ERROR AMTypes.Error[reason: noSymbols];
fci ← StatementToFirstCI[NARROW[section]];
lci ← StatementToLastCI[NARROW[section]];
IF fci = lci THEN lci ← fci-1;
ans ← z.NEW[SourceObj
← [fileName: BcdNameToRope[bcd, bcd.source],
class: statement,
versionStamp: bcd.sourceVersion,
sourceRange:
field[firstCharIndex: fci,
lastCharIndex: lci]]];
RTSymbolsPrivate.ReleaseBCD[bcd]}
ELSE -- loaded proc section; get the bcd from the loadstate
{ptv: TV = s.prog.someGFHTV;
world: World ← GetWorld[ptv];
IF world = LocalWorld[]
THEN
{bcd: BcdOps.BcdBase = GetLocalBCD[rgfi: GFHFromTV[ptv].gfi];
stb: SymbolTableBase ← GetModuleSTB[bcd, s.prog.versionStamp];
{ ENABLE UNWIND => ReleaseSTB[stb];
ns: LONG STRING
= @LOOPHOLE
[stb.stHandle
+ stb.stHandle.fgRelPgBase*wordsPerPage,
LONG POINTER TO FineGrainTableHeader].sourceFile;
fci, lci: INT;
fci ← StatementToFirstCI[NARROW[section]];
lci ← StatementToLastCI[NARROW[section]];
IF fci = lci THEN lci ← fci-1;
ans ← z.NEW[SourceObj
← [fileName: ConvertUnsafe.ToRope[ns],
class: statement,
versionStamp: stb.stHandle.sourceVersion,
sourceRange:
field[firstCharIndex: fci,
lastCharIndex: lci]]];
}; -- end ENABLE UNWIND => ReleaseSTB[stb]
ReleaseSTB[stb];
}
ELSE -- remote world
{bcd: BcdOps.BcdBase
← GetRemoteBCD[world: world,
rgfi: GetRemoteGFHeader
[RemoteGFHFromTV[ptv]].gfi];
{ ENABLE UNWIND => ReleaseRemoteBCD[bcd];
stb: SymbolTableBase ← GetModuleSTB[bcd, s.prog.versionStamp];
{ ENABLE UNWIND => ReleaseSTB[stb];
ns: LONG STRING
= @LOOPHOLE
[stb.stHandle
+ stb.stHandle.fgRelPgBase*wordsPerPage,
LONG POINTER TO FineGrainTableHeader].sourceFile;
fci, lci: INT;
fci ← StatementToFirstCI[NARROW[section]];
lci ← StatementToLastCI[NARROW[section]];
IF fci = lci THEN lci ← fci-1;
ans ← z.NEW[SourceObj
← [fileName: ConvertUnsafe.ToRope[ns],
class: statement,
versionStamp: stb.stHandle.sourceVersion,
sourceRange:
field[firstCharIndex: fci,
lastCharIndex: lci]]];
}; -- end ENABLE UNWIND => ReleaseSTB[stb]
ReleaseSTB[stb];
}; -- end ENABLE UNWIND => ... FREE[@bcd];
ReleaseRemoteBCD[bcd];
}
};
};
ENDCASE => ERROR
}; -- end SectionSource

-- param to creator of section.
-- (DIRECTORY entries)
-- Implemented only for model, prog and interface sections
SectionParams: PUBLIC PROC[section: Section] RETURNS[list: LIST OF Type ← NIL] =
--ditto (DIRECTORY entries)
{WITH s: section SELECT FROM
model => ERROR; --NOTE enumerate the directory entries;
prog => ERROR; --NOTE enumerate the directory entries;
interface => ERROR; --NOTE enumerate the directory entries;
proc => ERROR AMTypes.Error[reason: notImplemented];
statement => ERROR AMTypes.Error[reason: notImplemented];
ENDCASE => ERROR
};

-- containers:
-- prog module for a proc
-- proc for a statement
ParentSection: PUBLIC PROC[section: Section] RETURNS[Section] =
{WITH s: section SELECT FROM
proc => RETURN[s.prog];
statement => RETURN[z.NEW[SectionObj ← [proc[prog: s.prog,
entryPointIndex:
StatementToParentEPI
[NARROW[section]]
]
]]];
ENDCASE => ERROR AMTypes.Error[reason: notImplemented];
}; -- end ParentSections

-- parts: modules of a model, procs of a module, statements of a proc
SectionChildren: PUBLIC PROC[section: Section, proc: PROC[Section] RETURNS[stop: BOOL]]
RETURNS[ans: Section ← NIL--NIL if not stopped--] =
{x: INT ← 0;
NextSection: PROC[parent, child: Section] RETURNS[s: Section ← NIL] =
{[s, x] ← NextSiblingSection[parent: parent, child: child, indexInParent: x]};

FOR s: Section ← FirstChildSection[section], NextSection[section, s]
UNTIL s = NIL DO IF proc[s] THEN RETURN[s]; ENDLOOP;
};

-- parts: modules of a model, procs of a module, statements of a proc
FirstChildSection: PROC[section: Section] RETURNS[ans: Section] =
{WITH s: section SELECT FROM
model => IF s.configContext # NIL
THEN
{IF s.configContext.world = LocalWorld[]
THEN -- section has a local configContext
{bcd: BcdOps.BcdBase;
ftb: Table.Base;
mth: BcdOps.MTHandle;
p: PROC [mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
RETURNS [BOOLEAN] = {RETURN[TRUE]};

[] ← PilotLoadStateOps.InputLoadState[];
bcd ← PilotLoadStateOps.AcquireBcd[s.configContext.configIndex];
IF bcd = NIL
THEN {PilotLoadStateOps.ReleaseBcd[bcd];
PilotLoadStateOps.ReleaseLoadState[];
ERROR AMTypes.Error[reason: noSymbols]};
ftb ← LOOPHOLE[bcd + bcd.ftOffset];
mth ← BcdOps.ProcessModules[bcd, p].mth;
ans ← z.NEW
[SectionObj
← [prog[moduleName: BcdNameToRope[bcd, mth.name],
versionStamp: ftb[mth.file].version,
someGFHTV:
NARROW
[TVForGFHReferent
[RTTypesPrivate.GFT
[PilotLoadStateOps.MapConfigToReal
[mth.gfi,
s.configContext.configIndex
]
].frame
]]
]
]
];
PilotLoadStateOps.ReleaseBcd[bcd];
PilotLoadStateOps.ReleaseLoadState[];
RETURN;
}
ELSE -- section has a remote configContext
{bcd: BcdOps.BcdBase;
ftb: Table.Base;
mth: BcdOps.MTHandle;
world: World = s.configContext.world;

Lock[world];
{ ENABLE UNWIND => Unlock[world];
oldState: PilotLoadStateFormat.LoadState;
newState: REF PilotLoadStateFormat.LoadStateObject;
loadStateHeld: BOOL ← FALSE;

p: PROC [mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
RETURNS [BOOLEAN] = {RETURN[TRUE]};

newState ← Loadstate[world];
[] ← PilotLoadStateOps.InputLoadState[];
loadStateHeld ← TRUE;
oldState ← PilotLoadStatePrivate.InstallLoadState[LOOPHOLE[newState]];
-- no error raised

bcd ← AcquireRemoteBCD[world: world,
bcd: PilotLoadStateOps.AcquireBcd
[s.configContext.configIndex]
! ANY => {[] ← PilotLoadStatePrivate.InstallLoadState
[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadStateHeld ← FALSE;
}];
IF loadStateHeld
THEN {[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[]};
IF bcd = NIL
THEN ERROR AMTypes.Error[reason: noSymbols];
ftb ← LOOPHOLE[bcd + bcd.ftOffset];
mth ← BcdOps.ProcessModules[bcd, p].mth;
ans ← z.NEW
[SectionObj
← [prog[moduleName: BcdNameToRope[bcd, mth.name],
versionStamp: ftb[mth.file].version,
someGFHTV:
NARROW
[TVForRemoteGFHReferent
[GetRemoteGFHandle
[world: s.configContext.world,
gfi: PilotLoadStateOps.MapConfigToReal
[mth.gfi,
s.configContext.configIndex
]
]
]]

]
]
];
ReleaseRemoteBCD[bcd];
}; -- end ENABLE UNWIND => Unlock[world];
Unlock[world];
RETURN;
}
}
ELSE -- here if model section is not loaded
{ -- get the binder output bcd, given the config name and
-- its version stamp
bcd: BcdOps.BcdBase
= RTSymbolsPrivate.AcquireBCDFromVersion
[versionStamp: s.versionStamp,
shortFileNameHint: Rope.Concat[s.configName,
".bcd"]];
ftb: Table.Base;
mth: BcdOps.MTHandle;
p: PROC [mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
RETURNS [BOOLEAN] = {RETURN[TRUE]};

IF bcd = NIL THEN ERROR AMTypes.Error[reason: noSymbols];
ftb ← LOOPHOLE[bcd + bcd.ftOffset];

mth ← BcdOps.ProcessModules[bcd, p].mth;
ans ← z.NEW[SectionObj ← [prog[moduleName: BcdNameToRope
[bcd, mth.name],
versionStamp: ftb[mth.file].version,
someGFHTV: NIL
]
]
];
RTSymbolsPrivate.ReleaseBCD[bcd];
};
prog => RETURN[z.NEW[SectionObj ← [proc[prog: NARROW[section, REF prog SectionObj],
entryPointIndex: 0]]]]; --ep# wizardry: StartProc.
interface => RETURN[NIL];

proc => RETURN[z.NEW[SectionObj ← [statement[prog: s.prog,
fgtIndex: ProcToFirstFGI
[NARROW[section]]]]]];

statement => RETURN[NIL];
ENDCASE => ERROR
}; -- end FirstChildSection

-- parts: modules of a model, procs of a module, statements of a proc
-- NextSiblingSection will never get a child that represents a loadstate entry
-- for children that are progs, indexInParent # 0 means use it to pass over previous modules
-- returns NIL if nomore
NextSiblingSection: PROC[parent, child: Section, indexInParent: INT ← 0]
RETURNS[ans: Section ← NIL, newIndexInParent: INT ← 0] =
{IF parent = NIL THEN RETURN[NIL];
WITH s: child SELECT FROM
model => ERROR AMTypes.Error[reason: notImplemented];
prog =>
{ bcd: BcdOps.BcdBase;
mth: BcdOps.MTHandle ← NIL;
lastWasOldChild: BOOL ← FALSE;
duplicateModules: BOOL ← FALSE;
ftb: Table.Base ← NIL;
p: REF model SectionObj = NARROW[parent];

FindNextModule: PROC[mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
RETURNS [stop: BOOL ← FALSE] =
{newIndexInParent ← newIndexInParent + 1;
IF lastWasOldChild THEN RETURN[TRUE];
IF (indexInParent = 0 OR newIndexInParent >= indexInParent)
AND s.versionStamp = ftb[mth.file].version
THEN lastWasOldChild ← TRUE};

IF s.someGFHTV # NIL
THEN -- the sections are loaded
{ world: World = GetWorld[s.someGFHTV];
IF world = LocalWorld[]
THEN {config: PilotLoadStateFormat.ConfigIndex;
rgfi: PrincOps.GFTIndex ← PrincOps.GFTNull;
[] ← PilotLoadStateOps.InputLoadState[];
config ← PilotLoadStateOps.MapRealToConfig
[GFHFromTV[s.someGFHTV].gfi].config;
bcd ← PilotLoadStateOps.AcquireBcd[config];
ftb ← LOOPHOLE[bcd + bcd.ftOffset];
mth ← BcdOps.ProcessModules[bcd, FindNextModule].mth;
IF mth # NIL
THEN rgfi ← PilotLoadStateOps.MapConfigToReal[mth.gfi, config];
PilotLoadStateOps.ReleaseLoadState[];
IF mth # NIL
THEN
ans ← z.NEW
[SectionObj
← [prog[moduleName: BcdNameToRope[bcd, mth.name],
versionStamp: ftb[mth.file].version,
someGFHTV:
NARROW[TVForGFHReferent
[RTTypesPrivate.GFT[rgfi].frame]]
]
]
];
}
ELSE -- NextSiblingSection, prog child, the sections are loaded, remote world
{ Lock[world];
{ ENABLE UNWIND => Unlock[world];
config: PilotLoadStateFormat.ConfigIndex;
rgfi: PrincOps.GFTIndex ← PrincOps.GFTNull;
oldState: PilotLoadStateFormat.LoadState;
newState: REF PilotLoadStateFormat.LoadStateObject;
loadstateHeld: BOOL ← FALSE;

newState ← Loadstate[world];
[] ← PilotLoadStateOps.InputLoadState[];
loadstateHeld ← TRUE;
oldState ← PilotLoadStatePrivate.InstallLoadState[LOOPHOLE[newState]];
-- no error raised
{ ENABLE ANY => IF loadstateHeld
THEN {[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadstateHeld ← FALSE};
config ← PilotLoadStateOps.MapRealToConfig
[GetRemoteGFHeader
[RemoteGFHFromTV
[s.someGFHTV]].gfi].config;
IF NOT loadstateHeld THEN ERROR;
bcd ← AcquireRemoteBCD[world, PilotLoadStateOps.AcquireBcd[config]];
IF bcd = NIL THEN ERROR;
{ ENABLE UNWIND => ReleaseRemoteBCD[bcd];
ftb ← LOOPHOLE[bcd + bcd.ftOffset];
mth ← BcdOps.ProcessModules[bcd, FindNextModule].mth;
IF NOT loadstateHeld THEN ERROR;
IF mth # NIL
THEN rgfi ← PilotLoadStateOps.MapConfigToReal[mth.gfi, config];
IF loadstateHeld
THEN {[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadstateHeld ← FALSE};
IF mth # NIL
THEN
ans ← z.NEW
[SectionObj
← [prog[moduleName: BcdNameToRope[bcd, mth.name],
versionStamp: ftb[mth.file].version,
someGFHTV:
NARROW
[TVForRemoteGFHReferent
[GetRemoteGFHandle[world, rgfi]]]
]
]
];
}; -- end ENABLE UNWIND => ... FREE bcd ...
ReleaseRemoteBCD[bcd];
}; -- end ENABLE ANY ... ReleaseLoadState
}; -- end ENABLE UNWIND => Unlock[world];
Unlock[world];
}; -- end ELSE arm (remote world)
} -- end case where the sections are loaded
ELSE -- NextSiblingSection, prog child, not loaded
{ -- get the binder output bcd, given the config name and version stamp
bcd ← RTSymbolsPrivate.AcquireBCDFromVersion
[versionStamp: p.versionStamp,
shortFileNameHint: Rope.Concat[p.configName,
".bcd"]];
IF bcd = NIL THEN ERROR AMTypes.Error[reason: noSymbols];
ftb ← LOOPHOLE[bcd + bcd.ftOffset];
mth ← BcdOps.ProcessModules[bcd, FindNextModule].mth;
IF mth # NIL
THEN ans ← z.NEW[SectionObj
← [prog[moduleName: BcdNameToRope[bcd, mth.name],
versionStamp: ftb[mth.file].version,
someGFHTV: NIL -- not loaded
]
]
];
RTSymbolsPrivate.ReleaseBCD[bcd];
}}; -- end prog child case of NextSiblingSection
interface => ERROR AMTypes.Error[reason: notImplemented];
proc => {sth: SymbolTableHandle
= RTSymbolsPrivate.GetSTHForModule
[stamp: s.prog.versionStamp,
fileName: Rope.Concat[s.prog.moduleName, ".bcd"],
moduleName: s.prog.moduleName];
stb: SymbolTableBase ← AcquireSTB[sth];
maxEI: EPI ← 0;
GetMax: PROC [bti: BodyIndex] RETURNS [stop: BOOLEAN ← FALSE] =
{WITH stb.bb[bti] SELECT FROM
Callable => IF ~inline THEN maxEI ← MAX[maxEI, entryIndex];
ENDCASE};
[] ← stb.EnumerateBodies[rootBodyIndex, GetMax];
IF s.entryPointIndex = maxEI
THEN ans ← NIL
ELSE ans ← z.NEW[SectionObj ←
[proc[prog: NARROW[parent, REF prog SectionObj],
entryPointIndex: s.entryPointIndex + 1]]];
ReleaseSTB[stb]}; -- end proc child case of NextSiblingSection
statement => {nextFGI: FGIndex = NextStatementFGI[NARROW
[child,
REF statement SectionObj]];
IF nextFGI = FGNull
THEN RETURN[NIL]
ELSE RETURN[z.NEW[SectionObj ←
[statement[prog: NARROW[parent,
REF proc SectionObj].prog,
fgtIndex: nextFGI
]]]];
}; -- end statement child case of NextSiblingSection
ENDCASE => ERROR
}; -- end NextSiblingSection


-- Implemented only for proc sections
SectionType: PUBLIC PROC[section: Section] RETURNS[--procedure--type: Type] =
{WITH s: section SELECT FROM
model => ERROR AMTypes.Error[reason: notImplemented];
prog => ERROR AMTypes.Error[reason: notImplemented];
interface => ERROR AMTypes.Error[reason: notImplemented];
proc => IF s.procTV = NIL
THEN {sth: SymbolTableHandle
= RTSymbolsPrivate.GetSTHForModule
[stamp: s.prog.versionStamp,
fileName: Rope.Concat[s.prog.moduleName, ".bcd"],
moduleName: s.prog.moduleName];
stb: SymbolTableBase ← AcquireSTB[sth];
FindProc: PROC[bti: BodyIndex] RETURNS[stop: BOOLEAN ← FALSE] =
{WITH b: stb.bb[bti] SELECT FROM
Callable => IF ~b.inline AND b.entryIndex = s.entryPointIndex
THEN {type ← AcquireType[stb, b.ioType];
RETURN[TRUE]};
ENDCASE};

IF stb.EnumerateBodies[rootBodyIndex, FindProc
! UNWIND => ReleaseSTB[stb]] = nullBodyIndex
THEN {ReleaseSTB[stb]; ERROR};
ReleaseSTB[stb];
RETURN[type]} -- figure it out from the ep# and the prog section
ELSE RETURN[TVType[s.procTV]];
statement => ERROR AMTypes.Error[reason: notImplemented];
ENDCASE => ERROR
};


SectionVersion: PUBLIC PROC[section: Section] RETURNS[TimeStamp.Stamp] =
{WITH s: section SELECT FROM
model => RETURN[s.versionStamp];
prog => RETURN[s.versionStamp];
interface => RETURN[s.versionStamp];
proc => RETURN[s.prog.versionStamp];
statement => RETURN[s.prog.versionStamp];
ENDCASE => ERROR;
};

-- Private Procedures

BcdNameToRope: PROC[bcd: BcdOps.BcdBase, n: BcdDefs.NameRecord] RETURNS[ROPE] =
{nameString: STRING = [100];
ssb: BcdOps.NameString = LOOPHOLE[bcd + bcd.ssOffset];
ssd: Strings.SubStringDescriptor ← [base: @ssb.string,
offset: n,
length: MIN[ssb.size[n], 100]];
nameString.length ← 0;
Strings.AppendSubString[nameString, @ssd];
RETURN[ConvertUnsafe.ToRope[LONG[nameString]]]};

-- [prog module bcd, entryPointIndex] => CharIndex
ProcToFirstCI: PROC[proc: REF proc SectionObj] RETURNS[ans: CharIndex ← 0] =
{localBCD: BOOL ← FALSE;
remoteBCD: BOOL ← FALSE;
versionBCD: BOOL ← FALSE;
bcd: BcdOps.BcdBase;
ptv: TV = proc.prog.someGFHTV;
stb: SymbolTableBase;
IF ptv = NIL -- proc not loaded
THEN {bcd ← RTSymbolsPrivate.AcquireBCDFromVersion
[versionStamp: proc.prog.versionStamp,
shortFileNameHint:
Rope.Concat[proc.prog.moduleName,
".bcd"]];
versionBCD ← TRUE}
ELSE IF GetWorld[ptv] = LocalWorld[]
THEN {bcd ← GetLocalBCD[rgfi: GFHFromTV[ptv].gfi];
localBCD ← TRUE}
ELSE { bcd ← GetRemoteBCD[world: GetWorld[ptv],
rgfi: GetRemoteGFHeader[RemoteGFHFromTV[ptv]].gfi];
remoteBCD ← TRUE};
{ ENABLE UNWIND => IF versionBCD
THEN RTSymbolsPrivate.ReleaseBCD[bcd]
ELSE IF remoteBCD THEN ReleaseRemoteBCD[bcd];
stb ← GetModuleSTB[bcd, proc.prog.versionStamp];
}; -- end ENABLE UNWIND => RTSymbolsPrivate.ReleaseBCD[bcd];
{ ENABLE UNWIND => ReleaseSTB[stb];
IF versionBCD
THEN RTSymbolsPrivate.ReleaseBCD[bcd]
ELSE IF remoteBCD THEN ReleaseRemoteBCD[bcd];
ans ← FGIToFirstChar[stb, EPIToFirstFGI[stb, proc.entryPointIndex]];
}; -- end ENABLE UNWIND => ReleaseSTB[stb];
ReleaseSTB[stb];
};

-- [prog module bcd, entryPointIndex] => CharIndex
ProcToLastCI: PROC[proc: REF proc SectionObj] RETURNS[ans: CharIndex ← 0] =
{localBCD: BOOL ← FALSE;
remoteBCD: BOOL ← FALSE;
versionBCD: BOOL ← FALSE;
bcd: BcdOps.BcdBase;
ptv: TV = proc.prog.someGFHTV;
stb: SymbolTableBase;
IF ptv = NIL -- proc not loaded
THEN {bcd ← RTSymbolsPrivate.AcquireBCDFromVersion
[versionStamp: proc.prog.versionStamp,
shortFileNameHint:
Rope.Concat[proc.prog.moduleName,
".bcd"]];
versionBCD ← TRUE}
ELSE IF GetWorld[ptv] = LocalWorld[]
THEN {bcd ← GetLocalBCD[rgfi: GFHFromTV[ptv].gfi];
localBCD ← TRUE}
ELSE { bcd ← GetRemoteBCD[world: GetWorld[ptv],
rgfi: GetRemoteGFHeader[RemoteGFHFromTV[ptv]].gfi];
remoteBCD ← TRUE};
{ ENABLE UNWIND => IF versionBCD
THEN RTSymbolsPrivate.ReleaseBCD[bcd]
ELSE IF remoteBCD THEN ReleaseRemoteBCD[bcd];
stb ← GetModuleSTB[bcd, proc.prog.versionStamp];
}; -- end ENABLE UNWIND => RTSymbolsPrivate.ReleaseBCD[bcd];
{ ENABLE UNWIND => ReleaseSTB[stb];
IF versionBCD
THEN RTSymbolsPrivate.ReleaseBCD[bcd]
ELSE IF remoteBCD THEN ReleaseRemoteBCD[bcd];
ans ← FGIToLastChar[stb, EPIToLastFGI[stb, proc.entryPointIndex]];
}; -- end ENABLE UNWIND => ReleaseSTB[stb];
ReleaseSTB[stb];
};

-- [prog module bcd, FGIndex] => CharIndex
StatementToFirstCI: PROC[statement: REF statement SectionObj] RETURNS[ans: CharIndex ← 0] =
{localBCD: BOOL ← FALSE;
remoteBCD: BOOL ← FALSE;
versionBCD: BOOL ← FALSE;
bcd: BcdOps.BcdBase;
ptv: TV = statement.prog.someGFHTV;
stb: SymbolTableBase;
IF ptv = NIL -- statement not loaded
THEN {bcd ← RTSymbolsPrivate.AcquireBCDFromVersion
[versionStamp: statement.prog.versionStamp,
shortFileNameHint:
Rope.Concat[statement.prog.moduleName,
".bcd"]];
versionBCD ← TRUE}
ELSE IF GetWorld[ptv] = LocalWorld[]
THEN {bcd ← GetLocalBCD[rgfi: GFHFromTV[ptv].gfi];
localBCD ← TRUE}
ELSE { bcd ← GetRemoteBCD[world: GetWorld[ptv],
rgfi: GetRemoteGFHeader[RemoteGFHFromTV[ptv]].gfi];
remoteBCD ← TRUE};
{ ENABLE UNWIND => IF versionBCD
THEN RTSymbolsPrivate.ReleaseBCD[bcd]
ELSE IF remoteBCD THEN ReleaseRemoteBCD[bcd];
stb ← GetModuleSTB[bcd, statement.prog.versionStamp];
}; -- end ENABLE UNWIND => RTSymbolsPrivate.ReleaseBCD[bcd];
{ ENABLE UNWIND => ReleaseSTB[stb];
IF versionBCD
THEN RTSymbolsPrivate.ReleaseBCD[bcd]
ELSE IF remoteBCD THEN ReleaseRemoteBCD[bcd];
ans ← FGIToFirstChar[stb, statement.fgtIndex];
}; -- end ENABLE UNWIND => ReleaseSTB[stb];
ReleaseSTB[stb];
};

-- [prog module bcd, FGIndex] => CharIndex
StatementToLastCI: PROC[statement: REF statement SectionObj] RETURNS[ans: CharIndex ← 0] =
{localBCD: BOOL ← FALSE;
remoteBCD: BOOL ← FALSE;
versionBCD: BOOL ← FALSE;
bcd: BcdOps.BcdBase;
ptv: TV = statement.prog.someGFHTV;
stb: SymbolTableBase;
IF ptv = NIL -- statement not loaded
THEN {bcd ← RTSymbolsPrivate.AcquireBCDFromVersion
[versionStamp: statement.prog.versionStamp,
shortFileNameHint:
Rope.Concat[statement.prog.moduleName,
".bcd"]];
versionBCD ← TRUE}
ELSE IF GetWorld[ptv] = LocalWorld[]
THEN {bcd ← GetLocalBCD[rgfi: GFHFromTV[ptv].gfi];
localBCD ← TRUE}
ELSE { bcd ← GetRemoteBCD[world: GetWorld[ptv],
rgfi: GetRemoteGFHeader[RemoteGFHFromTV[ptv]].gfi];
remoteBCD ← TRUE};
{ ENABLE UNWIND => IF versionBCD
THEN RTSymbolsPrivate.ReleaseBCD[bcd]
ELSE IF remoteBCD THEN ReleaseRemoteBCD[bcd];
stb ← GetModuleSTB[bcd, statement.prog.versionStamp];
}; -- end ENABLE UNWIND => RTSymbolsPrivate.ReleaseBCD[bcd];
{ ENABLE UNWIND => ReleaseSTB[stb];
IF versionBCD
THEN RTSymbolsPrivate.ReleaseBCD[bcd]
ELSE IF remoteBCD THEN ReleaseRemoteBCD[bcd];
ans ← FGIToLastChar[stb, statement.fgtIndex];
}; -- end ENABLE UNWIND => ReleaseSTB[stb];
ReleaseSTB[stb];
};

-- [prog module bcd, FGIndex] => entryPointIndex (maybe 0)
StatementToParentEPI: PROC[statement: REF statement SectionObj] RETURNS[ans: EPI ← 0] =
{localBCD: BOOL ← FALSE;
remoteBCD: BOOL ← FALSE;
versionBCD: BOOL ← FALSE;
bcd: BcdOps.BcdBase;
ptv: TV = statement.prog.someGFHTV;
stb: SymbolTableBase;
IF ptv = NIL -- statement not loaded
THEN {bcd ← RTSymbolsPrivate.AcquireBCDFromVersion
[versionStamp: statement.prog.versionStamp,
shortFileNameHint:
Rope.Concat[statement.prog.moduleName,
".bcd"]];
versionBCD ← TRUE}
ELSE IF GetWorld[ptv] = LocalWorld[]
THEN {bcd ← GetLocalBCD[rgfi: GFHFromTV[ptv].gfi];
localBCD ← TRUE}
ELSE { bcd ← GetRemoteBCD[world: GetWorld[ptv],
rgfi: GetRemoteGFHeader[RemoteGFHFromTV[ptv]].gfi];
remoteBCD ← TRUE};
{ ENABLE UNWIND => IF versionBCD
THEN RTSymbolsPrivate.ReleaseBCD[bcd]
ELSE IF remoteBCD THEN ReleaseRemoteBCD[bcd];
stb ← GetModuleSTB[bcd, statement.prog.versionStamp];
}; -- end ENABLE UNWIND => RTSymbolsPrivate.ReleaseBCD[bcd];
{ ENABLE UNWIND => ReleaseSTB[stb];
IF versionBCD
THEN RTSymbolsPrivate.ReleaseBCD[bcd]
ELSE IF remoteBCD THEN ReleaseRemoteBCD[bcd];
ans ← FGIToEPI[stb, statement.fgtIndex];
}; -- end ENABLE UNWIND => ReleaseSTB[stb];
ReleaseSTB[stb];
};

-- [prog module bcd, entryPointIndex] => FGIndex
ProcToFirstFGI: PROC[proc: REF proc SectionObj] RETURNS[ans: FGIndex ← FGNull] =
{localBCD: BOOL ← FALSE;
remoteBCD: BOOL ← FALSE;
versionBCD: BOOL ← FALSE;
bcd: BcdOps.BcdBase;
ptv: TV = proc.prog.someGFHTV;
stb: SymbolTableBase;
IF ptv = NIL -- proc not loaded
THEN {bcd ← RTSymbolsPrivate.AcquireBCDFromVersion
[versionStamp: proc.prog.versionStamp,
shortFileNameHint:
Rope.Concat[proc.prog.moduleName,
".bcd"]];
versionBCD ← TRUE}
ELSE IF GetWorld[ptv] = LocalWorld[]
THEN {bcd ← GetLocalBCD[rgfi: GFHFromTV[ptv].gfi];
localBCD ← TRUE}
ELSE { bcd ← GetRemoteBCD[world: GetWorld[ptv],
rgfi: GetRemoteGFHeader[RemoteGFHFromTV[ptv]].gfi];
remoteBCD ← TRUE};
{ ENABLE UNWIND => IF versionBCD
THEN RTSymbolsPrivate.ReleaseBCD[bcd]
ELSE IF remoteBCD THEN ReleaseRemoteBCD[bcd];
stb ← GetModuleSTB[bcd, proc.prog.versionStamp];
}; -- end ENABLE UNWIND => RTSymbolsPrivate.ReleaseBCD[bcd];
{ ENABLE UNWIND => ReleaseSTB[stb];
IF versionBCD
THEN RTSymbolsPrivate.ReleaseBCD[bcd]
ELSE IF remoteBCD THEN ReleaseRemoteBCD[bcd];
ans ← EPIToFirstFGI[stb, proc.entryPointIndex];
}; -- end ENABLE UNWIND => ReleaseSTB[stb];
ReleaseSTB[stb];
};

-- [prog module bcd, FGIndex, entryPointIndex] => FGIndex
-- (or FGNull if in a different proc than entryPointIndex)
NextStatementFGI: PROC[statement: REF statement SectionObj]
RETURNS[ans: FGIndex ← FGNull] =
{localBCD: BOOL ← FALSE;
remoteBCD: BOOL ← FALSE;
versionBCD: BOOL ← FALSE;
bcd: BcdOps.BcdBase;
ptv: TV = statement.prog.someGFHTV;
stb: SymbolTableBase;
IF ptv = NIL -- statement not loaded
THEN {bcd ← RTSymbolsPrivate.AcquireBCDFromVersion
[versionStamp: statement.prog.versionStamp,
shortFileNameHint:
Rope.Concat[statement.prog.moduleName,
".bcd"]];
versionBCD ← TRUE}
ELSE IF GetWorld[ptv] = LocalWorld[]
THEN {bcd ← GetLocalBCD[rgfi: GFHFromTV[ptv].gfi];
localBCD ← TRUE}
ELSE { bcd ← GetRemoteBCD[world: GetWorld[ptv],
rgfi: GetRemoteGFHeader[RemoteGFHFromTV[ptv]].gfi];
remoteBCD ← TRUE};
{ ENABLE UNWIND => IF versionBCD
THEN RTSymbolsPrivate.ReleaseBCD[bcd]
ELSE IF remoteBCD THEN ReleaseRemoteBCD[bcd];
stb ← GetModuleSTB[bcd, statement.prog.versionStamp];
}; -- end ENABLE UNWIND => RTSymbolsPrivate.ReleaseBCD[bcd];
{ ENABLE UNWIND => ReleaseSTB[stb];
IF versionBCD
THEN RTSymbolsPrivate.ReleaseBCD[bcd]
ELSE IF remoteBCD THEN ReleaseRemoteBCD[bcd];
ans ← NextFGI[stb, statement.fgtIndex, StatementToParentEPI[statement]];
}; -- end ENABLE UNWIND => ReleaseSTB[stb];
ReleaseSTB[stb];
};

}.