-- 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.