From: sewardj <unknown>
Date: Wed, 30 May 2001 16:39:22 +0000 (+0000)
Subject: [project @ 2001-05-30 16:39:22 by sewardj]
X-Git-Tag: Approximately_9120_patches~1844
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=4d3731de448d49e99724fd63527397816352479b;p=ghc-hetmet.git

[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.
---

diff --git a/ghc/lib/std/PrelHandle.hsc b/ghc/lib/std/PrelHandle.hsc
index 0f62333..ce13119 100644
--- a/ghc/lib/std/PrelHandle.hsc
+++ b/ghc/lib/std/PrelHandle.hsc
@@ -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
diff --git a/ghc/lib/std/PrelPosix.hsc b/ghc/lib/std/PrelPosix.hsc
index 354d320..50268ed 100644
--- a/ghc/lib/std/PrelPosix.hsc
+++ b/ghc/lib/std/PrelPosix.hsc
@@ -1,7 +1,7 @@
 {-# 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
diff --git a/ghc/lib/std/Time.hsc b/ghc/lib/std/Time.hsc
index 2dbee5d..597f1b1 100644
--- a/ghc/lib/std/Time.hsc
+++ b/ghc/lib/std/Time.hsc
@@ -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
diff --git a/ghc/lib/std/cbits/system.c b/ghc/lib/std/cbits/system.c
index 657866a..5b8047b 100644
--- a/ghc/lib/std/cbits/system.c
+++ b/ghc/lib/std/cbits/system.c
@@ -1,7 +1,7 @@
 /* 
  * (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);