diff options
Diffstat (limited to 'compiler/codeGen')
-rw-r--r-- | compiler/codeGen/StgCmmBind.hs | 4 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmCon.hs | 2 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmEnv.hs | 14 |
3 files changed, 14 insertions, 6 deletions
diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index bfb749cb69..2947d33042 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -301,7 +301,7 @@ mkRhsClosure bndr cc _ fvs upd_flag srt args body (map toVarArg fv_details) -- RETURN - ; return $ (regIdInfo bndr lf_info tmp, init) } + ; regIdInfo bndr lf_info tmp init } -- Use with care; if used inappropriately, it could break invariants. stripNV :: NonVoid a -> a @@ -336,7 +336,7 @@ cgStdThunk bndr cc _bndr_info body lf_info payload ; (tmp, init) <- allocDynClosure closure_info use_cc blame_cc payload_w_offsets -- RETURN - ; returnFC $ (regIdInfo bndr lf_info tmp, init) } + ; regIdInfo bndr lf_info tmp init } mkClosureLFInfo :: Id -- The binder -> TopLevelFlag -- True of top level diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index 633d577c73..368bc53483 100644 --- a/compiler/codeGen/StgCmmCon.hs +++ b/compiler/codeGen/StgCmmCon.hs @@ -193,7 +193,7 @@ buildDynCon binder ccs con args = do { let (cl_info, args_w_offsets) = layOutDynConstr con (addArgReps args) -- No void args in args_w_offsets ; (tmp, init) <- allocDynClosure cl_info use_cc blame_cc args_w_offsets - ; return (regIdInfo binder lf_info tmp, init) } + ; regIdInfo binder lf_info tmp init } where lf_info = mkConLFInfo con diff --git a/compiler/codeGen/StgCmmEnv.hs b/compiler/codeGen/StgCmmEnv.hs index 469f58d7df..369e1993aa 100644 --- a/compiler/codeGen/StgCmmEnv.hs +++ b/compiler/codeGen/StgCmmEnv.hs @@ -37,6 +37,7 @@ import CLabel import BlockId import CmmExpr import CmmUtils +import MkGraph (CmmAGraph, mkAssign, (<*>)) import FastString import Id import VarEnv @@ -86,9 +87,16 @@ litIdInfo :: Id -> LambdaFormInfo -> CmmLit -> CgIdInfo litIdInfo id lf_info lit = --mkCgIdInfo id lf_info (CmmLit lit) mkCgIdInfo id lf_info (addDynTag (CmmLit lit) (lfDynTag lf_info)) -regIdInfo :: Id -> LambdaFormInfo -> LocalReg -> CgIdInfo -regIdInfo id lf_info reg = - mkCgIdInfo id lf_info (addDynTag (CmmReg (CmmLocal reg)) (lfDynTag lf_info)) +-- Because the register may be spilled to the stack in untagged form, we +-- modify the initialization code 'init' to immediately tag the +-- register, and store a plain register in the CgIdInfo. We allocate +-- a new register in order to keep single-assignment and help out the +-- inliner. -- EZY +regIdInfo :: Id -> LambdaFormInfo -> LocalReg -> CmmAGraph -> FCode (CgIdInfo, CmmAGraph) +regIdInfo id lf_info reg init = do + reg' <- newTemp (localRegType reg) + let init' = init <*> mkAssign (CmmLocal reg') (addDynTag (CmmReg (CmmLocal reg)) (lfDynTag lf_info)) + return (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg')), init') idInfoToAmode :: CgIdInfo -> CmmExpr -- Returns a CmmExpr for the *tagged* pointer |