From 840fc9c65728efd860886c08bee85ce441ab92c6 Mon Sep 17 00:00:00 2001
From: Michael Filonenko <mfilonenko@ipa.nw.ru>
Date: Fri, 15 Feb 2013 11:29:59 -0700
Subject: [PATCH] full unboxing for extflonums, plus `ffi/unsafe' support

Includes a repair for floating-point `min' and `max' that affects all
x86 builds that use SSE arithmetic, leaving the (otherwise unused)
floating-point stack in a bad state, which might have affected
x87-using C/foreign libraries running alongside Racket.
---
 collects/ffi/unsafe.rkt                   |   4 +-
 collects/ffi/vector.rkt                   |   7 +
 collects/scribblings/foreign/types.scrbl  |   7 +
 collects/scribblings/foreign/vector.scrbl |  44 ++--
 collects/tests/racket/foreign-test.rktl   |  17 +-
 collects/tests/racket/optimize.rktl       | 261 +++++++++++++++++++++-
 collects/tests/racket/unsafe.rktl         |  22 +-
 doc/release-notes/racket/HISTORY.txt      |   3 +
 src/foreign/foreign.c                     | 109 +++++++--
 src/foreign/foreign.rktc                  |  39 +++-
 src/racket/src/cstartup.inc               |  50 ++---
 src/racket/src/jit.c                      | 100 ++++++---
 src/racket/src/jit.h                      |  13 +-
 src/racket/src/jitalloc.c                 |   6 +-
 src/racket/src/jitarith.c                 |  45 ++--
 src/racket/src/jitcall.c                  | 192 ++++++++--------
 src/racket/src/jitcommon.c                |  33 ++-
 src/racket/src/jitinline.c                |  26 ++-
 src/racket/src/lightning/i386/fp-extfpu.h |  13 ++
 src/racket/src/number.c                   |  88 +++++++-
 src/racket/src/schminc.h                  |   2 +-
 src/racket/src/schvers.h                  |   4 +-
 22 files changed, 844 insertions(+), 241 deletions(-)

diff --git a/collects/ffi/unsafe.rkt b/collects/ffi/unsafe.rkt
index abe3718eb8..56239c0fa2 100644
--- a/collects/ffi/unsafe.rkt
+++ b/collects/ffi/unsafe.rkt
@@ -10,12 +10,12 @@
          cpointer? cpointer-gcable? prop:cpointer
          ptr-equal? ptr-add ptr-ref ptr-set! (protect-out cast)
          ptr-offset ptr-add! offset-ptr? set-ptr-offset!
-         vector->cpointer flvector->cpointer saved-errno lookup-errno
+         vector->cpointer flvector->cpointer extflvector->cpointer saved-errno lookup-errno
          ctype? make-ctype make-cstruct-type make-array-type make-union-type
          make-sized-byte-string ctype->layout
          _void _int8 _uint8 _int16 _uint16 _int32 _uint32 _int64 _uint64
          _fixint _ufixint _fixnum _ufixnum
-         _float _double _double*
+         _float _double _longdouble _double*
          _bool _pointer _gcpointer _scheme (rename-out [_scheme _racket]) _fpointer function-ptr
          memcpy memmove memset
          malloc-immobile-cell free-immobile-cell
