;;;; files for more information.
(in-package "SB!IMPL")
-
-(file-comment
- "$Header$")
\f
#|
;;;; object set stuff
(default-handler #'default-default-handler)))
(:print-object
(lambda (s stream)
- (format stream "#<Object Set ~S>" (object-set-name s)))))
+ (format stream "#<Object Set ~S>" (object-set-name s))))
+ (:copier nil))
name ; Name, for descriptive purposes.
(table (make-hash-table :test 'eq)) ; Message-ID or
; xevent-type --> handler fun.
#!+sb-doc
"Return the handler function in Object-Set for the operation specified by
Message-ID, if none, NIL is returned."
- (check-type object-set object-set)
- (check-type message-id fixnum)
+ (enforce-type object-set object-set)
+ (enforce-type message-id fixnum)
(values (gethash message-id (object-set-table object-set))))
;;; The setf inverse for Object-Set-Operation.
(defun %set-object-set-operation (object-set message-id new-value)
- (check-type object-set object-set)
- (check-type message-id fixnum)
+ (enforce-type object-set object-set)
+ (enforce-type message-id fixnum)
(setf (gethash message-id (object-set-table object-set)) new-value))
|#
;;;; file descriptor I/O noise
(defstruct (handler
- (:constructor make-handler (direction descriptor function)))
+ (:constructor make-handler (direction descriptor function))
+ (:copier nil))
;; Reading or writing...
(direction nil :type (member :input :output))
;; File descriptor this handler is tied to.
"Arange to call FUNCTION whenever FD is usable. DIRECTION should be
either :INPUT or :OUTPUT. The value returned should be passed to
SYSTEM:REMOVE-FD-HANDLER when it is no longer needed."
- (assert (member direction '(:input :output))
- (direction)
- "Invalid direction ~S, must be either :INPUT or :OUTPUT" direction)
+ (unless (member direction '(:input :output))
+ ;; FIXME: should be TYPE-ERROR?
+ (error "Invalid direction ~S, must be either :INPUT or :OUTPUT" direction))
(let ((handler (make-handler direction fd function)))
(push handler *descriptor-handlers*)
handler))
(real
(multiple-value-bind (q r) (truncate (coerce timeout 'single-float))
(declare (type index q) (single-float r))
- (values q (the index (truncate (* r 1f6))))))
+ (values q (the (values index t) (truncate (* r 1f6))))))
(t
(error "Timeout is not a real number or NIL: ~S" timeout))))
(sb!alien:with-alien ((read-fds (sb!alien:struct sb!unix:fd-set))
(write-fds (sb!alien:struct sb!unix:fd-set)))
(let ((count (calc-masks)))
- (multiple-value-bind (value err) (sb!unix:unix-fast-select
- count
- (sb!alien:addr read-fds) (sb!alien:addr write-fds)
- nil to-sec to-usec)
+ (multiple-value-bind (value err)
+ (sb!unix:unix-fast-select count
+ (sb!alien:addr read-fds)
+ (sb!alien:addr write-fds)
+ nil to-sec to-usec)
;; Now see what it was (if anything)
(cond (value