]> gitweb.factorcode.org Git - factor.git/commitdiff
some bignum work
authorSlava Pestov <slava@factorcode.org>
Thu, 26 Aug 2004 00:51:19 +0000 (00:51 +0000)
committerSlava Pestov <slava@factorcode.org>
Thu, 26 Aug 2004 00:51:19 +0000 (00:51 +0000)
25 files changed:
TODO.FACTOR.txt
library/cross-compiler.factor
library/platform/jvm/sbuf.factor
library/platform/native/kernel.factor
library/platform/native/unparser.factor
library/sbuf.factor
library/test/benchmark/fac.factor [new file with mode: 0644]
library/test/benchmark/fib.factor
library/test/math/bignum.factor [new file with mode: 0644]
library/test/math/gcd.factor [new file with mode: 0644]
library/test/math/rational.factor
library/test/strings.factor
library/test/test.factor
library/vectors.factor
native/arithmetic.h
native/bignum.c
native/bignum.h
native/fixnum.c
native/float.c
native/primitives.c
native/primitives.h
native/s48_bignum.c
native/s48_bignumint.h
native/sbuf.c
native/sbuf.h

index 4eda8ac34eb2da72d93ce553315ef0ecc2c885a8..836ccd78b1e2707679df5f1509e7c5b2ea25a08b 100644 (file)
@@ -1,19 +1,16 @@
 + bignums:\r
 \r
-- -1 is broken, add a test to verify this in the future\r
-- gcd is broken\r
-- bignum/ is broken\r
 - change shift< and shift> to ash\r
-- gcd is broken\r
 - cached 0/-1/1 should be cross compiled in image\r
 - bignum cross compiling\r
-- upgrading fixnums does not work\r
+- upgrading fixnums does not work with shift</shift>\r
 - ash is inefficient: arg 2 is upgraded to bignum then back\r
   to long\r
 - move some s48_ functions into bignum.c\r
 - remove unused functions\r
-\r
+- clean up type coercions in arithmetic.c\r
 - add a socket timeout\r
+\r
 - >lower, >upper for strings\r
 - telnetd should use multitasking\r
 - accept multi-line input in listener\r
@@ -62,7 +59,6 @@
 + native:\r
 \r
 - is the profiler using correct stack depth?\r
-- bignums\r
 - read1\r
 - sbuf-hashcode\r
 - vector-hashcode\r
index a7a44fddc4d0f1210625ff61892f5613c5b7d007..24dabb7b1962233a080ae52668bba91041432040 100644 (file)
@@ -58,7 +58,7 @@ IN: strings
 DEFER: str=
 DEFER: str-hashcode
 DEFER: sbuf=
-DEFER: clone-sbuf
+DEFER: sbuf-clone
 
 IN: io-internals
 DEFER: port?
@@ -138,7 +138,8 @@ IN: cross-compiler
         set-sbuf-nth
         sbuf-append
         sbuf>str
-        clone-sbuf
+        sbuf-reverse
+        sbuf-clone
         sbuf=
         number?
         >fixnum
index a511ac927431d615909d0be75453c303a76fdf40..ea12ab098e27ec6963af87effcaaeb99587f29ec 100644 (file)
@@ -54,3 +54,7 @@ USE: stack
 
 : sbuf>str ( sbuf -- str )
     >str ;
+
+: sbuf-reverse ( sbuf -- )
+    #! Destructively reverse a string buffer.
+    [ ] "java.lang.StringBuffer" "reverse" jinvoke drop ;
index f194c5788f44402b268f3dff87ebdf6610c1b911..5441dbfa2bea6a652abb051d4c610862fb6966bc 100644 (file)
@@ -71,8 +71,8 @@ USE: vectors
 : clone ( obj -- obj )
     [
         [ cons? ] [ clone-list ]
-        [ vector? ] [ clone-vector ]
-        [ sbuf? ] [ clone-sbuf ]
+        [ vector? ] [ vector-clone ]
+        [ sbuf? ] [ sbuf-clone ]
         [ drop t ] [ ( return the object ) ]
     ] cond ;
 
