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

alien.c-types: Add c-type-signed to protocol, which is true for signed 

types. Use c-type-signed in classes.struct.
db4
Doug Coleman 2012-09-16 14:42:18 -07:00
parent eaed0db99a
commit 1a91e3a8ff
2 changed files with 15 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
basis/alien/c-types/c-types.factor
View File

@ -26,6 +26,7 @@ TUPLE: abstract-c-type
{ getter callable } { getter callable }
{ setter callable } { setter callable }
{ size integer } { size integer }
{ signed boolean }
{ align integer } { align integer }
{ align-first integer } ; { align-first integer } ;
@ -94,6 +95,10 @@ GENERIC: c-type-setter ( name -- quot )
M: c-type c-type-setter setter>> ; M: c-type c-type-setter setter>> ;
GENERIC: c-type-signed ( name -- boolean ) foldable
M: abstract-c-type c-type-signed signed>> ;
GENERIC: c-type-align ( name -- n ) foldable GENERIC: c-type-align ( name -- n ) foldable
M: abstract-c-type c-type-align align>> ; M: abstract-c-type c-type-align align>> ;
@ -143,6 +148,7 @@ PROTOCOL: c-type-protocol
c-type-getter c-type-getter
c-type-copier c-type-copier
c-type-setter c-type-setter
c-type-signed
c-type-align c-type-align
c-type-align-first c-type-align-first
base-type base-type
@ -236,6 +242,7 @@ M: pointer lookup-c-type
[ alien-signed-2 ] >>getter [ alien-signed-2 ] >>getter
[ set-alien-signed-2 ] >>setter [ set-alien-signed-2 ] >>setter
2 >>size 2 >>size
t >>signed
2 >>align 2 >>align
2 >>align-first 2 >>align-first
"from_signed_2" >>boxer "from_signed_2" >>boxer
@ -262,6 +269,7 @@ M: pointer lookup-c-type
[ alien-signed-1 ] >>getter [ alien-signed-1 ] >>getter
[ set-alien-signed-1 ] >>setter [ set-alien-signed-1 ] >>setter
1 >>size 1 >>size
t >>signed
1 >>align 1 >>align
1 >>align-first 1 >>align-first
"from_signed_1" >>boxer "from_signed_1" >>boxer
@ -316,6 +324,7 @@ M: pointer lookup-c-type
[ alien-signed-4 ] >>getter [ alien-signed-4 ] >>getter
[ set-alien-signed-4 ] >>setter [ set-alien-signed-4 ] >>setter
4 >>size 4 >>size
t >>signed
4 >>align 4 >>align
4 >>align-first 4 >>align-first
"from_signed_4" >>boxer "from_signed_4" >>boxer
@ -342,6 +351,7 @@ M: pointer lookup-c-type
[ alien-signed-cell ] >>getter [ alien-signed-cell ] >>getter
[ set-alien-signed-cell ] >>setter [ set-alien-signed-cell ] >>setter
8 >>size 8 >>size
t >>signed
8 >>align 8 >>align
8 >>align-first 8 >>align-first
"from_signed_cell" >>boxer "from_signed_cell" >>boxer
@ -382,6 +392,7 @@ M: pointer lookup-c-type
[ alien-signed-cell ] >>getter [ alien-signed-cell ] >>getter
[ set-alien-signed-cell ] >>setter [ set-alien-signed-cell ] >>setter
4 >>size 4 >>size
t >>signed
4 >>align 4 >>align
4 >>align-first 4 >>align-first
"from_signed_cell" >>boxer "from_signed_cell" >>boxer
@ -408,6 +419,7 @@ M: pointer lookup-c-type
[ alien-signed-8 ] >>getter [ alien-signed-8 ] >>getter
[ set-alien-signed-8 ] >>setter [ set-alien-signed-8 ] >>setter
8 >>size 8 >>size
t >>signed
8-byte-alignment 8-byte-alignment
"from_signed_8" >>boxer "from_signed_8" >>boxer
"to_signed_8" >>unboxer "to_signed_8" >>unboxer
@ -463,8 +475,8 @@ M: double-2-rep rep-component-type drop double ;
: c-type-interval ( c-type -- from to ) : c-type-interval ( c-type -- from to )
{ {
{ [ dup { float double } member-eq? ] [ drop -1/0. 1/0. ] } { [ dup { float double } member-eq? ] [ drop -1/0. 1/0. ] }
{ [ dup { char short int long longlong } member-eq? ] [ signed-interval ] } { [ dup c-type-signed ] [ signed-interval ] }
{ [ dup { uchar ushort uint ulong ulonglong } member-eq? ] [ unsigned-interval ] } { [ dup c-type-signed not ] [ unsigned-interval ] }
} cond ; foldable } cond ; foldable
: c-type-clamp ( value c-type -- value' ) : c-type-clamp ( value c-type -- value' )

6
basis/classes/struct/struct.factor
View File

@ -344,11 +344,7 @@ ERROR: bad-type-for-bits type ;
:: set-bits ( slot-spec n -- slot-spec ) :: set-bits ( slot-spec n -- slot-spec )
struct-bit-slot-spec new struct-bit-slot-spec new
n >>bits n >>bits
slot-spec type>> { slot-spec type>> c-type-signed >>signed?
{ int [ t ] }
{ uint [ f ] }
[ bad-type-for-bits ]
} case >>signed?
slot-spec name>> >>name slot-spec name>> >>name
slot-spec class>> >>class slot-spec class>> >>class
slot-spec type>> >>type slot-spec type>> >>type