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

change half-floats to make a primitive C type instead of a single-slot C-STRUCT: + boxer/unboxer

db4
Joe Groff 2009-09-18 17:26:20 -05:00
parent 53752b4cfd
commit 4f07a26bd0
2 changed files with 25 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
extra/half-floats/half-floats-tests.factor
View File

@ -1,5 +1,5 @@
USING: alien.c-types alien.syntax half-floats kernel math tools.test USING: accessors alien.c-types alien.syntax half-floats kernel
specialized-arrays alien.data ; math tools.test specialized-arrays alien.data classes.struct ;
SPECIALIZED-ARRAY: half SPECIALIZED-ARRAY: half
IN: half-floats.tests IN: half-floats.tests
@ -9,7 +9,7 @@ IN: half-floats.tests
[ HEX: be00 ] [ -1.5 half>bits ] unit-test [ HEX: be00 ] [ -1.5 half>bits ] unit-test
[ HEX: 7c00 ] [ 1/0. half>bits ] unit-test [ HEX: 7c00 ] [ 1/0. half>bits ] unit-test
[ HEX: fc00 ] [ -1/0. half>bits ] unit-test [ HEX: fc00 ] [ -1/0. half>bits ] unit-test
[ HEX: 7eaa ] [ HEX: aaaaaaaaaaaaa <fp-nan> half>bits ] unit-test [ HEX: 7eaa ] [ NAN: aaaaaaaaaaaaa half>bits ] unit-test
! too-big floats overflow to infinity ! too-big floats overflow to infinity
[ HEX: 7c00 ] [ 65536.0 half>bits ] unit-test [ HEX: 7c00 ] [ 65536.0 half>bits ] unit-test
@ -30,18 +30,18 @@ IN: half-floats.tests
[ 3.0 ] [ HEX: 4200 bits>half ] unit-test [ 3.0 ] [ HEX: 4200 bits>half ] unit-test
[ t ] [ HEX: 7e00 bits>half fp-nan? ] unit-test [ t ] [ HEX: 7e00 bits>half fp-nan? ] unit-test
C-STRUCT: halves STRUCT: halves
{ "half" "tom" } { tom half }
{ "half" "dick" } { dick half }
{ "half" "harry" } { harry half }
{ "half" "harry-jr" } ; { harry-jr half } ;
[ 8 ] [ "halves" heap-size ] unit-test [ 8 ] [ halves heap-size ] unit-test
[ 3.0 ] [ [ 3.0 ] [
"halves" <c-object> halves <struct>
3.0 over set-halves-dick 3.0 >>dick
halves-dick dick>>
] unit-test ] unit-test
[ half-array{ 1.0 2.0 3.0 1/0. -1/0. } ] [ half-array{ 1.0 2.0 3.0 1/0. -1/0. } ]

19
extra/half-floats/half-floats.factor
View File

@ -1,5 +1,7 @@
! (c)2009 Joe Groff bsd license ! (c)2009 Joe Groff bsd license
USING: accessors alien.c-types alien.data alien.syntax kernel math math.order ; USING: accessors alien.accessors alien.c-types alien.data
alien.syntax kernel math math.order ;
FROM: math => float ;
IN: half-floats IN: half-floats
: half>bits ( float -- bits ) : half>bits ( float -- bits )
@ -26,13 +28,18 @@ IN: half-floats
] unless ] unless
] bi bitor bits>float ; ] bi bitor bits>float ;
C-STRUCT: half { "ushort" "(bits)" } ; SYMBOL: half
<< <<
"half" c-type <c-type>
[ half>bits <ushort> ] >>unboxer-quot float >>class
[ *ushort bits>half ] >>boxer-quot float >>boxed-class
drop [ alien-unsigned-2 bits>half ] >>getter
[ [ >float half>bits ] 2dip set-alien-unsigned-2 ] >>setter
2 >>size
2 >>align
[ >float ] >>unboxer-quot
\ half define-primitive-type
>> >>