/[usocket]/usocket/trunk/backend/openmcl.lisp
ViewVC logotype

Diff of /usocket/trunk/backend/openmcl.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 714 by ctian, Tue Feb 19 05:23:09 2013 UTC revision 715 by ctian, Wed Apr 17 07:46:44 2013 UTC
# Line 42  Line 42 
42        (let ((max-fd -1))        (let ((max-fd -1))
43          (dolist (sock sockets)          (dolist (sock sockets)
44            (let ((fd (openmcl-socket:socket-os-fd (socket sock))))            (let ((fd (openmcl-socket:socket-os-fd (socket sock))))
45              (setf max-fd (max max-fd fd))              (when fd ;; may be NIL if closed
46              (ccl::fd-set fd infds)))                (setf max-fd (max max-fd fd))
47          (let* ((res (#_select (1+ max-fd)                (ccl::fd-set fd infds))))
48                                infds (ccl::%null-ptr) (ccl::%null-ptr)          (let ((res (#_select (1+ max-fd)
49                                (if ticks-to-wait tv (ccl::%null-ptr)))))                               infds (ccl::%null-ptr) (ccl::%null-ptr)
50                                 (if ticks-to-wait tv (ccl::%null-ptr)))))
51            (when (> res 0)            (when (> res 0)
52              (dolist (x sockets)              (dolist (sock sockets)
53                (when (ccl::fd-is-set (openmcl-socket:socket-os-fd (socket x))                (let ((fd (openmcl-socket:socket-os-fd (socket sock))))
54                                      infds)                  (when (and fd (ccl::fd-is-set fd infds))
55                  (setf (state x) :READ))))                    (setf (state sock) :READ)))))
56            sockets)))))            sockets)))))
57    
58  (defun raise-error-from-id (condition-id socket real-condition)  (defun raise-error-from-id (condition-id socket real-condition)
# Line 74  Line 75 
75                (nameserver-error (cdr (assoc condition-id                (nameserver-error (cdr (assoc condition-id
76                                              +openmcl-nameserver-error-map+))))                                              +openmcl-nameserver-error-map+))))
77           (if nameserver-error           (if nameserver-error
78             (error nameserver-error :host-or-ip nil)               (if (typep nameserver-error 'serious-condition)
79                     (error nameserver-error :host-or-ip nil)
80                     (signal nameserver-error :host-or-ip nil))
81             (raise-error-from-id condition-id socket condition))))))             (raise-error-from-id condition-id socket condition))))))
82    
83  (defun to-format (element-type protocol)  (defun to-format (element-type protocol)
# Line 135  Line 138 
138                                         :reuse-address reuseaddress                                         :reuse-address reuseaddress
139                                         :local-port port                                         :local-port port
140                                         :backlog backlog                                         :backlog backlog
141                                         :format (to-format element-type))                                         :format (to-format element-type :stream))
142                                   (when (ip/= host *wildcard-host*)                                   (when (ip/= host *wildcard-host*)
143                                     (list :local-host real-host)))))))                                     (list :local-host real-host)))))))
144      (make-stream-server-socket sock :element-type element-type)))      (make-stream-server-socket sock :element-type element-type)))

Legend:
Removed from v.714  
changed lines
  Added in v.715

  ViewVC Help
Powered by ViewVC 1.1.5