1 USING: accessors alien.syntax arrays assocs biassocs
2 classes.struct combinators kernel literals math math.bitwise
3 math.floats.env math.floats.env.private system ;
4 IN: math.floats.env.ppc
10 ! defined in the vm, cpu-ppc*.S
11 FUNCTION: void get_ppc_fpu_env ( ppc-fpu-env* env ) ;
12 FUNCTION: void set_ppc_fpu_env ( ppc-fpu-env* env ) ;
14 : <ppc-fpu-env> ( -- ppc-fpu-env )
16 [ get_ppc_fpu_env ] keep ;
18 M: ppc-fpu-env (set-fp-env-register)
21 M: ppc (fp-env-registers)
22 <ppc-fpu-env> 1array ;
24 CONSTANT: ppc-exception-flag-bits HEX: 3e00,0000
25 CONSTANT: ppc-exception-flag>bit
27 { +fp-invalid-operation+ HEX: 2000,0000 }
28 { +fp-overflow+ HEX: 1000,0000 }
29 { +fp-underflow+ HEX: 0800,0000 }
30 { +fp-zero-divide+ HEX: 0400,0000 }
31 { +fp-inexact+ HEX: 0200,0000 }
34 CONSTANT: ppc-fp-traps-bits HEX: f8
35 CONSTANT: ppc-fp-traps>bit
37 { +fp-invalid-operation+ HEX: 80 }
38 { +fp-overflow+ HEX: 40 }
39 { +fp-underflow+ HEX: 20 }
40 { +fp-zero-divide+ HEX: 10 }
41 { +fp-inexact+ HEX: 08 }
44 CONSTANT: ppc-rounding-mode-bits HEX: 3
45 CONSTANT: ppc-rounding-mode>bit
47 { +round-nearest+ HEX: 0 }
48 { +round-zero+ HEX: 1 }
50 { +round-down+ HEX: 3 }
53 CONSTANT: ppc-denormal-mode-bits HEX: 4
55 M: ppc-fpu-env (get-exception-flags) ( register -- exceptions )
56 fpscr>> ppc-exception-flag>bit mask> ; inline
57 M: ppc-fpu-env (set-exception-flags) ( register exceptions -- register' )
58 [ ppc-exception-flag>bit >mask ppc-exception-flag-bits remask ] curry change-fpscr ; inline
60 M: ppc-fpu-env (get-fp-traps) ( register -- exceptions )
61 fpscr>> ppc-fp-traps>bit mask> ; inline
62 M: ppc-fpu-env (set-fp-traps) ( register exceptions -- register' )
63 [ ppc-fp-traps>bit >mask ppc-fp-traps-bits remask ] curry change-fpscr ; inline
65 M: ppc-fpu-env (get-rounding-mode) ( register -- mode )
66 fpscr>> ppc-rounding-mode-bits mask ppc-rounding-mode>bit value-at ; inline
67 M: ppc-fpu-env (set-rounding-mode) ( register mode -- register' )
68 [ ppc-rounding-mode>bit at ppc-rounding-mode-bits remask ] curry change-fpscr ; inline
70 M: ppc-fpu-env (get-denormal-mode) ( register -- mode )
71 fpscr>> ppc-denormal-mode-bits mask zero? +denormal-keep+ +denormal-flush+ ? ; inline
72 M: ppc-fpu-env (set-denormal-mode) ( register mode -- register' )
75 { +denormal-keep+ [ ppc-denormal-mode-bits unmask ] }
76 { +denormal-flush+ [ ppc-denormal-mode-bits bitor ] }
78 ] curry change-fpscr ; inline