-- file Pass3P.mesa -- last modified by Satterthwaite, June 26, 1983 10:37 am DIRECTORY Alloc: TYPE USING [Notifier, AddNotify, DropNotify, Top, Words], ComData: TYPE USING [ defBodyLimit, interface, nBodies, nInnerBodies, table, textIndex, zone], CompilerUtil: TYPE USING [], Log: TYPE USING [Error, ErrorSei], Symbols: TYPE USING [ Base, BodyInfo, BodyRecord, ContextLevel, SERecord, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex, BTIndex, CBTIndex, nullName, ISENull, RecordSENull, CTXNull, BTNull, lL, lZ, RootBti, typeTYPE, seType, ctxType, mdType, bodyType], SymbolOps: TYPE USING [ ArgCtx, CopyArgSe, CopyXferType, CtxEntries, DelinkBti, FindExtension, FirstCtxSe, LinkBti, MakeNonCtxSe, MakeSeChain, NewCtx, NextLevel, NextSe, ParentBti, SetSeLink, SearchContext, TransferTypes, StaticNestError], Tree: TYPE USING [Base, Index, Link, Map, Scan, Null, NullIndex, treeType], TreeOps: TYPE USING [ CopyTree, FreeNode, FreeTree, GetNode, ListTail, MakeList, MarkShared, NthSon, OpName, PopTree, PushList, PushNode, PushTree, ScanList, ScanSons, SetAttr, SetInfo, Shared, UpdateList, UpdateLeaves]; Pass3P: PROGRAM IMPORTS Alloc, Log, SymbolOps, TreeOps, dataPtr: ComData EXPORTS CompilerUtil = { OPEN TreeOps, SymbolOps, Symbols; tb: Tree.Base; -- tree base address (local copy) seb: Symbols.Base; -- se table base address (local copy) ctxb: Symbols.Base; -- context table base address (local copy) mdb: Symbols.Base; -- module table base address (local copy) bb: Symbols.Base; -- body table base address (local copy) PostNotify: Alloc.Notifier = { -- called by allocator whenever table area is repacked tb ← base[Tree.treeType]; seb ← base[seType]; ctxb ← base[ctxType]; mdb ← base[mdType]; bb ← base[bodyType]}; -- driver P3Postlude: PUBLIC PROC [expand: BOOL] = { (dataPtr.table).AddNotify[PostNotify]; IF expand THEN {LinkImportedBodies[]; ExpandInlines[RootBti]}; (dataPtr.table).DropNotify[PostNotify]}; -- included body copying LinkImportedBodies: PROC = { next: BTIndex; btLimit: BTIndex = (dataPtr.table).Top[bodyType]; FOR bti: BTIndex ← LOOPHOLE[dataPtr.defBodyLimit], next UNTIL bti = btLimit DO WITH body: bb[bti] SELECT FROM Callable => { IF body.inline THEN {body.link ← bb[RootBti].link; bb[RootBti].link ← [sibling, bti]}; next ← bti + (SELECT body.nesting FROM Inner => BodyRecord.Callable.Inner.SIZE, ENDCASE => BodyRecord.Callable.Outer.SIZE)}; ENDCASE => next ← bti + BodyRecord.Other.SIZE; ENDLOOP}; -- inline expansion -- state information currentMaster: CBTIndex; masterBody: Tree.Index; copyCtx: CTXIndex; copying: BOOL; substSafe: BOOL; currentEnclosing: BTIndex; bodyNesting: CARDINAL; aStack: AList; -- current association list AItem: TYPE = RECORD [id: ISEIndex, name: BOOL, val: Tree.Link]; ANode: TYPE = RECORD [ next: AList, ctx: CTXIndex, nItems: CARDINAL, map: SEQUENCE maxItems: CARDINAL OF AItem]; AList: TYPE = LONG POINTER TO ANode; -- overall control 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; ResetSharing[]}; 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}; -- argument list testing/processing NameSafe: PROC [t: Tree.Link] RETURNS [safe: BOOL] = { RETURN [~bb[currentMaster].hints.argUpdated AND (substSafe OR (WITH t SELECT FROM symbol => seb[index].immutable, literal => TRUE, ENDCASE => SELECT OpName[t] FROM IN [relE..relLE], IN [plus..mod] => NameSafe[NthSon[t, 1]] AND NameSafe[NthSon[t, 2]], not, uminus, abs, pred, succ => NameSafe[NthSon[t, 1]], loophole, cast, check, lengthen, shorten, float => NameSafe[NthSon[t, 1]], clit, llit, mwconst, nil, atom => TRUE, cdot => NameSafe[NthSon[t, 2]], ENDCASE => FALSE))]}; VarRefs: PROC [sei: ISEIndex] RETURNS [CARDINAL] = INLINE { RETURN [seb[sei].idInfo]}; CheapEval: PROC [t: Tree.Link, top: BOOL←TRUE] RETURNS [BOOL] = { RETURN [WITH t SELECT FROM subtree => SELECT OpName[t] FROM clit, llit, mwconst, nil, atom => TRUE, loophole, cast, openx => CheapEval[NthSon[t, 1], top], addr, uparrow, dot, dollar => CheapEval[NthSon[t, 1], top], IN [index .. reloc] => CheapEval[NthSon[t, 1], FALSE] AND CheapEval[NthSon[t, 2], FALSE], IN [or .. mod] => top AND CheapEval[NthSon[t, 1], FALSE] AND CheapEval[NthSon[t, 2], FALSE], not, uminus, abs, pred, succ, lengthen, shorten => top AND CheapEval[NthSon[t, 1], FALSE], cdot => CheapEval[NthSon[t, 2], top], ENDCASE => FALSE, ENDCASE => TRUE]}; MapByName: PROC [sei: ISEIndex, t: Tree.Link] RETURNS [BOOL] = { n: CARDINAL = VarRefs[sei]; RETURN [NameSafe[t] AND (n <= 2 OR CheapEval[t])]}; CountVars: PROC [ctx: CTXIndex, t: Tree.Link] RETURNS [n: CARDINAL ← 0] = { sei: ISEIndex ← FirstCtxSe[ctx]; CountVar: Tree.Scan = { IF sei # ISENull THEN {IF ~MapByName[sei, t] THEN n ← n+1; sei ← NextSe[sei]}}; ScanList[t, CountVar]; RETURN}; RequiredFields: PROC [rSei: RecordSEIndex] RETURNS [BOOL] = { FOR sei: ISEIndex ← FirstCtxSe[FieldCtx[rSei]], NextSe[sei] UNTIL sei = ISENull DO IF seb[sei].hash = nullName THEN RETURN [FALSE]; IF seb[sei].idInfo # 0 THEN RETURN [TRUE]; ENDLOOP; RETURN [FALSE]}; -- tree manipulation 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 = LONG POINTER TO SharingItem; sharingMap: SharingList; MapShared: PROC [t, v: Tree.Link] = { p: SharingList ← (dataPtr.zone).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}; ResetSharing: PROC = { p: SharingList; UNTIL sharingMap = NIL DO p ← sharingMap; sharingMap ← sharingMap.next; (dataPtr.zone).FREE[@p]; ENDLOOP}; 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}; -- blocks and bodies 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}; -- id translation AppendSeChain: PROC [ctx: CTXIndex, chain: ISEIndex] = { last, next: ISEIndex; SELECT TRUE FROM chain = ISENull => NULL; (last ← ctxb[ctx].seList) = ISENull => ctxb[ctx].seList ← chain; ENDCASE => { UNTIL (next ← NextSe[last]) = ISENull DO last ← next ENDLOOP; SetSeLink[last, chain]}}; CtxVars: PROC [ctx: CTXIndex] RETURNS [n: CARDINAL ← 0] = { FOR sei: ISEIndex ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO IF seb[sei].idType # typeTYPE THEN n ← n+1 ENDLOOP; RETURN}; AllocateAList: PROC [ctx: CTXIndex] RETURNS [aLink: AList] = { maxItems: CARDINAL = CtxEntries[ctx]; aLink ← (dataPtr.zone).NEW[ANode[maxItems] ← [next:NIL, ctx:ctx, nItems:0, map:]]}; -- mapping 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; (dataPtr.zone).FREE[@aLink]}; 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}; -- reference count adjustment 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]}; -- association lists PushAList: PROC [aLink: AList] = {aLink.next ← aStack; aStack ← aLink}; PopAList: PROC RETURNS [aLink: AList] = { IF aStack = NIL THEN ERROR; aLink ← aStack; aStack ← aLink.next}; ExpandSei: PROC [sei: ISEIndex] RETURNS [v: Tree.Link] = { i: CARDINAL; FOR aLink: AList ← 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 => { saveCopying: BOOL = copying; copying ← TRUE; v ← ExpandTree[aLink.map[i].val]; copying ← saveCopying}; FINISHED => {IF copying THEN IncrCount[sei]; v ← [symbol[index:sei]]}; ENDLOOP; RETURN}; -- nested calls ThreadSubst: PROC [node: Tree.Index, dest: Tree.Link] = { dThread: Tree.Index = GetNode[NthSon[dest, 1]]; IF copying THEN { sThread: Tree.Index; DO sThread ← GetNode[tb[node].son[1]]; IF tb[sThread].name # thread THEN ERROR; IF tb[sThread].son[2] = Tree.Null THEN EXIT; node ← GetNode[tb[sThread].son[2]]; ENDLOOP; tb[dThread].son[2] ← Tree.Null; tb[sThread].son[2] ← dest; MarkShared[dest, TRUE]}; tb[dThread].info ← currentEnclosing}; }.