steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge git://factorcode.org/git/factor

db4
Doug Coleman 2008-01-12 22:11:27 -10:00
parent b14a0e54e4 3fd394d06e
commit 8373b63076
1 changed files with 24 additions and 7 deletions
core/cpu/ppc/intrinsics

31
core/cpu/ppc/intrinsics/intrinsics.factor
View File

@ -185,22 +185,21 @@ IN: cpu.ppc.intrinsics
{
[
{ "positive" "end" } [ define-label ] each
{ "x" "y" } %untag-fixnums
"y" operand "out" operand swap %untag-fixnum
0 "y" operand 0 CMPI
"positive" get BGE
"y" operand dup NEG
"out" operand "x" operand "y" operand SRAW
"out" operand "x" operand "out" operand SRAW
"end" get B
"positive" resolve-label
"out" operand "x" operand "y" operand SLW
"out" operand "x" operand "out" operand SLW
"end" resolve-label
! Mask off low bits
"out" operand dup %tag-fixnum
"out" operand dup %untag
] H{
{ +input+ { { f "x" } { f "y" } } }
{ +scratch+ { { f "out" } } }
{ +output+ { "out" } }
{ +clobber+ { "x" "y" } }
}
}
} define-intrinsics
@ -361,9 +360,10 @@ IN: cpu.ppc.intrinsics
} define-intrinsic
: define-float-op ( word op -- )
[ "x" operand "x" operand "y" operand ] swap add H{
[ "z" operand "x" operand "y" operand ] swap add H{
{ +input+ { { float "x" } { float "y" } } }
{ +output+ { "x" } }
{ +scratch+ { { float "z" } } }
{ +output+ { "z" } }
} define-intrinsic ;
{
@ -400,6 +400,23 @@ IN: cpu.ppc.intrinsics
{ +output+ { "out" } }
} define-intrinsic
\ fixnum>float [
HEX: 4330 "scratch" operand LIS
"scratch" operand 1 0 param@ STW
"scratch" operand "in" operand %untag-fixnum
"scratch" operand dup HEX: 8000 XORIS
"scratch" operand 1 cell param@ STW
"f1" operand 1 0 param@ LFD
4503601774854144.0 "scratch" operand load-indirect
"f2" operand "scratch" operand float-offset LFD
"f1" operand "f1" operand "f2" operand FSUB
] H{
{ +input+ { { f "in" } } }
{ +scratch+ { { f "scratch" } { float "f1" } { float "f2" } } }
{ +output+ { "f1" } }
} define-intrinsic
\ tag [
"out" operand "in" operand tag-mask get ANDI
"out" operand dup %tag-fixnum