Ignore:
Timestamp:
Oct 14, 2008, 2:00:40 AM (11 years ago)
Author:
gb
Message:

Stop wrapping (pseudo) file-descriptors around Windows file handlers;
there seem to be cases where this definitely loses, because the MSVCRT
runtime tries to flush buffers associated with (e.g.) a listening socket
when it's closed, and we often have to do I/O in Windows-specific ways
and can't always use the C runtime, anyway.

Handles are (depending on which function you're dealing with) either
pointers or pointer-sized integers; they can be used interchangably
with ints on Win32, but porting this change to Win64 may require some
changes (in l1-io.lisp, in the PIPE function, perhaps elsewhere.)

Supporting this requires some changss in the kernel (mostly in
windows-calls.c) To bootstrap it, most of the I/O functions in
that file assume that very small integers [0 .. 31] are fds wrapped
around a handle and that anything larger is the handle itself. All
of the actual work done by those functions is done on the handle,
without involving the C runtime.

I'll check in a win32 kernel and image in a few minutes. Mixing
older kernels/images won't work, but I don't want to change the
kernel/image compatibility stuff until this is further along.

SLIME sort of works, but not very reliably yet.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-sockets.lisp

    r11068 r11081  
    6161  )
    6262
    63 (declaim (inline socket-handle))
    64 (defun socket-handle (fd)
    65   #+windows-target (#__get_osfhandle fd)
    66   #-windows-target fd)
    6763
    6864#+windows-target
     
    569565(defun set-socket-fd-blocking (fd block-flag)
    570566  #+windows-target
    571   (let* ((handle (socket-handle fd)))
    572     (rlet ((argp :u_long (if block-flag 0 1)))
    573       (#_ioctlsocket handle #.(u32->s32 #$FIONBIO) argp)))
     567  (rlet ((argp :u_long (if block-flag 0 1)))
     568    (#_ioctlsocket fd #.(u32->s32 #$FIONBIO) argp))
    574569  #-windows-target
    575570  (if block-flag
     
    876871                          (eql res (- #$ENETUNREACH))))
    877872               (- #$EAGAIN)
    878                #+windows-target (if (< res 0)
    879                                   res
    880                                   (progn
    881                                     ;; SLIME still crashes on startup
    882                                     ;; on (at least) win32.
    883                                     ;; This is intended to make it
    884                                     ;; possible to attach GDB and
    885                                     ;; try to see what's going on.
    886                                     #+debug
    887                                     (format t "~& pid = ~d" (getpid))
    888                                     #+debug
    889                                     (sleep 60)
    890                                     (#__open_osfhandle res 0)))
    891                #-windows-target res))))
     873               res))))
    892874    (cond (wait
    893875            (with-eagain fd :input
     
    11931175                     (if (< handle 0)
    11941176                       (%get-winsock-error)
    1195                        (let* ((fd (#__open_osfhandle handle 0)))
    1196                          (if (< fd 0)
    1197                            (prog1
    1198                                (%get-errno)
    1199                              (#_CloseHandle handle))
    1200                            fd)))))
     1177                       handle)))
    12011178
    12021179
     
    12481225
    12491226(defun c_bind (sockfd sockaddr addrlen)
    1250   (check-socket-error (#_bind (socket-handle sockfd) sockaddr addrlen)))
     1227  (check-socket-error (#_bind sockfd sockaddr addrlen)))
    12511228
    12521229
     
    12591236         (exceptfds :fd_set)
    12601237         (tv :timeval :tv_sec 0 :tv_usec 0))
    1261     (let* ((handle (socket-handle sockfd)))
    1262       (fd-zero writefds)
    1263       (fd-zero exceptfds)
    1264       (fd-set handle writefds)
    1265       (fd-set handle exceptfds)
    1266       (when timeout-in-milliseconds
    1267         (multiple-value-bind (seconds milliseconds)
    1268             (floor timeout-in-milliseconds 1000)
    1269           (setf (pref tv :timeval.tv_sec) seconds
    1270                 (pref tv :timeval.tv_usec) (* 1000 milliseconds))))
    1271       (> (#_select 1 (%null-ptr) writefds exceptfds (if timeout-in-milliseconds tv (%null-ptr))) 0))))
     1238    (fd-zero writefds)
     1239    (fd-zero exceptfds)
     1240    (fd-set sockfd writefds)
     1241    (fd-set sockfd exceptfds)
     1242    (when timeout-in-milliseconds
     1243      (multiple-value-bind (seconds milliseconds)
     1244          (floor timeout-in-milliseconds 1000)
     1245        (setf (pref tv :timeval.tv_sec) seconds
     1246              (pref tv :timeval.tv_usec) (* 1000 milliseconds))))
     1247    (> (#_select 1 (%null-ptr) writefds exceptfds (if timeout-in-milliseconds tv (%null-ptr))) 0)))
    12721248     
    12731249     
     
    12811257         (progn
    12821258           (set-socket-fd-blocking sockfd nil)
    1283            (let* ((err (check-socket-error (#_connect (socket-handle sockfd) addr len))))
     1259           (let* ((err (check-socket-error (#_connect sockfd addr len))))
    12841260             (cond ((or (eql err (- #+windows-target #$WSAEINPROGRESS
    12851261                                   
     
    12961272
    12971273(defun c_listen (sockfd backlog)
    1298   (check-socket-error (#_listen (socket-handle sockfd) backlog)))
     1274  (check-socket-error (#_listen sockfd backlog)))
    12991275
    13001276(defun c_accept (sockfd addrp addrlenp)
    13011277  (ignoring-eintr
    1302    (check-socket-error (#_accept (socket-handle sockfd) addrp addrlenp))))
     1278   (check-socket-error (#_accept sockfd addrp addrlenp))))
    13031279
    13041280(defun c_getsockname (sockfd addrp addrlenp)
    1305   (check-socket-error (#_getsockname (socket-handle sockfd) addrp addrlenp)))
     1281  (check-socket-error (#_getsockname sockfd addrp addrlenp)))
    13061282
    13071283(defun c_getpeername (sockfd addrp addrlenp)
    1308   (check-socket-error (#_getpeername (socket-handle sockfd) addrp addrlenp)))
     1284  (check-socket-error (#_getpeername sockfd addrp addrlenp)))
    13091285
    13101286#-windows-target
     
    13141290
    13151291(defun c_sendto (sockfd msgptr len flags addrp addrlen)
    1316   (check-socket-error (#_sendto (socket-handle sockfd) msgptr len flags addrp addrlen)))
     1292  (check-socket-error (#_sendto sockfd msgptr len flags addrp addrlen)))
    13171293
    13181294(defun c_recvfrom (sockfd bufptr len flags addrp addrlenp)
    1319   (check-socket-error (#_recvfrom (socket-handle sockfd) bufptr len flags addrp addrlenp)))
     1295  (check-socket-error (#_recvfrom sockfd bufptr len flags addrp addrlenp)))
    13201296
    13211297(defun c_shutdown (sockfd how)
    1322   (check-socket-error (#_shutdown (socket-handle sockfd) how)))
     1298  (check-socket-error (#_shutdown sockfd how)))
    13231299
    13241300(defun c_setsockopt (sockfd level optname optvalp optlen)
    1325   (check-socket-error (#_setsockopt (socket-handle sockfd) level optname optvalp optlen)))
     1301  (check-socket-error (#_setsockopt sockfd level optname optvalp optlen)))
    13261302
    13271303(defun c_getsockopt (sockfd level optname optvalp optlenp)
    1328   (check-socket-error (#_getsockopt (socket-handle sockfd) level optname optvalp optlenp)))
     1304  (check-socket-error (#_getsockopt sockfd level optname optvalp optlenp)))
    13291305
    13301306#-windows-target
    13311307(defun c_sendmsg (sockfd msghdrp flags)
    1332   (check-socket-error (#_sendmsg (socket-handle sockfd) msghdrp flags)))
     1308  (check-socket-error (#_sendmsg sockfd msghdrp flags)))
    13331309
    13341310#-windows-target
    13351311(defun c_recvmsg (sockfd msghdrp flags)
    1336   (check-socket-error   (#_recvmsg (socket-handle sockfd) msghdrp flags)))
     1312  (check-socket-error   (#_recvmsg sockfd msghdrp flags)))
    13371313
    13381314
Note: See TracChangeset for help on using the changeset viewer.