factor out x86 and ppc backends for math.floats.env; update both x87 and SSE state on x86
Joe Groff
parent
e3509e7f11
commit
0ec342a1c5
|
|
@ -59,7 +59,8 @@ HELP: fp-exception-flags
|
|||
|
||||
HELP: set-fp-exception-flags
|
||||
{ $values { "exceptions" "a sequence of " { $link fp-exception } " symbols" } }
|
||||
{ $description "Replaces the set of floating-point exception flags with the set specified in " { $snippet "exceptions" } "." } ;
|
||||
{ $description "Replaces the set of floating-point exception flags with the set specified in " { $snippet "exceptions" } "." }
|
||||
{ $notes "On Intel platforms, the legacy x87 floating-point unit does not support setting exception flags, so this word only clears the x87 exception flags. However, the SSE unit's flags are set as expected." } ;
|
||||
|
||||
HELP: clear-fp-exception-flags
|
||||
{ $description "Clears all of the floating-point exception flags." } ;
|
||||
|
|
@ -121,7 +122,6 @@ $nl
|
|||
{ $subsection with-rounding-mode }
|
||||
{ $subsection denormal-mode }
|
||||
{ $subsection with-denormal-mode }
|
||||
{ $notes
|
||||
"On x86, the above words only modify the SSE unit's state (in particular, the MXCSR register); the x87 unit is unaffected. On PowerPC, the above words only modify the scalar FPU's state (in FPSCR); the AltiVec unit is unaffected." } ;
|
||||
{ $notes "On PowerPC, the above words only modify the scalar FPU's state (in FPSCR); the AltiVec unit is currently unaffected." } ;
|
||||
|
||||
ABOUT: "math.floats.env"
|
||||
|
|
|
|||
|
|
@ -1,7 +1,13 @@
|
|||
USING: kernel math math.floats.env math.functions math.libm
|
||||
sets tools.test ;
|
||||
USING: kernel math math.floats.env math.floats.env.private
|
||||
math.functions math.libm sets tools.test ;
|
||||
IN: math.floats.env.tests
|
||||
|
||||
: set-default-fp-env ( -- )
|
||||
{ } { } +round-nearest+ +denormal-keep+ set-fp-env ;
|
||||
|
||||
! In case the tests screw up the FP env because of bugs in math.floats.env
|
||||
set-default-fp-env
|
||||
|
||||
[ t ] [
|
||||
[ 1.0 0.0 / drop ] collect-fp-exceptions
|
||||
{ +fp-zero-divide+ } set=
|
||||
|
|
@ -129,3 +135,7 @@ IN: math.floats.env.tests
|
|||
|
||||
! Ensure traps get cleared
|
||||
[ 1/0. ] [ 1.0 0.0 /f ] unit-test
|
||||
|
||||
! In case the tests screw up the FP env because of bugs in math.floats.env
|
||||
set-default-fp-env
|
||||
|
||||
|
|
|
|||
|
|
@ -1,10 +1,9 @@
|
|||
! (c)Joe Groff bsd license
|
||||
USING: alien.syntax assocs biassocs combinators continuations
|
||||
generalizations kernel literals locals math math.bitwise
|
||||
sequences system ;
|
||||
sequences system vocabs.loader ;
|
||||
IN: math.floats.env
|
||||
|
||||
|
||||
SINGLETONS:
|
||||
+fp-invalid-operation+
|
||||
+fp-overflow+
|
||||
|
|
@ -41,84 +40,9 @@ UNION: fp-denormal-mode
|
|||
|
||||
<PRIVATE
|
||||
|
||||
! These functions are provided in the VM; see cpu-*.S
|
||||
FUNCTION: uint get_fp_control_register ( ) ;
|
||||
FUNCTION: void set_fp_control_register ( uint reg ) ;
|
||||
HOOK: (fp-env-registers) cpu ( -- registers )
|
||||
|
||||
HOOK: exception-flag-bits cpu ( -- bits )
|
||||
HOOK: exception-flag>bit cpu ( -- assoc )
|
||||
HOOK: fp-traps-bits cpu ( -- bits )
|
||||
HOOK: fp-traps>bit cpu ( -- assoc )
|
||||
HOOK: >fp-traps cpu ( mask -- enable )
|
||||
HOOK: rounding-mode-bits cpu ( -- bits )
|
||||
HOOK: rounding-mode>bit cpu ( -- assoc )
|
||||
HOOK: denormal-mode-bits cpu ( -- bits )
|
||||
|
||||
M: x86 exception-flag-bits HEX: 3f ;
|
||||
M: x86 exception-flag>bit
|
||||
H{
|
||||
{ +fp-invalid-operation+ HEX: 01 }
|
||||
{ +fp-overflow+ HEX: 08 }
|
||||
{ +fp-underflow+ HEX: 10 }
|
||||
{ +fp-zero-divide+ HEX: 04 }
|
||||
{ +fp-inexact+ HEX: 20 }
|
||||
} ;
|
||||
|
||||
M: x86 fp-traps-bits HEX: 1f80 ;
|
||||
M: x86 fp-traps>bit
|
||||
H{
|
||||
{ +fp-invalid-operation+ HEX: 0080 }
|
||||
{ +fp-overflow+ HEX: 0400 }
|
||||
{ +fp-underflow+ HEX: 0800 }
|
||||
{ +fp-zero-divide+ HEX: 0200 }
|
||||
{ +fp-inexact+ HEX: 1000 }
|
||||
} ;
|
||||
|
||||
M: x86 >fp-traps bitnot ;
|
||||
|
||||
M: x86 rounding-mode-bits HEX: 6000 ;
|
||||
M: x86 rounding-mode>bit
|
||||
$[ H{
|
||||
{ +round-nearest+ HEX: 0000 }
|
||||
{ +round-down+ HEX: 2000 }
|
||||
{ +round-up+ HEX: 4000 }
|
||||
{ +round-zero+ HEX: 6000 }
|
||||
} >biassoc ] ;
|
||||
|
||||
M: x86 denormal-mode-bits HEX: 8040 ;
|
||||
|
||||
M: ppc exception-flag-bits HEX: 3e00,0000 ;
|
||||
M: ppc exception-flag>bit
|
||||
H{
|
||||
{ +fp-invalid-operation+ HEX: 2000,0000 }
|
||||
{ +fp-overflow+ HEX: 1000,0000 }
|
||||
{ +fp-underflow+ HEX: 0800,0000 }
|
||||
{ +fp-zero-divide+ HEX: 0400,0000 }
|
||||
{ +fp-inexact+ HEX: 0200,0000 }
|
||||
} ;
|
||||
|
||||
M: ppc fp-traps-bits HEX: f80 ;
|
||||
M: ppc fp-traps>bit
|
||||
H{
|
||||
{ +fp-invalid-operation+ HEX: 8000 }
|
||||
{ +fp-overflow+ HEX: 4000 }
|
||||
{ +fp-underflow+ HEX: 2000 }
|
||||
{ +fp-zero-divide+ HEX: 1000 }
|
||||
{ +fp-inexact+ HEX: 0800 }
|
||||
} ;
|
||||
|
||||
M: ppc >fp-traps ;
|
||||
|
||||
M: ppc rounding-mode-bits HEX: 3 ;
|
||||
M: ppc rounding-mode>bit
|
||||
$[ H{
|
||||
{ +round-nearest+ HEX: 0 }
|
||||
{ +round-zero+ HEX: 1 }
|
||||
{ +round-up+ HEX: 2 }
|
||||
{ +round-down+ HEX: 3 }
|
||||
} >biassoc ] ;
|
||||
|
||||
M: ppc denormal-mode-bits HEX: 4 ;
|
||||
: fp-env-register ( -- register ) (fp-env-registers) first ;
|
||||
|
||||
:: mask> ( bits assoc -- symbols )
|
||||
assoc [| k v | bits v mask zero? not ] assoc-filter keys ;
|
||||
|
|
@ -130,38 +54,29 @@ M: ppc denormal-mode-bits HEX: 4 ;
|
|||
: remask ( x new-bits mask-bits -- x' )
|
||||
[ unmask ] [ mask ] bi-curry bi* bitor ; inline
|
||||
|
||||
: (get-exception-flags) ( register -- exceptions )
|
||||
exception-flag>bit mask> ; inline
|
||||
: (set-exception-flags) ( register exceptions -- register' )
|
||||
exception-flag>bit >mask exception-flag-bits remask ; inline
|
||||
GENERIC: (set-fp-env-register) ( fp-env -- )
|
||||
|
||||
: (get-fp-traps) ( register -- exceptions )
|
||||
>fp-traps fp-traps>bit mask> ; inline
|
||||
: (set-fp-traps) ( register exceptions -- register' )
|
||||
fp-traps>bit >mask >fp-traps fp-traps-bits remask ; inline
|
||||
GENERIC: (get-exception-flags) ( fp-env -- exceptions )
|
||||
GENERIC# (set-exception-flags) 1 ( fp-env exceptions -- fp-env )
|
||||
|
||||
: (get-rounding-mode) ( register -- mode )
|
||||
rounding-mode-bits mask rounding-mode>bit value-at ; inline
|
||||
: (set-rounding-mode) ( register mode -- register' )
|
||||
rounding-mode>bit at rounding-mode-bits remask ; inline
|
||||
GENERIC: (get-fp-traps) ( fp-env -- exceptions )
|
||||
GENERIC# (set-fp-traps) 1 ( fp-env exceptions -- fp-env )
|
||||
|
||||
: (get-denormal-mode) ( register -- mode )
|
||||
denormal-mode-bits mask zero? +denormal-keep+ +denormal-flush+ ? ; inline
|
||||
: (set-denormal-mode) ( register ? -- register' )
|
||||
{
|
||||
{ +denormal-keep+ [ denormal-mode-bits unmask ] }
|
||||
{ +denormal-flush+ [ denormal-mode-bits bitor ] }
|
||||
} case ; inline
|
||||
GENERIC: (get-rounding-mode) ( fp-env -- mode )
|
||||
GENERIC# (set-rounding-mode) 1 ( fp-env mode -- fp-env )
|
||||
|
||||
: change-control-register ( quot -- )
|
||||
get_fp_control_register swap call set_fp_control_register ; inline
|
||||
GENERIC: (get-denormal-mode) ( fp-env -- mode )
|
||||
GENERIC# (set-denormal-mode) 1 ( fp-env mode -- fp-env )
|
||||
|
||||
: set-fp-traps ( exceptions -- ) [ (set-fp-traps) ] curry change-control-register ;
|
||||
: set-rounding-mode ( exceptions -- ) [ (set-rounding-mode) ] curry change-control-register ;
|
||||
: set-denormal-mode ( mode -- ) [ (set-denormal-mode) ] curry change-control-register ;
|
||||
: change-fp-env-registers ( quot -- )
|
||||
(fp-env-registers) swap [ (set-fp-env-register) ] compose each ; inline
|
||||
|
||||
: get-fp-env ( -- exception-flags fp-traps rounding-mode denormals? )
|
||||
get_fp_control_register {
|
||||
: set-fp-traps ( exceptions -- ) [ (set-fp-traps) ] curry change-fp-env-registers ;
|
||||
: set-rounding-mode ( mode -- ) [ (set-rounding-mode) ] curry change-fp-env-registers ;
|
||||
: set-denormal-mode ( mode -- ) [ (set-denormal-mode) ] curry change-fp-env-registers ;
|
||||
|
||||
: get-fp-env ( -- exception-flags fp-traps rounding-mode denormal-mode )
|
||||
fp-env-register {
|
||||
[ (get-exception-flags) ]
|
||||
[ (get-fp-traps) ]
|
||||
[ (get-rounding-mode) ]
|
||||
|
|
@ -176,32 +91,32 @@ M: ppc denormal-mode-bits HEX: 4 ;
|
|||
[ [ (set-rounding-mode) ] when* ]
|
||||
[ [ (set-denormal-mode) ] when* ]
|
||||
} spread
|
||||
] 4 ncurry change-control-register ;
|
||||
] 4 ncurry change-fp-env-registers ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: fp-exception-flags ( -- exceptions ) get_fp_control_register (get-exception-flags) ;
|
||||
: set-fp-exception-flags ( exceptions -- ) [ (set-exception-flags) ] curry change-control-register ;
|
||||
: fp-exception-flags ( -- exceptions ) fp-env-register (get-exception-flags) ;
|
||||
: set-fp-exception-flags ( exceptions -- ) [ (set-exception-flags) ] curry change-fp-env-registers ;
|
||||
: clear-fp-exception-flags ( -- ) { } set-fp-exception-flags ; inline
|
||||
|
||||
: collect-fp-exceptions ( quot -- exceptions )
|
||||
clear-fp-exception-flags call fp-exception-flags ; inline
|
||||
|
||||
: denormal-mode ( -- mode ) get_fp_control_register (get-denormal-mode) ;
|
||||
: denormal-mode ( -- mode ) fp-env-register (get-denormal-mode) ;
|
||||
|
||||
:: with-denormal-mode ( mode quot -- )
|
||||
denormal-mode :> orig
|
||||
mode set-denormal-mode
|
||||
quot [ orig set-denormal-mode ] [ ] cleanup ; inline
|
||||
|
||||
: rounding-mode ( -- mode ) get_fp_control_register (get-rounding-mode) ;
|
||||
: rounding-mode ( -- mode ) fp-env-register (get-rounding-mode) ;
|
||||
|
||||
:: with-rounding-mode ( mode quot -- )
|
||||
rounding-mode :> orig
|
||||
mode set-rounding-mode
|
||||
quot [ orig set-rounding-mode ] [ ] cleanup ; inline
|
||||
|
||||
: fp-traps ( -- exceptions ) get_fp_control_register (get-fp-traps) ;
|
||||
: fp-traps ( -- exceptions ) fp-env-register (get-fp-traps) ;
|
||||
|
||||
:: with-fp-traps ( exceptions quot -- )
|
||||
fp-traps :> orig
|
||||
|
|
@ -210,3 +125,10 @@ PRIVATE>
|
|||
|
||||
: without-fp-traps ( quot -- )
|
||||
{ } swap with-fp-traps ; inline
|
||||
|
||||
<< {
|
||||
{ [ cpu x86? ] [ "math.floats.env.x86" require ] }
|
||||
{ [ cpu ppc? ] [ "math.floats.env.ppc" require ] }
|
||||
[ "CPU architecture unsupported by math.floats.env" throw ]
|
||||
} cond >>
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,79 @@
|
|||
USING: accessors alien.syntax arrays assocs biassocs
|
||||
classes.struct combinators kernel literals math math.bitwise
|
||||
math.floats.env math.floats.env.private system ;
|
||||
IN: math.floats.env.ppc
|
||||
|
||||
STRUCT: ppc-fpu-env
|
||||
{ padding uint }
|
||||
{ fpcsr uint } ;
|
||||
|
||||
! defined in the vm, cpu-ppc*.S
|
||||
FUNCTION: void get_ppc_fpu_env ( ppc-fpu-env* env ) ;
|
||||
FUNCTION: void set_ppc_fpu_env ( ppc-fpu-env* env ) ;
|
||||
|
||||
: <ppc-fpu-env> ( -- ppc-fpu-env )
|
||||
ppc-fpu-env (struct)
|
||||
[ get_ppc_fpu_env ] keep ;
|
||||
|
||||
M: ppc-fpu-env (set-fp-env-register)
|
||||
set_ppc_fpu_env ;
|
||||
|
||||
M: ppc (fp-env-registers)
|
||||
<ppc-fpu-env> 1array ;
|
||||
|
||||
CONSTANT: ppc-exception-flag-bits HEX: 3e00,0000
|
||||
CONSTANT: ppc-exception-flag>bit
|
||||
H{
|
||||
{ +fp-invalid-operation+ HEX: 2000,0000 }
|
||||
{ +fp-overflow+ HEX: 1000,0000 }
|
||||
{ +fp-underflow+ HEX: 0800,0000 }
|
||||
{ +fp-zero-divide+ HEX: 0400,0000 }
|
||||
{ +fp-inexact+ HEX: 0200,0000 }
|
||||
}
|
||||
|
||||
CONSTANT: ppc-fp-traps-bits HEX: f80
|
||||
CONSTANT: ppc-fp-traps>bit
|
||||
H{
|
||||
{ +fp-invalid-operation+ HEX: 8000 }
|
||||
{ +fp-overflow+ HEX: 4000 }
|
||||
{ +fp-underflow+ HEX: 2000 }
|
||||
{ +fp-zero-divide+ HEX: 1000 }
|
||||
{ +fp-inexact+ HEX: 0800 }
|
||||
}
|
||||
|
||||
CONSTANT: ppc-rounding-mode-bits HEX: 3
|
||||
CONSTANT: ppc-rounding-mode>bit
|
||||
$[ H{
|
||||
{ +round-nearest+ HEX: 0 }
|
||||
{ +round-zero+ HEX: 1 }
|
||||
{ +round-up+ HEX: 2 }
|
||||
{ +round-down+ HEX: 3 }
|
||||
} >biassoc ]
|
||||
|
||||
CONSTANT: ppc-denormal-mode-bits HEX: 4
|
||||
|
||||
M: ppc-fpu-env (get-exception-flags) ( register -- exceptions )
|
||||
fpcsr>> ppc-exception-flag>bit mask> ; inline
|
||||
M: ppc-fpu-env (set-exception-flags) ( register exceptions -- register' )
|
||||
[ ppc-exception-flag>bit >mask ppc-exception-flag-bits remask ] curry change-fpcsr ; inline
|
||||
|
||||
M: ppc-fpu-env (get-fp-traps) ( register -- exceptions )
|
||||
fpcsr>> not ppc-fp-traps>bit mask> ; inline
|
||||
M: ppc-fpu-env (set-fp-traps) ( register exceptions -- register' )
|
||||
[ ppc-fp-traps>bit >mask not ppc-fp-traps-bits remask ] curry change-fpcsr ; inline
|
||||
|
||||
M: ppc-fpu-env (get-rounding-mode) ( register -- mode )
|
||||
fpcsr>> ppc-rounding-mode-bits mask ppc-rounding-mode>bit value-at ; inline
|
||||
M: ppc-fpu-env (set-rounding-mode) ( register mode -- register' )
|
||||
[ ppc-rounding-mode>bit at ppc-rounding-mode-bits remask ] curry change-fpcsr ; inline
|
||||
|
||||
M: ppc-fpu-env (get-denormal-mode) ( register -- mode )
|
||||
fpcsr>> ppc-denormal-mode-bits mask zero? +denormal-keep+ +denormal-flush+ ? ; inline
|
||||
M: ppc-fpu-env (set-denormal-mode) ( register mode -- register' )
|
||||
[
|
||||
{
|
||||
{ +denormal-keep+ [ ppc-denormal-mode-bits unmask ] }
|
||||
{ +denormal-flush+ [ ppc-denormal-mode-bits bitor ] }
|
||||
} case
|
||||
] curry change-fpcsr ; inline
|
||||
|
||||
|
|
@ -0,0 +1,132 @@
|
|||
USING: accessors alien.syntax arrays assocs biassocs
|
||||
classes.struct combinators cpu.x86.features kernel literals
|
||||
math math.bitwise math.floats.env math.floats.env.private
|
||||
system ;
|
||||
IN: math.floats.env.x86
|
||||
|
||||
STRUCT: sse-env
|
||||
{ mxcsr uint } ;
|
||||
|
||||
STRUCT: x87-env
|
||||
{ status ushort }
|
||||
{ control ushort } ;
|
||||
|
||||
! defined in the vm, cpu-x86*.S
|
||||
FUNCTION: void get_sse_env ( sse-env* env ) ;
|
||||
FUNCTION: void set_sse_env ( sse-env* env ) ;
|
||||
|
||||
FUNCTION: void get_x87_env ( x87-env* env ) ;
|
||||
FUNCTION: void set_x87_env ( x87-env* env ) ;
|
||||
|
||||
: <sse-env> ( -- sse-env )
|
||||
sse-env (struct) [ get_sse_env ] keep ;
|
||||
|
||||
M: sse-env (set-fp-env-register)
|
||||
set_sse_env ;
|
||||
|
||||
: <x87-env> ( -- x87-env )
|
||||
x87-env (struct) [ get_x87_env ] keep ;
|
||||
|
||||
M: x87-env (set-fp-env-register)
|
||||
set_x87_env ;
|
||||
|
||||
M: x86 (fp-env-registers)
|
||||
sse2?
|
||||
[ <sse-env> <x87-env> 2array ]
|
||||
[ <x87-env> 1array ] if ;
|
||||
|
||||
CONSTANT: sse-exception-flag-bits HEX: 3f
|
||||
CONSTANT: sse-exception-flag>bit
|
||||
H{
|
||||
{ +fp-invalid-operation+ HEX: 01 }
|
||||
{ +fp-overflow+ HEX: 08 }
|
||||
{ +fp-underflow+ HEX: 10 }
|
||||
{ +fp-zero-divide+ HEX: 04 }
|
||||
{ +fp-inexact+ HEX: 20 }
|
||||
}
|
||||
|
||||
CONSTANT: sse-fp-traps-bits HEX: 1f80
|
||||
CONSTANT: sse-fp-traps>bit
|
||||
H{
|
||||
{ +fp-invalid-operation+ HEX: 0080 }
|
||||
{ +fp-overflow+ HEX: 0400 }
|
||||
{ +fp-underflow+ HEX: 0800 }
|
||||
{ +fp-zero-divide+ HEX: 0200 }
|
||||
{ +fp-inexact+ HEX: 1000 }
|
||||
}
|
||||
|
||||
CONSTANT: sse-rounding-mode-bits HEX: 6000
|
||||
CONSTANT: sse-rounding-mode>bit
|
||||
$[ H{
|
||||
{ +round-nearest+ HEX: 0000 }
|
||||
{ +round-down+ HEX: 2000 }
|
||||
{ +round-up+ HEX: 4000 }
|
||||
{ +round-zero+ HEX: 6000 }
|
||||
} >biassoc ]
|
||||
|
||||
CONSTANT: sse-denormal-mode-bits HEX: 8040
|
||||
|
||||
M: sse-env (get-exception-flags) ( register -- exceptions )
|
||||
mxcsr>> sse-exception-flag>bit mask> ; inline
|
||||
M: sse-env (set-exception-flags) ( register exceptions -- register' )
|
||||
[ sse-exception-flag>bit >mask sse-exception-flag-bits remask ] curry change-mxcsr ; inline
|
||||
|
||||
M: sse-env (get-fp-traps) ( register -- exceptions )
|
||||
mxcsr>> bitnot sse-fp-traps>bit mask> ; inline
|
||||
M: sse-env (set-fp-traps) ( register exceptions -- register' )
|
||||
[ sse-fp-traps>bit >mask bitnot sse-fp-traps-bits remask ] curry change-mxcsr ; inline
|
||||
|
||||
M: sse-env (get-rounding-mode) ( register -- mode )
|
||||
mxcsr>> sse-rounding-mode-bits mask sse-rounding-mode>bit value-at ; inline
|
||||
M: sse-env (set-rounding-mode) ( register mode -- register' )
|
||||
[ sse-rounding-mode>bit at sse-rounding-mode-bits remask ] curry change-mxcsr ; inline
|
||||
|
||||
M: sse-env (get-denormal-mode) ( register -- mode )
|
||||
mxcsr>> sse-denormal-mode-bits mask zero? +denormal-keep+ +denormal-flush+ ? ; inline
|
||||
M: sse-env (set-denormal-mode) ( register mode -- register' )
|
||||
[
|
||||
{
|
||||
{ +denormal-keep+ [ sse-denormal-mode-bits unmask ] }
|
||||
{ +denormal-flush+ [ sse-denormal-mode-bits bitor ] }
|
||||
} case
|
||||
] curry change-mxcsr ; inline
|
||||
|
||||
CONSTANT: x87-exception-bits HEX: 3f
|
||||
CONSTANT: x87-exception>bit
|
||||
H{
|
||||
{ +fp-invalid-operation+ HEX: 01 }
|
||||
{ +fp-overflow+ HEX: 08 }
|
||||
{ +fp-underflow+ HEX: 10 }
|
||||
{ +fp-zero-divide+ HEX: 04 }
|
||||
{ +fp-inexact+ HEX: 20 }
|
||||
}
|
||||
|
||||
CONSTANT: x87-rounding-mode-bits HEX: 0c00
|
||||
CONSTANT: x87-rounding-mode>bit
|
||||
$[ H{
|
||||
{ +round-nearest+ HEX: 0000 }
|
||||
{ +round-down+ HEX: 0400 }
|
||||
{ +round-up+ HEX: 0800 }
|
||||
{ +round-zero+ HEX: 0c00 }
|
||||
} >biassoc ]
|
||||
|
||||
M: x87-env (get-exception-flags) ( register -- exceptions )
|
||||
status>> x87-exception>bit mask> ; inline
|
||||
M: x87-env (set-exception-flags) ( register exceptions -- register' )
|
||||
drop ;
|
||||
|
||||
M: x87-env (get-fp-traps) ( register -- exceptions )
|
||||
control>> bitnot x87-exception>bit mask> ; inline
|
||||
M: x87-env (set-fp-traps) ( register exceptions -- register' )
|
||||
[ x87-exception>bit >mask bitnot x87-exception-bits remask ] curry change-control ; inline
|
||||
|
||||
M: x87-env (get-rounding-mode) ( register -- mode )
|
||||
control>> x87-rounding-mode-bits mask x87-rounding-mode>bit value-at ; inline
|
||||
M: x87-env (set-rounding-mode) ( register mode -- register' )
|
||||
[ x87-rounding-mode>bit at x87-rounding-mode-bits remask ] curry change-control ; inline
|
||||
|
||||
M: x87-env (get-denormal-mode) ( register -- mode )
|
||||
drop +denormal-keep+ ; inline
|
||||
M: x87-env (set-denormal-mode) ( register mode -- register' )
|
||||
drop ;
|
||||
|
||||
13
vm/cpu-ppc.S
13
vm/cpu-ppc.S
|
|
@ -245,17 +245,12 @@ DEF(void,primitive_inline_cache_miss_tail,(void)):
|
|||
mtctr r3
|
||||
bctr
|
||||
|
||||
DEF(unsigned,get_fp_control_register,(void)):
|
||||
DEF(void,get_ppc_fpu_env,(void*)):
|
||||
mffs fr0
|
||||
li r2,-4
|
||||
stfiwx fr0,r2,r1
|
||||
lwzx r3,r2,r1
|
||||
stfd fr0,0(r3)
|
||||
blr
|
||||
|
||||
DEF(void,set_fp_control_register,(unsigned)):
|
||||
li r2,-4
|
||||
stwx r3,r2,r1
|
||||
li r2,-8
|
||||
lfdx fr0,r2,r1
|
||||
DEF(void,set_ppc_fpu_env,(const void*)):
|
||||
lfd fr0,0(r3)
|
||||
mtfsf 0xff,fr0
|
||||
blr
|
||||
|
|
|
|||
|
|
@ -68,14 +68,30 @@ DEF(void,primitive_inline_cache_miss_tail,(void)):
|
|||
add $12,%esp
|
||||
jmp *%eax
|
||||
|
||||
DEF(unsigned,get_fp_control_register,(void)):
|
||||
push %eax
|
||||
stmxcsr (%esp)
|
||||
pop %eax
|
||||
DEF(void,get_sse_env,(void*)):
|
||||
movl 4(%esp), %eax
|
||||
stmxcsr (%eax)
|
||||
ret
|
||||
|
||||
DEF(void,set_fp_control_register,(unsigned reg)):
|
||||
ldmxcsr 4(%esp)
|
||||
DEF(void,set_sse_env,(const void*)):
|
||||
movl 4(%esp), %eax
|
||||
ldmxcsr (%eax)
|
||||
ret
|
||||
|
||||
DEF(void,get_x87_env,(void*)):
|
||||
movl 4(%esp), %eax
|
||||
fnstsw (%eax)
|
||||
fnstcw 2(%eax)
|
||||
ret
|
||||
|
||||
DEF(void,set_x87_env,(const void*)):
|
||||
movl 4(%esp), %eax
|
||||
fldcw 2(%eax)
|
||||
movb 4(%eax), %dl
|
||||
test %dl, %dl
|
||||
jz 1f
|
||||
fnclex
|
||||
1:
|
||||
ret
|
||||
|
||||
#include "cpu-x86.S"
|
||||
|
|
@ -84,4 +100,8 @@ DEF(void,set_fp_control_register,(unsigned reg)):
|
|||
.section .drectve
|
||||
.ascii " -export:check_sse2"
|
||||
.ascii " -export:read_timestamp_counter"
|
||||
.ascii " -export:get_sse_env"
|
||||
.ascii " -export:set_sse_env"
|
||||
.ascii " -export:get_x87_env"
|
||||
.ascii " -export:set_x87_env"
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -88,14 +88,22 @@ DEF(void,primitive_inline_cache_miss_tail,(void)):
|
|||
add $STACK_PADDING,%rsp
|
||||
jmp *%rax
|
||||
|
||||
DEF(unsigned,get_fp_control_register,(void)):
|
||||
stmxcsr -4(%rsp)
|
||||
movl -4(%rsp), %eax
|
||||
DEF(void,get_sse_env,(void*)):
|
||||
stmxcsr (%rdi)
|
||||
ret
|
||||
|
||||
DEF(void,set_fp_control_register,(unsigned reg)):
|
||||
movl %edi, -4(%rsp)
|
||||
ldmxcsr -4(%rsp)
|
||||
DEF(void,set_sse_env,(const void*)):
|
||||
ldmxcsr (%rdi)
|
||||
ret
|
||||
|
||||
DEF(void,get_x87_env,(void*)):
|
||||
fnstsw (%rdi)
|
||||
fnstcw 2(%rdi)
|
||||
ret
|
||||
|
||||
DEF(void,set_x87_env,(const void*)):
|
||||
fnclex
|
||||
fldcw 2(%rdi)
|
||||
ret
|
||||
|
||||
#include "cpu-x86.S"
|
||||
|
|
|
|||
Loading…
Reference in New Issue