Add c-types in alien.endian for making endian-aware STRUCTs.
Doug Coleman
parent
eedc1e185f
commit
4220f9dc0c
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
||||
|
|
@ -0,0 +1,90 @@
|
|||
! Copyright (C) 2011 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.markup help.syntax kernel math quotations ;
|
||||
IN: alien.endian
|
||||
|
||||
HELP: be16
|
||||
{ $var-description "Signed bit-endian 16-bit." } ;
|
||||
|
||||
HELP: be32
|
||||
{ $var-description "Signed bit-endian 32-bit." } ;
|
||||
|
||||
HELP: be64
|
||||
{ $var-description "Signed bit-endian 64-bit." } ;
|
||||
|
||||
HELP: be8
|
||||
{ $var-description "Signed bit-endian 8-bit." } ;
|
||||
|
||||
HELP: byte-reverse
|
||||
{ $values
|
||||
{ "n" integer } { "signed?" boolean }
|
||||
{ "quot" quotation }
|
||||
}
|
||||
{ $description "Reverses the " { $snippet "n" } " bytes in an integer with bitwise operations. The second parameter only works for 1, 2, 4, or 8 byte signed numbers." } ;
|
||||
|
||||
HELP: le16
|
||||
{ $var-description "Signed little-endian 16-bit." } ;
|
||||
|
||||
HELP: le32
|
||||
{ $var-description "Signed little-endian 32-bit." } ;
|
||||
|
||||
HELP: le64
|
||||
{ $var-description "Signed little-endian 64-bit." } ;
|
||||
|
||||
HELP: le8
|
||||
{ $var-description "Signed little-endian 8-bit." } ;
|
||||
|
||||
HELP: ube16
|
||||
{ $var-description "Unsigned big-endian 16-bit." } ;
|
||||
|
||||
HELP: ube32
|
||||
{ $var-description "Unsigned big-endian 32-bit." } ;
|
||||
|
||||
HELP: ube64
|
||||
{ $var-description "Unsigned big-endian 64-bit." } ;
|
||||
|
||||
HELP: ube8
|
||||
{ $var-description "Unsigned big-endian 8-bit." } ;
|
||||
|
||||
HELP: ule16
|
||||
{ $var-description "Unsigned little-endian 16-bit." } ;
|
||||
|
||||
HELP: ule32
|
||||
{ $var-description "Unsigned little-endian 32-bit." } ;
|
||||
|
||||
HELP: ule64
|
||||
{ $var-description "Unsigned little-endian 64-bit." } ;
|
||||
|
||||
HELP: ule8
|
||||
{ $var-description "Unsigned little-endian 8-bit." } ;
|
||||
|
||||
ARTICLE: "alien.endian" "Alien endian-aware types"
|
||||
"The " { $vocab-link "alien.endian" } " vocabulary defines c-types that are endian-aware for use in structs. These types will cause the bytes in a byte-array to be interpreted as little or big-endian transparently when reading or writing. There are both signed and unsigned types defined; signed is the default while unsigned are prefixed with a " { $snippet "u" } ". The intended use-case is for network protocols in network-byte-order (big-endian)." $nl
|
||||
"Byte-reversal of integers:"
|
||||
{ $subsections
|
||||
byte-reverse
|
||||
}
|
||||
"The big-endian c-types are:"
|
||||
{ $subsections
|
||||
be8
|
||||
be16
|
||||
be32
|
||||
be64
|
||||
ube8
|
||||
ube16
|
||||
ube32
|
||||
ube64
|
||||
}
|
||||
"The little-endian c-types are:"
|
||||
{ $subsections
|
||||
le8
|
||||
le16
|
||||
le32
|
||||
le64
|
||||
ule8
|
||||
ule16
|
||||
ule32
|
||||
ule64
|
||||
} ;
|
||||
|
||||
ABOUT: "alien.endian"
|
||||
|
|
@ -0,0 +1,96 @@
|
|||
! Copyright (C) 2011 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien.endian classes.struct io
|
||||
io.encodings.binary io.streams.byte-array kernel tools.test ;
|
||||
IN: alien.endian.tests
|
||||
|
||||
STRUCT: endian-struct
|
||||
{ a ule16 }
|
||||
{ b le16 }
|
||||
{ c ube16 }
|
||||
{ d be16 }
|
||||
{ e ule32 }
|
||||
{ f le32 }
|
||||
{ g ube32 }
|
||||
{ h be32 }
|
||||
{ i ule64 }
|
||||
{ j le64 }
|
||||
{ k ube64 }
|
||||
{ l be64 } ;
|
||||
|
||||
CONSTANT: endian-bytes-0f B{
|
||||
HEX: 0 HEX: ff
|
||||
HEX: 0 HEX: ff
|
||||
HEX: 0 HEX: ff
|
||||
HEX: 0 HEX: ff
|
||||
|
||||
HEX: 0 HEX: 0 HEX: 0 HEX: ff
|
||||
HEX: 0 HEX: 0 HEX: 0 HEX: ff
|
||||
HEX: 0 HEX: 0 HEX: 0 HEX: ff
|
||||
HEX: 0 HEX: 0 HEX: 0 HEX: ff
|
||||
|
||||
HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: ff
|
||||
HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: ff
|
||||
HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: ff
|
||||
HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: ff
|
||||
}
|
||||
|
||||
CONSTANT: endian-bytes-f0 B{
|
||||
HEX: ff HEX: 0
|
||||
HEX: ff HEX: 0
|
||||
HEX: ff HEX: 0
|
||||
HEX: ff HEX: 0
|
||||
|
||||
HEX: ff HEX: 0 HEX: 0 HEX: 0
|
||||
HEX: ff HEX: 0 HEX: 0 HEX: 0
|
||||
HEX: ff HEX: 0 HEX: 0 HEX: 0
|
||||
HEX: ff HEX: 0 HEX: 0 HEX: 0
|
||||
|
||||
HEX: ff HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: 0
|
||||
HEX: ff HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: 0
|
||||
HEX: ff HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: 0
|
||||
HEX: ff HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: 0 HEX: 0
|
||||
}
|
||||
|
||||
: endian-test-struct-0f ( -- obj )
|
||||
endian-bytes-0f endian-struct memory>struct ;
|
||||
|
||||
: endian-test-struct-f0 ( -- obj )
|
||||
endian-bytes-f0 endian-struct memory>struct ;
|
||||
|
||||
[ HEX: ff00 ] [ endian-test-struct-0f a>> ] unit-test
|
||||
[ -256 ] [ endian-test-struct-0f b>> ] unit-test
|
||||
[ HEX: 00ff ] [ endian-test-struct-0f c>> ] unit-test
|
||||
[ HEX: 00ff ] [ endian-test-struct-0f d>> ] unit-test
|
||||
|
||||
[ HEX: ff000000 ] [ endian-test-struct-0f e>> ] unit-test
|
||||
[ -16777216 ] [ endian-test-struct-0f f>> ] unit-test
|
||||
[ HEX: 000000ff ] [ endian-test-struct-0f g>> ] unit-test
|
||||
[ HEX: 000000ff ] [ endian-test-struct-0f h>> ] unit-test
|
||||
|
||||
[ HEX: ff00000000000000 ] [ endian-test-struct-0f i>> ] unit-test
|
||||
[ -72057594037927936 ] [ endian-test-struct-0f j>> ] unit-test
|
||||
[ HEX: 00000000000000ff ] [ endian-test-struct-0f k>> ] unit-test
|
||||
[ HEX: 00000000000000ff ] [ endian-test-struct-0f l>> ] unit-test
|
||||
|
||||
|
||||
[ HEX: ff00 ] [ endian-test-struct-f0 c>> ] unit-test
|
||||
[ -256 ] [ endian-test-struct-f0 d>> ] unit-test
|
||||
[ HEX: 00ff ] [ endian-test-struct-f0 a>> ] unit-test
|
||||
[ HEX: 00ff ] [ endian-test-struct-f0 b>> ] unit-test
|
||||
|
||||
[ HEX: ff000000 ] [ endian-test-struct-f0 g>> ] unit-test
|
||||
[ -16777216 ] [ endian-test-struct-f0 h>> ] unit-test
|
||||
[ HEX: 000000ff ] [ endian-test-struct-f0 e>> ] unit-test
|
||||
[ HEX: 000000ff ] [ endian-test-struct-f0 f>> ] unit-test
|
||||
|
||||
[ HEX: ff00000000000000 ] [ endian-test-struct-f0 k>> ] unit-test
|
||||
[ -72057594037927936 ] [ endian-test-struct-f0 l>> ] unit-test
|
||||
[ HEX: 00000000000000ff ] [ endian-test-struct-f0 i>> ] unit-test
|
||||
[ HEX: 00000000000000ff ] [ endian-test-struct-f0 j>> ] unit-test
|
||||
|
||||
[ t ]
|
||||
[ endian-test-struct-0f binary [ write ] with-byte-writer endian-bytes-0f = ] unit-test
|
||||
|
||||
[ t ]
|
||||
[ endian-test-struct-f0 binary [ write ] with-byte-writer endian-bytes-f0 = ] unit-test
|
||||
|
|
@ -0,0 +1,84 @@
|
|||
! Copyright (C) 2011 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien.accessors alien.c-types combinators
|
||||
compiler.units endian fry generalizations kernel macros math
|
||||
namespaces sequences words alien.data ;
|
||||
QUALIFIED-WITH: alien.c-types ac
|
||||
IN: alien.endian
|
||||
|
||||
ERROR: invalid-signed-conversion n ;
|
||||
|
||||
: convert-signed-quot ( n -- quot )
|
||||
{
|
||||
{ 1 [ [ char <ref> char deref ] ] }
|
||||
{ 2 [ [ ac:short <ref> ac:short deref ] ] }
|
||||
{ 4 [ [ int <ref> int deref ] ] }
|
||||
{ 8 [ [ longlong <ref> longlong deref ] ] }
|
||||
[ invalid-signed-conversion ]
|
||||
} case ; inline
|
||||
|
||||
MACRO: byte-reverse ( n signed? -- quot )
|
||||
[
|
||||
drop
|
||||
[
|
||||
dup iota [
|
||||
[ 1 + - -8 * ] [ nip 8 * ] 2bi
|
||||
'[ _ shift HEX: ff bitand _ shift ]
|
||||
] with map
|
||||
] [ 1 - [ bitor ] n*quot ] bi
|
||||
] [
|
||||
[ convert-signed-quot ] [ drop [ ] ] if
|
||||
] 2bi
|
||||
'[ _ cleave @ @ ] ;
|
||||
|
||||
SYMBOLS: le8 be8 ule8 ube8
|
||||
ule16 ule32 ule64 ube16 ube32 ube64
|
||||
le16 le32 le64 be16 be32 be64 ;
|
||||
|
||||
ERROR: unknown-endian-c-type symbol ;
|
||||
|
||||
: endian-c-type>c-type-symbol ( symbol -- symbol' )
|
||||
{
|
||||
{ [ dup { ule16 ube16 } member? ] [ drop ushort ] }
|
||||
{ [ dup { le16 be16 } member? ] [ drop ac:short ] }
|
||||
{ [ dup { ule32 ube32 } member? ] [ drop uint ] }
|
||||
{ [ dup { le32 be32 } member? ] [ drop int ] }
|
||||
{ [ dup { ule64 ube64 } member? ] [ drop ulonglong ] }
|
||||
{ [ dup { le64 be64 } member? ] [ drop longlong ] }
|
||||
[ unknown-endian-c-type ]
|
||||
} cond ;
|
||||
|
||||
: change-c-type-accessors ( n ? c-type -- c-type' )
|
||||
endian-c-type>c-type-symbol "c-type" word-prop clone
|
||||
-rot
|
||||
[ '[ [ _ _ byte-reverse ] compose ] change-getter drop ]
|
||||
[ '[ [ [ _ _ byte-reverse ] 2dip ] prepose ] change-setter ] 3bi ;
|
||||
|
||||
: typedef-endian ( n ? c-type endian -- )
|
||||
native-endianness get = [
|
||||
2nip [ endian-c-type>c-type-symbol ] keep typedef
|
||||
] [
|
||||
[ change-c-type-accessors ] keep typedef
|
||||
] if ;
|
||||
|
||||
: typedef-le ( n ? c-type -- ) little-endian typedef-endian ;
|
||||
: typedef-be ( n ? c-type -- ) big-endian typedef-endian ;
|
||||
|
||||
[
|
||||
\ char \ le8 typedef
|
||||
\ char \ be8 typedef
|
||||
\ uchar \ ule8 typedef
|
||||
\ uchar \ ube8 typedef
|
||||
2 f \ ule16 typedef-le
|
||||
2 f \ ube16 typedef-be
|
||||
2 t \ le16 typedef-le
|
||||
2 t \ be16 typedef-be
|
||||
4 f \ ule32 typedef-le
|
||||
4 f \ ube32 typedef-be
|
||||
4 t \ le32 typedef-le
|
||||
4 t \ be32 typedef-be
|
||||
8 f \ ule64 typedef-le
|
||||
8 f \ ube64 typedef-be
|
||||
8 t \ le64 typedef-le
|
||||
8 t \ be64 typedef-be
|
||||
] with-compilation-unit
|
||||
Loading…
Reference in New Issue