David Eichmann pushed to branch wip/davide/windows-dlls at Glasgow Haskell Compiler / GHC
Commits:
-
9e2ed034
by David Eichmann at 2026-06-29T17:51:23+01:00
15 changed files:
- libraries/Win32
- libraries/base/src/Control/Concurrent.hs
- libraries/bytestring
- libraries/file-io
- libraries/ghc-internal/cbits/Win32Utils.c
- 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/System/IO.hs
- libraries/ghc-internal/src/GHC/Internal/Windows.hs
- libraries/text
Changes:
| 1 | -Subproject commit 7d0772bb265a6c59eb14c441cf65c778895528df |
|
| 1 | +Subproject commit b3d4064052dd6cd42a59d896b193c5c645a43aa9 |
| ... | ... | @@ -132,6 +132,12 @@ import Control.Concurrent.Chan |
| 132 | 132 | import Control.Concurrent.QSem
|
| 133 | 133 | import Control.Concurrent.QSemN
|
| 134 | 134 | |
| 135 | + |
|
| 136 | +-- Needed for windows dynamic builds
|
|
| 137 | +-- TODO we may need to disable inlining of ccalls by default
|
|
| 138 | +{-# NOINLINE waitFd #-}
|
|
| 139 | + |
|
| 140 | + |
|
| 135 | 141 | {- $conc_intro
|
| 136 | 142 | |
| 137 | 143 | The concurrency extension for Haskell is described in the paper
|
| 1 | -Subproject commit d984ad00644c0157bad04900434b9d36f23633c5 |
|
| 1 | +Subproject commit 48cab2a9247f1a21cdfd1cb64c41f6911c23e395 |
| 1 | -Subproject commit 21303160b5dd91d6197bd1d20a8796ba2a819d4e |
|
| 1 | +Subproject commit ea36fd962360bef588366b04609c2adc2c82eec7 |
| ... | ... | @@ -138,6 +138,7 @@ LPWSTR base_getErrorMessage(DWORD err) |
| 138 | 138 | return what;
|
| 139 | 139 | }
|
| 140 | 140 | |
| 141 | +__attribute__((dllexport))
|
|
| 141 | 142 | int get_unique_file_info_hwnd(HANDLE h, HsWord64 *dev, HsWord64 *ino)
|
| 142 | 143 | {
|
| 143 | 144 | BY_HANDLE_FILE_INFORMATION info;
|
| ... | ... | @@ -150,6 +150,7 @@ compute_WaitForSingleObject_timeout(bool infinite, Time remaining) |
| 150 | 150 | * 1 => Input ready, 0 => not ready, -1 => error
|
| 151 | 151 | * On error, sets `errno`.
|
| 152 | 152 | */
|
| 153 | +__attribute__((dllexport))
|
|
| 153 | 154 | int
|
| 154 | 155 | fdReady(int fd, bool write, int64_t msecs, bool isSock)
|
| 155 | 156 | {
|
| ... | ... | @@ -134,7 +134,7 @@ |
| 134 | 134 | #if defined(_WIN32)
|
| 135 | 135 | /* in Win32Utils.c */
|
| 136 | 136 | extern void maperrno (void);
|
| 137 | -extern int maperrno_func(DWORD dwErrorCode);
|
|
| 137 | +__attribute__((dllexport)) extern int maperrno_func(DWORD dwErrorCode);
|
|
| 138 | 138 | extern HsWord64 getMonotonicUSec(void);
|
| 139 | 139 | #endif
|
| 140 | 140 |
| ... | ... | @@ -622,8 +622,11 @@ foreign import ccall unsafe "integer_gmp_mpn_xor_n" |
| 622 | 622 | -> IO ()
|
| 623 | 623 | |
| 624 | 624 | -- mp_bitcnt_t mpn_popcount (const mp_limb_t *s1p, mp_size_t n)
|
| 625 | +{-# NOINLINE c_mpn_popcount #-}
|
|
| 626 | +c_mpn_popcount :: ByteArray# -> GmpSize# -> Word#
|
|
| 627 | +c_mpn_popcount a b = _c_mpn_popcount a b
|
|
| 625 | 628 | foreign import ccall unsafe "gmp.h __gmpn_popcount"
|
| 626 | - c_mpn_popcount :: ByteArray# -> GmpSize# -> Word#
|
|
| 629 | + _c_mpn_popcount :: ByteArray# -> GmpSize# -> Word#
|
|
| 627 | 630 | |
| 628 | 631 | -- double integer_gmp_mpn_get_d (const mp_limb_t sp[], const mp_size_t sn)
|
| 629 | 632 | foreign import ccall unsafe "integer_gmp_mpn_get_d"
|
| ... | ... | @@ -1632,17 +1632,47 @@ atanhDouble (D# x) = D# (atanhDouble# x) |
| 1632 | 1632 | powerDouble :: Double -> Double -> Double
|
| 1633 | 1633 | powerDouble (D# x) (D# y) = D# (x **## y)
|
| 1634 | 1634 | |
| 1635 | -foreign import ccall unsafe "isFloatNaN" isFloatNaN :: Float -> Int
|
|
| 1636 | -foreign import ccall unsafe "isFloatInfinite" isFloatInfinite :: Float -> Int
|
|
| 1637 | -foreign import ccall unsafe "isFloatDenormalized" isFloatDenormalized :: Float -> Int
|
|
| 1638 | -foreign import ccall unsafe "isFloatNegativeZero" isFloatNegativeZero :: Float -> Int
|
|
| 1639 | -foreign import ccall unsafe "isFloatFinite" isFloatFinite :: Float -> Int
|
|
| 1640 | - |
|
| 1641 | -foreign import ccall unsafe "isDoubleNaN" isDoubleNaN :: Double -> Int
|
|
| 1642 | -foreign import ccall unsafe "isDoubleInfinite" isDoubleInfinite :: Double -> Int
|
|
| 1643 | -foreign import ccall unsafe "isDoubleDenormalized" isDoubleDenormalized :: Double -> Int
|
|
| 1644 | -foreign import ccall unsafe "isDoubleNegativeZero" isDoubleNegativeZero :: Double -> Int
|
|
| 1645 | -foreign import ccall unsafe "isDoubleFinite" isDoubleFinite :: Double -> Int
|
|
| 1635 | +{-# NOINLINE isFloatInfinite #-}
|
|
| 1636 | +isFloatInfinite :: Float -> Int
|
|
| 1637 | +isFloatInfinite x = cIsFloatInfinite x
|
|
| 1638 | +foreign import ccall unsafe "isFloatInfinite" cIsFloatInfinite :: Float -> Int
|
|
| 1639 | +{-# NOINLINE isFloatNaN #-}
|
|
| 1640 | +isFloatNaN :: Float -> Int
|
|
| 1641 | +isFloatNaN = _isFloatNaN
|
|
| 1642 | +foreign import ccall unsafe "isFloatNaN" _isFloatNaN :: Float -> Int
|
|
| 1643 | +{-# NOINLINE isFloatDenormalized #-}
|
|
| 1644 | +isFloatDenormalized :: Float -> Int
|
|
| 1645 | +isFloatDenormalized = _isFloatDenormalized
|
|
| 1646 | +foreign import ccall unsafe "isFloatDenormalized" _isFloatDenormalized :: Float -> Int
|
|
| 1647 | +{-# NOINLINE isFloatNegativeZero #-}
|
|
| 1648 | +isFloatNegativeZero :: Float -> Int
|
|
| 1649 | +isFloatNegativeZero = _isFloatNegativeZero
|
|
| 1650 | +foreign import ccall unsafe "isFloatNegativeZero" _isFloatNegativeZero :: Float -> Int
|
|
| 1651 | +{-# NOINLINE isFloatFinite #-}
|
|
| 1652 | +isFloatFinite :: Float -> Int
|
|
| 1653 | +isFloatFinite = _isFloatFinite
|
|
| 1654 | +foreign import ccall unsafe "isFloatFinite" _isFloatFinite :: Float -> Int
|
|
| 1655 | + |
|
| 1656 | +{-# NOINLINE isDoubleInfinite #-}
|
|
| 1657 | +isDoubleInfinite :: Double -> Int
|
|
| 1658 | +isDoubleInfinite x = cIsDoubleInfinite x
|
|
| 1659 | +foreign import ccall unsafe "isDoubleInfinite" cIsDoubleInfinite :: Double -> Int
|
|
| 1660 | +{-# NOINLINE isDoubleNaN #-}
|
|
| 1661 | +isDoubleNaN :: Double -> Int
|
|
| 1662 | +isDoubleNaN = _isDoubleNaN
|
|
| 1663 | +foreign import ccall unsafe "isDoubleNaN" _isDoubleNaN :: Double -> Int
|
|
| 1664 | +{-# NOINLINE isDoubleDenormalized #-}
|
|
| 1665 | +isDoubleDenormalized :: Double -> Int
|
|
| 1666 | +isDoubleDenormalized = _isDoubleDenormalized
|
|
| 1667 | +foreign import ccall unsafe "isDoubleDenormalized" _isDoubleDenormalized :: Double -> Int
|
|
| 1668 | +{-# NOINLINE isDoubleNegativeZero #-}
|
|
| 1669 | +isDoubleNegativeZero :: Double -> Int
|
|
| 1670 | +isDoubleNegativeZero = _isDoubleNegativeZero
|
|
| 1671 | +foreign import ccall unsafe "isDoubleNegativeZero" _isDoubleNegativeZero :: Double -> Int
|
|
| 1672 | +{-# NOINLINE isDoubleFinite #-}
|
|
| 1673 | +isDoubleFinite :: Double -> Int
|
|
| 1674 | +isDoubleFinite = _isDoubleFinite
|
|
| 1675 | +foreign import ccall unsafe "isDoubleFinite" _isDoubleFinite :: Double -> Int
|
|
| 1646 | 1676 | |
| 1647 | 1677 | ------------------------------------------------------------------------
|
| 1648 | 1678 | -- Coercion rules
|
| ... | ... | @@ -357,5 +357,8 @@ float2Integer (F# x) = |
| 357 | 357 | foreign import ccall unsafe "rintDouble"
|
| 358 | 358 | c_rintDouble :: Double -> Double
|
| 359 | 359 | |
| 360 | +{-# NOINLINE c_rintFloat #-}
|
|
| 361 | +c_rintFloat :: Float -> Float
|
|
| 362 | +c_rintFloat = _c_rintFloat
|
|
| 360 | 363 | foreign import ccall unsafe "rintFloat"
|
| 361 | - c_rintFloat :: Float -> Float |
|
| 364 | + _c_rintFloat :: Float -> Float |
| ... | ... | @@ -109,6 +109,14 @@ import GHC.Internal.Num |
| 109 | 109 | import GHC.Internal.Base ( String, otherwise, return, ($) )
|
| 110 | 110 | import GHC.Internal.Types ( Bool(..) )
|
| 111 | 111 | |
| 112 | + |
|
| 113 | + |
|
| 114 | +-- Needed for windows dynamic builds
|
|
| 115 | +-- TODO we may need to disable inlining of ccalls by default
|
|
| 116 | +{-# NOINLINE getErrno #-}
|
|
| 117 | + |
|
| 118 | + |
|
| 119 | + |
|
| 112 | 120 | -- "errno" type
|
| 113 | 121 | -- ------------
|
| 114 | 122 |
| ... | ... | @@ -387,8 +387,11 @@ foreign import ccall safe "__get_console_echo" |
| 387 | 387 | foreign import ccall safe "__close_handle"
|
| 388 | 388 | c_close_handle :: HANDLE -> IO Bool
|
| 389 | 389 | |
| 390 | +{-# NOINLINE c_handle_type #-}
|
|
| 391 | +c_handle_type :: HANDLE -> IO Int
|
|
| 392 | +c_handle_type = _c_handle_type
|
|
| 390 | 393 | foreign import ccall safe "__handle_type"
|
| 391 | - c_handle_type :: HANDLE -> IO Int
|
|
| 394 | + _c_handle_type :: HANDLE -> IO Int
|
|
| 392 | 395 | |
| 393 | 396 | foreign import ccall safe "__set_file_pointer"
|
| 394 | 397 | c_set_file_pointer :: HANDLE -> CLong -> DWORD -> Ptr CLong -> IO BOOL
|
| ... | ... | @@ -990,8 +993,11 @@ handleToMode hwnd = do |
| 990 | 993 | | hasFlag (#{const GENERIC_WRITE}) -> return WriteMode
|
| 991 | 994 | | otherwise -> error "unknown access mask in handleToMode."
|
| 992 | 995 | |
| 996 | +{-# NOINLINE c_get_handle_access_mask #-}
|
|
| 997 | +c_get_handle_access_mask :: HANDLE -> IO DWORD
|
|
| 998 | +c_get_handle_access_mask = _c_get_handle_access_mask
|
|
| 993 | 999 | foreign import ccall unsafe "__get_handle_access_mask"
|
| 994 | - c_get_handle_access_mask :: HANDLE -> IO DWORD
|
|
| 1000 | + _c_get_handle_access_mask :: HANDLE -> IO DWORD
|
|
| 995 | 1001 | |
| 996 | 1002 | release :: RawHandle a => a -> IO ()
|
| 997 | 1003 | release h = if isLockable h
|
| ... | ... | @@ -1011,11 +1017,15 @@ foreign import ccall unsafe "unlockFile" |
| 1011 | 1017 | |
| 1012 | 1018 | -- | Returns -1 on error. Otherwise writes two values representing
|
| 1013 | 1019 | -- the file into the given ptrs.
|
| 1020 | +{-# NOINLINE c_getUniqueFileInfo #-}
|
|
| 1021 | +c_getUniqueFileInfo :: HANDLE -> Ptr Word64 -> Ptr Word64 -> IO ()
|
|
| 1022 | +c_getUniqueFileInfo = _c_getUniqueFileInfo
|
|
| 1014 | 1023 | foreign import ccall unsafe "get_unique_file_info_hwnd"
|
| 1015 | - c_getUniqueFileInfo :: HANDLE -> Ptr Word64 -> Ptr Word64 -> IO ()
|
|
| 1024 | + _c_getUniqueFileInfo :: HANDLE -> Ptr Word64 -> Ptr Word64 -> IO ()
|
|
| 1016 | 1025 | |
| 1017 | 1026 | -- | getUniqueFileInfo assumes the C call to getUniqueFileInfo
|
| 1018 | 1027 | -- succeeds.
|
| 1028 | +{-# NOINLINE getUniqueFileInfo #-}
|
|
| 1019 | 1029 | getUniqueFileInfo :: RawHandle a => a -> IO (Word64, Word64)
|
| 1020 | 1030 | getUniqueFileInfo handle = do
|
| 1021 | 1031 | with 0 $ \devptr -> do
|
| ... | ... | @@ -738,7 +738,10 @@ openTempFile' loc tmp_dir template binary mode |
| 738 | 738 | foreign import ccall "getTempFileNameErrorNo" c_getTempFileNameErrorNo
|
| 739 | 739 | :: CWString -> CWString -> CWString -> CUInt -> Ptr CWchar -> IO Bool
|
| 740 | 740 | |
| 741 | -foreign import ccall "__createUUIDTempFileErrNo" c_createUUIDTempFileErrNo
|
|
| 741 | +{-# NOINLINE c_createUUIDTempFileErrNo #-}
|
|
| 742 | +c_createUUIDTempFileErrNo :: CWString -> CWString -> CWString -> Ptr CWString -> IO Bool
|
|
| 743 | +c_createUUIDTempFileErrNo = _c_createUUIDTempFileErrNo
|
|
| 744 | +foreign import ccall "__createUUIDTempFileErrNo" _c_createUUIDTempFileErrNo
|
|
| 742 | 745 | :: CWString -> CWString -> CWString -> Ptr CWString -> IO Bool
|
| 743 | 746 | |
| 744 | 747 | pathSeparator :: String -> Bool
|
| ... | ... | @@ -217,8 +217,11 @@ foreign import ccall unsafe "maperrno" -- in Win32Utils.c |
| 217 | 217 | |
| 218 | 218 | -- | Pure function variant of 'c_maperrno' that does not call @GetLastError@
|
| 219 | 219 | -- or modify @errno@.
|
| 220 | +{-# NOINLINE c_maperrno_func #-}
|
|
| 221 | +c_maperrno_func :: ErrCode -> Errno
|
|
| 222 | +c_maperrno_func = _c_maperrno_func
|
|
| 220 | 223 | foreign import ccall unsafe "maperrno_func" -- in Win32Utils.c
|
| 221 | - c_maperrno_func :: ErrCode -> Errno
|
|
| 224 | + _c_maperrno_func :: ErrCode -> Errno
|
|
| 222 | 225 | |
| 223 | 226 | foreign import ccall unsafe "base_getErrorMessage" -- in Win32Utils.c
|
| 224 | 227 | c_getErrorMessage :: DWORD -> IO LPWSTR
|
| 1 | -Subproject commit 423fd981e576bd17a8b5fa48d0ad6b9a0c370e77 |
|
| 1 | +Subproject commit a1e9d389911eb613f2951364b9203be92ebc3cfa |