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

Add STRUCT: syntax to alien.endian. Test and document the changes.

db4
Doug Coleman 2011-09-22 11:26:06 -05:00
parent 216f2332be
commit fa52349f9c
3 changed files with 276 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
basis/alien/endian/endian-docs.factor
View File

@ -1,8 +1,61 @@
! Copyright (C) 2011 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax kernel math quotations ;
USING: help.markup help.syntax kernel math quotations
classes.struct ;
IN: alien.endian
HELP: BE-PACKED-STRUCT:
{ $description "Defines a packed " { $link struct } " where endian-unaware types become big-endian types. Note that endian-aware types will override the big-endianness of this " { $link struct } " declaration; little-endian types will stay little-endian. On big-endian platforms, the endian-unaware types will not change since they are the correct endianness already." }
{ $unchecked-example
"! When run on a big-endian platform, this struct should prettyprint the same as defined"
"! The output of this example is from a little-endian platform"
"USE: alien.endian"
"BE-PACKED-STRUCT: s1 { a char[7] } { b int } ;"
"\\ s1 see"
"USING: alien.c-types alien.endian classes.struct ;
IN: scratchpad
STRUCT: s1 { a char[7] } { b be32 initial: 0 } ;"
} ;
HELP: BE-STRUCT:
{ $description "Defines a " { $link struct } " where endian-unaware types become big-endian types. Note that endian-aware types will override the big-endianness of this " { $link struct } " declaration; little-endian types will stay little-endian. On big-endian platforms, the endian-unaware types will not change since they are the correct endianness already." }
{ $unchecked-example
"! When run on a big-endian platform, this struct should prettyprint the same as defined"
"! The output of this example is from a little-endian platform"
"USE: alien.endian"
"BE-STRUCT: s1 { a int } { b le32 } ;"
"\\ s1 see"
"USING: alien.c-types alien.endian classes.struct ;
IN: scratchpad
STRUCT: s1 { a be32 initial: 0 } { b le32 initial: 0 } ;"
} ;
HELP: LE-PACKED-STRUCT:
{ $description "Defines a packed " { $link struct } " where endian-unaware types become little-endian types. Note that endian-aware types will override the little-endianness of this " { $link struct } " declaration; big-endian types will stay big-endian. On little-endian platforms, the endian-unaware types will not change since they are the correct endianness already." }
{ $unchecked-example
"! When run on a little-endian platform, this struct should prettyprint the same as defined"
"! The output of this example is from a little-endian platform"
"USE: alien.endian"
"LE-PACKED-STRUCT: s1 { a char[7] } { b int } ;"
"\\ s1 see"
"USING: alien.c-types alien.endian classes.struct ;
IN: scratchpad
STRUCT: s1 { a char[7] } { b int initial: 0 } ;"
} ;
HELP: LE-STRUCT:
{ $description "Defines a " { $link struct } " where endian-unaware types become little-endian types. Note that endian-aware types will override the little-endianness of this " { $link struct } " declaration; big-endian types will stay big-endian. On little-endian platforms, the endian-unaware types will not change since they are the correct endianness already." }
{ $unchecked-example
"! When run on a little-endian platform, this struct should prettyprint the same as defined"
"! The output of this example is from a little-endian platform"
"USE: alien.endian"
"LE-STRUCT: s1 { a int } { b be32 } ;"
"\\ s1 see"
"USING: alien.c-types alien.endian classes.struct ;
IN: scratchpad
STRUCT: s1 { a int initial: 0 } { b be32 initial: 0 } ;"
} ;
HELP: be16
{ $var-description "Signed bit-endian 16-bit." } ;
@ -85,6 +138,13 @@ ARTICLE: "alien.endian" "Alien endian-aware types"
ule16
ule32
ule64
}
"Syntax for making endian-aware structs out of native types:"
{ $subsections
POSTPONE: LE-STRUCT:
POSTPONE: BE-STRUCT:
POSTPONE: LE-PACKED-STRUCT:
POSTPONE: BE-PACKED-STRUCT:
} ;
ABOUT: "alien.endian"

147
basis/alien/endian/endian-tests.factor
View File

