X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FByteCodeItbls.lhs;h=863a7b730ecb1d6e543468a7e7a09578d2fc0657;hb=2423c249f5ca7785d0ec89eb33e72662da7561c1;hp=d990da2198cb40233a79a25516022ff2bd14245e;hpb=ab22f4e6456820c1b5169d75f5975a94e61f54ce;p=ghc-hetmet.git diff --git a/compiler/ghci/ByteCodeItbls.lhs b/compiler/ghci/ByteCodeItbls.lhs index d990da2..863a7b7 100644 --- a/compiler/ghci/ByteCodeItbls.lhs +++ b/compiler/ghci/ByteCodeItbls.lhs @@ -92,11 +92,16 @@ make_constr_itbls cons | ptrs + nptrs >= mIN_PAYLOAD_SIZE = nptrs | otherwise = mIN_PAYLOAD_SIZE - ptrs itbl = StgInfoTable { +#ifndef GHCI_TABLES_NEXT_TO_CODE + entry = entry_addr, +#endif ptrs = fromIntegral ptrs, nptrs = fromIntegral nptrs_really, tipe = fromIntegral cONSTR, - srtlen = fromIntegral conNo, - code = code + srtlen = fromIntegral conNo +#ifdef GHCI_TABLES_NEXT_TO_CODE + , code = code +#endif } -- Make a piece of code to jump to "entry_label". -- This is the only arch-dependent bit. @@ -107,7 +112,11 @@ make_constr_itbls cons --putStrLn ("# ptrs of itbl is " ++ show ptrs) --putStrLn ("# nptrs of itbl is " ++ show nptrs_really) poke addr itbl - return (getName dcon, addr `plusPtr` (2 * wORD_SIZE)) + return (getName dcon, addr +#ifdef GHCI_TABLES_NEXT_TO_CODE + `plusPtr` (2 * wORD_SIZE) +#endif + ) -- Make code which causes a jump to the given address. This is the @@ -270,48 +279,77 @@ type HalfWord = Word16 #endif data StgInfoTable = StgInfoTable { +#ifndef GHCI_TABLES_NEXT_TO_CODE + entry :: Ptr (), +#endif ptrs :: HalfWord, nptrs :: HalfWord, tipe :: HalfWord, - srtlen :: HalfWord, - code :: [ItblCode] -} + srtlen :: HalfWord +#ifdef GHCI_TABLES_NEXT_TO_CODE + , code :: [ItblCode] +#endif + } instance Storable StgInfoTable where sizeOf itbl = sum - [fieldSz ptrs itbl, + [ +#ifndef GHCI_TABLES_NEXT_TO_CODE + fieldSz entry itbl, +#endif + fieldSz ptrs itbl, fieldSz nptrs itbl, fieldSz tipe itbl, - fieldSz srtlen itbl, - fieldSz (head.code) itbl * itblCodeLength] + fieldSz srtlen itbl +#ifdef GHCI_TABLES_NEXT_TO_CODE + ,fieldSz (head.code) itbl * itblCodeLength +#endif + ] alignment itbl = SIZEOF_VOID_P poke a0 itbl = runState (castPtr a0) - $ do store (ptrs itbl) + $ do +#ifndef GHCI_TABLES_NEXT_TO_CODE + store (entry itbl) +#endif + store (ptrs itbl) store (nptrs itbl) store (tipe itbl) store (srtlen itbl) +#ifdef GHCI_TABLES_NEXT_TO_CODE sequence_ (map store (code itbl)) +#endif peek a0 = runState (castPtr a0) - $ do ptrs <- load + $ do +#ifndef GHCI_TABLES_NEXT_TO_CODE + entry <- load +#endif + ptrs <- load nptrs <- load tipe <- load srtlen <- load +#ifdef GHCI_TABLES_NEXT_TO_CODE code <- sequence (replicate itblCodeLength load) +#endif return StgInfoTable { +#ifndef GHCI_TABLES_NEXT_TO_CODE + entry = entry, +#endif ptrs = ptrs, nptrs = nptrs, tipe = tipe, - srtlen = srtlen, - code = code + srtlen = srtlen +#ifdef GHCI_TABLES_NEXT_TO_CODE + ,code = code +#endif } fieldSz :: (Storable a, Storable b) => (a -> b) -> a -> Int