-- AMModelSourceImpl.mesa
-- Last Modified On January 4, 1983 1:45 pm By Paul Rovner
-- moduleName, configName should not be source name

DIRECTORY
AMBridge USING [GetWorld, GFHFromTV, RemoteGFHFromTV],
AMModel USING [Class, Context, Source, SourceObj, CharIndex,
SourceFileName, SourceClass, ContextChildren, ContextClass, SectionVersion,
SectionSource, ContextSection, MostRecentNamedContext],
AMModelPrivate USING [FGIndex, FGNull, EPI, FGIToEPI, GetLocalBCD, GetRemoteBCD,
CharIndexToFGI, SectionRec, RefTVRec, ConfigContext, z],
AMTypes USING [Error, TVType, GlobalParent],
BcdDefs USING [VersionStamp, MTIndex, FTSelf],
BcdOps USING [BcdBase, MTHandle, ProcessModules],
TimeStamp USING [Stamp],
PilotLoadStateFormat USING [NullConfig],
Rope USING [ROPE, Concat, Equal, Find, Substr],
RTSymbolDefs USING [SymbolTableBase, SymbolTableHandle, nullHandle, nullBase],
RTSymbols USING [ReleaseSTB, AcquireSTBFromSGI, AcquireSTB],
RTSymbolsPrivate USING [AcquireBCDFromVersion, ReleaseBCD, GetSTHForModule],
RTTypesBasic USING [gfhType, fhType],
RTTypesRemotePrivate USING [GetRemoteGFHeader, ReleaseRemoteBCD],
Table USING [Base],
WorldVM USING [LocalWorld, World];

AMModelSourceImpl: PROGRAM
IMPORTS AMBridge, AMTypes, BcdOps, Rope, AMModel, AMModelPrivate, RTSymbols,
RTSymbolsPrivate, RTTypesRemotePrivate, WorldVM
EXPORTS AMModel, AMModelPrivate

