[usocket-cvs] r155 - in usocket/trunk: . backend

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Tue Jan 16 15:01:04 2007
New Revision: 155

Modified:
   usocket/trunk/backend/lispworks.lisp
   usocket/trunk/usocket.lisp
Log:
Server socket support for LispWorks.

Modified: usocket/trunk/backend/lispworks.lisp
==============================================================================
--- usocket/trunk/backend/lispworks.lisp	(original)
+++ usocket/trunk/backend/lispworks.lisp	Tue Jan 16 15:01:04 2007
@@ -61,10 +61,30 @@
 ;;                 :host host
 ;;                 :port port))
 
-(defmethod socket-close ((usocket usocket))
+(defun socket-listen (host port &key reuseaddress (backlog 5))
+  ;; backlog ignored; I've mailed LispWorks support, but
+  ;; don't have an answer yet
+  (let* ((comm::*use_so_reuseaddr* reuseaddress)
+         (sock #-lispworks4.1 (comm::create-tcp-socket-for-service
+                               port :address host :backlog backlog)
+               #+lispworks4.1 (comm::create-tcp-socket-for-service port)))
+    (make-stream-server-socket sock)))
+
+(defmethod socket-accept ((usocket stream-server-usocket))
+  (let* ((sock (comm::get-fd-from-socket (socket usocket)))
+         (stream (make-instance 'comm:socket-stream
+                                :socket sock
+                                :direction :io
+                                :element-type (element-type usocket))))
+    (make-stream-socket :socket sock :stream stream)))
+
+(defmethod socket-close ((usocket stream-usocket))
   "Close socket."
   (close (socket-stream usocket)))
 
+(defmethod socket-close ((usocket stream-server-usocket))
+  (comm::close-socket (socket usocket)))
+
 (defmethod get-local-name ((usocket usocket))
   (multiple-value-bind
       (address port)

Modified: usocket/trunk/usocket.lisp
==============================================================================
--- usocket/trunk/usocket.lisp	(original)
+++ usocket/trunk/usocket.lisp	Tue Jan 16 15:01:04 2007
@@ -33,7 +33,8 @@
 (defclass stream-server-usocket (usocket)
   ((element-type
     :initarg :element-type
-    :initform 'character
+    :initform #-lispworks 'character
+              #+lispworks 'base-char
     :reader element-type
     :documentation "Default element type for streams created by
 `socket-accept'."))
@@ -56,7 +57,9 @@
                  :socket socket
                  :stream stream))
 
-(defun make-stream-server-socket (socket &key (element-type 'character))
+(defun make-stream-server-socket (socket &key (element-type
+                                               #-lispworks 'character
+                                               #+lispworks 'base-char))
   "Create a usocket-server socket type from an
 implementation-specific socket object.