summaryrefslogtreecommitdiff
path: root/compiler/codeGen
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/codeGen')
-rw-r--r--compiler/codeGen/StgCmmBind.hs4
-rw-r--r--compiler/codeGen/StgCmmCon.hs2
-rw-r--r--compiler/codeGen/StgCmmEnv.hs14
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