Changeset 11825 in project


Ignore:
Timestamp:
08/31/08 13:23:36 (13 years ago)
Author:
certainty
Message:

added code to give control to other threads, so sendfile behaves coorporative.
At the moment only read-write-loop/fd and mmapped has this. For sendfile-impl
we need to rewrite the c-code first.

File:
1 edited

Legend:

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

    r11816 r11825  
    5050
    5151(declare
    52  
    5352 (usual-integrations)
    54 
    55  (uses library extras scheduler srfi-13)
     53 (uses extras scheduler srfi-13)
    5654
    5755 (no-procedure-checks-for-usual-bindings)
     
    6765  sendfile:os-dep:sendfile-available?
    6866  sendfile:os-dep:mmap-available?
     67  sendfile:write-timeout
    6968  sendfile))
    7069
     
    157156
    158157
     158;;copied from tcp
     159(define (sendfile:yield)
     160  (##sys#call-with-current-continuation
     161   (lambda (return)
     162     (let ((ct ##sys#current-thread))
     163       (##sys#setslot ct 1 (lambda () (return (##core#undefined))))
     164       (##sys#schedule) ) ) ) )
     165
     166
     167(define sendfile:write-timeout (make-parameter #f))
    159168
    160169;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     
    173182  (define sys-write (foreign-lambda integer "write" integer c-pointer unsigned-integer))
    174183
    175   (define (send-chunk size ptr)
     184  (define (send-chunk size ptr write-timeout)
    176185    (sendfile:madvise ptr size %sendfile:madvise-sequential)
    177186   
     
    183192          (cond
    184193           ((and (negative? result) (= errno/again (##sys#update-errno)))
     194            (when write-timeout
     195              (##sys#thread-block-for-timeout!
     196               ##sys#current-thread
     197               (fx+ (##sys#fudge 16) write-timeout)))
     198            (##sys#thread-block-for-i/o! ##sys#current-thread dst #f)
     199            (sendfile:yield)
     200            (when (##sys#slot ##sys#current-thread 13)
     201              (sendfile:error "write operation timed out"))
    185202            (loop left work-ptr))
    186203           ((negative? result) #f)
     
    193210     (else
    194211      (let* ((next-chunk (sendfile:next-chunk-size len offset))
    195              (mem-file (map-file-to-memory #f next-chunk prot/read (bitwise-ior map/shared map/file) src offset)))
    196         (unless (send-chunk next-chunk (memory-mapped-file-pointer mem-file))
     212             (mem-file (map-file-to-memory #f next-chunk prot/read (bitwise-ior map/shared map/file) src offset))
     213             (write-timeout (sendfile:write-timeout)))
     214        (unless (send-chunk next-chunk (memory-mapped-file-pointer mem-file) write-timeout)
    197215          (unmap-file-from-memory mem-file)
    198216          (##sys#update-errno)
     
    251269  (let* ((buff-size (sendfile:read-write-buffer-size))
    252270         (buffer (make-string buff-size))
     271         (write-timeout (sendfile:write-timeout))
    253272         (write/offset (foreign-lambda* int ((int dst) (c-string buff) (unsigned-integer offset) (unsigned-integer bytes))
    254273                                        "C_return(write(dst,buff + offset,bytes));")))
     
    260279           ((= 0 left) #t)
    261280           ((and (negative? written-bytes) (= errno/again (##sys#update-errno)))
     281            (when write-timeout
     282              (##sys#thread-block-for-timeout!
     283               ##sys#current-thread
     284               (fx+ (##sys#fudge 16) write-timeout)))
     285            (##sys#thread-block-for-i/o! ##sys#current-thread dst #f)
     286            (sendfile:yield)
     287            (when (##sys#slot ##sys#current-thread 13)
     288              (sendfile:error "write operation timed out"))
    262289            (loop left offset)) ;;try again
    263290           ((negative? written-bytes)
Note: See TracChangeset for help on using the changeset viewer.