-- #hide
module System.Posix.Internals where
-#include "HsBaseConfig.h"
+#ifdef __NHC__
+#define HTYPE_TCFLAG_T
+#else
+# include "HsBaseConfig.h"
+#endif
+#if ! (defined(mingw32_HOST_OS) || defined(__MINGW32__))
import Control.Monad
+#endif
import System.Posix.Types
import Foreign
import Data.Bits
import Data.Maybe
+#if !defined(HTYPE_TCFLAG_T)
+import System.IO.Error
+#endif
+
#if __GLASGOW_HASKELL__
import GHC.Base
import GHC.Num
import GHC.Real
-import GHC.IOBase
+import GHC.IO
+import GHC.IO.IOMode
+import GHC.IO.Exception
+import GHC.IO.Device
#elif __HUGS__
import Hugs.Prelude (IOException(..), IOErrorType(..))
import Hugs.IO (IOMode(..))
-#else
+#elif __NHC__
import System.IO
+import Control.Exception
+import DIOError
#endif
#ifdef __HUGS__
type CUtimbuf = ()
type CUtsname = ()
-#ifndef __GLASGOW_HASKELL__
type FD = CInt
-#endif
-- ---------------------------------------------------------------------------
-- stat()-related stuff
if not (s_isreg c_mode)
then return (-1)
else do
- c_size <- st_size p_stat
- return (fromIntegral c_size)
-
-data FDType = Directory | Stream | RegularFile | RawDevice
- deriving (Eq)
+ c_size <- st_size p_stat
+ return (fromIntegral c_size)
-fileType :: FilePath -> IO FDType
+fileType :: FilePath -> IO IODeviceType
fileType file =
allocaBytes sizeof_stat $ \ p_stat -> do
withCString file $ \p_file -> do
-- NOTE: On Win32 platforms, this will only work with file descriptors
-- referring to file handles. i.e., it'll fail for socket FDs.
-fdStat :: FD -> IO (FDType, CDev, CIno)
+fdStat :: FD -> IO (IODeviceType, CDev, CIno)
fdStat fd =
allocaBytes sizeof_stat $ \ p_stat -> do
throwErrnoIfMinus1Retry "fdType" $
ino <- st_ino p_stat
return (ty,dev,ino)
-fdType :: FD -> IO FDType
+fdType :: FD -> IO IODeviceType
fdType fd = do (ty,_,_) <- fdStat fd; return ty
-statGetType :: Ptr CStat -> IO FDType
+statGetType :: Ptr CStat -> IO IODeviceType
statGetType p_stat = do
c_mode <- st_mode p_stat :: IO CMode
case () of
| otherwise -> ioError ioe_unknownfiletype
ioe_unknownfiletype :: IOException
+#ifndef __NHC__
ioe_unknownfiletype = IOError Nothing UnsupportedOperation "fdType"
- "unknown file type" Nothing
-
-#if __GLASGOW_HASKELL__ && (defined(mingw32_HOST_OS) || defined(__MINGW32__))
-closeFd :: Bool -> CInt -> IO CInt
-closeFd isStream fd
- | isStream = c_closesocket fd
- | otherwise = c_close fd
-
-foreign import stdcall unsafe "HsBase.h closesocket"
- c_closesocket :: CInt -> IO CInt
+ "unknown file type"
+# if __GLASGOW_HASKELL__
+ Nothing
+# endif
+ Nothing
+#else
+ioe_unknownfiletype = UserError "fdType" "unknown file type"
#endif
fdGetMode :: FD -> IO IOMode
-fdGetMode fd = do
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
+fdGetMode _ = do
-- We don't have a way of finding out which flags are set on FDs
-- on Windows, so make a handle that thinks that anything goes.
let flags = o_RDWR
#else
+fdGetMode fd = do
flags <- throwErrnoIfMinus1Retry "fdGetMode"
(c_fcntl_read fd const_f_getfl)
#endif
-- ---------------------------------------------------------------------------
-- Terminal-related stuff
-fdIsTTY :: FD -> IO Bool
-fdIsTTY fd = c_isatty fd >>= return.toBool
-
#if defined(HTYPE_TCFLAG_T)
setEcho :: FD -> Bool -> IO ()
-- wrapper which temporarily blocks SIGTTOU around the call, making it
-- transparent.
allocaBytes sizeof_sigset_t $ \ p_sigset -> do
- allocaBytes sizeof_sigset_t $ \ p_old_sigset -> do
+ allocaBytes sizeof_sigset_t $ \ p_old_sigset -> do
c_sigemptyset p_sigset
c_sigaddset p_sigset const_sigttou
c_sigprocmask const_sig_block p_sigset p_old_sigset
then ioError (ioe_unk_error "setCooked" "failed to set buffering")
else return ()
+ioe_unk_error :: String -> String -> IOException
ioe_unk_error loc msg
- = IOError Nothing OtherError loc msg Nothing
+#ifndef __NHC__
+ = ioeSetErrorString (mkIOError OtherError loc Nothing Nothing) msg
+#else
+ = UserError loc msg
+#endif
-- Note: echoing goes hand in hand with enabling 'line input' / raw-ness
-- for Win32 consoles, hence setEcho ends up being the inverse of setCooked.
-- ---------------------------------------------------------------------------
-- Turning on non-blocking for a file descriptor
-#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
setNonBlockingFD :: FD -> IO ()
+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
setNonBlockingFD fd = do
flags <- throwErrnoIfMinus1Retry "setNonBlockingFD"
(c_fcntl_read fd const_f_getfl)
#else
-- bogus defns for win32
-setNonBlockingFD fd = return ()
+setNonBlockingFD _ = return ()
+
+#endif
+
+-- -----------------------------------------------------------------------------
+-- Set close-on-exec for a file descriptor
+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
+setCloseOnExec :: FD -> IO ()
+setCloseOnExec fd = do
+ throwErrnoIfMinus1 "setCloseOnExec" $
+ c_fcntl_write fd const_f_setfd const_fd_cloexec
+ return ()
#endif
-- -----------------------------------------------------------------------------
c_getpid :: IO CPid
#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
-foreign import ccall unsafe "HsBase.h fcntl"
+foreign import ccall unsafe "HsBase.h fcntl_read"
c_fcntl_read :: CInt -> CInt -> IO CInt
-foreign import ccall unsafe "HsBase.h fcntl"
+foreign import ccall unsafe "HsBase.h fcntl_write"
c_fcntl_write :: CInt -> CInt -> CLong -> IO CInt
-foreign import ccall unsafe "HsBase.h fcntl"
+foreign import ccall unsafe "HsBase.h fcntl_lock"
c_fcntl_lock :: CInt -> CInt -> Ptr CFLock -> IO CInt
foreign import ccall unsafe "HsBase.h fork"
foreign import ccall unsafe "HsBase.h __hscore_sig_setmask" const_sig_setmask :: CInt
foreign import ccall unsafe "HsBase.h __hscore_f_getfl" const_f_getfl :: CInt
foreign import ccall unsafe "HsBase.h __hscore_f_setfl" const_f_setfl :: CInt
+foreign import ccall unsafe "HsBase.h __hscore_f_setfd" const_f_setfd :: CInt
+foreign import ccall unsafe "HsBase.h __hscore_fd_cloexec" const_fd_cloexec :: CLong
#if defined(HTYPE_TCFLAG_T)
foreign import ccall unsafe "HsBase.h __hscore_sizeof_termios" sizeof_termios :: Int
foreign import ccall unsafe "HsBase.h __hscore_ptr_c_cc" ptr_c_cc :: Ptr CTermios -> IO (Ptr Word8)
#endif
-#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
-foreign import ccall unsafe "HsBase.h __hscore_s_issock" c_s_issock :: CMode -> CInt
s_issock :: CMode -> Bool
+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
s_issock cmode = c_s_issock cmode /= 0
+foreign import ccall unsafe "HsBase.h __hscore_s_issock" c_s_issock :: CMode -> CInt
#else
-s_issock :: CMode -> Bool
-s_issock cmode = False
+s_issock _ = False
#endif
+
+foreign import ccall unsafe "__hscore_bufsiz" dEFAULT_BUFFER_SIZE :: Int
+foreign import ccall unsafe "__hscore_seek_cur" sEEK_CUR :: CInt
+foreign import ccall unsafe "__hscore_seek_set" sEEK_SET :: CInt
+foreign import ccall unsafe "__hscore_seek_end" sEEK_END :: CInt
projects / ghc-base.git / blobdiff