David Eichmann pushed to branch wip/davide/windows-dlls at Glasgow Haskell Compiler / GHC

Commits:

16 changed files:

Changes:

  • libraries/Win32
    1 
    -Subproject commit 7d0772bb265a6c59eb14c441cf65c778895528df
    1 
    +Subproject commit b3d4064052dd6cd42a59d896b193c5c645a43aa9

  • libraries/base/src/Control/Concurrent.hs
    ... ... @@ -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

  • libraries/bytestring
    1 
    -Subproject commit d984ad00644c0157bad04900434b9d36f23633c5
    1 
    +Subproject commit 48cab2a9247f1a21cdfd1cb64c41f6911c23e395

  • libraries/file-io
    1 
    -Subproject commit 21303160b5dd91d6197bd1d20a8796ba2a819d4e
    1 
    +Subproject commit ea36fd962360bef588366b04609c2adc2c82eec7

  • libraries/ghc-internal/cbits/Win32Utils.c
    ... ... @@ -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;
    ... ... @@ -167,6 +168,7 @@ BOOL file_exists(LPCTSTR path)
    167 168 
     }
    168 169
    169 170 
     /* If true then caller needs to free tempFileName.  */
    171 
    +__attribute__((dllexport))
    170 172 
     bool __createUUIDTempFileErrNo (wchar_t* pathName, wchar_t* prefix,
    171 173 
                                     wchar_t* suffix, wchar_t** tempFileName)
    172 174 
     {

  • libraries/ghc-internal/cbits/inputReady.c
    ... ... @@ -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 
     {

  • libraries/ghc-internal/include/HsBase.h
    ... ... @@ -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

  • libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/GMP.hs
    ... ... @@ -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"

  • libraries/ghc-internal/src/GHC/Internal/Float.hs
    ... ... @@ -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

  • libraries/ghc-internal/src/GHC/Internal/Float/RealFracMethods.hs
    ... ... @@ -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

  • libraries/ghc-internal/src/GHC/Internal/Foreign/C/Error.hs
    ... ... @@ -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

  • libraries/ghc-internal/src/GHC/Internal/IO/Windows/Handle.hsc
    ... ... @@ -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

  • libraries/ghc-internal/src/GHC/Internal/System/IO.hs
    ... ... @@ -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

  • libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs
    ... ... @@ -747,8 +747,12 @@ foreign import capi unsafe "HsBase.h _unlink"
    747 747 
     foreign import capi unsafe "HsBase.h _utime"
    748 748 
        c_utime :: CString -> Ptr CUtimbuf -> IO CInt
    749 749
    750 
    +
    751 
    +{-# NOINLINE c_getpid #-}
    752 
    +c_getpid :: IO CPid
    753 
    +c_getpid = _c_getpid
    750 754 
     foreign import capi unsafe "HsBase.h _getpid"
    751 
    -   c_getpid :: IO CPid
    755 
    +   _c_getpid :: IO CPid
    752 756 
     #else
    753 757 
     -- We use CAPI as on some OSs (eg. Linux) this is wrapped by a macro
    754 758 
     -- which redirects to the 64-bit-off_t versions when large file
    ... ... @@ -833,8 +837,11 @@ foreign import capi unsafe "HsBase.h utime"
    833 837 
     c_getpid :: IO CPid
    834 838 
     c_getpid = pure 1
    835 839 
     #else
    840 
    +{-# NOINLINE c_getpid #-}
    841 
    +c_getpid :: IO CPid
    842 
    +c_getpid = _c_getpid
    836 843 
     foreign import ccall unsafe "HsBase.h getpid"
    837 
    -   c_getpid :: IO CPid
    844 
    +   _c_getpid :: IO CPid
    838 845 
     #endif
    839 846 
     #endif
    840 847
    ... ... @@ -924,7 +931,10 @@ foreign import ccall unsafe "HsBase.h __hscore_o_wronly" o_WRONLY :: CInt
    924 931 
     foreign import ccall unsafe "HsBase.h __hscore_o_rdwr"   o_RDWR   :: CInt
    925 932 
     foreign import ccall unsafe "HsBase.h __hscore_o_append" o_APPEND :: CInt
    926 933 
     foreign import ccall unsafe "HsBase.h __hscore_o_creat"  o_CREAT  :: CInt
    927 
    -foreign import ccall unsafe "HsBase.h __hscore_o_excl"   o_EXCL   :: CInt
    934 
    +{-# NOINLINE o_EXCL #-}
    935 
    +o_EXCL :: CInt
    936 
    +o_EXCL = _o_EXCL
    937 
    +foreign import ccall unsafe "HsBase.h __hscore_o_excl"   _o_EXCL   :: CInt
    928 938 
     foreign import ccall unsafe "HsBase.h __hscore_o_trunc"  o_TRUNC  :: CInt
    929 939
    930 940 
     -- non-POSIX flags.

  • libraries/ghc-internal/src/GHC/Internal/Windows.hs
    ... ... @@ -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

  • libraries/text
    1 
    -Subproject commit 423fd981e576bd17a8b5fa48d0ad6b9a0c370e77
    1 
    +Subproject commit a1e9d389911eb613f2951364b9203be92ebc3cfa

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help