diff --git a/collects/ffi/vector.rkt b/collects/ffi/vector.rkt
index 801319934b..f2e61d6e78 100644
--- a/collects/ffi/vector.rkt
+++ b/collects/ffi/vector.rkt
@@ -2,6 +2,8 @@
 
 (require "unsafe.rkt"
          racket/unsafe/ops
+         racket/extflonum
+         (for-syntax racket/extflonum)
          (for-syntax racket/base))
 
 (define-syntax define*
@@ -37,6 +39,7 @@
                      [_TAG*        (id "_" "*")]
                      [TAGname      name]
                      [f64?         (if (eq? (syntax-e #'TAG) 'f64) #'#t #'#f)]
+                     [f80?         (if (eq? (syntax-e #'TAG) 'f80) #'#t #'#f)]
                      [s16?         (if (eq? (syntax-e #'TAG) 's16) #'#t #'#f)]
                      [u16?         (if (eq? (syntax-e #'TAG) 'u16) #'#t #'#f)])
          #'(begin
@@ -62,6 +65,7 @@
                        ;; use JIT-inlined operation if available:
                        (cond
                         [f64? (unsafe-f64vector-ref v i)]
+                        [f80? (unsafe-f80vector-ref v i)]
                         [s16? (unsafe-s16vector-ref v i)]
                         [u16? (unsafe-u16vector-ref v i)]
                         [else (ptr-ref (TAG-ptr v) type i)])
@@ -75,6 +79,8 @@
                        (cond
                         [(and f64? (inexact-real? x))
                          (unsafe-f64vector-set! v i x)]
+                        [(and f80? (extflonum? x))
+                         (unsafe-f80vector-set! v i x)]
                         [(and s16? (fixnum? x) (unsafe-fx<= -32768 x) (unsafe-fx<= x 32767))
                          (unsafe-s16vector-set! v i x)]
                         [(and u16? (fixnum? x) (unsafe-fx<= 0 x) (unsafe-fx<= x 65535))
@@ -135,6 +141,7 @@
 (srfi-4-define/provide u64 _uint64)
 (srfi-4-define/provide f32 _float)
 (srfi-4-define/provide f64 _double*)
+(srfi-4-define/provide f80 _longdouble)
 
 ;; simply rename bytes* to implement the u8vector type
 (provide (rename-out [bytes?       u8vector?      ]
diff --git a/collects/scribblings/foreign/types.scrbl b/collects/scribblings/foreign/types.scrbl
index f24bd1c6d1..b401f7f277 100644
--- a/collects/scribblings/foreign/types.scrbl
+++ b/collects/scribblings/foreign/types.scrbl
@@ -180,6 +180,13 @@ coerce C values to double-precision Racket numbers.
 The type @racket[_double*]
 coerces any Racket real number to a C @cpp{double}.}
 
+@defthing[_longdouble ctype?]{
+
+Represents the @cpp{long double} type on platforms where it is
+supported, in which case Racket @tech[#:doc
+reference.scrbl]{extflonums} convert to and from @cpp{long double}
+values.}
+
 @; ------------------------------------------------------------
 
 @section{Other Atomic Types}
diff --git a/collects/scribblings/foreign/vector.scrbl b/collects/scribblings/foreign/vector.scrbl
index 5392c0f086..68b7be1349 100644
--- a/collects/scribblings/foreign/vector.scrbl
+++ b/collects/scribblings/foreign/vector.scrbl
@@ -1,5 +1,8 @@
 #lang scribble/doc
-@(require "utils.rkt" (only-in scribble/decode make-splice))
+@(require "utils.rkt" 
+          (only-in scribble/decode make-splice)
+          scribble/racket
+          (for-label racket/extflonum))
 
 @title[#:tag "homogeneous-vectors"]{Safe Homogenous Vectors}
 
@@ -7,7 +10,7 @@
 
 Homogenous vectors are similar to C vectors (see
 @secref["foreign:cvector"]), except that they define different types
-of vectors, each with a hard-wired type. An exception is the
+of vectors, each with a fixed element type. An exception is the
 @racketidfont{u8} family of bindings, which are just aliases for
 byte-string bindings; for example, @racket[make-u8vector] is an alias
 for @racket[make-bytes].
@@ -16,12 +19,12 @@ for @racket[make-bytes].
    (require (for-syntax scheme/base))
    (define-syntax (srfi-4-vector stx)
      (syntax-case stx ()
-       [(_ id elem)
-        #'(srfi-4-vector/desc id elem make-splice
+       [(_ id elem number?)
+        #'(srfi-4-vector/desc id elem number? make-splice
             "Like " (racket make-vector) ", etc., but for " (racket elem) " elements.")]))
    (define-syntax (srfi-4-vector/desc stx)
      (syntax-case stx ()
-       [(_ id elem extra desc ...)
+       [(_ id elem as-number? extra desc ...)
         (let ([mk
                (lambda l
                  (datum->syntax
@@ -44,7 +47,10 @@ for @racket[make-bytes].
                         [->list (mk #'id "vector->list")]
                         [->cpointer (mk #'id "vector->cpointer")]
                         [_vec (mk "_" #'id "vector")])
-            #`(begin
+            #`(let-syntax ([number? (make-element-id-transformer
+                                     (lambda (stx)
+                                       #'(racket as-number?)))])
+              (list
                (defproc* ([(make [len exact-nonnegative-integer?]) ?]
                           [(vecr [val number?] (... ...)) ?]
                           [(? [v any/c]) boolean?]
@@ -92,22 +98,22 @@ for @racket[make-bytes].
                                    10))
                            _vec]
                  "Like " (racket _cvector) ", but for vectors of "
-                 (racket elem) " elements."))))])))
+                 (racket elem) " elements.")))))])))
 
 
-@srfi-4-vector/desc[u8 _uint8 (lambda (x) (make-splice null))]{
+@srfi-4-vector/desc[u8 _uint8 byte? (lambda (x) (make-splice null))]{
 
-Like @racket[_cvector], but for vectors of @racket[_byte] elements. These are
+Like @racket[_cvector], but for vectors of @racket[_uint8] elements. These are
 aliases for @racketidfont{byte} operations, where @racket[u8vector->cpointer]
 is the identity function.}
 
-@srfi-4-vector[s8 _int8]
-@srfi-4-vector[s16 _int16]
-@srfi-4-vector[u16 _uint16]
-@srfi-4-vector[s32 _int32]
-@srfi-4-vector[u32 _uint32]
-@srfi-4-vector[s64 _int64]
-@srfi-4-vector[u64 _uint64]
-@srfi-4-vector[f32 _float]
-@srfi-4-vector[f64 _double*]
-
+@srfi-4-vector[s8 _int8 (integer-in -128 127)]
+@srfi-4-vector[s16 _int16 (integer-in -32768 32767)]
+@srfi-4-vector[u16 _uint16 (integer-in 0 65535)]
+@srfi-4-vector[s32 _int32 (integer-in -2147483648 2147483647)]
+@srfi-4-vector[u32 _uint32 (integer-in 0 4294967295)]
+@srfi-4-vector[s64 _int64 (integer-in -9223372036854775808 9223372036854775807)]
+@srfi-4-vector[u64 _uint64 (integer-in 0 18446744073709551615)]
+@srfi-4-vector[f32 _float real?]
+@srfi-4-vector[f64 _double* real?]
+@srfi-4-vector[f80 _longdouble extflonum?]
diff --git a/collects/tests/racket/foreign-test.rktl b/collects/tests/racket/foreign-test.rktl
index 135c5a56c8..4beb061338 100644
--- a/collects/tests/racket/foreign-test.rktl
+++ b/collects/tests/racket/foreign-test.rktl
@@ -3,8 +3,10 @@
 
 (Section 'foreign)
 
-(require mzlib/foreign)
-(unsafe!)
+(require ffi/unsafe
+         ffi/unsafe/cvector
+         ffi/vector
+         racket/extflonum)
 
 (test #f malloc 0)
 (test #f malloc 0 _int)
@@ -481,6 +483,17 @@
   (define _values (get-ffi-obj 'scheme_values #f (_fun _int (_list i _racket) -> _racket)))
   (test-values '(1 "b" three) (lambda () (_values 3 (list 1 "b" 'three)))))
 
+(when (extflonum-available?)
+  (define m (malloc _longdouble))
+  (ptr-set! m _longdouble 13.57t0)
+  (test 13.57t0 ptr-ref m _longdouble)
+
+  (define v (extflvector 1.1t0 2.2t0 3.3t0))
+  (test 3.3t0 extflvector-ref v 2)
+  (test (void) extflvector-set! v 2 4.4t0)
+  (test 4.4t0 extflvector-ref v 2)
+  (test 2.2t0 ptr-ref (ptr-add (extflvector->cpointer v) (ctype-sizeof _longdouble)) _longdouble))
+
 (report-errs)
 
 #| --- ignore everything below ---
diff --git a/collects/tests/racket/optimize.rktl b/collects/tests/racket/optimize.rktl
index c6de5ecf29..32340ea3cb 100644
--- a/collects/tests/racket/optimize.rktl
+++ b/collects/tests/racket/optimize.rktl
@@ -4,6 +4,7 @@
 (Section 'optimization)
 
 (require racket/flonum
+         racket/extflonum
          racket/fixnum
          racket/unsafe/ops
          compiler/zo-parse
@@ -15,6 +16,7 @@
 (parameterize ([current-namespace (make-base-namespace)]
 	       [eval-jit-enabled #t])
   (namespace-require 'racket/flonum)
+  (namespace-require 'racket/extflonum)
   (namespace-require 'racket/fixnum)
   (eval '(define-values (prop:thing thing? thing-ref) 
            (make-struct-type-property 'thing)))
@@ -25,7 +27,7 @@
          [check-error-message (lambda (name proc [fixnum? #f])
 				(unless (memq name '(eq? eqv? equal? 
                                                          not null? pair? list?
-							 real? number? boolean? 
+							 real? number? boolean?
 							 procedure? symbol?
 							 string? bytes?
 							 vector? box?
@@ -71,7 +73,7 @@
 	 [bin0 (lambda (v op arg1 arg2)
 		 ;; (printf "Trying ~a ~a ~a\n" op arg1 arg2);
 		 (let ([name `(,op ,arg1 ,arg2)])
-		   (test v name ((eval `(lambda (x) (,op x ',arg2))) arg1))
+                   (test v name ((eval `(lambda (x) (,op x ',arg2))) arg1))
 		   (test v name ((eval `(lambda (x) (,op ',arg1 x))) arg2))
 		   (test v name ((eval `(lambda (x y) (,op x y))) arg1 arg2))
 		   (test v name ((eval `(lambda (x y) 
@@ -172,6 +174,7 @@
                         (check-error-message op (eval `(lambda (x) (,op (,get-arg1) ,arg2 x)))))
 		      (tri0 v op get-arg1 arg2 arg3 check-effect))])
 
+       
     (un #f 'null? 0)
     (un-exact #t 'null? '())
     (un #f 'pair? 0)
@@ -662,6 +665,99 @@
     (tri0 '(1 2 . 3) 'list* (lambda () 1) 2 3 void)
     (un0 '#&1 'box 1)
 
+    (when (extflonum-available?)
+      (define (extflonum-close? fl1 fl2)
+        (extfl<= (extflabs (fl- fl1 fl2))
+                 (real->extfl 1e-8)))
+      
+      (bin-exact #t 'extfl< 100.0t0 200.0t0 #t)
+      (bin-exact #f 'extfl< 200.0t0 100.0t0)
+      (bin-exact #f 'extfl< 200.0t0 200.0t0)
+      
+      (bin-exact #t 'extfl<= 100.0t0 200.0t0 #t)
+      (bin-exact #f 'extfl<= 200.0t0 100.0t0)
+      (bin-exact #t 'extfl<= 200.0t0 200.0t0)
+      
+      (bin-exact #f 'extfl> 100.0t0 200.0t0 #t)
+      (bin-exact #t 'extfl> 200.0t0 100.0t0)
+      (bin-exact #f 'extfl> 200.0t0 200.0t0)
+      
+      (bin-exact #f 'extfl>= 100.0t0 200.0t0 #t)
+      (bin-exact #t 'extfl>= 200.0t0 100.0t0)
+      (bin-exact #t 'extfl>= 200.0t0 200.0t0)
+
+      (bin-exact #f 'extfl= 100.0t0 200.0t0 #t)
+      (bin-exact #t 'extfl= 200.0t0 200.0t0)
+
+      (un-exact 3.0t0 'extflabs -3.0t0 #t)
+      (un-exact 3.0t0 'extflsqrt 9.0t0 #t)
+      (un-exact +nan.t 'extflsqrt -9.0t0)
+      
+      (let ([test-trig
+             (lambda (trig extfltrig)
+               ;;(un (real->extfl (trig 1.0)) extfltrig 1.0t0 #t)
+               (un +nan.t extfltrig +nan.t))])
+        (test-trig sin 'extflsin)
+        (test-trig cos 'extflcos)
+        (test-trig tan 'extfltan)
+        (test-trig asin 'extflasin)
+        (test-trig acos 'extflacos)
+        (test-trig atan 'extflatan)
+        (test-trig log 'extfllog)
+        (test-trig exp 'extflexp))
+
+      (when (extflonum-available?)
+        (for-each
+         (lambda (v)
+           (define (once v)
+             (define (->fl v) (extfl->inexact v))
+             (define (->extfl v) (real->extfl v))
+             (un-exact (->extfl (round (->fl v))) 'extflround v #t)
+             (un-exact (->extfl (ceiling (->fl v))) 'extflceiling v #t)
+             (un-exact (->extfl (floor (->fl v))) 'extflfloor v #t)
+             (un-exact (->extfl (truncate (->fl v))) 'extfltruncate v #t))
+          (once v)
+          (once (extfl- 0.0t0 v)))
+         '(3.0t0 3.1t0 3.5t0 3.8t0 4.0t0 4.1t0 4.5t0 4.8t0 0.0t0)))
+
+      (bin-exact 9.0t0 'extflexpt 3.0t0 2.0t0 #t)
+      (bin-exact (extflexpt 3.1t0 2.5t0) 'extflexpt 3.1t0 2.5t0 #t)
+      (bin-exact -1.0t0 'extflexpt -1.0t0 3.0t0 #t)
+      (bin-exact -0.125t0 'extflexpt -2.0t0 -3.0t0 #t)
+      (bin-exact +nan.t 'extflexpt -1.0t0 3.1t0 #t)
+      (bin-exact 0.0t0 'extflexpt 0.0t0 10.0t0 #t)
+      (bin-exact +inf.t 'extflexpt 0.0t0 -1.0t0 #t)
+      (bin-exact +1.0t0 'extflexpt 0.0t0 0.0t0 #t)
+      (bin-exact +nan.t 'extflexpt +nan.t 2.7t0 #t)
+      (bin-exact +nan.t 'extflexpt 2.7t0 +nan.t #t)
+      (bin-exact +nan.t 'extflexpt +nan.t +nan.t #t)
+
+      (un-exact 10.0t0 '->extfl 10)
+      (un-exact 10.0t0 'fx->extfl 10)
+
+      (un-exact 11 'extfl->exact-integer 11.0t0 #t)
+      (un-exact -1 'extfl->exact-integer -1.0t0)
+      (un-exact (inexact->exact 5e200) 'extfl->exact-integer (real->extfl 5e200))
+      (un-exact 11 'extfl->fx 11.0t0 #t)
+      (un-exact -11 'extfl->fx -11.0t0)
+
+      (bin-exact -0.75t0 'extfl- 1.5t0 2.25t0 #t)
+
+      (bin-exact 3.0t0 'extflmin 3.0t0 4.5t0 #t)
+      (bin-exact 2.5t0 'extflmin 3.0t0 2.5t0)
+      (bin0 3.5t0 '(lambda (x y) (extfl+ 1.0t0 (extflmin x y))) 3.0t0 2.5t0)
+      (bin0 4.0t0 '(lambda (x y) (extfl+ 1.0t0 (extflmin x y))) 3.0t0 4.5t0)
+
+      (bin-exact 4.5t0 'extflmax 3.0t0 4.5t0 #t)
+      (bin-exact 3.0t0 'extflmax 3.0t0 2.5t0)
+      (bin0 5.5t0 '(lambda (x y) (extfl+ 1.0t0 (extflmax x y))) 3.0t0 4.5t0)
+      (bin0 4.0t0 '(lambda (x y) (extfl+ 1.0t0 (extflmax x y))) 3.0t0 2.5t0)
+
+      (bin-exact 1.1t0 'extflvector-ref (extflvector 1.1t0 2.2t0 3.3t0) 0 #t)
+      (bin-exact 3.3t0 'extflvector-ref (extflvector 1.1t0 2.2t0 3.3t0) 2)
+      (un-exact 3 'extflvector-length (extflvector 1.1t0 2.2t0 3.3t0) #t)
+      )
+    
     (let ([test-setter
 	   (lambda (make-X def-val set-val set-name set ref 3rd-all-ok?)
 	     (let ([v (make-X 3 def-val)])
@@ -1535,6 +1631,15 @@
               (+ (unsafe-flvector-length x) (unsafe-flvector-length x)))
            #f)
 
+(when (extflonum-available?)
+  (test-comp '(lambda (x)
+              (let ([y (unsafe-extflvector-length x)])
+                (let ([f (lambda () y)])
+                  (+ (f) (f)))))
+           '(lambda (x)
+              (+ (unsafe-extflvector-length x) (unsafe-extflvector-length x)))
+           #f))
+
 ;; don't delay an unsafe car, because it might be space-unsafe
 (test-comp '(lambda (f x)
               (let ([y (unsafe-car x)])
@@ -1585,6 +1690,38 @@
                     f)))
            #f)
 
+(when (extflonum-available?)
+  ;; don't duplicate formerly once-used variable due to inlining
+  (test-comp '(lambda (y)
+                (let ([q (unsafe-extfl* y y)]) ; => q is known flonum
+                  (let ([x (unsafe-extfl* q q)]) ; can delay (but don't duplicate)
+                    (define (f z) (unsafe-extfl+ z x))
+                    (if y
+                        (f 10)
+                        f))))
+             '(lambda (y)
+                (let ([q (unsafe-extfl* y y)])
+                  (let ([x (unsafe-extfl* q q)])
+                    (define (f z) (unsafe-extfl+ z x))
+                    (if y
+                        (unsafe-extfl+ 10 x)
+                        f)))))
+  ;; double-check that previous test doesn't succeed due to copying
+  (test-comp '(lambda (y)
+                (let ([q (unsafe-extfl* y y)])
+                  (let ([x (unsafe-extfl* q q)])
+                    (define (f z) (unsafe-extfl+ z x))
+                    (if y
+                        (unsafe-extfl+ 10 x)
+                        f))))
+             '(lambda (y)
+                (let ([q (unsafe-extfl* y y)])
+                  (define (f z) (unsafe-extfl+ z (unsafe-extfl* q q)))
+                  (if y
+                      (unsafe-extfl+ 10 (unsafe-extfl* q q))
+                      f)))
+             #f))
+
 ;; check move through an intermediate variable:
 (test-comp '(lambda (n)
               (let ([p (+ n n)])
@@ -1768,7 +1905,18 @@
          (unsafe-fxvector-set! x x x)
          (unsafe-f64vector-set! x x x)
          (unsafe-s16vector-set! x x x)
-         (unsafe-u16vector-set! x x x))))
+         (unsafe-u16vector-set! x x x)))
+
+  (when (extflonum-available?)
+    (map check-omit-ok
+         '((unsafe-extflvector-ref x x)
+           (unsafe-f80vector-ref x x)))
+
+    (map (lambda (x) (check-omit-ok x #f))
+         '((unsafe-extflvector-set! x x x)
+           (unsafe-f80vector-set! x x x)
+           ))
+    ))
 
 (test-comp '(lambda (x)
               (hash-ref '#hash((x . y)) x (lambda () 10)))
@@ -1953,6 +2101,8 @@
                (list (c? (c-q (c 1 2 3))))
                5)))
 
+
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Check splitting of definitions
 (test-comp `(module m racket/base
@@ -2191,6 +2341,22 @@
                   (f y (sub1 y)))))
         (f 1.0 100)))
 
+(when (extflonum-available?)
+  (test '(done)
+      'unboxing-inference-test
+      (let ()
+        (define (f x y)
+          (if (zero? y)
+              ;; prevents inlining:
+              '(done)
+              (if (zero? y)
+                  ;; incorrectly triggered unboxing, 
+                  ;; once upon a time:
+                  (extfl+ x 1.0t0) 
+                  ;; not a float argument => no unboxing of x:
+                  (f y (sub1 y)))))
+        (f 1.0t0 100))))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Test against letrec-splitting bug:
 
@@ -2257,6 +2423,19 @@
                (regexp-match #rx"1e[+]?100" (exn-message exn))))
 (test (inexact->exact 1e100) (lambda (x) (inexact->exact (fl/ (fl- x 0.0) 1.0))) 1e100)
 
+(when (extflonum-available?)
+  (test 1 (lambda (x) (extfl->fx (extfl/ (extfl- x 0.0t0) 1.0t0))) 1.0t0)
+  (test 1 (lambda (x) (extfl->exact (extfl/ (extfl- x 0.0t0) 1.0t0))) 1.0t0)
+  (err/rt-test (let ([f (lambda (x) (extfl->fx (extfl/ (extfl- x 0.0t0) 1.0t0)))])
+                 (set! f f)
+                 (f 1t100))
+               ;; make sure that exception reports actual bad argument, and
+               ;; not some bad argument due to the fact that the original
+               ;; was unboxed:
+               (lambda (exn)
+                 (regexp-match #rx"1t[+]?100" (exn-message exn))))
+  (test (extfl->exact 1t100) (lambda (x) (extfl->exact (extfl/ (extfl- x 0.0t0) 1.0t0))) 1t100))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Check that compiler handles shifting `#%variable-reference'
 
@@ -2396,6 +2575,51 @@
   (test -2200000.0 non-tail2)
   (test-values '(-100001.0 100001.0) tail))
 
+
+(when (extflonum-available?)
+  (let ()
+    (define N 100000)
+    
+    (define (non-tail)
+      (define-values (a b)
+        (let loop ([n N] [x -1.0t0] [y 1.0t0])
+          (cond
+           [(zero? n) (values x y)]
+           [else (loop (sub1 n)
+                       (extfl+ x -1.0t0)
+                       (extfl+ y 1.0t0))])))
+      (values a b))
+    
+    (define (non-tail2ext)
+      (for/fold ([v 0.0t0]) ([i (in-range N)])
+        (define-values (a b)
+          (let loop ([n 10] [x -1.0t0] [y 1.0t0])
+            (cond
+             [(zero? n) (values x y)]
+             [else (loop (sub1 n)
+                         (extfl+ x -1.0t0)
+                         (extfl+ y 1.0t0))])))
+        (extfl+ v (extfl- a b))))
+    
+    (define (tail)
+      (let loop ([n N] [x -1.0t0] [y 1.0t0])
+        (cond
+         [(zero? n) (values x y)]
+         [else (loop (sub1 n)
+                     (extfl+ x -1.0t0)
+                     (extfl+ y 1.0t0))])))
+
+    (define x-tail #f)
+    (define x-non-tail #f)
+    (define x-non-tail2ext #f)
+    (set! x-tail tail)
+    (set! x-non-tail non-tail)
+    (set! x-non-tail2ext non-tail2ext)
+
+    (test-values '(-100001.0t0 100001.0t0) non-tail)
+    (test -2200000.0t0 non-tail2ext)
+    (test-values '(-100001.0t0 100001.0t0) tail)))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Check for corect fixpoint calculation when lifting
 
@@ -2614,6 +2838,24 @@
     ;; too-aggressive compilation produces a validator failure here
     (read (open-input-bytes (get-output-bytes o)))))
 
+(when (extflonum-available?)
+  (let ([m '(module m racket/base
+              (require racket/extflonum)
+              (define (f x)
+                (letrec ([z (if x (other 1) 'none)]
+                         [collect (lambda (x)
+                                    (lambda (n)
+                                      (list '(1 2 3)
+                                            (extfl+ n x))))]
+                         [a (collect 0.0t0)]
+                         [other 6])
+                  (values a z))))])
+    (define o (open-output-bytes))
+    (write (compile m) o)
+    (parameterize ([read-accept-compiled #t])
+      ;; too-aggressive compilation produces a validator failure here
+      (read (open-input-bytes (get-output-bytes o))))))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; check error checking of JITted `continuation-mark-set-first'
 
@@ -2636,6 +2878,19 @@
   
   (test 4.0 (f 1.0) 2.0))
 
+(when (extflonum-available?)
+  (let ()
+    (define f #f)
+    (set! f
+          (lambda (x)
+            (let ([x (extfl+ x x)])
+              (case-lambda
+                [() (extfl+ x x)]
+                [(y) (extfl+ x y)]))))
+    
+    (test 4.0t0 (f 1.0t0) 2.0t0)
+    ))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
diff --git a/collects/tests/racket/unsafe.rktl b/collects/tests/racket/unsafe.rktl
index 52c7fffede..afe1a6ede2 100644
--- a/collects/tests/racket/unsafe.rktl
+++ b/collects/tests/racket/unsafe.rktl
@@ -380,7 +380,15 @@
       (test-tri (list (void) 27.4t0) 'unsafe-extflvector-set! v 2 27.4t0
                 #:pre (lambda () (extflvector-set! v 2 0.0t0))
                 #:post (lambda (x) (list x (extflvector-ref v 2)))
-                #:literal-ok? #f)))
+                #:literal-ok? #f))
+
+    (test-bin 9.5t0 'unsafe-f80vector-ref (f80vector 1.0t0 9.5t0 18.7t0) 1)
+    (let ([v (f80vector 1.0t0 9.5t0 18.7t0)])
+      (test-tri (list (void) 27.4t0) 'unsafe-f80vector-set! v 2 27.4t0
+                #:pre (lambda () (f80vector-set! v 2 0.0t0)) 
+                #:post (lambda (x) (list x (f80vector-ref v 2)))
+                #:literal-ok? #f))
+    )
 
   (test-bin 95 'unsafe-fxvector-ref (fxvector 10 95 187) 1)
   (test-un 5 'unsafe-fxvector-length (fxvector 11 20 31 45 57))
@@ -437,6 +445,13 @@
                    (unsafe-f64vector-ref y 1))
             1.2 (f64vector 1.0 4.2 6.7) 2.0)
 
+  (when (extflonum-available?)
+    (test-tri 5.3999999999999999997t0 '(lambda (x y z) (unsafe-extfl+ x (unsafe-f80vector-ref y z))) 1.2t0 (f80vector 1.0t0 4.2t0 6.7t0) 1)
+    (test-tri 3.2t0 '(lambda (x y z) 
+                       (unsafe-f80vector-set! y 1 (unsafe-extfl+ x z))
+                       (unsafe-f80vector-ref y 1))
+              1.2t0 (f80vector 1.0t0 4.2t0 6.7t0) 2.0t0))
+
   (void))
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -472,7 +487,7 @@
                            (- n 1))))))])
   (test 500000.0 f 1.0))
 
-(when (extflonum-available?)
+(when (extflonum-available?) 
   (let ([f (lambda (x)
              (let ([x (unsafe-extfl+ x 1.0t0)])
                (let loop ([v 0.0t0][n 10000])
@@ -490,7 +505,6 @@
                            (- n 1)
                            (unsafe-extfl- 0.0t0 q))))))])
     (test 20002.0t0 f 1.0t0))
-
   (let ([f (lambda (x)
              (let loop ([a 0.0t0][v 0.0t0][n 1000000])
                (if (zero? n)
@@ -502,7 +516,7 @@
                        (loop a
                              (unsafe-extfl+ v x)
                              (- n 1))))))])
-    (test 1000000.0t0 f 2.0t0)))
+    (test 500000.0t0 f 1.0t0)))
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
diff --git a/doc/release-notes/racket/HISTORY.txt b/doc/release-notes/racket/HISTORY.txt
index 01eb0fa812..a2578bfaf4 100644
--- a/doc/release-notes/racket/HISTORY.txt
+++ b/doc/release-notes/racket/HISTORY.txt
@@ -1,3 +1,6 @@
+Version 5.3.3.3
+ffi/vector: added f8vectors
+
 Version 5.3.3.2
 Added port-counts-lines?
 
diff --git a/src/foreign/foreign.c b/src/foreign/foreign.c
index 7830f9337c..4a242ae881 100644
--- a/src/foreign/foreign.c
+++ b/src/foreign/foreign.c
@@ -780,8 +780,42 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
  * C->Racket:   scheme_make_double(<C>)
  */
 
+#define ffi_type_slongdouble ffi_type_longdouble
+#ifdef MZ_LONG_DOUBLE
+typedef long double mz_long_double;
+#else /* MZ_LONG_DOUBLE undefined */
+typedef double mz_long_double;
+#endif /* MZ_LONG_DOUBLE */
+#ifdef MZ_LONG_DOUBLE
+#define SCHEME_MAYBE_LONG_DBL_VAL(x) SCHEME_LONG_DBL_VAL(x)
+#else /* MZ_LONG_DOUBLE undefined */
+#define SCHEME_MAYBE_LONG_DBL_VAL(x) unsupported_long_double_val()
+static mz_long_double unsupported_long_double_val() {
+  scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, "_longdouble: " NOT_SUPPORTED_STR);
+  return 0.0;
+}
+#endif /* MZ_LONG_DOUBLE */
+#ifdef MZ_LONG_DOUBLE
+#define scheme_make_maybe_long_double(x) scheme_make_long_double(x)
+#else /* MZ_LONG_DOUBLE undefined */
+#define scheme_make_maybe_long_double(x) unsupported_make_long_double()
+static Scheme_Object *unsupported_make_long_double() {
+  scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, "_longdouble: " NOT_SUPPORTED_STR);
+  return NULL;
+}
+#endif /* MZ_LONG_DOUBLE */
+#define FOREIGN_longdouble (16)
+/* Type Name:   longdouble
+ * LibFfi type: ffi_type_slongdouble
+ * C type:      mz_long_double
+ * Predicate:   SCHEME_LONG_DBLP(<Scheme>)
+ * Racket->C:   SCHEME_MAYBE_LONG_DBL_VAL(<Scheme>)
+ * S->C offset: 0
+ * C->Racket:   scheme_make_maybe_long_double(<C>)
+ */
+
 /* A double that will coerce numbers to doubles: */
-#define FOREIGN_doubleS (16)
+#define FOREIGN_doubleS (17)
 /* Type Name:   double* (doubleS)
  * LibFfi type: ffi_type_double
  * C type:      double
@@ -792,7 +826,7 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
  */
 
 /* Booleans -- implemented as an int which is 1 or 0: */
-#define FOREIGN_bool (17)
+#define FOREIGN_bool (18)
 /* Type Name:   bool
  * LibFfi type: ffi_type_sint
  * C type:      int
@@ -806,7 +840,7 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
  * #f is not NULL only for byte-strings, for other strings it is
  * meaningless to use NULL. */
 
-#define FOREIGN_string_ucs_4 (18)
+#define FOREIGN_string_ucs_4 (19)
 /* Type Name:   string/ucs-4 (string_ucs_4)
  * LibFfi type: ffi_type_gcpointer
  * C type:      mzchar*
@@ -816,7 +850,7 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
  * C->Racket:   scheme_make_char_string_without_copying(<C>)
  */
 
-#define FOREIGN_string_utf_16 (19)
+#define FOREIGN_string_utf_16 (20)
 /* Type Name:   string/utf-16 (string_utf_16)
  * LibFfi type: ffi_type_gcpointer
  * C type:      unsigned short*
@@ -829,7 +863,7 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
 /* Byte strings -- not copying C strings, #f is NULL.
  * (note: these are not like char* which is just a pointer) */
 
-#define FOREIGN_bytes (20)
+#define FOREIGN_bytes (21)
 /* Type Name:   bytes
  * LibFfi type: ffi_type_gcpointer
  * C type:      char*
@@ -839,7 +873,7 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
  * C->Racket:   (<C>==NULL)?scheme_false:scheme_make_byte_string_without_copying(<C>)
  */
 
-#define FOREIGN_path (21)
+#define FOREIGN_path (22)
 /* Type Name:   path
  * LibFfi type: ffi_type_gcpointer
  * C type:      char*
@@ -849,7 +883,7 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
  * C->Racket:   (<C>==NULL)?scheme_false:scheme_make_path_without_copying(<C>)
  */
 
-#define FOREIGN_symbol (22)
+#define FOREIGN_symbol (23)
 /* Type Name:   symbol
  * LibFfi type: ffi_type_pointer
  * C type:      char*
@@ -862,7 +896,7 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
 /* This is for any C pointer: #f is NULL, cpointer values as well as
  * ffi-obj and string values pass their pointer.  When used as a return
  * value, either a cpointer object or #f is returned. */
-#define FOREIGN_pointer (23)
+#define FOREIGN_pointer (24)
 /* Type Name:   pointer
  * LibFfi type: ffi_type_pointer
  * C type:      void*
@@ -872,7 +906,7 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
  * C->Racket:   scheme_make_foreign_external_cpointer(<C>)
  */
 
-#define FOREIGN_gcpointer (24)
+#define FOREIGN_gcpointer (25)
 /* Type Name:   gcpointer
  * LibFfi type: ffi_type_gcpointer
  * C type:      void*
@@ -884,7 +918,7 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
 
 /* This is used for passing and Scheme_Object* value as is.  Useful for
  * functions that know about Scheme_Object*s, like Racket's. */
-#define FOREIGN_scheme (25)
+#define FOREIGN_scheme (26)
 /* Type Name:   scheme
  * LibFfi type: ffi_type_gcpointer
  * C type:      Scheme_Object*
@@ -897,7 +931,7 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
 /* Special type, not actually used for anything except to mark values
  * that are treated like pointers but not referenced.  Used for
  * creating function types. */
-#define FOREIGN_fpointer (26)
+#define FOREIGN_fpointer (27)
 /* Type Name:   fpointer
  * LibFfi type: ffi_type_pointer
  * C type:      void*
@@ -922,6 +956,7 @@ typedef union _ForeignAny {
   uintptr_t x_ufixnum;
   float x_float;
   double x_double;
+  mz_long_double x_longdouble;
   double x_doubleS;
   int x_bool;
   mzchar* x_string_ucs_4;
@@ -936,9 +971,9 @@ typedef union _ForeignAny {
 } ForeignAny;
 
 /* This is a tag that is used to identify user-made struct types. */
-#define FOREIGN_struct (27)
-#define FOREIGN_array (28)
-#define FOREIGN_union (29)
+#define FOREIGN_struct (28)
+#define FOREIGN_array (29)
+#define FOREIGN_union (30)
 
 XFORM_NONGCING static int is_gcable_pointer(Scheme_Object *o) {
   if (SCHEME_FFIOBJP(o)) return 0;
@@ -1069,6 +1104,7 @@ XFORM_NONGCING static intptr_t ctype_sizeof(Scheme_Object *type)
   case FOREIGN_ufixnum: return sizeof(uintptr_t);
   case FOREIGN_float: return sizeof(float);
   case FOREIGN_double: return sizeof(double);
+  case FOREIGN_longdouble: return sizeof(mz_long_double);
   case FOREIGN_doubleS: return sizeof(double);
   case FOREIGN_bool: return sizeof(int);
   case FOREIGN_string_ucs_4: return sizeof(mzchar*);
@@ -1667,6 +1703,7 @@ static Scheme_Object *C2SCHEME(Scheme_Object *already_ptr, Scheme_Object *type,
     case FOREIGN_ufixnum: return scheme_make_integer_from_unsigned(REF_CTYPE(uintptr_t));
     case FOREIGN_float: return scheme_make_double(REF_CTYPE(float));
     case FOREIGN_double: return scheme_make_double(REF_CTYPE(double));
+    case FOREIGN_longdouble: return scheme_make_maybe_long_double(REF_CTYPE(mz_long_double));
     case FOREIGN_doubleS: return scheme_make_double(REF_CTYPE(double));
     case FOREIGN_bool: return (REF_CTYPE(int)?scheme_true:scheme_false);
     case FOREIGN_string_ucs_4: return scheme_make_char_string_without_copying(REF_CTYPE(mzchar*));
@@ -1902,6 +1939,21 @@ static void* SCHEME2C(const char *who,
         wrong_value(who, "_double", val);;
         return NULL; /* hush the compiler */
       }
+    case FOREIGN_longdouble:
+#     ifdef SCHEME_BIG_ENDIAN
+      if (sizeof(mz_long_double)<sizeof(intptr_t) && ret_loc) {
+        ((int*)W_OFFSET(dst,delta))[0] = 0;
+        delta += (sizeof(intptr_t)-sizeof(mz_long_double));
+      }
+#     endif /* SCHEME_BIG_ENDIAN */
+      if (SCHEME_LONG_DBLP(val)) {
+        mz_long_double tmp;
+        tmp = (mz_long_double)(SCHEME_MAYBE_LONG_DBL_VAL(val));
+        (((mz_long_double*)W_OFFSET(dst,delta))[0]) = tmp; return NULL;
+      } else {
+        wrong_value(who, "_longdouble", val);;
+        return NULL; /* hush the compiler */
+      }
     case FOREIGN_doubleS:
 #     ifdef SCHEME_BIG_ENDIAN
       if (sizeof(double)<sizeof(intptr_t) && ret_loc) {
@@ -2273,7 +2325,7 @@ static Scheme_Object *foreign_compiler_sizeof(int argc, Scheme_Object *argv[])
     break;
   case 5: /* double */
     if (intsize==0) RETSIZE(double);
-    else if (intsize==1) RETSIZE(long double);
+    else if (intsize==1) RETSIZE(mz_long_double);
     else scheme_signal_error(MYNAME": bad qualifiers for 'double");
     break;
   default:
@@ -2690,6 +2742,21 @@ static Scheme_Object *foreign_flvector_to_cpointer(int argc, Scheme_Object *argv
 }
 #undef MYNAME
 
+#define MYNAME "extflvector->cpointer"
+static Scheme_Object *foreign_extflvector_to_cpointer(int argc, Scheme_Object *argv[])
+{
+# ifdef MZ_LONG_DOUBLE
+  if (!SCHEME_EXTFLVECTORP(argv[0]))
+    scheme_wrong_contract(MYNAME, "extflvector?", 0, argc, argv);
+  return scheme_make_offset_cptr(argv[0], (intptr_t)SCHEME_EXTFLVEC_ELS((Scheme_Object *)0x0), NULL);
+# else /* MZ_LONG_DOUBLE undefined */
+  scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
+                   MYNAME ": " NOT_SUPPORTED_STR);
+  return NULL;
+# endif /* MZ_LONG_DOUBLE */
+}
+#undef MYNAME
+
 #define MYNAME "memset"
 static Scheme_Object *foreign_memset(int argc, Scheme_Object *argv[])
 {
@@ -3886,6 +3953,8 @@ void scheme_init_foreign(Scheme_Env *env)
     scheme_make_prim_w_arity(foreign_vector_to_cpointer, "vector->cpointer", 1, 1), menv);
   scheme_add_global("flvector->cpointer",
     scheme_make_prim_w_arity(foreign_flvector_to_cpointer, "flvector->cpointer", 1, 1), menv);
+  scheme_add_global("extflvector->cpointer",
+    scheme_make_prim_w_arity(foreign_extflvector_to_cpointer, "extflvector->cpointer", 1, 1), menv);
   scheme_add_global("memset",
     scheme_make_prim_w_arity(foreign_memset, "memset", 3, 5), menv);
   scheme_add_global("memmove",
@@ -4019,6 +4088,13 @@ void scheme_init_foreign(Scheme_Env *env)
   t->scheme_to_c = ((Scheme_Object*)(void*)(&ffi_type_double));
   t->c_to_scheme = ((Scheme_Object*)FOREIGN_double);
   scheme_add_global("_double", (Scheme_Object*)t, menv);
+  s = scheme_intern_symbol("longdouble");
+  t = (ctype_struct*)scheme_malloc_tagged(sizeof(ctype_struct));
+  t->so.type = ctype_tag;
+  t->basetype = (s);
+  t->scheme_to_c = ((Scheme_Object*)(void*)(&ffi_type_slongdouble));
+  t->c_to_scheme = ((Scheme_Object*)FOREIGN_longdouble);
+  scheme_add_global("_longdouble", (Scheme_Object*)t, menv);
   s = scheme_intern_symbol("double*");
   t = (ctype_struct*)scheme_malloc_tagged(sizeof(ctype_struct));
   t->so.type = ctype_tag;
@@ -4211,6 +4287,8 @@ void scheme_init_foreign(Scheme_Env *env)
    scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "vector->cpointer", 1, 1), menv);
   scheme_add_global("flvector->cpointer",
    scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "flvector->cpointer", 1, 1), menv);
+  scheme_add_global("extflvector->cpointer",
+   scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "extflvector->cpointer", 1, 1), menv);
   scheme_add_global("memset",
    scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "memset", 3, 5), menv);
   scheme_add_global("memmove",
@@ -4254,6 +4332,7 @@ void scheme_init_foreign(Scheme_Env *env)
   scheme_add_global("_ufixnum", scheme_false, menv);
   scheme_add_global("_float", scheme_false, menv);
   scheme_add_global("_double", scheme_false, menv);
+  scheme_add_global("_longdouble", scheme_false, menv);
   scheme_add_global("_double*", scheme_false, menv);
   scheme_add_global("_bool", scheme_false, menv);
   scheme_add_global("_string/ucs-4", scheme_false, menv);
diff --git a/src/foreign/foreign.rktc b/src/foreign/foreign.rktc
index e261733952..6297ae7a72 100755
--- a/src/foreign/foreign.rktc
+++ b/src/foreign/foreign.rktc
@@ -738,9 +738,28 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
 @(defctype* 'float  "float"        "FLOAT"  "FLOAT"        "double")
 
 @(defctype* 'double "double"       "FLOAT"  "FLOAT"        "double")
-@;
-@; Not useful?  not implemented in any case.
-@; (defctype* 'longdouble "long double" ...???...)
+
+#define ffi_type_slongdouble ffi_type_longdouble
+@@@IFDEF{MZ_LONG_DOUBLE}{typedef long double mz_long_double;}{typedef double mz_long_double;}
+@@@IFDEF{MZ_LONG_DOUBLE}{
+  @DEFINE{SCHEME_MAYBE_LONG_DBL_VAL(x) SCHEME_LONG_DBL_VAL(x)}
+}{
+  @DEFINE{SCHEME_MAYBE_LONG_DBL_VAL(x) unsupported_long_double_val()}
+  static mz_long_double unsupported_long_double_val() { 
+    scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, "_longdouble: " NOT_SUPPORTED_STR);    
+    return 0.0;
+  }
+}
+@@@IFDEF{MZ_LONG_DOUBLE}{
+  @DEFINE{scheme_make_maybe_long_double(x) scheme_make_long_double(x)}
+ }{
+  @DEFINE{scheme_make_maybe_long_double(x) unsupported_make_long_double()}
+  static Scheme_Object *unsupported_make_long_double() {
+    scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, "_longdouble: " NOT_SUPPORTED_STR);    
+    return NULL;
+  }
+}
+@(defctype* '(longdouble "longdouble") "mz_long_double"       "LONG_DBL"  "MAYBE_LONG_DBL"        "maybe_long_double")
 
 /* A double that will coerce numbers to doubles: */
 @(defctype* '(double* "double") "double"
@@ -1704,7 +1723,7 @@ static void* SCHEME2C(const char *who,
     break;
   case 5: /* double */
     if (intsize==0) RETSIZE(double);
-    else if (intsize==1) RETSIZE(long double);
+    else if (intsize==1) RETSIZE(mz_long_double);
     else scheme_signal_error(MYNAME": bad qualifiers for 'double");
     break;
   default:
@@ -2073,6 +2092,18 @@ static Scheme_Object *do_memop(const char *who, int mode,
   return scheme_make_offset_cptr(argv[0], (intptr_t)SCHEME_FLVEC_ELS((Scheme_Object *)0x0), NULL);
 }
 
+@cdefine[extflvector->cpointer 1]{
+@@@IFDEF{MZ_LONG_DOUBLE}{
+  if (!SCHEME_EXTFLVECTORP(argv[0]))
+    scheme_wrong_contract(MYNAME, "extflvector?", 0, argc, argv);
+  return scheme_make_offset_cptr(argv[0], (intptr_t)SCHEME_EXTFLVEC_ELS((Scheme_Object *)0x0), NULL);
+ }{
+  scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
+                   MYNAME ": " NOT_SUPPORTED_STR);
+  return NULL;
+ }
+}
+
 @cdefine[memset  3 5]{return do_memop(MYNAME, 0, argc, argv);}
 @cdefine[memmove 3 6]{return do_memop(MYNAME, 1, argc, argv);}
 @cdefine[memcpy  3 6]{return do_memop(MYNAME, 2, argc, argv);}
diff --git a/src/racket/src/cstartup.inc b/src/racket/src/cstartup.inc
index b2f4a45ee6..fa3bb7dd0f 100644
--- a/src/racket/src/cstartup.inc
+++ b/src/racket/src/cstartup.inc
@@ -1,14 +1,14 @@
   {
-    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,51,46,50,84,0,0,0,0,0,0,0,0,0,0,
+    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,51,46,51,84,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,0,51,0,0,0,1,0,0,10,0,14,0,
-19,0,32,0,37,0,40,0,47,0,54,0,59,0,63,0,67,0,74,0,83,
+21,0,28,0,33,0,37,0,40,0,45,0,58,0,62,0,67,0,74,0,83,
 0,87,0,93,0,107,0,121,0,124,0,130,0,134,0,136,0,147,0,149,0,
 163,0,170,0,192,0,194,0,208,0,19,1,48,1,59,1,70,1,96,1,129,
 1,162,1,224,1,24,2,105,2,161,2,166,2,187,2,84,3,105,3,158,3,
 225,3,114,4,2,5,56,5,67,5,150,5,0,0,112,7,0,0,69,35,37,
-109,105,110,45,115,116,120,29,11,11,11,64,119,104,101,110,72,112,97,114,97,
-109,101,116,101,114,105,122,101,64,99,111,110,100,62,111,114,66,100,101,102,105,
-110,101,66,108,101,116,114,101,99,64,108,101,116,42,63,108,101,116,63,97,110,
+109,105,110,45,115,116,120,29,11,11,11,66,100,101,102,105,110,101,66,108,101,
+116,114,101,99,64,108,101,116,42,63,97,110,100,62,111,114,64,119,104,101,110,
+72,112,97,114,97,109,101,116,101,114,105,122,101,63,108,101,116,64,99,111,110,
 100,66,117,110,108,101,115,115,68,104,101,114,101,45,115,116,120,29,11,11,11,
 65,113,117,111,116,101,29,94,2,15,68,35,37,107,101,114,110,101,108,11,29,
 94,2,15,68,35,37,112,97,114,97,109,122,11,62,105,102,65,98,101,103,105,
@@ -17,8 +17,8 @@
 20,112,97,114,97,109,101,116,101,114,105,122,97,116,105,111,110,45,107,101,121,
 61,118,73,100,101,102,105,110,101,45,118,97,108,117,101,115,97,36,11,8,240,
 110,91,0,0,95,159,2,17,36,36,159,2,16,36,36,159,2,16,36,36,16,
-20,2,3,2,2,2,5,2,2,2,4,2,2,2,6,2,2,2,7,2,2,
-2,8,2,2,2,9,2,2,2,10,2,2,2,11,2,2,2,12,2,2,97,
+20,2,3,2,2,2,4,2,2,2,5,2,2,2,6,2,2,2,7,2,2,
+2,8,2,2,2,11,2,2,2,10,2,2,2,9,2,2,2,12,2,2,97,
 37,11,8,240,110,91,0,0,93,159,2,16,36,37,16,2,2,13,161,2,2,
 37,2,13,2,2,2,13,96,11,11,8,240,110,91,0,0,16,0,96,38,11,
 8,240,110,91,0,0,16,0,18,98,64,104,101,114,101,13,16,6,36,2,14,
@@ -28,13 +28,13 @@
 2,18,248,22,104,199,249,22,79,2,19,248,22,106,201,12,27,248,22,81,248,
 22,163,4,196,28,248,22,87,193,20,14,159,37,36,37,28,248,22,87,248,22,
 81,194,248,22,177,17,193,249,22,156,4,80,158,39,36,251,22,89,2,18,248,
-22,177,17,199,249,22,79,2,11,248,22,178,17,201,11,18,100,10,13,16,6,
+22,177,17,199,249,22,79,2,6,248,22,178,17,201,11,18,100,10,13,16,6,
 36,2,14,2,2,11,11,11,8,32,8,31,8,30,8,29,16,4,11,11,2,
 20,3,1,8,101,110,118,49,55,52,48,56,16,4,11,11,2,21,3,1,8,
 101,110,118,49,55,52,48,57,27,248,22,81,248,22,163,4,196,28,248,22,87,
 193,20,14,159,37,36,37,28,248,22,87,248,22,81,194,248,22,177,17,193,249,
 22,156,4,80,158,39,36,250,22,89,2,22,248,22,89,249,22,89,248,22,89,
-2,23,248,22,177,17,201,251,22,89,2,18,2,23,2,23,249,22,79,2,6,
+2,23,248,22,177,17,201,251,22,89,2,18,2,23,2,23,249,22,79,2,7,
 248,22,178,17,204,18,100,11,13,16,6,36,2,14,2,2,11,11,11,8,32,
 8,31,8,30,8,29,16,4,11,11,2,20,3,1,8,101,110,118,49,55,52,
 49,49,16,4,11,11,2,21,3,1,8,101,110,118,49,55,52,49,50,248,22,
@@ -52,7 +52,7 @@
 37,47,11,9,222,33,43,248,22,163,4,248,22,80,201,248,22,178,17,198,27,
 248,22,81,248,22,163,4,196,27,248,22,163,4,248,22,80,195,249,22,156,4,
 80,158,40,36,28,248,22,87,195,250,22,90,2,22,9,248,22,81,199,250,22,
-89,2,10,248,22,89,248,22,80,199,250,22,90,2,9,248,22,178,17,201,248,
+89,2,10,248,22,89,248,22,80,199,250,22,90,2,5,248,22,178,17,201,248,
 22,81,202,27,248,22,81,248,22,163,4,23,197,1,27,249,22,1,22,93,249,
 22,2,22,163,4,248,22,163,4,248,22,80,199,248,22,183,4,249,22,156,4,
 80,158,41,36,251,22,89,1,22,119,105,116,104,45,99,111,110,116,105,110,117,
@@ -63,10 +63,10 @@
 204,27,248,22,81,248,22,163,4,196,28,248,22,87,193,20,14,159,37,36,37,
 249,22,156,4,80,158,39,36,27,248,22,163,4,248,22,80,197,28,249,22,154,
 9,62,61,62,248,22,157,4,248,22,104,196,250,22,89,2,22,248,22,89,249,
-22,89,21,93,2,27,248,22,80,199,250,22,90,2,5,249,22,89,2,27,249,
+22,89,21,93,2,27,248,22,80,199,250,22,90,2,11,249,22,89,2,27,249,
 22,89,248,22,113,203,2,27,248,22,81,202,251,22,89,2,18,28,249,22,154,
 9,248,22,157,4,248,22,80,200,64,101,108,115,101,10,248,22,177,17,197,250,
-22,90,2,22,9,248,22,178,17,200,249,22,79,2,5,248,22,81,202,99,13,
+22,90,2,22,9,248,22,178,17,200,249,22,79,2,11,248,22,81,202,99,13,
 16,6,36,2,14,2,2,11,11,11,8,32,8,31,8,30,8,29,16,4,11,
 11,2,20,3,1,8,101,110,118,49,55,52,51,52,16,4,11,11,2,21,3,
 1,8,101,110,118,49,55,52,51,53,18,158,94,10,64,118,111,105,100,8,48,
@@ -83,24 +83,24 @@
 0,36,36,11,12,11,11,16,0,16,0,16,0,36,36,16,11,16,5,11,20,
 15,16,2,20,14,159,36,36,37,80,158,36,36,36,20,114,159,36,16,1,2,
 13,16,1,33,33,10,16,5,2,12,88,163,8,36,37,53,37,9,223,0,33,
-34,36,20,114,159,36,16,1,2,13,16,0,11,16,5,2,3,88,163,8,36,
+34,36,20,114,159,36,16,1,2,13,16,0,11,16,5,2,8,88,163,8,36,
 37,53,37,9,223,0,33,35,36,20,114,159,36,16,1,2,13,16,0,11,16,
-5,2,11,88,163,8,36,37,53,37,9,223,0,33,36,36,20,114,159,36,16,
-1,2,13,16,1,33,37,11,16,5,2,6,88,163,8,36,37,56,37,9,223,
+5,2,6,88,163,8,36,37,53,37,9,223,0,33,36,36,20,114,159,36,16,
+1,2,13,16,1,33,37,11,16,5,2,7,88,163,8,36,37,56,37,9,223,
 0,33,38,36,20,114,159,36,16,1,2,13,16,1,33,39,11,16,5,2,10,
 88,163,8,36,37,58,37,9,223,0,33,42,36,20,114,159,36,16,1,2,13,
-16,0,11,16,5,2,8,88,163,8,36,37,53,37,9,223,0,33,44,36,20,
-114,159,36,16,1,2,13,16,0,11,16,5,2,9,88,163,8,36,37,54,37,
-9,223,0,33,45,36,20,114,159,36,16,1,2,13,16,0,11,16,5,2,4,
+16,0,11,16,5,2,4,88,163,8,36,37,53,37,9,223,0,33,44,36,20,
+114,159,36,16,1,2,13,16,0,11,16,5,2,5,88,163,8,36,37,54,37,
+9,223,0,33,45,36,20,114,159,36,16,1,2,13,16,0,11,16,5,2,9,
 88,163,8,36,37,56,37,9,223,0,33,46,36,20,114,159,36,16,1,2,13,
-16,0,11,16,5,2,5,88,163,8,36,37,58,37,9,223,0,33,47,36,20,
-114,159,36,16,1,2,13,16,1,33,49,11,16,5,2,7,88,163,8,36,37,
+16,0,11,16,5,2,11,88,163,8,36,37,58,37,9,223,0,33,47,36,20,
+114,159,36,16,1,2,13,16,1,33,49,11,16,5,2,3,88,163,8,36,37,
 54,37,9,223,0,33,50,36,20,114,159,36,16,1,2,13,16,0,11,16,0,
 94,2,16,2,17,93,2,16,9,9,36,0};
     EVAL_ONE_SIZED_STR((char *)expr, 2048);
   }
   {
-    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,51,46,50,84,0,0,0,0,0,0,0,0,0,0,
+    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,51,46,51,84,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,0,126,0,0,0,1,0,0,8,0,21,0,
 26,0,43,0,55,0,77,0,106,0,121,0,139,0,151,0,167,0,181,0,203,
 0,219,0,236,0,2,1,13,1,19,1,28,1,35,1,42,1,54,1,70,1,
@@ -376,7 +376,7 @@
 38,48,11,9,223,3,33,96,28,197,86,94,20,18,159,11,80,158,42,49,193,
 20,18,159,11,80,158,42,50,196,86,94,20,18,159,11,80,158,42,55,193,20,
 18,159,11,80,158,42,56,196,193,28,193,80,158,38,49,80,158,38,55,248,22,
-9,88,163,8,32,37,8,40,8,240,0,240,94,0,9,224,1,2,33,97,0,
+8,88,163,8,32,37,8,40,8,240,0,240,94,0,9,224,1,2,33,97,0,
 7,35,114,120,34,47,43,34,28,248,22,144,7,23,195,2,27,249,22,188,15,
 2,99,196,28,192,28,249,22,191,3,248,22,103,195,248,22,181,3,248,22,147,
 7,198,249,22,7,250,22,166,7,199,36,248,22,103,198,197,249,22,7,250,22,
@@ -582,7 +582,7 @@
     EVAL_ONE_SIZED_STR((char *)expr, 10044);
   }
   {
-    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,51,46,50,84,0,0,0,0,0,0,0,0,0,0,
+    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,51,46,51,84,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,0,14,0,0,0,1,0,0,15,0,40,0,
 57,0,75,0,97,0,120,0,140,0,162,0,169,0,176,0,183,0,190,0,197,
 0,0,0,222,1,0,0,74,35,37,112,108,97,99,101,45,115,116,114,117,99,
@@ -612,7 +612,7 @@
     EVAL_ONE_SIZED_STR((char *)expr, 548);
   }
   {
-    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,51,46,50,84,0,0,0,0,0,0,0,0,0,0,
+    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,51,46,51,84,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,0,89,0,0,0,1,0,0,7,0,18,0,
 45,0,51,0,60,0,67,0,89,0,102,0,128,0,145,0,167,0,175,0,187,
 0,202,0,218,0,236,0,0,1,12,1,28,1,51,1,63,1,94,1,101,1,
@@ -1022,7 +1022,7 @@
     EVAL_ONE_SIZED_STR((char *)expr, 8526);
   }
   {
-    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,51,46,50,84,0,0,0,0,0,0,0,0,0,0,
+    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,51,46,51,84,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,0,11,0,0,0,1,0,0,10,0,16,0,
 29,0,44,0,58,0,78,0,90,0,104,0,118,0,170,0,0,0,98,1,0,
 0,69,35,37,98,117,105,108,116,105,110,65,113,117,111,116,101,29,94,2,2,
diff --git a/src/racket/src/jit.c b/src/racket/src/jit.c
index 85fb004b40..17846da62d 100644
--- a/src/racket/src/jit.c
+++ b/src/racket/src/jit.c
@@ -325,6 +325,20 @@ int scheme_jit_check_closure_flonum_bit(Scheme_Closure_Data *data, int pos, int
   else
     return 0;
 }
+int scheme_jit_check_closure_extflonum_bit(Scheme_Closure_Data *data, int pos, int delta)
+{
+#ifdef MZ_LONG_DOUBLE
+  int ct;
+  pos += delta;
+  ct = scheme_boxmap_get(data->closure_map, pos, data->closure_size);
+  if (ct == (CLOS_TYPE_TYPE_OFFSET + SCHEME_LOCAL_TYPE_EXTFLONUM))
+    return 1;
+  else
+    return 0;
+#else
+  return 0;
+#endif
+}
 #endif
 
 #ifdef NEED_LONG_BRANCHES
@@ -1096,25 +1110,26 @@ int scheme_generate_flonum_local_boxing(mz_jit_state *jitter, int pos, int offse
   return 1;
 }
 
-static int generate_flonum_local_boxing(mz_jit_state *jitter, int pos, int local_pos, int target)
+static int generate_flonum_local_boxing(mz_jit_state *jitter, int pos, int local_pos, int target, int extfl)
 {
   int offset;
+
   offset = scheme_mz_flostack_pos(jitter, local_pos);
   offset = JIT_FRAME_FLOSTACK_OFFSET - offset;
   if (jitter->unbox) {
     int fpr0;
-    fpr0 = JIT_FPR_0(jitter->unbox_depth);
-    jit_ldxi_d_fppush(fpr0, JIT_FP, offset);
+    fpr0 = JIT_FPUSEL_FPR_0(extfl, jitter->unbox_depth);
+    jit_FPSEL_ldxi_xd_fppush(extfl, fpr0, JIT_FP, offset);
     jitter->unbox_depth++;
   } else {
     mz_rs_sync();
-    scheme_generate_flonum_local_boxing(jitter, pos, offset, target, 0);
+    scheme_generate_flonum_local_boxing(jitter, pos, offset, target, extfl);
   }
 
   return 1;
 }
 
-int scheme_generate_flonum_local_unboxing(mz_jit_state *jitter, int push, int extfl)
+int scheme_generate_flonum_local_unboxing(mz_jit_state *jitter, int push, int no_store, int extfl)
 /* Move FPR0 onto C stack */
 {
   int sz, fpr0;
@@ -1126,13 +1141,15 @@ int scheme_generate_flonum_local_unboxing(mz_jit_state *jitter, int push, int ex
     jitter->flostack_space += space;
     jit_subi_l(JIT_SP, JIT_SP, space);
   }
-
   jitter->flostack_offset += sz;
+
   if (push) mz_runstack_flonum_pushed(jitter, jitter->flostack_offset);
   CHECK_LIMIT();
 
-  fpr0 = MZ_FPUSEL(extfl, JIT_FPU_FPR0, JIT_FPR0);
-  mz_st_fppop(jitter->flostack_offset, fpr0, extfl);
+  if (!no_store) {
+    fpr0 = MZ_FPUSEL(extfl, JIT_FPU_FPR0, JIT_FPR0);
+    mz_st_fppop(jitter->flostack_offset, fpr0, extfl);
+  }
 
   return 1;
 }
@@ -1253,10 +1270,13 @@ static int generate_closure_prep(Scheme_Closure_Data *data, mz_jit_state *jitter
     size = data->closure_size;
     map = data->closure_map;
     for (j = 0; j < size; j++) {
-      if (CLOSURE_CONTENT_IS_FLONUM(data, j)) {
+      if (CLOSURE_CONTENT_IS_FLONUM(data, j)
+          || CLOSURE_CONTENT_IS_EXTFLONUM(data, j)) {
+        int extfl;
+        extfl = CLOSURE_CONTENT_IS_EXTFLONUM(data, j);
         pos = mz_remap(map[j]);
         jit_ldxi_p(JIT_R1, JIT_RUNSTACK, WORDS_TO_BYTES(pos));
-        generate_flonum_local_boxing(jitter, pos, map[j], JIT_R1);
+        generate_flonum_local_boxing(jitter, pos, map[j], JIT_R1, extfl);
         CHECK_LIMIT();
         retval = 1;
       }
@@ -1964,12 +1984,17 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
     {
       /* Other parts of the JIT rely on this code modifying only the target register,
          unless the type is SCHEME_FLONUM_TYPE */
-      int pos, flonum;
+      int pos, flonum, extfl;
       START_JIT_DATA();
 #ifdef USE_FLONUM_UNBOXING
       flonum = (SCHEME_GET_LOCAL_TYPE(obj) == SCHEME_LOCAL_TYPE_FLONUM);
+      if (MZ_LONG_DOUBLE_AND(SCHEME_GET_LOCAL_TYPE(obj) == SCHEME_LOCAL_TYPE_EXTFLONUM))
+        flonum = extfl = 1;
+      else
+        extfl = 0;
 #else
       flonum = 0;
+      extfl = 0;
 #endif
       pos = mz_remap(SCHEME_LOCAL_POS(obj));
       LOG_IT(("local %d [%d]\n", pos, SCHEME_LOCAL_FLAGS(obj)));
@@ -2026,7 +2051,7 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
       CHECK_LIMIT();
       if (flonum && !result_ignored) {
 #ifdef USE_FLONUM_UNBOXING
-        generate_flonum_local_boxing(jitter, pos, SCHEME_LOCAL_POS(obj), target);
+        generate_flonum_local_boxing(jitter, pos, SCHEME_LOCAL_POS(obj), target, extfl);
         CHECK_LIMIT();
 #endif
       } else {
@@ -2838,7 +2863,7 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
   case scheme_let_one_type:
     {
       Scheme_Let_One *lv = (Scheme_Let_One *)obj;
-      int flonum, unused;
+      int flonum, unused, extfl;
       mz_jit_unbox_state ubs;
       START_JIT_DATA();
 
@@ -2850,23 +2875,30 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
 
 #ifdef USE_FLONUM_UNBOXING
       flonum = (SCHEME_LET_ONE_TYPE(lv) == SCHEME_LOCAL_TYPE_FLONUM);
+      if (MZ_LONG_DOUBLE_AND(SCHEME_LET_ONE_TYPE(lv) == SCHEME_LOCAL_TYPE_EXTFLONUM))
+        flonum = extfl = 1;
+      else
+        extfl = 0;
 #else
-      flonum = 0;
+      flonum = extfl = 0;
 #endif
       unused = SCHEME_LET_EVAL_TYPE(lv) & LET_ONE_UNUSED;
 
       PAUSE_JIT_DATA();
       if (flonum) {
 #ifdef USE_FLONUM_UNBOXING
-        if (scheme_can_unbox_inline(lv->value, 5, JIT_FPR_NUM-1, 0, 0)) {
+        if (scheme_can_unbox_inline(lv->value, 5, JIT_FPUSEL_FPR_NUM(extfl)-1, 0, extfl)) {
           jitter->unbox++;
+          MZ_FPUSEL_STMT_ONLY(extfl, jitter->unbox_extflonum++;);
           scheme_generate_unboxed(lv->value, jitter, 2, 0);
-        } else if (scheme_can_unbox_directly(lv->value, 0)) {
+        } else if (scheme_can_unbox_directly(lv->value, extfl)) {
           jitter->unbox++;
+          MZ_FPUSEL_STMT_ONLY(extfl, jitter->unbox_extflonum++;);
           scheme_generate_unboxed(lv->value, jitter, 1, 0);
         } else {
           /* validator should ensure that this is ok */
           jitter->unbox++;
+          MZ_FPUSEL_STMT_ONLY(extfl, jitter->unbox_extflonum++;);
           scheme_generate_unboxed(lv->value, jitter, 0, 1);
         }
 #endif
@@ -2887,11 +2919,12 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
 
       if (flonum) {
 #ifdef USE_FLONUM_UNBOXING
+        MZ_FPUSEL_STMT_ONLY(extfl, --jitter->unbox_extflonum);
         --jitter->unbox;
         --jitter->unbox_depth;
         if (jitter->unbox_depth)
           scheme_signal_error("internal error: flonum let RHS leaves unbox depth");
-        scheme_generate_flonum_local_unboxing(jitter, 1, 0);
+        scheme_generate_flonum_local_unboxing(jitter, 1, 0, extfl);
         CHECK_LIMIT();
         (void)jit_movi_p(JIT_R0, NULL);
 #endif
@@ -3387,10 +3420,15 @@ static int do_generate_closure(mz_jit_state *jitter, void *_data)
     zref = jit_bnei_l(jit_forward(), JIT_R1, f_offset);
         
     for (i = data->num_params; i--; ) {
-      if (CLOSURE_ARGUMENT_IS_FLONUM(data, i)) {
+      if (CLOSURE_ARGUMENT_IS_FLONUM(data, i)
+          || CLOSURE_ARGUMENT_IS_EXTFLONUM(data, i)) {
+        int extfl;
+        extfl = CLOSURE_ARGUMENT_IS_EXTFLONUM(data, i);
         mz_rs_ldxi(JIT_R1, i);
-        jit_ldxi_d_fppush(JIT_FPR0, JIT_R1, &((Scheme_Double *)0x0)->double_val);  
-        scheme_generate_flonum_local_unboxing(jitter, 1, 0);
+        MZ_FPUSEL_STMT(extfl,
+                       jit_fpu_ldxi_ld_fppush(JIT_FPU_FPR0, JIT_R1, &((Scheme_Long_Double *)0x0)->long_double_val),
+                       jit_ldxi_d_fppush(JIT_FPR0, JIT_R1, &((Scheme_Double *)0x0)->double_val));
+        scheme_generate_flonum_local_unboxing(jitter, 1, 0, extfl);
         CHECK_LIMIT();
       } else {
         mz_runstack_pushed(jitter, 1);
@@ -3463,10 +3501,15 @@ static int do_generate_closure(mz_jit_state *jitter, void *_data)
       } else {
 #ifdef USE_FLONUM_UNBOXING
         if ((SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_TYPED_ARGS)
-            && (CLOSURE_CONTENT_IS_FLONUM(data, i))) {
+            && (CLOSURE_CONTENT_IS_FLONUM(data, i)
+                || CLOSURE_CONTENT_IS_EXTFLONUM(data, i))) {
+          int extfl;
+          extfl = CLOSURE_CONTENT_IS_EXTFLONUM(data, i);
           mz_rs_ldxi(JIT_R1, i);
-          jit_ldxi_d_fppush(JIT_FPR0, JIT_R1, &((Scheme_Double *)0x0)->double_val);
-          scheme_generate_flonum_local_unboxing(jitter, 1, 0);
+          MZ_FPUSEL_STMT(extfl,
+                         jit_fpu_ldxi_ld_fppush(JIT_FPU_FPR0, JIT_R1, &((Scheme_Long_Double *)0x0)->long_double_val),
+                         jit_ldxi_d_fppush(JIT_FPR0, JIT_R1, &((Scheme_Double *)0x0)->double_val));
+          scheme_generate_flonum_local_unboxing(jitter, 1, 0, extfl);
           CHECK_LIMIT();
         } else
 #endif
@@ -3482,10 +3525,15 @@ static int do_generate_closure(mz_jit_state *jitter, void *_data)
     /* Unpack flonum closure data */
     if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_TYPED_ARGS) {
       for (i = data->closure_size; i--; ) {
-        if (CLOSURE_CONTENT_IS_FLONUM(data, i)) {
+        if (CLOSURE_CONTENT_IS_FLONUM(data, i)
+            || CLOSURE_CONTENT_IS_EXTFLONUM(data, i)) {
+          int extfl;
+          extfl = CLOSURE_CONTENT_IS_EXTFLONUM(data, i);
           mz_rs_ldxi(JIT_R1, i);
-          jit_ldxi_d_fppush(JIT_FPR0, JIT_R1, &((Scheme_Double *)0x0)->double_val);
-          scheme_generate_flonum_local_unboxing(jitter, 1, 0);
+          MZ_FPUSEL_STMT(extfl,
+                         jit_fpu_ldxi_ld_fppush(JIT_FPU_FPR0, JIT_R1, &((Scheme_Long_Double *)0x0)->long_double_val),
+                         jit_ldxi_d_fppush(JIT_FPR0, JIT_R1, &((Scheme_Double *)0x0)->double_val));
+          scheme_generate_flonum_local_unboxing(jitter, 1, 0, extfl);
           CHECK_LIMIT();
         } else {
           mz_runstack_pushed(jitter, 1);
diff --git a/src/racket/src/jit.h b/src/racket/src/jit.h
index 44f16158a6..1a52a59d6f 100644
--- a/src/racket/src/jit.h
+++ b/src/racket/src/jit.h
@@ -523,8 +523,10 @@ void *scheme_jit_get_threadlocal_table();
 # define mz_tl_ldi_i(reg, addr) (mz_tl_addr(reg, addr), mz_tl_ldr_i(reg, addr))
 # define mz_tl_sti_d_fppop(addr, reg, tmp_reg) (mz_tl_addr(tmp_reg, addr), mz_tl_str_d_fppop(tmp_reg, reg, addr))
 # define mz_tl_ldi_d_fppush(reg, addr, tmp_reg) (mz_tl_addr(tmp_reg, addr), mz_tl_ldr_d_fppush(reg, tmp_reg, addr))
-# define mz_fpu_tl_sti_ld_fppop(addr, reg, tmp_reg) (mz_tl_addr(tmp_reg, addr), mz_fpu_tl_str_ld_fppop(tmp_reg, reg, addr))
-# define mz_fpu_tl_ldi_ld_fppush(reg, addr, tmp_reg) (mz_tl_addr(tmp_reg, addr), mz_fpu_tl_ldr_ld_fppush(reg, tmp_reg, addr))
+# ifdef MZ_LONG_DOUBLE
+#  define mz_fpu_tl_sti_ld_fppop(addr, reg, tmp_reg) (mz_tl_addr(tmp_reg, addr), mz_fpu_tl_str_ld_fppop(tmp_reg, reg, addr))
+#  define mz_fpu_tl_ldi_ld_fppush(reg, addr, tmp_reg) (mz_tl_addr(tmp_reg, addr), mz_fpu_tl_ldr_ld_fppush(reg, tmp_reg, addr))
+# endif
 #else
 # define mz_tl_sti_p(addr, reg, tmp_reg) jit_sti_p(addr, reg)
 # define mz_tl_sti_l(addr, reg, tmp_reg) jit_sti_l(addr, reg)
@@ -1441,10 +1443,9 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int tail_ok, int w
 int scheme_generate_unboxed(Scheme_Object *obj, mz_jit_state *jitter, int inlined_ok, int unbox_anyway);
 
 #ifdef USE_FLONUM_UNBOXING
-int scheme_generate_flonum_local_unboxing(mz_jit_state *jitter, int push, int extfl);
+int scheme_generate_flonum_local_unboxing(mz_jit_state *jitter, int push, int no_store, int extfl);
 int scheme_generate_flonum_local_boxing(mz_jit_state *jitter, int pos, int offset, int target, int extfl);
 #endif
-int scheme_generate_unboxed(Scheme_Object *obj, mz_jit_state *jitter, int inlined_ok, int unbox_anyway);
 int scheme_generate_non_tail_mark_pos_prefix(mz_jit_state *jitter);
 void scheme_generate_non_tail_mark_pos_suffix(mz_jit_state *jitter);
 
@@ -1479,6 +1480,9 @@ int scheme_is_non_gc(Scheme_Object *obj, int depth);
 int scheme_jit_check_closure_flonum_bit(Scheme_Closure_Data *data, int pos, int delta);
 # define CLOSURE_ARGUMENT_IS_FLONUM(data, pos) scheme_jit_check_closure_flonum_bit(data, pos, 0)
 # define CLOSURE_CONTENT_IS_FLONUM(data, pos) scheme_jit_check_closure_flonum_bit(data, pos, data->num_params)
+ int scheme_jit_check_closure_extflonum_bit(Scheme_Closure_Data *data, int pos, int delta);
+# define CLOSURE_ARGUMENT_IS_EXTFLONUM(data, pos) scheme_jit_check_closure_extflonum_bit(data, pos, 0)
+# define CLOSURE_CONTENT_IS_EXTFLONUM(data, pos) scheme_jit_check_closure_extflonum_bit(data, pos, data->num_params)
 #endif
 
 Scheme_Object *scheme_extract_global(Scheme_Object *o, Scheme_Native_Closure *nc, int local_only);
@@ -1569,3 +1573,4 @@ Scheme_Object *scheme_jit_continuation_apply_install(Apply_LWC_Args *args);
 
 
 
+
diff --git a/src/racket/src/jitalloc.c b/src/racket/src/jitalloc.c
index 6447a37d12..c2b2821f34 100644
--- a/src/racket/src/jitalloc.c
+++ b/src/racket/src/jitalloc.c
@@ -150,13 +150,11 @@ int scheme_inline_alloc(mz_jit_state *jitter, int amt, Scheme_Type ty, int flags
     }
   } else if (keep_fpr1) {
     (void)jit_calli(sjc.retry_alloc_code_keep_fpr1);
-  } 
 #ifdef MZ_LONG_DOUBLE
-  else if (keep_extfpr1) {
+  } else if (keep_extfpr1) {
     (void)jit_calli(sjc.retry_alloc_code_keep_extfpr1);
-  }
 #endif
-  else {
+  } else {
     (void)jit_calli(sjc.retry_alloc_code);
   }
   __START_TINY_JUMPS__(1);
diff --git a/src/racket/src/jitarith.c b/src/racket/src/jitarith.c
index 1bd4984252..d0457a0346 100644
--- a/src/racket/src/jitarith.c
+++ b/src/racket/src/jitarith.c
@@ -119,6 +119,7 @@ static int is_inline_unboxable_op(Scheme_Object *obj, int flag, int unsafely, in
     if (IS_NAMED_PRIM(obj, "unsafe-extflmin")) return 1;
     if (IS_NAMED_PRIM(obj, "unsafe-extflmax")) return 1;
     if (IS_NAMED_PRIM(obj, "unsafe-fx->extfl")) return 1;
+    if (IS_NAMED_PRIM(obj, "unsafe-f80vector-ref")) return 1;
     if (IS_NAMED_PRIM(obj, "unsafe-extflvector-ref")) return 1;
 
     if (unsafely) {
@@ -263,9 +264,10 @@ int scheme_can_unbox_inline(Scheme_Object *obj, int fuel, int regs, int unsafely
           return 1;
         }
       }
-#ifdef MZ_LONG_DOUBLE_UNBOXED
+#ifdef MZ_LONG_DOUBLE
       if ((SCHEME_PRIM_PROC_OPT_FLAGS(app->rator) & SCHEME_PRIM_IS_BINARY_INLINED)
-          && (IS_NAMED_PRIM(app->rator, "unsafe-extflvector-ref"))) {
+          && (IS_NAMED_PRIM(app->rator, "unsafe-f80vector-ref")
+              || IS_NAMED_PRIM(app->rator, "unsafe-extflvector-ref"))) {
         if (is_unboxing_immediate(app->rand1, 1, extfl)
             && is_unboxing_immediate(app->rand2, 1, extfl)) {
           return 1;
@@ -303,7 +305,7 @@ int scheme_can_unbox_directly(Scheme_Object *obj, int extfl)
                 || IS_NAMED_PRIM(app->rator, "fx->fl"))
               return 1;
           }
-#ifdef MZ_LONG_DOUBLE_UNBOXED
+#ifdef MZ_LONG_DOUBLE
           if (extfl) {
             if (IS_NAMED_PRIM(app->rator, "->extfl")
                 || IS_NAMED_PRIM(app->rator, "fx->extfl"))
@@ -324,7 +326,7 @@ int scheme_can_unbox_directly(Scheme_Object *obj, int extfl)
           if (!extfl) {
             if (IS_NAMED_PRIM(app->rator, "flvector-ref")) return 1;
           }
-#ifdef MZ_LONG_DOUBLE_UNBOXED
+#ifdef MZ_LONG_DOUBLE
           if (extfl) {
             if (IS_NAMED_PRIM(app->rator, "extflvector-ref")) return 1;
           }
@@ -560,7 +562,7 @@ int scheme_generate_alloc_long_double(mz_jit_state *jitter, int inline_retry, in
 {
 #ifdef INLINE_FP_OPS
 # ifdef CAN_INLINE_ALLOC
-  scheme_inline_alloc(jitter, sizeof(Scheme_Long_Double), scheme_long_double_type, 0, 0, 1, inline_retry, 1);
+  scheme_inline_alloc(jitter, sizeof(Scheme_Long_Double), scheme_long_double_type, 0, 0, 0, inline_retry, 1);
   CHECK_LIMIT();
   jit_addi_p(dest, JIT_V1, OBJHEAD_SIZE);
   (void)jit_fpu_stxi_ld_fppop(&((Scheme_Long_Double *)0x0)->long_double_val, dest, JIT_FPU_FPR0);
@@ -660,11 +662,12 @@ static int generate_float_point_arith(mz_jit_state *jitter, Scheme_Object *rator
       /* inexact->exact needs no extra number */
     } else {
 #ifdef MZ_LONG_DOUBLE
-      long double ld = second_const;
-#endif
+      long double d = second_const;
+#else
       double d = second_const;
+#endif
       MZ_FPUSEL_STMT(extfl,
-                     mz_fpu_movi_ld_fppush(fpr1, ld, JIT_R2),
+                     mz_fpu_movi_ld_fppush(fpr1, d, JIT_R2),
                      mz_movi_d_fppush(fpr1, d, JIT_R2));
       reversed = !reversed;
       cmp = -cmp;
@@ -679,7 +682,13 @@ static int generate_float_point_arith(mz_jit_state *jitter, Scheme_Object *rator
     }
 
 #ifdef DIRECT_FPR_ACCESS
-    if (unboxed && !extfl) {
+# define USES_DIRECT_FPR_ACCESS (!extfl)
+#else
+# define USES_DIRECT_FPR_ACCESS 0
+#endif
+
+#ifdef DIRECT_FPR_ACCESS
+    if (unboxed && USES_DIRECT_FPR_ACCESS) {
       /* arguments are backward */
       reversed = !reversed;
       cmp = -cmp;
@@ -783,9 +792,9 @@ static int generate_float_point_arith(mz_jit_state *jitter, Scheme_Object *rator
           __START_TINY_JUMPS__(1);
           refs2 = jit_bner_l(jit_forward(), JIT_R1, JIT_R2);
           __END_TINY_JUMPS__(1);
-#ifndef DIRECT_FPR_ACCESS
-          if (unboxed)
-            jit_FPSEL_roundr_xd_l_fppop(extfl, JIT_R1, fpr2); /* slow path won't be needed */
+#if !defined(DIRECT_FPR_ACCESS) || defined(MZ_LONG_DOUBLE)
+          if (unboxed && !USES_DIRECT_FPR_ACCESS)
+            jit_FPSEL_roundr_xd_l_fppop(extfl, JIT_R1, fpr1+1); /* slow path won't be needed */
 #endif
         }
         jit_fixnum_l(dest, JIT_R1);
@@ -913,13 +922,13 @@ static int generate_float_point_arith(mz_jit_state *jitter, Scheme_Object *rator
         scheme_generate_alloc_X_double(jitter, 0, dest, extfl);
         CHECK_LIMIT();
 #if defined(MZ_USE_JIT_I386)
-        if (need_post_pop)
+        if (need_post_pop && !USES_DIRECT_FPR_ACCESS)
           FSTPr(0);
 #endif
       } else if (unboxed_result) {
         jitter->unbox_depth++;
 #if defined(MZ_USE_JIT_I386)
-        if (need_post_pop) {
+        if (need_post_pop && !USES_DIRECT_FPR_ACCESS) {
           FXCHr(1);
           FSTPr(0);
         }
@@ -1105,11 +1114,11 @@ int scheme_generate_arith_for(mz_jit_state *jitter, Scheme_Object *rator, Scheme
     if (!rand) {
       inlined_flonum1 = inlined_flonum2 = 1;
     } else {
-      if (scheme_can_unbox_inline(rand, 5, MZ_FPUSEL(extfl, JIT_FPU_FPR_NUM, JIT_FPR_NUM)-2, unsafe_fl > 0, extfl))
+      if (scheme_can_unbox_inline(rand, 5, JIT_FPUSEL_FPR_NUM(extfl)-2, unsafe_fl > 0, extfl))
         inlined_flonum1 = 1;
       else
         inlined_flonum1 = 0;
-      if (!rand2 || scheme_can_unbox_inline(rand2, 5, MZ_FPUSEL(extfl, JIT_FPU_FPR_NUM, JIT_FPR_NUM)-3, unsafe_fl > 0, extfl))
+      if (!rand2 || scheme_can_unbox_inline(rand2, 5, JIT_FPUSEL_FPR_NUM(extfl)-3, unsafe_fl > 0, extfl))
         inlined_flonum2 = 1;
       else
         inlined_flonum2 = 0;
@@ -1188,7 +1197,7 @@ int scheme_generate_arith_for(mz_jit_state *jitter, Scheme_Object *rator, Scheme
 #ifdef USE_FLONUM_UNBOXING
           flostack = scheme_mz_flostack_save(jitter, &flopos);
           --jitter->unbox_depth;
-          scheme_generate_flonum_local_unboxing(jitter, 0, extfl);
+          scheme_generate_flonum_local_unboxing(jitter, 0, 0, extfl);
           CHECK_LIMIT();
 #endif        
         }
@@ -1231,8 +1240,8 @@ int scheme_generate_arith_for(mz_jit_state *jitter, Scheme_Object *rator, Scheme
       flonum_depth = 2;
     }
     if (args_unboxed) {
-      --jitter->unbox;
       MZ_FPUSEL_STMT_ONLY(extfl, --jitter->unbox_extflonum);
+      --jitter->unbox;
     }
     jitter->unbox_depth -= flonum_depth;
     if (!jitter->unbox && jitter->unbox_depth && rand)
diff --git a/src/racket/src/jitcall.c b/src/racket/src/jitcall.c
index 212d17a5ab..c207a9681c 100644
--- a/src/racket/src/jitcall.c
+++ b/src/racket/src/jitcall.c
@@ -1071,7 +1071,8 @@ int scheme_generate_non_tail_call(mz_jit_state *jitter, int num_rands, int direc
 }
 
 static int generate_self_tail_call(Scheme_Object *rator, mz_jit_state *jitter, int num_rands, GC_CAN_IGNORE jit_insn *slow_code,
-                                   int args_already_in_place, Scheme_App_Rec *app, Scheme_Object **alt_rands)
+                                   int args_already_in_place, int direct_flostack_offset,
+                                   Scheme_App_Rec *app, Scheme_Object **alt_rands)
 /* Last argument is in R0 */
 {
   GC_CAN_IGNORE jit_insn *refslow, *refagain;
@@ -1107,7 +1108,7 @@ static int generate_self_tail_call(Scheme_Object *rator, mz_jit_state *jitter, i
   offset = jitter->flostack_offset;
   space = jitter->flostack_space;
 #ifdef USE_FLONUM_UNBOXING
-  arg_tmp_offset = offset;
+  arg_tmp_offset = offset - direct_flostack_offset;
 #endif
 
   /* Copy args to runstack after closure data: */
@@ -1116,32 +1117,37 @@ static int generate_self_tail_call(Scheme_Object *rator, mz_jit_state *jitter, i
   for (i = num_rands; i--; ) {
     int already_loaded = (i == num_rands - 1);
 #ifdef USE_FLONUM_UNBOXING
-    int is_flonum, already_unboxed = 0;
+    int is_flonum, already_unboxed = 0, extfl = 0;
     if ((SCHEME_CLOSURE_DATA_FLAGS(jitter->self_data) & CLOS_HAS_TYPED_ARGS)
-        && CLOSURE_ARGUMENT_IS_FLONUM(jitter->self_data, i + args_already_in_place)) {
+        && (CLOSURE_ARGUMENT_IS_FLONUM(jitter->self_data, i + args_already_in_place)
+            || CLOSURE_ARGUMENT_IS_EXTFLONUM(jitter->self_data, i + args_already_in_place))) {
       is_flonum = 1;
+      extfl = CLOSURE_ARGUMENT_IS_EXTFLONUM(jitter->self_data, i + args_already_in_place);
       rand = (alt_rands 
               ? alt_rands[i+1+args_already_in_place] 
               : app->args[i+1+args_already_in_place]);
-      mz_ld_fppush(JIT_FPR0, arg_tmp_offset, 0);
-      arg_tmp_offset -= sizeof(double);
+      arg_tmp_offset += MZ_FPUSEL(extfl, 2*sizeof(double), sizeof(double));
+      mz_ld_fppush(MZ_FPUSEL(extfl, JIT_FPU_FPR0, JIT_FPR0), arg_tmp_offset, extfl);
       already_unboxed = 1;
       if (!already_loaded && !SAME_TYPE(SCHEME_TYPE(rand), scheme_local_type)) {
         already_loaded = 1;
         (void)jit_movi_p(JIT_R0, NULL);
       }
     } else
-      is_flonum = 0;
+      is_flonum = extfl = 0;
 #endif
     if (!already_loaded)
       jit_ldxi_p(JIT_R0, JIT_RUNSTACK, WORDS_TO_BYTES(i));
     jit_stxi_p(WORDS_TO_BYTES(i + closure_size + args_already_in_place), JIT_R2, JIT_R0);
 #ifdef USE_FLONUM_UNBOXING
     if (is_flonum) {
-      if (!already_unboxed)
-        jit_ldxi_d_fppush(JIT_FPR0, JIT_R0, &((Scheme_Double *)0x0)->double_val); 
-      arg_offset += sizeof(double);
-      mz_st_fppop(arg_offset, JIT_FPR0, 0);
+      if (!already_unboxed) {
+        MZ_FPUSEL_STMT(extfl,
+                       jit_fpu_ldxi_ld_fppush(JIT_FPU_FPR0, JIT_R0, &((Scheme_Long_Double *)0x0)->long_double_val),
+                       jit_ldxi_d_fppush(JIT_FPR0, JIT_R0, &((Scheme_Double *)0x0)->double_val));
+      }
+      arg_offset += MZ_FPUSEL(extfl, 2*sizeof(double), sizeof(double));
+      mz_st_fppop(arg_offset, MZ_FPUSEL(extfl, JIT_FPU_FPR0, JIT_FPR0), extfl);
     }
 #endif
     CHECK_LIMIT();
@@ -1171,20 +1177,27 @@ static int generate_self_tail_call(Scheme_Object *rator, mz_jit_state *jitter, i
 #ifdef USE_FLONUM_UNBOXING
   /* Need to box any arguments that we have only in flonum form */
   if (SCHEME_CLOSURE_DATA_FLAGS(jitter->self_data) & CLOS_HAS_TYPED_ARGS) {
-    arg_tmp_offset = offset;
+    arg_tmp_offset = offset - direct_flostack_offset;
     for (i = num_rands; i--; ) {
-      if (CLOSURE_ARGUMENT_IS_FLONUM(jitter->self_data, i + args_already_in_place)) {
+      if (CLOSURE_ARGUMENT_IS_FLONUM(jitter->self_data, i + args_already_in_place)
+          || CLOSURE_ARGUMENT_IS_EXTFLONUM(jitter->self_data, i + args_already_in_place)) {
+        int extfl;
+        extfl = CLOSURE_ARGUMENT_IS_EXTFLONUM(jitter->self_data, i + args_already_in_place);
         rand = (alt_rands 
                 ? alt_rands[i+1+args_already_in_place] 
                 : app->args[i+1+args_already_in_place]);
         if (!SAME_TYPE(SCHEME_TYPE(rand), scheme_local_type)
-            || (SCHEME_GET_LOCAL_TYPE(rand) == SCHEME_LOCAL_TYPE_FLONUM)) {
-          int aoffset = JIT_FRAME_FLOSTACK_OFFSET - arg_tmp_offset;
+            || (!extfl && (SCHEME_GET_LOCAL_TYPE(rand) == SCHEME_LOCAL_TYPE_FLONUM))
+            || (extfl && (SCHEME_GET_LOCAL_TYPE(rand) == SCHEME_LOCAL_TYPE_EXTFLONUM))) {
           GC_CAN_IGNORE jit_insn *iref;
+          int aoffset;
+          arg_tmp_offset += MZ_FPUSEL(extfl, 2*sizeof(double), sizeof(double));
+          aoffset = JIT_FRAME_FLOSTACK_OFFSET - arg_tmp_offset;
           if (i != num_rands - 1)
             mz_pushr_p(JIT_R0);
           if (SAME_TYPE(SCHEME_TYPE(rand), scheme_local_type)) {
             /* assert: SCHEME_GET_LOCAL_TYPE(rand) == SCHEME_LOCAL_TYPE_FLONUM */
+            /* or SCHEME_GET_LOCAL_TYPE(rand) == SCHEME_LOCAL_TYPE_EXTFLONUM */
             /* have to check for an existing box */
             if (i != num_rands - 1)
               mz_rs_ldxi(JIT_R0, i+1);
@@ -1196,7 +1209,9 @@ static int generate_self_tail_call(Scheme_Object *rator, mz_jit_state *jitter, i
             iref = NULL;
           jit_movi_l(JIT_R0, aoffset);
           mz_rs_sync();
-          (void)jit_calli(sjc.box_flonum_from_stack_code);
+          MZ_FPUSEL_STMT(extfl,
+                         (void)jit_calli(sjc.box_extflonum_from_stack_code),
+                         (void)jit_calli(sjc.box_flonum_from_stack_code));
           if (i != num_rands - 1)
             mz_rs_stxi(i+1, JIT_R0);
           if (iref) {
@@ -1207,7 +1222,6 @@ static int generate_self_tail_call(Scheme_Object *rator, mz_jit_state *jitter, i
           CHECK_LIMIT();
           if (i != num_rands - 1)
             mz_popr_p(JIT_R0);
-          arg_tmp_offset -= sizeof(double);
         }
       }
     }
@@ -1215,8 +1229,11 @@ static int generate_self_tail_call(Scheme_Object *rator, mz_jit_state *jitter, i
     /* Arguments already in place may also need to be boxed. */
     arg_tmp_offset = jitter->self_restart_offset;
     for (i = 0; i < args_already_in_place; i++) {
-      if (CLOSURE_ARGUMENT_IS_FLONUM(jitter->self_data, i)) {
+      if (CLOSURE_ARGUMENT_IS_FLONUM(jitter->self_data, i)
+          || CLOSURE_ARGUMENT_IS_EXTFLONUM(jitter->self_data, i)) {
         GC_CAN_IGNORE jit_insn *iref;
+        int extfl;
+        extfl = CLOSURE_ARGUMENT_IS_EXTFLONUM(jitter->self_data, i);
         mz_pushr_p(JIT_R0);
         mz_ld_runstack_base_alt(JIT_R2);
         jit_subi_p(JIT_R2, JIT_RUNSTACK_BASE_OR_ALT(JIT_R2), WORDS_TO_BYTES(num_rands + args_already_in_place)); 
@@ -1228,7 +1245,9 @@ static int generate_self_tail_call(Scheme_Object *rator, mz_jit_state *jitter, i
         {
           int aoffset = JIT_FRAME_FLOSTACK_OFFSET - arg_tmp_offset;
           jit_movi_l(JIT_R0, aoffset);
-          (void)jit_calli(sjc.box_flonum_from_stack_code);
+          MZ_FPUSEL_STMT(extfl,
+                         (void)jit_calli(sjc.box_extflonum_from_stack_code),
+                         (void)jit_calli(sjc.box_flonum_from_stack_code));
           mz_ld_runstack_base_alt(JIT_R2);
           jit_subi_p(JIT_R2, JIT_RUNSTACK_BASE_OR_ALT(JIT_R2), WORDS_TO_BYTES(num_rands + args_already_in_place)); 
           jit_stxi_p(WORDS_TO_BYTES(i), JIT_R2, JIT_R0);
@@ -1238,7 +1257,7 @@ static int generate_self_tail_call(Scheme_Object *rator, mz_jit_state *jitter, i
         __END_TINY_JUMPS__(1);
         mz_popr_p(JIT_R0);
         CHECK_LIMIT();
-        arg_tmp_offset -= sizeof(double);
+        arg_tmp_offset -= MZ_FPUSEL(extfl, 2*sizeof(double), sizeof(double));
       }
     }
   }
@@ -1515,58 +1534,24 @@ static jit_direct_arg *check_special_direct_args(Scheme_App_Rec *app, Scheme_Obj
 
 #ifdef USE_FLONUM_UNBOXING
 
-static int generate_fp_argument_shuffle(int direct_flostack_offset, mz_jit_state *jitter)
+static int generate_fp_argument_shift(int direct_flostack_offset, mz_jit_state *jitter, int src_fp_reg)
 {
-  int i, j;
+  int i;
 
-  /* Copy unboxed flonums into place where the target code expects them,
-     which is shifted and reverse of the order that we pushed. */
-  if (direct_flostack_offset
-      && ((direct_flostack_offset > sizeof(double))
-          || (direct_flostack_offset != jitter->flostack_offset))) {
-    /* If the source and target areas don't overlap (or if they
-       overlap only by one item), we can do it in one step, otherwise
-       reverse then shift. */
-    if (jitter->flostack_offset >= ((2 * direct_flostack_offset) - sizeof(double))) {
-      /* one step: */
-      if (direct_flostack_offset != jitter->flostack_offset) {
-        /* shift: */
-        for (i = 0; i < direct_flostack_offset; i += sizeof(double)) {
-          int i_pos, a_pos;
-          i_pos = jitter->flostack_offset - direct_flostack_offset + i + sizeof(double);
-          a_pos = direct_flostack_offset - i;
-          if (i_pos != a_pos) {
-            mz_ld_fppush(JIT_FPR0, i_pos, 0);
-            mz_st_fppop(a_pos, JIT_FPR0, 0);
-            CHECK_LIMIT();
-          }
-        }
-      }
-    } else {
-      /* reverse: */          
-      for (i = 0, j = direct_flostack_offset-sizeof(double); i < j; i += sizeof(double), j -= sizeof(double)) {
-        int i_pos, j_pos;
-        i_pos = jitter->flostack_offset - direct_flostack_offset + i + sizeof(double);
-        j_pos = jitter->flostack_offset - direct_flostack_offset + j + sizeof(double);
-        mz_ld_fppush(JIT_FPR1, i_pos, 0);
-        mz_ld_fppush(JIT_FPR0, j_pos, 0);
-        mz_st_fppop(i_pos, JIT_FPR0, 0);
-        mz_st_fppop(j_pos, JIT_FPR1, 0);
-        CHECK_LIMIT();
-      }
-     
-      if (direct_flostack_offset != jitter->flostack_offset) {
-        /* shift: */
-        for (i = 0; i < direct_flostack_offset; i += sizeof(double)) {
-          int i_pos, a_pos;
-          i_pos = jitter->flostack_offset - direct_flostack_offset + i + sizeof(double);
-          mz_ld_fppush(JIT_FPR0, i_pos, 0);
-          a_pos = i + sizeof(double);
-          mz_st_fppop(a_pos, JIT_FPR0, 0);
-          CHECK_LIMIT();
-        }
-      }
-    }
+  if ((src_fp_reg == JIT_FP)
+      && (jitter->flostack_offset == direct_flostack_offset))
+    /* no shift needed */
+    return 1;
+
+  /* Since we're just shifting bytes, it's ok to pretend that all 
+     boxed values are `double's. */
+  for (i = 0; i < direct_flostack_offset; i += sizeof(double)) {
+    int i_pos, a_pos;
+    i_pos = jitter->flostack_offset - direct_flostack_offset + i + sizeof(double);
+    mz_ld_fppush_x(JIT_FPR0, i_pos, src_fp_reg, 0);
+    a_pos = i + sizeof(double);
+    mz_st_fppop(a_pos, JIT_FPR0, 0);
+    CHECK_LIMIT();
   }
 
   return 1;
@@ -1585,18 +1570,12 @@ static int generate_call_path_with_unboxes(mz_jit_state *jitter, int direct_flos
   /* Callback code to copy unboxed arguments.
      R1 has the return address, R2 holds the old FP */
 
-  offset = FLOSTACK_SPACE_CHUNK * ((direct_flostack_offset + (FLOSTACK_SPACE_CHUNK - 1)) 
+  offset = FLOSTACK_SPACE_CHUNK * ((direct_flostack_offset + (FLOSTACK_SPACE_CHUNK - 1))
                                    / FLOSTACK_SPACE_CHUNK);
   jit_subi_l(JIT_SP, JIT_SP, offset);
   
-  for (i = 0; i < direct_flostack_offset; i += sizeof(double)) {
-    int i_pos, a_pos;
-    i_pos = jitter->flostack_offset - direct_flostack_offset + i + sizeof(double);
-    a_pos = direct_flostack_offset - i;
-    mz_ld_fppush_x(JIT_FPR0, i_pos, JIT_R2, 0);
-    mz_st_fppop(a_pos, JIT_FPR0, 0);
-    CHECK_LIMIT();
-  }
+  generate_fp_argument_shift(direct_flostack_offset, jitter, JIT_R2);
+  CHECK_LIMIT();
 
   jit_jmpr(JIT_R1);
 
@@ -1617,12 +1596,16 @@ static int generate_call_path_with_unboxes(mz_jit_state *jitter, int direct_flos
   /* box arguments for slow path */
   for (i = 0, k = 0; i < num_rands; i++) {
     if ((SCHEME_CLOSURE_DATA_FLAGS(direct_data) & CLOS_HAS_TYPED_ARGS)
-        && (CLOSURE_ARGUMENT_IS_FLONUM(direct_data, i))) {
-      k += sizeof(double);
+        && (CLOSURE_ARGUMENT_IS_FLONUM(direct_data, i)
+            || CLOSURE_ARGUMENT_IS_EXTFLONUM(direct_data, i))) {
+      int extfl;
+      extfl = CLOSURE_ARGUMENT_IS_EXTFLONUM(direct_data, i);
+
+      k += MZ_FPUSEL(extfl, 2*sizeof(double), sizeof(double));
       offset = jitter->flostack_offset - direct_flostack_offset + k;
       offset = JIT_FRAME_FLOSTACK_OFFSET - offset;
       jit_ldxi_p(JIT_R0, JIT_RUNSTACK, WORDS_TO_BYTES(i));
-      scheme_generate_flonum_local_boxing(jitter, i, offset, JIT_R0, 0);
+      scheme_generate_flonum_local_boxing(jitter, i, offset, JIT_R0, extfl);
     }
   }
 
@@ -1632,7 +1615,6 @@ static int generate_call_path_with_unboxes(mz_jit_state *jitter, int direct_flos
   
   return 1;
 }
-
 #endif
 
 int scheme_generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_rands, 
@@ -1905,6 +1887,23 @@ int scheme_generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_
     direct_data = jitter->self_data;
 #endif
 
+#ifdef USE_FLONUM_UNBOXING
+  /* we want to push flonums into local storage in reverse order
+     of evaluation, so make a pass to create space: */
+  if (direct_data
+      && (SCHEME_CLOSURE_DATA_FLAGS(direct_data) & CLOS_HAS_TYPED_ARGS)) {
+    for (i = num_rands; i--; ) {
+      int extfl;
+      extfl = CLOSURE_ARGUMENT_IS_EXTFLONUM(direct_data, i+args_already_in_place);
+      if (extfl || CLOSURE_ARGUMENT_IS_FLONUM(direct_data, i+args_already_in_place)) {
+        /* make space: */
+        scheme_generate_flonum_local_unboxing(jitter, 0, 1, extfl);
+        CHECK_LIMIT();
+      }
+    }
+  }
+#endif
+
   for (i = 0; i < num_rands; i++) {
     PAUSE_JIT_DATA();
     arg = (alt_rands 
@@ -1918,30 +1917,40 @@ int scheme_generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_
 #ifdef USE_FLONUM_UNBOXING
     if (direct_data
         && (SCHEME_CLOSURE_DATA_FLAGS(direct_data) & CLOS_HAS_TYPED_ARGS)
-        && (CLOSURE_ARGUMENT_IS_FLONUM(direct_data, i+args_already_in_place))) {
+        && (CLOSURE_ARGUMENT_IS_FLONUM(direct_data, i+args_already_in_place)
+            || CLOSURE_ARGUMENT_IS_EXTFLONUM(direct_data, i+args_already_in_place))) {
       int directly;
+      int extfl;
+      extfl = CLOSURE_ARGUMENT_IS_EXTFLONUM(direct_data, i+args_already_in_place);
       jitter->unbox++;
-      if (scheme_can_unbox_inline(arg, 5, JIT_FPR_NUM-1, 0, 0))
+      MZ_FPUSEL_STMT_ONLY(extfl, jitter->unbox_extflonum++);
+      if (scheme_can_unbox_inline(arg, 5, JIT_FPUSEL_FPR_NUM(extfl)-1, 0, extfl))
         directly = 2;
-      else if (scheme_can_unbox_directly(arg, 0))
+      else if (scheme_can_unbox_directly(arg, extfl))
         directly = 1;
       else
         directly = 0;
       scheme_generate_unboxed(arg, jitter, directly, 1);
+      MZ_FPUSEL_STMT_ONLY(extfl, --jitter->unbox_extflonum);
       --jitter->unbox;
       --jitter->unbox_depth;
       CHECK_LIMIT();
-      scheme_generate_flonum_local_unboxing(jitter, 0, 0);
+
+      /* use space made by scheme_generate_flonum_local_unboxing() above: */
+      mz_st_fppop(jitter->flostack_offset - direct_flostack_offset, 
+                  MZ_FPUSEL(extfl, JIT_FPU_FPR0, JIT_FPR0), 
+                  extfl);
+      direct_flostack_offset += MZ_FPUSEL(extfl, 2 * sizeof(double), sizeof(double));
       CHECK_LIMIT();
+
       if (SAME_TYPE(SCHEME_TYPE(arg), scheme_local_type)) {
-        /* Keep local Scheme_Object view, in case a box has been allocated */
+        /* Keep local Scheme_Object* view, in case a box has been allocated */
         int apos;
         apos = mz_remap(SCHEME_LOCAL_POS(arg));
         mz_rs_ldxi(JIT_R0, apos);
       } else {
         (void)jit_movi_p(JIT_R0, NULL);
       }
-      direct_flostack_offset += sizeof(double);
     } else
 #endif
       if (inline_direct_args) {
@@ -2051,13 +2060,14 @@ int scheme_generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_
       code = sjc.shared_tail_code[dp][num_rands];
       if (direct_self) {
         LOG_IT(("<-self\n"));
-	generate_self_tail_call(rator, jitter, num_rands, code, args_already_in_place, app, alt_rands);
+	generate_self_tail_call(rator, jitter, num_rands, code, args_already_in_place, direct_flostack_offset, 
+                                app, alt_rands);
 	CHECK_LIMIT();
       } else if (inline_direct_native) {
         LOG_IT(("<-native-tail\n"));
 #ifdef USE_FLONUM_UNBOXING
         /* Copy unboxed flonums into place where the target code expects them: */
-        generate_fp_argument_shuffle(direct_flostack_offset, jitter);
+        generate_fp_argument_shift(direct_flostack_offset, jitter, JIT_FP);
         CHECK_LIMIT();
 #endif
         scheme_mz_flostack_restore(jitter, 
diff --git a/src/racket/src/jitcommon.c b/src/racket/src/jitcommon.c
index e18bc52edd..4b18477442 100644
--- a/src/racket/src/jitcommon.c
+++ b/src/racket/src/jitcommon.c
@@ -1698,7 +1698,9 @@ static int common4(mz_jit_state *jitter, void *_data)
         jit_movi_i(JIT_R1, 3);
         if (i == 2) {
           /* need to box flonum */
-          scheme_generate_alloc_double(jitter, 1, JIT_R0);
+          MZ_FPUSEL_STMT(iii,
+                         scheme_generate_alloc_long_double(jitter, 1, JIT_R0),
+                         scheme_generate_alloc_double(jitter, 1, JIT_R0));
           jit_stxi_p(WORDS_TO_BYTES(2), JIT_RUNSTACK, JIT_R0);
         }
       }
@@ -2152,13 +2154,11 @@ static int common5(mz_jit_state *jitter, void *_data)
       sjc.retry_alloc_code = jit_get_ip().ptr;
     else if (i == 1)
       sjc.retry_alloc_code_keep_r0_r1 = jit_get_ip().ptr;
-    else if (i == 2) {
+    else if (i == 2)
       sjc.retry_alloc_code_keep_fpr1 = jit_get_ip().ptr;
-    }
 #ifdef MZ_LONG_DOUBLE
-    else if (i == 3) {
+    else if (i == 3)
       sjc.retry_alloc_code_keep_extfpr1 = jit_get_ip().ptr;
-    }
 #endif
 
     mz_prolog(JIT_V1);
@@ -2248,9 +2248,26 @@ static int common5(mz_jit_state *jitter, void *_data)
     mz_epilog(JIT_R2);
   }
 
+#ifdef MZ_LONG_DOUBLE
+  /* *** box_extflonum_from_stack_code *** */
+  /* R0 has offset from frame pointer to long double on stack */
+  {
+    sjc.box_extflonum_from_stack_code = jit_get_ip().ptr;
+
+    mz_prolog(JIT_R2);
+
+    JIT_UPDATE_THREAD_RSPTR();
+
+    jit_movr_p(JIT_R1, JIT_FP);
+    jit_fpu_ldxr_ld_fppush(JIT_FPU_FPR0, JIT_R1, JIT_R0);
+    scheme_generate_alloc_long_double(jitter, 1, JIT_R0);
+    CHECK_LIMIT();
+    
+    mz_epilog(JIT_R2);
+  }
+
   /* *** box_extflonum_from_reg_code *** */
   /* JIT_FPU_FPR2 (reg-based) or JIT_FPU_FPR0 (stack-based) has value */
-#ifdef MZ_LONG_DOUBLE
   {
     sjc.box_extflonum_from_reg_code = jit_get_ip().ptr;
 
@@ -2258,10 +2275,6 @@ static int common5(mz_jit_state *jitter, void *_data)
 
     JIT_UPDATE_THREAD_RSPTR();
 
-#ifdef DISABLED_DIRECT_FPR_ACCESS
-    jit_fpu_movr_ld(JIT_FPU_FPR0, JIT_FPU_FPR2);
-#endif
-
     scheme_generate_alloc_long_double(jitter, 1, JIT_R0);
     CHECK_LIMIT();
     
diff --git a/src/racket/src/jitinline.c b/src/racket/src/jitinline.c
index 0e15805cb3..51a58bb083 100644
--- a/src/racket/src/jitinline.c
+++ b/src/racket/src/jitinline.c
@@ -1372,9 +1372,10 @@ int scheme_generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
       } else if (IS_NAMED_PRIM(rator, "fxvector-length")) {
         for_fx = 1;
       } else if (MZ_LONG_DOUBLE_AND(IS_NAMED_PRIM(rator, "extflvector-length"))) {
+        for_fl = 1;
         extfl = 1;
-        unsafe = 1;
       } else if (MZ_LONG_DOUBLE_AND(IS_NAMED_PRIM(rator, "unsafe-extflvector-length"))) {
+        for_fl = 1;
         extfl = 1;
         unsafe = 1;
       } else {
@@ -2590,6 +2591,9 @@ int scheme_generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
   } else if (IS_NAMED_PRIM(rator, "unsafe-extfl=")) {
     scheme_generate_extflonum_arith(jitter, rator, app->rand1, app->rand2, 2, 0, CMP_EQUAL, 0, for_branch, branch_short, 0, 1, NULL, dest);
     return 1;
+  } else if (IS_NAMED_PRIM(rator, "extfl=")) {
+    scheme_generate_extflonum_arith(jitter, rator, app->rand1, app->rand2, 2, 0, CMP_EQUAL, 0, for_branch, branch_short, 0, -1, NULL, dest);
+    return 1;
   } else if (IS_NAMED_PRIM(rator, "unsafe-extfl<=")) {
     scheme_generate_extflonum_arith(jitter, rator, app->rand1, app->rand2, 2, 0, CMP_LEQ, 0, for_branch, branch_short, 0, 1, NULL, dest);
     return 1;
@@ -3013,14 +3017,17 @@ int scheme_generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
       return 1;
     } else if (IS_NAMED_PRIM(rator, "unsafe-f64vector-ref")
                || IS_NAMED_PRIM(rator, "unsafe-flvector-ref")
-               || MZ_LONG_DOUBLE_AND(IS_NAMED_PRIM(rator, "unsafe-extflvector-ref"))) {
+               || MZ_LONG_DOUBLE_AND(IS_NAMED_PRIM(rator, "unsafe-extflvector-ref")
+                                     || IS_NAMED_PRIM(rator, "unsafe-f80vector-ref"))) {
       int fpr0;
       int is_f64;
       int extfl;
       mz_jit_unbox_state ubs;
 
-      is_f64 = IS_NAMED_PRIM(rator, "unsafe-f64vector-ref");
-      extfl = MZ_LONG_DOUBLE_AND(IS_NAMED_PRIM(rator, "unsafe-extflvector-ref"));
+      is_f64 = IS_NAMED_PRIM(rator, "unsafe-f64vector-ref")
+        || MZ_LONG_DOUBLE_AND(IS_NAMED_PRIM(rator, "unsafe-f80vector-ref"));
+      extfl = MZ_LONG_DOUBLE_AND(IS_NAMED_PRIM(rator, "unsafe-extflvector-ref")
+                                 || IS_NAMED_PRIM(rator, "unsafe-f80vector-ref"));
 
       scheme_mz_unbox_save(jitter, &ubs); /* no unboxing of vector and index arguments */
       scheme_generate_two_args(app->rand1, app->rand2, jitter, 1, 2);
@@ -3042,7 +3049,7 @@ int scheme_generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
       }
 
       if (jitter->unbox)
-        fpr0 = JIT_FPR_0(jitter->unbox_depth);
+        fpr0 = JIT_FPUSEL_FPR_0(jitter->unbox_extflonum, jitter->unbox_depth);
       else
         fpr0 = MZ_FPUSEL(extfl, JIT_FPU_FPR0, JIT_FPR0);
 
@@ -3950,13 +3957,16 @@ int scheme_generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
       return 1;
     } else if (IS_NAMED_PRIM(rator, "unsafe-f64vector-set!")
                || IS_NAMED_PRIM(rator, "unsafe-flvector-set!")
-               || MZ_LONG_DOUBLE_AND(IS_NAMED_PRIM(rator, "unsafe-extflvector-set!"))) {
+               || MZ_LONG_DOUBLE_AND(IS_NAMED_PRIM(rator, "unsafe-extflvector-set!")
+                                     || IS_NAMED_PRIM(rator, "unsafe-f80vector-set!"))) {
       int is_f64;
       int can_direct, got_two;
       int extfl;
 
-      is_f64 = IS_NAMED_PRIM(rator, "unsafe-f64vector-set!");
-      extfl = MZ_LONG_DOUBLE_AND(IS_NAMED_PRIM(rator, "unsafe-extflvector-set!"));
+      is_f64 = IS_NAMED_PRIM(rator, "unsafe-f64vector-set!")
+        || MZ_LONG_DOUBLE_AND(IS_NAMED_PRIM(rator, "unsafe-f80vector-set!"));
+      extfl = MZ_LONG_DOUBLE_AND(IS_NAMED_PRIM(rator, "unsafe-extflvector-set!"))
+        || MZ_LONG_DOUBLE_AND(IS_NAMED_PRIM(rator, "unsafe-f80vector-set!"));
       
       if (scheme_is_constant_and_avoids_r1(app->args[1])
           && scheme_is_constant_and_avoids_r1(app->args[2])) {
diff --git a/src/racket/src/lightning/i386/fp-extfpu.h b/src/racket/src/lightning/i386/fp-extfpu.h
index e78b5aff2b..016dccb5a4 100644
--- a/src/racket/src/lightning/i386/fp-extfpu.h
+++ b/src/racket/src/lightning/i386/fp-extfpu.h
@@ -162,6 +162,12 @@ union jit_fpu_double_imm {
    MOVQir(((intptr_t)is), JIT_R0),              \
    jit_fpu_ldr_d_fppush(rd, JIT_R0),            \
    MOVQrr(JIT_REXTMP, JIT_R0))
+
+#define jit_fpu_ldi_ld_fppush(rd, is)           \
+  (MOVQrr(JIT_R0, JIT_REXTMP),                  \
+   MOVQir(((intptr_t)is), JIT_R0),              \
+   jit_fpu_ldr_ld_fppush(rd, JIT_R0),           \
+   MOVQrr(JIT_REXTMP, JIT_R0))
 #else
 #define jit_fpu_ldi_f(rd, is)                           \
   ((rd) == 0 ? (FSTPr (0), FLDSm((is), 0, 0, 0))        \
@@ -261,6 +267,13 @@ union jit_fpu_double_imm {
    MOVQir(((intptr_t)is), JIT_R0),              \
    jit_fpu_str_d_fppop(JIT_R0, rd),             \
    MOVQrr(JIT_REXTMP, JIT_R0))
+
+#define jit_fpu_sti_ld_fppop(is, rd)            \
+  (MOVQrr(JIT_R0, JIT_REXTMP),                  \
+   MOVQir(((intptr_t)is), JIT_R0),              \
+   jit_fpu_str_ld_fppop(JIT_R0, rd),            \
+   MOVQrr(JIT_REXTMP, JIT_R0))
+
 #else
 #define jit_fpu_sti_f(id, rs)      jit_fpu_fxch ((rs), FPX(), FSTSm((id), 0,    0, 0))
 #define jit_fpu_str_f(rd, rs)      jit_fpu_fxch ((rs), FPX(), FSTSm(0,    (rd), 0, 0))
diff --git a/src/racket/src/number.c b/src/racket/src/number.c
index b072d983db..f36e907ebf 100644
--- a/src/racket/src/number.c
+++ b/src/racket/src/number.c
@@ -208,6 +208,9 @@ static Scheme_Object *TO_FLOAT(const Scheme_Object *n);
 #endif
 Scheme_Object *scheme_TO_DOUBLE(const Scheme_Object *n);
 
+static Scheme_Object *extfl_ref (int argc, Scheme_Object *argv[]);
+static Scheme_Object *extfl_set (int argc, Scheme_Object *argv[]);
+
 #ifdef MZ_LONG_DOUBLE
 static Scheme_Object *exact_to_extfl(int argc, Scheme_Object *argv[]);
 #endif
@@ -1487,6 +1490,28 @@ void scheme_init_extfl_unsafe_number(Scheme_Env *env)
   SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
                                                             | SCHEME_PRIM_WANTS_EXTFLONUM_THIRD);
   scheme_add_global_constant("unsafe-extflvector-set!", p, env);
+
+  p = scheme_make_immed_prim(extfl_ref, "unsafe-f80vector-ref",
+                             2, 2);
+  if (MZ_LONG_DOUBLE_AND(scheme_can_inline_fp_op()))
+    flags = SCHEME_PRIM_IS_BINARY_INLINED;
+  else
+    flags = SCHEME_PRIM_SOMETIMES_INLINED;
+  SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
+                                                            | SCHEME_PRIM_IS_UNSAFE_OMITABLE
+                                                            | SCHEME_PRIM_IS_OMITABLE
+                                                            | SCHEME_PRIM_PRODUCES_EXTFLONUM);
+  scheme_add_global_constant("unsafe-f80vector-ref", p, env);
+  
+  p = scheme_make_immed_prim(extfl_set, "unsafe-f80vector-set!",
+                             3, 3);
+  if (MZ_LONG_DOUBLE_AND(1))
+    flags = SCHEME_PRIM_IS_NARY_INLINED;
+  else
+    flags = SCHEME_PRIM_SOMETIMES_INLINED;
+  SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
+                                                            | SCHEME_PRIM_WANTS_EXTFLONUM_THIRD);
+  scheme_add_global_constant("unsafe-f80vector-set!", p, env);
 }
 
 Scheme_Object *
@@ -2485,8 +2510,40 @@ double scheme_double_floor(double x) { return floor(x); }
 double scheme_double_ceiling(double x) { return ceil(x); }
 
 #ifdef MZ_LONG_DOUBLE
+XFORM_NONGCING static long double SCH_ROUNDL(long double d)
+{
+  long double i, frac;
+  int invert;
+
+#ifdef FMOD_CAN_RETURN_POS_ZERO
+  if ((d == 0.0L) && long_minus_zero_p(d))
+    return d;
+#endif
+
+  if (d < 0.0L) {
+    d = -d;
+    invert = 1;
+  } else
+    invert = 0;
+
+  frac = modfl(d, &i);
+  if (frac < 0.5L)
+    d = i;
+  else if (frac > 0.5L)
+    d = i + 1;
+  else if (fmodl(i, 2.0L) != 0.0L)
+    d = i + 1;
+  else
+    d = i;
+
+  if (invert)
+    d = -d;
+
+  return d;
+}
+
 long double scheme_long_double_truncate(long double x) { return truncl(x); }
-long double scheme_long_double_round(long double x) { return roundl(x); }
+long double scheme_long_double_round(long double x) { return SCH_ROUNDL(x); }
 long double scheme_long_double_floor(long double x) { return floorl(x); }
 long double scheme_long_double_ceiling(long double x) { return ceill(x); }
 #endif
@@ -4618,6 +4675,31 @@ Scheme_Object *scheme_extflvector_length(Scheme_Object *vec)
 #endif
 }
 
+static Scheme_Object *extfl_ref (int argc, Scheme_Object *argv[])
+{
+#ifdef MZ_LONG_DOUBLE
+  long double v;
+  Scheme_Object *p;
+  p = ((Scheme_Structure *)argv[0])->slots[0];
+  v = ((long double *)SCHEME_CPTR_VAL(p))[SCHEME_INT_VAL(argv[1])];
+  return scheme_make_long_double(v);
+#else
+  return unsupported("unsafe-f80vector-ref");
+#endif
+}
+
+static Scheme_Object *extfl_set (int argc, Scheme_Object *argv[])
+{
+#ifdef MZ_LONG_DOUBLE
+  Scheme_Object *p;
+  p = ((Scheme_Structure *)argv[0])->slots[0];
+  ((long double *)SCHEME_CPTR_VAL(p))[SCHEME_INT_VAL(argv[1])] = SCHEME_LONG_DBL_VAL(argv[2]);
+  return scheme_void;
+#else
+  return unsupported("unsafe-f80vector-set!");
+#endif
+}
+
 static Scheme_Object *extflvector_length (int argc, Scheme_Object *argv[])
 {
   return scheme_extflvector_length(argv[0]);
@@ -4995,8 +5077,8 @@ static Scheme_Object *extfl_to_fx (int argc, Scheme_Object *argv[])
   Scheme_Object *o;
 
   if (!SCHEME_LONG_DBLP(argv[0])
-      && !scheme_is_integer(argv[0]))
-    scheme_wrong_contract("extfl->fx", "(and/c extflonum? integer?)", 0, argc, argv);
+      /* && !scheme_is_integer(argv[0]) */)
+    scheme_wrong_contract("extfl->fx", "(and/c extflonum?)", 0, argc, argv);
 
   d = SCHEME_LONG_DBL_VAL(argv[0]);
   v = (intptr_t)d;
diff --git a/src/racket/src/schminc.h b/src/racket/src/schminc.h
index b65e60cd13..463e625703 100644
--- a/src/racket/src/schminc.h
+++ b/src/racket/src/schminc.h
@@ -15,7 +15,7 @@
 #define USE_COMPILED_STARTUP 1
 
 #define EXPECTED_PRIM_COUNT 1086
-#define EXPECTED_UNSAFE_COUNT 98
+#define EXPECTED_UNSAFE_COUNT 100
 #define EXPECTED_FLFXNUM_COUNT 69
 #define EXPECTED_EXTFL_COUNT 45
 #define EXPECTED_FUTURES_COUNT 15
diff --git a/src/racket/src/schvers.h b/src/racket/src/schvers.h
index fa07a47361..677937e454 100644
--- a/src/racket/src/schvers.h
+++ b/src/racket/src/schvers.h
@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "5.3.3.2"
+#define MZSCHEME_VERSION "5.3.3.3"
 
 #define MZSCHEME_VERSION_X 5
 #define MZSCHEME_VERSION_Y 3
 #define MZSCHEME_VERSION_Z 3
-#define MZSCHEME_VERSION_W 2
+#define MZSCHEME_VERSION_W 3
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)