summaryrefslogtreecommitdiff
path: root/compiler/cmm
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/cmm')
-rw-r--r--compiler/cmm/CmmInfo.hs25
-rw-r--r--compiler/cmm/CmmOpt.hs11
-rw-r--r--compiler/cmm/CmmParse.y7
-rw-r--r--compiler/cmm/CmmPipeline.hs3
4 files changed, 22 insertions, 24 deletions
diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index 7bdaf5aaca..29affaef0b 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -27,7 +27,6 @@ import Maybes
import Constants
import DynFlags
import Panic
-import StaticFlags
import UniqSupply
import MonadUtils
import Util
@@ -88,7 +87,7 @@ cmmToRawCmm dflags cmms
-- * The SRT slot is only there if there is SRT info to record
mkInfoTable :: DynFlags -> CmmDecl -> UniqSM [RawCmmDecl]
-mkInfoTable _ (CmmData sec dat)
+mkInfoTable _ (CmmData sec dat)
= return [CmmData sec dat]
mkInfoTable dflags proc@(CmmProc infos entry_lbl blocks)
@@ -96,7 +95,7 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl blocks)
-- in the non-tables-next-to-code case, procs can have at most a
-- single info table associated with the entry label of the proc.
--
- | not tablesNextToCode
+ | not (tablesNextToCode dflags)
= case topInfoTable proc of -- must be at most one
-- no info table
Nothing ->
@@ -106,8 +105,8 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl blocks)
(top_decls, (std_info, extra_bits)) <-
mkInfoTableContents dflags info Nothing
let
- rel_std_info = map (makeRelativeRefTo info_lbl) std_info
- rel_extra_bits = map (makeRelativeRefTo info_lbl) extra_bits
+ rel_std_info = map (makeRelativeRefTo dflags info_lbl) std_info
+ rel_extra_bits = map (makeRelativeRefTo dflags info_lbl) extra_bits
--
case blocks of
ListGraph [] ->
@@ -143,8 +142,8 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl blocks)
mkInfoTableContents dflags itbl Nothing
let
info_lbl = cit_lbl itbl
- rel_std_info = map (makeRelativeRefTo info_lbl) std_info
- rel_extra_bits = map (makeRelativeRefTo info_lbl) extra_bits
+ rel_std_info = map (makeRelativeRefTo dflags info_lbl) std_info
+ rel_extra_bits = map (makeRelativeRefTo dflags info_lbl) extra_bits
--
return (top_decls, (lbl, Statics info_lbl $ map CmmStaticLit $
reverse rel_extra_bits ++ rel_std_info))
@@ -267,15 +266,15 @@ mkSRTLit (C_SRT lbl off bitmap) = ([cmmLabelOffW lbl off], bitmap)
-- Note that this is done even when the -fPIC flag is not specified,
-- as we want to keep binary compatibility between PIC and non-PIC.
-makeRelativeRefTo :: CLabel -> CmmLit -> CmmLit
+makeRelativeRefTo :: DynFlags -> CLabel -> CmmLit -> CmmLit
-makeRelativeRefTo info_lbl (CmmLabel lbl)
- | tablesNextToCode
+makeRelativeRefTo dflags info_lbl (CmmLabel lbl)
+ | tablesNextToCode dflags
= CmmLabelDiffOff lbl info_lbl 0
-makeRelativeRefTo info_lbl (CmmLabelOff lbl off)
- | tablesNextToCode
+makeRelativeRefTo dflags info_lbl (CmmLabelOff lbl off)
+ | tablesNextToCode dflags
= CmmLabelDiffOff lbl info_lbl off
-makeRelativeRefTo _ lit = lit
+makeRelativeRefTo _ _ lit = lit
-------------------------------------------------------------------------
diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs
index 09cbf5045d..5f208244f8 100644
--- a/compiler/cmm/CmmOpt.hs
+++ b/compiler/cmm/CmmOpt.hs
@@ -21,7 +21,6 @@ import OldPprCmm
import CmmNode (wrapRecExp)
import CmmUtils
import DynFlags
-import StaticFlags
import CLabel
import UniqFM
@@ -672,10 +671,10 @@ exactLog2 x_
except factorial, but what the hell.
-}
-cmmLoopifyForC :: RawCmmDecl -> RawCmmDecl
+cmmLoopifyForC :: DynFlags -> RawCmmDecl -> RawCmmDecl
-- XXX: revisit if we actually want to do this
-- cmmLoopifyForC p@(CmmProc Nothing _ _) = p -- only if there's an info table, ignore case alts
-cmmLoopifyForC (CmmProc infos entry_lbl
+cmmLoopifyForC dflags (CmmProc infos entry_lbl
(ListGraph blocks@(BasicBlock top_id _ : _))) =
-- pprTrace "jump_lbl" (ppr jump_lbl <+> ppr entry_lbl) $
CmmProc infos entry_lbl (ListGraph blocks')
@@ -686,10 +685,10 @@ cmmLoopifyForC (CmmProc infos entry_lbl
= CmmBranch top_id
do_stmt stmt = stmt
- jump_lbl | tablesNextToCode = toInfoLbl entry_lbl
- | otherwise = entry_lbl
+ jump_lbl | tablesNextToCode dflags = toInfoLbl entry_lbl
+ | otherwise = entry_lbl
-cmmLoopifyForC top = top
+cmmLoopifyForC _ top = top
-- -----------------------------------------------------------------------------
-- Utils
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index f14aa9c987..cd8dc6c711 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -656,11 +656,11 @@ exprOp name args_code = do
exprMacros :: DynFlags -> UniqFM ([CmmExpr] -> CmmExpr)
exprMacros dflags = listToUFM [
- ( fsLit "ENTRY_CODE", \ [x] -> entryCode x ),
+ ( fsLit "ENTRY_CODE", \ [x] -> entryCode dflags x ),
( fsLit "INFO_PTR", \ [x] -> closureInfoPtr x ),
( fsLit "STD_INFO", \ [x] -> infoTable dflags x ),
( fsLit "FUN_INFO", \ [x] -> funInfoTable dflags x ),
- ( fsLit "GET_ENTRY", \ [x] -> entryCode (closureInfoPtr x) ),
+ ( fsLit "GET_ENTRY", \ [x] -> entryCode dflags (closureInfoPtr x) ),
( fsLit "GET_STD_INFO", \ [x] -> infoTable dflags (closureInfoPtr x) ),
( fsLit "GET_FUN_INFO", \ [x] -> funInfoTable dflags (closureInfoPtr x) ),
( fsLit "INFO_TYPE", \ [x] -> infoTableClosureType dflags x ),
@@ -932,13 +932,14 @@ doStore rep addr_code val_code
-- Return an unboxed tuple.
emitRetUT :: [(CgRep,CmmExpr)] -> Code
emitRetUT args = do
+ dflags <- getDynFlags
tickyUnboxedTupleReturn (length args) -- TICK
(sp, stmts, live) <- pushUnboxedTuple 0 args
emitSimultaneously stmts -- NB. the args might overlap with the stack slots
-- or regs that we assign to, so better use
-- simultaneous assignments here (#3546)
when (sp /= 0) $ stmtC (CmmAssign spReg (cmmRegOffW spReg (-sp)))
- stmtC $ CmmJump (entryCode (CmmLoad (cmmRegOffW spReg sp) bWord)) (Just live)
+ stmtC $ CmmJump (entryCode dflags (CmmLoad (cmmRegOffW spReg sp) bWord)) (Just live)
-- -----------------------------------------------------------------------------
-- If-then-else and boolean expressions
diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs
index f53135384c..e86374b264 100644
--- a/compiler/cmm/CmmPipeline.hs
+++ b/compiler/cmm/CmmPipeline.hs
@@ -25,7 +25,6 @@ import ErrUtils
import HscTypes
import Control.Monad
import Outputable
-import StaticFlags
-----------------------------------------------------------------------------
-- | Top level driver for C-- pipeline
@@ -161,7 +160,7 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
-- label to put on info tables for basic blocks that are not
-- the entry point.
splitting_proc_points = hscTarget dflags /= HscAsm
- || not tablesNextToCode
+ || not (tablesNextToCode dflags)
runUniqSM :: UniqSM a -> IO a
runUniqSM m = do
View Lorry Controller Status