From 713063076560e0a8e23de6c361e5df8218004e41 Mon Sep 17 00:00:00 2001 From: simonmar Date: Tue, 12 Jul 2005 11:55:17 +0000 Subject: [PATCH] [project @ 2005-07-12 11:55:17 by simonmar] Use stgMallocBytesRWX for allocating info tables, since the memory needs to be executable (not sure how this is working on OpenBSD right now, but it definitely breaks on x86_64/Linux). --- ghc/compiler/ghci/ByteCodeItbls.lhs | 80 ++++++++++++++++++++++++----------- 1 file changed, 55 insertions(+), 25 deletions(-) diff --git a/ghc/compiler/ghci/ByteCodeItbls.lhs b/ghc/compiler/ghci/ByteCodeItbls.lhs index 835fd2a..190da9b 100644 --- a/ghc/compiler/ghci/ByteCodeItbls.lhs +++ b/ghc/compiler/ghci/ByteCodeItbls.lhs @@ -16,13 +16,13 @@ import NameEnv import SMRep ( typeCgRep ) import DataCon ( DataCon, dataConRepArgTys ) import TyCon ( TyCon, tyConFamilySize, isDataTyCon, tyConDataCons ) -import Constants ( mIN_SIZE_NonUpdHeapObject ) +import Constants ( mIN_SIZE_NonUpdHeapObject, wORD_SIZE ) import CgHeapery ( mkVirtHeapOffsets ) import FastString ( FastString(..) ) import Util ( lengthIs, listLengthCmp ) -import Foreign ( Storable(..), Word8, Word16, Word32, Word64, - malloc, castPtr, plusPtr ) +import Foreign +import Foreign.C import DATA_BITS ( Bits(..), shiftR ) import GHC.Exts ( Int(I#), addr2Int# ) @@ -107,7 +107,7 @@ make_constr_itbls cons -- This is the only arch-dependent bit. code = mkJumpToAddr entry_addr in - do addr <- malloc + do addr <- malloc_exec (sizeOf itbl) --putStrLn ("SIZE of itbl is " ++ show (sizeOf itbl)) --putStrLn ("# ptrs of itbl is " ++ show ptrs) --putStrLn ("# nptrs of itbl is " ++ show nptrs_really) @@ -172,26 +172,45 @@ mkJumpToAddr a = 0x7D8903A6, 0x4E800420 ] -#elif i386_TARGET_ARCH || x86_64_TARGET_ARCH +#elif i386_TARGET_ARCH -- Let the address to jump to be 0xWWXXYYZZ. -- Generate movl $0xWWXXYYZZ,%eax ; jmp *%eax -- which is -- B8 ZZ YY XX WW FF E0 --- This works on x86_64 too, because we're assuming the small memory --- model, where all symbols fit into the lower 2Gb. - type ItblCode = Word8 mkJumpToAddr a - = let w32 = fromIntegral (ptrToInt a) + = let w32 = fromIntegral (ptrToInt a) :: Word32 insnBytes :: [Word8] insnBytes - = [0xB8, byte 0 w32, byte 1 w32, - byte 2 w32, byte 3 w32, + = [0xB8, byte0 w32, byte1 w32, + byte2 w32, byte3 w32, 0xFF, 0xE0] in insnBytes +#elif x86_64_TARGET_ARCH +-- Generates: +-- jmpq *.L1(%rip) +-- .align 8 +-- .L1: +-- .quad +-- +-- We need a full 64-bit pointer (we can't assume the info table is +-- allocated in low memory). Assuming the info pointer is aligned to +-- an 8-byte boundary, the addr will also be aligned. + +type ItblCode = Word8 +mkJumpToAddr a + = let w64 = fromIntegral (ptrToInt a) :: Word64 + insnBytes :: [Word8] + insnBytes + = [0xff, 0x25, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, + byte0 w64, byte1 w64, byte2 w64, byte3 w64, + byte4 w64, byte5 w64, byte6 w64, byte7 w64] + in + insnBytes + #elif alpha_TARGET_ARCH type ItblCode = Word32 mkJumpToAddr a @@ -210,11 +229,16 @@ mkJumpToAddr a #endif -byte :: Int -> Word32 -> Word8 -byte 0 w = fromIntegral (w .&. 0xFF) -byte 1 w = fromIntegral ((w `shiftR` 8) .&. 0xFF) -byte 2 w = fromIntegral ((w `shiftR` 16) .&. 0xFF) -byte 3 w = fromIntegral ((w `shiftR` 24) .&. 0xFF) +byte0, byte1, byte2, byte3, byte4, byte5, byte6, byte7 + :: (Integral w, Bits w) => w -> Word8 +byte0 w = fromIntegral w +byte1 w = fromIntegral (w `shiftR` 8) +byte2 w = fromIntegral (w `shiftR` 16) +byte3 w = fromIntegral (w `shiftR` 24) +byte4 w = fromIntegral (w `shiftR` 32) +byte5 w = fromIntegral (w `shiftR` 40) +byte6 w = fromIntegral (w `shiftR` 48) +byte7 w = fromIntegral (w `shiftR` 56) vecret_entry 0 = stg_interp_constr1_entry @@ -228,16 +252,16 @@ vecret_entry 7 = stg_interp_constr8_entry #ifndef __HADDOCK__ -- entry point for direct returns for created constr itbls -foreign label "stg_interp_constr_entry" stg_interp_constr_entry :: Ptr () +foreign import ccall "&stg_interp_constr_entry" stg_interp_constr_entry :: Ptr () -- and the 8 vectored ones -foreign label "stg_interp_constr1_entry" stg_interp_constr1_entry :: Ptr () -foreign label "stg_interp_constr2_entry" stg_interp_constr2_entry :: Ptr () -foreign label "stg_interp_constr3_entry" stg_interp_constr3_entry :: Ptr () -foreign label "stg_interp_constr4_entry" stg_interp_constr4_entry :: Ptr () -foreign label "stg_interp_constr5_entry" stg_interp_constr5_entry :: Ptr () -foreign label "stg_interp_constr6_entry" stg_interp_constr6_entry :: Ptr () -foreign label "stg_interp_constr7_entry" stg_interp_constr7_entry :: Ptr () -foreign label "stg_interp_constr8_entry" stg_interp_constr8_entry :: Ptr () +foreign import ccall "&stg_interp_constr1_entry" stg_interp_constr1_entry :: Ptr () +foreign import ccall "&stg_interp_constr2_entry" stg_interp_constr2_entry :: Ptr () +foreign import ccall "&stg_interp_constr3_entry" stg_interp_constr3_entry :: Ptr () +foreign import ccall "&stg_interp_constr4_entry" stg_interp_constr4_entry :: Ptr () +foreign import ccall "&stg_interp_constr5_entry" stg_interp_constr5_entry :: Ptr () +foreign import ccall "&stg_interp_constr6_entry" stg_interp_constr6_entry :: Ptr () +foreign import ccall "&stg_interp_constr7_entry" stg_interp_constr7_entry :: Ptr () +foreign import ccall "&stg_interp_constr8_entry" stg_interp_constr8_entry :: Ptr () #endif @@ -333,4 +357,10 @@ load :: Storable a => PtrIO a load = do addr <- advance lift (peek addr) +foreign import ccall unsafe "stgMallocBytesRWX" + _stgMallocBytesRWX :: CInt -> IO (Ptr a) + +malloc_exec :: Int -> IO (Ptr a) +malloc_exec bytes = _stgMallocBytesRWX (fromIntegral bytes) + \end{code} -- 1.7.10.4