When allocating new objects on the heap, we previously returned
a CmmExpr containing the heap pointer as well as the tag expression,
which would be added to the code graph upon first usage. Unfortunately,
this meant that untagged heap pointers living in registers might
be spilled to the stack, where they interacted poorly with garbage
collection (we saw this bug specifically with the compacting garbage
collector.)
This fix immediately tags the register containing the heap pointer,
so that unless we have extremely unfriendly spill code, the new pointer
will never be spilled to the stack untagged.
An alternate solution might have been to modify allocDynClosure to
tag the pointer upon the initial register allocation, but not all
invocations of allocDynClosure tag the resulting pointer, and
threading the consequent CgIdInfo for the cases that did would have
been annoying.
(map toVarArg fv_details)
-- RETURN
(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
-- Use with care; if used inappropriately, it could break invariants.
stripNV :: NonVoid a -> a
; (tmp, init) <- allocDynClosure closure_info use_cc blame_cc payload_w_offsets
-- RETURN
; (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
mkClosureLFInfo :: Id -- The binder
-> TopLevelFlag -- True of top level
= 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
= 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
where
lf_info = mkConLFInfo con
import BlockId
import CmmExpr
import CmmUtils
import BlockId
import CmmExpr
import CmmUtils
+import MkGraph (CmmAGraph, mkAssign, (<*>))
import FastString
import Id
import VarEnv
import FastString
import Id
import VarEnv
litIdInfo id lf_info lit = --mkCgIdInfo id lf_info (CmmLit lit)
mkCgIdInfo id lf_info (addDynTag (CmmLit lit) (lfDynTag lf_info))
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
idInfoToAmode :: CgIdInfo -> CmmExpr
-- Returns a CmmExpr for the *tagged* pointer