-- file Pass4S.mesa
-- last modified by Satterthwaite, May 10, 1983 4:23 pm
-- last modified by Sweet, January 21, 1981 10:50 PM
-- last modified by Donahue, 10-Dec-81 9:14:17
DIRECTORY
Alloc: TYPE USING [Notifier],
ComData: TYPE USING [
bodyIndex, catchIndex, globalFrameSize, interface, monitored, stopping,
switches, textIndex, typeBOOL, typeINT, typeLOCK],
Log: TYPE USING [Error, ErrorSei, ErrorTree],
LiteralOps: TYPE USING [Find, ResetLocalStrings],
P4: TYPE USING [
Attr, voidAttr, ConsState, Repr, none, unsigned, both, other,
AdjustBias, Assignment, BiasForType, BoolTest, BoolValue, Call, CheckBlock,
CommonProp, CommonRep, ConstantInterval, Cover, DeclItem, DeclUpdate,
Exp, Extract, Interval, LayoutBlock, LayoutGlobals, LayoutInterface, LayoutLocals,
MakeArgRecord, MakeTreeLiteral, NeutralExp, NormalizeRange,
OperandType, ProcessSymLiterals, RelTest, RepForType, Rhs, RValue,
TreeLiteral, TreeLiteralValue, VAttr, VBias, VPop, VProp, VRep, WordsForType,
EmptyInterval],
Pass4: TYPE USING [
implicitAttr, implicitBias, implicitType, lockNode, resident, resumeRecord, returnRecord],
PrincOps: TYPE USING [StateVector, EPRange, localbase],
Symbols: TYPE USING [
Base, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex, BTIndex, CBTIndex, CCBTIndex,
BodyInfo, ContextLevel, CSENull, ISENull, RecordSENull, CTXNull, RootBti, BTNull,
lG, lL, typeANY, WordLength, seType, ctxType, bodyType],
SymbolOps: TYPE USING [
ArgRecord, Cardinality, ContextVariant, DelinkBti, FirstCtxSe, NextSe, NormalType,
TransferTypes, TypeLink, UnderType],
SymLiteralOps: TYPE USING [DescribeRefLits, DescribeTypes],
Tree: TYPE USING [
Base, Index, Link, Map, NodeName, Scan, Test, Null, NullIndex, treeType],
TreeOps: TYPE USING [
FreeNode, FreeTree, GetNode, GetSe, IdentityMap, ListHead, ListLength, MakeList,
MakeNode, MarkShared, NthSon, OpName, PopTree, PushProperList, PushList,
PushLit, PushNode, PushTree, ReverseScanList, ReverseUpdateList, ScanList,
SearchList, SetAttr, SetInfo, UpdateList];
Pass4S: PROGRAM
IMPORTS
Log, LiteralOps, P4, SymbolOps, SymLiteralOps, TreeOps,
dataPtr: ComData, passPtr: Pass4
EXPORTS P4 = {
OPEN SymbolOps, Symbols, P4, TreeOps;
tb: Tree.Base; -- tree base address (local copy)
seb: Symbols.Base; -- se table base address (local copy)
ctxb: Symbols.Base; -- ctx table base address (local copy)
bb: Symbols.Base; -- body table base (local copy)
StmtNotify: PUBLIC Alloc.Notifier = {
-- called by allocator whenever table area is repacked
tb ← base[Tree.treeType];
seb ← base[seType]; ctxb ← base[ctxType]; bb ← base[bodyType]};
Repr: TYPE = P4.Repr;
none: Repr = P4.none;
-- bodies and blocks
currentLevel: PUBLIC ContextLevel;
currentBody: BTIndex;
checked: PUBLIC BOOL;
BodyList: PROC [firstBti: BTIndex] = {
nextBti: BTIndex;
FOR bti: BTIndex ← firstBti, nextBti UNTIL bti = BTNull DO
nextBti ← IF bb[bti].link.which = parent THEN BTNull ELSE bb[bti].link.index;
WITH bb[bti] SELECT FROM
Callable =>
IF ~inline OR (dataPtr.interface AND LocalBody[LOOPHOLE[bti]]) THEN {
IF nesting = Catch THEN BodyList[bb[bti].firstSon]
ELSE Body[LOOPHOLE[bti, CBTIndex]]}
ELSE DelinkBti[bti];
ENDCASE => BodyList[bb[bti].firstSon];
ENDLOOP};
LocalBody: PROC [bti: CBTIndex] RETURNS [BOOL] = INLINE {
sei: ISEIndex = bb[bti].id;
RETURN [sei = ISENull OR ctxb[seb[sei].idCtx].ctxType = simple]};
Body: PUBLIC PROC [bti: CBTIndex] = {
oldBodyIndex: CBTIndex = dataPtr.bodyIndex;
oldLevel: ContextLevel = currentLevel;
saveChecked: BOOL = checked;
saveIndex: CARDINAL = dataPtr.textIndex;
saveCatchScope: BOOL = catchScope;
saveRecord: RecordSEIndex = passPtr.returnRecord;
node: Tree.Index = NARROW[bb[bti].info, BodyInfo.Internal].bodyTree;
sei: CSEIndex = bb[bti].ioType;
base, bound: CARDINAL;
initTree: Tree.Link;
inRecord: RecordSEIndex;
catchScope ← FALSE;
dataPtr.bodyIndex ← currentBody ← bti; dataPtr.textIndex ← bb[bti].sourceIndex;
currentLevel ← IF bti = RootBti THEN lG ELSE bb[bti].level;
checked ← tb[node].attr1;
IF dataPtr.interface AND bb[bti].level > lL
THEN Log.ErrorSei[nonDefinition, bb[bti].id];
[inRecord, passPtr.returnRecord] ← TransferTypes[bb[bti].ioType];
IF ~bb[bti].hints.argUpdated THEN SetImmutable[inRecord, TRUE];
[] ← LiteralOps.ResetLocalStrings[];
bb[bti].hints.noStrings ← TRUE; -- see MarkString, below
IF tb[node].son[4] # Tree.Null THEN {
tb[node].son[4] ← Exp[tb[node].son[4], none]; VPop[]};
tb[node].son[1] ← UpdateList[tb[node].son[1], OpenItem];
[init: initTree, decls: tb[node].son[2]] ← ScanDecls[tb[node].son[2]];
IF bti = RootBti THEN {
fragments: BOOL ←
(SymLiteralOps.DescribeTypes[].length + SymLiteralOps.DescribeRefLits[].length) # 0;
dataPtr.globalFrameSize ←
(LayoutGlobals[bti, dataPtr.stopping, fragments] + (WordLength-1))/WordLength;
IF bb[bti].type # RecordSENull THEN
seb[bb[bti].type].length ← dataPtr.globalFrameSize*WordLength;
ProcessSymLiterals[];
base ← PrincOps.localbase*WordLength;
IF dataPtr.monitored AND tb[passPtr.lockNode].attr1 THEN {
PushTree[tb[passPtr.lockNode].son[2]];
PushLit[LiteralOps.Find[100000b]]; PushNode[cast, 1];
SetInfo[dataPtr.typeLOCK];
PushNode[assign, 2]; SetAttr[1, TRUE];
initTree ← Prefix[PopTree[], initTree]}}
ELSE {
base ← LayoutLocals[bti];
IF bb[bti].type # RecordSENull THEN seb[bb[bti].type].length ← base;
IF bb[bti].firstSon # BTNull THEN
initTree ← Prefix[BodyInitList[bb[bti].firstSon], initTree]};
IF bb[bti].type # RecordSENull THEN seb[bb[bti].type].mark4 ← TRUE;
tb[node].son[3] ← UpdateList[tb[node].son[3], Stmt];
bound ← AssignSubBlocks[bti, base];
WITH bb[bti].info SELECT FROM
Internal => {
frameSize ← (bound + (WordLength-1))/WordLength;
thread ← LiteralOps.ResetLocalStrings[]};
ENDCASE;
bb[bti].resident ← passPtr.resident;
IF bb[bti].firstSon # BTNull THEN BodyList[bb[bti].firstSon];
tb[node].son[1] ← ReverseUpdateList[tb[node].son[1], CloseItem];
tb[node].son[2] ← Prefix[initTree, UpdateList[tb[node].son[2], DeclUpdate]];
IF dataPtr.interface AND bti = RootBti THEN {
n: CARDINAL = LayoutInterface[bti];
WITH t: seb[bb[bti].ioType] SELECT FROM
definition => t.nGfi ← IF n=0 THEN 1 ELSE (n-1)/PrincOps.EPRange + 1;
ENDCASE};
SetImmutable[inRecord, FALSE];
catchScope ← saveCatchScope;
currentBody ← dataPtr.bodyIndex ← oldBodyIndex;
currentLevel ← oldLevel; checked ← saveChecked;
dataPtr.textIndex ← saveIndex; passPtr.returnRecord ← saveRecord};
MarkString: PUBLIC PROC [local: BOOL] = {
bb[IF local THEN dataPtr.bodyIndex ELSE RootBti].hints.noStrings ← FALSE};
SetImmutable: PROC [rSei: RecordSEIndex, b: BOOL] = {
IF rSei # RecordSENull THEN
FOR sei: ISEIndex ← FirstCtxSe[seb[rSei].fieldCtx], NextSe[sei] UNTIL sei = ISENull DO
seb[sei].immutable ← b;
ENDLOOP};
ScanDecls: PROC [t: Tree.Link] RETURNS [init, decls: Tree.Link] = {
IF OpName[t] = initlist THEN {
node: Tree.Index = GetNode[t];
init ← UpdateList[tb[node].son[1], Stmt]; tb[node].son[1] ← Tree.Null;
decls ← tb[node].son[2]; tb[node].son[2] ← Tree.Null;
FreeNode[node]}
ELSE {init ← Tree.Null; decls ← t};
ScanList[decls, DeclItem]; RETURN};
Prefix: PROC [first, rest: Tree.Link] RETURNS [Tree.Link] = {
SELECT TRUE FROM
(first = Tree.Null) => RETURN [rest];
(rest = Tree.Null) => RETURN [first];
ENDCASE => {PushTree[first]; PushTree[rest]; RETURN [MakeList[2]]}};
BodyInitList: PROC [firstBti: BTIndex] RETURNS [Tree.Link] = {
bti: BTIndex ← firstBti;
n: CARDINAL ← 0;
IF bti # BTNull THEN
DO
WITH body: bb[bti] SELECT FROM
Callable =>
IF ~body.inline AND body.nesting # Catch THEN {
PushNode[procinit, 0]; SetInfo[bti]; n ← n+1};
ENDCASE => NULL;
IF bb[bti].link.which = parent THEN EXIT;
bti ← bb[bti].link.index;
ENDLOOP;
RETURN [MakeList[n]]};
AssignSubBlocks: PROC [rootBti: BTIndex, base: CARDINAL] RETURNS [bound: CARDINAL] = {
level: ContextLevel = bb[rootBti].level;
bti: BTIndex;
bound ← base;
IF (bti ← bb[rootBti].firstSon) # BTNull THEN
DO
SELECT bb[bti].kind FROM
Other =>
IF bb[bti].level = level THEN {
length: CARDINAL = AssignBlock[bti, base];
bound ← MAX[length, bound]};
ENDCASE => NULL;
IF bb[bti].link.which = parent THEN EXIT;
bti ← bb[bti].link.index;
ENDLOOP;
RETURN};
Subst: PUBLIC PROC [node: Tree.Index] RETURNS [Tree.Link] = {
OPEN tb[node];
saveRecord: RecordSEIndex = passPtr.returnRecord;
saveChecked: BOOL = checked;
son[1] ← NeutralExp[son[1]];
passPtr.returnRecord ← TransferTypes[OperandType[son[1]]].typeOut;
IF ~attr3 THEN checked ← attr1;
son[2] ← UpdateList[son[2], Stmt];
checked ← saveChecked; passPtr.returnRecord ← saveRecord;
RETURN [[subtree[index: node]]]};
Scope: PROC [node: Tree.Index, item: Tree.Map] RETURNS [Tree.Link] = {
OPEN tb[node];
bti: BTIndex = info;
saveIndex: CARDINAL = dataPtr.textIndex;
oldBodyIndex: BTIndex = currentBody;
oldLevel: ContextLevel = currentLevel;
initTree: Tree.Link;
dataPtr.textIndex ← bb[bti].sourceIndex;
currentBody ← bti; currentLevel ← bb[bti].level;
[init: initTree, decls: son[1]] ← ScanDecls[son[1]];
IF bb[bti].type # RecordSENull THEN seb[bb[bti].type].mark4 ← TRUE;
CheckBlock[bti];
son[2] ← UpdateList[son[2], item];
son[1] ← Prefix[initTree, UpdateList[son[1], DeclUpdate]];
IF catchScope THEN catchBound ← MAX[AssignBlock[bti, catchBase], catchBound];
currentBody ← oldBodyIndex; currentLevel ← oldLevel;
dataPtr.textIndex ← saveIndex;
RETURN [[subtree[index: node]]]};
AssignBlock: PROC [bti: BTIndex, base: CARDINAL] RETURNS [bound: CARDINAL] = {
node: Tree.Index;
newBase: CARDINAL = LayoutBlock[bti, base];
initTree: Tree.Link = IF bb[bti].firstSon # BTNull
THEN BodyInitList[bb[bti].firstSon]
ELSE Tree.Null;
IF bb[bti].type # RecordSENull THEN seb[bb[bti].type].length ← newBase;
bound ← AssignSubBlocks[bti, newBase];
WITH bb[bti].info SELECT FROM
Internal => {frameSize ← (bound + (WordLength-1))/WordLength; node ← bodyTree};
ENDCASE => NULL;
IF initTree # Tree.Null THEN tb[node].son[1] ← Prefix[initTree, tb[node].son[1]];
RETURN};
-- main dispatch
Stmt: PROC [stmt: Tree.Link] RETURNS [val: Tree.Link] = {
node: Tree.Index;
saveIndex: CARDINAL = dataPtr.textIndex;
val ← stmt; -- the default case
WITH stmt SELECT FROM
subtree => {
node ← index;
IF node # Tree.NullIndex THEN {
OPEN tb[node];
dataPtr.textIndex ← info;
SELECT name FROM
assign => {val ← Assignment[node]; VPop[]};
extract => val ← ExtractStmt[node];
call, portcall, signal, error, xerror, start, join => {val ← Call[node]; VPop[]};
subst => val ← Subst[node];
block => {
saveChecked: BOOL = checked;
checked ← tb[node].attr1; val ← Scope[node, Stmt];
checked ← saveChecked};
if => val ← IfStmt[node];
case => val ← CaseDriver[node, Stmt, 0];
bind =>
val ← IF attr3 THEN BindType[node, Stmt] ELSE BindCase[node, case, BindStmt];
do => val ← DoStmt[node];
return, result => Return[node, passPtr.returnRecord];
resume => Return[node, passPtr.resumeRecord];
label => {son[1] ← Stmt[son[1]]; son[2] ← UpdateList[son[2], Stmt]};
open => {
son[1] ← UpdateList[son[1], OpenItem];
son[2] ← UpdateList[son[2], Stmt];
son[1] ← ReverseUpdateList[son[1], CloseItem]};
checked => {
saveChecked: BOOL = checked;
checked ← attr1; son[1] ← Stmt[son[1]];
checked ← saveChecked};
enable => {CatchPhrase[son[1]]; son[2] ← Stmt[son[2]]};
catchmark => son[1] ← Stmt[son[1]];
lock => {son[1] ← UpdateList[son[1], Stmt]; son[2] ← Exp[son[2], none]; VPop[]};
notify, broadcast, unlock => {son[1] ← Exp[son[1], none]; VPop[]};
wait => {
son[1] ← Exp[son[1], none]; VPop[];
son[2] ← Exp[son[2], none]; VPop[];
IF nSons > 2 THEN CatchNest[son[3]]};
restart => {son[1] ← NeutralExp[son[1]]; IF nSons > 2 THEN CatchNest[son[3]]};
dst, lst, lste, lstf => {
son[1] ← Exp[son[1], none];
IF WordsForType[OperandType[son[1]]] < PrincOps.StateVector.SIZE THEN
Log.ErrorTree[sizeClash, son[1]];
VPop[]};
goto, exit, loop, syserror, reject, continue, retry, stop, null => NULL;
free => val ← Free[node];
apply => NULL;
item => son[2] ← Stmt[son[2]];
list => val ← UpdateList[stmt, Stmt];
ENDCASE => Log.Error[unimplemented]}};
ENDCASE => ERROR;
dataPtr.textIndex ← saveIndex; RETURN};
-- extraction
ExtractStmt: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
subNode: Tree.Index = GetNode[tb[node].son[1]];
rType: RecordSEIndex = tb[subNode].info;
IF rType # Symbols.RecordSENull THEN {val ← Extract[node]; VPop[]}
ELSE {
val ← Stmt[tb[node].son[2]]; tb[node].son[2] ← Tree.Null;
WITH val SELECT FROM subtree => tb[index].info ← tb[node].info ENDCASE;
FreeNode[node]};
RETURN};
-- return
Return: PROC [node: Tree.Index, type: RecordSEIndex] = {
tb[node].son[1] ← IF tb[node].attr3 AND type # RecordSENull
THEN Rhs[tb[node].son[1], type]
ELSE MakeArgRecord[type, tb[node].son[1]];
VPop[]};
-- conditionals
IfStmt: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
OPEN tb[node];
son[1] ← BoolValue[son[1]]; VPop[];
son[2] ← Stmt[son[2]]; son[3] ← Stmt[son[3]];
IF ~TreeLiteral[son[1]] THEN val ← Tree.Link[subtree[index: node]]
ELSE {
IF BoolTest[son[1]] THEN {val ← son[2]; son[2] ← Tree.Null}
ELSE {val ← son[3]; son[3] ← Tree.Null};
FreeNode[node]};
RETURN};
BindStmt: PROC [t: Tree.Link, labelBias: INTEGER] RETURNS [Tree.Link] = {
node: Tree.Index = GetNode[t];
RETURN [CaseDriver[GetNode[t], Stmt, labelBias]]};
-- drivers for processing selections
BindType: PUBLIC PROC [node: Tree.Index, eval: Tree.Map] RETURNS [Tree.Link] = {
OPEN tb[node];
saveType: CSEIndex = passPtr.implicitType;
saveBias: INTEGER = passPtr.implicitBias;
saveAttr: Attr = passPtr.implicitAttr;
Item: Tree.Map = {RETURN [Scope[GetNode[t], eval]]};
subNode: Tree.Index ← GetNode[son[1]];
type: CSEIndex = OperandType[tb[subNode].son[2]];
PushTree[RValue[tb[subNode].son[2], BiasForType[type], RepForType[type]]];
passPtr.implicitType ← type;
passPtr.implicitAttr ← VAttr[]; passPtr.implicitBias ← VBias[]; VPop[];
tb[subNode].son[2] ← Tree.Null;
PushTree[UpdateList[son[3], Item]]; son[3] ← Tree.Null;
PushTree[eval[son[4]]]; son[4] ← Tree.Null;
PushNode[name, 3]; SetInfo[info]; SetAttr[1, attr1]; SetAttr[2, attr2];
FreeNode[node];
passPtr.implicitAttr ← saveAttr; passPtr.implicitBias ← saveBias;
passPtr.implicitType ← saveType;
RETURN [PopTree[]]};
BindCase: PUBLIC PROC [
node: Tree.Index,
op: Tree.NodeName,
eval: PROC [Tree.Link, INTEGER] RETURNS [Tree.Link]]
RETURNS [val: Tree.Link] = {
OPEN tb[node];
labelBias: INTEGER = TagBias[BoundType[son[1]], TestCtx[ListHead[son[3]]]];
subNode: Tree.Index;
PushTree[son[2]]; son[2] ← Tree.Null;
PushTree[son[3]]; son[3] ← Tree.Null;
PushTree[son[4]]; son[4] ← Tree.Null;
PushTree[OpenItem[son[1]]]; son[1] ← Tree.Null;
PushNode[op, 4]; SetInfo[info];
SetAttr[1, FALSE]; SetAttr[2, FALSE]; SetAttr[3, attr3];
val ← eval[PopTree[], labelBias]; subNode ← GetNode[val];
tb[subNode].son[4] ← CloseItem[tb[subNode].son[4]];
FreeNode[node];
RETURN};
BoundType: PROC [base: Tree.Link] RETURNS [CSEIndex] = INLINE {
RETURN [DerefType[OperandType[NthSon[base, 2]]]]};
TestCtx: PROC [item: Tree.Link] RETURNS [CTXIndex] = INLINE {
RETURN [IF item = Tree.Null
THEN CTXNull
ELSE seb[GetSe[NthSon[ListHead[NthSon[item, 1]], 2]]].idCtx]};
TagBias: PROC [rType: CSEIndex, testCtx: CTXIndex] RETURNS [INTEGER] = {
FOR subType: CSEIndex ← rType, UnderType[TypeLink[subType]]
WHILE subType # CSENull DO
WITH t: seb[subType] SELECT FROM
record =>
IF t.hints.variant THEN {
sei: ISEIndex = ContextVariant[t.fieldCtx];
uType: CSEIndex = UnderType[seb[sei].idType];
WITH u: seb[uType] SELECT FROM
union =>
IF u.caseCtx = testCtx OR testCtx = CTXNull THEN
RETURN [BiasForType[UnderType[seb[u.tagSei].idType]]];
ENDCASE};
ENDCASE => EXIT;
ENDLOOP;
ERROR};
CaseDriver: PUBLIC PROC [node: Tree.Index, selection: Tree.Map, labelBias: INTEGER]
RETURNS [val: Tree.Link] = {
OPEN tb[node];
saveType: CSEIndex = passPtr.implicitType;
saveBias: INTEGER = passPtr.implicitBias;
saveAttr: Attr = passPtr.implicitAttr;
type: CSEIndex = OperandType[son[1]];
son[1] ← Exp[son[1], none];
IF attr2 THEN { -- not bind/bindx
found: BOOL ← FALSE;
EvalTest: Tree.Map = {
subNode: Tree.Index = GetNode[t];
IF tb[subNode].son[1] # Tree.Null THEN ERROR;
tb[subNode].son[1] ← IdentityMap[tb[node].son[1]];
v ← BoolValue[t]; VPop[];
IF BoolTest[v] THEN found ← TRUE;
RETURN};
TestItem: Tree.Test = {
subNode: Tree.Index = GetNode[t];
tb[subNode].son[1] ← UpdateList[tb[subNode].son[1], EvalTest];
IF found THEN {val ← tb[subNode].son[2]; tb[subNode].son[2] ← Tree.Null};
RETURN [found]};
SearchList[son[2], TestItem];
IF ~found THEN {val ← son[3]; son[3] ← Tree.Null};
FreeNode[node];
val ← selection[val]}
ELSE IF type = dataPtr.typeBOOL AND attr1 AND TreeLiteral[son[1]] THEN {
CaseItem: Tree.Scan = {
subNode: Tree.Index = GetNode[t];
started: BOOL;
PushTest: Tree.Scan = {
tNode: Tree.Index = GetNode[t];
PushTree[tb[tNode].son[2]]; tb[tNode].son[2] ← Tree.Null;
IF ~BoolTest[son[1]] THEN PushNode[not, 1];
IF started THEN PushNode[or, 2];
started ← TRUE; RETURN};
PushTree[tb[subNode].son[2]]; tb[subNode].son[2] ← Tree.Null;
started ← FALSE; ScanList[tb[subNode].son[1], PushTest];
IF selection = Stmt THEN {PushNode[if, -3]; SetInfo[tb[subNode].info]}
ELSE {PushNode[ifx, -3]; SetInfo[tb[node].info]};
RETURN};
son[1] ← AdjustBias[son[1], -VBias[]]; VPop[];
PushTree[son[3]]; son[3] ← Tree.Null;
ReverseScanList[son[2], CaseItem];
FreeNode[node];
passPtr.implicitAttr ← voidAttr;
val ← selection[PopTree[]]}
ELSE {
nSons: CARDINAL = ListLength[son[2]];
i, j, first, last, next, newSons: CARDINAL;
min, max: INTEGER;
minTree, maxTree: Tree.Link;
rep: Repr;
subNode, listNode: Tree.Index;
switchable, copying: BOOL;
multiword: BOOL = WordsForType[type] # 1;
count: CARDINAL;
TestExp: Tree.Map = {
v ← RValue[t, 0, none];
passPtr.implicitAttr.prop ← CommonProp[passPtr.implicitAttr.prop, VProp[]];
VPop[]};
SwitchValue: Tree.Map = {
val: Tree.Link;
tNode: Tree.Index = GetNode[t];
val ← tb[tNode].son[2] ← RValue[tb[tNode].son[2], passPtr.implicitBias, rep];
passPtr.implicitAttr.prop ← CommonProp[passPtr.implicitAttr.prop, VProp[]];
VPop[];
IF count = 0 THEN {first ← i; minTree ← maxTree ← val}
ELSE {
subRep: Repr = (SELECT rep FROM other, none => unsigned, ENDCASE => rep);
IF RelTest[val, minTree, relL, subRep] THEN minTree ← val;
IF RelTest[val, maxTree, relG, subRep] THEN maxTree ← val};
count ← count + 1;
RETURN [t]};
passPtr.implicitType ← type;
passPtr.implicitBias ← VBias[] - labelBias;
passPtr.implicitAttr ← VAttr[]; rep ← passPtr.implicitAttr.rep; VPop[];
newSons ← nSons;
i ← next ← 1; copying ← FALSE; listNode ← GetNode[son[2]];
UNTIL i > nSons DO
WHILE i <= nSons DO
subNode ← GetNode[tb[listNode].son[i]];
IF tb[subNode].attr1 AND ~multiword THEN EXIT;
tb[subNode].son[1] ← UpdateList[tb[subNode].son[1], TestExp];
tb[subNode].son[2] ← selection[tb[subNode].son[2]];
i ← i+1;
ENDLOOP;
switchable ← FALSE; count ← 0;
WHILE i <= nSons DO -- N.B. implicitbias is never changed by this loop
subNode ← GetNode[tb[listNode].son[i]];
IF ~tb[subNode].attr1 OR multiword THEN EXIT;
tb[subNode].son[1] ← UpdateList[tb[subNode].son[1], SwitchValue];
tb[subNode].son[2] ← selection[tb[subNode].son[2]];
switchable ← TRUE; last ← i; i ← i+1;
ENDLOOP;
IF switchable
AND SwitchWorthy[count,
(max←TreeLiteralValue[maxTree])-(min←TreeLiteralValue[minTree])] THEN {
copying ← TRUE;
FOR j IN [next .. first) DO PushTree[tb[listNode].son[j]] ENDLOOP;
PushTree[AdjustBias[Tree.Null, min]];
PushTree[MakeTreeLiteral[max-min+1]];
FOR j IN [first .. last] DO PushTree[SwitchTree[tb[listNode].son[j], min]] ENDLOOP;
PushProperList[last-first+1];
PushNode[caseswitch, 3];
next ← last+1; newSons ← newSons - (last-first)};
ENDLOOP;
IF copying THEN {
FOR j IN [next .. nSons] DO PushTree[tb[listNode].son[j]] ENDLOOP;
PushProperList[newSons]; son[2] ← PopTree[]};
son[3] ← selection[son[3]];
val ← Tree.Link[subtree[index: node]]};
passPtr.implicitAttr ← saveAttr; passPtr.implicitBias ← saveBias;
passPtr.implicitType ← saveType;
RETURN};
-- auxiliary routines for CaseDriver
SwitchWorthy: PROC [entries, delta: CARDINAL] RETURNS [BOOL] = {
-- the decision function for using a switch
RETURN [delta < 77777b AND delta+6 < 3*entries]};
SwitchTree: PROC [t: Tree.Link, offset: INTEGER] RETURNS [Tree.Link] = {
node: Tree.Index = GetNode[t];
count: CARDINAL;
PushSwitchEntry: Tree.Scan = {
subNode: Tree.Index = GetNode[t];
count ← count+1;
PushTree[MakeTreeLiteral[TreeLiteralValue[tb[subNode].son[2]]-offset]]};
count ← 0; ScanList[tb[node].son[1], PushSwitchEntry];
PushList[count]; PushTree[tb[node].son[2]];
tb[node].son[2] ← Tree.Null; FreeNode[node];
RETURN [MakeNode[casetest, 2]]};
-- iterative statements
DoStmt: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
OPEN tb[node];
void: BOOL ← FALSE;
bti: BTIndex ← BTNull;
IF son[1] # Tree.Null THEN [bti, void] ← ForClause[GetNode[son[1]]];
IF son[2] # Tree.Null THEN {
son[2] ← BoolValue[son[2]];
IF TreeLiteral[son[2]] THEN {
IF BoolTest[son[2]] THEN son[2] ← FreeTree[son[2]] ELSE void ← TRUE};
VPop[]};
son[3] ← UpdateList[son[3], OpenItem];
son[4] ← UpdateList[son[4], Stmt];
son[5] ← UpdateList[son[5], Stmt];
son[6] ← UpdateList[son[6], Stmt];
son[3] ← ReverseUpdateList[son[3], CloseItem];
IF catchScope AND bti # BTNull THEN
catchBound ← MAX[AssignBlock[bti, catchBase], catchBound];
IF ~void THEN val ← [subtree[index: node]]
ELSE {val ← son[6]; son[6] ← Tree.Null; FreeNode[node]};
RETURN};
ForClause: PROC [node: Tree.Index] RETURNS [bti: BTIndex, void: BOOL] = {
idBias: INTEGER;
idRep, rep: Repr;
idType, type1, type2: CSEIndex;
iNode: Tree.Index;
range: CARDINAL;
cs: ConsState ← $first;
void ← FALSE; bti ← tb[node].info;
IF tb[node].son[1] = Tree.Null THEN {
idType ← dataPtr.typeINT; idBias ← 0; idRep ← both}
ELSE {
IF OpName[tb[node].son[1]] = decl THEN {
subNode: Tree.Index ← GetNode[tb[node].son[1]];
ScanList[tb[node].son[1], DeclItem];
tb[node].son[1] ← tb[subNode].son[1];
tb[subNode].son[1] ← Tree.Null; FreeNode[subNode];
cs ← $init};
idType ← OperandType[tb[node].son[1]];
tb[node].son[1] ← Exp[tb[node].son[1], none];
idBias ← VBias[]; idRep ← VRep[]; VPop[]};
SELECT tb[node].name FROM
forseq => {
tb[node].son[2] ← Rhs[tb[node].son[2], idType, cs]; VPop[];
tb[node].son[3] ← Rhs[tb[node].son[3], idType, $first]; VPop[]};
upthru, downthru => {
tb[node].son[2] ← NormalizeRange[tb[node].son[2]];
iNode ← GetNode[tb[node].son[2]];
type1 ← OperandType[tb[iNode].son[1]];
type2 ← OperandType[tb[iNode].son[2]];
tb[node].attr1 ← Interval[iNode, idBias, idRep].const AND seb[idType].typeTag # long;
IF tb[node].attr1 AND ~tb[iNode].attr2 THEN
[] ← ConstantInterval[iNode ! EmptyInterval => {void ← TRUE; RESUME}];
rep ← CommonRep[VRep[], idRep];
tb[iNode].attr3 ← rep # unsigned; VPop[];
IF rep = none OR (rep = unsigned AND idBias > 0) THEN
Log.ErrorTree[mixedRepresentation, tb[node].son[2]];
SELECT TRUE FROM
void => NULL;
(WordsForType[idType] = 0) => Log.ErrorTree[sizeClash, tb[node].son[1]];
(idType # dataPtr.typeINT) AND (idType # typeANY) => {
OPEN tb[iNode];
range ← Cardinality[idType];
IF (checked OR dataPtr.switches['b]) AND range # 0 THEN
IF (Cover[idType, idRep, type1, rep] # full AND RangeTest[son[1], range] # in)
OR
(Cover[idType, idRep, type2, rep] # full AND RangeTest[son[2], range] # in) THEN
tb[node].son[3] ← MakeTreeLiteral[range];
IF name = intCC AND type2 # dataPtr.typeINT THEN
IF TreeLiteral[son[1]] AND
INTEGER[TreeLiteralValue[son[1]]]+idBias <= BiasForType[type2] THEN
tb[node].attr1 ← TRUE;
IF tb[node].attr1 AND range # 0 THEN { -- nonvoid interval
IF (name=intCC OR name=intCO) AND RangeTest[son[1], range] = out THEN
Log.ErrorTree[boundsFault, son[1]];
IF (name=intCC OR name=intOC) AND RangeTest[son[2], range] = out THEN
Log.ErrorTree[boundsFault, son[2]]}};
ENDCASE};
ENDCASE => ERROR;
RETURN};
RangeTest: PROC [t: Tree.Link, range: CARDINAL] RETURNS [{in, out, unknown}] = {
RETURN [IF TreeLiteral[t]
THEN IF TreeLiteralValue[t] < range THEN in ELSE out
ELSE unknown]};
-- free
Free: PROC [node: Tree.Index] RETURNS [Tree.Link] = {
OPEN tb[node];
vType, pType: CSEIndex;
IF son[1] # Tree.Null THEN {son[1] ← Exp[son[1], none]; VPop[]};
son[2] ← NeutralExp[son[2]];
vType ← OperandType[son[2]]; pType ← DerefType[vType];
IF OpName[son[2]] = addr THEN {
subNode: Tree.Index = GetNode[son[2]];
son[2] ← tb[subNode].son[1]; tb[subNode].son[1] ← Tree.Null; FreeNode[subNode]}
ELSE {
PushTree[son[2]]; PushNode[uparrow, 1]; SetInfo[pType];
SetAttr[1, checked OR dataPtr.switches['n]];
SetAttr[2, seb[vType].typeTag = long];
son[2] ← PopTree[]};
tb[node].son[3] ← MakeTreeLiteral[WordsForType[DerefType[pType]]];
IF nSons > 3 THEN CatchNest[son[4]];
RETURN [[subtree[index: node]]]};
-- basing
DerefType: PROC [type: CSEIndex] RETURNS [CSEIndex] = {
subType: CSEIndex = NormalType[type];
RETURN [WITH seb[subType] SELECT FROM
ref => UnderType[refType],
ENDCASE => type]};
OpenItem: Tree.Map = {
node: Tree.Index = GetNode[t];
IF OpName[tb[node].son[2]] # openx THEN v ← Tree.Null
ELSE {v ← NeutralExp[tb[node].son[2]]; tb[node].son[2] ← Tree.Null};
FreeNode[node];
RETURN};
CloseItem: Tree.Map = {
node: Tree.Index;
IF bb[currentBody].firstSon # BTNull OR OpName[t] # openx THEN v ← t
ELSE {
MarkShared[t, FALSE]; node ← GetNode[t];
v ← tb[node].son[1]; tb[node].son[1] ← Tree.Null; FreeNode[node]};
RETURN};
-- catch phrases
CatchFrameBase: CARDINAL = (PrincOps.localbase+3)*WordLength;
catchScope: BOOL;
catchBase: CARDINAL;
catchBound: CARDINAL;
CatchNest: PUBLIC PROC [t: Tree.Link] = {
IF t # Tree.Null THEN CatchPhrase[t]};
CatchPhrase: PROC [t: Tree.Link] = {
node: Tree.Index = GetNode[t];
saveCatchScope: BOOL = catchScope;
saveCatchBase: CARDINAL = catchBase;
saveCatchBound: CARDINAL = catchBound;
bound: CARDINAL;
CatchTest: Tree.Map = {
PushTree[Tree.Null]; PushTree[Exp[t, none]]; VPop[];
PushNode[relE, 2]; SetInfo[dataPtr.typeBOOL];
RETURN [PopTree[]]};
CatchItem: Tree.Scan = {
node: Tree.Index = GetNode[t];
type: CSEIndex = tb[node].info;
saveRecord: RecordSEIndex = passPtr.resumeRecord;
tb[node].son[1] ← UpdateList[tb[node].son[1], CatchTest];
catchBase ← CatchFrameBase;
IF type = CSENull THEN passPtr.resumeRecord ← RecordSENull
ELSE
WITH t: seb[type] SELECT FROM
transfer => {
passPtr.resumeRecord ← ArgRecord[t.typeOut];
catchBase ← catchBase +
ArgLength[ArgRecord[t.typeIn]] + ArgLength[passPtr.resumeRecord]};
ENDCASE => ERROR;
catchBound ← catchBase;
tb[node].son[2] ← Stmt[tb[node].son[2]];
bound ← MAX[bound, catchBound];
passPtr.resumeRecord ← saveRecord};
bti: CCBTIndex = tb[node].info;
bb[bti].index ← dataPtr.catchIndex; dataPtr.catchIndex ← dataPtr.catchIndex + 1;
catchScope ← TRUE; currentLevel ← currentLevel + 1;
bound ← CatchFrameBase + WordLength;
ScanList[tb[node].son[1], CatchItem];
IF tb[node].nSons > 1 THEN {
catchBound ← catchBase ← CatchFrameBase;
tb[node].son[2] ← Stmt[tb[node].son[2]];
bound ← MAX[bound, catchBound]};
WITH body: bb[bti].info SELECT FROM
Internal => body.frameSize ← (bound + (WordLength-1))/WordLength;
ENDCASE => ERROR;
catchBase ← saveCatchBase; catchBound ← saveCatchBound;
currentLevel ← currentLevel - 1; catchScope ← saveCatchScope};
ArgLength: PROC [rSei: RecordSEIndex] RETURNS [CARDINAL] = {
RETURN [IF rSei = RecordSENull THEN 0 ELSE seb[rSei].length]};
}.