~ chicken-core (chicken-5) 7a3f416ccb79d568e6f0f2a1440b727de993755a

commit 7a3f416ccb79d568e6f0f2a1440b727de993755a
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Sat May 7 14:00:25 2011 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Sat May 7 14:00:25 2011 +0200

    specialization rewrites for some cases of move-memory!

diff --git a/chicken.h b/chicken.h
index 84bee82f..47137294 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1104,7 +1104,7 @@ extern double trunc(double);
 #define C_pointer_to_block(p, x)        (C_set_block_item(p, 0, (C_word)C_data_pointer(x)), C_SCHEME_UNDEFINED)
 #define C_null_pointerp(x)              C_mk_bool((void *)C_block_item(x, 0) == NULL)
 #define C_update_pointer(p, ptr)        (C_set_block_item(ptr, 0, C_num_to_unsigned_int(p)), C_SCHEME_UNDEFINED)
-#define C_copy_pointer(from, to)        (C_set_block_item(to, 0, C_u_i_car(from)), C_SCHEME_UNDEFINED)
+#define C_copy_pointer(from, to)        (C_set_block_item(to, 0, C_block_item(from, 0)), C_SCHEME_UNDEFINED)
 #define C_pointer_to_object(ptr)        C_block_item(ptr, 0)
 
 #define C_direct_return(dk, x)          (C_kontinue(dk, x), C_SCHEME_UNDEFINED)
@@ -1116,6 +1116,9 @@ extern double trunc(double);
 #endif
 
 #define C_copy_memory(to, from, n)      (C_memcpy(C_data_pointer(to), C_data_pointer(from), C_unfix(n)), C_SCHEME_UNDEFINED)
+#define C_copy_ptr_memory(to, from, n, toff, foff) \
+  (C_memcpy(C_pointer_address(to) + C_unfix(toff), C_pointer_address(from) + C_unfix(foff), \
+	    C_unfix(n)), C_SCHEME_UNDEFINED)
 #define C_set_memory(to, c, n)          (C_memset(C_data_pointer(to), C_character_code(c), C_unfix(n)), C_SCHEME_UNDEFINED)
 #define C_string_compare(to, from, n)   C_fix(C_strncmp(C_c_string(to), C_c_string(from), C_unfix(n)))
 #define C_string_compare_case_insensitive(from, to, n) \
diff --git a/types.db b/types.db
index 89c7b37b..01e85f2d 100644
--- a/types.db
+++ b/types.db
@@ -1089,8 +1089,21 @@
 (make-pointer-vector (procedure! make-pointer-vector (fixnum #!optional pointer) pointer-vector))
 (make-record-instance (procedure make-record-instance (* #!rest) *))
 (make-weak-locative (procedure! make-weak-locative (* #!optional fixnum) locative))
-;;XXX move-memory! could be rewritten according to argumejnt types and supplied args
-(move-memory! (procedure! move-memory! (* * #!optional fixnum fixnum fixnum) *))
+
+(move-memory! (procedure! move-memory! (* * #!optional fixnum fixnum fixnum) *)
+	      ((pointer pointer fixnum)
+	       (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) '0 '0))
+	      ((pointer pointer fixnum fixnum)
+	       (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) '0 #(4)))
+	      ((pointer pointer fixnum fixnum fixnum)
+	       (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) #(5) #(4)))
+	      ((locative locative fixnum)
+	       (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) '0 '0))
+	      ((locative locative fixnum fixnum)
+	       (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) '0 #(4)))
+	      ((locative locative fixnum fixnum fixnum)
+	       (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) #(5) #(4))))
+
 (mutate-procedure (procedure! mutate-procedure (procedure procedure) procedure))
 (null-pointer (procedure null-pointer () pointer))