-- file Pass4Xb.Mesa -- last written by Satterthwaite, January 10, 1980 4:16 PM DIRECTORY AltoDefs: FROM "altodefs" USING [maxcharcode, maxinteger, maxword], ComData: FROM "comdata" USING [ bodyIndex, nTypeCodes, switches, typeMap, typeMapId, typeINTEGER, typeSTRING], InlineDefs: FROM "inlinedefs" USING [BITAND], LiteralOps: FROM "literalops" USING [FindDescriptor, FindLocalString, StringReference], Log: FROM "log" USING [ErrorTree, WarningTree], P4: FROM "p4" USING [ Repr, none, signed, unsigned, both, long, other, RegCount, MaxRegs, AddrOp, All, Assignment, BiasForType, Binding, Call, CaseDriver, ComparableType, Construct, DeclItem, Dollar, FoldExpr, Index, LiteralRep, MakeTreeLiteral, MiscXfer, PadRecord, Reloc, RelTest, RepForType, Rhs, RowConstruct, Subst, TreeLiteralValue, TypeExp, TypeForTree, Union, WordsForType], Pass4: FROM "pass4" USING [implicitBias, implicitRep, implicitType, tFALSE, tTRUE], Symbols: FROM "symbols" USING [bodyType, ctxType, seType, SEIndex, ISEIndex, CSEIndex, codeCHARACTER, codeINTEGER, lG, typeANY], SymbolOps: FROM "symbolops" USING [ Cardinality, ConstantId, FindExtension, TypeForm, UnderType, WordsForType, XferMode], Table: FROM "table" USING [Base, Notifier], Tree: FROM "tree" USING [Index, Link, Map, NodeName, Null, treeType], TreeOps: FROM "treeops" USING [ FreeNode, FreeTree, GetNode, IdentityMap, ListLength, MakeNode, PopTree, PushLit, PushNode, PushTree, SetAttr, SetInfo, SetShared, Shared, TestTree, UpdateList]; Pass4Xb: PROGRAM IMPORTS InlineDefs, Log, LiteralOps, P4, SymbolOps, TreeOps, dataPtr: ComData, passPtr: Pass4 EXPORTS P4 = BEGIN OPEN SymbolOps, P4, TreeOps; CommonRep: PROCEDURE [Repr, Repr] RETURNS [Repr] = LOOPHOLE[InlineDefs.BITAND]; -- pervasive definitions from Symbols ISEIndex: TYPE = Symbols.ISEIndex; CSEIndex: TYPE = Symbols.CSEIndex; tb: Table.Base; -- tree base address (local copy) seb: Table.Base; -- se table base address (local copy) ctxb: Table.Base; -- context table base address (local copy) bb: Table.Base; -- body table base address (local copy) ExpBNotify: PUBLIC Table.Notifier = BEGIN -- called by allocator whenever table area is repacked tb _ base[Tree.treeType]; seb _ base[Symbols.seType]; ctxb _ base[Symbols.ctxType]; bb _ base[Symbols.bodyType]; END; -- intermediate result bookkeeping ValueDescriptor: TYPE = RECORD[ bias: INTEGER, -- bias in representation (scalars only) nRegs: RegCount, -- estimate of register requirement rep: Repr]; -- signed/unsigned (scalars only) VStackLimit: CARDINAL = 32; vStack: ARRAY [0 .. VStackLimit] OF ValueDescriptor; vI: CARDINAL; -- index into vStack VStackOverflow: ERROR = CODE; VPush: PUBLIC PROCEDURE [bias: INTEGER, rep: Repr, nRegs: RegCount] = BEGIN IF (vI _ vI+1) >= VStackLimit THEN ERROR VStackOverflow; vStack[vI] _ ValueDescriptor[bias:bias, rep:rep, nRegs:nRegs]; END; VPop: PUBLIC PROCEDURE = BEGIN IF vI = 0 THEN ERROR; vI _ vI-1; END; VBias: PUBLIC PROCEDURE RETURNS [INTEGER] = BEGIN RETURN [vStack[vI].bias] END; VRep: PUBLIC PROCEDURE RETURNS [Repr] = BEGIN RETURN [vStack[vI].rep] END; VRegs: PUBLIC PROCEDURE RETURNS [RegCount] = BEGIN RETURN [vStack[vI].nRegs] END; Pass4XInit: PUBLIC PROCEDURE = BEGIN vI _ 0; RETURN END; OperandType: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [CSEIndex] = BEGIN RETURN [WITH t SELECT FROM symbol => UnderType[seb[index].idType], literal => IF info.litTag = string THEN dataPtr.typeSTRING ELSE dataPtr.typeINTEGER, subtree => IF t = Tree.Null THEN passPtr.implicitType ELSE tb[index].info, ENDCASE => Symbols.typeANY] END; ForceType: PUBLIC PROCEDURE [t: Tree.Link, type: CSEIndex] RETURNS [Tree.Link] = BEGIN PushTree[t]; IF (~TestTree[t, mwconst] AND ~TestTree[t, cast]) OR Shared[t] THEN PushNode[cast, 1]; SetInfo[type]; RETURN [PopTree[]] END; ChopType: PROCEDURE [t: Tree.Link, type: CSEIndex] RETURNS [Tree.Link] = BEGIN PushTree[t]; PushNode[chop, 1]; SetInfo[type]; RETURN [PopTree[]] END; -- literals TreeLiteral: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] = BEGIN RETURN [WITH t SELECT FROM literal => info.litTag = word, subtree => SELECT tb[index].name FROM cast => TreeLiteral[tb[index].son[1]], ENDCASE => FALSE, ENDCASE => FALSE] END; StructuredLiteral: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] = BEGIN RETURN [WITH t SELECT FROM literal => info.litTag = word, subtree => SELECT tb[index].name FROM mwconst => TRUE, cast => StructuredLiteral[tb[index].son[1]], ENDCASE => FALSE, ENDCASE => FALSE] END; MakeStructuredLiteral: PUBLIC PROCEDURE [val: WORD, type: CSEIndex] RETURNS [t: Tree.Link] = BEGIN t _ MakeTreeLiteral[val]; SELECT seb[type].typeTag FROM basic, enumerated, subrange, mode => NULL; ENDCASE => t _ ForceType[t, type]; RETURN END; -- register accounting RegsForType: PUBLIC PROCEDURE [type: CSEIndex] RETURNS [RegCount] = BEGIN n: RegCount = IF seb[type].mark4 THEN SymbolOps.WordsForType[type] ELSE 0; RETURN [IF n = 2 THEN 2 ELSE 1] END; ComputeRegs: PROCEDURE [node: Tree.Index] RETURNS [RegCount] = BEGIN n1: RegCount = vStack[vI-1].nRegs; n2: RegCount = vStack[vI].nRegs; k: RegCount = RegsForType[tb[node].info]; RETURN [MIN[MAX[n1, n2+k], MaxRegs]] END; ComputeIndexRegs: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [RegCount] = BEGIN n1: RegCount = vStack[vI-1].nRegs; n2: RegCount = vStack[vI].nRegs; k: RegCount = RegsForType[OperandType[tb[node].son[1]]]; RETURN [MIN[MAX[RegsForType[tb[node].info], n1, n2+k], MaxRegs]] END; AdjustRegs: PROCEDURE [node: Tree.Index, commuteOp: Tree.NodeName] RETURNS [RegCount] = BEGIN n1: RegCount = vStack[vI-1].nRegs; n2: RegCount = vStack[vI].nRegs; k: RegCount = RegsForType[tb[node].info]; n: CARDINAL; IF n1 >= n2 THEN n _ n2 + k ELSE BEGIN v: ValueDescriptor; t: Tree.Link _ tb[node].son[1]; tb[node].son[1] _ tb[node].son[2]; tb[node].son[2] _ t; tb[node].name _ commuteOp; v _ vStack[vI]; vStack[vI] _ vStack[vI-1]; vStack[vI-1] _ v; n _ n1 + k; END; RETURN [MIN[MAX[n1, n2, n], MaxRegs]] END; -- operators Fold: PROCEDURE [node: Tree.Index, rep: Repr] RETURNS [Tree.Link] = BEGIN fullRep: Repr = IF tb[node].attr2 THEN long + rep ELSE rep; RETURN [FoldExpr[node, fullRep]] END; Substx: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] = BEGIN type: CSEIndex = tb[node].info; subNode: Tree.Index; val _ Subst[node]; node _ GetNode[val]; IF TestTree[tb[node].son[2], result] THEN BEGIN subNode _ GetNode[tb[node].son[2]]; SELECT ListLength[tb[subNode].son[1]] FROM 0 => ERROR; 1 => val _ ForceType[tb[subNode].son[1], type]; ENDCASE => BEGIN PushTree[Tree.Null]; PushTree[tb[subNode].son[1]]; PushNode[construct, 2]; SetInfo[type]; val _ PopTree[]; END; tb[subNode].son[1] _ Tree.Null; FreeNode[node]; END; VPush[BiasForType[type], RepForType[type], MaxRegs]; RETURN END; UMinus: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] = BEGIN tb[node].son[1] _ Exp[tb[node].son[1], signed]; SELECT vStack[vI].rep FROM both => vStack[vI].rep _ signed; none => BEGIN Log.WarningTree[mixedRepresentation, val]; vStack[vI].rep _ signed; END; ENDCASE => NULL; IF ~StructuredLiteral[tb[node].son[1]] THEN BEGIN tb[node].attr3 _ TRUE; val _ [subtree[index: node]] END ELSE val _ Fold[node, vStack[vI].rep]; IF vStack[vI].rep = unsigned THEN vStack[vI].rep _ signed; vStack[vI].bias _ -VBias[]; RETURN END; Abs: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] = BEGIN tb[node].son[1] _ RValue[tb[node].son[1], 0, signed]; val _ [subtree[index: node]]; SELECT vStack[vI].rep FROM unsigned, both => BEGIN Log.WarningTree[unsignedCompare, val]; val _ tb[node].son[1]; tb[node].son[1] _ Tree.Null; FreeNode[node]; END; other => tb[node].attr3 _ TRUE; none => BEGIN Log.ErrorTree[mixedRepresentation, val]; vStack[vI].rep _ both; END; ENDCASE => BEGIN tb[node].attr3 _ TRUE; vStack[vI].rep _ both; IF StructuredLiteral[tb[node].son[1]] THEN val _ Fold[node, signed]; END; RETURN END; AddOp: PROCEDURE [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] = BEGIN OPEN tb[node]; op: Tree.NodeName = tb[node].name; type: CSEIndex = tb[node].info; bias, shift: INTEGER; rep: Repr; nRegs: RegCount; son[1] _ Exp[son[1], target]; son[2] _ Exp[son[2], target]; val _ [subtree[index: node]]; rep _ CommonRep[vStack[vI-1].rep, vStack[vI].rep]; SELECT rep FROM both => rep _ IF target=none OR target=other THEN signed ELSE target; none => IF target = none THEN BEGIN Log.WarningTree[mixedRepresentation, val]; rep _ both END ELSE rep _ target; ENDCASE => NULL; IF StructuredLiteral[son[1]] AND StructuredLiteral[son[2]] THEN BEGIN val _ Fold[node, rep]; rep _ LiteralRep[val, rep]; bias _ 0; nRegs _ RegsForType[type]; END ELSE BEGIN nRegs _ IF op=plus THEN AdjustRegs[node, plus] ELSE ComputeRegs[node]; bias _ vStack[vI-1].bias; shift _ vStack[vI].bias; attr3 _ rep # unsigned; SELECT TRUE FROM TreeLiteral[son[2]] => BEGIN val _ son[1]; shift _ shift + TreeLiteralValue[son[2]]; son[1] _ Tree.Null; FreeNode[node]; END; (op = plus AND TreeLiteral[son[1]]) => BEGIN val _ son[2]; shift _ shift + TreeLiteralValue[son[1]]; son[2] _ Tree.Null; FreeNode[node]; END; ENDCASE; bias _ bias + (IF op=plus THEN shift ELSE -shift); END; VPop[]; VPop[]; VPush[bias, rep, nRegs]; IF type # dataPtr.typeINTEGER AND OperandType[val] # type THEN val _ ForceType[val, type]; RETURN END; Mult: PROCEDURE [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] = BEGIN OPEN tb[node]; rep: Repr; const1, const2: BOOLEAN; v1, v2: WORD; bias: INTEGER; nRegs: RegCount; t: Tree.Link; son[1] _ Exp[son[1], target]; son[2] _ Exp[son[2], target]; val _ [subtree[index: node]]; rep _ CommonRep[vStack[vI-1].rep, vStack[vI].rep]; SELECT rep FROM both => rep _ IF target=none OR target=other THEN signed ELSE target; none => IF target = none THEN BEGIN Log.WarningTree[mixedRepresentation, val]; rep _ both END ELSE rep _ target; ENDCASE => NULL; IF StructuredLiteral[son[1]] AND StructuredLiteral[son[2]] THEN BEGIN nRegs _ RegsForType[info]; val _ Fold[node, rep]; rep _ LiteralRep[val, rep]; bias _ 0; END ELSE BEGIN nRegs _ AdjustRegs[node, times]; const1 _ TreeLiteral[son[1]]; const2 _ TreeLiteral[son[2]]; IF const1 OR ~const2 THEN son[1] _ AdjustBias[son[1], -vStack[vI-1].bias]; IF ~const1 OR const2 THEN son[2] _ AdjustBias[son[2], -vStack[vI].bias]; IF const1 THEN v1 _ TreeLiteralValue[son[1]]; IF const2 THEN v2 _ TreeLiteralValue[son[2]]; attr3 _ rep # unsigned; bias _ SELECT TRUE FROM const1 => v1*vStack[vI].bias, const2 => vStack[vI-1].bias*v2, ENDCASE => 0; IF const1 -- AND ~const2 THEN BEGIN t _ son[2]; son[2] _ son[1]; son[1] _ t END; IF const1 OR const2 THEN SELECT (IF const1 THEN v1 ELSE v2) FROM 0 => BEGIN val _ son[2]; son[2] _ Tree.Null; FreeNode[node]; rep _ both; END; 1 => BEGIN val _ son[1]; son[1] _ Tree.Null; FreeNode[node]; rep _ vStack[IF const1 THEN vI ELSE vI-1].rep; END; -1 => BEGIN PushTree[son[1]]; son[1] _ Tree.Null; FreeNode[node]; PushNode[uminus, 1]; SetInfo[dataPtr.typeINTEGER]; SetAttr[1, FALSE]; SetAttr[2, FALSE]; SetAttr[3, TRUE]; val _ PopTree[]; END; ENDCASE; END; VPop[]; VPop[]; VPush[bias, rep, nRegs]; RETURN END; DivMod: PROCEDURE [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] = BEGIN OPEN tb[node]; rep: Repr; nRegs: RegCount; son[1] _ RValue[son[1], 0, target]; son[2] _ RValue[son[2], 0, target]; val _ [subtree[index: node]]; rep _ CommonRep[vStack[vI-1].rep, vStack[vI].rep]; SELECT rep FROM both => NULL; -- preserved by div and mod none => IF target = none THEN BEGIN Log.ErrorTree[mixedRepresentation, val]; rep _ both END ELSE rep _ target; ENDCASE => NULL; IF StructuredLiteral[son[1]] AND StructuredLiteral[son[2]] THEN BEGIN nRegs _ RegsForType[info]; val _ Fold[node, rep]; rep _ LiteralRep[val, rep]; END ELSE BEGIN nRegs _ ComputeRegs[node]; attr3 _ CommonRep[rep, unsigned] = none; IF name = div AND TreeLiteral[son[2]] THEN SELECT TreeLiteralValue[son[2]] FROM = 1 => BEGIN val _ son[1]; son[1] _ Tree.Null; FreeNode[node] END; >=2 => IF rep = unsigned THEN rep _ both; ENDCASE; END; VPop[]; VPop[]; VPush[0, rep, nRegs]; RETURN END; RelOp: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] = BEGIN OPEN tb[node]; rep, rep1, rep2: Repr; nRegs: RegCount; d1, d2: INTEGER; uc: BOOLEAN; ZeroWarning: ARRAY Tree.NodeName [relE..relLE] OF [0..2] = [0, 0, 2, 2, 1, 1]; CommutedOp: ARRAY Tree.NodeName [relE..relLE] OF Tree.NodeName = [relE, relN, relG, relLE, relL, relGE]; son[1] _ Exp[son[1], none]; son[2] _ Exp[son[2], none]; val _ [subtree[index: node]]; IF ~ComparableSons[node] THEN Log.ErrorTree[sizeClash, son[2]]; rep1 _ vStack[vI-1].rep; d1 _ vStack[vI-1].bias; rep2 _ vStack[vI].rep; d2 _ vStack[vI].bias; rep _ CommonRep[rep1, rep2]; IF rep = none THEN SELECT name FROM relE, relN => Log.WarningTree[mixedRepresentation, val]; ENDCASE => Log.ErrorTree[mixedRepresentation, val]; SELECT name FROM relE, relN => uc _ FALSE; ENDCASE => BEGIN IF rep1 = unsigned OR rep2 = unsigned THEN BEGIN son[1] _ AdjustBias[son[1], -d1]; d1 _ 0; son[2] _ AdjustBias[son[2], -d2]; d2 _ 0; END; uc _ CommonRep[rep, unsigned] # none; END; IF d1 # d2 THEN IF (~uc AND TreeLiteral[son[2]]) OR (uc AND d2 > d1) THEN son[2] _ AdjustBias[son[2], d1-d2] ELSE son[1] _ AdjustBias[son[1], d2-d1]; IF CommonRep[rep, signed+other] = none THEN BEGIN SELECT ZeroWarning[name] FROM 1 => IF TreeLiteral[son[1]] AND TreeLiteralValue[son[1]] = 0 THEN GO TO warn; 2 => IF TreeLiteral[son[2]] AND TreeLiteralValue[son[2]] = 0 THEN GO TO warn; ENDCASE; EXITS warn => Log.WarningTree[unsignedCompare, val]; END; IF StructuredLiteral[son[1]] AND StructuredLiteral[son[2]] THEN BEGIN val _ Fold[node, rep]; nRegs _ 1 END ELSE BEGIN nRegs _ AdjustRegs[node, CommutedOp[name]]; attr3 _ rep # unsigned; END; VPop[]; VPop[]; VPush[0, both, nRegs]; RETURN END; ComparableSons: PROCEDURE [node: Tree.Index] RETURNS [BOOLEAN] = BEGIN OPEN tb[node]; -- compatibility version type1: CSEIndex = OperandType[son[1]]; n1: CARDINAL = P4.WordsForType[type1]; type2: CSEIndex = OperandType[son[2]]; n2: CARDINAL = P4.WordsForType[type2]; IF n1 = 0 OR n2 = 0 THEN RETURN [FALSE]; SELECT TRUE FROM (n1 = n2) => NULL; (seb[type1].typeTag = record AND seb[type2].typeTag = record) => IF n1 < n2 -- account for lost discrimination THEN son[2] _ ChopType[son[2], type1] ELSE son[1] _ ChopType[son[1], type2]; ENDCASE => RETURN [FALSE]; RETURN [ComparableType[type1] OR ComparableType[type2]] END; In: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] = BEGIN OPEN tb[node]; bias: INTEGER; rep: Repr; nRegs: RegCount; void, const: BOOLEAN; subNode: Tree.Index; son[1] _ Exp[son[1], none]; bias _ VBias[]; rep _ VRep[]; -- IF rep = unsigned THEN BEGIN son[1] _ AdjustBias[son[1], -bias]; bias _ 0 END; void _ FALSE; val _ [subtree[index: node]]; son[2] _ NormalizeRange[son[2]]; subNode _ GetNode[son[2]]; IF (const _ Interval[subNode, bias, none].const) AND ~tb[node].attr2 THEN [] _ ConstantInterval[subNode ! EmptyInterval => BEGIN void _ TRUE; RESUME END]; rep _ CommonRep[rep, VRep[]]; IF rep = none THEN Log.ErrorTree[mixedRepresentation, val]; tb[subNode].attr3 _ attr3 _ rep # unsigned; SELECT TRUE FROM void AND son[1] # Tree.Null => BEGIN FreeNode[node]; val _ passPtr.tFALSE; nRegs _ 1 END; const AND StructuredLiteral[son[1]] => BEGIN val _ Fold[node, rep]; nRegs _ 1 END; ENDCASE => nRegs _ ComputeRegs[node]; VPop[]; VPop[]; VPush[0, both, nRegs]; RETURN END; NormalizeRange: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [val: Tree.Link] = BEGIN next: Tree.Link; FOR val _ t, next DO WITH val SELECT FROM symbol => BEGIN lBound: INTEGER = BiasForType[UnderType[index]]; THROUGH [1..2] DO PushTree[MakeTreeLiteral[ABS[lBound]]]; IF lBound < 0 THEN PushNode[uminus, 1]; ENDLOOP; PushTree[MakeTreeLiteral[Cardinality[index] - 1]]; PushNode[plus, 2]; SetInfo[dataPtr.typeINTEGER]; next _ MakeNode[intCC, 2]; END; subtree => BEGIN node: Tree.Index = index; SELECT tb[node].name FROM subrangeTC, cdot => BEGIN next _ tb[node].son[2]; tb[node].son[2] _ Tree.Null; FreeNode[node]; END; IN [intOO .. intCC] => EXIT; ENDCASE => ERROR; END; ENDCASE => ERROR; ENDLOOP; RETURN END; Interval: PUBLIC PROCEDURE [node: Tree.Index, bias: INTEGER, target: Repr] RETURNS [const: BOOLEAN] = BEGIN OPEN tb[node]; rep: Repr; nRegs: RegCount; son[1] _ RValue[son[1], bias, target]; nRegs _ VRegs[]; son[2] _ RValue[son[2], bias, target]; nRegs _ MAX[VRegs[], nRegs]; rep _ CommonRep[vStack[vI-1].rep, vStack[vI].rep]; VPop[]; VPop[]; VPush[bias, rep, nRegs]; const _ StructuredLiteral[son[1]] AND StructuredLiteral[son[2]]; RETURN END; EmptyInterval: PUBLIC SIGNAL = CODE; ConstantInterval: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [origin, range: INTEGER] = BEGIN OPEN tb[node]; uBound: INTEGER; rep: Repr; empty: BOOLEAN; rep _ VRep[]; empty _ FALSE; origin _ TreeLiteralValue[son[1]]; uBound _ TreeLiteralValue[son[2]]; SELECT name FROM intOO, intOC => BEGIN IF RelTest[son[1], son[2], relGE, rep] THEN empty _ TRUE; origin _ origin + 1; son[1] _ FreeTree[son[1]]; name _ IF name = intOO THEN intCO ELSE intCC; son[1] _ MakeTreeLiteral[origin]; END; ENDCASE; SELECT name FROM intCC => IF RelTest[son[1], son[2], relG, rep] THEN empty _ TRUE; intCO => BEGIN IF RelTest[son[1], son[2], relGE, rep] THEN empty _ TRUE; uBound _ uBound - 1; son[2] _ FreeTree[son[2]]; name _ intCC; son[2] _ MakeTreeLiteral[uBound]; END; ENDCASE => ERROR; IF ~empty THEN range _ uBound - origin ELSE BEGIN SIGNAL EmptyInterval; range _ 0 END; RETURN END; BoolOp: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] = BEGIN OPEN tb[node]; b: Tree.Link = IF (name = and) THEN passPtr.tTRUE ELSE passPtr.tFALSE; n1, n2, nRegs: RegCount; son[1] _ Exp[son[1], none]; n1 _ VRegs[]; son[2] _ Exp[son[2], none]; n2 _ VRegs[]; IF TreeLiteral[son[1]] THEN BEGIN IF son[1] = b THEN BEGIN val _ son[2]; son[2] _ Tree.Null; nRegs _ n2 END ELSE BEGIN val _ IF (name = and) THEN passPtr.tFALSE ELSE passPtr.tTRUE; nRegs _ 1 END; FreeNode[node]; END ELSE IF son[2] # b THEN BEGIN val _ [subtree[index: node]]; nRegs _ MAX[n1, n2] END ELSE BEGIN val _ son[1]; son[1] _ Tree.Null; nRegs _ n1; FreeNode[node]; END; VPop[]; VPop[]; VPush[0, both, nRegs]; RETURN END; CheckAlt: PROCEDURE [t: Tree.Link, target: CSEIndex] RETURNS [Tree.Link] = BEGIN type: CSEIndex = OperandType[t]; IF P4.WordsForType[type] # P4.WordsForType[target] THEN IF seb[type].typeTag = record AND seb[target].typeTag = record THEN t _ PadRecord[t, target] ELSE Log.ErrorTree[sizeClash, t]; RETURN [t] END; IfExp: PROCEDURE [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] = BEGIN OPEN tb[node]; select: Tree.Link; rep: Repr; nRegs: RegCount; bias: INTEGER = BiasForType[info]; son[1] _ RValue[son[1], 0, none]; nRegs _ VRegs[]; VPop[]; IF TreeLiteral[son[1]] THEN BEGIN IF son[1] # passPtr.tFALSE THEN BEGIN select _ son[2]; son[2] _ Tree.Null END ELSE BEGIN select _ son[3]; son[3] _ Tree.Null END; FreeNode[node]; val _ Exp[select, target]; END ELSE BEGIN son[2] _ CheckAlt[RValue[son[2], bias, target], info]; rep _ vStack[vI].rep; nRegs _ MAX[VRegs[], nRegs]; VPop[]; son[3] _ CheckAlt[RValue[son[3], bias, target], info]; val _ [subtree[index: node]]; rep _ CommonRep[vStack[vI].rep, rep]; IF rep = none THEN IF target = none THEN BEGIN Log.WarningTree[mixedRepresentation, val]; rep _ both END ELSE rep _ target; vStack[vI].rep _ rep; vStack[vI].nRegs _ MAX[VRegs[], nRegs]; END; RETURN END; CaseExp: PROCEDURE [node: Tree.Index, target: Repr, caseBias: INTEGER] RETURNS [val: Tree.Link] = BEGIN type: CSEIndex = tb[node].info; bias: INTEGER = BiasForType[type]; rep: Repr; const: BOOLEAN; Selection: Tree.Map = BEGIN v _ CheckAlt[RValue[t, bias, target], type]; rep _ CommonRep[rep, vStack[vI].rep]; VPop[]; const _ const AND StructuredLiteral[v]; RETURN END; rep _ both+other; const _ TRUE; PushTree[CaseDriver[node, Selection, caseBias]]; SetAttr[1, const]; val _ PopTree[]; IF rep = none THEN IF target = none THEN BEGIN Log.WarningTree[mixedRepresentation, val]; rep _ both END ELSE rep _ target; VPush[bias, rep, MaxRegs]; RETURN END; BindExp: PROCEDURE [node: Tree.Index, target: Repr] RETURNS [Tree.Link] = BEGIN BoundExp: PROCEDURE [t: Tree.Link, labelBias: INTEGER] RETURNS [Tree.Link] = BEGIN RETURN [CaseExp[GetNode[t], target, labelBias]] END; RETURN [Binding[node, casex, BoundExp]] END; MinMax: PROCEDURE [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] = BEGIN OPEN tb[node]; const, zeroTest: BOOLEAN; rep: Repr; nRegs: RegCount; k: RegCount = RegsForType[info]; Item: Tree.Map = BEGIN v _ RValue[t, 0, target]; IF ~StructuredLiteral[v] THEN const _ FALSE ELSE IF TreeLiteral[v] AND TreeLiteralValue[v] = 0 THEN zeroTest _ TRUE; rep _ CommonRep[rep, vStack[vI].rep]; nRegs _ MIN[MAX[nRegs, VRegs[]+k], MaxRegs]; VPop[]; RETURN END; IF ListLength[son[1]] = 1 THEN BEGIN val _ Exp[son[1], target]; son[1] _ Tree.Null; FreeNode[node]; END ELSE BEGIN const _ TRUE; zeroTest _ FALSE; rep _ both+other; nRegs _ 0; son[1] _ UpdateList[son[1], Item]; val _ [subtree[index: node]]; IF zeroTest AND CommonRep[rep, unsigned] # none THEN Log.WarningTree[unsignedCompare, val]; SELECT rep FROM both => rep _ IF target = none THEN both ELSE target; none => IF target = none THEN BEGIN Log.ErrorTree[mixedRepresentation, val]; rep _ both END ELSE rep _ target; ENDCASE => NULL; IF const THEN BEGIN val _ Fold[node, rep]; rep _ LiteralRep[val, rep]; nRegs _ k; END ELSE attr3 _ rep # unsigned; VPush[0, rep, nRegs]; END; RETURN END; Lengthen: PROCEDURE [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] = BEGIN OPEN tb[node]; v: ARRAY [0..2) OF WORD; rep: Repr; nRegs: RegCount; son[1] _ RValue[son[1], 0, IF target=both THEN unsigned ELSE target]; attr1 _ SELECT TypeForm[OperandType[son[1]]] FROM pointer, arraydesc => TRUE, ENDCASE => FALSE; IF (rep _ VRep[]) = none THEN BEGIN Log.ErrorTree[mixedRepresentation, son[1]]; rep _ both END; attr3 _ CommonRep[rep, unsigned] = none; nRegs _ MAX[VRegs[], RegsForType[info]]; IF ~TreeLiteral[son[1]] OR (attr1 AND TreeLiteralValue[son[1]] # 0--NIL--) THEN val _ [subtree[index: node]] ELSE BEGIN v[0] _ TreeLiteralValue[son[1]]; v[1] _ IF ~attr3 OR InlineDefs.BITAND[v[0], 1B5] = 0 THEN 0 ELSE 177777B; PushLit[LiteralOps.FindDescriptor[DESCRIPTOR[v]]]; PushNode[mwconst, 1]; SetInfo[info]; val _ PopTree[]; FreeNode[node]; END; VPop[]; VPush[0, IF rep = unsigned AND ~attr1 THEN both ELSE rep, nRegs]; RETURN END; Loophole: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] = BEGIN OPEN tb[node]; type: CSEIndex = info; rep: Repr = RepForType[type]; val _ Exp[son[1], rep]; IF son[2] # Tree.Null THEN TypeExp[son[2]]; IF P4.WordsForType[OperandType[val]] # P4.WordsForType[type] THEN Log.ErrorTree[sizeClash, son[1]]; val _ ForceType[val, type]; son[1] _ Tree.Null; FreeNode[node]; vStack[vI].rep _ rep; RETURN END; EndPoint: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] = BEGIN OPEN tb[node]; type, next: CSEIndex; first: BOOLEAN = (name=first); MaxInteger: WORD = AltoDefs.maxinteger; MaxWord: WORD = AltoDefs.maxword; v: WORD; vv: ARRAY [0..2) OF WORD; TypeExp[son[1]]; FOR type _ UnderType[TypeForTree[son[1]]], next DO WITH seb[type] SELECT FROM basic => BEGIN v _ SELECT code FROM Symbols.codeINTEGER => IF first THEN MaxInteger+1 ELSE MaxInteger, Symbols.codeCHARACTER => IF first THEN 0 ELSE AltoDefs.maxcharcode, ENDCASE => IF first THEN 0 ELSE MaxWord; GO TO short END; enumerated => BEGIN v _ IF first THEN 0 ELSE Cardinality[type]-1; GO TO short END; relative => next _ UnderType[offsetType]; subrange => BEGIN v _ IF first THEN origin ELSE origin+range; GO TO short END; long => BEGIN vv _ IF UnderType[rangeType] = dataPtr.typeINTEGER THEN IF first THEN [0, MaxInteger+1] ELSE [MaxWord, MaxInteger] ELSE IF first THEN [0, 0] ELSE [MaxWord, MaxWord]; GO TO long END; ENDCASE => ERROR; REPEAT short => val _ MakeTreeLiteral[v]; long => BEGIN PushLit[LiteralOps.FindDescriptor[DESCRIPTOR[vv]]]; PushNode[mwconst, 1]; SetInfo[type]; val _ PopTree[]; END; ENDLOOP; FreeNode[node]; VPush[0, RepForType[type], RegsForType[type]]; RETURN END; TypeCode: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] = BEGIN type: Symbols.SEIndex; i: CARDINAL; TypeExp[tb[node].son[1]]; type _ TypeForTree[tb[node].son[1]]; tb[node].son[1] _ Tree.Null; FreeNode[node]; FOR i IN [0 .. dataPtr.nTypeCodes) DO IF type = dataPtr.typeMap[i] THEN EXIT ENDLOOP; PushTree[[symbol[dataPtr.typeMapId]]]; PushTree[MakeTreeLiteral[i]]; PushNode[index, 2]; SetInfo[Symbols.typeANY]; SetAttr[2, FALSE]; RETURN [RValue[PopTree[], 0, other]] END; AdjustBias: PUBLIC PROCEDURE [t: Tree.Link, delta: INTEGER] RETURNS [Tree.Link] = BEGIN op: Tree.NodeName; type: CSEIndex; IF delta = 0 THEN RETURN [t]; IF TestTree[t, safen] THEN BEGIN subNode: Tree.Index = GetNode[t]; tb[subNode].son[1] _ AdjustBias[tb[subNode].son[1], delta]; RETURN [t] END; IF t = Tree.Null THEN passPtr.implicitBias _ passPtr.implicitBias + delta; type _ OperandType[t]; IF TreeLiteral[t] THEN RETURN [MakeStructuredLiteral[TreeLiteralValue[t]-delta, type]]; IF delta > 0 THEN op _ minus ELSE BEGIN op _ plus; delta _ -delta END; PushTree[t]; PushTree[MakeTreeLiteral[delta]]; PushNode[op, 2]; SetInfo[type]; SetAttr[1, FALSE]; SetAttr[2, FALSE]; RETURN [PopTree[]] END; RValue: PUBLIC PROCEDURE [exp: Tree.Link, bias: INTEGER, target: Repr] RETURNS [val: Tree.Link] = BEGIN d: INTEGER; val _ Exp[exp, target]; d _ bias - vStack[vI].bias; IF d # 0 THEN BEGIN val _ AdjustBias[val, d]; vStack[vI].bias _ bias END; RETURN END; Exp: PUBLIC PROCEDURE [exp: Tree.Link, target: Repr] RETURNS [val: Tree.Link] = BEGIN rep: Repr; WITH expr: exp SELECT FROM symbol => BEGIN sei: ISEIndex = expr.index; type: CSEIndex; IF ~seb[sei].mark4 THEN DeclItem[Tree.Link[subtree[index: seb[sei].idValue]]]; type _ UnderType[seb[sei].idType]; rep _ RepForType[type]; IF ~seb[sei].constant THEN val _ expr ELSE SELECT XferMode[type] FROM procedure, signal, error, program => val _ IF ConstantId[sei] AND ~seb[sei].extended THEN MakeStructuredLiteral[seb[sei].idValue, type] ELSE expr; ENDCASE => IF seb[sei].extended THEN BEGIN val _ IdentityMap[FindExtension[sei].tree]; WITH val SELECT FROM subtree => tb[index].info _ type; ENDCASE; val _ Exp[val, target]; rep _ vStack[vI].rep; VPop[]; END ELSE BEGIN val _ MakeStructuredLiteral[seb[sei].idValue, type]; rep _ LiteralRep[val, rep]; END; VPush[BiasForType[type], rep, RegsForType[type]]; END; literal => BEGIN WITH expr.info SELECT FROM word => rep _ LiteralRep[expr, unsigned]; string => BEGIN LiteralOps.StringReference[index]; rep _ unsigned END; ENDCASE => rep _ none; VPush[0, rep, 1]; val _ expr; END; subtree => IF expr = Tree.Null THEN BEGIN val _ Tree.Null; VPush[passPtr.implicitBias, passPtr.implicitRep, MaxRegs]; END ELSE BEGIN node: Tree.Index = expr.index; SELECT tb[node].name FROM dot => BEGIN OPEN tb[node]; nRegs: RegCount; son[1] _ RValue[son[1], 0, unsigned]; nRegs _ MAX[RegsForType[info], VRegs[]]; VPop[]; son[2] _ Exp[son[2], target]; vStack[vI].nRegs _ nRegs; attr1 _ dataPtr.switches['n]; val _ expr; END; dollar => val _ Dollar[node]; cdot => BEGIN val _ Exp[tb[node].son[2], target]; tb[node].son[2] _ Tree.Null; FreeNode[node]; END; uparrow => BEGIN OPEN tb[node]; nRegs: RegCount; son[1] _ RValue[son[1], 0, unsigned]; nRegs _ MAX[RegsForType[info], VRegs[]]; VPop[]; VPush[BiasForType[info], RepForType[info], nRegs]; attr1 _ dataPtr.switches['n]; val _ expr; END; callx, portcallx, signalx, errorx, startx, joinx => val _ Call[node]; substx => val _ Substx[node]; index, dindex => val _ Index[node]; seqindex => BEGIN OPEN tb[node]; nRegs: RegCount; son[1] _ RValue[son[1], 0, unsigned]; son[2] _ RValue[son[2], 0, unsigned]; nRegs _ ComputeIndexRegs[node]; VPop[]; VPop[]; VPush[0, both, nRegs]; attr1 _ dataPtr.switches['n]; attr3 _ dataPtr.switches['b]; val _ expr; END; reloc => val _ Reloc[node]; construct => val _ Construct[node]; union => val _ Union[node]; rowcons => val _ RowConstruct[node]; all => val _ All[node]; uminus => val _ UMinus[node]; abs => val _ Abs[node]; plus, minus => val _ AddOp[node, target]; times => val _ Mult[node, target]; div, mod => val _ DivMod[node, target]; relE, relN, relL, relGE, relG, relLE => val _ RelOp[node]; in, notin => val _ In[node]; not => BEGIN IF ~TreeLiteral[tb[node].son[1] _ Exp[tb[node].son[1], none]] THEN val _ expr ELSE BEGIN val _ IF tb[node].son[1] # passPtr.tFALSE THEN passPtr.tFALSE ELSE passPtr.tTRUE; FreeNode[node]; vStack[vI].nRegs _ 1; END; END; or, and => val _ BoolOp[node]; ifx => val _ IfExp[node, target]; casex => val _ CaseExp[node, target, 0]; bindx => val _ BindExp[node, target]; assignx => val _ Assignment[node]; min, max => val _ MinMax[node, target]; mwconst => BEGIN rep: Repr; val _ expr; rep _ LiteralRep[val, RepForType[tb[node].info]]; VPush[0, rep, RegsForType[tb[node].info]]; END; clit => BEGIN val _ tb[node].son[1]; FreeNode[node]; VPush[0, both, 1]; END; llit => BEGIN IF bb[dataPtr.bodyIndex].level > Symbols.lG THEN WITH e: tb[node].son[1] SELECT FROM literal => WITH e.info SELECT FROM string => index _ LiteralOps.FindLocalString[index]; ENDCASE; ENDCASE; val _ Exp[tb[node].son[1], none]; tb[node].son[1] _ Tree.Null; FreeNode[node]; END; new, fork => val _ MiscXfer[node]; syserrorx => BEGIN val _ expr; VPush[0, RepForType[tb[node].info], MaxRegs]; END; lengthen => val _ Lengthen[node, target]; float => BEGIN OPEN tb[node]; son[1] _ RValue[son[1], 0, none]; val _ expr; vStack[vI].rep _ other; END; safen => BEGIN tb[node].son[1] _ Exp[tb[node].son[1], target]; val _ expr; END; loophole => val _ Loophole[node]; cast => BEGIN OPEN tb[node]; rep: Repr = RepForType[info]; son[1] _ Exp[son[1], rep]; vStack[vI].rep _ rep; val _ expr; IF P4.WordsForType[OperandType[son[1]]] # P4.WordsForType[info] THEN name _ chop; vStack[vI].rep _ rep; val _ expr; END; check => BEGIN rep: Repr = RepForType[tb[node].info]; val _ Rhs[tb[node].son[1], tb[node].info]; vStack[vI].rep _ rep; tb[node].son[1] _ Tree.Null; FreeNode[node]; END; openx => BEGIN OPEN tb[node]; type: CSEIndex = OperandType[son[1]]; IF attr1 THEN val _ son[1] ELSE BEGIN son[1] _ NeutralExp[son[1]]; IF Shared[son[1]] -- must generate an unshared node THEN son[1] _ ForceType[son[1], type]; SetShared[son[1], TRUE]; attr1 _ TRUE; val _ expr; END; VPush[0, other, RegsForType[type]]; END; size => BEGIN TypeExp[tb[node].son[1]]; val _ MakeTreeLiteral[P4.WordsForType[ UnderType[TypeForTree[tb[node].son[1]]]]]; FreeNode[node]; VPush[0, both, 1]; END; first, last => val _ EndPoint[node]; typecode => val _ TypeCode[node]; apply => BEGIN VPush[0, none, 0]; val _ [subtree[node]] END; ENDCASE => val _ AddrOp[node]; END; ENDCASE => ERROR; RETURN END; NeutralExp: PUBLIC PROCEDURE [exp: Tree.Link] RETURNS [val: Tree.Link] = BEGIN val _ RValue[exp, 0, none]; VPop[]; RETURN END; END.