-USING: accessors alien.syntax arrays assocs biassocs
+USING: accessors alien.c-types arrays assocs biassocs
classes.struct combinators cpu.x86.features kernel literals
math math.bitwise math.floats.env math.floats.env.private
-system ;
+system vocabs ;
IN: math.floats.env.x86
STRUCT: sse-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 ) ;
+HOOK: get-sse-env cpu ( sse-env -- )
+HOOK: set-sse-env cpu ( sse-env -- )
-FUNCTION: void get_x87_env ( x87-env* env ) ;
-FUNCTION: void set_x87_env ( x87-env* env ) ;
+HOOK: get-x87-env cpu ( x87-env -- )
+HOOK: set-x87-env cpu ( x87-env -- )
: <sse-env> ( -- sse-env )
- sse-env (struct) [ get_sse_env ] keep ;
+ sse-env (struct) [ get-sse-env ] keep ;
M: sse-env (set-fp-env-register)
- set_sse_env ;
+ set-sse-env ;
: <x87-env> ( -- x87-env )
- x87-env (struct) [ get_x87_env ] keep ;
+ x87-env (struct) [ get-x87-env ] keep ;
M: x87-env (set-fp-env-register)
- set_x87_env ;
+ set-x87-env ;
M: x86 (fp-env-registers)
- sse-version 20 >=
- [ <sse-env> <x87-env> 2array ]
- [ <x87-env> 1array ] if ;
+ sse2? [ <sse-env> <x87-env> 2array ] [ <x87-env> 1array ] if ;
-CONSTANT: sse-exception-flag-bits HEX: 3f
+CONSTANT: sse-exception-flag-bits 0x3f
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 }
+ { +fp-invalid-operation+ 0x01 }
+ { +fp-overflow+ 0x08 }
+ { +fp-underflow+ 0x10 }
+ { +fp-zero-divide+ 0x04 }
+ { +fp-inexact+ 0x20 }
}
-CONSTANT: sse-fp-traps-bits HEX: 1f80
+CONSTANT: sse-fp-traps-bits 0x1f80
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 }
+ { +fp-invalid-operation+ 0x0080 }
+ { +fp-overflow+ 0x0400 }
+ { +fp-underflow+ 0x0800 }
+ { +fp-zero-divide+ 0x0200 }
+ { +fp-inexact+ 0x1000 }
}
-CONSTANT: sse-rounding-mode-bits HEX: 6000
+CONSTANT: sse-rounding-mode-bits 0x6000
CONSTANT: sse-rounding-mode>bit
$[ H{
- { +round-nearest+ HEX: 0000 }
- { +round-down+ HEX: 2000 }
- { +round-up+ HEX: 4000 }
- { +round-zero+ HEX: 6000 }
+ { +round-nearest+ 0x0000 }
+ { +round-down+ 0x2000 }
+ { +round-up+ 0x4000 }
+ { +round-zero+ 0x6000 }
} >biassoc ]
-CONSTANT: sse-denormal-mode-bits HEX: 8040
+CONSTANT: sse-denormal-mode-bits 0x8040
M: sse-env (get-exception-flags) ( register -- exceptions )
mxcsr>> sse-exception-flag>bit mask> ; inline
} case
] curry change-mxcsr ; inline
-CONSTANT: x87-exception-bits HEX: 3f
+SINGLETON: +fp-x87-stack-fault+
+
+CONSTANT: x87-exception-bits 0x7f
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 }
+ { +fp-invalid-operation+ 0x01 }
+ { +fp-overflow+ 0x08 }
+ { +fp-underflow+ 0x10 }
+ { +fp-zero-divide+ 0x04 }
+ { +fp-inexact+ 0x20 }
+ { +fp-x87-stack-fault+ 0x40 }
}
-CONSTANT: x87-rounding-mode-bits HEX: 0c00
+CONSTANT: x87-rounding-mode-bits 0x0c00
CONSTANT: x87-rounding-mode>bit
$[ H{
- { +round-nearest+ HEX: 0000 }
- { +round-down+ HEX: 0400 }
- { +round-up+ HEX: 0800 }
- { +round-zero+ HEX: 0c00 }
+ { +round-nearest+ 0x0000 }
+ { +round-down+ 0x0400 }
+ { +round-up+ 0x0800 }
+ { +round-zero+ 0x0c00 }
} >biassoc ]
M: x87-env (get-exception-flags) ( register -- exceptions )
M: x87-env (set-denormal-mode) ( register mode -- register' )
drop ;
+cpu {
+ { x86.32 [ "math.floats.env.x86.32" ] }
+ { x86.64 [ "math.floats.env.x86.64" ] }
+} case require