Fix type mismatches between foreign imports and HsBase.h

Merge to stable, checking for interface changes.

diff --git a/Data/Array/IO.hs b/Data/Array/IO.hs
index a476a32..1231683 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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