From 720d634388c2b79f964e4986cecec3a4ff109368 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 28 Aug 2010 12:01:09 -0500 Subject: [PATCH] math.floats.env.x86: make sure the x87 stack is cleared after the overflow test, otherwise random things screw up later --- basis/math/floats/env/env-tests.factor | 103 +++++++++++---------- basis/math/floats/env/x86/x86-tests.factor | 5 +- 2 files changed, 56 insertions(+), 52 deletions(-) mode change 100644 => 100755 basis/math/floats/env/env-tests.factor mode change 100644 => 100755 basis/math/floats/env/x86/x86-tests.factor diff --git a/basis/math/floats/env/env-tests.factor b/basis/math/floats/env/env-tests.factor old mode 100644 new mode 100755 index 89aa1bd394..08e2ed1a9e --- a/basis/math/floats/env/env-tests.factor +++ b/basis/math/floats/env/env-tests.factor @@ -113,23 +113,26 @@ os linux? cpu x86.64? and [ ! FP traps cause a kernel panic on OpenBSD 4.5 i386 os openbsd eq? cpu x86.32 eq? and [ - : test-traps ( traps inputs quot -- quot' ) - append '[ _ _ with-fp-traps ] ; + : fp-trap-error? ( error -- ? ) + 2 head { "kernel-error" 17 } = ; - : test-traps-compiled ( traps inputs quot -- quot' ) - swapd '[ @ [ _ _ with-fp-traps ] compile-call ] ; + : test-traps ( traps inputs quot -- quot' fail-quot ) + append '[ _ _ with-fp-traps ] [ fp-trap-error? ] ; - { +fp-zero-divide+ } [ 1.0 0.0 ] [ /f ] test-traps must-fail - { +fp-inexact+ } [ 1.0 3.0 ] [ /f ] test-traps must-fail - { +fp-invalid-operation+ } [ -1.0 ] [ fsqrt ] test-traps must-fail - { +fp-overflow+ } [ 2.0 ] [ 100,000.0 ^ ] test-traps must-fail - { +fp-underflow+ +fp-inexact+ } [ 2.0 ] [ -100,000.0 ^ ] test-traps must-fail + : test-traps-compiled ( traps inputs quot -- quot' fail-quot ) + swapd '[ @ [ _ _ with-fp-traps ] compile-call ] [ fp-trap-error? ] ; - { +fp-zero-divide+ } [ 1.0 0.0 ] [ /f ] test-traps-compiled must-fail - { +fp-inexact+ } [ 1.0 3.0 ] [ /f ] test-traps-compiled must-fail - { +fp-invalid-operation+ } [ -1.0 ] [ fsqrt ] test-traps-compiled must-fail - { +fp-overflow+ } [ 2.0 ] [ 100,000.0 ^ ] test-traps-compiled must-fail - { +fp-underflow+ +fp-inexact+ } [ 2.0 ] [ -100,000.0 ^ ] test-traps-compiled must-fail + { +fp-zero-divide+ } [ 1.0 0.0 ] [ /f ] test-traps must-fail-with + { +fp-inexact+ } [ 1.0 3.0 ] [ /f ] test-traps must-fail-with + { +fp-invalid-operation+ } [ -1.0 ] [ fsqrt ] test-traps must-fail-with + { +fp-overflow+ } [ 2.0 ] [ 100,000.0 ^ ] test-traps must-fail-with + { +fp-underflow+ +fp-inexact+ } [ 2.0 ] [ -100,000.0 ^ ] test-traps must-fail-with + + { +fp-zero-divide+ } [ 1.0 0.0 ] [ /f ] test-traps-compiled must-fail-with + { +fp-inexact+ } [ 1.0 3.0 ] [ /f ] test-traps-compiled must-fail-with + { +fp-invalid-operation+ } [ -1.0 ] [ fsqrt ] test-traps-compiled must-fail-with + { +fp-overflow+ } [ 2.0 ] [ 100,000.0 ^ ] test-traps-compiled must-fail-with + { +fp-underflow+ +fp-inexact+ } [ 2.0 ] [ -100,000.0 ^ ] test-traps-compiled must-fail-with ! Ensure ordered comparisons raise traps :: test-comparison-quot ( word -- quot ) @@ -138,46 +141,46 @@ os openbsd eq? cpu x86.32 eq? and [ { +fp-invalid-operation+ } [ word execute ] with-fp-traps ] ; - : test-comparison ( inputs word -- quot ) - test-comparison-quot append ; + : test-comparison ( inputs word -- quot fail-quot ) + test-comparison-quot append [ fp-trap-error? ] ; - : test-comparison-compiled ( inputs word -- quot ) - test-comparison-quot '[ @ _ compile-call ] ; + : test-comparison-compiled ( inputs word -- quot fail-quot ) + test-comparison-quot '[ @ _ compile-call ] [ fp-trap-error? ] ; \ float< "intrinsic" word-prop [ - [ 0/0. -15.0 ] \ < test-comparison must-fail - [ 0/0. -15.0 ] \ < test-comparison-compiled must-fail - [ -15.0 0/0. ] \ < test-comparison must-fail - [ -15.0 0/0. ] \ < test-comparison-compiled must-fail - [ 0/0. -15.0 ] \ <= test-comparison must-fail - [ 0/0. -15.0 ] \ <= test-comparison-compiled must-fail - [ -15.0 0/0. ] \ <= test-comparison must-fail - [ -15.0 0/0. ] \ <= test-comparison-compiled must-fail - [ 0/0. -15.0 ] \ > test-comparison must-fail - [ 0/0. -15.0 ] \ > test-comparison-compiled must-fail - [ -15.0 0/0. ] \ > test-comparison must-fail - [ -15.0 0/0. ] \ > test-comparison-compiled must-fail - [ 0/0. -15.0 ] \ >= test-comparison must-fail - [ 0/0. -15.0 ] \ >= test-comparison-compiled must-fail - [ -15.0 0/0. ] \ >= test-comparison must-fail - [ -15.0 0/0. ] \ >= test-comparison-compiled must-fail + [ 0/0. -15.0 ] \ < test-comparison must-fail-with + [ 0/0. -15.0 ] \ < test-comparison-compiled must-fail-with + [ -15.0 0/0. ] \ < test-comparison must-fail-with + [ -15.0 0/0. ] \ < test-comparison-compiled must-fail-with + [ 0/0. -15.0 ] \ <= test-comparison must-fail-with + [ 0/0. -15.0 ] \ <= test-comparison-compiled must-fail-with + [ -15.0 0/0. ] \ <= test-comparison must-fail-with + [ -15.0 0/0. ] \ <= test-comparison-compiled must-fail-with + [ 0/0. -15.0 ] \ > test-comparison must-fail-with + [ 0/0. -15.0 ] \ > test-comparison-compiled must-fail-with + [ -15.0 0/0. ] \ > test-comparison must-fail-with + [ -15.0 0/0. ] \ > test-comparison-compiled must-fail-with + [ 0/0. -15.0 ] \ >= test-comparison must-fail-with + [ 0/0. -15.0 ] \ >= test-comparison-compiled must-fail-with + [ -15.0 0/0. ] \ >= test-comparison must-fail-with + [ -15.0 0/0. ] \ >= test-comparison-compiled must-fail-with - [ f ] [ 0/0. -15.0 ] \ u< test-comparison unit-test - [ f ] [ 0/0. -15.0 ] \ u< test-comparison-compiled unit-test - [ f ] [ -15.0 0/0. ] \ u< test-comparison unit-test - [ f ] [ -15.0 0/0. ] \ u< test-comparison-compiled unit-test - [ f ] [ 0/0. -15.0 ] \ u<= test-comparison unit-test - [ f ] [ 0/0. -15.0 ] \ u<= test-comparison-compiled unit-test - [ f ] [ -15.0 0/0. ] \ u<= test-comparison unit-test - [ f ] [ -15.0 0/0. ] \ u<= test-comparison-compiled unit-test - [ f ] [ 0/0. -15.0 ] \ u> test-comparison unit-test - [ f ] [ 0/0. -15.0 ] \ u> test-comparison-compiled unit-test - [ f ] [ -15.0 0/0. ] \ u> test-comparison unit-test - [ f ] [ -15.0 0/0. ] \ u> test-comparison-compiled unit-test - [ f ] [ 0/0. -15.0 ] \ u>= test-comparison unit-test - [ f ] [ 0/0. -15.0 ] \ u>= test-comparison-compiled unit-test - [ f ] [ -15.0 0/0. ] \ u>= test-comparison unit-test - [ f ] [ -15.0 0/0. ] \ u>= test-comparison-compiled unit-test + [ f ] [ 0/0. -15.0 ] \ u< test-comparison drop unit-test + [ f ] [ 0/0. -15.0 ] \ u< test-comparison-compiled drop unit-test + [ f ] [ -15.0 0/0. ] \ u< test-comparison drop unit-test + [ f ] [ -15.0 0/0. ] \ u< test-comparison-compiled drop unit-test + [ f ] [ 0/0. -15.0 ] \ u<= test-comparison drop unit-test + [ f ] [ 0/0. -15.0 ] \ u<= test-comparison-compiled drop unit-test + [ f ] [ -15.0 0/0. ] \ u<= test-comparison drop unit-test + [ f ] [ -15.0 0/0. ] \ u<= test-comparison-compiled drop unit-test + [ f ] [ 0/0. -15.0 ] \ u> test-comparison drop unit-test + [ f ] [ 0/0. -15.0 ] \ u> test-comparison-compiled drop unit-test + [ f ] [ -15.0 0/0. ] \ u> test-comparison drop unit-test + [ f ] [ -15.0 0/0. ] \ u> test-comparison-compiled drop unit-test + [ f ] [ 0/0. -15.0 ] \ u>= test-comparison drop unit-test + [ f ] [ 0/0. -15.0 ] \ u>= test-comparison-compiled drop unit-test + [ f ] [ -15.0 0/0. ] \ u>= test-comparison drop unit-test + [ f ] [ -15.0 0/0. ] \ u>= test-comparison-compiled drop unit-test ] when ] unless diff --git a/basis/math/floats/env/x86/x86-tests.factor b/basis/math/floats/env/x86/x86-tests.factor old mode 100644 new mode 100755 index 4a77af9856..c8beed1489 --- a/basis/math/floats/env/x86/x86-tests.factor +++ b/basis/math/floats/env/x86/x86-tests.factor @@ -1,13 +1,14 @@ USING: math.floats.env math.floats.env.x86 tools.test classes.struct cpu.x86.assembler cpu.x86.assembler.operands -compiler.test math kernel sequences alien alien.c-types ; +compiler.test math kernel sequences alien alien.c-types +continuations ; IN: math.floats.env.x86.tests - [ t ] [ [ [ void { } cdecl [ 9 [ FLDZ ] times + 9 [ ST0 FSTP ] times ] alien-assembly ] compile-call ] collect-fp-exceptions +fp-x87-stack-fault+ swap member?