-- AMModelPrivateImpl.Mesa
-- Russ Atkinson, November 16, 1982 11:46 am
-- Paul Rovner, December 20, 1982 4:19 pm

DIRECTORY
AMModel USING [CharIndex],
AMModelPrivate USING
[EPI, FGIndex, FGNull, NullPCOffset, PCOffset],
RTSymbols USING [SymbolTableBase, BodyIndex, FineGrainTableEntry, nullBodyIndex,
rootBodyIndex, BodyTableEntry];

AMModelPrivateImpl: PROGRAM
EXPORTS AMModelPrivate
= BEGIN OPEN AMModel, AMModelPrivate, RTSymbols;

-- local type definitions

BodyPtr: TYPE = LONG POINTER TO BodyTableEntry;
EPIndex: TYPE = AMModelPrivate.EPI;
FGCard: TYPE = CARDINAL;
FGPtr: TYPE = LONG POINTER TO FineGrainTableEntry;

-- kludge for the missing FGI
fudge: INT ← 8; -- number of characters to assume beyond the last fgi in a procedure

-- procedures exported to AMModelPrivate

FGIToEPI: PUBLIC PROC
[stb: SymbolTableBase, fgi: FGIndex] RETURNS [epi: EPIndex ← 0] = {
-- returns first fine grain index for the given procedure
-- (0 for start proc OR invalid fgi)
bti: BodyIndex;
IF fgi = FGNull THEN RETURN;
bti ← FGItoBTI[stb, fgi];
IF bti # nullBodyIndex THEN
{body: BodyPtr ← @stb.bb[bti];
WITH ext: body^ SELECT FROM
Callable => epi ← ext.entryIndex;
ENDCASE => RETURN;
};
};

EPIToFirstFGI: PUBLIC PROC
[stb: SymbolTableBase, epi: EPIndex]
RETURNS [fgi: FGIndex ← FGNull] = {
-- returns first fine grain index for the given procedure
-- (FGNull for invalid epi)
bti: BodyIndex ← EPItoBTI[stb, epi];
IF bti = nullBodyIndex THEN RETURN;
WITH info: stb.bb[bti].info SELECT FROM
External => fgi ← [fgCard: info.startIndex, fudge: FALSE];
ENDCASE;
};

EPIToLastFGI: PUBLIC PROC
[stb: SymbolTableBase, epi: EPIndex]
RETURNS [fgi: FGIndex ← FGNull] = {
-- returns last fine grain index for the given procedure
-- (FGNull for invalid epi)
bti: BodyIndex ← EPItoBTI[stb, epi];
IF bti = nullBodyIndex THEN RETURN;
WITH info: stb.bb[bti].info SELECT FROM
External =>
fgi ← [fgCard: info.startIndex + MAX[info.indexLength, 1] - 1,
fudge: TRUE];
ENDCASE;
};

EPIToFirstPC: PUBLIC PROC
[stb: SymbolTableBase, epi: EPIndex]
RETURNS [pc: PCOffset ← NullPCOffset] = {
-- returns offset (usually 0) of first byte in the procedure
bti: BodyIndex ← EPItoBTI[stb, epi];
IF bti = nullBodyIndex THEN RETURN;
pc ← 0;
};

EPIToLastPC: PUBLIC PROC
[stb: SymbolTableBase, epi: EPIndex]
RETURNS [pc: PCOffset ← NullPCOffset] = {
-- returns offset of last byte in the procedure (may be padding byte)
bti: BodyIndex ← EPItoBTI[stb, epi];
IF bti = nullBodyIndex THEN RETURN;
WITH info: stb.bb[bti].info SELECT FROM
External => {pc ← info.bytes; pc ← pc - 1};
ENDCASE;
};

