From 7d86914e22df09da3a1d4aa8ab331209a994d22d Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Tue, 3 Apr 2007 00:16:11 +0000 Subject: [PATCH] Fix type mismatches between foreign imports and HsBase.h Merge to stable, checking for interface changes. --- Data/Array/IO.hs | 10 ++--- GHC/IO.hs | 31 +++++++-------- System/Posix/Internals.hs | 25 +++++++++--- cbits/longlong.c | 10 +++-- include/HsBase.h | 93 ++++++++++++++++++++++----------------------- 5 files changed, 92 insertions(+), 77 deletions(-) diff --git a/Data/Array/IO.hs b/Data/Array/IO.hs index a476a32..1231683 100644 --- a/Data/Array/IO.hs +++ b/Data/Array/IO.hs @@ -143,11 +143,11 @@ hGetArray handle (IOUArray (STUArray l u ptr)) count let avail = w - r copied <- if (count >= avail) then do - memcpy_ba_baoff ptr raw r (fromIntegral avail) + memcpy_ba_baoff ptr raw (fromIntegral r) (fromIntegral avail) writeIORef ref buf{ bufWPtr=0, bufRPtr=0 } return avail else do - memcpy_ba_baoff ptr raw r (fromIntegral count) + memcpy_ba_baoff ptr raw (fromIntegral r) (fromIntegral count) writeIORef ref buf{ bufRPtr = r + count } return count @@ -196,7 +196,7 @@ hPutArray handle (IOUArray (STUArray l u raw)) count if (size - w > count) -- There's enough room in the buffer: -- just copy the data in and update bufWPtr. - then do memcpy_baoff_ba old_raw w raw (fromIntegral count) + then do memcpy_baoff_ba old_raw (fromIntegral w) raw (fromIntegral count) writeIORef ref old_buf{ bufWPtr = w + count } return () @@ -213,9 +213,9 @@ hPutArray handle (IOUArray (STUArray l u raw)) count -- Internal Utils foreign import ccall unsafe "__hscore_memcpy_dst_off" - memcpy_baoff_ba :: RawBuffer -> Int -> RawBuffer -> CSize -> IO (Ptr ()) + memcpy_baoff_ba :: RawBuffer -> CInt -> RawBuffer -> CSize -> IO (Ptr ()) foreign import ccall unsafe "__hscore_memcpy_src_off" - memcpy_ba_baoff :: RawBuffer -> RawBuffer -> Int -> CSize -> IO (Ptr ()) + memcpy_ba_baoff :: RawBuffer -> RawBuffer -> CInt -> CSize -> IO (Ptr ()) illegalBufferSize :: Handle -> String -> Int -> IO a illegalBufferSize handle fn sz = diff --git a/GHC/IO.hs b/GHC/IO.hs index 14a6696..0a7416f 100644 --- a/GHC/IO.hs +++ b/GHC/IO.hs @@ -90,12 +90,13 @@ hWaitForInput h msecs = do writeIORef ref buf' return True else do r <- throwErrnoIfMinus1Retry "hWaitForInput" $ - inputReady (haFD handle_) - (fromIntegral msecs) (haIsStream handle_) + inputReady (haFD handle_) + (fromIntegral msecs) + (fromIntegral $ fromEnum $ haIsStream handle_) return (r /= 0) foreign import ccall safe "inputReady" - inputReady :: CInt -> CInt -> Bool -> IO CInt + inputReady :: CInt -> CInt -> CInt -> IO CInt -- --------------------------------------------------------------------------- -- hGetChar @@ -601,7 +602,7 @@ commitBuffer' raw sz@(I# _) count@(I# _) flush release -- not flushing, and there's enough room in the buffer: -- just copy the data in and update bufWPtr. - then do memcpy_baoff_ba old_raw w raw (fromIntegral count) + then do memcpy_baoff_ba old_raw (fromIntegral w) raw (fromIntegral count) writeIORef ref old_buf{ bufWPtr = w + count } return (newEmptyBuffer raw WriteBuffer sz) @@ -695,7 +696,7 @@ bufWrite fd ref is_stream ptr count can_block = if (size - w > count) -- There's enough room in the buffer: -- just copy the data in and update bufWPtr. - then do memcpy_baoff_ptr old_raw w ptr (fromIntegral count) + then do memcpy_baoff_ptr old_raw (fromIntegral w) ptr (fromIntegral count) writeIORef ref old_buf{ bufWPtr = w + count } return count @@ -793,18 +794,18 @@ bufRead fd ref is_stream ptr so_far count = let avail = w - r if (count == avail) then do - memcpy_ptr_baoff ptr raw r (fromIntegral count) + memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral count) writeIORef ref buf{ bufWPtr=0, bufRPtr=0 } return (so_far + count) else do if (count < avail) then do - memcpy_ptr_baoff ptr raw r (fromIntegral count) + memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral count) writeIORef ref buf{ bufRPtr = r + count } return (so_far + count) else do - memcpy_ptr_baoff ptr raw r (fromIntegral avail) + memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral avail) writeIORef ref buf{ bufWPtr=0, bufRPtr=0 } let remaining = count - avail so_far' = so_far + avail @@ -876,18 +877,18 @@ bufReadNonBlocking fd ref is_stream ptr so_far count = let avail = w - r if (count == avail) then do - memcpy_ptr_baoff ptr raw r (fromIntegral count) + memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral count) writeIORef ref buf{ bufWPtr=0, bufRPtr=0 } return (so_far + count) else do if (count < avail) then do - memcpy_ptr_baoff ptr raw r (fromIntegral count) + memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral count) writeIORef ref buf{ bufRPtr = r + count } return (so_far + count) else do - memcpy_ptr_baoff ptr raw r (fromIntegral avail) + memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral avail) writeIORef ref buf{ bufWPtr=0, bufRPtr=0 } let remaining = count - avail so_far' = so_far + avail @@ -941,13 +942,13 @@ slurpFile fname = do -- memcpy wrappers foreign import ccall unsafe "__hscore_memcpy_src_off" - memcpy_ba_baoff :: RawBuffer -> RawBuffer -> Int -> CSize -> IO (Ptr ()) + memcpy_ba_baoff :: RawBuffer -> RawBuffer -> CInt -> CSize -> IO (Ptr ()) foreign import ccall unsafe "__hscore_memcpy_src_off" - memcpy_ptr_baoff :: Ptr a -> RawBuffer -> Int -> CSize -> IO (Ptr ()) + memcpy_ptr_baoff :: Ptr a -> RawBuffer -> CInt -> CSize -> IO (Ptr ()) foreign import ccall unsafe "__hscore_memcpy_dst_off" - memcpy_baoff_ba :: RawBuffer -> Int -> RawBuffer -> CSize -> IO (Ptr ()) + memcpy_baoff_ba :: RawBuffer -> CInt -> RawBuffer -> CSize -> IO (Ptr ()) foreign import ccall unsafe "__hscore_memcpy_dst_off" - memcpy_baoff_ptr :: RawBuffer -> Int -> Ptr a -> CSize -> IO (Ptr ()) + memcpy_baoff_ptr :: RawBuffer -> CInt -> Ptr a -> CSize -> IO (Ptr ()) ----------------------------------------------------------------------------- -- Internal Utils diff --git a/System/Posix/Internals.hs b/System/Posix/Internals.hs index a679949..015c477 100644 --- a/System/Posix/Internals.hs +++ b/System/Posix/Internals.hs @@ -466,11 +466,22 @@ foreign import ccall unsafe "HsBase.h __hscore_o_noctty" o_NOCTTY :: CInt foreign import ccall unsafe "HsBase.h __hscore_o_nonblock" o_NONBLOCK :: CInt foreign import ccall unsafe "HsBase.h __hscore_o_binary" o_BINARY :: CInt -foreign import ccall unsafe "HsBase.h __hscore_s_isreg" s_isreg :: CMode -> Bool -foreign import ccall unsafe "HsBase.h __hscore_s_ischr" s_ischr :: CMode -> Bool -foreign import ccall unsafe "HsBase.h __hscore_s_isblk" s_isblk :: CMode -> Bool -foreign import ccall unsafe "HsBase.h __hscore_s_isdir" s_isdir :: CMode -> Bool -foreign import ccall unsafe "HsBase.h __hscore_s_isfifo" s_isfifo :: CMode -> Bool +foreign import ccall unsafe "HsBase.h __hscore_s_isreg" c_s_isreg :: CMode -> CInt +foreign import ccall unsafe "HsBase.h __hscore_s_ischr" c_s_ischr :: CMode -> CInt +foreign import ccall unsafe "HsBase.h __hscore_s_isblk" c_s_isblk :: CMode -> CInt +foreign import ccall unsafe "HsBase.h __hscore_s_isdir" c_s_isdir :: CMode -> CInt +foreign import ccall unsafe "HsBase.h __hscore_s_isfifo" c_s_isfifo :: CMode -> CInt + +s_isreg :: CMode -> Bool +s_isreg cm = c_s_isreg cm /= 0 +s_ischr :: CMode -> Bool +s_ischr cm = c_s_ischr cm /= 0 +s_isblk :: CMode -> Bool +s_isblk cm = c_s_isblk cm /= 0 +s_isdir :: CMode -> Bool +s_isdir cm = c_s_isdir cm /= 0 +s_isfifo :: CMode -> Bool +s_isfifo cm = c_s_isfifo cm /= 0 foreign import ccall unsafe "HsBase.h __hscore_sizeof_stat" sizeof_stat :: Int foreign import ccall unsafe "HsBase.h __hscore_st_mtime" st_mtime :: Ptr CStat -> IO CTime @@ -498,7 +509,9 @@ foreign import ccall unsafe "HsBase.h __hscore_ptr_c_cc" ptr_c_cc :: Ptr CTermi #endif #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) -foreign import ccall unsafe "HsBase.h __hscore_s_issock" s_issock :: CMode -> Bool +foreign import ccall unsafe "HsBase.h __hscore_s_issock" c_s_issock :: CMode -> CInt +s_issock :: CMode -> Bool +s_issock cmode = c_s_issock cmode /= 0 #else s_issock :: CMode -> Bool s_issock cmode = False diff --git a/cbits/longlong.c b/cbits/longlong.c index f6e8567..459ff38 100644 --- a/cbits/longlong.c +++ b/cbits/longlong.c @@ -50,6 +50,7 @@ StgBool stg_leInt64 (StgInt64 a, StgInt64 b) {return a <= b;} StgWord64 stg_remWord64 (StgWord64 a, StgWord64 b) {return a % b;} StgWord64 stg_quotWord64 (StgWord64 a, StgWord64 b) {return a / b;} + StgInt64 stg_remInt64 (StgInt64 a, StgInt64 b) {return a % b;} StgInt64 stg_quotInt64 (StgInt64 a, StgInt64 b) {return a / b;} StgInt64 stg_negateInt64 (StgInt64 a) {return -a;} @@ -63,6 +64,7 @@ StgWord64 stg_and64 (StgWord64 a, StgWord64 b) {return a & b;} StgWord64 stg_or64 (StgWord64 a, StgWord64 b) {return a | b;} StgWord64 stg_xor64 (StgWord64 a, StgWord64 b) {return a ^ b;} StgWord64 stg_not64 (StgWord64 a) {return ~a;} + StgWord64 stg_uncheckedShiftL64 (StgWord64 a, StgInt b) {return a << b;} StgWord64 stg_uncheckedShiftRL64 (StgWord64 a, StgInt b) {return a >> b;} /* Right shifting of signed quantities is not portable in C, so @@ -72,7 +74,7 @@ StgWord64 stg_uncheckedShiftRL64 (StgWord64 a, StgInt b) {return a >> b;} StgInt64 stg_uncheckedIShiftL64 (StgInt64 a, StgInt b) {return a << b;} StgInt64 stg_uncheckedIShiftRA64 (StgInt64 a, StgInt b) {return a >> b;} StgInt64 stg_uncheckedIShiftRL64 (StgInt64 a, StgInt b) -{return (StgInt64) ((StgWord64) a >> b);} + {return (StgInt64) ((StgWord64) a >> b);} /* Casting between longs and longer longs. (the primops that cast from long longs to Integers @@ -86,10 +88,10 @@ StgWord64 stg_wordToWord64 (StgWord w) {return (StgWord64) w;} StgWord stg_word64ToWord (StgWord64 w) {return (StgWord) w;} StgInt64 stg_word64ToInt64 (StgWord64 w) {return (StgInt64) w;} -StgWord64 stg_integerToWord64 (I_ sa, StgByteArray /* Really: mp_limb_t* */ da) +StgWord64 stg_integerToWord64 (StgInt sa, StgByteArray /* Really: mp_limb_t* */ da) { mp_limb_t* d; - I_ s; + StgInt s; StgWord64 res; d = (mp_limb_t *)da; s = sa; @@ -107,7 +109,7 @@ StgWord64 stg_integerToWord64 (I_ sa, StgByteArray /* Really: mp_limb_t* */ da) StgInt64 stg_integerToInt64 (StgInt sa, StgByteArray /* Really: mp_limb_t* */ da) { mp_limb_t* d; - I_ s; + StgInt s; StgInt64 res; d = (mp_limb_t *)da; s = (sa); diff --git a/include/HsBase.h b/include/HsBase.h index 45e2d39..39acf82 100644 --- a/include/HsBase.h +++ b/include/HsBase.h @@ -167,19 +167,19 @@ extern void pPrPr_disableITimers (void); #ifdef SUPPORT_LONG_LONGS -StgInt stg_gtWord64 (StgWord64, StgWord64); -StgInt stg_geWord64 (StgWord64, StgWord64); -StgInt stg_eqWord64 (StgWord64, StgWord64); -StgInt stg_neWord64 (StgWord64, StgWord64); -StgInt stg_ltWord64 (StgWord64, StgWord64); -StgInt stg_leWord64 (StgWord64, StgWord64); - -StgInt stg_gtInt64 (StgInt64, StgInt64); -StgInt stg_geInt64 (StgInt64, StgInt64); -StgInt stg_eqInt64 (StgInt64, StgInt64); -StgInt stg_neInt64 (StgInt64, StgInt64); -StgInt stg_ltInt64 (StgInt64, StgInt64); -StgInt stg_leInt64 (StgInt64, StgInt64); +StgBool stg_gtWord64 (StgWord64, StgWord64); +StgBool stg_geWord64 (StgWord64, StgWord64); +StgBool stg_eqWord64 (StgWord64, StgWord64); +StgBool stg_neWord64 (StgWord64, StgWord64); +StgBool stg_ltWord64 (StgWord64, StgWord64); +StgBool stg_leWord64 (StgWord64, StgWord64); + +StgBool stg_gtInt64 (StgInt64, StgInt64); +StgBool stg_geInt64 (StgInt64, StgInt64); +StgBool stg_eqInt64 (StgInt64, StgInt64); +StgBool stg_neInt64 (StgInt64, StgInt64); +StgBool stg_ltInt64 (StgInt64, StgInt64); +StgBool stg_leInt64 (StgInt64, StgInt64); StgWord64 stg_remWord64 (StgWord64, StgWord64); StgWord64 stg_quotWord64 (StgWord64, StgWord64); @@ -199,19 +199,18 @@ StgWord64 stg_not64 (StgWord64); StgWord64 stg_uncheckedShiftL64 (StgWord64, StgInt); StgWord64 stg_uncheckedShiftRL64 (StgWord64, StgInt); StgInt64 stg_uncheckedIShiftL64 (StgInt64, StgInt); -StgInt64 stg_uncheckedIShiftRL64 (StgInt64, StgInt); StgInt64 stg_uncheckedIShiftRA64 (StgInt64, StgInt); +StgInt64 stg_uncheckedIShiftRL64 (StgInt64, StgInt); StgInt64 stg_intToInt64 (StgInt); StgInt stg_int64ToInt (StgInt64); StgWord64 stg_int64ToWord64 (StgInt64); - StgWord64 stg_wordToWord64 (StgWord); StgWord stg_word64ToWord (StgWord64); StgInt64 stg_word64ToInt64 (StgWord64); -StgInt64 stg_integerToInt64 (StgInt sa, StgByteArray /* Really: mp_limb_t* */ da); StgWord64 stg_integerToWord64 (StgInt sa, StgByteArray /* Really: mp_limb_t* */ da); +StgInt64 stg_integerToInt64 (StgInt sa, StgByteArray /* Really: mp_limb_t* */ da); #endif /* SUPPORT_LONG_LONGS */ @@ -235,13 +234,13 @@ INLINE int __hscore_get_errno(void) { return errno; } INLINE void __hscore_set_errno(int e) { errno = e; } #if !defined(_MSC_VER) -INLINE int __hscore_s_isreg(m) { return S_ISREG(m); } -INLINE int __hscore_s_isdir(m) { return S_ISDIR(m); } -INLINE int __hscore_s_isfifo(m) { return S_ISFIFO(m); } -INLINE int __hscore_s_isblk(m) { return S_ISBLK(m); } -INLINE int __hscore_s_ischr(m) { return S_ISCHR(m); } +INLINE int __hscore_s_isreg(mode_t m) { return S_ISREG(m); } +INLINE int __hscore_s_isdir(mode_t m) { return S_ISDIR(m); } +INLINE int __hscore_s_isfifo(mode_t m) { return S_ISFIFO(m); } +INLINE int __hscore_s_isblk(mode_t m) { return S_ISBLK(m); } +INLINE int __hscore_s_ischr(mode_t m) { return S_ISCHR(m); } #ifdef S_ISSOCK -INLINE int __hscore_s_issock(m) { return S_ISSOCK(m); } +INLINE int __hscore_s_issock(mode_t m) { return S_ISSOCK(m); } #endif #endif @@ -291,13 +290,13 @@ __hscore_bufsiz() return BUFSIZ; } -INLINE HsInt +INLINE int __hscore_seek_cur() { return SEEK_CUR; } -INLINE HsInt +INLINE int __hscore_o_binary() { #if defined(_MSC_VER) @@ -397,13 +396,13 @@ __hscore_o_nonblock( void ) #endif } -INLINE HsInt +INLINE int __hscore_seek_set( void ) { return SEEK_SET; } -INLINE HsInt +INLINE int __hscore_seek_end( void ) { return SEEK_END; @@ -421,8 +420,8 @@ __hscore_ftruncate( int fd, off_t where ) #endif } -INLINE HsInt -__hscore_setmode( HsInt fd, HsBool toBin ) +INLINE int +__hscore_setmode( int fd, HsBool toBin ) { #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) return setmode(fd,(toBin == HS_BOOL_TRUE) ? _O_BINARY : _O_TEXT); @@ -433,28 +432,28 @@ __hscore_setmode( HsInt fd, HsBool toBin ) #if __GLASGOW_HASKELL__ -INLINE HsInt -__hscore_PrelHandle_write( HsInt fd, HsAddr ptr, HsInt off, int sz ) +INLINE int +__hscore_PrelHandle_write( int fd, void *ptr, HsInt off, int sz ) { return write(fd,(char *)ptr + off, sz); } -INLINE HsInt -__hscore_PrelHandle_read( HsInt fd, HsAddr ptr, HsInt off, int sz ) +INLINE int +__hscore_PrelHandle_read( int fd, void *ptr, HsInt off, int sz ) { return read(fd,(char *)ptr + off, sz); } #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) -INLINE HsInt -__hscore_PrelHandle_send( HsInt fd, HsAddr ptr, HsInt off, int sz ) +INLINE int +__hscore_PrelHandle_send( int fd, void *ptr, HsInt off, int sz ) { return send(fd,(char *)ptr + off, sz, 0); } -INLINE HsInt -__hscore_PrelHandle_recv( HsInt fd, HsAddr ptr, HsInt off, int sz ) +INLINE int +__hscore_PrelHandle_recv( int fd, void *ptr, HsInt off, int sz ) { return recv(fd,(char *)ptr + off, sz, 0); } @@ -462,8 +461,8 @@ __hscore_PrelHandle_recv( HsInt fd, HsAddr ptr, HsInt off, int sz ) #endif /* __GLASGOW_HASKELL__ */ -INLINE HsInt -__hscore_mkdir( HsAddr pathName, HsInt mode ) +INLINE int +__hscore_mkdir( char *pathName, int mode ) { #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) return mkdir(pathName); @@ -472,13 +471,13 @@ __hscore_mkdir( HsAddr pathName, HsInt mode ) #endif } -INLINE HsInt -__hscore_lstat( HsAddr fname, HsAddr st ) +INLINE int +__hscore_lstat( const char *fname, struct stat *st ) { #if HAVE_LSTAT - return lstat((const char*)fname, (struct stat*)st); + return lstat(fname, st); #else - return stat((const char*)fname, (struct stat*)st); + return stat(fname, st); #endif } @@ -512,20 +511,20 @@ INLINE mode_t __hscore_S_IWUSR() { return S_IWUSR; } INLINE mode_t __hscore_S_IXUSR() { return S_IXUSR; } #endif -INLINE HsAddr +INLINE char * __hscore_d_name( struct dirent* d ) { - return (HsAddr)(d->d_name); + return (d->d_name); } -INLINE HsInt +INLINE int __hscore_end_of_dir( void ) { return READDIR_ERRNO_EOF; } INLINE void -__hscore_free_dirent(HsAddr dEnt) +__hscore_free_dirent(struct dirent *dEnt) { #if HAVE_READDIR_R free(dEnt); @@ -710,7 +709,7 @@ INLINE int hsFD_SETSIZE(void) { return FD_SETSIZE; } INLINE void hsFD_CLR(int fd, fd_set *fds) { FD_CLR(fd, fds); } INLINE int hsFD_ISSET(int fd, fd_set *fds) { return FD_ISSET(fd, fds); } INLINE void hsFD_SET(int fd, fd_set *fds) { FD_SET(fd, fds); } -INLINE int sizeof_fd_set(void) { return sizeof(fd_set); } +INLINE HsInt sizeof_fd_set(void) { return sizeof(fd_set); } extern void hsFD_ZERO(fd_set *fds); #endif -- 1.7.10.4