+ (if arg1
+ (fd-stream-set-file-position fd-stream arg1)
+ (fd-stream-get-file-position fd-stream)))))
+
+;; FIXME: Think about this.
+;;
+;; (defun finish-fd-stream-output (fd-stream)
+;; (let ((timeout (fd-stream-timeout fd-stream)))
+;; (loop while (fd-stream-output-later fd-stream)
+;; ;; FIXME: SIGINT while waiting for a timeout will
+;; ;; cause a timeout here.
+;; do (when (and (not (serve-event timeout)) timeout)
+;; (signal-timeout 'io-timeout
+;; :stream fd-stream
+;; :direction :write
+;; :seconds timeout)))))
+
+(defun finish-fd-stream-output (stream)
+ (flush-output-buffer stream)
+ (do ()
+ ((null (fd-stream-output-later stream)))
+ (serve-all-events)))
+
+(defun fd-stream-get-file-position (stream)
+ (declare (fd-stream stream))
+ (without-interrupts
+ (let ((posn (sb!unix:unix-lseek (fd-stream-fd stream) 0 sb!unix:l_incr)))
+ (declare (type (or (alien sb!unix:off-t) null) posn))
+ ;; We used to return NIL for errno==ESPIPE, and signal an error
+ ;; in other failure cases. However, CLHS says to return NIL if
+ ;; the position cannot be determined -- so that's what we do.
+ (when (integerp posn)
+ ;; Adjust for buffered output: If there is any output
+ ;; buffered, the *real* file position will be larger
+ ;; than reported by lseek() because lseek() obviously
+ ;; cannot take into account output we have not sent
+ ;; yet.
+ (dolist (later (fd-stream-output-later stream))
+ (incf posn (- (caddr later) (cadr later))))
+ (incf posn (fd-stream-obuf-tail stream))
+ ;; Adjust for unread input: If there is any input
+ ;; read from UNIX but not supplied to the user of the
+ ;; stream, the *real* file position will smaller than
+ ;; reported, because we want to look like the unread
+ ;; stuff is still available.
+ (decf posn (- (fd-stream-ibuf-tail stream)
+ (fd-stream-ibuf-head stream)))
+ (when (fd-stream-unread stream)
+ (decf posn))
+ ;; Divide bytes by element size.
+ (truncate posn (fd-stream-element-size stream))))))
+
+(defun fd-stream-set-file-position (stream position-spec)
+ (declare (fd-stream stream))
+ (check-type position-spec
+ (or (alien sb!unix:off-t) (member nil :start :end))
+ "valid file position designator")
+ (tagbody
+ :again
+ ;; Make sure we don't have any output pending, because if we
+ ;; move the file pointer before writing this stuff, it will be
+ ;; written in the wrong location.
+ (finish-fd-stream-output stream)
+ ;; Disable interrupts so that interrupt handlers doing output
+ ;; won't screw us.
+ (without-interrupts
+ (unless (fd-stream-output-finished-p stream)
+ ;; We got interrupted and more output came our way during
+ ;; the interrupt. Wrapping the FINISH-FD-STREAM-OUTPUT in
+ ;; WITHOUT-INTERRUPTS gets nasty as it can signal errors,
+ ;; so we prefer to do things like this...
+ (go :again))
+ ;; Clear out any pending input to force the next read to go to
+ ;; the disk.
+ (setf (fd-stream-unread stream) nil
+ (fd-stream-ibuf-head stream) 0
+ (fd-stream-ibuf-tail stream) 0)
+ ;; Trash cached value for listen, so that we check next time.
+ (setf (fd-stream-listen stream) nil)
+ ;; Now move it.
+ (multiple-value-bind (offset origin)
+ (case position-spec
+ (:start
+ (values 0 sb!unix:l_set))
+ (:end
+ (values 0 sb!unix:l_xtnd))
+ (t
+ (values (* position-spec (fd-stream-element-size stream))
+ sb!unix:l_set)))
+ (declare (type (alien sb!unix:off-t) offset))
+ (let ((posn (sb!unix:unix-lseek (fd-stream-fd stream)
+ offset origin)))
+ ;; CLHS says to return true if the file-position was set
+ ;; succesfully, and NIL otherwise. We are to signal an error
+ ;; only if the given position was out of bounds, and that is
+ ;; dealt with above. In times past we used to return NIL for
+ ;; errno==ESPIPE, and signal an error in other cases.
+ ;;
+ ;; FIXME: We are still liable to signal an error if flushing
+ ;; output fails.
+ (return-from fd-stream-set-file-position
+ (typep posn '(alien sb!unix:off-t))))))))