summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC/ByteCode/InfoTable.hs4
-rw-r--r--compiler/ghc.mk8
-rw-r--r--hadrian/src/Settings/Packages.hs4
-rw-r--r--libraries/ghci/GHCi/InfoTable.hsc30
-rw-r--r--libraries/ghci/GHCi/Message.hs7
-rw-r--r--libraries/ghci/GHCi/Run.hs4
-rw-r--r--testsuite/tests/codeGen/should_compile/jmp_tbl.hs2
7 files changed, 22 insertions, 37 deletions
diff --git a/compiler/GHC/ByteCode/InfoTable.hs b/compiler/GHC/ByteCode/InfoTable.hs
index 1c2a89b02b..f5082717f3 100644
--- a/compiler/GHC/ByteCode/InfoTable.hs
+++ b/compiler/GHC/ByteCode/InfoTable.hs
@@ -71,6 +71,8 @@ make_constr_itbls hsc_env cons =
descr = dataConIdentity dcon
- r <- iservCmd hsc_env (MkConInfoTable ptrs' nptrs_really
+ tables_next_to_code = tablesNextToCode dflags
+
+ r <- iservCmd hsc_env (MkConInfoTable tables_next_to_code ptrs' nptrs_really
conNo (tagForCon dflags dcon) descr)
return (getName dcon, ItblPtr r)
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index e37a285fed..5274d1a892 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -199,14 +199,6 @@ endif
ifeq "$(GhcWithInterpreter)" "YES"
compiler_stage2_CONFIGURE_OPTS += --flags=ghci
-ifeq "$(TablesNextToCode)" "YES"
-# Should GHCI be building info tables in the TABLES_NEXT_TO_CODE style
-# or not?
-# XXX This should logically be a CPP option, but there doesn't seem to
-# be a flag for that
-compiler_stage2_CONFIGURE_OPTS += --ghc-option=-DGHCI_TABLES_NEXT_TO_CODE
-endif
-
# Should the debugger commands be enabled?
ifeq "$(GhciWithDebugger)" "YES"
compiler_stage2_CONFIGURE_OPTS += --ghc-option=-DDEBUGGER
diff --git a/hadrian/src/Settings/Packages.hs b/hadrian/src/Settings/Packages.hs
index d06d4292dd..160259002c 100644
--- a/hadrian/src/Settings/Packages.hs
+++ b/hadrian/src/Settings/Packages.hs
@@ -63,10 +63,6 @@ packageArgs = do
, (any (wayUnit Threaded) rtsWays) ?
notStage0 ? arg "--ghc-option=-optc-DTHREADED_RTS"
, ghcWithInterpreter ?
- flag TablesNextToCode ?
- notM (flag GhcUnregisterised) ?
- notStage0 ? arg "--ghc-option=-DGHCI_TABLES_NEXT_TO_CODE"
- , ghcWithInterpreter ?
ghciWithDebugger <$> flavour ?
notStage0 ? arg "--ghc-option=-DDEBUGGER"
, ghcProfiled <$> flavour ?
diff --git a/libraries/ghci/GHCi/InfoTable.hsc b/libraries/ghci/GHCi/InfoTable.hsc
index 09970e0370..67b0df863a 100644
--- a/libraries/ghci/GHCi/InfoTable.hsc
+++ b/libraries/ghci/GHCi/InfoTable.hsc
@@ -24,18 +24,12 @@ import Data.ByteString (ByteString)
import Control.Monad.Fail
import qualified Data.ByteString as BS
-tables_next_to_code :: Bool
-#if defined(TABLES_NEXT_TO_CODE)
-tables_next_to_code = True
-#else
-tables_next_to_code = False
-#endif
-
-- NOTE: Must return a pointer acceptable for use in the header of a closure.
-- If tables_next_to_code is enabled, then it must point the the 'code' field.
-- Otherwise, it should point to the start of the StgInfoTable.
mkConInfoTable
- :: Int -- ptr words
+ :: Bool -- TABLES_NEXT_TO_CODE
+ -> Int -- ptr words
-> Int -- non-ptr words
-> Int -- constr tag
-> Int -- pointer tag
@@ -44,7 +38,7 @@ mkConInfoTable
-- resulting info table is allocated with allocateExec(), and
-- should be freed with freeExec().
-mkConInfoTable ptr_words nonptr_words tag ptrtag con_desc = do
+mkConInfoTable tables_next_to_code ptr_words nonptr_words tag ptrtag con_desc = do
let entry_addr = interpConstrEntry !! ptrtag
code' <- if tables_next_to_code
then Just <$> mkJumpToAddr entry_addr
@@ -60,7 +54,7 @@ mkConInfoTable ptr_words nonptr_words tag ptrtag con_desc = do
srtlen = fromIntegral tag,
code = code'
}
- castFunPtrToPtr <$> newExecConItbl itbl con_desc
+ castFunPtrToPtr <$> newExecConItbl tables_next_to_code itbl con_desc
-- -----------------------------------------------------------------------------
@@ -337,9 +331,9 @@ data StgConInfoTable = StgConInfoTable {
pokeConItbl
- :: Ptr StgConInfoTable -> Ptr StgConInfoTable -> StgConInfoTable
+ :: Bool -> Ptr StgConInfoTable -> Ptr StgConInfoTable -> StgConInfoTable
-> IO ()
-pokeConItbl wr_ptr _ex_ptr itbl = do
+pokeConItbl tables_next_to_code wr_ptr _ex_ptr itbl = do
if tables_next_to_code
then do
-- Write the offset to the con_desc from the end of the standard InfoTable
@@ -353,8 +347,8 @@ pokeConItbl wr_ptr _ex_ptr itbl = do
pokeByteOff wr_ptr itblSize (conDesc itbl)
pokeItbl (wr_ptr `plusPtr` (#offset StgConInfoTable, i)) (infoTable itbl)
-sizeOfEntryCode :: MonadFail m => m Int
-sizeOfEntryCode
+sizeOfEntryCode :: MonadFail m => Bool -> m Int
+sizeOfEntryCode tables_next_to_code
| not tables_next_to_code = pure 0
| otherwise = do
code' <- mkJumpToAddr undefined
@@ -363,10 +357,10 @@ sizeOfEntryCode
Right xs -> sizeOf (head xs) * length xs
-- Note: Must return proper pointer for use in a closure
-newExecConItbl :: StgInfoTable -> ByteString -> IO (FunPtr ())
-newExecConItbl obj con_desc
+newExecConItbl :: Bool -> StgInfoTable -> ByteString -> IO (FunPtr ())
+newExecConItbl tables_next_to_code obj con_desc
= alloca $ \pcode -> do
- sz0 <- sizeOfEntryCode
+ sz0 <- sizeOfEntryCode tables_next_to_code
let lcon_desc = BS.length con_desc + 1{- null terminator -}
-- SCARY
-- This size represents the number of bytes in an StgConInfoTable.
@@ -379,7 +373,7 @@ newExecConItbl obj con_desc
ex_ptr <- peek pcode
let cinfo = StgConInfoTable { conDesc = ex_ptr `plusPtr` fromIntegral sz
, infoTable = obj }
- pokeConItbl wr_ptr ex_ptr cinfo
+ pokeConItbl tables_next_to_code wr_ptr ex_ptr cinfo
BS.useAsCStringLen con_desc $ \(src, len) ->
copyBytes (castPtr wr_ptr `plusPtr` fromIntegral sz) src len
let null_off = fromIntegral sz + fromIntegral (BS.length con_desc)
diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs
index 7e96601b99..b7c402ccfa 100644
--- a/libraries/ghci/GHCi/Message.hs
+++ b/libraries/ghci/GHCi/Message.hs
@@ -104,7 +104,8 @@ data Message a where
-- | Create an info table for a constructor
MkConInfoTable
- :: Int -- ptr words
+ :: Bool -- TABLES_NEXT_TO_CODE
+ -> Int -- ptr words
-> Int -- non-ptr words
-> Int -- constr tag
-> Int -- pointer tag
@@ -477,7 +478,7 @@ getMessage = do
15 -> Msg <$> MallocStrings <$> get
16 -> Msg <$> (PrepFFI <$> get <*> get <*> get)
17 -> Msg <$> FreeFFI <$> get
- 18 -> Msg <$> (MkConInfoTable <$> get <*> get <*> get <*> get <*> get)
+ 18 -> Msg <$> (MkConInfoTable <$> get <*> get <*> get <*> get <*> get <*> get)
19 -> Msg <$> (EvalStmt <$> get <*> get)
20 -> Msg <$> (ResumeStmt <$> get <*> get)
21 -> Msg <$> (AbandonStmt <$> get)
@@ -520,7 +521,7 @@ putMessage m = case m of
MallocStrings bss -> putWord8 15 >> put bss
PrepFFI conv args res -> putWord8 16 >> put conv >> put args >> put res
FreeFFI p -> putWord8 17 >> put p
- MkConInfoTable p n t pt d -> putWord8 18 >> put p >> put n >> put t >> put pt >> put d
+ MkConInfoTable tc p n t pt d -> putWord8 18 >> put tc >> put p >> put n >> put t >> put pt >> put d
EvalStmt opts val -> putWord8 19 >> put opts >> put val
ResumeStmt opts val -> putWord8 20 >> put opts >> put val
AbandonStmt val -> putWord8 21 >> put val
diff --git a/libraries/ghci/GHCi/Run.hs b/libraries/ghci/GHCi/Run.hs
index 37dc7f2f48..ab55502f8e 100644
--- a/libraries/ghci/GHCi/Run.hs
+++ b/libraries/ghci/GHCi/Run.hs
@@ -89,8 +89,8 @@ run m = case m of
MallocStrings bss -> mapM mkString0 bss
PrepFFI conv args res -> toRemotePtr <$> prepForeignCall conv args res
FreeFFI p -> freeForeignCallInfo (fromRemotePtr p)
- MkConInfoTable ptrs nptrs tag ptrtag desc ->
- toRemotePtr <$> mkConInfoTable ptrs nptrs tag ptrtag desc
+ MkConInfoTable tc ptrs nptrs tag ptrtag desc ->
+ toRemotePtr <$> mkConInfoTable tc ptrs nptrs tag ptrtag desc
StartTH -> startTH
GetClosure ref -> do
clos <- getClosureData =<< localRef ref
diff --git a/testsuite/tests/codeGen/should_compile/jmp_tbl.hs b/testsuite/tests/codeGen/should_compile/jmp_tbl.hs
index 5274ff29f3..c7211b0ebd 100644
--- a/testsuite/tests/codeGen/should_compile/jmp_tbl.hs
+++ b/testsuite/tests/codeGen/should_compile/jmp_tbl.hs
@@ -4,7 +4,7 @@
This funny module was reduced from a failing build of stage2 using
the new code generator and the linear register allocator, with this bug:
-"inplace/bin/ghc-stage1" -fPIC -dynamic -H32m -O -Wall -H64m -O0 -package-name ghc-7.1.20110414 -hide-all-packages -i -icompiler/basicTypes -icompiler/cmm -icompiler/codeGen -icompiler/coreSyn -icompiler/deSugar -icompiler/ghci -icompiler/hsSyn -icompiler/iface -icompiler/llvmGen -icompiler/main -icompiler/nativeGen -icompiler/parser -icompiler/prelude -icompiler/profiling -icompiler/rename -icompiler/simplCore -icompiler/simplStg -icompiler/specialise -icompiler/stgSyn -icompiler/stranal -icompiler/typecheck -icompiler/types -icompiler/utils -icompiler/vectorise -icompiler/stage2/build -icompiler/stage2/build/autogen -Icompiler/stage2/build -Icompiler/stage2/build/autogen -Icompiler/../libffi/build/include -Icompiler/stage2 -Icompiler/../libraries/base/cbits -Icompiler/../libraries/base/include -Icompiler/. -Icompiler/parser -Icompiler/utils -optP-DHAVE_INTERNAL_INTERPRETER -optP-include -optPcompiler/stage2/build/autogen/cabal_macros.h -package Cabal-1.11.0 -package array-0.3.0.2 -package base-4.3.1.0 -package ghc-boot-0.0.0.0 -package bytestring-0.9.1.10 -package containers-0.4.0.0 -package directory-1.1.0.0 -package filepath-1.2.0.0 -package hoopl-3.8.7.0 -package hpc-0.5.0.6 -package old-time-1.0.0.6 -package process-1.0.1.4 -package template-haskell-2.5.0.0 -package unix-2.4.1.0 -Wall -fno-warn-name-shadowing -fno-warn-orphans -XHaskell98 -XNondecreasingIndentation -XCPP -XMagicHash -XUnboxedTuples -XPatternGuards -XForeignFunctionInterface -XEmptyDataDecls -XTypeSynonymInstances -XMultiParamTypeClasses -XFlexibleInstances -XRank2Types -XScopedTypeVariables -XDeriveDataTypeable -DGHCI_TABLES_NEXT_TO_CODE -DSTAGE=2 -O2 -O -DGHC_DEFAULT_NEW_CODEGEN -no-user-package-db -rtsopts -odir compiler/stage2/build -hidir compiler/stage2/build -stubdir compiler/stage2/build -hisuf dyn_hi -osuf dyn_o -hcsuf dyn_hc -c compiler/main/DriverPipeline.hs -o compiler/stage2/build/DriverPipeline.dyn_o -fforce-recomp -dno-debug-output -fno-warn-unused-binds
+"inplace/bin/ghc-stage1" -fPIC -dynamic -H32m -O -Wall -H64m -O0 -package-name ghc-7.1.20110414 -hide-all-packages -i -icompiler/basicTypes -icompiler/cmm -icompiler/codeGen -icompiler/coreSyn -icompiler/deSugar -icompiler/ghci -icompiler/hsSyn -icompiler/iface -icompiler/llvmGen -icompiler/main -icompiler/nativeGen -icompiler/parser -icompiler/prelude -icompiler/profiling -icompiler/rename -icompiler/simplCore -icompiler/simplStg -icompiler/specialise -icompiler/stgSyn -icompiler/stranal -icompiler/typecheck -icompiler/types -icompiler/utils -icompiler/vectorise -icompiler/stage2/build -icompiler/stage2/build/autogen -Icompiler/stage2/build -Icompiler/stage2/build/autogen -Icompiler/../libffi/build/include -Icompiler/stage2 -Icompiler/../libraries/base/cbits -Icompiler/../libraries/base/include -Icompiler/. -Icompiler/parser -Icompiler/utils -optP-DHAVE_INTERNAL_INTERPRETER -optP-include -optPcompiler/stage2/build/autogen/cabal_macros.h -package Cabal-1.11.0 -package array-0.3.0.2 -package base-4.3.1.0 -package ghc-boot-0.0.0.0 -package bytestring-0.9.1.10 -package containers-0.4.0.0 -package directory-1.1.0.0 -package filepath-1.2.0.0 -package hoopl-3.8.7.0 -package hpc-0.5.0.6 -package old-time-1.0.0.6 -package process-1.0.1.4 -package template-haskell-2.5.0.0 -package unix-2.4.1.0 -Wall -fno-warn-name-shadowing -fno-warn-orphans -XHaskell98 -XNondecreasingIndentation -XCPP -XMagicHash -XUnboxedTuples -XPatternGuards -XForeignFunctionInterface -XEmptyDataDecls -XTypeSynonymInstances -XMultiParamTypeClasses -XFlexibleInstances -XRank2Types -XScopedTypeVariables -XDeriveDataTypeable -DSTAGE=2 -O2 -O -DGHC_DEFAULT_NEW_CODEGEN -no-user-package-db -rtsopts -odir compiler/stage2/build -hidir compiler/stage2/build -stubdir compiler/stage2/build -hisuf dyn_hi -osuf dyn_o -hcsuf dyn_hc -c compiler/main/DriverPipeline.hs -o compiler/stage2/build/DriverPipeline.dyn_o -fforce-recomp -dno-debug-output -fno-warn-unused-binds
ghc-stage1: panic! (the 'impossible' happened)
(GHC version 7.1.20110414 for x86_64-unknown-linux):
View Lorry Controller Status