Changeset 11952 in project


Ignore:
Timestamp:
09/15/08 20:26:22 (13 years ago)
Author:
certainty
Message:

add support for write-timeout
add code to be nicer in multi-threaded envs (mostly taken form unit tcp)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/sendfile/trunk/sendfile.scm

    r11950 r11952  
    134134  (define *last-selected-implementation* #f)
    135135
    136 
     136  (define write-timeout (make-parameter #f))
     137
     138  ;;copied from tcp
     139  (define (%yield)
     140    (##sys#call-with-current-continuation
     141     (lambda (return)
     142       (let ((ct ##sys#current-thread))
     143         (##sys#setslot ct 1 (lambda () (return (##core#undefined))))
     144         (##sys#schedule) ) ) ) )
    137145
    138146;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     
    190198    (define sys:write (foreign-lambda integer "write" integer c-pointer unsigned-integer))
    191199
    192     (define (send-chunk ptr size)
     200    (define (send-chunk ptr size write-timeout)
    193201      ;;don't bother adivices for data smaller than 64k
    194202      (when (> size (kilobytes 64)) (%madvise ptr size %madvise-will-need))
     
    199207              (cond
    200208               ((and (negative? result) (= errno/again (##sys#update-errno)))
     209                (when write-timeout
     210                  (##sys#thread-block-for-timeout!
     211                   ##sys#current-thread
     212                   (fx+ (##sys#fudge 16) write-timeout)))
     213                (##sys#thread-block-for-i/o! ##sys#current-thread dst #f)
     214                (%yield)
     215                (when (##sys#slot ##sys#current-thread 13)
     216                  (%error "write operation timed out"))
    201217                (loop bytes-left work-ptr)) ;retry
    202218               ((negative? result) #f)
     
    210226         (else
    211227          (let* ((next-chunk (%next-chunk-size len offset))
    212                  (mem-file (map-file-to-memory #f next-chunk prot/read map/shared src offset)))
    213             (unless (send-chunk (memory-mapped-file-pointer mem-file) next-chunk)
     228                 (mem-file (map-file-to-memory #f next-chunk prot/read map/shared src offset))
     229                 (write-timeout (write-timeout)))
     230            (unless (send-chunk (memory-mapped-file-pointer mem-file) next-chunk write-timeout)
    214231              (unmap-file-from-memory mem-file)
    215232              (##sys#update-errno)
     
    265282    (let* ((buffsize (read-write-buffer-size))
    266283           (buffer (make-string buffsize))
     284           (write-timeout (write-timeout))
    267285           (write/offset (foreign-lambda* int ((int dst) (c-string buff) (unsigned-integer offset) (unsigned-integer bytes))
    268286                                          "C_return(write(dst,buff + offset,bytes));"))
     
    273291                               ((zero? left) #t)
    274292                               ((and (negative? written-bytes) (= errno/again (##sys#update-errno)))
     293                                (when write-timeout
     294                                  (##sys#thread-block-for-timeout!
     295                                   ##sys#current-thread
     296                                   (fx+ (##sys#fudge 16) write-timeout)))
     297                                (##sys#thread-block-for-i/o! ##sys#current-thread dst #f)
     298                                (%yield)
     299                                (when (##sys#slot ##sys#current-thread 13)
     300                                  (%error "write operation timed out"))
    275301                                (loop left offset))
    276302                               ((negative? written-bytes)
Note: See TracChangeset for help on using the changeset viewer.