Commit 4d3731de authored by sewardj's avatar sewardj
Browse files

[project @ 2001-05-30 16:39:22 by sewardj]

Initial mods to make the Glorious New IO Library (tm) work on mingw.
Not everything works, but is compilable, and off to a good start.
parent 16179470
......@@ -4,7 +4,7 @@
#undef DEBUG
-- -----------------------------------------------------------------------------
-- $Id: PrelHandle.hsc,v 1.5 2001/05/24 10:41:13 simonmar Exp $
-- $Id: PrelHandle.hsc,v 1.6 2001/05/30 16:39:22 sewardj Exp $
--
-- (c) The University of Glasgow, 1994-2001
--
......@@ -341,11 +341,11 @@ getBuffer :: FD -> BufferState -> IO (IORef Buffer, BufferMode)
getBuffer fd state = do
buffer <- allocateBuffer dEFAULT_BUFFER_SIZE state
ioref <- newIORef buffer
is_tty <- c_isatty (fromIntegral fd)
is_tty <- fdIsTTY fd
let buffer_mode
| toBool is_tty = LineBuffering
| otherwise = BlockBuffering Nothing
| is_tty = LineBuffering
| otherwise = BlockBuffering Nothing
return (ioref, buffer_mode)
......@@ -1132,11 +1132,11 @@ hIsTerminalDevice handle = do
#ifdef _WIN32
hSetBinaryMode handle bin =
withHandle "hSetBinaryMode" handle $ \ handle_ ->
let flg | bin = (#const O_BINARY)
| otherwise = (#const O_TEXT)
throwErrnoIfMinus1_ "hSetBinaryMode" $
setmode (fromIntegral (haFD handle_)) flg
withHandle_ "hSetBinaryMode" handle $ \ handle_ ->
do let flg | bin = (#const O_BINARY)
| otherwise = (#const O_TEXT)
throwErrnoIfMinus1_ "hSetBinaryMode"
(setmode (fromIntegral (haFD handle_)) flg)
foreign import "setmode" setmode :: CInt -> CInt -> IO CInt
#else
......
{-# OPTIONS -fno-implicit-prelude -optc-DNON_POSIX_SOURCE #-}
-- ---------------------------------------------------------------------------
-- $Id: PrelPosix.hsc,v 1.4 2001/05/22 13:22:14 simonmar Exp $
-- $Id: PrelPosix.hsc,v 1.5 2001/05/30 16:39:22 sewardj Exp $
--
-- POSIX support layer for the standard libraries
--
......@@ -42,7 +42,10 @@ type CIno = #type ino_t
type CMode = #type mode_t
type COff = #type off_t
type CPid = #type pid_t
#ifndef mingw32_TARGET_OS
#ifdef mingw32_TARGET_OS
type CSsize = #type size_t
#else
type CGid = #type gid_t
type CNlink = #type nlink_t
type CSsize = #type ssize_t
......@@ -96,15 +99,21 @@ foreign import "s_isdir_wrap" s_isdir :: CMode -> Bool
foreign import "s_isfifo_wrap" s_isfifo :: CMode -> Bool
#def inline int s_isfifo_wrap(m) { return S_ISFIFO(m); }
#ifndef mingw32_TARGET_OS
foreign import "s_issock_wrap" s_issock :: CMode -> Bool
#def inline int s_issock_wrap(m) { return S_ISSOCK(m); }
#else
s_issock :: CMode -> Bool
s_issock cmode = False
#endif
-- ---------------------------------------------------------------------------
-- Terminal-related stuff
fdIsTTY :: Int -> IO Bool
fdIsTTY fd = c_isatty (fromIntegral fd) >>= return.toBool
#ifndef mingw32_TARGET_OS
type Termios = ()
setEcho :: Int -> Bool -> IO ()
......@@ -165,15 +174,37 @@ tcSetAttr fd options p_tios = do
c_tcsetattr (fromIntegral fd) options p_tios
c_sigprocmask (#const SIG_SETMASK) p_old_sigset nullPtr
#else
-- bogus defns for win32
setCooked :: Int -> Bool -> IO ()
setCooked fd cooked = return ()
setEcho :: Int -> Bool -> IO ()
setEcho fd on = return ()
getEcho :: Int -> IO Bool
getEcho fd = return False
#endif
-- ---------------------------------------------------------------------------
-- Turning on non-blocking for a file descriptor
#ifndef mingw32_TARGET_OS
setNonBlockingFD fd = do
flags <- throwErrnoIfMinus1Retry "setNonBlockingFD"
(fcntl_read (fromIntegral fd) (#const F_GETFL))
throwErrnoIfMinus1Retry "setNonBlockingFD"
(fcntl_write (fromIntegral fd)
(#const F_SETFL) (flags .|. #const O_NONBLOCK))
#else
-- bogus defns for win32
setNonBlockingFD fd = return ()
#endif
-- -----------------------------------------------------------------------------
-- foreign imports
......@@ -199,13 +230,33 @@ o_RDWR = (#const O_RDWR) :: CInt
o_APPEND = (#const O_APPEND) :: CInt
o_CREAT = (#const O_CREAT) :: CInt
o_EXCL = (#const O_EXCL) :: CInt
o_NOCTTY = (#const O_NOCTTY) :: CInt
o_TRUNC = (#const O_TRUNC) :: CInt
#ifdef mingw32_TARGET_OS
o_NOCTTY = 0 :: CInt
o_NONBLOCK = 0 :: CInt
#else
o_NOCTTY = (#const O_NOCTTY) :: CInt
o_NONBLOCK = (#const O_NONBLOCK) :: CInt
#endif
#ifdef HAVE_O_BINARY
o_BINARY = (#const O_BINARY) :: CInt
#endif
foreign import "isatty" unsafe
c_isatty :: CInt -> IO CInt
foreign import "close" unsafe
c_close :: CInt -> IO CInt
foreign import "lseek" unsafe
c_lseek :: CInt -> COff -> CInt -> IO COff
foreign import "write" unsafe
c_write :: CInt -> Ptr CChar -> CSize -> IO CSsize
#ifndef mingw32_TARGET_OS
foreign import "fcntl" unsafe
fcntl_read :: CInt -> CInt -> IO CInt
......@@ -215,12 +266,6 @@ foreign import "fcntl" unsafe
foreign import "fork" unsafe
fork :: IO CPid
foreign import "isatty" unsafe
c_isatty :: CInt -> IO CInt
foreign import "lseek" unsafe
c_lseek :: CInt -> COff -> CInt -> IO COff
foreign import "read" unsafe
c_read :: CInt -> Ptr CChar -> CSize -> IO CSsize
......@@ -241,7 +286,4 @@ foreign import "tcsetattr" unsafe
foreign import "waitpid" unsafe
c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid
foreign import "write" unsafe
c_write :: CInt -> Ptr CChar -> CSize -> IO CSsize
#endif
......@@ -3,7 +3,7 @@
-- to compile on sparc-solaris. Blargh.
-- -----------------------------------------------------------------------------
-- $Id: Time.hsc,v 1.13 2001/05/18 16:54:05 simonmar Exp $
-- $Id: Time.hsc,v 1.14 2001/05/30 16:39:22 sewardj Exp $
--
-- (c) The University of Glasgow, 1995-2001
--
......@@ -316,7 +316,7 @@ zone x = (#peek struct tm,tm_zone) x
gmtoff x = (#peek struct tm,tm_gmtoff) x
#else /* ! HAVE_TM_ZONE */
# if HAVE_TZNAME || _WIN32
# if HAVE_TZNAME || defined(_WIN32)
# if cygwin32_TARGET_OS
# define tzname _tzname
# endif
......
/*
* (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
*
* $Id: system.c,v 1.12 2001/05/18 16:54:06 simonmar Exp $
* $Id: system.c,v 1.13 2001/05/30 16:39:22 sewardj Exp $
*
* system Runtime Support
*/
......@@ -20,8 +20,6 @@ systemCmd(HsAddr cmd)
until the sub shell has finished before returning. Using Sleep()
works around that.) */
if (system(cmd) < 0) {
cvtErrno();
stdErrno();
return -1;
}
Sleep(1000);
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment