From afc07c0e053b421f4e38ad9ebf2caf414a8883f1 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Tue, 11 Oct 2011 21:13:30 -0700 Subject: [PATCH 1/3] io.binary: make le> and be> faster (20% and 75%, respectively). Removed primitive byte-array>bignum and digit_stream_to_bignum from vm/. --- basis/random/random.factor | 2 +- .../known-words/known-words.factor | 1 - core/bootstrap/primitives.factor | 1 - core/io/binary/binary-tests.factor | 15 ++++++++ core/io/binary/binary.factor | 4 +- core/math/integers/integers-tests.factor | 12 ------ core/math/math-docs.factor | 4 -- extra/images/tiff/tiff.factor | 2 +- vm/bignum.cpp | 37 ------------------- vm/bignum.hpp | 2 - vm/math.cpp | 7 ---- vm/primitives.hpp | 1 - vm/vm.hpp | 2 - 13 files changed, 19 insertions(+), 71 deletions(-) diff --git a/basis/random/random.factor b/basis/random/random.factor index c1ee6b475b..2b8d4c783b 100644 --- a/basis/random/random.factor +++ b/basis/random/random.factor @@ -41,7 +41,7 @@ M: f random-32* ( obj -- * ) no-random-number-generator ; : random-integer ( n -- n' ) dup log2 7 + 8 /i 1 + - [ random-bytes >byte-array byte-array>bignum ] + [ random-bytes le> ] [ 3 shift 2^ ] bi / * >integer ; PRIVATE> diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index bc7e28c2b0..d51ac0b6d6 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -343,7 +343,6 @@ M: object infer-call* \ call bad-macro-input ; \ bits>double { integer } { float } define-primitive \ bits>double make-foldable \ bits>float { integer } { float } define-primitive \ bits>float make-foldable \ both-fixnums? { object object } { object } define-primitive -\ byte-array>bignum { byte-array } { bignum } define-primitive \ byte-array>bignum make-foldable \ callstack { } { callstack } define-primitive \ callstack make-flushable \ callstack-bounds { } { alien alien } define-primitive \ callstack-bounds make-flushable \ callstack-for { c-ptr } { callstack } define-primitive \ callstack make-flushable diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 5d1a166022..de8d7b7d5a 100755 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -472,7 +472,6 @@ tuple { "load-locals" "locals.backend" "primitive_load_locals" (( ... n -- )) } { "bits>double" "math" "primitive_bits_double" (( n -- x )) } { "bits>float" "math" "primitive_bits_float" (( n -- x )) } - { "byte-array>bignum" "math" "primitive_byte_array_to_bignum" (( x -- y )) } { "double>bits" "math" "primitive_double_bits" (( x -- n )) } { "float>bits" "math" "primitive_float_bits" (( x -- n )) } { "(format-float)" "math.parser.private" "primitive_format_float" (( n format -- byte-array )) } diff --git a/core/io/binary/binary-tests.factor b/core/io/binary/binary-tests.factor index 82a8293082..3556e66631 100644 --- a/core/io/binary/binary-tests.factor +++ b/core/io/binary/binary-tests.factor @@ -1,6 +1,21 @@ USING: io.binary tools.test classes math ; IN: io.binary.tests +[ HEX: 03020100 ] [ B{ 0 1 2 3 } le> ] unit-test +[ HEX: 00010203 ] [ B{ 0 1 2 3 } be> ] unit-test + +[ HEX: 332211 ] [ + B{ HEX: 11 HEX: 22 HEX: 33 } le> +] unit-test + +[ HEX: 7a2c793b2ff08554 ] [ + B{ HEX: 54 HEX: 85 HEX: f0 HEX: 2f HEX: 3b HEX: 79 HEX: 2c HEX: 7a } le> +] unit-test + +[ HEX: 988a259c3433f237 ] [ + B{ HEX: 37 HEX: f2 HEX: 33 HEX: 34 HEX: 9c HEX: 25 HEX: 8a HEX: 98 } le> +] unit-test + [ B{ 0 0 4 HEX: d2 } ] [ 1234 4 >be ] unit-test [ B{ 0 0 0 0 0 0 4 HEX: d2 } ] [ 1234 8 >be ] unit-test [ B{ HEX: d2 4 0 0 } ] [ 1234 4 >le ] unit-test diff --git a/core/io/binary/binary.factor b/core/io/binary/binary.factor index 1275248613..5d416400e6 100644 --- a/core/io/binary/binary.factor +++ b/core/io/binary/binary.factor @@ -3,8 +3,8 @@ USING: kernel math sequences ; IN: io.binary -: le> ( seq -- x ) B{ } like byte-array>bignum >integer ; -: be> ( seq -- x ) le> ; +: le> ( seq -- x ) dup length iota 0 [ 8 * shift + ] 2reduce ; +: be> ( seq -- x ) 0 [ [ 8 shift ] dip + ] reduce ; : mask-byte ( x -- y ) HEX: ff bitand ; inline diff --git a/core/math/integers/integers-tests.factor b/core/math/integers/integers-tests.factor index 178bb544c1..c0f7a76d0a 100644 --- a/core/math/integers/integers-tests.factor +++ b/core/math/integers/integers-tests.factor @@ -181,18 +181,6 @@ unit-test [ 14 ] [ 13 2 align ] unit-test [ 11 ] [ 11 1 align ] unit-test -[ HEX: 332211 ] [ - B{ HEX: 11 HEX: 22 HEX: 33 } byte-array>bignum -] unit-test - -[ HEX: 7a2c793b2ff08554 ] [ - B{ HEX: 54 HEX: 85 HEX: f0 HEX: 2f HEX: 3b HEX: 79 HEX: 2c HEX: 7a } byte-array>bignum -] unit-test - -[ HEX: 988a259c3433f237 ] [ - B{ HEX: 37 HEX: f2 HEX: 33 HEX: 34 HEX: 9c HEX: 25 HEX: 8a HEX: 98 } byte-array>bignum -] unit-test - [ t ] [ 256 power-of-2? ] unit-test [ f ] [ 123 power-of-2? ] unit-test diff --git a/core/math/math-docs.factor b/core/math/math-docs.factor index 1449b46d76..cc5f2d43f7 100644 --- a/core/math/math-docs.factor +++ b/core/math/math-docs.factor @@ -429,10 +429,6 @@ HELP: find-last-integer { $description "Applies the quotation to each integer from " { $snippet "n" } " down to 0, inclusive. Iteration stops when the quotation outputs a true value or 0 is reached. If the quotation yields a true value for some integer, the word outputs that integer. Otherwise, the word outputs " { $link f } "." } { $notes "This word is used to implement " { $link find-last } "." } ; -HELP: byte-array>bignum -{ $values { "x" byte-array } { "y" bignum } } -{ $description "Converts a byte-array, interpreted as little-endian, into a bignum integer. User code should call " { $link le> } " or " { $link be> } " instead." } ; - ARTICLE: "division-by-zero" "Division by zero" "Behavior of division operations when a denominator of zero is used depends on the data types in question, as well as the platform being used." $nl diff --git a/extra/images/tiff/tiff.factor b/extra/images/tiff/tiff.factor index e79ed5f07d..c8a3f76353 100755 --- a/extra/images/tiff/tiff.factor +++ b/extra/images/tiff/tiff.factor @@ -281,7 +281,7 @@ ERROR: no-tag class ; ERROR: unknown-ifd-type n ; : bytes>bits ( n/byte-array -- n ) - dup byte-array? [ byte-array>bignum ] when ; + dup byte-array? [ le> ] when ; : value-length ( ifd-entry -- n ) [ count>> ] [ type>> ] bi { diff --git a/vm/bignum.cpp b/vm/bignum.cpp index adcfa6f4da..3f13a3396b 100755 --- a/vm/bignum.cpp +++ b/vm/bignum.cpp @@ -1714,41 +1714,4 @@ int factor_vm::bignum_unsigned_logbitp(int shift, bignum * bignum) return (digit & mask) ? 1 : 0; } -/* Allocates memory */ -bignum *factor_vm::digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int, factor_vm*), unsigned int radix, int negative_p) -{ - BIGNUM_ASSERT ((radix > 1) && (radix <= BIGNUM_RADIX_ROOT)); - if (n_digits == 0) - return (BIGNUM_ZERO ()); - if (n_digits == 1) - { - fixnum digit = ((fixnum) ((*producer) (0,this))); - return (fixnum_to_bignum (negative_p ? (- digit) : digit)); - } - { - bignum_length_type length; - { - unsigned int radix_copy = radix; - unsigned int log_radix = 0; - while (radix_copy > 0) - { - radix_copy >>= 1; - log_radix += 1; - } - /* This length will be at least as large as needed. */ - length = (BIGNUM_BITS_TO_DIGITS (n_digits * log_radix)); - } - { - bignum * result = (allot_bignum_zeroed (length, negative_p)); - while ((n_digits--) > 0) - { - bignum_destructive_scale_up (result, ((bignum_digit_type) radix)); - bignum_destructive_add - (result, ((bignum_digit_type) ((*producer) (n_digits,this)))); - } - return (bignum_trim (result)); - } - } -} - } diff --git a/vm/bignum.hpp b/vm/bignum.hpp index c6aaf447a4..cae2873f49 100644 --- a/vm/bignum.hpp +++ b/vm/bignum.hpp @@ -44,6 +44,4 @@ enum bignum_comparison bignum_comparison_greater = 1 }; -bignum * digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int,factor_vm*), unsigned int radix, int negative_p); - } diff --git a/vm/math.cpp b/vm/math.cpp index 4bc918ad66..bb18139246 100755 --- a/vm/math.cpp +++ b/vm/math.cpp @@ -224,13 +224,6 @@ unsigned int bignum_producer(unsigned int digit, factor_vm *parent) return parent->bignum_producer(digit); } -void factor_vm::primitive_byte_array_to_bignum() -{ - unsigned int n_digits = (unsigned int)array_capacity(untag_check(ctx->peek())); - bignum * result = digit_stream_to_bignum(n_digits,factor::bignum_producer,0x100,0); - ctx->replace(tag(result)); -} - cell factor_vm::unbox_array_size_slow() { if(tagged(ctx->peek()).type() == BIGNUM_TYPE) diff --git a/vm/primitives.hpp b/vm/primitives.hpp index 6f2cd6c4a9..e9965c2f3b 100644 --- a/vm/primitives.hpp +++ b/vm/primitives.hpp @@ -31,7 +31,6 @@ namespace factor _(bits_double) \ _(bits_float) \ _(byte_array) \ - _(byte_array_to_bignum) \ _(callback) \ _(callstack) \ _(callstack_bounds) \ diff --git a/vm/vm.hpp b/vm/vm.hpp index aab6864f20..3ee9937d8f 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -242,7 +242,6 @@ struct factor_vm bignum *bignum_integer_length(bignum * x); int bignum_logbitp(int shift, bignum * arg); int bignum_unsigned_logbitp(int shift, bignum * bignum); - bignum *digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int, factor_vm *), unsigned int radix, int negative_p); //data heap void init_card_decks(); @@ -455,7 +454,6 @@ struct factor_vm void primitive_bignum_bitp(); void primitive_bignum_log2(); unsigned int bignum_producer(unsigned int digit); - void primitive_byte_array_to_bignum(); inline cell unbox_array_size(); cell unbox_array_size_slow(); void primitive_fixnum_to_float(); From 4653df21cbca6be6eeb5f7ea58ec3f84ca0b1a70 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Tue, 11 Oct 2011 21:24:38 -0700 Subject: [PATCH 2/3] vm: remove math::bignum_producer. --- vm/math.cpp | 11 ----------- vm/vm.hpp | 1 - 2 files changed, 12 deletions(-) diff --git a/vm/math.cpp b/vm/math.cpp index bb18139246..ce8ac6eaf4 100755 --- a/vm/math.cpp +++ b/vm/math.cpp @@ -213,17 +213,6 @@ void factor_vm::primitive_bignum_log2() ctx->replace(tag(bignum_integer_length(untag(ctx->peek())))); } -unsigned int factor_vm::bignum_producer(unsigned int digit) -{ - unsigned char *ptr = (unsigned char *)alien_offset(ctx->peek()); - return *(ptr + digit); -} - -unsigned int bignum_producer(unsigned int digit, factor_vm *parent) -{ - return parent->bignum_producer(digit); -} - cell factor_vm::unbox_array_size_slow() { if(tagged(ctx->peek()).type() == BIGNUM_TYPE) diff --git a/vm/vm.hpp b/vm/vm.hpp index 3ee9937d8f..ed7f9bf6d0 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -453,7 +453,6 @@ struct factor_vm void primitive_bignum_not(); void primitive_bignum_bitp(); void primitive_bignum_log2(); - unsigned int bignum_producer(unsigned int digit); inline cell unbox_array_size(); cell unbox_array_size_slow(); void primitive_fixnum_to_float(); From 950f1e1c0494a5ae24981dad01cf4874383a7597 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Tue, 11 Oct 2011 22:31:21 -0700 Subject: [PATCH 3/3] random: be> is faster (and they are random anyway)... --- basis/random/random.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/random/random.factor b/basis/random/random.factor index 2b8d4c783b..f15cd8f9de 100644 --- a/basis/random/random.factor +++ b/basis/random/random.factor @@ -23,7 +23,7 @@ M: object random-bytes* ( n tuple -- byte-array ) [ 2drop ] [ random-32* 4 >le swap head append! ] if ] bi-curry bi* ; -M: object random-32* ( tuple -- r ) 4 swap random-bytes* le> ; +M: object random-32* ( tuple -- r ) 4 swap random-bytes* be> ; ERROR: no-random-number-generator ; @@ -41,7 +41,7 @@ M: f random-32* ( obj -- * ) no-random-number-generator ; : random-integer ( n -- n' ) dup log2 7 + 8 /i 1 + - [ random-bytes le> ] + [ random-bytes be> ] [ 3 shift 2^ ] bi / * >integer ; PRIVATE>