@ -1,7 +1,8 @@
! 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 ;
io.encodings.binary io.streams.byte-array kernel tools.test
alien.c-types ;
IN: alien.endian.tests
STRUCT: endian-struct
@ -94,3 +95,147 @@ CONSTANT: endian-bytes-f0 B{
[ t ]
[ endian-test-struct-f0 binary [ write ] with-byte-writer endian-bytes-f0 = ] unit-test
LE-STRUCT: le-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 } ;
[ t ]
[
endian-bytes-0f le-endian-struct memory>struct
binary [ write ] with-byte-writer endian-bytes-0f =
] unit-test
[ t ]
[
endian-bytes-f0 le-endian-struct memory>struct
binary [ write ] with-byte-writer endian-bytes-f0 =
] unit-test
BE-STRUCT: be-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 } ;
[ t ]
[
endian-bytes-0f be-endian-struct memory>struct
binary [ write ] with-byte-writer endian-bytes-0f =
] unit-test
[ t ]
[
endian-bytes-f0 be-endian-struct memory>struct
binary [ write ] with-byte-writer endian-bytes-f0 =
] unit-test
LE-STRUCT: le-override-struct
{ a ushort }
{ b short }
{ c ube16 }
{ d be16 }
{ e uint }
{ f int }
{ g ube32 }
{ h be32 }
{ i ulonglong }
{ j longlong }
{ k ube64 }
{ l be64 } ;
[ t ]
[
endian-bytes-0f le-override-struct memory>struct
binary [ write ] with-byte-writer endian-bytes-0f =
] unit-test
[ t ]
[
endian-bytes-f0 le-override-struct memory>struct
binary [ write ] with-byte-writer endian-bytes-f0 =
] unit-test
BE-STRUCT: be-override-struct
{ a ule16 }
{ b le16 }
{ c ushort }
{ d short }
{ e ule32 }
{ f le32 }
{ g uint }
{ h int }
{ i ule64 }
{ j le64 }
{ k ulonglong }
{ l longlong } ;
[ t ]
[
endian-bytes-0f be-override-struct memory>struct
binary [ write ] with-byte-writer endian-bytes-0f =
] unit-test
[ t ]
[
endian-bytes-f0 be-override-struct memory>struct
binary [ write ] with-byte-writer endian-bytes-f0 =
] unit-test
LE-PACKED-STRUCT: le-packed-struct
{ a char[7] }
{ b int } ;
[ t ]
[
B{ 0 0 0 0 0 0 0 3 0 0 0 } [
le-packed-struct memory>struct
binary [ write ] with-byte-writer
] keep =
] unit-test
[ 3 ]
[
B{ 0 0 0 0 0 0 0 3 0 0 0 } le-packed-struct memory>struct
b>>
] unit-test
BE-PACKED-STRUCT: be-packed-struct
{ a char[7] }
{ b int } ;
[ t ]
[
B{ 0 0 0 0 0 0 0 0 0 0 3 } [
be-packed-struct memory>struct
binary [ write ] with-byte-writer
] keep =
] unit-test
[ 3 ]
[
B{ 0 0 0 0 0 0 0 0 0 0 3 } be-packed-struct memory>struct
b>>
] unit-test

72
basis/alien/endian/endian.factor
View File

@ -1,8 +1,9 @@
! 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 ;
USING: accessors alien alien.accessors alien.c-types alien.data
classes.struct.private combinators compiler.units endian fry
generalizations kernel macros math namespaces sequences words
arrays slots ;
QUALIFIED-WITH: alien.c-types ac
IN: alien.endian
@ -35,6 +36,12 @@ SYMBOLS: le8 be8 ule8 ube8
ule16 ule32 ule64 ube16 ube32 ube64
le16 le32 le64 be16 be32 be64 ;
: endian-c-type? ( symbol -- ? )
{
le8 be8 ule8 ube8 ule16 ule32 ule64
ube16 ube32 ube64 le16 le32 le64 be16 be32 be64
} member? ;
ERROR: unknown-endian-c-type symbol ;
: endian-c-type>c-type-symbol ( symbol -- symbol' )
@ -82,3 +89,62 @@ ERROR: unknown-endian-c-type symbol ;
8 t \ le64 typedef-le
8 t \ be64 typedef-be
] with-compilation-unit
! pair: { le be }
: pair>c-type ( pair -- c-type )
[ native-endianness get big-endian = ] dip first2 ? ;
! endian is desired endian type. if we match endianness, return the c type
! otherwise return the opposite of our endianness
: endian-slot ( endian c-type pair -- endian-slot )
[ native-endianness get = ] 2dip rot [ drop ] [ nip pair>c-type ] if ;
ERROR: unsupported-endian-type endian slot ;
: slot>endian-slot ( endian slot -- endian-slot )
dup array? [
first2 [ slot>endian-slot ] dip 2array
] [
{
{ [ dup char = ] [ 2drop char ] }
{ [ dup uchar = ] [ 2drop uchar ] }
{ [ dup ac:short = ] [ { le16 be16 } endian-slot ] }
{ [ dup ushort = ] [ { ule16 ube16 } endian-slot ] }
{ [ dup int = ] [ { le32 be32 } endian-slot ] }
{ [ dup uint = ] [ { ule32 ube32 } endian-slot ] }
{ [ dup longlong = ] [ { le64 be64 } endian-slot ] }
{ [ dup ulonglong = ] [ { ule64 ube64 } endian-slot ] }
{ [ dup endian-c-type? ] [ nip ] }
[ unsupported-endian-type ]
} cond
] if ;
: set-endian-slots ( endian slots -- slot-specs )
[ [ slot>endian-slot ] change-type ] with map ;
: define-endian-struct-class ( class slots endian -- )
swap make-slots set-endian-slots
[ compute-struct-offsets ] [ struct-alignment ]
(define-struct-class) ;
: define-endian-packed-struct-class ( class slots endian -- )
swap make-packed-slots set-endian-slots
[ compute-struct-offsets ] [ drop 1 ]
(define-struct-class) ;
SYNTAX: LE-STRUCT:
parse-struct-definition
little-endian define-endian-struct-class ;
SYNTAX: BE-STRUCT:
parse-struct-definition
big-endian define-endian-struct-class ;
SYNTAX: LE-PACKED-STRUCT:
parse-struct-definition
little-endian define-endian-packed-struct-class ;
SYNTAX: BE-PACKED-STRUCT:
parse-struct-definition
big-endian define-endian-packed-struct-class ;