(define (open-output-fd fd)
  (let ((port (open-output-file* fd)))
    (make-output-port
     (lambda (buffer)
       (let loop ((buffer buffer) (len (string-length buffer)))
         (thread-wait-for-i/o! fd #:output)
         (let ((written (file-write fd buffer)))
           (unless (= written len)
             (loop (substring buffer written len) (- len written))))))
     (lambda ()
       (close-output-port port))
     (lambda ()
       (flush-output port)))))