-- file SymbolCopier.Mesa
-- last modified by Johnsson, July 16, 1980 8:55 AM
-- last modified by Satterthwaite, October 17, 1980 2:51 PM
-- last modified by Bruce, September 1, 1980 8:28 PM
DIRECTORY
Copier USING [
SEToken, NullSEToken, FindMdEntry, FreeSymbolTable, GetSymbolTable],
Strings USING [SubString, SubStringDescriptor],
Inline USING [LongDivMod, LongMult],
LiteralOps USING [CopyLiteral],
Storage USING [Words, FreeWords],
SymbolTable USING [Base, SetCacheSize],
Symbols,
SymbolOps USING [
EnterExtension, EnterString, LinkBti, MakeCtxSe, MakeNonCtxSe,
MakeSeChain, NewCtx, NextSe, ParentBti, ResetCtxList, SearchContext,
SetSeLink, SubStringForHash, UnderType],
SymbolPack,
Table USING [Base, Notifier, AddNotify, Allocate, Bounds, DropNotify],
Tree USING [treeType, Index, Link, Map, NullIndex],
TreeOps USING [
CopyTree, GetNode, OpName, PopTree, PushNode, PushTree, SetAttr, SetInfo];
SymbolCopier: PROGRAM
IMPORTS
Copier, Inline, LiteralOps, SymbolTable, Storage, Table, TreeOps,
ownSymbols: SymbolPack, SymbolOps
EXPORTS Copier SHARES Copier =
BEGIN
OPEN SymbolOps, Symbols;
-- tables defining the current symbol table
seb: Table.Base; -- se table
ctxb: Table.Base; -- context table
mdb: Table.Base; -- module directory base
bb: Table.Base; -- body table
tb: Table.Base; -- tree table
CopierNotify: Table.Notifier = {
-- called whenever the main symbol table is repacked
seb ← base[seType]; ctxb ← base[ctxType];
mdb ← base[mdType]; bb ← base[bodyType];
tb ← base[Tree.treeType];
IF iBase # NIL AND iBase = ownSymbols THEN INotify[]};
-- table bases for the current include module
iBase: SymbolTable.Base;
iHt: LONG DESCRIPTOR FOR ARRAY HTIndex OF HTRecord;
iSeb: Table.Base;
iCtxb: Table.Base;
INotify: PROC = {
-- called whenever iBase switches or tables moved
iHt ← iBase.ht; iSeb ← iBase.seb; iCtxb ← iBase.ctxb};
MemoCacheSize: CARDINAL = 509; -- prime < 512
SearchCache: TYPE = ARRAY [0..MemoCacheSize) OF RECORD[
hti: HTIndex,
ctx: CTXIndex];
memoCache: POINTER TO SearchCache;
-- initialization/finalization
CopierInit: PUBLIC PROC [cache: BOOLEAN] = {
iBase ← NIL;
Table.AddNotify[CopierNotify];
IF cache
THEN {
memoCache ← Storage.Words[SIZE[SearchCache]];
memoCache↑ ← ALL[ [hti:HTNull, ctx:CTXNull] ];
typeCache ← Storage.Words[SIZE[TypeCache]];
typeCache↑ ← ALL[ [mdi:MDNull, iSei:SENull, sei: SENull] ]}
ELSE {memoCache ← NIL; typeCache ← NIL};
SymbolTable.SetCacheSize[100];
currentBody ← BTNull};
ResetCaches: PROC = INLINE { -- see ResetIncludeContexts
SymbolTable.SetCacheSize[0];
IF typeCache # NIL THEN Storage.FreeWords[typeCache];
IF memoCache # NIL THEN Storage.FreeWords[memoCache]};
CopierReset: PUBLIC PROC = {
ResetIncludeContexts[];
IF iBase # NIL THEN CloseIncludedTable[];
Table.DropNotify[CopierNotify]};
-- manipulation of symbol tokens (without copying)
SEToken: TYPE = Copier.SEToken;
NullSEToken: SEToken = Copier.NullSEToken;
CtxValue: PUBLIC PROC [ctx: CTXIndex, value: CARDINAL] RETURNS [t: SEToken] = {
mdi: MDIndex;
iCtx: CTXIndex;
[mdi, iCtx] ← InverseMapCtx[ctx];
IF OpenIncludedTable[mdi]
THEN {t ← [iBase.SeiForValue[value, iCtx]]; CloseIncludedTable[]}
ELSE t ← NullSEToken;
RETURN};
CtxFirst: PUBLIC PROC [ctx: CTXIndex] RETURNS [t: SEToken] = {
mdi: MDIndex;
iCtx: CTXIndex;
[mdi, iCtx] ← InverseMapCtx[ctx];
IF OpenIncludedTable[mdi]
THEN {t ← [iBase.FirstCtxSe[iCtx]]; CloseIncludedTable[]}
ELSE t ← NullSEToken;
RETURN};
CtxNext: PUBLIC PROC [ctx: CTXIndex, t: SEToken] RETURNS [next: SEToken] = {
mdi: MDIndex;
iCtx: CTXIndex;
[mdi, iCtx] ← InverseMapCtx[ctx];
IF t # NullSEToken AND OpenIncludedTable[mdi]
THEN {next ← [iBase.NextSe[t]]; CloseIncludedTable[]}
ELSE next ← NullSEToken;
RETURN};
TokenHash: PUBLIC PROC [ctx: CTXIndex, t: SEToken] RETURNS [hti: HTIndex] = {
mdi: MDIndex = InverseMapCtx[ctx].mdi;
IF t # NullSEToken AND OpenIncludedTable[mdi]
THEN {hti ← MapHti[iBase.seb[t].hash]; CloseIncludedTable[]}
ELSE hti ← HTNull;
RETURN};
TokenValue: PUBLIC PROC [ctx: CTXIndex, t: SEToken] RETURNS [v: WORD] = {
mdi: MDIndex = InverseMapCtx[ctx].mdi;
IF t # NullSEToken AND OpenIncludedTable[mdi]
THEN {v ← iBase.seb[t].idValue; CloseIncludedTable[]}
ELSE v ← 0;
RETURN};
TokenSymbol: PUBLIC PROC [ctx: CTXIndex, t: SEToken] RETURNS [sei: ISEIndex] = {
mdi: MDIndex = InverseMapCtx[ctx].mdi;
SELECT TRUE FROM
(mdi = OwnMdi) => sei ← t;
OpenIncludedTable[mdi] => {
sei ← LOOPHOLE[CopyIncludedSymbol[t, mdi, TRUE]]; CloseIncludedTable[]};
ENDCASE => sei ← ISENull;
RETURN};
-- copying across table boundaries
SubString: TYPE = Strings.SubString;
SubStringDescriptor: TYPE = Strings.SubStringDescriptor;
SearchFileCtx: PUBLIC PROC [hti: HTIndex, ctx: IncludedCTXIndex]
RETURNS [found: BOOLEAN, sei: ISEIndex] = {
desc: SubStringDescriptor;
s: SubString = @desc;
hash: [0..MemoCacheSize);
iHti: HTIndex;
iSei: ISEIndex;
mdi: MDIndex = ctxb[ctx].module;
ignorePrivate: BOOLEAN = TRUE; -- for debugger
SubStringForHash[s, hti];
hash ← Inline.LongDivMod[
Inline.LongMult[LOOPHOLE[hti], LOOPHOLE[ctx]],
MemoCacheSize].remainder;
IF memoCache # NIL AND memoCache[hash].hti = hti AND memoCache[hash].ctx = ctx
THEN RETURN [FALSE, ISENull];
IF OpenIncludedTable[mdi]
THEN {
iHti ← iBase.FindString[s];
IF iHti # HTNull
AND
(iHt[iHti].anyPublic OR (ignorePrivate --AND iHt[iHti].anyInternal--))
THEN {
iSei ← iBase.SearchContext[iHti, ctxb[ctx].map];
found ← iSei # SENull AND (iSeb[iSei].public OR ignorePrivate);
IF found THEN sei ← CopyCtxSe[iSei, hti, ctx, mdi]}
ELSE found ← FALSE;
CloseIncludedTable[]}
ELSE {found ← FALSE; sei ← ISENull};
IF ~found AND memoCache # NIL THEN memoCache[hash] ← [hti:hti, ctx:ctx];
RETURN};
CompleteContext: PUBLIC PROC [ctx: IncludedCTXIndex, ignorePrivate: BOOLEAN] = {
IF ~ctxb[ctx].reset AND OpenIncludedTable[ctxb[ctx].module]
THEN {FillContext[ctx, ignorePrivate]; CloseIncludedTable[]}};
CopyUnion: PUBLIC PROC [ctx: CTXIndex] = {
iSei, iRoot: ISEIndex;
WITH ctxb[ctx] SELECT FROM
included =>
IF ~reset AND OpenIncludedTable[module]
THEN {
iSei ← iRoot ← iCtxb[map].seList;
DO
IF iSei = SENull THEN EXIT;
SELECT iBase.TypeForm[iSeb[iSei].idType] FROM
union, sequence => {
IF iSeb[iSei].hash # HTNull
THEN [] ← CopyIncludedSymbol[iSei, module]
ELSE FillContext[LOOPHOLE[ctx], TRUE];
EXIT};
ENDCASE;
IF (iSei ← iBase.NextSe[iSei]) = iRoot THEN EXIT;
ENDLOOP;
CloseIncludedTable[]};
ENDCASE};
AugmentContext: PUBLIC PROC [
ctx: IncludedCTXIndex, ignorePrivate: BOOLEAN, mdi: MDIndex] = {
mdRoot: MDIndex;
target: CTXIndex;
[mdRoot, target] ← InverseMapCtx[ctx];
IF ~ctxb[ctx].reset AND OpenIncludedTable[mdi]
THEN {
newMdi: MDIndex = iBase.FindMdi[mdb[mdRoot].stamp];
IF newMdi # MDNull
THEN
FOR iCtx: IncludedCTXIndex ← iBase.mdb[newMdi].ctx,
iBase.ctxb[iCtx].chain UNTIL iCtx = CTXNull
DO
IF iBase.ctxb[iCtx].map = target
THEN {
CopyCtxEntries[ctx, iCtx, mdi, ignorePrivate];
IF ~iBase.ctxb[iCtx].complete THEN ctxb[ctx].complete ← FALSE;
IF ctxb[ctx].complete THEN ResetCtx[ctx];
EXIT};
ENDLOOP;
CloseIncludedTable[]}};
FillContext: PROC [ctx: IncludedCTXIndex, ignorePrivate: BOOLEAN] = {
mdi: MDIndex = ctxb[ctx].module;
CopyCtxEntries[ctx, ctxb[ctx].map, mdi, TRUE]; -- for debugger
ResetCtx[ctx]};
CopyCtxEntries: PROC [
ctx: IncludedCTXIndex, iCtx: CTXIndex, mdi: MDIndex, ignorePrivate: BOOLEAN] = {
complete: BOOLEAN ← TRUE;
pSei: ISEIndex ← ISENull;
FOR iSei: ISEIndex ← iBase.FirstCtxSe[iCtx], iBase.NextSe[iSei] UNTIL iSei = SENull
DO
IF ~(iSeb[iSei].public OR ignorePrivate)
THEN complete ← FALSE
ELSE {
hti: HTIndex = MapHti[iSeb[iSei].hash];
sei: ISEIndex ← SearchContext[hti, ctx];
IF sei = SENull THEN sei ← CopyCtxSe[iSei, hti, ctx, mdi];
IF pSei # SENull AND NextSe[pSei] # sei
THEN {Delink[sei]; SetSeLink[sei, NextSe[pSei]]; SetSeLink[pSei, sei]};
ctxb[ctx].seList ← pSei ← sei};
ENDLOOP;
ctxb[ctx].complete ← complete};
Delink: PUBLIC PROC [sei: ISEIndex] = {
prev, next: ISEIndex;
ctx: CTXIndex = seb[sei].idCtx; -- assumed not reset
prev ← ctxb[ctx].seList;
DO
next ← NextSe[prev];
SELECT next FROM
sei => EXIT;
ctxb[ctx].seList, ISENull => ERROR;
ENDCASE => prev ← next;
ENDLOOP;
IF NextSe[sei] = sei
THEN ctxb[ctx].seList ← ISENull
ELSE {
IF sei = ctxb[ctx].seList THEN ctxb[ctx].seList ← prev;
SetSeLink[prev, NextSe[sei]]};
SetSeLink[sei, ISENull]};
FillRecord: PROC [sei: CSEIndex, mdi: MDIndex] = {
WITH type: seb[sei] SELECT FROM
record => {
WITH type SELECT FROM
linked => FillRecord[UnderType[linkType], mdi];
ENDCASE => NULL;
WITH c: ctxb[type.fieldCtx] SELECT FROM
included =>
IF ~c.reset
THEN {
IF c.module = mdi
THEN FillContext[LOOPHOLE[type.fieldCtx], TRUE]
ELSE {
CloseIncludedTable[];
CompleteContext[LOOPHOLE[type.fieldCtx], TRUE];
[] ← OpenIncludedTable[mdi]}};
ENDCASE => NULL};
ENDCASE => NULL};
MapHti: PROC [iHti: HTIndex] RETURNS [hti: HTIndex] = {
desc: SubStringDescriptor;
s: SubString = @desc;
IF iHti = HTNull
THEN hti ← HTNull
ELSE {
iBase.SubStringForHash[s, iHti];
hti ← EnterString[s ! TableRelocated => s.base ← iBase.ssb]};
RETURN};
MissingHti: ERROR = CODE;
InverseMapHti: PROC [hti: HTIndex] RETURNS [iHti: HTIndex] = {
desc: SubStringDescriptor;
s: SubString = @desc;
IF hti = HTNull
THEN iHti ← HTNull
ELSE {
SubStringForHash[s, hti];
iHti ← iBase.FindString[s];
IF iHti = HTNull THEN ERROR MissingHti};
RETURN};
FindExternalCtx: PUBLIC PROC [mdi: MDIndex, iCtx: CTXIndex]
RETURNS [ctx: IncludedCTXIndex] = {
IF mdi # MDNull AND OpenIncludedTable[mdi]
THEN {ctx ← MapCtx[mdi, iCtx]; CloseIncludedTable[]}
ELSE ctx ← IncludedCTXNull;
RETURN};
MapCtx: PROC [mdi: MDIndex, iCtx: CTXIndex] RETURNS [IncludedCTXIndex] = {
ctx, last: IncludedCTXIndex;
target: CTXIndex;
mdRoot: MDIndex;
IF iCtx = CTXNull
THEN {mdRoot ← mdi; target ← CTXNull; last ← IncludedCTXNull}
ELSE {
WITH iCtxb[iCtx] SELECT FROM
included => [mdRoot, target] ← IncludedTargets[LOOPHOLE[iCtx]];
-- imported => {
-- IF iBase.mdb[iCtxb[includeLink].module].defaultImport # iCtx
-- THEN ERROR; need a signal to raise
-- [mdRoot, target] ← IncludedTargets[includeLink]};
ENDCASE => {mdRoot ← mdi; target ← iCtx};
last ← IncludedCTXNull;
FOR ctx ← mdb[mdRoot].ctx, ctxb[ctx].chain UNTIL ctx = CTXNull
DO
IF ctxb[ctx].map = target THEN RETURN [ctx];
last ← ctx;
ENDLOOP};
ctx ← Table.Allocate[ctxType, SIZE[included CTXRecord]];
ctxb[ctx] ← CTXRecord[
mark: FALSE, varUpdated: FALSE,
seList: ISENull,
level: IF iCtx = CTXNull THEN lZ ELSE iCtxb[iCtx].level,
extension: included[
chain: IncludedCTXNull,
module: mdRoot,
map: target,
restricted: FALSE, complete: FALSE,
closed: FALSE, reset: FALSE]];
IF last = IncludedCTXNull THEN mdb[mdRoot].ctx ← ctx ELSE ctxb[last].chain ← ctx;
RETURN [ctx]};
InverseMapCtx: PROC [ctx: CTXIndex] RETURNS [mdi: MDIndex, iCtx: CTXIndex] = {
WITH ctxb[ctx] SELECT FROM
included => {mdi ← module; iCtx ← map};
imported => [mdi, iCtx] ← InverseMapCtx[includeLink];
ENDCASE => {mdi ← OwnMdi; iCtx ← ctx};
RETURN};
IncludedTargets: PROC [iCtx: IncludedCTXIndex]
RETURNS [mdi: MDIndex, ctx: CTXIndex] = {
oldMdi: MDIndex = iCtxb[iCtx].module;
desc: SubStringDescriptor;
s: SubString = @desc;
iBase.SubStringForHash[s, iBase.mdb[oldMdi].fileId];
mdi ← Copier.FindMdEntry[
id: MapHti[iBase.mdb[oldMdi].moduleId],
version: iBase.mdb[oldMdi].stamp,
file: MapHti[iBase.mdb[oldMdi].fileId]];
ctx ← iCtxb[iCtx].map;
RETURN};
UnknownModule: PUBLIC SIGNAL [HTIndex] = CODE;
DummyCtxSe: PROC [sei: ISEIndex] = {
seb[sei].idType ← typeANY; seb[sei].idInfo ← seb[sei].idValue ← 0;
seb[sei].extended ← seb[sei].public ← seb[sei].linkSpace ← FALSE;
seb[sei].immutable ← seb[sei].constant ← TRUE;
seb[sei].mark3 ← seb[sei].mark4 ← TRUE};
-- caching of (cons) types
TypeCacheSize: CARDINAL = 83; -- prime < 256/3
TypeCacheIndex: TYPE = [0..TypeCacheSize);
TypeCache: TYPE = ARRAY TypeCacheIndex OF RECORD [
mdi: MDIndex, iSei: SEIndex, -- the search keys
sei: SEIndex]; -- the result
typeCache: POINTER TO TypeCache;
TypeHash: PROC [mdi: MDIndex, iSei: SEIndex] RETURNS [TypeCacheIndex] = INLINE {
RETURN [(LOOPHOLE[mdi,CARDINAL]*LOOPHOLE[iSei,CARDINAL]) MOD TypeCacheSize]};
-- copying symbols
CopyIncludedSymbol: PROC [iSei: SEIndex, mdi: MDIndex, compressed: BOOLEAN ← FALSE]
RETURNS [sei: SEIndex] = {
IF iSei = SENull THEN RETURN [SENull];
WITH iSeb[iSei] SELECT FROM
id => {
ctx: IncludedCTXIndex;
hti: HTIndex;
iMdi: MDIndex;
tSei: ISEIndex;
IF idCtx IN (CTXNull .. LAST[StandardContext]] AND ~compressed THEN RETURN [iSei];
ctx ← MapCtx[mdi, idCtx];
hti ← MapHti[hash];
sei ← tSei ← SearchContext[hti, ctx];
IF sei # SENull
THEN seb[tSei].idCtx ← ctx
ELSE {
iMdi ← ctxb[ctx].module;
IF iMdi = mdi OR ~mdb[iMdi].shared
THEN sei ← CopyCtxSe[LOOPHOLE[iSei, ISEIndex], hti, ctx, mdi]
ELSE {
CloseIncludedTable[];
IF OpenIncludedTable[iMdi]
THEN iSei ← iBase.SearchContext[InverseMapHti[hti], ctxb[ctx].map]
ELSE [] ← OpenIncludedTable[iMdi←mdi];
sei ← CopyCtxSe[LOOPHOLE[iSei, ISEIndex], hti, ctx, iMdi];
CloseIncludedTable[];
[] ← OpenIncludedTable[mdi]}}};
cons =>
SELECT typeTag FROM
mode => sei ← typeTYPE;
basic => sei ← iSei;
transfer => sei ← CopyNonCtxSe[LOOPHOLE[iSei, CSEIndex], mdi];
ENDCASE => {
i: TypeCacheIndex = TypeHash[mdi, iSei];
IF typeCache # NIL AND typeCache[i].iSei = iSei AND typeCache[i].mdi = mdi
THEN sei ← typeCache[i].sei
ELSE {
sei ← CopyNonCtxSe[LOOPHOLE[iSei, CSEIndex], mdi];
IF typeCache # NIL THEN typeCache[i] ← [mdi:mdi, iSei:iSei, sei:sei]}};
ENDCASE;
RETURN};
CopyCtxSe: PROC [iSei: ISEIndex, hti: HTIndex, ctx: CTXIndex, mdi: MDIndex]
RETURNS [sei: ISEIndex] = {
sei ← MakeCtxSe[hti, ctx]; CopyCtxSeInfo[sei, iSei, mdi]; RETURN};
CopyCtxSeInfo: PROC [sei, iSei: ISEIndex, mdi: MDIndex] = {
OPEN id: seb[sei];
IF iSeb[iSei].idCtx = CTXNull THEN id.idCtx ← CTXNull;
id.extended ← iSeb[iSei].extended;
id.public ← iSeb[iSei].public;
id.immutable ← iSeb[iSei].immutable;
id.constant ← iSeb[iSei].constant;
id.linkSpace ← iSeb[iSei].linkSpace;
id.idType ← CopyIncludedSymbol[iSeb[iSei].idType, mdi];
IF iSeb[iSei].idType = typeTYPE
THEN id.idInfo ← CopyIncludedSymbol[iSeb[iSei].idInfo, mdi]
ELSE IF iSeb[iSei].constant AND
(SELECT iBase.XferMode[iSeb[iSei].idType] FROM
proc, program => TRUE,
ENDCASE => FALSE)
THEN id.idInfo ← CopyIncludedBody[iSeb[iSei].idInfo, sei, mdi]
ELSE id.idInfo ← iSeb[iSei].idInfo;
id.idValue ← iSeb[iSei].idValue;
id.mark3 ← id.mark4 ← TRUE;
IF id.extended
THEN CopyExtension[sei, iSei, mdi]};
-- ELSE IF id.linkSpace THEN id.idInfo ← 0};
currentBody: BTIndex;
CopyExtension: PROC [sei, iSei: ISEIndex, mdi: MDIndex] = {
iType: ExtensionType;
iTree: Tree.Link;
saveCurrentBody: BTIndex = currentBody;
currentBody ← BTNull;
[iType, iTree] ← iBase.FindExtension[iSei];
WITH iTree SELECT FROM
subtree => IF iBase.tb[index].name = body THEN currentBody ← seb[sei].idInfo;
ENDCASE;
EnterExtension[sei, iType, InputExtension[iTree, mdi]];
currentBody ← saveCurrentBody};
InputExtension: PROC [t: Tree.Link, mdi: MDIndex] RETURNS [Tree.Link] = {
InputTree: Tree.Map = {
WITH link: t SELECT FROM
hash => v ← [hash[index: MapHti[link.index]]];
symbol => v ← [symbol[index: LOOPHOLE[CopyIncludedSymbol[link.index, mdi]]]];
literal => v ← InputLiteral[link];
subtree => {
iNode: Tree.Index = link.index;
v ← SELECT iBase.tb[iNode].name FROM
block => InputBlock[iNode],
IN [forseq .. downthru] => InputBlock[iNode],
openx =>
TreeOps.CopyTree[[baseP:@iBase.tb, link:iBase.tb[iNode].son[1]], InputTree],
ENDCASE => TreeOps.CopyTree[[baseP:@iBase.tb, link:link], InputTree];
WITH v SELECT FROM
subtree => {
node: Tree.Index = index;
SELECT tb[node].name FROM
body => tb[node].info ← currentBody;
block => ExitBlock[node];
IN [basicTC..discrimTC], cdot,
IN [callx..typecode], exlist => {
tb[node].info ← CopyIncludedSymbol[iBase.tb[iNode].info, mdi];
SELECT tb[node].name FROM
construct, exlist => FillRecord[tb[node].info, mdi];
union =>
WITH tb[node].son[1] SELECT FROM
symbol => FillRecord[UnderType[index], mdi];
ENDCASE => ERROR;
ENDCASE};
IN [forseq..downthru] => NULL;
do => {
tb[node].info ← LAST[CARDINAL];
IF TreeOps.OpName[tb[node].son[1]] IN [forseq..downthru]
THEN ExitBlock[TreeOps.GetNode[tb[node].son[1]]]};
IN [assign..join] => tb[node].info ← LAST[CARDINAL];
ENDCASE => NULL};
ENDCASE => NULL};
ENDCASE => ERROR;
RETURN};
InputLiteral: PROC [t: literal Tree.Link] RETURNS [Tree.Link] = {
WITH t.info SELECT FROM
word => index ← LiteralOps.CopyLiteral[[baseP:@iBase.ltb, index:index]];
ENDCASE => ERROR;
RETURN [t]};
InputBlock: PROC [iNode: Tree.Index] RETURNS [v: Tree.Link] = {
OPEN TreeOps;
iBti: BTIndex = iBase.tb[iNode].info;
n: CARDINAL = iBase.tb[iNode].nSons;
bti: BTIndex;
IF iBti = BTNull
THEN bti ← BTNull
ELSE {
ctx: IncludedCTXIndex = MapCtx[mdi, iBase.bb[iBti].localCtx];
bti ← Table.Allocate[bodyType, SIZE[Other BodyRecord]];
bb[bti] ← BodyRecord[
link: ,
firstSon: BTNull,
type: RecordSENull,
localCtx: ctx, level: iBase.bb[iBti].level,
sourceIndex: LAST[CARDINAL], info: ,
extension: Other[relOffset: ]];
LinkBti[bti: bti, parent: currentBody]; currentBody ← bti};
FOR i: CARDINAL IN [1 .. n] DO PushTree[InputTree[iBase.tb[iNode].son[i]]] ENDLOOP;
PushNode[iBase.tb[iNode].name, n];
SetAttr[1, iBase.tb[iNode].attr1]; SetAttr[2, iBase.tb[iNode].attr2];
SetAttr[3, iBase.tb[iNode].attr3]; SetInfo[bti]; v ← PopTree[];
IF bti # BTNull
THEN bb[bti].info ← BodyInfo[Internal[
bodyTree: GetNode[v], thread: Tree.NullIndex, frameSize: ]];
RETURN};
ExitBlock: PROC [node: Tree.Index] = INLINE {
IF tb[node].info # BTNull THEN currentBody ← ParentBti[tb[node].info]};
RETURN [InputTree[t]]};
CopyExternalBody: PUBLIC PROC [mdi: MDIndex, iBti: CBTIndex]
RETURNS [bti: CBTIndex] = {
IF iBti # CBTNull AND mdi # MDNull AND OpenIncludedTable[mdi]
THEN {
sei: ISEIndex;
iSei: ISEIndex = iBase.bb[iBti].id;
IF iSei # ISENull
THEN {sei ← LOOPHOLE[CopyIncludedSymbol[iSei, mdi, TRUE]]; bti ← seb[sei].idInfo}
ELSE bti ← CopyIncludedBody[iBti, ISENull, mdi];
CloseIncludedTable[]}
ELSE bti ← CBTNull;
RETURN};
CopyIncludedBody: PROC [iBti: CBTIndex, sei: ISEIndex, mdi: MDIndex]
RETURNS [bti: CBTIndex] = {
iCtx: CTXIndex;
IF iBti = BTNull
THEN bti ← CBTNull
ELSE {
iCtx ← iBase.bb[iBti].localCtx;
WITH body: iBase.bb[iBti] SELECT FROM
Outer => {
bti ← Table.Allocate[bodyType, SIZE[Outer Callable BodyRecord]];
bb[LOOPHOLE[bti, OCBTIndex]] ← body};
Inner => {
bti ← Table.Allocate[bodyType, SIZE[Inner Callable BodyRecord]];
bb[LOOPHOLE[bti, ICBTIndex]] ← body};
ENDCASE => ERROR;
bb[bti].link ← [parent, BTNull]; bb[bti].firstSon ← BTNull;
bb[bti].id ← sei;
IF iBase.bb[iBti].inline
THEN {
bb[bti].ioType ← CopyBodyType[iBase.bb[iBti].ioType, mdi];
WITH body: bb[bti].info SELECT FROM
Internal => body.thread ← body.bodyTree ← Tree.NullIndex;
ENDCASE}
ELSE
bb[bti].ioType ← IF sei = ISENull OR seb[seb[sei].idType].seTag = id
THEN CopyBodyType[iBase.bb[iBti].ioType, mdi]
ELSE UnderType[seb[sei].idType];
bb[bti].localCtx ← IF iCtx = CTXNull THEN CTXNull ELSE MapCtx[mdi, iCtx]};
RETURN};
CopyNonCtxSe: PROC [iSei: CSEIndex, mdi: MDIndex] RETURNS [sei: CSEIndex] = {
tSei1, tSei2: SEIndex;
WITH iType: iSeb[iSei] SELECT FROM
enumerated => {
tCtx: CTXIndex;
sei ← MakeNonCtxSe[SIZE[enumerated cons SERecord]];
tCtx ← IF iType.valueCtx IN StandardContext
THEN iType.valueCtx
ELSE CopyIncludedValues[iType.valueCtx, mdi, sei];
seb[sei].typeInfo ← enumerated[
ordered: iType.ordered,
machineDep: iType.machineDep,
sparse: iType.sparse,
valueCtx: tCtx,
nValues: iType.nValues]};
record => {
tCtx: CTXIndex = IF iType.fieldCtx IN StandardContext
THEN iType.fieldCtx
ELSE MapCtx[mdi, iType.fieldCtx];
WITH iType SELECT FROM
notLinked => {
sei ← MakeNonCtxSe[SIZE[notLinked record cons SERecord]];
seb[sei].typeInfo ← record[
machineDep: iType.machineDep,
painted: iType.painted,
argument: iType.argument,
hints: iType.hints,
fieldCtx: tCtx,
length: iType.length,
monitored: iType.monitored,
linkPart: notLinked[]]};
linked => {
sei ← MakeNonCtxSe[SIZE[linked record cons SERecord]];
tSei1 ← CopyIncludedSymbol[linkType, mdi];
seb[sei].typeInfo ← record[
machineDep: iType.machineDep,
painted: iType.painted,
argument: iType.argument,
hints: iType.hints,
fieldCtx: tCtx,
length: iType.length,
monitored: iType.monitored,
linkPart: linked[linkType: tSei1]]};
ENDCASE};
ref => {
sei ← MakeNonCtxSe[SIZE[ref cons SERecord]];
tSei1 ← CopyIncludedSymbol[iType.refType, mdi];
seb[sei].typeInfo ← ref[
refType: tSei1,
counted: iType.counted,
readOnly: iType.readOnly,
ordered: iType.ordered,
list: iType.list,
basing: iType.basing]};
array => {
sei ← MakeNonCtxSe[SIZE[array cons SERecord]];
tSei1 ← CopyIncludedSymbol[iType.indexType, mdi];
tSei2 ← CopyIncludedSymbol[iType.componentType, mdi];
seb[sei].typeInfo ← array[
packed: iType.packed,
indexType: tSei1,
componentType: tSei2]};
arraydesc => {
sei ← MakeNonCtxSe[SIZE[arraydesc cons SERecord]];
tSei1 ← CopyIncludedSymbol[iType.describedType, mdi];
seb[sei].typeInfo ← arraydesc[
readOnly: iType.readOnly,
describedType: tSei1]};
transfer => {
rSei1, rSei2: RecordSEIndex;
sei ← MakeNonCtxSe[SIZE[transfer cons SERecord]];
rSei1 ← CopyArgRecord[iType.inRecord, mdi, FALSE];
rSei2 ← CopyArgRecord[iType.outRecord, mdi, FALSE];
seb[sei].typeInfo ← transfer[
mode: iType.mode,
inRecord: rSei1,
outRecord: rSei2]};
definition => {
sei ← MakeNonCtxSe[SIZE[definition cons SERecord]];
seb[sei].typeInfo ← definition[
nGfi: iType.nGfi,
named: iType.named,
defCtx: MapCtx[mdi, iType.defCtx]]};
union => {
tag: ISEIndex;
tCtx: CTXIndex;
sei ← MakeNonCtxSe[SIZE[union cons SERecord]];
tCtx ← MapCtx[mdi, iType.caseCtx];
tag ← CopyCtxSe[iType.tagSei, MapHti[iSeb[iType.tagSei].hash], CTXNull, mdi];
seb[sei].typeInfo ← union[
caseCtx: tCtx,
machineDep: iType.machineDep,
overlaid: iType.overlaid,
controlled: iType.controlled,
tagSei: tag,
hints: iType.hints]};
sequence => {
tag: ISEIndex;
tSei1 ← CopyIncludedSymbol[iType.componentType, mdi];
sei ← MakeNonCtxSe[SIZE[sequence cons SERecord]];
tag ← CopyCtxSe[iType.tagSei, MapHti[iSeb[iType.tagSei].hash], CTXNull, mdi];
seb[sei].typeInfo ← sequence[
packed: iType.packed,
controlled: iType.controlled,
machineDep: iType.machineDep,
tagSei: tag,
componentType: tSei1]};
relative => {
tSei3: SEIndex;
sei ← MakeNonCtxSe[SIZE[relative cons SERecord]];
tSei1 ← CopyIncludedSymbol[iType.baseType, mdi];
tSei2 ← CopyIncludedSymbol[iType.offsetType, mdi];
tSei3 ← IF iType.resultType = iType.offsetType
THEN tSei2
ELSE CopyIncludedSymbol[iType.resultType, mdi];
seb[sei].typeInfo ← relative[
baseType: tSei1,
offsetType: tSei2,
resultType: tSei3]};
opaque => {
sei ← MakeNonCtxSe[SIZE[opaque cons SERecord]];
tSei1 ← CopyIncludedSymbol[iType.id, mdi];
seb[sei].typeInfo ← opaque[
lengthKnown: iType.lengthKnown,
length: iType.length,
id: LOOPHOLE[tSei1]]};
zone => {
sei ← MakeNonCtxSe[SIZE[zone cons SERecord]];
seb[sei].typeInfo ← zone[mds: iType.mds, counted: iType.counted]};
subrange => {
sei ← MakeNonCtxSe[SIZE[subrange cons SERecord]];
tSei1 ← CopyIncludedSymbol[iType.rangeType, mdi];
seb[sei].typeInfo ← subrange[
filled: iType.filled,
empty: iType.empty,
rangeType: tSei1,
origin: iType.origin,
range: iType.range]};
long => {
sei ← MakeNonCtxSe[SIZE[long cons SERecord]];
tSei1 ← CopyIncludedSymbol[iType.rangeType, mdi];
seb[sei].typeInfo ← long[rangeType: tSei1]};
real => {
sei ← MakeNonCtxSe[SIZE[real cons SERecord]];
tSei1 ← CopyIncludedSymbol[iType.rangeType, mdi];
seb[sei].typeInfo ← real[rangeType: tSei1]};
any => {
sei ← MakeNonCtxSe[SIZE[any cons SERecord]]; seb[sei].typeInfo ← any[]};
ENDCASE => ERROR;
seb[sei].mark3 ← seb[sei].mark4 ← TRUE; RETURN};
CopyBodyType: PROC [iSei: CSEIndex, mdi: MDIndex] RETURNS [sei: CSEIndex] = {
rSei1, rSei2: RecordSEIndex;
WITH iType: iSeb[iSei] SELECT FROM
transfer => {
sei ← MakeNonCtxSe[SIZE[transfer cons SERecord]];
rSei1 ← CopyArgRecord[iType.inRecord, mdi, TRUE];
rSei2 ← CopyArgRecord[iType.outRecord, mdi, TRUE];
seb[sei].typeInfo ← transfer[
mode: iType.mode,
inRecord: rSei1,
outRecord: rSei2]};
ENDCASE => ERROR;
seb[sei].mark3 ← seb[sei].mark4 ← TRUE; RETURN};
CopyArgRecord: PROC [irSei: RecordSEIndex, mdi: MDIndex, mapped: BOOLEAN]
RETURNS [rSei: RecordSEIndex] = {
ctx, iCtx: CTXIndex;
sei, iSei, seChain: ISEIndex;
i: TypeCacheIndex;
IF irSei = SENull
THEN rSei ← RecordSENull
ELSE {
rSei ← LOOPHOLE[MakeNonCtxSe[SIZE[notLinked record cons SERecord]]];
iCtx ← iSeb[irSei].fieldCtx;
IF ~mapped
THEN ctx ← NewCtx[iCtxb[iCtx].level]
ELSE {
tCtx: IncludedCTXIndex = MapCtx[mdi, iCtx];
ctxb[tCtx].complete ← TRUE; ResetCtx[tCtx]; ctx ← tCtx};
IF ctxb[ctx].seList = ISENull
THEN {
seChain ← MakeSeChain[ctx, iBase.CtxEntries[iCtx], FALSE];
ctxb[ctx].seList ← seChain;
FOR iSei ← iCtxb[iCtx].seList, iBase.NextSe[iSei] UNTIL iSei = ISENull
DO
sei ← seChain; seChain ← NextSe[seChain];
seb[sei].hash ← MapHti[iSeb[iSei].hash];
CopyCtxSeInfo[sei, iSei, mdi];
ENDLOOP};
seb[rSei] ← SERecord[
mark3: TRUE,
mark4: TRUE,
body: cons[
record[
machineDep: FALSE,
painted: FALSE, argument: TRUE,
hints: iSeb[irSei].hints,
fieldCtx: ctx,
length: iSeb[irSei].length,
monitored: FALSE,
linkPart: notLinked[]]]];
i ← TypeHash[mdi, irSei];
IF typeCache # NIL THEN typeCache[i] ← [mdi:mdi, iSei:irSei, sei:rSei]};
RETURN};
CopyIncludedValues: PROC [iCtx: CTXIndex, mdi: MDIndex, type: SEIndex]
RETURNS [ctx: IncludedCTXIndex] = {
iSei, sei, seChain: ISEIndex;
ctx ← MapCtx[mdi, iCtx];
iSei ← iCtxb[iCtx].seList;
IF iSei # SENull AND iSeb[iSeb[iSei].idType].seTag # id
THEN {
seChain ← MakeSeChain[ctx, iBase.CtxEntries[iCtx], FALSE];
ctxb[ctx].seList ← seChain;
ctxb[ctx].closed ← ctxb[ctx].reset ← TRUE;
UNTIL iSei = SENull
DO
sei ← seChain; seChain ← NextSe[seChain];
seb[sei].hash ← MapHti[iSeb[iSei].hash];
seb[sei].extended ← seb[sei].linkSpace ← FALSE;
seb[sei].immutable ← seb[sei].constant ← TRUE;
seb[sei].public ← iSeb[iSei].public;
seb[sei].idType ← type; seb[sei].idInfo ← 0;
seb[sei].idValue ← iSeb[iSei].idValue;
seb[sei].mark3 ← seb[sei].mark4 ← TRUE;
iSei ← iBase.NextSe[iSei];
ENDLOOP;
ctxb[ctx].complete ← TRUE};
RETURN};
-- included module accounting
ResetCtx: PROC [ctx: IncludedCTXIndex] = {
IF ~ctxb[ctx].reset THEN {ResetCtxList[ctx]; ctxb[ctx].closed ← ctxb[ctx].reset ← TRUE}};
ResetIncludeContexts: PROC = {
mdi: MDIndex;
limit: MDIndex = LOOPHOLE[Table.Bounds[mdType].size];
ctx: IncludedCTXIndex;
FOR mdi ← FIRST[MDIndex], mdi + SIZE[MDRecord] UNTIL mdi = limit
DO
FOR ctx ← mdb[mdi].ctx, ctxb[ctx].chain UNTIL ctx = CTXNull
DO ResetCtx[ctx] ENDLOOP;
ENDLOOP;
ResetCaches[]};
WrongTable: ERROR = CODE;
Outer: PUBLIC PROC [mdi: MDIndex, inner: PROC [SymbolTable.Base]] = {
IF mdi = LOOPHOLE[0] THEN ERROR WrongTable;
IF mdi # MDNull AND OpenIncludedTable[mdi]
THEN {inner[iBase ! UNWIND => CloseIncludedTable[]]; CloseIncludedTable[]}};
TableRelocated: PUBLIC SIGNAL = CODE;
OpenIncludedTable: PROC [mdi: MDIndex] RETURNS [success: BOOLEAN] = {
base: SymbolTable.Base =
IF mdi = OwnMdi THEN ownSymbols ELSE Copier.GetSymbolTable[mdi];
IF success ← (base # NIL)
THEN {iBase ← base; IF mdi # OwnMdi THEN iBase.notifier ← IRelocNotify; INotify[]};
RETURN};
IRelocNotify: PROC [base: SymbolTable.Base] = {
IF base = iBase THEN {INotify[]; SIGNAL TableRelocated}};
CloseIncludedTable: PROC = {
IF iBase # ownSymbols
THEN {iBase.notifier ← iBase.NullNotifier; Copier.FreeSymbolTable[iBase]};
iBase ← NIL};
END.