Update of /cvsroot/sbcl/sbcl/contrib/sb-bsd-sockets In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4550/contrib/sb-bsd-sockets Modified Files: tests.lisp sockopt.lisp sockets.lisp sb-bsd-sockets.asd name-service.lisp misc.lisp inet.lisp defpackage.lisp Log Message: 0.9.11.13 Merge Timothy Ritchey's win32 megapatch: * user-homedir-pathname and initfile fixes (by Yaroslav Kavenchuk) * run-program (by Mike Thomas) * sockets (Timothy Ritchey) With this patch, sbcl has been reported to run SLIME on win32. ... apologies if I got any credits wrong, the patches have been floating around quite a bit - if you contributed something in there and the NEWS entry doesn't mention you, just drop me a note and I'll update it accordingly. Index: tests.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/contrib/sb-bsd-sockets/tests.lisp,v retrieving revision 1.19 retrieving revision 1.20 diff -u -d -r1.19 -r1.20 --- tests.lisp 26 Jan 2006 23:29:07 -0000 1.19 +++ tests.lisp 5 Apr 2006 08:47:17 -0000 1.20 @@ -155,6 +155,7 @@ ;;; the message ended up (deftest simple-local-client + #-win32 (progn ;; SunOS (Solaris) and Darwin systems don't have a socket at ;; /dev/log. We might also be building in a chroot or Index: sockopt.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/contrib/sb-bsd-sockets/sockopt.lisp,v retrieving revision 1.9 retrieving revision 1.10 diff -u -d -r1.9 -r1.10 --- sockopt.lisp 14 Jul 2005 16:30:08 -0000 1.9 +++ sockopt.lisp 5 Apr 2006 08:47:17 -0000 1.10 @@ -43,7 +43,7 @@ (if (numberp (eval level)) level `(get-protocol-by-name ,(string-downcase (symbol-name level))))) - (supportedp (or (null features) (featurep features)))) + (supportedp (or (null features) (sb-int:featurep features)))) `(progn (export ',lisp-name) (defun ,lisp-name (socket) Index: sockets.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/contrib/sb-bsd-sockets/sockets.lisp,v retrieving revision 1.17 retrieving revision 1.18 diff -u -d -r1.17 -r1.18 --- sockets.lisp 14 Jul 2005 16:30:08 -0000 1.17 +++ sockets.lisp 5 Apr 2006 08:47:17 -0000 1.18 @@ -4,6 +4,11 @@ ;;;; is deferred to inet.lisp, unix.lisp, etc (eval-when (:load-toplevel :compile-toplevel :execute) + +#+win32 +(defvar *wsa-startup-call* + (sockint::wsa-startup (sockint::make-wsa-version 2 2))) + (defclass socket () ((file-descriptor :initarg :descriptor :reader socket-file-descriptor) Index: sb-bsd-sockets.asd =================================================================== RCS file: /cvsroot/sbcl/sbcl/contrib/sb-bsd-sockets/sb-bsd-sockets.asd,v retrieving revision 1.23 retrieving revision 1.24 diff -u -d -r1.23 -r1.24 --- sb-bsd-sockets.asd 7 Mar 2006 12:04:26 -0000 1.23 +++ sb-bsd-sockets.asd 5 Apr 2006 08:47:17 -0000 1.24 @@ -1,29 +1,31 @@ ;;; -*- Lisp -*- -(eval-when (:compile-toplevel :load-toplevel :execute) - (require :sb-grovel)) -(defpackage #:sb-bsd-sockets-system (:use #:asdf #:sb-grovel #:cl)) +#-win32 (eval-when (:compile-toplevel :load-toplevel :execute) + (require :sb-grovel)) +(defpackage #:sb-bsd-sockets-system (:use #:asdf #-win32 #:sb-grovel #:cl)) (in-package #:sb-bsd-sockets-system) (defsystem sb-bsd-sockets :version "0.58" - :depends-on (sb-grovel) + :depends-on #-win32 (sb-grovel) #+win32 () #+sb-building-contrib :pathname #+sb-building-contrib "SYS:CONTRIB;SB-BSD-SOCKETS;" :components ((:file "defpackage") + #+win32 (:file "win32-constants" :depends-on ("defpackage")) + #+win32 (:file "win32-sockets" :depends-on ("win32-constants")) (:file "split" :depends-on ("defpackage")) (:file "malloc" :depends-on ("defpackage")) - (sb-grovel:grovel-constants-file + #-win32 (sb-grovel:grovel-constants-file "constants" :package :sockint :depends-on ("defpackage")) (:file "sockets" - :depends-on ("constants")) - + :depends-on #-win32 ("constants") + #+win32 ("win32-sockets")) (:file "sockopt" :depends-on ("sockets")) - (:file "inet" :depends-on ("sockets" "split" "constants" )) - (:file "local" :depends-on ("sockets" "split" "constants" )) - (:file "name-service" :depends-on ("sockets" "constants")) - (:file "misc" :depends-on ("sockets" "constants")) + (:file "inet" :depends-on ("sockets" "split")) + (:file "local" :depends-on ("sockets" "split")) + (:file "name-service" :depends-on ("sockets" #-win32 "constants")) + (:file "misc" :depends-on ("sockets")) (:static-file "NEWS") ;; (:static-file "INSTALL") @@ -35,14 +37,17 @@ (defmethod perform :after ((o load-op) (c (eql (find-system :sb-bsd-sockets)))) (provide 'sb-bsd-sockets)) +#-win32 (defmethod perform ((o test-op) (c (eql (find-system :sb-bsd-sockets)))) (operate 'load-op 'sb-bsd-sockets-tests) (operate 'test-op 'sb-bsd-sockets-tests)) +#-win32 (defsystem sb-bsd-sockets-tests - :depends-on (sb-rt sb-bsd-sockets sb-posix) + :depends-on (sb-rt sb-bsd-sockets #-win32 sb-posix) :components ((:file "tests"))) +#-win32 (defmethod perform ((o test-op) (c (eql (find-system :sb-bsd-sockets-tests)))) (or (funcall (intern "DO-TESTS" (find-package "SB-RT"))) (error "test-op failed"))) Index: name-service.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/contrib/sb-bsd-sockets/name-service.lisp,v retrieving revision 1.11 retrieving revision 1.12 diff -u -d -r1.11 -r1.12 --- name-service.lisp 14 Jul 2005 16:30:08 -0000 1.11 +++ name-service.lisp 5 Apr 2006 08:47:17 -0000 1.12 @@ -24,7 +24,7 @@ ;(define-condition try-again-error (socket-error)) ; temporary (defun make-host-ent (h) - (if (sb-grovel::foreign-nullp h) (name-service-error "gethostbyname")) + (if (sb-alien:null-alien h) (name-service-error "gethostbyname")) (let* ((length (sockint::hostent-length h)) (aliases (loop for i = 0 then (1+ i) for al = (sb-alien:deref (sockint::hostent-aliases h) i) @@ -41,7 +41,8 @@ (loop for i from 0 below length do (setf (elt addr i) (sb-alien:deref ad i))) addr)) - (#.sockint::af-local + #-win32 + (#.sockint::af-local (sb-alien:cast ad sb-alien:c-string)))))) (make-instance 'host-ent :name (sockint::hostent-name h) @@ -81,6 +82,7 @@ (get-name-service-errno) ;; Comment next to NETDB_INTERNAL in netdb.h says "See errno.". ;; This special case treatment hasn't actually been tested yet. + #-win32 (if (= *name-service-errno* sockint::NETDB-INTERNAL) (socket-error where) (let ((condition @@ -109,7 +111,9 @@ (defparameter *conditions-for-name-service-errno* nil) +#-win32 (define-name-service-condition sockint::NETDB-INTERNAL netdb-internal-error) +#-win32 (define-name-service-condition sockint::NETDB-SUCCESS netdb-success-error) (define-name-service-condition sockint::HOST-NOT-FOUND host-not-found-error) (define-name-service-condition sockint::TRY-AGAIN try-again-error) @@ -122,16 +126,17 @@ (or (cdr (assoc err *conditions-for-name-service-errno* :test #'eql)) 'name-service)) - - (defun get-name-service-errno () (setf *name-service-errno* (sb-alien:alien-funcall - (sb-alien:extern-alien "get_h_errno" (function integer))))) + #-win32 + (sb-alien:extern-alien "get_h_errno" (function integer)) + #+win32 + (sb-alien:extern-alien "WSAGetLastError" (function integer))))) #-(and cmu solaris) (progn - #+sbcl + #+(and sbcl (not win32)) (sb-alien:define-alien-routine "hstrerror" sb-c-call:c-string (errno integer)) @@ -142,3 +147,7 @@ (defun get-name-service-error-message (num) (hstrerror num)) ) + +;;; placeholder for hstrerror on windows +#+(and sbcl win32) +(defun hstrerror () 0) Index: misc.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/contrib/sb-bsd-sockets/misc.lisp,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- misc.lisp 14 Jul 2005 16:30:08 -0000 1.3 +++ misc.lisp 5 Apr 2006 08:47:17 -0000 1.4 @@ -12,6 +12,7 @@ (defgeneric non-blocking-mode (socket) (:documentation "Is SOCKET in non-blocking mode?")) +#-win32 (defmethod non-blocking-mode ((socket socket)) (let ((fd (socket-file-descriptor socket))) (sb-alien:with-alien ((arg integer)) @@ -20,9 +21,13 @@ sockint::o-nonblock) 0)))) +#+win32 +(defmethod non-blocking-mode ((socket socket)) 0) + (defgeneric (setf non-blocking-mode) (non-blocking-p socket) (:documentation "Put SOCKET in non-blocking mode - or not, according to NON-BLOCKING-P")) +#-win32 (defmethod (setf non-blocking-mode) (non-blocking-p (socket socket)) (declare (optimize (speed 3))) (let* ((fd (socket-file-descriptor socket)) @@ -37,4 +42,9 @@ (socket-error "fcntl")) non-blocking-p)) +#+win32 +(defmethod (setf non-blocking-mode) (non-blocking-p (socket socket)) 0) +;; (sb-alien:with-alien ((mode (unsigned 32))) +;; (if non-blocking-p (setf mode 1)) +;; (ioctlsocket socket FIONBIO mode))) Index: inet.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/contrib/sb-bsd-sockets/inet.lisp,v retrieving revision 1.9 retrieving revision 1.10 diff -u -d -r1.9 -r1.10 --- inet.lisp 26 Jan 2006 23:29:07 -0000 1.9 +++ inet.lisp 5 Apr 2006 08:47:17 -0000 1.10 @@ -42,7 +42,7 @@ ;; for extra brownie points, could return canonical protocol name ;; and aliases as extra values (let ((ent (sockint::getprotobyname name))) - (if (sb-grovel::foreign-nullp ent) + (if (sb-alien::null-alien ent) (error 'unknown-protocol :name name)) (sockint::protoent-proto ent))) Index: defpackage.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/contrib/sb-bsd-sockets/defpackage.lisp,v retrieving revision 1.10 retrieving revision 1.11 diff -u -d -r1.10 -r1.11 --- defpackage.lisp 26 Jan 2006 23:29:07 -0000 1.10 +++ defpackage.lisp 5 Apr 2006 08:47:17 -0000 1.11 @@ -1,3 +1,9 @@ +#+(and sbcl win32) +(defpackage "SB-WIN32-SOCKETS-INTERNAL" + (:nicknames "WIN32SOCKINT") + (:shadow close listen) + (:use "COMMON-LISP" "SB-ALIEN" "SB-EXT" "SB-C-CALL")) + (defpackage "SB-BSD-SOCKETS-INTERNAL" (:nicknames "SOCKINT") (:shadow close listen) |