diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ # Changelog for rounded-hw +## 0.3.0 (2022-01-08) + +* Support Clang on AArch64. +* Show the rounding attribute in `instance Show (Rounded r a)`. + ## 0.2.0 (2020-12-27) * Some functionality was moved to fp-ieee. diff --git a/cbits/interval-prim-x86_64-avx512.S b/cbits/interval-prim-x86_64-avx512.S --- a/cbits/interval-prim-x86_64-avx512.S +++ b/cbits/interval-prim-x86_64-avx512.S @@ -24,7 +24,7 @@ .globl SYMBOL(rounded_hw_interval_add) SYMBOL(rounded_hw_interval_add): vaddsd {rd-sae}, %xmm3, %xmm1, %xmm1 # xmm1 = xmm1[0] + xmm3[0], xmm1[1] (downward) - vaddsd {ru-sae}, %xmm4, %xmm2, %xmm2 # xmm2 = xmm2[0] + xmm4[0], xmm2[1] (downward) + vaddsd {ru-sae}, %xmm4, %xmm2, %xmm2 # xmm2 = xmm2[0] + xmm4[0], xmm2[1] (upward) jmp *(%rbp) # diff --git a/cbits/rounded.c b/cbits/rounded.c --- a/cbits/rounded.c +++ b/cbits/rounded.c @@ -102,8 +102,8 @@ #elif defined(USE_AARCH64_FPCR) -typedef unsigned int fp_reg; -typedef unsigned int native_rounding_mode; +typedef uint64_t fp_reg; +typedef uint64_t native_rounding_mode; static const native_rounding_mode ROUND_TONEAREST = 0 << 22; static const native_rounding_mode ROUND_DOWNWARD = 2 << 22; static const native_rounding_mode ROUND_UPWARD = 1 << 22; @@ -121,21 +121,53 @@ } } +#if defined(__has_builtin) +#define HAS_BUILTIN(f) __has_builtin(f) +#else +#define HAS_BUILTIN(f) 0 +#endif +/* + * __has_builtin: Clang / GCC 10 or later + * __builtin_aarch64_{get,set}_fpcr64: GCC 11 or later + * __builtin_aarch64_{get,set}_fpcr: GCC 5 or later + */ static inline ALWAYS_INLINE fp_reg get_fp_reg(void) { - return __builtin_aarch64_get_fpcr(); +#if HAS_BUILTIN(__builtin_aarch64_get_fpcr64) + return __builtin_aarch64_get_fpcr64(); +#elif HAS_BUILTIN(__builtin_aarch64_get_fpcr) || __GNUC__ >= 5 + return (uint64_t)__builtin_aarch64_get_fpcr(); +#else + uint64_t fpcr; + asm volatile("mrs %0, fpcr" : "=r"(fpcr)); + return fpcr; +#endif } static inline ALWAYS_INLINE void set_rounding(fp_reg reg, native_rounding_mode mode) { - __builtin_aarch64_set_fpcr((reg & ~(3u << 22)) | mode); + uint64_t newreg = (reg & ~(3u << 22)) | mode; +#if HAS_BUILTIN(__builtin_aarch64_set_fpcr64) + __builtin_aarch64_set_fpcr64(newreg); +#elif HAS_BUILTIN(__builtin_aarch64_set_fpcr) || __GNUC__ >= 5 + __builtin_aarch64_set_fpcr((unsigned int)newreg); +#else + asm volatile("msr fpcr, %0" : : "r"(newreg)); +#endif } static inline ALWAYS_INLINE void restore_fp_reg(fp_reg reg) { - __builtin_aarch64_set_fpcr(reg); +#if HAS_BUILTIN(__builtin_aarch64_set_fpcr64) + __builtin_aarch64_set_fpcr64(reg); +#elif HAS_BUILTIN(__builtin_aarch64_set_fpcr) || __GNUC__ >= 5 + __builtin_aarch64_set_fpcr((unsigned int)reg); +#else + asm volatile("msr fpcr, %0" : : "r"(reg)); +#endif } +#undef HAS_BUILTIN static const char backend_name[] = "AArch64 FPCR"; diff --git a/rounded-hw.cabal b/rounded-hw.cabal --- a/rounded-hw.cabal +++ b/rounded-hw.cabal @@ -1,13 +1,7 @@ -cabal-version: 1.24 - --- This file has been generated from package.yaml by hpack version 0.33.0. --- --- see: https://github.com/sol/hpack --- --- hash: c52684ece684d2a3e1a2bde6e2919d961a59bd69724c32a8e7ab1ac0b9230685 +cabal-version: 2.2 name: rounded-hw -version: 0.2.0 +version: 0.3.0 synopsis: Directed rounding for built-in floating types description: Please see the README on GitHub at category: Numeric, Math @@ -16,10 +10,11 @@ author: ARATA Mizuki maintainer: minorinoki@gmail.com copyright: 2020 ARATA Mizuki -license: BSD3 +license: BSD-3-Clause license-file: LICENSE -tested-with: GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.2 build-type: Custom +tested-with: + GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.7, GHC == 9.0.2, GHC == 9.2.1 extra-source-files: README.md ChangeLog.md @@ -30,14 +25,16 @@ source-repository head type: git location: https://github.com/minoki/haskell-floating-point + subdir: rounded-hw +-- Custom setup is required to allow assembly sources to #include "ghcconfig.h" custom-setup setup-depends: Cabal >=1.24 , base >=4.7 -flag avx512 - description: Use AVX512 EVEX encoding +flag pure-hs + description: Disable FFI manual: True default: False @@ -46,8 +43,8 @@ manual: True default: False -flag float128 - description: Support Float128 +flag avx512 + description: Use AVX512 EVEX encoding manual: True default: False @@ -56,17 +53,30 @@ manual: True default: True -flag pure-hs - description: Disable FFI - manual: True - default: False - flag x87-long-double description: Support x87 "long double" manual: True default: True +flag float128 + description: Support Float128 + manual: True + default: False + +common deps + build-depends: + array + , base >=4.12 && <5 + , deepseq + , fp-ieee ==0.1.* + , primitive + , vector + +common options + ghc-options: -Wcompat + library + import: deps, options exposed-modules: Numeric.Rounded.Hardware Numeric.Rounded.Hardware.Backend @@ -91,13 +101,9 @@ hs-source-dirs: src build-depends: - array - , base >=4.12 && <5 - , deepseq - , fp-ieee ==0.1.* - , primitive - , tagged - , vector + tagged + ghc-options: -Wall + -- Use FFI when flag(pure-hs) is off if !flag(pure-hs) exposed-modules: Numeric.Rounded.Hardware.Backend.C @@ -107,10 +113,13 @@ cpp-options: -DUSE_FFI c-sources: cbits/rounded.c + -- flag(c99): Disable platform-dependent techniques and only use C99 fesetround if flag(c99) cc-options: -DUSE_C99 + -- flag(avx512): Use AVX512 EVEX encoding if flag(avx512) cc-options: -DUSE_AVX512 -mavx512f + -- flag(ghc-prim): We support "foreign import prim" on GHC/x86_64 if !flag(pure-hs) && !flag(c99) && flag(ghc-prim) && impl(ghc) && arch(x86_64) exposed-modules: Numeric.Rounded.Hardware.Backend.FastFFI @@ -121,6 +130,7 @@ else c-sources: cbits/interval-prim-x86_64.S + -- flag(x87-long-double): Support LongDouble on x86 if flag(x87-long-double) && (arch(i386) || arch(x86_64)) other-modules: Numeric.Rounded.Hardware.Backend.X87LongDouble @@ -129,6 +139,7 @@ cbits/rounded-x87longdouble.c build-depends: long-double + -- flag(float128): Support Float128 if flag(float128) other-modules: Numeric.Rounded.Hardware.Backend.Float128 @@ -140,21 +151,15 @@ default-language: Haskell2010 test-suite rounded-hw-doctests + import: deps, options type: exitcode-stdio-1.0 main-is: doctests.hs - other-modules: - Paths_rounded_hw build-depends: - array - , base >=4.12 && <5 - , deepseq - , doctest >=0.8 - , fp-ieee ==0.1.* - , primitive - , vector + doctest >=0.8 default-language: Haskell2010 test-suite rounded-hw-test + import: deps, options type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: @@ -166,22 +171,16 @@ ShowFloatSpec Util VectorSpec - Paths_rounded_hw hs-source-dirs: test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: QuickCheck - , array - , base >=4.12 && <5 - , deepseq - , fp-ieee ==0.1.* , hspec - , primitive , random , rounded-hw - , vector if flag(x87-long-double) && (arch(i386) || (arch(x86_64) && !os(windows))) + -- Support for 80-bit long double is not good on Win64, so don't test other-modules: X87LongDoubleSpec cpp-options: -DTEST_X87_LONG_DOUBLE @@ -196,21 +195,17 @@ default-language: Haskell2010 benchmark rounded-hw-benchmark + import: deps, options type: exitcode-stdio-1.0 main-is: Benchmark.hs other-modules: Conversion IGA - Paths_rounded_hw hs-source-dirs: benchmark build-depends: - array - , base >=4.12 && <5 - , deepseq - , fp-ieee ==0.1.* - , gauge - , primitive - , rounded-hw - , vector + rounded-hw + , tasty-bench + mixins: + tasty-bench (Test.Tasty.Bench as Gauge, Test.Tasty.Bench as Gauge.Main, Test.Tasty.Bench as Gauge.Benchmark) default-language: Haskell2010 diff --git a/src/Numeric/Rounded/Hardware/Internal/Class.hs b/src/Numeric/Rounded/Hardware/Internal/Class.hs --- a/src/Numeric/Rounded/Hardware/Internal/Class.hs +++ b/src/Numeric/Rounded/Hardware/Internal/Class.hs @@ -8,7 +8,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} -{-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -Wno-orphans -Wno-name-shadowing #-} module Numeric.Rounded.Hardware.Internal.Class ( module Numeric.Rounded.Hardware.Internal.Class , module Numeric.Rounded.Hardware.Internal.Rounding diff --git a/src/Numeric/Rounded/Hardware/Internal/Rounding.hs b/src/Numeric/Rounded/Hardware/Internal/Rounding.hs --- a/src/Numeric/Rounded/Hardware/Internal/Rounding.hs +++ b/src/Numeric/Rounded/Hardware/Internal/Rounding.hs @@ -88,9 +88,12 @@ newtype Rounded (r :: RoundingMode) a = Rounded { getRounded :: a } deriving (Eq, Ord, Generic, Functor, Storable) -instance Show a => Show (Rounded r a) where - -- TODO: Take the rounding direction into account - showsPrec prec (Rounded x) = showParen (prec > 10) $ showString "Rounded " . showsPrec 11 x +instance (Rounding r, Show a) => Show (Rounded r a) where + showsPrec prec rx@(Rounded x) = showParen (prec > 10) $ showString "Rounded @" . rs . showChar ' ' . showsPrec 11 x + where + toProxy :: Rounded r a -> Proxy r + toProxy _ = Proxy + rs = shows (rounding (toProxy rx)) instance NFData a => NFData (Rounded r a)