From 7e965758cf8fa57d9f6f5b592f1b12072f4b3a3f Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Thu, 30 Apr 2009 12:35:49 +0300
Subject: [PATCH] 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     |  2 +-
 scheme/ikarus.pointers.ss | 32 ++++++++++++++++++++++++++++++--
 scheme/last-revision      |  2 +-
 scheme/makefile.ss        |  1 +
 src/ikarus-pointers.c     | 21 +++++++++++++++++++++
 5 files changed, 54 insertions(+), 4 deletions(-)

diff --git a/lib/ikarus/foreign.ss b/lib/ikarus/foreign.ss
index fee006e..37f99f5 100644
--- a/lib/ikarus/foreign.ss
+++ b/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 
diff --git a/scheme/ikarus.pointers.ss b/scheme/ikarus.pointers.ss
index 3b3dc8c..793cf5b 100644
--- a/scheme/ikarus.pointers.ss
+++ b/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
diff --git a/scheme/last-revision b/scheme/last-revision
index ff5a506..65b78cf 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1769
+1770
diff --git a/scheme/makefile.ss b/scheme/makefile.ss
index f04ff0c..1726309 100755
--- a/scheme/makefile.ss
+++ b/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]
diff --git a/src/ikarus-pointers.c b/src/ikarus-pointers.c
index 016ff4b..43c4385 100644
--- a/src/ikarus-pointers.c
+++ b/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*/) {