PPC inline allocators almost working

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index ac4a79403f036047427a69ee3965aada33537fec..642260345ad2c7eff4324e920c620006a3adf79c 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -7,10 +7,14 @@
 - amd64 structs-by-value bug
 - callback scheduling issue
 - sometimes fep when closing window
-- %allot-bignum-signed-2: handle carry in negation
 - x86: load-allot-ptr doesn't have a stack effect? why?
 - mov 0x0(%esi),%ecx  why?
 - mac intel: perhaps its not a good idea using ebx as allot-tmp-reg
+- RNG is broken
+- gdb triggered 'interrupted system call' error
+- fdasfsdfsa :help -- weird
+- %allot-bignum-signed-2 still has issues on ppc
+- fix %allot-bignum-signed-1/2 on x86
 
 + ui:
 

diff --git a/library/compiler/ppc/allot.factor b/library/compiler/ppc/allot.factor
index 780ae975146c594257a7512e993fcc3e16019372..c79a04f1f5eb5d4dd512577effd589af251a08b9 100644 (file)
--- a/library/compiler/ppc/allot.factor
+++ b/library/compiler/ppc/allot.factor
@@ -34,12 +34,13 @@ M: float-regs (%replace)
     #! 1 cell header, 1 cell length, 1 cell sign, + digits
     #! length is the # of digits + sign
     bignum-tag over 3 + cells %allot
-    1 + tag-bits shift 12 LI ! compute the length
+    1+ tag-bits shift 12 LI ! compute the length
     12 11 cell STW ! store the length
     ;
 
 : %allot-bignum-signed-1 ( reg -- )
-    #! on entry, reg is a signed 32-bit quantity
+    #! on entry, reg is a 30-bit quantity sign-extended to
+    #! 32-bits.
     #! exits with tagged ptr to bignum in reg
     [
         "end" define-label
@@ -60,25 +61,33 @@ M: float-regs (%replace)
     ] with-scope ;
 
 : %allot-bignum-signed-2 ( reg1 reg2 -- )
-    #! on entry, reg1 and reg2 together form a signed 64-bit
-    #! quantity.
+    #! this word has some hairy restrictions; its really only
+    #! intended to be used by fixnum*.
+    #! - reg1 and reg2 together form a 60-bit signed quantity
+    #!   (product of two 29-bit fixnums cannot exceed this)
+    #! - the quantity must be non-zero
+    #!   (if the product of two fixnums is zero, there's no
+    #!   overflow so this word won't be called in that case)
     #! exits with tagged ptr to bignum in reg1
     [
         "end" define-label
         "pos" define-label
         2 %allot-bignum
-        0 pick 0 CMPI ! is the 64-bit quantity negative?
+        0 pick 0 CMPI ! is the 60-bit quantity negative?
         "pos" get BGE
         1 12 LI
         12 11 2 cells STW ! store negative sign
-        over dup NOT ! negate 64-bit quanity
+        over dup NOT ! negate 60-bit quanity
         dup dup -1 MULI
         "end" get B
         "pos" resolve-label
         0 12 LI
         12 11 2 cells STW ! store positive sign
         "end" resolve-label
-        11 3 cells STW ! store the number
+        HEX: 3fffffff 12 LOAD ! first 30 bits set
+        dup dup 12 AND ! store the number
+        11 3 cells STW
+        dup dup 12 AND
         dup 11 4 cells STW
         11 swap bignum-tag ORI ! tag the bignum, store it in reg
     ] with-scope ;

diff --git a/library/compiler/ppc/intrinsics.factor b/library/compiler/ppc/intrinsics.factor
index 9c4d195b1a3f515b6b3fcae895fb807f85e584f0..d4f757f52e6a217de8946a3995e90e052b94d0b7 100644 (file)
--- a/library/compiler/ppc/intrinsics.factor
+++ b/library/compiler/ppc/intrinsics.factor
@@ -154,23 +154,24 @@ math-internals namespaces sequences words ;
     { +clobber+ { "x" "y" } }
 } define-intrinsic
 
-\ fixnum* [
-    "end" define-label
-    "r" operand "x" operand %untag-fixnum
-    0 MTXER
-    "s" operand "y" operand "r" operand MULLWO.
-    "end" get BNO
-    "s" operand "y" operand %untag-fixnum
-    "x" operand "s" operand "r" operand MULLWO.
-    "s" operand "s" operand "r" operand MULHW
-    "s" operand "x" operand %allot-bignum-signed-2
-    "end" resolve-label
-] H{
-    { +input+ { { f "x" } { f "y" } } }
-    { +scratch+ { { f "r" } { f "s" } } }
-    { +output+ { "s" } }
-    { +clobber+ { "x" "y" } }
-} define-intrinsic
+! \ fixnum* [
+!     "end" define-label
+!     "r" operand "x" operand %untag-fixnum
+!     0 MTXER
+!     "s" operand "y" operand "r" operand MULLWO.
+!     "end" get BNO
+!     "s" operand "y" operand 1 SRAWI
+!     "x" operand "s" operand "r" operand MULLWO.
+!     "x" operand dup 2 SRAWI
+!     "s" operand "s" operand "r" operand MULHW
+!     "s" operand "x" operand %allot-bignum-signed-2
+!     "end" resolve-label
+! ] H{
+!     { +input+ { { f "x" } { f "y" } } }
+!     { +scratch+ { { f "r" } { f "s" } } }
+!     { +output+ { "s" } }
+!     { +clobber+ { "x" "y" } }
+! } define-intrinsic
 
 : generate-fixnum/i
     #! This VOP is funny. If there is an overflow, it falls
@@ -217,6 +218,42 @@ math-internals namespaces sequences words ;
     { +clobber+ { "y" } }
 } define-intrinsic
 
