Stop emitting references to inexistant #n= forms in the pretty printer
[sbcl.git] / contrib / sb-bsd-sockets / win32-sockets.lisp
1 ;;;; win32 socket operations
2 ;;;; these have all been done by hand since I can't seem
3 ;;;; to get my head around the sb-grovel stuff
4
5 ;;;; Winsock requires us to convert HANDLES to/from
6 ;;;; file descriptors, so I've added an additional
7 ;;;; package for the actual winsock alien defs, and then
8 ;;;; in the sockint package, we implement wrappers that
9 ;;;; handle the conversion.
10
11 ;;; these are all of the basic structure alien defs
12 (in-package :sockint)
13
14 ;;;; we are now going back to the normal sockint
15 ;;;; package where we will redefine all of the above
16 ;;;; functions, converting between HANDLES and fds
17
18 (defconstant WSA_FLAG_OVERLAPPED 1)
19 (declaim (inline handle->fd fd->handle))
20
21 ;;; For a few more releases, let's preserve old functions (now
22 ;;; implemented as identity) for user code which might have had to peek
23 ;;; into our internals in past versions when we hadn't been using
24 ;;; handles yet. -- DFL, 2012
25 (defun handle->fd (handle flags) (declare (ignore flags)) handle)
26 (defun fd->handle (fd) fd)
27
28 (defun socket (af type proto)
29   (wsa-socket af type proto nil 0 WSA_FLAG_OVERLAPPED))
30
31 ;;; For historical reasons, the FFI functions declared in win32-constants
32 ;;; prepend "win32-" to the symbol names.  Rather than break compatibility
33 ;;; for users depending on those names, wrap the misnamed functions in
34 ;;; correctly named ones...
35 (macrolet ((define-socket-fd-arg-routines (&rest names)
36              `(progn
37                 (declaim (inline ,@names))
38                 ,@(loop for routine in names collect
39                        `(defun ,routine (handle &rest options)
40                           (apply #',(sb-int:symbolicate "WIN32-" routine)
41                                  handle options))))))
42   (define-socket-fd-arg-routines
43       bind getsockname listen recv recvfrom send sendto close connect
44       getpeername ioctl setsockopt getsockopt))
45
46 (defun accept (handle &rest options)
47   (let ((handle (apply #'win32-accept handle options)))
48     (if (= handle -1)
49         -1
50         handle)))
51
52 (defun make-wsa-version (major minor)
53   (dpb minor (byte 8 8) major))
54
55 (defvar *wsa-startup-call* nil)
56
57 (defun call-wsa-startup ()
58   (setf *wsa-startup-call* (wsa-startup (make-wsa-version 2 2))))
59
60 ;;; Startup!
61 (call-wsa-startup)
62
63 ;;; Ensure startup for saved cores as well.
64 (push 'call-wsa-startup sb-ext:*init-hooks*)
65
66 ;; not implemented on win32
67 (defconstant af-local 0)
68 (defconstant msg-dontwait 0)
69 (defconstant msg-trunc 0)
70 (defconstant msg-eor 0)
71 (defconstant msg-nosignal 0)
72 (defconstant msg-waitall 0)
73 (defconstant msg-eor 0)
74 (defconstant size-of-sockaddr-un 0)
75 (defun (setf sockaddr-un-family) (addr family) ())
76 (defun (setf sockaddr-un-path) (addr family) ())
77 (defun sockaddr-un-path (addr) ())
78 (defun free-sockaddr-un (addr) ())
79 (defun allocate-sockaddr-un () ())
80
81