~ chicken-core (chicken-5) 5a094af3597397cb44a5c1f7c6ae693aac3b1ff6

commit 5a094af3597397cb44a5c1f7c6ae693aac3b1ff6
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Sun May 8 12:58:28 2011 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Sun May 8 12:58:28 2011 +0200

    removed unsafe-specialization-arithmetic declaration and machinery

diff --git a/batch-driver.scm b/batch-driver.scm
index ed7f6442..2a759558 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -611,7 +611,7 @@
 				       (> (- (cputime) start-time) funny-message-timeout))
 			      (display "(don't worry - still compiling...)\n") )
 			    (print-node "closure-converted" '|9| node2)
-			    (when (and unbox (or unsafe unchecked-specialized-arithmetic))
+			    (when (and unbox unsafe)
 			      (debugging 'p "performing unboxing")
 			      (begin-time)
 			      (perform-unboxing! node2)
diff --git a/compiler-namespace.scm b/compiler-namespace.scm
index b158a2dd..1ef66f4e 100644
--- a/compiler-namespace.scm
+++ b/compiler-namespace.scm
@@ -277,7 +277,6 @@
  toplevel-scope
  transform-direct-lambdas!
  tree-copy
- unchecked-specialized-arithmetic
  undefine-shadowed-macros
  unique-id
  unit-name
diff --git a/compiler.scm b/compiler.scm
index a4f8f6b8..c02cecf6 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -71,7 +71,6 @@
 ; (unsafe)
 ; (unused <symbol> ...)
 ; (uses {<unitname>})
-; (unsafe-specialized-arithmetic)
 ;
 ;   <type> = fixnum | generic
 
@@ -335,7 +334,6 @@
 (define do-scrutinize #f)
 (define enable-inline-files #f)
 (define compiler-syntax-enabled #t)
-(define unchecked-specialized-arithmetic #f)
 (define bootstrap-mode #f)
 
 
@@ -1495,8 +1493,6 @@
 		 (else
 		  (warning "illegal `type' declaration item" spec))))
 	 (globalize-all (cdr spec))))
-       ((unsafe-specialized-arithmetic)
-	(set! unchecked-specialized-arithmetic #t))
        (else (warning "illegal declaration specifier" spec)) )
      '(##core#undefined) ) ) )
 
diff --git a/manual/Declarations b/manual/Declarations
index d35d3dfc..a693046e 100644
--- a/manual/Declarations
+++ b/manual/Declarations
@@ -384,17 +384,6 @@ are registered as features during compile-time, so {{cond-expand}}
 knows about them.
 
 
-=== unsafe-specialized-arithmetic
-
- [declaration specifier] (unsafe-specialized-arithmetic)
-
-Assume specialized arithmetic operations like {{fp+}}, {{fpsin}}, etc. 
-are always called with arguments of correct type and perform
-unboxing of intermediate results if possible and if the {{-unboxing}}
-compiler-option has been enabled (done by default on optimization
-levels 2 and higher).
-
-
 ---
 Previous: [[Modules]]
 
diff --git a/optimizer.scm b/optimizer.scm
index c770b793..c3c94561 100644
--- a/optimizer.scm
+++ b/optimizer.scm
@@ -1074,10 +1074,7 @@
        (and inline-substitutions-enabled
 	    (or (not argc) (= rargc argc))
 	    (intrinsic? name)
-	    (or unsafe
-		(if (eq? safe 'specialized)
-		    unchecked-specialized-arithmetic
-		    safe))
+	    (or unsafe safe)
 	    (make-node
 	     '##core#call '(#t)
 	     (list cont 
diff --git a/unboxing.scm b/unboxing.scm
index 60a35006..40224766 100644
--- a/unboxing.scm
+++ b/unboxing.scm
@@ -289,11 +289,7 @@
 
 	      ((##core#inline ##core#inline_allocate)
 	       (let* ((rw1 (##sys#get (symbolify (first params)) '##compiler#unboxed-op))
-		      (rw (and rw1 
-			       (or unsafe
-				   (and (fourth rw1)
-					unchecked-specialized-arithmetic))
-			       rw1))
+		      (rw (and unsafe rw1))
 		      (args (map (cut walk <> #f rw pass2?) subs)))
 		 (cond ((not rw) #f)
 		       ((or (not pass2?)
@@ -396,21 +392,16 @@
   (syntax-rules ()
     ((_ (name atypes rtype alt) ...)
      (begin
-       (register-unboxed-op 'name 'atypes 'rtype 'alt #f) ...))))
+       (register-unboxed-op 'name 'atypes 'rtype 'alt) ...))))
 
-(define-syntax define-unboxed-arithmetic-ops
-  (syntax-rules ()
-    ((_ (name atypes rtype alt) ...)
-     (begin
-       (register-unboxed-op 'name 'atypes 'rtype 'alt #t) ...))))
+(define (register-unboxed-op name atypes rtype alt)
+  (##sys#put! (symbolify name) '##compiler#unboxed-op (list alt atypes rtype)))
 
-(define (register-unboxed-op name atypes rtype alt arithmetic)
-  (##sys#put! (symbolify name) '##compiler#unboxed-op (list alt atypes rtype arithmetic)))
 
+;;; unboxed rewrites
 
-;; unboxed rewrites
-
-(define-unboxed-arithmetic-ops 
+;; arithmetic
+(define-unboxed-ops 
   (C_a_i_flonum_plus (flonum flonum) flonum "C_ub_i_flonum_plus")
   (C_a_i_flonum_difference (flonum flonum) flonum "C_ub_i_flonum_difference")
   (C_a_i_flonum_times (flonum flonum) flonum "C_ub_i_flonum_times") 
@@ -438,6 +429,7 @@
   (C_a_i_flonum_floor (flonum) flonum "C_floor")
   (C_a_i_flonum_round (flonum) flonum "C_round"))
 
+;; others
 (define-unboxed-ops 
   (C_u_i_f32vector_set (* fixnum flonum) fixnum "C_ub_i_f32vector_set")
   (C_u_i_f64vector_set (* fixnum flonum) fixnum "C_ub_i_f64vector_set")