X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fdriver%2FMain.hs;h=630dd99ca34ef722481716b632d0b0a502ce3ecc;hb=c8a6996a324bc39e71f72053e5902e669aeb0209;hp=856d7d0f7b37cd937654d714db2426569ad01a22;hpb=eacefec6c56e1c0c4ed5e45b297c9653e594c4fe;p=ghc-hetmet.git

diff --git a/ghc/driver/Main.hs b/ghc/driver/Main.hs
index 856d7d0..630dd99 100644
--- 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) )