anchor.diff:  (defvar *ps/2-break-control* nil)
   
   (defun ps/2-fifo-empty (fifo)
  -  (eql (ps/2-fifo-head fifo) (ps/2-fifo-tail fifo)))
  +  (with-interrupts-disabled ()
  +    (with-spinlock-held (ps/2-fifo-lock fifo)
  +      (eql (ps/2-fifo-head fifo) (ps/2-fifo-tail fifo)))))
   
   (defun ps/2-pop-fifo (fifo)
     "Pop a byte from FIFO. Returns NIL if FIFO is empty!"
  -  (unless (ps/2-fifo-empty fifo)
  -    (prog1 (aref (ps/2-fifo-buffer fifo) (ps/2-fifo-head fifo))
  -      (incf (ps/2-fifo-head fifo))
  -      (when (>= (ps/2-fifo-head fifo) (length (ps/2-fifo-buffer fifo)))
  -        (setf (ps/2-fifo-head fifo) 0)))))
  +  (with-interrupts-disabled ()
  +    (with-spinlock-held (ps/2-fifo-lock fifo)
  +      (when (try-semaphore (ps/2-fifo-semaphore fifo))
  +        (prog1 (aref (ps/2-fifo-buffer fifo) (ps/2-fifo-head fifo))
  +          (incf (ps/2-fifo-head fifo))
  +          (when (>= (ps/2-fifo-head fifo) (length (ps/2-fifo-buffer fifo)))
  +            (setf (ps/2-fifo-head fifo) 0)))))))
   
   (defun ps/2-read-fifo (fifo &optional timeout)
  -  (loop
  -     (let ((byte (ps/2-pop-fifo fifo)))
  -       (when byte (return byte)))
  -     (cond (timeout
  -            (when (process-wait-with-timeout "PS/2 input" timeout
  -                                             (lambda ()
  -                                               (not (ps/2-fifo-empty fifo))))
  -              (return nil)))
  -           (t (process-wait "PS/2 input"
  -                            (lambda ()
  -                              (not (ps/2-fifo-empty fifo))))))))
  +  (when (wait-on-semaphore (ps/2-fifo-semaphore fifo) :timeout timeout)
  +    ;; There's one byte in the FIFO for us now.
  +    (with-interrupts-disabled ()
  +      (with-spinlock-held (ps/2-fifo-lock fifo)
  +        (assert (not (eql (ps/2-fifo-head fifo) (ps/2-fifo-tail fifo))) (fifo)
  +                "FIFO empty after sem down?")
  +        (prog1 (aref (ps/2-fifo-buffer fifo) (ps/2-fifo-head fifo))
  +          (incf (ps/2-fifo-head fifo))
  +          (when (>= (ps/2-fifo-head fifo) (length (ps/2-fifo-buffer fifo)))
  +            (setf (ps/2-fifo-head fifo) 0)))))))
   
   (defclass ps/2-keyboard-stream (sys.gray:fundamental-character-input-stream sys.gray:unread-char-mixin) ())
   
  
positive.code:   (head 0 :type fixnum)
    (tail 0 :type fixnum)
    (buffer (make-array 500 :element-type '(unsigned-byte 8) :area :static)
            :type (simple-array (unsigned-byte 8) (*))))
  
  (defconstant +ps/2-data-port+ #x60)
  (defconstant +ps/2-control-port+ #x64)
  
negative.code:   (ps/2-read-char *ps/2-key-fifo*))
  
  (defun keyboard-listen (fifo)
    (not (ps/2-fifo-empty fifo)))
  
  (defmethod sys.gray:stream-listen ((stream ps/2-keyboard-stream))
    (keyboard-listen *ps/2-key-fifo*))
  