[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Implement executablePath for Solaris and make getBaseDir less platform-dependent
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Mon Apr 24 13:19:11 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
499a1c20 by PHO at 2023-04-23T13:39:32-04:00
Implement executablePath for Solaris and make getBaseDir less platform-dependent
Use base-4.17 executablePath when possible, and fall back on
getExecutablePath when it's not available. The sole reason why getBaseDir
had #ifdef's was apparently that getExecutablePath wasn't reliable, and we
could reduce the number of CPP conditionals by making use of
executablePath instead.
Also export executablePath on js_HOST_ARCH.
- - - - -
97a6f7bc by tocic at 2023-04-23T13:40:08-04:00
Fix doc typos in libraries/base
- - - - -
99c28e8f by Ben Gamari at 2023-04-24T09:18:58-04:00
testsuite/T20137: Avoid impl.-defined behavior
Previously we would cast pointers to uint64_t. However, implementations
are allowed to either zero- or sign-extend such casts. Instead cast to
uintptr_t to avoid this.
Fixes #23247.
- - - - -
cb55beb5 by Cheng Shao at 2023-04-24T09:19:00-04:00
rts: always build 64-bit atomic ops
This patch does a few things:
- Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit
platforms
- Remove legacy "64bit" cabal flag of rts package
- Fix hs_xchg64 function prototype for 32-bit platforms
- Fix AtomicFetch test for wasm32
- - - - -
2d937299 by Cheng Shao at 2023-04-24T09:19:01-04:00
compiler: don't install signal handlers when the host platform doesn't have signals
Previously, large parts of GHC API will transitively invoke
withSignalHandlers, which doesn't work on host platforms without
signal functionality at all (e.g. wasm32-wasi). By making
withSignalHandlers a no-op on those platforms, we can make more parts
of GHC API work out of the box when signals aren't supported.
- - - - -
19 changed files:
- compiler/GHC/Utils/Panic.hs
- configure.ac
- hadrian/src/Rules/Generate.hs
- libraries/base/Control/Concurrent/MVar.hs
- libraries/base/Control/Exception/Base.hs
- libraries/base/Control/Monad.hs
- libraries/base/Data/Complex.hs
- libraries/base/Data/List.hs
- libraries/base/Data/OldList.hs
- libraries/base/System/Environment.hs
- libraries/base/System/Environment/ExecutablePath.hsc
- libraries/base/Text/Read/Lex.hs
- libraries/ghc-boot/GHC/BaseDir.hs
- libraries/ghc-prim/cbits/atomic.c
- rts/include/stg/Prim.h
- rts/rts.cabal.in
- testsuite/tests/cmm/should_run/AtomicFetch_cmm.cmm
- testsuite/tests/codeGen/should_run/T20137/T20137.stdout-ws-32
- testsuite/tests/codeGen/should_run/T20137/T20137C.c
Changes:
=====================================
compiler/GHC/Utils/Panic.hs
=====================================
@@ -7,6 +7,8 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables, LambdaCase #-}
+#include <ghcautoconf.h>
+
-- | Defines basic functions for printing error messages.
--
-- It's hard to put these functions anywhere else without causing
@@ -236,6 +238,11 @@ signalHandlersRefCount = unsafePerformIO $ newMVar (0,Nothing)
-- | Temporarily install standard signal handlers for catching ^C, which just
-- throw an exception in the current thread.
withSignalHandlers :: ExceptionMonad m => m a -> m a
+#if !defined(HAVE_SIGNAL_H)
+-- No signal functionality exist on the host platform (e.g. on
+-- wasm32-wasi), so don't attempt to set up signal handlers
+withSignalHandlers = id
+#else
withSignalHandlers act = do
main_thread <- liftIO myThreadId
wtid <- liftIO (mkWeakThreadId main_thread)
@@ -295,6 +302,7 @@ withSignalHandlers act = do
mayInstallHandlers
act `MC.finally` mayUninstallHandlers
+#endif
callStackDoc :: HasCallStack => SDoc
callStackDoc = prettyCallStackDoc callStack
=====================================
configure.ac
=====================================
@@ -904,11 +904,6 @@ FP_CHECK_SIZEOF_AND_ALIGNMENT(uint64_t)
dnl for use in settings file
TargetWordSize=$ac_cv_sizeof_void_p
-if test "x$TargetWordSize" = x8; then
- AC_SUBST([Cabal64bit],[True])
-else
- AC_SUBST([Cabal64bit],[False])
-fi
AC_SUBST(TargetWordSize)
AC_C_BIGENDIAN([TargetWordBigEndian=YES],[TargetWordBigEndian=NO])
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -295,11 +295,6 @@ rtsCabalFlags = mconcat
, flag "CabalUseSystemLibFFI" UseSystemFfi
, flag "CabalLibffiAdjustors" UseLibffiForAdjustors
, flag "CabalLeadingUnderscore" LeadingUnderscore
- , interpolateVar "Cabal64bit" $ do
- let settingWord :: Setting -> Action Word
- settingWord s = read <$> setting s
- ws <- settingWord TargetWordSize
- return $ toCabalBool (ws == 8)
]
where
flag = interpolateCabalFlag
=====================================
libraries/base/Control/Concurrent/MVar.hs
=====================================
@@ -37,7 +37,7 @@
-- than 'GHC.Conc.STM'. They are appropriate for building synchronization
-- primitives and performing simple interthread communication; however
-- they are very simple and susceptible to race conditions, deadlocks or
--- uncaught exceptions. Do not use them if you need perform larger
+-- uncaught exceptions. Do not use them if you need to perform larger
-- atomic operations such as reading from multiple variables: use 'GHC.Conc.STM'
-- instead.
--
=====================================
libraries/base/Control/Exception/Base.hs
=====================================
@@ -223,7 +223,7 @@ onException io what = io `catch` \e -> do _ <- what
-- handle. Similarly, closing a socket (from \"network\" package) is also
-- uninterruptible under similar conditions. An example of an interruptible
-- action is 'killThread'. Completion of interruptible release actions can be
--- ensured by wrapping them in in 'uninterruptibleMask_', but this risks making
+-- ensured by wrapping them in 'uninterruptibleMask_', but this risks making
-- the program non-responsive to @Control-C@, or timeouts. Another option is to
-- run the release action asynchronously in its own thread:
--
=====================================
libraries/base/Control/Monad.hs
=====================================
@@ -101,11 +101,11 @@ import GHC.Num ( (-) )
--
-- ==== __Examples__
--
--- Common uses of 'guard' include conditionally signaling an error in
+-- Common uses of 'guard' include conditionally signalling an error in
-- an error monad and conditionally rejecting the current choice in an
-- 'Alternative'-based parser.
--
--- As an example of signaling an error in the error monad 'Maybe',
+-- As an example of signalling an error in the error monad 'Maybe',
-- consider a safe division function @safeDiv x y@ that returns
-- 'Nothing' when the denominator @y@ is zero and @'Just' (x \`div\`
-- y)@ otherwise. For example:
=====================================
libraries/base/Data/Complex.hs
=====================================
@@ -104,13 +104,13 @@ cis theta = cos theta :+ sin theta
-- | The function 'polar' takes a complex number and
-- returns a (magnitude, phase) pair in canonical form:
--- the magnitude is nonnegative, and the phase in the range @(-'pi', 'pi']@;
+-- the magnitude is non-negative, and the phase in the range @(-'pi', 'pi']@;
-- if the magnitude is zero, then so is the phase.
{-# SPECIALISE polar :: Complex Double -> (Double,Double) #-}
polar :: (RealFloat a) => Complex a -> (a,a)
polar z = (magnitude z, phase z)
--- | The nonnegative magnitude of a complex number.
+-- | The non-negative magnitude of a complex number.
{-# SPECIALISE magnitude :: Complex Double -> Double #-}
magnitude :: (RealFloat a) => Complex a -> a
magnitude (x:+y) = scaleFloat k
=====================================
libraries/base/Data/List.hs
=====================================
@@ -124,7 +124,7 @@ module Data.List
, partition
-- * Indexing lists
- -- | These functions treat a list @xs@ as a indexed collection,
+ -- | These functions treat a list @xs@ as an indexed collection,
-- with indices ranging from 0 to @'length' xs - 1 at .
, (!?)
=====================================
libraries/base/Data/OldList.hs
=====================================
@@ -124,7 +124,7 @@ module Data.OldList
, partition
-- * Indexing lists
- -- | These functions treat a list @xs@ as a indexed collection,
+ -- | These functions treat a list @xs@ as an indexed collection,
-- with indices ranging from 0 to @'length' xs - 1 at .
, (!?)
=====================================
libraries/base/System/Environment.hs
=====================================
@@ -19,9 +19,7 @@ module System.Environment
(
getArgs,
getProgName,
-#if !defined(javascript_HOST_ARCH)
executablePath,
-#endif
getExecutablePath,
getEnv,
lookupEnv,
=====================================
libraries/base/System/Environment/ExecutablePath.hsc
=====================================
@@ -18,9 +18,7 @@
module System.Environment.ExecutablePath
( getExecutablePath
-##if !defined(javascript_HOST_ARCH)
, executablePath
-##endif
) where
##if defined(javascript_HOST_ARCH)
@@ -28,6 +26,9 @@ module System.Environment.ExecutablePath
getExecutablePath :: IO FilePath
getExecutablePath = return "a.jsexe"
+executablePath :: Maybe (IO (Maybe FilePath))
+executablePath = Nothing
+
##else
-- The imports are purposely kept completely disjoint to prevent edits
@@ -47,6 +48,12 @@ import Data.List (isSuffixOf)
import Foreign.C
import Foreign.Marshal.Array
import System.Posix.Internals
+#elif defined(solaris2_HOST_OS)
+import Control.Exception (catch, throw)
+import Foreign.C
+import Foreign.Marshal.Array
+import System.IO.Error (isDoesNotExistError)
+import System.Posix.Internals
#elif defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS)
import Control.Exception (catch, throw)
import Foreign.C
@@ -101,7 +108,7 @@ getExecutablePath :: IO FilePath
--
-- If the operating system provides a reliable way to determine the current
-- executable, return the query action, otherwise return @Nothing at . The action
--- is defined on FreeBSD, Linux, MacOS, NetBSD, and Windows.
+-- is defined on FreeBSD, Linux, MacOS, NetBSD, Solaris, and Windows.
--
-- Even where the query action is defined, there may be situations where no
-- result is available, e.g. if the executable file was deleted while the
@@ -171,9 +178,9 @@ executablePath = Just (fmap Just getExecutablePath `catch` f)
| otherwise = throw e
--------------------------------------------------------------------------------
--- Linux
+-- Linux / Solaris
-#elif defined(linux_HOST_OS)
+#elif defined(linux_HOST_OS) || defined(solaris2_HOST_OS)
foreign import ccall unsafe "readlink"
c_readlink :: CString -> CString -> CSize -> IO CInt
@@ -190,6 +197,7 @@ readSymbolicLink file =
c_readlink s buf 4096
peekFilePathLen (buf,fromIntegral len)
+# if defined(linux_HOST_OS)
getExecutablePath = readSymbolicLink $ "/proc/self/exe"
executablePath = Just (check <$> getExecutablePath) where
@@ -200,6 +208,18 @@ executablePath = Just (check <$> getExecutablePath) where
check s | "(deleted)" `isSuffixOf` s = Nothing
| otherwise = Just s
+# elif defined(solaris2_HOST_OS)
+getExecutablePath = readSymbolicLink "/proc/self/path/a.out"
+
+executablePath = Just ((Just <$> getExecutablePath) `catch` f)
+ where
+ -- readlink(2) fails with ENOENT when the executable has been deleted,
+ -- even though the symlink itself still exists according to readdir(3).
+ f e | isDoesNotExistError e = pure Nothing
+ | otherwise = throw e
+
+#endif
+
--------------------------------------------------------------------------------
-- FreeBSD / NetBSD
=====================================
libraries/base/Text/Read/Lex.hs
=====================================
@@ -112,7 +112,7 @@ numberToFixed _ _ = Nothing
-- space problems in #5688
-- Ways this is conservative:
-- * the floatRange is in base 2, but we pretend it is in base 10
--- * we pad the floateRange a bit, just in case it is very small
+-- * we pad the floatRange a bit, just in case it is very small
-- and we would otherwise hit an edge case
-- * We only worry about numbers that have an exponent. If they don't
-- have an exponent then the Rational won't be much larger than the
=====================================
libraries/ghc-boot/GHC/BaseDir.hs
=====================================
@@ -12,7 +12,11 @@
-- installation location at build time. ghc-pkg also can expand those variables
-- and so needs the top dir location to do that too.
-module GHC.BaseDir where
+module GHC.BaseDir
+ ( expandTopDir
+ , expandPathVar
+ , getBaseDir
+ ) where
import Prelude -- See Note [Why do we import Prelude here?]
@@ -20,11 +24,9 @@ import Data.List (stripPrefix)
import Data.Maybe (listToMaybe)
import System.FilePath
--- Windows
-#if defined(mingw32_HOST_OS)
-import System.Environment (getExecutablePath)
--- POSIX
-#elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(openbsd_HOST_OS) || defined(netbsd_HOST_OS)
+#if MIN_VERSION_base(4,17,0)
+import System.Environment (executablePath)
+#else
import System.Environment (getExecutablePath)
#endif
@@ -43,17 +45,27 @@ expandPathVar var value str
expandPathVar var value (x:xs) = x : expandPathVar var value xs
expandPathVar _ _ [] = []
+#if !MIN_VERSION_base(4,17,0)
+-- Polyfill for base-4.17 executablePath
+executablePath :: Maybe (IO (Maybe FilePath))
+executablePath = Just (Just <$> getExecutablePath)
+#elif !MIN_VERSION_base(4,18,0) && defined(js_HOST_ARCH)
+-- executablePath is missing from base < 4.18.0 on js_HOST_ARCH
+executablePath :: Maybe (IO (Maybe FilePath))
+executablePath = Nothing
+#endif
+
-- | Calculate the location of the base dir
getBaseDir :: IO (Maybe String)
#if defined(mingw32_HOST_OS)
-getBaseDir = Just . (\p -> p </> "lib") . rootDir <$> getExecutablePath
+getBaseDir = maybe (pure Nothing) ((((</> "lib") . rootDir) <$>) <$>) executablePath
where
-- locate the "base dir" when given the path
-- to the real ghc executable (as opposed to symlink)
-- that is running this function.
rootDir :: FilePath -> FilePath
rootDir = takeDirectory . takeDirectory . normalise
-#elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(openbsd_HOST_OS) || defined(netbsd_HOST_OS)
+#else
-- on unix, this is a bit more confusing.
-- The layout right now is something like
--
@@ -65,14 +77,15 @@ getBaseDir = Just . (\p -> p </> "lib") . rootDir <$> getExecutablePath
-- As such, we first need to find the absolute location to the
-- binary.
--
--- getExecutablePath will return (3). One takeDirectory will
+-- executablePath will return (3). One takeDirectory will
-- give use /lib/ghc-X.Y.Z/bin, and another will give us (4).
--
-- This of course only works due to the current layout. If
-- the layout is changed, such that we have ghc-X.Y.Z/{bin,lib}
-- this would need to be changed accordingly.
--
-getBaseDir = Just . (\p -> p </> "lib") . takeDirectory . takeDirectory <$> getExecutablePath
-#else
-getBaseDir = return Nothing
+getBaseDir = maybe (pure Nothing) ((((</> "lib") . rootDir) <$>) <$>) executablePath
+ where
+ rootDir :: FilePath -> FilePath
+ rootDir = takeDirectory . takeDirectory
#endif
=====================================
libraries/ghc-prim/cbits/atomic.c
=====================================
@@ -33,14 +33,12 @@ hs_atomic_add32(StgWord x, StgWord val)
return __sync_fetch_and_add((volatile StgWord32 *) x, (StgWord32) val);
}
-#if WORD_SIZE_IN_BITS == 64
extern StgWord64 hs_atomic_add64(StgWord x, StgWord64 val);
StgWord64
hs_atomic_add64(StgWord x, StgWord64 val)
{
return __sync_fetch_and_add((volatile StgWord64 *) x, val);
}
-#endif
// FetchSubByteArrayOp_Int
@@ -65,14 +63,12 @@ hs_atomic_sub32(StgWord x, StgWord val)
return __sync_fetch_and_sub((volatile StgWord32 *) x, (StgWord32) val);
}
-#if WORD_SIZE_IN_BITS == 64
extern StgWord64 hs_atomic_sub64(StgWord x, StgWord64 val);
StgWord64
hs_atomic_sub64(StgWord x, StgWord64 val)
{
return __sync_fetch_and_sub((volatile StgWord64 *) x, val);
}
-#endif
// FetchAndByteArrayOp_Int
@@ -97,14 +93,12 @@ hs_atomic_and32(StgWord x, StgWord val)
return __sync_fetch_and_and((volatile StgWord32 *) x, (StgWord32) val);
}
-#if WORD_SIZE_IN_BITS == 64
extern StgWord64 hs_atomic_and64(StgWord x, StgWord64 val);
StgWord64
hs_atomic_and64(StgWord x, StgWord64 val)
{
return __sync_fetch_and_and((volatile StgWord64 *) x, val);
}
-#endif
// FetchNandByteArrayOp_Int
@@ -206,7 +200,6 @@ hs_atomic_nand32(StgWord x, StgWord val)
#endif
}
-#if WORD_SIZE_IN_BITS == 64
extern StgWord64 hs_atomic_nand64(StgWord x, StgWord64 val);
StgWord64
hs_atomic_nand64(StgWord x, StgWord64 val)
@@ -217,7 +210,6 @@ hs_atomic_nand64(StgWord x, StgWord64 val)
CAS_NAND((volatile StgWord64 *) x, val);
#endif
}
-#endif
#pragma GCC diagnostic pop
@@ -244,14 +236,12 @@ hs_atomic_or32(StgWord x, StgWord val)
return __sync_fetch_and_or((volatile StgWord32 *) x, (StgWord32) val);
}
-#if WORD_SIZE_IN_BITS == 64
extern StgWord64 hs_atomic_or64(StgWord x, StgWord64 val);
StgWord64
hs_atomic_or64(StgWord x, StgWord64 val)
{
return __sync_fetch_and_or((volatile StgWord64 *) x, val);
}
-#endif
// FetchXorByteArrayOp_Int
@@ -276,14 +266,12 @@ hs_atomic_xor32(StgWord x, StgWord val)
return __sync_fetch_and_xor((volatile StgWord32 *) x, (StgWord32) val);
}
-#if WORD_SIZE_IN_BITS == 64
extern StgWord64 hs_atomic_xor64(StgWord x, StgWord64 val);
StgWord64
hs_atomic_xor64(StgWord x, StgWord64 val)
{
return __sync_fetch_and_xor((volatile StgWord64 *) x, val);
}
-#endif
// CasByteArrayOp_Int
@@ -338,15 +326,13 @@ hs_xchg32(StgWord x, StgWord val)
return (StgWord) __atomic_exchange_n((StgWord32 *) x, (StgWord32) val, __ATOMIC_SEQ_CST);
}
-#if WORD_SIZE_IN_BITS == 64
//GCC provides this even on 32bit, but StgWord is still 32 bits.
-extern StgWord hs_xchg64(StgWord x, StgWord val);
-StgWord
-hs_xchg64(StgWord x, StgWord val)
+extern StgWord64 hs_xchg64(StgWord x, StgWord64 val);
+StgWord64
+hs_xchg64(StgWord x, StgWord64 val)
{
- return (StgWord) __atomic_exchange_n((StgWord64 *) x, (StgWord64) val, __ATOMIC_SEQ_CST);
+ return (StgWord64) __atomic_exchange_n((StgWord64 *) x, (StgWord64) val, __ATOMIC_SEQ_CST);
}
-#endif
// AtomicReadByteArrayOp_Int
// Implies a full memory barrier (see compiler/GHC/Builtin/primops.txt.pp)
@@ -391,7 +377,6 @@ hs_atomicread32(StgWord x)
#endif
}
-#if WORD_SIZE_IN_BITS == 64
extern StgWord64 hs_atomicread64(StgWord x);
StgWord64
hs_atomicread64(StgWord x)
@@ -402,7 +387,6 @@ hs_atomicread64(StgWord x)
return __sync_add_and_fetch((StgWord64 *) x, 0);
#endif
}
-#endif
// AtomicWriteByteArrayOp_Int
// Implies a full memory barrier (see compiler/GHC/Builtin/primops.txt.pp)
@@ -441,7 +425,6 @@ hs_atomicwrite32(StgWord x, StgWord val)
#endif
}
-#if WORD_SIZE_IN_BITS == 64
extern void hs_atomicwrite64(StgWord x, StgWord64 val);
void
hs_atomicwrite64(StgWord x, StgWord64 val)
@@ -452,6 +435,5 @@ hs_atomicwrite64(StgWord x, StgWord64 val)
while (!__sync_bool_compare_and_swap((StgWord64 *) x, *(StgWord64 *) x, (StgWord64) val));
#endif
}
-#endif
#endif
=====================================
rts/include/stg/Prim.h
=====================================
@@ -53,7 +53,7 @@ void hs_atomicwrite64(StgWord x, StgWord64 val);
StgWord hs_xchg8(StgWord x, StgWord val);
StgWord hs_xchg16(StgWord x, StgWord val);
StgWord hs_xchg32(StgWord x, StgWord val);
-StgWord hs_xchg64(StgWord x, StgWord val);
+StgWord64 hs_xchg64(StgWord x, StgWord64 val);
/* libraries/ghc-prim/cbits/bswap.c */
StgWord16 hs_bswap16(StgWord16 x);
=====================================
rts/rts.cabal.in
=====================================
@@ -45,8 +45,6 @@ flag libdw
default: @CabalHaveLibdw@
flag libnuma
default: @CabalHaveLibNuma@
-flag 64bit
- default: @Cabal64bit@
flag leading-underscore
default: @CabalLeadingUnderscore@
flag smp
@@ -289,27 +287,6 @@ library
stg/Types.h
-- See Note [Undefined symbols in the RTS]
- if flag(64bit)
- if flag(leading-underscore)
- ld-options:
- "-Wl,-u,_hs_atomic_add64"
- "-Wl,-u,_hs_atomic_sub64"
- "-Wl,-u,_hs_atomic_and64"
- "-Wl,-u,_hs_atomic_nand64"
- "-Wl,-u,_hs_atomic_or64"
- "-Wl,-u,_hs_atomic_xor64"
- "-Wl,-u,_hs_atomicread64"
- "-Wl,-u,_hs_atomicwrite64"
- else
- ld-options:
- "-Wl,-u,hs_atomic_add64"
- "-Wl,-u,hs_atomic_sub64"
- "-Wl,-u,hs_atomic_and64"
- "-Wl,-u,hs_atomic_nand64"
- "-Wl,-u,hs_atomic_or64"
- "-Wl,-u,hs_atomic_xor64"
- "-Wl,-u,hs_atomicread64"
- "-Wl,-u,hs_atomicwrite64"
if flag(leading-underscore)
ld-options:
"-Wl,-u,_base_GHCziTopHandler_runIO_closure"
@@ -357,21 +334,27 @@ library
"-Wl,-u,_hs_atomic_add8"
"-Wl,-u,_hs_atomic_add16"
"-Wl,-u,_hs_atomic_add32"
+ "-Wl,-u,_hs_atomic_add64"
"-Wl,-u,_hs_atomic_sub8"
"-Wl,-u,_hs_atomic_sub16"
"-Wl,-u,_hs_atomic_sub32"
+ "-Wl,-u,_hs_atomic_sub64"
"-Wl,-u,_hs_atomic_and8"
"-Wl,-u,_hs_atomic_and16"
"-Wl,-u,_hs_atomic_and32"
+ "-Wl,-u,_hs_atomic_and64"
"-Wl,-u,_hs_atomic_nand8"
"-Wl,-u,_hs_atomic_nand16"
"-Wl,-u,_hs_atomic_nand32"
+ "-Wl,-u,_hs_atomic_nand64"
"-Wl,-u,_hs_atomic_or8"
"-Wl,-u,_hs_atomic_or16"
"-Wl,-u,_hs_atomic_or32"
+ "-Wl,-u,_hs_atomic_or64"
"-Wl,-u,_hs_atomic_xor8"
"-Wl,-u,_hs_atomic_xor16"
"-Wl,-u,_hs_atomic_xor32"
+ "-Wl,-u,_hs_atomic_xor64"
"-Wl,-u,_hs_cmpxchg8"
"-Wl,-u,_hs_cmpxchg16"
"-Wl,-u,_hs_cmpxchg32"
@@ -383,9 +366,11 @@ library
"-Wl,-u,_hs_atomicread8"
"-Wl,-u,_hs_atomicread16"
"-Wl,-u,_hs_atomicread32"
+ "-Wl,-u,_hs_atomicread64"
"-Wl,-u,_hs_atomicwrite8"
"-Wl,-u,_hs_atomicwrite16"
"-Wl,-u,_hs_atomicwrite32"
+ "-Wl,-u,_hs_atomicwrite64"
"-Wl,-u,_base_GHCziStackziCloneStack_StackSnapshot_closure"
if flag(find-ptr)
@@ -440,21 +425,27 @@ library
"-Wl,-u,hs_atomic_add8"
"-Wl,-u,hs_atomic_add16"
"-Wl,-u,hs_atomic_add32"
+ "-Wl,-u,hs_atomic_add64"
"-Wl,-u,hs_atomic_sub8"
"-Wl,-u,hs_atomic_sub16"
"-Wl,-u,hs_atomic_sub32"
+ "-Wl,-u,hs_atomic_sub64"
"-Wl,-u,hs_atomic_and8"
"-Wl,-u,hs_atomic_and16"
"-Wl,-u,hs_atomic_and32"
+ "-Wl,-u,hs_atomic_and64"
"-Wl,-u,hs_atomic_nand8"
"-Wl,-u,hs_atomic_nand16"
"-Wl,-u,hs_atomic_nand32"
+ "-Wl,-u,hs_atomic_nand64"
"-Wl,-u,hs_atomic_or8"
"-Wl,-u,hs_atomic_or16"
"-Wl,-u,hs_atomic_or32"
+ "-Wl,-u,hs_atomic_or64"
"-Wl,-u,hs_atomic_xor8"
"-Wl,-u,hs_atomic_xor16"
"-Wl,-u,hs_atomic_xor32"
+ "-Wl,-u,hs_atomic_xor64"
"-Wl,-u,hs_cmpxchg8"
"-Wl,-u,hs_cmpxchg16"
"-Wl,-u,hs_cmpxchg32"
@@ -466,9 +457,11 @@ library
"-Wl,-u,hs_atomicread8"
"-Wl,-u,hs_atomicread16"
"-Wl,-u,hs_atomicread32"
+ "-Wl,-u,hs_atomicread64"
"-Wl,-u,hs_atomicwrite8"
"-Wl,-u,hs_atomicwrite16"
"-Wl,-u,hs_atomicwrite32"
+ "-Wl,-u,hs_atomicwrite64"
"-Wl,-u,base_GHCziStackziCloneStack_StackSnapshot_closure"
if flag(find-ptr)
=====================================
testsuite/tests/cmm/should_run/AtomicFetch_cmm.cmm
=====================================
@@ -7,17 +7,17 @@ cmm_foo64 (P_ p)
{
// p points to a ByteArray header, q points to its first element
P_ q;
- q = p + SIZEOF_StgHeader + WDS(1);
+ q = p + SIZEOF_StgHeader + OFFSET_StgArrBytes_payload;
- bits64 x;
+ I64 x;
- prim %store_seqcst64(q, 42);
- (x) = prim %fetch_add64(q, 5);
- (x) = prim %fetch_sub64(q, 10);
- (x) = prim %fetch_and64(q, 120);
- (x) = prim %fetch_or64(q, 2);
- (x) = prim %fetch_xor64(q, 33);
- (x) = prim %fetch_nand64(q, 127);
+ prim %store_seqcst64(q, 42 :: I64);
+ (x) = prim %fetch_add64(q, 5 :: I64);
+ (x) = prim %fetch_sub64(q, 10 :: I64);
+ (x) = prim %fetch_and64(q, 120 :: I64);
+ (x) = prim %fetch_or64(q, 2 :: I64);
+ (x) = prim %fetch_xor64(q, 33 :: I64);
+ (x) = prim %fetch_nand64(q, 127 :: I64);
(x) = prim %load_seqcst64(q);
return (x);
}
@@ -26,9 +26,9 @@ cmm_foo32 (P_ p)
{
// p points to a ByteArray header, q points to its first element
P_ q;
- q = p + SIZEOF_StgHeader + WDS(1);
+ q = p + SIZEOF_StgHeader + OFFSET_StgArrBytes_payload;
- bits32 x;
+ I32 x;
prim %store_seqcst32(q, 42);
(x) = prim %fetch_add32(q, 5);
@@ -45,9 +45,9 @@ cmm_foo16 (P_ p)
{
// p points to a ByteArray header, q points to its first element
P_ q;
- q = p + SIZEOF_StgHeader + WDS(1);
+ q = p + SIZEOF_StgHeader + OFFSET_StgArrBytes_payload;
- bits16 x;
+ I16 x;
prim %store_seqcst16(q, 42);
(x) = prim %fetch_add16(q, 5);
@@ -64,9 +64,9 @@ cmm_foo8 (P_ p)
{
// p points to a ByteArray header, q points to its first element
P_ q;
- q = p + SIZEOF_StgHeader + WDS(1);
+ q = p + SIZEOF_StgHeader + OFFSET_StgArrBytes_payload;
- bits8 x;
+ I8 x;
prim %store_seqcst8(q, 42);
(x) = prim %fetch_add8(q, 5);
=====================================
testsuite/tests/codeGen/should_run/T20137/T20137.stdout-ws-32
=====================================
@@ -5,9 +5,9 @@
5
6
77777777
-ffffffff88888888
-ffffffff99999999
-ffffffffaaaaaaaa
-ffffffffbbbbbbbb
+88888888
+99999999
+aaaaaaaa
+bbbbbbbb
cccccccc
-ffffffffdddddddd
+dddddddd
=====================================
testsuite/tests/codeGen/should_run/T20137/T20137C.c
=====================================
@@ -16,19 +16,19 @@ runInteractiveProcess (char *const * args,
{
// N.B. We don't use %p here since the rendering of this varies across
// libc implementations
- printf("%" PRIx64 "\n", (uint64_t) args);
- printf("%" PRIx64 "\n", (uint64_t) workingDirectory);
- printf("%" PRIx64 "\n", (uint64_t) environment);
+ printf("%" PRIxPTR "\n", (uintptr_t) args);
+ printf("%" PRIxPTR "\n", (uintptr_t) workingDirectory);
+ printf("%" PRIxPTR "\n", (uintptr_t) environment);
printf("%x\n", fdStdIn);
printf("%x\n", fdStdOut);
printf("%x\n", fdStdErr);
- printf("%" PRIx64 "\n", (uint64_t) pfdStdInput);
- printf("%" PRIx64 "\n", (uint64_t) pfdStdOutput);
- printf("%" PRIx64 "\n", (uint64_t) pfdStdError);
- printf("%" PRIx64 "\n", (uint64_t) childGroup);
- printf("%" PRIx64 "\n", (uint64_t) childUser);
+ printf("%" PRIxPTR "\n", (uintptr_t) pfdStdInput);
+ printf("%" PRIxPTR "\n", (uintptr_t) pfdStdOutput);
+ printf("%" PRIxPTR "\n", (uintptr_t) pfdStdError);
+ printf("%" PRIxPTR "\n", (uintptr_t) childGroup);
+ printf("%" PRIxPTR "\n", (uintptr_t) childUser);
printf("%x\n", flags);
- printf("%" PRIx64 "\n", (uint64_t) failed_doing);
+ printf("%" PRIxPTR "\n", (uintptr_t) failed_doing);
return 0;
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9e083c0b704dc3c5574fcb5fce534fbdd43f3729...2d93729979787f001b74e79f489a910915bc2195
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9e083c0b704dc3c5574fcb5fce534fbdd43f3729...2d93729979787f001b74e79f489a910915bc2195
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/20230424/04f35303/attachment-0001.html>
More information about the ghc-commits
mailing list