extflonums

An extflonum is like a flonum, but with 80-bit precision and
not a number in the sense of `number?': only operations such as
`extfl+' work on extflonums, and only on platforms where extflonums
can be implemented by hardware without interefering with flonums
(i.e., on platforms where SSE instructions are used for
double-precision floats).

[Patch provided by Michael Filonenko and revised by Matthew.]

The compiler tracks information about bindings that are known to
hold extflonums, but the JIT does not yet exploit this information
to unbox them (except as intermediate results).

original commit: 17b8092641

collects/compiler/decompile.rkt

@@ -19,6 +19,7 @@
              (namespace-require ''#%kernel)
              (namespace-require ''#%unsafe)
              (namespace-require ''#%flfxnum)
+             (namespace-require ''#%extfl)
              (namespace-require ''#%futures)
              (for/list ([l (namespace-mapped-symbols)])
                (cons l (with-handlers ([exn:fail? (lambda (x) #f)])

collects/compiler/zo-marshal.rkt

@@ -584,6 +584,7 @@
   (case type
     [(flonum) 1]
     [(fixnum) 2]
+    [(extflonum) 3]
     [else (error 'type->index "unknown type: ~e" type)]))
 
 (define (out-anything v out)

collects/compiler/zo-parse.rkt

@@ -107,6 +107,7 @@
                                     (case n
                                       [(2) 'flonum]
                                       [(3) 'fixnum]
+                                      [(4) 'extflonum]
                                       [else (error "invaid type flag")]))]
                      [(arg-types) (let ([num-params ((if rest? sub1 values) num-params)])
                                     (for/list ([i (in-range num-params)]) 
@@ -373,8 +374,8 @@
     [(27) 'inline-variant-type]
     [(35) 'variable-type]
     [(36) 'module-variable-type]
-    [(113) 'resolve-prefix-type]
-    [(162) 'free-id-info-type]
+    [(114) 'resolve-prefix-type]
+    [(164) 'free-id-info-type]
     [else (error 'int->type "unknown type: ~e" i)]))
 
 (define type-readers
@@ -554,6 +555,7 @@
 
 (define SCHEME_LOCAL_TYPE_FLONUM 1)
 (define SCHEME_LOCAL_TYPE_FIXNUM 2)
+(define SCHEME_LOCAL_TYPE_EXTFLONUM 3)
 
 (define (make-local unbox? pos flags)
   (define SCHEME_LOCAL_CLEAR_ON_READ 1)
@@ -565,6 +567,7 @@
                  (let ([t (- flags SCHEME_LOCAL_TYPE_OFFSET)])
                    (cond
                     [(= t SCHEME_LOCAL_TYPE_FLONUM) 'flonum]
+                    [(= t SCHEME_LOCAL_TYPE_EXTFLONUM) 'extflonum]
                     [(= t SCHEME_LOCAL_TYPE_FIXNUM) 'fixnum]
                     [else #f]))))
 
@@ -856,6 +859,7 @@
                             (case (read-compact-number cp)
                               [(1) 'flonum]
                               [(2) 'fixnum]
+                              [(3) 'extflonum]
                               [else #f]))
                        (eq? cpt-tag 'let-one-unused))]
         [(branch)

collects/compiler/zo-structs.rkt

@@ -146,10 +146,10 @@
                                 [flags (listof (or/c 'preserves-marks 'is-method 'single-result
                                                      'only-rest-arg-not-used 'sfs-clear-rest-args))]
                                 [num-params exact-nonnegative-integer?]
-                                [param-types (listof (or/c 'val 'ref 'flonum 'fixnum))]
+                                [param-types (listof (or/c 'val 'ref 'flonum 'fixnum 'extflonum))]
                                 [rest? boolean?]
                                 [closure-map (vectorof exact-nonnegative-integer?)]
-                                [closure-types (listof (or/c 'val/ref 'flonum 'fixnum))]
+                                [closure-types (listof (or/c 'val/ref 'flonum 'fixnum 'extflonum))]
                                 [toplevel-map (or/c #f (set/c exact-nonnegative-integer?))]
                                 [max-let-depth exact-nonnegative-integer?]
                                 [body (or/c expr? seq? any/c)])) ; `lambda'
@@ -158,7 +158,7 @@
 
 (define-form-struct (let-one expr) ([rhs (or/c expr? seq? any/c)]  ; pushes one value onto stack
                                     [body (or/c expr? seq? any/c)] 
-                                    [type (or/c #f 'flonum 'fixnum)]
+                                    [type (or/c #f 'flonum 'fixnum 'extflonum)]
                                     [unused? boolean?]))
 (define-form-struct (let-void expr) ([count exact-nonnegative-integer?] [boxes? boolean?] [body (or/c expr? seq? any/c)])) ; create new stack slots
 (define-form-struct (install-value expr) ([count exact-nonnegative-integer?] 
@@ -173,7 +173,7 @@
                                      [pos exact-nonnegative-integer?] 
                                      [clear? boolean?] 
                                      [other-clears? boolean?] 
-                                     [type (or/c #f 'flonum 'fixnum)])) ; access local via stack
+                                     [type (or/c #f 'flonum 'fixnum 'extflonum)])) ; access local via stack
 
 
 (define-form-struct (topsyntax expr) ([depth exact-nonnegative-integer?] [pos exact-nonnegative-integer?] [midpt exact-nonnegative-integer?])) ; access syntax object via prefix array (which is on stack)