summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/main/DynFlags.hs6
-rw-r--r--compiler/main/InteractiveEval.hs10
-rw-r--r--docs/users_guide/flags.xml6
-rw-r--r--docs/users_guide/ghci.xml13
-rw-r--r--includes/Rts.h6
-rw-r--r--includes/rts/storage/Closures.h2
-rw-r--r--mk/config.mk.in8
-rw-r--r--rts/HeapStackCheck.cmm6
-rw-r--r--rts/PrimOps.cmm4
-rw-r--r--rts/StgMiscClosures.cmm2
-rw-r--r--rts/ghc.mk2
-rw-r--r--rts/sm/GC.c8
12 files changed, 50 insertions, 23 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index d745cd63af..4810ce85b1 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -670,6 +670,8 @@ data DynFlags = DynFlags {
maxWorkerArgs :: Int,
+ ghciHistSize :: Int,
+
-- | MsgDoc output action: use "ErrUtils" instead of this if you can
log_action :: LogAction,
flushOut :: FlushOut,
@@ -1227,6 +1229,8 @@ defaultDynFlags mySettings =
maxWorkerArgs = 10,
+ ghciHistSize = 50, -- keep a log of length 50 by default
+
log_action = defaultLogAction,
flushOut = defaultFlushOut,
flushErr = defaultFlushErr,
@@ -2126,6 +2130,8 @@ dynamic_flags = [
, Flag "fmax-worker-args" (intSuffix (\n d -> d {maxWorkerArgs = n}))
+ , Flag "fghci-hist-size" (intSuffix (\n d -> d {ghciHistSize = n}))
+
------ Profiling ----------------------------------------------------
-- OLD profiling flags
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 64b2d3303c..9b9c14bb0b 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -220,13 +220,15 @@ runStmtWithLocation source linenumber expr step =
let ic = hsc_IC hsc_env
bindings = (ic_tythings ic, ic_rn_gbl_env ic)
+ size = ghciHistSize idflags'
+
case step of
RunAndLogSteps ->
traceRunStatus expr bindings tyThings
- breakMVar statusMVar status emptyHistory
+ breakMVar statusMVar status (emptyHistory size)
_other ->
handleRunStatus expr bindings tyThings
- breakMVar statusMVar status emptyHistory
+ breakMVar statusMVar status (emptyHistory size)
runDecls :: GhcMonad m => String -> m [Name]
runDecls = runDeclsWithLocation "<interactive>" 1
@@ -268,8 +270,8 @@ withVirtualCWD m = do
parseImportDecl :: GhcMonad m => String -> m (ImportDecl RdrName)
parseImportDecl expr = withSession $ \hsc_env -> liftIO $ hscImport hsc_env expr
-emptyHistory :: BoundedList History
-emptyHistory = nilBL 50 -- keep a log of length 50
+emptyHistory :: Int -> BoundedList History
+emptyHistory size = nilBL size
handleRunStatus :: GhcMonad m =>
String-> ([TyThing],GlobalRdrEnv) -> [Id]
diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml
index d670cb91a9..bc1c228e36 100644
--- a/docs/users_guide/flags.xml
+++ b/docs/users_guide/flags.xml
@@ -511,6 +511,12 @@
<entry><option>-fno-break-on-error</option></entry>
</row>
<row>
+ <entry><option>-fghci-hist-size=<replaceable>n</replaceable></option></entry>
+ <entry><link linkend="ghci-debugger">Set the number of entries GHCi keeps for <literal>:history</literal></link></entry>
+ <entry>dynamic</entry>
+ <entry><option>(default is 50)</option></entry>
+ </row>
+ <row>
<entry><option>-fprint-evld-with-show</option></entry>
<entry><link linkend="breakpoints">Enable usage of Show instances in <literal>:print</literal></link></entry>
<entry>dynamic</entry>
diff --git a/docs/users_guide/ghci.xml b/docs/users_guide/ghci.xml
index 3d1aecc2fb..c59f4b3830 100644
--- a/docs/users_guide/ghci.xml
+++ b/docs/users_guide/ghci.xml
@@ -1715,8 +1715,7 @@ a :: a
<para>The history is only available when
using <literal>:trace</literal>; the reason for this is we found that
logging each breakpoint in the history cuts performance by a factor of
- 2 or more. GHCi remembers the last 50 steps in the history (perhaps in
- the future we'll make this configurable).</para>
+ 2 or more. By default, GHCi remembers the last 50 steps in the history, but this can be changed with the <option>-fghci-hist-size=<replaceable>n</replaceable></option><indexterm><primary><option>&ndash;fghci-hist-size</option></primary></indexterm> option).</para>
</sect2>
<sect2 id="ghci-debugger-exceptions">
@@ -2381,10 +2380,12 @@ Prelude> :. cmds.ghci
<indexterm><primary><literal>:history</literal></primary></indexterm>
</term>
<listitem>
- <para>Display the history of evaluation steps. With a number,
- displays that many steps (default: 20). For use with
- <literal>:trace</literal>; see <xref
- linkend="tracing" />.</para>
+ <para>Display the history of evaluation steps. With a
+ number, displays that many steps (default: 20). For use
+ with <literal>:trace</literal>; see <xref linkend="tracing"
+ />. To set the number of history entries stored by GHCi,
+ use
+ <option>-fghci-hist-size=<replaceable>n</replaceable></option>.</para>
</listitem>
</varlistentry>
diff --git a/includes/Rts.h b/includes/Rts.h
index b31776828f..edb48c1a91 100644
--- a/includes/Rts.h
+++ b/includes/Rts.h
@@ -306,6 +306,12 @@ TICK_VAR(2)
#define DEBUG_ONLY(s) doNothing()
#endif
+#ifdef DEBUG
+#define DEBUG_IS_ON 1
+#else
+#define DEBUG_IS_ON 0
+#endif
+
/* -----------------------------------------------------------------------------
Useful macros and inline functions
-------------------------------------------------------------------------- */
diff --git a/includes/rts/storage/Closures.h b/includes/rts/storage/Closures.h
index fcba1ebeb6..2302b7d2a1 100644
--- a/includes/rts/storage/Closures.h
+++ b/includes/rts/storage/Closures.h
@@ -306,9 +306,7 @@ typedef struct {
StgHeader header;
StgClosure *volatile current_value;
StgTVarWatchQueue *volatile first_watch_queue_entry;
-#if defined(THREADED_RTS)
StgInt volatile num_updates;
-#endif
} StgTVar;
typedef struct {
diff --git a/mk/config.mk.in b/mk/config.mk.in
index a906d25fdf..f8d4d6a95f 100644
--- a/mk/config.mk.in
+++ b/mk/config.mk.in
@@ -360,9 +360,11 @@ LAX_DEPENDENCIES = NO
# ----------------------------------------------------------------------------
# Options for GHC's RTS
-# For an optimised RTS (you probably don't want to change these; we build
-# a debugging RTS by default now. Use -debug to get it).
-GhcRtsHcOpts=-optc-O2
+# Build an optimised RTS. Remember that we need to turn on
+# optimisation both for C code (-optc-O2) and .cmm code (-O2). For
+# the debugging RTS flavour, rts/ghc.mk overrides these to turn off
+# optimisation.
+GhcRtsHcOpts=-optc-O2 -O2
GhcRtsCcOpts=-fomit-frame-pointer
# Include the front panel code? Needs GTK+.
diff --git a/rts/HeapStackCheck.cmm b/rts/HeapStackCheck.cmm
index b3ae2648d9..fbceb7691a 100644
--- a/rts/HeapStackCheck.cmm
+++ b/rts/HeapStackCheck.cmm
@@ -221,7 +221,11 @@ INFO_TABLE_RET ( stg_enter_checkbh, RET_SMALL,
{
foreign "C" checkBlockingQueues(MyCapability() "ptr",
CurrentTSO);
- return (updatee);
+
+ // we need to return updatee now. Note that it might be a pointer
+ // to an indirection or a tagged value, we don't know which, so we
+ // need to ENTER() rather than return().
+ ENTER(updatee);
}
/* -----------------------------------------------------------------------------
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 67a0a5a72a..6ff7dc0cf3 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -1070,8 +1070,8 @@ stg_newTVarzh (P_ init)
stg_readTVarzh (P_ tvar)
{
- W_ trec;
- W_ result;
+ P_ trec;
+ P_ result;
// Call to stmReadTVar may allocate
MAYBE_GC_P (stg_readTVarzh, tvar);
diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm
index 2985982d64..e6a30e67a3 100644
--- a/rts/StgMiscClosures.cmm
+++ b/rts/StgMiscClosures.cmm
@@ -127,7 +127,7 @@ INFO_TABLE_RET( stg_ctoi_R1n, RET_BCO )
{
Sp_adj(-2);
Sp(1) = R1;
- Sp(0) = stg_ret_p_info;
+ Sp(0) = stg_ret_n_info;
jump stg_yield_to_interpreter [];
}
diff --git a/rts/ghc.mk b/rts/ghc.mk
index 36df61d2d5..fe26ee1f10 100644
--- a/rts/ghc.mk
+++ b/rts/ghc.mk
@@ -130,7 +130,7 @@ ifneq "$$(BINDIST)" "YES"
# The per-way CC_OPTS
ifneq "$$(findstring debug, $1)" ""
-rts_dist_$1_HC_OPTS =
+rts_dist_$1_HC_OPTS = -O0
rts_dist_$1_CC_OPTS = -g -O0
else
rts_dist_$1_HC_OPTS = $$(GhcRtsHcOpts)
diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index 8b92ca82cb..b9485f2c36 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -404,7 +404,7 @@ GarbageCollect (nat collect_gen,
break;
}
- if (n_gc_threads != 1) {
+ if (!DEBUG_IS_ON && n_gc_threads != 1) {
gct->allocated = clearNursery(cap);
}
@@ -638,7 +638,7 @@ GarbageCollect (nat collect_gen,
}
// Reset the nursery: make the blocks empty
- if (n_gc_threads == 1) {
+ if (DEBUG_IS_ON || n_gc_threads == 1) {
for (n = 0; n < n_capabilities; n++) {
allocated += clearNursery(&capabilities[n]);
}
@@ -1074,7 +1074,9 @@ gcWorkerThread (Capability *cap)
scavenge_until_all_done();
- gct->allocated = clearNursery(cap);
+ if (!DEBUG_IS_ON) {
+ gct->allocated = clearNursery(cap);
+ }
#ifdef THREADED_RTS
// Now that the whole heap is marked, we discard any sparks that
View Lorry Controller Status