Avoid linear lookup in unload_wkr in the Linker
[ghc.git] / compiler / ghci / DebuggerUtils.hs
1 {-# LANGUAGE CPP #-}
2
3 module DebuggerUtils (
4 dataConInfoPtrToName,
5 ) where
6
7 import GHCi.InfoTable
8 import CmmInfo ( stdInfoTableSizeB )
9 import DynFlags
10 import FastString
11 import TcRnTypes
12 import TcRnMonad
13 import IfaceEnv
14 import Module
15 import OccName
16 import Name
17 import Outputable
18 import Util
19
20 import Data.Char
21 import Foreign
22 import Data.List
23
24 #include "HsVersions.h"
25
26 -- | Given a data constructor in the heap, find its Name.
27 -- The info tables for data constructors have a field which records
28 -- the source name of the constructor as a Ptr Word8 (UTF-8 encoded
29 -- string). The format is:
30 --
31 -- > Package:Module.Name
32 --
33 -- We use this string to lookup the interpreter's internal representation of the name
34 -- using the lookupOrig.
35 --
36 dataConInfoPtrToName :: Ptr () -> TcM (Either String Name)
37 dataConInfoPtrToName x = do
38 dflags <- getDynFlags
39 theString <- liftIO $ do
40 let ptr = castPtr x :: Ptr StgInfoTable
41 conDescAddress <- getConDescAddress dflags ptr
42 peekArray0 0 conDescAddress
43 let (pkg, mod, occ) = parse theString
44 pkgFS = mkFastStringByteList pkg
45 modFS = mkFastStringByteList mod
46 occFS = mkFastStringByteList occ
47 occName = mkOccNameFS OccName.dataName occFS
48 modName = mkModule (fsToUnitId pkgFS) (mkModuleNameFS modFS)
49 return (Left $ showSDoc dflags $ ppr modName <> dot <> ppr occName)
50 `recoverM` (Right `fmap` lookupOrig modName occName)
51
52 where
53
54 {- To find the string in the constructor's info table we need to consider
55 the layout of info tables relative to the entry code for a closure.
56
57 An info table can be next to the entry code for the closure, or it can
58 be separate. The former (faster) is used in registerised versions of ghc,
59 and the latter (portable) is for non-registerised versions.
60
61 The diagrams below show where the string is to be found relative to
62 the normal info table of the closure.
63
64 1) Code next to table:
65
66 --------------
67 | | <- pointer to the start of the string
68 --------------
69 | | <- the (start of the) info table structure
70 | |
71 | |
72 --------------
73 | entry code |
74 | .... |
75
76 In this case the pointer to the start of the string can be found in
77 the memory location _one word before_ the first entry in the normal info
78 table.
79
80 2) Code NOT next to table:
81
82 --------------
83 info table structure -> | *------------------> --------------
84 | | | entry code |
85 | | | .... |
86 --------------
87 ptr to start of str -> | |
88 --------------
89
90 In this case the pointer to the start of the string can be found
91 in the memory location: info_table_ptr + info_table_size
92 -}
93
94 getConDescAddress :: DynFlags -> Ptr StgInfoTable -> IO (Ptr Word8)
95 getConDescAddress dflags ptr
96 | ghciTablesNextToCode = do
97 let ptr' = ptr `plusPtr` (- wORD_SIZE dflags)
98 -- NB. the offset must be read as an Int32 not a Word32, so
99 -- that the sign is preserved when converting to an Int.
100 offsetToString <- fromIntegral <$> (peek ptr' :: IO Int32)
101 return $ (ptr `plusPtr` stdInfoTableSizeB dflags) `plusPtr` offsetToString
102 | otherwise =
103 peek $ intPtrToPtr $ ptrToIntPtr ptr + fromIntegral (stdInfoTableSizeB dflags)
104 -- parsing names is a little bit fiddly because we have a string in the form:
105 -- pkg:A.B.C.foo, and we want to split it into three parts: ("pkg", "A.B.C", "foo").
106 -- Thus we split at the leftmost colon and the rightmost occurrence of the dot.
107 -- It would be easier if the string was in the form pkg:A.B.C:foo, but alas
108 -- this is not the conventional way of writing Haskell names. We stick with
109 -- convention, even though it makes the parsing code more troublesome.
110 -- Warning: this code assumes that the string is well formed.
111 parse :: [Word8] -> ([Word8], [Word8], [Word8])
112 parse input
113 = ASSERT(all (`lengthExceeds` 0) ([pkg, mod, occ])) (pkg, mod, occ)
114 where
115 dot = fromIntegral (ord '.')
116 (pkg, rest1) = break (== fromIntegral (ord ':')) input
117 (mod, occ)
118 = (concat $ intersperse [dot] $ reverse modWords, occWord)
119 where
120 (modWords, occWord) = ASSERT(rest1 `lengthExceeds` 0) (parseModOcc [] (tail rest1))
121 parseModOcc :: [[Word8]] -> [Word8] -> ([[Word8]], [Word8])
122 -- We only look for dots if str could start with a module name,
123 -- i.e. if it starts with an upper case character.
124 -- Otherwise we might think that "X.:->" is the module name in
125 -- "X.:->.+", whereas actually "X" is the module name and
126 -- ":->.+" is a constructor name.
127 parseModOcc acc str@(c : _)
128 | isUpper $ chr $ fromIntegral c
129 = case break (== dot) str of
130 (top, []) -> (acc, top)
131 (top, _ : bot) -> parseModOcc (top : acc) bot
132 parseModOcc acc str = (acc, str)