diff options
author | Ben Gamari <ben@smart-cactus.org> | 2021-07-12 20:07:59 -0400 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-07-27 04:47:51 -0400 |
commit | 0e875c3f1d7373812ddae9962edfc9538465d2ed (patch) | |
tree | 49a86dcbe6b875c042dc3e21070114a8cd4d5471 /libraries | |
parent | 3b07d8270341725c862230d8aec213fe34bd9fb6 (diff) | |
download | haskell-0e875c3f1d7373812ddae9962edfc9538465d2ed.tar.gz |
rts: Introduce and use ExecPage abstraction
Here we introduce a very thin abstraction for allocating, filling, and
freezing executable pages to replace allocateExec.
Diffstat (limited to 'libraries')
-rw-r--r-- | libraries/ghci/GHCi/InfoTable.hsc | 93 |
1 files changed, 57 insertions, 36 deletions
diff --git a/libraries/ghci/GHCi/InfoTable.hsc b/libraries/ghci/GHCi/InfoTable.hsc index c5dd4f0db8..65989a6e5b 100644 --- a/libraries/ghci/GHCi/InfoTable.hsc +++ b/libraries/ghci/GHCi/InfoTable.hsc @@ -37,8 +37,8 @@ mkConInfoTable -> Int -- pointer tag -> ByteString -- con desc -> IO (Ptr StgInfoTable) - -- resulting info table is allocated with allocateExec(), and - -- should be freed with freeExec(). + -- resulting info table is allocated with allocateExecPage(), and + -- should be freed with freeExecPage(). mkConInfoTable tables_next_to_code ptr_words nonptr_words tag ptrtag con_desc = do let entry_addr = interpConstrEntry !! ptrtag @@ -326,28 +326,18 @@ sizeOfEntryCode tables_next_to_code -- Note: Must return proper pointer for use in a closure newExecConItbl :: Bool -> StgInfoTable -> ByteString -> IO (FunPtr ()) -newExecConItbl tables_next_to_code obj con_desc -#if RTS_LINKER_USE_MMAP && MIN_VERSION_rts(1,0,1) - = do -#else - = alloca $ \pcode -> do -#endif - 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 + 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 - -- allocated the string separately it might be out of range. -#if RTS_LINKER_USE_MMAP && MIN_VERSION_rts(1,0,1) - wr_ptr <- _allocateWrite (sz + fromIntegral lcon_desc) - let ex_ptr = wr_ptr -#else - wr_ptr <- _allocateExec (sz + fromIntegral lcon_desc) pcode - ex_ptr <- peek pcode -#endif +newExecConItbl tables_next_to_code obj con_desc = 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 + 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 + -- allocated the string separately it might be out of range. + + ex_ptr <- fillExecBuffer (sz + fromIntegral lcon_desc) $ \wr_ptr ex_ptr -> do let cinfo = StgConInfoTable { conDesc = ex_ptr `plusPtr` fromIntegral sz , infoTable = obj } pokeConItbl tables_next_to_code wr_ptr ex_ptr cinfo @@ -355,13 +345,37 @@ newExecConItbl tables_next_to_code obj con_desc 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 RTS_LINKER_USE_MMAP && MIN_VERSION_rts(1,0,1) - _markExec (sz + fromIntegral lcon_desc) ex_ptr -#endif - pure $ if tables_next_to_code - then castPtrToFunPtr $ ex_ptr `plusPtr` conInfoTableSizeB - else castPtrToFunPtr ex_ptr + + pure $ if tables_next_to_code + then castPtrToFunPtr $ ex_ptr `plusPtr` conInfoTableSizeB + else castPtrToFunPtr ex_ptr + +-- | Allocate a buffer of a given size, use the given action to fill it with +-- data, and mark it as executable. The action is given a writable pointer and +-- the executable pointer. Returns a pointer to the executable code. +fillExecBuffer :: CSize -> (Ptr a -> Ptr a -> IO ()) -> IO (Ptr a) + +#if MIN_VERSION_rts(1,0,2) + +data ExecPage + +foreign import ccall unsafe "allocateExecPage" + _allocateExecPage :: IO (Ptr ExecPage) + +foreign import ccall unsafe "freezeExecPage" + _freezeExecPage :: Ptr ExecPage -> IO () + +fillExecBuffer sz cont + -- we can only allocate single pages. This assumes a 4k page size which + -- isn't strictly correct but is a reasonable conservative lower bound. + | sz > 4096 = fail "withExecBuffer: Too large" + | otherwise = do + pg <- _allocateExecPage + cont (castPtr pg) (castPtr pg) + _freezeExecPage pg + return (castPtr pg) + +#elif MIN_VERSION_rts(1,0,1) foreign import ccall unsafe "allocateExec" _allocateExec :: CUInt -> Ptr (Ptr a) -> IO (Ptr a) @@ -369,12 +383,19 @@ foreign import ccall unsafe "allocateExec" foreign import ccall unsafe "flushExec" _flushExec :: CUInt -> Ptr a -> IO () -#if RTS_LINKER_USE_MMAP && MIN_VERSION_rts(1,0,1) -foreign import ccall unsafe "allocateWrite" - _allocateWrite :: CUInt -> IO (Ptr a) -foreign import ccall unsafe "markExec" - _markExec :: CUInt -> Ptr a -> IO () +fillExecBuffer sz cont = alloca $ \pcode -> do + wr_ptr <- _allocateExec (fromIntegral sz) pcode + ex_ptr <- peek pcode + cont wr_ptr ex_ptr + _flushExec (fromIntegral sz) ex_ptr -- Cache flush (if needed) + return (ex_ptr) + +#else + +#error hi + #endif + -- ----------------------------------------------------------------------------- -- Constants and config |