~ chicken-core (chicken-5) c1f8ca15d237ed91ebe52e28b2200f906b777f49
commit c1f8ca15d237ed91ebe52e28b2200f906b777f49
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Fri May 14 15:20:10 2010 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Fri May 14 15:20:10 2010 +0200
provided safe inline variants for fx/ and fxmod
diff --git a/c-platform.scm b/c-platform.scm
index 581acf86..9eb46674 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -605,8 +605,6 @@
(rewrite '##sys#size 2 1 "C_block_size" #t)
(rewrite 'fxnot 2 1 "C_fixnum_not" #t)
(rewrite 'fx* 2 2 "C_fixnum_times" #t)
-(rewrite 'fx/ 2 2 "C_fixnum_divide" #f)
-(rewrite 'fxmod 2 2 "C_fixnum_modulo" #f)
(rewrite 'fx= 2 2 "C_eqp" #t)
(rewrite 'fx> 2 2 "C_fixnum_greaterp" #t)
(rewrite 'fx< 2 2 "C_fixnum_lessp" #t)
@@ -871,6 +869,8 @@
(rewrite 'fxxor 17 2 "C_fixnum_xor" "C_fixnum_xor")
(rewrite 'fxand 17 2 "C_fixnum_and" "C_u_fixnum_and")
(rewrite 'fxior 17 2 "C_fixnum_or" "C_u_fixnum_or")
+(rewrite 'fx/ 17 2 "C_fixnum_divide" "C_u_fixnum_divide")
+(rewrite 'fxmod 17 2 "C_fixnum_modulo" "C_u_fixnum_modulo")
(rewrite
'arithmetic-shift 8
diff --git a/chicken.h b/chicken.h
index ef23d6d2..f4d08711 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1047,8 +1047,8 @@ extern double trunc(double);
#define C_fixnum_plus(n1, n2) (C_u_fixnum_plus(n1, n2) | C_FIXNUM_BIT)
#define C_u_fixnum_difference(n1, n2) ((n1) - (n2) + C_FIXNUM_BIT)
#define C_fixnum_difference(n1, n2) (C_u_fixnum_difference(n1, n2) | C_FIXNUM_BIT)
-#define C_fixnum_divide(n1, n2) (C_fix(C_unfix(n1) / C_unfix(n2)))
-#define C_fixnum_modulo(n1, n2) (C_fix(C_unfix(n1) % C_unfix(n2)))
+#define C_u_fixnum_divide(n1, n2) (C_fix(C_unfix(n1) / C_unfix(n2)))
+#define C_u_fixnum_modulo(n1, n2) (C_fix(C_unfix(n1) % C_unfix(n2)))
#define C_u_fixnum_and(n1, n2) ((n1) & (n2))
#define C_fixnum_and(n1, n2) (C_u_fixnum_and(n1, n2) | C_FIXNUM_BIT)
#define C_u_fixnum_or(n1, n2) ((n1) | (n2))
@@ -1757,6 +1757,8 @@ C_fctexport C_word C_fcall C_i_null_list_p(C_word x) C_regparm;
C_fctexport C_word C_fcall C_i_string_null_p(C_word x) C_regparm;
C_fctexport C_word C_fcall C_i_null_pointerp(C_word x) C_regparm;
C_fctexport C_word C_fcall C_i_fixnum_arithmetic_shift(C_word n, C_word c) C_regparm;
+C_fctexport C_word C_fcall C_fixnum_divide(C_word x, C_word y) C_regparm;
+C_fctexport C_word C_fcall C_fixnum_modulo(C_word x, C_word y) C_regparm;
C_fctexport C_word C_fcall C_i_locative_set(C_word loc, C_word x) C_regparm;
C_fctexport C_word C_fcall C_i_locative_to_object(C_word loc) C_regparm;
C_fctexport C_word C_fcall C_a_i_make_locative(C_word **a, int c, C_word type, C_word object, C_word index, C_word weak) C_regparm;
diff --git a/data-structures.scm b/data-structures.scm
index 934272da..061a887b 100644
--- a/data-structures.scm
+++ b/data-structures.scm
@@ -835,7 +835,7 @@ EOF
(and (fx> len 0)
(let loop ([ps 0]
[pe len] )
- (let ([p (fx+ ps (##core#inline "C_fixnum_divide" (fx- pe ps) 2))])
+ (let ([p (fx+ ps (##core#inline "C_fixnum_shift_right" (fx- pe ps) 1))])
(let* ([x (##sys#slot vec p)]
[r (proc x)] )
(cond [(fx= r 0) p]
diff --git a/library.scm b/library.scm
index 29afef98..d93373e3 100644
--- a/library.scm
+++ b/library.scm
@@ -749,11 +749,11 @@ EOF
(define (fx/ x y)
(fx-check-divison-by-zero x y 'fx/)
- (##core#inline "C_fixnum_divide" x y) )
+ (##core#inline "C_u_fixnum_divide" x y) )
(define (fxmod x y)
(fx-check-divison-by-zero x y 'fxmod)
- (##core#inline "C_fixnum_modulo" x y) )
+ (##core#inline "C_u_fixnum_modulo" x y) )
(define maximum-flonum (foreign-value "DBL_MAX" double))
(define minimum-flonum (foreign-value "DBL_MIN" double))
diff --git a/runtime.c b/runtime.c
index 968e1aed..c010ee62 100644
--- a/runtime.c
+++ b/runtime.c
@@ -5206,6 +5206,22 @@ C_regparm C_word C_fcall C_i_fixnum_arithmetic_shift(C_word n, C_word c)
}
+/* I */
+C_regparm C_word C_fcall C_fixnum_divide(C_word x, C_word y)
+{
+ if(y == C_fix(0)) barf(C_DIVISION_BY_ZERO_ERROR, "fx/");
+ else return C_u_fixnum_divide(x, y);
+}
+
+
+/* I */
+C_regparm C_word C_fcall C_fixnum_modulo(C_word x, C_word y)
+{
+ if(y == C_fix(0)) barf(C_DIVISION_BY_ZERO_ERROR, "fxmod");
+ else return C_u_fixnum_modulo(x, y);
+}
+
+
C_regparm C_word C_fcall C_i_assq(C_word x, C_word lst)
{
C_word a;
diff --git a/srfi-4.scm b/srfi-4.scm
index 83d75a39..024ea007 100644
--- a/srfi-4.scm
+++ b/srfi-4.scm
@@ -599,7 +599,7 @@ EOF
(##sys#check-structure v t loc)
(let* ([bv (##sys#slot v 1)]
[len (##sys#size bv)]
- [ilen (##core#inline "C_fixnum_divide" len es)] )
+ [ilen (##core#inline "C_u_fixnum_divide" len es)] )
(##sys#check-range from 0 (fx+ ilen 1) loc)
(##sys#check-range to 0 (fx+ ilen 1) loc)
(let* ([size2 (fx* es (fx- to from))]
Trap