From 194762776ee14a2a9d08bd175104c5497f716c94 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 3 Sep 2008 17:23:58 -0500 Subject: [PATCH 1/9] Euler benchmarks were leaving junk on the stack --- extra/benchmark/euler150/euler150.factor | 7 +++++-- extra/benchmark/euler186/euler186.factor | 5 +++-- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/extra/benchmark/euler150/euler150.factor b/extra/benchmark/euler150/euler150.factor index 5ee7c57e17..448c8575f9 100644 --- a/extra/benchmark/euler150/euler150.factor +++ b/extra/benchmark/euler150/euler150.factor @@ -1,4 +1,7 @@ IN: benchmark.euler150 -USE: project-euler.150 +USING: kernel project-euler.150 ; -MAIN: euler150 +: euler150-benchmark ( -- ) + euler150 -271248680 assert= ; + +MAIN: euler150-benchmark diff --git a/extra/benchmark/euler186/euler186.factor b/extra/benchmark/euler186/euler186.factor index 1124c8807c..344b922902 100644 --- a/extra/benchmark/euler186/euler186.factor +++ b/extra/benchmark/euler186/euler186.factor @@ -1,4 +1,5 @@ IN: benchmark.euler186 -USE: project-euler.186 +USING: kernel project-euler.186 ; -MAIN: euler186 +: euler186-benchmark ( -- ) + euler186 2325629 assert= ; From d12f55be3116ee93032baa66a8bb01bdbc00acfc Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 3 Sep 2008 17:24:06 -0500 Subject: [PATCH 2/9] Fix unit test failure in compiler --- core/classes/mixin/mixin.factor | 5 ++++- core/compiler/units/units.factor | 3 +-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/core/classes/mixin/mixin.factor b/core/classes/mixin/mixin.factor index 56e995899b..d569103d97 100755 --- a/core/classes/mixin/mixin.factor +++ b/core/classes/mixin/mixin.factor @@ -62,10 +62,13 @@ TUPLE: check-mixin-class mixin ; ] if-mixin-member? ; : remove-mixin-instance ( class mixin -- ) + #! The order of the three clauses is important here. The last + #! one must come after the other two so that the entries it + #! adds to changed-generics are not overwritten. [ - [ class-usages update-methods ] [ [ swap remove ] change-mixin-class ] [ nip update-classes ] + [ class-usages update-methods ] 2tri ] [ 2drop ] if-mixin-member? ; diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor index fa29a5a519..cb361ec9e6 100755 --- a/core/compiler/units/units.factor +++ b/core/compiler/units/units.factor @@ -110,8 +110,7 @@ SYMBOL: update-tuples-hook : (compiled-generic-usages) ( generic class -- assoc ) dup class? [ [ compiled-generic-usage ] dip - [ [ classes-intersect? ] [ null class<= ] bi or nip ] - curry assoc-filter + [ classes-intersect? nip ] curry assoc-filter ] [ 2drop f ] if ; : compiled-generic-usages ( assoc -- assocs ) From 6d506b89e8aa66f285b4512207d02588aa514cf7 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 3 Sep 2008 18:23:48 -0500 Subject: [PATCH 3/9] Image size reduction --- basis/compiler/compiler.factor | 4 ++-- basis/stack-checker/state/state.factor | 7 +++++-- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index d340c21663..2dd6e440d5 100755 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -43,8 +43,8 @@ SYMBOL: +failed+ [ dup crossref? [ - dependencies get - generic-dependencies get + dependencies get >alist + generic-dependencies get >alist compiled-xref ] [ drop ] if ] tri ; diff --git a/basis/stack-checker/state/state.factor b/basis/stack-checker/state/state.factor index 3d3db980e1..0d0de7f19b 100755 --- a/basis/stack-checker/state/state.factor +++ b/basis/stack-checker/state/state.factor @@ -89,8 +89,11 @@ SYMBOL: meta-r SYMBOL: dependencies : depends-on ( word how -- ) - dependencies get dup - [ swap '[ , strongest-dependency ] change-at ] [ 3drop ] if ; + over primitive? [ 2drop ] [ + dependencies get dup [ + swap '[ , strongest-dependency ] change-at + ] [ 3drop ] if + ] if ; ! Generic words that the current quotation depends on SYMBOL: generic-dependencies From fdf75fe110c592860a37aa56e8cd2003cf23bf96 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 3 Sep 2008 18:47:52 -0500 Subject: [PATCH 4/9] Remove slots.deprecated, remove unused slots from slot-spec tuple; last vestiges of old accessors are now gone forever --- basis/alien/structs/fields/fields.factor | 76 ++++++++++++++++++++++ basis/alien/structs/structs-docs.factor | 74 +--------------------- basis/alien/structs/structs.factor | 52 ++------------- basis/cpu/x86/64/64.factor | 2 +- core/slots/deprecated/deprecated.factor | 81 ------------------------ core/slots/slots.factor | 2 +- 6 files changed, 86 insertions(+), 201 deletions(-) create mode 100644 basis/alien/structs/fields/fields.factor delete mode 100755 core/slots/deprecated/deprecated.factor diff --git a/basis/alien/structs/fields/fields.factor b/basis/alien/structs/fields/fields.factor new file mode 100644 index 0000000000..5273c2c7ba --- /dev/null +++ b/basis/alien/structs/fields/fields.factor @@ -0,0 +1,76 @@ +! Copyright (C) 2005, 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays kernel kernel.private math namespaces +sequences strings words effects combinators alien.c-types ; +IN: alien.structs.fields + +TUPLE: field-spec name offset type reader writer ; + +: reader-effect ( type spec -- effect ) + [ 1array ] [ name>> 1array ] bi* ; + +PREDICATE: slot-reader < word "reading" word-prop >boolean ; + +: set-reader-props ( class spec -- ) + 2dup reader-effect + over reader>> + swap "declared-effect" set-word-prop + reader>> swap "reading" set-word-prop ; + +: writer-effect ( type spec -- effect ) + name>> swap 2array 0 ; + +PREDICATE: slot-writer < word "writing" word-prop >boolean ; + +: set-writer-props ( class spec -- ) + 2dup writer-effect + over writer>> + swap "declared-effect" set-word-prop + writer>> swap "writing" set-word-prop ; + +: reader-word ( class name vocab -- word ) + >r >r "-" r> 3append r> create ; + +: writer-word ( class name vocab -- word ) + >r [ swap "set-" % % "-" % % ] "" make r> create ; + +: ( struct-name vocab type field-name -- spec ) + field-spec new + 0 >>offset + swap >>name + swap expand-constants >>type + 3dup name>> swap reader-word >>reader + 3dup name>> swap writer-word >>writer + 2nip ; + +: align-offset ( offset type -- offset ) + c-type-align align ; + +: struct-offsets ( specs -- size ) + 0 [ + [ type>> align-offset ] keep + [ (>>offset) ] [ type>> heap-size + ] 2bi + ] reduce ; + +: define-struct-slot-word ( spec word quot -- ) + rot offset>> prefix define-inline ; + +: define-getter ( type spec -- ) + [ set-reader-props ] keep + [ ] + [ reader>> ] + [ + type>> + [ c-getter ] [ c-type-boxer-quot ] bi append + ] tri + define-struct-slot-word ; + +: define-setter ( type spec -- ) + [ set-writer-props ] keep + [ ] + [ writer>> ] + [ type>> c-setter ] tri + define-struct-slot-word ; + +: define-field ( type spec -- ) + [ define-getter ] [ define-setter ] 2bi ; diff --git a/basis/alien/structs/structs-docs.factor b/basis/alien/structs/structs-docs.factor index 6f83885d9f..62b8510d17 100755 --- a/basis/alien/structs/structs-docs.factor +++ b/basis/alien/structs/structs-docs.factor @@ -1,75 +1,7 @@ -IN: alien.structs USING: accessors alien.c-types strings help.markup help.syntax -alien.syntax sequences io arrays slots.deprecated -kernel words slots assocs namespaces accessors ; - -! Deprecated code -: ($spec-reader-values) ( slot-spec class -- element ) - dup ?word-name swap 2array - over name>> - rot class>> 2array 2array - [ { $instance } swap suffix ] assoc-map ; - -: $spec-reader-values ( slot-spec class -- ) - ($spec-reader-values) $values ; - -: $spec-reader-description ( slot-spec class -- ) - [ - "Outputs the value stored in the " , - { $snippet } rot name>> suffix , - " slot of " , - { $instance } swap suffix , - " instance." , - ] { } make $description ; - -: slot-of-reader ( reader specs -- spec/f ) - [ reader>> eq? ] with find nip ; - -: $spec-reader ( reader slot-specs class -- ) - >r slot-of-reader r> - over [ - 2dup $spec-reader-values - 2dup $spec-reader-description - ] when 2drop ; - -GENERIC: slot-specs ( help-type -- specs ) - -M: word slot-specs "slots" word-prop ; - -: $slot-reader ( reader -- ) - first dup "reading" word-prop [ slot-specs ] keep - $spec-reader ; - -: $spec-writer-values ( slot-spec class -- ) - ($spec-reader-values) reverse $values ; - -: $spec-writer-description ( slot-spec class -- ) - [ - "Stores a new value to the " , - { $snippet } rot name>> suffix , - " slot of " , - { $instance } swap suffix , - " instance." , - ] { } make $description ; - -: slot-of-writer ( writer specs -- spec/f ) - [ writer>> eq? ] with find nip ; - -: $spec-writer ( writer slot-specs class -- ) - >r slot-of-writer r> - over [ - 2dup $spec-writer-values - 2dup $spec-writer-description - dup ?word-name 1array $side-effects - ] when 2drop ; - -: $slot-writer ( reader -- ) - first dup "writing" word-prop [ slot-specs ] keep - $spec-writer ; - -M: string slot-specs c-type fields>> ; - -M: array ($instance) first ($instance) " array" write ; +alien.syntax sequences io arrays kernel words assocs namespaces +accessors ; +IN: alien.structs ARTICLE: "c-structs" "C structure types" "A " { $snippet "struct" } " in C is essentially a block of memory with the value of each structure field stored at a fixed offset from the start of the block. The C library interface provides some utilities to define words which read and write structure fields given a base address." diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor index e6a363941d..e82d663d08 100755 --- a/basis/alien/structs/structs.factor +++ b/basis/alien/structs/structs.factor @@ -1,43 +1,10 @@ -! Copyright (C) 2004, 2007 Slava Pestov. +! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays generic hashtables kernel kernel.private -math namespaces parser sequences strings words libc slots -slots.deprecated alien.c-types cpu.architecture ; +math namespaces parser sequences strings words libc +alien.c-types alien.structs.fields cpu.architecture ; IN: alien.structs -: align-offset ( offset type -- offset ) - c-type-align align ; - -: struct-offsets ( specs -- size ) - 0 [ - [ class>> align-offset ] keep - [ (>>offset) ] 2keep - class>> heap-size + - ] reduce ; - -: define-struct-slot-word ( spec word quot -- ) - rot offset>> prefix define-inline ; - -: define-getter ( type spec -- ) - [ set-reader-props ] keep - [ ] - [ reader>> ] - [ - class>> - [ c-getter ] [ c-type-boxer-quot ] bi append - ] tri - define-struct-slot-word ; - -: define-setter ( type spec -- ) - [ set-writer-props ] keep - [ ] - [ writer>> ] - [ class>> c-setter ] tri - define-struct-slot-word ; - -: define-field ( type spec -- ) - 2dup define-getter define-setter ; - : if-value-structs? ( ctype true false -- ) value-structs? [ drop call ] [ >r 2drop "void*" r> call ] if ; inline @@ -76,17 +43,8 @@ M: struct-type stack-size struct-type boa -rot define-c-type ; -: make-field ( struct-name vocab type field-name -- spec ) - - 0 >>offset - swap >>name - swap expand-constants >>class - 3dup name>> swap reader-word >>reader - 3dup name>> swap writer-word >>writer - 2nip ; - : define-struct-early ( name vocab fields -- fields ) - -rot [ rot first2 make-field ] 2curry map ; + -rot [ rot first2 ] 2curry map ; : compute-struct-align ( types -- n ) [ c-type-align ] map supremum ; @@ -94,7 +52,7 @@ M: struct-type stack-size : define-struct ( name vocab fields -- ) pick >r [ struct-offsets ] keep - [ [ class>> ] map compute-struct-align ] keep + [ [ type>> ] map compute-struct-align ] keep [ (define-struct) ] keep r> [ swap define-field ] curry each ; diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index c1697f1d98..6e864ab968 100755 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -178,7 +178,7 @@ stack-params "__stack_value" c-type (>>reg-class) >> : struct-types&offset ( struct-type -- pairs ) fields>> [ - [ class>> ] [ offset>> ] bi 2array + [ type>> ] [ offset>> ] bi 2array ] map ; : split-struct ( pairs -- seq ) diff --git a/core/slots/deprecated/deprecated.factor b/core/slots/deprecated/deprecated.factor deleted file mode 100755 index df16f0baa8..0000000000 --- a/core/slots/deprecated/deprecated.factor +++ /dev/null @@ -1,81 +0,0 @@ -! Copyright (C) 2005, 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays kernel kernel.private math namespaces -sequences strings words effects generic generic.standard -classes slots.private combinators slots ; -IN: slots.deprecated - -: reader-effect ( class spec -- effect ) - >r ?word-name 1array r> name>> 1array ; - -PREDICATE: slot-reader < word "reading" word-prop >boolean ; - -: set-reader-props ( class spec -- ) - 2dup reader-effect - over reader>> - swap "declared-effect" set-word-prop - reader>> swap "reading" set-word-prop ; - -: define-slot-word ( class word quot -- ) - [ - dup define-simple-generic - create-method - ] dip define ; - -: define-reader ( class spec -- ) - dup reader>> [ - [ set-reader-props ] 2keep - dup reader>> - swap reader-quot - define-slot-word - ] [ - 2drop - ] if ; - -: writer-effect ( class spec -- effect ) - name>> swap ?word-name 2array 0 ; - -PREDICATE: slot-writer < word "writing" word-prop >boolean ; - -: set-writer-props ( class spec -- ) - 2dup writer-effect - over writer>> - swap "declared-effect" set-word-prop - writer>> swap "writing" set-word-prop ; - -: define-writer ( class spec -- ) - dup writer>> [ - [ set-writer-props ] 2keep - dup writer>> - swap writer-quot - define-slot-word - ] [ - 2drop - ] if ; - -: define-slot ( class spec -- ) - 2dup define-reader define-writer ; - -: define-slots ( class specs -- ) - [ define-slot ] with each ; - -: reader-word ( class name vocab -- word ) - >r >r "-" r> 3append r> create ; - -: writer-word ( class name vocab -- word ) - >r [ swap "set-" % % "-" % % ] "" make r> create ; - -: (simple-slot-word) ( class name -- class name vocab ) - over vocabulary>> >r >r name>> r> r> ; - -: simple-reader-word ( class name -- word ) - (simple-slot-word) reader-word ; - -: simple-writer-word ( class name -- word ) - (simple-slot-word) writer-word ; - -: deprecated-slots ( class slot-specs -- slot-specs' ) - [ - 2dup name>> simple-reader-word >>reader - 2dup name>> simple-writer-word >>writer - ] map nip ; diff --git a/core/slots/slots.factor b/core/slots/slots.factor index 8754444ce0..6f831c30c5 100755 --- a/core/slots/slots.factor +++ b/core/slots/slots.factor @@ -6,7 +6,7 @@ classes.algebra slots.private combinators accessors words sequences.private assocs alien ; IN: slots -TUPLE: slot-spec name offset class initial read-only reader writer ; +TUPLE: slot-spec name offset class initial read-only ; PREDICATE: reader < word "reader" word-prop ; From 87afb9d6576da1d5243130b8e7bdea25cfd611d1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 3 Sep 2008 18:48:03 -0500 Subject: [PATCH 5/9] Fix benchmark --- extra/benchmark/euler186/euler186.factor | 2 ++ 1 file changed, 2 insertions(+) diff --git a/extra/benchmark/euler186/euler186.factor b/extra/benchmark/euler186/euler186.factor index 344b922902..681ca0e269 100644 --- a/extra/benchmark/euler186/euler186.factor +++ b/extra/benchmark/euler186/euler186.factor @@ -3,3 +3,5 @@ USING: kernel project-euler.186 ; : euler186-benchmark ( -- ) euler186 2325629 assert= ; + +MAIN: euler186-benchmark From 4f86c5ce7f179169a1f58129f4d6e80cfeafcd91 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 3 Sep 2008 20:09:39 -0500 Subject: [PATCH 6/9] Add unportable tags to blas for now --- extra/math/blas/cblas/tags.txt | 1 + extra/math/blas/matrices/tags.txt | 1 + extra/math/blas/syntax/tags.txt | 1 + extra/math/blas/vectors/tags.txt | 1 + 4 files changed, 4 insertions(+) diff --git a/extra/math/blas/cblas/tags.txt b/extra/math/blas/cblas/tags.txt index 241ec1ecda..5118958180 100644 --- a/extra/math/blas/cblas/tags.txt +++ b/extra/math/blas/cblas/tags.txt @@ -1,2 +1,3 @@ math bindings +unportable diff --git a/extra/math/blas/matrices/tags.txt b/extra/math/blas/matrices/tags.txt index 241ec1ecda..5118958180 100644 --- a/extra/math/blas/matrices/tags.txt +++ b/extra/math/blas/matrices/tags.txt @@ -1,2 +1,3 @@ math bindings +unportable diff --git a/extra/math/blas/syntax/tags.txt b/extra/math/blas/syntax/tags.txt index ede10ab61b..6a932d96d2 100644 --- a/extra/math/blas/syntax/tags.txt +++ b/extra/math/blas/syntax/tags.txt @@ -1 +1,2 @@ math +unportable diff --git a/extra/math/blas/vectors/tags.txt b/extra/math/blas/vectors/tags.txt index ede10ab61b..6a932d96d2 100644 --- a/extra/math/blas/vectors/tags.txt +++ b/extra/math/blas/vectors/tags.txt @@ -1 +1,2 @@ math +unportable From e9877bf940cfab9ad3a7c800ee30fff5bfede41b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 3 Sep 2008 20:19:52 -0500 Subject: [PATCH 7/9] Move csv to basis --- {extra => basis}/csv/authors.txt | 0 {extra => basis}/csv/csv-docs.factor | 0 {extra => basis}/csv/csv-tests.factor | 0 {extra => basis}/csv/csv.factor | 0 {extra => basis}/csv/summary.txt | 0 5 files changed, 0 insertions(+), 0 deletions(-) rename {extra => basis}/csv/authors.txt (100%) rename {extra => basis}/csv/csv-docs.factor (100%) rename {extra => basis}/csv/csv-tests.factor (100%) rename {extra => basis}/csv/csv.factor (100%) rename {extra => basis}/csv/summary.txt (100%) diff --git a/extra/csv/authors.txt b/basis/csv/authors.txt similarity index 100% rename from extra/csv/authors.txt rename to basis/csv/authors.txt diff --git a/extra/csv/csv-docs.factor b/basis/csv/csv-docs.factor similarity index 100% rename from extra/csv/csv-docs.factor rename to basis/csv/csv-docs.factor diff --git a/extra/csv/csv-tests.factor b/basis/csv/csv-tests.factor similarity index 100% rename from extra/csv/csv-tests.factor rename to basis/csv/csv-tests.factor diff --git a/extra/csv/csv.factor b/basis/csv/csv.factor similarity index 100% rename from extra/csv/csv.factor rename to basis/csv/csv.factor diff --git a/extra/csv/summary.txt b/basis/csv/summary.txt similarity index 100% rename from extra/csv/summary.txt rename to basis/csv/summary.txt From 15391abdd7d33b39f78bac1d873c7a77952c534e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 3 Sep 2008 20:20:03 -0500 Subject: [PATCH 8/9] Print call stack trace for thread errors --- basis/debugger/threads/threads.factor | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/basis/debugger/threads/threads.factor b/basis/debugger/threads/threads.factor index 093d231d08..7bb240859e 100644 --- a/basis/debugger/threads/threads.factor +++ b/basis/debugger/threads/threads.factor @@ -10,14 +10,17 @@ IN: debugger.threads dup id>> # " (" % dup name>> % ", " % dup quot>> unparse-short % ")" % - ] "" make swap write-object ":" print nl ; + ] "" make swap write-object ":" print ; M: thread error-in-thread ( error thread -- ) initial-thread get-global eq? [ die drop ] [ global [ - error-thread get-global error-in-thread. print-error flush + error-thread get-global error-in-thread. nl + print-error nl + :c + flush ] bind ] if ; From 90b2bfbc4334353d1db8f6be8d4c0def49062a64 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 3 Sep 2008 21:03:31 -0500 Subject: [PATCH 9/9] Fix benchmark --- extra/benchmark/typecheck4/typecheck4.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/benchmark/typecheck4/typecheck4.factor b/extra/benchmark/typecheck4/typecheck4.factor index a2595810be..c881864304 100644 --- a/extra/benchmark/typecheck4/typecheck4.factor +++ b/extra/benchmark/typecheck4/typecheck4.factor @@ -3,7 +3,7 @@ IN: benchmark.typecheck4 TUPLE: hello n ; -: hello-n* ( obj -- val ) 3 slot ; +: hello-n* ( obj -- val ) 2 slot ; : foo ( obj -- obj n ) 0 100000000 [ over hello-n* + ] times ;