index 46eb95fa572fedffeb391a762bb390c61abd29da..26d2129943b505dd86e9e966dba836b94e9e0e55 100644 (file)
@@ -39,19 +39,23 @@ USE: stdio
 USE: strings
 USE: words
 
-: integer% ( num -- )
-    "base" get /mod swap dup 0 > [
-        integer%
+: integer% ( num radix -- )
+    tuck /mod >digit % dup 0 > [
+        swap integer%
     ] [
-        drop
-    ] ifte >digit % ;
+        2drop
+    ] ifte ;
 
 : integer- ( num -- num )
     dup 0 < [ "-" % neg ] when ;
 
 : >base ( num radix -- string )
     #! Convert a number to a string in a certain base.
-    [ "base" set <% integer- integer% %> ] with-scope ;
+    <% dup 0 < [
+        neg integer% CHAR: - %
+    ] [
+        integer%
+    ] ifte reverse%> ;
 
 : >dec ( num -- string )
     #! Convert an integer to its decimal representation.
index 3ec6d4ebe6167a6c6adf31ba2c183c9b44fc6879..59bf76010295f1501adb34e62c7d968678e5afb1 100644 (file)
@@ -53,6 +53,11 @@ USE: stack
     #! stack.
     "string-buffer" get sbuf>str n> drop ;
 
+: reverse%> ( -- str )
+     #! Ends construction and pushes the *reversed*, constructed
+     #! text on the stack.
+     "string-buffer" get dup sbuf-reverse sbuf>str n> drop ;
+
 : fill ( count char -- string )
     #! Push a string that consists of the same character
     #! repeated.
diff --git a/library/test/benchmark/fac.factor b/library/test/benchmark/fac.factor
new file mode 100644 (file)
index 0000000..55d14f0
--- /dev/null
@@ -0,0 +1,6 @@
+IN: scratchpad
+USE: math
+USE: stack
+USE: test
+
+[ 30000 fac drop ] time
index 948d385e5c8d817908bc148e3348a05afe0ead92..9bcbc34b9175d05a25dda6c8ff0f31caae1e8e56 100644 (file)
@@ -1,5 +1,6 @@
 IN: scratchpad
 USE: math
+USE: stack
 USE: test
 
-[ 35 fib ] time
+[ 35 fib drop ] time
diff --git a/library/test/math/bignum.factor b/library/test/math/bignum.factor
new file mode 100644 (file)
index 0000000..cfb2fd1
--- /dev/null
@@ -0,0 +1,11 @@
+IN: scratchpad
+USE: arithmetic
+USE: stack
+USE: test
+USE: unparser
+
+[ -1 ] [ -1 >bignum >fixnum ] unit-test
+
+[ "8589934592" ]
+[ 134217728 dup + dup + dup + dup + dup + dup + unparse ]
+unit-test
diff --git a/library/test/math/gcd.factor b/library/test/math/gcd.factor
new file mode 100644 (file)
index 0000000..fd738e6
--- /dev/null
@@ -0,0 +1,21 @@
+IN: scratchpad
+USE: arithmetic
+USE: test
+
+[ 100 ] [ 100 100 gcd ] unit-test
+[ 100 ] [ 1000 100 gcd ] unit-test
+[ 100 ] [ 100 1000 gcd ] unit-test
+[ 4 ] [ 132 64 gcd ] unit-test
+[ 4 ] [ -132 64 gcd ] unit-test
+[ 4 ] [ -132 -64 gcd ] unit-test
+[ 4 ] [ 132 -64 gcd ] unit-test
+[ 4 ] [ -132 -64 gcd ] unit-test
+
+[ 100 ] [ 100 >bignum 100 >bignum gcd ] unit-test
+[ 100 ] [ 1000 >bignum 100 >bignum gcd ] unit-test
+[ 100 ] [ 100 >bignum 1000 >bignum gcd ] unit-test
+[ 4 ] [ 132 >bignum 64 >bignum gcd ] unit-test
+[ 4 ] [ -132 >bignum 64 >bignum gcd ] unit-test
+[ 4 ] [ -132 >bignum -64 >bignum gcd ] unit-test
+[ 4 ] [ 132 >bignum -64 >bignum gcd ] unit-test
+[ 4 ] [ -132 >bignum -64 >bignum gcd ] unit-test
index 988d19dd5e9495c04da181a1752c5355896b71c9..0cc14158e3d2c88e3af829810bcf52ba6a9d7e4c 100644 (file)
@@ -76,12 +76,3 @@ USE: test
 [ t ]
 [ 1000000000000/999999999999 1000000000001/999999999998 < ]
 unit-test
