-- file Pass4S.Mesa
-- last modified by Satterthwaite, December 11, 1979 9:07 AM
DIRECTORY
AltoDefs: FROM "altodefs" USING [wordlength],
ComData: FROM "comdata"
USING [
bodyIndex, definitionsOnly, monitored, nTypeCodes, switches, textIndex,
typeMap, typeMapId,
typeBOOLEAN, typeINTEGER, typeLOCK],
ControlDefs: FROM "controldefs"
USING [StateVector, EPRange, localbase],
InlineDefs: FROM "inlinedefs" USING [BITAND],
Log: FROM "log" USING [Error, ErrorSei, ErrorTree],
LiteralOps: FROM "literalops"
USING [Find, FindDescriptor, ResetLocalStrings],
P4: FROM "p4"
USING [
Repr, none, unsigned, both, other,
AdjustBias, Assignment, BiasForType, Call, CheckBlock, --CommonRep,--
ConstantInterval, Cover, DeclItem, DeclUpdate, Exp, Interval,
LayoutBlock, LayoutGlobals, LayoutInterface, LayoutLocals,
MakeArgRecord, MakeTreeLiteral, NeutralExp, NormalizeRange,
OperandType, RelTest, RepForType, Rhs, RValue, TargetRep,
TreeLiteral, TreeLiteralValue, VBias, VPop, VRep, WordsForType,
EmptyInterval],
Pass4: FROM "pass4"
USING [
implicitBias, implicitRep, implicitType, lockNode, resident,
resumeRecord, returnRecord, tFALSE, tTRUE],
Symbols: FROM "symbols"
USING [seType, ctxType, bodyType,
ISEIndex, CSEIndex, RecordSEIndex, BTIndex, CBTIndex, ContextLevel,
SENull, RecordSENull, BTNull, lG, lL, typeANY],
SymbolOps: FROM "symbolops"
USING [
Cardinality, ContextVariant, FirstVisibleSe, NextSe,
NormalType, TransferTypes, UnderType],
SystemDefs: FROM "systemdefs" USING [FreeHeapNode],
Table: FROM "table" USING [Base, Notifier],
Tree: FROM "tree"
USING [treeType, Index, Link, Map, NodeName, Scan, Null, NullIndex],
TreeOps: FROM "treeops"
USING [
FreeNode, FreeTree, GetNode, ListLength, MakeList, MakeNode,
PopTree, PushProperList, PushList, PushLit, PushNode, PushTree,
ReverseScanList, ReverseUpdateList, ScanList,
SetAttr, SetInfo, SetShared, TestTree, UpdateList];
Pass4S: PROGRAM
IMPORTS
InlineDefs, Log, LiteralOps, P4, SymbolOps, SystemDefs, TreeOps,
dataPtr: ComData, passPtr: Pass4
EXPORTS P4 =
BEGIN
OPEN SymbolOps, Symbols, P4, TreeOps;
CommonRep: PROCEDURE [Repr, Repr] RETURNS [Repr] =
LOOPHOLE[InlineDefs.BITAND];
tb: Table.Base; -- tree base address (local copy)
seb: Table.Base; -- se table base address (local copy)
ctxb: Table.Base; -- ctx table base address (local copy)
bb: Table.Base; -- body table base (local copy)
StmtNotify: PUBLIC Table.Notifier =
BEGIN -- called by allocator whenever table area is repacked
tb ← base[Tree.treeType];
seb ← base[seType]; ctxb ← base[ctxType]; bb ← base[bodyType];
END;
WordLength: CARDINAL = AltoDefs.wordlength;
Repr: TYPE = P4.Repr;
none: Repr = P4.none;
-- bodies and blocks
BodyList: PUBLIC PROCEDURE [firstBti: BTIndex] =
BEGIN
bti: BTIndex;
IF (bti ← firstBti) # BTNull
THEN
DO
WITH bb[bti] SELECT FROM
Callable =>
IF ~inline
OR (dataPtr.definitionsOnly AND LocalBody[LOOPHOLE[bti]])
THEN Body[LOOPHOLE[bti, CBTIndex]];
ENDCASE => BodyList[bb[bti].firstSon];
IF bb[bti].link.which = parent THEN EXIT;
bti ← bb[bti].link.index;
ENDLOOP;
END;
LocalBody: PROCEDURE [bti: CBTIndex] RETURNS [BOOLEAN] = INLINE
BEGIN
sei: ISEIndex = bb[bti].id;
RETURN [sei = SENull OR ctxb[seb[sei].idCtx].ctxType = simple]
END;
Body: PROCEDURE [bti: CBTIndex] =
BEGIN
oldBodyIndex: CBTIndex = dataPtr.bodyIndex;
saveIndex: CARDINAL = dataPtr.textIndex;
saveCatchScope: BOOLEAN = catchScope;
saveRecord: RecordSEIndex = passPtr.returnRecord;
node: Tree.Index;
sei: CSEIndex;
base, bound: CARDINAL;
initTree: Tree.Link;
catchScope ← FALSE;
dataPtr.bodyIndex ← bti;
WITH bb[bti].info SELECT FROM
Internal => BEGIN node ← bodyTree; dataPtr.textIndex ← sourceIndex END;
ENDCASE => ERROR;
IF dataPtr.definitionsOnly AND bb[bti].level > lL
THEN Log.ErrorSei[nonDefinition, bb[bti].id];
sei ← UnderType[bb[bti].ioType];
passPtr.returnRecord ← TransferTypes[sei].typeOut;
[] ← LiteralOps.ResetLocalStrings[];
IF bb[bti].level = lG THEN FillTypeMap[];
IF tb[node].son[4] # Tree.Null
THEN BEGIN tb[node].son[4] ← Exp[tb[node].son[4], none]; VPop[] END;
tb[node].son[1] ← UpdateList[tb[node].son[1], OpenItem];
ScanList[tb[node].son[2], DeclItem];
base ← SELECT bb[bti].level FROM
lG => LayoutGlobals[bti],
ENDCASE => LayoutLocals[bti];
initTree ← Tree.Null;
SELECT bb[bti].level FROM
lG =>
BEGIN
IF dataPtr.monitored AND tb[passPtr.lockNode].attr1
THEN
BEGIN
PushTree[tb[passPtr.lockNode].son[2]];
PushLit[LiteralOps.Find[100000B]]; PushNode[cast, 1];
SetInfo[dataPtr.typeLOCK];
PushNode[assign, 2]; SetAttr[1, FALSE]; initTree ← PopTree[];
END;
IF dataPtr.nTypeCodes # 0
THEN
BEGIN
PushTree[TypeMapInit[]];
IF initTree # Tree.Null
THEN BEGIN PushTree[initTree]; PushList[-2] END;
initTree ← PopTree[];
END;
END;
ENDCASE =>
IF bb[bti].firstSon # BTNull
THEN initTree ← BodyInitList[bb[bti].firstSon];
tb[node].son[3] ← UpdateList[tb[node].son[3], Stmt];
bound ← AssignSubBlocks[bti, base];
WITH bb[bti].info SELECT FROM
Internal =>
BEGIN
frameSize ← (bound + (WordLength-1))/WordLength;
thread ← LiteralOps.ResetLocalStrings[];
END;
ENDCASE;
bb[bti].resident ← passPtr.resident;
IF bb[bti].firstSon # BTNull
THEN BodyList[bb[bti].firstSon]
ELSE tb[node].son[1] ← ReverseUpdateList[tb[node].son[1], CloseItem];
tb[node].son[2] ← UpdateList[tb[node].son[2], DeclUpdate];
IF initTree # Tree.Null
THEN
BEGIN PushTree[initTree];
IF tb[node].son[2] # Tree.Null
THEN BEGIN PushTree[tb[node].son[2]]; PushList[2] END;
tb[node].son[2] ← PopTree[];
END;
IF dataPtr.definitionsOnly AND bb[bti].level = lG
THEN
BEGIN
n: CARDINAL = LayoutInterface[bti];
WITH seb[sei] SELECT FROM
definition =>
nGfi ← IF n=0 THEN 1 ELSE (n-1)/ControlDefs.EPRange + 1;
ENDCASE;
END;
catchScope ← saveCatchScope;
dataPtr.bodyIndex ← oldBodyIndex; dataPtr.textIndex ← saveIndex;
passPtr.returnRecord ← saveRecord;
IF bb[bti].level = lG AND dataPtr.nTypeCodes # 0
THEN SystemDefs.FreeHeapNode[BASE[dataPtr.typeMap]];
END;
BodyInitList: PROCEDURE [firstBti: BTIndex] RETURNS [Tree.Link] =
BEGIN
bti: BTIndex;
n: CARDINAL;
n ← 0;
IF (bti ← firstBti) # BTNull
THEN
DO
WITH body: bb[bti] SELECT FROM
Callable =>
IF ~body.inline
THEN BEGIN PushNode[procinit, 0]; SetInfo[bti]; n ← n+1 END;
ENDCASE => NULL;
IF bb[bti].link.which = parent THEN EXIT;
bti ← bb[bti].link.index;
ENDLOOP;
RETURN [MakeList[n]]
END;
AssignSubBlocks: PROCEDURE [rootBti: BTIndex, base: CARDINAL] RETURNS [bound: CARDINAL] =
BEGIN
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 bound ← MAX[AssignBlock[bti, base], bound];
ENDCASE => NULL;
IF bb[bti].link.which = parent THEN EXIT;
bti ← bb[bti].link.index;
ENDLOOP;
RETURN
END;
Subst: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Tree.Link] =
BEGIN OPEN tb[node];
saveRecord: RecordSEIndex = passPtr.returnRecord;
son[1] ← NeutralExp[son[1]];
passPtr.returnRecord ← TransferTypes[OperandType[son[1]]].typeOut;
son[2] ← UpdateList[son[2], Stmt];
passPtr.returnRecord ← saveRecord;
RETURN [Tree.Link[subtree[index: node]]]
END;
Block: PROCEDURE [node: Tree.Index] RETURNS [Tree.Link] =
BEGIN OPEN tb[node];
bti: BTIndex = info;
saveIndex: CARDINAL = dataPtr.textIndex;
initTree: Tree.Link ← Tree.Null;
WITH bb[bti].info SELECT FROM
Internal => dataPtr.textIndex ← sourceIndex;
ENDCASE;
ScanList[son[1], DeclItem];
CheckBlock[bti];
son[2] ← UpdateList[son[2], Stmt];
son[1] ← UpdateList[son[1], DeclUpdate];
IF catchScope
THEN catchBound ← MAX[AssignBlock[bti, catchBase], catchBound];
dataPtr.textIndex ← saveIndex;
RETURN [Tree.Link[subtree[index: node]]]
END;
AssignBlock: PROCEDURE [bti: BTIndex, base: CARDINAL] RETURNS [bound: CARDINAL] =
BEGIN
node: Tree.Index;
newBase: CARDINAL;
initTree: Tree.Link ← Tree.Null;
newBase ← LayoutBlock[bti, base];
IF bb[bti].level # lG AND bb[bti].firstSon # BTNull
THEN initTree ← BodyInitList[bb[bti].firstSon];
bound ← AssignSubBlocks[bti, newBase];
WITH bb[bti].info SELECT FROM
Internal =>
BEGIN
frameSize ← (bound + (WordLength-1))/WordLength; node ← bodyTree;
END;
ENDCASE => NULL;
IF initTree # Tree.Null
THEN
BEGIN OPEN tb[node];
PushTree[initTree];
IF son[1] # Tree.Null THEN BEGIN PushTree[son[1]]; PushList[2] END;
son[1] ← PopTree[];
END;
RETURN
END;
-- type map
FillTypeMap: PROCEDURE =
BEGIN
mapType, subType: CSEIndex;
sei: ISEIndex = dataPtr.typeMapId;
IF sei # SENull
THEN
BEGIN
mapType ← UnderType[seb[sei].idType];
WITH seb[mapType] SELECT FROM
array =>
BEGIN
subType ← UnderType[indexType];
WITH seb[subType] SELECT FROM
subrange =>
BEGIN
origin ← 0;
IF dataPtr.nTypeCodes # 0
THEN range ← dataPtr.nTypeCodes - 1
ELSE BEGIN empty ← TRUE; range ← 0 END;
filled ← mark4 ← TRUE;
END;
ENDCASE => ERROR;
mark4 ← TRUE;
END;
ENDCASE => ERROR;
seb[sei].mark4 ← TRUE;
END;
END;
TypeMapInit: PROCEDURE RETURNS [Tree.Link] =
BEGIN
PushTree[[symbol[index: dataPtr.typeMapId]]];
PushLit[LiteralOps.FindDescriptor[
DESCRIPTOR[BASE[dataPtr.typeMap], dataPtr.nTypeCodes, WORD]]];
PushNode[mwconst, 1]; SetInfo[UnderType[seb[dataPtr.typeMapId].idType]];
PushNode[assign, 2]; SetAttr[1, FALSE];
-- generate a descriptor
PushTree[[symbol[index: dataPtr.typeMapId]]];
PushNode[addr, 1]; SetInfo[typeANY]; SetAttr[2, FALSE];
PushLit[LiteralOps.Find[dataPtr.nTypeCodes]];
PushList[2];
PushLit[LiteralOps.Find[277B]];
PushNode[syscall, -2]; PushList[2];
RETURN [PopTree[]]
END;
-- main dispatch
Stmt: PROCEDURE [stmt: Tree.Link] RETURNS [val: Tree.Link] =
BEGIN
node: Tree.Index;
saveIndex: CARDINAL = dataPtr.textIndex;
val ← stmt; -- the default case
WITH stmt SELECT FROM
subtree =>
BEGIN node ← index;
IF node # Tree.NullIndex
THEN
BEGIN OPEN tb[node];
dataPtr.textIndex ← info;
SELECT name FROM
assign =>
BEGIN val ← Assignment[node]; VPop[] END;
extract => Extract[node];
call, portcall, signal, error, xerror, start, join =>
BEGIN val ← Call[node]; VPop[] END;
subst => val ← Subst[node];
block => val ← Block[node];
if => val ← IfStmt[node];
case => val ← CaseDriver[node, Stmt, 0];
bind => val ← Binding[node, case, BindStmt];
do => val ← DoStmt[node];
return, result =>
son[1] ← MakeArgRecord[passPtr.returnRecord, son[1]];
label =>
BEGIN
son[1] ← Stmt[son[1]];
son[2] ← UpdateList[son[2], Stmt];
END;
goto, exit, loop, syserror, continue, retry, null => NULL;
restart =>
BEGIN
son[1] ← NeutralExp[son[1]];
IF nSons > 2 THEN CatchNest[son[3]];
END;
stop => CatchNest[son[1]];
lock =>
BEGIN
son[1] ← UpdateList[son[1], Stmt];
son[2] ← Exp[son[2], none]; VPop[];
END;
wait =>
BEGIN
son[1] ← Exp[son[1], none]; VPop[];
son[2] ← Exp[son[2], none]; VPop[];
IF nSons > 2 THEN CatchNest[son[3]];
END;
notify, broadcast, unlock =>
BEGIN son[1] ← Exp[son[1], none]; VPop[] END;
open =>
BEGIN
son[1] ← UpdateList[son[1], OpenItem];
son[2] ← UpdateList[son[2], Stmt];
END;
enable =>
BEGIN CatchPhrase[son[1]]; son[2] ← Stmt[son[2]] END;
resume =>
son[1] ← MakeArgRecord[passPtr.resumeRecord, son[1]];
catchmark => son[1] ← Stmt[son[1]];
dst, lst, lstf =>
BEGIN
son[1] ← Exp[son[1], none];
IF WordsForType[OperandType[son[1]]] #
SIZE[ControlDefs.StateVector]
THEN Log.ErrorTree[sizeClash, son[1]];
VPop[];
END;
apply => NULL;
item => son[2] ← Stmt[son[2]];
list => val ← UpdateList[stmt, Stmt];
ENDCASE => Log.Error[unimplemented];
END;
END;
ENDCASE => ERROR;
dataPtr.textIndex ← saveIndex; RETURN
END;
-- extraction
Extract: PROCEDURE [node: Tree.Index] =
BEGIN
AssignItem: Tree.Map =
BEGIN
type: CSEIndex;
saveType: CSEIndex = passPtr.implicitType;
saveBias: INTEGER = passPtr.implicitBias;
saveRep: Repr = passPtr.implicitRep;
IF t = Tree.Null
THEN v ← Tree.Null
ELSE
BEGIN
subNode: Tree.Index = GetNode[t];
type ← UnderType[seb[sei].idType];
passPtr.implicitType ← type;
passPtr.implicitBias ← BiasForType[type];
passPtr.implicitRep ← RepForType[type];
IF tb[subNode].name = extract
THEN BEGIN Extract[subNode]; v ← t END
ELSE BEGIN v ← Assignment[subNode]; VPop[] END;
END;
sei ← NextSe[sei];
passPtr.implicitRep ← saveRep; passPtr.implicitBias ← saveBias;
passPtr.implicitType ← saveType; RETURN
END;
subNode: Tree.Index = GetNode[tb[node].son[1]];
rType: RecordSEIndex = tb[subNode].info;
sei: ISEIndex;
seb[rType].lengthUsed ← TRUE;
sei ← FirstVisibleSe[seb[rType].fieldCtx];
tb[subNode].son[1] ← UpdateList[tb[subNode].son[1], AssignItem];
tb[node].son[2] ← Exp[tb[node].son[2], none]; VPop[];
END;
-- conditionals
IfStmt: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
BEGIN OPEN tb[node];
son[1] ← NeutralExp[son[1]];
son[2] ← Stmt[son[2]]; son[3] ← Stmt[son[3]];
IF ~TreeLiteral[son[1]]
THEN val ← Tree.Link[subtree[index: node]]
ELSE
BEGIN
IF son[1] # passPtr.tFALSE
THEN BEGIN val ← son[2]; son[2] ← Tree.Null END
ELSE BEGIN val ← son[3]; son[3] ← Tree.Null END;
FreeNode[node];
END;
RETURN
END;
BindStmt: PROCEDURE [t: Tree.Link, labelBias: INTEGER] RETURNS [Tree.Link] =
BEGIN
node: Tree.Index = GetNode[t];
RETURN [CaseDriver[GetNode[t], Stmt, labelBias]]
END;
-- drivers for processing selections
Binding: PUBLIC PROCEDURE [
node: Tree.Index,
op: Tree.NodeName,
eval: PROCEDURE [Tree.Link, INTEGER] RETURNS [Tree.Link]]
RETURNS [val: Tree.Link] =
BEGIN OPEN tb[node];
labelBias: INTEGER = TagBias[OpenedType[son[1]]];
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];
val ← eval[PopTree[], labelBias]; subNode ← GetNode[val];
tb[subNode].son[4] ← CloseItem[tb[subNode].son[4]];
FreeNode[node]; RETURN
END;
TagBias: PROCEDURE [rType: CSEIndex] RETURNS [INTEGER] =
BEGIN
sei: ISEIndex = WITH seb[rType] SELECT FROM
record => ContextVariant[fieldCtx],
ENDCASE => ERROR;
uType: CSEIndex = UnderType[seb[sei].idType];
RETURN [WITH seb[uType] SELECT FROM
union => BiasForType[UnderType[seb[tagSei].idType]],
ENDCASE => 0]
END;
CaseDriver: PUBLIC PROCEDURE [
node: Tree.Index, selection: Tree.Map, labelBias: INTEGER]
RETURNS [val: Tree.Link] =
BEGIN OPEN tb[node];
type: CSEIndex = OperandType[son[1]];
son[1] ← Exp[son[1], none];
IF type = dataPtr.typeBOOLEAN AND attr1 AND TreeLiteral[son[1]]
THEN
BEGIN
CaseItem: Tree.Scan =
BEGIN
subNode: Tree.Index = GetNode[t];
started: BOOLEAN;
PushTest: Tree.Scan =
BEGIN
tNode: Tree.Index = GetNode[t];
PushTree[tb[tNode].son[2]]; tb[tNode].son[2] ← Tree.Null;
IF son[1] = passPtr.tFALSE THEN PushNode[not, 1];
IF started THEN PushNode[or, 2];
started ← TRUE; RETURN
END;
PushTree[tb[subNode].son[2]]; tb[subNode].son[2] ← Tree.Null;
started ← FALSE; ScanList[tb[subNode].son[1], PushTest];
IF selection = Stmt
THEN BEGIN PushNode[if, -3]; SetInfo[tb[subNode].info] END
ELSE BEGIN PushNode[ifx, -3]; SetInfo[tb[node].info] END;
RETURN
END;
son[1] ← AdjustBias[son[1], -VBias[]]; VPop[];
PushTree[son[3]]; son[3] ← Tree.Null;
ReverseScanList[son[2], CaseItem];
FreeNode[node];
val ← selection[PopTree[]];
END
ELSE
BEGIN
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: BOOLEAN;
multiword: BOOLEAN = WordsForType[type] # 1;
count: CARDINAL;
SwitchValue: Tree.Map =
BEGIN
val: Tree.Link;
tNode: Tree.Index = GetNode[t];
val ← tb[tNode].son[2] ←
RValue[tb[tNode].son[2], passPtr.implicitBias, rep];
VPop[];
IF count = 0
THEN BEGIN first ← i; minTree ← maxTree ← val END
ELSE
BEGIN
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;
END;
count ← count + 1;
RETURN [t]
END;
saveType: CSEIndex = passPtr.implicitType;
saveBias: INTEGER = passPtr.implicitBias;
saveRep: Repr = passPtr.implicitRep;
passPtr.implicitType ← type;
passPtr.implicitBias ← VBias[] - labelBias;
passPtr.implicitRep ← rep ← VRep[]; 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], NeutralExp];
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
BEGIN 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);
END;
ENDLOOP;
IF copying
THEN
BEGIN
FOR j IN [next .. nSons] DO PushTree[tb[listNode].son[j]] ENDLOOP;
PushProperList[newSons]; son[2] ← PopTree[];
END;
son[3] ← selection[son[3]];
val ← Tree.Link[subtree[index: node]];
passPtr.implicitRep ← saveRep; passPtr.implicitBias ← saveBias;
passPtr.implicitType ← saveType;
END;
RETURN
END;
-- auxiliary routines for CaseDriver
SwitchWorthy: PROCEDURE [entries, delta: CARDINAL] RETURNS [BOOLEAN] =
-- the decision function for using a switch
BEGIN RETURN [delta < 77777B AND delta+6 < 3*entries]
END;
SwitchTree: PROCEDURE [t: Tree.Link, offset: INTEGER] RETURNS [Tree.Link] =
BEGIN
node: Tree.Index = GetNode[t];
count: CARDINAL;
PushSwitchEntry: Tree.Scan =
BEGIN
subNode: Tree.Index = GetNode[t];
count ← count+1;
PushTree[MakeTreeLiteral[
TreeLiteralValue[tb[subNode].son[2]]-offset]];
END;
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]]
END;
-- iterative statements
DoStmt: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
BEGIN OPEN tb[node];
delete: BOOLEAN ← FALSE;
IF son[1] # Tree.Null THEN delete ← ForClause[GetNode[son[1]]].empty;
IF son[2] # Tree.Null
THEN
BEGIN son[2] ← NeutralExp[son[2]];
SELECT son[2] FROM
passPtr.tTRUE => son[2] ← FreeTree[son[2]];
passPtr.tFALSE => delete ← TRUE;
ENDCASE;
END;
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 ~delete
THEN val ← Tree.Link[subtree[index: node]]
ELSE BEGIN FreeNode[node]; val ← Tree.Null END;
RETURN
END;
ForClause: PROCEDURE [node: Tree.Index] RETURNS [empty: BOOLEAN] =
BEGIN
idBias: INTEGER;
idRep, target, rep: Repr;
idType, type1, type2: CSEIndex;
iNode: Tree.Index;
range: CARDINAL;
empty ← FALSE;
IF tb[node].son[1] = Tree.Null
THEN
BEGIN
idType ← dataPtr.typeINTEGER;
idBias ← 0; idRep ← both; target ← none;
END
ELSE
BEGIN
idType ← OperandType[tb[node].son[1]];
tb[node].son[1] ← Exp[tb[node].son[1], none];
idBias ← VBias[]; idRep ← VRep[]; target ← TargetRep[idRep]; VPop[];
END;
SELECT tb[node].name FROM
forseq =>
BEGIN
tb[node].son[2] ← Rhs[tb[node].son[2], idType]; VPop[];
tb[node].son[3] ← Rhs[tb[node].son[3], idType]; VPop[];
END;
upthru, downthru =>
BEGIN
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]];
IF (tb[node].attr1 ← Interval[iNode, idBias, idRep].const)
THEN [] ← ConstantInterval[iNode
!EmptyInterval => BEGIN empty ← TRUE; RESUME END];
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
empty => NULL;
WordsForType[idType] = 0 =>
Log.ErrorTree[sizeClash, tb[node].son[1]];
idType # dataPtr.typeINTEGER AND idType # typeANY =>
BEGIN OPEN tb[iNode];
range ← Cardinality[idType];
IF 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.typeINTEGER 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 -- nonempty interval
BEGIN
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]];
END;
END;
ENDCASE;
END;
ENDCASE => ERROR;
RETURN
END;
RangeTest: PROCEDURE [t: Tree.Link, range: CARDINAL] RETURNS [{in, out, unknown}] =
BEGIN
RETURN [IF TreeLiteral[t]
THEN IF TreeLiteralValue[t] < range THEN in ELSE out
ELSE unknown]
END;
-- basing
OpenedType: PROCEDURE [t: Tree.Link] RETURNS [CSEIndex] =
BEGIN
node: Tree.Index = GetNode[t];
type: CSEIndex = NormalType[OperandType[tb[node].son[2]]];
RETURN [WITH seb[type] SELECT FROM
pointer => UnderType[refType],
ENDCASE => type]
END;
OpenItem: Tree.Map =
BEGIN
node: Tree.Index = GetNode[t];
IF ~TestTree[tb[node].son[2], openx]
THEN v ← Tree.Null
ELSE
BEGIN
v ← NeutralExp[tb[node].son[2]]; tb[node].son[2] ← Tree.Null;
END;
FreeNode[node];
RETURN
END;
CloseItem: Tree.Map =
BEGIN
node: Tree.Index;
IF ~TestTree[t, openx]
THEN v ← t
ELSE
BEGIN
SetShared[t, FALSE]; node ← GetNode[t];
v ← tb[node].son[1]; tb[node].son[1] ← Tree.Null; FreeNode[node];
END;
RETURN
END;
-- catch phrases
CatchFrameBase: CARDINAL = (ControlDefs.localbase+1)*WordLength;
catchScope: BOOLEAN;
catchBase: CARDINAL;
catchBound: CARDINAL;
CatchNest: PUBLIC PROCEDURE [t: Tree.Link] =
BEGIN
IF t # Tree.Null THEN CatchPhrase[t];
END;
CatchPhrase: PROCEDURE [t: Tree.Link] =
BEGIN
node: Tree.Index = GetNode[t];
saveCatchScope: BOOLEAN = catchScope;
saveCatchBase: CARDINAL = catchBase;
saveCatchBound: CARDINAL = catchBound;
bound: CARDINAL;
CatchTest: Tree.Map =
BEGIN
PushTree[Tree.Null]; PushTree[Exp[t, none]]; VPop[];
PushNode[relE, 2]; SetInfo[dataPtr.typeBOOLEAN];
RETURN [PopTree[]]
END;
CatchItem: Tree.Scan =
BEGIN
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 = SENull
THEN passPtr.resumeRecord ← RecordSENull
ELSE
WITH seb[type] SELECT FROM
transfer =>
BEGIN passPtr.resumeRecord ← outRecord;
catchBase ← catchBase + ArgLength[inRecord]+ArgLength[outRecord];
END;
ENDCASE => ERROR;
catchBound ← catchBase;
tb[node].son[2] ← Stmt[tb[node].son[2]];
bound ← MAX[bound, catchBound];
passPtr.resumeRecord ← saveRecord;
END;
catchScope ← TRUE;
bound ← CatchFrameBase + WordLength;
ScanList[tb[node].son[1], CatchItem];
IF tb[node].nSons > 1 THEN
BEGIN
catchBound ← catchBase ← CatchFrameBase;
tb[node].son[2] ← Stmt[tb[node].son[2]];
bound ← MAX[bound, catchBound];
END;
tb[node].info ← (bound + (WordLength-1))/WordLength;
catchBase ← saveCatchBase; catchBound ← saveCatchBound;
catchScope ← saveCatchScope;
END;
ArgLength: PROCEDURE [rSei: RecordSEIndex] RETURNS [length: CARDINAL] =
BEGIN
IF rSei = SENull
THEN length ← 0
ELSE BEGIN length ← seb[rSei].length; seb[rSei].lengthUsed ← TRUE END;
RETURN
END;
END.