diff options
| author | Ian Lynagh <ian@well-typed.com> | 2013-02-20 14:08:39 +0000 |
|---|---|---|
| committer | Ian Lynagh <ian@well-typed.com> | 2013-02-21 00:50:13 +0000 |
| commit | 47235c332bc27ed7b0e9d65007f249e05bdac0ec (patch) | |
| tree | 7e974cfa8032babe25801b9f67ccd0dd93085a80 | |
| parent | ffd68b43d56852f78089c4384abe8906cb307a39 (diff) | |
| download | haskell-47235c332bc27ed7b0e9d65007f249e05bdac0ec.tar.gz | |
Some -dynamic-too fixes
| -rw-r--r-- | compiler/main/CodeOutput.lhs | 14 | ||||
| -rw-r--r-- | compiler/main/DriverPipeline.hs | 18 |
2 files changed, 23 insertions, 9 deletions
diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs index 047cc018da..817d789a93 100644 --- a/compiler/main/CodeOutput.lhs +++ b/compiler/main/CodeOutput.lhs @@ -145,12 +145,14 @@ outputAsm dflags filenm cmm_stream = do ncg_uniqs <- mkSplitUniqSupply 'n' let filenmDyn = filenm ++ "-dyn" - withHandles f = doOutput filenm $ \h -> - ifGeneratingDynamicToo dflags - (doOutput filenmDyn $ \dynH -> - f [(h, dflags), - (dynH, doDynamicToo dflags)]) - (f [(h, dflags)]) + withHandles f = do debugTraceMsg dflags 4 (text "Outputing asm to" <+> text filenm) + doOutput filenm $ \h -> + ifGeneratingDynamicToo dflags + (do debugTraceMsg dflags 4 (text "Outputing dynamic-too asm to" <+> text filenmDyn) + doOutput filenmDyn $ \dynH -> + f [(h, dflags), + (dynH, doDynamicToo dflags)]) + (f [(h, dflags)]) _ <- {-# SCC "OutputAsm" #-} withHandles $ \hs -> {-# SCC "NativeCodeGen" #-} diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 62ff424bb6..fa3b9dcad8 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -482,6 +482,7 @@ data PipelineOutput -- eg. in "ghc -c Foo.hs" the output goes into ./Foo.o. | SpecificFile FilePath -- ^ The output must go into the specified file. + deriving Show -- | Run a compilation pipeline, consisting of multiple phases. -- @@ -563,8 +564,9 @@ runPipeline stop_phase hsc_env0 (input_fn, mb_phase) SpecificFile fn -> SpecificFile (replaceExtension fn (objectSuf dflags')) Persistent -> Persistent Temporary -> Temporary + env' = env { output_spec = output' } hsc_env' <- newHscEnv dflags' - _ <- runPipeline' start_phase stop_phase hsc_env' env input_fn + _ <- runPipeline' start_phase stop_phase hsc_env' env' input_fn output' maybe_loc maybe_stub_o return () return r @@ -1023,8 +1025,11 @@ runPhase (Hsc src_flavour) input_fn dflags0 setStubO stub_o -- In the case of hs-boot files, generate a dummy .o-boot -- stamp file for the benefit of Make - when (isHsBoot src_flavour) $ + when (isHsBoot src_flavour) $ do liftIO $ touchObjectFile dflags' o_file + whenGeneratingDynamicToo dflags' $ do + let dyn_o_file = addBootSuffix (replaceExtension o_file (dynObjectSuf dflags')) + liftIO $ touchObjectFile dflags' dyn_o_file return (next_phase, output_fn) ----------------------------------------------------------------------------- @@ -1275,8 +1280,15 @@ runPhase As input_fn dflags , SysTools.FileOption "" outputFilename ]) + liftIO $ debugTraceMsg dflags 4 (text "Running the assembler") runAssembler input_fn output_fn - whenGeneratingDynamicToo dflags $ + -- If we're compiling a Haskell module (isHaskellishFile), and + -- we're doing -dynamic-too, then we also need to assemble the + -- -dyn assembly file. + env <- getPipeEnv + when (pe_isHaskellishFile env) $ whenGeneratingDynamicToo dflags $ do + liftIO $ debugTraceMsg dflags 4 + (text "Running the assembler again for -dynamic-too") runAssembler (input_fn ++ "-dyn") (replaceExtension output_fn (dynObjectSuf dflags)) |