-
-[ 100 ] [ 100 100 gcd ] unit-test
-[ 100 ] [ 1000 100 gcd ] unit-test
-[ 100 ] [ 100 1000 gcd ] unit-test
-[ 4 ] [ 132 64 gcd ] unit-test
-[ 4 ] [ -132 64 gcd ] unit-test
-[ 4 ] [ -132 -64 gcd ] unit-test
-[ 4 ] [ 132 -64 gcd ] unit-test
-[ 4 ] [ -132 -64 gcd ] unit-test
index 75a312c470cf4fa11b5a44757d6ba2f57fc75106..86084eae6e1693eb29732e0438af3a5cafe71b55 100644 (file)
@@ -3,6 +3,7 @@ USE: arithmetic
 USE: combinators
 USE: kernel
 USE: namespaces
+USE: stack
 USE: strings
 USE: test
 
@@ -82,6 +83,9 @@ unit-test
 [ t ] [ "abc" "abd" str-compare 0 < ] unit-test
 [ t ] [ "z" "abd" str-compare 0 > ] unit-test
 
+[ "fedcba" ] [ "abcdef" str>sbuf dup sbuf-reverse sbuf>str ] unit-test
+[ "edcba" ] [ "abcde" str>sbuf dup sbuf-reverse sbuf>str ] unit-test
+
 native? [
     [ t ] [ "Foo" str>sbuf "Foo" str>sbuf = ] unit-test
     [ f ] [ "Foo" str>sbuf "Foob" str>sbuf = ] unit-test
index d347b015fbabfed7de7f6110a5aeffaeccc8468b..b250cea605e4c25eb74823e35de7fb4653d249f5 100644 (file)
@@ -83,7 +83,9 @@ USE: unparser
         "words"
         "unparser"
         "random"
+        "math/bignum"
         "math/bitops"
+        "math/gcd"
         "math/rational"
         "math/float"
         "math/complex"
index 48d861079ebc948f8009b5ea877a80eec9018b33..058a3c7d79d661d00f2bb67f646b32f01c6168fb 100644 (file)
@@ -62,6 +62,6 @@ USE: stack
 
 DEFER: vector-map
 
-: clone-vector ( vector -- vector )
+: vector-clone ( vector -- vector )
     #! Shallow copy of a vector.
     [ ] vector-map ;
index f5abd94f0abcfe83c25e61cafca6b1169822cda0..63ffe38d55b55f3aad5990771405fa885dcae966 100644 (file)
@@ -11,17 +11,10 @@ FLOAT* ratio_to_float(CELL n);
 
 #define CELL_TO_INTEGER(result) \
        FIXNUM _result = (result); \
-       /* if(_result < FIXNUM_MIN || _result > FIXNUM_MAX) \
-               return tag_object(fixnum_to_bignum(_result)); \
+       if(_result < FIXNUM_MIN || _result > FIXNUM_MAX) \
+               return tag_object(s48_long_to_bignum(_result)); \
        else \
-                */return tag_fixnum(_result);
-
-#define BIGNUM_2_TO_INTEGER(result) \
-        BIGNUM_2 _result = (result); \
-        /* if(_result < FIXNUM_MIN || _result > FIXNUM_MAX) \
-                return tag_object(s48_long_to_bignum(_result)); \
-        else \
-                 */return tag_fixnum(_result);
+               return tag_fixnum(_result);
 
 #define BINARY_OP(OP) \
 CELL OP(CELL x, CELL y) \
index f62a06125b254e4e1f909701774de2ad02d41412..d7ce2e7c97b4b2f313673127bbbeaf688bdaed94 100644 (file)
@@ -7,7 +7,7 @@ void init_bignum(void)
        bignum_pos_one = bignum_allocate(1,0);
        (BIGNUM_REF (bignum_pos_one, 0)) = 1;
 
-       bignum_neg_one = bignum_allocate(1,0);
+       bignum_neg_one = bignum_allocate(1,1);
        (BIGNUM_REF (bignum_neg_one, 0)) = 1;
 }
 
