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))))
