<> <> <> <> <> <> DIRECTORY Alloc, Basics, Code, CodeDefs, ComData, FOpCodes, IntCodeDefs, P5, P5S, P5U, SymbolOps, Symbols, Tree, TreeOps; Store: PROGRAM IMPORTS CPtr: Code, MPtr: ComData, CodeDefs, P5U, P5, SymbolOps, TreeOps EXPORTS CodeDefs, P5, P5S = BEGIN OPEN CodeDefs, SymbolOps; <> <<>> Node: TYPE = IntCodeDefs.Node; wordlength: CARDINAL = Basics.bitsPerWord; BitAddress: TYPE = Symbols.BitAddress; CBTIndex: TYPE = Symbols.CBTIndex; CTXIndex: TYPE = Symbols.CTXIndex; ISEIndex: TYPE = Symbols.ISEIndex; ISENull: ISEIndex = Symbols.ISENull; lG: Symbols.ContextLevel = Symbols.lG; RecordSEIndex: TYPE = Symbols.RecordSEIndex; tb: Tree.Base; -- tree base (local copy) seb: Symbols.Base; -- semantic entry base (local copy) bb: Symbols.Base; -- body entry base (local copy) cb: CodeDefs.Base; -- code base (local copy) StoreNotify: PUBLIC Alloc.Notifier = BEGIN -- called by allocator whenever table area is repacked seb _ base[Symbols.seType]; bb _ base[Symbols.bodyType]; tb _ base[Tree.treeType]; cb _ base[codeType]; END; Assign: PUBLIC PROC [node: Tree.Index] RETURNS [l: Node] = BEGIN -- generates code for assignment statement (RRA) l _ ComAssign[ t1: tb[node].son[1], t2: tb[node].son[2], options: [expr: FALSE, init: tb[node].attr1, counted: tb[node].attr2, composite: tb[node].attr3]]; END; AssignExp: PUBLIC PROC [node: Tree.Index] RETURNS [l: Node] = BEGIN -- generates code for assignment expression (RRA) l _ ComAssign[ t1: tb[node].son[1], t2: tb[node].son[2], options: [expr: TRUE, init: tb[node].attr1, counted: tb[node].attr2, composite: tb[node].attr3]]; RETURN END; ComAssign: PROC [t1, t2: Tree.Link, options: StoreOptions] RETURNS [l: Node] = BEGIN -- can support counted assignments (RRA) nbits: CARDINAL; aligned: BOOL _ FALSE; lv: Var; rv: Node; nbits _ P5U.BitsForOperand[t1]; DO -- until we get to something interesting SELECT TreeOps.OpName[t2] FROM pad => BEGIN t2 _ TreeOps.NthSon[t2, 1]; aligned _ TRUE; nbits _ P5U.BitsForOperand[t2]; END; cast, safen => t2 _ TreeOps.NthSon[t2, 1]; ENDCASE => EXIT; ENDLOOP; SELECT TreeOps.OpName[t2] FROM construct => IF (SimpleLocation[t1] OR options.counted OR nbits > 20*WordSize OR TreeOps.ListLength[TreeOps.NthSon[t2, 2]] <= 4) AND ~ManySafens[t2, nbits] THEN BEGIN l _ P5.Construct[t1, TreeOps.GetNode[t2], options]; RETURN END ELSE rv _ P5.Construct[Tree.Null, TreeOps.GetNode[t2], []]; union => {l _ P5.VariantConstruct[t1, t2, options]; RETURN}; rowcons => IF options.counted OR SimpleLocation[t1] AND ~ManySafens[t2, nbits] THEN BEGIN l _ P5.RowCons[t1, TreeOps.GetNode[t2], options]; RETURN END ELSE rv _ P5.RowCons[Tree.Null, TreeOps.GetNode[t2], []]; all => BEGIN l _ P5.All[t1, TreeOps.GetNode[t2], options]; RETURN END; ENDCASE => rv _ P5.Exp[t2]; lv _ NARROW[P5.Exp[t1]]; IF aligned THEN lv _ P5U.TakeField[n: lv, vl: [disp: 0, size: nbits]]; l _ z.NEW[NodeRep.assign _ [details: assign[lhs: lv, rhs: rv]]]; END; ManySafens: PROC [t: Tree.Link, nbits: CARDINAL] RETURNS [BOOL] = BEGIN nFields, nSafens: CARDINAL _ 0; noAll: BOOL _ TRUE; CountSafens: PROC [t: Tree.Link] = BEGIN SELECT TreeOps.OpName[t] FROM rowcons, construct, union => TreeOps.ScanList[TreeOps.NthSon[t, 2], CountSafens]; all => BEGIN noAll _ FALSE; CountSafens[TreeOps.NthSon[t, 1]] END; cast, pad => CountSafens[TreeOps.NthSon[t, 1]]; safen => BEGIN nSafens _ nSafens+1; nFields _ nFields+1 END; ENDCASE => nFields _ nFields+1; END; CountSafens[t]; RETURN [IF nbits<16*wordlength THEN (nSafens >= 2) ELSE (noAll AND 2*nSafens > nFields)] END; Extract: PUBLIC PROC [node: Tree.Index] RETURNS [l: Node] = BEGIN cl: CodeList _ P5U.NewCodeList[]; [] _ ExtractToCl[cl, node]; l _ P5U.MakeBlock[cl]; END; ExtractToCl: PUBLIC PROC [cl: CodeList, node: Tree.Index] RETURNS [sn: Node] = BEGIN t1: Tree.Link = tb[node].son[1]; tsei: RecordSEIndex = LOOPHOLE[P5U.OperandType[t1]]; t2: Tree.Link = tb[node].son[2]; IF SimpleLocation[t2] THEN sn _ P5.Exp[t2] ELSE { e2: Node _ P5.Exp[t2]; tv: Var _ P5U.CreateTemp[e2.bits].var; P5U.Declare[cl: cl, var: tv, init: e2]; sn _ tv}; ExtractFrom[cl, t1, tsei, sn]; END; ExtractExp: PUBLIC PROC [node: Tree.Index] RETURNS [l: Node] = BEGIN cl: CodeList _ P5U.NewCodeList[]; sn: Node = ExtractToCl[cl, node]; P5U.MoreCode[cl, sn]; l _ P5U.MakeBlock[cl]; l.bits _ sn.bits; END; ExtractFrom: PUBLIC PROC [ cl: CodeList, t1: Tree.Link, tsei: RecordSEIndex, sourceNode: Node] = BEGIN saveExtractState: RECORD [ xtracting: BOOL, xtractNode: Node, xtractsei: Symbols.ISEIndex] = [CPtr.xtracting, CPtr.xtractNode, CPtr.xtractsei]; fa: PROC [ISEIndex] RETURNS [BitAddress, CARDINAL] = IF seb[tsei].argument THEN FnField ELSE RecField; startsei: ISEIndex = FirstCtxSe[seb[tsei].fieldCtx]; sei: ISEIndex _ startsei; isei: ISEIndex _ startsei; node: Tree.Index = TreeOps.GetNode[t1]; soncount: CARDINAL _ 0; totalBits: CARDINAL; trashOnStack: CARDINAL _ 0; SExtract: PROC [node: Tree.Index] = BEGIN t1: Tree.Link = tb[node].son[1]; tsei: RecordSEIndex = LOOPHOLE[P5U.OperandType[t1]]; ExtractFrom[cl, t1, tsei, P5.Exp[tb[node].son[2]]]; END; ExtractItem: PROC [t: Tree.Link] RETURNS [v: Tree.Link] = BEGIN posn: BitAddress; size: CARDINAL; v _ t; [posn, size] _ fa[sei]; IF t # Tree.Null THEN BEGIN subNode: Tree.Index = TreeOps.GetNode[t]; vl: VLoc _ [disp: P5U.Bits[posn], size: size]; IF fa # FnField AND totalBits <= WordSize THEN vl _ P5U.AdjustLoc[vl: vl, rSei: tsei, fSei: sei, tBits: totalBits]; CPtr.xtractNode _ P5U.TakeField[n: sourceNode, vl: vl]; CPtr.xtractsei _ sei; SELECT tb[subNode].name FROM assign => P5U.MoreCode[cl, Assign[subNode]]; extract => SExtract[subNode]; ENDCASE => ERROR; END; sei _ P5U.PrevVar[startsei, sei]; RETURN END; -- of ExtractItem xlist: Tree.Link _ tb[node].son[1]; UNTIL (isei _ NextSe[sei]) = ISENull DO isei _ P5U.NextVar[isei]; IF isei = ISENull THEN EXIT; sei _ isei; ENDLOOP; totalBits _ sourceNode.bits; CPtr.xtracting _ TRUE; tb[node].son[1] _ TreeOps.ReverseUpdateList[xlist, ExtractItem]; [CPtr.xtracting, CPtr.xtractNode, CPtr.xtractsei] _ saveExtractState; END; SimpleLocation: PROC [t: Tree.Link] RETURNS [BOOL] = { GlobalOrLocal: PROC [t: Tree.Link] RETURNS [BOOL] = { sei: ISEIndex; WITH t SELECT FROM symbol => sei _ index; ENDCASE => RETURN[FALSE]; {ctx: CTXIndex _ seb[sei].idCtx; level: Symbols.ContextLevel _ SymbolOps.CtxLevel[ctx]; SELECT level FROM lG, CPtr.curctxlvl => RETURN[TRUE]; ENDCASE => NULL}; RETURN[FALSE]}; WITH t SELECT FROM symbol => RETURN[GlobalOrLocal[t]]; subtree => { node: Tree.Index = index; SELECT tb[node].name FROM dot, uparrow => RETURN[GlobalOrLocal[tb[node].son[1]]]; ENDCASE; }; ENDCASE; RETURN[FALSE]}; BodyInit: PUBLIC PROC [node: Tree.Index] RETURNS [Node _ NIL] = BEGIN -- assigns proc. desc for proc. variable <> <> <> <> END; <<>> <<>> ProcInit: PUBLIC PROC [node: Tree.Index] RETURNS [Node _ NIL] = BEGIN <> <> <>> <> <> <> <> <> <> END; <<>> <<>> END.