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

3 files changed, 18 insertions, 23 deletions

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