Changeset 11081 for trunk/source/level-1


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.

Location:
trunk/source/level-1
Files:
3 edited

Legend:

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

    r10894 r11081  
    9797  (let* ((encoding (lookup-character-encoding *terminal-character-encoding-name*))
    9898         (encoding-name (if encoding (character-encoding-name encoding))))
    99     (setq *stdin* (make-fd-stream 0
     99    (setq *stdin* (make-fd-stream #-windows-target 0
     100                                  #+windows-target (%ptr-to-int
     101                                                    (#_GetStdHandle #$STD_INPUT_HANDLE))
    100102                                  :basic t
    101103                                  :sharing :lock
     
    103105                                  :interactive (not *batch-flag*)
    104106                                  :encoding encoding-name))
    105     (setq *stdout* (make-fd-stream 1 :basic t :direction :output :sharing :lock :encoding encoding-name))
    106 
    107     (setq *stderr* (make-fd-stream 2 :basic t :direction :output :sharing :lock :encoding encoding-name))
     107    (setq *stdout* (make-fd-stream #-windows-target 1
     108                                   #+windows-target (%ptr-to-int
     109                                                     (#_GetStdHandle #$STD_OUTPUT_HANDLE))
     110                                   :basic t :direction :output :sharing :lock :encoding encoding-name))
     111
     112    (setq *stderr* (make-fd-stream #-windows-target 2
     113                                   #+windows-target (%ptr-to-int
     114                                                     (#_GetStdHandle #$STD_ERROR_HANDLE))
     115                    :basic t :direction :output :sharing :lock :encoding encoding-name))
    108116    (if *batch-flag*
    109117      (let* ((tty-fd
  • 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
  • trunk/source/level-1/linux-files.lisp

    r10897 r11081  
    406406
    407407
    408 (defun %file-kind (mode)
     408(defun %file-kind (mode &optional fd)
     409  (declare (ignorable fd))
    409410  (when mode
    410411    (let* ((kind (logand mode #$S_IFMT)))
     
    413414            #-windows-target
    414415            ((eql kind #$S_IFLNK) :link)
    415             ((eql kind #$S_IFIFO) :pipe)
     416            ((eql kind #$S_IFIFO)
     417             #-windows-target :pipe
     418             ;; Windows doesn't seem to be able to distinguish between
     419             ;; sockets and pipes.  Since this function is currently
     420             ;; (mostly) used for printing streams and since we've
     421             ;; already done something fairly expensive (stat, fstat)
     422             ;; to get here.  try to distinguish between pipes and
     423             ;; sockets by calling #_getsockopt.  If that succeeds,
     424             ;; we've got a socket; otherwise, we're probably got a pipe.
     425             #+windows-target (rlet ((ptype :int)
     426                                     (plen :int 4))
     427                                (if (and fd (eql 0 (#_getsockopt fd #$SOL_SOCKET #$SO_TYPE  ptype plen)))
     428                                    :socket
     429                                    :pipe)))
    416430            #-windows-target
    417431            ((eql kind #$S_IFSOCK) :socket)
     
    425439  (if (isatty fd)
    426440    :tty
    427     (%file-kind (nth-value 1 (%fstat fd)))))
     441    (%file-kind (nth-value 1 (%fstat fd)) fd)))
    428442
    429443#-windows-target
     
    498512#+windows-target
    499513(defun fd-dup (fd &key direction inheritable)
     514  (declare (ignore direction))
    500515  (rlet ((handle #>HANDLE))
    501516    (#_DuplicateHandle (#_GetCurrentProcess)
    502                        (#__get_osfhandle fd)
     517                       fd
    503518                       (#_GetCurrentProcess)
    504519                       handle
    505520                       0
    506521                       (if inheritable #$TRUE #$FALSE)
    507                        #$DUPLICATE_SAME_ACCESS)
    508     (#__open_osfhandle (pref handle #>HANDLE) (case direction
    509                                                 (:input #$O_RDONLY)
    510                                                 (:output #$O_WRONLY)
    511                                                 (t #$O_RDWR)))))
     522                       #$DUPLICATE_SAME_ACCESS)))
    512523                       
    513524
    514525(defun fd-fsync (fd)
    515   #+windows-target (progn fd 0)
     526  #+windows-target (#_FlushFileBuffers fd)
    516527  #-windows-target
    517528  (int-errno-call (#_fsync fd)))
     
    16081619      (setf (pref si #>STARTUPINFO.wShowWindow) #$SW_HIDE)
    16091620      (setf (pref si #>STARTUPINFO.hStdInput)
    1610             (%int-to-ptr (#__get_osfhandle (or new-in 0))))
     1621            (if new-in
     1622              (%int-to-ptr new-in)
     1623              (#_GetStdHandle #$STD_INPUT_HANDLE)))
    16111624      (setf (pref si #>STARTUPINFO.hStdOutput)
    1612             (%int-to-ptr (#__get_osfhandle (or new-out 1))))
     1625            (if new-out
     1626              (%int-to-ptr new-out)
     1627              (#_GetStdHandle #$STD_OUTPUT_HANDLE)))
    16131628      (setf (pref si #>STARTUPINFO.hStdError)
    1614             (%int-to-ptr (#__get_osfhandle (or new-err 2))))
     1629            (if new-err
     1630              (%int-to-ptr new-err)
     1631              (#_GetStdHandle #$STD_ERROR_HANDLE)))
    16151632      (if (zerop (#_CreateProcessW (%null-ptr)
    16161633                                   command
Note: See TracChangeset for help on using the changeset viewer.