]> gitweb.factorcode.org Git - factor.git/commitdiff
more PowerPC fixes, bootstrap works
authorSlava Pestov <slava@factorcode.org>
Thu, 9 Jun 2005 23:49:31 +0000 (23:49 +0000)
committerSlava Pestov <slava@factorcode.org>
Thu, 9 Jun 2005 23:49:31 +0000 (23:49 +0000)
12 files changed:
TODO.FACTOR.txt
library/collections/hashtables.factor
library/compiler/intrinsics.factor
library/compiler/linearizer.factor
library/compiler/ppc/alien.factor
library/compiler/ppc/stack.factor
library/compiler/vops.factor
library/inference/values.factor
library/math/math.factor
library/test/math/matrices.factor
library/test/test.factor
library/test/tuple.factor

index 379901422074ddbdbebe57def4c9f837d0d79e99..8c83b47322e85a3d3b0cf7a17309022d9f07243b 100644 (file)
@@ -6,6 +6,8 @@
 <magnus--> http://www.caddr.com/macho/archives/sbcl-devel/2005-3/4764.html\r
 <magnus--> http://clozure.com/cgi-bin/viewcvs.cgi/ccl/lisp-kernel/lisp-exceptions.c?rev=1.9&content-type=text/vnd.viewcvs-markup\r
 \r
+<erg> if write returns -1  and errno == EINTR then it's not a real error, you can try again\r
+\r
 - make head? tail? more efficient with slices\r
 - fix ceiling\r
 - single-stepper and variable access: wrong namespace?\r
index 4ec6ff154b8b4c6322a812103f0ed6e092a67983..5a929154ca4edd8c5094130ff979f6960009a34e 100644 (file)
@@ -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
index 99b4cbecad6dbe240cde7db8114a5a8432b64def..f864fd571512ace3fb70aaea6e5c1df9aafc43ca 100644 (file)
@@ -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
index 4f589dcf0a60bd50ca019229ad0d7f3e533381cb..d9f16b89c288636e22c62669047585f7a16e94d6 100644 (file)
@@ -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 ,
index cf187b5086fdf2d4e82d1011e1475dcb09261d83..2c3e62bac389d53de8d7971cc83f0842531b3f94 100644 (file)
@@ -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 ;
index de14a5afb3565bc62bc65d830d94a7b301f83833..e86ad433d0c8cf263ad834d2caf71f7ec429ef1b 100644 (file)
@@ -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 ;
index b0edc0095c99c9b0f1b5ed3a663a4caeff6aae21..b8a94f8e0ec38fb481acbc28037ad6e40dac1164 100644 (file)
@@ -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+> ;
index bf94babf50d81d3851d973c8a9787ffbae9f854a..004accfcb2b917633ad99dd6f9229b976d76d258 100644 (file)
@@ -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 ;
index 12af83dc02d011f4b10d82836c60e2740b0b065a..bc962eb5f5076ffa996f82b44b120d360f0afa17 100644 (file)
@@ -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
index 3a55b2384cddbb3b50ac4198c70ee7f8640fcb77..e59ae4d187d46b2d9f8bc13473fcfd2f70a269d9 100644 (file)
@@ -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
 
 [
index 1af733690ef41f7db6b4ddc9a59d24558e8b8a95..88a5f2c3df3ef33babbbe939894ac7881d605561 100644 (file)
@@ -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 ;
index e014d89e4b5aeba085ff02b0abf93857376b3f12..947bf5025b6db751533e0344fe26ed38fdfcaac8 100644 (file)
@@ -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