Commit 24ffa317 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Merge branch 'master' of http://darcs.haskell.org/ghc

parents da651729 87baa31c
......@@ -62,9 +62,14 @@ dblatex.
$ perl boot
$ ./configure
$ make
$ make # can also say 'make -jX' for X number of jobs
$ make install
(NB: **Do you have multiple cores? Be sure to tell that to `make`!** This can
save you hours of build time depending on your system configuration, and is
almost always a win regardless of how many cores you have. As a simple rule,
you should have about N+1 jobs, where `N` is the amount of cores you have.)
The `perl boot` step is only necessary if this is a tree checked out
from git. For source distributions downloaded from [GHC's web site] [1],
this step has already been performed.
......
......@@ -201,7 +201,7 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS],
checkVendor() {
case [$]1 in
dec|unknown|hp|apple|next|sun|sgi|ibm|montavista)
dec|unknown|hp|apple|next|sun|sgi|ibm|montavista|portbld)
;;
*)
echo "Unknown vendor [$]1"
......@@ -863,7 +863,7 @@ AC_SUBST(HappyVersion)
dnl
dnl Check for Alex and version. If we're building GHC, then we need
dnl at least Alex version 2.0.1.
dnl at least Alex version 2.1.1.
dnl
AC_DEFUN([FPTOOLS_ALEX],
[
......@@ -879,12 +879,17 @@ else
fi;
changequote([, ])dnl
])
FP_COMPARE_VERSIONS([$fptools_cv_alex_version],[-ge],[3.0],
[Alex3=YES],[Alex3=NO])
if test ! -f compiler/cmm/CmmLex.hs || test ! -f compiler/parser/Lexer.hs
then
FP_COMPARE_VERSIONS([$fptools_cv_alex_version],[-lt],[2.1.0],
[AC_MSG_ERROR([Alex version 2.1.0 or later is required to compile GHC.])])[]
FP_COMPARE_VERSIONS([$fptools_cv_alex_version],[-ge],[3.0],
[Alex3=YES],[Alex3=NO])
fi
if test ! -f utils/haddock/src/Haddock/Lex.hs
then
FP_COMPARE_VERSIONS([$fptools_cv_alex_version],[-lt],[3.0],
[AC_MSG_ERROR([Alex version 3.0 or later is required to compile Haddock.])])[]
fi
AlexVersion=$fptools_cv_alex_version;
AC_SUBST(AlexVersion)
......@@ -998,6 +1003,38 @@ AC_SUBST([LdHasNoCompactUnwind])
])# FP_PROG_LD_NO_COMPACT_UNWIND
# FP_PROG_LD_FILELIST
# -------------------
# Sets the output variable LdHasFilelist to YES if ld supports
# -filelist, or NO otherwise.
AC_DEFUN([FP_PROG_LD_FILELIST],
[
AC_CACHE_CHECK([whether ld understands -filelist], [fp_cv_ld_has_filelist],
[
echo 'int foo() { return 0; }' > conftest1.c
echo 'int bar() { return 0; }' > conftest2.c
${CC-cc} -c conftest1.c
${CC-cc} -c conftest2.c
echo conftest1.o > conftest.o-files
echo conftest2.o >> conftest.o-files
if ${LdCmd} -r -filelist conftest.o-files -o conftest.o > /dev/null 2>&1
then
fp_cv_ld_has_filelist=yes
else
fp_cv_ld_has_filelist=no
fi
rm -rf conftest*
])
if test "$fp_cv_ld_has_filelist" = yes; then
LdHasFilelist=YES
else
LdHasFilelist=NO
fi
AC_SUBST([LdHasFilelist])
])# FP_PROG_LD_FILELIST
# FP_PROG_AR
# ----------
# Sets fp_prog_ar to a (non-Cygwin) path to ar. Exits if no ar can be found
......
......@@ -58,7 +58,7 @@ sub sanity_check_tree {
if (/^#/) {
# Comment; do nothing
}
elsif (/^([a-zA-Z0-9\/.-]+) +([^ ]+) +[^ ]+ +[^ ]+$/) {
elsif (/^([a-zA-Z0-9\/.-]+) +([^ ]+) +[^ ]+$/) {
$dir = $1;
$tag = $2;
......
......@@ -24,7 +24,6 @@ you will screw up the layout where they are used in case expressions!
/* Global variables may not work in other Haskell implementations,
* but we need them currently! so the conditional on GLASGOW won't do. */
#ifndef __HADDOCK__
#if defined(__GLASGOW_HASKELL__) || !defined(__GLASGOW_HASKELL__)
#define GLOBAL_VAR(name,value,ty) \
{-# NOINLINE name #-}; \
......@@ -36,15 +35,6 @@ name = Util.global (value);
name :: IORef (ty); \
name = Util.globalM (value);
#endif
#else /* __HADDOCK__ */
#define GLOBAL_VAR(name,value,ty) \
name :: IORef (ty); \
name = Util.global (value);
#define GLOBAL_VAR_M(name,value,ty) \
name :: IORef (ty); \
name = Util.globalM (value);
#endif
#define ASSERT(e) if debugIsOn && not (e) then (assertPanic __FILE__ __LINE__) else
#define ASSERT2(e,msg) if debugIsOn && not (e) then (assertPprPanic __FILE__ __LINE__ (msg)) else
......
......@@ -161,10 +161,6 @@ seqStrDmdList :: [StrDmd] -> ()
seqStrDmdList [] = ()
seqStrDmdList (d:ds) = seqStrDmd d `seq` seqStrDmdList ds
isStrict :: StrDmd -> Bool
isStrict Lazy = False
isStrict _ = True
-- Splitting polymorphic demands
splitStrProdDmd :: Int -> StrDmd -> [StrDmd]
splitStrProdDmd n Lazy = replicate n Lazy
......@@ -376,7 +372,11 @@ seqDemandList [] = ()
seqDemandList (d:ds) = seqDemand d `seq` seqDemandList ds
isStrictDmd :: Demand -> Bool
isStrictDmd (JD {strd = x}) = isStrict x
-- See Note [Strict demands]
isStrictDmd (JD {absd = Abs}) = False
isStrictDmd (JD {strd = Lazy}) = False
isStrictDmd _ = True
isUsedDmd :: Demand -> Bool
isUsedDmd (JD {absd = x}) = isUsed x
......@@ -400,6 +400,25 @@ defer (JD {absd = a}) = mkJointDmd strTop a
-- use (JD {strd = d}) = mkJointDmd d top
\end{code}
Note [Strict demands]
~~~~~~~~~~~~~~~~~~~~~
isStrictDmd returns true only of demands that are
both strict
and used
In particular, it is False for <HyperStr, Abs>, which can and does
arise in, say (Trac #7319)
f x = raise# <some exception>
Then 'x' is not used, so f gets strictness <HyperStr,Abs> -> .
Now the w/w generates
fx = let x <HyperStr,Abs> = absentError "unused"
in raise <some exception>
At this point we really don't want to convert to
fx = case absentError "unused" of x -> raise <some exception>
Since the program is going to diverge, this swaps one error for another,
but it's really a bad idea to *ever* evaluate an absent argument.
In Trac #7319 we get
T7319.exe: Oops! Entered absent arg w_s1Hd{v} [lid] [base:GHC.Base.String{tc 36u}]
Note [Dealing with call demands]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Call demands are constructed and deconstructed coherently for
......
--
-- (c) The University of Glasgow 2003-2006
--
--
-- Functions for constructing bitmaps, which are used in various
-- places in generated code (stack frame liveness masks, function
-- argument liveness masks, SRT bitmaps).
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details
module Bitmap (
Bitmap, mkBitmap,
intsToBitmap, intsToReverseBitmap,
mAX_SMALL_BITMAP_SIZE,
seqBitmap,
module Bitmap (
Bitmap, mkBitmap,
intsToBitmap, intsToReverseBitmap,
mAX_SMALL_BITMAP_SIZE,
seqBitmap,
) where
#include "HsVersions.h"
......@@ -53,8 +46,8 @@ chunkToBitmap dflags chunk =
intsToBitmap :: DynFlags -> Int -> [Int] -> Bitmap
intsToBitmap dflags size slots{- must be sorted -}
| size <= 0 = []
| otherwise =
(foldr (.|.) (toStgWord dflags 0) (map (toStgWord dflags 1 `shiftL`) these)) :
| otherwise =
(foldr (.|.) (toStgWord dflags 0) (map (toStgWord dflags 1 `shiftL`) these)) :
intsToBitmap dflags (size - wORD_SIZE_IN_BITS dflags)
(map (\x -> x - wORD_SIZE_IN_BITS dflags) rest)
where (these,rest) = span (< wORD_SIZE_IN_BITS dflags) slots
......@@ -67,7 +60,7 @@ intsToBitmap dflags size slots{- must be sorted -}
intsToReverseBitmap :: DynFlags -> Int -> [Int] -> Bitmap
intsToReverseBitmap dflags size slots{- must be sorted -}
| size <= 0 = []
| otherwise =
| otherwise =
(foldr xor (toStgWord dflags init) (map (toStgWord dflags 1 `shiftL`) these)) :
intsToReverseBitmap dflags (size - wORD_SIZE_IN_BITS dflags)
(map (\x -> x - wORD_SIZE_IN_BITS dflags) rest)
......
......@@ -61,7 +61,7 @@ module CLabel (
mkCAFBlackHoleInfoTableLabel,
mkCAFBlackHoleEntryLabel,
mkRtsPrimOpLabel,
mkRtsSlowTickyCtrLabel,
mkRtsSlowFastTickyCtrLabel,
mkSelectorInfoLabel,
mkSelectorEntryLabel,
......@@ -99,7 +99,7 @@ module CLabel (
isCFunctionLabel, isGcPtrLabel, labelDynamic,
-- * Conversions
toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, toRednCountsLbl,
toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, toRednCountsLbl, hasHaskellName,
pprCLabel
) where
......@@ -313,7 +313,7 @@ data RtsLabelInfo
| RtsPrimOp PrimOp
| RtsApFast FastString -- ^ _fast versions of generic apply
| RtsSlowTickyCtr String
| RtsSlowFastTickyCtr String
deriving (Eq, Ord)
-- NOTE: Eq on LitString compares the pointer only, so this isn't
......@@ -356,9 +356,10 @@ mkTopSRTLabel :: Unique -> CLabel
mkTopSRTLabel u = SRTLabel u
mkSRTLabel :: Name -> CafInfo -> CLabel
mkRednCountsLabel :: Name -> CafInfo -> CLabel
mkRednCountsLabel :: Name -> CLabel
mkSRTLabel name c = IdLabel name c SRT
mkRednCountsLabel name c = IdLabel name c RednCounts
mkRednCountsLabel name =
IdLabel name NoCafRefs RednCounts -- Note [ticky for LNE]
-- These have local & (possibly) external variants:
mkLocalClosureLabel :: Name -> CafInfo -> CLabel
......@@ -503,8 +504,8 @@ mkCCSLabel ccs = CCS_Label ccs
mkRtsApFastLabel :: FastString -> CLabel
mkRtsApFastLabel str = RtsLabel (RtsApFast str)
mkRtsSlowTickyCtrLabel :: String -> CLabel
mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
mkRtsSlowFastTickyCtrLabel :: String -> CLabel
mkRtsSlowFastTickyCtrLabel pat = RtsLabel (RtsSlowFastTickyCtr pat)
-- Constructing Code Coverage Labels
......@@ -549,10 +550,6 @@ toSlowEntryLbl :: CLabel -> CLabel
toSlowEntryLbl (IdLabel n c _) = IdLabel n c Slow
toSlowEntryLbl l = pprPanic "toSlowEntryLbl" (ppr l)
toRednCountsLbl :: CLabel -> CLabel
toRednCountsLbl (IdLabel n c _) = IdLabel n c RednCounts
toRednCountsLbl l = pprPanic "toRednCountsLbl" (ppr l)
toEntryLbl :: CLabel -> CLabel
toEntryLbl (IdLabel n c LocalInfoTable) = IdLabel n c LocalEntry
toEntryLbl (IdLabel n c ConInfoTable) = IdLabel n c ConEntry
......@@ -574,12 +571,38 @@ toInfoLbl (CmmLabel m str CmmEntry) = CmmLabel m str CmmInfo
toInfoLbl (CmmLabel m str CmmRet) = CmmLabel m str CmmRetInfo
toInfoLbl l = pprPanic "CLabel.toInfoLbl" (ppr l)
toRednCountsLbl :: CLabel -> Maybe CLabel
toRednCountsLbl = fmap mkRednCountsLabel . hasHaskellName
hasHaskellName :: CLabel -> Maybe Name
hasHaskellName (IdLabel n _ _) = Just n
hasHaskellName _ = Nothing
-- -----------------------------------------------------------------------------
-- Does a CLabel refer to a CAF?
-- Does a CLabel's referent itself refer to a CAF?
hasCAF :: CLabel -> Bool
hasCAF (IdLabel _ _ RednCounts) = False -- Note [ticky for LNE]
hasCAF (IdLabel _ MayHaveCafRefs _) = True
hasCAF _ = False
-- Note [ticky for LNE]
-- ~~~~~~~~~~~~~~~~~~~~~
-- Until 14 Feb 2013, every ticky counter was associated with a
-- closure. Thus, ticky labels used IdLabel. It is odd that
-- CmmBuildInfoTables.cafTransfers would consider such a ticky label
-- reason to add the name to the CAFEnv (and thus eventually the SRT),
-- but it was harmless because the ticky was only used if the closure
-- was also.
--
-- Since we now have ticky counters for LNEs, it is no longer the case
-- that every ticky counter has an actual closure. So I changed the
-- generation of ticky counters' CLabels to not result in their
-- associated id ending up in the SRT.
--
-- NB IdLabel is still appropriate for ticky ids (as opposed to
-- CmmLabel) because the LNE's counter is still related to an .hs Id,
-- that Id just isn't for a proper closure.
-- -----------------------------------------------------------------------------
-- Does a CLabel need declaring before use or not?
......@@ -1051,8 +1074,8 @@ pprCLbl (CmmLabel _ fs CmmClosure)
pprCLbl (RtsLabel (RtsPrimOp primop))
= ptext (sLit "stg_") <> ppr primop
pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
= ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
pprCLbl (RtsLabel (RtsSlowFastTickyCtr pat))
= ptext (sLit "SLOW_CALL_fast_") <> text pat <> ptext (sLit "_ctr")
pprCLbl (ForeignLabel str _ _ _)
= ftext str
......
-- Cmm representations using Hoopl's Graph CmmNode e x.
{-# LANGUAGE GADTs #-}
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
module Cmm (
-- * Cmm top-level datatypes
......
{-# LANGUAGE GADTs, NoMonoLocalBinds #-}
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details
-- Norman likes local bindings
-- If this module lives on I'd like to get rid of the NoMonoLocalBinds
......@@ -164,7 +158,7 @@ srtToData srt = [CmmData RelocatableReadOnlyData (Statics (lbl srt) tbl)]
-- 1. Build a table of all the CAFs used in the procedure.
-- 2. Compute the C_SRT describing the subset of CAFs live at each procpoint.
--
-- When building the local view of the SRT, we first make sure that all the CAFs are
-- When building the local view of the SRT, we first make sure that all the CAFs are
-- in the SRT. Then, if the number of CAFs is small enough to fit in a bitmap,
-- we make sure they're all close enough to the bottom of the table that the
-- bitmap will be able to cover all of them.
......@@ -240,7 +234,7 @@ to_SRT dflags top_srt off len bmp
return (Just tbl, C_SRT srt_desc_lbl 0 (srtEscape dflags))
| otherwise
= return (Nothing, C_SRT top_srt off (toStgHalfWord dflags (fromStgWord (head bmp))))
-- The fromIntegral converts to StgHalfWord
-- The fromIntegral converts to StgHalfWord
-- Gather CAF info for a procedure, but only if the procedure
-- doesn't have a static closure.
......
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details
module CmmCallConv (
ParamLocation(..),
......@@ -93,7 +87,7 @@ assignArgumentsPos dflags off conv arg_ty reps = (stk_off, assignments)
ty = arg_ty r
w = typeWidth ty
gcp | isGcPtrType ty = VGcPtr
| otherwise = VNonGcPtr
| otherwise = VNonGcPtr
hasSseRegs = mAX_Real_SSE_REG dflags /= 0
......@@ -133,7 +127,7 @@ getRegsWithoutNode dflags =
( filter (\r -> r VGcPtr /= node) (realVanillaRegs dflags)
, realFloatRegs dflags
, realDoubleRegs dflags
, realLongRegs dflags
, realLongRegs dflags
, sseRegNos dflags)
-- getRegsWithNode uses R1/node even if it isn't a register
......
{-# LANGUAGE GADTs #-}
-- ToDo: remove -fno-warn-warnings-deprecations
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
-- ToDo: remove -fno-warn-incomplete-patterns
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
module CmmCommonBlockElim
( elimCommonBlocks
)
......
{-# LANGUAGE GADTs #-}
{-# OPTIONS_GHC -fno-warn-warnings-deprecations -fno-warn-incomplete-patterns #-}
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
module CmmContFlowOpt
( cmmCfgOpts
, cmmCfgOptsProc
......
-- CmmNode type for representation using Hoopl graphs.
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details
module CmmNode (
CmmNode(..), CmmFormal, CmmActual,
UpdFrameOffset, Convention(..),
......@@ -49,19 +43,20 @@ data CmmNode e x where
-- Assign to memory location. Size is
-- given by cmmExprType of the rhs.
CmmUnsafeForeignCall :: -- An unsafe foreign call;
-- see Note [Foreign calls]
-- Like a "fat machine instruction"; can occur
-- in the middle of a block
ForeignTarget -> -- call target
[CmmFormal] -> -- zero or more results
[CmmActual] -> -- zero or more arguments
CmmUnsafeForeignCall :: -- An unsafe foreign call;
-- see Note [Foreign calls]
-- Like a "fat machine instruction"; can occur
-- in the middle of a block
ForeignTarget -> -- call target
[CmmFormal] -> -- zero or more results
[CmmActual] -> -- zero or more arguments
CmmNode O O
-- Semantics: clobbers any GlobalRegs for which callerSaves r == True
-- See Note [foreign calls clobber GlobalRegs]
--
-- Also, there is a current bug for what can be put in
-- arguments, see Note [Register Parameter Passing]
-- Invariant: the arguments and the ForeignTarget must not
-- mention any registers for which CodeGen.Platform.callerSaves
-- is True. See Note [Register Parameter Passing].
CmmBranch :: ULabel -> CmmNode O C
-- Goto another block in the same procedure
......@@ -122,7 +117,7 @@ data CmmNode e x where
} -> CmmNode O C
CmmForeignCall :: { -- A safe foreign call; see Note [Foreign calls]
-- Always the last node of a block
-- Always the last node of a block
tgt :: ForeignTarget, -- call target and convention
res :: [CmmFormal], -- zero or more results
args :: [CmmActual], -- zero or more arguments; see Note [Register parameter passing]
......@@ -141,14 +136,14 @@ instruction". In particular, they do *not* kill all live registers,
just the registers they return to (there was a bit of code in GHC that
conservatively assumed otherwise.) However, see [Register parameter passing].
Safe ones are trickier. A safe foreign call
Safe ones are trickier. A safe foreign call
r = f(x)
ultimately expands to
push "return address" -- Never used to return to;
-- just points an info table
push "return address" -- Never used to return to;
-- just points an info table
save registers into TSO
call suspendThread
r = f(x) -- Make the call
r = f(x) -- Make the call
call resumeThread
restore registers
pop "return address"
......@@ -198,20 +193,8 @@ way is done in cmm/CmmOpt.hs currently. We should fix this!
---------------------------------------------
-- Eq instance of CmmNode
-- It is a shame GHC cannot infer it by itself :(
instance Eq (CmmNode e x) where
(CmmEntry a) == (CmmEntry a') = a==a'
(CmmComment a) == (CmmComment a') = a==a'
(CmmAssign a b) == (CmmAssign a' b') = a==a' && b==b'
(CmmStore a b) == (CmmStore a' b') = a==a' && b==b'
(CmmUnsafeForeignCall a b c) == (CmmUnsafeForeignCall a' b' c') = a==a' && b==b' && c==c'
(CmmBranch a) == (CmmBranch a') = a==a'
(CmmCondBranch a b c) == (CmmCondBranch a' b' c') = a==a' && b==b' && c==c'
(CmmSwitch a b) == (CmmSwitch a' b') = a==a' && b==b'
(CmmCall a b c d e f) == (CmmCall a' b' c' d' e' f') = a==a' && b==b' && c==c' && d==d' && e==e' && f==f'
(CmmForeignCall a b c d e f) == (CmmForeignCall a' b' c' d' e' f') = a==a' && b==b' && c==c' && d==d' && e==e' && f==f'
_ == _ = False
deriving instance Eq (CmmNode e x)
----------------------------------------------
-- Hoopl instances of CmmNode
......@@ -364,7 +347,7 @@ instance DefinerOfRegs GlobalReg (CmmNode e x) where
-----------------------------------
-- mapping Expr in CmmNode
mapForeignTarget :: (CmmExpr -> CmmExpr) -> ForeignTarget -> ForeignTarget
mapForeignTarget :: (CmmExpr -> CmmExpr) -> ForeignTarget -> ForeignTarget
mapForeignTarget exp (ForeignTarget e c) = ForeignTarget (exp e) c
mapForeignTarget _ m@(PrimTarget _) = m
......@@ -440,7 +423,7 @@ mapExpDeepM f = mapExpM $ wrapRecExpM f
-----------------------------------
-- folding Expr in CmmNode
foldExpForeignTarget :: (CmmExpr -> z -> z) -> ForeignTarget -> z -> z
foldExpForeignTarget :: (CmmExpr -> z -> z) -> ForeignTarget -> z -> z
foldExpForeignTarget exp (ForeignTarget e _) z = exp e z
foldExpForeignTarget _ (PrimTarget _) z = z
......
......@@ -62,7 +62,7 @@ cpsTop hsc_env proc =
--
CmmProc h l v g <- {-# SCC "cmmCfgOpts(1)" #-}
return $ cmmCfgOptsProc splitting_proc_points proc
dump Opt_D_dump_cmm_cfg "Post control-flow optimsations" g
dump Opt_D_dump_cmm_cfg "Post control-flow optimisations" g
let !TopInfo {stack_info=StackInfo { arg_space = entry_off
, do_layout = do_layout }} = h
......@@ -135,7 +135,7 @@ cpsTop hsc_env proc =
else gs
gs <- return (map removeUnreachableBlocksProc gs)
-- Note [unreachable blocks]
dumps Opt_D_dump_cmm_cfg "Post control-flow optimsations" gs
dumps Opt_D_dump_cmm_cfg "Post control-flow optimisations" gs
return (cafEnv, gs)
......@@ -155,7 +155,7 @@ cpsTop hsc_env proc =
else g
g <- return (removeUnreachableBlocksProc g)
-- Note [unreachable blocks]
dump' Opt_D_dump_cmm_cfg "Post control-flow optimsations" g
dump' Opt_D_dump_cmm_cfg "Post control-flow optimisations" g
return (cafEnv, [g])
......@@ -184,11 +184,11 @@ cpsTop hsc_env proc =
|| not (tablesNextToCode dflags)
|| -- Note [inconsistent-pic-reg]
usingInconsistentPicReg
usingInconsistentPicReg = ( platformArch platform == ArchX86 ||
platformArch platform == ArchPPC
)
&& platformOS platform == OSDarwin
&& gopt Opt_PIC dflags
usingInconsistentPicReg
= case (platformArch platform, platformOS platform, gopt Opt_PIC dflags)
of (ArchX86, OSDarwin, pic) -> pic
(ArchPPC, OSDarwin, pic) -> pic
_ -> False
{- Note [inconsistent-pic-reg]
......
{-# LANGUAGE GADTs, DisambiguateRecordFields #-}
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
module CmmProcPoint
( ProcPointSet, Status(..)
......
......@@ -4,9 +4,6 @@
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
-- TODO: Get rid of this flag:
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
-- This module implements generalized code motion for assignments to
-- local registers, inlining and sinking when possible. It also does
-- some amount of rewriting for stores to register slots, which are
......
......@@ -15,6 +15,7 @@ module CmmType
, rEP_CostCentreStack_mem_alloc
, rEP_CostCentreStack_scc_count
, rEP_StgEntCounter_allocs
, rEP_StgEntCounter_allocd
, ForeignHint(..)
......@@ -337,6 +338,11 @@ rEP_StgEntCounter_allocs dflags
= cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocs pc))
where pc = sPlatformConstants (settings dflags)
rEP_StgEntCounter_allocd :: DynFlags -> CmmType
rEP_StgEntCounter_allocd dflags
= cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocd pc))
where pc = sPlatformConstants (settings dflags)
-------------------------------------------------------------------------
{- Note [Signed vs unsigned]
~~~~~~~~~~~~~~~~~~~~~~~~~
......
<
{-# LANGUAGE GADTs #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-}
-- Warnings from deprecated blockToNodeList
-----------------------------------------------------------------------------
--
-- Cmm utilities.
......@@ -42,8 +38,8 @@ module CmmUtils(
blankWord,
-- Tagging
cmmTagMask, cmmPointerMask, cmmUntag, cmmGetTag, cmmIsTagged,