[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: base: fix sign confusion in log1mexp implementation (fix #17125)

Marge Bot gitlab at gitlab.haskell.org
Fri Jun 5 07:50:36 UTC 2020



 Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
af5e3a88 by Artem Pelenitsyn at 2020-06-05T03:18:49-04:00
base: fix sign confusion in log1mexp implementation (fix #17125)

author: claude (https://gitlab.haskell.org/trac-claude)

The correct threshold for log1mexp is -(log 2) with the current specification
of log1mexp. This change improves accuracy for large negative inputs.

To avoid code duplication, a small helper function is added;
it isn't the default implementation in Floating because it needs Ord.

This patch does nothing to address that the Haskell specification is
different from that in common use in other languages.

- - - - -
f021a0c1 by Moritz Angermann at 2020-06-05T03:50:30-04:00
ghc-prim needs to depend on libc and libm

libm is just an empty shell on musl, and all the math functions are contained in
libc.

- - - - -
61eef83a by Moritz Angermann at 2020-06-05T03:50:30-04:00
Disable DLL loading if without system linker

Some platforms (musl, aarch64) do not have a working dynamic linker
implemented in the libc, even though we might see dlopen.  It will
ultimately just return that this is not supported.  Hence we'll add
a flag to the compiler to flat our disable loading dlls.  This is
needed as we will otherwise try to load the shared library even
if this will subsequently fail.  At that point we have given up
looking for static options though.

- - - - -
e8cf30dd by Moritz Angermann at 2020-06-05T03:50:30-04:00
Range is actually +/-2^32, not +/-2^31

See also: https://static.docs.arm.com/ihi0056/g/aaelf64.pdf

- - - - -


5 changed files:

- compiler/GHC/Runtime/Linker.hs
- compiler/ghc.cabal.in
- libraries/base/GHC/Float.hs
- libraries/ghc-prim/ghc-prim.cabal
- rts/linker/elf_reloc_aarch64.c


Changes:

=====================================
compiler/GHC/Runtime/Linker.hs
=====================================
@@ -1328,6 +1328,7 @@ linkPackage hsc_env pkg
             ("Loading package " ++ unitPackageIdString pkg ++ " ... ")
 
         -- See comments with partOfGHCi
+#if defined(CAN_LOAD_DLL)
         when (unitPackageName pkg `notElem` partOfGHCi) $ do
             loadFrameworks hsc_env platform pkg
             -- See Note [Crash early load_dyn and locateLib]
@@ -1336,7 +1337,7 @@ linkPackage hsc_env pkg
             -- For remaining `dlls` crash early only when there is surely
             -- no package's DLL around ... (not is_dyn)
             mapM_ (load_dyn hsc_env (not is_dyn) . mkSOName platform) dlls
-
+#endif
         -- After loading all the DLLs, we can load the static objects.
         -- Ordering isn't important here, because we do one final link
         -- step to resolve everything.
@@ -1471,10 +1472,15 @@ locateLib hsc_env is_hs lib_dirs gcc_dirs lib
     --   O(n). Loading an import library is also O(n) so in general we prefer
     --   shared libraries because they are simpler and faster.
     --
-  = findDll   user `orElse`
+  =
+#if defined(CAN_LOAD_DLL)
+    findDll   user `orElse`
+#endif
     tryImpLib user `orElse`
+#if defined(CAN_LOAD_DLL)
     findDll   gcc  `orElse`
     findSysDll     `orElse`
+#endif
     tryImpLib gcc  `orElse`
     findArchive    `orElse`
     tryGcc         `orElse`
@@ -1539,7 +1545,13 @@ locateLib hsc_env is_hs lib_dirs gcc_dirs lib
                          full     = dllpath $ search lib_so_name lib_dirs
                          gcc name = liftM (fmap Archive) $ search name lib_dirs
                          files    = import_libs ++ arch_files
-                     in apply $ short : full : map gcc files
+                         dlls     = [short, full]
+                         archives = map gcc files
+                     in apply $
+#if defined(CAN_LOAD_DLL)
+                          dlls ++
+#endif
+                          archives
      tryImpLib re = case os of
                        OSMinGW32 ->
                         let dirs' = if re == user then lib_dirs else gcc_dirs


=====================================
compiler/ghc.cabal.in
=====================================
@@ -55,6 +55,11 @@ Flag integer-gmp
     Manual: True
     Default: False
 
+Flag dynamic-system-linker
+    Description: The system can load dynamic code. This is not the case for musl.
+    Default: True
+    Manual: False
+
 Library
     Default-Language: Haskell2010
     Exposed: False
@@ -108,6 +113,10 @@ Library
         CPP-Options: -DINTEGER_SIMPLE
         build-depends: integer-simple >= 0.1.1.1
 
+    -- if no dynamic system linker is available, don't try DLLs.
+    if flag(dynamic-system-linker)
+        CPP-Options: -DCAN_LOAD_DLL
+
     Other-Extensions:
         BangPatterns
         CPP


=====================================
libraries/base/GHC/Float.hs
=====================================
@@ -142,6 +142,14 @@ class  (Fractional a) => Floating a  where
     log1pexp x = log1p (exp x)
     log1mexp x = log1p (negate (exp x))
 
+-- | Default implementation for @'log1mexp'@ requiring @'Ord'@ to test
+-- against a threshold to decide which implementation variant to use.
+log1mexpOrd :: (Ord a, Floating a) => a -> a
+{-# INLINE log1mexpOrd #-}
+log1mexpOrd a
+    | a > -(log 2) = log (negate (expm1 a))
+    | otherwise  = log1p (negate (exp a))
+
 -- | Efficient, machine-independent access to the components of a
 -- floating-point number.
 class  (RealFrac a, Floating a) => RealFloat a  where
@@ -399,9 +407,7 @@ instance  Floating Float  where
     log1p = log1pFloat
     expm1 = expm1Float
 
-    log1mexp a
-      | a <= log 2 = log (negate (expm1Float a))
-      | otherwise  = log1pFloat (negate (exp a))
+    log1mexp x = log1mexpOrd x
     {-# INLINE log1mexp #-}
     log1pexp a
       | a <= 18   = log1pFloat (exp a)
@@ -540,9 +546,7 @@ instance  Floating Double  where
     log1p = log1pDouble
     expm1 = expm1Double
 
-    log1mexp a
-      | a <= log 2 = log (negate (expm1Double a))
-      | otherwise  = log1pDouble (negate (exp a))
+    log1mexp x = log1mexpOrd x
     {-# INLINE log1mexp #-}
     log1pexp a
       | a <= 18   = log1pDouble (exp a)


=====================================
libraries/ghc-prim/ghc-prim.cabal
=====================================
@@ -68,6 +68,11 @@ Library
         --         on Windows. Required because of mingw32.
         extra-libraries: user32, mingw32, mingwex
 
+    if os(linux)
+        -- we need libm, but for musl and other's we might need libc, as libm
+        -- is just an empty shell.
+        extra-libraries: c, m
+
     c-sources:
         cbits/atomic.c
         cbits/bswap.c


=====================================
rts/linker/elf_reloc_aarch64.c
=====================================
@@ -93,12 +93,14 @@ encodeAddendAarch64(Section * section, Elf_Rel * rel, int64_t addend) {
             // ...              hi            ] [     Rd     ]
             //
             // imm64 = SignExtend(hi:lo:0x000,64)
-            assert(isInt64(32, addend));
+            // Range is 21 bits + the 12 page relative bits
+            // known to be 0. -2^32 <= X < 2^32
+            assert(isInt64(21+12, addend));
             assert((addend & 0xfff) == 0); /* page relative */
 
             *(inst_t *)P = (*(inst_t *)P & 0x9f00001f)
-                           | (inst_t) (((uint64_t) addend << 17) & 0x60000000)
-                           | (inst_t) (((uint64_t) addend >> 9) & 0x00ffffe0);
+                        | (inst_t) (((uint64_t) addend << 17) & 0x60000000)
+                        | (inst_t) (((uint64_t) addend >> 9) & 0x00ffffe0);
             break;
         }
         /* - control flow relocations */
@@ -111,8 +113,8 @@ encodeAddendAarch64(Section * section, Elf_Rel * rel, int64_t addend) {
             break;
         }
         case COMPAT_R_AARCH64_ADR_GOT_PAGE: {
-
-            assert(isInt64(32, addend)); /* X in range */
+            /* range is -2^32 <= X < 2^32 */
+            assert(isInt64(21+12, addend)); /* X in range */
             assert((addend & 0xfff) == 0); /* page relative */
 
             *(inst_t *)P = (*(inst_t *)P & 0x9f00001f)



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2e82231e9f9c5bb8f8ac6e8fbaacde7b0236ce81...e8cf30dd8e343517458f1173be3fbfdcae015f36

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2e82231e9f9c5bb8f8ac6e8fbaacde7b0236ce81...e8cf30dd8e343517458f1173be3fbfdcae015f36
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200605/b6283cad/attachment-0001.html>


More information about the ghc-commits mailing list