From 1df7a409846603dd0d247d34b2e06eb10f5a25ad Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 12 Oct 2011 09:45:03 -0700 Subject: [PATCH] Add 2/4/8le>, 2/4/8be> -- 30% faster on the 8-byte versions, slightly less faster on the others. --- extra/io/binary/fast/authors.txt | 1 + extra/io/binary/fast/fast-tests.factor | 13 ++++++++ extra/io/binary/fast/fast.factor | 42 ++++++++++++++++++++++++++ 3 files changed, 56 insertions(+) create mode 100644 extra/io/binary/fast/authors.txt create mode 100644 extra/io/binary/fast/fast-tests.factor create mode 100644 extra/io/binary/fast/fast.factor diff --git a/extra/io/binary/fast/authors.txt b/extra/io/binary/fast/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/io/binary/fast/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/io/binary/fast/fast-tests.factor b/extra/io/binary/fast/fast-tests.factor new file mode 100644 index 0000000000..ce2ff093b9 --- /dev/null +++ b/extra/io/binary/fast/fast-tests.factor @@ -0,0 +1,13 @@ +! Copyright (C) 2011 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test io.binary.fast ; +IN: io.binary.fast.tests + +[ HEX: 0102 ] [ B{ 01 02 } 2be> ] unit-test +[ HEX: 01020304 ] [ B{ 01 02 03 04 } 4be> ] unit-test +[ HEX: 0102030405060708 ] [ B{ 01 02 03 04 05 06 07 08 } 8be> ] unit-test + +[ HEX: 0102 ] [ B{ 02 01 } 2le> ] unit-test +[ HEX: 01020304 ] [ B{ 04 03 02 01 } 4le> ] unit-test +[ HEX: 0102030405060708 ] [ B{ 08 07 06 05 04 03 02 01 } 8le> ] unit-test + diff --git a/extra/io/binary/fast/fast.factor b/extra/io/binary/fast/fast.factor new file mode 100644 index 0000000000..47f326f4e0 --- /dev/null +++ b/extra/io/binary/fast/fast.factor @@ -0,0 +1,42 @@ +! Copyright (C) 2011 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: combinators combinators.smart fry kernel macros math +math.ranges sequences sequences.generalizations io.binary +locals ; +IN: io.binary.fast + +ERROR: bad-length bytes n ; + +: check-length ( bytes n -- bytes n ) + 2dup [ length ] dip > [ bad-length ] when ; inline + +<< +: be-range ( n -- range ) + 1 - 8 * 0 -8 ; inline + +: le-range ( n -- range ) + 1 - 8 * 0 swap 8 ; inline + +: reassemble-bytes ( range -- quot ) + [ dup 0 = [ drop [ ] ] [ '[ _ shift ] ] if ] map + '[ [ _ spread ] [ bitor ] reduce-outputs ] ; inline + +MACRO: reassemble-be ( n -- quot ) be-range reassemble-bytes ; + +MACRO: reassemble-le ( n -- quot ) le-range reassemble-bytes ; +>> + +:: n-be> ( bytes n -- x ) + bytes n check-length drop n firstn-unsafe n reassemble-be ; inline + +:: n-le> ( bytes n -- x ) + bytes n check-length drop n firstn-unsafe n reassemble-le ; inline + +: 2be> ( bytes -- x ) 2 n-be> ; +: 4be> ( bytes -- x ) 4 n-be> ; +: 8be> ( bytes -- x ) 8 n-be> ; + +: 2le> ( bytes -- x ) 2 n-le> ; +: 4le> ( bytes -- x ) 4 n-le> ; +: 8le> ( bytes -- x ) 8 n-le> ; +