Thank you for this explanation, I looked at code and understand that everything is not so simple. And yeah, sorry for the leaking (it accidentally). But now, I thought - why bother to use WSA* function (the comment in win32.lisp) may be easiest to call the wait-for-single-object function on the handle - if the character is available immediately, it will be returned, and if not - nil will be returned (also we can improve the timeout). Short as you have, but without altering the functions bind/close/accept and maintain lists of handles.

This is new version (I left WSA function, just in case):

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :sb-win32)

;;; from winbase.h

(define-alien-routine ("WaitForSingleObject" wait-for-single-object) handle
  (handle handle)
  (milliseconds unsigned-long))

(define-alien-routine ("WaitForMultipleObjects" wait-for-multiple-objects) unsigned-long
  (count unsigned-long)
  (handles (* handle))
  (wait-all long)
  (milliseconds unsigned-long))

;;; from winsock2.h

(define-alien-routine ("WSACreateEvent" wsa-create-event) handle)

(define-alien-routine ("WSAEventSelect" wsa-event-select) int
  (socket handle)
  (event handle)
  (flags long))

(define-alien-routine ("WSACloseEvent" wsa-close-event) int
  (event handle))

(defmacro with-wsa-event (var &body body)
 `(let ((,var (wsa-create-event)))
    (declare (type ,var handle))
    (unwind-protect
        (progn ,@body)
      (wsa-close-event ,var))))

(defconstant +wait-timeout+ #x102)

;;; Listen for input on a Windows file handle.  Unlike UNIX, there
;;; isn't a unified interface to do this---we have to know what sort
;;; of handle we have.  Of course, there's no way to actually
;;; introspect it, so we have to try various things until we find
;;; something that works.  Returns true if there could be input
;;; available, or false if there is not.
(defun handle-listen (handle)
  (with-alien ((avail dword)
               (buf (array char #.input-record-size)))
    (unless (zerop (peek-named-pipe handle nil 0 nil (addr avail) nil))
      (return-from handle-listen (plusp avail)))

    (unless (zerop (peek-console-input handle
                                       (cast buf (* t))
                                       input-record-size (addr avail)))
      (return-from handle-listen (plusp avail)))

    (let ((result (wait-for-single-object handle 0)))
      (when (or (zerop result) (= result +wait-timeout+))
        (return-from handle-listen (zerop result))))

    t))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

And those two tests (which are above) again normal. By the way, what else can be tested?


2010/6/25 Alastair Bridgewater <alastair.bridgewater@gmail.com>
Hello,

I have a very simple answer for you: Maybe.

The reason that I am skeptical of this proposed solution is that I was
always under the impression that the event objects from WSAEventSelect
were edge-triggered, and not level-triggered. If they are
level-triggered, or if the use of WSAEventSelect counts as a rising
edge / sets the event state in a level-triggered fashion, then this
much would be plausible. Perhaps the addition of a call to SLEEP
somewhere in the test code would allow you to confirm that these
events are effectively level-triggered in this scenario?

You're also leaking the event handles like crazy, and this only gets
read-char-no-hang going, ignoring serve-event (a whole other mess, but
useful for SLIME and window-message handling).

I had a more comprehensive, though still not complete solution a few
months before the problem was first noticed by anyone else, but it was
never completed because of the "backdoor" interface required between
sb-bsd-sockets and serve-event. My code for this is available at
http://www.lisphacker.com/temp/new-serve-event.lisp as it has been
since late 2007.

-- Alastair Bridgewater