diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 3799014220..8c83b47322 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -6,6 +6,8 @@ http://www.caddr.com/macho/archives/sbcl-devel/2005-3/4764.html http://clozure.com/cgi-bin/viewcvs.cgi/ccl/lisp-kernel/lisp-exceptions.c?rev=1.9&content-type=text/vnd.viewcvs-markup + 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? diff --git a/library/collections/hashtables.factor b/library/collections/hashtables.factor index 4ec6ff154b..5a929154ca 100644 --- a/library/collections/hashtables.factor +++ b/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 diff --git a/library/compiler/intrinsics.factor b/library/compiler/intrinsics.factor index 99b4cbecad..f864fd5715 100644 --- a/library/compiler/intrinsics.factor +++ b/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 diff --git a/library/compiler/linearizer.factor b/library/compiler/linearizer.factor index 4f589dcf0a..d9f16b89c2 100644 --- a/library/compiler/linearizer.factor +++ b/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 , diff --git a/library/compiler/ppc/alien.factor b/library/compiler/ppc/alien.factor index cf187b5086..2c3e62bac3 100644 --- a/library/compiler/ppc/alien.factor +++ b/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 ; diff --git a/library/compiler/ppc/stack.factor b/library/compiler/ppc/stack.factor index de14a5afb3..e86ad433d0 100644 --- a/library/compiler/ppc/stack.factor +++ b/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 ; diff --git a/library/compiler/vops.factor b/library/compiler/vops.factor index b0edc0095c..b8a94f8e0e 100644 --- a/library/compiler/vops.factor +++ b/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 r> r> [ 3list ] keep unit f + >r >r r> r> 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 ) unit f f <%write-barrier> ; +: %write-barrier ( ptr ) unit dup f <%write-barrier> ; ! fixnum intrinsics VOP: %fixnum+ : %fixnum+ 3-vop <%fixnum+> ; diff --git a/library/inference/values.factor b/library/inference/values.factor index bf94babf50..004accfcb2 100644 --- a/library/inference/values.factor +++ b/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 ; diff --git a/library/math/math.factor b/library/math/math.factor index 12af83dc02..bc962eb5f5 100644 --- a/library/math/math.factor +++ b/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 diff --git a/library/test/math/matrices.factor b/library/test/math/matrices.factor index 3a55b2384c..e59ae4d187 100644 --- a/library/test/math/matrices.factor +++ b/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 } + { 1 2 3 } ] unit-test [ diff --git a/library/test/test.factor b/library/test/test.factor index 1af733690e..88a5f2c3df 100644 --- a/library/test/test.factor +++ b/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 ; diff --git a/library/test/tuple.factor b/library/test/tuple.factor index e014d89e4b..947bf5025b 100644 --- a/library/test/tuple.factor +++ b/library/test/tuple.factor @@ -76,3 +76,8 @@ M: circle area circle-radius sq pi * ; ! Hashcode breakage TUPLE: empty ; [ t ] [ hashcode fixnum? ] unit-test + +TUPLE: delegate-clone ; + +[ << delegate-clone << empty f >> >> ] +[ << delegate-clone << empty f >> >> clone ] unit-test