DIRECTORY Alloc, Code, CodeDefs, ComData, IntCodeDefs, P5, P5S, P5U, RTSD, SymbolOps, Symbols, SymLiteralOps, Tree, TreeOps; Selection: PROGRAM IMPORTS MPtr: ComData, CPtr: Code, CodeDefs, P5U, P5, SymbolOps, TreeOps EXPORTS CodeDefs, P5 = BEGIN OPEN IntCodeDefs, CodeDefs; SEIndex: TYPE = Symbols.SEIndex; ISEIndex: TYPE = Symbols.ISEIndex; ISENull: ISEIndex = Symbols.ISENull; CSEIndex: TYPE = Symbols.CSEIndex; BTIndex: TYPE = Symbols.BTIndex; BitCount: TYPE = Symbols.BitCount; tb: Tree.Base; -- tree base (local copy) seb: Symbols.Base; -- semantic entry base (local copy) cb: CodeDefs.Base; -- code base (local copy) SelectionNotify: PUBLIC Alloc.Notifier = BEGIN -- called by allocator whenever table area is repacked seb _ base[Symbols.seType]; tb _ base[Tree.treeType]; cb _ base[codeType]; END; CaseStmtExp: PUBLIC PROC [rootNode: Tree.Index, isExp: BOOL] RETURNS [l: Node] = BEGIN -- generate code for CASE statment and expression saveCaseCV: Node = CPtr.caseCV; saveExtracting: BOOL = CPtr.xtracting; cvTemp: Var; cvr: Node; bits: BitCount; cl: CodeList _ P5U.NewCodeList[]; armHead, armTail: CaseList _ NIL; t3: Tree.Link _ tb[rootNode].son[3]; CaseArm: Tree.Scan = { node: Tree.Index _ TreeOps.GetNode[t]; -- t is an item tests: NodeList _ P5.ExpList[tb[node].son[1]].head; t2: Tree.Link _ tb[node].son[2]; body: Node _ IF isExp THEN P5.Exp[t2] ELSE P5.StatementTree[t2]; arm: CaseList _ z.NEW[CaseListRep _ [tests: tests, body: body, rest: NIL]]; IF armTail = NIL THEN armHead _ arm ELSE armTail.rest _ arm; armTail _ arm}; CPtr.xtracting _ FALSE; cvr _ P5.Exp[tb[rootNode].son[1]]; cvTemp _ P5U.CreateTemp[cvr.bits].var; P5U.Declare[cl, cvTemp, cvr]; CPtr.caseCV _ cvTemp; TreeOps.ScanList[tb[rootNode].son[2], CaseArm]; IF t3 # Tree.Null THEN { ec: Node _ IF isExp THEN P5.Exp[t3] ELSE P5.StatementTree[t3]; other: CaseList _ z.NEW[CaseListRep _ [tests: NIL, body: ec, rest: NIL]]; IF armHead = NIL THEN armHead _ other ELSE armTail.rest _ other}; CPtr.caseCV _ saveCaseCV; CPtr.xtracting _ saveExtracting; IF armHead = NIL OR armHead.body = NIL THEN bits _ 0 ELSE bits _ armHead.body.bits; l _ z.NEW[cond NodeRep _ [bits: bits, details: cond[armHead]]]; RETURN END; BindStmtExp: PUBLIC PROC [rootNode: Tree.Index, isExp: BOOL] RETURNS [l: Node] = BEGIN -- discrimination with copying END; NarrowExp: PUBLIC PROC [node: Tree.Index] RETURNS [Node _ NIL] = BEGIN END; TypeRel: PUBLIC PROC [node: Tree.Index, tf: BOOL, label: Label] = BEGIN END; GetCanonicalType: PUBLIC PROC [node: Tree.Index] RETURNS [l: Node] = BEGIN oper: Node; IF tb[node].attr2 THEN oper _ P5U.CedarOpNode[referentType] ELSE { type: CSEIndex _ P5U.OperandType[tb[node].son[1]]; SELECT SymbolOps.XferMode[type] FROM proc => oper _ NIL; -- P5U.CedarOpNode[procType]; signal, error => oper _ NIL; -- P5U.CedarOpNode[signalType]; ENDCASE}; l _ P5U.ApplyOp[oper: oper, args: P5U.MakeNodeList[P5.Exp[tb[node].son[1]]], bits: WordSize]; END; END. %lSelection.mesa Copyright c 1985 by Xerox Corporation. All rights reserved. Satterthwaite, March 26, 1986 3:23:41 pm PST Paul Rovner, September 8, 1983 8:30 am Russ Atkinson (RRA) March 6, 1985 11:25:00 pm PST Sweet May 30, 1986 5:19:00 pm PDT imported definitions saveExtracting: BOOL = CPtr.xtracting; saveCaseCV: CaseCVState = CPtr.caseCV; typeTemp: BOOL _ FALSE; typeLex: se Lexeme _ NullLex; pushableTag: BOOL _ FALSE; nItems: CARDINAL _ 0; sourceType: CSEIndex = P5U.OperandType[tb[rootNode].son[1]]; BindItem: PROC [ node: Tree.Index, isExp: BOOL, tempSei: ISEIndex, failLabel: LabelCCIndex] RETURNS [r: VarIndex, tSei: ISEIndex] = BEGIN bti: BTIndex = tb[node].info; subNode: Tree.Index = TreeOps.GetNode[tb[node].son[1]]; type: SEIndex = seb[TreeOps.GetSe[tb[subNode].son[1]]].idType; indirect: BOOL = tb[node].attr1; subType: SEIndex; nItems _ nItems + 1; tSei _ tempSei; P5.EnterBlock[bti]; IF tb[rootNode].attr2 THEN BEGIN subType _ P5U.MarkedType[type]; IF tb[node].attr3 -- will destroy type code AND typeLex = NullLex AND nItems < TreeOps.ListLength[tb[rootNode].son[2]] THEN BEGIN typeLex _ P5.GenAnonLex[1]; IF CPtr.caseCVState # singleLoaded THEN P5U.Out0[FOpCodes.qPUSH]; P5.SAssign[typeLex.lexsei]; CPtr.caseCVState _ single; END; IF tb[node].attr2 THEN BEGIN t: Tree.Link; IF typeTemp THEN {PushCopy[typeLex]; CPtr.caseCVState _ singleLoaded}; TreeOps.PushTree[Tree.Null]; TreeOps.PushTree[SymLiteralOps.TypeRef[subType]]; TreeOps.PushNode[relE, 2]; TreeOps.SetInfo[MPtr.typeBOOL]; t _ TreeOps.PopTree[]; P5.FlowTree[t, FALSE, failLabel]; t _ TreeOps.FreeTree[t]; END ELSE IF CPtr.caseCVState = singleLoaded THEN BEGIN P5U.Out0[FOpCodes.qPOP]; CPtr.caseCVState _ single END; pushableTag _ FALSE; IF tb[node].attr3 THEN typeTemp _ TRUE; END ELSE subType _ IF indirect THEN P5U.ReferentType[sourceType] ELSE sourceType; BEGIN saveCVState: CaseCVState = CPtr.caseCVState; CPtr.caseCVState _ multi; -- the value being discriminated IF tb[node].attr3 THEN pushableTag _ TestTag[ type: subType, target: IF indirect THEN P5U.ReferentType[type] ELSE type, failLabel: failLabel, indirect: indirect, long: indirect AND SymbolOps.WordsForType[sourceType] # 1, onStack: pushableTag]; P5S.Assign[subNode]; CPtr.caseCVState _ saveCVState; END; IF isExp THEN r _ P5L.VarForLex[P5.Exp[tb[node].son[2]]] ELSE {tb[node].son[2] _ P5.StatementTree[tb[node].son[2]]; r _ VarNull}; P5.ExitBlock[bti]; RETURN END; endCaseLabel: LabelCCIndex _ LabelCCNull; CPtr.xtracting _ FALSE; Stack.Dump[]; IF isExp THEN Stack.Mark[]; CPtr.mwCaseCV _ SelectArg[tb[rootNode].son[1], tb[rootNode].attr1]; SELECT TRUE FROM tb[rootNode].attr2 => BEGIN IF tb[rootNode].attr1 THEN BEGIN PushCopy[CPtr.mwCaseCV]; P5U.Out0[FOpCodes.qGCRT]; END ELSE BEGIN Stack.Dump[]; Stack.Mark[]; PushCopy[CPtr.mwCaseCV]; P5.SysCallN[GetTypeEntry[sourceType], 1]; END; CPtr.caseCVState _ singleLoaded; END; tb[rootNode].attr1 => BEGIN t: Tree.Link _ NilPredicate[sourceType]; endCaseLabel _ P5U.LabelAlloc[]; CPtr.caseCVState _ multi; P5.FlowTree[t, TRUE, endCaseLabel]; t _ TreeOps.FreeTree[t]; END; ENDCASE; lex _ CaseDriver[rootNode, isExp, BindItem, endCaseLabel]; IF typeLex # NullLex THEN P5.ReleaseTempLex[typeLex]; P5L.ReleaseLex[CPtr.mwCaseCV]; CPtr.mwCaseCV _ saveMwCaseCV; CPtr.caseCVState _ saveCaseCVState; CPtr.xtracting _ saveExtracting; RETURN SelectArg: PROC [t: Tree.Link, indirect: BOOL] RETURNS [Lexeme] = BEGIN l: Lexeme; r: VarIndex; l _ P5.Exp[t ! P5.LogHeapFree => {RESUME [FALSE, NullLex]}]; IF indirect THEN r _ P5L.OVarItem[P5L.EasilyLoadable[P5L.ComponentForLex[l], load]] ELSE BEGIN r1: VarIndex; [first: r1, next: r] _ P5L.ReusableCopies[P5L.VarForLex[l], load, FALSE, TRUE]; P5L.ReleaseVarItem[r1]; END; RETURN [[bdo[r]]] END; PushCopy: PROC [l: Lexeme] = {P5.PushLex[P5L.CopyLex[l]]}; TestTag: PROC [ type, target: SEIndex, failLabel: LabelCCIndex, indirect, long, onStack: BOOL] RETURNS [pushable: BOOL] = BEGIN OPEN SymbolOps; link: SEIndex = TypeLink[target]; subLink: CSEIndex = SymbolOps.UnderType[link]; uType: CSEIndex = SymbolOps.UnderType[seb[SymbolOps.VariantField[subLink]].idType]; IF SymbolOps.UnderType[type] # subLink THEN -- discriminate to the link type BEGIN [] _ TestTag[type, link, failLabel, indirect, long, onStack]; onStack _ pushable _ FALSE; END ELSE pushable _ TRUE; -- should force non-commutativity WITH u: seb[uType] SELECT FROM union => BEGIN OPEN TreeOps; saveCVState: CaseCVState = CPtr.caseCVState; tagSei: ISEIndex = u.tagSei; t: Tree.Link; PushTree[Tree.Null]; IF onStack THEN CPtr.caseCVState _ single ELSE -- CPtr.caseCVState = multi BEGIN IF indirect THEN {PushNode[uparrow, 1]; SetAttr[1, FALSE]; SetAttr[2, long]} ELSE PushNode[cast, 1]; SetInfo[subLink]; PushSe[tagSei]; PushNode[dollar, 2]; SetInfo[SymbolOps.UnderType[seb[tagSei].idType]]; SetAttr[2, long]; END; PushTree[P5U.MakeTreeLiteral[P5U.VariantTag[target, u.caseCtx]]]; PushNode[relE, 2]; SetInfo[MPtr.typeBOOL]; t _ PopTree[]; P5.FlowTree[t, FALSE, failLabel]; t _ FreeTree[t]; CPtr.caseCVState _ saveCVState; END; ENDCASE => ERROR; RETURN END; TagPredicate: PROC [type, target: SEIndex, indirect, long: BOOL] RETURNS [Tree.Link] = BEGIN OPEN SymbolOps, TreeOps; link: SEIndex = TypeLink[target]; subLink: CSEIndex = SymbolOps.UnderType[link]; uType: CSEIndex = SymbolOps.UnderType[seb[SymbolOps.VariantField[subLink]].idType]; WITH u: seb[uType] SELECT FROM union => BEGIN tagSei: ISEIndex = u.tagSei; PushTree[Tree.Null]; IF indirect THEN {PushNode[uparrow, 1]; SetAttr[1, FALSE]; SetAttr[2, long]} ELSE PushNode[cast, 1]; SetInfo[subLink]; PushSe[tagSei]; PushNode[dollar, 2]; SetInfo[SymbolOps.UnderType[seb[tagSei].idType]]; SetAttr[2, long]; PushTree[P5U.MakeTreeLiteral[P5U.VariantTag[target, u.caseCtx]]]; PushNode[relE, 2]; SetInfo[MPtr.typeBOOL]; END; ENDCASE => ERROR; IF SymbolOps.UnderType[type] # subLink THEN -- discriminate to the link type BEGIN PushTree[TagPredicate[type, link, indirect, long]]; PushNode[and, -2]; END; RETURN [PopTree[]] END; TypePredicate: PROC [ source: CSEIndex, dest: SEIndex, node: Tree.Index] RETURNS [t: Tree.Link_Tree.Null] = BEGIN OPEN TreeOps; -- attrs, son[1] as in narrow, istype indirect: BOOL = tb[node].attr1; long: BOOL = indirect AND SymbolOps.WordsForType[source] = 2; type: SEIndex; IF tb[node].attr2 THEN BEGIN type _ P5U.MarkedType[dest]; PushTree[Tree.Null]; IF ~indirect THEN {PushNode[cast, 1]; SetInfo[source]}; PushNode[gcrt, 1]; SetAttr[2, indirect]; PushTree[SymLiteralOps.TypeRef[type]]; PushNode[relE, 2]; SetInfo[MPtr.typeBOOL]; t _ PopTree[]; END ELSE type _ IF indirect THEN P5U.ReferentType[source] ELSE source; IF tb[node].attr3 THEN BEGIN add NIL test here if not attr2? PushTree[ TagPredicate[type, IF indirect THEN P5U.ReferentType[dest] ELSE dest, indirect, long]]; IF t # Tree.Null THEN {PushTree[t]; PushNode[and, -2]}; t _ PopTree[]; END; RETURN END; NilPredicate: PROC [type: CSEIndex] RETURNS [Tree.Link] = BEGIN OPEN TreeOps; PushTree[Tree.Null]; PushTree[P5U.NilTree[type]]; PushNode[relE, 2]; SetInfo[MPtr.typeBOOL]; RETURN [PopTree[]] END; OrTest: PROC [t1, t2: Tree.Link] RETURNS [Tree.Link] = BEGIN OPEN TreeOps; PushTree[t1]; PushTree[t2]; PushNode[or, 2]; SetInfo[MPtr.typeBOOL]; RETURN [PopTree[]] END; saveMwCaseCV: Lexeme = CPtr.mwCaseCV; saveExtracting: BOOL = CPtr.xtracting; saveCaseCVState: CaseCVState = CPtr.caseCVState; eLabel: LabelCCIndex = P5U.LabelAlloc[]; indirect: BOOL = tb[node].attr1; sourceType: CSEIndex = P5U.OperandType[tb[node].son[1]]; targetType: SEIndex = IF tb[node].son[2] # Tree.Null THEN P5U.TypeForTree[tb[node].son[2]] ELSE tb[node].info; nWords: CARDINAL = SymbolOps.WordsForType[sourceType]; counted: BOOL = indirect AND (SymbolOps.RCType[sourceType] = simple); t: Tree.Link; CPtr.xtracting _ FALSE; Stack.Dump[]; Stack.Mark[]; t _ TypePredicate[sourceType, targetType, node]; IF indirect # tb[node].attr2 THEN t _ OrTest[NilPredicate[sourceType], t]; CPtr.mwCaseCV _ SelectArg[tb[node].son[1], indirect]; CPtr.caseCVState _ multi; IF indirect THEN PushCopy[CPtr.mwCaseCV]; P5.FlowTree[t, TRUE, eLabel]; t _ TreeOps.FreeTree[t]; IF indirect THEN BEGIN IF counted THEN BEGIN t _ SymLiteralOps.TypeRef[P5U.ReferentType[targetType], FALSE]; P5.PushRhs[t]; t _ TreeOps.FreeTree[t]; P5.SysCallN[RTSD.sCheckForNarrowRefFault, nWords]; END ELSE P5.SysCallN[RTSD.sRaiseNarrowFault, nWords]; P5L.ReleaseLex[CPtr.mwCaseCV]; l _ P5L.TOSLex[nWords]; END ELSE BEGIN len: CARDINAL = SymbolOps.WordsForType[SymbolOps.UnderType[targetType]]; P5.SysCallN[RTSD.sRaiseNarrowFault, 0]; IF len = nWords THEN l _ CPtr.mwCaseCV ELSE -- simulate a chop BEGIN r: VarIndex = P5L.VarForLex[CPtr.mwCaseCV]; P5L.FieldOfVarOnly[r: r, wSize: len]; l _ [bdo[r]]; END; END; CPtr.mwCaseCV _ saveMwCaseCV; CPtr.caseCVState _ saveCaseCVState; CPtr.xtracting _ saveExtracting; P5.CallCatch[IF tb[node].nSons > 2 THEN tb[node].son[3] ELSE Tree.Null]; P5U.InsertLabel[eLabel]; RETURN saveMwCaseCV: Lexeme = CPtr.mwCaseCV; saveExtracting: BOOL = CPtr.xtracting; saveCaseCVState: CaseCVState = CPtr.caseCVState; sourceType: CSEIndex = P5U.OperandType[tb[node].son[1]]; t: Tree.Link; CPtr.xtracting _ FALSE; Stack.Dump[]; t _ TypePredicate[sourceType, P5U.TypeForTree[tb[node].son[2]], node]; IF tb[node].attr1 OR tb[node].attr2 THEN t _ OrTest[NilPredicate[sourceType], t]; CPtr.mwCaseCV _ SelectArg[tb[node].son[1], tb[node].attr1]; CPtr.caseCVState _ multi; P5.FlowTree[t, tf, label]; t _ TreeOps.FreeTree[t]; P5L.ReleaseLex[CPtr.mwCaseCV]; CPtr.mwCaseCV _ saveMwCaseCV; CPtr.caseCVState _ saveCaseCVState; CPtr.xtracting _ saveExtracting; Κ S˜codešœ™Kšœ Οmœ1™Kšœžœ,žœ˜IKšžœ žœžœžœ˜B—K˜K˜ Kš žœ žœžœžœžœ žœ˜TKšœžœ6˜?Kšž˜Kšžœ˜K˜—K˜š   œžœžœžœžœ ˜PKšžœŸ˜$Kšœžœ™&K™&Kšœ žœžœ™K™Kšœ žœžœ™Kšœžœ™K™Kšœ žœ™ K™K™K™K™šžœž™Kšž™K™šžœŸ™+šžœžœ2ž™OKšž™K™Kšžœ!žœ™AK™K™Kšžœ™——šžœž™Kšž™K™ Kšžœ žœ6™FK™K™1K™SKšœžœ'™;Kšž™—šžœžœ!ž™,Kšžœ4žœ™=—Kšœžœ™Kšžœžœ žœ™'Kšž™—Kšžœ žœ žœžœ ™MKšž™K™,KšœŸ ™:šžœž™™K™Kšœžœ žœžœ™:K™K™Kšœžœ(™:K™——K™K™Kšžœ™Kšžœžœ+™8KšžœE™IK™Kšž™Kšžœ™K™—K™)Kšœžœ™K™ Kšžœžœ™K™Cšžœžœž™™Kšž™šžœž™Kšž™K™3Kšž™—šž™Kšž™K™K™K™)Kšžœ™—K™ Kšžœ™—™Kšž™K™(K™ K™Kšœžœ*™=Kšžœ™—Kšžœ™—K™:Kšžœžœ™5K™K™BK™ Kšž™Kšžœ˜K™K™—š  œžœžœžœ ™AKšž™K™ K™ Kšœ"žœžœ ™