-- #hide
module System.Posix.Internals where
-#include "config.h"
+#include "ghcconfig.h"
import Control.Monad
import System.Posix.Types
#ifdef __HUGS__
import Hugs.Prelude (IOException(..), IOErrorType(..))
-{-# CBITS PrelIOUtils.c dirUtils.c #-}
+{-# CBITS PrelIOUtils.c dirUtils.c consUtils.c #-}
+ioException = ioError
#endif
-- ---------------------------------------------------------------------------
c_close fd
return ()
-#ifdef mingw32_TARGET_OS
+#if defined(mingw32_TARGET_OS) || defined(__MINGW32__)
closeFd :: Bool -> CInt -> IO CInt
closeFd isStream fd
| isStream = c_closesocket fd
fdGetMode :: Int -> IO IOMode
fdGetMode fd = do
-#ifdef mingw32_TARGET_OS
+#if defined(mingw32_TARGET_OS) || defined(__MINGW32__)
+ -- XXX: this code is *BROKEN*, _setmode only deals with O_TEXT/O_BINARY
flags1 <- throwErrnoIfMinus1Retry "fdGetMode"
(c__setmode (fromIntegral fd) (fromIntegral o_WRONLY))
flags <- throwErrnoIfMinus1Retry "fdGetMode"
fdIsTTY :: Int -> IO Bool
fdIsTTY fd = c_isatty (fromIntegral fd) >>= return.toBool
-#ifndef mingw32_TARGET_OS
+#if defined(HTYPE_TCFLAG_T)
setEcho :: Int -> Bool -> IO ()
setEcho fd on = do
throwErrnoIfMinus1Retry "tcSetAttr"
(c_tcgetattr (fromIntegral fd) p_tios)
+#ifdef __GLASGOW_HASKELL__
-- Save a copy of termios, if this is a standard file descriptor.
-- These terminal settings are restored in hs_exit().
when (fd <= 2) $ do
- p <- peekElemOff saved_termios fd
+ p <- get_saved_termios fd
when (p == nullPtr) $ do
saved_tios <- mallocBytes sizeof_termios
copyBytes saved_tios p_tios sizeof_termios
- pokeElemOff saved_termios fd saved_tios
+ set_saved_termios fd saved_tios
+#endif
-- tcsetattr() when invoked by a background process causes the process
-- to be sent SIGTTOU regardless of whether the process has TOSTOP set
c_sigprocmask const_sig_setmask p_old_sigset nullPtr
return r
-foreign import ccall "&saved_termios" saved_termios :: Ptr (Ptr CTermios)
+#ifdef __GLASGOW_HASKELL__
+foreign import ccall unsafe "HsBase.h __hscore_get_saved_termios"
+ get_saved_termios :: Int -> IO (Ptr CTermios)
+
+foreign import ccall unsafe "HsBase.h __hscore_set_saved_termios"
+ set_saved_termios :: Int -> (Ptr CTermios) -> IO ()
+#endif
#else
-- ---------------------------------------------------------------------------
-- Turning on non-blocking for a file descriptor
-#ifndef mingw32_TARGET_OS
+#if !defined(mingw32_TARGET_OS) && !defined(__MINGW32__)
setNonBlockingFD fd = do
flags <- throwErrnoIfMinus1Retry "setNonBlockingFD"
-- An error when setting O_NONBLOCK isn't fatal: on some systems
-- 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.
- c_fcntl_write (fromIntegral fd) const_f_setfl (flags .|. o_NONBLOCK)
+ unless (testBit flags (fromIntegral o_NONBLOCK)) $ do
+ c_fcntl_write (fromIntegral fd) const_f_setfl (flags .|. o_NONBLOCK)
+ return ()
#else
-- bogus defns for win32
foreign import ccall unsafe "HsBase.h dup2"
c_dup2 :: CInt -> CInt -> IO CInt
-foreign import ccall unsafe "HsBase.h fstat"
+foreign import ccall unsafe "HsBase.h __hscore_fstat"
c_fstat :: CInt -> Ptr CStat -> IO CInt
foreign import ccall unsafe "HsBase.h getcwd"
foreign import ccall unsafe "HsBase.h isatty"
c_isatty :: CInt -> IO CInt
-foreign import ccall unsafe "HsBase.h lseek"
+foreign import ccall unsafe "HsBase.h __hscore_lseek"
c_lseek :: CInt -> COff -> CInt -> IO COff
foreign import ccall unsafe "HsBase.h __hscore_lstat"
lstat :: CString -> Ptr CStat -> IO CInt
-foreign import ccall unsafe "HsBase.h open"
+foreign import ccall unsafe "HsBase.h __hscore_open"
c_open :: CString -> CInt -> CMode -> IO CInt
foreign import ccall unsafe "HsBase.h opendir"
foreign import ccall unsafe "HsBase.h read"
c_read :: CInt -> Ptr CChar -> CSize -> IO CSsize
-foreign import ccall unsafe "HsBase.h readdir"
- c_readdir :: Ptr CDir -> IO (Ptr CDirent)
-
foreign import ccall unsafe "dirUtils.h __hscore_renameFile"
c_rename :: CString -> CString -> IO CInt
foreign import ccall unsafe "HsBase.h rmdir"
c_rmdir :: CString -> IO CInt
-foreign import ccall unsafe "HsBase.h stat"
+foreign import ccall unsafe "HsBase.h __hscore_stat"
c_stat :: CString -> Ptr CStat -> IO CInt
foreign import ccall unsafe "HsBase.h umask"
foreign import ccall unsafe "HsBase.h unlink"
c_unlink :: CString -> IO CInt
-#ifndef mingw32_TARGET_OS
+#if !defined(mingw32_TARGET_OS) && !defined(__MINGW32__)
foreign import ccall unsafe "HsBase.h fcntl"
c_fcntl_read :: CInt -> CInt -> IO 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
-#ifndef mingw32_TARGET_OS
+#if defined(HTYPE_TCFLAG_T)
foreign import ccall unsafe "HsBase.h __hscore_sizeof_termios" sizeof_termios :: Int
foreign import ccall unsafe "HsBase.h __hscore_sizeof_sigset_t" sizeof_sigset_t :: Int
foreign import ccall unsafe "HsBase.h __hscore_ptr_c_cc" ptr_c_cc :: Ptr CTermios -> IO (Ptr Word8)
#endif
-#ifndef mingw32_TARGET_OS
+#if !defined(mingw32_TARGET_OS) && !defined(__MINGW32__)
foreign import ccall unsafe "HsBase.h __hscore_s_issock" s_issock :: CMode -> Bool
#else
s_issock :: CMode -> Bool