Merge pull request #250 from mrjbq7/binary

io.binary: make le> and be> faster (20% and 75%, respectively).

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 >byte-array byte-array>bignum ]
+    [ random-bytes be> ]
     [ 3 shift 2^ ] bi / * >integer ;
 
 PRIVATE>

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

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 )) }

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

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 ;
+: le> ( seq -- x ) dup length iota 0 [ 8 * shift + ] 2reduce ;
-: be> ( seq -- x ) <reversed> le> ;
+: be> ( seq -- x ) 0 [ [ 8 shift ] dip + ] reduce ;
 
 : mask-byte ( x -- y ) HEX: ff bitand ; inline
 

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
 

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

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 {

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));
-		}
-	}
-}
-
 }

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);
-
 }

vm/math.cpp

@@ -213,24 +213,6 @@ void factor_vm::primitive_bignum_log2()
 	ctx->replace(tag<bignum>(bignum_integer_length(untag<bignum>(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);
-}
-
-void factor_vm::primitive_byte_array_to_bignum()
-{
-	unsigned int n_digits = (unsigned int)array_capacity(untag_check<byte_array>(ctx->peek()));
-	bignum * result = digit_stream_to_bignum(n_digits,factor::bignum_producer,0x100,0);
-	ctx->replace(tag<bignum>(result));
-}
-
 cell factor_vm::unbox_array_size_slow()
 {
 	if(tagged<object>(ctx->peek()).type() == BIGNUM_TYPE)

vm/primitives.hpp

@@ -31,7 +31,6 @@ namespace factor
 	_(bits_double) \
 	_(bits_float) \
 	_(byte_array) \
-	_(byte_array_to_bignum) \
 	_(callback) \
 	_(callstack) \
 	_(callstack_bounds) \

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();
@@ -454,8 +453,6 @@ struct factor_vm
 	void primitive_bignum_not();
 	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();