CharIndexToFGI: PUBLIC PROC
[stb: SymbolTableBase, ci: CharIndex] RETURNS [fgi: FGIndex ← FGNull] = {
-- returns the "best" fine grain index for the given character position
-- (FGNull for invalid position)
bti: BodyIndex ← nullBodyIndex;
usedFudge: BOOL ← FALSE;
[bti, usedFudge] ← CItoBTI[stb, ci];
IF bti # nullBodyIndex THEN
{body: BodyPtr ← @stb.bb[bti];
WITH info: body.info SELECT FROM
External =>
{firstFGI: FGCard ← info.startIndex;
lastFGI: FGCard ← firstFGI + MAX[info.indexLength, 1] - 1;
thisCI: CharIndex ← body.sourceIndex;
fgi ← [fgCard: firstFGI, fudge: FALSE];
FOR tfgi: FGCard IN [firstFGI..lastFGI] DO
fp: FGPtr ← @stb.fgTable[tfgi];
nextCI: CharIndex ← thisCI;
fgi.fgCard ← tfgi;
-- we try not to stop at a source step, because source steps usually come
-- just before the pc step for the statement (sigh)
WITH fp^ SELECT FROM
normal =>
nextCI ← nextCI + deltaSource;
step =>
IF which = source THEN
{thisCI ← nextCI + delta; LOOP};
ENDCASE;
IF nextCI > ci THEN RETURN;
thisCI ← nextCI;
ENDLOOP;
fgi.fudge ← TRUE;
};
ENDCASE;
};
};

PCToFGI: PUBLIC PROC
[stb: SymbolTableBase, epi: EPIndex, pc: PCOffset]
RETURNS [fgi: FGIndex ← FGNull] = {
-- returns the "best" fine grain index for the given pc offset in the given procedure
-- (FGNull for invalid epi or invalid pc)
bti: BodyIndex ← EPItoBTI[stb, epi];
IF bti # nullBodyIndex THEN
{body: BodyPtr ← @stb.bb[bti];
WITH info: body.info SELECT FROM
External =>
{firstFGI: FGCard ← info.startIndex;
lastFGI: FGCard ← firstFGI + MAX[info.indexLength, 1] - 1;
rem: INT ← pc;
IF pc >= info.bytes THEN RETURN [FGNull];
fgi ← [fgCard: firstFGI, fudge: FALSE];
FOR tfgi: FGCard IN [firstFGI..lastFGI] DO
fp: FGPtr ← @stb.fgTable[tfgi];
fgi.fgCard ← tfgi;
IF rem = 0 THEN RETURN;
WITH fp^ SELECT FROM
normal => rem ← rem - deltaObject;
step => IF which = object THEN rem ← rem - delta;
ENDCASE;
IF rem < 0 THEN RETURN;
ENDLOOP;
fgi.fudge ← TRUE;
};
ENDCASE;
};
};

NextFGI: PUBLIC PROC
[stb: SymbolTableBase, fgi: FGIndex, epi: EPIndex]
RETURNS [nfgi: FGIndex ← FGNull] = {
-- takes a FGIndex & entry point, returns the next FGIndex
-- returns FGNull if next fgi is in a different proc than entryPointIndex
-- OR the given FGIndex or entry point was not valid
bti: BodyIndex;
IF fgi = FGNull THEN RETURN;
bti ← EPItoBTI[stb, epi];
IF bti # nullBodyIndex THEN
WITH info: stb.bb[bti].info SELECT FROM
External =>
{firstFGI: FGCard ← info.startIndex;
lastFGI: FGCard ← firstFGI + MAX[info.indexLength, 1] - 1;
IF fgi.fudge OR fgi.fgCard NOT IN [firstFGI..lastFGI] THEN RETURN;
IF fgi.fgCard = lastFGI
THEN fgi.fudge ← TRUE
ELSE fgi.fgCard ← fgi.fgCard + 1;
nfgi ← fgi;
};
ENDCASE;
};

