Added memcpy (courtesy of Andreas Rottmann).

The `memcpy' procedure allows to copy memory from bytevectors to
  unmanaged (malloc'ed) memory and vice-versa.

lib/ikarus/foreign.ss

@@ -37,7 +37,7 @@
           pointer-ref-c-pointer
           pointer-ref-c-float 
           pointer-ref-c-double
-          malloc free 
+          malloc free memcpy
           pointer->integer integer->pointer pointer? dlopen dlsym
           dlclose dlerror
           make-c-callout make-c-callback 

scheme/ikarus.pointers.ss

@@ -17,7 +17,7 @@
 
 (library (ikarus.pointers)
   (export pointer? integer->pointer pointer->integer 
-          dlopen dlerror dlclose dlsym malloc free
+          dlopen dlerror dlclose dlsym malloc free memcpy
           errno
           pointer-ref-c-signed-char 
           pointer-ref-c-signed-short
@@ -45,7 +45,7 @@
     (except (ikarus) 
       pointer? 
       integer->pointer pointer->integer
-      dlopen dlerror dlclose dlsym malloc free))
+      dlopen dlerror dlclose dlsym malloc free memcpy))
 
   ;;; pointer manipulation procedures 
 
@@ -116,6 +116,34 @@
         (foreign-call "ikrt_free" x)
         (die 'free "not a pointer" x)))
 
+  (define (pointer+ ptr off)
+    (integer->pointer (+ (pointer->integer ptr) off)))
+
+  
+  (define (memcpy dst dst-offset src src-offset count)
+    (define who 'memcpy)
+    (unless (and (fixnum? dst-offset) (fx>=? dst-offset 0))
+      (die who "not a positive fixnum" dst-offset))
+    (unless (and (fixnum? src-offset) (fx>=? src-offset 0))
+      (die who "not a positive fixnum" src-offset))
+    (unless (and (fixnum? count) (fx>=? count 0))
+      (die who "not a postive fixnum" count))
+    (cond ((and (pointer? dst) (bytevector? src))
+           (unless (fx<=? (fx+ src-offset count) (bytevector-length src))
+             (die who "source bytevector length exceeded"
+                  (bytevector-length src) src-offset count))
+           (foreign-call "ikrt_memcpy_from_bv"
+                         (pointer+ dst dst-offset) src src-offset count))
+          ((and (bytevector? dst) (pointer? src))
+           (unless (fx<=? (fx+ dst-offset count) (bytevector-length dst))
+             (die who "destination bytevector length exceeded"
+                  (bytevector-length dst) dst-offset count))
+           (foreign-call "ikrt_memcpy_to_bv"
+                         dst dst-offset (pointer+ src src-offset) count))
+          (else
+           (die who "destination and source not a bytevector/pointer pair"
+                dst dst))))
+
   ;;; getters and setters
 
   (define-syntax define-getter

scheme/last-revision

@@ -1 +1 @@
-1769
+1770

scheme/makefile.ss

@@ -1499,6 +1499,7 @@
     [dlsym                             $for]
     [malloc                            $for]
     [free                              $for]
+    [memcpy                            $for]
     [errno                             $for]
     [pointer-ref-c-signed-char         $for]
     [pointer-ref-c-signed-short        $for]

src/ikarus-pointers.c

@@ -149,6 +149,27 @@ ikrt_free(ikptr x) {
   return void_object;
 }
 
+ikptr
+ikrt_memcpy_to_bv(ikptr dst, ikptr dst_off, ikptr src, ikptr count
+    /*, ikpcb* pcb */) {
+  void *src_ptr, *dst_ptr;
+  
+  src_ptr = (void *)ref(src, off_pointer_data);
+  dst_ptr = (void *)(dst + off_bytevector_data + unfix(dst_off));
+  memcpy(dst_ptr, src_ptr, unfix(count));
+  return void_object;
+}
+
+ikptr
+ikrt_memcpy_from_bv(ikptr dst, ikptr src, ikptr src_off, ikptr count
+    /*, ikpcb* pcb */) {
+  void *src_ptr, *dst_ptr;
+  
+  src_ptr = (void *)(src + off_bytevector_data + unfix(src_off));
+  dst_ptr = (void *)ref(dst, off_pointer_data);
+  memcpy(dst_ptr, src_ptr, unfix(count));
+  return void_object;
+}
 
 ikptr
 ikrt_ref_char(ikptr p, ikptr off /*, ikpcb* pcb*/) {