[project @ 1999-05-05 10:33:13 by sof]

Winsock support

ghc/lib/std/cbits/Makefile

-# $Id: Makefile,v 1.3 1999/03/02 20:14:00 sof Exp $
+# $Id: Makefile,v 1.4 1999/05/05 10:33:13 sof Exp $
 
 TOP = ../../..
 include $(TOP)/mk/boilerplate.mk
@@ -13,6 +13,10 @@ C_OBJS  = $(C_SRCS:.c=.o)
 LIBOBJS = $(C_OBJS)
 SRC_CC_OPTS += -O -I$(GHC_INCLUDE_DIR) $(GhcLibCcOpts)
 
+DLL_NAME = HScbits.dll
+DLL_IMPLIB_NAME = libHScbits_imp.a
+SRC_BLD_DLL_OPTS += --export-all --output-def=HScbits.def
+SRC_BLD_DLL_OPTS += -lwinmm -lwsock32 -lHSrts_imp -lgmp -L. -L../../../rts/gmp -L../../../rts
 
 #
 # Compile the files using the Haskell compiler (ghc really).

ghc/lib/std/cbits/closeFile.c

 /* 
  * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
  *
- * $Id: closeFile.c,v 1.3 1998/12/02 13:27:14 simonm Exp $
+ * $Id: closeFile.c,v 1.4 1999/05/05 10:33:14 sof Exp $
  *
  * hClose Runtime Support
  */
@@ -9,6 +9,10 @@
 #include "Rts.h"
 #include "stgio.h"
 
+#ifdef HAVE_WINSOCK_H
+#include <winsock.h>
+#endif
+
 StgInt __really_close_stdfiles=1;
 
 StgInt
