Changeset 11816 in project


Ignore:
Timestamp:
08/30/08 21:46:20 (13 years ago)
Author:
certainty
Message:

cleaned up the source
added a ports-only version of read-write-loop and adjusted the main-interface to choose this version
if a port is passed that has no underlying fd.
adjusted unit-tests and added new test for ports-only version
The last selected implementation is no set by the implementations instead of the dispatcher.
This simplified the source.

Location:
release/3/sendfile/trunk
Files:
3 edited

Legend:

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

    r10955 r11816  
    6363  sendfile:mmapped
    6464  sendfile:sendfile
    65   sendfile:read-write-loop
     65  sendfile:read-write-loop/port
     66  sendfile:read-write-loop/fd
    6667  sendfile:os-dep:sendfile-available?
    6768  sendfile:os-dep:mmap-available?
     
    7273EOL
    7374)
     75(use posix lolevel srfi-4)
    7476
    7577(define strerror (foreign-lambda c-string "strerror" int))
    7678
    77 (use posix lolevel srfi-4)
     79
    7880
    7981;;what type of system do we have?
     
    126128
    127129
     130(define (make-exn-condition location message arguments)
     131  (apply make-property-condition
     132    'exn
     133    (append
     134     (if location (list 'location location) '())
     135     (if message (list 'message message) '())
     136     (if (and arguments (not (null? arguments))) (list 'arguments arguments) '()))) )
     137
     138(define (make-sendfile-condition location message arguments)
     139  (make-composite-condition
     140   (make-exn-condition location message arguments)
     141   (make-property-condition 'sendfile)) )
     142
     143(define (errno-argument)
     144  (let ((err (errno)))
     145    (if (zero? err)
     146        '()
     147        (let ((str (strerror err)))
     148          (if (or (not str) (zero? (string-length str)))
     149              (list (number->string err))
     150              (list str) ) ) ) ) )
     151
     152(define (sendfile:error msg . args)
     153  (abort (make-sendfile-condition #f msg (append (errno-argument) args))))
     154
     155
     156(define *sendfile:last-selected-implementation* #f)
     157
     158
     159
     160;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     161;; Implementations
     162;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     163
    128164;;posix mmapped send
    129165;;as we're working with non-blocking IO
    130166;;EAGAIN is equal to EWOULDBLOCK
    131167(define (sendfile:mmapped src dst len)
     168  (set!  *sendfile:last-selected-implementation* 'mmapped)
     169 
    132170  (unless sendfile:os-dep:mmap-available?
    133171    (sendfile:error "mmap is not available on this system"))
     
    169207;;MAKE THE WRITE LOOP AN INNER LOOP
    170208;;SO THAT ONLY THE ACTUAL SYSCALL IS REDONE AND NOT THE CALCULATION
    171 (define (sendfile:sendfile src dst len)
     209(define (sendfile:sendfile src dst len )
     210  (set!  *sendfile:last-selected-implementation* 'sendfile)
     211 
    172212  (unless sendfile:os-dep:sendfile-available?
    173213    (sendfile:error "sendfile is not available on this system"))
     214 
    174215  (let loop ((offset 0.0))
    175216    (cond
     
    191232;;TODO: get rid of the copy due to (substring)/ (substring/shared)
    192233
    193 (define (sendfile:read-write-loop src dst len)
     234(define (sendfile:read-write-loop/port src dst len)
     235   (set!  *sendfile:last-selected-implementation* 'read-write-loop)
     236   
     237    (let* ((buffsize (sendfile:read-write-buffer-size))
     238           (buffer (make-string buffsize)))
     239      (let loop ((n len))
     240        (if (not (positive? n))
     241            len
     242            (let* ((to-read (fxmin buffsize (inexact->exact n)))
     243                   (read-bytes (cadr (file-read src to-read buffer))))
     244              (display (substring buffer 0 read-bytes) dst)
     245              (loop (- n read-bytes)))))))
     246
     247 
     248(define (sendfile:read-write-loop/fd src dst len )
     249  (set!  *sendfile:last-selected-implementation* 'read-write-loop)
     250 
    194251  (let* ((buff-size (sendfile:read-write-buffer-size))
    195252         (buffer (make-string buff-size))
     
    221278;;=============================== HIGHER LEVEL INTERFACE =======================================================
    222279
    223 (define *sendfile:last-selected-implementation* #f)
    224 
    225280(define (sendfile:default-selector len)
    226281  (cond
    227    ((< len (* 1024 1024)) ;;below mb we don't bother memory-mapping or sendfile
    228     (set!  *sendfile:last-selected-implementation* 'read-write-loop)
    229     sendfile:read-write-loop)
    230    (sendfile:os-dep:sendfile-available?
    231     (set!  *sendfile:last-selected-implementation* 'sendfile)
    232     sendfile:sendfile)
    233    (sendfile:os-dep:mmap-available?
    234     (set!  *sendfile:last-selected-implementation* 'mmapped)
    235     sendfile:mmapped)
    236    (else
    237     (set!  *sendfile:last-selected-implementation* 'read-write-loop)
    238     sendfile:read-write-loop)))
    239    
    240  
    241 (define sendfile:implementation-selector (make-parameter sendfile:default-selector))
    242 
    243 
    244 (define (sendfile:->filenum obj)
    245   (if (port? obj)
    246       (port->fileno obj)
    247       (if (number? obj)
    248           obj
    249           (sendfile:error "supplied type is neither port nor file-descriptor" obj))))
    250 
    251 (define (make-exn-condition location message arguments)
    252   (apply make-property-condition
    253     'exn
    254     (append
    255      (if location (list 'location location) '())
    256      (if message (list 'message message) '())
    257      (if (and arguments (not (null? arguments))) (list 'arguments arguments) '()))) )
    258 
    259 (define (make-sendfile-condition location message arguments)
    260   (make-composite-condition
    261    (make-exn-condition location message arguments)
    262    (make-property-condition 'sendfile)) )
    263 
    264 (define (errno-argument)
    265   (let ((err (errno)))
    266     (if (zero? err)
    267         '()
    268         (let ((str (strerror err)))
    269           (if (or (not str) (zero? (string-length str)))
    270               (list (number->string err))
    271               (list str) ) ) ) ) )
    272 
    273 (define (sendfile:error msg . args)
    274   (abort (make-sendfile-condition #f msg (append (errno-argument) args))))
    275 
     282   ((< len 1024) sendfile:read-write-loop/fd)
     283   (sendfile:os-dep:sendfile-available? sendfile:sendfile)
     284   (sendfile:os-dep:mmap-available? sendfile:mmapped)
     285   (else sendfile:read-write-loop/fd)))
     286
     287
     288(define (sendfile:port-has-fd? obj)
     289  (unless (port? obj)
     290    (sendfile:error "supplied argument is not a port"))
     291  (handle-exceptions exn #f (port->fileno obj) #t))
     292
     293(define (->fileno obj)
     294    (cond
     295     ((fixnum? obj) obj)
     296     ((port? obj) (port->fileno obj))
     297     (else (sendfile:error "supplied argument is neither port nor descriptor"))))
    276298
    277299;;set to either 'sendfile 'mmapped 'read-write or 'nothing
    278300(define sendfile:force-implementation (make-parameter 'nothing))
    279301
     302(define sendfile:implementation-selector (make-parameter sendfile:default-selector))
     303
    280304(define (sendfile src dst)
    281   (let* ((src (sendfile:->filenum src))
    282          (dst (sendfile:->filenum dst))
    283          (len (file-size src)))
    284      (case (sendfile:force-implementation)
    285        ((sendfile)
    286         (set!  *sendfile:last-selected-implementation* 'sendfile)
    287         (sendfile:sendfile src dst len))
    288        ((mmapped)
    289         (set!  *sendfile:last-selected-implementation* 'mmapped)
    290         (sendfile:mmapped src dst len))
    291        ((read-write)
    292         (set!  *sendfile:last-selected-implementation* 'read-write-loop)
    293         (sendfile:read-write-loop src dst len))
    294        ((nothing)
    295         (((sendfile:implementation-selector) len) src dst len))
    296        (else
    297         (sendfile:error "invalid implementation forced. Allowed values are (sendfile mmapped read-write nothing)")))))
    298      
     305  (let ((size (file-size src)))
     306    (if (and (port? dst) (not (sendfile:port-has-fd? dst)))
     307        (impl:read-write-loop/port src dst size)
     308        (let ((src (->fileno src))
     309              (dst (->fileno dst)))
     310          (case (sendfile:force-implementation)
     311            ((sendfile) (sendfile:sendfile src dst size))
     312            ((mmapped) (sendfile:mmapped src dst size))
     313            ((read-write) (sendfile:read-write-loop/fd src dst size))
     314            ((nothing)
     315             (let ((impl ((sendfile:implementation-selector) size)))
     316               (impl src dst size)))
     317            (else
     318             (sendfile:error "invalid implementation forced. Allowed values are (sendfile mmapped read-write nothing)")))))))
     319
    299320
    300321 
  • release/3/sendfile/trunk/tests/test-run.scm

    r10740 r11816  
    2323       (with-prepared-environment test-file
    2424        (lambda (in out)
    25           (sendfile:read-write-loop in out test-file-size))))
     25          (sendfile:read-write-loop/fd in out test-file-size))))
    2626      (sleep 1)
    2727      (test "verify"
    2828       test-file-checksum
    2929       (compute-file-checksum test-file-out)))
     30
     31
     32(test-group "read-write-loop (ports-only)"
     33      (test "send"
     34        test-file-size
     35        (with-prepared-environment test-file
     36         (lambda (in out)
     37             (sendfile:read-write-loop/port in out test-file-size)) #t))
     38      (sleep 1)
     39      (test "verify"
     40       test-file-checksum
     41       (compute-file-checksum test-file-out)))
     42
     43
    3044
    3145(if sendfile:os-dep:mmap-available?
  • release/3/sendfile/trunk/tests/test-utils.scm

    r9979 r11816  
    1616(define big-test-file-checksum (compute-file-checksum big-test-file))
    1717
    18 (define (with-prepared-environment file proc)
     18(define (with-prepared-environment file proc #!optional (ports? #f))
    1919  (let ((in (file-open file (bitwise-ior open/rdonly open/binary)))
    2020        (size (file-size file)))
    2121    (receive (i o) (tcp-connect "localhost" 5555)
    2222      (if (file-exists? test-file-out) (delete-file test-file-out))
    23       (let ((res (proc in (port->fileno o))))
     23      (let ((res (proc in (if ports? o (port->fileno o)))))
    2424        (close-input-port i)
    2525        (close-output-port o)
Note: See TracChangeset for help on using the changeset viewer.