Changeset 10574

Show
Ignore:
Timestamp:
08/27/08 05:49:04 (3 months ago)
Author:
gb
Message:

More changes to ease Windows bootstrapping - error returns, socket fds
vs handles, etc.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/source/level-1/l1-sockets.lisp

    r10544 r10574  
    4848            SOCKET-ERROR-IDENTIFIER 
    4949            SOCKET-ERROR-SITUATION 
    50             WITH-OPEN-SOCKET))) 
     50            WITH-OPEN-SOCKET)) 
     51  #+windows-target 
     52  (defmacro check-winsock-error (form) 
     53    (let* ((val (gensym))) 
     54      `(let* ((,val ,form)) 
     55        (if (< ,val 0) 
     56          (%get-winsock-error) 
     57          ,val)))) 
     58  (defmacro check-socket-error (form) 
     59    #+windows-target `(check-winsock-error ,form) 
     60    #-windows-target `(int-errno-call ,form)) 
     61  ) 
     62 
     63(declaim (inline socket-handle)) 
     64(defun socket-handle (fd) 
     65  #+windows-target (#__get_osfhandle fd) 
     66  #-windows-target fd) 
     67 
     68#+windows-target 
     69(defun %get-winsock-error () 
     70  (- (#_WSAGetLastError))) 
    5171 
    5272;;; The PPC is big-endian (uses network byte order), which makes 
    …… 
    11951215 
    11961216(defun c_socket_1 (domain type protocol) 
    1197   (int-errno-call (#_socket domain type protocol))) 
     1217  #-windows-target (int-errno-call (#_socket domain type protocol)) 
     1218  #+windows-target (let* ((handle (#_socket domain type protocol))) 
     1219                     (if (< handle 0) 
     1220                       (%get-winsock-error) 
     1221                       (let* ((fd (#__open_osfhandle handle 0))) 
     1222                         (if (< fd 0) 
     1223                           (progn 
     1224                             (#_CloseHandle handle) 
     1225                             (%get-errno)) 
     1226                           fd))))) 
     1227 
     1228 
    11981229 
    11991230(defun c_socket (domain type protocol) 
    …… 
    12411272 
    12421273(defun c_bind (sockfd sockaddr addrlen) 
    1243   (int-errno-call (#_bind sockfd sockaddr addrlen))) 
     1274  (check-socket-error (#_bind (socket-handle sockfd) sockaddr addrlen))) 
    12441275 
    12451276 
    …… 
    12531284         (progn 
    12541285           (fd-set-flags sockfd (logior flags #$O_NONBLOCK)) 
    1255            (let* ((err (int-errno-call (#_connect sockfd addr len)))) 
     1286           (let* ((err (check-socket-error (#_connect (socket-handle sockfd) addr len)))) 
    12561287             (cond ((or (eql err (- #$EINPROGRESS)) (eql err (- #$EINTR))) 
    12571288                    (if (process-output-wait sockfd timeout-in-milliseconds) 
    …… 
    12621293 
    12631294(defun c_listen (sockfd backlog) 
    1264   (int-errno-call (#_listen sockfd backlog))) 
     1295  (check-socket-error (#_listen (socket-handle sockfd) backlog))) 
    12651296 
    12661297(defun c_accept (sockfd addrp addrlenp) 
    12671298  (ignoring-eintr 
    1268    (int-errno-call (#_accept sockfd addrp addrlenp)))) 
     1299   (check-socket-error (#_accept (socket-handle sockfd) addrp addrlenp)))) 
    12691300 
    12701301(defun c_getsockname (sockfd addrp addrlenp) 
    1271   (int-errno-call (#_getsockname sockfd addrp addrlenp))) 
     1302  (check-socket-error (#_getsockname (socket-handle sockfd) addrp addrlenp))) 
    12721303 
    12731304(defun c_getpeername (sockfd addrp addrlenp) 
    1274   (int-errno-call (#_getpeername sockfd addrp addrlenp))) 
     1305  (check-socket-error (#_getpeername (socket-handle sockfd) addrp addrlenp))) 
    12751306 
    12761307(defun c_socketpair (domain type protocol socketsptr) 
    1277   (int-errno-call (#_socketpair domain type protocol socketsptr))) 
     1308  (check-socket-error (#_socketpair domain type protocol socketsptr))) 
    12781309 
    12791310 
    12801311(defun c_sendto (sockfd msgptr len flags addrp addrlen) 
    1281   (int-errno-call (#_sendto sockfd msgptr len flags addrp addrlen))) 
     1312  (check-socket-error (#_sendto (socket-handle sockfd) msgptr len flags addrp addrlen))) 
    12821313 
    12831314(defun c_recvfrom (sockfd bufptr len flags addrp addrlenp) 
    1284   (int-errno-call (#_recvfrom sockfd bufptr len flags addrp addrlenp))) 
     1315  (check-socket-error (#_recvfrom (socket-handle sockfd) bufptr len flags addrp addrlenp))) 
    12851316 
    12861317(defun c_shutdown (sockfd how) 
    1287   (int-errno-call (#_shutdown sockfd how))) 
     1318  (check-socket-error (#_shutdown (socket-handle sockfd) how))) 
    12881319 
    12891320(defun c_setsockopt (sockfd level optname optvalp optlen) 
    1290   (int-errno-call (#_setsockopt sockfd level optname optvalp optlen))) 
     1321  (check-socket-error (#_setsockopt (socket-handle sockfd) level optname optvalp optlen))) 
    12911322 
    12921323(defun c_getsockopt (sockfd level optname optvalp optlenp) 
    1293   (int-errno-call (#_getsockopt sockfd level optname optvalp optlenp))) 
     1324  (check-socket-error (#_getsockopt (socket-handle sockfd) level optname optvalp optlenp))) 
    12941325 
    12951326(defun c_sendmsg (sockfd msghdrp flags) 
    1296   (int-errno-call (#_sendmsg sockfd msghdrp flags))) 
     1327  (check-socket-error (#_sendmsg (socket-handle sockfd) msghdrp flags))) 
    12971328 
    12981329(defun c_recvmsg (sockfd msghdrp flags) 
    1299   (int-errno-call   (#_recvmsg sockfd msghdrp flags))) 
     1330  (check-socket-error   (#_recvmsg (socket-handle sockfd) msghdrp flags))) 
    13001331  
    13011332;;; Return a list of currently configured interfaces, a la ifconfig.