summaryrefslogtreecommitdiff
path: root/compiler/codeGen
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/codeGen')
-rw-r--r--compiler/codeGen/CgInfoTbls.hs13
-rw-r--r--compiler/codeGen/ClosureInfo.lhs16
-rw-r--r--compiler/codeGen/StgCmmClosure.hs16
-rw-r--r--compiler/codeGen/StgCmmLayout.hs6
4 files changed, 24 insertions, 27 deletions
diff --git a/compiler/codeGen/CgInfoTbls.hs b/compiler/codeGen/CgInfoTbls.hs
index 76a433b48e..dbd22f3906 100644
--- a/compiler/codeGen/CgInfoTbls.hs
+++ b/compiler/codeGen/CgInfoTbls.hs
@@ -57,9 +57,7 @@ emitClosureCodeAndInfoTable :: ClosureInfo -> [CmmFormal] -> CgStmts -> Code
emitClosureCodeAndInfoTable cl_info args body
= do { blks <- cgStmtsToBlocks body
; info <- mkCmmInfo cl_info
- ; emitInfoTableAndCode (infoLblToEntryLbl info_lbl) info args blks }
- where
- info_lbl = infoTableLabelFromCI cl_info
+ ; emitInfoTableAndCode (entryLabelFromCI cl_info) info args blks }
-- We keep the *zero-indexed* tag in the srt_len field of the info
-- table of a data constructor.
@@ -84,12 +82,12 @@ mkCmmInfo cl_info = do
info = ConstrInfo (ptrs, nptrs)
(fromIntegral (dataConTagZ con))
conName
- return $ CmmInfo gc_target Nothing (CmmInfoTable False False prof cl_type info)
+ return $ CmmInfo gc_target Nothing (CmmInfoTable (infoTableLabelFromCI cl_info) False prof cl_type info)
ClosureInfo { closureName = name,
closureLFInfo = lf_info,
closureSRT = srt } ->
- return $ CmmInfo gc_target Nothing (CmmInfoTable (closureInfoLocal cl_info) False prof cl_type info)
+ return $ CmmInfo gc_target Nothing (CmmInfoTable (infoTableLabelFromCI cl_info) False prof cl_type info)
where
info =
case lf_info of
@@ -142,16 +140,17 @@ emitReturnTarget name stmts
; let info = CmmInfo
gc_target
Nothing
- (CmmInfoTable False False
+ (CmmInfoTable info_lbl False
(ProfilingInfo zeroCLit zeroCLit)
rET_SMALL -- cmmToRawCmm may convert it to rET_BIG
(ContInfo frame srt_info))
- ; emitInfoTableAndCode (infoLblToEntryLbl info_lbl) info args blks
+ ; emitInfoTableAndCode entry_lbl info args blks
; return info_lbl }
where
args = {- trace "emitReturnTarget: missing args" -} []
uniq = getUnique name
info_lbl = mkReturnInfoLabel uniq
+ entry_lbl = mkReturnPtLabel uniq
-- The gc_target is to inform the CPS pass when it inserts a stack check.
-- Since that pass isn't used yet we'll punt for now.
diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs
index ad2ea4fddd..6964de7273 100644
--- a/compiler/codeGen/ClosureInfo.lhs
+++ b/compiler/codeGen/ClosureInfo.lhs
@@ -29,7 +29,7 @@ module ClosureInfo (
closureGoodStuffSize, closurePtrsSize,
slopSize,
- infoTableLabelFromCI,
+ infoTableLabelFromCI, entryLabelFromCI,
closureLabelFromCI,
isLFThunk, closureUpdReqd,
closureNeedsUpdSpace, closureIsThunk,
@@ -50,7 +50,7 @@ module ClosureInfo (
isToplevClosure,
closureValDescr, closureTypeDescr, -- profiling
- closureInfoLocal, isStaticClosure,
+ isStaticClosure,
cafBlackHoleClosureInfo,
staticClosureNeedsLink,
@@ -847,10 +847,6 @@ staticClosureRequired _ _ _ = True
%************************************************************************
\begin{code}
-closureInfoLocal :: ClosureInfo -> Bool
-closureInfoLocal ClosureInfo{ closureInfLcl = lcl } = lcl
-closureInfoLocal ConInfo{} = False
-
isStaticClosure :: ClosureInfo -> Bool
isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
@@ -931,8 +927,9 @@ Label generation.
\begin{code}
infoTableLabelFromCI :: ClosureInfo -> CLabel
infoTableLabelFromCI cl@(ClosureInfo { closureName = name,
- closureLFInfo = lf_info })
- = case lf_info of
+ closureLFInfo = lf_info,
+ closureInfLcl = is_lcl })
+ = (if is_lcl then localiseLabel else id) $ case lf_info of
LFBlackHole info -> info
LFThunk _ _ upd_flag (SelectorThunk offset) _ ->
@@ -954,6 +951,9 @@ infoTableLabelFromCI cl@(ConInfo { closureCon = con,
where
name = dataConName con
+entryLabelFromCI :: ClosureInfo -> CLabel
+entryLabelFromCI = infoLblToEntryLbl . infoTableLabelFromCI
+
-- ClosureInfo for a closure (as opposed to a constructor) is always local
closureLabelFromCI :: ClosureInfo -> CLabel
closureLabelFromCI cl@(ClosureInfo { closureName = nm }) = mkLocalClosureLabel nm $ clHasCafRefs cl
diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs
index 7c4f8bc8b8..7a6f0bbc45 100644
--- a/compiler/codeGen/StgCmmClosure.hs
+++ b/compiler/codeGen/StgCmmClosure.hs
@@ -35,7 +35,7 @@ module StgCmmClosure (
closureGoodStuffSize, closurePtrsSize,
slopSize,
- closureName, infoTableLabelFromCI,
+ closureName, infoTableLabelFromCI, entryLabelFromCI,
closureLabelFromCI,
closureTypeInfo,
closureLFInfo, isLFThunk,closureSMRep, closureUpdReqd,
@@ -56,7 +56,7 @@ module StgCmmClosure (
isToplevClosure,
closureValDescr, closureTypeDescr, -- profiling
- closureInfoLocal, isStaticClosure,
+ isStaticClosure,
cafBlackHoleClosureInfo,
staticClosureNeedsLink, clHasCafRefs
@@ -938,10 +938,6 @@ staticClosureNeedsLink (ConInfo { closureSMRep = sm_rep, closureCon = con })
GenericRep _ _ _ ConstrNoCaf -> False
_other -> True
-closureInfoLocal :: ClosureInfo -> Bool
-closureInfoLocal ClosureInfo{ closureInfLcl = lcl } = lcl
-closureInfoLocal ConInfo{} = False
-
isStaticClosure :: ClosureInfo -> Bool
isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
@@ -998,8 +994,9 @@ isToplevClosure _ = False
infoTableLabelFromCI :: ClosureInfo -> CLabel
infoTableLabelFromCI cl@(ClosureInfo { closureName = name,
- closureLFInfo = lf_info })
- = case lf_info of
+ closureLFInfo = lf_info,
+ closureInfLcl = is_lcl })
+ = (if is_lcl then localiseLabel else id) $ case lf_info of
LFBlackHole info -> info
LFThunk _ _ upd_flag (SelectorThunk offset) _ ->
@@ -1020,6 +1017,9 @@ infoTableLabelFromCI cl@(ConInfo { closureCon = con, closureSMRep = rep })
where
name = dataConName con
+entryLabelFromCI :: ClosureInfo -> CLabel
+entryLabelFromCI = infoLblToEntryLbl . infoTableLabelFromCI
+
-- ClosureInfo for a closure (as opposed to a constructor) is always local
closureLabelFromCI :: ClosureInfo -> CLabel
closureLabelFromCI cl@(ClosureInfo { closureName = nm }) =
diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs
index 278c41aef2..63fc840845 100644
--- a/compiler/codeGen/StgCmmLayout.hs
+++ b/compiler/codeGen/StgCmmLayout.hs
@@ -481,10 +481,8 @@ emitClosureAndInfoTable ::
emitClosureAndInfoTable cl_info conv args body
= do { info <- mkCmmInfo cl_info
; blks <- getCode body
- ; emitProcWithConvention conv info (infoLblToEntryLbl info_lbl) args blks
+ ; emitProcWithConvention conv info (entryLabelFromCI cl_info) args blks
}
- where
- info_lbl = infoTableLabelFromCI cl_info
-- Convert from 'ClosureInfo' to 'CmmInfoTable'.
-- Not used for return points. (The 'smRepClosureTypeInt' call would panic.)
@@ -496,7 +494,7 @@ mkCmmInfo cl_info
ad_lit <- mkStringCLit (closureValDescr cl_info)
return $ ProfilingInfo fd_lit ad_lit
else return $ ProfilingInfo (mkIntCLit 0) (mkIntCLit 0)
- ; return (CmmInfoTable (closureInfoLocal cl_info) (isStaticClosure cl_info) prof cl_type info) }
+ ; return (CmmInfoTable (infoTableLabelFromCI cl_info) (isStaticClosure cl_info) prof cl_type info) }
where
k_with_con_name con_info con info_lbl =
do cstr <- mkByteStringCLit $ dataConIdentity con
View Lorry Controller Status