diff --git a/scheme/ikarus.boot.orig b/scheme/ikarus.boot.orig
index d76d2a8..4d0233a 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 97ebf70..8ced1ce 100644
--- a/scheme/ikarus.numerics.ss
+++ b/scheme/ikarus.numerics.ss
@@ -21,7 +21,7 @@
 
 
 (library (ikarus flonums)
-  (export $flonum->exact $flonum-signed-biased-exponent flonum-parts
+  (export $flonum->exact flonum-parts
           inexact->exact exact $flonum-rational? $flonum-integer? $flzero?
           $flnegative? flpositive? flabs fixnum->flonum
           flsin flcos fltan flasin flacos flatan fleven? flodd?
@@ -31,10 +31,9 @@
   (import 
     (ikarus system $bytevectors)
     (ikarus system $fx) 
-    (only (ikarus system $flonums) $fl>=)
+    (only (ikarus system $flonums) $fl>= $flonum-sbe)
     (ikarus system $bignums)
-    (except (ikarus system $flonums) $flonum-signed-biased-exponent
-            $flonum-rational? $flonum-integer?)
+    (except (ikarus system $flonums) $flonum-rational? $flonum-integer?)
     (except (ikarus) inexact->exact exact flpositive? flabs fixnum->flonum
             flsin flcos fltan flasin flacos flatan fleven? flodd?
             flfloor flceiling flnumerator fldenominator flexp fllog
@@ -76,20 +75,13 @@
          ($fxzero? ($flonum-u8-ref f 2))
          ($fxzero? ($fxlogand ($flonum-u8-ref f 1) #b1111))))
 
-
-
-  (define ($flonum-signed-biased-exponent x)
-    (let ([b0 ($flonum-u8-ref x 0)]
-          [b1 ($flonum-u8-ref x 1)])
-      ($fxlogor ($fxsll b0 4) ($fxsra b1 4))))
-
   (define ($flonum-rational? x)
-    (let ([be ($fxlogand ($flonum-signed-biased-exponent x) 
+    (let ([be ($fxlogand ($flonum-sbe x) 
                 ($fxsub1 ($fxsll 1 11)))])
       ($fx< be 2047)))
 
   (define ($flonum-integer? x)
-    (let ([be ($fxlogand ($flonum-signed-biased-exponent x) 
+    (let ([be ($fxlogand ($flonum-sbe x) 
                 ($fxsub1 ($fxsll 1 11)))])
       (cond
         [($fx= be 2047)  ;;; nans and infs
@@ -156,26 +148,26 @@
 
   (define (flinfinite? x) 
     (if (flonum? x) 
-        (let ([be (fxlogand ($flonum-signed-biased-exponent x) (sub1 (fxsll 1 11)))])
+        (let ([be (fxlogand ($flonum-sbe x) (sub1 (fxsll 1 11)))])
           (and (fx= be 2047)  ;;; nans and infs
                ($zero-m? x)))
         (error 'flinfinite? "not a flonum" x)))
 
   (define (flnan? x) 
     (if (flonum? x) 
-        (let ([be (fxlogand ($flonum-signed-biased-exponent x) (sub1 (fxsll 1 11)))])
+        (let ([be (fxlogand ($flonum-sbe x) (sub1 (fxsll 1 11)))])
           (and (fx= be 2047)  ;;; nans and infs
                (not ($zero-m? x))))
         (error 'flnan? "not a flonum" x)))
 
   (define (flfinite? x) 
     (if (flonum? x) 
-        (let ([be (fxlogand ($flonum-signed-biased-exponent x) (sub1 (fxsll 1 11)))])
+        (let ([be (fxlogand ($flonum-sbe x) (sub1 (fxsll 1 11)))])
           (not (fx= be 2047)))
         (error 'flfinite? "not a flonum" x)))
   
   (define ($flzero? x)
-    (let ([be (fxlogand ($flonum-signed-biased-exponent x) (sub1 (fxsll 1 11)))])
+    (let ([be (fxlogand ($flonum-sbe x) (sub1 (fxsll 1 11)))])
        (and 
          (fx= be 0) ;;; denormalized double, only +/-0.0 is integer
          (and (fx= ($flonum-u8-ref x 7) 0)
@@ -203,6 +195,9 @@
         [else #f])))
   
 
+
+
+
   (define (inexact->exact x)
     (cond
       [(flonum? x)
diff --git a/scheme/psyntax.expander.ss b/scheme/psyntax.expander.ss
index 4b4ae81..dec8a77 100644
--- a/scheme/psyntax.expander.ss
+++ b/scheme/psyntax.expander.ss
@@ -1527,14 +1527,14 @@
         (syntax-match spec ()
           [(foo make-foo foo?) foo]
           [foo foo]))
-      (define (get-record-constructor-name spec ctxt)
+      (define (get-record-constructor-name spec)
         (syntax-match spec ()
           [(foo make-foo foo?) make-foo]
-          [foo (id ctxt "make-" (stx->datum foo))]))
-      (define (get-record-predicate-name spec ctxt)
+          [foo (id? foo) (id foo "make-" (stx->datum foo))]))
+      (define (get-record-predicate-name spec)
         (syntax-match spec ()
           [(foo make-foo foo?) foo?]
-          [foo (id ctxt (stx->datum foo) "?")]))
+          [foo (id? foo) (id foo (stx->datum foo) "?")]))
       (define (get-clause id ls)
         (syntax-match ls ()
           [() #f]
@@ -1542,7 +1542,7 @@
            (if (free-id=? (bless id) x)
                `(,x . ,rest)
                (get-clause id ls))]))
-      (define (foo-rtd-code ctxt name clause*) 
+      (define (foo-rtd-code name clause*) 
         (define (convert-field-spec* ls)
           (list->vector
             (map (lambda (x) 
@@ -1601,9 +1601,9 @@
              (cons i (f rest (+ i 1)))]
             [(_ . rest)
              (f rest (+ i 1))])))
-      (define (get-mutators foo fields ctxt)
+      (define (get-mutators foo fields)
         (define (gen-name x) 
-          (datum->syntax ctxt
+          (datum->syntax foo
             (string->symbol 
               (string-append "set-" 
                 (symbol->string (syntax->datum foo))
@@ -1618,9 +1618,9 @@
             [((mutable name) . rest)
              (cons (gen-name name) (f rest))]
             [(_ . rest) (f rest)])))
-      (define (get-accessors foo fields ctxt)
+      (define (get-accessors foo fields)
         (define (gen-name x) 
-          (datum->syntax ctxt
+          (datum->syntax foo
             (string->symbol 
               (string-append
                 (symbol->string (syntax->datum foo))
@@ -1641,19 +1641,19 @@
           (cond
             [(null? ls) '()]
             [else (cons i (f (cdr ls) (+ i 1)))])))
-      (define (do-define-record ctxt namespec clause*)
+      (define (do-define-record namespec clause*)
         (let* ([foo (get-record-name namespec)]
                [foo-rtd (gensym)]
                [foo-rcd (gensym)]
                [protocol (gensym)]
-               [make-foo (get-record-constructor-name namespec ctxt)]
+               [make-foo (get-record-constructor-name namespec)]
                [fields (get-fields clause*)]
                [idx* (enumerate fields)]
-               [foo-x* (get-accessors foo fields ctxt)]
-               [set-foo-x!* (get-mutators foo fields ctxt)]
+               [foo-x* (get-accessors foo fields)]
+               [set-foo-x!* (get-mutators foo fields)]
                [set-foo-idx* (get-mutator-indices fields)]
-               [foo? (get-record-predicate-name namespec ctxt)]
-               [foo-rtd-code (foo-rtd-code ctxt foo clause*)]
+               [foo? (get-record-predicate-name namespec)]
+               [foo-rtd-code (foo-rtd-code foo clause*)]
                [foo-rcd-code (foo-rcd-code clause* foo-rtd protocol)]
                [protocol-code (get-protocol-code clause*)])
           (bless
@@ -1673,8 +1673,8 @@
                      `(define ,set-foo-x! (record-mutator ,foo-rtd ,idx)))
                    set-foo-x!* set-foo-idx*)))))
       (syntax-match x ()
-        [(ctxt namespec clause* ...)
-         (do-define-record ctxt namespec clause*)])))
+        [(_ namespec clause* ...)
+         (do-define-record namespec clause*)])))
   
   (define define-condition-type-macro
     (lambda (x)