FGIToFirstChar: PUBLIC PROC
[stb: SymbolTableBase, fgi: FGIndex] RETURNS [ci: CharIndex ← -1] = {
-- takes a FGIndex, returns the first character position
-- -1 for invalid fgi
bti: BodyIndex ← FGItoBTI[stb, fgi];
IF bti # nullBodyIndex THEN
{body: BodyPtr ← @stb.bb[bti];
WITH info: body.info SELECT FROM
External =>
{firstFGI: FGCard ← info.startIndex;
fgc: FGCard ← fgi.fgCard + (IF fgi.fudge THEN 1 ELSE 0);
ci ← body.sourceIndex;
FOR tfgc: FGCard IN [firstFGI..fgc) DO
fp: FGPtr ← @stb.fgTable[tfgc];
WITH fp^ SELECT FROM
normal => ci ← ci + deltaSource;
step => IF which = source THEN ci ← ci + delta;
ENDCASE;
ENDLOOP;
IF fgc > firstFGI THEN
{-- look back one fgi to see if this it was a source step
-- if it was, subtract it out
fp: FGPtr ← @stb.fgTable[fgc - 1];
WITH fp^ SELECT FROM
step => IF which = source THEN ci ← ci - delta;
ENDCASE;
};
};
ENDCASE;
};
};

FGIToLastChar: PUBLIC PROC
[stb: SymbolTableBase, fgi: FGIndex] RETURNS [ci: CharIndex ← -1] = {
-- takes a FGIndex, returns the last character position
-- -1 for invalid fgi
bti: BodyIndex ← FGItoBTI[stb, fgi];
IF bti # nullBodyIndex THEN
{body: BodyPtr ← @stb.bb[bti];
WITH info: body.info SELECT FROM
External =>
{firstFGI: FGCard ← info.startIndex;
lastFGI: FGCard ← firstFGI + MAX[info.indexLength, 1] - 1;
ci ← body.sourceIndex;
FOR tfgi: FGCard IN [firstFGI..fgi.fgCard] DO
fp: FGPtr ← @stb.fgTable[tfgi];
WITH fp^ SELECT FROM
normal => ci ← ci + deltaSource;
step => IF which = source THEN ci ← ci + delta;
ENDCASE;
ENDLOOP;
IF fgi.fudge
THEN ci ← ci + fudge
ELSE ci ← ci - 1;
};
ENDCASE;
};
};

FGIToFirstPC: PUBLIC PROC
[stb: SymbolTableBase, fgi: FGIndex] RETURNS [pc: PCOffset ← NullPCOffset] = {
-- takes a FGIndex, returns the first character position
-- (NullPCOffset for invalid fgi)
bti: BodyIndex ← FGItoBTI[stb, fgi];
IF bti # nullBodyIndex THEN
{body: BodyPtr ← @stb.bb[bti];
WITH info: body.info SELECT FROM
External =>
{firstFGI: FGCard ← info.startIndex;
tfgi: FGCard ← fgi.fgCard + (IF fgi.fudge THEN 1 ELSE 0);
pc ← 0;
FOR tfgi IN [firstFGI..tfgi) DO
fp: FGPtr ← @stb.fgTable[tfgi];
WITH fp^ SELECT FROM
normal => pc ← pc + deltaObject;
step => IF which = object THEN pc ← pc + delta;
ENDCASE;
ENDLOOP;
};
ENDCASE;
};
};

FGIToLastPC: PUBLIC PROC
[stb: SymbolTableBase, fgi: FGIndex] RETURNS [pc: PCOffset ← NullPCOffset] = {
-- returns offset of last byte in the fine grain entry
-- (NullPCOffset for invalid fgi)
bti: BodyIndex ← FGItoBTI[stb, fgi];
IF bti # nullBodyIndex THEN
{body: BodyPtr ← @stb.bb[bti];
WITH info: body.info SELECT FROM
External =>
{firstFGI: FGCard ← info.startIndex;
IF fgi.fudge THEN
{pc ← info.bytes; pc ← pc - 1; RETURN};
pc ← 0;
FOR tfgi: FGCard IN [firstFGI..fgi.fgCard] DO
fp: FGPtr ← @stb.fgTable[tfgi];
WITH fp^ SELECT FROM
normal => pc ← pc + deltaObject;
step => IF which = object THEN pc ← pc + delta;
ENDCASE;
ENDLOOP;
pc ← pc - 1;
};
ENDCASE;
};
};

-- implementation procedures

