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 9bae382ef69139278599c36f89297def1bcc1c20..2659e2bb5746e1f9565946c99c8e8c70b7afa9f9 100644 (file)
--- a/basis/math/floats/env/x86/x86.factor
+++ b/basis/math/floats/env/x86/x86.factor
@@ -1,8 +1,7 @@
-USING: accessors alien alien.c-types alien.syntax arrays assocs
-biassocs classes.struct combinators cpu.architecture
-cpu.x86.assembler cpu.x86.assembler.operands cpu.x86.features
-kernel literals math math.bitwise math.floats.env
-math.floats.env.private sequences 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
@@ -18,56 +17,6 @@ HOOK: set-sse-env cpu ( sse-env -- )
 HOOK: get-x87-env cpu ( x87-env -- )
 HOOK: set-x87-env cpu ( x87-env -- )
 
-! 32-bit
-M: x86.32 get-sse-env
-    void { void* } "cdecl" [
-        EAX ESP [] MOV
-        EAX [] STMXCSR
-    ] alien-assembly ;
-
-M: x86.32 set-sse-env
-    void { void* } "cdecl" [
-        EAX ESP [] MOV
-        EAX [] LDMXCSR
-    ] alien-assembly ;
-
-M: x86.32 get-x87-env
-    void { void* } "cdecl" [
-        EAX ESP [] MOV
-        EAX [] FNSTSW
-        EAX 2 [+] FNSTCW
-    ] alien-assembly ;
-
-M: x86.32 set-x87-env
-    void { void* } "cdecl" [
-        EAX ESP [] MOV
-        FNCLEX
-        EAX 2 [+] FLDCW
-    ] alien-assembly ;
-
-! 64-bit
-M: x86.64 get-sse-env
-    void { void* } "cdecl" [
-        int-regs param-regs first [] STMXCSR
-    ] alien-assembly ;
-
-M: x86.64 set-sse-env
-    void { void* } "cdecl" [
-        int-regs param-regs first [] LDMXCSR
-    ] alien-assembly ;
-
-M: x86.64 get-x87-env
-    void { void* } "cdecl" [
-        int-regs param-regs first [] FNSTSW
-        int-regs param-regs first 2 [+] FNSTCW
-    ] alien-assembly ;
-
-M: x86.64 set-x87-env
-    void { void* } "cdecl" [
-        FNCLEX
-        int-regs param-regs first 2 [+] FLDCW
-    ] alien-assembly ;
-
 : <sse-env> ( -- sse-env )
     sse-env (struct) [ get-sse-env ] keep ;
 
@@ -83,36 +32,36 @@ M: x87-env (set-fp-env-register)
 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
@@ -139,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 )
@@ -178,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