M: ppc %copy ( dst src rep -- )
{
{ int-rep [ MR ] }
- { double-float-rep [ FMR ] }
+ { double-rep [ FMR ] }
} case ;
M: ppc %unbox-float ( dst src -- ) float-offset LFD ;
"f" resolve-label
] with-scope ;
-M:: ppc %box-displaced-alien ( dst displacement base displacement' base' -- )
+M:: ppc %box-displaced-alien ( dst displacement base displacement' base' base-class -- )
[
"end" define-label
"alloc" define-label
dst \ t %load-reference
"end" get resolve-label ; inline
-:: %boolean ( dst temp cc -- )
+:: %boolean ( dst cc temp -- )
cc negate-cc order-cc {
{ cc< [ dst temp \ BLT f (%boolean) ] }
{ cc<= [ dst temp \ BLE f (%boolean) ] }
: (%compare-float-unordered) ( src1 src2 -- ) [ 0 ] dip FCMPU ; inline
: (%compare-float-ordered) ( src1 src2 -- ) [ 0 ] dip FCMPO ; inline
-:: (%compare-float) ( cc src1 src2 -- branch1 branch2 )
+:: (%compare-float) ( src1 src2 cc -- branch1 branch2 )
cc {
{ cc< [ src1 src2 (%compare-float-ordered) \ BLT f ] }
{ cc<= [ src1 src2 (%compare-float-ordered) \ BLT \ BEQ ] }
{ cc/<>= [ src1 src2 (%compare-float-unordered) \ BO f ] }
} case ; inline
-M: ppc %compare (%compare) %boolean ;
-M: ppc %compare-imm (%compare-imm) %boolean ;
-M:: ppc %compare-float ( dst temp cc src1 src2 -- )
+M: ppc %compare [ (%compare) ] 2dip %boolean ;
+
+M: ppc %compare-imm [ (%compare-imm) ] 2dip %boolean ;
+
+M:: ppc %compare-float ( dst src1 src2 cc temp -- )
cc negate-cc src1 src2 (%compare-float) :> branch2 :> branch1
dst temp branch1 branch2 (%boolean) ;
{ cc/= [ label BNE ] }
} case ;
-M: ppc %compare-branch (%compare) %branch ;
-M: ppc %compare-imm-branch (%compare-imm) %branch ;
-M:: ppc %compare-float-branch ( label cc src1 src2 -- )
+M: ppc %compare-branch [ (%compare) ] 2dip %branch ;
+
+M: ppc %compare-imm-branch [ (%compare-imm) ] 2dip %branch ;
+
+M:: ppc %compare-float-branch ( label src1 src2 cc -- )
cc src1 src2 (%compare-float) :> branch2 :> branch1
label branch1 execute( label -- )
branch2 [ label branch2 execute( label -- ) ] when ;
: load-from-frame ( dst n rep -- )
{
{ int-rep [ [ 1 ] dip LWZ ] }
- { single-float-rep [ [ 1 ] dip LFS ] }
- { double-float-rep [ [ 1 ] dip LFD ] }
+ { float-rep [ [ 1 ] dip LFS ] }
+ { double-rep [ [ 1 ] dip LFD ] }
{ stack-params [ [ 0 1 ] dip LWZ [ 0 1 ] dip param@ STW ] }
} case ;
: store-to-frame ( src n rep -- )
{
{ int-rep [ [ 1 ] dip STW ] }
- { single-float-rep [ [ 1 ] dip STFS ] }
- { double-float-rep [ [ 1 ] dip STFD ] }
+ { float-rep [ [ 1 ] dip STFS ] }
+ { double-rep [ [ 1 ] dip STFD ] }
{ stack-params [ [ [ 0 1 ] dip next-param@ LWZ 0 1 ] dip STW ] }
} case ;
-M: ppc %spill ( src n rep -- )
- [ spill@ ] dip store-to-frame ;
+M: ppc %spill ( src rep n -- )
+ swap [ spill@ ] dip store-to-frame ;
-M: ppc %reload ( dst n rep -- )
- [ spill@ ] dip load-from-frame ;
+M: ppc %reload ( dst rep n -- )
+ swap [ spill@ ] dip load-from-frame ;
M: ppc %loop-entry ;