AMModelPrivateImpl.Mesa
Russ Atkinson, May 7, 1984 10:06:07 pm PDT
Paul Rovner, November 29, 1983 7:25 pm
DIRECTORY
AMModel USING [CharIndex],
AMModelPrivate USING [EPI, FGIndex, FGNull, NullPCOffset, PCOffset],
BrandXSymbolDefs
USING [
SymbolTableBase, BodyTableEntry, FineGrainTableEntry, rootBodyIndex, BodyIndex, nullBodyIndex],
BrandYSymbolDefs
USING [
SymbolTableBase, BodyTableEntry, FineGrainTableEntry, rootBodyIndex, BodyIndex, nullBodyIndex],
RTSymbolDefs USING [SymbolTableBase];
AMModelPrivateImpl:
PROGRAM
EXPORTS AMModelPrivate
=
BEGIN
OPEN
AMModel, AMModelPrivate, bx: BrandXSymbolDefs, by: BrandYSymbolDefs, RTSymbolDefs;
local type definitions
XBodyPtr: TYPE = LONG POINTER TO bx.BodyTableEntry;
YBodyPtr: TYPE = LONG POINTER TO by.BodyTableEntry;
EPIndex: TYPE = AMModelPrivate.EPI;
FGCard: TYPE = CARDINAL;
XFGPtr: TYPE = LONG POINTER TO bx.FineGrainTableEntry;
YFGPtr: TYPE = LONG POINTER TO by.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 [EPIndex] = {
WITH stb
SELECT
FROM
t: SymbolTableBase.x => RETURN[FGIToEPIX[t.e, fgi]];
t: SymbolTableBase.y => RETURN[FGIToEPIY[t.e, fgi]];
ENDCASE => ERROR;
};
FGIToEPIX:
PROC [stb: bx.SymbolTableBase, fgi: FGIndex]
RETURNS [epi: EPIndex ← 0] = {
returns first fine grain index for the given procedure
(0 for start proc OR invalid fgi)
IF fgi # FGNull
THEN {
bti: bx.BodyIndex = FGItoBTIX[stb, fgi];
IF bti # bx.nullBodyIndex
THEN {
body: XBodyPtr ← @stb.bb[bti];
WITH ext: body^
SELECT
FROM
Callable => epi ← ext.entryIndex;
ENDCASE => RETURN;
};
};
};
FGIToEPIY:
PROC [stb: by.SymbolTableBase, fgi: FGIndex]
RETURNS [epi: EPIndex ← 0] = {
returns first fine grain index for the given procedure
(0 for start proc OR invalid fgi)
IF fgi # FGNull
THEN {
bti: by.BodyIndex = FGItoBTIY[stb, fgi];
IF bti # by.nullBodyIndex
THEN {
body: YBodyPtr ← @stb.bb[bti];
WITH ext: body^
SELECT
FROM
Callable => epi ← ext.entryIndex;
ENDCASE => RETURN;
};
};
};
EPIToFirstFGI:
PUBLIC
PROC
[stb: SymbolTableBase, epi: EPIndex, skipArgs: BOOL] RETURNS [FGIndex] = {
WITH stb
SELECT
FROM
t: SymbolTableBase.x => RETURN[EPIToFirstFGIX[t.e, epi, skipArgs]];
t: SymbolTableBase.y => RETURN[EPIToFirstFGIY[t.e, epi, skipArgs]];
ENDCASE => ERROR;
EPIToFirstFGIX:
PROC
[stb: bx.SymbolTableBase, epi: EPIndex, skipArgs: BOOL]
RETURNS [fgi: FGIndex ← FGNull] = {
returns first fine grain index for the given procedure (FGNull for invalid epi)
bti: bx.BodyIndex ← EPItoBTIX[stb, epi];
IF bti = bx.nullBodyIndex THEN RETURN;
WITH info: stb.bb[bti].info
SELECT
FROM
External => fgi ← [fgCard: info.startIndex, fudge: FALSE];
ENDCASE;
IF skipArgs
AND fgi # FGNull
THEN {
pc: PCOffset ← FGIToFirstPC[[x[stb]], fgi];
DO
nfgi: FGIndex ← NextFGIX[stb, fgi, epi];
npc: PCOffset;
IF nfgi = FGNull THEN RETURN [fgi];
npc ← FGIToFirstPCX[stb, nfgi];
IF npc # pc THEN RETURN [nfgi];
fgi ← nfgi;
ENDLOOP;
};
};
EPIToFirstFGIY:
PROC
[stb: by.SymbolTableBase, epi: EPIndex, skipArgs: BOOL]
RETURNS [fgi: FGIndex ← FGNull] = {
returns first fine grain index for the given procedure (FGNull for invalid epi)
bti: by.BodyIndex ← EPItoBTIY[stb, epi];
IF bti = by.nullBodyIndex THEN RETURN;
WITH info: stb.bb[bti].info
SELECT
FROM
External => fgi ← [fgCard: info.startIndex, fudge: FALSE];
ENDCASE;
IF skipArgs
AND fgi # FGNull
THEN {
pc: PCOffset ← FGIToFirstPC[[y[stb]], fgi];
DO
nfgi: FGIndex ← NextFGIY[stb, fgi, epi];
npc: PCOffset;
IF nfgi = FGNull THEN RETURN [fgi];
npc ← FGIToFirstPCY[stb, nfgi];
IF npc # pc THEN RETURN [nfgi];
fgi ← nfgi;
ENDLOOP;
};
};
EPIToLastFGI:
PUBLIC
PROC [stb: SymbolTableBase, epi: EPIndex]
RETURNS [FGIndex] = {
WITH stb
SELECT
FROM
t: SymbolTableBase.x => RETURN[EPIToLastFGIX[t.e, epi]];
t: SymbolTableBase.y => RETURN[EPIToLastFGIY[t.e, epi]];
ENDCASE => ERROR;
};
EPIToLastFGIX:
PROC
[stb: bx.SymbolTableBase, epi: EPIndex] RETURNS [fgi: FGIndex ← FGNull] = {
returns last fine grain index for the given procedure
(FGNull for invalid epi)
bti: bx.BodyIndex ← EPItoBTIX[stb, epi];
IF bti = bx.nullBodyIndex THEN RETURN;
WITH info: stb.bb[bti].info
SELECT
FROM
External =>
fgi ← [fgCard: info.startIndex + MAX[info.indexLength, 1] - 1, fudge: TRUE];
ENDCASE;
};
EPIToLastFGIY:
PROC
[stb: by.SymbolTableBase, epi: EPIndex] RETURNS [fgi: FGIndex ← FGNull] = {
returns last fine grain index for the given procedure
(FGNull for invalid epi)
bti: by.BodyIndex ← EPItoBTIY[stb, epi];
IF bti = by.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, skipArgs: BOOL] RETURNS [PCOffset] = {
fgi: FGIndex ← EPIToFirstFGI[stb, epi, skipArgs];
IF fgi = FGNull THEN RETURN [NullPCOffset];
RETURN [FGIToFirstPC[stb, fgi]];
};
EPIToLastPC:
PUBLIC
PROC [stb: SymbolTableBase, epi: EPIndex]
RETURNS [PCOffset] = {
WITH stb
SELECT
FROM
t: SymbolTableBase.x => RETURN[EPIToLastPCX[t.e, epi]];
t: SymbolTableBase.y => RETURN[EPIToLastPCY[t.e, epi]];
ENDCASE => ERROR;
};
EPIToLastPCX:
PROC
[stb: bx.SymbolTableBase, epi: EPIndex] RETURNS [pc: PCOffset ← NullPCOffset] = {
returns offset of last byte in the procedure (may be padding byte)
bti: bx.BodyIndex ← EPItoBTIX[stb, epi];
IF bti = bx.nullBodyIndex THEN RETURN;
WITH info: stb.bb[bti].info
SELECT
FROM
External => {pc ← info.bytes; pc ← pc - 1};
ENDCASE;
};
EPIToLastPCY:
PROC
[stb: by.SymbolTableBase, epi: EPIndex] RETURNS [pc: PCOffset ← NullPCOffset] = {
returns offset of last byte in the procedure (may be padding byte)
bti: by.BodyIndex ← EPItoBTIY[stb, epi];
IF bti = by.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 [FGIndex] = {
WITH stb
SELECT
FROM
t: SymbolTableBase.x => RETURN[CharIndexToFGIX[t.e, ci]];
t: SymbolTableBase.y => RETURN[CharIndexToFGIY[t.e, ci]];
ENDCASE => ERROR;
CharIndexToFGIX:
PROC
[stb: bx.SymbolTableBase, ci: CharIndex] RETURNS [fgi: FGIndex ← FGNull] = {
returns the "best" fine grain index for the given character position
(FGNull for invalid position)
bti: bx.BodyIndex ← bx.nullBodyIndex;
bti ← CItoBTIX[stb, ci];
IF bti # bx.nullBodyIndex
THEN {
body: XBodyPtr ← @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: XFGPtr ← @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;
};
};
CharIndexToFGIY:
PROC
[stb: by.SymbolTableBase, ci: CharIndex] RETURNS [fgi: FGIndex ← FGNull] = {
returns the "best" fine grain index for the given character position
(FGNull for invalid position)
bti: by.BodyIndex ← by.nullBodyIndex;
bti ← CItoBTIY[stb, ci];
IF bti # bx.nullBodyIndex
THEN {
body: YBodyPtr ← @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: XFGPtr ← @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 [FGIndex] = {
WITH stb
SELECT
FROM
t: SymbolTableBase.x => RETURN[PCToFGIX[t.e, epi, pc]];
t: SymbolTableBase.y => RETURN[PCToFGIY[t.e, epi, pc]];
ENDCASE => ERROR;
PCToFGIX:
PROC
[stb: bx.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: bx.BodyIndex ← EPItoBTIX[stb, epi];
IF bti # bx.nullBodyIndex
THEN {
body: XBodyPtr ← @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: XFGPtr ← @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;
};
};
PCToFGIY:
PROC
[stb: by.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: by.BodyIndex ← EPItoBTIY[stb, epi];
IF bti # by.nullBodyIndex
THEN {
body: YBodyPtr ← @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: YFGPtr ← @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 [FGIndex] = {
WITH stb
SELECT
FROM
t: SymbolTableBase.x => RETURN[NextFGIX[t.e, fgi, epi]];
t: SymbolTableBase.y => RETURN[NextFGIY[t.e, fgi, epi]];
ENDCASE => ERROR;
NextFGIX:
PROC
[stb: bx.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: bx.BodyIndex;
IF fgi = FGNull THEN RETURN;
bti ← EPItoBTIX[stb, epi];
IF bti # bx.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;
};
NextFGIY:
PROC
[stb: by.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: by.BodyIndex;
IF fgi = FGNull THEN RETURN;
bti ← EPItoBTIY[stb, epi];
IF bti # by.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 [CharIndex] = {
WITH stb
SELECT
FROM
t: SymbolTableBase.x => RETURN[FGIToFirstCharX[t.e, fgi]];
t: SymbolTableBase.y => RETURN[FGIToFirstCharY[t.e, fgi]];
ENDCASE => ERROR;
FGIToFirstCharX:
PROC
[stb: bx.SymbolTableBase, fgi: FGIndex] RETURNS [ci: CharIndex ← -1] = {
takes a FGIndex, returns the first character position
-1 for invalid fgi
bti: bx.BodyIndex ← FGItoBTIX[stb, fgi];
IF bti # bx.nullBodyIndex
THEN {
body: XBodyPtr ← @stb.bb[bti];
WITH info: body.info
SELECT
FROM
External => {
stop: FGCard = IF fgi.fudge THEN fgi.fgCard + 1 ELSE fgi.fgCard;
ci ← body.sourceIndex;
FOR tfgi: FGCard ← info.startIndex, tfgi + 1
DO
IF tfgi >= stop
THEN
EXIT
ELSE {
fp: XFGPtr ← @stb.fgTable[tfgi];
WITH fp^
SELECT
FROM
normal => ci ← ci + deltaSource;
step => {
IF which = object THEN LOOP;
IF which # source THEN ERROR;
ci ← ci + delta;
};
ENDCASE;
};
ENDLOOP;
};
ENDCASE;
};
};
FGIToFirstCharY:
PROC
[stb: by.SymbolTableBase, fgi: FGIndex] RETURNS [ci: CharIndex ← -1] = {
takes a FGIndex, returns the first character position
-1 for invalid fgi
bti: by.BodyIndex ← FGItoBTIY[stb, fgi];
IF bti # by.nullBodyIndex
THEN {
body: YBodyPtr ← @stb.bb[bti];
WITH info: body.info
SELECT
FROM
External => {
stop: FGCard = IF fgi.fudge THEN fgi.fgCard + 1 ELSE fgi.fgCard;
ci ← body.sourceIndex;
FOR tfgi: FGCard ← info.startIndex, tfgi + 1
DO
IF tfgi >= stop
THEN
EXIT
ELSE {
fp: YFGPtr ← @stb.fgTable[tfgi];
WITH fp^
SELECT
FROM
normal => ci ← ci + deltaSource;
step => {
IF which = object THEN LOOP;
IF which # source THEN ERROR;
ci ← ci + delta;
};
ENDCASE;
};
ENDLOOP;
};
ENDCASE;
};
};
FGIToLastChar:
PUBLIC
PROC [stb: SymbolTableBase, fgi: FGIndex]
RETURNS [CharIndex] = {
WITH stb
SELECT
FROM
t: SymbolTableBase.x => RETURN[FGIToLastCharX[t.e, fgi]];
t: SymbolTableBase.y => RETURN[FGIToLastCharY[t.e, fgi]];
ENDCASE => ERROR;
};
FGIToLastCharX:
PROC
[stb: bx.SymbolTableBase, fgi: FGIndex] RETURNS [ci: CharIndex ← -1] = {
takes a FGIndex, returns the last character position
-1 for invalid fgi
bti: bx.BodyIndex ← FGItoBTIX[stb, fgi];
IF bti # bx.nullBodyIndex
THEN {
body: XBodyPtr ← @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: XFGPtr ← @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 --XXX
ELSE ci ← ci - 1;
};
ENDCASE;
};
FGIToLastCharY:
PROC
[stb: by.SymbolTableBase, fgi: FGIndex] RETURNS [ci: CharIndex ← -1] = {
takes a FGIndex, returns the last character position
-1 for invalid fgi
bti: by.BodyIndex ← FGItoBTIY[stb, fgi];
IF bti # by.nullBodyIndex
THEN {
body: YBodyPtr ← @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: YFGPtr ← @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 --XXX
ELSE ci ← ci - 1;
};
ENDCASE;
};
FGIToFirstPC:
PUBLIC
PROC [stb: SymbolTableBase, fgi: FGIndex]
RETURNS [PCOffset] = {
WITH stb
SELECT
FROM
t: SymbolTableBase.x => RETURN[FGIToFirstPCX[t.e, fgi]];
t: SymbolTableBase.y => RETURN[FGIToFirstPCY[t.e, fgi]];
ENDCASE => ERROR;
FGIToFirstPCX:
PROC
[stb: bx.SymbolTableBase, fgi: FGIndex] RETURNS [pc: PCOffset ← NullPCOffset] = {
takes a FGIndex, returns the first PC (NullPCOffset for invalid fgi)
bti: bx.BodyIndex ← FGItoBTIX[stb, fgi];
IF bti # bx.nullBodyIndex
THEN {
body: XBodyPtr ← @stb.bb[bti];
WITH info: body.info
SELECT
FROM
External => {
stop: FGCard = IF fgi.fudge THEN fgi.fgCard+1 ELSE fgi.fgCard;
pc ← 0;
FOR tfgi: FGCard ← info.startIndex, tfgi + 1
DO
IF tfgi >= stop
THEN
EXIT
ELSE {
fp: XFGPtr = @stb.fgTable[tfgi];
WITH fp^
SELECT
FROM
normal => pc ← pc + deltaObject;
step => {
IF which = source THEN LOOP;
IF which # object THEN ERROR;
pc ← pc + delta;
};
ENDCASE;
};
ENDLOOP;
};
ENDCASE;
};
};
FGIToFirstPCY:
PROC
[stb: by.SymbolTableBase, fgi: FGIndex]
RETURNS [pc: PCOffset ← NullPCOffset] = {
takes a FGIndex, returns the first PC (NullPCOffset for invalid fgi)
bti: by.BodyIndex ← FGItoBTIY[stb, fgi];
IF bti # by.nullBodyIndex
THEN {
body: YBodyPtr ← @stb.bb[bti];
WITH info: body.info
SELECT
FROM
External => {
stop: FGCard = IF fgi.fudge THEN fgi.fgCard+1 ELSE fgi.fgCard;
pc ← 0;
FOR tfgi: FGCard ← info.startIndex, tfgi + 1
DO
IF tfgi >= stop
THEN
EXIT
ELSE {
fp: YFGPtr = @stb.fgTable[tfgi];
WITH fp^
SELECT
FROM
normal => pc ← pc + deltaObject;
step => {
IF which = source THEN LOOP;
IF which # object THEN ERROR;
pc ← pc + delta;
};
ENDCASE;
};
ENDLOOP;
};
ENDCASE;
};
};
FGIToLastPC:
PUBLIC
PROC [stb: SymbolTableBase, fgi: FGIndex]
RETURNS [PCOffset] = {
WITH stb
SELECT
FROM
t: SymbolTableBase.x => RETURN[FGIToLastPCX[t.e, fgi]];
t: SymbolTableBase.y => RETURN[FGIToLastPCY[t.e, fgi]];
ENDCASE => ERROR;
FGIToLastPCX:
PROC
[stb: bx.SymbolTableBase, fgi: FGIndex] RETURNS [pc: PCOffset ← NullPCOffset] = {
returns offset of last byte in the fine grain entry
(NullPCOffset for invalid fgi)
bti: bx.BodyIndex ← FGItoBTIX[stb, fgi];
IF bti # bx.nullBodyIndex
THEN {
body: XBodyPtr ← @stb.bb[bti];
WITH info: body.info
SELECT
FROM
External => {
firstFGI: FGCard ← info.startIndex;
IF fgi.fudge THEN {pc ← INT[info.bytes] - 1; RETURN};
pc ← 0;
FOR tfgi: FGCard
IN [firstFGI..fgi.fgCard]
DO
fp: XFGPtr ← @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;
};
};
FGIToLastPCY:
PROC
[stb: by.SymbolTableBase, fgi: FGIndex] RETURNS [pc: PCOffset ← NullPCOffset] = {
returns offset of last byte in the fine grain entry
(NullPCOffset for invalid fgi)
bti: by.BodyIndex ← FGItoBTIY[stb, fgi];
IF bti # by.nullBodyIndex
THEN {
body: YBodyPtr ← @stb.bb[bti];
WITH info: body.info
SELECT
FROM
External => {
firstFGI: FGCard ← info.startIndex;
IF fgi.fudge THEN {pc ← INT[info.bytes] - 1; RETURN};
pc ← 0;
FOR tfgi: FGCard
IN [firstFGI..fgi.fgCard]
DO
fp: YFGPtr ← @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
EPItoBTIX:
PROC[stb: bx.SymbolTableBase, epi: EPIndex]
RETURNS [outerBti: bx.BodyIndex ← bx.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: bx.BodyIndex]
RETURNS [stop:
BOOL ←
FALSE] = {
body: XBodyPtr ← @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[bx.rootBodyIndex, innerEPItoBTI];
EPItoBTIY:
PROC[stb: by.SymbolTableBase, epi: EPIndex]
RETURNS [outerBti: by.BodyIndex ← by.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: by.BodyIndex]
RETURNS [stop:
BOOL ←
FALSE] = {
body: YBodyPtr ← @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[by.rootBodyIndex, innerEPItoBTI];
FGItoBTIX:
PROC
[stb: bx.SymbolTableBase, fgi: FGIndex]
RETURNS [outerBti: bx.BodyIndex ← bx.nullBodyIndex] = {
takes a SymbolTableBase & FGIndex
returns a Callable BTI containing the FGIndex
or nullBodyIndex if that can't be done
innerFGItoBTI:
PROC [bti: bx.BodyIndex]
RETURNS [stop:
BOOL ←
FALSE] = {
body: XBodyPtr ← @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[bx.rootBodyIndex, innerFGItoBTI];
};
FGItoBTIY:
PROC
[stb: by.SymbolTableBase, fgi: FGIndex]
RETURNS [outerBti: by.BodyIndex ← by.nullBodyIndex] = {
takes a SymbolTableBase & FGIndex
returns a Callable BTI containing the FGIndex
or nullBodyIndex if that can't be done
innerFGItoBTI:
PROC [bti: by.BodyIndex]
RETURNS [stop:
BOOL ←
FALSE] = {
body: YBodyPtr ← @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[by.rootBodyIndex, innerFGItoBTI];
};
CItoBTIX:
PROC
[stb: bx.SymbolTableBase, ci: CharIndex]
RETURNS [bestBTI: bx.BodyIndex ← bx.nullBodyIndex] = {
takes a SymbolTableBase & character position
returns a Callable BTI containing the FGIndex or nullBodyIndex if that can't be done
bestCI: CharIndex ← 0;
the start CharIndex of the smallest enclosing (of ci) Callable body, initialized to the start CharIndex of the module
bti1, fgi1, and ci1 get the largest point where ci1 < ci. Note that ci1 is the character index after fgi1 has been applied.
bti1: bx.BodyIndex ← bx.nullBodyIndex;
fgi1: FGCard ← 0;
ci1: CharIndex ← 0;
bti2, fgi2, and ci2 get the smallest point where ci2 >= ci. Note that ci2 is the character index before fgi2 has been applied.
bti2: bx.BodyIndex ← bx.nullBodyIndex;
fgi2: FGCard ← 0;
ci2: CharIndex ← 0;
innerCItoBTI:
PROC [bti: bx.BodyIndex]
RETURNS [stop:
BOOL ←
FALSE] = {
body: XBodyPtr ← @stb.bb[bti];
WITH ext: body^ SELECT FROM Callable => NULL; 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; -- the first sourceIndex of this Callable body
lastCI: CharIndex ← thisCI; -- the first sourceIndex of the current statement
FOR tfgi: FGCard
IN [firstFGI..lastFGI]
DO
fp: XFGPtr ← @stb.fgTable[tfgi];
Compute (fgt2) the smallest fgt entry startIndex where ci2 >= ci
IF (lastCI < ci2
OR bti2 = bx.nullBodyIndex)
AND lastCI >= ci
THEN {
bti2 ← bti; fgi2 ← tfgi; ci2 ← lastCI;
};
WITH fp^
SELECT
FROM
normal => lastCI ← lastCI + deltaSource;
step => IF which = source THEN lastCI ← lastCI + delta;
ENDCASE;
Compute (fgt1) the largest fgt entry startIndex where ci1 < ci
IF (lastCI >= ci1
OR bti1 = bx.nullBodyIndex)
AND lastCI < ci
THEN {bti1 ← bti; fgi1 ← tfgi; ci1 ← lastCI};
ENDLOOP;
};
ENDCASE;
};
[] ← stb.EnumerateBodies[bx.rootBodyIndex, innerCItoBTI];
bestBTI ← bti1;
IF bti1 # bti2
THEN {
IF ci = ci2 OR bti1 = bx.nullBodyIndex THEN bestBTI ← bti2;
};
};
CItoBTIY:
PROC
[stb: by.SymbolTableBase, ci: CharIndex]
RETURNS [bestBTI: by.BodyIndex ← by.nullBodyIndex] = {
takes a SymbolTableBase & character position
returns a Callable BTI containing the FGIndex or nullBodyIndex if that can't be done
bestCI: CharIndex ← 0;
the start CharIndex of the smallest enclosing (of ci) Callable body, initialized to the start CharIndex of the module
bti1, fgi1, and ci1 get the largest point where ci1 < ci. Note that ci1 is the character index after fgi1 has been applied.
bti1: by.BodyIndex ← by.nullBodyIndex;
fgi1: FGCard ← 0;
ci1: CharIndex ← 0;
bti2, fgi2, and ci2 get the smallest point where ci2 >= ci. Note that ci2 is the character index before fgi2 has been applied.
bti2: by.BodyIndex ← by.nullBodyIndex;
fgi2: FGCard ← 0;
ci2: CharIndex ← 0;
innerCItoBTI:
PROC [bti: by.BodyIndex]
RETURNS [stop:
BOOL ←
FALSE] = {
body: YBodyPtr ← @stb.bb[bti];
WITH ext: body^ SELECT FROM Callable => NULL; 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; -- the first sourceIndex of this Callable body
lastCI: CharIndex ← thisCI; -- the first sourceIndex of the current statement
FOR tfgi: FGCard
IN [firstFGI..lastFGI]
DO
fp: YFGPtr ← @stb.fgTable[tfgi];
Compute (fgt2) the smallest fgt entry startIndex where ci2 >= ci
IF (lastCI < ci2
OR bti2 = by.nullBodyIndex)
AND lastCI >= ci
THEN {
bti2 ← bti; fgi2 ← tfgi; ci2 ← lastCI;
};
WITH fp^
SELECT
FROM
normal => lastCI ← lastCI + deltaSource;
step => IF which = source THEN lastCI ← lastCI + delta;
ENDCASE;
Compute (fgt1) the largest fgt entry startIndex where ci1 < ci
IF (lastCI >= ci1
OR bti1 = by.nullBodyIndex)
AND lastCI < ci
THEN {bti1 ← bti; fgi1 ← tfgi; ci1 ← lastCI};
ENDLOOP;
};
ENDCASE;
};
[] ← stb.EnumerateBodies[by.rootBodyIndex, innerCItoBTI];
bestBTI ← bti1;
IF bti1 # bti2
THEN {
IF ci = ci2 OR bti1 = by.nullBodyIndex THEN bestBTI ← bti2;
};
};
END.