ExpandInlines:
PROC [rootBti: BTIndex] = {
bti: BTIndex ← rootBti;
aStack ← NIL; sharingMap ← NIL;
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};
ExpandCalls:
PROC [bti: CBTIndex] = {
saveIndex: CARDINAL = dataPtr.textIndex;
sei: ISEIndex = bb[bti].id;
current, subNode: Tree.Index;
dataPtr.textIndex ← bb[bti].sourceIndex;
WITH body: bb[bti].info
SELECT
FROM
Internal => {
currentMaster ← bti;
IF seb[sei].mark4
THEN {
t: Tree.Link = FindExtension[sei].tree;
ComputeArgCounts[bb[bti].ioType, t];
masterBody ← GetNode[t]}
ELSE masterBody ← body.bodyTree;
copying ← TRUE;
UNTIL (current ← body.thread) = Tree.NullIndex
DO
discard: BOOL;
process the thread (son[1])
subNode ← GetNode[tb[current].son[1]];
discard ← tb[subNode].attr1;
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];
tb[current].shared ← FALSE;
IF body.thread = Tree.NullIndex
AND (~dataPtr.interface OR bb[bti].level > lL) THEN copying ← FALSE;
SELECT
TRUE
FROM
discard => DiscardCall[current];
~RecursiveSubst[bti, currentEnclosing] => ExpandCall[current]
ENDCASE => Log.ErrorSei[recursiveInline, bb[bti].id];
ENDLOOP};
ENDCASE => ERROR;
dataPtr.textIndex ← saveIndex};
DiscardCall:
PROC [node: Tree.Index] =
INLINE {
-- orphan subtree
[] ← DiscardTree[[subtree[node]]]};
ExpandCall:
PROC [node: Tree.Index] = {
typeIn, typeOut: RecordSEIndex;
masterCtx: CTXIndex = bb[currentMaster].localCtx;
formalCtx: CTXIndex;
seChain, saveChain: ISEIndex;
nAssigns, nVars: CARDINAL;
extendedScope: BOOL;
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 {
saveChain ← ctxb[masterCtx].seList; ctxb[masterCtx].seList ← ISENull;
ctxb[masterCtx].level ← bb[currentEnclosing].level;
copyCtx ← masterCtx};
[typeIn, typeOut] ← TransferTypes[bb[currentMaster].ioType];
substSafe ← tb[node].attr3 AND bb[currentMaster].hints.nameSafe;
nAssigns ←
SELECT
TRUE
FROM
(typeIn = RecordSENull) => 0,
tb[node].attr1 => ExtractArgs[typeIn, seb[typeIn].fieldCtx, node],
ENDCASE => MapArgs[seb[typeIn].fieldCtx, node];
tb[node].son[2] ← FreeTree[tb[node].son[2]];
IF RequiredFields[typeOut]
THEN {
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]};
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 {
IF copyCtx = CTXNull THEN copyCtx ← NewCtx[bb[currentEnclosing].level];
seChain ← MakeSeChain[copyCtx, nVars, FALSE];
MapIds[masterCtx, seChain, 0];
AppendSeChain[copyCtx, seChain]};
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 {
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];
SetAttr[1, tb[masterBody].attr1]; SetAttr[2, tb[masterBody].attr2];
WITH body: bb[newBti].info
SELECT
FROM
Internal => {body.bodyTree ← GetNode[t←PopTree[]]; PushTree[t]};
ENDCASE => ERROR};
IF tb[masterBody].son[1] # Tree.Null
THEN {
PushNode[open, 2]; SetInfo[dataPtr.textIndex]};
IF tb[masterBody].son[4] # Tree.Null
THEN {
PushTree[ExpandTree[tb[masterBody].son[4]]];
PushNode[lock, 2]; SetInfo[dataPtr.textIndex]};
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 {
PushTree[tb[node].son[3]]; tb[node].son[3] ← Tree.Null;
PushNode[enable, -2]; SetInfo[dataPtr.textIndex]; SetAttr[3, TRUE]};
IF RequiredFields[typeOut] 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].attr1 ← tb[masterBody].attr1; tb[node].attr2 ← tb[masterBody].attr2;
tb[node].attr3 ← extendedScope;
sharingMap ← NIL};
RecursiveSubst:
PROC [bti, parent: BTIndex]
RETURNS [
BOOL] = {
UNTIL parent = BTNull
DO
IF bti = parent THEN RETURN [TRUE];
parent ← ParentBti[parent];
ENDLOOP;
RETURN [FALSE]};
PruneBody:
PROC [node: Tree.Index] = {
OPEN tb[node];
son[1] ← son[2] ← son[3] ← son[4] ← Tree.Null; name ← procinit};
DiscardTree: Tree.Map = {
IF t # Tree.Null
THEN
WITH t
SELECT
FROM
subtree => {
node: Tree.Index ← index;
SELECT tb[node].name
FROM
call, callx =>
IF OpName[tb[node].son[1]] = thread
THEN {
mark for later discard (see DiscardCall)
subNode: Tree.Index = GetNode[tb[node].son[1]];
tb[subNode].attr1 ← TRUE}
ELSE {
[] ← UpdateLeaves[t, DiscardTree]; FreeNode[node]};
ENDCASE =>
IF ~tb[node].shared
THEN {
[] ← UpdateLeaves[t, DiscardTree]; FreeNode[node]}};
ENDCASE;
RETURN [Tree.Null]};
ExpandTree: Tree.Map = {
WITH t
SELECT
FROM
symbol => v ← ExpandSei[index];
subtree => {
sNode: Tree.Index = index;
IF tb[sNode].shared
THEN
v ←
SELECT tb[sNode].name
FROM
call, callx => ExpandThreadedCall[sNode],
ENDCASE => ExpandShared[sNode]
ELSE
SELECT tb[sNode].name
FROM
body => v ← ExpandBody[sNode];
block => v ← ExpandBlock[sNode, tb[sNode].attr3];
ditem => v ← ExpandBlock[sNode, FALSE];
do => v ← ExpandDo[sNode];
open, bind, bindx => v ← ExpandBinding[sNode];
subst, substx => v ← ExpandSubst[sNode];
lock => v ← ExpandLock[sNode];
thread => v ← ExpandThread[sNode];
ENDCASE => {
v ←
IF copying
THEN CopyTree[[baseP:@tb, link:t], ExpandTree]
ELSE UpdateLeaves[t, ExpandTree];
WITH v
SELECT
FROM
subtree => {
dNode: Tree.Index = index;
SELECT tb[dNode].name
FROM
return => IF bodyNesting = 0 THEN UpdateReturn[dNode];
xerror => IF bodyNesting = 0 THEN tb[dNode].attr3 ← TRUE;
ENDCASE => NULL};
ENDCASE => NULL}};
ENDCASE => v ← t;
RETURN};
RewriteNode:
PROC [node: Tree.Index, nSons:
CARDINAL]
RETURNS [Tree.Link] = {
FOR i: CARDINAL DECREASING IN [1 .. nSons] DO tb[node].son[i] ← PopTree[] ENDLOOP;
RETURN [[subtree[index: node]]]};
CopyNode:
PROC [node: Tree.Index, nSons:
CARDINAL]
RETURNS [Tree.Link] = {
PushNode[tb[node].name, nSons]; SetInfo[tb[node].info];
SetAttr[1, tb[node].attr1]; SetAttr[2, tb[node].attr2]; SetAttr[3, tb[node].attr3];
RETURN [PopTree[]]};
ExpandBlock:
PROC [node: Tree.Index, extendedScope:
BOOL]
RETURNS [v: Tree.Link] = {
EnterBlock[node, extendedScope];
PushTree[ExpandDecls[tb[node].son[1]]];
PushTree[ExpandTree[tb[node].son[2]]];
v ← IF copying THEN CopyNode[node, 2] ELSE RewriteNode[node, 2];
ExitBlock[GetNode[v]];
RETURN};
ExpandBody:
PROC [node: Tree.Index]
RETURNS [v: Tree.Link] = {
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]]];
v ← IF copying THEN CopyNode[node, 4] ELSE RewriteNode[node, 4];
ExitBody[GetNode[v]];
RETURN};
ExpandDo:
PROC [node: Tree.Index]
RETURNS [v: Tree.Link] = {
decl: BOOL;
subNode: Tree.Index;
IF tb[node].son[1] = Tree.Null THEN decl ← FALSE
ELSE {subNode ← GetNode[tb[node].son[1]]; decl ← OpName[tb[subNode].son[1]] = decl};
IF decl
THEN {
nSons: CARDINAL = tb[subNode].nSons;
EnterBlock[subNode, FALSE];
PushTree[ExpandDecls[tb[subNode].son[1]]];
FOR i: CARDINAL IN [2..nSons] DO PushTree[ExpandTree[tb[subNode].son[i]]] ENDLOOP;
IF copying THEN {PushNode[tb[subNode].name, nSons]; SetInfo[tb[subNode].info]}
ELSE PushTree[RewriteNode[subNode, nSons]]}
ELSE PushTree[ExpandTree[tb[node].son[1]]];
PushTree[ExpandTree[tb[node].son[2]]];
PushTree[ExpandOpens[tb[node].son[3]]];
FOR i: CARDINAL IN [4..6] DO PushTree[ExpandTree[tb[node].son[i]]] ENDLOOP;
v ← IF copying THEN CopyNode[node, 6] ELSE RewriteNode[node, 6];
IF decl
THEN {
newNode: Tree.Index = GetNode[v];
ExitBlock[GetNode[tb[newNode].son[1]], newNode]};
RETURN};
ExpandBinding:
PROC [node: Tree.Index]
RETURNS [Tree.Link] = {
nSons: CARDINAL = tb[node].nSons;
PushTree[ExpandOpens[tb[node].son[1]]];
FOR i: CARDINAL IN [2..nSons] DO PushTree[ExpandTree[tb[node].son[i]]] ENDLOOP;
RETURN [IF copying THEN CopyNode[node, nSons] ELSE RewriteNode[node, nSons]]};
ExpandSubst:
PROC [node: Tree.Index]
RETURNS [Tree.Link] = {
extendedScope: BOOL = tb[node].attr3;
PushTree[ExpandTree[tb[node].son[1]]];
IF extendedScope THEN MapBlock[FindBlock[tb[node].son[2]]];
PushTree[ExpandTree[tb[node].son[2]]];
RETURN [IF copying THEN CopyNode[node, 2] ELSE RewriteNode[node, 2]]};
ExpandThreadedCall:
PROC [node: Tree.Index]
RETURNS [v: Tree.Link] = {
nSons: CARDINAL = tb[node].nSons;
FOR i: CARDINAL IN [1 .. nSons] DO PushTree[ExpandTree[tb[node].son[i]]] ENDLOOP;
v ← IF copying THEN CopyNode[node, nSons] ELSE RewriteNode[node, nSons];
ThreadSubst[node, v];
RETURN};
ExpandThread:
PROC [node: Tree.Index]
RETURNS [v: Tree.Link] = {
IF ~copying THEN {tb[node].son[1] ← ExpandTree[tb[node].son[1]]; v ← [subtree[node]]}
ELSE {
PushTree[ExpandTree[tb[node].son[1]]]; PushTree[Tree.Null];
PushNode[thread, 2]; SetInfo[tb[node].info]; v ← PopTree[]};
RETURN};
ExpandLock:
PROC [node: Tree.Index]
RETURNS [v: Tree.Link] = {
PushTree[ExpandTree[tb[node].son[2]]];
PushTree[ExpandTree[tb[node].son[1]]];
IF copying THEN {PushNode[lock, -2]; SetInfo[tb[node].info]; v ← PopTree[]}
ELSE {
tb[node].son[1] ← PopTree[]; tb[node].son[2] ← PopTree[];
v ← [subtree[index: node]]};
RETURN};
UpdateReturn:
PROC [node: Tree.Index] = {
typeOut: RecordSEIndex;
IF tb[node].son[1] = Tree.Null
AND
(typeOut←TransferTypes[bb[currentMaster].ioType].typeOut) # RecordSENull
THEN {
n: CARDINAL ← 0;
FOR sei: ISEIndex ← FirstCtxSe[FieldCtx[typeOut]], NextSe[sei]
UNTIL sei = ISENull
DO
PushTree[ExpandSei[sei]]; n ← n+1 ENDLOOP;
tb[node].son[1] ← MakeList[n]};
tb[node].name ← result};
ExpandDecls: Tree.Map = {
n: CARDINAL;
ExpandDecl: Tree.Scan = {
node: Tree.Index;
LinkDecl: Tree.Scan = {
WITH t
SELECT
FROM
symbol => {
sei: ISEIndex = index;
seb[sei].idValue ← node;
IF ~seb[sei].mark4
AND tb[node].son[3] = Tree.Null
AND ~seb[sei].immutable
THEN
seb[sei].idInfo ← seb[sei].idInfo - 1};
ENDCASE};
copy: Tree.Link;
IF OpName[t] # typedecl
THEN {
PushTree[copy ← ExpandTree[t]]; n ← n+1;
node ← GetNode[copy];
ScanList[tb[node].son[1], LinkDecl]}};
IF OpName[t] = initlist
THEN {
node: Tree.Index = GetNode[t];
PushTree[ExpandTree[tb[node].son[1]]];
PushTree[ExpandDecls[tb[node].son[2]]];
IF copying THEN {PushNode[initlist, 2]; SetInfo[tb[node].info]; v ← PopTree[]}
ELSE v ← RewriteNode[node, 2]}
ELSE
IF copying THEN {n ← 0; ScanList[t, ExpandDecl]; v ← MakeList[n]}
ELSE v ← ExpandTree[t];
RETURN};
SharingItem: TYPE = RECORD [old, new: Tree.Link, next: SharingList];
SharingList: TYPE = REF SharingItem;
sharingMap: SharingList;
MapShared:
PROC [t, v: Tree.Link] = {
p: SharingList ← NEW[SharingItem];
p^ ← [old:t, new:v, next:sharingMap]; sharingMap ← p;
MarkShared[v, TRUE]};
ExpandShared:
PROC [node: Tree.Index]
RETURNS [v: Tree.Link] = {
target: Tree.Link = [subtree[index: node]];
UpdateCount: Tree.Scan = {
WITH t
SELECT
FROM
symbol => IncrCount[index];
subtree => ScanSons[t, UpdateCount];
ENDCASE => NULL};
FOR p: SharingList ← sharingMap, p.next
UNTIL p =
NIL
DO
IF p.old = target THEN GO TO Found;
REPEAT
Found => v ← p.new;
FINISHED => v ← target;
ENDLOOP;
IF copying THEN UpdateCount[v]; RETURN};
ExpandOpens: Tree.Map = {
n: CARDINAL;
UpdateOpen: Tree.Scan = {
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 {
MarkShared[base, FALSE]; base ← ExpandTree[base];
MarkShared[base, TRUE]; tb[node].son[2] ← base}};
ExpandOpen: Tree.Scan = {
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 {
MarkShared[base, FALSE]; PushTree[copy ← ExpandTree[base]];
MarkShared[base, TRUE]; MapShared[base, copy]};
PushNode[item, 2]; SetInfo[tb[node].info]; n ← n+1};
IF ~copying THEN {ScanList[t, UpdateOpen]; v ← t}
ELSE {n ← 0; ScanList[t, ExpandOpen]; v ← MakeList[n]};
RETURN};
FindBlock:
PROC [t: Tree.Link]
RETURNS [node: Tree.Index] = {
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};
EnterBlock:
PROC [node: Tree.Index, extendedScope:
BOOL] =
INLINE {
IF ~extendedScope THEN MapBlock[node]};
MapBlock:
PROC [node: Tree.Index] = {
oldBti: BTIndex = tb[node].info;
oldCtx: CTXIndex = bb[oldBti].localCtx;
seChain: ISEIndex;
newCtx: CTXIndex;
SELECT
TRUE
FROM
oldCtx = CTXNull => newCtx ← CTXNull;
~copying => {newCtx ← oldCtx; ctxb[newCtx].level ← bb[currentEnclosing].level};
ENDCASE => {
newCtx ← NewCtx[bb[currentEnclosing].level];
seChain ← MakeSeChain[newCtx, CtxVars[oldCtx], FALSE];
AppendSeChain[newCtx, seChain];
MapIds[oldCtx, seChain, 0]};
[] ← MakeEnclosingBody[IF copying THEN BTNull ELSE oldBti, newCtx];
RETURN};
ExitBlock:
PROC [node: Tree.Index, bodyNode: Tree.Index ← Tree.NullIndex] = {
oldBti: BTIndex = tb[node].info;
newBti: BTIndex = currentEnclosing;
tb[node].info ← newBti;
WITH body: bb[newBti].info
SELECT
FROM
Internal => body.bodyTree ← IF bodyNode = Tree.NullIndex THEN node ELSE bodyNode;
ENDCASE;
IF copying AND bb[oldBti].localCtx # CTXNull THEN UnmapIds[explicit];
currentEnclosing ← ParentBti[currentEnclosing]};
MakeEnclosingBody:
PROC [oldBti: BTIndex, ctx: CTXIndex]
RETURNS [newBti: BTIndex] = {
newSon: BTIndex;
IF oldBti = BTNull
THEN {
newBti ← (dataPtr.table).Words[bodyType, BodyRecord.Other.SIZE]; newSon ← BTNull}
ELSE {newSon ← bb[oldBti].firstSon; DelinkBti[oldBti]; newBti ← oldBti};
bb[newBti] ← BodyRecord[
link: ,
firstSon: newSon,
type: BodyType[ctx],
localCtx: ctx, level: bb[currentEnclosing].level,
sourceIndex: ,
info: BodyInfo[Internal[
bodyTree: Tree.NullIndex,
thread: Tree.NullIndex,
frameSize: ]],
extension: Other[relOffset: ]];
LinkBti[bti: newBti, parent: currentEnclosing];
currentEnclosing ← newBti;
RETURN};
EnterBody:
PROC [node: Tree.Index] = {
oldBti: CBTIndex = tb[node].info;
newBti: CBTIndex;
ioType: CSEIndex;
type: RecordSEIndex;
level: ContextLevel = NextLevel[bb[currentEnclosing].level
! StaticNestError => {Log.Error[staticNesting]; RESUME}];
SetArgLevel:
PROC [sei: CSEIndex] = {
ctx: CTXIndex = ArgCtx[sei];
IF ctx # CTXNull THEN ctxb[ctx].level ← level};
ctx: CTXIndex;
bodyNesting ← bodyNesting + 1;
IF ~copying THEN DelinkBti[oldBti];
IF ~copying
AND (bb[oldBti].level > lL) = (level > lL)
THEN {
ctx ← bb[oldBti].localCtx;
IF ctx # CTXNull THEN ctxb[ctx].level ← level;
ioType ← bb[oldBti].ioType; type ← bb[oldBti].type;
newBti ← oldBti}
ELSE {
id: ISEIndex;
IF level > lL
THEN {
newBti ← (dataPtr.table).Words[bodyType, BodyRecord.Callable.Inner.SIZE];
bb[newBti] ← [,,,,,,, Callable[,,,,,,,,,, Inner[frameOffset: ]]]}
ELSE {
newBti ← (dataPtr.table).Words[bodyType, BodyRecord.Callable.Outer.SIZE];
bb[newBti] ← [,,,,,,, Callable[,,,,,,,,,, Outer[]]]};
IF ~copying
THEN {
ctx ← bb[oldBti].localCtx;
IF ctx # CTXNull THEN ctxb[ctx].level ← level;
id ← bb[oldBti].id; ioType ← bb[oldBti].ioType; type ← bb[oldBti].type;
bb[newBti].firstSon ← bb[oldBti].firstSon}
ELSE {
oldCtx: CTXIndex;
IF (id ← bb[oldBti].id) # ISENull
THEN
id ← SearchContext[seb[id].hash, bb[currentEnclosing].localCtx];
ioType ← CopyXferType[bb[oldBti].ioType, NIL];
MapFormals[oldType: bb[oldBti].ioType, newType: ioType];
IF (oldCtx ← bb[oldBti].localCtx) = CTXNull THEN ctx ← CTXNull
ELSE {
ctx ← NewCtx[level];
ctxb[ctx].seList ← MakeSeChain[ctx, CtxVars[oldCtx], FALSE];
MapIds[oldCtx, ctxb[ctx].seList, 0]};
type ← BodyType[ctx];
bb[newBti].firstSon ← BTNull;
dataPtr.nBodies ← dataPtr.nBodies+1;
IF level > lL THEN dataPtr.nInnerBodies ← dataPtr.nInnerBodies+1};
bb[newBti].type ← type;
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 ← ioType;
bb[newBti].monitored ← bb[oldBti].monitored;
bb[newBti].entry ← bb[oldBti].entry; bb[newBti].internal ← bb[oldBti].internal;
bb[newBti].noXfers ← bb[oldBti].noXfers;
bb[newBti].hints ← bb[oldBti].hints};
bb[newBti].level ← level;
WITH t: seb[ioType]
SELECT
FROM
transfer => {SetArgLevel[t.typeIn]; SetArgLevel[t.typeOut]};
ENDCASE;
LinkBti[bti: newBti, parent: currentEnclosing];
currentEnclosing ← newBti};
ExitBody:
PROC [node: Tree.Index] = {
newBti: CBTIndex = LOOPHOLE[currentEnclosing];
ExitBlock[node];
IF copying THEN UnmapFormals[bb[newBti].ioType];
bodyNesting ← bodyNesting - 1};
UpdateBodyNesting:
PROC [list: Tree.Link, newBti: BTIndex] = {
oldBti: BTIndex = ParentBti[newBti];
UpdateLinks: Tree.Map = {
WITH t
SELECT
FROM
subtree => {
node: Tree.Index = index;
SELECT tb[node].name
FROM
block => {
bti: BTIndex = tb[node].info;
IF ParentBti[bti] = oldBti THEN {DelinkBti[bti]; LinkBti[bti, newBti]};
v ← t};
thread => {
IF tb[node].info = oldBti THEN tb[node].info ← newBti;
tb[node].son[1] ← UpdateLeaves[tb[node].son[1], UpdateLinks];
v ← t};
ENDCASE => v ← UpdateLeaves[t, UpdateLinks]};
ENDCASE => v ← t};
UpdateItem: Tree.Scan = {
WITH t
SELECT
FROM
subtree => {
node: Tree.Index = index;
SELECT tb[node].name
FROM
assign, extract =>
tb[node].son[2] ← UpdateLeaves[tb[node].son[2], UpdateLinks];
ENDCASE};
ENDCASE};
ScanList[list, UpdateItem]};
BodyType:
PROC [ctx: CTXIndex]
RETURNS [rSei: RecordSEIndex] = {
rSei ← LOOPHOLE[MakeNonCtxSe[SERecord.cons.record.notLinked.SIZE]];
seb[rSei].typeInfo ← record[
machineDep: FALSE, painted: TRUE, argument: FALSE,
hints: [
unifield: FALSE, variant: FALSE,
assignable: FALSE, comparable: FALSE, privateFields: TRUE,
refField: FALSE, default: FALSE, voidable: FALSE],
length: 0,
fieldCtx: CTXNull,
monitored: FALSE,
linkPart: notLinked[]];
seb[rSei].fieldCtx ← ctx; seb[rSei].mark3 ← TRUE;
RETURN};
AllocateCopyEntries:
PROC [nVars:
CARDINAL]
RETURNS [seChain: ISEIndex] = {
IF nVars = 0 THEN seChain ← ISENull
ELSE {
IF copyCtx = CTXNull THEN copyCtx ← NewCtx[bb[currentEnclosing].level];
seChain ← MakeSeChain[copyCtx, nVars, TRUE];
AppendSeChain[copyCtx, seChain]};
RETURN};
FillArgSe:
PROC [copy, master: ISEIndex] = {
CopyArgSe[copy, master];
IF seb[copy].mark4 THEN seb[copy].idValue ← Tree.NullIndex;
seb[copy].mark4 ← FALSE; seb[copy].idInfo ← 0};
ExtractArgs:
PROC [argType: RecordSEIndex, formalCtx: CTXIndex, node: Tree.Index]
RETURNS [nAssigns: CARDINAL] = {
aLink: AList = AllocateAList[formalCtx];
nVars: CARDINAL = CtxEntries[formalCtx];
seChain: ISEIndex = AllocateCopyEntries[nVars];
sei1: ISEIndex;
sei2: ISEIndex ← seChain;
FOR sei1 ← FirstCtxSe[formalCtx], NextSe[sei1]
UNTIL sei1 = ISENull
DO
val: Tree.Link = [symbol[index: sei2]];
FillArgSe[copy: sei2, master: sei1];
PushTree[val]; PushTree[Tree.Null];
PushNode[assign, 2]; SetInfo[dataPtr.textIndex];
IncrCount[sei2];
aLink.map[aLink.nItems] ← [id: sei1, name: FALSE, val: val];
aLink.nItems ← aLink.nItems + 1;
sei2 ← NextSe[sei2];
ENDLOOP;
IF nVars = 0 THEN nAssigns ← 0
ELSE {
PushList[nVars]; PushNode[exlist, 1]; SetInfo[argType];
PushTree[tb[node].son[2]]; tb[node].son[2] ← Tree.Null;
PushNode[extract, 2]; SetInfo[dataPtr.textIndex];
nAssigns ← 1};
PushAList[aLink];
RETURN};
MapArgs:
PROC [formalCtx: CTXIndex, node: Tree.Index]
RETURNS [nAssigns: CARDINAL ← 0] = {
aLink: AList = AllocateAList[formalCtx];
nVars: CARDINAL = CountVars[formalCtx, tb[node].son[2]];
seChain: ISEIndex = AllocateCopyEntries[nVars];
sei1, sei2: ISEIndex;
MapArg: Tree.Map = {
name: BOOL;
val: Tree.Link;
IF sei1 = ISENull THEN v ← t
ELSE {
IF MapByName[sei1, t]
THEN {
name ← TRUE; AdjustForName[t]; val ← t}
ELSE {
FillArgSe[copy: sei2, master: sei1];
name ← FALSE; val ← [symbol[index: sei2]];
IF t # Tree.Null
THEN {
PushTree[val]; PushTree[t];
PushNode[assign, 2]; SetInfo[dataPtr.textIndex];
IncrCount[sei2]; nAssigns ← nAssigns + 1};
sei2 ← NextSe[sei2]};
aLink.map[aLink.nItems] ← [id: sei1, name: name, val: val];
aLink.nItems ← aLink.nItems + 1;
sei1 ← NextSe[sei1]; v ← Tree.Null};
RETURN};
sei1 ← FirstCtxSe[formalCtx]; sei2 ← seChain;
tb[node].son[2] ← UpdateList[tb[node].son[2], MapArg];
PushAList[aLink];
RETURN};
MapIds:
PROC [ctx: CTXIndex, chain: ISEIndex, nRefs: [0..1]] = {
aLink: AList = AllocateAList[ctx];
sei1: ISEIndex ← FirstCtxSe[ctx];
sei2: ISEIndex ← chain;
UNTIL sei1 = ISENull
DO
IF seb[sei1].idType # typeTYPE
THEN {
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]};
sei1 ← NextSe[sei1];
ENDLOOP;
PushAList[aLink]};
UnmapIds:
PROC [decl: {implicit, explicit}] = {
aLink: AList ← PopAList[];
FOR i:
CARDINAL
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 ← DiscardTree[aLink.map[i].val];
ENDLOOP;
aLink ← NIL};
MapFields:
PROC [oldRecord, newRecord: CSEIndex, nRefs: [0..1]] = {
oldCtx: CTXIndex = ArgCtx[oldRecord];
IF oldCtx # CTXNull
THEN {
aLink: AList = AllocateAList[oldCtx];
sei1: ISEIndex ← FirstCtxSe[oldCtx];
sei2: ISEIndex ← FirstCtxSe[ArgCtx[newRecord]];
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]}};
MapFormals:
PROC [oldType, newType: CSEIndex] = {
WITH new: seb[newType]
SELECT
FROM
transfer =>
WITH old: seb[oldType]
SELECT
FROM
transfer => {
MapFields[old.typeIn, new.typeIn, 1];
MapFields[old.typeOut, new.typeOut, 0]};
ENDCASE => ERROR;
ENDCASE};
UnmapFormals:
PROC [type: CSEIndex] = {
WITH t: seb[type]
SELECT
FROM
transfer => {
IF ArgCtx[t.typeOut] # CTXNull THEN UnmapIds[implicit];
IF ArgCtx[t.typeIn] # CTXNull THEN UnmapIds[implicit]};
ENDCASE};
CountedSei:
PROC [sei: ISEIndex]
RETURNS [
BOOL] = {
ctx: CTXIndex = seb[sei].idCtx;
RETURN [~seb[sei].constant
AND ctxb[ctx].level # lZ AND ctxb[ctx].ctxType # included]};
IncrCount:
PROC [sei: ISEIndex] = {
-- modified BumpCount (Pass3I)
IF seb[sei].idType # typeTYPE
AND (~seb[sei].mark4
OR CountedSei[sei])
THEN
seb[sei].idInfo ← seb[sei].idInfo + 1};
DecrCount:
PROC [sei: ISEIndex] = {
IF seb[sei].idType # typeTYPE
AND (~seb[sei].mark4
OR CountedSei[sei])
THEN
IF seb[sei].idInfo # 0 THEN seb[sei].idInfo ← seb[sei].idInfo - 1};
AdjustForName: Tree.Scan = {
WITH t
SELECT
FROM
symbol => DecrCount[index];
subtree => {
node: Tree.Index = index;
SELECT tb[node].name
FROM
thread => AdjustForName[tb[node].son[1]];
ENDCASE => ScanSons[t, AdjustForName]};
ENDCASE};
SetCtxCounts:
PROC [ctx: CTXIndex, nRefs: [0..1]] = {
FOR sei: ISEIndex ← FirstCtxSe[ctx], NextSe[sei]
UNTIL sei = ISENull
DO
IF ~seb[sei].constant THEN seb[sei].idInfo ← nRefs;
ENDLOOP};
BumpCtxCounts:
PROC [ctx: CTXIndex, incr:
CARDINAL] = {
FOR sei: ISEIndex ← FirstCtxSe[ctx], NextSe[sei]
UNTIL sei = ISENull
DO
IF ~seb[sei].constant THEN seb[sei].idInfo ← seb[sei].idInfo + incr;
ENDLOOP};
ComputeArgCounts:
PROC [type: CSEIndex, body: Tree.Link] = {
typeIn, typeOut: RecordSEIndex;
argCtx, resultCtx: CTXIndex;
[typeIn, typeOut] ← TransferTypes[type];
argCtx ← FieldCtx[typeIn]; resultCtx ← FieldCtx[typeOut];
IF argCtx # CTXNull OR resultCtx # CTXNull THEN {
UpdateCount: Tree.Scan = {
WITH t
SELECT
FROM
symbol => {
sei: ISEIndex = index;
SELECT seb[sei].idCtx
FROM
CTXNull => NULL;
argCtx, resultCtx => seb[sei].idInfo ← seb[sei].idInfo + 1;
ENDCASE};
subtree => {
node: Tree.Index = index;
IF tb[node].name = return
AND tb[node].son[1] = Tree.Null
THEN
BumpCtxCounts[resultCtx, 1];
ScanSons[t, UpdateCount]};
ENDCASE => NULL};
SetCtxCounts[argCtx, 1]; SetCtxCounts[resultCtx, 0];
ScanSons[body, UpdateCount]}};
FieldCtx:
PROC [rSei: RecordSEIndex]
RETURNS [CTXIndex] = {
RETURN [IF rSei = RecordSENull THEN CTXNull ELSE seb[rSei].fieldCtx]};