use radix literals

[factor.git] / basis / math / floats / env / x86 / x86.factor

diff --git a/basis/math/floats/env/x86/x86.factor b/basis/math/floats/env/x86/x86.factor
index 2b73628b4ce064b7c6074647d2ad801cd082fa8d..2659e2bb5746e1f9565946c99c8e8c70b7afa9f9 100644 (file)
--- a/basis/math/floats/env/x86/x86.factor
+++ b/basis/math/floats/env/x86/x86.factor
@@ -1,7 +1,7 @@
-USING: accessors alien.c-types alien.syntax arrays assocs
-biassocs classes.struct combinators cpu.x86.features kernel
-literals math math.bitwise math.floats.env
-math.floats.env.private system ;
+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 vocabs ;
 IN: math.floats.env.x86
 
 STRUCT: sse-env
@@ -11,58 +11,57 @@ 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 ) ;
+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)
     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
@@ -89,23 +88,26 @@ M: sse-env (set-denormal-mode) ( register mode -- register' )
         } 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 )
@@ -128,3 +130,7 @@ M: x87-env (get-denormal-mode) ( register -- mode )
 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