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

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Fri Feb  3 15:26:05 2006
New Revision: 29

Modified:
   usocket/trunk/backend/clisp.lisp
   usocket/trunk/condition.lisp
Log:
Make clisp error translation work.

Modified: usocket/trunk/backend/clisp.lisp
==============================================================================
--- usocket/trunk/backend/clisp.lisp	(original)
+++ usocket/trunk/backend/clisp.lisp	Fri Feb  3 15:26:05 2006
@@ -5,22 +5,45 @@
 
 (in-package :usocket)
 
+(defun remap-maybe-for-win32 (z &optional errorp)
+  (mapcar #'(lambda (x)
+              (list #-win32 (car x)
+                    #+win32 (mapcar #'(lambda (y)
+                                        (+ 10000 y))
+                                    (car x))
+                    (cdr x)
+                    errorp))
+          z))
+
+(defparameter +clisp-error-map+
+  (append (remap-maybe-for-win32 +unix-errno-condition-map+)
+          (remap-maybe-for-win32 +unix-errno-error-map+ t)))
+
 (defun handle-condition (condition &optional (socket nil))
   "Dispatch correct usocket condition."
   (typecase condition
-    (condition (error 'usocket-error
-                      :real-condition condition
-                      :socket socket))))
+    (system::simple-os-error
+       (destructuring-bind
+           (&optional usock-err errorp)
+           (cdr (assoc (car (system::$format-arguments))
+                       +clisp-error-map+))
+         (if usock-err
+             (if errorp
+                 (error usock-err :socket socket)
+               (signal usock-err :socket socket))
+           (error 'usocket-unkown-error
+                  :socket socket
+                  :real-error condition))))))
 
 (defun socket-connect (host port &optional (type :stream))
   (declare (ignore type))
-  (let ((socket (socket:socket-connect port host
+  (let ((socket (socket:socket-connect port (host-to-hostname host)
                                        :element-type 'character
                                        :buffered t)))
     (make-socket :socket socket
-                 :stream socket ;; the socket is a stream too
-                 :host host
-                 :port port))
+                 :stream socket))) ;; the socket is a stream too
+;;                 :host host
+;;                 :port port))
 
 (defmethod socket-close ((usocket usocket))
   "Close socket."

Modified: usocket/trunk/condition.lisp
==============================================================================
--- usocket/trunk/condition.lisp	(original)
+++ usocket/trunk/condition.lisp	Fri Feb  3 15:26:05 2006
@@ -82,9 +82,9 @@
      (condition (condition) (handle-condition condition ,socket))))
 
 (defparameter +unix-errno-condition-map+
-  `((11 . usocket-retry-condition) ;; EAGAIN
-    (35 . usocket-retry-condition) ;; EDEADLCK
-    (4 . usocket-interrupted-condition))) ;; EINTR
+  `(((11) . usocket-retry-condition) ;; EAGAIN
+    ((35) . usocket-retry-condition) ;; EDEADLCK
+    ((4) . usocket-interrupted-condition))) ;; EINTR
 
 (defparameter +unix-errno-error-map+
   ;;### the first column is for non-(linux or srv4) systems
@@ -117,7 +117,7 @@
 
 
 (defun map-errno-condition (errno)
-  (cdr (assoc errno +unix-errno-error-map+)))
+  (cdr (assoc errno +unix-errno-error-map+ :test #'member)))
 
 
 (defun map-errno-error (errno)