 ! f0-f29: float vregs
 ! f30, f31: float scratch
 
+enable-float-intrinsics
+
+<< \ ##integer>float t frame-required? set-word-prop
+\ ##float>integer t frame-required? set-word-prop >>
+
 M: ppc machine-registers
     {
         { int-regs T{ range f 2 26 1 } }
-        { double-float-regs T{ range f 0 28 1 } }
+        { double-float-regs T{ range f 0 29 1 } }
     } ;
 
 : scratch-reg 28 ; inline
-: fp-scratch-reg-1 29 ; inline
-: fp-scratch-reg-2 30 ; inline
+: fp-scratch-reg 30 ; inline
 
 M: ppc two-operand? f ;
 

math.order math.ranges system namespaces locals layouts words
alien alien.c-types cpu.architecture cpu.ppc.assembler
compiler.cfg.registers compiler.cfg.instructions
compiler.constants compiler.codegen compiler.codegen.fixup ;
IN: cpu.ppc

! PowerPC register assignments:


M:: ppc %integer>float ( dst src -- )
    HEX: 4330 scratch-reg LIS
    scratch-reg 1 0 scratch@ STW
    scratch-reg src MR
    scratch-reg dup HEX: 8000 XORIS
    scratch-reg 1 4 scratch@ STW
    dst 1 0 scratch@ LFD
    scratch-reg 4503601774854144.0 %load-indirect
    fp-scratch-reg scratch-reg float-offset LFD
    dst dst fp-scratch-reg FSUB ;

M:: ppc %float>integer ( dst src -- )
    fp-scratch-reg src FCTIWZ
    fp-scratch-reg 1 0 scratch@ STFD
    dst 1 4 scratch@ LWZ ;

M: ppc %copy ( dst src -- ) MR ;

M: ppc %copy-float ( dst src -- ) FMR ;

M: ppc %unbox-float ( dst src -- ) float-offset LFD ;

M:: ppc %box-float ( dst src temp -- )
    dst 16 float temp %allot
    src dst float-offset STFD ;

M:: ppc %unbox-any-c-ptr ( dst src temp -- )
    [