@@ -64,16 +64,16 @@ CELL multiply_bignum(ARRAY* x, ARRAY* y)
        return tag_object(s48_bignum_multiply(x,y));
 }
 
-BIGNUM_2 gcd_bignum(BIGNUM_2 x, BIGNUM_2 y)
+CELL gcd_bignum(ARRAY* x, ARRAY* y)
 {
-       BIGNUM_2 t;
+       ARRAY* t;
 
-       if(x < 0)
-               x = -x;
-       if(y < 0)
-               y = -y;
+       if(BIGNUM_NEGATIVE_P(x))
+               x = s48_bignum_negate(x);
+       if(BIGNUM_NEGATIVE_P(y))
+               y = s48_bignum_negate(y);
 
-       if(x > y)
+       if(s48_bignum_compare(x,y) == bignum_comparison_greater)
        {
                t = x;
                x = y;
@@ -82,10 +82,10 @@ BIGNUM_2 gcd_bignum(BIGNUM_2 x, BIGNUM_2 y)
 
        for(;;)
        {
-               if(x == 0)
-                       return y;
+               if(BIGNUM_ZERO_P(x))
+                       return tag_object(y);
 
-               t = y % x;
+               t = s48_bignum_remainder(y,x);
                y = x;
                x = t;
        }
@@ -93,37 +93,29 @@ BIGNUM_2 gcd_bignum(BIGNUM_2 x, BIGNUM_2 y)
 
 CELL divide_bignum(ARRAY* x, ARRAY* y)
 {
-       /* BIGNUM_2 _x = x->n;
-       BIGNUM_2 _y = y->n;
-       BIGNUM_2 gcd;
+       ARRAY* gcd;
 
-       if(_y == 0)
-       {
-               /* FIXME
-               abort();
-       }
-       else if(_y < 0)
-       {
-               _x = -_x;
-               _y = -_y;
-       }
+       if(BIGNUM_ZERO_P(y))
+               raise(SIGFPE);
 
-       gcd = gcd_bignum(_x,_y);
-       if(gcd != 1)
+       if(BIGNUM_NEGATIVE_P(y))
        {
-               _x /= gcd;
-               _y /= gcd;
+               x = s48_bignum_negate(x);
+               y = s48_bignum_negate(y);
        }
 
-       if(_y == 1)
-               return tag_object(bignum(_x));
+       gcd = (ARRAY*)UNTAG(gcd_bignum(x,y));
+       x = s48_bignum_quotient(x,gcd);
+       y = s48_bignum_quotient(y,gcd);
+
+       if(BIGNUM_ONE_P(y,0))
+               return tag_object(x);
        else
        {
                return tag_ratio(ratio(
-                       tag_object(bignum(_x)),
-                       tag_object(bignum(_y))));
-       } */
-       return F;
+                       tag_object(x),
+                       tag_object(y)));
+       }
 }
 
 CELL divint_bignum(ARRAY* x, ARRAY* y)
