steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

math.floats.env.x86: make sure the x87 stack is cleared after the overflow test, otherwise random things screw up later

db4
Slava Pestov 2010-08-28 12:01:09 -05:00
parent 261e55a918
commit 720d634388
2 changed files with 56 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

103
basis/math/floats/env/env-tests.factor vendored Normal file → Executable file
View File

@ -113,23 +113,26 @@ os linux? cpu x86.64? and [
! FP traps cause a kernel panic on OpenBSD 4.5 i386 ! FP traps cause a kernel panic on OpenBSD 4.5 i386
os openbsd eq? cpu x86.32 eq? and [ os openbsd eq? cpu x86.32 eq? and [
: test-traps ( traps inputs quot -- quot' ) : fp-trap-error? ( error -- ? )
append '[ _ _ with-fp-traps ] ; 2 head { "kernel-error" 17 } = ;
: test-traps-compiled ( traps inputs quot -- quot' ) : test-traps ( traps inputs quot -- quot' fail-quot )
swapd '[ @ [ _ _ with-fp-traps ] compile-call ] ; append '[ _ _ with-fp-traps ] [ fp-trap-error? ] ;
{ +fp-zero-divide+ } [ 1.0 0.0 ] [ /f ] test-traps must-fail : test-traps-compiled ( traps inputs quot -- quot' fail-quot )
{ +fp-inexact+ } [ 1.0 3.0 ] [ /f ] test-traps must-fail swapd '[ @ [ _ _ with-fp-traps ] compile-call ] [ fp-trap-error? ] ;
{ +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
{ +fp-zero-divide+ } [ 1.0 0.0 ] [ /f ] 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-compiled must-fail { +fp-inexact+ } [ 1.0 3.0 ] [ /f ] test-traps must-fail-with
{ +fp-invalid-operation+ } [ -1.0 ] [ fsqrt ] test-traps-compiled must-fail { +fp-invalid-operation+ } [ -1.0 ] [ fsqrt ] test-traps must-fail-with
{ +fp-overflow+ } [ 2.0 ] [ 100,000.0 ^ ] test-traps-compiled must-fail { +fp-overflow+ } [ 2.0 ] [ 100,000.0 ^ ] test-traps must-fail-with
{ +fp-underflow+ +fp-inexact+ } [ 2.0 ] [ -100,000.0 ^ ] test-traps-compiled must-fail { +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 ! Ensure ordered comparisons raise traps
:: test-comparison-quot ( word -- quot ) :: 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 { +fp-invalid-operation+ } [ word execute ] with-fp-traps
] ; ] ;
: test-comparison ( inputs word -- quot ) : test-comparison ( inputs word -- quot fail-quot )
test-comparison-quot append ; test-comparison-quot append [ fp-trap-error? ] ;
: test-comparison-compiled ( inputs word -- quot ) : test-comparison-compiled ( inputs word -- quot fail-quot )
test-comparison-quot '[ @ _ compile-call ] ; test-comparison-quot '[ @ _ compile-call ] [ fp-trap-error? ] ;
\ float< "intrinsic" word-prop [ \ float< "intrinsic" word-prop [
[ 0/0. -15.0 ] \ < test-comparison must-fail [ 0/0. -15.0 ] \ < test-comparison must-fail-with
[ 0/0. -15.0 ] \ < test-comparison-compiled must-fail [ 0/0. -15.0 ] \ < test-comparison-compiled must-fail-with
[ -15.0 0/0. ] \ < test-comparison must-fail [ -15.0 0/0. ] \ < test-comparison must-fail-with
[ -15.0 0/0. ] \ < test-comparison-compiled must-fail [ -15.0 0/0. ] \ < test-comparison-compiled must-fail-with
[ 0/0. -15.0 ] \ <= test-comparison must-fail [ 0/0. -15.0 ] \ <= test-comparison must-fail-with
[ 0/0. -15.0 ] \ <= test-comparison-compiled must-fail [ 0/0. -15.0 ] \ <= test-comparison-compiled must-fail-with
[ -15.0 0/0. ] \ <= test-comparison must-fail [ -15.0 0/0. ] \ <= test-comparison must-fail-with
[ -15.0 0/0. ] \ <= test-comparison-compiled must-fail [ -15.0 0/0. ] \ <= test-comparison-compiled must-fail-with
[ 0/0. -15.0 ] \ > test-comparison must-fail [ 0/0. -15.0 ] \ > test-comparison must-fail-with
[ 0/0. -15.0 ] \ > test-comparison-compiled must-fail [ 0/0. -15.0 ] \ > test-comparison-compiled must-fail-with
[ -15.0 0/0. ] \ > test-comparison must-fail [ -15.0 0/0. ] \ > test-comparison must-fail-with
[ -15.0 0/0. ] \ > test-comparison-compiled must-fail [ -15.0 0/0. ] \ > test-comparison-compiled must-fail-with
[ 0/0. -15.0 ] \ >= test-comparison must-fail [ 0/0. -15.0 ] \ >= test-comparison must-fail-with
[ 0/0. -15.0 ] \ >= test-comparison-compiled must-fail [ 0/0. -15.0 ] \ >= test-comparison-compiled must-fail-with
[ -15.0 0/0. ] \ >= test-comparison must-fail [ -15.0 0/0. ] \ >= test-comparison must-fail-with
[ -15.0 0/0. ] \ >= test-comparison-compiled must-fail [ -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 drop unit-test
[ f ] [ 0/0. -15.0 ] \ u< test-comparison-compiled unit-test [ f ] [ 0/0. -15.0 ] \ u< test-comparison-compiled drop unit-test
[ f ] [ -15.0 0/0. ] \ u< test-comparison unit-test [ f ] [ -15.0 0/0. ] \ u< test-comparison drop unit-test
[ f ] [ -15.0 0/0. ] \ u< test-comparison-compiled unit-test [ f ] [ -15.0 0/0. ] \ u< test-comparison-compiled drop unit-test
[ f ] [ 0/0. -15.0 ] \ u<= test-comparison unit-test [ f ] [ 0/0. -15.0 ] \ u<= test-comparison drop unit-test
[ f ] [ 0/0. -15.0 ] \ u<= test-comparison-compiled unit-test [ f ] [ 0/0. -15.0 ] \ u<= test-comparison-compiled drop unit-test
[ f ] [ -15.0 0/0. ] \ u<= test-comparison unit-test [ f ] [ -15.0 0/0. ] \ u<= test-comparison drop unit-test
[ f ] [ -15.0 0/0. ] \ u<= test-comparison-compiled unit-test [ f ] [ -15.0 0/0. ] \ u<= test-comparison-compiled drop unit-test
[ f ] [ 0/0. -15.0 ] \ u> test-comparison unit-test [ f ] [ 0/0. -15.0 ] \ u> test-comparison drop unit-test
[ f ] [ 0/0. -15.0 ] \ u> test-comparison-compiled unit-test [ f ] [ 0/0. -15.0 ] \ u> test-comparison-compiled drop unit-test
[ f ] [ -15.0 0/0. ] \ u> test-comparison unit-test [ f ] [ -15.0 0/0. ] \ u> test-comparison drop unit-test
[ f ] [ -15.0 0/0. ] \ u> test-comparison-compiled unit-test [ f ] [ -15.0 0/0. ] \ u> test-comparison-compiled drop unit-test
[ f ] [ 0/0. -15.0 ] \ u>= test-comparison unit-test [ f ] [ 0/0. -15.0 ] \ u>= test-comparison drop unit-test
[ f ] [ 0/0. -15.0 ] \ u>= test-comparison-compiled unit-test [ f ] [ 0/0. -15.0 ] \ u>= test-comparison-compiled drop unit-test
[ f ] [ -15.0 0/0. ] \ u>= test-comparison unit-test [ f ] [ -15.0 0/0. ] \ u>= test-comparison drop unit-test
[ f ] [ -15.0 0/0. ] \ u>= test-comparison-compiled unit-test [ f ] [ -15.0 0/0. ] \ u>= test-comparison-compiled drop unit-test
] when ] when
] unless ] unless

5
basis/math/floats/env/x86/x86-tests.factor vendored Normal file → Executable file
View File

@ -1,13 +1,14 @@
USING: math.floats.env math.floats.env.x86 tools.test USING: math.floats.env math.floats.env.x86 tools.test
classes.struct cpu.x86.assembler cpu.x86.assembler.operands 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 IN: math.floats.env.x86.tests
[ t ] [ [ t ] [
[ [ [ [
void { } cdecl [ void { } cdecl [
9 [ FLDZ ] times 9 [ FLDZ ] times
9 [ ST0 FSTP ] times
] alien-assembly ] alien-assembly
] compile-call ] collect-fp-exceptions ] compile-call ] collect-fp-exceptions
+fp-x87-stack-fault+ swap member? +fp-x87-stack-fault+ swap member?