[project @ 1999-05-05 10:36:29 by sof]

switch over to using Winsock on the _WIN32 side

diff --git a/ghc/lib/misc/BSD.lhs b/ghc/lib/misc/BSD.lhs
index e7fbecf..2b07ebc 100644 (file)
--- a/ghc/lib/misc/BSD.lhs
+++ b/ghc/lib/misc/BSD.lhs
@@ -25,7 +25,7 @@ module BSD (
     getServiceByPort,       -- :: PortNumber  -> ProtocolName -> IO ServiceEntry
     getServicePortNumber,   -- :: ServiceName -> IO PortNumber
 
-#ifndef cygwin32_TARGET_OS
+#ifndef _WIN32
     getServiceEntry,       -- :: IO ServiceEntry
     setServiceEntry,       -- :: Bool -> IO ()
     endServiceEntry,       -- :: IO ()
@@ -39,7 +39,7 @@ module BSD (
     getProtocolByNumber,    -- :: ProtocolNumber -> IO ProtcolEntry
     getProtocolNumber,     -- :: ProtocolName   -> ProtocolNumber
 
-#ifndef cygwin32_TARGET_OS
+#ifndef _WIN32
     setProtocolEntry,      -- :: Bool -> IO ()
     getProtocolEntry,      -- :: IO ProtocolEntry
     endProtocolEntry,      -- :: IO ()
@@ -54,7 +54,7 @@ module BSD (
     getHostByAddr,         -- :: HostAddress -> Family -> IO HostEntry
     hostAddress,           -- :: HostEntry -> HostAddress
 
-#ifndef cygwin32_TARGET_OS
+#ifndef _WIN32
     setHostEntry,          -- :: Bool -> IO ()
     getHostEntry,          -- :: IO HostEntry
     endHostEntry,          -- :: IO ()
@@ -64,7 +64,7 @@ module BSD (
     NetworkName,
     NetworkAddr,
     NetworkEntry(..)
-#ifndef cygwin32_TARGET_OS
+#ifndef _WIN32
     , getNetworkByName     -- :: NetworkName -> IO NetworkEntry
     , getNetworkByAddr     -- :: NetworkAddr -> Family -> IO NetworkEntry
     , setNetworkEntry      -- :: Bool -> IO ()
@@ -178,7 +178,7 @@ getServicePortNumber name = do
     (ServiceEntry _ _ port _) <- getServiceByName name "tcp"
     return port
 
-#ifndef cygwin32_TARGET_OS
+#ifndef _WIN32
 getServiceEntry        :: IO ServiceEntry
 getServiceEntry = do
     ptr <- _ccall_ getservent
@@ -214,7 +214,7 @@ getProtocolByName   :: ProtocolName   -> IO ProtocolEntry
 getProtocolByNumber :: ProtocolNumber -> IO ProtocolEntry
 getProtocolNumber   :: ProtocolName   -> IO ProtocolNumber
 
-#ifndef cygwin32_TARGET_OS
+#ifndef _WIN32
 setProtocolEntry    :: Bool -> IO ()   -- Keep DB Open ?
 getProtocolEntry    :: IO ProtocolEntry        -- Next Protocol Entry from DB
 endProtocolEntry    :: IO ()
@@ -242,7 +242,7 @@ getProtocolNumber proto = do
  (ProtocolEntry _ _ num) <- getProtocolByName proto
  return num
 
-#ifndef cygwin32_TARGET_OS
+#ifndef _WIN32
 --getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB
 getProtocolEntry = do
  ptr <- _ccall_ getprotoent
@@ -284,7 +284,7 @@ getHostByAddr family addr = do
     then ioError (IOError Nothing NoSuchThing "getHostByAddr" "no such host entry")
     else unpackHostEntry ptr
 
-#ifndef cygwin32_TARGET_OS
+#ifndef _WIN32
 getHostEntry :: IO HostEntry
 getHostEntry = do
  ptr <- _ccall_ gethostent
@@ -328,7 +328,7 @@ data NetworkEntry =
      networkFamily     :: Family,         -- type
      networkAddress    :: NetworkAddr
    }
-#ifndef cygwin32_TARGET_OS
+#ifndef _WIN32
 getNetworkByName :: NetworkName -> IO NetworkEntry
 getNetworkByName name = do
  ptr <- _ccall_ getnetbyname name

diff --git a/ghc/lib/misc/Makefile b/ghc/lib/misc/Makefile
index 2483768..64768bd 100644 (file)
--- a/ghc/lib/misc/Makefile
+++ b/ghc/lib/misc/Makefile
@@ -1,4 +1,4 @@
-# $Id: Makefile,v 1.11 1999/02/03 16:54:01 simonm Exp $
+# $Id: Makefile,v 1.12 1999/05/05 10:36:30 sof Exp $
 #
 # Makefile for miscellaneous libraries.
 #
@@ -41,6 +41,7 @@ SRC_HC_OPTS += -i../concurrent -recomp -cpp -fglasgow-exts -fvia-C -Rghc-timing
 
 #
 # Profiling options
+# (what's this stuff doing here?)
 WAY_p_HC_OPTS += -GPrelude
 WAY_mr_HC_OPTS += -GPrelude
 
@@ -65,6 +66,15 @@ PackedString_HC_OPTS += -H12m
 SRC_MKDEPENDHS_OPTS += -I$(GHC_INCLUDE_DIR)
 
 #-----------------------------------------------------------------------------
+#      Win32 DLL setup
+
+DLL_NAME = HSmisc.dll
+DLL_IMPLIB_NAME = libHSmisc_imp.a
+SRC_BLD_DLL_OPTS += --export-all --output-def=HSmisc.def
+SRC_BLD_DLL_OPTS += -lwinmm -lwsock32 -lHSrts_imp -lHS_cbits_imp -lHSmisc_cbits_imp -lHS_imp -lHSexts_imp -lgmp -L. -L../../rts/gmp -L../../rts -L../std -L../std/cbits -L../exts -Lcbits
+
+
+#-----------------------------------------------------------------------------
 #      Installation; need to install .hi files as well as libraries
 #
 # The interface files are put inside the $(libdir), since they

diff --git a/ghc/lib/misc/Socket.lhs b/ghc/lib/misc/Socket.lhs
index 30bf12e..b960b90 100644 (file)
--- a/ghc/lib/misc/Socket.lhs
+++ b/ghc/lib/misc/Socket.lhs
@@ -26,7 +26,12 @@ module Socket (
        sendTo,         -- :: Hostname -> PortID -> String -> IO ()
        recvFrom,       -- :: Hostname -> PortID -> IO String
 
-       socketPort      -- :: Socket -> IO PortID
+       socketPort,     -- :: Socket -> IO PortID
+       
+       withSocketsDo,  -- :: IO a   -> IO a
+       
+       PortNumber,
+       mkPortNumber    -- :: Int    -> PortNumber
 
        ) where
 
@@ -56,7 +61,7 @@ signalling that the current hostname applies.
 data PortID = 
          Service String                -- Service Name eg "ftp"
        | PortNumber PortNumber         -- User defined Port Number
-#ifndef cygwin32_TARGET_OS
+#ifndef _WIN32
        | UnixSocket String             -- Unix family socket in file system
 #endif
 
@@ -88,7 +93,7 @@ connectTo hostname (PortNumber port) = do
     connect sock (SockAddrInet port (hostAddress he))
     socketToHandle sock ReadWriteMode
 
-#ifndef cygwin32_TARGET_OS
+#ifndef _WIN32
 connectTo _ (UnixSocket path) = do
     sock    <- socket AF_UNIX Datagram 0
     connect sock (SockAddrUnix path)
@@ -119,7 +124,7 @@ listenOn (PortNumber port) = do
     listen sock maxListenQueue
     return sock
 
-#ifndef cygwin32_TARGET_OS
+#ifndef _WIN32
 listenOn (UnixSocket path) = do
     sock <- socket AF_UNIX Datagram 0
     bindSocket sock (SockAddrUnix path)
@@ -190,7 +195,7 @@ socketPort s = do
    portID sa =
     case sa of
      SockAddrInet port _    -> PortNumber port
-#ifndef cygwin32_TARGET_OS
+#ifndef _WIN32
      SockAddrUnix path     -> UnixSocket path
 #endif
 

diff --git a/ghc/lib/misc/SocketPrim.lhs b/ghc/lib/misc/SocketPrim.lhs
index 589edfa..d88e3d7 100644 (file)
--- a/ghc/lib/misc/SocketPrim.lhs
+++ b/ghc/lib/misc/SocketPrim.lhs
@@ -77,6 +77,8 @@ module SocketPrim (
     packSocketType,
     packSockAddr, unpackSockAddr
 
+    , withSocketsDo  -- :: IO a -> IO a
+
 ) where
  
 import GlaExts
@@ -86,6 +88,7 @@ import Weak       ( addForeignFinalizer )
 import PrelIOBase  -- IOError, Handle representation
 import PrelHandle
 import Foreign
+import Addr        ( nullAddr )
 
 import IO
 import IOExts      ( IORef, newIORef, readIORef, writeIORef )
@@ -188,7 +191,7 @@ instance Num PortNumber where
    signum n  = mkPortNumber (signum (ntohs n))
 
 data SockAddr          -- C Names                              
-#ifndef cygwin32_TARGET_OS
+#if !defined(cygwin32_TARGET_OS) && !defined(mingw32_TARGET_OS)
   = SockAddrUnix        -- struct sockaddr_un
         String          -- sun_path
   | SockAddrInet       -- struct sockaddr_in
@@ -266,7 +269,7 @@ bindSocket :: Socket        -- Unconnected Socket
           -> IO ()
 
 bindSocket (MkSocket s _family _stype _protocol socketStatus) addr = do
-#ifndef cygwin32_TARGET_OS
+#if !defined(cygwin32_TARGET_OS) && !defined(mingw32_TARGET_OS)
  let isDomainSocket = if _family == AF_UNIX then 1 else (0::Int)
 #else
  let isDomainSocket = 0
@@ -301,7 +304,7 @@ connect :: Socket   -- Unconnected Socket
        -> IO ()
 
 connect (MkSocket s _family _stype _protocol socketStatus) addr = do
-#ifndef cygwin32_TARGET_OS
+#ifndef _WIN32
  let isDomainSocket = if _family == AF_UNIX then 1 else (0::Int)
 #else
  let isDomainSocket = 0
@@ -555,7 +558,9 @@ data SocketOption
     | RecvBuffer    {- SO_RCVBUF    -}
     | KeepAlive     {- SO_KEEPALIVE -}
     | OOBInline     {- SO_OOBINLINE -}
+#ifndef _WIN32
     | MaxSegment    {- TCP_MAXSEG   -}
+#endif
     | NoDelay       {- TCP_NODELAY  -}
 --    | Linger        {- SO_LINGER    -}
 #if 0
@@ -580,7 +585,9 @@ packSocketOption so =
     RecvBuffer    -> ``SO_RCVBUF''
     KeepAlive     -> ``SO_KEEPALIVE''
     OOBInline     -> ``SO_OOBINLINE''
+#ifndef _WIN32
     MaxSegment    -> ``TCP_MAXSEG''
+#endif
     NoDelay       -> ``TCP_NODELAY''
 #if 0
     ReusePort     -> ``SO_REUSEPORT''  -- BSD only?
@@ -708,7 +715,7 @@ unpackFamily family = (range (AF_UNSPEC, AF_IPX))!!family
 
 #endif
 
-#if cygwin32_TARGET_OS
+#if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
  
 data Family = 
          AF_UNSPEC     -- unspecified
@@ -951,14 +958,13 @@ packSocketType stype = 1 + (index (Stream, SeqPacket) stype)
 
 -- This is for a box running cygwin32 toolchain.
 
-#if defined(cygwin32_TARGET_OS)
+#if defined(_WIN32)
 data SocketType = 
          Stream 
        | Datagram
        | Raw 
        | RDM       -- reliably delivered msg
        | SeqPacket
-       | Packet
        deriving (Eq, Ord, Ix, Show)
        
 packSocketType stype =
@@ -968,7 +974,6 @@ packSocketType stype =
    Raw       -> ``SOCK_RAW''
    RDM       -> ``SOCK_RDM'' 
    SeqPacket -> ``SOCK_SEQPACKET''
-   Packet    -> ``SOCK_PACKET''
 
 #endif
 
@@ -1081,7 +1086,7 @@ sIsWritable = sIsReadable -- sort of.
 -------------------------------------------------------------------------------
 
 sIsAcceptable :: Socket -> IO Bool
-#ifndef cygwin32_TARGET_OS
+#if !defined(cygwin32_TARGET_OS) && !defined(mingw32_TARGET_OS)
 sIsAcceptable (MkSocket _ AF_UNIX Stream _ status) = do
     value <- readIORef status
     return (value == Connected || value == Bound || value == Listening)
@@ -1127,7 +1132,7 @@ Marshaling and allocation helper functions:
 
 allocSockAddr :: Family -> IO (MutableByteArray RealWorld Int, Int)
 
-#ifndef cygwin32_TARGET_OS
+#if !defined(cygwin32_TARGET_OS) && !defined(mingw32_TARGET_OS)
 allocSockAddr AF_UNIX = do
     ptr <- allocChars ``sizeof(struct sockaddr_un)''
     let (_,sz) = boundsOfMutableByteArray ptr
@@ -1145,14 +1150,14 @@ unpackSockAddr :: MutableByteArray RealWorld Int -> Int -> IO SockAddr
 unpackSockAddr arr len = do
     fam <- _casm_ ``%r = ((struct sockaddr*)%0)->sa_family;'' arr
     case unpackFamily fam of
-#ifndef cygwin32_TARGET_OS
+#if !defined(cygwin32_TARGET_OS) && !defined(mingw32_TARGET_OS)
        AF_UNIX -> unpackSockAddrUnix arr (len - ``sizeof(short)'')
 #endif
        AF_INET -> unpackSockAddrInet arr
 
 -------------------------------------------------------------------------------
 
-#ifndef cygwin32_TARGET_OS
+#if !defined(cygwin32_TARGET_OS) && !defined(mingw32_TARGET_OS)
 
 {-
   sun_path is *not* NULL terminated, hence we *do* need to know the
@@ -1178,7 +1183,7 @@ unpackSockAddrInet ptr = do
 
 
 packSockAddr :: SockAddr -> IO (MutableByteArray RealWorld Int)
-#ifndef cygwin32_TARGET_OS
+#if !defined(cygwin32_TARGET_OS) && !defined(mingw32_TARGET_OS)
 packSockAddr (SockAddrUnix path) = do
     (ptr,_) <- allocSockAddr AF_UNIX
     _casm_ ``(((struct sockaddr_un *)%0)->sun_family) = AF_UNIX;''    ptr
@@ -1204,14 +1209,23 @@ it subsequently.
 socketToHandle :: Socket -> IOMode -> IO Handle
 
 socketToHandle (MkSocket fd _ _ _ _) m = do
-    fileobj <- _ccall_ openFd fd (file_mode::Int) (flush_on_close::Int)
-    fo <- mkForeignObj fileobj
-    addForeignFinalizer fo (freeFileObject fo)
-    mkBuffer__ fo 0  -- not buffered
-    hndl <- newHandle (Handle__ fo htype NoBuffering socket_str)
-    return hndl
+    fileobj <- _ccall_ openFd fd (file_mode::Int) (file_flags::Int)
+    if fileobj == nullAddr then
+       ioError (userError "socketHandle: Failed to open file desc")
+     else do
+       fo <- mkForeignObj fileobj
+       addForeignFinalizer fo (freeFileObject fo)
+       mkBuffer__ fo 0  -- not buffered
+       hndl <- newHandle (Handle__ fo htype NoBuffering socket_str)
+       return hndl
  where
   socket_str = "<socket: "++show fd
+#ifdef _WIN32
+  file_flags = flush_on_close + 1024{-I'm a socket fd, me!-}
+#else
+  file_flags = flush_on_close
+#endif
+
   (flush_on_close, file_mode) =
    case m of 
            AppendMode    -> (1, 0)
@@ -1231,3 +1245,28 @@ socketToHandle (MkSocket s family stype protocol status) m =
 #endif
 \end{code}
 
+If you're using WinSock, the programmer has to call a startup
+routine before starting to use the goods. So, if you want to
+stay portable across all ghc-supported platforms, you have to
+use @withSocketsDo@...:
+
+\begin{code}
+withSocketsDo :: IO a -> IO a
+#ifndef _WIN32
+withSocketsDo x = x
+#else
+withSocketsDo act = do
+   x <- initWinSock
+   if ( x /= 0 ) then
+     ioError (userError "Failed to initialise WinSock")
+    else do
+      v <- act
+      shutdownWinSock
+      return v
+
+foreign import "initWinSock" initWinSock :: IO Int
+foreign import "shutdownWinSock" shutdownWinSock :: IO ()
+
+#endif
+
+\end{code}