itblCode (ItblPtr ptr)
= (castPtr ptr)
#ifdef GHCI_TABLES_NEXT_TO_CODE
- `plusPtr` (wORD_SIZE * 2)
+ `plusPtr` (3 * wORD_SIZE)
#endif
type ItblEnv = NameEnv (Name, ItblPtr)
-- Assumes constructors are numbered from zero, not one
make_constr_itbls :: [DataCon] -> IO ItblEnv
make_constr_itbls cons
- | listLengthCmp cons 8 /= GT -- <= 8 elements in the list
- = do is <- mapM mk_vecret_itbl (zip cons [0..])
- return (mkItblEnv is)
- | otherwise
= do is <- mapM mk_dirret_itbl (zip cons [0..])
return (mkItblEnv is)
where
- mk_vecret_itbl (dcon, conNo)
- = mk_itbl dcon conNo (vecret_entry conNo)
mk_dirret_itbl (dcon, conNo)
= mk_itbl dcon conNo stg_interp_constr_entry
}
-- Make a piece of code to jump to "entry_label".
-- This is the only arch-dependent bit.
- -- addr <- newExec [itbl]
addrCon <- newExec [conInfoTbl]
- let addr = (castFunPtrToPtr addrCon) `plusPtr` 4 -- ToDo: remove magic number
--putStrLn ("SIZE of itbl is " ++ show (sizeOf itbl))
--putStrLn ("# ptrs of itbl is " ++ show ptrs)
--putStrLn ("# nptrs of itbl is " ++ show nptrs_really)
- -- return (getName dcon, ItblPtr (castFunPtrToPtr addr))
- return (getName dcon, ItblPtr addr)
+ return (getName dcon, ItblPtr (castFunPtrToPtr addrCon))
-- Make code which causes a jump to the given address. This is the
byte7 w = fromIntegral (w `shiftR` 56)
-vecret_entry 0 = stg_interp_constr1_entry
-vecret_entry 1 = stg_interp_constr2_entry
-vecret_entry 2 = stg_interp_constr3_entry
-vecret_entry 3 = stg_interp_constr4_entry
-vecret_entry 4 = stg_interp_constr5_entry
-vecret_entry 5 = stg_interp_constr6_entry
-vecret_entry 6 = stg_interp_constr7_entry
-vecret_entry 7 = stg_interp_constr8_entry
-
#ifndef __HADDOCK__
-- entry point for direct returns for created constr itbls
foreign import ccall "&stg_interp_constr_entry" stg_interp_constr_entry :: Ptr ()
--- and the 8 vectored ones
-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
alignment conInfoTable = SIZEOF_VOID_P
peek ptr
= runState (castPtr ptr) $ do
+#ifdef GHCI_TABLES_NEXT_TO_CODE
desc <- load
+#endif
itbl <- load
+#ifndef GHCI_TABLES_NEXT_TO_CODE
+ desc <- load
+#endif
return
StgConInfoTable
- { conDesc = desc
+ {
+#ifdef GHCI_TABLES_NEXT_TO_CODE
+ conDesc = castPtr $ ptr `plusPtr` wORD_SIZE `plusPtr` desc
+#else
+ conDesc = desc
+#endif
, infoTable = itbl
}
poke ptr itbl
= runState (castPtr ptr) $ do
- store (conDesc itbl)
+#ifdef GHCI_TABLES_NEXT_TO_CODE
+ store (conDesc itbl `minusPtr` (ptr `plusPtr` wORD_SIZE))
+#endif
store (infoTable itbl)
+#ifndef GHCI_TABLES_NEXT_TO_CODE
+ store (conDesc itbl)
+#endif
data StgInfoTable = StgInfoTable {
#ifndef GHCI_TABLES_NEXT_TO_CODE