Fix i386 code generated for flonum rounding primitives.

The default has not been round-to-even since primitives were added to
change it, but the generated code assumed it was.

Remember to run at least a two-stage build so that the runtime is
compiled with the new compiler.

Before:

(flo:with-rounding-mode 'TOWARD-ZERO (lambda () (flo:ceiling 1.2)))
;Value: 1.

After:

(flo:with-rounding-mode 'TOWARD-ZERO (lambda () (flo:ceiling 1.2)))
;Value: 2.

diff --git a/src/compiler/machines/i386/rulflo.scm b/src/compiler/machines/i386/rulflo.scm
index 04eea3493f672cc8155a06c7677ca4a7f681948c..09523a1efc32cc63db032a8f8ece5005ed25a418 100644 (file)
--- a/src/compiler/machines/i386/rulflo.scm
+++ b/src/compiler/machines/i386/rulflo.scm
@@ -265,11 +265,7 @@ USA.
   ;; Disabled: FSIN and FCOS limited to pi * 2^62.
   ;;(define-flonum-operation FLONUM-SIN FSIN)
   ;;(define-flonum-operation FLONUM-COS FCOS)
-  (define-flonum-operation FLONUM-SQRT FSQRT)
-  (define-flonum-operation FLONUM-ROUND FRNDINT))
-
-;; These (and FLONUM-ROUND above) presume that the default rounding mode
-;; is round-to-nearest/even
+  (define-flonum-operation FLONUM-SQRT FSQRT))
 
 (define (define-rounding prim-name mode)
   (define-arithmetic-method prim-name flonum-methods/1-arg
@@ -281,6 +277,7 @@ USA.
                    (LAP)
                    (LAP (FLD (ST ,source))))
              (MOV B ,temp (@RO B ,regnum:free-pointer 1))
+             (AND B (@RO B ,regnum:free-pointer 1) (&U #xf3))
              (OR B (@RO B ,regnum:free-pointer 1) (&U ,mode))
              (FNLDCW (@R ,regnum:free-pointer))
              (FRNDINT)
@@ -290,6 +287,7 @@ USA.
                    (LAP (FSTP (ST ,(1+ target)))))
              (FNLDCW (@R ,regnum:free-pointer))))))))
 
+(define-rounding 'FLONUM-ROUND #x00)
 (define-rounding 'FLONUM-CEILING #x08)
 (define-rounding 'FLONUM-FLOOR #x04)
 (define-rounding 'FLONUM-TRUNCATE #x0c)