diff --git a/scheme/ikarus.boot.orig b/scheme/ikarus.boot.orig
index d219ffb..d76d2a8 100644
Binary files a/scheme/ikarus.boot.orig and b/scheme/ikarus.boot.orig differ
diff --git a/scheme/ikarus.numerics.ss b/scheme/ikarus.numerics.ss
index 12a158b..f8a3f40 100644
--- a/scheme/ikarus.numerics.ss
+++ b/scheme/ikarus.numerics.ss
@@ -109,48 +109,6 @@
         [else
          (let ([v ($flonum->exact x)])
            (or (fixnum? v) (bignum? v)))])))
-  
-;;;X (define ($fltruncate x)
-;;;X   ;(define bv 
-;;;X   ;  '#vu8(127 255 255 255  63 255 255 255  31 255 255 255  15 255 255 255
-;;;X   ;          7 255 255 255   3 255 255 255   1 255 255 255   0 255 255 255
-;;;X   ;          0 127 255 255   0  63 255 255   0  31 255 255   0  15 255 255   
-;;;X   ;          0   7 255 255   0   3 255 255   0   1 255 255   0   0 255 255   
-;;;X   ;          0   0 127 255   0   0  63 255   0   0  31 255   0   0  15 255   
-;;;X   ;          0   0   7 255   0   0   3 255   0   0   1 255   0   0   0 255   
-;;;X   ;          0   0   0 127   0   0   0  63   0   0   0  31   0   0   0  15   
-;;;X   ;          0   0   0   7   0   0   0   3   0   0   0   1   0   0   0   0))
-;;;X   ;(define bv
-;;;X   ;  '#vu8(255 255 255 255 255 255 255 255 0 0 0 0 0 0 0 0
-;;;X   ;        255 255 255 255 255 255 255 254 0 0 0 0 0 0 0 0
-;;;X   ;        255 255 255 255 255 255 255 252 0 0 0 0 0 0 0 0
-;;;X   ;        255 255 255 255 255 255 255 248 0 0 0 0 0 0 0 0
-;;;X   ;        255 255 255 255 255 255 255 240 0 0 0 0 0 0 0 0
-;;;X   ;        255 255 255 255 255 255 255 224 0 0 0 0 0 0 0 0
-;;;X   ;        255 255 255 255 255 255 255 192 0 0 0 0 0 0 0 0
-;;;X   ;        255 255 255 255 255 255 255 128 0 0 0 0 0 0 0 0
-;;;X
-;;;X   (let ([sbe ($flonum-signed-biased-exponent x)])
-;;;X     (let ([be ($fxlogand sbe ($fxsub1 ($fxsll 1 11)))])
-;;;X       (cond
-;;;X         [($fx= be 2047)  ;;; nans and infs
-;;;X          x]
-;;;X         [($fx>= be 1075) ;;; magnitue large enough
-;;;X          x]
-;;;X         [($fx= be 0) ;;; denormalized double
-;;;X          (if ($fxzero? sbe) 0.0 -0.0)]
-;;;X         [($fx< be ($fx+ 1075 -52)) ;;; too small to be an integer
-;;;X          (if ($fxzero? ($fxlogand sbe ($fxsll 1 11))) 0.0 -0.0)]
-;;;X         [else
-;;;X          (let ([v ($make-flonum)])
-;;;X
-;;;X
-;;;X          (let ([v ($flonum->exact x)])
-;;;X            (or (fixnum? v) (bignum? v)))]))))
-;;;X
-
-
-
 
   (define (flnumerator x) 
     (unless (flonum? x) 
@@ -2104,9 +2062,6 @@
     (let ([n ($ratnum-n x)] [d ($ratnum-d x)])
       (quotient n d)))
 
-  (define ($flround x) 
-    ($fl/ ($fl* x 5e-324) 5e-324))
-
   (define (flround x)
     (if (flonum? x)
         ($flround x)
diff --git a/scheme/makefile.ss b/scheme/makefile.ss
index 68e271d..c1cb99c 100755
--- a/scheme/makefile.ss
+++ b/scheme/makefile.ss
@@ -431,6 +431,7 @@
     [$fl<=                                       $flonums]
     [$fl>                                        $flonums]
     [$fl>=                                       $flonums]
+    [$flround                                    $flonums]
     [$fixnum->flonum                             $flonums]
     [$make-bignum                                $bignums]
     [$bignum-positive?                           $bignums]
diff --git a/scheme/pass-specify-rep-primops.ss b/scheme/pass-specify-rep-primops.ss
index d240183..049a38b 100644
--- a/scheme/pass-specify-rep-primops.ss
+++ b/scheme/pass-specify-rep-primops.ss
@@ -967,6 +967,18 @@
   [(P x y) (check-flonums (list x y) ($flcmp-aux 'fl:>= x y))]
   [(E x y) (check-flonums (list x y) (nop))])
 
+(define-primop $flround unsafe
+  [(V fl) 
+   (let ([bv #vu8(1 0 0 0 0 0 0 0)])
+     (with-tmp ([x (prm 'alloc (K (align flonum-size)) (K vector-tag))])
+       (prm 'mset x (K (- vector-tag)) (K flonum-tag))
+       (prm 'fl:load (T fl) (K (- disp-flonum-data vector-tag)))
+       (prm 'fl:mul! (K (make-object bv))
+            (K (- disp-bytevector-data bytevector-tag)))
+       (prm 'fl:div! (K (make-object bv))
+            (K (- disp-bytevector-data bytevector-tag)))
+       (prm 'fl:store x (K (- disp-flonum-data vector-tag)))
+       x))])
 
 /section)