From 1a19221159ad4210e1c0a8201a55a0bdaeaa6a20 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 12 Sep 2009 20:39:41 -0500
Subject: [PATCH] set altivec denormal flag when with-denormal-mode is used

---
 basis/math/floats/env/ppc/ppc.factor | 42 +++++++++++++++++++++++++++-
 vm/Config.macosx.ppc                 |  2 +-
 vm/cpu-ppc.S                         | 23 +++++++++++++++
 3 files changed, 65 insertions(+), 2 deletions(-)

diff --git a/basis/math/floats/env/ppc/ppc.factor b/basis/math/floats/env/ppc/ppc.factor
index c4c81471ca..748f149ccd 100644
--- a/basis/math/floats/env/ppc/ppc.factor
+++ b/basis/math/floats/env/ppc/ppc.factor
@@ -7,19 +7,32 @@ STRUCT: ppc-fpu-env
     { padding uint }
     { fpscr uint } ;
 
+STRUCT: ppc-vmx-env
+    { vscr 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 ) ;
 
+FUNCTION: void get_ppc_vmx_env ( ppc-vmx-env* env ) ;
+FUNCTION: void set_ppc_vmx_env ( ppc-vmx-env* env ) ;
+
 : <ppc-fpu-env> ( -- ppc-fpu-env )
     ppc-fpu-env (struct)
     [ get_ppc_fpu_env ] keep ;
 
+: <ppc-vmx-env> ( -- ppc-fpu-env )
+    ppc-vmx-env (struct)
+    [ get_ppc_vmx_env ] keep ;
+
 M: ppc-fpu-env (set-fp-env-register)
     set_ppc_fpu_env ;
 
+M: ppc-vmx-env (set-fp-env-register)
+    set_ppc_vmx_env ;
+
 M: ppc (fp-env-registers)
-    <ppc-fpu-env> 1array ;
+    <ppc-fpu-env> <ppc-vmx-env> 2array ;
 
 CONSTANT: ppc-exception-flag-bits HEX: 3e00,0000
 CONSTANT: ppc-exception-flag>bit
@@ -77,3 +90,30 @@ M: ppc-fpu-env (set-denormal-mode) ( register mode -- register' )
         } case
     ] curry change-fpscr ; inline
 
+CONSTANT: vmx-denormal-mode-bits HEX: 8000
+
+M: ppc-vmx-env (get-exception-flags) ( register -- exceptions )
+    drop { } ; inline
+M: ppc-vmx-env (set-exception-flags) ( register exceptions -- register' )
+    drop ;
+
+M: ppc-vmx-env (get-fp-traps) ( register -- exceptions )
+    drop { } ; inline
+M: ppc-vmx-env (set-fp-traps) ( register exceptions -- register' )
+    drop ;
+
+M: ppc-vmx-env (get-rounding-mode) ( register -- mode )
+    drop +round-nearest+ ;
+M: ppc-vmx-env (set-rounding-mode) ( register mode -- register' )
+    drop ;
+
+M: ppc-vmx-env (get-denormal-mode) ( register -- mode )
+    vscr>> vmx-denormal-mode-bits mask zero? +denormal-keep+ +denormal-flush+ ? ; inline
+M: ppc-vmx-env (get-denormal-mode) ( register mode -- register )
+    [
+        {
+            { +denormal-keep+  [ vmx-denormal-mode-bits unmask ] }
+            { +denormal-flush+ [ vmx-denormal-mode-bits bitor  ] }
+        } case
+    ] curry change-vscr ; inline
+
diff --git a/vm/Config.macosx.ppc b/vm/Config.macosx.ppc
index ed3c0d5a19..9fb84d6185 100644
--- a/vm/Config.macosx.ppc
+++ b/vm/Config.macosx.ppc
@@ -1,3 +1,3 @@
 include vm/Config.macosx
 include vm/Config.ppc
-CFLAGS += -arch ppc
+CFLAGS += -arch ppc -force_cpusubtype_ALL
diff --git a/vm/cpu-ppc.S b/vm/cpu-ppc.S
index 67c9e8d142..007638189a 100644
--- a/vm/cpu-ppc.S
+++ b/vm/cpu-ppc.S
@@ -254,3 +254,26 @@ DEF(void,set_ppc_fpu_env,(const void*)):
     lfd f0,0(r3)
     mtfsf 0xff,f0
     blr
+
+DEF(void,get_ppc_vmx_env,(void*)):
+    mfvscr v0
+    subi r4,r1,16
+    li r5,0xf
+    andc r4,r4,r5
+    li r5,0xc
+    stvewx v0,r5,r4
+    lwzx r6,r5,r4
+    stw r6,0(r3)
+    blr
+
+DEF(void,set_ppc_vmx_env,(const void*)):
+    subi r4,r1,16
+    li r5,0xf
+    andc r4,r4,r5
+    li r5,0xc
+    lwz r6,0(r3)
+    stwx r6,r5,r4
+    lvewx v0,r5,r4
+    mtvscr v0
+    blr
+