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)