more PowerPC fixes, bootstrap works

TODO.FACTOR.txt

@@ -6,6 +6,8 @@
 <magnus--> http://www.caddr.com/macho/archives/sbcl-devel/2005-3/4764.html
 <magnus--> http://clozure.com/cgi-bin/viewcvs.cgi/ccl/lisp-kernel/lisp-exceptions.c?rev=1.9&content-type=text/vnd.viewcvs-markup
 
+<erg> if write returns -1  and errno == EINTR then it's not a real error, you can try again
+
 - make head? tail? more efficient with slices
 - fix ceiling
 - single-stepper and variable access: wrong namespace?

library/collections/hashtables.factor

@@ -25,6 +25,8 @@ BUILTIN: hashtable 10 hashtable?
 ! if it is somewhat 'implementation detail', is in the
 ! public 'hashtables' vocabulary.
 
+: bucket-count ( hash -- n ) hash-array length ;
+
 IN: kernel-internals
 
 : hash-bucket ( n hash -- alist )
@@ -54,8 +56,6 @@ IN: kernel-internals
     
 IN: hashtables
 
-: bucket-count ( hash -- n ) hash-array length ;
-
 : (hashcode) ( key table -- index )
     #! Compute the index of the bucket for a key.
     >r hashcode r> bucket-count rem ; inline

library/compiler/intrinsics.factor

@@ -70,7 +70,7 @@ sequences words ;
 : typed-literal? ( node -- ? )
     #! Output if the node's first input is well-typed, and the
     #! second is a literal.
