! 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." } ;
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"
! 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
[ 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
+
! 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
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' )
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 ;
+
projects / factor.git / commitdiff