-- file Pass3P.Mesa
-- last modified by Satterthwaite, November 13, 1979 1:30 PM
DIRECTORY
ComData: FROM "comdata"
USING [bodyRoot, defBodyLimit, definitionsOnly, nBodies, textIndex],
Copier: FROM "copier" USING [CopyArgSe, CopyXferType],
Log: FROM "log" USING [Error, ErrorSei],
P3: FROM "p3",
Symbols: FROM "symbols"
USING [seType, ctxType, mdType, bodyType,
BodyInfo, BodyRecord, ContextLevel, StandardContext,
ISEIndex, CSEIndex, RecordSEIndex, CTXIndex, BTIndex, CBTIndex,
ISENull, RecordSENull, CTXNull, BTNull, HTNull,
lL, typeTYPE],
SymbolOps: FROM "symbolops"
USING [
CtxEntries, DelinkBti, FindExtension, FirstCtxSe, LinkBti,
MakeSeChain, NewCtx, NextLevel, NextSe,
ParentBti, SetSeLink, SearchContext, TransferTypes,
StaticNestError],
SystemDefs: FROM "systemdefs" USING [AllocateHeapNode, FreeHeapNode],
Table: FROM "table"
USING [Base, Notifier, AddNotify, Allocate, Bounds, DropNotify],
Tree: FROM "tree" USING [Index, Link, Map, Scan, Null, NullIndex, treeType],
TreeOps: FROM "treeops"
USING [
CopyTree, FreeNode, FreeTree, GetNode, ListTail, MakeList, PopTree,
PushNode, PushTree, ScanList, SetAttr, SetInfo, SetShared, Shared,
TestTree, UpdateList, UpdateTree];
Pass3P: PROGRAM
IMPORTS
Copier, Log, SymbolOps, SystemDefs, Table, TreeOps,
dataPtr: ComData
EXPORTS P3 =
BEGIN
OPEN TreeOps, SymbolOps, Symbols;
tb: Table.Base; -- tree base address (local copy)
seb: Table.Base; -- se table base address (local copy)
ctxb: Table.Base; -- context table base address (local copy)
mdb: Table.Base; -- module table base address (local copy)
bb: Table.Base; -- body table base address (local copy)
PostNotify: Table.Notifier =
BEGIN -- called by allocator whenever table area is repacked
tb ← base[Tree.treeType];
seb ← base[seType]; ctxb ← base[ctxType]; mdb ← base[mdType];
bb ← base[bodyType];
END;
-- driver
Postlude: PUBLIC PROCEDURE =
BEGIN
Table.AddNotify[PostNotify];
LinkImportedBodies[];
ExpandInlines[dataPtr.bodyRoot];
Table.DropNotify[PostNotify];
END;
-- included body copying
LinkImportedBodies: PROCEDURE =
BEGIN
bti, nextBti: BTIndex;
btLimit: BTIndex = LOOPHOLE[Table.Bounds[bodyType].size];
FOR bti ← LOOPHOLE[dataPtr.defBodyLimit], nextBti UNTIL bti = btLimit
DO
WITH body: bb[bti] SELECT FROM
Callable =>
BEGIN
IF body.inline THEN
BEGIN
body.link ← bb[dataPtr.bodyRoot].link;
bb[dataPtr.bodyRoot].link ← [sibling, bti];
END;
nextBti ← bti + (SELECT body.nesting FROM
Inner => SIZE[Inner Callable BodyRecord],
ENDCASE => SIZE[Outer Callable BodyRecord]);
END;
ENDCASE => nextBti ← bti + SIZE[Other BodyRecord];
ENDLOOP;
END;
-- inline expansion
-- state information
currentMaster: CBTIndex;
masterBody: Tree.Index;
copyCtx: CTXIndex;
copying: BOOLEAN;
substSafe: BOOLEAN;
currentEnclosing: BTIndex;
bodyNesting: CARDINAL;
aStack: AList; -- current association list
AItem: TYPE = RECORD [id: ISEIndex, name: BOOLEAN, val: Tree.Link];
ANode: TYPE = RECORD [
next: AList,
ctx: CTXIndex,
nItems: CARDINAL,
map: ARRAY [0..0) OF AItem];
AList: TYPE = POINTER TO ANode;
-- overall control
ExpandInlines: PROCEDURE [rootBti: BTIndex] =
BEGIN
bti: BTIndex;
aStack ← NIL; sharingMap ← NIL;
bti ← rootBti;
UNTIL bti = BTNull
DO
ExpandInlines[bb[bti].firstSon];
WITH body: bb[bti] SELECT FROM
Callable =>
IF body.inline THEN ExpandCalls[LOOPHOLE[bti, CBTIndex]];
ENDCASE;
bti ← IF bb[bti].link.which=parent THEN BTNull ELSE bb[bti].link.index;
ENDLOOP;
END;
ExpandCalls: PROCEDURE [bti: CBTIndex] =
BEGIN
saveIndex: CARDINAL = dataPtr.textIndex;
sei: ISEIndex = bb[bti].id;
current, subNode: Tree.Index;
WITH body: bb[bti].info SELECT FROM
Internal =>
BEGIN
currentMaster ← bti;
masterBody ← IF seb[sei].mark4
THEN GetNode[FindExtension[sei].tree]
ELSE body.bodyTree;
copying ← TRUE;
dataPtr.textIndex ← body.sourceIndex;
UNTIL (current ← body.thread) = Tree.NullIndex
DO
-- process the thread (son[1])
subNode ← GetNode[tb[current].son[1]];
tb[current].son[1] ← tb[subNode].son[1];
currentEnclosing ← tb[subNode].info;
body.thread ← GetNode[tb[subNode].son[2]];
tb[subNode].son[1] ← tb[subNode].son[2] ← Tree.Null;
FreeNode[subNode];
IF body.thread = Tree.NullIndex
AND (~dataPtr.definitionsOnly OR bb[bti].level > lL)
THEN copying ← FALSE;
IF ~RecursiveSubst[bti, currentEnclosing]
THEN ExpandCall[current]
ELSE Log.ErrorSei[recursiveInline, bb[bti].id];
ENDLOOP;
END;
ENDCASE => ERROR;
dataPtr.textIndex ← saveIndex;
END;
ExpandCall: PROCEDURE [node: Tree.Index] =
BEGIN
typeIn, typeOut: RecordSEIndex;
masterCtx: CTXIndex = bb[currentMaster].localCtx;
formalCtx: CTXIndex;
seChain, saveChain: ISEIndex;
nAssigns, nVars: CARDINAL;
extendedScope: BOOLEAN;
newBti: BTIndex;
t: Tree.Link;
IF tb[node].name = call THEN dataPtr.textIndex ← tb[node].info;
bodyNesting ← 0;
IF copying OR masterCtx = CTXNull
THEN copyCtx ← CTXNull
ELSE
BEGIN
saveChain ← ctxb[masterCtx].seList; ctxb[masterCtx].seList ← ISENull;
ctxb[masterCtx].level ← bb[currentEnclosing].level;
copyCtx ← masterCtx;
END;
[typeIn, typeOut] ← TransferTypes[bb[currentMaster].ioType];
substSafe ← tb[node].attr3 AND bb[currentMaster].hints.nameSafe;
nAssigns ← IF typeIn = RecordSENull
THEN 0
ELSE MapArgs[seb[typeIn].fieldCtx, node];
tb[node].son[2] ← FreeTree[tb[node].son[2]];
IF typeOut # RecordSENull AND RequiredFields[seb[typeOut].fieldCtx] THEN
BEGIN
formalCtx ← seb[typeOut].fieldCtx;
IF copyCtx = CTXNull THEN copyCtx ← NewCtx[bb[currentEnclosing].level];
seChain ← MakeSeChain[copyCtx, CtxVars[formalCtx], TRUE];
AppendSeChain[copyCtx, seChain];
MapIds[formalCtx, seChain, 0];
END;
IF tb[masterBody].son[1] # Tree.Null THEN
PushTree[ExpandOpens[tb[masterBody].son[1]]];
IF masterCtx # CTXNull THEN
IF ~copying
THEN AppendSeChain[copyCtx, saveChain]
ELSE
IF (nVars ← CtxVars[masterCtx]) # 0 THEN
BEGIN
IF copyCtx = CTXNull
THEN copyCtx ← NewCtx[bb[currentEnclosing].level];
seChain ← MakeSeChain[copyCtx, nVars, FALSE];
MapIds[masterCtx, seChain, 0];
AppendSeChain[copyCtx, seChain];
END;
-- expand the body
IF copyCtx # CTXNull THEN newBti ← MakeEnclosingBody[BTNull, copyCtx];
t ← ExpandDecls[tb[masterBody].son[2]];
PushTree[ExpandTree[tb[masterBody].son[3]]];
IF copyCtx = CTXNull
THEN extendedScope ← FALSE
ELSE
BEGIN
extendedScope ← nAssigns # 0 OR tb[masterBody].son[1] # Tree.Null
OR tb[masterBody].son[4] # Tree.Null;
PushTree[t]; PushNode[block, -2];
SetInfo[newBti]; SetAttr[3, extendedScope];
WITH body: bb[newBti].info SELECT FROM
Internal =>
BEGIN body.bodyTree ← GetNode[t ← PopTree[]]; PushTree[t] END;
ENDCASE => ERROR;
END;
IF tb[masterBody].son[1] # Tree.Null THEN
BEGIN PushNode[open, 2]; SetInfo[dataPtr.textIndex] END;
IF tb[masterBody].son[4] # Tree.Null THEN
BEGIN
PushTree[ExpandTree[tb[masterBody].son[4]]];
PushNode[lock, 2]; SetInfo[dataPtr.textIndex];
END;
IF masterCtx # CTXNull AND copying AND nVars # 0 THEN UnmapIds[explicit];
IF copyCtx # CTXNull THEN currentEnclosing ← ParentBti[currentEnclosing];
IF ~copying THEN PruneBody[masterBody];
-- complete the setup
IF tb[node].nSons > 2 THEN
BEGIN
PushTree[tb[node].son[3]]; tb[node].son[3] ← Tree.Null;
PushNode[enable, -2]; SetInfo[dataPtr.textIndex];
END;
IF typeOut # RecordSENull AND RequiredFields[seb[typeOut].fieldCtx] THEN
UnmapIds[implicit];
IF typeIn # RecordSENull THEN UnmapIds[implicit];
tb[node].son[2] ← MakeList[nAssigns+1];
IF copyCtx # CTXNull AND nAssigns # 0
THEN UpdateBodyNesting[tb[node].son[2], newBti];
tb[node].name ← IF tb[node].name = callx THEN substx ELSE subst;
tb[node].attr3 ← extendedScope;
ResetSharing[];
END;
RecursiveSubst: PROCEDURE [bti, parent: BTIndex] RETURNS [BOOLEAN] =
BEGIN
UNTIL parent = BTNull
DO
IF bti = parent THEN RETURN [TRUE];
parent ← ParentBti[parent];
ENDLOOP;
RETURN [FALSE]
END;
PruneBody: PROCEDURE [node: Tree.Index] =
BEGIN OPEN tb[node];
son[1] ← son[2] ← son[3] ← son[4] ← Tree.Null; name ← procinit;
END;
-- argument list testing/processing
NameSafe: PROCEDURE [sei: ISEIndex, t: Tree.Link] RETURNS [safe: BOOLEAN] =
BEGIN
RETURN [~bb[currentMaster].hints.argUpdated AND
(substSafe OR
(WITH t SELECT FROM
symbol => seb[index].immutable,
literal => TRUE,
subtree =>
SELECT tb[index].name FROM
cdot, uminus, loophole, clit, llit, cast, mwconst =>
NameSafe[sei, tb[index].son[1]],
ENDCASE => FALSE,
ENDCASE => FALSE))]
END;
CountVars: PROCEDURE [ctx: CTXIndex, t: Tree.Link] RETURNS [CARDINAL] =
BEGIN
n: CARDINAL;
sei: ISEIndex;
CountVar: Tree.Scan =
BEGIN
IF sei # ISENull THEN
BEGIN
IF ~NameSafe[sei, t] THEN n ← n+1;
sei ← NextSe[sei];
END;
END;
n ← 0; sei ← FirstCtxSe[ctx]; ScanList[t, CountVar];
RETURN [n]
END;
RequiredFields: PROCEDURE [ctx: CTXIndex] RETURNS [BOOLEAN] =
BEGIN
sei: ISEIndex;
FOR sei ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull
DO
IF seb[sei].hash = HTNull THEN RETURN [FALSE];
IF seb[sei].idInfo # 0 THEN RETURN [TRUE];
ENDLOOP;
RETURN [FALSE]
END;
ExpandTree: Tree.Map =
BEGIN
sNode, dNode: Tree.Index;
WITH t SELECT FROM
subtree =>
BEGIN sNode ← index;
IF tb[sNode].shared
THEN v ← ExpandShared[sNode]
ELSE
SELECT tb[sNode].name FROM
body => v ← ExpandBody[sNode];
block => v ← ExpandBlock[sNode];
do => v ← ExpandDo[sNode];
open, bind, bindx => v ← ExpandBinding[sNode];
subst, substx => v ← ExpandSubst[sNode];
thread => v ← ExpandThread[sNode];
ENDCASE =>
BEGIN
v ← IF copying
THEN CopyTree[[baseP:@tb, link:t], ExpandTree]
ELSE UpdateTree[t, ExpandTree];
WITH v SELECT FROM
subtree =>
BEGIN dNode ← index;
SELECT tb[dNode].name FROM
return => IF bodyNesting = 0 THEN UpdateReturn[dNode];
call, callx =>
IF TestTree[tb[dNode].son[1], thread]
THEN ThreadSubst[sNode, dNode];
ENDCASE => NULL;
END;
ENDCASE => NULL;
END;
END;
symbol => v ← ExpandSei[index];
ENDCASE => v ← t;
RETURN
END;
ExpandBlock: PROCEDURE [node: Tree.Index] RETURNS [v: Tree.Link] =
BEGIN
extendedScope: BOOLEAN = tb[node].attr3;
EnterBlock[node, extendedScope];
PushTree[ExpandDecls[tb[node].son[1]]];
PushTree[ExpandTree[tb[node].son[2]]];
IF copying
THEN
BEGIN
PushNode[block, 2]; SetInfo[tb[node].info]; SetAttr[3, extendedScope];
v ← PopTree[];
END
ELSE
BEGIN
tb[node].son[2] ← PopTree[]; tb[node].son[1] ← PopTree[];
v ← [subtree[index: node]];
END;
ExitBlock[GetNode[v]];
RETURN
END;
ExpandBody: PROCEDURE [node: Tree.Index] RETURNS [v: Tree.Link] =
BEGIN
i: CARDINAL;
EnterBody[node];
PushTree[ExpandOpens[tb[node].son[1]]];
PushTree[ExpandDecls[tb[node].son[2]]];
PushTree[ExpandTree[tb[node].son[3]]];
PushTree[ExpandTree[tb[node].son[4]]];
IF copying
THEN
BEGIN
PushNode[body, 4]; SetInfo[tb[node].info];
SetAttr[1, tb[node].attr1]; SetAttr[2, tb[node].attr2];
v ← PopTree[];
END
ELSE
BEGIN
FOR i DECREASING IN [1..4] DO tb[node].son[i] ← PopTree[] ENDLOOP;
v ← [subtree[index: node]];
END;
ExitBody[GetNode[v]];
RETURN
END;
ExpandDo: PROCEDURE [node: Tree.Index] RETURNS [v: Tree.Link] =
BEGIN
i: CARDINAL;
FOR i IN [1..2] DO PushTree[ExpandTree[tb[node].son[i]]] ENDLOOP;
PushTree[ExpandOpens[tb[node].son[3]]];
FOR i IN [4..6] DO PushTree[ExpandTree[tb[node].son[i]]] ENDLOOP;
IF copying
THEN
BEGIN
PushNode[do, 6]; SetInfo[tb[node].info];
SetAttr[1, tb[node].attr1]; SetAttr[2, tb[node].attr2];
v ← PopTree[];
END
ELSE
BEGIN
FOR i DECREASING IN [1..6] DO tb[node].son[i] ← PopTree[] ENDLOOP;
v ← [subtree[index: node]];
END;
RETURN
END;
ExpandBinding: PROCEDURE [node: Tree.Index] RETURNS [v: Tree.Link] =
BEGIN
i: CARDINAL;
nSons: CARDINAL = tb[node].nSons;
PushTree[ExpandOpens[tb[node].son[1]]];
FOR i IN [2..nSons] DO PushTree[ExpandTree[tb[node].son[i]]] ENDLOOP;
IF copying
THEN
BEGIN
PushNode[tb[node].name, nSons];
SetInfo[tb[node].info]; SetAttr[1, tb[node].attr1];
SetAttr[2, tb[node].attr2]; SetAttr[3, tb[node].attr3];
v ← PopTree[];
END
ELSE
BEGIN
FOR i DECREASING IN [1..nSons] DO tb[node].son[i] ← PopTree[] ENDLOOP;
v ← [subtree[index: node]];
END;
RETURN
END;
ExpandSubst: PROCEDURE [node: Tree.Index] RETURNS [v: Tree.Link] =
BEGIN
extendedScope: BOOLEAN = tb[node].attr3;
PushTree[ExpandTree[tb[node].son[1]]];
IF extendedScope THEN [] ← MapBlock[FindBlock[tb[node].son[2]]];
PushTree[ExpandTree[tb[node].son[2]]];
IF copying
THEN
BEGIN
PushNode[tb[node].name, 2];
SetInfo[tb[node].info]; SetAttr[3, tb[node].attr3]; v ← PopTree[];
END
ELSE
BEGIN
tb[node].son[2] ← PopTree[]; tb[node].son[1] ← PopTree[];
v ← [subtree[index: node]];
END;
RETURN
END;
ExpandThread: PROCEDURE [node: Tree.Index] RETURNS [v: Tree.Link] =
BEGIN
IF ~copying
THEN
BEGIN
tb[node].son[1] ← ExpandTree[tb[node].son[1]]; v ← [subtree[node]];
END
ELSE
BEGIN
PushTree[ExpandTree[tb[node].son[1]]]; PushTree[Tree.Null];
PushNode[thread, 2]; SetInfo[tb[node].info]; v ← PopTree[];
END;
RETURN
END;
UpdateReturn: PROCEDURE [node: Tree.Index] =
BEGIN
typeOut: RecordSEIndex;
sei: ISEIndex;
n: CARDINAL;
IF tb[node].son[1] = Tree.Null AND
(typeOut←TransferTypes[bb[currentMaster].ioType].typeOut) # RecordSENull
THEN
BEGIN
n ← 0;
FOR sei ← FirstCtxSe[seb[typeOut].fieldCtx], NextSe[sei] UNTIL sei = ISENull
DO PushTree[ExpandSei[sei]]; n ← n+1 ENDLOOP;
tb[node].son[1] ← MakeList[n];
END;
tb[node].name ← result;
END;
ExpandDecls: Tree.Map =
BEGIN
n: CARDINAL;
ExpandDecl: Tree.Scan =
BEGIN
node: Tree.Index;
LinkDecl: Tree.Scan =
BEGIN
sei: ISEIndex;
WITH t SELECT FROM
symbol =>
BEGIN sei ← index;
seb[sei].idValue ← node;
IF ~seb[sei].mark4 AND tb[node].son[3] = Tree.Null
THEN seb[sei].idInfo ← seb[sei].idInfo - 1;
END;
ENDCASE;
END;
copy: Tree.Link;
IF ~TestTree[t, typedecl] THEN
BEGIN
PushTree[copy ← ExpandTree[t]]; n ← n+1;
node ← GetNode[copy];
ScanList[tb[node].son[1], LinkDecl];
END;
END;
IF ~copying
THEN v ← ExpandTree[t]
ELSE BEGIN n ← 0; ScanList[t, ExpandDecl]; v ← MakeList[n] END;
RETURN
END;
SharingItem: TYPE = RECORD [old, new: Tree.Link, next: SharingList];
SharingList: TYPE = POINTER TO SharingItem;
sharingMap: SharingList;
MapShared: PROCEDURE [t, v: Tree.Link] =
BEGIN
p: SharingList ← SystemDefs.AllocateHeapNode[SIZE[SharingItem]];
p↑ ← [old:t, new:v, next:sharingMap]; sharingMap ← p;
SetShared[v, TRUE];
END;
ExpandShared: PROCEDURE [node: Tree.Index] RETURNS [v: Tree.Link] =
BEGIN
p: SharingList;
UpdateCount: Tree.Map =
BEGIN
WITH t SELECT FROM
symbol => IncrCount[index];
subtree => [] ← UpdateTree[t, UpdateCount];
ENDCASE => NULL;
RETURN [t]
END;
t: Tree.Link = [subtree[index: node]];
FOR p ← sharingMap, p.next UNTIL p = NIL
DO
IF p.old = t THEN GO TO Found;
REPEAT
Found => v ← p.new;
FINISHED => v ← t;
ENDLOOP;
IF copying THEN [] ← UpdateCount[v]; RETURN
END;
ResetSharing: PROCEDURE =
BEGIN
p: SharingList;
UNTIL sharingMap = NIL
DO
p ← sharingMap; sharingMap ← sharingMap.next;
SystemDefs.FreeHeapNode[p];
ENDLOOP;
END;
ExpandOpens: Tree.Map =
BEGIN
n: CARDINAL;
UpdateOpen: Tree.Scan =
BEGIN
node: Tree.Index = GetNode[t];
base: Tree.Link;
tb[node].son[1] ← ExpandTree[tb[node].son[1]];
IF ~Shared[base ← tb[node].son[2]]
THEN tb[node].son[2] ← ExpandTree[base]
ELSE
BEGIN
SetShared[base, FALSE]; base ← ExpandTree[base];
SetShared[base, TRUE]; tb[node].son[2] ← base;
END;
END;
ExpandOpen: Tree.Scan =
BEGIN
node: Tree.Index = GetNode[t];
base: Tree.Link = tb[node].son[2];
copy: Tree.Link;
PushTree[ExpandTree[tb[node].son[1]]];
IF ~Shared[base]
THEN PushTree[ExpandTree[base]]
ELSE
BEGIN
SetShared[base, FALSE]; PushTree[copy ← ExpandTree[base]];
SetShared[base, TRUE]; MapShared[base, copy];
END;
PushNode[item, 2]; SetInfo[tb[node].info]; n ← n+1;
END;
IF ~copying
THEN BEGIN ScanList[t, UpdateOpen]; v ← t END
ELSE BEGIN n ← 0; ScanList[t, ExpandOpen]; v ← MakeList[n] END;
RETURN
END;
-- blocks and bodies
FindBlock: PROCEDURE [t: Tree.Link] RETURNS [node: Tree.Index] =
BEGIN
DO
node ← GetNode[t];
SELECT tb[node].name FROM
list => t ← ListTail[t];
block => EXIT;
open, enable => t ← tb[node].son[2];
lock => t ← tb[node].son[1];
ENDCASE => ERROR;
ENDLOOP;
RETURN
END;
EnterBlock: PROCEDURE [node: Tree.Index, extendedScope: BOOLEAN] =
BEGIN
oldBti: BTIndex = tb[node].info;
oldCtx: CTXIndex = bb[oldBti].localCtx;
newBti: BTIndex;
newCtx: CTXIndex;
newCtx ← SELECT TRUE FROM
~extendedScope => MapBlock[node],
oldCtx = CTXNull, ~copying => oldCtx,
aStack = NIL OR aStack.ctx # oldCtx => ERROR,
ENDCASE => ImageContext[aStack];
newBti ← MakeEnclosingBody[IF copying THEN BTNull ELSE oldBti, newCtx];
END;
MapBlock: PROCEDURE [node: Tree.Index] RETURNS [newCtx: CTXIndex] =
BEGIN
oldBti: BTIndex = tb[node].info;
oldCtx: CTXIndex = bb[oldBti].localCtx;
seChain: ISEIndex;
SELECT TRUE FROM
oldCtx = CTXNull =>
newCtx ← CTXNull;
~copying =>
BEGIN
newCtx ← oldCtx; ctxb[newCtx].level ← bb[currentEnclosing].level;
END;
ENDCASE =>
BEGIN
newCtx ← NewCtx[bb[currentEnclosing].level];
seChain ← MakeSeChain[newCtx, CtxVars[oldCtx], FALSE];
AppendSeChain[newCtx, seChain];
MapIds[oldCtx, seChain, 0];
END;
RETURN
END;
ImageContext: PROCEDURE [aLink: AList] RETURNS [CTXIndex] =
BEGIN
RETURN [IF aLink.nItems = 0
THEN CTXNull
ELSE WITH aLink.map[0].val SELECT FROM
symbol => seb[index].idCtx,
ENDCASE => ERROR]
END;
ExitBlock: PROCEDURE [node: Tree.Index] =
BEGIN
oldBti: BTIndex = tb[node].info;
newBti: BTIndex = currentEnclosing;
tb[node].info ← newBti;
WITH body: bb[newBti].info SELECT FROM
Internal => body.bodyTree ← node;
ENDCASE;
IF copying AND bb[oldBti].localCtx # CTXNull THEN UnmapIds[explicit];
currentEnclosing ← ParentBti[currentEnclosing];
END;
MakeEnclosingBody: PROCEDURE [oldBti: BTIndex, ctx: CTXIndex] RETURNS [newBti: BTIndex] =
BEGIN
newSon: BTIndex;
IF oldBti = BTNull
THEN
BEGIN
newBti ← Table.Allocate[bodyType, SIZE[Other BodyRecord]];
newSon ← BTNull;
END
ELSE
BEGIN
newSon ← bb[oldBti].firstSon; DelinkBti[oldBti]; newBti ← oldBti;
END;
bb[newBti] ← BodyRecord[
link: ,
firstSon: newSon,
localCtx: ctx,
level: bb[currentEnclosing].level,
info: BodyInfo[Internal[
bodyTree: Tree.NullIndex,
sourceIndex: ,
thread: Tree.NullIndex,
frameSize: ]],
extension: Other[]];
LinkBti[bti: newBti, parent: currentEnclosing];
currentEnclosing ← newBti;
RETURN
END;
EnterBody: PROCEDURE [node: Tree.Index] =
BEGIN
oldBti: CBTIndex = tb[node].info;
newBti: CBTIndex;
type: CSEIndex;
level: ContextLevel = NextLevel[bb[currentEnclosing].level
!StaticNestError => BEGIN Log.Error[staticNesting]; RESUME END];
SetArgLevel: PROCEDURE [sei: RecordSEIndex] =
BEGIN
IF sei # RecordSENull THEN ctxb[seb[sei].fieldCtx].level ← level;
END;
bodyNesting ← bodyNesting + 1;
IF ~copying THEN DelinkBti[oldBti];
IF ~copying AND (bb[oldBti].level > lL) = (level > lL)
THEN BEGIN newBti ← oldBti; type ← bb[oldBti].ioType END
ELSE
BEGIN
id: ISEIndex;
ctx: CTXIndex;
IF level > lL
THEN
BEGIN
newBti ←Table.Allocate[bodyType, SIZE[Inner Callable BodyRecord]];
bb[newBti] ← [,,,,, Callable[,,,,,,,,,, Inner[frameOffset: ]]];
END
ELSE
BEGIN
newBti ←Table.Allocate[bodyType, SIZE[Outer Callable BodyRecord]];
bb[newBti] ← [,,,,, Callable[,,,,,,,,,, Outer[]]];
END;
IF ~copying
THEN
BEGIN
id ← bb[oldBti].id; type ← bb[oldBti].ioType;
ctx ← bb[oldBti].localCtx; ctxb[ctx].level ← level;
bb[newBti].firstSon ← bb[oldBti].firstSon;
END
ELSE
BEGIN
oldCtx: CTXIndex;
IF (id ← bb[oldBti].id) # ISENull THEN
id ← SearchContext[seb[id].hash, bb[currentEnclosing].localCtx];
type ← Copier.CopyXferType[bb[oldBti].ioType];
MapFormals[oldType: bb[oldBti].ioType, newType: type];
IF (oldCtx ← bb[oldBti].localCtx) = CTXNull
THEN ctx ← CTXNull
ELSE
BEGIN
ctx ← NewCtx[level];
ctxb[ctx].seList ← MakeSeChain[ctx, CtxVars[oldCtx], FALSE];
MapIds[oldCtx, ctxb[ctx].seList, 0];
END;
bb[newBti].firstSon ← BTNull;
dataPtr.nBodies ← dataPtr.nBodies+1;
END;
bb[newBti].localCtx ← ctx;
bb[newBti].info ← bb[oldBti].info;
bb[newBti].inline ← bb[oldBti].inline;
bb[newBti].resident ← bb[oldBti].resident;
bb[newBti].id ← id;
bb[newBti].ioType ← type;
bb[newBti].monitored ← bb[oldBti].monitored;
bb[newBti].stopping ← bb[oldBti].stopping;
bb[newBti].entry ← bb[oldBti].entry;
bb[newBti].internal ← bb[oldBti].internal;
bb[newBti].hints ← bb[oldBti].hints;
END;
bb[newBti].level ← level;
WITH seb[type] SELECT FROM
transfer =>
BEGIN SetArgLevel[inRecord]; SetArgLevel[outRecord] END;
ENDCASE;
LinkBti[bti: newBti, parent: currentEnclosing];
currentEnclosing ← newBti;
END;
ExitBody: PROCEDURE [node: Tree.Index] =
BEGIN
newBti: CBTIndex = LOOPHOLE[currentEnclosing];
ExitBlock[node];
IF copying THEN UnmapFormals[bb[newBti].ioType];
bodyNesting ← bodyNesting - 1;
END;
UpdateBodyNesting: PROCEDURE [list: Tree.Link, newBti: BTIndex] =
BEGIN
oldBti: BTIndex = ParentBti[newBti];
UpdateLinks: Tree.Map =
BEGIN
node: Tree.Index;
WITH t SELECT FROM
subtree =>
BEGIN node ← index;
SELECT tb[node].name FROM
block =>
BEGIN
bti: BTIndex = tb[node].info;
IF ParentBti[bti] = oldBti
THEN BEGIN DelinkBti[bti]; LinkBti[bti, newBti] END;
v ← t;
END;
thread =>
BEGIN
IF tb[node].info = oldBti THEN tb[node].info ← newBti;
tb[node].son[1] ← UpdateTree[tb[node].son[1], UpdateLinks];
v ← t;
END;
ENDCASE => v ← UpdateTree[t, UpdateLinks];
END;
ENDCASE => v ← t;
END;
UpdateItem: Tree.Scan =
BEGIN
node: Tree.Index;
WITH t SELECT FROM
subtree =>
BEGIN node ← index;
IF tb[node].name = assign
THEN tb[node].son[2] ← UpdateTree[tb[node].son[2], UpdateLinks];
END;
ENDCASE;
END;
ScanList[list, UpdateItem];
END;
-- id translation
AppendSeChain: PROCEDURE [ctx: CTXIndex, chain: ISEIndex] =
BEGIN
last, next: ISEIndex;
SELECT TRUE FROM
chain = ISENull => NULL;
(last ← ctxb[ctx].seList) = ISENull => ctxb[ctx].seList ← chain;
ENDCASE =>
BEGIN
UNTIL (next ← NextSe[last]) = ISENull DO last ← next ENDLOOP;
SetSeLink[last, chain];
END;
END;
CtxVars: PROCEDURE [ctx: CTXIndex] RETURNS [n: CARDINAL] =
BEGIN
sei: ISEIndex;
n ← 0;
FOR sei ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull
DO
IF seb[sei].idType # typeTYPE THEN n ← n+1;
ENDLOOP;
RETURN
END;
AllocateAList: PROCEDURE [ctx: CTXIndex] RETURNS [aLink: AList] =
BEGIN
maxItems: CARDINAL = CtxEntries[ctx];
aLink ← SystemDefs.AllocateHeapNode[SIZE[ANode] + maxItems*SIZE[AItem]];
aLink↑ ← [next:NIL, ctx:ctx, nItems:0, map:];
END;
FreeAList: PROCEDURE [aLink: AList] = SystemDefs.FreeHeapNode;
-- mapping
MapArgs: PROCEDURE [formalCtx: CTXIndex, node: Tree.Index] RETURNS [nAssigns: CARDINAL] =
BEGIN
nVars: CARDINAL;
seChain: ISEIndex;
sei1, sei2: ISEIndex;
aLink: AList;
MapArg: Tree.Map =
BEGIN
name: BOOLEAN;
val: Tree.Link;
IF sei1 = ISENull
THEN v ← t
ELSE
BEGIN
IF TestTree[t, safen]
THEN
BEGIN
node: Tree.Index ← GetNode[t];
t ← tb[node].son[1];
tb[node].son[1] ← Tree.Null; FreeNode[node];
END;
IF NameSafe[sei1, t]
THEN BEGIN name ← TRUE; val ← t END
ELSE
BEGIN
Copier.CopyArgSe[sei2, sei1];
IF seb[sei2].mark4 THEN seb[sei2].idValue ← Tree.NullIndex;
seb[sei2].mark4 ← FALSE; seb[sei2].idInfo ← 0;
name ← FALSE; val ← [symbol[index: sei2]];
IF t # Tree.Null THEN
BEGIN
PushTree[val]; PushTree[t];
PushNode[assign, 2]; SetInfo[dataPtr.textIndex];
IncrCount[sei2]; nAssigns ← nAssigns + 1;
END;
sei2 ← NextSe[sei2];
END;
aLink.map[aLink.nItems] ← [id: sei1, name: name, val: val];
aLink.nItems ← aLink.nItems + 1;
sei1 ← NextSe[sei1]; v ← Tree.Null;
END;
RETURN
END;
aLink ← AllocateAList[formalCtx];
IF (nVars ← CountVars[formalCtx, tb[node].son[2]]) = 0
THEN seChain ← ISENull
ELSE
BEGIN
IF copyCtx = CTXNull
THEN copyCtx ← NewCtx[bb[currentEnclosing].level];
seChain ← MakeSeChain[copyCtx, nVars, TRUE];
AppendSeChain[copyCtx, seChain];
END;
sei1 ← FirstCtxSe[formalCtx]; sei2 ← seChain; nAssigns ← 0;
tb[node].son[2] ← UpdateList[tb[node].son[2], MapArg];
PushAList[aLink];
RETURN
END;
MapIds: PROCEDURE [ctx: CTXIndex, chain: ISEIndex, nRefs: [0..1]] =
BEGIN
sei1, sei2: ISEIndex;
aLink: AList = AllocateAList[ctx];
sei1 ← FirstCtxSe[ctx]; sei2 ← chain;
UNTIL sei1 = ISENull
DO
IF seb[sei1].idType # typeTYPE THEN
BEGIN
Copier.CopyArgSe[sei2, sei1];
IF seb[sei2].mark4 THEN seb[sei2].idValue ← Tree.NullIndex;
seb[sei2].idInfo ← nRefs;
aLink.map[aLink.nItems] ←
[id: sei1, name: FALSE, val: [symbol[index:sei2]]];
aLink.nItems ← aLink.nItems + 1;
sei2 ← NextSe[sei2];
END;
sei1 ← NextSe[sei1];
ENDLOOP;
PushAList[aLink];
END;
UnmapIds: PROCEDURE [decl: {implicit, explicit}] =
BEGIN
i: CARDINAL;
aLink: AList ← PopAList[];
FOR i IN [0..aLink.nItems)
DO
WITH aLink.map[i].val SELECT FROM
symbol =>
IF decl = implicit AND ~aLink.map[i].name
THEN seb[index].mark4 ← TRUE;
ENDCASE;
aLink.map[i].val ← FreeTree[aLink.map[i].val];
ENDLOOP;
FreeAList[aLink];
END;
MapFields: PROCEDURE [oldRecord, newRecord: RecordSEIndex, nRefs: [0..1]] =
BEGIN
sei1, sei2: ISEIndex;
aLink: AList;
IF oldRecord # RecordSENull THEN
BEGIN
aLink ← AllocateAList[seb[oldRecord].fieldCtx];
sei1 ← FirstCtxSe[seb[oldRecord].fieldCtx];
sei2 ← FirstCtxSe[seb[newRecord].fieldCtx];
UNTIL sei1 = ISENull
DO
seb[sei2].idInfo ← nRefs;
aLink.map[aLink.nItems] ←
[id: sei1, name: FALSE, val: [symbol[index:sei2]]];
aLink.nItems ← aLink.nItems + 1;
sei1 ← NextSe[sei1]; sei2 ← NextSe[sei2];
ENDLOOP;
PushAList[aLink];
END;
END;
MapFormals: PROCEDURE [oldType, newType: CSEIndex] =
BEGIN
WITH new: seb[newType] SELECT FROM
transfer =>
WITH old: seb[oldType] SELECT FROM
transfer =>
BEGIN
MapFields[old.inRecord, new.inRecord, 1];
MapFields[old.outRecord, new.outRecord, 0];
END;
ENDCASE => ERROR;
ENDCASE;
END;
UnmapFormals: PROCEDURE [type: CSEIndex] =
BEGIN
WITH seb[type] SELECT FROM
transfer =>
BEGIN
IF outRecord # RecordSENull THEN UnmapIds[implicit];
IF inRecord # RecordSENull THEN UnmapIds[implicit];
END;
ENDCASE;
END;
-- association lists
PushAList: PROCEDURE [aLink: AList] =
BEGIN
aLink.next ← aStack; aStack ← aLink;
END;
PopAList: PROCEDURE RETURNS [aLink: AList] =
BEGIN
IF aStack = NIL THEN ERROR;
aLink ← aStack; aStack ← aLink.next;
END;
ExpandSei: PROCEDURE [sei: ISEIndex] RETURNS [v: Tree.Link] =
BEGIN
aLink: AList;
i: CARDINAL;
FOR aLink ← aStack, aLink.next UNTIL aLink = NIL
DO
IF seb[sei].idCtx = aLink.ctx THEN
FOR i IN [0 .. aLink.nItems)
DO
IF aLink.map[i].id = sei THEN GO TO Found;
ENDLOOP;
REPEAT
Found =>
BEGIN
saveCopying: BOOLEAN = copying;
copying ← TRUE; v ← ExpandTree[aLink.map[i].val];
copying ← saveCopying;
END;
FINISHED =>
BEGIN
IF copying THEN IncrCount[sei];
v ← [symbol[index:sei]];
END;
ENDLOOP;
RETURN
END;
IncrCount: PROCEDURE [sei: ISEIndex] = -- modified BumpCount (Pass3I)
BEGIN
ctx: CTXIndex;
IF seb[sei].idType # typeTYPE AND
(~seb[sei].mark4
OR (~seb[sei].constant
AND (ctx ← seb[sei].idCtx) ~IN StandardContext
AND ctxb[ctx].ctxType # included))
THEN seb[sei].idInfo ← seb[sei].idInfo + 1;
END;
-- nested calls
ThreadSubst: PROCEDURE [sNode, dNode: Tree.Index] =
BEGIN
sThread, dThread: Tree.Index;
dThread ← GetNode[tb[dNode].son[1]];
IF sNode # Tree.NullIndex AND sNode # dNode THEN
BEGIN
DO
sThread ← GetNode[tb[sNode].son[1]];
IF tb[sThread].son[2] = Tree.Null THEN EXIT;
sNode ← GetNode[tb[sThread].son[2]];
ENDLOOP;
tb[sThread].son[2] ← [subtree[index: dNode]];
tb[dThread].son[2] ← Tree.Null;
END;
tb[dThread].info ← currentEnclosing;
END;
END.