- let vmin = (c_cc `plusPtr` (fromIntegral const_vmin)) :: Ptr Word8
- vtime = (c_cc `plusPtr` (fromIntegral const_vtime)) :: Ptr Word8
- poke vmin 1
- poke vtime 0
-
- tcSetAttr fd const_tcsanow p_tios
-
--- tcsetattr() when invoked by a background process causes the process
--- to be sent SIGTTOU regardless of whether the process has TOSTOP set
--- in its terminal flags (try it...). This function provides a
--- wrapper which temporarily blocks SIGTTOU around the call, making it
--- transparent.
-
-tcSetAttr :: FD -> CInt -> Ptr CTermios -> IO ()
-tcSetAttr fd options p_tios = do
- allocaBytes sizeof_sigset_t $ \ p_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
- throwErrnoIfMinus1Retry_ "tcSetAttr" $
- c_tcsetattr (fromIntegral fd) options p_tios
- c_sigprocmask const_sig_setmask p_old_sigset nullPtr
- return ()
+ let vmin = (c_cc `plusPtr` (fromIntegral const_vmin)) :: Ptr Word8
+ vtime = (c_cc `plusPtr` (fromIntegral const_vtime)) :: Ptr Word8
+ poke vmin 1
+ poke vtime 0
+
+tcSetAttr :: FD -> (Ptr CTermios -> IO a) -> IO a
+tcSetAttr fd fun = do
+ allocaBytes sizeof_termios $ \p_tios -> do
+ throwErrnoIfMinus1Retry "tcSetAttr"
+ (c_tcgetattr 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 <- get_saved_termios fd
+ when (p == nullPtr) $ 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
+ -- in its terminal flags (try it...). This function provides a
+ -- 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
+ c_sigemptyset p_sigset
+ c_sigaddset p_sigset const_sigttou
+ c_sigprocmask const_sig_block p_sigset p_old_sigset
+ r <- fun p_tios -- do the business
+ throwErrnoIfMinus1Retry_ "tcSetAttr" $
+ c_tcsetattr fd const_tcsanow p_tios
+ 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 :: CInt -> IO (Ptr CTermios)
+
+foreign import ccall unsafe "HsBase.h __hscore_set_saved_termios"
+ set_saved_termios :: CInt -> (Ptr CTermios) -> IO ()
+#endif