ghci 8.4.4 → 8.6.1
raw patch · 7 files changed
+71/−151 lines, 7 filesdep +ghc-heapdep ~basedep ~containersdep ~ghc-boot
Dependencies added: ghc-heap
Dependency ranges changed: base, containers, ghc-boot, ghc-boot-th, template-haskell
Files
- GHCi/InfoTable.hsc +29/−102
- GHCi/Message.hs +23/−24
- GHCi/Run.hs +6/−1
- GHCi/TH.hs +2/−1
- GHCi/TH/Binary.hs +0/−17
- changelog.md +4/−0
- ghci.cabal +7/−6
GHCi/InfoTable.hsc view
@@ -9,71 +9,20 @@ -- We use the RTS data structures directly via hsc2hs. -- module GHCi.InfoTable- ( peekItbl, StgInfoTable(..)- , conInfoPtr+ ( #ifdef GHCI- , mkConInfoTable+ mkConInfoTable #endif ) where -#if !defined(TABLES_NEXT_TO_CODE)-import Data.Maybe (fromJust)-#endif+#ifdef GHCI import Foreign-import Foreign.C -- needed for 2nd stage-import GHC.Ptr -- needed for 2nd stage-import GHC.Exts -- needed for 2nd stage-import System.IO.Unsafe -- needed for 2nd stage--type ItblCodes = Either [Word8] [Word32]---- Ultra-minimalist version specially for constructors-#if SIZEOF_VOID_P == 8-type HalfWord = Word32-#elif SIZEOF_VOID_P == 4-type HalfWord = Word16-#else-#error Unknown SIZEOF_VOID_P+import Foreign.C+import GHC.Ptr+import GHC.Exts+import GHC.Exts.Heap #endif -type EntryFunPtr = FunPtr (Ptr () -> IO (Ptr ()))--data StgInfoTable = StgInfoTable {- entry :: Maybe EntryFunPtr, -- Just <=> not ghciTablesNextToCode- ptrs :: HalfWord,- nptrs :: HalfWord,- tipe :: HalfWord,- srtlen :: HalfWord,- code :: Maybe ItblCodes -- Just <=> ghciTablesNextToCode- }--peekItbl :: Ptr StgInfoTable -> IO StgInfoTable-peekItbl a0 = do-#if defined(TABLES_NEXT_TO_CODE)- let entry' = Nothing-#else- entry' <- Just <$> (#peek StgInfoTable, entry) a0-#endif- ptrs' <- (#peek StgInfoTable, layout.payload.ptrs) a0- nptrs' <- (#peek StgInfoTable, layout.payload.nptrs) a0- tipe' <- (#peek StgInfoTable, type) a0- srtlen' <- (#peek StgInfoTable, srt_bitmap) a0- return StgInfoTable- { entry = entry'- , ptrs = ptrs'- , nptrs = nptrs'- , tipe = tipe'- , srtlen = srtlen'- , code = Nothing- }---- | Convert a pointer to an StgConInfo into an info pointer that can be--- used in the header of a closure.-conInfoPtr :: Ptr () -> Ptr ()-conInfoPtr ptr- | ghciTablesNextToCode = ptr `plusPtr` (#size StgConInfoTable)- | otherwise = ptr- ghciTablesNextToCode :: Bool #ifdef TABLES_NEXT_TO_CODE ghciTablesNextToCode = True@@ -82,6 +31,9 @@ #endif #ifdef GHCI /* To end */+-- 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 -> Int -- non-ptr words@@ -103,7 +55,7 @@ else Just entry_addr, ptrs = fromIntegral ptr_words, nptrs = fromIntegral nonptr_words,- tipe = fromIntegral cONSTR,+ tipe = CONSTR, srtlen = fromIntegral tag, code = if ghciTablesNextToCode then Just code'@@ -368,12 +320,17 @@ pokeConItbl :: Ptr StgConInfoTable -> Ptr StgConInfoTable -> StgConInfoTable -> IO ()-pokeConItbl wr_ptr ex_ptr itbl = do- let _con_desc = conDesc itbl `minusPtr` (ex_ptr `plusPtr` conInfoTableSizeB)+pokeConItbl wr_ptr _ex_ptr itbl = do #if defined(TABLES_NEXT_TO_CODE)- (#poke StgConInfoTable, con_desc) wr_ptr _con_desc+ -- 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- (#poke StgConInfoTable, con_desc) wr_ptr (conDesc itbl)+ -- 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 pokeItbl (wr_ptr `plusPtr` (#offset StgConInfoTable, i)) (infoTable itbl) @@ -385,28 +342,14 @@ Left xs -> sizeOf (head xs) * length xs Right xs -> sizeOf (head xs) * length xs -pokeItbl :: Ptr StgInfoTable -> StgInfoTable -> IO ()-pokeItbl a0 itbl = do-#if !defined(TABLES_NEXT_TO_CODE)- (#poke StgInfoTable, entry) a0 (fromJust (entry itbl))-#endif- (#poke StgInfoTable, layout.payload.ptrs) a0 (ptrs itbl)- (#poke StgInfoTable, layout.payload.nptrs) a0 (nptrs itbl)- (#poke StgInfoTable, type) a0 (tipe itbl)- (#poke StgInfoTable, srt_bitmap) a0 (srtlen itbl)-#if defined(TABLES_NEXT_TO_CODE)- let code_offset = (a0 `plusPtr` (#offset StgInfoTable, code))- case code itbl of- Nothing -> return ()- Just (Left xs) -> pokeArray code_offset xs- Just (Right xs) -> pokeArray code_offset xs-#endif-+-- Note: Must return proper pointer for use in a closure newExecConItbl :: StgInfoTable -> [Word8] -> IO (FunPtr ()) newExecConItbl obj con_desc = alloca $ \pcode -> do let lcon_desc = length con_desc + 1{- null terminator -}- sz = fromIntegral ((#size StgConInfoTable) + sizeOfEntryCode)+ -- SCARY+ -- This size represents the number of bytes in an StgConInfoTable.+ sz = fromIntegral (conInfoTableSizeB + sizeOfEntryCode) -- 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@@ -418,7 +361,11 @@ pokeConItbl wr_ptr ex_ptr cinfo pokeArray0 0 (castPtr wr_ptr `plusPtr` fromIntegral sz) con_desc _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 foreign import ccall unsafe "allocateExec" _allocateExec :: CUInt -> Ptr (Ptr a) -> IO (Ptr a)@@ -432,26 +379,6 @@ wORD_SIZE :: Int wORD_SIZE = (#const SIZEOF_HSINT) -fixedInfoTableSizeB :: Int-fixedInfoTableSizeB = 2 * wORD_SIZE--profInfoTableSizeB :: Int-profInfoTableSizeB = (#size StgProfInfo)--stdInfoTableSizeB :: Int-stdInfoTableSizeB- = (if ghciTablesNextToCode then 0 else wORD_SIZE)- + (if rtsIsProfiled then profInfoTableSizeB else 0)- + fixedInfoTableSizeB- conInfoTableSizeB :: Int-conInfoTableSizeB = stdInfoTableSizeB + wORD_SIZE--foreign import ccall unsafe "rts_isProfiled" rtsIsProfiledIO :: IO CInt--rtsIsProfiled :: Bool-rtsIsProfiled = unsafeDupablePerformIO rtsIsProfiledIO /= 0--cONSTR :: Int -- Defined in ClosureTypes.h-cONSTR = (#const CONSTR)+conInfoTableSizeB = wORD_SIZE + itblSize #endif /* GHCI */
GHCi/Message.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE GADTs, DeriveGeneric, StandaloneDeriving, ScopedTypeVariables,- GeneralizedNewtypeDeriving, ExistentialQuantification, RecordWildCards,- CPP #-}+ GeneralizedNewtypeDeriving, ExistentialQuantification, RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-orphans #-} -- |@@ -24,12 +23,12 @@ ) where import GHCi.RemoteTypes-import GHCi.InfoTable (StgInfoTable) import GHCi.FFI import GHCi.TH.Binary () import GHCi.BreakArray import GHC.LanguageExtensions+import GHC.Exts.Heap import GHC.ForeignSrcLang import GHC.Fingerprint import Control.Concurrent@@ -41,10 +40,7 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB import Data.Dynamic-#if MIN_VERSION_base(4,10,0)--- Previously this was re-exported by Data.Dynamic import Data.Typeable (TypeRep)-#endif import Data.IORef import Data.Map (Map) import GHC.Generics@@ -239,10 +235,11 @@ ReifyConStrictness :: TH.Name -> THMessage (THResult [TH.DecidedStrictness]) AddDependentFile :: FilePath -> THMessage (THResult ())+ AddTempFile :: String -> THMessage (THResult FilePath) AddModFinalizer :: RemoteRef (TH.Q ()) -> THMessage (THResult ()) AddCorePlugin :: String -> THMessage (THResult ()) AddTopDecls :: [TH.Dec] -> THMessage (THResult ())- AddForeignFile :: ForeignSrcLang -> String -> THMessage (THResult ())+ AddForeignFilePath :: ForeignSrcLang -> FilePath -> THMessage (THResult ()) IsExtEnabled :: Extension -> THMessage (THResult Bool) ExtsEnabled :: THMessage (THResult [Extension]) @@ -272,14 +269,15 @@ 8 -> THMsg <$> ReifyModule <$> get 9 -> THMsg <$> ReifyConStrictness <$> get 10 -> THMsg <$> AddDependentFile <$> get- 11 -> THMsg <$> AddTopDecls <$> get- 12 -> THMsg <$> (IsExtEnabled <$> get)- 13 -> THMsg <$> return ExtsEnabled- 14 -> THMsg <$> return StartRecover- 15 -> THMsg <$> EndRecover <$> get- 16 -> return (THMsg RunTHDone)- 17 -> THMsg <$> AddModFinalizer <$> get- 18 -> THMsg <$> (AddForeignFile <$> get <*> get)+ 11 -> THMsg <$> AddTempFile <$> get+ 12 -> THMsg <$> AddTopDecls <$> get+ 13 -> THMsg <$> (IsExtEnabled <$> get)+ 14 -> THMsg <$> return ExtsEnabled+ 15 -> THMsg <$> return StartRecover+ 16 -> THMsg <$> EndRecover <$> get+ 17 -> return (THMsg RunTHDone)+ 18 -> THMsg <$> AddModFinalizer <$> get+ 19 -> THMsg <$> (AddForeignFilePath <$> get <*> get) _ -> THMsg <$> AddCorePlugin <$> get putTHMessage :: THMessage a -> Put@@ -295,15 +293,16 @@ ReifyModule a -> putWord8 8 >> put a ReifyConStrictness a -> putWord8 9 >> put a AddDependentFile a -> putWord8 10 >> put a- AddTopDecls a -> putWord8 11 >> put a- IsExtEnabled a -> putWord8 12 >> put a- ExtsEnabled -> putWord8 13- StartRecover -> putWord8 14- EndRecover a -> putWord8 15 >> put a- RunTHDone -> putWord8 16- AddModFinalizer a -> putWord8 17 >> put a- AddForeignFile lang a -> putWord8 18 >> put lang >> put a- AddCorePlugin a -> putWord8 19 >> put a+ AddTempFile a -> putWord8 11 >> put a+ AddTopDecls a -> putWord8 12 >> put a+ IsExtEnabled a -> putWord8 13 >> put a+ ExtsEnabled -> putWord8 14+ StartRecover -> putWord8 15+ EndRecover a -> putWord8 16 >> put a+ RunTHDone -> putWord8 17+ AddModFinalizer a -> putWord8 18 >> put a+ AddForeignFilePath lang a -> putWord8 19 >> put lang >> put a+ AddCorePlugin a -> putWord8 20 >> put a data EvalOpts = EvalOpts
GHCi/Run.hs view
@@ -298,7 +298,12 @@ resetStepFlag :: IO () resetStepFlag = poke stepFlag 0 -type BreakpointCallback = Int# -> Int# -> Bool -> HValue -> IO ()+type BreakpointCallback+ = Int# -- the breakpoint index+ -> Int# -- the module uniq+ -> Bool -- exception?+ -> HValue -- the AP_STACK, or exception+ -> IO () foreign import ccall "&rts_breakpoint_io_action" breakPointIOAction :: Ptr (StablePtr BreakpointCallback)
GHCi/TH.hs view
@@ -195,8 +195,9 @@ qReifyConStrictness name = ghcCmd (ReifyConStrictness name) qLocation = fromMaybe noLoc . qsLocation <$> getState qAddDependentFile file = ghcCmd (AddDependentFile file)+ qAddTempFile suffix = ghcCmd (AddTempFile suffix) qAddTopDecls decls = ghcCmd (AddTopDecls decls)- qAddForeignFile str lang = ghcCmd (AddForeignFile str lang)+ qAddForeignFilePath lang fp = ghcCmd (AddForeignFilePath lang fp) qAddModFinalizer fin = GHCiQ (\s -> mkRemoteRef fin >>= return . (, s)) >>= ghcCmd . AddModFinalizer qAddCorePlugin str = ghcCmd (AddCorePlugin str)
GHCi/TH/Binary.hs view
@@ -1,5 +1,4 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -13,9 +12,6 @@ import GHC.Serialized import qualified Language.Haskell.TH as TH import qualified Language.Haskell.TH.Syntax as TH-#if !MIN_VERSION_base(4,10,0)-import Data.Typeable-#endif -- Put these in a separate module because they take ages to compile instance Binary TH.Loc@@ -75,16 +71,3 @@ instance Binary Serialized where put (Serialized tyrep wds) = put tyrep >> put (B.pack wds) get = Serialized <$> get <*> (B.unpack <$> get)---- Typeable and related instances live in binary since GHC 8.2-#if !MIN_VERSION_base(4,10,0)-instance Binary TyCon where- put tc = put (tyConPackage tc) >> put (tyConModule tc) >> put (tyConName tc)- get = mkTyCon3 <$> get <*> get <*> get--instance Binary TypeRep where- put type_rep = put (splitTyConApp type_rep)- get = do- (ty_con, child_type_reps) <- get- return (mkTyConApp ty_con child_type_reps)-#endif
changelog.md view
@@ -1,3 +1,7 @@+## 8.2.2 Nov 2017++ * Bundled with GHC 8.2.2+ ## 8.0.1 *Feb 2016* * Bundled with GHC 8.0.1
ghci.cabal view
@@ -1,5 +1,5 @@ name: ghci-version: 8.4.4+version: 8.6.1 license: BSD3 license-file: LICENSE category: GHC@@ -66,15 +66,16 @@ Build-Depends: array == 0.5.*,- base >= 4.8 && < 4.12,+ base >= 4.8 && < 4.13, binary == 0.8.*, bytestring == 0.10.*,- containers == 0.5.*,+ containers >= 0.5 && < 0.7, deepseq == 1.4.*, filepath == 1.4.*,- ghc-boot == 8.4.4,- ghc-boot-th == 8.4.4,- template-haskell == 2.13.*,+ ghc-boot == 8.6.1,+ ghc-boot-th == 8.6.1,+ ghc-heap == 8.6.1,+ template-haskell == 2.14.*, transformers == 0.5.* if !os(windows)