Author: ehuelsmann Date: Mon Jun 16 17:31:21 2008 New Revision: 344

Modified: usocket/branches/new-wfi/backend/lispworks.lisp usocket/branches/new-wfi/usocket.lisp Log: Fix general usocket breakage and lispworks/non-win32.

Modified: usocket/branches/new-wfi/backend/lispworks.lisp ============================================================================== --- usocket/branches/new-wfi/backend/lispworks.lisp (original) +++ usocket/branches/new-wfi/backend/lispworks.lisp Mon Jun 16 17:31:21 2008 @@ -185,7 +185,7 @@ ;; unfortunately, it's impossible to share code between ;; non-win32 and win32 platforms... ;; Can we have a sane -pref. complete [UDP!?]- API next time, please? - (dolist (x (wait-list wait-list)) + (dolist (x (wait-list-waiters wait-list)) (mp:notice-fd (os-socket-handle x))) (mp:process-wait-with-timeout "Waiting for a socket to become active" (truncate timeout) @@ -195,8 +195,8 @@ (when (usocket-listen x) (setf (state x) :READ rv t))))) - (wait-list wait-list)) - (dolist (x (wait-list wait-list)) + (wait-list-waiters wait-list)) + (dolist (x (wait-list-waiters wait-list)) (mp:unnotice-fd (os-socket-handle x))) wait-list)))

Modified: usocket/branches/new-wfi/usocket.lisp ============================================================================== --- usocket/branches/new-wfi/usocket.lisp (original) +++ usocket/branches/new-wfi/usocket.lisp Mon Jun 16 17:31:21 2008 @@ -215,10 +215,10 @@

(defstruct (wait-list (:constructor %make-wait-list)) - (%wait ;; implementation specific - wait-list ;; the list of all usockets - wait-map ;; maps implementation sockets to usockets - )) + %wait ;; implementation specific + waiters ;; the list of all usockets + map ;; maps implementation sockets to usockets + )

;; Implementation specific: ;; @@ -232,22 +232,22 @@

(defun make-wait-list (waiters) (let ((wl (%make-wait-list))) - (setf (wait-map wl) (make-hash-table)) + (setf (wait-list-map wl) (make-hash-table)) (%setup-wait-list wl) (dolist (x waiters) (add-waiter wl x)) wl))

(defun add-waiter (wait-list input) - (setf (gethash (socket input) (wait-map wait-list)) input) - (pushnew input (wait-list wait-list)) + (setf (gethash (socket input) (wait-list-map wait-list)) input) + (pushnew input (wait-list-waiters wait-list)) (%add-waiter wait-list input))

(defun remove-waiter (wait-list input) (%remove-waiter wait-list input) - (setf (wait-list wait-list) - (remove input (wait-list wait-list))) - (remhash (socket input) (wait-map wait-list))) + (setf (wait-list-waiters wait-list) + (remove input (wait-list-waiters wait-list))) + (remhash (socket input) (wait-list-map wait-list)))

@@ -275,7 +275,7 @@ (values (if ready-only socks socket-or-sockets) to))))) (let* ((start (get-internal-real-time)) (sockets-ready 0)) - (dolist (x (wait-list sockets)) + (dolist (x (wait-list-waiters sockets)) (when (setf (state x) (if (and (stream-usocket-p x) (listen (socket-stream x))) @@ -293,7 +293,7 @@ (when (< elapsed timeout) (- timeout elapsed)))))) (values (if ready-only - (remove-if #'null (wait-list socket-or-sockets) :key #'state) + (remove-if #'null (wait-list-waiters socket-or-sockets) :key #'state) socket-or-sockets) to-result))))

@@ -301,13 +301,13 @@ ;; Data utility functions ;;

-(defun integer-to-octready-et-buffer (integer buffer octets &key (start 0)) +(defun integer-to-octet-buffer (integer buffer octets &key (start 0)) (do ((b start (1+ b)) (i (ash (1- octets) 3) ;; * 8 (- i 8))) ((> 0 i) buffer) (setf (aref buffer b) - (ldb (byteready- 8 i) integer)))) + (ldb (byte 8 i) integer))))

(defun octet-buffer-to-integer (buffer octets &key (start 0)) (let ((integer 0)) @@ -423,7 +423,7 @@ (when hosts (elt hosts (random (length hosts))))))

- (defun host-toready--vector-quad (host) + (defun host-to-vector-quad (host) "Translate a host specification (vector quad, dotted quad or domain name) to a vector quad." (etypecase host @@ -470,7 +470,6 @@ ;; ;; (defun SOCKET-CONNECT (host port &key element-type) ..) ;; -ready-ready- (setf (documentation 'socket-connect 'function) "Connect to `host' on `port'. `host' is assumed to be a string or an IP address represented in vector notation, such as #(192 168 1 1). @@ -501,4 +500,4 @@ streams to be created by `socket-accept'. `reuseaddress' is supported for backward compatibility (but deprecated); when both `reuseaddress' and `reuse-address' have been specified, the latter takes precedence. -")ready-ready- +")