diff --git a/basis/hints/hints.factor b/basis/hints/hints.factor index dc16cf8b24..abfb3199a2 100644 --- a/basis/hints/hints.factor +++ b/basis/hints/hints.factor @@ -3,9 +3,9 @@ USING: accessors arrays assocs byte-arrays byte-vectors classes combinators definitions effects fry generic generic.single generic.standard hashtables io.binary io.encodings -io.streams.string kernel kernel.private math -math.integers.private math.parser namespaces parser sbufs -sequences splitting splitting.private strings vectors words ; +io.streams.string kernel kernel.private math math.parser +namespaces parser sbufs sequences splitting splitting.private +strings vectors words ; IN: hints GENERIC: specializer-predicate ( spec -- quot ) @@ -130,6 +130,4 @@ M\ hashtable at* { { fixnum object } { word object } } "specializer" set-word-pr M\ hashtable set-at { { object fixnum object } { object word object } } "specializer" set-word-prop -\ bignum/f { { bignum bignum } { bignum fixnum } { fixnum bignum } { fixnum fixnum } } "specializer" set-word-prop - \ encode-string { string object object } "specializer" set-word-prop diff --git a/basis/specialized-arrays/specialized-arrays-docs.factor b/basis/specialized-arrays/specialized-arrays-docs.factor index 722dff6d91..4572a188a2 100644 --- a/basis/specialized-arrays/specialized-arrays-docs.factor +++ b/basis/specialized-arrays/specialized-arrays-docs.factor @@ -41,7 +41,7 @@ ARTICLE: "specialized-array-words" "Specialized array words" { { $snippet "T-array" } { "The class of arrays with elements of type " { $snippet "T" } } } { { $snippet "" } { "Constructor for arrays with elements of type " { $snippet "T" } "; stack effect " { $snippet "( len -- array )" } } } { { $snippet "(T-array)" } { "Constructor for arrays with elements of type " { $snippet "T" } ", where the initial contents are uninitialized; stack effect " { $snippet "( len -- array )" } } } - { { $snippet "malloc-T-array" } { "Constructor for arrays with elements of type " { $snippet "T" } " backed by newly-allocated unmanaged memory; stack effect " { $snippet "( alien len -- array )" } } } + { { $snippet "malloc-T-array" } { "Constructor for arrays with elements of type " { $snippet "T" } " backed by newly-allocated, zeroed out, unmanaged memory; stack effect " { $snippet "( len -- array )" } } } { { $snippet "" } { "Constructor for arrays with elements of type " { $snippet "T" } " backed by raw memory; stack effect " { $snippet "( alien len -- array )" } } } { { $snippet "T-array-cast" } { "Converts a byte array into a specialized array by interpreting the bytes in as machine-specific values. Code which uses this word is unportable" } } { { $snippet ">T-array" } { "Converts a sequence into a specialized array of type " { $snippet "T" } "; stack effect " { $snippet "( seq -- array )" } } } diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index 47e882f227..43bff4e96a 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -338,7 +338,6 @@ M: object infer-call* \ call bad-macro-input ; \ bignum> { bignum bignum } { object } define-primitive \ bignum> make-foldable \ bignum>= { bignum bignum } { object } define-primitive \ bignum>= make-foldable \ bignum>fixnum { bignum } { fixnum } define-primitive \ bignum>fixnum make-foldable -\ bignum>float { bignum } { float } define-primitive \ bignum>float make-foldable \ 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 diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 8e3af26932..90b48c6a37 100755 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -491,7 +491,6 @@ tuple { "bignum>" "math.private" "primitive_bignum_greater" (( x y -- ? )) } { "bignum>=" "math.private" "primitive_bignum_greatereq" (( x y -- ? )) } { "bignum>fixnum" "math.private" "primitive_bignum_to_fixnum" (( x -- y )) } - { "bignum>float" "math.private" "primitive_bignum_to_float" (( x -- y )) } { "fixnum-shift" "math.private" "primitive_fixnum_shift" (( x y -- z )) } { "fixnum/i" "math.private" "primitive_fixnum_divint" (( x y -- z )) } { "fixnum/mod" "math.private" "primitive_fixnum_divmod" (( x y -- z w )) } diff --git a/core/math/floats/floats.factor b/core/math/floats/floats.factor index 45fce36ee6..49e5ec30cc 100644 --- a/core/math/floats/floats.factor +++ b/core/math/floats/floats.factor @@ -7,9 +7,6 @@ IN: math.floats.private : float-min ( x y -- z ) [ float< ] most ; foldable : float-max ( x y -- z ) [ float> ] most ; foldable -M: fixnum >float fixnum>float ; inline -M: bignum >float bignum>float ; inline - M: float >fixnum float>fixnum ; inline M: float >bignum float>bignum ; inline M: float >float ; inline diff --git a/core/math/integers/integers.factor b/core/math/integers/integers.factor index 22fe01f1ab..eded605ddd 100644 --- a/core/math/integers/integers.factor +++ b/core/math/integers/integers.factor @@ -14,6 +14,7 @@ M: integer denominator drop 1 ; inline M: fixnum >fixnum ; inline M: fixnum >bignum fixnum>bignum ; inline M: fixnum >integer ; inline +M: fixnum >float fixnum>float ; inline M: fixnum hashcode* nip ; inline M: fixnum equal? over bignum? [ >bignum bignum= ] [ 2drop f ] if ; inline @@ -37,16 +38,6 @@ M: fixnum - fixnum- ; inline M: fixnum * fixnum* ; inline M: fixnum /i fixnum/i ; inline -DEFER: bignum/f -CONSTANT: bignum/f-threshold HEX: 20,0000,0000,0000 - -: fixnum/f ( m n -- m/n ) - [ >float ] bi@ float/f ; inline - -M: fixnum /f - 2dup [ abs bignum/f-threshold >= ] either? - [ bignum/f ] [ fixnum/f ] if ; inline - M: fixnum mod fixnum-mod ; inline M: fixnum /mod fixnum/mod ; inline @@ -130,15 +121,12 @@ M: bignum (log2) bignum-log2 ; inline [ /mod ] dip ; inline ! Third step: post-scaling -: unscaled-float ( mantissa -- n ) - 52 2^ 1 - bitand 1022 52 shift bitor bits>double ; inline - -: scale-float ( mantissa scale -- float' ) - dup 0 < [ neg 2^ recip ] [ 2^ ] if * ; inline +: scaled-float ( mantissa scale -- n ) + [ 52 2^ 1 - bitand ] dip 1022 + 52 shift bitor bits>double ; inline : post-scale ( mantissa scale -- n ) [ 2/ ] dip over log2 52 > [ [ 2/ ] [ 1 + ] bi* ] when - [ unscaled-float ] dip scale-float ; inline + scaled-float ; inline : round-to-nearest ( fraction-and-guard rem -- fraction-and-guard' ) over odd? @@ -157,7 +145,21 @@ M: bignum (log2) bignum-log2 ; inline ] if ; inline : bignum/f ( m n -- f ) - [ [ abs ] bi@ /f-abs ] [ [ 0 < ] bi@ xor ] 2bi [ neg ] when ; + [ [ abs ] bi@ /f-abs ] [ [ 0 < ] bi@ xor ] 2bi [ neg ] when ; inline -M: bignum /f ( m n -- f ) - bignum/f ; +M: bignum /f ( m n -- f ) { bignum bignum } declare bignum/f ; + +CONSTANT: bignum/f-threshold HEX: 20,0000,0000,0000 + +: fixnum/f ( m n -- m/n ) + [ >float ] bi@ float/f ; inline + +M: fixnum /f + { fixnum fixnum } declare + 2dup [ abs bignum/f-threshold >= ] either? + [ bignum/f ] [ fixnum/f ] if ; inline + +: bignum>float ( bignum -- float ) + { bignum } declare 1 >bignum bignum/f ; + +M: bignum >float bignum>float ; inline diff --git a/core/math/math.factor b/core/math/math.factor index bc7658feba..e8f2813a95 100644 --- a/core/math/math.factor +++ b/core/math/math.factor @@ -59,11 +59,7 @@ PRIVATE> ERROR: log2-expects-positive x ; : log2 ( x -- n ) - dup 0 <= [ - log2-expects-positive - ] [ - (log2) - ] if ; inline + dup 0 <= [ log2-expects-positive ] [ (log2) ] if ; inline : zero? ( x -- ? ) 0 number= ; inline : 2/ ( x -- y ) -1 shift ; inline @@ -74,8 +70,8 @@ ERROR: log2-expects-positive x ; : ?1+ ( x -- y ) [ 1 + ] [ 0 ] if* ; inline : rem ( x y -- z ) abs [ mod ] [ + ] [ mod ] tri ; foldable : 2^ ( n -- 2^n ) 1 swap shift ; inline -: even? ( n -- ? ) 1 bitand zero? ; -: odd? ( n -- ? ) 1 bitand 1 number= ; +: even? ( n -- ? ) 1 bitand zero? ; inline +: odd? ( n -- ? ) 1 bitand 1 number= ; inline : if-zero ( ..a n quot1: ( ..a -- ..b ) quot2: ( ..a n -- ..b ) -- ..b ) [ dup zero? ] [ [ drop ] prepose ] [ ] tri* if ; inline diff --git a/vm/bignum.cpp b/vm/bignum.cpp index 47896340cd..adcfa6f4da 100755 --- a/vm/bignum.cpp +++ b/vm/bignum.cpp @@ -381,25 +381,11 @@ FOO_TO_BIGNUM(ulong_long,u64,s64,u64) } \ } -BIGNUM_TO_FOO(cell,cell,fixnum,cell); -BIGNUM_TO_FOO(fixnum,fixnum,fixnum,cell); +BIGNUM_TO_FOO(cell,cell,fixnum,cell) +BIGNUM_TO_FOO(fixnum,fixnum,fixnum,cell) BIGNUM_TO_FOO(long_long,s64,s64,u64) BIGNUM_TO_FOO(ulong_long,u64,s64,u64) -double factor_vm::bignum_to_double(bignum * bignum) -{ - if (BIGNUM_ZERO_P (bignum)) - return (0); - { - double accumulator = 0; - bignum_digit_type * start = (BIGNUM_START_PTR (bignum)); - bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum))); - while (start < scan) - accumulator = ((accumulator * BIGNUM_RADIX) + (*--scan)); - return ((BIGNUM_NEGATIVE_P (bignum)) ? (-accumulator) : accumulator); - } -} - #define DTB_WRITE_DIGIT(factor) \ { \ significand *= (factor); \ diff --git a/vm/math.cpp b/vm/math.cpp index 67cab3570d..4bc918ad66 100755 --- a/vm/math.cpp +++ b/vm/math.cpp @@ -255,11 +255,6 @@ void factor_vm::primitive_fixnum_to_float() ctx->replace(allot_float(fixnum_to_float(ctx->peek()))); } -void factor_vm::primitive_bignum_to_float() -{ - ctx->replace(allot_float(bignum_to_float(ctx->peek()))); -} - void factor_vm::primitive_format_float() { byte_array *array = allot_byte_array(100); diff --git a/vm/math.hpp b/vm/math.hpp index ffe60dced5..62c007be8d 100644 --- a/vm/math.hpp +++ b/vm/math.hpp @@ -33,11 +33,6 @@ inline bignum *factor_vm::float_to_bignum(cell tagged) return double_to_bignum(untag_float(tagged)); } -inline double factor_vm::bignum_to_float(cell tagged) -{ - return bignum_to_double(untag(tagged)); -} - inline double factor_vm::untag_float(cell tagged) { return untag(tagged)->n; diff --git a/vm/primitives.hpp b/vm/primitives.hpp index ce40ca0a7e..573f91b072 100644 --- a/vm/primitives.hpp +++ b/vm/primitives.hpp @@ -27,7 +27,6 @@ namespace factor _(bignum_shift) \ _(bignum_subtract) \ _(bignum_to_fixnum) \ - _(bignum_to_float) \ _(bignum_xor) \ _(bits_double) \ _(bits_float) \ diff --git a/vm/vm.hpp b/vm/vm.hpp index f940bd5937..38eb5033d7 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -192,7 +192,6 @@ struct factor_vm fixnum bignum_to_fixnum(bignum * bignum); s64 bignum_to_long_long(bignum * bignum); u64 bignum_to_ulong_long(bignum * bignum); - double bignum_to_double(bignum * bignum); bignum *double_to_bignum(double x); int bignum_equal_p_unsigned(bignum * x, bignum * y); enum bignum_comparison bignum_compare_unsigned(bignum * x, bignum * y); @@ -457,7 +456,6 @@ struct factor_vm inline cell unbox_array_size(); cell unbox_array_size_slow(); void primitive_fixnum_to_float(); - void primitive_bignum_to_float(); void primitive_format_float(); void primitive_float_eq(); void primitive_float_add(); @@ -487,7 +485,6 @@ struct factor_vm inline cell from_unsigned_cell(cell x); inline cell allot_float(double n); inline bignum *float_to_bignum(cell tagged); - inline double bignum_to_float(cell tagged); inline double untag_float(cell tagged); inline double untag_float_check(cell tagged); inline fixnum float_to_fixnum(cell tagged);