= { OPEN AMBridge, AMModel, AMModelPrivate, AMTypes, PilotLoadStateFormat, Rope,
RTSymbolDefs, RTSymbols, RTTypesBasic, 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 Source

-- Use SourceSection to figure out (given a proc or statement source location)
-- where to place a breakpoint.
-- The list of prog Contexts returned by SourceSection is meaningful for
-- prog, proc and statement sources. It will be ordered "most-recently-loaded first".
-- Strictly speaking, a source can have multiple sections: one for each set of "SectionParams".
-- Someday we'll accommodate such, but not this week.
-- NOTE context = NIL oughta mean to find the section even though it's not loaded
SourceSection: PUBLIC PROC[source: Source, context: --worldRoot or model--Context]
RETURNS[section: Section ← NIL, contexts: LIST OF --prog--Context ← NIL] =
{SELECT SourceClass[source] FROM
statement =>
{[section, contexts]
← SourceSection
[z.NEW[SourceObj ← [fileName: source.fileName,
class: prog,
versionStamp: source.versionStamp,
sourceRange: entire[]]],
context];
section ← z.NEW[SectionObj ← [statement[prog: NARROW[section],
fgtIndex: SourceToFirstFGI
[source,
NARROW[section]]]]];
};
proc =>
{[section, contexts]
← SourceSection
[z.NEW[SourceObj ← [fileName: source.fileName,
class: prog,
versionStamp: source.versionStamp,
sourceRange: entire[]]],
context];
section ← z.NEW[SectionObj ← [proc[prog: NARROW[section],
entryPointIndex: SourceToEPI
[source, NARROW[section]]]]];
};
prog =>
-- look thru all global frames in context for ones with the source name.
-- Construct section for the first one found, thereafter check version stamp.
-- For each found, cons onto contexts
{ WITH context SELECT FROM
tv: RefTVRec =>
{SELECT TVType[tv] FROM
gfhType =>
{ section ← ContextSection[context];
IF Rope.Equal[SourceFileName[source],
SourceFileName[SectionSource[section]],
FALSE]
THEN contexts ← z.CONS[context, NIL]
ELSE section ← NIL;
RETURN};
fhType =>
{[section, contexts] ← SourceSection[source, GlobalParent[tv]];
RETURN};
ENDCASE => ERROR Error[typeFault];
};
mc: ConfigContext =>
{context: Context;
fn: ROPE = SourceFileName[source];
i: INT ← Rope.Find[s1: fn, s2: ".", pos1: 0, case: FALSE];
mn: ROPE ← IF i = -1 THEN fn ELSE Rope.Substr[base: fn, len: i];
context ← MostRecentNamedContext[mn, mc];
section ← ContextSection[context];
contexts ← z.CONS[context, contexts];
IF TRUE THEN RETURN;

IF mc.configIndex = NullConfig
THEN
{proc: PROC[context: Context] RETURNS[stop: BOOL ← FALSE] =
{ IF ContextClass[context] = model
THEN {s: Section;
cl: LIST OF Context;
[s, cl] ← SourceSection[source, context];
IF s # NIL
THEN { IF section = NIL
THEN section ← s
ELSE
{IF SectionVersion[section]
# SectionVersion[s]
THEN
ERROR
Error
[reason: notImplemented,
msg: "different sections for the same source"]};
UNTIL cl = NIL
DO contexts ← z.CONS[cl.first, contexts];
cl ← cl.rest;
ENDLOOP;
};
RETURN};
IF Rope.Equal[SourceFileName[source],
SourceFileName[SectionSource[ContextSection[context]]],
FALSE]
THEN {IF section = NIL
THEN section ← ContextSection[context]
ELSE {IF SectionVersion[ContextSection[context]]
# SectionVersion[section]
THEN ERROR
Error[reason: notImplemented,
msg: "different sections for the same source"]};
contexts ← z.CONS[context, contexts];
};
}; -- end proc defn
[] ← ContextChildren[context, proc];
} -- end IF mc.configIndex = NullConfig
ELSE
{proc: PROC[context: Context] RETURNS[stop: BOOL ← FALSE] =
{ IF Rope.Equal[SourceFileName[source],
SourceFileName[SectionSource[ContextSection[context]]],
FALSE]
THEN {IF section = NIL
THEN section ← ContextSection[context]
ELSE {IF SectionVersion[ContextSection[context]]
# SectionVersion[section]
THEN ERROR
Error[reason: notImplemented,
msg: "different sections for the same source"]};
contexts ← z.CONS[context, contexts];
};
};
[] ← ContextChildren[context, proc];
};
};
ENDCASE => ERROR
};
model => ERROR AMTypes.Error[reason: notImplemented,
msg: "SourceSection[model source]"];
interface => ERROR AMTypes.Error[reason: notImplemented,
msg: "SourceSection[interface source]"];
ENDCASE => ERROR}; -- end SourceSection


-- [prog module bcd, CharIndex] => FGIndex (wrt prog module bcd)
SourceToFirstFGI: PROC[source: Source, prog: REF prog SectionObj]
RETURNS[ans: FGIndex ← FGNull] =
{IF prog.someGFHTV # NIL
THEN -- prog loaded
{world: World = GetWorld[prog.someGFHTV];
local: BOOL ← (world = LocalWorld[]);
IF local
THEN
{bcd: BcdOps.BcdBase = GetLocalBCD[rgfi: GFHFromTV[prog.someGFHTV].gfi];
stb: SymbolTableBase ← GetModuleSTB[bcd, prog.versionStamp];
ans ← CharIndexToFGI[stb,
(WITH s: source SELECT FROM
field => s.firstCharIndex
ENDCASE => 0) ! UNWIND => ReleaseSTB[stb]];
ReleaseSTB[stb]}
ELSE
{bcd: BcdOps.BcdBase
← GetRemoteBCD[world: world,
rgfi: GetRemoteGFHeader
[RemoteGFHFromTV[prog.someGFHTV]].gfi];
stb: SymbolTableBase ← GetModuleSTB[bcd, prog.versionStamp
! UNWIND => ReleaseRemoteBCD[bcd]];
ReleaseRemoteBCD[bcd];
ans ← CharIndexToFGI[stb,
(WITH s: source SELECT FROM
field => s.firstCharIndex
ENDCASE => 0)
! UNWIND => ReleaseSTB[stb]];
ReleaseSTB[stb]};
}
ELSE -- prog not loaded
{bcd: BcdOps.BcdBase = RTSymbolsPrivate.AcquireBCDFromVersion
[versionStamp: prog.versionStamp,
shortFileNameHint:
Rope.Concat[prog.moduleName,
".bcd"]];
stb: SymbolTableBase ← GetModuleSTB[bcd, prog.versionStamp
! UNWIND => RTSymbolsPrivate.ReleaseBCD[bcd]];
RTSymbolsPrivate.ReleaseBCD[bcd];
ans ← CharIndexToFGI[stb,
(WITH s: source SELECT FROM
field => s.firstCharIndex
ENDCASE => 0)
! UNWIND => ReleaseSTB[stb]];
ReleaseSTB[stb]};
};

-- [prog module bcd, CharIndex] => entryPointIndex (wrt prog module bcd)
SourceToEPI: PROC[source: Source, prog: REF prog SectionObj] RETURNS[ans: EPI ← 0] =
{IF prog.someGFHTV # NIL
THEN -- prog loaded
{world: World = GetWorld[prog.someGFHTV];
local: BOOL ← (world = LocalWorld[]);
IF local
THEN
{bcd: BcdOps.BcdBase = GetLocalBCD[rgfi: GFHFromTV[prog.someGFHTV].gfi];
stb: SymbolTableBase ← GetModuleSTB[bcd, prog.versionStamp];
fgi: FGIndex ← CharIndexToFGI[stb, (WITH s: source SELECT FROM
field => s.firstCharIndex
ENDCASE => 0) ! UNWIND => ReleaseSTB[stb]];
ans ← FGIToEPI[stb, fgi ! UNWIND => ReleaseSTB[stb]];
ReleaseSTB[stb];
}
ELSE
{bcd: BcdOps.BcdBase
← GetRemoteBCD[world: world,
rgfi: GetRemoteGFHeader
[RemoteGFHFromTV[prog.someGFHTV]].gfi];
stb: SymbolTableBase ← GetModuleSTB[bcd, prog.versionStamp
! UNWIND => ReleaseRemoteBCD[bcd]];
fgi: FGIndex;
ReleaseRemoteBCD[bcd];
fgi ← CharIndexToFGI[stb, (WITH s: source SELECT FROM
field => s.firstCharIndex
ENDCASE => 0)
! UNWIND => ReleaseSTB[stb]];
ans ← FGIToEPI[stb, fgi
! UNWIND => ReleaseSTB[stb]];
ReleaseSTB[stb]};
}
ELSE -- prog not loaded
{bcd: BcdOps.BcdBase = RTSymbolsPrivate.AcquireBCDFromVersion
[versionStamp: prog.versionStamp,
shortFileNameHint:
Rope.Concat[prog.moduleName,
".bcd"]];
stb: SymbolTableBase ← GetModuleSTB[bcd, prog.versionStamp
! UNWIND => RTSymbolsPrivate.ReleaseBCD[bcd]];
fgi: FGIndex;
RTSymbolsPrivate.ReleaseBCD[bcd];
fgi ← CharIndexToFGI[stb, (WITH s: source SELECT FROM
field => s.firstCharIndex
ENDCASE => 0)
! UNWIND => ReleaseSTB[stb]];
ans ← FGIToEPI[stb, fgi
! UNWIND => ReleaseSTB[stb]];
ReleaseSTB[stb]};
};

GetModuleSTB: PUBLIC PROC[bcd: BcdOps.BcdBase, versionStamp: BcdDefs.VersionStamp]
RETURNS[stb: SymbolTableBase ← nullBase] =
{ FindModule: PROC[mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
RETURNS[stop: BOOLEAN ← FALSE] =
{version: BcdDefs.VersionStamp ← IF mth.file = BcdDefs.FTSelf
THEN bcd.version ELSE ftb[mth.file].version;
IF version = versionStamp
THEN {stb ← AcquireSTBFromSGI[bcd, mth.sseg]; RETURN[TRUE]}};

-- start GetModuleSTB here
sth: SymbolTableHandle ← nullHandle;
ftb: Table.Base = LOOPHOLE[bcd + bcd.ftOffset];
sth ← RTSymbolsPrivate.GetSTHForModule[versionStamp, NIL, NIL ! ANY => CONTINUE];
IF sth = nullHandle
THEN [] ← BcdOps.ProcessModules[bcd, FindModule]
ELSE stb ← AcquireSTB[sth];
};

}.