[Git][ghc/ghc][master] 3 commits: Remove unused `ghciTablesNextToCode` from compiler proper
Marge Bot
gitlab at gitlab.haskell.org
Sun Mar 29 21:28:22 UTC 2020
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
eb2162c8 by John Ericson at 2020-03-26T12:37:08-04:00
Remove unused `ghciTablesNextToCode` from compiler proper
- - - - -
f51efc4b by Joachim Breitner at 2020-03-26T12:37:09-04:00
Prepare to use run-time tablesNextToCode in compiler exclusively
Factor out CPP as much as possible to prepare for runtime
determinattion.
Progress towards #15548
- - - - -
1c446220 by Joachim Breitner at 2020-03-26T12:37:09-04:00
Use run-time tablesNextToCode in compiler exclusively (#15548)
Summary:
- There is no more use of the TABLES_NEXT_TO_CODE CPP macro in
`compiler/`. GHCI_TABLES_NEXT_TO_CODE is also removed entirely.
The field within `PlatformMisc` within `DynFlags` is used instead.
- The field is still not exposed as a CLI flag. We might consider some
way to ensure the right RTS / libraries are used before doing that.
Original reviewers:
Original subscribers: TerrorJack, rwbarton, carter
Original Differential Revision: https://phabricator.haskell.org/D5082
- - - - -
9 changed files:
- compiler/GHC/ByteCode/InfoTable.hs
- compiler/ghc.mk
- compiler/utils/Util.hs
- hadrian/src/Settings/Packages.hs
- libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc
- libraries/ghci/GHCi/InfoTable.hsc
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- testsuite/tests/codeGen/should_compile/jmp_tbl.hs
Changes:
=====================================
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)
=====================================
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
=====================================
compiler/utils/Util.hs
=====================================
@@ -13,7 +13,6 @@
module Util (
-- * Flags dependent on the compiler build
ghciSupported, debugIsOn,
- ghciTablesNextToCode,
isWindowsHost, isDarwinHost,
-- * Miscellaneous higher-order functions
@@ -203,13 +202,6 @@ debugIsOn = True
debugIsOn = False
#endif
-ghciTablesNextToCode :: Bool
-#if defined(GHCI_TABLES_NEXT_TO_CODE)
-ghciTablesNextToCode = True
-#else
-ghciTablesNextToCode = False
-#endif
-
isWindowsHost :: Bool
#if defined(mingw32_HOST_OS)
isWindowsHost = True
=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -62,10 +62,6 @@ packageArgs = do
, notM targetSupportsSMP ? arg "--ghc-option=-optc-DNOSMP"
, (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"
=====================================
libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc
=====================================
@@ -31,10 +31,10 @@ type EntryFunPtr = FunPtr (Ptr () -> IO (Ptr ()))
-- <https://gitlab.haskell.org/ghc/ghc/blob/master/includes/rts/storage/InfoTables.h>
-- for more details on this data structure.
data StgInfoTable = StgInfoTable {
- entry :: Maybe EntryFunPtr, -- Just <=> not ghciTablesNextToCode
+ entry :: Maybe EntryFunPtr, -- Just <=> not TABLES_NEXT_TO_CODE
ptrs :: HalfWord,
nptrs :: HalfWord,
tipe :: ClosureType,
srtlen :: HalfWord,
- code :: Maybe ItblCodes -- Just <=> ghciTablesNextToCode
+ code :: Maybe ItblCodes -- Just <=> TABLES_NEXT_TO_CODE
} deriving (Show, Generic)
=====================================
libraries/ghci/GHCi/InfoTable.hsc
=====================================
@@ -13,27 +13,23 @@ module GHCi.InfoTable
mkConInfoTable
) where
-import Prelude -- See note [Why do we import Prelude here?]
+import Prelude hiding (fail) -- See note [Why do we import Prelude here?]
+
import Foreign
import Foreign.C
import GHC.Ptr
import GHC.Exts
import GHC.Exts.Heap
import Data.ByteString (ByteString)
+import Control.Monad.Fail
import qualified Data.ByteString as BS
-ghciTablesNextToCode :: Bool
-#if defined(TABLES_NEXT_TO_CODE)
-ghciTablesNextToCode = True
-#else
-ghciTablesNextToCode = 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
@@ -42,23 +38,23 @@ mkConInfoTable
-- resulting info table is allocated with allocateExec(), and
-- should be freed with freeExec().
-mkConInfoTable ptr_words nonptr_words tag ptrtag con_desc =
- castFunPtrToPtr <$> newExecConItbl itbl con_desc
- where
- entry_addr = interpConstrEntry !! ptrtag
- code' = mkJumpToAddr entry_addr
+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
+ else pure Nothing
+ let
itbl = StgInfoTable {
- entry = if ghciTablesNextToCode
+ entry = if tables_next_to_code
then Nothing
else Just entry_addr,
ptrs = fromIntegral ptr_words,
nptrs = fromIntegral nonptr_words,
tipe = CONSTR,
srtlen = fromIntegral tag,
- code = if ghciTablesNextToCode
- then Just code'
- else Nothing
+ code = code'
}
+ castFunPtrToPtr <$> newExecConItbl tables_next_to_code itbl con_desc
-- -----------------------------------------------------------------------------
@@ -77,41 +73,48 @@ data Arch = ArchSPARC
| ArchPPC64
| ArchPPC64LE
| ArchS390X
- | ArchUnknown
deriving Show
-platform :: Arch
-platform =
+mkJumpToAddr :: MonadFail m => EntryFunPtr-> m ItblCodes
+mkJumpToAddr ptr = do
+ arch <- case mArch of
+ Just a -> pure a
+ Nothing ->
+ -- This code must not be called. You either need to add your
+ -- architecture as a distinct case to 'Arch' and 'mArch', or use
+ -- non-TABLES_NEXT_TO_CODE mode.
+ fail "mkJumpToAddr: Unknown obscure arch is not supported with TABLES_NEXT_TO_CODE"
+ pure $ mkJumpToAddr' arch ptr
+
+-- | 'Just' if it's a known OS, or 'Nothing' otherwise.
+mArch :: Maybe Arch
+mArch =
#if defined(sparc_HOST_ARCH)
- ArchSPARC
+ Just ArchSPARC
#elif defined(powerpc_HOST_ARCH)
- ArchPPC
+ Just ArchPPC
#elif defined(i386_HOST_ARCH)
- ArchX86
+ Just ArchX86
#elif defined(x86_64_HOST_ARCH)
- ArchX86_64
+ Just ArchX86_64
#elif defined(alpha_HOST_ARCH)
- ArchAlpha
+ Just ArchAlpha
#elif defined(arm_HOST_ARCH)
- ArchARM
+ Just ArchARM
#elif defined(aarch64_HOST_ARCH)
- ArchARM64
+ Just ArchARM64
#elif defined(powerpc64_HOST_ARCH)
- ArchPPC64
+ Just ArchPPC64
#elif defined(powerpc64le_HOST_ARCH)
- ArchPPC64LE
+ Just ArchPPC64LE
#elif defined(s390x_HOST_ARCH)
- ArchS390X
+ Just ArchS390X
#else
-# if defined(TABLES_NEXT_TO_CODE)
-# error Unimplemented architecture
-# else
- ArchUnknown
-# endif
+ Nothing
#endif
-mkJumpToAddr :: EntryFunPtr -> ItblCodes
-mkJumpToAddr a = case platform of
+mkJumpToAddr' :: Arch -> EntryFunPtr -> ItblCodes
+mkJumpToAddr' platform a = case platform of
ArchSPARC ->
-- After some consideration, we'll try this, where
-- 0x55555555 stands in for the address to jump to.
@@ -285,11 +288,6 @@ mkJumpToAddr a = case platform of
0xC0, 0x19, byte3 w64, byte2 w64, byte1 w64, byte0 w64,
0x07, 0xF1 ]
- -- This code must not be called. You either need to
- -- add your architecture as a distinct case or
- -- use non-TABLES_NEXT_TO_CODE mode
- ArchUnknown -> error "mkJumpToAddr: ArchUnknown is unsupported"
-
byte0 :: (Integral w) => w -> Word8
byte0 w = fromIntegral w
@@ -333,38 +331,40 @@ data StgConInfoTable = StgConInfoTable {
pokeConItbl
- :: Ptr StgConInfoTable -> Ptr StgConInfoTable -> StgConInfoTable
+ :: Bool -> Ptr StgConInfoTable -> Ptr StgConInfoTable -> StgConInfoTable
-> IO ()
-pokeConItbl wr_ptr _ex_ptr itbl = do
-#if defined(TABLES_NEXT_TO_CODE)
- -- Write the offset to the con_desc from the end of the standard InfoTable
- -- at the first byte.
- let con_desc_offset = conDesc itbl `minusPtr` (_ex_ptr `plusPtr` conInfoTableSizeB)
- (#poke StgConInfoTable, con_desc) wr_ptr con_desc_offset
-#else
- -- Write the con_desc address after the end of the info table.
- -- Use itblSize because CPP will not pick up PROFILING when calculating
- -- the offset.
- pokeByteOff wr_ptr itblSize (conDesc itbl)
-#endif
+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
+ -- at the first byte.
+ let con_desc_offset = conDesc itbl `minusPtr` (_ex_ptr `plusPtr` conInfoTableSizeB)
+ (#poke StgConInfoTable, con_desc) wr_ptr con_desc_offset
+ else do
+ -- Write the con_desc address after the end of the info table.
+ -- Use itblSize because CPP will not pick up PROFILING when calculating
+ -- the offset.
+ pokeByteOff wr_ptr itblSize (conDesc itbl)
pokeItbl (wr_ptr `plusPtr` (#offset StgConInfoTable, i)) (infoTable itbl)
-sizeOfEntryCode :: Int
-sizeOfEntryCode
- | not ghciTablesNextToCode = 0
- | otherwise =
- case mkJumpToAddr undefined of
+sizeOfEntryCode :: MonadFail m => Bool -> m Int
+sizeOfEntryCode tables_next_to_code
+ | not tables_next_to_code = pure 0
+ | otherwise = do
+ code' <- mkJumpToAddr undefined
+ pure $ case code' of
Left xs -> sizeOf (head xs) * length xs
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 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.
- sz = fromIntegral (conInfoTableSizeB + sizeOfEntryCode)
+ sz = fromIntegral $ conInfoTableSizeB + sz0
-- Note: we need to allocate the conDesc string next to the info
-- table, because on a 64-bit platform we reference this string
-- with a 32-bit offset relative to the info table, so if we
@@ -373,17 +373,15 @@ 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)
poke (castPtr wr_ptr `plusPtr` null_off) (0 :: Word8)
_flushExec sz ex_ptr -- Cache flush (if needed)
-#if defined(TABLES_NEXT_TO_CODE)
- return (castPtrToFunPtr (ex_ptr `plusPtr` conInfoTableSizeB))
-#else
- return (castPtrToFunPtr ex_ptr)
-#endif
+ pure $ if tables_next_to_code
+ then castPtrToFunPtr $ ex_ptr `plusPtr` conInfoTableSizeB
+ else castPtrToFunPtr ex_ptr
foreign import ccall unsafe "allocateExec"
_allocateExec :: CUInt -> Ptr (Ptr a) -> IO (Ptr a)
=====================================
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
=====================================
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
=====================================
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 it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6d172e63f3dd3590b0a57371efb8f924f1fcdf05...1c446220250dcada51d4bb33a0cc7d8ce572e8b6
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6d172e63f3dd3590b0a57371efb8f924f1fcdf05...1c446220250dcada51d4bb33a0cc7d8ce572e8b6
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200329/b29d4015/attachment-0001.html>
More information about the ghc-commits
mailing list