diff --git a/basis/alien/endian/endian-docs.factor b/basis/alien/endian/endian-docs.factor index 4351c17f4e..c15bc7d186 100644 --- a/basis/alien/endian/endian-docs.factor +++ b/basis/alien/endian/endian-docs.factor @@ -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" diff --git a/basis/alien/endian/endian-tests.factor b/basis/alien/endian/endian-tests.factor index 2b440cc66d..53901a3938 100644 --- a/basis/alien/endian/endian-tests.factor +++ b/basis/alien/endian/endian-tests.factor @@ -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 + diff --git a/basis/alien/endian/endian.factor b/basis/alien/endian/endian.factor index a00c9ac6fe..bc2919bb6e 100644 --- a/basis/alien/endian/endian.factor +++ b/basis/alien/endian/endian.factor @@ -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 ; +