Author: ctian Date: Sat Dec 8 08:35:12 2012 New Revision: 700 Log: [ECL] Add the framework for ECL DFFI support Added: usocket/trunk/backend/ecl.lisp (contents, props changed) Modified: usocket/trunk/backend/sbcl.lisp usocket/trunk/usocket.asd Added: usocket/trunk/backend/ecl.lisp ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ usocket/trunk/backend/ecl.lisp Sat Dec 8 08:35:12 2012 (r700) @@ -0,0 +1,87 @@ +;;;; -*- Mode: Lisp -*- +;;;; $Id$ +;;;; $URL$ + +;;;; Foreign functions defined by ECL's DFFI, used for #+ecl-bytecmp only. +;;;; See LICENSE for licensing information. + +(in-package :usocket) + +#+(and ecl-bytecmp windows) +(eval-when (:load-toplevel :execute) + (ffi:load-foreign-library "ws2_32.dll" :module "ws2_32")) + +#+(and ecl-bytecmp windows) +(progn + +(ffi:def-function ("gethostname" c-gethostname) + ((name (* :unsigned-char)) + (len :int)) + :returning :int + :module "ws2_32") + +(defun get-host-name () + "Returns the hostname" + (ffi:with-foreign-object (name '(:array :unsigned-char 256)) + (when (zerop (c-gethostname (ffi:char-array-to-pointer name) 256)) + (ffi:convert-from-foreign-string name)))) + +(ffi:def-foreign-type ws-socket :signed) +(ffi:def-foreign-type ws-dword :unsigned-long) +(ffi:def-foreign-type ws-event :pointer-void) + +(ffi:def-struct wsa-network-events + (network-events :long) + (error-code (:array :int 10))) + +(ffi:def-function ("WSACreateEvent" wsa-event-create) + () + :returning ws-event + :module "ws2_32") + +(ffi:def-function ("WSACloseEvent" c-wsa-event-close) + ((event-object ws-event)) + :returning :int + :module "ws2_32") + +(defun wsa-event-close (ws-event) + (not (zerop (c-wsa-event-close ws-event)))) + +(ffi:def-function ("WSAEnumNetworkEvents" wsa-enum-network-events) + ((socket ws-socket) + (event-object ws-event) + (network-events (* wsa-network-events))) + :returning :int + :module "ws2_32") + +(ffi:def-function ("WSAEventSelect" wsa-event-select) + ((socket ws-socket) + (event-object ws-event) + (network-events :long)) + :returning :int + :module "ws2_32") + +(ffi:def-function ("WSAWaitForMultipleEvents" c-wsa-wait-for-multiple-events) + ((number-of-events ws-dword) + (events (* ws-event)) + (wait-all-p :int) + (timeout ws-dword) + (alertable-p :int)) + :returning ws-dword + :module "ws2_32") + +(defun wsa-wait-for-multiple-events (number-of-events events wait-all-p timeout alertable-p) + (c-wsa-wait-for-multiple-events number-of-events + events + (if wait-all-p -1 0) + timeout + (if alertable-p -1 0))) + +(ffi:def-function ("ioctlsocket" wsa-ioctlsocket) + ((socket ws-socket) + (cmd :long) + (argp (* :unsigned-long))) + :returning :int + :module "ws2_32") + +) ; #+(and ecl-bytecmp windows) Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp Sat Nov 17 17:44:09 2012 (r699) +++ usocket/trunk/backend/sbcl.lisp Sat Dec 8 08:35:12 2012 (r700) @@ -1,3 +1,4 @@ +;;;; -*- Mode: Lisp -*- ;;;; $Id$ ;;;; $URL$ @@ -26,7 +27,7 @@ (when (= result 0) (sb-alien:cast buf sb-alien:c-string)))))) -#+ecl +#+(and ecl (not ecl-bytecmp)) (progn #-:wsock (ffi:clines @@ -548,10 +549,6 @@ (sb-alien:define-alien-routine ("WSACreateEvent" wsa-event-create) ws-event) ; return type only - (sb-alien:define-alien-routine ("WSAResetEvent" wsa-event-reset) - (boolean #.sb-vm::n-machine-word-bits) - (event-object ws-event)) - (sb-alien:define-alien-routine ("WSACloseEvent" wsa-event-close) (boolean #.sb-vm::n-machine-word-bits) (event-object ws-event)) @@ -716,7 +713,7 @@ (declare (ignore wl w))) ) ; progn -#+(and ecl win32) +#+(and ecl win32 (not ecl-bytecmp)) (progn (defun maybe-wsa-error (rv &optional syscall) (unless (zerop rv) Modified: usocket/trunk/usocket.asd ============================================================================== --- usocket/trunk/usocket.asd Sat Nov 17 17:44:09 2012 (r699) +++ usocket/trunk/usocket.asd Sat Dec 8 08:35:12 2012 (r700) @@ -16,20 +16,22 @@ (:module "vendor" :depends-on ("package") :components ((:file "split-sequence") #+mcl (:file "kqueue") - (:file "spawn-thread"))) - (:file "usocket" :depends-on ("vendor")) - (:file "condition" :depends-on ("usocket")) + (:file "spawn-thread"))) + (:file "usocket" :depends-on ("vendor")) + (:file "condition" :depends-on ("usocket")) (:module "backend" :depends-on ("condition") :components (#+abcl (:file "abcl") #+clisp (:file "clisp") #+cmu (:file "cmucl") #+scl (:file "scl") - #+(or sbcl ecl) (:file "sbcl") + #+ecl (:file "ecl") + #+(or sbcl ecl) (:file "sbcl" + :depends-on (#+ecl "ecl")) #+lispworks (:file "lispworks") #+mcl (:file "mcl") #+openmcl (:file "openmcl") #+allegro (:file "allegro"))) - (:file "option" :depends-on ("backend")) + (:file "option" :depends-on ("backend")) (:file "server" :depends-on ("backend" "option")))) (defmethod perform ((op test-op) (c (eql (find-system :usocket))))