Commit 83030e70 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

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

parents 56a05294 d95a7f13
This diff is collapsed.
......@@ -7,25 +7,19 @@ The Code Generator
This module says how things get going at the top level.
@codeGen@ is the interface to the outside world. The \tr{cgTop*}
@codeGen@ is the interface to the outside world. The \tr{cgTop*}
functions drive the mangling of top-level bindings.
\begin{code}
{-# 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 CodeGen ( codeGen ) where
#include "HsVersions.h"
-- Kludge (??) so that CgExpr is reached via at least one non-SOURCE
-- import. Before, that wasn't the case, and CM therefore didn't
-- Required so that CgExpr is reached via at least one non-SOURCE
-- import. Before, that wasn't the case, and CM therefore didn't
-- bother to compile it.
import CgExpr ( {-NOTHING!-} ) -- DO NOT DELETE THIS IMPORT
import CgExpr ( {-NOTHING!-} ) -- DO NOT DELETE THIS IMPORT
import CgProf
import CgMonad
import CgBindery
......@@ -51,39 +45,30 @@ import TyCon
import Module
import ErrUtils
import Panic
\end{code}
\begin{code}
codeGen :: DynFlags
-> Module
-> [TyCon]
-> CollectedCCs -- (Local/global) cost-centres needing declaring/registering.
-> [(StgBinding,[(Id,[Id])])] -- Bindings to convert, with SRTs
-> HpcInfo
-> IO [CmmGroup] -- Output
-- N.B. returning '[Cmm]' and not 'Cmm' here makes it
-- possible for object splitting to split up the
-- pieces later.
codeGen dflags this_mod data_tycons cost_centre_info stg_binds hpc_info
= do
{ showPass dflags "CodeGen"
-- Why?
-- ; mapM_ (\x -> seq x (return ())) data_tycons
; code_stuff <- initC dflags this_mod $ do
{ cmm_binds <- mapM (getCmm . cgTopBinding dflags) stg_binds
; cmm_tycons <- mapM cgTyCon data_tycons
; cmm_init <- getCmm (mkModuleInit dflags cost_centre_info
this_mod hpc_info)
; return (cmm_init : cmm_binds ++ cmm_tycons)
}
-- Put datatype_stuff after code_stuff, because the
-- datatype closure table (for enumeration types) to
-- (say) PrelBase_True_closure, which is defined in
-- code_stuff
-> Module -- Module we are compiling
-> [TyCon] -- Type constructors
-> CollectedCCs -- (Local/global) cost-centres needing declaring/registering.
-> [(StgBinding,[(Id,[Id])])] -- Bindings to convert, with SRTs
-> HpcInfo -- Profiling info
-> IO [CmmGroup]
-- N.B. returning '[Cmm]' and not 'Cmm' here makes it
-- possible for object splitting to split up the
-- pieces later.
codeGen dflags this_mod data_tycons cost_centre_info stg_binds hpc_info = do
showPass dflags "CodeGen"
code_stuff <-
initC dflags this_mod $ do
cmm_binds <- mapM (getCmm . cgTopBinding dflags) stg_binds
cmm_tycons <- mapM cgTyCon data_tycons
cmm_init <- getCmm (mkModuleInit dflags cost_centre_info this_mod hpc_info)
return (cmm_init : cmm_binds ++ cmm_tycons)
-- Put datatype_stuff after code_stuff, because the
-- datatype closure table (for enumeration types) to
-- (say) PrelBase_True_closure, which is defined in
-- code_stuff
-- Note [codegen-split-init] the cmm_init block must
-- come FIRST. This is because when -split-objs is on
......@@ -91,24 +76,23 @@ codeGen dflags this_mod data_tycons cost_centre_info stg_binds hpc_info
-- initialisation routines; see Note
-- [pipeline-split-init].
; dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (pprCmms (targetPlatform dflags) code_stuff)
; return code_stuff }
dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (pprCmms (targetPlatform dflags) code_stuff)
return code_stuff
mkModuleInit
:: DynFlags
-> CollectedCCs -- cost centre info
-> Module
-> CollectedCCs -- cost centre info
-> Module
-> HpcInfo
-> Code
-> Code
mkModuleInit dflags cost_centre_info this_mod hpc_info
= do { -- Allocate the static boolean that records if this
= do { -- Allocate the static boolean that records if this
; whenC (opt_Hpc) $
hpcTable this_mod hpc_info
; whenC (opt_SccProfilingOn) $ do
initCostCentres cost_centre_info
; whenC (opt_SccProfilingOn) $ do
initCostCentres cost_centre_info
-- For backwards compatibility: user code may refer to this
-- label for calling hs_add_root().
......@@ -133,15 +117,15 @@ initCostCentres :: CollectedCCs -> Code
initCostCentres (local_CCs, ___extern_CCs, singleton_CCSs)
| not opt_SccProfilingOn = nopC
| otherwise
= do { mapM_ emitCostCentreDecl local_CCs
; mapM_ emitCostCentreStackDecl singleton_CCSs
= do { mapM_ emitCostCentreDecl local_CCs
; mapM_ emitCostCentreStackDecl singleton_CCSs
}
\end{code}
%************************************************************************
%* *
%* *
\subsection[codegen-top-bindings]{Converting top-level STG bindings}
%* *
%* *
%************************************************************************
@cgTopBinding@ is only used for top-level bindings, since they need
......@@ -157,45 +141,45 @@ variable.
\begin{code}
cgTopBinding :: DynFlags -> (StgBinding,[(Id,[Id])]) -> Code
cgTopBinding dflags (StgNonRec id rhs, srts)
= do { id' <- maybeExternaliseId dflags id
; mapM_ (mkSRT [id']) srts
; (id,info) <- cgTopRhs id' rhs
; addBindC id info -- Add the *un-externalised* Id to the envt,
-- so we find it when we look up occurrences
}
= do { id' <- maybeExternaliseId dflags id
; mapM_ (mkSRT [id']) srts
; (id,info) <- cgTopRhs id' rhs
; addBindC id info -- Add the *un-externalised* Id to the envt,
-- so we find it when we look up occurrences
}
cgTopBinding dflags (StgRec pairs, srts)
= do { let (bndrs, rhss) = unzip pairs
; bndrs' <- mapFCs (maybeExternaliseId dflags) bndrs
; let pairs' = zip bndrs' rhss
; mapM_ (mkSRT bndrs') srts
; _new_binds <- fixC (\ new_binds -> do
{ addBindsC new_binds
; mapFCs ( \ (b,e) -> cgTopRhs b e ) pairs' })
; nopC }
= do { let (bndrs, rhss) = unzip pairs
; bndrs' <- mapFCs (maybeExternaliseId dflags) bndrs
; let pairs' = zip bndrs' rhss
; mapM_ (mkSRT bndrs') srts
; _new_binds <- fixC (\ new_binds -> do
{ addBindsC new_binds
; mapFCs ( \ (b,e) -> cgTopRhs b e ) pairs' })
; nopC }
mkSRT :: [Id] -> (Id,[Id]) -> Code
mkSRT _ (_,[]) = nopC
mkSRT these (id,ids)
= do { ids <- mapFCs remap ids
; id <- remap id
; emitRODataLits "CodeGen.mkSRT" (mkSRTLabel (idName id) (idCafInfo id))
(map (\id -> CmmLabel $ mkClosureLabel (idName id) (idCafInfo id)) ids)
}
= do { ids <- mapFCs remap ids
; id <- remap id
; emitRODataLits "CodeGen.mkSRT" (mkSRTLabel (idName id) (idCafInfo id))
(map (\id -> CmmLabel $ mkClosureLabel (idName id) (idCafInfo id)) ids)
}
where
-- Sigh, better map all the ids against the environment in
-- case they've been externalised (see maybeExternaliseId below).
-- Sigh, better map all the ids against the environment in
-- case they've been externalised (see maybeExternaliseId below).
remap id = case filter (==id) these of
(id':_) -> returnFC id'
[] -> do { info <- getCgIdInfo id; return (cgIdInfoId info) }
(id':_) -> returnFC id'
[] -> do { info <- getCgIdInfo id; return (cgIdInfoId info) }
-- Urgh! I tried moving the forkStatics call from the rhss of cgTopRhs
-- to enclose the listFCs in cgTopBinding, but that tickled the
-- statics "error" call in initC. I DON'T UNDERSTAND WHY!
cgTopRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo)
-- The Id is passed along for setting up a binding...
-- It's already been externalised if necessary
-- The Id is passed along for setting up a binding...
-- It's already been externalised if necessary
cgTopRhs bndr (StgRhsCon _cc con args)
= forkStatics (cgTopRhsCon bndr con args)
......@@ -209,9 +193,9 @@ cgTopRhs bndr (StgRhsClosure cc bi fvs upd_flag srt args body)
%************************************************************************
%* *
%* *
\subsection{Stuff to support splitting}
%* *
%* *
%************************************************************************
If we're splitting the object, we need to externalise all the top-level names
......@@ -221,18 +205,18 @@ which refers to this name).
\begin{code}
maybeExternaliseId :: DynFlags -> Id -> FCode Id
maybeExternaliseId dflags id
| dopt Opt_SplitObjs dflags, -- Externalise the name for -split-objs
| dopt Opt_SplitObjs dflags, -- Externalise the name for -split-objs
isInternalName name = do { mod <- getModuleName
; returnFC (setIdName id (externalise mod)) }
| otherwise = returnFC id
; returnFC (setIdName id (externalise mod)) }
| otherwise = returnFC id
where
externalise mod = mkExternalName uniq mod new_occ loc
name = idName id
uniq = nameUnique name
new_occ = mkLocalOcc uniq (nameOccName name)
loc = nameSrcSpan name
-- We want to conjure up a name that can't clash with any
-- existing name. So we generate
-- Mod_$L243foo
-- where 243 is the unique.
-- We want to conjure up a name that can't clash with any
-- existing name. So we generate
-- Mod_$L243foo
-- where 243 is the unique.
\end{code}
......@@ -444,7 +444,6 @@ Library
GraphOps
GraphPpr
IOEnv
Interval
ListSetOps
Maybes
MonadUtils
......
......@@ -505,11 +505,13 @@ tidyVectInfo (_, var_env) info@(VectInfo { vectInfoVar = vars
, vectInfoScalarVars = tidy_scalarVars
}
where
-- we only export mappings whose co-domain is exported (otherwise, the iface is inconsistent)
-- we only export mappings whose domain and co-domain is exported (otherwise, the iface is
-- inconsistent)
tidy_vars = mkVarEnv [ (tidy_var, (tidy_var, tidy_var_v))
| (var, var_v) <- varEnvElts vars
, let tidy_var = lookup_var var
tidy_var_v = lookup_var var_v
, isExportedId tidy_var
, isExportedId tidy_var_v
]
......
......@@ -305,10 +305,10 @@ cmmNativeGens dflags ncgImpl h us (cmm : cmms) impAcc profAcc count
let platform = targetPlatform dflags
(us', native, imports, colorStats, linearStats)
<- cmmNativeGen dflags ncgImpl us cmm count
<- {-# SCC "cmmNativeGen" #-} cmmNativeGen dflags ncgImpl us cmm count
Pretty.bufLeftRender h
$ {-# SCC "pprNativeCode" #-} Pretty.vcat $ map (pprNatCmmDecl ncgImpl platform) native
{-# SCC "pprNativeCode" #-} Pretty.bufLeftRender h
$ Pretty.vcat $ map (pprNatCmmDecl ncgImpl platform) native
-- carefully evaluate this strictly. Binding it with 'let'
-- and then using 'seq' doesn't work, because the let
......@@ -322,7 +322,7 @@ cmmNativeGens dflags ncgImpl h us (cmm : cmms) impAcc profAcc count
count' <- return $! count + 1;
-- force evaulation all this stuff to avoid space leaks
seqString (showSDoc $ vcat $ map (pprPlatform platform) imports) `seq` return ()
{-# SCC "seqString" #-} seqString (showSDoc $ vcat $ map (pprPlatform platform) imports) `seq` return ()
cmmNativeGens dflags ncgImpl
h us' cmms
......
......@@ -912,7 +912,7 @@ liveness1 liveregs blockmap (LiveInstr instr _)
, liveDieWrite = mkUniqSet w_dying }))
where
RU read written = regUsageOfInstr instr
!(RU read written) = regUsageOfInstr instr
-- registers that were written here are dead going backwards.
-- registers that were read here are live going backwards.
......
......@@ -330,10 +330,10 @@ x86_regUsageOfInstr instr
ADC _ src dst -> usageRM src dst
SUB _ src dst -> usageRM src dst
IMUL _ src dst -> usageRM src dst
IMUL2 _ src -> mkRU (eax:use_R src) [eax,edx]
IMUL2 _ src -> mkRU (eax:use_R src []) [eax,edx]
MUL _ src dst -> usageRM src dst
DIV _ op -> mkRU (eax:edx:use_R op) [eax,edx]
IDIV _ op -> mkRU (eax:edx:use_R op) [eax,edx]
DIV _ op -> mkRU (eax:edx:use_R op []) [eax,edx]
IDIV _ op -> mkRU (eax:edx:use_R op []) [eax,edx]
AND _ src dst -> usageRM src dst
OR _ src dst -> usageRM src dst
......@@ -346,25 +346,25 @@ x86_regUsageOfInstr instr
SHL _ imm dst -> usageRM imm dst
SAR _ imm dst -> usageRM imm dst
SHR _ imm dst -> usageRM imm dst
BT _ _ src -> mkRUR (use_R src)
BT _ _ src -> mkRUR (use_R src [])
PUSH _ op -> mkRUR (use_R op)
PUSH _ op -> mkRUR (use_R op [])
POP _ op -> mkRU [] (def_W op)
TEST _ src dst -> mkRUR (use_R src ++ use_R dst)
CMP _ src dst -> mkRUR (use_R src ++ use_R dst)
TEST _ src dst -> mkRUR (use_R src $! use_R dst [])
CMP _ src dst -> mkRUR (use_R src $! use_R dst [])
SETCC _ op -> mkRU [] (def_W op)
JXX _ _ -> mkRU [] []
JXX_GBL _ _ -> mkRU [] []
JMP op -> mkRUR (use_R op)
JMP_TBL op _ _ _ -> mkRUR (use_R op)
JMP op -> mkRUR (use_R op [])
JMP_TBL op _ _ _ -> mkRUR (use_R op [])
CALL (Left _) params -> mkRU params callClobberedRegs
CALL (Right reg) params -> mkRU (reg:params) callClobberedRegs
CLTD _ -> mkRU [eax] [edx]
NOP -> mkRU [] []
GMOV src dst -> mkRU [src] [dst]
GLD _ src dst -> mkRU (use_EA src) [dst]
GST _ src dst -> mkRUR (src : use_EA dst)
GLD _ src dst -> mkRU (use_EA src []) [dst]
GST _ src dst -> mkRUR (src : use_EA dst [])
GLDZ dst -> mkRU [] [dst]
GLD1 dst -> mkRU [] [dst]
......@@ -392,10 +392,10 @@ x86_regUsageOfInstr instr
CVTSS2SD src dst -> mkRU [src] [dst]
CVTSD2SS src dst -> mkRU [src] [dst]
CVTTSS2SIQ _ src dst -> mkRU (use_R src) [dst]
CVTTSD2SIQ _ src dst -> mkRU (use_R src) [dst]
CVTSI2SS _ src dst -> mkRU (use_R src) [dst]
CVTSI2SD _ src dst -> mkRU (use_R src) [dst]
CVTTSS2SIQ _ src dst -> mkRU (use_R src []) [dst]
CVTTSD2SIQ _ src dst -> mkRU (use_R src []) [dst]
CVTSI2SS _ src dst -> mkRU (use_R src []) [dst]
CVTSI2SD _ src dst -> mkRU (use_R src []) [dst]
FDIV _ src dst -> usageRM src dst
FETCHGOT reg -> mkRU [] [reg]
......@@ -404,27 +404,27 @@ x86_regUsageOfInstr instr
COMMENT _ -> noUsage
DELTA _ -> noUsage
POPCNT _ src dst -> mkRU (use_R src) [dst]
POPCNT _ src dst -> mkRU (use_R src []) [dst]
_other -> panic "regUsage: unrecognised instr"
where
-- 2 operand form; first operand Read; second Written
usageRW :: Operand -> Operand -> RegUsage
usageRW op (OpReg reg) = mkRU (use_R op) [reg]
usageRW op (OpAddr ea) = mkRUR (use_R op ++ use_EA ea)
usageRW op (OpReg reg) = mkRU (use_R op []) [reg]
usageRW op (OpAddr ea) = mkRUR (use_R op $! use_EA ea [])
usageRW _ _ = panic "X86.RegInfo.usageRW: no match"
-- 2 operand form; first operand Read; second Modified
usageRM :: Operand -> Operand -> RegUsage
usageRM op (OpReg reg) = mkRU (use_R op ++ [reg]) [reg]
usageRM op (OpAddr ea) = mkRUR (use_R op ++ use_EA ea)
usageRM op (OpReg reg) = mkRU (use_R op [reg]) [reg]
usageRM op (OpAddr ea) = mkRUR (use_R op $! use_EA ea [])
usageRM _ _ = panic "X86.RegInfo.usageRM: no match"
-- 1 operand form; operand Modified
usageM :: Operand -> RegUsage
usageM (OpReg reg) = mkRU [reg] [reg]
usageM (OpAddr ea) = mkRUR (use_EA ea)
usageM (OpAddr ea) = mkRUR (use_EA ea [])
usageM _ = panic "X86.RegInfo.usageM: no match"
-- Registers defd when an operand is written.
......@@ -433,18 +433,18 @@ x86_regUsageOfInstr instr
def_W _ = panic "X86.RegInfo.def_W: no match"
-- Registers used when an operand is read.
use_R (OpReg reg) = [reg]
use_R (OpImm _) = []
use_R (OpAddr ea) = use_EA ea
use_R (OpReg reg) tl = reg : tl
use_R (OpImm _) tl = tl
use_R (OpAddr ea) tl = use_EA ea tl
-- Registers used to compute an effective address.
use_EA (ImmAddr _ _) = []
use_EA (AddrBaseIndex base index _) =
use_base base $! use_index index
where use_base (EABaseReg r) x = r : x
use_base _ x = x
use_index EAIndexNone = []
use_index (EAIndex i _) = [i]
use_EA (ImmAddr _ _) tl = tl
use_EA (AddrBaseIndex base index _) tl =
use_base base $! use_index index tl
where use_base (EABaseReg r) tl = r : tl
use_base _ tl = tl
use_index EAIndexNone tl = tl
use_index (EAIndex i _) tl = i : tl
mkRUR src = src' `seq` RU src' []
where src' = filter interesting src
......@@ -562,10 +562,10 @@ x86_patchRegsOfInstr instr env
where
lookupBase EABaseNone = EABaseNone
lookupBase EABaseRip = EABaseRip
lookupBase (EABaseReg r) = EABaseReg (env r)
lookupBase (EABaseReg r) = EABaseReg $! env r
lookupIndex EAIndexNone = EAIndexNone
lookupIndex (EAIndex r i) = EAIndex (env r) i
lookupIndex (EAIndex r i) = (EAIndex $! env r) i
--------------------------------------------------------------------------------
......
module Interval
( Interval
, mkInterval, intervalToInfinityFrom
, integersInInterval
, DisjointIntervalSet
, emptyIntervalSet, extendIntervalSet, deleteFromIntervalSet
, subIntervals
)
where
import Panic
#include "HsVersions.h"
------------------------------------------------------------------
-- Intervals and Sets of Intervals
------------------------------------------------------------------
-- This module implements intervals over the integer line and sets of
-- disjoint intervals.
{-
An interval $[x,y)$ over ordered points represents a half-open
interval of points: $\{ p \mid x \leq p < y \}$. Half-open intervals
have the nice property $[x,y) \cup [y,z) = [x,z)$. Non-empty
intervals can precede or overlap each other; an empty interval never
overlaps or precedes any other. The set of ordered elements contains
a unique element $\mathit{zero}$; using it in any interval is an
\emph{unchecked} run-time error.
-}
data Interval = Interval { i_min :: Int, i_lim :: Int }
-- width == i_lim - i_min >= 0
type Width = Int
mkInterval :: Int -> Width -> Interval
mkInterval min w = ASSERT (w>=0) Interval min (min+w)
intervalToInfinityFrom :: Int -> Interval
intervalToInfinityFrom min = Interval min maxBound
integersInInterval :: Interval -> [Int]
integersInInterval (Interval min lim) = gen min lim
where gen min lim | min >= lim = []
| otherwise = min : gen (min+1) lim
precedes, overlaps, adjoins, contains :: Interval -> Interval -> Bool
precedes (Interval m l) (Interval m' l') = l <= m' || l' <= m
overlaps i i' = not (i `precedes` i' || i' `precedes` i)
adjoins (Interval _ l) (Interval m _) = l == m
contains (Interval m l) (Interval m' l') = m <= m' && l >= l'
merge :: Interval -> Interval -> Interval
merge _i@(Interval m _) _i'@(Interval _ l) = {- ASSERT (adjoins i i') -} (Interval m l)
----------
newtype DisjointIntervalSet = Intervals [Interval]
-- invariants: * No two intervals overlap
-- * Adjacent intervals have a gap between
-- * Intervals are sorted by min element
emptyIntervalSet :: DisjointIntervalSet
emptyIntervalSet = Intervals []
extendIntervalSet :: DisjointIntervalSet -> Interval -> DisjointIntervalSet
extendIntervalSet (Intervals l) i = Intervals (insert [] i l)
where insert :: [Interval] -> Interval -> [Interval] -> [Interval]
-- precondition: in 'insert prev' i l', every element of prev'
-- precedes and does not adjoin i
insert prev' i [] = rev_app prev' [i]
insert prev' i (i':is) =
if i `precedes` i' then
if i `adjoins` i' then
insert prev' (merge i i') is
else
rev_app prev' (i : i' : is)
else if i' `precedes` i then
if i' `adjoins` i then
insert prev' (merge i' i) is
else
insert (i' : prev') i is
else
panic "overlapping intervals"
deleteFromIntervalSet :: DisjointIntervalSet -> Interval -> DisjointIntervalSet
deleteFromIntervalSet (Intervals l) i = Intervals (rm [] i l)
where rm :: [Interval] -> Interval -> [Interval] -> [Interval]
-- precondition: in 'rm prev' i l', every element of prev'
-- precedes and does not adjoin i
rm _ _ [] = panic "removed interval not present in set"
rm prev' i (i':is) =
if i `precedes` i' then
panic "removed interval not present in set"
else if i' `precedes` i then
rm (i' : prev') i is
else
-- remove i from i', leaving 0, 1, or 2 leftovers
undefined {-
ASSERTX (i' `contains` i)
let (Interval m l, Interval m' l'
panic "overlapping intervals"
-}
subIntervals :: DisjointIntervalSet -> Width -> [Interval]
subIntervals = undefined
rev_app :: [a] -> [a] -> [a]
rev_app [] xs = xs
rev_app (y:ys) xs = rev_app ys (y:xs)
_unused :: ()
_unused = undefined i_min i_lim overlaps contains
......@@ -43,7 +43,15 @@ classifyTyCons :: UniqFM Bool -- ^type constructor conversio
-> ([TyCon], [TyCon], [TyCon]) -- ^tycons to be converted & not to be converted
classifyTyCons convStatus tcs = classify [] [] [] convStatus (tyConGroups tcs)
where
classify conv keep ignored _ [] = (conv, keep, ignored)
-- ******** HACKS *********
-- TyCons that were marked as 'keep' are instead put into the 'conv' list,
-- because keeping them was breaking the nbody example.
-- This needs to be fixed. -- BL 29/11/2011
-- classify conv keep ignored _ [] = (conv, keep, ignored)
classify conv keep ignored _ [] = (conv ++ keep, [], ignored)
-- ************************
classify conv keep ignored cs ((tcs, ds) : rs)
| can_convert && must_convert
= classify (tcs ++ conv) keep ignored (cs `addListToUFM` [(tc, True) | tc <- tcs]) rs
......
......@@ -13,7 +13,7 @@ dnl
# see what flags are available. (Better yet, read the documentation!)
#
AC_INIT([The Glorious Glasgow Haskell Compilation System], [7.3], [glasgow-haskell-bugs@haskell.org], [ghc])
AC_INIT([The Glorious Glasgow Haskell Compilation System], [7.5], [glasgow-haskell-bugs@haskell.org], [ghc])
# Set this to YES for a released version, otherwise NO
: ${RELEASE=NO}
......
......@@ -170,6 +170,14 @@ struct PAR_FLAGS {
unsigned int parGcLoadBalancingGen;
/* do load-balancing in this
* generation and higher only */
unsigned int parGcNoSyncWithIdle;
/* if a Capability has been idle for
* this many GCs, do not try to wake
* it up when doing a
* non-load-balancing parallel GC.
* (zero disables) */
rtsBool setAffinity; /* force thread affinity with CPUs */
};
#endif /* THREADED_RTS */
......
......@@ -226,6 +226,7 @@ initCapability( Capability *cap, nat i )
cap->no = i;
cap->in_haskell = rtsFalse;