[project @ 2004-02-17 11:59:16 by simonmar]

[ghc-base.git] / System / Posix / Internals.hs

diff --git a/System/Posix/Internals.hs b/System/Posix/Internals.hs
index d02b02c..989a082 100644 (file)
--- a/System/Posix/Internals.hs
+++ b/System/Posix/Internals.hs
@@ -44,7 +44,8 @@ import System.IO
 #ifdef __HUGS__
 import Hugs.Prelude (IOException(..), IOErrorType(..))
 
-{-# CBITS PrelIOUtils.c dirUtils.c #-}
+{-# CBITS PrelIOUtils.c dirUtils.c consUtils.c #-}
+ioException = ioError
 #endif
 
 -- ---------------------------------------------------------------------------
@@ -129,7 +130,7 @@ fileTruncate file = do
     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
@@ -141,7 +142,7 @@ foreign import stdcall unsafe "HsBase.h closesocket"
 
 fdGetMode :: Int -> IO IOMode
 fdGetMode fd = do
-#ifdef mingw32_TARGET_OS
+#if defined(mingw32_TARGET_OS) || defined(__MINGW32__)
     flags1 <- throwErrnoIfMinus1Retry "fdGetMode" 
                 (c__setmode (fromIntegral fd) (fromIntegral o_WRONLY))
     flags  <- throwErrnoIfMinus1Retry "fdGetMode" 
@@ -169,7 +170,7 @@ fdGetMode fd = do
 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
@@ -210,6 +211,7 @@ tcSetAttr fd fun = 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
@@ -218,6 +220,7 @@ tcSetAttr fd fun = do
             saved_tios <- mallocBytes sizeof_termios
             copyBytes saved_tios p_tios sizeof_termios
             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
@@ -235,11 +238,13 @@ tcSetAttr fd fun = do
             c_sigprocmask const_sig_setmask p_old_sigset nullPtr
             return r
 
+#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
 
@@ -291,7 +296,7 @@ foreign import ccall unsafe "consUtils.h get_console_echo__"
 -- ---------------------------------------------------------------------------
 -- 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"
@@ -299,7 +304,9 @@ setNonBlockingFD fd = do
   -- 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
@@ -334,7 +341,7 @@ foreign import ccall unsafe "HsBase.h dup"
 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"
@@ -343,13 +350,13 @@ 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" 
@@ -361,9 +368,6 @@ foreign import ccall unsafe "HsBase.h __hscore_mkdir"
 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
                     
@@ -385,7 +389,7 @@ foreign import ccall unsafe "HsBase.h write"
 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
 
@@ -491,7 +495,7 @@ foreign import ccall unsafe "HsBase.h __hscore_sig_setmask"  const_sig_setmask :
 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
 
@@ -500,7 +504,7 @@ foreign import ccall unsafe "HsBase.h __hscore_poke_lflag" poke_c_lflag :: Ptr C
 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