[project @ 2000-07-23 10:53:11 by panne]

[ghc-hetmet.git] / ghc / driver / Main.hs

diff --git a/ghc/driver/Main.hs b/ghc/driver/Main.hs
index 856d7d0..630dd99 100644 (file)
--- a/ghc/driver/Main.hs
+++ b/ghc/driver/Main.hs
@@ -73,9 +73,9 @@ short_usage = do
   exitWith ExitSuccess
    
 long_usage = do
-  let usage_filename = "ghc-usage.txt"
-      usage_dir = findFile usage_filename cGHC_DRIVER_DIR
-  usage <- readFile (usage_dir ++ "/" ++ usage_filename)
+  let usage_file = "ghc-usage.txt"
+      usage_path = findFile usage_file (cGHC_DRIVER_DIR ++ '/':usage_file)
+  usage <- readFile usage_path
   dump usage
   exitWith ExitSuccess
   where
@@ -253,6 +253,7 @@ GLOBAL_VAR(static,              False,          Bool)
 #endif
 GLOBAL_VAR(collect_ghc_timing,         False,          Bool)
 GLOBAL_VAR(do_asm_mangling,    True,           Bool)
+GLOBAL_VAR(excess_precision,   False,          Bool)
 
 -----------------------------------------------------------------------------
 -- Splitting object files (for libraries)
@@ -731,6 +732,7 @@ GLOBAL_VAR(build_tag, "", String)
 data WayName
   = WayProf
   | WayUnreg
+  | WayDll
   | WayTicky
   | WayPar
   | WayGran
@@ -757,6 +759,8 @@ data WayName
 
 GLOBAL_VAR(ways, [] ,[WayName])
 
+-- ToDo: allow WayDll with any other allowed combination
+
 allowed_combinations = 
    [  [WayProf,WayUnreg],
       [WayProf,WaySMP]    -- works???
@@ -811,6 +815,9 @@ way_details =
        , "-fno-asm-mangling"
        , "-funregisterised" ]),
 
+    (WayDll, Way  "dll" "DLLized"
+        [ ]),
+
     (WayPar, Way  "mp" "Parallel" 
        [ "-fstack-check"
        , "-fparallel"
@@ -1519,6 +1526,8 @@ run_phase cc_phase basename input_fn output_fn
 
        pkg_extra_cc_opts <- getPackageExtraCcOpts
 
+       excessPrecision <- readIORef excess_precision
+
        run_something "C Compiler"
         (unwords ([ cc, "-x", "c", cc_help, "-o", output_fn ]
                   ++ md_c_flags
@@ -1531,6 +1540,7 @@ run_phase cc_phase basename input_fn output_fn
 #ifdef mingw32_TARGET_OS
                    ++ [" -mno-cygwin"]
 #endif
+                  ++ (if excessPrecision then [] else [ "-ffloat-store" ])
                   ++ include_paths
                   ++ pkg_extra_cc_opts
 --                ++ [">", ccout]
@@ -1684,14 +1694,25 @@ run_something phase_name cmd
        putStr phase_name
        putStrLn ":"
        putStrLn cmd
+       hFlush stdout
 
    -- test for -n flag
    n <- readIORef dry_run
    unless n $ do 
 
    -- and run it!
-   exit_code <- system ("sh -c \"" ++ cmd ++ "\"")  `catchAllIO` 
+#ifndef mingw32_TARGET_OS
+   exit_code <- system cmd `catchAllIO` 
                   (\e -> throwDyn (PhaseFailed phase_name (ExitFailure 1)))
+#else
+   tmp <- newTempName "sh"
+   h <- openFile tmp WriteMode
+   hPutStrLn h cmd
+   hClose h
+   exit_code <- system ("sh - " ++ tmp) `catchAllIO` 
+                  (\e -> throwDyn (PhaseFailed phase_name (ExitFailure 1)))
+   removeFile tmp
+#endif
 
    if exit_code /= ExitSuccess
        then throwDyn (PhaseFailed phase_name exit_code)
@@ -1738,6 +1759,7 @@ opts =
        ------- ways --------------------------------------------------------
   ,  ( "prof"          , NoArg (addNoDups ways WayProf) )
   ,  ( "unreg"         , NoArg (addNoDups ways WayUnreg) )
+  ,  ( "dll"            , NoArg (addNoDups ways WayDll) )
   ,  ( "ticky"         , NoArg (addNoDups ways WayTicky) )
   ,  ( "parallel"      , NoArg (addNoDups ways WayPar) )
   ,  ( "gransim"       , NoArg (addNoDups ways WayGran) )
@@ -1884,8 +1906,8 @@ opts =
   ,  ( "fusagesp"         , NoArg (do writeIORef opt_UsageSPInf True
                                       add opt_C "-fusagesp-on") )
 
-  ,  ( "fstrictfp"        , NoArg (do add opt_C "-fstrictfp"
-                                      add opt_c "-ffloat-store"))
+  ,  ( "fexcess-precision" , NoArg (do writeIORef excess_precision True
+                                      add opt_C "-fexcess-precision"))
 
        -- flags that are "active negatives"
   ,  ( "fno-implicit-prelude"  , PassFlag (add opt_C) )