From 553e39786807a03e5072a717d722d56d646cbde8 Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Tue, 3 Apr 2007 19:49:43 +0000 Subject: [PATCH] Fix C/Haskell type mismatches --- Data/Array/Base.hs | 4 +- Data/ByteString/Base.hs | 45 ++++++++++----------- Foreign/Marshal/Utils.hs | 10 +++-- GHC/Conc.lhs | 6 +-- GHC/Int.hs | 54 ++++++++++++------------- GHC/TopHandler.lhs | 4 +- GHC/Word.hs | 50 +++++++++++------------ System/Directory.hs | 6 +-- System/Environment.hs | 5 ++- System/Posix/Internals.hs | 10 ++--- System/Posix/Signals.hs | 2 +- System/Random.hs | 2 +- System/Time.hsc | 7 ++-- cbits/dirUtils.c | 24 ++++++------ cbits/longlong.c | 96 +++++++++++++++++++++++---------------------- cbits/timeUtils.c | 8 ++-- include/HsBase.h | 94 ++++++++++++++++++++++---------------------- include/dirUtils.h | 4 +- include/timeUtils.h | 4 +- 19 files changed, 219 insertions(+), 216 deletions(-) diff --git a/Data/Array/Base.hs b/Data/Array/Base.hs index 08a748a..0cc0df5 100644 --- a/Data/Array/Base.hs +++ b/Data/Array/Base.hs @@ -25,6 +25,7 @@ import qualified Control.Monad.ST.Lazy as Lazy (ST) import Data.Ix ( Ix, range, index, rangeSize ) import Data.Int import Data.Word +import Foreign.C.Types import Foreign.Ptr import Foreign.StablePtr @@ -1593,7 +1594,8 @@ thawSTUArray (UArray l u arr#) = ST $ \s1# -> (# s3#, STUArray l u marr# #) }}} foreign import ccall unsafe "memcpy" - memcpy :: MutableByteArray# RealWorld -> ByteArray# -> Int# -> IO () + memcpy :: MutableByteArray# RealWorld -> ByteArray# -> CSize + -> IO (Ptr a) {-# RULES "thaw/STArray" thaw = ArrST.thawSTArray diff --git a/Data/ByteString/Base.hs b/Data/ByteString/Base.hs index d80a118..a125812 100644 --- a/Data/ByteString/Base.hs +++ b/Data/ByteString/Base.hs @@ -456,21 +456,34 @@ foreign import ccall unsafe "static stdlib.h free" c_free foreign import ccall unsafe "static stdlib.h &free" c_free_finalizer :: FunPtr (Ptr Word8 -> IO ()) -foreign import ccall unsafe "string.h memchr" memchr - :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8) +foreign import ccall unsafe "string.h memchr" c_memchr + :: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8) + +memchr :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8) +memchr p w s = c_memchr p (fromIntegral w) s foreign import ccall unsafe "string.h memcmp" memcmp :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt -foreign import ccall unsafe "string.h memcpy" memcpy - :: Ptr Word8 -> Ptr Word8 -> CSize -> IO () +foreign import ccall unsafe "string.h memcpy" c_memcpy + :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8) + +memcpy :: Ptr Word8 -> Ptr Word8 -> CSize -> IO () +memcpy p q s = do c_memcpy p q s + return () -foreign import ccall unsafe "string.h memmove" memmove - :: Ptr Word8 -> Ptr Word8 -> CSize -> IO () +foreign import ccall unsafe "string.h memmove" c_memmove + :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8) -foreign import ccall unsafe "string.h memset" memset - :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8) +memmove :: Ptr Word8 -> Ptr Word8 -> CSize -> IO () +memmove p q s = do c_memmove p q s + return () +foreign import ccall unsafe "string.h memset" c_memset + :: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8) + +memset :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8) +memset p w s = c_memset p (fromIntegral w) s -- --------------------------------------------------------------------- -- @@ -493,22 +506,6 @@ foreign import ccall unsafe "static fpstring.h fps_count" c_count :: Ptr Word8 -> CULong -> Word8 -> IO CULong -- --------------------------------------------------------------------- --- MMap - -{- -foreign import ccall unsafe "static fpstring.h my_mmap" my_mmap - :: Int -> Int -> IO (Ptr Word8) - -foreign import ccall unsafe "static unistd.h close" c_close - :: Int -> IO Int - -# if !defined(__OpenBSD__) -foreign import ccall unsafe "static sys/mman.h munmap" c_munmap - :: Ptr Word8 -> Int -> IO Int -# endif --} - --- --------------------------------------------------------------------- -- Internal GHC Haskell magic #if defined(__GLASGOW_HASKELL__) diff --git a/Foreign/Marshal/Utils.hs b/Foreign/Marshal/Utils.hs index 4e03055..72f7d9b 100644 --- a/Foreign/Marshal/Utils.hs +++ b/Foreign/Marshal/Utils.hs @@ -159,13 +159,15 @@ withMany withFoo (x:xs) f = withFoo x $ \x' -> -- first (destination); the copied areas may /not/ overlap -- copyBytes :: Ptr a -> Ptr a -> Int -> IO () -copyBytes dest src size = memcpy dest src (fromIntegral size) +copyBytes dest src size = do memcpy dest src (fromIntegral size) + return () -- |Copies the given number of bytes from the second area (source) into the -- first (destination); the copied areas /may/ overlap -- moveBytes :: Ptr a -> Ptr a -> Int -> IO () -moveBytes dest src size = memmove dest src (fromIntegral size) +moveBytes dest src size = do memmove dest src (fromIntegral size) + return () -- auxilliary routines @@ -173,5 +175,5 @@ moveBytes dest src size = memmove dest src (fromIntegral size) -- |Basic C routines needed for memory copying -- -foreign import ccall unsafe "string.h" memcpy :: Ptr a -> Ptr a -> CSize -> IO () -foreign import ccall unsafe "string.h" memmove :: Ptr a -> Ptr a -> CSize -> IO () +foreign import ccall unsafe "string.h" memcpy :: Ptr a -> Ptr a -> CSize -> IO (Ptr a) +foreign import ccall unsafe "string.h" memmove :: Ptr a -> Ptr a -> CSize -> IO (Ptr a) diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs index e52785f..7883cd6 100644 --- a/GHC/Conc.lhs +++ b/GHC/Conc.lhs @@ -146,7 +146,7 @@ instance Show ThreadId where showString "ThreadId " . showsPrec d (getThreadId (id2TSO t)) -foreign import ccall unsafe "rts_getThreadId" getThreadId :: ThreadId# -> Int +foreign import ccall unsafe "rts_getThreadId" getThreadId :: ThreadId# -> CInt id2TSO :: ThreadId -> ThreadId# id2TSO (ThreadId t) = t @@ -915,7 +915,7 @@ service_loop wakeup readfds writefds ptimeval old_reqs old_delays = do now <- getUSecOfDay (delays', timeout) <- getDelay now ptimeval delays - res <- c_select ((max wakeup maxfd)+1) readfds writefds + res <- c_select (fromIntegral ((max wakeup maxfd)+1)) readfds writefds nullPtr timeout if (res == -1) then do @@ -1065,7 +1065,7 @@ foreign import ccall unsafe "setTimevalTicks" newtype CFdSet = CFdSet () foreign import ccall safe "select" - c_select :: Fd -> Ptr CFdSet -> Ptr CFdSet -> Ptr CFdSet -> Ptr CTimeVal + c_select :: CInt -> Ptr CFdSet -> Ptr CFdSet -> Ptr CFdSet -> Ptr CTimeVal -> IO CInt foreign import ccall unsafe "hsFD_SETSIZE" diff --git a/GHC/Int.hs b/GHC/Int.hs index c2ce279..2bb7d5c 100644 --- a/GHC/Int.hs +++ b/GHC/Int.hs @@ -688,33 +688,33 @@ a `iShiftRA64#` b | b >=# 64# = if a `ltInt64#` (intToInt64# 0#) | otherwise = a `uncheckedIShiftRA64#` b -foreign import ccall unsafe "stg_eqInt64" eqInt64# :: Int64# -> Int64# -> Bool -foreign import ccall unsafe "stg_neInt64" neInt64# :: Int64# -> Int64# -> Bool -foreign import ccall unsafe "stg_ltInt64" ltInt64# :: Int64# -> Int64# -> Bool -foreign import ccall unsafe "stg_leInt64" leInt64# :: Int64# -> Int64# -> Bool -foreign import ccall unsafe "stg_gtInt64" gtInt64# :: Int64# -> Int64# -> Bool -foreign import ccall unsafe "stg_geInt64" geInt64# :: Int64# -> Int64# -> Bool -foreign import ccall unsafe "stg_plusInt64" plusInt64# :: Int64# -> Int64# -> Int64# -foreign import ccall unsafe "stg_minusInt64" minusInt64# :: Int64# -> Int64# -> Int64# -foreign import ccall unsafe "stg_timesInt64" timesInt64# :: Int64# -> Int64# -> Int64# -foreign import ccall unsafe "stg_negateInt64" negateInt64# :: Int64# -> Int64# -foreign import ccall unsafe "stg_quotInt64" quotInt64# :: Int64# -> Int64# -> Int64# -foreign import ccall unsafe "stg_remInt64" remInt64# :: Int64# -> Int64# -> Int64# -foreign import ccall unsafe "stg_intToInt64" intToInt64# :: Int# -> Int64# -foreign import ccall unsafe "stg_int64ToInt" int64ToInt# :: Int64# -> Int# -foreign import ccall unsafe "stg_wordToWord64" wordToWord64# :: Word# -> Word64# -foreign import ccall unsafe "stg_int64ToWord64" int64ToWord64# :: Int64# -> Word64# -foreign import ccall unsafe "stg_word64ToInt64" word64ToInt64# :: Word64# -> Int64# -foreign import ccall unsafe "stg_and64" and64# :: Word64# -> Word64# -> Word64# -foreign import ccall unsafe "stg_or64" or64# :: Word64# -> Word64# -> Word64# -foreign import ccall unsafe "stg_xor64" xor64# :: Word64# -> Word64# -> Word64# -foreign import ccall unsafe "stg_not64" not64# :: Word64# -> Word64# -foreign import ccall unsafe "stg_uncheckedShiftL64" uncheckedShiftL64# :: Word64# -> Int# -> Word64# -foreign import ccall unsafe "stg_uncheckedShiftRL64" uncheckedShiftRL64# :: Word64# -> Int# -> Word64# -foreign import ccall unsafe "stg_uncheckedIShiftL64" uncheckedIShiftL64# :: Int64# -> Int# -> Int64# -foreign import ccall unsafe "stg_uncheckedIShiftRA64" uncheckedIShiftRA64# :: Int64# -> Int# -> Int64# - -foreign import ccall unsafe "stg_integerToInt64" integerToInt64# :: Int# -> ByteArray# -> Int64# +foreign import ccall unsafe "hs_eqInt64" eqInt64# :: Int64# -> Int64# -> Bool +foreign import ccall unsafe "hs_neInt64" neInt64# :: Int64# -> Int64# -> Bool +foreign import ccall unsafe "hs_ltInt64" ltInt64# :: Int64# -> Int64# -> Bool +foreign import ccall unsafe "hs_leInt64" leInt64# :: Int64# -> Int64# -> Bool +foreign import ccall unsafe "hs_gtInt64" gtInt64# :: Int64# -> Int64# -> Bool +foreign import ccall unsafe "hs_geInt64" geInt64# :: Int64# -> Int64# -> Bool +foreign import ccall unsafe "hs_plusInt64" plusInt64# :: Int64# -> Int64# -> Int64# +foreign import ccall unsafe "hs_minusInt64" minusInt64# :: Int64# -> Int64# -> Int64# +foreign import ccall unsafe "hs_timesInt64" timesInt64# :: Int64# -> Int64# -> Int64# +foreign import ccall unsafe "hs_negateInt64" negateInt64# :: Int64# -> Int64# +foreign import ccall unsafe "hs_quotInt64" quotInt64# :: Int64# -> Int64# -> Int64# +foreign import ccall unsafe "hs_remInt64" remInt64# :: Int64# -> Int64# -> Int64# +foreign import ccall unsafe "hs_intToInt64" intToInt64# :: Int# -> Int64# +foreign import ccall unsafe "hs_int64ToInt" int64ToInt# :: Int64# -> Int# +foreign import ccall unsafe "hs_wordToWord64" wordToWord64# :: Word# -> Word64# +foreign import ccall unsafe "hs_int64ToWord64" int64ToWord64# :: Int64# -> Word64# +foreign import ccall unsafe "hs_word64ToInt64" word64ToInt64# :: Word64# -> Int64# +foreign import ccall unsafe "hs_and64" and64# :: Word64# -> Word64# -> Word64# +foreign import ccall unsafe "hs_or64" or64# :: Word64# -> Word64# -> Word64# +foreign import ccall unsafe "hs_xor64" xor64# :: Word64# -> Word64# -> Word64# +foreign import ccall unsafe "hs_not64" not64# :: Word64# -> Word64# +foreign import ccall unsafe "hs_uncheckedShiftL64" uncheckedShiftL64# :: Word64# -> Int# -> Word64# +foreign import ccall unsafe "hs_uncheckedShiftRL64" uncheckedShiftRL64# :: Word64# -> Int# -> Word64# +foreign import ccall unsafe "hs_uncheckedIShiftL64" uncheckedIShiftL64# :: Int64# -> Int# -> Int64# +foreign import ccall unsafe "hs_uncheckedIShiftRA64" uncheckedIShiftRA64# :: Int64# -> Int# -> Int64# + +foreign import ccall unsafe "hs_integerToInt64" integerToInt64# :: Int# -> ByteArray# -> Int64# {-# RULES "fromIntegral/Int->Int64" fromIntegral = \(I# x#) -> I64# (intToInt64# x#) diff --git a/GHC/TopHandler.lhs b/GHC/TopHandler.lhs index 3c64fc8..44ac461 100644 --- a/GHC/TopHandler.lhs +++ b/GHC/TopHandler.lhs @@ -123,12 +123,12 @@ cleanUpAndExit r = do cleanUp; safeExit r -- we have to use unsafeCoerce# to get the 'IO a' result type, since the -- compiler doesn't let us declare that as the result type of a foreign export. safeExit :: Int -> IO a -safeExit r = unsafeCoerce# (shutdownHaskellAndExit r) +safeExit r = unsafeCoerce# (shutdownHaskellAndExit $ fromIntegral r) -- NOTE: shutdownHaskellAndExit must be called "safe", because it *can* -- re-enter Haskell land through finalizers. foreign import ccall "Rts.h shutdownHaskellAndExit" - shutdownHaskellAndExit :: Int -> IO () + shutdownHaskellAndExit :: CInt -> IO () fastExit :: Int -> IO a fastExit r = unsafeCoerce# (stg_exit (fromIntegral r)) diff --git a/GHC/Word.hs b/GHC/Word.hs index 694a9df..0c9741d 100644 --- a/GHC/Word.hs +++ b/GHC/Word.hs @@ -745,31 +745,31 @@ a `shiftRL64#` b | b >=# 64# = wordToWord64# (int2Word# 0#) | otherwise = a `uncheckedShiftRL64#` b -foreign import ccall unsafe "stg_eqWord64" eqWord64# :: Word64# -> Word64# -> Bool -foreign import ccall unsafe "stg_neWord64" neWord64# :: Word64# -> Word64# -> Bool -foreign import ccall unsafe "stg_ltWord64" ltWord64# :: Word64# -> Word64# -> Bool -foreign import ccall unsafe "stg_leWord64" leWord64# :: Word64# -> Word64# -> Bool -foreign import ccall unsafe "stg_gtWord64" gtWord64# :: Word64# -> Word64# -> Bool -foreign import ccall unsafe "stg_geWord64" geWord64# :: Word64# -> Word64# -> Bool -foreign import ccall unsafe "stg_int64ToWord64" int64ToWord64# :: Int64# -> Word64# -foreign import ccall unsafe "stg_word64ToInt64" word64ToInt64# :: Word64# -> Int64# -foreign import ccall unsafe "stg_intToInt64" intToInt64# :: Int# -> Int64# -foreign import ccall unsafe "stg_wordToWord64" wordToWord64# :: Word# -> Word64# -foreign import ccall unsafe "stg_word64ToWord" word64ToWord# :: Word64# -> Word# -foreign import ccall unsafe "stg_plusInt64" plusInt64# :: Int64# -> Int64# -> Int64# -foreign import ccall unsafe "stg_minusInt64" minusInt64# :: Int64# -> Int64# -> Int64# -foreign import ccall unsafe "stg_timesInt64" timesInt64# :: Int64# -> Int64# -> Int64# -foreign import ccall unsafe "stg_negateInt64" negateInt64# :: Int64# -> Int64# -foreign import ccall unsafe "stg_quotWord64" quotWord64# :: Word64# -> Word64# -> Word64# -foreign import ccall unsafe "stg_remWord64" remWord64# :: Word64# -> Word64# -> Word64# -foreign import ccall unsafe "stg_and64" and64# :: Word64# -> Word64# -> Word64# -foreign import ccall unsafe "stg_or64" or64# :: Word64# -> Word64# -> Word64# -foreign import ccall unsafe "stg_xor64" xor64# :: Word64# -> Word64# -> Word64# -foreign import ccall unsafe "stg_not64" not64# :: Word64# -> Word64# -foreign import ccall unsafe "stg_uncheckedShiftL64" uncheckedShiftL64# :: Word64# -> Int# -> Word64# -foreign import ccall unsafe "stg_uncheckedShiftRL64" uncheckedShiftRL64# :: Word64# -> Int# -> Word64# - -foreign import ccall unsafe "stg_integerToWord64" integerToWord64# :: Int# -> ByteArray# -> Word64# +foreign import ccall unsafe "hs_eqWord64" eqWord64# :: Word64# -> Word64# -> Bool +foreign import ccall unsafe "hs_neWord64" neWord64# :: Word64# -> Word64# -> Bool +foreign import ccall unsafe "hs_ltWord64" ltWord64# :: Word64# -> Word64# -> Bool +foreign import ccall unsafe "hs_leWord64" leWord64# :: Word64# -> Word64# -> Bool +foreign import ccall unsafe "hs_gtWord64" gtWord64# :: Word64# -> Word64# -> Bool +foreign import ccall unsafe "hs_geWord64" geWord64# :: Word64# -> Word64# -> Bool +foreign import ccall unsafe "hs_int64ToWord64" int64ToWord64# :: Int64# -> Word64# +foreign import ccall unsafe "hs_word64ToInt64" word64ToInt64# :: Word64# -> Int64# +foreign import ccall unsafe "hs_intToInt64" intToInt64# :: Int# -> Int64# +foreign import ccall unsafe "hs_wordToWord64" wordToWord64# :: Word# -> Word64# +foreign import ccall unsafe "hs_word64ToWord" word64ToWord# :: Word64# -> Word# +foreign import ccall unsafe "hs_plusInt64" plusInt64# :: Int64# -> Int64# -> Int64# +foreign import ccall unsafe "hs_minusInt64" minusInt64# :: Int64# -> Int64# -> Int64# +foreign import ccall unsafe "hs_timesInt64" timesInt64# :: Int64# -> Int64# -> Int64# +foreign import ccall unsafe "hs_negateInt64" negateInt64# :: Int64# -> Int64# +foreign import ccall unsafe "hs_quotWord64" quotWord64# :: Word64# -> Word64# -> Word64# +foreign import ccall unsafe "hs_remWord64" remWord64# :: Word64# -> Word64# -> Word64# +foreign import ccall unsafe "hs_and64" and64# :: Word64# -> Word64# -> Word64# +foreign import ccall unsafe "hs_or64" or64# :: Word64# -> Word64# -> Word64# +foreign import ccall unsafe "hs_xor64" xor64# :: Word64# -> Word64# -> Word64# +foreign import ccall unsafe "hs_not64" not64# :: Word64# -> Word64# +foreign import ccall unsafe "hs_uncheckedShiftL64" uncheckedShiftL64# :: Word64# -> Int# -> Word64# +foreign import ccall unsafe "hs_uncheckedShiftRL64" uncheckedShiftRL64# :: Word64# -> Int# -> Word64# + +foreign import ccall unsafe "hs_integerToWord64" integerToWord64# :: Int# -> ByteArray# -> Word64# {-# RULES diff --git a/System/Directory.hs b/System/Directory.hs index 9b70480..90de6fa 100644 --- a/System/Directory.hs +++ b/System/Directory.hs @@ -862,9 +862,9 @@ fileNameEndClean name = i = (length name) - 1 ec = name !! i -foreign import ccall unsafe "__hscore_R_OK" r_OK :: CMode -foreign import ccall unsafe "__hscore_W_OK" w_OK :: CMode -foreign import ccall unsafe "__hscore_X_OK" x_OK :: CMode +foreign import ccall unsafe "__hscore_R_OK" r_OK :: CInt +foreign import ccall unsafe "__hscore_W_OK" w_OK :: CInt +foreign import ccall unsafe "__hscore_X_OK" x_OK :: CInt foreign import ccall unsafe "__hscore_S_IRUSR" s_IRUSR :: CMode foreign import ccall unsafe "__hscore_S_IWUSR" s_IWUSR :: CMode diff --git a/System/Environment.hs b/System/Environment.hs index 3271e29..ce972a0 100644 --- a/System/Environment.hs +++ b/System/Environment.hs @@ -29,6 +29,7 @@ module System.Environment import Prelude #ifdef __GLASGOW_HASKELL__ +import Data.List import Foreign import Foreign.C import Control.Exception ( bracket ) @@ -165,11 +166,11 @@ freeArgv argv = do setArgs :: [String] -> IO (Ptr CString) setArgs argv = do vs <- mapM newCString argv >>= newArray0 nullPtr - setArgsPrim (length argv) vs + setArgsPrim (genericLength argv) vs return vs foreign import ccall unsafe "setProgArgv" - setArgsPrim :: Int -> Ptr CString -> IO () + setArgsPrim :: CInt -> Ptr CString -> IO () -- |'getEnvironment' retrieves the entire environment as a -- list of @(key,value)@ pairs. diff --git a/System/Posix/Internals.hs b/System/Posix/Internals.hs index 015c477..e03c5dd 100644 --- a/System/Posix/Internals.hs +++ b/System/Posix/Internals.hs @@ -295,7 +295,7 @@ setNonBlockingFD fd = do -- there are certain file handles on which this will fail (eg. /dev/null -- on FreeBSD) so we throw away the return code from fcntl_write. unless (testBit flags (fromIntegral o_NONBLOCK)) $ do - c_fcntl_write fd const_f_setfl (flags .|. o_NONBLOCK) + c_fcntl_write fd const_f_setfl (fromIntegral (flags .|. o_NONBLOCK)) return () #else @@ -308,7 +308,7 @@ setNonBlockingFD fd = return () -- foreign imports foreign import ccall unsafe "HsBase.h access" - c_access :: CString -> CMode -> IO CInt + c_access :: CString -> CInt -> IO CInt foreign import ccall unsafe "HsBase.h chmod" c_chmod :: CString -> CMode -> IO CInt @@ -335,7 +335,7 @@ foreign import ccall unsafe "HsBase.h __hscore_fstat" c_fstat :: CInt -> Ptr CStat -> IO CInt foreign import ccall unsafe "HsBase.h getcwd" - c_getcwd :: Ptr CChar -> CInt -> IO (Ptr CChar) + c_getcwd :: Ptr CChar -> CSize -> IO (Ptr CChar) foreign import ccall unsafe "HsBase.h isatty" c_isatty :: CInt -> IO CInt @@ -390,7 +390,7 @@ foreign import ccall unsafe "HsBase.h fcntl" c_fcntl_read :: CInt -> CInt -> IO CInt foreign import ccall unsafe "HsBase.h fcntl" - c_fcntl_write :: CInt -> CInt -> CInt -> IO CInt + c_fcntl_write :: CInt -> CInt -> CLong -> IO CInt foreign import ccall unsafe "HsBase.h fcntl" c_fcntl_lock :: CInt -> CInt -> Ptr CFLock -> IO CInt @@ -423,7 +423,7 @@ foreign import ccall unsafe "HsBase.h tcsetattr" c_tcsetattr :: CInt -> CInt -> Ptr CTermios -> IO CInt foreign import ccall unsafe "HsBase.h utime" - c_utime :: CString -> Ptr CUtimbuf -> IO CMode + c_utime :: CString -> Ptr CUtimbuf -> IO CInt foreign import ccall unsafe "HsBase.h waitpid" c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid diff --git a/System/Posix/Signals.hs b/System/Posix/Signals.hs index 2af259a..962526d 100644 --- a/System/Posix/Signals.hs +++ b/System/Posix/Signals.hs @@ -281,7 +281,7 @@ signalProcessGroup sig pgid = throwErrnoIfMinus1_ "signalProcessGroup" (c_killpg (fromIntegral pgid) sig) foreign import ccall unsafe "killpg" - c_killpg :: CPid -> CInt -> IO CInt + c_killpg :: CInt -> CInt -> IO CInt -- | @raiseSignal int@ calls @kill@ to signal the current process -- with interrupt signal @int@. diff --git a/System/Random.hs b/System/Random.hs index d6517b1..4e9ba1e 100644 --- a/System/Random.hs +++ b/System/Random.hs @@ -84,7 +84,7 @@ import Numeric ( readDec ) -- replacement here. #ifdef __NHC__ data ClockTime = TOD Integer () -foreign import ccall "time.h time" readtime :: Ptr () -> IO Int +foreign import ccall "time.h time" readtime :: Ptr CTime -> IO CTime getClockTime :: IO ClockTime getClockTime = do t <- readtime nullPtr; return (TOD (toInteger t) ()) #endif diff --git a/System/Time.hsc b/System/Time.hsc index f230e97..a2c6b5b 100644 --- a/System/Time.hsc +++ b/System/Time.hsc @@ -357,10 +357,10 @@ gmtoff x = (#peek struct tm,tm_gmtoff) x # define tzname _tzname # endif # ifndef mingw32_HOST_OS -foreign import ccall unsafe "time.h &tzname" tzname :: Ptr (Ptr CChar) +foreign import ccall unsafe "time.h &tzname" tzname :: Ptr CString # else foreign import ccall unsafe "__hscore_timezone" timezone :: Ptr CLong -foreign import ccall unsafe "__hscore_tzname" tzname :: Ptr (Ptr CChar) +foreign import ccall unsafe "__hscore_tzname" tzname :: Ptr CString # endif zone x = do dst <- (#peek struct tm,tm_isdst) x @@ -740,8 +740,9 @@ foreign import ccall unsafe "time.h mktime" #if HAVE_GETTIMEOFDAY type CTimeVal = () +type CTimeZone = () foreign import ccall unsafe "time.h gettimeofday" - gettimeofday :: Ptr CTimeVal -> Ptr () -> IO CInt + gettimeofday :: Ptr CTimeVal -> Ptr CTimeZone -> IO CInt #elif HAVE_FTIME type CTimeB = () #ifndef mingw32_HOST_OS diff --git a/cbits/dirUtils.c b/cbits/dirUtils.c index 85aa0dc..d6da255 100644 --- a/cbits/dirUtils.c +++ b/cbits/dirUtils.c @@ -57,16 +57,15 @@ toErrno(DWORD rc) * read an entry from the directory stream; opt for the * re-entrant friendly way of doing this, if available. */ -HsInt -__hscore_readdir( HsAddr dirPtr, HsAddr pDirEnt ) +int +__hscore_readdir( DIR *dirPtr, struct dirent **pDirEnt ) { - struct dirent **pDirE = (struct dirent**)pDirEnt; #if HAVE_READDIR_R struct dirent* p; int res; static unsigned int nm_max = (unsigned int)-1; - if (pDirE == NULL) { + if (pDirEnt == NULL) { return -1; } if (nm_max == (unsigned int)-1) { @@ -80,24 +79,24 @@ __hscore_readdir( HsAddr dirPtr, HsAddr pDirEnt ) } p = (struct dirent*)malloc(sizeof(struct dirent) + nm_max); if (p == NULL) return -1; - res = readdir_r((DIR*)dirPtr, p, pDirE); + res = readdir_r(dirPtr, p, pDirEnt); if (res != 0) { - *pDirE = NULL; + *pDirEnt = NULL; free(p); } - else if (*pDirE == NULL) { + else if (*pDirEnt == NULL) { // end of stream free(p); } return res; #else - if (pDirE == NULL) { + if (pDirEnt == NULL) { return -1; } - *pDirE = readdir((DIR*)dirPtr); - if (*pDirE == NULL) { + *pDirEnt = readdir(dirPtr); + if (*pDirEnt == NULL) { return -1; } else { return 0; @@ -114,9 +113,8 @@ __hscore_readdir( HsAddr dirPtr, HsAddr pDirEnt ) * an error * */ -HsInt -__hscore_renameFile( HsAddr src, - HsAddr dest) +int +__hscore_renameFile( char *src, char *dest) { #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) static int forNT = -1; diff --git a/cbits/longlong.c b/cbits/longlong.c index 459ff38..7792675 100644 --- a/cbits/longlong.c +++ b/cbits/longlong.c @@ -10,7 +10,7 @@ /* -Miscellaneous primitive operations on StgInt64 and StgWord64s. +Miscellaneous primitive operations on HsInt64 and HsWord64s. N.B. These are not primops! Instead of going the normal (boring) route of making the list @@ -32,93 +32,95 @@ The exceptions to the rule are primops that cast to and from /* Relational operators */ -StgBool stg_gtWord64 (StgWord64 a, StgWord64 b) {return a > b;} -StgBool stg_geWord64 (StgWord64 a, StgWord64 b) {return a >= b;} -StgBool stg_eqWord64 (StgWord64 a, StgWord64 b) {return a == b;} -StgBool stg_neWord64 (StgWord64 a, StgWord64 b) {return a != b;} -StgBool stg_ltWord64 (StgWord64 a, StgWord64 b) {return a < b;} -StgBool stg_leWord64 (StgWord64 a, StgWord64 b) {return a <= b;} +static inline HsBool mkBool(int b) { return b ? HS_BOOL_TRUE : HS_BOOL_FALSE; } -StgBool stg_gtInt64 (StgInt64 a, StgInt64 b) {return a > b;} -StgBool stg_geInt64 (StgInt64 a, StgInt64 b) {return a >= b;} -StgBool stg_eqInt64 (StgInt64 a, StgInt64 b) {return a == b;} -StgBool stg_neInt64 (StgInt64 a, StgInt64 b) {return a != b;} -StgBool stg_ltInt64 (StgInt64 a, StgInt64 b) {return a < b;} -StgBool stg_leInt64 (StgInt64 a, StgInt64 b) {return a <= b;} +HsBool hs_gtWord64 (HsWord64 a, HsWord64 b) {return mkBool(a > b);} +HsBool hs_geWord64 (HsWord64 a, HsWord64 b) {return mkBool(a >= b);} +HsBool hs_eqWord64 (HsWord64 a, HsWord64 b) {return mkBool(a == b);} +HsBool hs_neWord64 (HsWord64 a, HsWord64 b) {return mkBool(a != b);} +HsBool hs_ltWord64 (HsWord64 a, HsWord64 b) {return mkBool(a < b);} +HsBool hs_leWord64 (HsWord64 a, HsWord64 b) {return mkBool(a <= b);} + +HsBool hs_gtInt64 (HsInt64 a, HsInt64 b) {return mkBool(a > b);} +HsBool hs_geInt64 (HsInt64 a, HsInt64 b) {return mkBool(a >= b);} +HsBool hs_eqInt64 (HsInt64 a, HsInt64 b) {return mkBool(a == b);} +HsBool hs_neInt64 (HsInt64 a, HsInt64 b) {return mkBool(a != b);} +HsBool hs_ltInt64 (HsInt64 a, HsInt64 b) {return mkBool(a < b);} +HsBool hs_leInt64 (HsInt64 a, HsInt64 b) {return mkBool(a <= b);} /* Arithmetic operators */ -StgWord64 stg_remWord64 (StgWord64 a, StgWord64 b) {return a % b;} -StgWord64 stg_quotWord64 (StgWord64 a, StgWord64 b) {return a / b;} +HsWord64 hs_remWord64 (HsWord64 a, HsWord64 b) {return a % b;} +HsWord64 hs_quotWord64 (HsWord64 a, HsWord64 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;} -StgInt64 stg_plusInt64 (StgInt64 a, StgInt64 b) {return a + b;} -StgInt64 stg_minusInt64 (StgInt64 a, StgInt64 b) {return a - b;} -StgInt64 stg_timesInt64 (StgInt64 a, StgInt64 b) {return a * b;} +HsInt64 hs_remInt64 (HsInt64 a, HsInt64 b) {return a % b;} +HsInt64 hs_quotInt64 (HsInt64 a, HsInt64 b) {return a / b;} +HsInt64 hs_negateInt64 (HsInt64 a) {return -a;} +HsInt64 hs_plusInt64 (HsInt64 a, HsInt64 b) {return a + b;} +HsInt64 hs_minusInt64 (HsInt64 a, HsInt64 b) {return a - b;} +HsInt64 hs_timesInt64 (HsInt64 a, HsInt64 b) {return a * b;} /* Logical operators: */ -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;} +HsWord64 hs_and64 (HsWord64 a, HsWord64 b) {return a & b;} +HsWord64 hs_or64 (HsWord64 a, HsWord64 b) {return a | b;} +HsWord64 hs_xor64 (HsWord64 a, HsWord64 b) {return a ^ b;} +HsWord64 hs_not64 (HsWord64 a) {return ~a;} -StgWord64 stg_uncheckedShiftL64 (StgWord64 a, StgInt b) {return a << b;} -StgWord64 stg_uncheckedShiftRL64 (StgWord64 a, StgInt b) {return a >> b;} +HsWord64 hs_uncheckedShiftL64 (HsWord64 a, HsInt b) {return a << b;} +HsWord64 hs_uncheckedShiftRL64 (HsWord64 a, HsInt b) {return a >> b;} /* Right shifting of signed quantities is not portable in C, so the behaviour you'll get from using these primops depends on the whatever your C compiler is doing. ToDo: fix. -- sof 8/98 */ -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);} +HsInt64 hs_uncheckedIShiftL64 (HsInt64 a, HsInt b) {return a << b;} +HsInt64 hs_uncheckedIShiftRA64 (HsInt64 a, HsInt b) {return a >> b;} +HsInt64 hs_uncheckedIShiftRL64 (HsInt64 a, HsInt b) + {return (HsInt64) ((HsWord64) a >> b);} /* Casting between longs and longer longs. (the primops that cast from long longs to Integers expressed as macros, since these may cause some heap allocation). */ -StgInt64 stg_intToInt64 (StgInt i) {return (StgInt64) i;} -StgInt stg_int64ToInt (StgInt64 i) {return (StgInt) i;} -StgWord64 stg_int64ToWord64 (StgInt64 i) {return (StgWord64) i;} -StgWord64 stg_wordToWord64 (StgWord w) {return (StgWord64) w;} -StgWord stg_word64ToWord (StgWord64 w) {return (StgWord) w;} -StgInt64 stg_word64ToInt64 (StgWord64 w) {return (StgInt64) w;} +HsInt64 hs_intToInt64 (HsInt i) {return (HsInt64) i;} +HsInt hs_int64ToInt (HsInt64 i) {return (HsInt) i;} +HsWord64 hs_int64ToWord64 (HsInt64 i) {return (HsWord64) i;} +HsWord64 hs_wordToWord64 (HsWord w) {return (HsWord64) w;} +HsWord hs_word64ToWord (HsWord64 w) {return (HsWord) w;} +HsInt64 hs_word64ToInt64 (HsWord64 w) {return (HsInt64) w;} -StgWord64 stg_integerToWord64 (StgInt sa, StgByteArray /* Really: mp_limb_t* */ da) +HsWord64 hs_integerToWord64 (HsInt sa, HsByteArray /* Really: mp_limb_t* */ da) { mp_limb_t* d; - StgInt s; - StgWord64 res; + HsInt s; + HsWord64 res; d = (mp_limb_t *)da; s = sa; switch (s) { case 0: res = 0; break; case 1: res = d[0]; break; - case -1: res = -(StgWord64)d[0]; break; + case -1: res = -(HsWord64)d[0]; break; default: - res = (StgWord64)d[0] + ((StgWord64)d[1] << (BITS_IN (mp_limb_t))); + res = (HsWord64)d[0] + ((HsWord64)d[1] << (BITS_IN (mp_limb_t))); if (s < 0) res = -res; } return res; } -StgInt64 stg_integerToInt64 (StgInt sa, StgByteArray /* Really: mp_limb_t* */ da) +HsInt64 hs_integerToInt64 (HsInt sa, HsByteArray /* Really: mp_limb_t* */ da) { mp_limb_t* d; - StgInt s; - StgInt64 res; + HsInt s; + HsInt64 res; d = (mp_limb_t *)da; s = (sa); switch (s) { case 0: res = 0; break; case 1: res = d[0]; break; - case -1: res = -(StgInt64)d[0]; break; + case -1: res = -(HsInt64)d[0]; break; default: - res = (StgInt64)d[0] + ((StgWord64)d[1] << (BITS_IN (mp_limb_t))); + res = (HsInt64)d[0] + ((HsWord64)d[1] << (BITS_IN (mp_limb_t))); if (s < 0) res = -res; } return res; diff --git a/cbits/timeUtils.c b/cbits/timeUtils.c index 31cfacb..64d5044 100644 --- a/cbits/timeUtils.c +++ b/cbits/timeUtils.c @@ -7,9 +7,9 @@ #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) /* to the end */ -HsAddr __hscore_timezone( void ) -{ return (HsAddr)&_timezone; } +long *__hscore_timezone( void ) +{ return &_timezone; } -HsAddr __hscore_tzname( void ) -{ return (HsAddr)_tzname; } +char **__hscore_tzname( void ) +{ return _tzname; } #endif diff --git a/include/HsBase.h b/include/HsBase.h index 39acf82..50eb2a8 100644 --- a/include/HsBase.h +++ b/include/HsBase.h @@ -167,50 +167,50 @@ extern void pPrPr_disableITimers (void); #ifdef SUPPORT_LONG_LONGS -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); - -StgInt64 stg_remInt64 (StgInt64, StgInt64); -StgInt64 stg_quotInt64 (StgInt64, StgInt64); -StgInt64 stg_negateInt64 (StgInt64); -StgInt64 stg_plusInt64 (StgInt64, StgInt64); -StgInt64 stg_minusInt64 (StgInt64, StgInt64); -StgInt64 stg_timesInt64 (StgInt64, StgInt64); - -StgWord64 stg_and64 (StgWord64, StgWord64); -StgWord64 stg_or64 (StgWord64, StgWord64); -StgWord64 stg_xor64 (StgWord64, StgWord64); -StgWord64 stg_not64 (StgWord64); - -StgWord64 stg_uncheckedShiftL64 (StgWord64, StgInt); -StgWord64 stg_uncheckedShiftRL64 (StgWord64, StgInt); -StgInt64 stg_uncheckedIShiftL64 (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); - -StgWord64 stg_integerToWord64 (StgInt sa, StgByteArray /* Really: mp_limb_t* */ da); -StgInt64 stg_integerToInt64 (StgInt sa, StgByteArray /* Really: mp_limb_t* */ da); +HsBool hs_gtWord64 (HsWord64, HsWord64); +HsBool hs_geWord64 (HsWord64, HsWord64); +HsBool hs_eqWord64 (HsWord64, HsWord64); +HsBool hs_neWord64 (HsWord64, HsWord64); +HsBool hs_ltWord64 (HsWord64, HsWord64); +HsBool hs_leWord64 (HsWord64, HsWord64); + +HsBool hs_gtInt64 (HsInt64, HsInt64); +HsBool hs_geInt64 (HsInt64, HsInt64); +HsBool hs_eqInt64 (HsInt64, HsInt64); +HsBool hs_neInt64 (HsInt64, HsInt64); +HsBool hs_ltInt64 (HsInt64, HsInt64); +HsBool hs_leInt64 (HsInt64, HsInt64); + +HsWord64 hs_remWord64 (HsWord64, HsWord64); +HsWord64 hs_quotWord64 (HsWord64, HsWord64); + +HsInt64 hs_remInt64 (HsInt64, HsInt64); +HsInt64 hs_quotInt64 (HsInt64, HsInt64); +HsInt64 hs_negateInt64 (HsInt64); +HsInt64 hs_plusInt64 (HsInt64, HsInt64); +HsInt64 hs_minusInt64 (HsInt64, HsInt64); +HsInt64 hs_timesInt64 (HsInt64, HsInt64); + +HsWord64 hs_and64 (HsWord64, HsWord64); +HsWord64 hs_or64 (HsWord64, HsWord64); +HsWord64 hs_xor64 (HsWord64, HsWord64); +HsWord64 hs_not64 (HsWord64); + +HsWord64 hs_uncheckedShiftL64 (HsWord64, HsInt); +HsWord64 hs_uncheckedShiftRL64 (HsWord64, HsInt); +HsInt64 hs_uncheckedIShiftL64 (HsInt64, HsInt); +HsInt64 hs_uncheckedIShiftRA64 (HsInt64, HsInt); +HsInt64 hs_uncheckedIShiftRL64 (HsInt64, HsInt); + +HsInt64 hs_intToInt64 (HsInt); +HsInt hs_int64ToInt (HsInt64); +HsWord64 hs_int64ToWord64 (HsInt64); +HsWord64 hs_wordToWord64 (HsWord); +HsWord hs_word64ToWord (HsWord64); +HsInt64 hs_word64ToInt64 (HsWord64); + +HsWord64 hs_integerToWord64 (HsInt sa, HsByteArray /* Really: mp_limb_t* */ da); +HsInt64 hs_integerToInt64 (HsInt sa, HsByteArray /* Really: mp_limb_t* */ da); #endif /* SUPPORT_LONG_LONGS */ @@ -492,13 +492,13 @@ INLINE HsInt __hscore_long_path_size() { return 4096; } #endif #ifdef R_OK -INLINE mode_t __hscore_R_OK() { return R_OK; } +INLINE int __hscore_R_OK() { return R_OK; } #endif #ifdef W_OK -INLINE mode_t __hscore_W_OK() { return W_OK; } +INLINE int __hscore_W_OK() { return W_OK; } #endif #ifdef X_OK -INLINE mode_t __hscore_X_OK() { return X_OK; } +INLINE int __hscore_X_OK() { return X_OK; } #endif #ifdef S_IRUSR diff --git a/include/dirUtils.h b/include/dirUtils.h index 801d807..b726402 100644 --- a/include/dirUtils.h +++ b/include/dirUtils.h @@ -6,8 +6,8 @@ #ifndef __DIRUTILS_H__ #define __DIRUTILS_H__ -extern HsInt __hscore_readdir(HsAddr dirPtr, HsAddr pDirEnt); -extern HsInt __hscore_renameFile(HsAddr src, HsAddr dest); +extern int __hscore_readdir(DIR *dirPtr, struct dirent **pDirEnt); +extern int __hscore_renameFile(char *src, char *dest); #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) extern int __hscore_getFolderPath(HWND hwndOwner, diff --git a/include/timeUtils.h b/include/timeUtils.h index 1f6ffff..c98450e 100644 --- a/include/timeUtils.h +++ b/include/timeUtils.h @@ -6,7 +6,7 @@ #ifndef __TIMEUTILS_H__ #define __TIMEUTILS_H__ -extern HsAddr __hscore_timezone( void ); -extern HsAddr __hscore_tzname( void ); +extern long *__hscore_timezone( void ); +extern char **__hscore_tzname( void ); #endif /* __DIRUTILS_H__ */ -- 1.7.10.4