Revert "Save a word in the info table on x86_64"
[ghc.git] / libraries / ghc-heap / GHC / Exts / Heap / InfoTableProf.hsc
1 module GHC.Exts.Heap.InfoTableProf
2     ( module GHC.Exts.Heap.InfoTable.Types
3     , itblSize
4     , peekItbl
5     , pokeItbl
6     ) where
7
8 -- This file overrides InfoTable.hsc's implementation of peekItbl and pokeItbl.
9 -- Manually defining PROFILING gives the #peek and #poke macros an accurate
10 -- representation of StgInfoTable_ when hsc2hs runs.
11 #define PROFILING
12 #include "Rts.h"
13
14 import GHC.Exts.Heap.InfoTable.Types
15 #if !defined(TABLES_NEXT_TO_CODE)
16 import GHC.Exts.Heap.Constants
17 import Data.Maybe
18 #endif
19 import Foreign
20
21 -- | Read an InfoTable from the heap into a haskell type.
22 -- WARNING: This code assumes it is passed a pointer to a "standard" info
23 -- table. If tables_next_to_code is enabled, it will look 1 byte before the
24 -- start for the entry field.
25 peekItbl :: Ptr StgInfoTable -> IO StgInfoTable
26 peekItbl a0 = do
27 #if !defined(TABLES_NEXT_TO_CODE)
28   let ptr = a0 `plusPtr` (negate wORD_SIZE)
29   entry' <- Just <$> (#peek struct StgInfoTable_, entry) ptr
30 #else
31   let ptr = a0
32       entry' = Nothing
33 #endif
34   ptrs'   <- (#peek struct StgInfoTable_, layout.payload.ptrs) ptr
35   nptrs'  <- (#peek struct StgInfoTable_, layout.payload.nptrs) ptr
36   tipe'   <- (#peek struct StgInfoTable_, type) ptr
37 #if __GLASGOW_HASKELL__ > 804
38   srtlen' <- (#peek struct StgInfoTable_, has_srt) a0
39 #else
40   srtlen' <- (#peek struct StgInfoTable_, srt_bitmap) ptr
41 #endif
42   return StgInfoTable
43     { entry  = entry'
44     , ptrs   = ptrs'
45     , nptrs  = nptrs'
46     , tipe   = toEnum (fromIntegral (tipe' :: HalfWord))
47     , srtlen = srtlen'
48     , code   = Nothing
49     }
50
51 pokeItbl :: Ptr StgInfoTable -> StgInfoTable -> IO ()
52 pokeItbl a0 itbl = do
53 #if !defined(TABLES_NEXT_TO_CODE)
54   (#poke StgInfoTable, entry) a0 (fromJust (entry itbl))
55 #endif
56   (#poke StgInfoTable, layout.payload.ptrs) a0 (ptrs itbl)
57   (#poke StgInfoTable, layout.payload.nptrs) a0 (nptrs itbl)
58   (#poke StgInfoTable, type) a0 (fromEnum (tipe itbl))
59 #if __GLASGOW_HASKELL__ > 804
60   (#poke StgInfoTable, has_srt) a0 (srtlen itbl)
61 #else
62   (#poke StgInfoTable, srt_bitmap) a0 (srtlen itbl)
63 #endif
64 #if defined(TABLES_NEXT_TO_CODE)
65   let code_offset = a0 `plusPtr` (#offset StgInfoTable, code)
66   case code itbl of
67     Nothing -> return ()
68     Just (Left xs) -> pokeArray code_offset xs
69     Just (Right xs) -> pokeArray code_offset xs
70 #endif
71
72 itblSize :: Int
73 itblSize = (#size struct StgInfoTable_)