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
specialized-arrays alien.data ;
USING: accessors alien.c-types alien.syntax half-floats kernel
math tools.test specialized-arrays alien.data classes.struct ;
SPECIALIZED-ARRAY: half
IN: half-floats.tests
@ -9,7 +9,7 @@ IN: half-floats.tests
[ HEX: be00 ] [ -1.5 half>bits ] unit-test
[ HEX: 7c00 ] [ 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
[ HEX: 7c00 ] [ 65536.0 half>bits ] unit-test
@ -30,18 +30,18 @@ IN: half-floats.tests
[ 3.0 ] [ HEX: 4200 bits>half ] unit-test
[ t ] [ HEX: 7e00 bits>half fp-nan? ] unit-test
C-STRUCT: halves
{ "half" "tom" }
{ "half" "dick" }
{ "half" "harry" }
{ "half" "harry-jr" } ;
STRUCT: halves
{ tom half }
{ dick half }
{ harry half }
{ harry-jr half } ;
[ 8 ] [ "halves" heap-size ] unit-test
[ 8 ] [ halves heap-size ] unit-test
[ 3.0 ] [
"halves" <c-object>
3.0 over set-halves-dick
halves-dick
halves <struct>
3.0 >>dick
dick>>
] unit-test
[ 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
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
: half>bits ( float -- bits )
@ -26,13 +28,18 @@ IN: half-floats
] unless
] bi bitor bits>float ;
C-STRUCT: half { "ushort" "(bits)" } ;
SYMBOL: half
<<
"half" c-type
[ half>bits <ushort> ] >>unboxer-quot
[ *ushort bits>half ] >>boxer-quot
drop
<c-type>
float >>class
float >>boxed-class
[ 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
>>