EPItoBTI: PROC
[stb: SymbolTableBase, epi: EPIndex] RETURNS [outerBti: BodyIndex ← nullBodyIndex] = {
-- takes a SymbolTableBase & entry point
-- returns a Callable BTI for the entry point
-- or nullBodyIndex if that can't be done
innerEPItoBTI: PROC [bti: BodyIndex] RETURNS [stop: BOOL ← FALSE] = {
body: BodyPtr ← @stb.bb[bti];
thisEPI: EPIndex ← 0;
WITH ext: body^ SELECT FROM
Callable => thisEPI ← ext.entryIndex;
ENDCASE => RETURN;
WITH info: body.info SELECT FROM
External =>
IF epi = thisEPI THEN {outerBti ← bti; stop ← TRUE};
ENDCASE;
};
[] ← stb.EnumerateBodies[rootBodyIndex, innerEPItoBTI];
};

FGItoBTI: PROC
[stb: SymbolTableBase, fgi: FGIndex] RETURNS [outerBti: BodyIndex ← nullBodyIndex] = {
-- takes a SymbolTableBase & FGIndex
-- returns a Callable BTI containing the FGIndex
-- or nullBodyIndex if that can't be done
innerFGItoBTI: PROC [bti: BodyIndex] RETURNS [stop: BOOL ← FALSE] = {
body: BodyPtr ← @stb.bb[bti];
thisEPI: EPIndex ← 0;
WITH ext: body^ SELECT FROM
Callable => thisEPI ← ext.entryIndex;
ENDCASE => RETURN;
WITH info: body.info SELECT FROM
External =>
{firstFGI: FGCard ← info.startIndex;
lastFGI: FGCard ← firstFGI + MAX[info.indexLength, 1] - 1;
IF fgi.fgCard IN [firstFGI..lastFGI] THEN
{outerBti ← bti; stop ← TRUE};
};
ENDCASE;
};
[] ← stb.EnumerateBodies[rootBodyIndex, innerFGItoBTI];
};

CItoBTI: PROC
[stb: SymbolTableBase, ci: CharIndex]
RETURNS [bestBTI: BodyIndex ← nullBodyIndex, usedFudge: BOOL ← FALSE] = {
-- takes a SymbolTableBase & character position
-- returns a Callable BTI containing the FGIndex
-- or nullBodyIndex if that can't be done
innerCItoBTI: PROC [bti: BodyIndex] RETURNS [stop: BOOL ← FALSE] = {
-- NOTE: we assume that the character ranges
-- covered by the Callable BTI's are disjoint or nested
-- and the smallest source range containing the index is the one desired
body: BodyPtr ← @stb.bb[bti];
thisEPI: EPIndex ← 0;
bestCI: CharIndex ← 0;
WITH ext: body^ SELECT FROM
Callable => thisEPI ← ext.entryIndex;
ENDCASE => RETURN;
WITH info: body.info SELECT FROM
External =>
{firstFGI: FGCard ← info.startIndex;
lastFGI: FGCard ← firstFGI + MAX[info.indexLength, 1] - 1;
thisCI: CharIndex ← body.sourceIndex;
IF thisCI <= ci AND bestCI <= thisCI THEN
{-- determine from fine grain table if this char index is valid
lastCI: CharIndex ← thisCI;
FOR tfgi: FGCard IN [firstFGI..lastFGI] DO
fp: FGPtr ← @stb.fgTable[tfgi];
WITH fp^ SELECT FROM
normal => lastCI ← lastCI + deltaSource;
step => IF which = source THEN lastCI ← lastCI + delta;
ENDCASE;
IF lastCI >= ci THEN EXIT; -- this index is OK
ENDLOOP;
IF lastCI < ci
THEN
{IF lastCI+fudge < ci THEN RETURN; -- no match here
usedFudge ← TRUE}
ELSE usedFudge ← FALSE;
bestBTI ← bti;
bestCI ← thisCI;
};
};
ENDCASE;
};
[] ← stb.EnumerateBodies[rootBodyIndex, innerCItoBTI];
};

END.