From 1c446220250dcada51d4bb33a0cc7d8ce572e8b6 Mon Sep 17 00:00:00 2001 From: Joachim Breitner Date: Sun, 20 Jan 2019 19:25:26 -0500 Subject: 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 --- libraries/ghci/GHCi/InfoTable.hsc | 30 ++++++++++++------------------ libraries/ghci/GHCi/Message.hs | 7 ++++--- libraries/ghci/GHCi/Run.hs | 4 ++-- 3 files changed, 18 insertions(+), 23 deletions(-) (limited to 'libraries/ghci') 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 -- cgit v1.2.1