@@ -64,7 +68,15 @@ StgInt flush_buf;
 
     } else  {
       /* Regardless of success or otherwise, the fd field gets smashed. */
-      while ( (rc = close(fo->fd)) != 0 ) {
+      while ( (rc = 
+	        (
+#ifdef HAVE_WINSOCK_H
+	          fo->flags & FILEOBJ_WINSOCK ?
+		  closesocket(fo->fd) :
+                  close(fo->fd))) != 0 ) {
+#else
+                  close(fo->fd))) != 0 ) {
+#endif
          /* See above unlockFile() comment */
 	 if ( errno != EINTR && (!unlocked && errno != EBADF ) ) {
 	    cvtErrno();

ghc/lib/std/cbits/fileObject.c

 /* 
  * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
  *
- * $Id: fileObject.c,v 1.2 1998/12/02 13:27:26 simonm Exp $
+ * $Id: fileObject.c,v 1.3 1999/05/05 10:33:14 sof Exp $
  *
  * hPutStr Runtime Support
  */
@@ -10,6 +10,12 @@
 #include "stgio.h"
 #include "fileObject.h"
 
+#include <stdio.h>
+
+#ifdef HAVE_WINSOCK_H
+#include <winsock.h>
+#endif
+
 void
 setBufFlags(fo, flg)
 StgForeignPtr fo;
@@ -173,7 +179,15 @@ IOFileObject* fo;
   if ( fo->flags & FILEOBJ_NONBLOCKING_IO && inputReady ((StgForeignPtr)fo,0) != 1 )
      return FILEOBJ_BLOCKED_READ;
 
-  if ((count = read(fo->fd, p, len)) <= 0) {
+  if ((count = 
+         (
+#ifdef HAVE_WINSOCK_H
+	   fo->flags & FILEOBJ_WINSOCK ?
+	   recv(fo->fd, p, len, 0) :
+	   read(fo->fd, p, len))) <= 0 ) {
+#else
+	   read(fo->fd, p, len))) <= 0 ) {
+#endif    
       if (count == 0) {
          ghc_errtype = ERR_EOF;
 	 ghc_errstr = "";

ghc/lib/std/cbits/fileObject.h

 #ifndef FILEOBJECT_H
 #define FILEOBJECT_H
 
-/* a good idea? */
-#include <stdio.h>
-
 /*
   IOFileObjects are used as part of the IO.Handle
   implementation, ensuring that when handles are
@@ -52,6 +49,11 @@ typedef struct _IOFileObject {
 */
 #define FILEOBJ_RW_READ 256
 #define FILEOBJ_RW_WRITE 512
+/* 
+ * Under Win32, a file fd is not the same as a socket fd, so
+ * we need to use separate r/w calls.
+ */ 
+#define FILEOBJ_WINSOCK  1024
 
 #define FILEOBJ_IS_EOF(x)     ((x)->flags & FILEOBJ_EOF)
 #define FILEOBJ_SET_EOF(x)    ((x)->flags |= FILEOBJ_EOF)

ghc/lib/std/cbits/filePutc.c

 /* 
  * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
  *
- * $Id: filePutc.c,v 1.4 1999/01/12 10:53:02 sewardj Exp $
+ * $Id: filePutc.c,v 1.5 1999/05/05 10:33:15 sof Exp $
  *
  * hPutChar Runtime Support
  */
@@ -10,6 +10,10 @@
 #include "stgio.h"
 #include "error.h"
 
+#ifdef HAVE_WINSOCK_H
+#include <winsock.h>
+#endif
+
 #define TERMINATE_LINE(x)   ((x) == '\n')
 
 StgInt
@@ -74,8 +78,14 @@ StgChar c;
       return FILEOBJ_BLOCKED_WRITE;
 
     /* Unbuffered, write the character directly. */
-    while ((rc = write(fo->fd, &c, 1)) == 0 && errno == EINTR) ;
-
+    while ((rc = (
+#ifdef HAVE_WINSOCK_H
+	         fo->flags & FILEOBJ_WINSOCK ?
+		 send(fo->fd, &c, 1, 0) :
+		 write(fo->fd, &c, 1))) == 0 && errno == EINTR) ;
+#else
+		 write(fo->fd, &c, 1))) == 0 && errno == EINTR) ;
+#endif
     if (rc == 0) {
 	cvtErrno();
 	stdErrno();

ghc/lib/std/cbits/freeFile.c

 /* 
  * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
  *
- * $Id: freeFile.c,v 1.3 1998/12/02 13:27:34 simonm Exp $
+ * $Id: freeFile.c,v 1.4 1999/05/05 10:33:15 sof Exp $
  *
  * Giving up files
  */
@@ -10,6 +10,11 @@
 #include "stgio.h"
 #include "fileObject.h"
 
+#ifdef HAVE_WINSOCK_H
+#include <winsock.h>
+#endif
+
+
 /* sigh, the FILEs attached to the standard descriptors are 
    handled differently. We don't want them freed via the
    ForeignObj finaliser, as we probably want to use these
@@ -63,7 +68,14 @@ StgForeignPtr ptr;
        flushFile(ptr);
     }
 
+    if ( fo->flags & FILEOBJ_WINSOCK )
+      /* Sigh - the cleanup call at the end will do this for us */
+      return;
+#ifdef HAVE_WINSOCK_H
+    rc = ( fo->flags & FILEOBJ_WINSOCK ? closesocket(fo->fd) : close(fo->fd) );
+#else
     rc = close(fo->fd);
+#endif
     /* Error or no error, we don't care.. */
 
     return;

ghc/lib/std/cbits/getLock.c

 /* 
  * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
  *
- * $Id: getLock.c,v 1.5 1999/03/01 09:11:39 sof Exp $
+ * $Id: getLock.c,v 1.6 1999/05/05 10:33:16 sof Exp $
  *
  * stdin/stout/stderr Runtime Support
  */
@@ -52,7 +52,14 @@ int exclusive;
 
     while (fstat(fd, &sb) < 0) {
 	if (errno != EINTR) {
+#ifndef _WIN32
 	    return -1;
+#else
+	    /* fstat()ing socket fd's seems to fail with CRT's fstat(),
+	       so let's just silently return and hope for the best..
+	    */
+	    return 0;
+#endif
 	}
     }
 

ghc/lib/std/cbits/readFile.c

 /* 
  * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
  *
- * $Id: readFile.c,v 1.3 1998/12/02 13:27:45 simonm Exp $
+ * $Id: readFile.c,v 1.4 1999/05/05 10:33:16 sof Exp $
  *
  * hGetContents Runtime Support
  */
@@ -9,6 +9,10 @@
 #include "Rts.h"
 #include "stgio.h"
 
+#ifdef HAVE_WINSOCK_H
+#include <winsock.h>
+#endif
+
 #define EOT 4
 
 /* Filling up a (block-buffered) buffer, that
@@ -72,7 +76,15 @@ StgForeignPtr ptr;
     if ( fo->flags & FILEOBJ_NONBLOCKING_IO && inputReady (ptr,0) != 1 )
       return FILEOBJ_BLOCKED_READ;
 
-    while ((count = read(fd, fo->buf, fo->bufSize)) <= 0) {
+    while ((count =
+	     (
+#ifdef HAVE_WINSOCK_H
+	       fo->flags & FILEOBJ_WINSOCK ?
+	         recv(fd, fo->buf, fo->bufSize, 0) :
+	         read(fd, fo->buf, fo->bufSize))) <= 0 ) {
+#else
+	         read(fd, fo->buf, fo->bufSize))) <= 0 ) {
+#endif
 	if ( count == 0 ) {
             FILEOBJ_SET_EOF(fo);
 	    ghc_errtype = ERR_EOF;
@@ -157,7 +169,15 @@ StgInt len;
     if ( fo->flags & FILEOBJ_NONBLOCKING_IO && inputReady (ptr,0) != 1 )
       return FILEOBJ_BLOCKED_READ;
 
-    while ((count = read(fd, p, len)) < len) {
+    while ((count =
+             (
+#ifdef HAVE_WINSOCK_H
+	       fo->flags & FILEOBJ_WINSOCK ?
+	         recv(fd, p, len, 0) :
+	         read(fd, p, len))) <= 0 ) {
+#else
+	         read(fd, p, len))) <= 0 ) {
+#endif
 	if ( count == 0 ) { /* EOF */
 	    break;
 	} else if ( count == -1 && errno == EAGAIN) {
@@ -296,7 +316,15 @@ StgForeignPtr ptr;
     if ( fo->flags & FILEOBJ_NONBLOCKING_IO && inputReady (ptr,0) != 1 )
       return FILEOBJ_BLOCKED_READ;
 
-    while ( (count = read(fo->fd, &c, 1)) <= 0 ) {
+    while ( (count = 
+	       (
+#ifdef HAVE_WINSOCK_H
+	         fo->flags & FILEOBJ_WINSOCK ?
+		 recv(fo->fd, &c, 1, 0) :
+		 read(fo->fd, &c, 1))) <= 0 ) {
+#else
+		 read(fo->fd, &c, 1))) <= 0 ) {
+#endif
 	if ( count == 0 ) {
 	    ghc_errtype = ERR_EOF;
 	    ghc_errstr = "";

ghc/lib/std/cbits/setBuffering.c

 /* 
  * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
  *
- * $Id: setBuffering.c,v 1.4 1999/03/01 09:26:45 sof Exp $
+ * $Id: setBuffering.c,v 1.5 1999/05/05 10:33:16 sof Exp $
  *
  * hSetBuffering Runtime Support
  */
@@ -100,7 +100,7 @@ StgInt size;
 	break;
     case SB_BB:
 
-#if HAVE_ST_BLKSIZE
+#ifdef HAVE_ST_BLKSIZE
 	while (fstat(fo->fd, &sb) < 0) {
 	   /* not very likely.. */
 	   if ( errno != EINTR ) {

ghc/lib/std/cbits/timezone.h

 /* 
  * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
  *
- * $Id: timezone.h,v 1.8 1999/03/03 17:17:05 simonm Exp $
+ * $Id: timezone.h,v 1.9 1999/05/05 10:33:17 sof Exp $
  *
  * Time-zone support header
  */
@@ -63,7 +63,7 @@
 #define SETZONE(x,z)     (((struct tm *)x)->tm_zone = z)
 #define GMTOFF(x)        (((struct tm *)x)->tm_gmtoff)
 #else /* ! HAVE_TM_ZONE */
-# if HAVE_TZNAME || cygwin32_TARGET_OS
+# if HAVE_TZNAME || _WIN32
 #  if cygwin32_TARGET_OS
 #   define tzname _tzname
 #  endif

ghc/lib/std/cbits/writeFile.c

 /* 
  * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
  *
- * $Id: writeFile.c,v 1.3 1998/12/02 13:28:07 simonm Exp $
+ * $Id: writeFile.c,v 1.4 1999/05/05 10:33:17 sof Exp $
  *
  * hPutStr Runtime Support
  */
@@ -9,6 +9,10 @@
 #include "Rts.h"
 #include "stgio.h"
 
+#ifdef HAVE_WINSOCK_H
+#include <winsock.h>
+#endif
+
 StgInt
 writeFileObject(ptr, bytes)
 StgForeignPtr ptr;
@@ -48,7 +52,15 @@ StgInt bytes;
     if ( fo->flags & FILEOBJ_NONBLOCKING_IO && inputReady(ptr,0) != 1 )
        return FILEOBJ_BLOCKED_WRITE;
 
-    while ((count = write(fo->fd, fo->buf, bytes)) < bytes) {
+    while ((count = 
+	       (
+#ifdef HAVE_WINSOCK_H
+	         fo->flags & FILEOBJ_WINSOCK ?
+		 send(fo->fd, fo->buf, bytes, 0) :
+		 write(fo->fd, fo->buf, bytes))) < bytes) {
+#else
+		 write(fo->fd, fo->buf, bytes))) < bytes) {
+#endif
 	if (errno != EINTR) {
 	    cvtErrno();
 	    stdErrno();
@@ -109,7 +121,15 @@ StgInt  len;
        return FILEOBJ_BLOCKED_WRITE;
 
     /* Disallow short writes */
-    while ((count = write(fo->fd, (char *)buf, (int)len)) < len) {
+    while ((count = 
+               (
+#ifdef HAVE_WINSOCK_H
+	         fo->flags & FILEOBJ_WINSOCK ?
+		 send(fo->fd,  (char*)buf, (int)len, 0) :
+		 write(fo->fd, (char*)buf, (int)len))) < len ) {
+#else
+		 write(fo->fd, (char*)buf, (int)len))) < len ) {
+#endif
 	if (errno != EINTR) {
 	    cvtErrno();
 	    stdErrno();