From c8a6996a324bc39e71f72053e5902e669aeb0209 Mon Sep 17 00:00:00 2001 From: panne Date: Sun, 23 Jul 2000 10:53:12 +0000 Subject: [PATCH] [project @ 2000-07-23 10:53:11 by panne] Strictfp-like behaviour is the default now, which can be switched off via -fexcess-precision. (Has anybody a better name for this option?) --- ghc/compiler/main/CmdLineOpts.lhs | 4 ++-- ghc/compiler/prelude/PrelRules.lhs | 16 +++++++--------- ghc/docs/users_guide/using.sgml | 13 ++++++------- ghc/driver/Main.hs | 8 ++++++-- 4 files changed, 21 insertions(+), 20 deletions(-) diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs index 4840d40..49f35e0 100644 --- a/ghc/compiler/main/CmdLineOpts.lhs +++ b/ghc/compiler/main/CmdLineOpts.lhs @@ -107,7 +107,7 @@ module CmdLineOpts ( opt_SimplCaseOfCase, opt_SimplCaseMerge, opt_SimplPedanticBottoms, - opt_SimplStrictFP, + opt_SimplExcessPrecision, -- Unfolding control opt_UF_HiFileThreshold, @@ -446,7 +446,7 @@ opt_SimplDoLambdaEtaExpansion = lookUp SLIT("-fdo-lambda-eta-expansion") opt_SimplCaseOfCase = lookUp SLIT("-fcase-of-case") opt_SimplCaseMerge = lookUp SLIT("-fcase-merge") opt_SimplPedanticBottoms = lookUp SLIT("-fpedantic-bottoms") -opt_SimplStrictFP = lookUp SLIT("-fstrictfp") +opt_SimplExcessPrecision = lookUp SLIT("-fexcess-precision") -- Unfolding control opt_UF_HiFileThreshold = lookup_def_int "-funfolding-interface-threshold" (45::Int) diff --git a/ghc/compiler/prelude/PrelRules.lhs b/ghc/compiler/prelude/PrelRules.lhs index 0b54318..2b6ccf9 100644 --- a/ghc/compiler/prelude/PrelRules.lhs +++ b/ghc/compiler/prelude/PrelRules.lhs @@ -37,7 +37,7 @@ import Unique ( unpackCStringFoldrIdKey, hasKey ) import Bits ( Bits(..) ) import Word ( Word64 ) import Outputable -import CmdLineOpts ( opt_SimplStrictFP ) +import CmdLineOpts ( opt_SimplExcessPrecision ) \end{code} @@ -286,9 +286,7 @@ intResult name result type RuleFun = [CoreExpr] -> Maybe (RuleName, CoreExpr) or_rule :: RuleFun -> RuleFun -> RuleFun -or_rule r1 r2 args = case r1 args of - Just stuff -> Just stuff - Nothing -> r2 args +or_rule r1 r2 args = maybe (r2 args) Just (r1 args) -- i.e.: r1 args `mplus` r2 args twoLits :: (Literal -> Literal -> Maybe (RuleName, CoreExpr)) -> RuleFun twoLits rule [Lit l1, Lit l2] = rule (convFloating l1) (convFloating l2) @@ -298,13 +296,13 @@ oneLit :: (Literal -> Maybe (RuleName, CoreExpr)) -> RuleFun oneLit rule [Lit l1] = rule (convFloating l1) oneLit rule other = Nothing --- When we strictfp is requested, cut down the precision of the Rational value --- to that of Float/Double. We confuse host architecture and target architecture --- here, but it's convenient (and wrong :-). +-- When excess precision is not requested, cut down the precision of the +-- Rational value to that of Float/Double. We confuse host architecture +-- and target architecture here, but it's convenient (and wrong :-). convFloating :: Literal -> Literal -convFloating (MachFloat f) | opt_SimplStrictFP = +convFloating (MachFloat f) | not opt_SimplExcessPrecision = MachFloat (toRational ((fromRational f) :: Float )) -convFloating (MachDouble d) | opt_SimplStrictFP = +convFloating (MachDouble d) | not opt_SimplExcessPrecision = MachDouble (toRational ((fromRational d) :: Double)) convFloating l = l diff --git a/ghc/docs/users_guide/using.sgml b/ghc/docs/users_guide/using.sgml index ba80d60..42c1a56 100644 --- a/ghc/docs/users_guide/using.sgml +++ b/ghc/docs/users_guide/using.sgml @@ -2204,15 +2204,14 @@ We have not played with enough to recommend it. -: +: -This option has an effect similar to Java's strictfp -modifier: When it is not given, intermediate floating point values can -have a greater precision/range than the final type. -Generally this is a good thing, but some programs may rely on the exact -precision/range of Float/Double -values and should use this option for their compilation. +When this option is given, intermediate floating point values can have +a greater precision/range than the final type. +Generally this is a good thing, but some programs may rely on the +exact precision/range of Float/Double +values and should not use this option for their compilation. diff --git a/ghc/driver/Main.hs b/ghc/driver/Main.hs index 63d2a76..630dd99 100644 --- a/ghc/driver/Main.hs +++ b/ghc/driver/Main.hs @@ -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) @@ -1525,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 @@ -1537,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] @@ -1902,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) ) -- 1.7.10.4