+! \ fixnum>bignum [
+!     "nonzero" define-label
+!     "end" define-label
+!     0 "x" operand 0 CMPI ! is it zero?
+!     "nonzero" get BNE
+!     0 >bignum "x" get load-literal
+!     "end" get B
+!     "nonzero" resolve-label
+!     "x" operand dup %untag-fixnum
+!     "x" operand %allot-bignum-signed-1
+!     "end" resolve-label
+! ] H{
+!     { +input+ { { f "x" } } }
+!     { +output+ { "x" } }
+! } define-intrinsic
+! 
+! \ bignum>fixnum [
+!     "nonzero" define-label
+!     "end" define-label
+!     "y" operand "x" operand cell LWZ
+!     0 "x" operand 0 CMPI ! is it zero?
+!     "nonzero" get BNE
+!     0 "y" operand LI
+!     "end" get B
+!     "nonzero" resolve-label
+!     "y" operand "x" operand 2 cells LWZ
+!     "y" operand dup -1 tag-bits shift MULI
+!     "x" operand dup 3 cells LWZ
+!     "y" operand "y" operand "x" operand MULLW
+!     "end" resolve-label
+! ] H{
+!     { +input+ { { f "x" } } }
+!     { +scratch+ { { f "y" } } }
+!     { +output+ { "y" } }
+! } define-intrinsic
+
 : define-float-op ( word op -- )
     [ [ "x" operand "x" operand "y" operand ] % , ] [ ] make H{
         { +input+ { { float "x" } { float "y" } } }

diff --git a/library/compiler/test/intrinsics.factor b/library/compiler/test/intrinsics.factor
index a68648bd8c5fe2e385b7cef1565dc4c277471208..f6ee053e09a89cc32dd905a2fa5b6087e36f4c00 100644 (file)
--- a/library/compiler/test/intrinsics.factor
+++ b/library/compiler/test/intrinsics.factor
@@ -1,6 +1,6 @@
 IN: temporary
 USING: arrays compiler kernel kernel-internals math
-math-internals sequences strings test words ;
+math-internals sequences strings test words errors ;
 
 ! Make sure that intrinsic ops compile to correct code.
 [ 1 ] [ { 1 2 } [ 2 slot ] compile-1 ] unit-test
@@ -219,3 +219,35 @@ cell 8 = [
 
     [ 1152921504606846976 0 ] [ -1152921504606846976 >fixnum -1 [ fixnum/mod ] compile-1 ] unit-test
 ] when
+
+! Some randomized tests
+: compiled-fixnum* fixnum* ;
+\ compiled-fixnum* compile
+
+: test-fixnum*
+    (random-int) >fixnum (random-int) >fixnum
+    2dup
+    [ fixnum* ] 2keep compiled-fixnum* =
+    [ 2drop ] [ "Oops" throw ] if ;
+
+[ ] [ 10000 [ test-fixnum* ] times ] unit-test
+
+: compiled-fixnum>bignum fixnum>bignum ;
+\ compiled-fixnum>bignum compile
+
+: test-fixnum>bignum
+    (random-int) >fixnum
+    dup [ fixnum>bignum ] keep compiled-fixnum>bignum =
+    [ drop ] [ "Oops" throw ] if ;
+
+[ ] [ 10000 [ test-fixnum>bignum ] times ] unit-test
+
+: compiled-bignum>fixnum bignum>fixnum ;
+\ compiled-bignum>fixnum compile
+
+: test-bignum>fixnum
+    5 random-int [ drop (random-int) ] map product >bignum
+    dup [ bignum>fixnum ] keep compiled-bignum>fixnum =
+    [ drop ] [ "Oops" throw ] if ;
+
+[ ] [ 10000 [ test-bignum>fixnum ] times ] unit-test

diff --git a/library/compiler/x86/intrinsics.factor b/library/compiler/x86/intrinsics.factor
index 7563144b318922ce3448fffb76131a135fd4667f..9fabf4f7fd4d54172a2a2d17303ddfdc02194726 100644 (file)
--- a/library/compiler/x86/intrinsics.factor
+++ b/library/compiler/x86/intrinsics.factor
@@ -182,7 +182,7 @@ IN: compiler
 
 : %tag-overflow ( -- )
     #! Tag a cell-size value, where the tagging might posibly
-    #! overflow.
+    #! overflow BUT IT MUST NOT EXCEED cell-2 BITS
     "y" operand "x" operand MOV ! Make a copy
     "x" operand 1 tag-bits shift IMUL2 ! Tag it
     "end" get JNO ! Overflow?

diff --git a/library/test/math/integer.factor b/library/test/math/integer.factor
index 97d5f83fb48cb1b61d041766102a253883364428..7928ed7f6dd17ee1db2db8e5e334afa1c6e546f2 100644 (file)
--- a/library/test/math/integer.factor
+++ b/library/test/math/integer.factor
@@ -1,5 +1,5 @@
 IN: temporary
-USING: kernel math namespaces prettyprint test ;
+USING: kernel math namespaces prettyprint test math-internals ;
 
 [ "-8" ] [ -8 unparse ] unit-test
 

diff --git a/vm/bignumint.h b/vm/bignumint.h
index 51c8956034af2aad7b601922b4cdd6f4768daa86..cb6a42b5f765a810e6bdbc0cadb77c865841accf 100644 (file)
--- a/vm/bignumint.h
+++ b/vm/bignumint.h
@@ -79,8 +79,6 @@ typedef F_FIXNUM bignum_length_type;
 #define BIGNUM_ONE(neg_p) \
    untag_array_fast(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)
 #define HD_CONS(high, low) (((high) << BIGNUM_HALF_DIGIT_LENGTH) | (low))