-    dup node-peek literal? swap node-peek-2 typed? and ;
+    dup node-peek safe-literal? swap node-peek-2 typed? and ;
 
 \ slot [
     dup typed-literal? [
@@ -152,7 +152,7 @@ sequences words ;
     0 0 %replace-d , ; inline
 
 : literal-fixnum? ( value -- ? )
-    dup literal? [ literal-value fixnum? ] [ drop f ] ifte ;
+    dup safe-literal? [ literal-value fixnum? ] [ drop f ] ifte ;
 
 : binary-op-imm ( imm op -- )
     1 %dec-d , in-1

library/compiler/linearizer.factor

@@ -1,8 +1,9 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: compiler-frontend
-USING: compiler-backend inference kernel kernel-internals lists
-math namespaces words strings errors prettyprint sequences ;
+USING: compiler-backend errors generic inference kernel
+kernel-internals lists math namespaces prettyprint sequences
+strings words ;
 
 GENERIC: linearize-node* ( node -- )
 M: f linearize-node* ( f -- ) drop ;
@@ -44,14 +45,17 @@ M: #call-label linearize-node* ( node -- )
 
 GENERIC: load-value ( vreg n value -- )
 
-M: computed load-value ( vreg n value -- )
+M: object load-value ( vreg n value -- )
     drop %peek-d , ;
 
-M: literal load-value ( vreg n value -- )
-    nip literal-value dup
+: push-literal ( vreg value -- )
+    literal-value dup
     immediate? [ %immediate ] [ %indirect ] ifte , ;
 
-: push-1 ( value -- ) >r 0 0 r> load-value ;
+M: safe-literal load-value ( vreg n value -- )
+    nip push-literal ;
+
+: push-1 ( value -- ) 0 swap push-literal ;
 
 M: #push linearize-node* ( node -- )
     node-out-d dup length dup %inc-d ,

library/compiler/ppc/alien.factor

@@ -11,7 +11,7 @@ M: %alien-invoke generate-node ( vop -- )
 : stack@ 3 + cell * ;
 
 M: %parameters generate-node ( vop -- )
-    dup 0 = [ drop ] [ stack-size 1 1 rot SUBI ] ifte ;
+    vop-in-1 dup 0 = [ drop ] [ stack-size 1 1 rot SUBI ] ifte ;
 
 M: %unbox generate-node ( vop -- )
     vop-in-1 uncons f compile-c-call 3 1 rot stack@ STW ;

library/compiler/ppc/stack.factor

@@ -7,7 +7,7 @@ USING: assembler compiler errors kernel math memory words ;
 : cs-op cell * neg 15 swap ;
 
 M: %immediate generate-node ( vop -- )
-    dup vop-in-1 address swap vop-out-1 v>operand LOAD32 ;
+    dup vop-in-1 address swap vop-out-1 v>operand LOAD ;
 
 : load-indirect ( dest literal -- )
     intern-literal over LOAD dup 0 LWZ ;

library/compiler/vops.factor

@@ -160,7 +160,7 @@ M: %slot basic-block? drop t ;
 VOP: %set-slot
 : %set-slot ( value obj n )
     #! %set-slot writes to vreg n.
-    >r >r <vreg> r> <vreg> r> <vreg> [ 3list ] keep unit f
+    >r >r <vreg> r> <vreg> r> <vreg> 3list dup second f
     <%set-slot> ;
 M: %set-slot basic-block? drop t ;
 
@@ -179,7 +179,7 @@ VOP: %fast-set-slot
 M: %fast-set-slot basic-block? drop t ;
 
 VOP: %write-barrier
-: %write-barrier ( ptr ) <vreg> unit f f <%write-barrier> ;
+: %write-barrier ( ptr ) <vreg> unit dup f <%write-barrier> ;
 
 ! fixnum intrinsics
 VOP: %fixnum+       : %fixnum+ 3-vop <%fixnum+> ;

library/inference/values.factor

@@ -5,7 +5,6 @@ USING: generic kernel lists namespaces sequences unparser words ;
 
 GENERIC: value= ( literal value -- ? )
 GENERIC: value-class-and ( class value -- )
-GENERIC: safe-literal? ( value -- ? )
 
 SYMBOL: cloned
 GENERIC: clone-value ( value -- value )
@@ -60,15 +59,11 @@ M: literal value-class-and ( class value -- )
 M: literal set-value-class ( class value -- )
     2drop ;
 
-M: literal safe-literal? ( value -- ? ) value-safe? ;
-
 M: computed clone-value ( value -- value )
     dup cloned get assq [ ] [
         dup clone [ swap cloned [ acons ] change ] keep
     ] ?ifte ;
 
-M: computed safe-literal? drop f ;
-
 M: computed literal-value ( value -- )
     "A literal value was expected where a computed value was"
     " found: " rot unparse append3 inference-error ;
@@ -78,3 +73,6 @@ M: computed literal-value ( value -- )
 
 : >literal< ( literal -- rstate obj )
     dup value-recursion swap literal-value ;
+
+PREDICATE: tuple safe-literal ( obj -- ? )
+    dup literal? [ value-safe? ] [ drop f ] ifte ;

library/math/math.factor

@@ -89,7 +89,7 @@ GENERIC: abs ( z -- |z| )
 
 : log2 ( n -- b )
     #! Log base two for integers.
-    dup 0 < [
+    dup 0 <= [
         "Input must be positive" throw
     ] [
         dup 1 = [ drop 0 ] [ 2 /i log2 1 + ] ifte

library/test/math/matrices.factor

@@ -13,7 +13,7 @@ USING: kernel lists math matrices namespaces sequences test ;
 [
     M[ [ 1 ] [ 2 ] [ 3 ] ]M
 ] [
-    { 1 2 3 } <col-vector>
+    { 1 2 3 } <col-matrix>
 ] unit-test
 
 [

library/test/test.factor

@@ -87,7 +87,7 @@ SYMBOL: failures
         "httpd/url-encoding" "httpd/html" "httpd/httpd"
         "httpd/http-client"
         "crashes" "sbuf" "threads" "parsing-word"
-        "inference" "dataflow" "interpreter" "alien"
+        "inference" "interpreter" "alien"
         "line-editor" "gadgets" "memory" "redefine"
         "annotate" "sequences"
     ] run-tests ;

library/test/tuple.factor

@@ -76,3 +76,8 @@ M: circle area circle-radius sq pi * ;
 ! Hashcode breakage
 TUPLE: empty ;
 [ t ] [ <empty> hashcode fixnum? ] unit-test
+
+TUPLE: delegate-clone ;
+
+[ << delegate-clone << empty f >> >> ]
+[ << delegate-clone << empty f >> >> clone ] unit-test