This patch adds data constructor names into their info tables.
This is useful in the ghci debugger. It replaces the old scheme which
was based on tracking data con names in the linker.
ConTag, fIRST_TAG,
mkDataCon,
dataConRepType, dataConSig, dataConFullSig,
- dataConName, dataConTag, dataConTyCon, dataConUserType,
+ dataConName, dataConIdentity, dataConTag, dataConTyCon, dataConUserType,
dataConUnivTyVars, dataConExTyVars, dataConAllTyVars, dataConResTys,
dataConEqSpec, eqSpecPreds, dataConTheta, dataConStupidTheta,
dataConInstArgTys, dataConOrigArgTys,
dataConName :: DataCon -> Name
dataConName = dcName
+-- generate a name in the format: package:Module.OccName
+-- and the unique identity of the name
+dataConIdentity :: DataCon -> String
+dataConIdentity dataCon
+ = prettyName
+ where
+ prettyName = pretty packageModule ++ "." ++ pretty occ
+ nm = getName dataCon
+ packageModule = nameModule nm
+ occ = getOccName dataCon
+ pretty :: Outputable a => a -> String
+ pretty = showSDoc . ppr
+
dataConTag :: DataCon -> ConTag
dataConTag = dcTag
import Maybes
import Constants
+import Outputable
+
-------------------------------------------------------------------------
--
-- Generating the info table and code for a closure
cl_type srt_len layout_lit
; blks <- cgStmtsToBlocks body
- ; emitInfoTableAndCode info_lbl std_info extra_bits args blks }
+
+ ; conName <-
+ if is_con
+ then mkStringCLit $ fromJust conIdentity
+ else return (mkIntCLit 0)
+
+ ; emitInfoTableAndCode info_lbl std_info (extra_bits conName) args blks }
where
info_lbl = infoTableLabelFromCI cl_info
mb_con = isConstrClosure_maybe cl_info
is_con = isJust mb_con
- (srt_label,srt_len)
+ (srt_label,srt_len,conIdentity)
= case mb_con of
Just con -> -- Constructors don't have an SRT
-- We keep the *zero-indexed* tag in the srt_len
-- field of the info table.
- (mkIntCLit 0, fromIntegral (dataConTagZ con))
+ (mkIntCLit 0, fromIntegral (dataConTagZ con), Just $ dataConIdentity con)
Nothing -> -- Not a constructor
- srtLabelAndLength srt info_lbl
+ let (label, len) = srtLabelAndLength srt info_lbl
+ in (label, len, Nothing)
ptrs = closurePtrsSize cl_info
nptrs = size - ptrs
size = closureNonHdrSize cl_info
layout_lit = packHalfWordsCLit ptrs nptrs
- extra_bits
+ extra_bits conName
| is_fun = fun_extra_bits
- | is_con = []
+ | is_con = [conName]
| needs_srt = [srt_label]
| otherwise = []
import Name ( Name, getName )
import NameEnv
import SMRep ( typeCgRep )
-import DataCon ( DataCon, dataConRepArgTys )
+import DataCon ( DataCon, dataConRepArgTys, dataConIdentity )
import TyCon ( TyCon, tyConFamilySize, isDataTyCon, tyConDataCons )
import Constants ( mIN_PAYLOAD_SIZE, wORD_SIZE )
import CgHeapery ( mkVirtHeapOffsets )
import Foreign
import Foreign.C
+import Foreign.C.String
import Data.Bits ( Bits(..), shiftR )
import GHC.Exts ( Int(I#), addr2Int# )
import GHC.Ptr ( Ptr(..) )
+import GHC.Prim
+
+import Outputable
\end{code}
%************************************************************************
= mk_itbl dcon conNo stg_interp_constr_entry
mk_itbl :: DataCon -> Int -> Ptr () -> IO (Name,ItblPtr)
- mk_itbl dcon conNo entry_addr
- = let rep_args = [ (typeCgRep arg,arg)
- | arg <- dataConRepArgTys dcon ]
- (tot_wds, ptr_wds, _) = mkVirtHeapOffsets False{-not a THUNK-} rep_args
-
- ptrs = ptr_wds
- nptrs = tot_wds - ptr_wds
- nptrs_really
- | ptrs + nptrs >= mIN_PAYLOAD_SIZE = nptrs
- | otherwise = mIN_PAYLOAD_SIZE - ptrs
- itbl = StgInfoTable {
+ mk_itbl dcon conNo entry_addr = do
+ let rep_args = [ (typeCgRep arg,arg) | arg <- dataConRepArgTys dcon ]
+ (tot_wds, ptr_wds, _) = mkVirtHeapOffsets False{-not a THUNK-} rep_args
+
+ ptrs = ptr_wds
+ nptrs = tot_wds - ptr_wds
+ nptrs_really
+ | ptrs + nptrs >= mIN_PAYLOAD_SIZE = nptrs
+ | otherwise = mIN_PAYLOAD_SIZE - ptrs
+ code = mkJumpToAddr entry_addr
+ itbl = StgInfoTable {
#ifndef GHCI_TABLES_NEXT_TO_CODE
entry = entry_addr,
#endif
, code = code
#endif
}
- -- Make a piece of code to jump to "entry_label".
- -- This is the only arch-dependent bit.
- code = mkJumpToAddr entry_addr
- in
- do addr <- newExec [itbl]
+ qNameCString <- newCString $ dataConIdentity dcon
+ let conInfoTbl = StgConInfoTable {
+ conDesc = qNameCString,
+ infoTable = itbl
+ }
+ -- 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 (castFunPtrToPtr addr))
+ return (getName dcon, ItblPtr addr)
-- Make code which causes a jump to the given address. This is the
type HalfWord = Word16
#endif
+data StgConInfoTable = StgConInfoTable {
+ conDesc :: CString,
+ infoTable :: StgInfoTable
+}
+
+instance Storable StgConInfoTable where
+ sizeOf conInfoTable
+ = sum [ sizeOf (conDesc conInfoTable)
+ , sizeOf (infoTable conInfoTable) ]
+ alignment conInfoTable = SIZEOF_VOID_P
+ peek ptr
+ = runState (castPtr ptr) $ do
+ desc <- load
+ itbl <- load
+ return
+ StgConInfoTable
+ { conDesc = desc
+ , infoTable = itbl
+ }
+ poke ptr itbl
+ = runState (castPtr ptr) $ do
+ store (conDesc itbl)
+ store (infoTable itbl)
+
data StgInfoTable = StgInfoTable {
#ifndef GHCI_TABLES_NEXT_TO_CODE
entry :: Ptr (),
import ByteCodeAsm
import RtClosureInspect
import IfaceEnv
-import Config
import OccName
import TcRnMonad
-import Constants
-import Encoding
import Packages
import DriverPhases
import Finder
-- Standard libraries
import Control.Monad
-import Control.Arrow ( second )
import Data.IORef
import Data.List
import Foreign.Ptr
+import Foreign.C.Types
+import Foreign.C.String
+import Foreign.Storable
import System.IO
import System.Directory
#else
import PrelIOBase ( IO(..) )
#endif
+
\end{code}
-- Held, as usual, in dependency order; though I am not sure if
-- that is really important
pkgs_loaded :: [PackageId]
- ,dtacons_env :: DataConEnv
}
emptyPLS :: DynFlags -> PersistentLinkerState
itbl_env = emptyNameEnv,
pkgs_loaded = init_pkgs,
bcos_loaded = [],
- objs_loaded = []
- , dtacons_env = emptyAddressEnv
- }
+ objs_loaded = [] }
+
-- Packages that don't need loading, because the compiler
-- shares them with the interpreted program.
--
new_pls = pls { closure_env = new_closure_env }
writeIORef v_PersistentLinkerState new_pls
+-- | Given a data constructor, find its internal name.
+-- The info tables for data constructors have a field which records the source name
+-- of the constructor as a CString. The format is:
+--
+-- Package:Module.Name
+--
+-- We use this string to lookup the interpreter's internal representation of the name
+-- using the lookupOrig.
recoverDataCon :: a -> TcM Name
-recoverDataCon a = recoverDCInRTS a `recoverM` ioToTcRn (do
- mb_name <- recoverDCInDynEnv a
- maybe (fail "Linker.recoverDatacon: Name not found in Dyn Env")
- return
- mb_name)
-
--- | If a is a Constr closure, lookupDC returns either the Name of the DataCon or the
--- symbol if it is a nullary constructor
--- For instance, for a closure containing 'Just x' it would return the Name for Data.Maybe.Just
--- For a closure containing 'Nothing' it would return the String "DataziMaybe_Nothing_static_info"
-recoverDCInDynEnv :: a -> IO (Maybe Name)
-recoverDCInDynEnv a = do
- pls <- readIORef v_PersistentLinkerState
- let de = dtacons_env pls
- ctype <- getClosureType a
- if not (isConstr ctype)
- then putStrLn ("Not a Constr (" ++ show ctype ++ ")") >>
- return Nothing
- else do let infot = getInfoTablePtr a
- name = lookupAddressEnv de (castPtr$ infot `plusPtr` (wORD_SIZE*2))
- return name
-
-
-recoverDCInRTS :: a -> TcM Name
-recoverDCInRTS a = do
- ctype <- ioToTcRn$ getClosureType a
- if (not$ isConstr ctype)
- then fail "not Constr"
- else do
- Just symbol <- ioToTcRn$ lookupDataCon (getInfoTablePtr a)
- let (occ,mod) = (parse . lex) symbol
- lookupOrig mod occ
- where lex x = map zDecodeString . init . init . split '_' . removeLeadingUnderscore $ x
- parse [pkg, modName, occ] = (mkOccName OccName.dataName occ,
- mkModule (stringToPackageId pkg) (mkModuleName modName))
- parse [modName, occ] = (mkOccName OccName.dataName occ,
- mkModule mainPackageId (mkModuleName modName))
- split delim = let
- helper [] = Nothing
- helper x = Just . second (drop 1) . break (==delim) $ x
- in unfoldr helper
- removeLeadingUnderscore = if cLeadingUnderscore=="YES"
- then tail
- else id
+recoverDataCon x = do
+ theString <- ioToTcRn $ do
+ let ptr = getInfoTablePtr x
+ conDescAddress <- getConDescAddress ptr
+ peekCString conDescAddress
+ let (pkg, mod, occ) = parse theString
+ occName = mkOccName OccName.dataName occ
+ modName = mkModule (stringToPackageId pkg) (mkModuleName mod)
+ lookupOrig modName occName
+
+ where
+
+ {- To find the string in the constructor's info table we need to consider
+ the layout of info tables relative to the entry code for a closure.
+
+ An info table can be next to the entry code for the closure, or it can
+ be separate. The former (faster) is used in registerised versions of ghc,
+ and the latter (portable) is for non-registerised versions.
+
+ The diagrams below show where the string is to be found relative to
+ the normal info table of the closure.
+
+ 1) Code next to table:
+
+ --------------
+ | | <- pointer to the start of the string
+ --------------
+ | | <- the (start of the) info table structure
+ | |
+ | |
+ --------------
+ | entry code |
+ | .... |
+
+ In this case the pointer to the start of the string can be found in
+ the memory location _one word before_ the first entry in the normal info
+ table.
+
+ 2) Code NOT next to table:
+
+ --------------
+ info table structure -> | *------------------> --------------
+ | | | entry code |
+ | | | .... |
+ --------------
+ ptr to start of str -> | |
+ --------------
+
+ In this case the pointer to the start of the string can be found
+ in the memory location: info_table_ptr + info_table_size
+ -}
+
+ getConDescAddress :: Ptr StgInfoTable -> IO (Ptr CChar)
+ getConDescAddress ptr = do
+ peek $ intPtrToPtr $ (ptrToIntPtr ptr) + offset
+#ifdef GHCI_TABLES_NEXT_TO_CODE
+ where
+ -- subtract a word number of bytes
+ offset = negate (fromIntegral SIZEOF_VOID_P)
+#endif
+#ifndef GHCI_TABLES_NEXT_TO_CODE
+ where
+ -- add the standard info table size in bytes
+ infoTableSizeBytes = sTD_ITBL_SIZE * wORD_SIZE
+ offset = infoTableSizeBytes
+#endif
+
+ -- parsing names is a little bit fiddly because we have a string in the form:
+ -- pkg:A.B.C.foo, and we want to split it into three parts: ("pkg", "A.B.C", "foo").
+ -- Thus we split at the leftmost colon and the rightmost occurrence of the dot.
+ -- It would be easier if the string was in the form pkg:A.B.C:foo, but alas
+ -- this is not the conventional way of writing Haskell names. We stick with
+ -- convention, even though it makes the parsing code more troublesome.
+ -- Warning: this code assumes that the string is well formed.
+ parse :: String -> (String, String, String)
+ parse input
+ = ASSERT (all (>0) (map length [pkg, mod, occ])) (pkg, mod, occ)
+ where
+ (pkg, rest1) = break (==':') input
+ (mod, occ)
+ = (concat $ intersperse "." $ reverse modWords, occWord)
+ where
+ (modWords, occWord) = ASSERT (length rest1 > 0) (parseModOcc [] (tail rest1))
+ parseModOcc :: [String] -> String -> ([String], String)
+ parseModOcc acc str
+ = case break (== '.') str of
+ (top, []) -> (acc, top)
+ (top, '.':bot) -> parseModOcc (top : acc) bot
+
getHValue :: Name -> IO (Maybe HValue)
getHValue name = do
printDump (vcat [text "----- Linker state -----",
text "Pkgs:" <+> ppr (pkgs_loaded pls),
text "Objs:" <+> ppr (objs_loaded pls),
- text "BCOs:" <+> ppr (bcos_loaded pls),
- text "DataCons:" <+> ppr (dtacons_env pls)
- ])
+ text "BCOs:" <+> ppr (bcos_loaded pls)])
\end{code}
pls <- readIORef v_PersistentLinkerState
; let ie = itbl_env pls
ce = closure_env pls
- de = dtacons_env pls
-- Link the necessary packages and linkables
- ; (_,de_out, (root_hval:_)) <- linkSomeBCOs False ie ce de [root_ul_bco]
- ; writeIORef v_PersistentLinkerState (pls{dtacons_env=de_out})
+ ; (_, (root_hval:_)) <- linkSomeBCOs False ie ce [root_ul_bco]
; return root_hval
}}
where
gce = closure_env pls
final_ie = foldr plusNameEnv (itbl_env pls) ies
- (final_gce, final_de, linked_bcos) <- linkSomeBCOs True final_ie gce (dtacons_env pls) ul_bcos
+ (final_gce, linked_bcos) <- linkSomeBCOs True final_ie gce ul_bcos
-- What happens to these linked_bcos?
let pls2 = pls1 { closure_env = final_gce,
- dtacons_env = final_de,
itbl_env = final_ie }
writeIORef v_PersistentLinkerState pls2
-- True <=> add only toplevel BCOs to closure env
-> ItblEnv
-> ClosureEnv
- -> DataConEnv
-> [UnlinkedBCO]
- -> IO (ClosureEnv, DataConEnv, [HValue])
+ -> IO (ClosureEnv, [HValue])
-- The returned HValues are associated 1-1 with
-- the incoming unlinked BCOs. Each gives the
-- value of the corresponding unlinked BCO
-linkSomeBCOs toplevs_only ie ce_in de_in ul_bcos
+linkSomeBCOs toplevs_only ie ce_in ul_bcos
= do let nms = map unlinkedBCOName ul_bcos
hvals <- fixIO
( \ hvs -> let ce_out = extendClosureEnv ce_in (zipLazy nms hvs)
-- closure environment, which leads to trouble.
ASSERT (all (not . (`elemNameEnv` ce_in)) (map fst ce_additions))
extendClosureEnv ce_in ce_additions
- names = concatMap (ssElts . unlinkedBCOItbls) ul_bcos
- addresses <- mapM (lookupIE ie) names
- let de_additions = [(address, name) | (address, name) <- zip addresses names
- , not(address `elemAddressEnv` de_in)
- ]
- de_out = extendAddressEnvList de_in de_additions
- return ( ce_out, de_out, hvals)
+ return (ce_out, hvals)
\end{code}
unloadObj, -- :: String -> IO ()
insertSymbol, -- :: String -> String -> Ptr a -> IO ()
lookupSymbol, -- :: String -> IO (Maybe (Ptr a))
- resolveObjs, -- :: IO SuccessFlag
- lookupDataCon -- :: Ptr a -> IO (Maybe String)
+ resolveObjs -- :: IO SuccessFlag
) where
-import ByteCodeItbls ( StgInfoTable )
import Panic ( panic )
import BasicTypes ( SuccessFlag, successIf )
import Config ( cLeadingUnderscore )
import Foreign ( nullPtr )
import GHC.Exts ( Ptr(..), unsafeCoerce# )
-import Constants ( wORD_SIZE )
-import Foreign ( plusPtr )
-- ---------------------------------------------------------------------------
then return Nothing
else return (Just addr)
--- | Expects a Ptr to an info table, not to a closure
-lookupDataCon :: Ptr StgInfoTable -> IO (Maybe String)
-lookupDataCon ptr = do
- name <- c_lookupDataCon (ptr `plusPtr` (wORD_SIZE*2))
- if name == nullPtr
- then return Nothing
- else peekCString name >>= return . Just
-
prefixUnderscore :: String -> String
prefixUnderscore
| cLeadingUnderscore == "YES" = ('_':)
foreign import ccall unsafe "loadObj" c_loadObj :: CString -> IO Int
foreign import ccall unsafe "unloadObj" c_unloadObj :: CString -> IO Int
foreign import ccall unsafe "resolveObjs" c_resolveObjs :: IO Int
-foreign import ccall unsafe "lookupDataCon" c_lookupDataCon :: Ptr a -> IO CString
-
\end{code}
cvObtainTerm, -- :: HscEnv -> Bool -> Maybe Type -> HValue -> IO Term
- AddressEnv(..),
- DataConEnv,
- extendAddressEnvList,
- elemAddressEnv,
- delFromAddressEnv,
- emptyAddressEnv,
- lookupAddressEnv,
-
ClosureType(..),
getClosureData, -- :: a -> IO Closure
Closure ( tipe, infoTable, ptrs, nonPtrs ),
NOTE: (Num t) contexts have been manually replaced by Integer for clarity
-}
-
---------------------------------------------------------------------
--- The DataConEnv is used to store the addresses of datacons loaded
--- via the dynamic linker
---------------------------------------------------------------------
-
-type DataConEnv = AddressEnv StgInfoTable
-
--- Note that this AddressEnv and DataConEnv I wrote trying to follow
--- conventions in ghc, but probably they make not much sense.
-
-newtype AddressEnv a = AE {aenv:: FiniteMap (Ptr a) Name}
- deriving (Outputable)
-
-emptyAddressEnv = AE emptyFM
-
-extendAddressEnvList :: AddressEnv a -> [(Ptr a, Name)] -> AddressEnv a
-elemAddressEnv :: Ptr a -> AddressEnv a -> Bool
-delFromAddressEnv :: AddressEnv a -> Ptr a -> AddressEnv a
-nullAddressEnv :: AddressEnv a -> Bool
-lookupAddressEnv :: AddressEnv a -> Ptr a -> Maybe Name
-
-extendAddressEnvList (AE env) = AE . addListToFM env
-elemAddressEnv ptr (AE env) = ptr `elemFM` env
-delFromAddressEnv (AE env) = AE . delFromFM env
-nullAddressEnv = isEmptyFM . aenv
-lookupAddressEnv (AE env) = lookupFM env
-
-
-instance Outputable (Ptr a) where
- ppr = text . show
#define get_ret_itbl(c) (RET_INFO_PTR_TO_STRUCT((c)->header.info))
#define get_fun_itbl(c) (FUN_INFO_PTR_TO_STRUCT((c)->header.info))
#define get_thunk_itbl(c) (THUNK_INFO_PTR_TO_STRUCT((c)->header.info))
+#define get_con_itbl(c) (CON_INFO_PTR_TO_STRUCT((c)->header.info))
#define GET_TAG(con) (get_itbl(con)->srt_bitmap)
#define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)(info) - 1)
#define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)(info) - 1)
#define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)(info) - 1)
+#define CON_INFO_PTR_TO_STRUCT(info) ((StgConInfoTable *)(info) - 1)
#define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
#define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
#define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
+#define itbl_to_con_itbl(i) ((StgConInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
#else
#define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)info)
#define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)info)
#define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)info)
#define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)info)
+#define CON_INFO_PTR_TO_STRUCT(info) ((StgConInfoTable *)info)
#define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(i))
#define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(i))
#define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(i))
+#define itbl_to_con_itbl(i) ((StgConInfoTable *)(i))
#endif
/* -----------------------------------------------------------------------------
#endif
} StgThunkInfoTable;
+/* -----------------------------------------------------------------------------
+ Constructor info tables
+ -------------------------------------------------------------------------- */
+
+typedef struct _StgConInfoTable {
+#if !defined(TABLES_NEXT_TO_CODE)
+ StgInfoTable i;
+#endif
+
+char *con_desc; /* the name of the data constructor as: Package:Module.Name */
+
+#if defined(TABLES_NEXT_TO_CODE)
+ StgInfoTable i;
+#endif
+} StgConInfoTable;
+
/* -----------------------------------------------------------------------------
Accessor macros for fields that might be offsets (C version)
/* load a dynamic library */
char *addDLL( char* dll_name );
-/* lookup an address in the datacon tbl */
-char *lookupDataCon( StgWord addr);
-
extern void markRootPtrTable(void (*)(StgClosure **));
#endif /* LINKER_H */
/* Hash table mapping symbol names to StgStablePtr */
static /*Str*/HashTable *stablehash;
-#if defined(DEBUGGER)
-/* Hash table mapping info table ptrs to DataCon names */
-static HashTable *dchash;
-#endif
-
/* List of currently loaded objects */
ObjectCode *objects = NULL; /* initially empty */
SymX(insertStableSymbol) \
SymX(insertSymbol) \
SymX(lookupSymbol) \
- SymX(lookupDataCon) \
SymX(makeStablePtrzh_fast) \
SymX(minusIntegerzh_fast) \
SymX(mkApUpd0zh_fast) \
/* -----------------------------------------------------------------------------
* Insert symbols into hash tables, checking for duplicates.
*/
-int isSuffixOf(char* x, char* suffix);
static void ghciInsertStrHashTable ( char* obj_name,
HashTable *table,
if (lookupHashTable(table, (StgWord)key) == NULL)
{
insertStrHashTable(table, (StgWord)key, data);
-#if defined(DEBUGGER)
- // Insert the reverse pair in the datacon hash if it is a closure
- {
- if(isSuffixOf(key, "static_info") || isSuffixOf(key, "con_info")) {
- insertHashTable(dchash, (StgWord)data, key);
- // debugBelch("DChash addSymbol: %s (%p)\n", key, data);
- }
- }
-#endif
return;
}
debugBelch(
stablehash = allocStrHashTable();
symhash = allocStrHashTable();
-#if defined(DEBUGGER)
- dchash = allocHashTable();
-#endif
/* populate the symbol table with stuff from the RTS */
for (sym = rtsSyms; sym->lbl != NULL; sym++) {
}
}
-#if defined(DEBUGGER)
-char *
-lookupDataCon( StgWord addr )
-{
- void *val;
- initLinker() ;
- ASSERT(dchash != NULL);
- val = lookupHashTable(dchash, addr);
-
- return val;
-}
-#else
-char* lookupDataCon( StgWord addr )
-{
- return NULL;
-}
-#endif
-
static
__attribute((unused))
void *
#endif
-int isSuffixOf(char* x, char* suffix) {
- int suffix_len = strlen (suffix);
- int x_len = strlen (x);
-
- if (x_len == 0)
- return 0;
- if (suffix_len > x_len)
- return 0;
- if (suffix_len == 0)
- return 1;
-
- char* x_suffix = &x[strlen(x)-strlen(suffix)];
- return strcmp(x_suffix, suffix) == 0;
- }