David Eichmann pushed to branch wip/davide/windows-dlls at Glasgow Haskell Compiler / GHC Commits: dfca0289 by David Eichmann at 2026-06-29T17:38:28+01:00 use --export-all-symbols for RTS - - - - - d1188eb4 by David Eichmann at 2026-06-29T17:40:19+01:00 WIP export-all-symbols from hadrian - - - - - 12 changed files: - hadrian/src/Settings/Packages.hs - libraries/Win32 - libraries/base/src/Control/Concurrent.hs - libraries/bytestring - libraries/ghc-internal/cbits/inputReady.c - libraries/ghc-internal/include/HsBase.h - libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/GMP.hs - libraries/ghc-internal/src/GHC/Internal/Float.hs - libraries/ghc-internal/src/GHC/Internal/Float/RealFracMethods.hs - libraries/ghc-internal/src/GHC/Internal/Foreign/C/Error.hs - libraries/ghc-internal/src/GHC/Internal/IO/Windows/Handle.hsc - libraries/ghc-internal/src/GHC/Internal/Windows.hs Changes: ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -322,6 +322,7 @@ rtsPackageArgs = package rts ? do , Threaded `wayUnit` way ? arg "-DTHREADED_RTS" , notM targetSupportsSMP ? arg "-optc-DNOSMP" , isWinHost ? arg "-optl-Wl,--disable-runtime-pseudo-reloc" + <> arg "-optl-Wl,--export-all-symbols" -- See Note [AutoApply.cmm for vectors] in genapply/Main.hs -- ===================================== libraries/Win32 ===================================== @@ -1 +1 @@ -Subproject commit 7d0772bb265a6c59eb14c441cf65c778895528df +Subproject commit b3d4064052dd6cd42a59d896b193c5c645a43aa9 ===================================== libraries/base/src/Control/Concurrent.hs ===================================== @@ -132,6 +132,12 @@ import Control.Concurrent.Chan import Control.Concurrent.QSem import Control.Concurrent.QSemN + +-- Needed for windows dynamic builds +-- TODO we may need to disable inlining of ccalls by default +{-# NOINLINE waitFd #-} + + {- $conc_intro The concurrency extension for Haskell is described in the paper ===================================== libraries/bytestring ===================================== @@ -1 +1 @@ -Subproject commit d984ad00644c0157bad04900434b9d36f23633c5 +Subproject commit 48cab2a9247f1a21cdfd1cb64c41f6911c23e395 ===================================== libraries/ghc-internal/cbits/inputReady.c ===================================== @@ -150,6 +150,7 @@ compute_WaitForSingleObject_timeout(bool infinite, Time remaining) * 1 => Input ready, 0 => not ready, -1 => error * On error, sets `errno`. */ +__attribute__((dllexport)) int fdReady(int fd, bool write, int64_t msecs, bool isSock) { ===================================== libraries/ghc-internal/include/HsBase.h ===================================== @@ -134,7 +134,7 @@ #if defined(_WIN32) /* in Win32Utils.c */ extern void maperrno (void); -extern int maperrno_func(DWORD dwErrorCode); +__attribute__((dllexport)) extern int maperrno_func(DWORD dwErrorCode); extern HsWord64 getMonotonicUSec(void); #endif ===================================== libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/GMP.hs ===================================== @@ -622,8 +622,11 @@ foreign import ccall unsafe "integer_gmp_mpn_xor_n" -> IO () -- mp_bitcnt_t mpn_popcount (const mp_limb_t *s1p, mp_size_t n) +{-# NOINLINE c_mpn_popcount #-} +c_mpn_popcount :: ByteArray# -> GmpSize# -> Word# +c_mpn_popcount a b = _c_mpn_popcount a b foreign import ccall unsafe "gmp.h __gmpn_popcount" - c_mpn_popcount :: ByteArray# -> GmpSize# -> Word# + _c_mpn_popcount :: ByteArray# -> GmpSize# -> Word# -- double integer_gmp_mpn_get_d (const mp_limb_t sp[], const mp_size_t sn) foreign import ccall unsafe "integer_gmp_mpn_get_d" ===================================== libraries/ghc-internal/src/GHC/Internal/Float.hs ===================================== @@ -1632,17 +1632,47 @@ atanhDouble (D# x) = D# (atanhDouble# x) powerDouble :: Double -> Double -> Double powerDouble (D# x) (D# y) = D# (x **## y) -foreign import ccall unsafe "isFloatNaN" isFloatNaN :: Float -> Int -foreign import ccall unsafe "isFloatInfinite" isFloatInfinite :: Float -> Int -foreign import ccall unsafe "isFloatDenormalized" isFloatDenormalized :: Float -> Int -foreign import ccall unsafe "isFloatNegativeZero" isFloatNegativeZero :: Float -> Int -foreign import ccall unsafe "isFloatFinite" isFloatFinite :: Float -> Int - -foreign import ccall unsafe "isDoubleNaN" isDoubleNaN :: Double -> Int -foreign import ccall unsafe "isDoubleInfinite" isDoubleInfinite :: Double -> Int -foreign import ccall unsafe "isDoubleDenormalized" isDoubleDenormalized :: Double -> Int -foreign import ccall unsafe "isDoubleNegativeZero" isDoubleNegativeZero :: Double -> Int -foreign import ccall unsafe "isDoubleFinite" isDoubleFinite :: Double -> Int +{-# NOINLINE isFloatInfinite #-} +isFloatInfinite :: Float -> Int +isFloatInfinite x = cIsFloatInfinite x +foreign import ccall unsafe "isFloatInfinite" cIsFloatInfinite :: Float -> Int +{-# NOINLINE isFloatNaN #-} +isFloatNaN :: Float -> Int +isFloatNaN = _isFloatNaN +foreign import ccall unsafe "isFloatNaN" _isFloatNaN :: Float -> Int +{-# NOINLINE isFloatDenormalized #-} +isFloatDenormalized :: Float -> Int +isFloatDenormalized = _isFloatDenormalized +foreign import ccall unsafe "isFloatDenormalized" _isFloatDenormalized :: Float -> Int +{-# NOINLINE isFloatNegativeZero #-} +isFloatNegativeZero :: Float -> Int +isFloatNegativeZero = _isFloatNegativeZero +foreign import ccall unsafe "isFloatNegativeZero" _isFloatNegativeZero :: Float -> Int +{-# NOINLINE isFloatFinite #-} +isFloatFinite :: Float -> Int +isFloatFinite = _isFloatFinite +foreign import ccall unsafe "isFloatFinite" _isFloatFinite :: Float -> Int + +{-# NOINLINE isDoubleInfinite #-} +isDoubleInfinite :: Double -> Int +isDoubleInfinite x = cIsDoubleInfinite x +foreign import ccall unsafe "isDoubleInfinite" cIsDoubleInfinite :: Double -> Int +{-# NOINLINE isDoubleNaN #-} +isDoubleNaN :: Double -> Int +isDoubleNaN = _isDoubleNaN +foreign import ccall unsafe "isDoubleNaN" _isDoubleNaN :: Double -> Int +{-# NOINLINE isDoubleDenormalized #-} +isDoubleDenormalized :: Double -> Int +isDoubleDenormalized = _isDoubleDenormalized +foreign import ccall unsafe "isDoubleDenormalized" _isDoubleDenormalized :: Double -> Int +{-# NOINLINE isDoubleNegativeZero #-} +isDoubleNegativeZero :: Double -> Int +isDoubleNegativeZero = _isDoubleNegativeZero +foreign import ccall unsafe "isDoubleNegativeZero" _isDoubleNegativeZero :: Double -> Int +{-# NOINLINE isDoubleFinite #-} +isDoubleFinite :: Double -> Int +isDoubleFinite = _isDoubleFinite +foreign import ccall unsafe "isDoubleFinite" _isDoubleFinite :: Double -> Int ------------------------------------------------------------------------ -- Coercion rules ===================================== libraries/ghc-internal/src/GHC/Internal/Float/RealFracMethods.hs ===================================== @@ -357,5 +357,8 @@ float2Integer (F# x) = foreign import ccall unsafe "rintDouble" c_rintDouble :: Double -> Double +{-# NOINLINE c_rintFloat #-} +c_rintFloat :: Float -> Float +c_rintFloat = _c_rintFloat foreign import ccall unsafe "rintFloat" - c_rintFloat :: Float -> Float + _c_rintFloat :: Float -> Float ===================================== libraries/ghc-internal/src/GHC/Internal/Foreign/C/Error.hs ===================================== @@ -109,6 +109,14 @@ import GHC.Internal.Num import GHC.Internal.Base ( String, otherwise, return, ($) ) import GHC.Internal.Types ( Bool(..) ) + + +-- Needed for windows dynamic builds +-- TODO we may need to disable inlining of ccalls by default +{-# NOINLINE getErrno #-} + + + -- "errno" type -- ------------ ===================================== libraries/ghc-internal/src/GHC/Internal/IO/Windows/Handle.hsc ===================================== @@ -387,8 +387,11 @@ foreign import ccall safe "__get_console_echo" foreign import ccall safe "__close_handle" c_close_handle :: HANDLE -> IO Bool +{-# NOINLINE c_handle_type #-} +c_handle_type :: HANDLE -> IO Int +c_handle_type = _c_handle_type foreign import ccall safe "__handle_type" - c_handle_type :: HANDLE -> IO Int + _c_handle_type :: HANDLE -> IO Int foreign import ccall safe "__set_file_pointer" c_set_file_pointer :: HANDLE -> CLong -> DWORD -> Ptr CLong -> IO BOOL @@ -990,8 +993,11 @@ handleToMode hwnd = do | hasFlag (#{const GENERIC_WRITE}) -> return WriteMode | otherwise -> error "unknown access mask in handleToMode." +{-# NOINLINE c_get_handle_access_mask #-} +c_get_handle_access_mask :: HANDLE -> IO DWORD +c_get_handle_access_mask = _c_get_handle_access_mask foreign import ccall unsafe "__get_handle_access_mask" - c_get_handle_access_mask :: HANDLE -> IO DWORD + _c_get_handle_access_mask :: HANDLE -> IO DWORD release :: RawHandle a => a -> IO () release h = if isLockable h @@ -1011,11 +1017,15 @@ foreign import ccall unsafe "unlockFile" -- | Returns -1 on error. Otherwise writes two values representing -- the file into the given ptrs. +{-# NOINLINE c_getUniqueFileInfo #-} +c_getUniqueFileInfo :: HANDLE -> Ptr Word64 -> Ptr Word64 -> IO () +c_getUniqueFileInfo = _c_getUniqueFileInfo foreign import ccall unsafe "get_unique_file_info_hwnd" - c_getUniqueFileInfo :: HANDLE -> Ptr Word64 -> Ptr Word64 -> IO () + _c_getUniqueFileInfo :: HANDLE -> Ptr Word64 -> Ptr Word64 -> IO () -- | getUniqueFileInfo assumes the C call to getUniqueFileInfo -- succeeds. +{-# NOINLINE getUniqueFileInfo #-} getUniqueFileInfo :: RawHandle a => a -> IO (Word64, Word64) getUniqueFileInfo handle = do with 0 $ \devptr -> do ===================================== libraries/ghc-internal/src/GHC/Internal/Windows.hs ===================================== @@ -217,8 +217,11 @@ foreign import ccall unsafe "maperrno" -- in Win32Utils.c -- | Pure function variant of 'c_maperrno' that does not call @GetLastError@ -- or modify @errno@. +{-# NOINLINE c_maperrno_func #-} +c_maperrno_func :: ErrCode -> Errno +c_maperrno_func = _c_maperrno_func foreign import ccall unsafe "maperrno_func" -- in Win32Utils.c - c_maperrno_func :: ErrCode -> Errno + _c_maperrno_func :: ErrCode -> Errno foreign import ccall unsafe "base_getErrorMessage" -- in Win32Utils.c c_getErrorMessage :: DWORD -> IO LPWSTR View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/352a6a489bbc611c6c5fb37dfcb9ee9... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/352a6a489bbc611c6c5fb37dfcb9ee9... You're receiving this email because of your account on gitlab.haskell.org.