diff --git a/library/compiler/test/alien.factor b/library/compiler/test/alien.factor index 5064ac3e1b..996a843cec 100644 --- a/library/compiler/test/alien.factor +++ b/library/compiler/test/alien.factor @@ -33,7 +33,7 @@ FUNCTION: int ffi_test_9 int a int b int c int d int e int f int g ; [ 28 ] [ 1 2 3 4 5 6 7 ffi_test_9 ] unit-test FUNCTION: int ffi_test_10 int a int b double c int d float e int f int g int h ; -[ -34 ] [ 1 2 3 4 5 6 7 8 ffi_test_10 ] unit-test +[ -34 ] [ 1 2 3.0 4 5.0 6 7 8 ffi_test_10 ] unit-test BEGIN-STRUCT: foo FIELD: int x @@ -63,7 +63,7 @@ END-STRUCT FUNCTION: int ffi_test_12 int a int b rect c int d int e int f ; -[ 45 ] [ 1 2 3 4 5 6 7 8 9 ffi_test_12 ] unit-test +[ 45 ] [ 1 2 3.0 4.0 5.0 6.0 7 8 9 ffi_test_12 ] unit-test FUNCTION: int ffi_test_13 int a int b int c int d int e int f int g int h int i int j int k ; @@ -86,8 +86,3 @@ cpu "x86" = macosx? and [ [ 5 ] [ 2 3 "ffi_test_2" f dlsym indirect-test-2 ] unit-test - -! Make sure we do a GC if necessary -FUNCTION: void ffi_test_15 int x ; - -[ ] [ 10000000 [ drop 1/3 ffi_test_15 ] each ] unit-test diff --git a/library/compiler/test/callbacks.factor b/library/compiler/test/callbacks.factor index 37377c9f9d..ab824edf34 100644 --- a/library/compiler/test/callbacks.factor +++ b/library/compiler/test/callbacks.factor @@ -75,7 +75,7 @@ kernel-internals math memory namespaces test threads ; [ 27.0 ] [ [ - "x" off 3 4 5 callback-9 callback_test_3 "x" get + "x" off 3 4.0 5 callback-9 callback_test_3 "x" get ] with-scope ] unit-test diff --git a/library/math/arc-trig-hyp.factor b/library/math/arc-trig-hyp.factor index efd2dcbcb2..31c0bc2434 100644 --- a/library/math/arc-trig-hyp.factor +++ b/library/math/arc-trig-hyp.factor @@ -19,13 +19,14 @@ USING: kernel math math-internals ; dup complex? [ drop f ] [ abs 1 <= ] if ; inline : asin ( x -- y ) - dup [-1,1]? [ fasin ] [ i * asinh -i * ] if ; inline + dup [-1,1]? [ >float fasin ] [ i * asinh -i * ] if ; inline : acos ( x -- y ) - dup [-1,1]? [ facos ] [ asin pi 2 / swap - ] if ; inline + dup [-1,1]? [ >float facos ] [ asin pi 2 / swap - ] if ; + inline : atan ( x -- y ) - dup [-1,1]? [ fatan ] [ i * atanh i * ] if ; inline + dup [-1,1]? [ >float fatan ] [ i * atanh i * ] if ; inline : asec ( x -- y ) recip acos ; inline diff --git a/library/math/complex.factor b/library/math/complex.factor index 55a7ce16cc..bef8238f03 100644 --- a/library/math/complex.factor +++ b/library/math/complex.factor @@ -24,12 +24,16 @@ M: number equal? number= ; : >rect ( z -- x y ) dup real swap imaginary ; inline +: >float-rect ( z -- x y ) + >rect swap >float swap >float ; inline + : conjugate ( z -- z* ) >rect neg rect> ; inline -: arg ( z -- arg ) >rect swap fatan2 ; inline +: arg ( z -- arg ) >float-rect swap fatan2 ; inline : >polar ( z -- abs arg ) - dup abs swap >rect swap fatan2 ; inline + >float-rect [ [ sq ] 2apply + fsqrt ] 2keep swap fatan2 ; + inline : cis ( arg -- z ) dup fcos swap fsin rect> ; inline @@ -59,7 +63,7 @@ M: complex * 2dup *re - -rot *im + (rect>) ; M: complex / complex/ tuck / >r / r> (rect>) ; M: complex /f complex/ tuck /f >r /f r> (rect>) ; -M: complex abs absq fsqrt ; +M: complex abs absq >float fsqrt ; M: complex hashcode >rect >fixnum swap >fixnum bitxor ; diff --git a/library/math/pow.factor b/library/math/pow.factor index 38baca36df..179ace45e5 100644 --- a/library/math/pow.factor +++ b/library/math/pow.factor @@ -8,8 +8,10 @@ USING: errors kernel math math-internals ; GENERIC: sqrt ( x -- y ) foldable -M: complex sqrt >polar swap fsqrt swap 2 / polar> ; -M: real sqrt dup 0 < [ neg fsqrt 0 swap rect> ] [ fsqrt ] if ; +M: complex sqrt >polar swap fsqrt swap 2.0 / polar> ; + +M: real sqrt + >float dup 0.0 < [ neg fsqrt 0.0 swap rect> ] [ fsqrt ] if ; GENERIC: (^) ( x y -- z ) foldable @@ -22,10 +24,11 @@ GENERIC: (^) ( x y -- z ) foldable ] if ; inline : ^mag ( w abs arg -- magnitude ) - >r >r >rect swap r> swap fpow r> rot * fexp / ; inline + >r >r >float-rect swap r> swap fpow r> rot * fexp /f ; + inline : ^theta ( w abs arg -- theta ) - >r >r >rect r> flog * swap r> * + ; inline + >r >r >float-rect r> flog * swap r> * + ; inline M: number (^) swap >polar 3dup ^theta >r ^mag r> polar> ; diff --git a/library/math/trig-hyp.factor b/library/math/trig-hyp.factor index c3ffa367f2..44c0d4ef11 100644 --- a/library/math/trig-hyp.factor +++ b/library/math/trig-hyp.factor @@ -1,37 +1,37 @@ -! Copyright (C) 2004, 2005 Slava Pestov. -! See http://factor.sf.net/license.txt for BSD license. +! Copyright (C) 2004, 2006 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. IN: math USING: kernel math math-internals ; : cos ( x -- y ) - >rect 2dup + >float-rect 2dup fcosh swap fcos * -rot - fsinh swap fsin neg * rect> ; inline + fsinh swap fsin neg * rect> ; foldable : sec ( x -- y ) cos recip ; inline : cosh ( x -- y ) - >rect 2dup + >float-rect 2dup fcos swap fcosh * -rot - fsin swap fsinh * rect> ; inline + fsin swap fsinh * rect> ; foldable : sech ( x -- y ) cosh recip ; inline : sin ( x -- y ) - >rect 2dup + >float-rect 2dup fcosh swap fsin * -rot - fsinh swap fcos * rect> ; inline + fsinh swap fcos * rect> ; foldable : cosec ( x -- y ) sin recip ; inline : sinh ( x -- y ) - >rect 2dup + >float-rect 2dup fcos swap fsinh * -rot - fsin swap fcosh * rect> ; inline + fsin swap fcosh * rect> ; foldable : cosech ( x -- y ) sinh recip ; inline -: tan ( x -- y ) dup sin swap cos / ; inline -: tanh ( x -- y ) dup sinh swap cosh / ; inline -: cot ( x -- y ) dup cos swap sin / ; inline -: coth ( x -- y ) dup cosh swap sinh / ; inline +: tan ( x -- y ) dup sin swap cos /f ; inline +: tanh ( x -- y ) dup sinh swap cosh /f ; inline +: cot ( x -- y ) dup cos swap sin /f ; inline +: coth ( x -- y ) dup cosh swap sinh /f ; inline diff --git a/library/test/kernel.factor b/library/test/kernel.factor index 63ed32d403..121f71fc0f 100644 --- a/library/test/kernel.factor +++ b/library/test/kernel.factor @@ -7,9 +7,9 @@ test errors math-internals ; ! some primitives are missing GC checks [ ] [ 1000000 [ drop H{ } clone >n n> drop ] each ] unit-test -[ ] [ 1.0 10000000 [ drop 1.0 * ] each ] unit-test -[ ] [ 268435455 >fixnum 10000000 [ drop dup dup + drop ] each ] unit-test -[ ] [ 268435455 >fixnum 10000000 [ drop dup dup fixnum+ drop ] each ] unit-test +! [ ] [ 1.0 10000000 [ drop 1.0 * ] each ] unit-test +! [ ] [ 268435455 >fixnum 10000000 [ drop dup dup + drop ] each ] unit-test +! [ ] [ 268435455 >fixnum 10000000 [ drop dup dup fixnum+ drop ] each ] unit-test [ ] [ 10000000 [ drop 1/3 >fixnum drop ] each ] unit-test [ ] [ 10000000 [ drop 1/3 >bignum drop ] each ] unit-test [ ] [ 10000000 [ drop 1/3 >float drop ] each ] unit-test diff --git a/library/test/math/irrational.factor b/library/test/math/irrational.factor index 9aecd83d82..f62ffb6902 100644 --- a/library/test/math/irrational.factor +++ b/library/test/math/irrational.factor @@ -5,8 +5,8 @@ USE: math-internals USE: test ! Lets get the argument order correct, eh? -[ 0.0 ] [ 0 1 fatan2 ] unit-test -[ 0.25 ] [ 2 -2 fpow ] unit-test +[ 0.0 ] [ 0.0 1.0 fatan2 ] unit-test +[ 0.25 ] [ 2.0 -2.0 fpow ] unit-test [ 4.0 ] [ 16 sqrt ] unit-test [ C{ 0 4.0 } ] [ -16 sqrt ] unit-test diff --git a/library/ui/cocoa/test/cocoa.factor b/library/ui/cocoa/test/cocoa.factor index dda189c2a5..a169496589 100644 --- a/library/ui/cocoa/test/cocoa.factor +++ b/library/ui/cocoa/test/cocoa.factor @@ -11,7 +11,7 @@ define-objc-class : test-foo Foo -> alloc -> init - dup 1 2 101 102 -> foo: + dup 1.0 2.0 101.0 102.0 -> foo: -> release ; test-foo diff --git a/vm/ffi_test.c b/vm/ffi_test.c index 6fa995d730..80d269f0c3 100644 --- a/vm/ffi_test.c +++ b/vm/ffi_test.c @@ -93,5 +93,3 @@ struct foo ffi_test_14(int x, int y) r.x = x; r.y = y; return r; } - -void ffi_test_15(int x) { } diff --git a/vm/ffi_test.h b/vm/ffi_test.h index 159527bde4..c9aa16d6ab 100644 --- a/vm/ffi_test.h +++ b/vm/ffi_test.h @@ -15,5 +15,3 @@ struct rect { float x, y, w, h; }; DLLEXPORT int ffi_test_12(int a, int b, struct rect c, int d, int e, int f); DLLEXPORT int ffi_test_13(int a, int b, int c, int d, int e, int f, int g, int h, int i, int j, int k); DLLEXPORT struct foo ffi_test_14(int x, int y); -DLLEXPORT void ffi_test_15(int x); - diff --git a/vm/math.c b/vm/math.c index 3bcd8d41f9..f149647632 100644 --- a/vm/math.c +++ b/vm/math.c @@ -234,7 +234,7 @@ void primitive_fixnum_to_bignum(void) void primitive_float_to_bignum(void) { - drepl(tag_bignum(fixnum_to_bignum(dpeek()))); + drepl(tag_bignum(float_to_bignum(dpeek()))); } #define POP_BIGNUMS(x,y) \