From 8b08c15b8ace5a76e341939081fbb6ad2736ddd1 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <mnislaih@gmail.com>
Date: Mon, 11 Dec 2006 18:13:07 +0000
Subject: [PATCH] Toggle whether the RTS gets build with debugger support for
ghci
Specifically, this disables the special support in the RTS for looking up the datacon name corresponding to an address.
Correspondingly, the debugging commads in GHCi will not be available, and neither will the '-fdebugging' flag
---
compiler/Makefile | 6 ++++--
compiler/deSugar/DsBreakpoint.lhs | 6 +++++-
compiler/ghci/Debugger.hs | 7 ++++++-
compiler/ghci/InteractiveUI.hs | 2 +-
compiler/main/DynFlags.hs | 2 ++
compiler/typecheck/TcSplice.lhs | 5 ++++-
mk/config.mk.in | 3 +++
rts/Linker.c | 10 ++++------
rts/Makefile | 4 ++++
9 files changed, 33 insertions(+), 12 deletions(-)
diff --git a/compiler/Makefile b/compiler/Makefile
index 70a0e723c5b1..aac594d3e977 100644
--- a/compiler/Makefile
+++ b/compiler/Makefile
@@ -413,10 +413,12 @@ ifeq "$(GhcWithInterpreter) $(bootstrapped)" "YES YES"
# Yes, include the interepreter, readline, and Template Haskell extensions
SRC_HC_OPTS += -DGHCI -package template-haskell
-# -DBREAKPOINT causes a loop in stage2
-# SRC_HC_OPTS += -DGHCI -DBREAKPOINT -package template-haskell
PKG_DEPENDS += template-haskell
+# Should the debugger commands be enabled?
+ifeq "$(GhciWithDebugger)" "YES"
+SRC_HC_OPTS += -DDEBUGGER
+endif
# Should GHCI be building info tables in the TABLES_NEXT_TO_CODE style
# or not?
ifeq "$(GhcEnableTablesNextToCode) $(GhcUnregisterised)" "YES NO"
diff --git a/compiler/deSugar/DsBreakpoint.lhs b/compiler/deSugar/DsBreakpoint.lhs
index f6c7d9e28bec..c714a5ea1ceb 100644
--- a/compiler/deSugar/DsBreakpoint.lhs
+++ b/compiler/deSugar/DsBreakpoint.lhs
@@ -45,7 +45,7 @@ import CoreUtils ( exprType )
import Outputable
import ErrUtils ( debugTraceMsg )
import FastString ( mkFastString, unpackFS )
-import DynFlags ( GhcMode(..), DynFlag(Opt_Debugging, Opt_IgnoreBreakpoints) )
+import DynFlags ( GhcMode(..), DynFlag(..) )
import DsMonad
import {-#SOURCE#-}DsExpr ( dsLExpr )
@@ -104,10 +104,14 @@ mkBreakpointExpr loc bkptFuncId = do
instrumenting = idName bkptFuncId == breakpointAutoName
debug_enabled :: DsM Bool
+#if defined(GHCI) && defined(DEBUGGER)
debug_enabled = do
debugging <- doptDs Opt_Debugging
b_enabled <- breakpoints_enabled
return (debugging && b_enabled)
+#else
+debug_enabled = return False
+#endif
maybeInsertBreakpoint :: LHsExpr Id -> Type -> DsM (LHsExpr Id)
--maybeInsertBreakpoint e | pprTrace("insertBreakpoint at" (ppr e) False = undefined
diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs
index 7135359cb454..99b14c9566a6 100644
--- a/compiler/ghci/Debugger.hs
+++ b/compiler/ghci/Debugger.hs
@@ -534,7 +534,7 @@ refreshBkptTable :: [ModSummary] -> GHCi ()
refreshBkptTable [] = return ()
refreshBkptTable (ms:mod_sums) = do
sess <- getSession
- when (Opt_Debugging `elem` flags (GHC.ms_hspp_opts ms)) $ do
+ when isDebugging $ do
old_table <- getBkptTable
new_table <- addModuleGHC sess old_table (GHC.ms_mod ms)
setBkptTable new_table
@@ -547,3 +547,8 @@ refreshBkptTable (ms:mod_sums) = do
(ppr mod <> text ": inserted " <> int (length sites) <>
text " breakpoints")
return$ addModule mod sites bt
+#if defined(GHCI) && defined(DEBUGGER)
+ isDebugging = Opt_Debugging `elem` flags (GHC.ms_hspp_opts ms)
+#else
+ isDebugging = False
+#endif
\ No newline at end of file
diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 980dcd92df8c..b9b82ace1832 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -131,7 +131,7 @@ builtin_commands = [
("etags", keepGoing createETagsFileCmd, False, completeFilename),
("ctags", keepGoing createCTagsFileCmd, False, completeFilename),
("type", keepGoing typeOfExpr, False, completeIdentifier),
-#if defined(GHCI)
+#if defined(DEBUGGER)
("print", keepGoing (pprintClosureCommand True False), False, completeIdentifier),
("sprint", keepGoing (pprintClosureCommand False False),False, completeIdentifier),
("force", keepGoing (pprintClosureCommand False True), False, completeIdentifier),
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 2bd681642448..d1226eaf7415 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -201,7 +201,9 @@ data DynFlag
| Opt_SplitObjs
| Opt_StgStats
| Opt_HideAllPackages
+#if defined(GHCI) && defined(DEBUGGER)
| Opt_Debugging
+#endif
| Opt_PrintBindResult
| Opt_Haddock
diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index 56eb637363a7..a99bf8b9e24e 100644
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -364,8 +364,11 @@ runMeta :: (SrcSpan -> th_syn -> Either Message hs_syn)
-> TcM hs_syn -- Of type t
runMeta convert expr
= do { -- Desugar
+#if defined(GHCI) && defined(DEBUGGER)
ds_expr <- unsetOptM Opt_Debugging $ initDsTc (dsLExpr expr)
-
+#else
+ ds_expr <- initDsTc (dsLExpr expr)
+#endif
-- Compile and link it; might fail if linking fails
; hsc_env <- getTopEnv
; src_span <- getSrcSpanM
diff --git a/mk/config.mk.in b/mk/config.mk.in
index a1c6a8487265..3718485bee47 100644
--- a/mk/config.mk.in
+++ b/mk/config.mk.in
@@ -315,6 +315,9 @@ BuildingGranSim=$(subst mg,YES,$(filter mg,$(WAYS)))
HscIfaceFileVersion=6
+# Building with debugger?
+GhciWithDebugger=YES
+
#------------------------------------------------------------------------------
# Options for Libraries
diff --git a/rts/Linker.c b/rts/Linker.c
index f1ec48aef88d..d0c120b917d9 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -95,7 +95,7 @@ static /*Str*/HashTable *symhash;
/* Hash table mapping symbol names to StgStablePtr */
static /*Str*/HashTable *stablehash;
-#if defined(GHCI) && defined(BREAKPOINT)
+#if defined(DEBUGGER)
/* Hash table mapping info table ptrs to DataCon names */
static HashTable *dchash;
#endif
@@ -828,7 +828,7 @@ static void ghciInsertStrHashTable ( char* obj_name,
if (lookupHashTable(table, (StgWord)key) == NULL)
{
insertStrHashTable(table, (StgWord)key, data);
-#if defined(GHCI) && defined(BREAKPOINT)
+#if defined(DEBUGGER)
// Insert the reverse pair in the datacon hash if it is a closure
{
if(isSuffixOf(key, "static_info") || isSuffixOf(key, "con_info")) {
@@ -882,7 +882,7 @@ initLinker( void )
stablehash = allocStrHashTable();
symhash = allocStrHashTable();
-#if defined(GHCI) && defined(BREAKPOINT)
+#if defined(DEBUGGER)
dchash = allocHashTable();
#endif
@@ -1103,7 +1103,7 @@ lookupSymbol( char *lbl )
}
}
-#if defined(GHCI) && defined(BREAKPOINT)
+#if defined(DEBUGGER)
char *
lookupDataCon( StgWord addr )
{
@@ -4397,7 +4397,6 @@ static int machoGetMisalignment( FILE * f )
#endif
-#if defined(GHCI) && defined(BREAKPOINT)
int isSuffixOf(char* x, char* suffix) {
int suffix_len = strlen (suffix);
int x_len = strlen (x);
@@ -4412,4 +4411,3 @@ int isSuffixOf(char* x, char* suffix) {
char* x_suffix = &x[strlen(x)-strlen(suffix)];
return strcmp(x_suffix, suffix) == 0;
}
-#endif
diff --git a/rts/Makefile b/rts/Makefile
index e7df18e666bb..c3c2b82fc428 100644
--- a/rts/Makefile
+++ b/rts/Makefile
@@ -144,6 +144,10 @@ ifeq "$(HaveLibMingwEx)" "YES"
PACKAGE_CPP_OPTS += -DHAVE_LIBMINGWEX
endif
+ifeq "$(GhciWithDebugger)" "YES"
+STANDARD_OPTS += -DDEBUGGER
+endif
+
ifeq "$(DotnetSupport)" "YES"
#
--
GitLab