Commits

Anonymous committed d3fb7d8

added compatibility layer for pointer-offset to make it work with master and older chickens

Comments (0)

Files changed (6)

backward-compatibility/pointer-offset.scm

+(define-syntax pointer-inc
+  (ir-macro-transformer
+   (lambda (exp inject compare)
+     (let-values (((_ exports _) (##sys#module-exports (alist-ref 'lolevel ##sys#module-table))))
+       (if (alist-ref 'pointer+ exports)
+           `(pointer+ ,@(cdr exp))
+           `(pointer-offset ,@(cdr exp)))))))

sendfile.import.scm

-;;;; sendfile.import.scm - GENERATED BY CHICKEN 4.6.3 -*- Scheme -*-
+;;;; sendfile.import.scm - GENERATED BY CHICKEN 4.7.0.3-st -*- Scheme -*-
 
-(eval '(import chicken scheme extras posix srfi-4 foreign lolevel ports))
+(eval '(import
+         chicken
+         scheme
+         extras
+         posix
+         srfi-4
+         foreign
+         lolevel
+         ports
+         (only data-structures alist-ref)))
+(import chicken)
 (##sys#register-compiled-module
   'sendfile
   (list)
  implementation-selector impl:mmapped impl:sendfile impl:read-write-loop/fd
  impl:read-write-loop/port mmap-available sendfile-available sendfile)
 (import chicken scheme)
-(require-library posix lolevel srfi-4)
-(import extras posix srfi-4 foreign lolevel ports)
+(import-for-syntax chicken)
+(require-library posix lolevel srfi-4 data-structures)
+(import extras posix srfi-4 foreign lolevel ports (only data-structures alist-ref))
 
 
 
 (include "backward-compatibility.scm")
+(include "backward-compatibility/pointer-offset.scm")
 
 (define (kilobytes num)  (* num 1024))
 (define (megabytes num)  (* (kilobytes num) 1024))
   (install-extension 
     'sendfile
     '("sendfile.so" "sendfile.import.so" "sendfile-static.o")
-    '((version "1.7.16")
+    '((version "1.7.17")
      (static "sendfile-static.o")
      (documentation "sendfile.html"))))

strategies/mmap.scm

   (set!  *last-selected-implementation* 'mmapped)
   (chunk-for-each (cut send-chunk dst <> <> <>) src offset bytes))
 
+
 ;; map the bytes starting at offset and ending at offset+bytes
 ;; into memory, by mapping %current-chunk-size bytes at a time
 (define (chunk-for-each proc src offset bytes)
                  (mem-file   (map-file-to-memory #f chunk-size prot/read map/shared src (or mmap-offset offset)))
                  (pointer    (memory-mapped-file-pointer mem-file)))
             (if ptr-offset
-                (proc (pointer-offset pointer ptr-offset) chunk-size write-timeout)
+                (proc (pointer-inc pointer ptr-offset) chunk-size write-timeout)
                 (proc pointer chunk-size write-timeout))
             (unmap-file-from-memory mem-file)
             (loop (+ offset chunk-size) (+ bytes-written chunk-size) #f #f))))))
   ;;don't bother advices for data smaller than 64k
   (when (>= size (kilobytes 64)) (%madvise ptr size %madvise-will-need))
   ;(printf "Shall writ: ~A bytes starting at: ~A" size ptr )
-  (let loop ((bytes-left size) (work-ptr (pointer-offset ptr 0)))
+  (let loop ((bytes-left size) (work-ptr (pointer-inc ptr 0)))
     (if (zero? bytes-left)
         #t
         (let ((result (sys:write dst work-ptr bytes-left)))
            ((negative? result)
             (complain #f "write failed"))
            (else
-            (loop (- bytes-left result) (pointer-offset work-ptr result))))))))
+            (loop (- bytes-left result) (pointer-inc work-ptr result))))))))
 

tests/test-helper.scm

 ;; until we reach eof-object
 
 ;; Use it like so:
-;; (call-with-connection-to-server (lambda (i o) (display "4" o) (newline o) (display "aaaa" o) (read-line i)))
+;; (call-with-connection-to-server (lambda (i o) (display "4" o) (newline
+;; o) (display "aaaa" o) (read-line i)))
+
+
 (define (handle-request input output)
   (handle-exceptions exn
       (begin (display "Error" output)
-             (display (get-condition-property exn 'exn 'msg) output)
+             (display (get-condition-property exn 'exn 'msg "Unknown") output)
              (newline output))
     (let* ((header (read-line input)))
       (unless (eof-object? header)