[project @ 2006-01-06 16:30:17 by simonmar]
[ghc-hetmet.git] / ghc / compiler / main / DriverPipeline.hs
index a8fa8ce..171cecf 100644 (file)
@@ -157,8 +157,6 @@ compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do
 
    let dflags' = dflags { hscTarget = hsc_lang,
                                hscOutName = output_fn,
-                               hscStubCOutName = basename ++ "_stub.c",
-                               hscStubHOutName = basename ++ "_stub.h",
                                extCoreName = basename ++ ".hcr" }
 
    -- -no-recomp should also work with --make
@@ -192,7 +190,7 @@ compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do
        -> do
           stub_unlinked <-
             if stub_c_exists then do
-               stub_o <- compileStub dflags' object_filename
+               stub_o <- compileStub dflags' this_mod location
                return [ DotO stub_o ]
             else
                return []
@@ -235,8 +233,9 @@ compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do
 -----------------------------------------------------------------------------
 -- stub .h and .c files (for foreign export support)
 
--- The _stub.c file is derived from the haskell source file (but stored
--- in hscStubCOutName in the dflags for some reason, probably historical).
+-- The _stub.c file is derived from the haskell source file, possibly taking
+-- into account the -stubdir option.
+--
 -- Consequently, we derive the _stub.o filename from the haskell object
 -- filename.  
 --
@@ -250,12 +249,13 @@ compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do
 -- -odir obj, we would get obj/src/A_stub.o, which is wrong; we want
 -- obj/A_stub.o.
 
-compileStub dflags object_filename = do
-       let (o_base, o_ext) = splitFilename object_filename
+compileStub :: DynFlags -> Module -> ModLocation -> IO FilePath
+compileStub dflags mod location = do
+       let (o_base, o_ext) = splitFilename (ml_obj_file location)
            stub_o = o_base ++ "_stub" `joinFileExt` o_ext
 
        -- compile the _stub.c file w/ gcc
-       let stub_c = hscStubCOutName dflags
+       let (stub_c,_) = mkStubPaths dflags mod location
        runPipeline StopLn dflags (stub_c,Nothing) 
                (SpecificFile stub_o) Nothing{-no ModLocation-}
 
@@ -330,7 +330,10 @@ link BatchCompile dflags batch_attempt_linking hpt
                                 <+> text "...")
 
        -- Don't showPass in Batch mode; doLink will do that for us.
-        staticLink dflags obj_files pkg_deps
+       let link = case ghcLink dflags of
+               MkDLL       -> doMkDLL
+               StaticLink  -> staticLink
+       link dflags obj_files pkg_deps
 
         debugTraceMsg dflags 3 (text "link: done")
 
@@ -509,7 +512,7 @@ getOutputFilename dflags stop_phase output basename
  = func
  where
        hcsuf      = hcSuf dflags
-       odir       = outputDir dflags
+       odir       = objectDir dflags
        osuf       = objectSuf dflags
        keep_hc    = dopt Opt_KeepHcFiles dflags
        keep_raw_s = dopt Opt_KeepRawSFiles dflags
@@ -742,8 +745,6 @@ runPhase (Hsc src_flavour) stop dflags0 basename suff input_fn get_output_fn _ma
 
         let dflags' = dflags { hscTarget = hsc_lang,
                               hscOutName = output_fn,
-                              hscStubCOutName = basename ++ "_stub.c",
-                              hscStubHOutName = basename ++ "_stub.h",
                               extCoreName = basename ++ ".hcr" }
 
        hsc_env <- newHscEnv dflags'
@@ -774,7 +775,7 @@ runPhase (Hsc src_flavour) stop dflags0 basename suff input_fn get_output_fn _ma
                      _maybe_interpreted_code -> do
 
                when stub_c_exists $ do
-                       stub_o <- compileStub dflags' o_file
+                       stub_o <- compileStub dflags' mod_name location4
                        consIORef v_Ld_inputs stub_o
 
                -- In the case of hs-boot files, generate a dummy .o-boot 
@@ -802,8 +803,6 @@ runPhase Cmm stop dflags basename suff input_fn get_output_fn maybe_loc
 
         let dflags' = dflags { hscTarget = hsc_lang,
                               hscOutName = output_fn,
-                              hscStubCOutName = basename ++ "_stub.c",
-                              hscStubHOutName = basename ++ "_stub.h",
                               extCoreName = basename ++ ".hcr" }
 
        ok <- hscCmmFile dflags' input_fn
@@ -856,6 +855,23 @@ runPhase cc_phase stop dflags basename suff input_fn get_output_fn maybe_loc
                | otherwise         = As
        output_fn <- get_output_fn next_phase maybe_loc
 
+       let
+         more_hcc_opts =
+#if i386_TARGET_ARCH
+               -- on x86 the floating point regs have greater precision
+               -- than a double, which leads to unpredictable results.
+               -- By default, we turn this off with -ffloat-store unless
+               -- the user specified -fexcess-precision.
+               (if excessPrecision then [] else [ "-ffloat-store" ]) ++
+#endif
+               -- gcc's -fstrict-aliasing allows two accesses to memory
+               -- to be considered non-aliasing if they have different types.
+               -- This interacts badly with the C code we generate, which is
+               -- very weakly typed, being derived from C--.
+               ["-fno-strict-aliasing"]
+
+
+
        SysTools.runCc dflags (
                -- force the C compiler to interpret this file as C when
                -- compiling .hc files, by adding the -x c option.
@@ -872,11 +888,13 @@ runPhase cc_phase stop dflags basename suff input_fn get_output_fn maybe_loc
                       ++ (if hcc && mangle
                             then md_regd_c_flags
                             else [])
+                      ++ (if hcc 
+                            then more_hcc_opts
+                            else [])
                       ++ [ verb, "-S", "-Wimplicit", "-O" ]
                       ++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
                       ++ cc_opts
                       ++ split_opt
-                      ++ (if excessPrecision then [] else [ "-ffloat-store" ])
                       ++ include_paths
                       ++ pkg_extra_cc_opts
                       ))
@@ -969,7 +987,7 @@ runPhase SplitAs stop dflags basename _suff _input_fn get_output_fn maybe_loc
        (split_s_prefix, n) <- readIORef v_Split_info
 
        let real_odir
-               | Just d <- outputDir dflags = d
+               | Just d <- objectDir dflags = d
                | otherwise                  = basename ++ "_split"
 
        let assemble_file n
@@ -1209,7 +1227,14 @@ staticLink dflags o_files dep_packages = do
 
 exeFileName :: DynFlags -> FilePath
 exeFileName dflags
-  | Just s <- outputFile dflags = s
+  | Just s <- outputFile dflags = 
+#if defined(mingw32_HOST_OS)
+      if null (suffixOf s)
+        then s `joinFileExt` "exe"
+        else s
+#else
+      s
+#endif
   | otherwise = 
 #if defined(mingw32_HOST_OS)
        "main.exe"
@@ -1371,9 +1396,9 @@ getOptionsFromSource file
                       | otherwise -> return []
 
 getOptionsFromStringBuffer :: StringBuffer -> FilePath -> [(Int,String)]
-getOptionsFromStringBuffer buffer@(StringBuffer _ len# _) fn = 
+getOptionsFromStringBuffer buffer@(StringBuffer _ len _) fn = 
   let 
-       ls = lines (lexemeToString buffer (I# len#))  -- lazy, so it's ok
+       ls = lines (lexemeToString buffer len)  -- lazy, so it's ok
   in
   look 1 ls
   where