index f57082842c6077e47ecd9361a5aacd728d15dcb6..0fa23f4a31ebfb9c3401c08f9b1cd40ffa16a1ad 100644 (file)
@@ -1,5 +1,3 @@
-typedef long long BIGNUM_2;
-
 INLINE ARRAY* untag_bignum(CELL tagged)
 {
        type_check(BIGNUM_TYPE,tagged);
@@ -18,7 +16,7 @@ CELL number_eq_bignum(ARRAY* x, ARRAY* y);
 CELL add_bignum(ARRAY* x, ARRAY* y);
 CELL subtract_bignum(ARRAY* x, ARRAY* y);
 CELL multiply_bignum(ARRAY* x, ARRAY* y);
-BIGNUM_2 gcd_bignum(BIGNUM_2 x, BIGNUM_2 y);
+CELL gcd_bignum(ARRAY* x, ARRAY* y);
 CELL divide_bignum(ARRAY* x, ARRAY* y);
 CELL divint_bignum(ARRAY* x, ARRAY* y);
 CELL divfloat_bignum(ARRAY* x, ARRAY* y);
index 041925e57eb2f08883b7512ce75f2aee519b06d2..2c6703b3f175fe778820d12d40a862ce99e1f610 100644 (file)
@@ -48,10 +48,19 @@ CELL subtract_fixnum(CELL x, CELL y)
        CELL_TO_INTEGER(untag_fixnum_fast(x) - untag_fixnum_fast(y));
 }
 
-CELL multiply_fixnum(CELL x, CELL y)
+CELL multiply_fixnum(CELL _x, CELL _y)
 {
-       BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x)
-               * (BIGNUM_2)untag_fixnum_fast(y));
+       FIXNUM x = untag_fixnum_fast(_x);
+       FIXNUM y = untag_fixnum_fast(_y);
+       long long result = (long long)x * (long long)y;
+       if(result < FIXNUM_MIN || result > FIXNUM_MAX)
+       {
+               return tag_object(s48_bignum_multiply(
+                       s48_long_to_bignum(x),
+                       s48_long_to_bignum(y)));
+       }
+       else
+               return tag_fixnum(result);
 }
 
 CELL divint_fixnum(CELL x, CELL y)
@@ -117,10 +126,7 @@ CELL divide_fixnum(CELL x, CELL y)
        FIXNUM gcd;
 
        if(_y == 0)
-       {
-               /* FIXME */
-               abort();
-       }
+               raise(SIGFPE);
        else if(_y < 0)
        {
                _x = -_x;
@@ -157,14 +163,16 @@ CELL xor_fixnum(CELL x, CELL y)
 
 CELL shiftleft_fixnum(CELL x, CELL y)
 {
-       BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x)
-               << (BIGNUM_2)untag_fixnum_fast(y));
+       /* BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x)
+               << (BIGNUM_2)untag_fixnum_fast(y)); */
+       return F;
 }
 
 CELL shiftright_fixnum(CELL x, CELL y)
 {
-       BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x)
-               >> (BIGNUM_2)untag_fixnum_fast(y));
+       /* BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x)
+               >> (BIGNUM_2)untag_fixnum_fast(y)); */
+       return F;
 }
 
 CELL less_fixnum(CELL x, CELL y)
index 22e34dc31d141c9ee220707739ff14587244b91e..766d1bd04a27836ad0ffc90301ee92a13cac0b54 100644 (file)
@@ -50,7 +50,7 @@ void primitive_float_to_str(void)
 void primitive_float_to_bits(void)
 {
        double f = untag_float(dpeek());
-       BIGNUM_2 f_raw = *(BIGNUM_2*)&f;
+       long long f_raw = *(long long*)&f;
        drepl(tag_object(s48_long_to_bignum(f_raw)));
 }
 
