From 7fdd72673d112d3f0ee5b7b966629a67a8a11f37 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Fri, 6 Aug 2010 01:36:09 +0000 Subject: [PATCH] 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. --- src/compiler/machines/i386/rulflo.scm | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/compiler/machines/i386/rulflo.scm b/src/compiler/machines/i386/rulflo.scm index 04eea3493..09523a1ef 100644 --- 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) -- 2.25.1