<> <> <> <> <> <> DIRECTORY Alloc USING [Notifier], Basics USING [bitsPerWord], Code USING [fileLoc, tailJumpOK, xtracting, xtractlex, xtractsei], CodeDefs USING [Base, BoVarIndex, codeType, Lexeme, NullLex, StoreOptions, VarComponent, VarIndex, VarNull], ComData USING [switches], Counting USING [VarVarAssignCounted], FOpCodes USING [qBLZL, qDESCB, qFREE, qLP, qSL], P5 USING [All, Construct, Exp, GenTempLex, LogHeapFree, MultiZero, PushLProcDesc, RowCons, VariantConstruct], P5L USING [AdjustComponent, ComponentForSE, CopyToTemp, EasilyLoadable, EasyToLoad, FieldOfComponent, FieldOfVar, GenVarItem, LoadAddress, LoadComponent, LoadVar, MakeBo, ModComponent, OVarItem, ReleaseVarItem, ReusableCopies, StoreComponent, TOSAddrLex, TOSComponent, TOSLex, VarForLex, VarVarAssign, Words], P5S USING [], P5U USING [BitsForOperand, LongTreeAddress, NextVar, OperandType, Out0, Out1, PushLitVal, PrevVar, WordAligned], SourceMap USING [Up], Stack USING [Clear, Dup, Pop], SymbolOps USING [FirstCtxSe, FnField, NextSe, RecField], Symbols USING [Base, BitAddress, bodyType, CBTIndex, ContextLevel, ISEIndex, ISENull, lG, RecordSEIndex, seType], Tree USING [Base, Index, Link, Null, treeType], TreeOps USING [GetNode, OpName, ListLength, NthSon, ReverseUpdateList, ScanList]; Store: PROGRAM IMPORTS CPtr: Code, MPtr: ComData, Counting, P5U, P5L, P5, SourceMap, Stack, SymbolOps, TreeOps EXPORTS CodeDefs, P5, P5S = BEGIN OPEN CodeDefs, SymbolOps; <> wordlength: CARDINAL = Basics.bitsPerWord; BitAddress: TYPE = Symbols.BitAddress; CBTIndex: TYPE = Symbols.CBTIndex; 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] = BEGIN -- generates code for assignment statement (RRA) [] _ 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: Lexeme] = 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: Lexeme] = BEGIN -- can support counted assignments (RRA) nbits: CARDINAL; longAddressLhs: BOOL _ P5U.LongTreeAddress[t1]; aligned: BOOL _ FALSE; lv, rv: VarIndex; l _ NullLex; 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 options.counted OR (( -- some heuristics ~longAddressLhs OR nbits > 20*wordlength 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 IF nbits > 2*wordlength THEN BEGIN --otherwise fall through into building on stack tlex: Lexeme.se = P5.GenTempLex[(nbits+wordlength-1) / wordlength]; [] _ P5.Construct[[symbol[tlex.lexsei]], TreeOps.GetNode[t2], TempOptions[options]]; t2 _ [symbol[tlex.lexsei]]; END; union => IF ~options.expr THEN {P5.VariantConstruct[t1, t2, options]; RETURN}; rowcons => IF options.counted OR (~longAddressLhs AND ~ManySafens[t2, nbits]) THEN BEGIN l _ P5.RowCons[t1, TreeOps.GetNode[t2], options]; RETURN END ELSE IF nbits > 2*wordlength THEN BEGIN tlex: Lexeme.se = P5.GenTempLex[(nbits+wordlength-1) / wordlength]; [] _ P5.RowCons[[symbol[tlex.lexsei]], TreeOps.GetNode[t2], TempOptions[options]]; t2 _ [symbol[tlex.lexsei]]; END; all => BEGIN l _ P5.All[t1, TreeOps.GetNode[t2], options]; RETURN END; mwconst => IF MPtr.switches['m] AND P5.MultiZero[t2] AND (options.init OR ~options.counted) THEN BEGIN nw: CARDINAL = P5L.Words[w: 0, b: nbits]; lv _ P5L.VarForLex[P5.Exp[t1]]; IF ~P5L.LoadAddress[lv] THEN P5U.Out0[FOpCodes.qLP]; P5U.PushLitVal[nw]; P5U.Out0[FOpCodes.qBLZL]; IF options.expr THEN l _ P5L.TOSAddrLex[nw, TRUE] ELSE Stack.Pop[2]; RETURN END; ENDCASE; rv _ P5L.VarForLex[P5.Exp[t2]]; IF nbits <= 2*wordlength AND ~ProbablyDumpStack[t1] THEN { P5L.LoadVar[rv]; rv _ P5L.VarForLex[P5L.TOSLex[(nbits+ wordlength-1)/wordlength]]}; lv _ P5L.VarForLex[P5.Exp[t1]]; IF aligned THEN P5L.FieldOfVar[r: lv, wSize: nbits/wordlength, bSize: nbits MOD wordlength]; IF options.counted THEN l _ Counting.VarVarAssignCounted[lv, rv, options, P5U.OperandType[t1]] ELSE l _ P5L.VarVarAssign[lv, rv, options.expr]; RETURN END; TempOptions: PROC [options: StoreOptions] RETURNS [StoreOptions] = { options.init _ TRUE; options.expr _ options.counted _ FALSE; RETURN [options]}; 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] = BEGIN SExtract[node]; Stack.Clear[]; END; SExtract: PROC [node: Tree.Index] = BEGIN t1: Tree.Link = tb[node].son[1]; tsei: RecordSEIndex = LOOPHOLE[P5U.OperandType[t1]]; r: VarIndex; transferrec: BOOL _ FALSE; r _ P5L.VarForLex[P5.Exp[tb[node].son[2] ! P5.LogHeapFree => IF calltree = tb[node].son[2] THEN {transferrec _ TRUE; RESUME[TRUE, NullLex]}]]; ExtractFrom[t1, tsei, r, transferrec]; END; ExtractExp: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] = BEGIN t1: Tree.Link = tb[node].son[1]; tsei: RecordSEIndex = LOOPHOLE[P5U.OperandType[t1]]; r, rret: VarIndex; r _ P5L.VarForLex[P5.Exp[tb[node].son[2] ! P5.LogHeapFree => IF calltree = tb[node].son[2] THEN RESUME[FALSE, NullLex]]]; [first: r, next: rret] _ P5L.ReusableCopies[r, store, FALSE]; ExtractFrom[t1, tsei, r, FALSE]; RETURN [[bdo[rret]]] END; ExtractFrom: PUBLIC PROC [ t1: Tree.Link, tsei: RecordSEIndex, r: VarIndex, transferrec: BOOL] = BEGIN saveExtractState: RECORD [ xtracting: BOOL, xtractlex: Lexeme, xtractsei: Symbols.ISEIndex] = [CPtr.xtracting, CPtr.xtractlex, 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; tbase, toffset: VarComponent; onStack, useDup: BOOL _ FALSE; totalBits: CARDINAL; trashOnStack: CARDINAL _ 0; XCount: PROC [t: Tree.Link] = BEGIN IF t # Tree.Null THEN soncount _ soncount+1; 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]; rr: VarIndex; offset, base: VarComponent; soncount _ soncount-1; IF onStack THEN offset _ toffset -- original record on stack ELSE BEGIN IF useDup THEN BEGIN IF (transferrec OR soncount > 0) THEN Stack.Dup[load: FALSE]; base _ P5L.TOSComponent[1]; END ELSE base _ tbase; offset _ toffset; END; P5L.FieldOfComponent[ var: @offset, wd: posn.wd, bd: posn.bd, wSize: size/wordlength, bSize: size MOD wordlength]; IF fa # FnField AND totalBits <= wordlength THEN P5L.AdjustComponent[var: @offset, rSei: tsei, fSei: sei, tBits: totalBits]; IF onStack THEN rr _ P5L.OVarItem[offset] ELSE BEGIN rr _ P5L.GenVarItem[bo]; cb[rr] _ [body: bo[base: base, offset: offset]]; END; CPtr.xtractlex _ [bdo[rr]]; CPtr.xtractsei _ sei; SELECT tb[subNode].name FROM assign => Assign[subNode]; extract => SExtract[subNode]; ENDCASE => ERROR; END ELSE IF onStack THEN Stack.Pop[size/wordlength]; 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; WITH cc: cb[r] SELECT FROM o => WITH vv: cc.var SELECT FROM stack => IF P5U.WordAligned[tsei] THEN BEGIN trashOnStack _ vv.wd; vv.wd _ 0; toffset _ cc.var; IF trashOnStack # 0 THEN P5L.ModComponent[var: @toffset, wd: trashOnStack]; P5L.ReleaseVarItem[r]; onStack _ TRUE; END ELSE BEGIN -- copy whole thing to temp var: VarComponent _ P5L.CopyToTemp[r].var; r _ P5L.OVarItem[var]; END; ENDCASE; ENDCASE; IF ~onStack THEN BEGIN bor: BoVarIndex _ P5L.MakeBo[r]; IF bor = VarNull THEN -- not addressable BEGIN -- r was not freed in this case var: VarComponent _ P5L.CopyToTemp[r].var; r _ P5L.OVarItem[var]; bor _ P5L.MakeBo[r]; -- it will work this time END; tbase _ cb[bor].base; toffset _ cb[bor].offset; P5L.ReleaseVarItem[bor]; IF tbase.wSize > 1 THEN tbase _ P5L.EasilyLoadable[tbase, store] ELSE IF ~P5L.EasyToLoad[tbase, store] THEN BEGIN P5L.LoadComponent[tbase]; useDup _ TRUE; END; END; totalBits _ toffset.wSize * wordlength + toffset.bSize; TreeOps.ScanList[xlist, XCount]; IF soncount = 0 THEN BEGIN IF onStack THEN trashOnStack _ trashOnStack + (totalBits+(wordlength-1))/wordlength; END ELSE BEGIN CPtr.xtracting _ TRUE; tb[node].son[1] _ TreeOps.ReverseUpdateList[xlist, ExtractItem]; END; IF transferrec THEN BEGIN IF ~useDup THEN P5L.LoadComponent[tbase]; P5U.Out0[FOpCodes.qFREE]; END; THROUGH [0..trashOnStack) DO Stack.Pop[] ENDLOOP; [CPtr.xtracting, CPtr.xtractlex, CPtr.xtractsei] _ saveExtractState; END; ProbablyDumpStack: PUBLIC PROC [t: Tree.Link] RETURNS [BOOL] = BEGIN -- only a hint node: Tree.Index; WITH t SELECT FROM subtree => node _ index; ENDCASE => RETURN [FALSE]; RETURN [SELECT tb[node].name FROM loophole, pad, chop, uparrow, dot, dollar, not => ProbablyDumpStack[tb[node].son[1]], and, or, plus, minus, times, div, mod, index, dindex, seqindex => ProbablyDumpStack[tb[node].son[2]] OR ProbablyDumpStack[tb[node].son[1]], ifx => ProbablyDumpStack[tb[node].son[3]] OR ProbablyDumpStack[tb[node].son[2]] OR ProbablyDumpStack[tb[node].son[1]], IN [relE..notin] => ProbablyDumpStack[tb[node].son[2]] OR ProbablyDumpStack[tb[node].son[1]], IN [callx..joinx] => TRUE, ENDCASE => FALSE] END; ReleaseLex: PROC [l: Lexeme] = BEGIN WITH l SELECT FROM bdo => P5L.ReleaseVarItem[lexbdoi]; ENDCASE; END; SAssign: PUBLIC PROC [sei: ISEIndex] = BEGIN -- assigns to a simple variable from the stack var: VarComponent = P5L.ComponentForSE[sei]; P5L.StoreComponent[var]; END; SLAssign: PUBLIC PROC [sei: ISEIndex, l: Lexeme, exp: BOOL, nwords: CARDINAL] = BEGIN -- obsolete? TLLAssign[Tree.Null, [se[sei]], l, exp, nwords*wordlength]; END; TTAssign: PUBLIC PROC [t1, t2: Tree.Link] = BEGIN -- not called for counted assignments (RRA) [] _ ComAssign[t1: t1, t2: t2, options: [expr: FALSE]]; END; TLLAssign: PUBLIC PROC [ leftson: Tree.Link, leftlex, l: Lexeme, exp: BOOL, nbits: CARDINAL] = BEGIN -- obsolete? rightr, leftr: VarIndex; rightr _ P5L.VarForLex[l]; IF leftson # Tree.Null THEN leftlex _ P5.Exp[leftson]; leftr _ P5L.VarForLex[leftlex]; [] _ P5L.VarVarAssign[leftr, rightr, exp]; END; BodyInit: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] = BEGIN -- assigns proc. desc for proc. variable bti: CBTIndex = tb[node].info; CPtr.fileLoc _ SourceMap.Up[bb[bti].sourceIndex]; P5.PushLProcDesc[bti]; RETURN [P5L.TOSLex[1]] END; ProcInit: PUBLIC PROC [node: Tree.Index] = BEGIN bti: CBTIndex = tb[node].info; WITH body: bb[bti] SELECT FROM Inner => BEGIN CPtr.tailJumpOK _ FALSE; -- conservative P5U.Out1[FOpCodes.qDESCB, body.entryIndex]; P5U.Out1[FOpCodes.qSL, body.frameOffset]; END; ENDCASE; END; END.