index 57b553afef658996a8cc45f112984a08b102e749..489417f97322b87cb5c86554d8f44882b7178782 100644 (file)
@@ -34,7 +34,8 @@ XT primitives[] = {
        primitive_set_sbuf_nth,
        primitive_sbuf_append,
        primitive_sbuf_to_string,
-       primitive_clone_sbuf,
+       primitive_sbuf_reverse,
+       primitive_sbuf_clone,
        primitive_sbuf_eq,
        primitive_numberp,
        primitive_to_fixnum,
index 9990a9d11ebe2ee9c1cf058d020ac954e1329d3b..e9789ccce84c2d3d3982ba2fcb1a0791758a6eb5 100644 (file)
@@ -1,4 +1,4 @@
 extern XT primitives[];
-#define PRIMITIVE_COUNT 141
+#define PRIMITIVE_COUNT 142
 
 CELL primitive_to_xt(CELL primitive);
index c93d807f3ea0fa492dd44a3f881b329b1488789c..a273e76bc6ae5ddb272ba15b0062b1e4282918d3 100644 (file)
@@ -259,7 +259,10 @@ bignum_type
 s48_bignum_quotient(bignum_type numerator, bignum_type denominator)
 {
   if (BIGNUM_ZERO_P (denominator))
-    return (BIGNUM_OUT_OF_BAND);
+    {
+      raise(SIGFPE);
+      return (BIGNUM_OUT_OF_BAND);
+    }
   if (BIGNUM_ZERO_P (numerator))
     return (BIGNUM_MAYBE_COPY (numerator));
   {
@@ -308,7 +311,10 @@ bignum_type
 s48_bignum_remainder(bignum_type numerator, bignum_type denominator)
 {
   if (BIGNUM_ZERO_P (denominator))
-    return (BIGNUM_OUT_OF_BAND);
+    {
+      raise(SIGFPE);
+      return (BIGNUM_OUT_OF_BAND);
+    }
   if (BIGNUM_ZERO_P (numerator))
     return (BIGNUM_MAYBE_COPY (numerator));
   switch (bignum_compare_unsigned (numerator, denominator))
index 743bc465e09360d117d7a95569c42824047584ed..5593926da413fc3c4d6a0c25b308e242f18cbdf5 100644 (file)
@@ -104,7 +104,9 @@ extern ARRAY* shrink_array(ARRAY* array, CELL capacity);
    0, 1, and -1. */
 #define BIGNUM_ZERO() bignum_zero
 #define BIGNUM_ONE(neg_p) \
-   (neg_p ? bignum_pos_one : bignum_neg_one)
+   (neg_p ? bignum_neg_one : bignum_pos_one)
+
+#define BIGNUM_ONE_P(bignum,negative_p) ((bignum) == BIGNUM_ONE(negative_p))
 
 #define HD_LOW(digit) ((digit) & BIGNUM_HALF_DIGIT_MASK)
 #define HD_HIGH(digit) ((digit) >> BIGNUM_HALF_DIGIT_LENGTH)
index 9a90008f170e7c398d3ea4e3d99610e7983601c0..f4d5862d87d15bbe2259a29eef87e06c4eb7202e 100644 (file)
@@ -114,7 +114,22 @@ void primitive_sbuf_to_string(void)
        drepl(tag_object(sbuf_to_string(untag_sbuf(dpeek()))));
 }
 
-void primitive_clone_sbuf(void)
+void primitive_sbuf_reverse(void)
+{
+       SBUF* sbuf = untag_sbuf(dpop());
+       int i, j;
+       CHAR ch1, ch2;
+       for(i = 0; i < sbuf->top / 2; i++)
+       {
+               j = sbuf->top - i - 1;
+               ch1 = string_nth(sbuf->string,i);
+               ch2 = string_nth(sbuf->string,j);
+               set_string_nth(sbuf->string,j,ch1);
+               set_string_nth(sbuf->string,i,ch2);
+       }
+}
+
+void primitive_sbuf_clone(void)
 {
        SBUF* s = untag_sbuf(dpeek());
        SBUF* new_s = sbuf(s->top);
index d5ba1cb6e032fbcbfe99b906f8ba21f78e7289f6..782b6ccff2f5cf28ccea35d26ec95ceb54733454 100644 (file)
@@ -27,7 +27,8 @@ void sbuf_append_string(SBUF* sbuf, STRING* string);
 void primitive_sbuf_append(void);
 STRING* sbuf_to_string(SBUF* sbuf);
 void primitive_sbuf_to_string(void);
-void primitive_clone_sbuf(void);
+void primitive_sbuf_reverse(void);
+void primitive_sbuf_clone(void);
 bool sbuf_eq(SBUF* s1, SBUF* s2);
 void primitive_sbuf_eq(void);
 void fixup_sbuf(SBUF* sbuf);