~ chicken-core (chicken-5) a984ac0d8467667f186c78154251116980688aa9
commit a984ac0d8467667f186c78154251116980688aa9
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Mon May 9 11:45:37 2011 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Mon May 9 11:45:37 2011 +0200
fixed obsolete specialized flag for rewrites
diff --git a/batch-driver.scm b/batch-driver.scm
index 216438de..9065dee6 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -534,7 +534,7 @@
(load-inline-file ilf) )
ifs)))
- (when (or strict-variable-types enable-specialization)
+ (when (or strict-variable-types do-scrutinize enable-specialization)
;;XXX hardcoded database file name
(unless (memq 'ignore-repository options)
(load-type-database "types.db"))
diff --git a/c-platform.scm b/c-platform.scm
index 4992dffd..f5dfb0f8 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -613,7 +613,7 @@
(rewrite 'flonum? 2 1 "C_i_flonump" #t)
(rewrite 'fixnum? 2 1 "C_fixnump" #t)
(rewrite 'finite? 2 1 "C_i_finitep" #f)
-(rewrite 'fpinteger? 2 1 "C_u_i_fpintegerp" 'specialized)
+(rewrite 'fpinteger? 2 1 "C_u_i_fpintegerp" #f)
(rewrite '##sys#pointer? 2 1 "C_anypointerp" #t)
(rewrite 'pointer? 2 1 "C_i_safe_pointerp" #t)
(rewrite '##sys#generic-structure? 2 1 "C_structurep" #t)
@@ -651,15 +651,15 @@
(rewrite 'fx< 2 2 "C_fixnum_lessp" #t)
(rewrite 'fx>= 2 2 "C_fixnum_greater_or_equal_p" #t)
(rewrite 'fx<= 2 2 "C_fixnum_less_or_equal_p" #t)
-(rewrite 'fp= 2 2 "C_flonum_equalp" 'specialized)
-(rewrite 'fp> 2 2 "C_flonum_greaterp" 'specialized)
-(rewrite 'fp< 2 2 "C_flonum_lessp" 'specialized)
-(rewrite 'fp>= 2 2 "C_flonum_greater_or_equal_p" 'specialized)
-(rewrite 'fp<= 2 2 "C_flonum_less_or_equal_p" 'specialized)
+(rewrite 'fp= 2 2 "C_flonum_equalp" #f)
+(rewrite 'fp> 2 2 "C_flonum_greaterp" #f)
+(rewrite 'fp< 2 2 "C_flonum_lessp" #f)
+(rewrite 'fp>= 2 2 "C_flonum_greater_or_equal_p" #f)
+(rewrite 'fp<= 2 2 "C_flonum_less_or_equal_p" #f)
(rewrite 'fxmax 2 2 "C_i_fixnum_max" #t)
(rewrite 'fxmin 2 2 "C_i_fixnum_min" #t)
-(rewrite 'fpmax 2 2 "C_i_flonum_max" 'specialized)
-(rewrite 'fpmin 2 2 "C_i_flonum_min" 'specialized)
+(rewrite 'fpmax 2 2 "C_i_flonum_max" #f)
+(rewrite 'fpmin 2 2 "C_i_flonum_min" #f)
(rewrite 'char-numeric? 2 1 "C_u_i_char_numericp" #t)
(rewrite 'char-alphabetic? 2 1 "C_u_i_char_alphabeticp" #t)
(rewrite 'char-whitespace? 2 1 "C_u_i_char_whitespacep" #t)
@@ -696,11 +696,11 @@
(rewrite 'bitwise-not 22 1 "C_a_i_bitwise_not" #t words-per-flonum "C_fixnum_not")
-(rewrite 'fp+ 16 2 "C_a_i_flonum_plus" 'specialized words-per-flonum)
-(rewrite 'fp- 16 2 "C_a_i_flonum_difference" 'specialized words-per-flonum)
-(rewrite 'fp* 16 2 "C_a_i_flonum_times" 'specialized words-per-flonum)
-(rewrite 'fp/ 16 2 "C_a_i_flonum_quotient" 'specialized words-per-flonum)
-(rewrite 'fpneg 16 1 "C_a_i_flonum_negate" 'specialized words-per-flonum)
+(rewrite 'fp+ 16 2 "C_a_i_flonum_plus" #f words-per-flonum)
+(rewrite 'fp- 16 2 "C_a_i_flonum_difference" #f words-per-flonum)
+(rewrite 'fp* 16 2 "C_a_i_flonum_times" #f words-per-flonum)
+(rewrite 'fp/ 16 2 "C_a_i_flonum_quotient" #f words-per-flonum)
+(rewrite 'fpneg 16 1 "C_a_i_flonum_negate" #f words-per-flonum)
(rewrite 'exp 16 1 "C_a_i_exp" #t words-per-flonum)
(rewrite 'sin 16 1 "C_a_i_sin" #t words-per-flonum)
@@ -836,22 +836,22 @@
(rewrite 'truncate 15 'flonum 'fixnum 'fptruncate #f)
(rewrite 'round 15 'flonum 'fixnum 'fpround #f)
-(rewrite 'fpsin 16 1 "C_a_i_flonum_sin" 'specialized words-per-flonum)
-(rewrite 'fpcos 16 1 "C_a_i_flonum_cos" 'specialized words-per-flonum)
-(rewrite 'fptan 16 1 "C_a_i_flonum_tan" 'specialized words-per-flonum)
-(rewrite 'fpasin 16 1 "C_a_i_flonum_asin" 'specialized words-per-flonum)
-(rewrite 'fpacos 16 1 "C_a_i_flonum_acos" 'specialized words-per-flonum)
-(rewrite 'fpatan 16 1 "C_a_i_flonum_atan" 'specialized words-per-flonum)
-(rewrite 'fpatan2 16 2 "C_a_i_flonum_atan2" 'specialized words-per-flonum)
-(rewrite 'fpexp 16 1 "C_a_i_flonum_exp" 'specialized words-per-flonum)
-(rewrite 'fpexpt 16 2 "C_a_i_flonum_expt" 'specialized words-per-flonum)
-(rewrite 'fplog 16 1 "C_a_i_flonum_log" 'specialized words-per-flonum)
-(rewrite 'fpsqrt 16 1 "C_a_i_flonum_sqrt" 'specialized words-per-flonum)
-(rewrite 'fpabs 16 1 "C_a_i_flonum_abs" 'specialized words-per-flonum)
-(rewrite 'fptruncate 16 1 "C_a_i_flonum_truncate" 'specialized words-per-flonum)
-(rewrite 'fpround 16 1 "C_a_i_flonum_truncate" 'specialized words-per-flonum)
-(rewrite 'fpceiling 16 1 "C_a_i_flonum_truncate" 'specialized words-per-flonum)
-(rewrite 'fpround 16 1 "C_a_i_flonum_truncate" 'specialized words-per-flonum)
+(rewrite 'fpsin 16 1 "C_a_i_flonum_sin" #f words-per-flonum)
+(rewrite 'fpcos 16 1 "C_a_i_flonum_cos" #f words-per-flonum)
+(rewrite 'fptan 16 1 "C_a_i_flonum_tan" #f words-per-flonum)
+(rewrite 'fpasin 16 1 "C_a_i_flonum_asin" #f words-per-flonum)
+(rewrite 'fpacos 16 1 "C_a_i_flonum_acos" #f words-per-flonum)
+(rewrite 'fpatan 16 1 "C_a_i_flonum_atan" #f words-per-flonum)
+(rewrite 'fpatan2 16 2 "C_a_i_flonum_atan2" #f words-per-flonum)
+(rewrite 'fpexp 16 1 "C_a_i_flonum_exp" #f words-per-flonum)
+(rewrite 'fpexpt 16 2 "C_a_i_flonum_expt" #f words-per-flonum)
+(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
'string->number 8
diff --git a/compiler.scm b/compiler.scm
index c01cf532..6494cdf9 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -334,7 +334,7 @@
(define enable-inline-files #f)
(define compiler-syntax-enabled #t)
(define bootstrap-mode #f)
-(define struct-variable-types #f)
+(define strict-variable-types #f)
(define enable-specialization #f)
diff --git a/unboxing.scm b/unboxing.scm
index 28de35bd..4871e256 100644
--- a/unboxing.scm
+++ b/unboxing.scm
@@ -311,7 +311,7 @@
(set! d-depth (add1 d-depth))
(let ((result
(case class
-
+
((##core#undefined
##core#proc
##core#global-ref
@@ -383,10 +383,11 @@
(when (and (not pass2?) r1 (cdr r1))
(unboxed! (first params) (cdr r1)))
(let ((r (walk (second subs) dest udest pass2?)))
+ (when pass2?
(let ((a (assq v e)))
(if (and a (cdr a))
(rebind-unboxed! n (cdr a))
- (straighten-binding! n))) )
+ (straighten-binding! n))))
r)))
((set!)
@@ -434,6 +435,7 @@
(else
(for-each (o invalidate (cut walk <> #f #f pass2?)) subs)
#f))))
+
(set! d-depth (sub1 d-depth))
result)))
Trap