X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-bsd-sockets%2Fwin32-sockets.lisp;h=c5dadacf82cf82677c1a10411a7a58e6192ae0de;hb=7f4bf063d5f4716b87d34cc706f05b27ad3906b1;hp=5b20df519c60a99153084103f1270a71df4facf3;hpb=5a0fd10d9995460c34c0cfb509b97d1cc931932b;p=sbcl.git

diff --git a/contrib/sb-bsd-sockets/win32-sockets.lisp b/contrib/sb-bsd-sockets/win32-sockets.lisp
index 5b20df5..c5dadac 100644
--- a/contrib/sb-bsd-sockets/win32-sockets.lisp
+++ b/contrib/sb-bsd-sockets/win32-sockets.lisp
@@ -15,61 +15,53 @@
 ;;;; package where we will redefine all of the above
 ;;;; functions, converting between HANDLES and fds
 
-(defun socket (af type proto)
-  (let* ((handle (wsa-socket af type proto nil 0 0))
-         (fd (handle->fd handle 0)))
-    fd))
-
-(defun bind (fd &rest options)
-  (let ((handle (fd->handle fd)))
-    (apply #'win32-bind handle options)))
-
-(defun getsockname (fd &rest options)
-  (apply #'win32-getsockname (fd->handle fd) options))
-
-(defun listen (fd &rest options)
-  (apply #'win32-listen (fd->handle fd) options))
-
-(defun accept (fd &rest options)
-  (handle->fd
-   (apply #'win32-accept (fd->handle fd) options)
-   0))
-
-(defun recv (fd &rest options)
-  (apply #'win32-recv (fd->handle fd) options))
-
-(defun recvfrom (fd &rest options)
-  (apply #'win32-recvfrom (fd->handle fd) options))
-
-(defun send (fd &rest options)
-  (apply #'win32-send (fd->handle fd) options))
+(defconstant WSA_FLAG_OVERLAPPED 1)
+(declaim (inline handle->fd fd->handle))
 
-(defun sendto (fd &rest options)
-  (apply #'win32-sendto (fd->handle fd) options))
+;;; For a few more releases, let's preserve old functions (now
+;;; implemented as identity) for user code which might have had to peek
+;;; into our internals in past versions when we hadn't been using
+;;; handles yet. -- DFL, 2012
+(defun handle->fd (handle flags) (declare (ignore flags)) handle)
+(defun fd->handle (fd) fd)
 
-(defun close (fd &rest options)
-  (apply #'win32-close (fd->handle fd) options))
-
-(defun connect (fd &rest options)
-  (apply #'win32-connect (fd->handle fd) options))
-
-(defun getpeername (fd &rest options)
-  (apply #'win32-getpeername (fd->handle fd) options))
+(defun socket (af type proto)
+  (wsa-socket af type proto nil 0 WSA_FLAG_OVERLAPPED))
+
+;;; For historical reasons, the FFI functions declared in win32-constants
+;;; prepend "win32-" to the symbol names.  Rather than break compatibility
+;;; for users depending on those names, wrap the misnamed functions in
+;;; correctly named ones...
+(macrolet ((define-socket-fd-arg-routines (&rest names)
+             `(progn
+                (declaim (inline ,@names))
+                ,@(loop for routine in names collect
+                       `(defun ,routine (handle &rest options)
+                          (apply #',(sb-int:symbolicate "WIN32-" routine)
+                                 handle options))))))
+  (define-socket-fd-arg-routines
+      bind getsockname listen recv recvfrom send sendto close connect
+      getpeername ioctl setsockopt getsockopt))
+
+(defun accept (handle &rest options)
+  (let ((handle (apply #'win32-accept handle options)))
+    (if (= handle -1)
+        -1
+        handle)))
 
-(defun ioctl (fd &rest options)
-  (apply #'win32-ioctl (fd->handle fd) options))
+(defun make-wsa-version (major minor)
+  (dpb minor (byte 8 8) major))
 
-(defun setsockopt (fd &rest options)
-  (apply #'win32-setsockopt (fd->handle fd) options))
+(defvar *wsa-startup-call* nil)
 
-(defun getsockopt (fd &rest options)
-  (apply #'win32-getsockopt (fd->handle fd) options))
+(defun call-wsa-startup ()
+  (setf *wsa-startup-call* (wsa-startup (make-wsa-version 2 2))))
 
-(defun make-wsa-version (major minor)
-  (dpb minor (byte 8 8) major))
+;;; Startup!
+(call-wsa-startup)
 
-(defvar *wsa-startup-call*
-  (wsa-startup (make-wsa-version 2 2)))
+;;; Ensure startup for saved cores as well.
+(push 'call-wsa-startup sb-ext:*init-hooks*)
 
 ;; not implemented on win32
 (defconstant af-local 0)