~ chicken-core (chicken-5) 9ea0b69a9e6b49e9a64d2ba59e40fcc1d131997f

commit 9ea0b69a9e6b49e9a64d2ba59e40fcc1d131997f
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Sun Dec 13 12:32:09 2009 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Sun Dec 13 12:32:09 2009 +0100

    fXXvector-ref unboxed rewrites; rewrites for fpXXX fraction-ops; unboxed fix type is C int; fft is shit-fast

diff --git a/c-backend.scm b/c-backend.scm
index 6382646e..0709dab0 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -727,7 +727,7 @@
 
     (define (utype t)
       (case t
-	((fix) "long")
+	((fix) "int")
 	((flo) "double")
 	((chr) "char")
 	((ptr) "void *")
diff --git a/c-platform.scm b/c-platform.scm
index 23ce02f8..cd54c477 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -802,6 +802,10 @@
 (rewrite 'fplog 16 1 "C_a_i_flonum_log" #f words-per-flonum)
 (rewrite 'fpsqrt 16 1 "C_a_i_flonum_sqrt" #f words-per-flonum)
 (rewrite 'fpabs 16 1 "C_a_i_flonum_abs" #f words-per-flonum)
+(rewrite 'fptruncate 16 1 "C_a_i_flonum_truncate" #f words-per-flonum)
+(rewrite 'fpround 16 1 "C_a_i_flonum_truncate" #f words-per-flonum)
+(rewrite 'fpceiling 16 1 "C_a_i_flonum_truncate" #f words-per-flonum)
+(rewrite 'fpround 16 1 "C_a_i_flonum_truncate" #f words-per-flonum)
 
 (rewrite 'cons 16 2 "C_a_i_cons" #t 3)
 (rewrite '##sys#cons 16 2 "C_a_i_cons" #t 3)
diff --git a/chicken.h b/chicken.h
index 1f8c3997..b6506e1c 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1317,6 +1317,8 @@ extern double trunc(double);
 #define C_u_i_f32vector_set(v, i, x)    ((((float *)C_data_pointer(C_block_item((v), 1)))[ C_unfix(i) ] = C_flonum_magnitude(x)), C_SCHEME_UNDEFINED)
 #define C_u_i_f64vector_set(v, i, x)    ((((double *)C_data_pointer(C_block_item((v), 1)))[ C_unfix(i) ] = C_flonum_magnitude(x)), C_SCHEME_UNDEFINED)
 
+#define C_ub_i_f32vector_ref(b, i)      (((float *)C_data_pointer(C_block_item((b), 1)))[ C_unfix(i) ])
+#define C_ub_i_f64vector_ref(b, i)      (((double *)C_data_pointer(C_block_item((b), 1)))[ C_unfix(i) ])
 #define C_ub_i_f32vector_set(v, i, x)   ((((float *)C_data_pointer(C_block_item((v), 1)))[ C_unfix(i) ] = (x)), 0)
 #define C_ub_i_f64vector_set(v, i, x)   ((((double *)C_data_pointer(C_block_item((v), 1)))[ C_unfix(i) ] = (x)), 0)
 
diff --git a/unboxing.scm b/unboxing.scm
index e4734ff4..86ec0093 100644
--- a/unboxing.scm
+++ b/unboxing.scm
@@ -393,4 +393,6 @@
   (C_a_i_flonum_round (flo) flo "C_round")
   (C_u_i_f32vector_set (* fix flo) fix "C_ub_i_f32vector_set")
   (C_u_i_f64vector_set (* fix flo) fix "C_ub_i_f64vector_set")
+  (C_a_i_f32vector_ref (* fix) flo "C_ub_i_f32vector_ref")
+  (C_a_i_f64vector_ref (* fix) flo "C_ub_i_f64vector_ref")
   )