
I'm using the GHC API in GHC 7.2, and running into some problems. For background, I have working code that uses compileExpr to get a value from a dynamically loaded module. However, I'd like to do some profiling, and it appears that compileExpr doesn't work from executables that are built with profiling. So instead, I tried to take a more circuitous route... I'm using getModuleInfo and modInfoTyThings to get a list of all the declarations in the module, and finding the one I want, which I call var. This all works fine, and I can print the type and the name, and I know I have the right thing and it's got the correct type. But then I do: session <- getSession v <- liftIO $ getHValue session var return (unsafeCoerce# v) and I get a segfault when I try to access the resulting value. Keep in mind that this is the same value that works fine when I access it with compileExpr on an expression I've constructed to retrieve it. Any ideas what's going on? Am I missing a step? -- Chris Smith

Okay, I should have waited until morning to post this... so actually, things still work fine when I build without profiling. However, when I build with profiling, I get the segfault. I'm guessing either I need to set different dynamic flags with the profiling build to match the options of the compiler that built the executable... or perhaps it's still impossible to do what I'm looking for with profiling enabled. Does anyone know which is the case? -- Chris

I don't think you can link GHCi with binaries compiled in profiling
mode. You'll have to build an executable.
On 28 August 2011 16:38, Chris Smith
Okay, I should have waited until morning to post this... so actually, things still work fine when I build without profiling. However, when I build with profiling, I get the segfault. I'm guessing either I need to set different dynamic flags with the profiling build to match the options of the compiler that built the executable... or perhaps it's still impossible to do what I'm looking for with profiling enabled. Does anyone know which is the case?
-- Chris
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
-- Push the envelope. Watch it bend.

On Sun, 2011-08-28 at 17:47 +0100, Thomas Schilling wrote:
I don't think you can link GHCi with binaries compiled in profiling mode. You'll have to build an executable.
Okay... sorry to be obtuse, but what exactly does this mean? I'm not using GHCi at all: I *am* in an executable built with profiling info. I'm doing this: dflags <- GHC.getSessionDynFlags let dflags' = dflags { GHC.ghcMode = GHC.CompManager, GHC.ghcLink = GHC.LinkInMemory, GHC.hscTarget = GHC.HscAsm, GHC.optLevel = 2, GHC.safeHaskell = GHC.Sf_Safe, GHC.packageFlags = [GHC.TrustPackage "gloss" ], GHC.log_action = addErrorTo codeErrors } GHC.setSessionDynFlags dflags' target <- GHC.guessTarget filename Nothing GHC.setTargets [target] r <- fmap GHC.succeeded (GHC.load GHC.LoadAllTargets) and then if r is true: mods <- GHC.getModuleGraph let mainMod = GHC.ms_mod (head mods) Just mi <- GHC.getModuleInfo mainMod let tyThings = GHC.modInfoTyThings mi let var = chooseTopLevel varname tyThings session <- GHC.getSession v <- GHC.liftIO $ GHC.getHValue session (GHC.varName var) return (unsafeCoerce# v) Here, I know that chooseTopLevel is working, but the getHValue part only works without profiling. So is this still hopeless, or do I just need to find the right additional flags to add to dflags'? -- Chris Smith

OK, I guess I misunderstood you. I don't know how SafeHaskell works,
so I don't know whether there might be some interaction. I know that
profiling is a static flag which must be set when you initialise the
session and cannot be changed afterwards. I assume you are doing
that.
I checked the source code for getHValue (in 7.0.4) and it calls
linkDependencies if the name is external (not 100 percent sure what
that means). There is an interesting comment in linkDependencies,
though:
-- The interpreter and dynamic linker can only handle object code built
-- the "normal" way, i.e. no non-std ways like profiling or ticky-ticky.
-- So here we check the build tag: if we're building a non-standard way
-- then we need to find & link object files built the "normal" way.
This is what I've was referring to in my previous mail. Even though
you're compiling to machine code, you are using the in-memory linker
(i.e., the GHCi linker). It seems like that this is a fundamental
limitation of the internal linker. You may be using it in a way that
doesn't trigger the sanity check and end up causing a panic. I
suggest you pose this question on the glasgow-haskell-users mailing
list.
On 28 August 2011 17:57, Chris Smith
On Sun, 2011-08-28 at 17:47 +0100, Thomas Schilling wrote:
I don't think you can link GHCi with binaries compiled in profiling mode. You'll have to build an executable.
Okay... sorry to be obtuse, but what exactly does this mean? I'm not using GHCi at all: I *am* in an executable built with profiling info.
I'm doing this:
dflags <- GHC.getSessionDynFlags let dflags' = dflags { GHC.ghcMode = GHC.CompManager, GHC.ghcLink = GHC.LinkInMemory, GHC.hscTarget = GHC.HscAsm, GHC.optLevel = 2, GHC.safeHaskell = GHC.Sf_Safe, GHC.packageFlags = [GHC.TrustPackage "gloss" ], GHC.log_action = addErrorTo codeErrors } GHC.setSessionDynFlags dflags' target <- GHC.guessTarget filename Nothing GHC.setTargets [target] r <- fmap GHC.succeeded (GHC.load GHC.LoadAllTargets)
and then if r is true:
mods <- GHC.getModuleGraph let mainMod = GHC.ms_mod (head mods) Just mi <- GHC.getModuleInfo mainMod let tyThings = GHC.modInfoTyThings mi let var = chooseTopLevel varname tyThings session <- GHC.getSession v <- GHC.liftIO $ GHC.getHValue session (GHC.varName var) return (unsafeCoerce# v)
Here, I know that chooseTopLevel is working, but the getHValue part only works without profiling. So is this still hopeless, or do I just need to find the right additional flags to add to dflags'?
-- Chris Smith
-- Push the envelope. Watch it bend.

Hi,
This is what I've was referring to in my previous mail. Even though you're compiling to machine code, you are using the in-memory linker (i.e., the GHCi linker). It seems like that this is a fundamental limitation of the internal linker. You may be using it in a way that doesn't trigger the sanity check and end up causing a panic.
I had similar problems when trying to profile an executable that was using certain parts of the GHC API [1]. If you are using parts of the GHC API that are related to the GHCi profiling API bug [2], then you will get errors/segfaults. AFAIK, a better error message was never implemented for GHC API users, only for building GHCi in profiling mode. -- Christiaan Baaij [1] http://hackage.haskell.org/trac/ghc/ticket/3285 [2] http://hackage.haskell.org/trac/ghc/ticket/2197

On 11-08-28 11:38 AM, Chris Smith wrote:
Okay, I should have waited until morning to post this... so actually, things still work fine when I build without profiling. However, when I build with profiling, I get the segfault. I'm guessing either I need to set different dynamic flags with the profiling build to match the options of the compiler that built the executable... or perhaps it's still impossible to do what I'm looking for with profiling enabled. Does anyone know which is the case?
Inspired by thees facts: A. all other aspects of GHC are so keen on never mixing profiling-built code with non-profiling-built code B. GHC API loads modules from disk, regardless of whether the same module is already part of the executable. And then, stuff from loaded modules is expected to be compatible with stuff from the executable, e.g., x <- unsafeCoerce `liftM` getHValue blah blah print x x is from loaded code, print is from executable code, we mix them. (After all, presumably the executable got its code from the same origin.) I hypothesize that your program is made to mix profiling-built code (in the executable, such as print) with non-profiling-built code (in loaded modules, such as x). They probably don't mix well. I don't know how to convince GHC API to load modules from profiling libraries.
participants (4)
-
Albert Y. C. Lai
-
Chris Smith
-
Christiaan Baaij
-
Thomas Schilling